/	OS/8 BOO ENCODING PROGRAM

/	LAST EDIT:	01-OCT-1991	15:00:00	CJL

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

/	PROGRAM TO ENCODE ANY  TYPE  OF  OS/8  FILE  INTO  "PRINTABLE"  ASCII (".BOO")
/	FORMAT.  THIS IS A  COMMON  DISTRIBUTION FORMAT FOR MANY COLUMBIA KERMIT FILES
/	AND IS AN ALTERNATIVE TO ENCODE FORMAT FOR PDP-8 AND DECMATE USERS.

/	DISTRIBUTED BY CUCCA AS "K12ENB.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:

/	.RUN DEV ENBOO		INVOKE PROGRAM
/	*OUTPUT<INPUT		PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>)
/	*OUTPUT<INPUT$		PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <ESC>)
/	.			PROGRAM EXITS NORMALLY

/	INPUT FILE ASSUMES .SV 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.

/	THIS PROGRAM SUPPORTS THE .BOO FORMAT  FOR  FILE  ENCODING WHICH IS POPULAR IN
/	OTHER  SYSTEMS.  THIS VERSION IMPLEMENTS THE  FILE  LENGTH  PROTECTION  SCHEME
/	DEVELOPED BY CHARLES LASNER TO ENSURE PRECISE FILE LENGTH.

/	MANY .BOO PROGRAMS HAVE PROBLEMS MAINTAINING PRECISE FILE  LENGTH.  THE ACTUAL
/	LENGTH  MAY  BE IMPRECISELY STATED BY ONE OR TWO  BYTES  DUE  TO  AN  INHERENT
/	WEAKNESS  IN  THE  ORIGINAL .BOO ENCODING FORMAT DESIGN.  THIS  IMPLEMENTATION
/	APPENDS CORRECTION BYTES AS NECESSARY TO THE BASIC .BOO FILE TO  ENSURE PROPER
/	DECODING BY PROGRAMS COMPATIBLE WITH THIS EXTENSION.  

/	FILES CREATED BY THIS PROGRAM MAY BE  USED  WITH  EARLIER  .BOO DECODERS;  THE
/	RESULTANT FILES MAY INACCURATELY RECREATE THE ORIGINAL FILES BY AS MUCH AS TWO
/	EXTRANEOUS  TRAILING  BYTES.   THERE WILL BE NO PROBLEMS  (BEYOND  THE  LENGTH
/	ANOMALY)  AS LONG AS THE DECODERS IMPLEMENT ZERO-LENGTH COMPRESSION FIELDS  AS
/	NO  OPERATION.  IT IS POSSIBLE THAT CERTAIN DECODERS COULD ERRONEOUSLY  APPEND
/	MASSIVE  QUANTITIES  OF  ZEROES  ONTO  THE END OF THE DECODED FILES, BUT  THIS
/	ACTION WOULD CERTAINLY BE CAUSED BY DEFECTIVE PROGRAM CODE WITHIN THE DECODER.
/	(ALTHOUGH NOT  LIKELY  SEEN  BEFORE  ENCOUNTERING FILES WITH LENGTH CORRECTION
/	BYTES, THIS WOULD  BE  A  LATENT  BUG  IN  THESE  DECODING  PROGRAMS.  UPDATED
/	VERSIONS SHOULD BE SOUGHT IF THIS PROBLEM SURFACES.)
/	ERROR MESSAGES.

/	ERROR MESSAGES ARE ONE OF TWO VARIETIES:   COMMAND  DECODER  MESSAGES AND USER
/	(PROGRAM-SIGNALLED) MESSAGES.

/	COMMAND  DECODER  MESSAGES  ARE  NON-FATAL  AND  MERELY  REQUIRE RETYPING  THE
/	COMMAND.  ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE  WILL  YIELD THE COMMAND
/	DECODER  MESSAGE  "TOO MANY FILES" AND CAUSE A REPEAT OF THE  COMMAND  DECODER
/	PROMPT REQUIRING  USER  INPUT.  THE USER IS DIRECTED TO OTHER DOCUMENTATION OF
/	THE "SPECIAL" MODE  OF  THE  COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY
/	THIS UTILITY PROGRAM.

/	ANY USER MESSAGE PRINTED IS A  FATAL  ERROR MESSAGE CAUSED BY A PROBLEM BEYOND
/	THE SCOPE OF THE COMMAND DECODER.   ALL  USER  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			NO OUTPUT FILE.

/	1			INPUT FILE ERROR  (CAN'T  FIND INPUT FILE) OR NO INPUT
/				FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED.
/	2			ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED).

/	3			NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED).

/	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 ENCODING FILE DATA.

/	9			OUTPUT ERROR WHILE ENCODING FILE DATA.

/	ASSEMBLY INSTRUCTIONS.

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

/	.PAL ENBOO<ENBOO/E/F	ASSEMBLE SOURCE PROGRAM
/	.LOAD ENBOO		LOAD THE BINARY FILE
/	.SAVE DEV ENBOO=2001	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=	7605		/INPUT FILE INFORMATION HERE
	LOOKUP=	2		/LOOKUP INPUT FILE
	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=	0200		/USR ENTRY POINT
	USRENT=	7700		/USR ENTRY POINT WHEN NON-RESIDENT
	USRFLD=	10		/USR FIELD
	USRIN=	10		/LOCK USR IN CORE
	WIDTH=	114		/LINES MUST BE 76 WIDE OR LESS
	WRITE=	4000		/I/O WRITE BIT
	*0			/START AT THE BEGINNING

	*20			/GET PAST AUTO-INDEX AREA

BUFPTR,	.-.			/OUTPUT BUFFER POINTER
CHAR,	.-.			/LATEST INPUT BYTE
CHARPTR,.-.			/OUTPUT BYTE POINTER
CHARS,	ZBLOCK	3		/OUTPUT BYTES HERE
CMPCNT,	.-.			/MATCH COUNT FOR COMPRESSION
COLUMN,	.-.			/LATEST COLUMN
DANGCNT,.-.			/DANGER COUNT
IDNUMBE,.-.			/INPUT DEVICE NUMBER
IFNAME,	ZBLOCK	4		/INPUT FILENAME
INLEN,	.-.			/INPUT FILE LENGTH
INPTR,	.-.			/INPUT BUFFER POINTER
INPUT,	.-.			/INPUT HANDLER POINTER
INRECOR,.-.			/INPUT RECORD
FNAME,	ZBLOCK	4		/OUTPUT FILENAME
LATEST,	.-.			/LATEST OUTPUT CHARACTER
ODNUMBE,.-.			/OUTPUT DEVICE NUMBER
OUTPUT,	.-.			/OUTPUT HANDLER POINTER
OUTRECO,.-.			/OUTPUT RECORD
PIFTEMP,.-.			/PRINT INPUT FILENAME TEMPORARY
TEMPTR,	.-.			/TEMPORARY POINTER
THIRD,	.-.			/THIRD INPUT BYTE UNPACKING TEMPORARY
	PAGE			/START AT THE USUAL PLACE

BEGIN,	NOP			/IN CASE WE'RE CHAINED TO
	CLA			/CLEAN UP
START,	CIF	USRFLD		/GOTO USR FIELD
	JMS I	(USRENT)	/CALL USR ROUTINE
	USRIN			/GET IT LOCKED IN
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	DECODE			/WANT COMMAND DECODER
	"*^100			/USING SPECIAL MODE
	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 OUTPUT FILE DEVICE WORD
	SNA			/SKIP IF FIRST OUTPUT FILE PRESENT
	JMP	TSTMORE		/JUMP IF NOT THERE
	AND	[17]		/JUST DEVICE BITS
	DCA	ODNUMBER	/SAVE OUTPUT DEVICE NUMBER
	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+5)	/GET SECOND INPUT FILE DEVICE WORD
	SZA CLA			/SKIP IF ONLY ONE INPUT FILE
	JMP	INERR		/ELSE COMPLAIN
	JMS I	(MIFNAME)	/MOVE INPUT FILENAME WITH ADJUSTED EXTENSION
	TAD I	[OUTFILE+1]	/GET FIRST OUTPUT FILENAME WORD
	SNA CLA			/SKIP IF NAME PRESENT
	JMP	NONAME		/JUMP IF DEVICE ONLY
	JMS I	(MOFNAME)	/MOVE OUTPUT FILENAME
	CDF	PRGFLD		/BACK TO OUR FIELD
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	RESET			/RESET SYSTEM TABLES
	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	(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	(GEIFILE)	/GO LOOKUP INPUT FILE
	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	(ENCODIT)	/GO DO THE ACTUAL ENCODING
	JMP	PROCERR		/ERROR WHILE ENCODING
	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.

ENCERRO,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

/	NO OUTPUT FILENAME ERROR.

NONAME,	IAC			/SET INCREMENT

/	ILLEGAL OUTPUT FILE NAME ERROR.

BADNAME,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	(INFILE)	/GET FIRST INPUT FILE DEVICE WORD
	SZA CLA			/SKIP NO INPUT OR OUTPUT GIVEN
	JMP	OUTERR		/ELSE COMPLAIN
	CDF	PRGFLD		/BACK TO OUR FIELD
	JMP	EXITZAP		/MIGHT BE LAST TIME, SO GO THERE FIRST

	PAGE
ENCODIT,.-.			/ENCODING ROUTINE
	NL7777			/SETUP INITIALIZE VALUE
	JMS I	[DOBYTE]	/INITIALIZE OUTPUT ROUTINE
	JMS I	(PIFNAME)	/OUTPUT THE INPUT FILENAME
	JMS I	(PCRLF)		/OUTPUT <CR>/<LF> AND CLEAR COLUMN COUNTER
	DCA	CMPCNT		/CLEAR COMPRESSION
	TAD	[CHARS]		/SETUP THE
	DCA	CHARPTR		/OUTPUT POINTER
	NL7777			/MAKE IT INITIALIZE
LOOP,	JMS I	(GETBYTE)	/GET LATEST BYTE
	JMP	ENDCHECK	/AREN'T ANY MORE, FINISH THE FILE

/	TEST IF ALREADY WITHIN A DEVELOPING COMPRESSION FIELD.

	TAD	CMPCNT		/GET COMPRESSION COUNT
	SNA CLA			/SKIP IF COMPRESSION IN PROGRESS
	JMP	NOCOMP		/JUMP IF NOT

/	CHECK IF LATEST INPUT BYTE IS ZERO.

	TAD	CHAR		/GET LATEST
	SZA CLA			/SKIP IF SO
	JMP	ENDCOMPRESS	/JUMP IF NOT
SETCOMP,ISZ	CMPCNT		/BUMP COMPRESSION COUNT
	TAD	CMPCNT		/GET LATEST COUNT
	TAD	(-116)		/COMPARE TO MAXIMUM ALLOWED
	SNA CLA			/SKIP IF NOT
	JMS I	(COMPRESSOUT) 	/OUTPUT MAXIMUM COMPRESSION AND CANCEL COMPRESSION
	JMP	LOOP		/GO GET ANOTHER ONE

/	IF LATEST IS NON-ZERO, THEN COMPLETE EXISTING COMPRESSION FIELD.

ENDCOMP,NL7777			/-1
	TAD	CMPCNT		/COMPARE TO COMPRESSION COUNT
	SZA CLA			/SKIP IF TRIVIAL CASE
	JMP	OUTCOMPRESS	/JUMP IF NOT

/	CANCEL TRIVIAL CASE OF ONE BYTE COMPRESSION.

	DCA	CMPCNT		/CLEAR COMPRESSION MODE
	DCA	CHARS		/FIRST BYTE WAS ZERO
	TAD	(CHARS+1)	/SETUP OUTPUT POINTER TO
	DCA	CHARPTR		/STORE INTO SECOND BYTE
	JMP	BYTEINSERT	/CONTINUE THERE
/	OUTPUT LATEST COMPRESSION AND PROCESS NEW NON-ZERO BYTE.

OUTCOMP,JMS I	(COMPRESSOUT)	/OUTPUT COMPRESSION FIELD AND CANCEL COMPRESSION

/	COMES HERE IF NOT WITHIN A COMPRESSION REGION.

NOCOMP,	TAD	CHARPTR		/GET POINTER
	TAD	(-CHARS)	/CHECK IF AT BEGINNING
	SZA CLA			/SKIP IF BUFFER EMPTY
	JMP	BYTEINSERT	/JUMP IF NOT

/	IF AT BEGINNING OF THREE BYTES, TEST IF LATEST STARTS A COMPRESSION FIELD.

	TAD	CHAR		/GET LATEST BYTE
	SNA CLA			/SKIP IF NOT ZERO
	JMP	SETCOMPRESSION	/JUMP IF SO
BYTEINS,TAD	CHAR		/GET LATEST BYTE
	DCA I	CHARPTR		/STORE IT
	ISZ	CHARPTR		/BUMP TO NEXT
	TAD	CHARPTR		/GET THE UPDATED POINTER
	TAD	(-CHARS-2-1)	/COMPARE TO UPPER LIMIT
	SNA CLA			/SKIP IF LESS THAN THREE PRESENT
	JMS I	(OUT3)		/ELSE OUTPUT THE THREE BYTES AND RESET THE BUFFER
	JMP	LOOP		/GO GET ANOTHER ONE

/	COMES HERE AT END OF INPUT.

ENDCHEC,NL7776			/-2
	TAD	CMPCNT		/COMPARE TO COMPRESSION COUNT
	SMA			/SKIP IF AT TRIVIAL CASE OR NO COMPRESSION CURRENTLY
	JMP	ENDFCOMPRESS	/FINISH WITH A COMPRESSION FIELD
	IAC			/CHECK FURTHER
	SZA CLA			/SKIP IF TRIVIAL COMPRESSION AT END
	JMP	NORMEND		/JUMP IF NOT WITHIN COMPRESSION

/	THE TRIVIAL CASE  CONVERTS  TO  AN INCOMPLETE OUTPUT, COMPLETE WITH CORRECTION
/	BYTES TO INDICATE THE SHORT FIELD.

	DCA	CHARS		/MOVE ZERO BYTE TO FIRST POSITION
NORM1,	DCA	CHARS+1		/CLEAR SECOND POSITION
	DCA	CHARS+2		/CLEAR THIRD POSITION
	JMS I	(OUT3)		/OUTPUT THE THREE BYTES
	DCA	CMPCNT		/CLEAR COMPRESSION COUNT
	JMS I	(COMPRESSOUT)	/OUTPUT NULL COMPRESSION FIELD TO CANCEL THIRD BYTE
				/NEXT WILL CANCEL SECOND BYTE

/	COMES HERE IF FILE ENDS ON A COMPRESSION FIELD.

ENDFCOM,JMS I	(COMPRESSOUT)	/OUTPUT COMPRESSION FIELD AND CANCEL COMPRESSION
	JMP	CLOSFILE	/FINISH IT THERE
/	COMES HERE IF FILE ENDS IN SOME FORM OF DATA FIELD.

NORMEND,TAD	CHARPTR		/GET CHARACTER POINTER
	TAD	(-CHARS-2)	/COMPARE TO TWO PRESENT VALUE
	SNA			/SKIP IF NOT THE CASE
	JMP	NORM2		/JUMP IF SO
	IAC			/BUMP TO ONE PRESENT VALUE
	SNA CLA			/SKIP IF NOT THE CASE
	JMP	NORM1		/JUMP IF SO
CLOSFIL,TAD	COLUMN		/GET CURRENT COLUMN COUNTER
	SZA CLA			/SKIP IF AT BEGINNING ALREADY
	JMS I	(PCRLF)		/ELSE OUTPUT <CR>/<LF> NOW
	TAD	("Z&37)		/GET <^Z>
CLOSLUP,JMS I	[DOBYTE]	/OUTPUT A BYTE (^Z OR NULL)
	TAD	BUFPTR		/GET THE OUTPUT BUFFER POINTER
	TAD	(-OUTBUFFER)	/COMPARE TO RESET VALUE
	SZA CLA			/SKIP IF IT MATCHES
	JMP	CLOSLUP		/ELSE KEEP GOING
	ISZ	ENCODIT		/NO ERRORS
	JMP I	ENCODIT		/RETURN

/	COMES HERE IF FILE ENDS WITH ONLY TWO DATA CHARACTERS.

NORM2,	DCA	CHARS+2		/CLEAR THIRD CHARACTER
	JMS I	(OUT3)		/OUTPUT THE THREE BYTES
	JMP	ENDFCOMPRESS	/FINISH IT THERE

	PAGE
/	GET AN INPUT BYTE ROUTINE.

GETBYTE,.-.				/GET A BYTE ROUTINE
	SNA CLA				/INITIALIZING?
	JMP I	PUTC			/NO, GO GET NEXT BYTE
	TAD	INRECORD		/GET INPUT FILE STARTING RECORD
	DCA	GETRECORD		/STORE IN-LINE
GETNEWR,JMS I	INPUT			/CALL INPUT HANDLER
	2^100				/READ TWO PAGES
PINBUFF,INBUFFER			/INTO INPUT BUFFER
GETRECO,.-.				/WILL BE LATEST INPUT FILE RECORD
	JMP I	(PROCERR)		/INPUT READ ERROR, GO COMPLAIN
	TAD	PINBUFFER/(INBUFFER)	/SETUP THE
	DCA	INPTR			/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	INPTR			/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
	NOP				/JUST IN CASE
	ISZ	INLEN			/DONE ALL INPUT RECORDS?
	JMP	GETNEWRECORD		/NO, KEEP GOING

/	AT END-OF-FILE, SO JUST TAKE IMMEDIATE RETURN.

	JMP I	GETBYTE			/RETURN TO CALLER

PUTONE,	.-.				/SEND BACK A BYTE ROUTINE
	TAD I	INPTR			/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	INPTR			/GET LATEST WORD AGAIN
	JMS	PUTC			/SEND BACK CURRENT BYTE
	ISZ	INPTR			/BUMP TO NEXT WORD
	JMP I	PUTONE			/RETURN

PUTC,	.-.				/SEND BACK LATEST BYTE ROUTINE
	AND	(377)			/KEEP ONLY GOOD BITS
	DCA	CHAR			/SAVE AS LATEST BYTE
	ISZ	GETBYTE			/BUMP PAST <EOF> RETURN
	JMP I	GETBYTE			/RETURN TO MAIN CALLER
/	COMPRESSION FIELD OUTPUT ROUTINE.

COMPRES,.-.			/COMPRESSION OUTPUT ROUTINE
	CLA			/CLEAN UP
	TAD	COLUMN		/GET CURRENT COLUMN COUNTER
	TAD	(-WIDTH+2)	/COMPARE TO UPPER LIMIT
	SMA SZA CLA		/SKIP IF NOT ABOVE LIMIT
	JMS	PCRLF		/ELSE DO <CR>/<LF> FIRST
	TAD	(176)		/GET TILDE VALUE
	JMS I	[DOBYTE]	/OUTPUT IT
	TAD	CMPCNT		/GET COMPRESSION COUNT
	JMS	PDIGIT		/OUTPUT IT
	DCA	CMPCNT		/CLEAR COMPRESSION
	JMP I	COMPRESSOUT	/RETURN

/	DATA FIELD OUTPUT ROUTINE.

OUT3,	.-.			/OUTPUT THREE BYTES ROUTINE
	TAD	COLUMN		/GET CURRENT COLUMN COUNTER
	TAD	(-WIDTH+4)	/COMPARE TO UPPER LIMIT
	SMA SZA CLA		/SKIP IF NOT ABOVE LIMIT
	JMS	PCRLF		/ELSE DO <CR>/<LF> FIRST
	TAD	CHARS		/GET FIRST BYTE
	RTR			/WANT HIGH SIX BITS FIRST
	JMS	PDIGIT		/OUTPUT THEM
	TAD	CHARS		/GET IT AGAIN
	AND	[3]		/JUST TWO LOWEST BITS
	CLL RTR;RTR;RAR		/MOVE UP
	TAD	CHARS+1		/GET SECOND BYTE
	RTR;RTR			/MOVE DOWN
	JMS	PDIGIT		/OUTPUT THEM
	TAD	CHARS+2		/GET THIRD BYTE
	AND	(300)		/JUST TWO HIGHEST BITS NEEDED
	CLL RTL;RTL;RAL		/MOVE INTO POSITION
	TAD	CHARS+1		/GET SECOND BYTE
	RTL			/MOVE UP
	AND	[77]		/JUST DESIRED BITS
	JMS	PDIGIT		/OUTPUT THEM
	TAD	CHARS+2		/GET THIRD BYTE
	AND	[77]		/JUST SIX BITS
	JMS	PDIGIT		/OUTPUT THEM
	TAD	[CHARS]		/RESET THE
	DCA	CHARPTR		/OUTPUT POINTER
	JMP I	OUT3		/RETURN

PDIGIT,	.-.			/PRINT AS A DIGIT INTO FILE ROUTINE
	AND	[177]		/REMOVE JUNK BITS
	TAD	("0&177)	/TURN PASSED VALUE INTO A DIGIT
	JMS I	[DOBYTE]	/OUTPUT IT
	JMP I	PDIGIT		/RETURN
PCRLF,	.-.			/PRINT <CR>/<LF> INTO FILE ROUTINE
	TAD	("M&37)		/GET A <CR>
	JMS I	[DOBYTE]	/OUTPUT IT
	TAD	("J&37)		/GET A <LF>
	JMS I	[DOBYTE]	/OUTPUT IT
	DCA	COLUMN		/CLEAR COLUMN COUNTER
	JMP I	PCRLF		/RETURN

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

PUTNEXT,.-.			/EXIT ROUTINE
	ISZ	PUTBYTE		/BUMP TO GOOD RETURN
PUTERRO,CLA CLL			/CLEAN UP
	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	(OUTBUFFER)	/SETUP THE
	DCA	BUFPTR		/BUFFER POINTER
PUTLOOP,JMS	PUTNEXT		/GET A CHARACTER
	DCA I	BUFPTR		/STORE IT
	TAD	BUFPTR		/GET POINTER VALUE
	DCA	TEMPTR		/SAVE FOR LATER
	ISZ	BUFPTR		/BUMP TO NEXT
	JMS	PUTNEXT		/GET A CHARACTER
	DCA I	BUFPTR		/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	BUFPTR		/ADD ON SECOND BYTE
	DCA I	BUFPTR		/STORE COMPOSITE
	ISZ	BUFPTR		/BUMP TO NEXT
	TAD	BUFPTR		/GET LATEST POINTER VALUE
	TAD	(-2^200-OUTBUFF)/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
	OUTBUFFER		/BUFFER ADDRESS
PUTRECO,.-.			/WILL BE LATEST RECORD NUMBER
	JMP	PUTERROR	/OUTPUT ERROR!
	ISZ I	(OUTCNT)	/BUMP ACTUAL LENGTH
	ISZ	PUTRECORD	/BUMP TO NEXT RECORD
	JMP	PUTNEWRECORD	/KEEP GOING
/	INPUT FILENAME MOVE ROUTINE; USES DEFAULT EXTENSION IF NONE PROVIDED BY USER.

MIFNAME,.-.			/MOVE INPUT FILENAME ROUTINE
	TAD I	(INFILE+1)	/GET FIRST INPUT FILENAME WORD
	DCA	IFNAME		/STASH IT
	TAD I	(INFILE+2)	/GET SECOND INPUT FILENAME WORD
	DCA	IFNAME+1	/STASH IT
	TAD I	(INFILE+3)	/GET THIRD INPUT FILENAME WORD
	DCA	IFNAME+2	/STASH IT
	TAD I	[INFILE+4]	/GET FOURTH INPUT FILENAME WORD
	SNA			/SKIP IF SOMETHING THERE
	TAD	("S^100+"V-300)	/ELSE USE DEFAULT EXTENSION VALUE
	DCA	IFNAME+3	/STASH IT EITHER WAY
	JMP I	MIFNAME		/RETURN

DOBYTE,	.-.			/OUTPUT A BYTE ROUTINE
	JMS	PUTBYTE		/OUTPUT PASSED VALUE
	JMP I	(ENCERROR)	/COULDN'T DO IT
	ISZ	COLUMN		/BUMP COLUMN COUNTER
	JMP I	DOBYTE		/RETURN

	PAGE
/	INPUT FILE ROUTINE.

GEIFILE,.-.			/GET INPUT FILE ROUTINE
	JMS	LUKUP		/TRY TO LOOKUP THE FILE
	SKP			/SKIP IF IT WORKED
	JMP	TRYNULL		/TRY NULL EXTENSION VERSION
NULLOK,	TAD	LARG1		/GET FIRST INPUT RECORD
	DCA	INRECORD	/STASH IT
	TAD	LARG2		/GET NEGATED LENGTH
	DCA	INLEN		/STASH IT
	JMP I	GEIFILE		/RETURN

/	COMES HERE IF LOOKUP FAILED.

TRYNULL,CDF	TBLFLD		/GOTO TABLE FIELD
	TAD I	[INFILE+4]	/GET ORIGINAL FILENAME'S EXTENSION
	CDF	PRGFLD		/BACK TO OUR FIELD
	SZA CLA			/SKIP IF IT WAS NULL ORIGINALLY
	JMP I	(INERR)		/ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE
	DCA	IFNAME+3	/NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION
	JMS	LUKUP		/TRY TO LOOK IT UP AGAIN
	JMP	NULLOK		/THAT WORKED!
	JMP I	(INERR)		/COMPLAIN OF LOOKUP FAILURE

LUKUP,	.-.			/LOW-LEVEL LOOKUP ROUTINE
	TAD	(IFNAME)	/GET OUR FILENAME POINTER
	DCA	LARG1		/STORE IN-LINE
	DCA	LARG2		/CLEAR SECOND ARGUMENT
	TAD	IDNUMBER	/GET INPUT DEVICE NUMBER
	CIF	USRFLD		/GOTO USR FIELD
	JMS I	[USR]		/CALL USR ROUTINE
	LOOKUP			/WANT LOOKUP FUNCTION
LARG1,	.-.			/WILL BE POINTER TO OUR FILENAME
LARG2,	.-.			/WILL RETURN FILE LENGTH (HOPEFULLY)
	ISZ	LUKUP		/LOOKUP FAILED, SO BUMP RETURN ADDRESS
	JMP I	LUKUP		/RETURN EITHER WAY
/	INPUT FILENAME PRINT ROUTINE.

PIFNAME,.-.			/PRINT INPUT FILENAME ROUTINE
	TAD	IFNAME		/GET FIRST PAIR
	JMS	PIF2		/PRINT IT
	TAD	IFNAME+1	/GET SECOND PAIR
	JMS	PIF2		/PRINT IT
	TAD	IFNAME+2	/GET THIRD PAIR
	JMS	PIF2		/PRINT IT
	TAD	(".&177)	/GET SEPARATOR
	JMS	PIFOUT		/PRINT IT
	TAD	IFNAME+3	/GET FOURTH PAIR
	JMS	PIF2		/PRINT IT
	JMP I	PIFNAME		/RETURN

PIF2,	.-.			/PRINT A PAIR ROUTINE
	DCA	PIFTEMP		/SAVE PASSED PAIR
	TAD	PIFTEMP		/GET IT BACK
	RTR;RTR;RTR		/MOVE DOWN
	JMS	PIFOUT		/PRINT HIGH-ORDER FIRST
	TAD	PIFTEMP		/GET IT AGAIN
	JMS	PIFOUT		/PRINT LOW-ORDER
	JMP I	PIF2		/RETURN

PIFOUT,	.-.			/FILENAME CHARACTER OUTPUT ROUTINE
	AND	[77]		/JUST SIXBIT
	SNA			/SKIP IF SOMETHING THERE
	JMP I	PIFOUT		/ELSE IGNORE IT
	TAD	[40]		/INVERT IT
	AND	[77]		/REMOVE EXCESS
	TAD	[40]		/INVERT IT AGAIN
	JMS I	[DOBYTE]	/OUTPUT IT
	JMP I	PIFOUT		/RETURN

MOFNAME,.-.			/MOVE OUTPUT FILENAME ROUTINE
	TAD I	[OUTFILE+1]	/GET FIRST OUTPUT FILENAME WORD
	JMS	CHKNAME		/CHECK IF LEGAL
	DCA	FNAME		/STASH IT
	TAD I	(OUTFILE+2)	/GET SECOND OUTPUT FILENAME WORD
	JMS	CHKNAME		/CHECK IF LEGAL
	DCA	FNAME+1		/STASH IT
	TAD I	(OUTFILE+3)	/GET THIRD OUTPUT FILENAME WORD
	JMS	CHKNAME		/CHECK IF LEGAL
	DCA	FNAME+2		/STASH IT
	TAD I	(OUTFILE+4)	/GET FOURTH OUTPUT FILENAME WORD
	JMS	CHKNAME		/CHECK IF LEGAL
	DCA	FNAME+3		/STASH IT
	JMP I	MOFNAME		/RETURN
/	OUTPUT NAME CHECK ROUTINE.

CHKNAME,.-.			/OUTPUT NAME CHECK ROUTINE
	DCA	LUKUP		/SAVE PASSED VALUE
	TAD	LUKUP		/GET IT BACK
	RTR;RTR;RTR		/MOVE DOWN
	JMS	CHKIT		/CHECK HIGH-ORDER AND GET IT BACK
	JMS	CHKIT		/CHECK LOW-ORDER AND GET IT BACK
	JMP I	CHKNAME		/RETURN

CHKIT,	.-.			/ONE CHARACTER CHECK ROUTINE
	AND	[77]		/JUST SIX BITS
	TAD	(-"?!200)	/COMPARE TO "?"
	SZA			/SKIP IF ALREADY BAD
	TAD	(-"*+"?)	/ELSE COMPARE TO "*"
	SNA CLA			/SKIP IF NEITHER BAD CASE
	JMP I	(BADNAME)	/COMPLAIN OF WILD CHARACTER
	TAD	LUKUP		/GET THE PAIR BACK FOR NEXT TIME
	JMP I	CHKIT		/RETURN

	PAGE
	$			/THAT'S ALL FOLK!