--- /dev/null
+/ 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!
projects / pdp8.git / blobdiff