A large commit.
[pdp8.git] / sw / kermit / k12 / k12enc.pal
diff --git a/sw/kermit/k12/k12enc.pal b/sw/kermit/k12/k12enc.pal
new file mode 100644 (file)
index 0000000..6c4ee66
--- /dev/null
@@ -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.
+\f/     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.
+\f/     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
+\f/     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
+\f      *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
+\f      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
+\f      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
+\f/     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
+\f      PAGE
+\fENCODIT,.-.                           /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
+\f/     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
+\fENDONE,       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
+\fPUTIT,        .-.                             /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
+\fPUT3, 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
+\fPUT5, .-.                             /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
+\f/     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
+\fPUTBYTE,.-.                           /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
+\fDOBYTE,       .-.                             /OUTPUT A BYTE ROUTINE
+       JMS     PUTBYTE                 /OUTPUT PASSED VALUE
+       JMP I   (ENCERROR)              /COULDN'T DO IT
+       JMP I   DOBYTE                  /RETURN
+
+       PAGE
+\f/     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
+\f/     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
+\fPIFOUT,       .-.                             /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
+\f      PAGE
+\fCALCHKS,.-.                           /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
+\f/     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
+\fPRDATE,       .-.                             /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
+\fDEC2, .-.                             /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
+\f/     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
+\f/     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
+\f/     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 =^"
+\fMMSG, TEXT    "-^D^EC-19"
+ONMSG, TEXT    ": ^"
+PT1MSG,        TEXT    " ^F^IRST ^H^ALF"
+PT2MSG,        TEXT    " ^S^ECOND ^H^ALF^"
+\fREMMSG,       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)%"
+\f      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
+\f      $                               /THAT'S ALL FOLK!