--- /dev/null
+/ OS/8 BOO ENCODING PROGRAM
+
+/ LAST EDIT: 01-OCT-1991 15:00:00 CJL
+
+/ MAY BE ASSEMBLED WITH '/F' SWITCH SET.
+
+/ PROGRAM TO ENCODE ANY TYPE OF OS/8 FILE INTO "PRINTABLE" ASCII (".BOO")
+/ FORMAT. THIS IS A COMMON DISTRIBUTION FORMAT FOR MANY COLUMBIA KERMIT FILES
+/ AND IS AN ALTERNATIVE TO ENCODE FORMAT FOR PDP-8 AND DECMATE USERS.
+
+/ DISTRIBUTED BY CUCCA AS "K12ENB.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE.
+
+/ WRITTEN BY:
+
+/ CHARLES LASNER (CJL)
+/ CLA SYSTEMS
+/ 72-55 METROPOLITAN AVENUE
+/ MIDDLE VILLAGE, NEW YORK 11379-2107
+/ (718) 894-6499
+
+/ USAGE:
+
+/ .RUN DEV ENBOO INVOKE PROGRAM
+/ *OUTPUT<INPUT PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>)
+/ *OUTPUT<INPUT$ PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <ESC>)
+/ . PROGRAM EXITS NORMALLY
+
+/ INPUT FILE ASSUMES .SV EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION.
+
+/ PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
+/ KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC>
+/ CHARACTER.
+
+/ THIS PROGRAM SUPPORTS THE .BOO FORMAT FOR FILE ENCODING WHICH IS POPULAR IN
+/ OTHER SYSTEMS. THIS VERSION IMPLEMENTS THE FILE LENGTH PROTECTION SCHEME
+/ DEVELOPED BY CHARLES LASNER TO ENSURE PRECISE FILE LENGTH.
+
+/ MANY .BOO PROGRAMS HAVE PROBLEMS MAINTAINING PRECISE FILE LENGTH. THE ACTUAL
+/ LENGTH MAY BE IMPRECISELY STATED BY ONE OR TWO BYTES DUE TO AN INHERENT
+/ WEAKNESS IN THE ORIGINAL .BOO ENCODING FORMAT DESIGN. THIS IMPLEMENTATION
+/ APPENDS CORRECTION BYTES AS NECESSARY TO THE BASIC .BOO FILE TO ENSURE PROPER
+/ DECODING BY PROGRAMS COMPATIBLE WITH THIS EXTENSION.
+
+/ FILES CREATED BY THIS PROGRAM MAY BE USED WITH EARLIER .BOO DECODERS; THE
+/ RESULTANT FILES MAY INACCURATELY RECREATE THE ORIGINAL FILES BY AS MUCH AS TWO
+/ EXTRANEOUS TRAILING BYTES. THERE WILL BE NO PROBLEMS (BEYOND THE LENGTH
+/ ANOMALY) AS LONG AS THE DECODERS IMPLEMENT ZERO-LENGTH COMPRESSION FIELDS AS
+/ NO OPERATION. IT IS POSSIBLE THAT CERTAIN DECODERS COULD ERRONEOUSLY APPEND
+/ MASSIVE QUANTITIES OF ZEROES ONTO THE END OF THE DECODED FILES, BUT THIS
+/ ACTION WOULD CERTAINLY BE CAUSED BY DEFECTIVE PROGRAM CODE WITHIN THE DECODER.
+/ (ALTHOUGH NOT LIKELY SEEN BEFORE ENCOUNTERING FILES WITH LENGTH CORRECTION
+/ BYTES, THIS WOULD BE A LATENT BUG IN THESE DECODING PROGRAMS. UPDATED
+/ VERSIONS SHOULD BE SOUGHT IF THIS PROBLEM SURFACES.)
+\f/ ERROR MESSAGES.
+
+/ ERROR MESSAGES ARE ONE OF TWO VARIETIES: COMMAND DECODER MESSAGES AND USER
+/ (PROGRAM-SIGNALLED) MESSAGES.
+
+/ COMMAND DECODER MESSAGES ARE NON-FATAL AND MERELY REQUIRE RETYPING THE
+/ COMMAND. ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE WILL YIELD THE COMMAND
+/ DECODER MESSAGE "TOO MANY FILES" AND CAUSE A REPEAT OF THE COMMAND DECODER
+/ PROMPT REQUIRING USER INPUT. THE USER IS DIRECTED TO OTHER DOCUMENTATION OF
+/ THE "SPECIAL" MODE OF THE COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY
+/ THIS UTILITY PROGRAM.
+
+/ ANY USER MESSAGE PRINTED IS A FATAL ERROR MESSAGE CAUSED BY A PROBLEM BEYOND
+/ THE SCOPE OF THE COMMAND DECODER. ALL USER MESSAGES ARE THE STANDARD OS/8
+/ "USER" ERROR MESSAGES OF THE FORM: "USER ERROR X AT AAAAA", WHERE X IS THE
+/ ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
+/ THE FOLLOWING USER ERRORS ARE DEFINED:
+
+/ ERROR NUMBER PROBABLE CAUSE
+
+/ 0 NO OUTPUT FILE.
+
+/ 1 INPUT FILE ERROR (CAN'T FIND INPUT FILE) OR NO INPUT
+/ FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED.
+/ 2 ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED).
+
+/ 3 NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED).
+
+/ 4 ERROR WHILE FETCHING FILE HANDLER.
+
+/ 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
+
+/ 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
+
+/ 7 ERROR WHILE CLOSING THE OUTPUT FILE.
+
+/ 8 I/O ERROR WHILE ENCODING FILE DATA.
+
+/ 9 OUTPUT ERROR WHILE ENCODING FILE DATA.
+
+/ ASSEMBLY INSTRUCTIONS.
+
+/ IT IS ASSUMED THE SOURCE FILE K12ENB.PAL HAS BEEN MOVED AND RENAMED TO
+/ DSK:ENBOO.PA.
+
+/ .PAL ENBOO<ENBOO/E/F ASSEMBLE SOURCE PROGRAM
+/ .LOAD ENBOO LOAD THE BINARY FILE
+/ .SAVE DEV ENBOO=2001 SAVE THE CORE-IMAGE FILE
+\f/ DEFINITIONS.
+
+ CLOSE= 4 /CLOSE OUTPUT FILE
+ DECODE= 5 /CALL COMMAND DECODER
+ ENTER= 3 /ENTER TENTATIVE FILE
+ FETCH= 1 /FETCH HANDLER
+ IHNDBUF=7200 /INPUT HANDLER BUFFER
+ INBUFFE=6200 /INPUT BUFFER
+ INFILE= 7605 /INPUT FILE INFORMATION HERE
+ LOOKUP= 2 /LOOKUP INPUT FILE
+ NL0001= CLA IAC /LOAD AC WITH 0001
+ NL0002= CLA CLL CML RTL /LOAD AC WITH 0002
+ NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776
+ NL7777= CLA CMA /LOAD AC WITH 7777
+ OHNDBUF=6600 /OUTPUT HANDLER BUFFER
+ OUTBUFF=5600 /OUTPUT BUFFER
+ OUTFILE=7600 /OUTPUT FILE INFORMATION HERE
+ PRGFLD= 00 /PROGRAM FIELD
+ RESET= 13 /RESET SYSTEM TABLES
+ SBOOT= 7600 /MONITOR EXIT
+ TBLFLD= 10 /COMMAND DECODER TABLE FIELD
+ TERMWRD=7642 /TERMINATOR WORD
+ USERROR=7 /USER SIGNALLED ERROR
+ USR= 0200 /USR ENTRY POINT
+ USRENT= 7700 /USR ENTRY POINT WHEN NON-RESIDENT
+ USRFLD= 10 /USR FIELD
+ USRIN= 10 /LOCK USR IN CORE
+ WIDTH= 114 /LINES MUST BE 76 WIDE OR LESS
+ WRITE= 4000 /I/O WRITE BIT
+\f *0 /START AT THE BEGINNING
+
+ *20 /GET PAST AUTO-INDEX AREA
+
+BUFPTR, .-. /OUTPUT BUFFER POINTER
+CHAR, .-. /LATEST INPUT BYTE
+CHARPTR,.-. /OUTPUT BYTE POINTER
+CHARS, ZBLOCK 3 /OUTPUT BYTES HERE
+CMPCNT, .-. /MATCH COUNT FOR COMPRESSION
+COLUMN, .-. /LATEST COLUMN
+DANGCNT,.-. /DANGER COUNT
+IDNUMBE,.-. /INPUT DEVICE NUMBER
+IFNAME, ZBLOCK 4 /INPUT FILENAME
+INLEN, .-. /INPUT FILE LENGTH
+INPTR, .-. /INPUT BUFFER POINTER
+INPUT, .-. /INPUT HANDLER POINTER
+INRECOR,.-. /INPUT RECORD
+FNAME, ZBLOCK 4 /OUTPUT FILENAME
+LATEST, .-. /LATEST OUTPUT CHARACTER
+ODNUMBE,.-. /OUTPUT DEVICE NUMBER
+OUTPUT, .-. /OUTPUT HANDLER POINTER
+OUTRECO,.-. /OUTPUT RECORD
+PIFTEMP,.-. /PRINT INPUT FILENAME TEMPORARY
+TEMPTR, .-. /TEMPORARY POINTER
+THIRD, .-. /THIRD INPUT BYTE UNPACKING TEMPORARY
+\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 (USRENT) /CALL USR ROUTINE
+ USRIN /GET IT LOCKED IN
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ DECODE /WANT COMMAND DECODER
+ "*^100 /USING SPECIAL MODE
+ CDF TBLFLD /GOTO TABLE FIELD
+ TAD I (TERMWRD) /GET TERMINATOR WORD
+ SPA CLA /SKIP IF <CR> TERMINATED THE LINE
+ DCA EXITZAP /ELSE CAUSE EXIT LATER
+ TAD I (OUTFILE) /GET OUTPUT FILE DEVICE WORD
+ SNA /SKIP IF FIRST OUTPUT FILE PRESENT
+ JMP TSTMORE /JUMP IF NOT THERE
+ AND [17] /JUST DEVICE BITS
+ DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER
+ TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
+ SNA /SKIP IF PRESENT
+ JMP INERR /JUMP IF NOT
+ AND [17] /JUST DEVICE BITS
+ DCA IDNUMBER /SAVE INPUT DEVICE NUMBER
+ TAD I (INFILE+5) /GET SECOND INPUT FILE DEVICE WORD
+ SZA CLA /SKIP IF ONLY ONE INPUT FILE
+ JMP INERR /ELSE COMPLAIN
+ JMS I (MIFNAME) /MOVE INPUT FILENAME WITH ADJUSTED EXTENSION
+ TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
+ SNA CLA /SKIP IF NAME PRESENT
+ JMP NONAME /JUMP IF DEVICE ONLY
+ JMS I (MOFNAME) /MOVE OUTPUT FILENAME
+ CDF PRGFLD /BACK TO OUR FIELD
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ RESET /RESET SYSTEM TABLES
+ TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT
+ DCA OHPTR /STORE IN-LINE
+ TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ FETCH /FETCH HANDLER
+OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
+ JMP FERROR /FETCH ERROR
+ TAD OHPTR /GET RETURNED ADDRESS
+ DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
+ TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT
+ DCA IHPTR /STORE IN-LINE
+\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
+ JMS I (GEIFILE) /GO LOOKUP INPUT FILE
+ TAD (FNAME) /POINT TO
+ DCA ENTAR1 /STORED FILENAME
+ DCA ENTAR2 /CLEAR SECOND ARGUMENT
+ TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ ENTER /ENTER TENTATIVE FILENAME
+ENTAR1, .-. /WILL POINT TO FILENAME
+ENTAR2, .-. /WILL BE ZERO
+ JMP ENTERR /ENTER ERROR
+ TAD ENTAR1 /GET RETURNED FIRST RECORD
+ DCA OUTRECORD /STORE IT
+ TAD ENTAR2 /GET RETURNED EMPTY LENGTH
+ IAC /ADD 2-1 FOR OS/278 CRAZINESS
+ DCA DANGCNT /STORE AS DANGER COUNT
+ JMS I (ENCODIT) /GO DO THE ACTUAL ENCODING
+ JMP PROCERR /ERROR WHILE ENCODING
+ TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ CLOSE /CLOSE OUTPUT FILE
+ FNAME /POINTER TO FILENAME
+OUTCNT, .-. /WILL BE ACTUAL COUNT
+ JMP CLSERR /CLOSE ERROR
+EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
+ JMP I (SBOOT) /EXIT TO MONITOR
+\f/ OUTPUT FILE ERROR WHILE PROCESSING.
+
+ENCERRO,TAD [3] /SET INCREMENT
+ SKP /DON'T USE NEXT
+
+/ ERROR WHILE PROCESSING INPUT FILE.
+
+PROCERR,NL0002 /SET INCREMENT
+ SKP /DON'T USE NEXT
+
+/ ERROR WHILE CLOSING THE OUTPUT FILE.
+
+CLSERR, NL0001 /SET INCREMENT
+ SKP /DON'T CLEAR IT
+
+/ OUTPUT FILE TOO LARGE ERROR.
+
+SIZERR, CLA /CLEAN UP
+ TAD [3] /SET INCREMENT
+ SKP /DON'T USE NEXT
+
+/ ENTER ERROR.
+
+ENTERR, NL0002 /SET INCREMENT
+ SKP /DON'T USE NEXT
+
+/ HANDLER FETCH ERROR.
+
+FERROR, NL0001 /SET INCREMENT
+
+/ NO OUTPUT FILENAME ERROR.
+
+NONAME, IAC /SET INCREMENT
+
+/ ILLEGAL OUTPUT FILE NAME ERROR.
+
+BADNAME,IAC /SET INCREMENT
+
+/ INPUT FILESPEC ERROR.
+
+INERR, IAC /SET INCREMENT
+
+/ OUTPUT FILESPEC ERROR.
+
+OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER
+ CDF PRGFLD /ENSURE OUR FIELD
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ USERROR /USER ERROR
+ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER
+\f/ 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
+\fENCODIT,.-. /ENCODING ROUTINE
+ NL7777 /SETUP INITIALIZE VALUE
+ JMS I [DOBYTE] /INITIALIZE OUTPUT ROUTINE
+ JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME
+ JMS I (PCRLF) /OUTPUT <CR>/<LF> AND CLEAR COLUMN COUNTER
+ DCA CMPCNT /CLEAR COMPRESSION
+ TAD [CHARS] /SETUP THE
+ DCA CHARPTR /OUTPUT POINTER
+ NL7777 /MAKE IT INITIALIZE
+LOOP, JMS I (GETBYTE) /GET LATEST BYTE
+ JMP ENDCHECK /AREN'T ANY MORE, FINISH THE FILE
+
+/ TEST IF ALREADY WITHIN A DEVELOPING COMPRESSION FIELD.
+
+ TAD CMPCNT /GET COMPRESSION COUNT
+ SNA CLA /SKIP IF COMPRESSION IN PROGRESS
+ JMP NOCOMP /JUMP IF NOT
+
+/ CHECK IF LATEST INPUT BYTE IS ZERO.
+
+ TAD CHAR /GET LATEST
+ SZA CLA /SKIP IF SO
+ JMP ENDCOMPRESS /JUMP IF NOT
+SETCOMP,ISZ CMPCNT /BUMP COMPRESSION COUNT
+ TAD CMPCNT /GET LATEST COUNT
+ TAD (-116) /COMPARE TO MAXIMUM ALLOWED
+ SNA CLA /SKIP IF NOT
+ JMS I (COMPRESSOUT) /OUTPUT MAXIMUM COMPRESSION AND CANCEL COMPRESSION
+ JMP LOOP /GO GET ANOTHER ONE
+
+/ IF LATEST IS NON-ZERO, THEN COMPLETE EXISTING COMPRESSION FIELD.
+
+ENDCOMP,NL7777 /-1
+ TAD CMPCNT /COMPARE TO COMPRESSION COUNT
+ SZA CLA /SKIP IF TRIVIAL CASE
+ JMP OUTCOMPRESS /JUMP IF NOT
+
+/ CANCEL TRIVIAL CASE OF ONE BYTE COMPRESSION.
+
+ DCA CMPCNT /CLEAR COMPRESSION MODE
+ DCA CHARS /FIRST BYTE WAS ZERO
+ TAD (CHARS+1) /SETUP OUTPUT POINTER TO
+ DCA CHARPTR /STORE INTO SECOND BYTE
+ JMP BYTEINSERT /CONTINUE THERE
+\f/ OUTPUT LATEST COMPRESSION AND PROCESS NEW NON-ZERO BYTE.
+
+OUTCOMP,JMS I (COMPRESSOUT) /OUTPUT COMPRESSION FIELD AND CANCEL COMPRESSION
+
+/ COMES HERE IF NOT WITHIN A COMPRESSION REGION.
+
+NOCOMP, TAD CHARPTR /GET POINTER
+ TAD (-CHARS) /CHECK IF AT BEGINNING
+ SZA CLA /SKIP IF BUFFER EMPTY
+ JMP BYTEINSERT /JUMP IF NOT
+
+/ IF AT BEGINNING OF THREE BYTES, TEST IF LATEST STARTS A COMPRESSION FIELD.
+
+ TAD CHAR /GET LATEST BYTE
+ SNA CLA /SKIP IF NOT ZERO
+ JMP SETCOMPRESSION /JUMP IF SO
+BYTEINS,TAD CHAR /GET LATEST BYTE
+ DCA I CHARPTR /STORE IT
+ ISZ CHARPTR /BUMP TO NEXT
+ TAD CHARPTR /GET THE UPDATED POINTER
+ TAD (-CHARS-2-1) /COMPARE TO UPPER LIMIT
+ SNA CLA /SKIP IF LESS THAN THREE PRESENT
+ JMS I (OUT3) /ELSE OUTPUT THE THREE BYTES AND RESET THE BUFFER
+ JMP LOOP /GO GET ANOTHER ONE
+
+/ COMES HERE AT END OF INPUT.
+
+ENDCHEC,NL7776 /-2
+ TAD CMPCNT /COMPARE TO COMPRESSION COUNT
+ SMA /SKIP IF AT TRIVIAL CASE OR NO COMPRESSION CURRENTLY
+ JMP ENDFCOMPRESS /FINISH WITH A COMPRESSION FIELD
+ IAC /CHECK FURTHER
+ SZA CLA /SKIP IF TRIVIAL COMPRESSION AT END
+ JMP NORMEND /JUMP IF NOT WITHIN COMPRESSION
+
+/ THE TRIVIAL CASE CONVERTS TO AN INCOMPLETE OUTPUT, COMPLETE WITH CORRECTION
+/ BYTES TO INDICATE THE SHORT FIELD.
+
+ DCA CHARS /MOVE ZERO BYTE TO FIRST POSITION
+NORM1, DCA CHARS+1 /CLEAR SECOND POSITION
+ DCA CHARS+2 /CLEAR THIRD POSITION
+ JMS I (OUT3) /OUTPUT THE THREE BYTES
+ DCA CMPCNT /CLEAR COMPRESSION COUNT
+ JMS I (COMPRESSOUT) /OUTPUT NULL COMPRESSION FIELD TO CANCEL THIRD BYTE
+ /NEXT WILL CANCEL SECOND BYTE
+
+/ COMES HERE IF FILE ENDS ON A COMPRESSION FIELD.
+
+ENDFCOM,JMS I (COMPRESSOUT) /OUTPUT COMPRESSION FIELD AND CANCEL COMPRESSION
+ JMP CLOSFILE /FINISH IT THERE
+\f/ COMES HERE IF FILE ENDS IN SOME FORM OF DATA FIELD.
+
+NORMEND,TAD CHARPTR /GET CHARACTER POINTER
+ TAD (-CHARS-2) /COMPARE TO TWO PRESENT VALUE
+ SNA /SKIP IF NOT THE CASE
+ JMP NORM2 /JUMP IF SO
+ IAC /BUMP TO ONE PRESENT VALUE
+ SNA CLA /SKIP IF NOT THE CASE
+ JMP NORM1 /JUMP IF SO
+CLOSFIL,TAD COLUMN /GET CURRENT COLUMN COUNTER
+ SZA CLA /SKIP IF AT BEGINNING ALREADY
+ JMS I (PCRLF) /ELSE OUTPUT <CR>/<LF> NOW
+ TAD ("Z&37) /GET <^Z>
+CLOSLUP,JMS I [DOBYTE] /OUTPUT A BYTE (^Z OR NULL)
+ TAD BUFPTR /GET THE OUTPUT BUFFER POINTER
+ TAD (-OUTBUFFER) /COMPARE TO RESET VALUE
+ SZA CLA /SKIP IF IT MATCHES
+ JMP CLOSLUP /ELSE KEEP GOING
+ ISZ ENCODIT /NO ERRORS
+ JMP I ENCODIT /RETURN
+
+/ COMES HERE IF FILE ENDS WITH ONLY TWO DATA CHARACTERS.
+
+NORM2, DCA CHARS+2 /CLEAR THIRD CHARACTER
+ JMS I (OUT3) /OUTPUT THE THREE BYTES
+ JMP ENDFCOMPRESS /FINISH IT THERE
+
+ PAGE
+\f/ GET AN INPUT BYTE ROUTINE.
+
+GETBYTE,.-. /GET A BYTE ROUTINE
+ SNA CLA /INITIALIZING?
+ JMP I PUTC /NO, GO GET NEXT BYTE
+ TAD INRECORD /GET INPUT FILE STARTING RECORD
+ DCA GETRECORD /STORE IN-LINE
+GETNEWR,JMS I INPUT /CALL INPUT HANDLER
+ 2^100 /READ TWO PAGES
+PINBUFF,INBUFFER /INTO INPUT BUFFER
+GETRECO,.-. /WILL BE LATEST INPUT FILE RECORD
+ JMP I (PROCERR) /INPUT READ ERROR, GO COMPLAIN
+ TAD PINBUFFER/(INBUFFER) /SETUP THE
+ DCA INPTR /BUFFER POINTER
+GETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW
+ JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE
+ JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE
+ TAD THIRD /GET THIRD BYTE
+ JMS PUTC /SEND IT BACK
+ TAD INPTR /GET THE POINTER
+ TAD (-2^200-INBUFFER) /COMPARE TO LIMIT
+ SZA CLA /SKIP IF AT END
+ JMP GETLOOP /KEEP GOING
+ ISZ GETRECORD /BUMP TO NEXT RECORD
+ NOP /JUST IN CASE
+ ISZ INLEN /DONE ALL INPUT RECORDS?
+ JMP GETNEWRECORD /NO, KEEP GOING
+
+/ AT END-OF-FILE, SO JUST TAKE IMMEDIATE RETURN.
+
+ JMP I GETBYTE /RETURN TO CALLER
+
+PUTONE, .-. /SEND BACK A BYTE ROUTINE
+ TAD I INPTR /GET LATEST WORD
+ AND [7400] /JUST THIRD-BYTE NYBBLE
+ CLL RAL /MOVE UP
+ TAD THIRD /GET OLD NYBBLE (IF ANY)
+ RTL;RTL /MOVE UP NYBBLE BITS
+ DCA THIRD /SAVE FOR NEXT TIME
+ TAD I INPTR /GET LATEST WORD AGAIN
+ JMS PUTC /SEND BACK CURRENT BYTE
+ ISZ INPTR /BUMP TO NEXT WORD
+ JMP I PUTONE /RETURN
+
+PUTC, .-. /SEND BACK LATEST BYTE ROUTINE
+ AND (377) /KEEP ONLY GOOD BITS
+ DCA CHAR /SAVE AS LATEST BYTE
+ ISZ GETBYTE /BUMP PAST <EOF> RETURN
+ JMP I GETBYTE /RETURN TO MAIN CALLER
+\f/ COMPRESSION FIELD OUTPUT ROUTINE.
+
+COMPRES,.-. /COMPRESSION OUTPUT ROUTINE
+ CLA /CLEAN UP
+ TAD COLUMN /GET CURRENT COLUMN COUNTER
+ TAD (-WIDTH+2) /COMPARE TO UPPER LIMIT
+ SMA SZA CLA /SKIP IF NOT ABOVE LIMIT
+ JMS PCRLF /ELSE DO <CR>/<LF> FIRST
+ TAD (176) /GET TILDE VALUE
+ JMS I [DOBYTE] /OUTPUT IT
+ TAD CMPCNT /GET COMPRESSION COUNT
+ JMS PDIGIT /OUTPUT IT
+ DCA CMPCNT /CLEAR COMPRESSION
+ JMP I COMPRESSOUT /RETURN
+
+/ DATA FIELD OUTPUT ROUTINE.
+
+OUT3, .-. /OUTPUT THREE BYTES ROUTINE
+ TAD COLUMN /GET CURRENT COLUMN COUNTER
+ TAD (-WIDTH+4) /COMPARE TO UPPER LIMIT
+ SMA SZA CLA /SKIP IF NOT ABOVE LIMIT
+ JMS PCRLF /ELSE DO <CR>/<LF> FIRST
+ TAD CHARS /GET FIRST BYTE
+ RTR /WANT HIGH SIX BITS FIRST
+ JMS PDIGIT /OUTPUT THEM
+ TAD CHARS /GET IT AGAIN
+ AND [3] /JUST TWO LOWEST BITS
+ CLL RTR;RTR;RAR /MOVE UP
+ TAD CHARS+1 /GET SECOND BYTE
+ RTR;RTR /MOVE DOWN
+ JMS PDIGIT /OUTPUT THEM
+ TAD CHARS+2 /GET THIRD BYTE
+ AND (300) /JUST TWO HIGHEST BITS NEEDED
+ CLL RTL;RTL;RAL /MOVE INTO POSITION
+ TAD CHARS+1 /GET SECOND BYTE
+ RTL /MOVE UP
+ AND [77] /JUST DESIRED BITS
+ JMS PDIGIT /OUTPUT THEM
+ TAD CHARS+2 /GET THIRD BYTE
+ AND [77] /JUST SIX BITS
+ JMS PDIGIT /OUTPUT THEM
+ TAD [CHARS] /RESET THE
+ DCA CHARPTR /OUTPUT POINTER
+ JMP I OUT3 /RETURN
+
+PDIGIT, .-. /PRINT AS A DIGIT INTO FILE ROUTINE
+ AND [177] /REMOVE JUNK BITS
+ TAD ("0&177) /TURN PASSED VALUE INTO A DIGIT
+ JMS I [DOBYTE] /OUTPUT IT
+ JMP I PDIGIT /RETURN
+\fPCRLF, .-. /PRINT <CR>/<LF> INTO FILE ROUTINE
+ TAD ("M&37) /GET A <CR>
+ JMS I [DOBYTE] /OUTPUT IT
+ TAD ("J&37) /GET A <LF>
+ JMS I [DOBYTE] /OUTPUT IT
+ DCA COLUMN /CLEAR COLUMN COUNTER
+ JMP I PCRLF /RETURN
+
+ PAGE
+\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-OUTBUFF)/COMPARE TO LIMIT
+ SZA CLA /SKIP IF AT END
+ JMP PUTLOOP /KEEP GOING
+ ISZ DANGCNT /TOO MANY RECORDS?
+ SKP /SKIP IF NOT
+ JMP I (SIZERR) /JUMP IF SO
+ JMS I OUTPUT /CALL I/O HANDLER
+ 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER
+ OUTBUFFER /BUFFER ADDRESS
+PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
+ JMP PUTERROR /OUTPUT ERROR!
+ ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
+ ISZ PUTRECORD /BUMP TO NEXT RECORD
+ JMP PUTNEWRECORD /KEEP GOING
+\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
+ DCA IFNAME /STASH IT
+ TAD I (INFILE+2) /GET SECOND INPUT FILENAME WORD
+ DCA IFNAME+1 /STASH IT
+ TAD I (INFILE+3) /GET THIRD INPUT FILENAME WORD
+ DCA IFNAME+2 /STASH IT
+ TAD I [INFILE+4] /GET FOURTH INPUT FILENAME WORD
+ SNA /SKIP IF SOMETHING THERE
+ TAD ("S^100+"V-300) /ELSE USE DEFAULT EXTENSION VALUE
+ DCA IFNAME+3 /STASH IT EITHER WAY
+ JMP I MIFNAME /RETURN
+
+DOBYTE, .-. /OUTPUT A BYTE ROUTINE
+ JMS PUTBYTE /OUTPUT PASSED VALUE
+ JMP I (ENCERROR) /COULDN'T DO IT
+ ISZ COLUMN /BUMP COLUMN COUNTER
+ JMP I DOBYTE /RETURN
+
+ PAGE
+\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 LARG1 /GET FIRST INPUT RECORD
+ DCA INRECORD /STASH IT
+ TAD LARG2 /GET NEGATED LENGTH
+ DCA INLEN /STASH IT
+ JMP I GEIFILE /RETURN
+
+/ COMES HERE IF LOOKUP FAILED.
+
+TRYNULL,CDF TBLFLD /GOTO TABLE FIELD
+ TAD I [INFILE+4] /GET ORIGINAL FILENAME'S EXTENSION
+ CDF PRGFLD /BACK TO OUR FIELD
+ SZA CLA /SKIP IF IT WAS NULL ORIGINALLY
+ JMP I (INERR) /ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE
+ DCA IFNAME+3 /NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION
+ JMS LUKUP /TRY TO LOOK IT UP AGAIN
+ JMP NULLOK /THAT WORKED!
+ JMP I (INERR) /COMPLAIN OF LOOKUP FAILURE
+
+LUKUP, .-. /LOW-LEVEL LOOKUP ROUTINE
+ TAD (IFNAME) /GET OUR FILENAME POINTER
+ DCA LARG1 /STORE IN-LINE
+ DCA LARG2 /CLEAR SECOND ARGUMENT
+ TAD IDNUMBER /GET INPUT DEVICE NUMBER
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ LOOKUP /WANT LOOKUP FUNCTION
+LARG1, .-. /WILL BE POINTER TO OUR FILENAME
+LARG2, .-. /WILL RETURN FILE LENGTH (HOPEFULLY)
+ ISZ LUKUP /LOOKUP FAILED, SO BUMP RETURN ADDRESS
+ JMP I LUKUP /RETURN EITHER WAY
+\f/ INPUT FILENAME PRINT ROUTINE.
+
+PIFNAME,.-. /PRINT INPUT FILENAME ROUTINE
+ TAD IFNAME /GET FIRST PAIR
+ JMS PIF2 /PRINT IT
+ TAD IFNAME+1 /GET SECOND PAIR
+ JMS PIF2 /PRINT IT
+ TAD IFNAME+2 /GET THIRD PAIR
+ JMS PIF2 /PRINT IT
+ TAD (".&177) /GET SEPARATOR
+ JMS PIFOUT /PRINT IT
+ TAD IFNAME+3 /GET FOURTH PAIR
+ JMS PIF2 /PRINT IT
+ JMP I PIFNAME /RETURN
+
+PIF2, .-. /PRINT A PAIR ROUTINE
+ DCA PIFTEMP /SAVE PASSED PAIR
+ TAD PIFTEMP /GET IT BACK
+ RTR;RTR;RTR /MOVE DOWN
+ JMS PIFOUT /PRINT HIGH-ORDER FIRST
+ TAD PIFTEMP /GET IT AGAIN
+ JMS PIFOUT /PRINT LOW-ORDER
+ JMP I PIF2 /RETURN
+
+PIFOUT, .-. /FILENAME CHARACTER OUTPUT ROUTINE
+ AND [77] /JUST SIXBIT
+ SNA /SKIP IF SOMETHING THERE
+ JMP I PIFOUT /ELSE IGNORE IT
+ TAD [40] /INVERT IT
+ AND [77] /REMOVE EXCESS
+ TAD [40] /INVERT IT AGAIN
+ JMS I [DOBYTE] /OUTPUT IT
+ JMP I PIFOUT /RETURN
+
+MOFNAME,.-. /MOVE OUTPUT FILENAME ROUTINE
+ TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
+ JMS CHKNAME /CHECK IF LEGAL
+ DCA FNAME /STASH IT
+ TAD I (OUTFILE+2) /GET SECOND OUTPUT FILENAME WORD
+ JMS CHKNAME /CHECK IF LEGAL
+ DCA FNAME+1 /STASH IT
+ TAD I (OUTFILE+3) /GET THIRD OUTPUT FILENAME WORD
+ JMS CHKNAME /CHECK IF LEGAL
+ DCA FNAME+2 /STASH IT
+ TAD I (OUTFILE+4) /GET FOURTH OUTPUT FILENAME WORD
+ JMS CHKNAME /CHECK IF LEGAL
+ DCA FNAME+3 /STASH IT
+ JMP I MOFNAME /RETURN
+\f/ 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
+\f $ /THAT'S ALL FOLK!
projects / pdp8.git / blobdiff