X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fkermit%2Fk12%2Fk12enc.pal;fp=sw%2Fkermit%2Fk12%2Fk12enc.pal;h=6c4ee6610c64f78d14ea2617c4b73a8923505cdf;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

diff --git a/sw/kermit/k12/k12enc.pal b/sw/kermit/k12/k12enc.pal
new file mode 100644
index 0000000..6c4ee66
--- /dev/null
+++ b/sw/kermit/k12/k12enc.pal
@@ -0,0 +1,1089 @@
+/	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.  ****
+/				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 TO 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 TO 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 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.
+/	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 ADDITIONAL 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 SYSTEM 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,	.-.				/INPUT 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 POINTER
+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 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	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 HANDLER 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 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
+/	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			/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
+	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 INPUT 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	(OUTSETUP)		/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			/STORE 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 I	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	PUTEMP			/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]			/JUST 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 CASE 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			/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-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	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
+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 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	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 CLA				/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]		/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
+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	CLRCHKSUM		/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	PRGFLD			/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			/GET 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
+	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 FIRST 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 HALF, 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
+	CLL 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)%"
+	TEXT	"(^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'S ALL FOLK!