/	OS/8 BOO DECODING PROGRAM

/	LAST EDIT:	22-OCT-1991	12:00:00	CJL

/	MAY BE ASSEMBLED WITH '/F' SWITCH SET.

/	PROGRAM TO  DECODE  OS/8  FILES  FROM  "PRINTABLE"  ASCII  (".BOO")  FORMAT TO
/	BINARY-IMAGE FORMAT.   INTERMEDIATE  "ASCII"  CONVERSION SHOULD BE HARMLESS AS
/	LONG AS ALL PRINTING DATA CHARACTERS ARE NOT MODIFIED.

/	DISTRIBUTED BY CUCCA AS "K12DEB.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE.

/	WRITTEN BY:

/	CHARLES LASNER (CJL)
/	CLA SYSTEMS
/	72-55 METROPOLITAN AVENUE
/	MIDDLE VILLAGE, NEW YORK 11379-2107
/	(718) 894-6499

/	USAGE:

/	THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH  HAVE  BEEN  CREATED BY
/	ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES.  THE ENCODING FORMAT ALLOWS
/	FOR  CERTAIN  "WHITE  SPACE" MODIFICATIONS SUCH AS LINE WIDTH REFORMATTING  AS
/	LONG  AS  ALL  PRINTING CHARACTERS ARE UNMODIFIED.  EXTRANEOUS <CR>/<LF> PAIRS
/	AND ALL OTHER CONTROL CHARACTERS (<FF>, <VT>, ETC.) ARE IGNORED.

/	WHEN CREATING THE DESCENDANT DECODED FILE,  THE  USER  MAY  SPECIFY EITHER THE
/	IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE
/	OR A SPECIFIED DEVICE: 

/	.RUN DEV DEBOO		INVOKE PROGRAM.
/	*INPUT			INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT).
/	*DEV:OUTPUT.EX<INPUT	INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:.
/	*DEV:<INPUT		INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:.
/	*OUTPUT.EX<INPUT$	INPUT IS  DECODED  INTO  OUTPUT.EX ON DSK:  (DEFAULT).
/				THE <ESC> CHARACTER  WAS  USED  TO  TERMINATE THE LINE
/				(THIS IS SIGNIFIED BY $).  THIS CAUSES PROGRAM EXIT.
/	.			PROGRAM EXITS NORMALLY.

/	INPUT FILE ASSUMES .BO EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION.

/	PROGRAM EXIT IS THE NORMAL  OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
/	KEYBOARD DURING THE COMMAND, OR ENDING  THE  COMMAND  INPUT LINE WITH AN <ESC>
/	CHARACTER.
/	.BOO FORMAT IMPLEMENTATION DESCRIPTION.

/	THIS  PROGRAM  SUPPORTS  STANDARD .BOO FORMAT ENCODED FILES AND OPTIONALLY THE
/	USE OF LENGTH CORRECTION BYTES AT THE FILE'S END TO ENSURE PROPER  LENGTH.  IF
/	NO  LENGTH CORRECTION FIELDS ARE FOUND, IT IS ASSUMED THEY AREN'T NEEDED;   IT
/	IS THE RESPONIBILITY OF THE ENCODER TO INSERT THESE FIELDS IF NECESSARY.  OS/8
/	FILES PROPERLY  ENCODED  BY THE COMPANION ENBOO-ING PROGRAM (ENBOO AKA K12ENB)
/	WILL CONTAIN SUCH  BYTES AS NECESSARY, AND WILL BE PROPERLY DECODED INTO THEIR
/	ORIGINAL FORM WITHOUT LOSS.  ALL OTHER FILES WILL BE <NUL>-PADDED AS NECESSARY
/	TO ROUND-UP THE FILE SIZE  TO  A  NUMBER  OF  COMPLETE  OS/8  RECORDS;   THEIR
/	ORIGINAL LENGTH WILL BE LOST.

/	**** WARNING **** USE OF  ENBOO-ING  PROGRAMS NOT COMPATIBLE WITH THE OPTIONAL
/	LENGTH  CORRECTION SCHEME CAN PRODUCE FILES  DRASTICALLY  DIFFERENT  FROM  THE
/	ORIGINAL;  AN ENTIRE OS/8 RECORD CONTAINING <NUL> CHARACTERS COULD BE APPENDED
/	TO THE END OF THE  FILES.    BEYOND  THE  WASTE OF DISK SPACE, THESE DEFECTIVE
/	FILES COULD ACTUALLY BE DANGEROUS TO USE UNDER OS/8.

/	ORDINARILY THESE FILES SHOULDN'T EXIST, BUT COULD BE CREATED  BY  METHODS SUCH
/	AS DECODING ON OTHER SYSTEMS FOLLOWED BY USE OF ENCODERS INCOMPATIBLE WITH THE
/	LENGTH CORRECTION SCHEME.  THIS TENDS TO MAKE THE FILE SIZE  WRONG  BY  ONE OR
/	TWO  BYTES,  WHICH  WHEN  DECODED  HERE  WILL CAUSE THE CREATION OF AN  ENTIRE
/	ERRONEOUS  RECORD.    IT IS RECOMMENDED THAT FILES STORED ON OTHER SYSTEMS FOR
/	EVENTUALLY DELIVERY  TO  OS/8  SYSTEMS BE MAINTAINED IN .BOO FORMAT TO PREVENT
/	THIS FORM OF FILE CORRUPTION.

/	ERROR MESSAGES.

/	ANY MESSAGE  PRINTED  IS A FATAL ERROR MESSAGE.  ALL MESSAGES ARE THE STANDARD
/	OS/8 "USER" ERROR  MESSAGES OF THE FORM:  USER ERROR X AT AAAAA WHERE X IS THE
/	ERROR NUMBER AND AAAAA  IS  THE  PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
/	THE FOLLOWING USER ERRORS ARE DEFINED:

/	ERROR NUMBER		PROBABLE CAUSE

/	0			TOO MANY OUTPUT FILES.

/	1			NO INPUT FILE OR TOO MANY INPUT FILES.

/	2			IMBEDDED OUTPUT FILENAME FORMAT ERROR.

/	3			I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME.

/	4			ERROR WHILE FETCHING FILE HANDLER.

/	5			ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.

/	6			OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.

/	7			ERROR WHILE CLOSING THE OUTPUT FILE.

/	8			I/O ERROR WHILE DECODING FILE DATA OR BAD DATA.

/	9			OUTPUT ERROR WHILE DECODING FILE DATA.
/	ASSEMBLY INSTRUCTIONS.

/	IT IS  ASSUMED  THE  SOURCE  FILE  K12DEB.PAL  HAS  BEEN  MOVED AND RENAMED TO
/	DSK:DEBOO.PA.

/	.PAL DEBOO<DEBOO/E/F	ASSEMBLE SOURCE PROGRAM
/	.LOAD DEBOO		LOAD THE BINARY FILE
/	.SAVE DEV DEBOO=0	SAVE THE CORE-IMAGE FILE
/	DEFINITIONS.

	CLOSE=	4		/CLOSE OUTPUT FILE
	DECODE=	5		/CALL COMMAND DECODER
	ENTER=	3		/ENTER TENTATIVE FILE
	FETCH=	1		/FETCH HANDLER
	IHNDBUF=7200		/INPUT HANDLER BUFFER
	INBUFFE=6200		/INPUT BUFFER
	INFILE=	7617		/INPUT FILE INFORMATION HERE
	INQUIRE=12		/INQUIRE ABOUT HANDLER
	NL0001=	CLA IAC		/LOAD AC WITH 0001
	NL0002=	CLA CLL CML RTL	/LOAD AC WITH 0002
	NL7776=	CLA CLL CMA RAL	/LOAD AC WITH 7776
	NL7777=	CLA CMA		/LOAD AC WITH 7777
	OHNDBUF=6600		/OUTPUT HANDLER BUFFER
	OUTBUFF=5600		/OUTPUT BUFFER
	OUTFILE=7600		/OUTPUT FILE INFORMATION HERE
	PRGFLD=	00		/PROGRAM FIELD
	RESET=	13		/RESET SYSTEM TABLES
	SBOOT=	7600		/MONITOR EXIT
	TBLFLD=	10		/COMMAND DECODER TABLE FIELD
	TERMWRD=7642		/TERMINATOR WORD
	USERROR=7		/USER SIGNALLED ERROR
	USR=	7700		/USR ENTRY POINT
	USRFLD=	10		/USR FIELD
	WRITE=	4000		/I/O WRITE BIT
	*0			/START AT THE BEGINNING

	*10			/DEFINE AUTO-INDEX AREA

XR1,	.-.			/AUTO-INDEX NUMBER 1
XR2,	.-.			/AUTO-INDEX NUMBER 2

	*20			/GET PAST AUTO-INDEX AREA

BUFPTR,	.-.			/INPUT BUFFER POINTER
BYTES,	ZBLOCK	3		/DATA BYTES
CHRCNT,	.-.			/CHARACTER COUNTER
CMPCNT,	.-.			/COMPRESSION COUNTER
DANGCNT,.-.			/DANGER COUNT
DATCNT,	.-.			/DATA COUNTER
IDNUMBE,.-.			/INPUT DEVICE NUMBER
INPUT,	.-.			/INPUT HANDLER POINTER
INRECOR,.-.			/INPUT RECORD
FNAME,	ZBLOCK	4		/OUTPUT FILENAME
GETBERR,.-.			/ERROR ROUTINE POINTER FOR GETBYTE ROUTINE
LATEST,	.-.			/LATEST OUTPUT BYTE
ODNUMBE,.-.			/OUTPUT DEVICE NUMBER
ONAME,	ZBLOCK	10		/OUTPUT NAME FIELD
OUTPUT,	.-.			/OUTPUT HANDLER POINTER
OUTRECO,.-.			/OUTPUT RECORD
PUTEMP,	.-.			/INPUT TEMPORARY
PUTPTR,	.-.			/OUTPUT POINTER
TEMPTR,	.-.			/TERMPORARY OUTPUT POINTER
THIRD,	.-.			/THIRD BYTE TEMPORARY

	PAGE			/START AT THE USUAL PLACE

BEGIN,	NOP			/HERE IN CASE WE'RE CHAINED TO
	CLA			/CLEAN UP
START,	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	DECODE			/WANT COMMAND DECODER
	"B^100+"O-300		/.BO IS DEFAULT EXTENSION
	CDF	TBLFLD		/GOTO TABLE FIELD
	TAD I	(TERMWRD)	/GET TERMINATOR WORD
	SPA CLA			/SKIP IF <CR> TERMINATED THE LINE
	DCA	EXITZAP		/ELSE CAUSE EXIT LATER
	TAD I	(OUTFILE)	/GET FIRST OUTPUT FILE DEVICE WORD
	SNA			/SKIP IF FIRST OUTPUT FILE PRESENT
	JMP	TSTMORE		/JUMP IF NOT THERE
	AND	[17]		/JUST DEVICE BITS
ODNULL,	DCA	ODNUMBER	/SAVE OUTPUT DEVICE NUMBER
	TAD I	(OUTFILE+5)	/GET SECOND OUTPUT FILE DEVICE WORD
	SNA			/SKIP IF THERE
	TAD I	(OUTFILE+12)	/ELSE GET THIRD OUTPUT FILE DEVICE WORD
	SZA CLA			/SKIP IF BOTH NOT PRESENT
	JMP	OUTERR		/ELSE COMPLAIN
	TAD I	(INFILE)	/GET FIRST INPUT FILE DEVICE WORD
	SNA			/SKIP IF PRESENT
	JMP	INERR		/JUMP IF NOT
	AND	[17]		/JUST DEVICE BITS
	DCA	IDNUMBER	/SAVE INPUT DEVICE NUMBER
	TAD I	(INFILE+2)	/GET SECOND INPUT FILE DEVICE WORD
	SZA CLA			/SKIP IF ONLY ONE INPUT FILE
	JMP	INERR		/ELSE COMPLAIN
	TAD I	(INFILE+1)	/GET FIRST INPUT FILE STARTING RECORD
	DCA	INRECORD	/SET IT UP
	CDF	PRGFLD		/BACK TO OUR FIELD
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	RESET			/RESET SYSTEM TABLES
	TAD	(IHNDBUFFER+1)	/GET INPUT BUFFER POINTER+TWO-PAGE BIT
	DCA	IHPTR		/STORE IN-LINE
	TAD	IDNUMBER	/GET INPUT DEVICE NUMBER
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	FETCH			/FETCH HANDLER
IHPTR,	.-.			/WILL BE BUFFER POINTER+TWO-PAGE BIT
	JMP	FERROR		/FETCH ERROR
	TAD	IHPTR		/GET RETURNED ADDRESS
	DCA	INPUT		/STORE AS INPUT HANDLER ADDRESS
	JMS I	(GEOFILE)	/GET OUTPUT FILE INFORMATION
	TAD	(OHNDBUFFER+1)	/GET BUFFER POINTER+TWO-PAGE BIT
	DCA	OHPTR		/STORE IN-LINE
	TAD	ODNUMBER	/GET OUTPUT DEVICE NUMBER
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	FETCH			/FETCH HANDLER
OHPTR,	.-.			/WILL BE BUFFER POINTER+TWO-PAGE BIT
	JMP	FERROR		/FETCH ERROR
	TAD	OHPTR		/GET RETURNED ADDRESS
	DCA	OUTPUT		/STORE AS OUTPUT HANDLER ADDRESS
	TAD	(FNAME)		/POINT TO
	DCA	ENTAR1		/STORED FILENAME
	DCA	ENTAR2		/CLEAR SECOND ARGUMENT
	TAD	ODNUMBER	/GET OUTPUT DEVICE NUMBER
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	ENTER			/ENTER TENTATIVE FILENAME
ENTAR1,	.-.			/WILL POINT TO FILENAME
ENTAR2,	.-.			/WILL BE ZERO
	JMP	ENTERR		/ENTER ERROR
	TAD	ENTAR1		/GET RETURNED FIRST RECORD
	DCA	OUTRECORD	/STORE IT
	TAD	ENTAR2		/GET RETURNED EMPTY LENGTH
	IAC			/ADD 2-1 FOR OS/278 CRAZINESS
	DCA	DANGCNT		/STORE AS DANGER COUNT
	JMS I	(DECODIT)	/GO DO THE ACTUAL DECODING
	JMP	PROCERR		/ERROR WHILE DECODING
	TAD	ODNUMBER	/GET OUTPUT DEVICE NUMBER
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	CLOSE			/CLOSE OUTPUT FILE
	FNAME			/POINTER TO FILENAME
OUTCNT,	.-.			/WILL BE ACTUAL COUNT
	JMP	CLSERR		/CLOSE ERROR
EXITZAP,JMP	START		/**** <ESC> TERMINATION **** 0000
	JMP I	(SBOOT)		/EXIT TO MONITOR
/	OUTPUT FILE ERROR WHILE PROCESSING.

OERROR,	TAD	[3]		/SET INCREMENT
	SKP			/DON'T USE NEXT

/	ERROR WHILE PROCESSING INPUT FILE.

PROCERR,NL0002			/SET INCREMENT
	SKP			/DON'T USE NEXT

/	ERROR WHILE CLOSING THE OUTPUT FILE.

CLSERR,	NL0001			/SET INCREMENT
	SKP			/DON'T CLEAR IT

/	OUTPUT FILE TOO LARGE ERROR.

SIZERR,	CLA			/CLEAN UP
	TAD	[3]		/SET INCREMENT
	SKP			/DON'T USE NEXT

/	ENTER ERROR.

ENTERR,	NL0002			/SET INCREMENT
	SKP			/DON'T USE NEXT

/	HANDLER FETCH ERROR.

FERROR,	NL0001			/SET INCREMENT

/	I/O ERROR WHILE PROCESSING IMBEDDED FILENAME.

NIOERR,	IAC			/SET INCREMENT

/	FORMAT ERROR WHILE PROCESSING IMBEDDED FILENAME.

CHARERR,IAC			/SET INCREMENT

/	INPUT FILESPEC ERROR.

INERR,	IAC			/SET INCREMENT

/	OUTPUT FILESPEC ERROR.

OUTERR,	DCA	ERRNUMBER	/STORE ERROR NUMBER
	CDF	PRGFLD		/ENSURE OUR FIELD
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	USERROR			/USER ERROR
ERRNUMB,.-.			/WILL BE PASSED ERROR NUMBER
/	COMES HERE TO TEST FOR NULL LINE.

TSTMORE,TAD I	(OUTFILE+5)	/GET SECOND OUTPUT FILE DEVICE WORD
	SNA			/SKIP IF PRESENT
	TAD I	(OUTFILE+12)	/ELSE GET THIRD OUTPUT FILE DEVICE WORD
	SZA CLA			/SKIP IF NO OUTPUT FILES
	JMP	OUTERR		/ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT 
	TAD I	(INFILE)	/GET FIRST OUTPUT FILE DEVICE WORD
	SZA CLA			/SKIP IF NO INPUT FILES
	JMP	ODNULL		/JUMP IF INPUT WITHOUT OUTPUT
	CDF	PRGFLD		/BACK TO OUR FIELD
	JMP	EXITZAP		/MIGHT BE LAST TIME, SO GO THERE FIRST

	PAGE
DECODIT,.-.			/DECODING ROUTINE
	TAD	(DECERR)	/SETUP THE
	DCA	GETBERROR	/GETBYTE ERROR ROUTINE
	DCA	DATCNT		/CLEAR DATA COUNT
	NL7777			/SETUP FOR INITIALIZING
	JMS I	(PUTBYTE)	/INITIALIZE OUTPUT FILE
LOOP,	JMS	GETCHR		/GET A CHARACTER
	JMP	ENDIT		/WEREN'T ANY MORE
	TAD	(-176)		/COMPARE TO TILDE
	SZA CLA			/SKIP IF IT MATCHES
	JMP	DATPROCESS	/JUMP IF NOT
	JMS	GETCHR		/GET A CHARACTER
DECERR,	JMP I	DECODIT		/WASN'T ANY
	TAD	(-"0!200)	/REMOVE PRINTING OFFSET
	SNA			/SKIP IF SIGNIFICENT COMPRESSION
	JMP	DATCORRECT	/JUMP IF NOT
	CIA			/INVERT FOR COUNTING
	DCA	CMPCNT		/SAVE COMPRESSION COUNT
	JMS	DATOUT		/OUTPUT DATA FIELD (IF ANY) AND CLEAR DATA COUNT
COMPLP,	JMS I	(PUTBYTE)	/OUTPUT A <NUL> BYTE
	ISZ	CMPCNT		/DONE YET?
	JMP	COMPLP		/NO, KEEP GOING
	JMP	LOOP		/YES, GO BACK FOR MORE FILE ITEMS

/	ZERO-LENGTH COMPRESSION (CORRECTION) FIELD FOUND.

DATCORR,NL7777			/BACKUP
	TAD	DATCNT		/NOW HAVE CORRECTED DATA COUNT
	SPA			/SKIP IF COUNT WASN'T ZERO
	JMP	LOOP		/IGNORE BECAUSE THERE IS NO DATA
	SNA			/SKIP IF ENOUGH TO CORRECT
	JMP I	DECODIT		/TAKE ERROR RETURN IF NOT
	DCA	DATCNT		/STORE CORRECTED COUNT
	JMP	LOOP		/GO BACK FOR MORE FILE ITEMS
/	UN-COMPRESSED DATA FOUND.

DATPROC,JMS	DATOUT		/OUTPUT PREVIOUS DATA FIELD (IF ANY), CLEAR DATA COUNT
	TAD	PUTEMP		/GET LATEST BACK
	TAD	(-"0!200)	/REMOVE DIGIT OFFSET
	CLL RTL			/MOVE UP
	DCA	BYTES		/STORE IT
	JMS	GETCHR		/GET NEXT CHARACTER
	JMP I	DECODIT		/WASN'T ANY
	AND	(17)		/JUST LOW-ORDER BITS
	CLL RTL;RTL		/MOVE UP
	DCA	BYTES+1		/STORE IT
	TAD	PUTEMP		/GET IT AGAIN
	RTR;RTR			/MOVE DOWN
	IAC			/REMOVE DIGIT BIAS
	AND	(3)		/JUST GOOD BITS
	TAD	BYTES		/GET OLD BITS
	DCA	BYTES		/STORE COMPOSITE
	JMS	GETCHR		/GET NEXT CHARACTER
	JMP I	DECODIT		/WASN'T ANY
	TAD	(-"0!200)	/REMOVE DIGIT OFFSET
	RTR			/MOVE DOWN
	AND	(17)		/ISOLATE GOOD BITS
	TAD	BYTES+1		/GET OLD BITS
	DCA	BYTES+1		/STORE COMPOSITE
	TAD	PUTEMP		/GET IT AGAIN
	AND	(3)		/ISOLATE GOOD BITS
	CLL RTL;RTL;RTL		/MOVE UP
	DCA	BYTES+2		/STORE IT
	JMS	GETCHR		/GET NEXT CHARACTER
	JMP I	DECODIT		/WASN'T ANY
	TAD	(-"0!200)	/REMOVE DIGIT OFFSET
	TAD	BYTES+2		/GET OLD BITS
	DCA	BYTES+2		/STORE COMPOSITE
	TAD	(3)		/SETUP THE
	DCA	DATCNT		/DATA COUNT
	JMP	LOOP		/GO GET NEXT FILE ITEM

/	COMES HERE AT END-OF-FILE.

ENDIT,	JMS	DATOUT		/OUTPUT ANY LEFTOVER DATA
	SKP			/DON'T OUTPUT YET
CLOSLUP,JMS I	(PUTBYTE)	/OUTPUT A <NUL> BYTE
	TAD	PUTPTR		/GET THE OUTPUT BUFFER POINTER
	TAD	(-OUTBUFFER)	/COMPARE TO RESET VALUE
	SZA CLA			/SKIP IF IT MATCHES
	JMP	CLOSLUP		/ELSE KEEP GOING
	ISZ	DECODIT		/BUMP TO GOOD RETURN
	JMP I	DECODIT		/RETURN TO CALLER
DATOUT,	.-.			/DATA OUTPUT ROUTINE
	TAD	DATCNT		/GET CURRENT DATA COUNT
	CMA			/SETUP FOR COUNTING
	DCA	DATCNT		/STORE IT
	TAD	(BYTES-1)	/POINT TO
	DCA	XR1		/DATA AREA
	JMP	DATEST		/CHECK BEFORE OUTPUTTING

DATLUP,	TAD I	XR1		/GET A BYTE
	JMS I	(PUTBYTE)	/OUTPUT IT
DATEST,	ISZ	DATCNT		/DONE YET?
	JMP	DATLUP		/NO, KEEP GOING
	JMP I	DATOUT		/YES, RETURN TO CALLER

GETCHR,	.-.			/GET A CHARACTER ROUTINE
GETCAGN,CLA			/GET A CHARACTER
	JMS I	[GETBYTE]	/GET A CHARACTER FROM FILE
	JMP I	GETCHR		/WASN'T ANY, TAKE IMMEDIATE RETURN
	TAD	[-" !200]	/COMPARE TO <SPACE>
	SPA SNA CLA		/SKIP IF NOT CONTROL CHARACTER OR <SPACE>
	JMP	GETCAGN		/GO GET ANOTHER ONE
	TAD	PUTEMP		/GET GOOD CHARACTER
	ISZ	GETCHR		/BUMP RETURN ADDRESS
	JMP I	GETCHR		/RETURN TO CALLER

	PAGE
PUTBYTE,.-.				/OUTPUT A BYTE ROUTINE
	SPA				/ARE WE INITIALIZING?
	JMP	PUTINITIALIZE		/YES
	AND	(377)			/JUST IN CASE
	DCA	LATEST			/SAVE LATEST CHARACTER
	TAD	LATEST			/GET LATEST CHARACTER
	JMP I	PUTNEXT			/GO WHERE YOU SHOULD GO

PUTNEXT,.-.				/EXIT ROUTINE
	JMP I	PUTBYTE			/RETURN TO MAIN CALLER

PUTINIT,CLA				/CLEAN UP
	TAD	OUTRECORD		/GET STARTING RECORD OF TENTATIVE FILE
	DCA	PUTRECORD		/STORE IN-LINE
	DCA I	(OUTCNT)		/CLEAR ACTUAL FILE LENGTH
PUTNEWR,TAD	POUTBUFFER/(OUTBUFFER)	/SETUP THE
	DCA	PUTPTR			/BUFFER POINTER
PUTLOOP,JMS	PUTNEXT			/GET A CHARACTER
	DCA I	PUTPTR			/STORE IT
	TAD	PUTPTR			/GET POINTER VALUE
	DCA	TEMPTR			/SAVE FOR LATER
	ISZ	PUTPTR			/BUMP TO NEXT
	JMS	PUTNEXT			/GET A CHARACTER
	DCA I	PUTPTR			/STORE IT
	JMS	PUTNEXT			/GET A CHARACTER
	RTL;RTL				/MOVE UP
	AND	[7400]			/ISOLATE HIGH NYBBLE
	TAD I	TEMPTR			/ADD ON FIRST BYTE
	DCA I	TEMPTR			/STORE COMPOSITE
	TAD	LATEST			/GET LATEST CHARACTER
	RTR;RTR;RAR			/MOVE UP AND
	AND	[7400]			/ISOLATE LOW NYBBLE
	TAD I	PUTPTR			/ADD ON SECOND BYTE
	DCA I	PUTPTR			/STORE COMPOSITE
	ISZ	PUTPTR			/BUMP TO NEXT
	TAD	PUTPTR			/GET LATEST POINTER VALUE
	TAD	(-2^200-OUTBUFFER)	/COMPARE TO LIMIT
	SZA CLA				/SKIP IF AT END
	JMP	PUTLOOP			/KEEP GOING
	ISZ	DANGCNT			/TOO MANY RECORDS?
	SKP				/SKIP IF NOT
	JMP I	(SIZERR)		/JUMP IF SO
	JMS I	OUTPUT			/CALL I/O HANDLER
	2^100+WRITE			/WRITE SOME PAGES FROM OUTPUT BUFFER
POUTBUF,OUTBUFFER			/BUFFER ADDRESS
PUTRECO,.-.				/WILL BE LATEST RECORD NUMBER
	JMP I	(OERROR)		/OUTPUT ERROR!
	ISZ I	(OUTCNT)		/BUMP ACTUAL LENGTH
	ISZ	PUTRECORD		/BUMP TO NEXT RECORD
	JMP	PUTNEWRECORD		/KEEP GOING
/	OS/8 FILE UNPACK ROUTINE.

GETBYTE,.-.				/GET A BYTE ROUTINE
	SNA CLA				/INITIALIZING?
	JMP I	PUTC			/NO, GO GET NEXT BYTE
	TAD	INRECORD		/GET STARTING RECORD OF INPUT FILE
	DCA	GETRECORD		/STORE IN-LINE
GETNEWR,JMS I	INPUT			/CALL I/O HANDLER
	2^100				/READ TWO PAGES INTO BUFFER
PINBUFF,INBUFFER			/BUFFER ADDRESS
GETRECO,.-.				/WILL BE LATEST RECORD NUMBER
	JMP I	GETBERROR		/INPUT ERROR!
	TAD	PINBUFFER/(INBUFFER)	/SETUP THE
	DCA	BUFPTR			/BUFFER POINTER
GETLOOP,DCA	THIRD			/CLEAR THIRD BYTE NOW
	JMS	PUTONE			/OBTAIN AND SEND BACK FIRST BYTE
	JMS	PUTONE			/OBTAIN AND SEND BACK SECOND BYTE
	TAD	THIRD			/GET THIRD BYTE
	JMS	PUTC			/SEND IT BACK
	TAD	BUFPTR			/GET THE POINTER
	TAD	(-2^200-INBUFFER)	/COMPARE TO LIMIT
	SZA CLA				/SKIP IF AT END
	JMP	GETLOOP			/KEEP GOING
	ISZ	GETRECORD		/BUMP TO NEXT RECORD
	JMP	GETNEWRECORD		/GO DO ANOTHER ONE

PUTONE,	.-.				/SEND BACK A BYTE ROUTINE
	TAD I	BUFPTR			/GET LATEST WORD
	AND	[7400]			/JUST THIRD-BYTE NYBBLE
	CLL RAL				/MOVE UP
	TAD	THIRD			/GET OLD NYBBLE (IF ANY)
	RTL;RTL				/MOVE UP NYBBLE BITS
	DCA	THIRD			/SAVE FOR NEXT TIME
	TAD I	BUFPTR			/GET LATEST WORD AGAIN
	JMS	PUTC			/SEND BACK CURRENT BYTE
	ISZ	BUFPTR			/BUMP TO NEXT WORD
	JMP I	PUTONE			/RETURN

PUTC,	.-.				/SEND BACK LATEST BYTE ROUTINE
	AND	(177)			/KEEP ONLY GOOD BITS
	DCA	PUTEMP			/SAVE IT
	TAD	PUTEMP			/GET IT BACK
	TAD	(-"Z!300)		/COMPARE TO <^Z>
	SNA CLA				/SKIP IF NOT ASCII <EOF>
	JMP I	GETBYTE			/RETURN IF ASCII MODE <EOF>
	TAD	PUTEMP			/RESTORE THE CHARACTER
	ISZ	GETBYTE			/BUMP PAST <EOF> RETURN
	JMP I	GETBYTE			/RETURN TO MAIN CALLER
	PAGE
GEOFILE,.-.			/GET OUTPUT FILE ROUTINE
	TAD	ODNUMBER	/GET OUTPUT DEVICE NUMBER
	SZA CLA			/SKIP IF NOT ESTABLISHED YET
	JMP	GOTOD		/JUMP IF DETERMINED ALREADY
	TAD	("D^100+"S-300)	/GET BEGINNING OF "DSK"
	DCA	DEVNAME		/STORE IN-LINE
	TAD	("K^100)	/GET REST OF "DSK"
	DCA	DEVNAME+1	/STORE IN-LINE
	DCA	RETVAL		/CLEAR HANDLER ENTRY WORD
	CDF	PRGFLD		/INDICATE OUR FIELD
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	INQUIRE			/INQUIRE ABOUT HANDLER
DEVNAME,ZBLOCK	2		/WILL BE DEVICE DSK
RETVAL,	.-.			/BECOMES HANDLER ENTRY POINT WORD
	HLT			/DSK: NOT IN SYSTEM IS IMPOSSIBLE!
	TAD	DEVNAME+1	/GET DEVICE NUMBER FOR DSK:
	AND	[17]		/JUST DEVICE BITS
	DCA	ODNUMBER	/STORE OUTPUT DEVICE
GOTOD,	JMS	SCANAME		/SCAN OFF FILE NAME
	CDF	TBLFLD		/BACK TO TABLE FIELD
	TAD I	(OUTFILE+1)	/GET OUTPUT FILE FIRST NAME WORD
	SNA			/SKIP IF PRESENT
	JMP	GFLNAME		/JUMP IF NOT
	DCA	FNAME		/MOVE TO OUR AREA
	TAD I	(OUTFILE+2)	/GET SECOND NAME WORD
	DCA	FNAME+1		/MOVE IT
	TAD I	(OUTFILE+3)	/GET THIRD NAME WORD
	DCA	FNAME+2		/MOVE IT
	TAD I	(OUTFILE+4)	/GET EXTENSION WORD
	DCA	FNAME+3		/MOVE IT
	CDF	PRGFLD		/BACK TO OUR FIELD
	JMP I	GEOFILE		/RETURN

/	WE MUST TAKE THE FILENAME FROM THE IMBEDDED FILENAME SUPPLIED.

GFLNAME,CDF	PRGFLD		/BACK TO OUR FIELD
	TAD	ONAME		/GET THE FIRST CHARACTER
	SNA CLA			/SKIP IF SOMETHING THERE
	JMP I	(CHARERROR)	/COMPLAIN IF NONE THERE
	TAD	(ONAME-1)	/SETUP POINTER
	DCA	XR1		/TO NAME CHARACTERS
	TAD	(FNAME-1)	/SETUP POINTER
	DCA	XR2		/TO PACKED NAME AREA
	TAD	(-4)		/SETUP THE
	DCA	CHRCNT		/MOVE COUNT
CHRLOOP,TAD I	XR1		/GET FIRST CHARACTER
	CLL RTL;RTL;RTL		/MOVE UP
	TAD I	XR1		/ADD ON SECOND CHARACTER
	DCA I	XR2		/STORE THE PAIR
	ISZ	CHRCNT		/DONE YET?
	JMP	CHRLOOP		/NO, KEEP GOING
	JMP I	GEOFILE		/YES, RETURN
SCANAME,.-.			/SCAN OFF FILENAME ROUTINE
	TAD	(NIOERROR)	/SETUP THE
	DCA	GETBERROR	/I/O ERROR HANDLER

/	ZERO OUT THE FILENAME AREA.

	TAD	(-10)		/SETUP THE
	DCA	CHRCNT		/CLEAR COUNTER
	TAD	(ONAME-1)	/SETUP THE
	DCA	XR1		/POINTER
	JMS	CLRNAME		/CLEAR THE NAME BUFFER

/	SETUP FOR SCANNING THE NAME PORTION.

	TAD	(-6)		/SETUP THE
	DCA	CHRCNT		/SCAN COUNT
	TAD	(ONAME-1)	/SETUP THE
	DCA	XR1		/POINTER
	NL7777			/MAKE IT INITIALIZE
FNCAGN,	JMS I	(GETAN)		/GET A CHARACTER
	JMP	GOTSEPARATOR	/GOT "."; GOTO NEXT FIELD
	DCA I	XR1		/STASH THE CHARACTER
	ISZ	CHRCNT		/DONE ALL YET?
	JMP	FNCAGN		/NO, KEEP GOING

/	THROW AWAY EXTRA NAME CHARACTERS.

TOSSNAM,JMS I	(GETAN)		/GET A CHARACTER
	JMP	GOTSEPARATOR	/GOT "."; GOTO NEXT FIELD
	CLA			/THROW AWAY THE CHARACTER
	JMP	TOSSNAME	/KEEP GOING

/	COMES HERE AFTER "." FOUND.

GOTSEPA,JMS	CLRNAME		/CLEAR OUT THE REMAINING NAME FIELD
	NL7776			/SETUP THE
	DCA	CHRCNT		/SCAN COUNT
EXCAGN,	JMS I	(GETAN)		/GET A CHARACTER
	JMP I	(CHARERROR)	/GOT "."; COMPLAIN
	DCA I	XR1		/STASH THE CHARACTER
	ISZ	CHRCNT		/DONE ENOUGH YET?
	JMP	EXCAGN		/NO, KEEP GOING

/	TOSS ANY EXTRA EXTENSION CHARACTERS.

TOSSEXT,JMS I	(GETAN)		/GET A CHARACTER
	JMP I	(CHARERROR)	/GOT "."; COMPLAIN
	CLA			/THROW AWAY THE CHARACTER
	JMP	TOSSEXTENSION	/KEEP GOING

/	COMES HERE WHEN TRAILING <CR> IS FOUND.

GOTCR,	JMS	CLRNAME		/CLEAR ANY REMAINING EXTENSION CHARACTERS
	JMP I	SCANAME		/RETURN
CLRNAME,.-.			/NAME FIELD CLEARING ROUTINE
	TAD	CHRCNT		/GET CHARACTER COUNTER
	SNA CLA			/SKIP IF ANY TO CLEAR
	JMP I	CLRNAME		/ELSE JUST RETURN
	DCA I	XR1		/CLEAR A NAME WORD
	ISZ	CHRCNT		/COUNT IT
	JMP	.-2		/KEEP GOING
	JMP I	CLRNAME		/RETURN

	PAGE
GETCHAR,.-.			/GET A CHARACTER ROUTINE
	JMS I	[GETBYTE]	/GET A CHARACTER
	JMP I	(CHARERROR)	/COMPLAIN IF <EOF> REACHED
	TAD	(-"M!300)	/COMPARE TO <CR>
	SNA			/SKIP IF OTHER
	JMP I	(GOTCR)		/JUMP IF IT MATCHES
	TAD	(-140+"M-300)	/COMPARE TO LOWER-CASE LIMIT
	SPA			/SKIP IF LOWER-CASE
	TAD	(40)		/RESTORE ORIGINAL IF UPPER-CASE
	AND	(77)		/JUST SIX-BIT
	DCA	PUTEMP		/SAVE IN CASE WE NEED IT
	TAD	PUTEMP		/GET IT BACK
	JMP I	GETCHAR		/RETURN

GETAN,	.-.			/GET ALPHANUMERIC ROUTINE
GETNAGN,JMS	GETCHAR		/GET A CHARACTER
	TAD	[-" !200]	/COMPARE TO <SPACE>
	SNA CLA			/SKIP IF OTHER
	JMP	GETNAGN		/JUMP IF IT MATCHES
	TAD	PUTEMP		/GET THE CHARACTER BACK
	TAD	(-".!200)	/COMPARE TO "."
	SNA			/SKIP IF OTHER
	JMP I	GETAN		/TAKE FIRST RETURN IF IT MATCHES
	TAD	(-":+".)	/SUBTRACT UPPER LIMIT
	CLL			/CLEAR LINK FOR TEST
	TAD	(":-"0)		/ADD ON RANGE
	SZL CLA			/SKIP IF NOT NUMERIC
	JMP	GETANOK		/JUMP IF NUMERIC
	TAD	PUTEMP		/GET THE CHARACTER BACK
	TAD	(-"[!300)	/SUBTRACT UPPER LIMIT
	CLL			/CLEAR LINK FOR TEST
	TAD	("[-"A)		/ADD ON RANGE
	SNL CLA			/SKIP IF ALPHABETIC
	JMP I	(CHARERROR)	/ELSE COMPLAIN
GETANOK,TAD	PUTEMP		/GET GOOD ALPHANUMERIC CHARACTER
	ISZ	GETAN		/BUMP TO SKIP RETURN
	JMP I	GETAN		/RETURN

	PAGE
	$			/THAT'S ALL FOLK!
