/	OS/8 ENCODING PROGRAM

/	LAST EDIT:	08-JUL-1992	22:00:00	CJL

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

/	PROGRAM TO ENCODE OS/8 FILES INTO "PRINTABLE" ASCII FORMAT ("ENCODE").

/	DISTRIBUTED BY CUCCA AS "K12ENC.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 ENCODE		INVOKE PROGRAM
/	*OUTPUT<INPUT		PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>)
/	*OUTPUT<DEV:=NNNN/I 	****  SPECIAL IMAGE TRANSFER MODE **** INPUT IS RECORD
/				0000-[NNNN-1] ON DEVICE DEV:.  THE =NNNN VALUE MUST BE
/				STATED PRECISELY TO  TRANSFER  THE REQUISITE AMOUNT OF
/				THE DEVICE AS REQUIRED.    THE  VALUE IS GENERALLY THE
/				TOTAL  LENGTH OF THE DEVICE,  BUT  COULD  BE  LESS  AS
/				NECESSARY;  LARGER VALUES WILL GENERALLY  FAIL.   THIS
/				MODE  SHOULD  ONLY  BE  USED  TO  EFFECT  TRANSFER  OF
/				COMPLETE  DEVICE  IMAGES  WHERE  THE  NORMAL OS/8 FILE
/				STRUCTURE IS UNSUITABLE.  IN THIS MODE, THE OS/8  FILE
/				(POSSIBLY PRESENT)  ON  THE  DEVICE  IS IGNORED.O TRANSFER THE FIRST HALF.
/	*OUTPUT<DEV:=NNNN/I/2	**** SPECIAL IMAGE  TRANSFER MODE **** SAME AS REGULAR
/				IMAGE MODE EXCEPT ONLY THE SECOND  HALF OF THE DATA IS
/				USED.  NOTE THAT THERE MUST BE TWO  FILES CREATED, ONE
/				USING  /I/1  AND  THE  OTHER  USING /I/2 TO COMPLETELY
/				TRANSFER A DEVICE IMAGE UNLESS /I IS USED ALONE!
/	*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.   IF
/	IMAGE MODE IS USED, THERE IS NO INPUT FILE SPECIFICATION;  ONLY  A  DEVICE  IS
/	GIVEN ALONG WITH A LENGTH AND THE MANDATORY /I SWITCH.

/	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 A SUBSET OF THE  ASCII FILE ENCODING SCHEME DEVELOPED BY
/	CHARLES LASNER AND FRANK DA CRUZ.  THE  SCHEME  USED IS FIVE-BIT ENCODING WITH
/	COMPRESSION,  (AS  OPPOSED  TO  SIX-BIT WITHOUT COMPRESSION AS USED  IN  PRIOR
/	VERSIONS).

/	RESTRICTIONS:

/	A)	NO SUPPORT FOR MULTIPLE DECODABLE FILES PER ENCODED FILE.

/	B)	CREATES ENCODED PDP-8 60-BIT CHECKSUM AT END OF FILE.

/	C)	CUSTOMIZED (REMARK) COMMANDS MUST BE SEPARATELY ADDED BY THE USER.

/	D)	THE FILENAME IN THE (FILE ) AND (END ) COMMANDS WILL BE  IDENTICAL  TO
/		THE ACTUAL INVOKED INPUT FILE.  THE USER MUST SEPARATELY MODIFY  THESE
/		COMMANDS  WHEN  EXPORTING  THE ENCODED FILE   ****
/				NOTE  ****  THIS   METHOD  VIOLATES  ALL  OS/8  DEVICE
/				STRUCTURE AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE
/				IMAGES ONLY;  USE WITH CARE!
/	*OUTPUT<DEV:=NNNN/I/1	**** SPECIAL IMAGE TRANSFER  MODE **** SAME AS REGULAR
/				IMAGE MODE EXCEPT ONLY THE FIRST  HALF  OF THE DATA IS
/				USED.    THE  DECODER  MUST  BE  GIVEN THE  EQUIVALENT
/				PARAMETERS TY 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.
/	ASSEMBLY INSTRUCTIONS.

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

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

	AIWCNT=	1404			/ADDITIONAL INFORMATION WORDS COUNT HERE
	AIWXR=	0017			/POINTER TO ADDITIONTO A SYSTEM WITH DIFFERENT
/		NAMING CONVENTIONS.

/	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 MANYSTEM TABLES
	REVISIO=1			/PROGRAM REVISION
	SBOOT=	7600			/MONITOR EXIT
	SWAL=	7643			/A-/L SWITCHES HERE IN TABLE FIELD
	SWY9=	7645			/Y-/9 SWITCHES HERE IN TABLE FIELD
	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
	VERSION=2			/PROGRAM VERSION
	WIDTH=	107-2			/69 DATA CHARACTERS PER LINE (TOTAL 71)
	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,	.-.				/OUTPUT BUFFER POINTER
CCNT,	.-.				/CHECKSUM COUNTER
CHKFLG,	.-.				/CHECKSUMMING ALLOWED FLAG
CHKSUM,	ZBLOCK	5			/CHECKSUM
CMPCNT,	.-.				/MATCH COUNT FOR COMPRESSION
DANGCNT,.-.				/DANGER COUNT
FDATE,	.-.				/FILE DATE
FILLVAL,.-.				/FILL VALUE FOR SPECIAL OUTPUT CHARACTERS
IDNUMBE,.-.				/INPUT DEVICE NUMBER
IFNAME,	ZBLOCK	4			/INPUT FILENAME
IMSW,	.-.				/IMAGE-MODE SWITCH
INLEN,	.-.				/IAL INFORMATION WORDS
	CLOSE=	4			/CLOSE OUTPUT FILE
	DATEXT=	7777			/DATE EXTENSION HERE
	DATWRD=	7666			/OS/8 DATE WORD
	DECODE=	5			/CALL COMMAND DECODER
	ENTER=	3			/ENTER TENTATIVE FILE
	EQUWRD=	7646			/EQUALS PARAMETER HERE IN TABLE FIELD
	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 SNTER
TDATE,	.-.				/TODAY'S DATE
TEMP,	.-.				/TEMPORARY
TEMPTR,	.-.				/TEMPORARY OUTPUT POINTER
WIDCNT,	.-.				/LINE WIDTH COUNTER
	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	(USRENTRY)		/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
	DCA	IMSW			/CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH
	TAD I	(OUTFILE)		/GET OUTPUT FILE DEVICE WORD
	SNA				/SKIP IF 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 INPUNPUT FILE LENGTH
INPTR,	.-.				/INPUT BUFFER POINTER
INPUT,	.-.				/INPUT HANDLER POINTER
INRECOR,.-.				/INPUT RECORD
FNAME,	ZBLOCK	4			/OUTPUT FILENAME
LATEST,	.-.				/LATEST OUTPUT CHARACTER
OBOUND,	.-.				/OUTPUT BOUNDARY COUNTER
OCTCNT,	.-.				/OCTAL OUTPUT ROUTINE COUNTER
OCTEMP,	.-.				/OCTAL OUTPUT ROUTINE TEMPORARY
ODNUMBE,.-.				/OUTPUT DEVICE NUMBER
OUTPUT,	.-.				/OUTPUT HANDLER POINTER
OUTRECO,.-.				/OUTPUT RECORD
PRTEMP,	.-.				/DATE OUTPUT TEMPORARY
PUTEMP,	.-.				/OUTPUT TEMPORARY
PUTLATE,.-.				/LATEST 5-BIT CHARACTER
PUTPREV,.-.				/PREVIOUS OUTPUT TEMPORARY
QUO,	.-.				/DIVIDE QUOTIENT
REM,	.-.				/DIVIDE REMAINDER
SCRCASE,.-.				/CURRENT MESSAGE CASE
SCRCHAR,.-.				/LATEST MESSAGE CHARACTER
SCRPTR,	.-.				/MESSAGE POIDLER ADDRESS
	TAD	IMSW			/GET IMAGE-MODE SWITCH
	SNA CLA				/SKIP IF IMAGE MODE SET
	JMS I	(GEIFILE)		/GO LOOKUP INPUT FILE
	TAD	(FNAME)			/POINT TO
	DCA	ENTAR1			/STORED FILENAME
	DCA	ENTAR2			/CLEAR SECOND ARGUMENT
	JMS I	(INDATE)		/GET INPUT FILE'S DATE
	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	(CLRCHKSUM)		/CLEAR THE CHECKSUM
	JMS I	(ENCODIT)		/GO DO THE ACT 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	NONAMERROR		/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 HANOTO 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
	TAD	INRECORD		/GET INPUT FILE STARTING RECORD
	DCA	INREC			/STORE IN-LINE
	NL7777				/SETUP INITIALIZE VALUE
	JMS I	[DOBYTE]		/INITIALIZE OUTPUT ROUTINE
	JMS I	(TDMESSAGE)		/OUTPUT TODAY'S DATE MESSAGE
	JMS I	(FDMESSAGE)		/OUTPUT FILE DATE MESSAGE
	JMS I	[SCRIBE]		/OUTPUT THE
	FILMSG				/(FILE MESSAGE
	JMS I	(PIFNAME)		/OUTPUT THE ITUAL 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
/	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.

NONAMER,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			/G)		/SETUP NORMAL NUMERICAL MODE
	TAD I	INPTR			/GET THE VALUE
	JMS I	[PUTIT]			/OUTPUT IT
	ISZ	CMPCNT			/ACCOUNT FOR ORIGINAL
	TAD	CMPCNT			/GET COMPRESSION COUNT
	CLL RTL;RTL			/*16
	JMS I	[PUTIT]			/OUTPUT BITS[0-7] ONLY
	JMS I	(OUTSETUP)		/SETUP NORMAL NUMERICAL MODE AGAIN
	TAD	INPTR			/GET INPUT POINTER
	TAD	CMPCNT			/UPDATE PAST ALL COMPRESSED VALUES
	DCA	INPTR			/STNPUT FILENAME
	JMS I	[SCRIBE]		/OUTPUT THE
	EMSG				/LINE ENDING
	TAD	[-WIDTH]		/SETUP THE
	DCA	WIDCNT			/LINE WIDTH COUNTER
	JMS I	(OUTSETUP)		/SETUP PACKING ROUTINE AND CLEAR FILL
	TAD	[-5]			/INITIALIZE
	DCA	OBOUND			/BOUNDARY COUNTER
ENCLOOP,JMS I	INPUT			/CALL INPUT HANDLER
	2^100				/READ TWO PAGES
PINBUFF,INBUFFER			/INTO INPUT BUFFER
INREC,	.-.				/WILL BE LATEST INPUT FILE RECORD
ENCERRO,JMP I	ENCODIT			/INPUT ERROR, TAKE IMMEDIATE RETURN
	ISZ	INREC			/BUMP TO NEXT RECORD
	NOP				/JUST IN CASE
	TAD	PINBUFFER/(INBUFFER)	/SETUP THE
	DCA	INPTR			/BUFFER POINTER
LOOP,	JMS I	(CHKBND)		/CHECK IF ON A GOOD BOUNDARY
	JMP	NOCOMPRESSION		/COMPRESS IS NOT ALLOWED AT THIS TIME
	TAD	INPTR			/GET CURRENT POINTER
	DCA	XR1			/STASH FOR SEARCH
	DCA	CMPCNT			/CLEAR MATCH COUNT
CMPLUP,	TAD	XR1			/GET INDEX VALUE
	TAD	(-2^200-INBUFFER+1)	/COMPARE TO LIMIT
	SNA CLA				/SKIP IF NOT AT END OF BUFFER
	JMP	CMPEND			/JUMP IF AT END OF BUFFER
	TAD I	XR1			/GET A CANDIDATE WORD
	CIA				/INVERT FOR TEST
	TAD I	INPTR			/COMPARE TO CURRENT TEST VALUE
	SZA CLA				/SKIP IF IT MATCHES
 	JMP	CMPEND			/JUMP IF THIS IS NOT A REPEAT
	ISZ	CMPCNT			/BUMP MATCH COUNT
	JMP	CMPLUP			/TRY TO FIND MORE
/	COMES HERE POSSIBLY WITH SOME COMPRESSED VALUES COUNTED.

CMPEND,	NL7776				/-2
	TAD	CMPCNT			/DID WE FIND ENOUGH MATCHES?
	SPA CLA				/SKIP IF SO
	JMP	NOCOMPRESSION		/FORGET IT
	TAD	("X-"0)			/SETUP COMPRESSION INDICATOR
	JMS I	(OUTSETUP)		/SETUP SPECIAL MODE
	JMS I	(PUT5)			/OUTPUT "X"
	JMS I	(OUTSETUPI	ENCODIT			/RETURN

	PAGE
PUTIT,	.-.				/WORD OUTPUT ROUTINE
	DCA	PUTEMP			/SAVE PASSED VALUE
	JMS I	(CALCHKSUM)		/UPDATE CHECKSUM
	JMP I	PUTNXT			/GO WHERE YOU SHOULD GO

PUTNXT,	PUT0				/OUTPUT EXIT ROUTINE
	TAD	PUTEMP			/GET LATEST VALUE
	DCA	PUTPREV			/SAVE FOR NEXT TIME
	JMP I	PUTIT			/RETURN TO MAIL CALLER

PUTLUP,	JMS	PUTNXT			/GET ANOTHER WORD
PUT0,	TAD	PUTEORE BACK
	JMP	TEST			/CONTINUE THERE

/	COMES HERE IF NO COMPRESSION FOUND (OR NOT ALLOWED).

NOCOMPR,TAD I	INPTR			/GET LATEST VALUE
	JMS I	[PUTIT]			/OUTPUT IT
	ISZ	INPTR			/BUMP TO NEXT
	ISZ	OBOUND			/BUMP TO NEXT WORD
	JMP	TEST			/KEEP GOING
	TAD	[-5]			/RESET THE
	DCA	OBOUND			/BOUNDARY COUNTER
TEST,	TAD	INPTR			/GET INPUT POINTER
	TAD	(-2^200-INBUFFER)	/COMPARE TO UPPER LIMIT
	SZA CLA				/SKIP IF AT END OF BUFFER
	JMP	LOOP			/ELSE JUST KEEP GOING
	ISZ	INLEN			/DONE ALL INPUT RECORDS?
	JMP	ENCLOOP			/NO, KEEP GOING

/	WE MUST FINISH THE LAST [5 WORDS => 12 BYTES] SEQUENCE.

ENDLUP,	JMS I	(CHKBND)		/AT A GOOD BOUNDARY?
	SKP				/SKIP IF NOT
	JMP	ENDONE			/JUMP IF SO
	JMS I	[PUTIT]			/OUTPUT SOME WASTE BYTES
	ISZ	OBOUND			/AT A GOOD BOUNDARY NOW?
	JMP	ENDLUP			/NO, TRY AGAIN
ENDONE,	TAD	("Z-"0)		/GET END INDICATOR
	JMS I	(OUTSETUP)		/SETUP SPECIAL MODE
	JMS I	(PUT5)			/OUTPUT A "Z"
	JMS I	(INVCHKSUM)		/INVERT THE CHECKSUM
	JMS I	(OUTSETUP)		/SETUP NORMAL NUMERICAL MODE
	JMS I	(CHKOUT)		/OUTPUT THE CHECKSUM
	JMS I	[SCRIBE]		/OUTPUT THE
	ENDMSG				/END MESSAGE
	JMS I	(PIFNAME)		/OUTPUT THE INPUT FILENAME
	JMS I	[SCRIBE]		/OUTPUT THE
	EMSG				/LINE ENDING
	JMS I	[SCRIBE]		/OUTPUT THE
	EOFMSG				/FINAL MESSAGE
	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 MP			/GET WORD[0]
	RTL;RTL;RTL			/BITS[0-4] => AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	TAD	PUTEMP			/GET WORD[0] AGAIN
	RTR				/BITS[5-9] => AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	JMS	PUTNXT			/GET ANOTHER WORD
PUT1,	TAD	PUTPREV			/GET WORD[0]
	AND	[3]			/ISOLATE BITS[10-11]
	CLL RTL;RAL			/BITS[10-11] => AC[7-8]
	DCA	PUTPREV			/SAVE FOR NOW
	TAD	PUTEMP			/GET WORD[1]
	RTL;RTL				/BITS[0-2] => AC[9-11]
	AND	[7]			/ISOLATE DESIRED BITS
	TAD	PUTPREV			/ADD ON WORD[0] BITS IN AC[7-8]
	JMS	PUT5			/OUTPUT A CHARACTER
	TAD	PUTEMP			/GET WORD[1]
	RTR;RTR				/BITS[3-7] => AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	JMS	PUTNXT			/GET ANOTHER WORD
PUT2,	TAD	PUTEMP			/GET WORD[2]
	RAL				/BIT[0] => L
	CLA				/CLEAN UP
	TAD	PUTPREV			/GET WORD[1]
	RAL				/BITS[8-11],L => AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	TAD	PUTEMP			/GET WORD[2]
	RTR;RTR;RTR			/BITS[1-5] => AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	TAD	PUTEMP			/GET WORD[2]
	RAR				/BITS[6-10] => AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	JMS	PUTNXT			/GET ANOTHER WORD
PUT3,	TAD	PUTPREV			/GET WORD[2]
	RAR				/BIT[11] => L
	CLA				/CLEAN UP
	TAD	PUTEMP			/GET WORD[3]
	RTL;RTL;RAL			/L, BITS[0-3] => AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	TAD	PUTEMP			/GET WORD[3]
	RTR;RAR				/BITS[4-8] => AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	JMS	PUTNXT			/GET ANOTHER WORD
PUT4,	TAD	PUTPREV			/GET WORD[3]
	AND	[7]			/ISOLATE BITS[9-11]
	CLL RTL				/BITS[9-11] => AC[7-9]
	DCA	PUTPREV			/SAVE FOR NOW
	TAD	PUTEMP			/GET WORD[4]
	RTL;RAL				/BITS[0-1] => AC[10-11]
	AND	[3]			/ISOLATE BITS[10-11]
	TAD	PUTPREV			/ADD ON WORD[3] BITS IN AC[7-9]
	JMS	PUT5			/OUTPUT A CHARACTER
	TAD	PUTEMP			/GET WORD[4]
	RTR;RTR;RAR			/BITS[2-6] => AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	TAD	PUTEMP			/GET WORD[4] BITS[7-11] IN AC[7-11]
	JMS	PUT5			/OUTPUT A CHARACTER
	JMP	PUTLUP			/GO DO ANOTHER GROUP OF FIVE WORDS

CHKNL,	.-.				/CHECK IF AT NEW LINE ROUTINE
	TAD	WIDCNT			/GET LINE WIDTH COUNTER
	TAD	(WIDTH)			/COMPARE TO MAXIMIM VALUE
	SZA CLA				/SKIP IF AT MAXIMUM
	ISZ	CHKNL			/TAKE SKIP RETURN IF NOT AT MAXIMUM
	JMP I	CHKNL			/RETURN EITHER WAY

OUTSETU,.-.				/OUTPUT SETUP ROUTINE
	DCA	FILLVALUE		/STORE PASSED FILL VALUE
	TAD	(PUT0)			/SETUP THE
	DCA	PUTNXT			/OUTPUT CO-ROUTINE
	JMP I	OUTSETUP		/RETURN
PUT5,	.-.				/FIVE-BIT OUTPUT ROUTINE
	AND	[37]			/JUST 5 BITS
	DCA	PUTLATEST		/SAVE IT
	JMS	CHKNL			/CHECK IF AT BEGINNING OF LINE
	SKP				/SKIP IF NOT
	JMP	PUTNORMAL		/JUMP IF SO
	TAD	("<&177)		/GET BEGINNING BRACKET
	JMS I	[DOBYTE]		/OUTPUT IT
PUTNORM,TAD	PUTLATEST		/GET LATEST VALUE
	TAD	("0-"9-1)		/COMPARE TO FIRST LIMIT
	SMA CLA				/SKIP IF LESS
	TAD	["A-"9-1]		/CONVERT LARGER VALUES TO A-V
	TAD	PUTLATEST		/ADD ON LATEST VALUE
	TAD	["0&177]		/MAKE IT ASCII
	TAD	FILLVALUE		/ADD ON FILL VALUE FOR SPECIAL MODE
	JMS I	[DOBYTE]		/OUTPUT IT
	ISZ	WIDCNT			/BUMP LINE COUNTER
	TAD	WIDCNT			/GET LINE COUNTER
	SZA CLA				/SKIP IF AT END OF LINE
	JMP I	PUT5			/ELSE JUST RETURN
	TAD	(">&177)		/GET DATA CLOSING CHARACTER
	JMS I	[DOBYTE]		/OUTPUT IT
	TAD	["M&37]			/GET A <CR>
	JMS I	[DOBYTE]		/OUTPUT IT
	TAD	["J&37]			/GET A <LF>
	JMS I	[DOBYTE]		/OUTPUT IT
	TAD	[-WIDTH]		/RESET THE
	DCA	WIDCNT			/LINE WIDTH COUNTER
	JMP I	PUT5			/RETURN

	PAGE
/	MESSAGE PRINT ROUTINE.

SCRIBE,	.-.				/MESSAGE PRINT ROUTINE
	TAD I	SCRIBE			/GET IN-LINE POINTER ARGUMENT
	DCA	SCRPTR			/STASH THE POINTER
	ISZ	SCRIBE			/BUMP PAST ARGUMENT
	TAD	(140)			/INITIALIZE TO
	DCA	SCRCASE			/LOWER-CASE
SCRLUP,	TAD I	SCRPTR			/GET LEFT HALF-WORD
	RTR;RTR;RTR			/MOVE OVER
	JMS	SCRPRNT			/PRINT IT
	TAD I	SCRPTR			/GET RIGHT HALF-WORD
	JMS	SCRPRNT			/PRINT IT
	ISZ	SCRPTR			/BUMP TO NEXT PAIR
	JMP	SCRLUP			/KEEP GOING

SCRPRNT,.-.				/CHARACTER PRINT ROUTINE
	AND	[77]			/JUSASE MATTER?
	SNA CLA				/SKIP IF NOT
	TAD	SCRCASE			/ELSE GET PREVAILING CASE
	TAD	SCRCHAR			/GET THE CHARACTER
SCRPRLF,JMS I	[DOBYTE]		/OUTPUT THE CHARACTER
	JMP I	SCRPRNT			/RETURN

SCRCRLF,TAD	["M&37]			/GET A <CR>
	JMS I	[DOBYTE]		/OUTPUT IT
	TAD	["J&37]			/GET A <LF>
	JMP	SCRPRLF			/CONTINUE THERE

SCRFLIP,TAD	SCRCASE			/GET CURRENT CASE
	CIA				/INVERT IT
	TAD	(140+100)		/ADD SUM OF POSSIBLE VALUES
	DCA	SCRCASE			/STORE NEW INVERTED CASE
	JMP I	SCRPRNT			/RETURN
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			/MT SIX BITS
	SNA				/END OF MESSAGE?
	JMP I	SCRIBE			/YES, RETURN TO ORIGINAL CALLER
	DCA	SCRCHAR			/NO, SAVE FOR NOW
	TAD	SCRCHAR			/GET IT BACK
	TAD	(-"%!200)		/IS IT "%"?
	SNA				/SKIP IF NOT
	JMP	SCRCRLF			/JUMP IF IT MATCHES
	TAD	(-"^+100+"%)		/IS IT "^"
	SNA CLA				/SKIP IF NOT
	JMP	SCRFLIP			/JUMP IF IT MATCHES
	TAD	SCRCHAR			/GET THE CHARACTER
	AND	[40]			/DOES CUTPUT			/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
DOBYTE,	.-.				/OUTPUT A BYTE ROUTINE
	JMS	PUTBYTE			/OUTPUT PASSED VALUE
	JMP I	(ENCERROR)		/COULDN'T DO IT
	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	LARG2			/GET NEGATED LENGTH
	DCA	INLEN			/STASH IT
	TAD	LARG1			/GET FIRST INPUT RECORD
	DCA	INRECORD		/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 OVE 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-OUTBUFFERR)	/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	OCLA				/SKIP IF /1 SET
	JMP	PIFPT2			/JUMP IF /2 SET
	JMS I	[SCRIBE]		/OUTPUT THE
	PT1MSG				/PART ONE MESSAGE
	JMP I	PIFNAME			/RETURN

PIFPT2,	JMS I	[SCRIBE]		/OUTPUT THE
	PT2MSG				/PART TWO MESSAGE
	JMP I	PIFNAME			/RETURN

DOIFNAM,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	SCRCHAR			/SAVE PASSED PAIR
	TAD	SCRCHAR			/GET IT BACK
	RTR;RTR;RTR			/MOVE DOWN
	JMS	PIFOUT			/PRINT HIGH-ORDER FIRST
	TAD	SCRCHAR			/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]		/GEPOINTER 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	IMSW			/GET IMAGE-MODE SWITCH
	SNA CLA				/SKIP IF SET
	JMP	DOIFNAME		/JUMP IF NOT
	JMS I	[SCRIBE]		/OUTPUT THE
	IFMSG				/IMAGE MESSAGE
	CDF	TBLFLD			/GOTO TABLE FIELD
	TAD I	[EQUWRD]		/GET EQUALS PARAMETER
	CDF	PRGFLD			/BACK TO OUR FIELD
	JMS I	(OCTOUT)		/OUTPUT IT
	CDF	TBLFLD			/GOTO TABLE FIELD
	TAD I	[SWY9]			/GET /Y-/9 SWITCHES
	CDF	PRGFLD			/BACK TO OUR FIELD
	AND	[600]			/JUST /1, /2 BITS
	SNA				/SKIP IF SOMETHING SET
	JMP I	PIFNAME			/JUST RETURN IF NOT
	AND	[400]			/JUST /1 BIT
	SNA  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
CALCHKS,.-.				/CALCULATE CHECKSUM ROUTINE
	TAD	CHKFLG			/SHOULD WE CHECKSUM?
	SZA CLA				/SKIP IF SO
	JMP I	CALCHKSUM		/JUMP IF NOT
	JMS	CHKSETUP		/SETUP
	TAD	PUTEMP			/GET PASSED VALUE
	CLL RAR				/CLEAR LINK AND MOVE OVER
ADDLUP,	RAL				/MOVE OVER CARRY
	TAD I	XR1			/ADD A WORD
	DCA I	XR2			/STORE BACK
	ISZ	CCNT			/DONE ENOUGH?
	JMP	ADDLUP			/NO, KEEP GOING
	JMP I	CALCHKSUM		/YES, RETURN

CHKOUT,	.-.				/OUTPUT THE CHECKSUM ROUTINE
	JMS	CHKSETUP		/SETUP
	ISZ	CHKFLG			/DISABLE CHECKSUMMING
	TAD I	XR1			/GET A WORD
	JMS I	[PUTIT]			/OUTPUT IT
	ISZ	CCNT			/DONE YET?
	JMP	.-3			/NO, KEEP GOING
	JMP I	CHKOUT			/YES, WE'RE DONE

CLRCHKS,.-.				/CLEAR CHECKSUM ROUTINE
	JMS	CHKSETUP		/SETUP
	DCA I	XR1			/CLEAR A WORD
	ISZ	CCNT			/DONE YET?
	JMP	.-2			/NO, DO ANOTHER
	DCA	CHKFLG			/ENABLE CHECKSUMMING
	JMP I	CLRCHT 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 CHECKRGFLD			/BACK TO OUR FIELD
	SNA				/SKIP IF THERE
	JMP	NOTDATE			/JUMP IF NOT
	DCA	TDATE			/SAVE TODAY'S DATE
	JMS I	[SCRIBE]		/OUTPUT THE
	ONMSG				/BRIDGING MESSAGE
	TAD	TDATE			/GET TODAY'S DATE
	JMS	PRDATE			/PRINT TODAY'S DATE
NOTDATE,JMS I	[SCRIBE]		/OUTPUT THE
	EMSG				/END MESSAGE
	JMP I	TDMESSAGE		/RETURN
PRDATE,	.-.				/DATE PRINT ROUTINE
	DCA	PRTEMP			/SAVE PASSED VALUE
	TAD	PRTEMP			/GET IT BACK
	RTR;RAR				/MOVE DOWN
	AND	[37]			/JUST DAY BITS
	JMS I	(DEC2)			/PRINT AS TWO DIGITS
	TAD	PRTEMP			/GET DATE AGAIN
	AND	[7400]			/JUST MONTH BITS
	CLL RTL;RTL;RTL			/MOVE DOWN
	TAD	(MONLST-2-1)		/POINT TO PROPER ELEMENT
	DCA	XR1			/STASH THE POINTER
	TAD I	XR1			/GET FIRST PAIR
	DCA I	(MMSG+1)		/STORE IN MESSAGE
	TAD I	XR1			/GEKSUM		/RETURN

INVCHKS,.-.				/CHECKSUM INVERSION ROUTINE
	JMS	CHKSETUP		/SETUP
	STL				/FORCE INITIAL CARRY
COMLUP,	TAD I	XR1			/GET A WORD
	CMA				/INVERT IT
	SZL				/SKIP IF NO CARRY
	CLL IAC				/ELSE ADD ONE AND CLEAR CARRY FOR NEXT TIME
	DCA I	XR2			/STORE BACK
	ISZ	CCNT			/DONE ALL YET?
	JMP	COMLUP			/NO, KEEP GOING
	JMP I	INVCHKSUM		/YES, RETURN

CHKSETU,.-.				/CHECKSUM SETUP ROUTINE
	TAD	(CHKSUM-1)		/POINT TO
	DCA	XR1			/CHECKSUM AREA
	TAD	(CHKSUM-1)		/POINT TO
	DCA	XR2			/CHECKSUM AREA
	TAD	[-5]			/SETUP THE
	DCA	CCNT			/CHECKSUM COUNT
	JMP I	CHKSETUP		/RETURN
/	FILE DATE ROUTINE.

FDMESSA,.-.				/PUT FILE DATE IN MESSAGE ROUTINE
	TAD	FDATE			/GET INPUT FILE'S DATE
	SNA CLA				/SKIP IF ANY
	JMP I	FDMESSAGE		/RETURN IF NONE
	JMS I	[SCRIBE]		/PRINT OUT THE
	DATMSG				/DATE BLURB
	TAD	FDATE			/GET IT BACK
	JMS	PRDATE			/PRINT THE DATE
	JMS I	[SCRIBE]		/PRINT THE
	EMSG				/END MESSAGE
	JMP I	FDMESSAGE		/RETURN

TDMESSA,.-.				/PUT TODAY'S DATE IN MESSAGE ROUTINE
	JMS I	[SCRIBE]		/OUTPUT THE
	REMMSG				/OPENING REMARKS
	CDF	TBLFLD			/GOTO TABLE FIELD
	TAD I	(DATWRD)		/GET DATE WORD
	CDF	P	TAD	REM			/GET IT BACK
	STL CIA				/INVERT
	SKP				/DON'T FIRST TIME
DVLOOP,	ISZ	QUO			/BUMP UP QUOTIENT
	TAD I	DIVIDE			/ADD ON ARGUMENT
	SNA SZL				/UNDERFLOW?
	JMP	DVLOOP			/NO, KEEP GOING
	CIA				/YES, INVERT IT BACK
	TAD I	DIVIDE			/RESTORE LOST VALUE
	DCA	REM			/SAVE AS REMAINDER
	TAD	QUO			/GET THE QUOTIENT
	ISZ	DIVIDE			/BUMP PAST ARGUMENT
	JMP I	DIVIDE			/RETURN

INDATE,	.-.				/GET INPUT FILE'S DATE WORD
	CDF	TBLFLD			/GOTO TABLE FIELD
	TAD	IMSW			/GET IMAGE-MODE SWITCH
	SNA CLA				/SKIP IF SET
	JMP	NOIMG			/JUMP IF NOT
	TAD I	(DATWRD)		/USE TODAY'S DATE
	JMP	NOAIW			/CONTINUE THERE

NOIMG,	TAD I	(AIWCNT)		/GET AIW COUNT
	SNA				/SKIP IF ANY
	JMP	NOAIW			/JUMP IF NOT
	TAD I	[AIWXR]			/GET ENTRY POINTER
	DCA	TEMP			/STASH T SECOND PAIR
	DCA I	(MMSG+2)		/STORE IN MESSAGE
	JMS I	[SCRIBE]		/OUTPUT THE
	MMSG				/MONTH MESSAGE
	TAD	PRTEMP			/GET DATE AGAIN
	AND	[7]			/JUST YEAR BITS
	DCA	TEMP			/SAVE IT
	CDF	TBLFLD			/GOTO TABLE FIELD
	TAD I	(DATWRD)		/GET CURRENT DATE WORD
	CDF	PRGFLD			/BACK TO OUR FIELD
	AND	[7]			/JUST YEAR BITS
	CIA				/INVERT FOR TEST
	TAD	TEMP			/COMPARE TO DESIRED YEAR
	SMA SZA CLA			/SKIP IF THEY MATCH OR ARE EARLIER
	TAD	(-10)			/ELSE BACKUP A GROUP
	TAD	TEMP			/ADD TO YEAR
	DCA	TEMP			/STORE BACK
	TAD I	(DATEXT)		/GET EXTENSION WORD
	AND	[600]			/JUST EXTENSION BITS
	CLL RTR;RTR			/MAKE IT GROUP COUNT
	TAD	TEMP			/ADD ON RELATIVE YEAR
	TAD	(106)			/MAKE IT ABSOLUTE YEAR (70-99)
	JMS I	(DEC2)			/PRINT AS TWO DIGITS
	JMP I	PRDATE			/RETURN

	PAGE
DEC2,	.-.				/PRINT TWO DIGITS ROUTINE
	JMS	DIVIDE			/DIVIDE
	12				/BY 10
	TAD	["0&177]		/MAKE IT ASCII
	JMS I	[DOBYTE]		/OUTPUT IT
	TAD	REM			/GET SECOND DIGIT
	TAD	["0&177]		/MAKE IT ASCII
	JMS I	[DOBYTE]		/OUTPUT IT
	JMP I	DEC2			/RETURN

/	DIVIDE ROUTINE.

DIVIDE,	.-.				/DIVIDE ROUTINE
	DCA	REM			/SAVE IN REMAINDER
	DCA	QUO			/CLEAR QUOTIENT
ALF, USE THE ROUNDED-DOWN FIRST HALF LENGTH.  THE DATA STARTS AT
/	RECORD ZERO (ALREADY SET).

	TAD I	[EQUWRD]		/GET EQUALS PARAMETER
	CLL RAR				/%2
IM2ENTR,CIA				/INVERT IT
	DCA	INLEN			/SET COUNT FOR HALF OF THE DEVICE
	JMP	IFNAMOK			/KEEP GOING
/	FOR A SECOND HALF, THE DATA STARTS AT THE HALFWAY POINT (ROUNDED DOWN).

IM2,	TAD I	[EQUWRD]		/GET EQUALS PARAMETER
	CLLFIRST AIW POINTER
	TAD I	TEMP			/GET FIRST AIW
NOAIW,	DCA	FDATE			/SAVE AS FILE'S DATE
	CDF	PRGFLD			/BACK TO OUR FIELD
	JMP I	INDATE			/RETURN
/	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
	SNA				/SKIP IF SOMETHING THERE
	JMP	IMTEST			/JUMP IF NOT
IFNAMOK,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

/	TEST IF IMAGE-MODE IS SET.  ASSUME /1 AND /2 ARE NOT SET.

IMTEST,	TAD I	(SWAL)			/GET /A-/L SWITCHES
	AND	(10)			/JUST /I BIT
	SZA CLA				/SKIP IF NOT SET
	TAD I	[EQUWRD]		/GET EQUALS PARAMETER
	SNA				/SKIP IF SOMETHING THERE
	JMP I	(INERR)			/ELSE COMPLAIN
	CIA				/INVERT IT
	DCA	INLEN			/USE AS INPUT RECORD COUNT
	DCA	INRECORD		/START AT THE BEGINNING OF THE DEVICE
	ISZ	IMSW			/INDICATE IMAGE-MODE SET

/	TEST IF /1 OR /2 IS SET.

	TAD I	[SWY9]			/GET /Y-/9 SWITCHES
	AND	[600]			/JUST /1, /2 SWITCHES
	SNA				/SKIP IF EITHER SET
	JMP	IFNAMOK			/JUMP IF NEITHER SET

/	TEST IF /1 IS SET.  IF NOT, /2 MUST BE SET.

	AND	[400]			/JUST /1 SWITCH
	SNA CLA				/SKIP IF /1 SET
	JMP	IM2			/JUMP IF /2 SET

/	FOR A  FIRST HT	"(^REMARK I^MAGE ^F^ILE ^C^REATED BY ^PDP^-8"

/	MONTH TEXT TABLE.

MONLST,	TEXT	"J^AN"			/JANUARY
	TEXT	"F^EB"			/FEBRUARY
	TEXT	"M^AR"			/MARCH
	TEXT	"A^PR"			/APRIL
	TEXT	"M^AY"			/MAY
	TEXT	"J^UN"			/JUNE
	TEXT	"J^UL"			/JULY
	TEXT	"A^UG"			/AUGUST
	TEXT	"S^EP"			/SEPTEMBER
	TEXT	"O^CT"			/OCTOBER
	TEXT	"N^OV"			/NOVEMBER
	TEXT	"D^EC"			/DECEMBER
	$				/THAT' RAR				/%2
	DCA	INRECORD		/SETUP STARTING RECORD

/	FOR A SECOND HALF,  THE  COUNT  IS THE ORIGINAL AMOUNT MINUS THE COUNT FOR THE
/	FIRST HALF.

	TAD I	[EQUWRD]		/GET EQUALS PARAMETER
	CLL RAR				/%2
	CIA				/INVERT IT
	TAD I	[EQUWRD]		/SUBTRACT FROM EQUALS PARAMETER
	JMP	IM2ENTRY		/CONTINUE THERE

CHKBND,	.-.				/CHECK IF ON GOOD OUTPUT BOUNDARY ROUTINE
	TAD	OBOUND			/GET BOUNDARY COUNTER
	TAD	(5)			/COMPARE TO BEGINNING VALUE
	SNA CLA				/SKIP IF NOT AT BEGINNING
	ISZ	CHKBND			/SET SKIP RETURN IF AT BEGINNING
	JMP I	CHKBND			/RETURN EITHER WAY

OCTOUT,	.-.				/OCTAL OUTPUT ROUTINE
	DCA	OCTEMP			/SAVE IT
	TAD	(-4)			/SETUP THE
	DCA	OCTCNT			/DIGIT COUNTER
OCTLUP,	TAD	OCTEMP			/GET THE VALUE
	RTL;RAL				/MOVE UP A DIGIT
	DCA	OCTEMP			/STORE BACK
	TAD	OCTEMP			/GET IT AGAIN
	RAL				/PUT INTO CORRECT BITS
	AND	[7]			/JUST ONE DIGIT
	TAD	["0&177]		/MAKE IT ASCII
	JMS I	[DOBYTE]		/OUTPUT IT
	ISZ	OCTCNT			/DONE ENOUGH?
	JMP	OCTLUP			/NO, GO BACK FOR MORE
	JMP I	OCTOUT			/YES, RETURN TO CALLER

	PAGE
/	FILE TEXT MESSAGES.

DATMSG,	TEXT	"(^REMARK F^ILE ^D^ATE: "
EMSG,	TEXT	")%^"
ENDMSG,	TEXT	">%(^END ^"
EOFMSG,	TEXT	"(^REMARK E^ND OF ^F^ILE)%"
FILMSG,	TEXT	"(^FILE "
IFMSG,	TEXT	"^B^LOCK-^I^MAGE-^F^ILE =^"
MMSG,	TEXT	"-^D^EC-19"
ONMSG,	TEXT	": ^"
PT1MSG,	TEXT	" ^F^IRST ^H^ALF"
PT2MSG,	TEXT	" ^S^ECOND ^H^ALF^"
REMMSG,	TEXT	"(^REMARK PDP-8/DEC^MATE ^E^NCODING ^P^ROGRAM ^V^ERSION ^"
	"0+VERSION^100+".-200;	"0+REVISION^100+" -200
	TEXT	"     C^HARLES ^L^ASNER)%"
	TEXS ALL FOLK!