File: K12ENB.PA of Disk: Disks/PDP8-Net/diag-games-kermit
(Source file text)
/ 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.)
/ 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
/ 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
*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
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
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
/ 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
/ COMES HERE TO TEST FOR NULL LINE.
TSTMORE,TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
SZA CLA /SKIP NO INPUT OR OUTPUT GIVEN
JMP OUTERR /ELSE COMPLAIN
CDF PRGFLD /BACK TO OUR FIELD
JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST
PAGE
ENCODIT,.-. /ENCODING ROUTINE
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
/ 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
/ 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
/ 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
/ 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
PCRLF, .-. /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
PUTBYTE,.-. /OUTPUT A BYTE ROUTINE
SPA /ARE WE INITIALIZING?
JMP PUTINITIALIZE /YES
AND [177] /JUST IN CASE
DCA LATEST /SAVE LATEST CHARACTER
TAD LATEST /GET LATEST CHARACTER
JMP I PUTNEXT /GO WHERE YOU SHOULD GO
PUTNEXT,.-. /EXIT ROUTINE
ISZ PUTBYTE /BUMP TO GOOD RETURN
PUTERRO,CLA CLL /CLEAN UP
JMP I PUTBYTE /RETURN TO MAIN CALLER
PUTINIT,CLA /CLEAN UP
TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
DCA PUTRECORD /STORE IN-LINE
DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
PUTNEWR,TAD (OUTBUFFER) /SETUP THE
DCA BUFPTR /BUFFER POINTER
PUTLOOP,JMS PUTNEXT /GET A CHARACTER
DCA I BUFPTR /STORE IT
TAD BUFPTR /GET POINTER VALUE
DCA TEMPTR /SAVE FOR LATER
ISZ BUFPTR /BUMP TO NEXT
JMS PUTNEXT /GET A CHARACTER
DCA I BUFPTR /STORE IT
JMS PUTNEXT /GET A CHARACTER
RTL;RTL /MOVE UP
AND [7400] /ISOLATE HIGH NYBBLE
TAD I TEMPTR /ADD ON FIRST BYTE
DCA I TEMPTR /STORE COMPOSITE
TAD LATEST /GET LATEST CHARACTER
RTR;RTR;RAR /MOVE UP AND
AND [7400] /ISOLATE LOW NYBBLE
TAD I BUFPTR /ADD ON SECOND BYTE
DCA I BUFPTR /STORE COMPOSITE
ISZ BUFPTR /BUMP TO NEXT
TAD BUFPTR /GET LATEST POINTER VALUE
TAD (-2^200-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
/ 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
/ 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
/ 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
/ 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
$ /THAT'S ALL FOLK!