--- /dev/null
+/ OS/8 DECODING PROGRAM
+
+/ LAST EDIT: 08-JUL-1992 22:00:00 CJL
+
+/ PROGRAM TO DECODE OS/8 FILES FROM "PRINTABLE" ASCII FORMAT TO BINARY-IMAGE
+/ FORMAT. INTERMEDIATE "ASCII" CONVERSION SHOULD BE HARMLESS AS LONG AS ALL
+/ PRINTING DATA CHARACTERS ARE NOT MODIFIED.
+
+/ DISTRIBUTED BY CUCCA AS "K12DEC.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:
+
+/ THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH HAVE BEEN CREATED BY
+/ ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES. THE ENCODING FORMAT ALLOWS
+/ FOR SOME INNOCUOUS CONTENT MODIFICATION SUCH AS EXTRANEOUS WHITE SPACE AND
+/ EXTRA <CR>/<LF> PAIRS, BUT RIGOROUSLY VALIDATES CERTAIN ASPECTS OF THE FORMAT,
+/ SUCH AS A TRAILING CHECKSUM.
+
+/ CERTAIN IMBEDDED COMMANDS ARE USED SUCH AS (REMARK .........) WHICH ALLOWS FOR
+/ COMMENTARY LINES WITHIN THE FILE FOR IDENTIFICATION PURPOSES. THE (FILE ) AND
+/ (END ) COMMANDS CONTAIN THE SUGGESTED FILENAME FOR THE DESCENDANT DECODED
+/ FILE.
+\f/ WHEN CREATING THE DESCENDANT DECODED FILE, THE USER MAY SPECIFY EITHER THE
+/ IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE
+/ OR A SPECIFIED DEVICE:
+
+/ .RUN DEV DECODE INVOKE PROGRAM.
+/ *INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT).
+/ *DEV:OUTPUT.EX<INPUT INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:.
+/ *DEV:<INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:.
+/ *DEV:<INPUT=NNNN/I **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS DECODED
+/ INTO RECORD 0000-[NNNN-1] ON DEVICE DEV:. THE =NNNN
+/ VALUE SHOULD BE CAREFULLY CHOSEN LARGE ENOUGH TO WRITE
+/ ALL DATA RECORDS, BUT NEED NOT BE STATED EXACTLY.
+/ (THE ENCODE PROGRAM REQUIRES PRECISE STATEMENT OF THE
+/ LENGTH IN IMAGE TRANSFER ENCODING MODE. **** NOTE
+/ **** THIS METHOD VIOLATES ALL OS/8 DEVICE STRUCTURE
+/ AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE IMAGES
+/ ONLY; USE WITH CARE!
+/ *DEV:<INPUT=NNNN/I/1 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
+/ IMAGE MODE EXCEPT ONLY THE FIRST HALF OF THE DATA IS
+/ USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
+/ BECAUSE IT IS USED TO CALCULATE THE APPROX. 1/2 VALUE
+/ ACTUALLY USED IN THIS HALF OF THE OVERALL TRANSFER.
+/ THIS MODE SHOULD BE USED WITH FILES CREATED FOR THE
+/ EXPRESS PURPOSE OF TRANSMISSION BY HALVES ONLY; USE
+/ WITH CARE!
+/ *DEV:<INPUT=NNNN/I/2 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
+/ IMAGE MODE EXCEPT ONLY THE SECOND HALF OF THE DATA IS
+/ USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
+/ BECAUSE IT IS USED TO CALCULATE THE STARTING RECORD OF
+/ THE APPROX. 1/2 VALUE ACTUALLY USED IN THIS HALF OF
+/ THE OVERALL TRANSFER. THIS MODE SHOULD BE USED WITH
+/ FILES CREATED FOR THE EXPRESS PURPOSE OF TRANSMISSION
+/ BY HALVES ONLY; USE WITH CARE! 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.EX<INPUT$ INPUT IS DECODED INTO OUTPUT.EX ON DSK: (DEFAULT).
+/ THE <ESC> CHARACTER WAS USED TO TERMINATE THE LINE
+/ (THIS IS SIGNIFIED BY $). THIS CAUSES PROGRAM EXIT.
+/ . PROGRAM EXITS NORMALLY.
+\f/ INPUT FILE ASSUMES .EN EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION.
+/ IMAGE TRANSFER MODE DOESN'T USE OUTPUT FILENAMES, AS THE TRANSFER DESTROYS THE
+/ OS/8 FILE STRUCTURE (POSSIBLY PRESENT) ON THE DEVICE.
+
+/ PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
+/ KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC>
+/ CHARACTER.
+
+/ THIS PROGRAM SUPPORTS A PROPER SUBSET OF THE ASCII ENCODING SCHEME DISCUSSED
+/ 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) SUPPORTS ONLY ONE DECODABLE FILE PER ENCODED FILE.
+
+/ B) IGNORES ALL (END ) COMMANDS.
+
+/ C) <CR> <LF> < ALWAYS INDICATES ENCODED DATA LINES; NO CHECK IS MADE FOR
+/ WHETHER THE > IS ON THE SAME LINE AS THE <.
+
+/ D) PDP-8 GENERATED CHECKSUM DATA MUST BE THE FINAL DATA IN THE FILE IN
+/ THE PROPER FORMAT: ZCCCCCCCCCCCC WHERE CCCCCCCCCCCC IS THE
+/ TWELVE-CHARACTER PDP-8 CHECKSUM DATA.
+
+/ IF THE ENCODED FILE IS PASSED THROUGH ANY INTERMEDIARY PROCESS THAT MODIFIES
+/ THE CONTENTS IN A WAY THAT INTERFERES WITH ANY OF THE ABOVE, THIS DECODING
+/ PROGRAM WILL FAIL. IT IS THE USER'S RESPONSIBILITY TO EDIT OUT UNWANTED
+/ CHANGES TO THE ENCODED FILE. ALL OTHER ASPECTS OF THE PROTOCOL ARE OBEYED,
+/ SUCH AS IMBEDDED <FF>, EXTRA <CR> <LF>, OR TRAILING SPACES HAVE NO EFFECT ON
+/ THE RELIABILITY OF THE DECODING PROCESS, ETC.
+\f/ ERROR MESSAGES.
+
+/ ANY MESSAGE PRINTED IS A FATAL ERROR MESSAGE. ALL 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 TOO MANY OUTPUT FILES.
+
+/ 1 NO INPUT FILE OR TOO MANY INPUT FILES.
+
+/ 2 IMBEDDED OUTPUT FILENAME FORMAT ERROR.
+
+/ 3 I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME.
+
+/ 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 DECODING FILE DATA OR BAD DATA.
+
+/ ASSEMBLY INSTRUCTIONS.
+
+/ IT IS ASSUMED THE SOURCE FILE K12DEC.PAL HAS BEEN MOVED AND RENAMED TO
+/ DSK:DECODE.PA.
+
+/ .PAL DECODE<DECODE ASSEMBLE SOURCE PROGRAM
+/ .LOAD DECODE LOAD THE BINARY FILE
+/ .SAVE DEV DECODE=0 SAVE THE CORE-IMAGE FILE
+\f/ DEFINITIONS.
+
+ CLOSE= 4 /CLOSE OUTPUT FILE
+ 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= 7617 /INPUT FILE INFORMATION HERE
+ INQUIRE=12 /INQUIRE ABOUT HANDLER
+ NL0001= CLA IAC /LOAD AC WITH 0001
+ NL0002= CLA CLL CML RTL /LOAD AC WITH 0002
+ NL4000= CLA CLL CML RAR /LOAD AC WITH 4000
+ 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
+ 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= 7700 /USR ENTRY POINT
+ USRFLD= 10 /USR FIELD
+ 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
+CHKSUM, ZBLOCK 5 /CHECKSUM TEMPORARY
+CHRCNT, .-. /CHARACTER COUNTER
+CSUMTMP,.-. /CHECKSUM TEMPORARY
+DANGCNT,.-. /DANGER COUNT
+DATCNT, .-. /DATA COUNTER
+DSTATE, .-. /DATA STATE VARIABLE
+IDNUMBE,.-. /INPUT DEVICE NUMBER
+IMSW, .-. /IMAGE-MODE SWITCH
+INITFLA,.-. /INITIALIZE INPUT FLAG
+INPUT, .-. /INPUT HANDLER POINTER
+INRECOR,.-. /INPUT RECORD
+FCHKSUM,ZBLOCK 5 /FILE CHECKSUM
+FNAME, ZBLOCK 4 /OUTPUT FILENAME
+GWTMP1, .-. /GETWORD TEMPORARY
+GWTMP2, .-. /GETWORD TEMPORARY
+GWVALUE,.-. /LATEST WORD VALUE
+ODNUMBE,.-. /OUTPUT DEVICE NUMBER
+OUTPUT, .-. /OUTPUT HANDLER POINTER
+OUTRECO,.-. /OUTPUT RECORD
+PUTEMP, .-. /OUTPUT TEMPORARY
+PUTPTR, .-. /OUTPUT POINTER
+THIRD, .-. /THIRD BYTE TEMPORARY
+
+/ STATE TABLE.
+
+P, SCANIT /0000 LOOKING FOR "(" OR "<"
+ FNDCOMMAND /0001 FOUND "(" AND NOW LOOKING FOR ")"
+ FNDCEND /0002 FOUND ")" AND NOW LOOKING FOR <CR>
+ FNDCR /0003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
+ STORDATA /4000 FOUND "<" AND PROCESSING 69 DATA BYTES
+ ENDATA /4001 FOUND 69 DATA BYTES AND NOW LOOKING FOR ">"
+ ENDCR /4002 FOUND ">" AND NOW LOOKING FOR <CR>
+ FNDCR/ENDLF /4003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
+\f PAGE /START AT THE USUAL PLACE
+
+BEGIN, NOP /HERE IN CASE WE'RE CHAINED TO
+ CLA /CLEAN UP
+START, CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ DECODE /WANT COMMAND DECODER
+ "E^100+"N-300 /.EN IS DEFAULT EXTENSION
+ 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 FIRST OUTPUT FILE DEVICE WORD
+ SNA /SKIP IF FIRST OUTPUT FILE PRESENT
+ JMP TSTMORE /JUMP IF NOT THERE
+ AND [17] /JUST DEVICE BITS
+ODNULL, DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER
+ TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD
+ SNA /SKIP IF THERE
+ TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD
+ SZA CLA /SKIP IF BOTH NOT PRESENT
+ JMP I (OUTERR) /ELSE COMPLAIN
+ TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
+ SNA /SKIP IF PRESENT
+ JMP I (INERR) /JUMP IF NOT
+ AND [17] /JUST DEVICE BITS
+ DCA IDNUMBER /SAVE INPUT DEVICE NUMBER
+ TAD I (INFILE+2) /GET SECOND INPUT FILE DEVICE WORD
+ SZA CLA /SKIP IF ONLY ONE INPUT FILE
+ JMP I (INERR) /ELSE COMPLAIN
+ TAD I (INFILE+1) /GET FIRST INPUT FILE STARTING RECORD
+ DCA INRECORD /SET IT UP
+ CDF PRGFLD /BACK TO OUR FIELD
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ RESET /RESET SYSTEM TABLES
+\f 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 I (FERROR) /FETCH ERROR
+ TAD IHPTR /GET RETURNED ADDRESS
+ DCA INPUT /STORE AS INPUT HANDLER ADDRESS
+ JMS I (GEOFILE) /GET OUTPUT FILE INFORMATION
+ 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 I (FERROR) /FETCH ERROR
+ TAD OHPTR /GET RETURNED ADDRESS
+ DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
+ TAD IMSW /GET IMAGE-MODE SWITCH
+ SNA CLA /SKIP IF SET
+ JMP NOIMAGE /JUMP IF NOT
+
+/ IF /2 IS SET, THE DATA STARTS HALF-WAY INTO THE IMAGE. OTHER IMAGE MODES
+/ START AT RECORD 0000.
+
+ CDF TBLFLD /GOTO TABLE FIELD
+ TAD I [SWY9] /GET /Y-/9 SWITCHES
+ AND (200) /JUST /2 SWITCH
+ SNA CLA /SKIP IF SET
+ JMP IMAGE1 /JUMP IF /1 OR NEITHER /1, /2 SET
+ TAD I [EQUWRD] /GET EQUALS PARAMETER
+ CLL RAR /%2
+IMAGE1, DCA OUTRECORD /STORE STARTING OUTPUT RECORD
+ CDF PRGFLD /BACK TO OUR FIELD
+ SKP /DON'T ENTER FILE NAME
+NOIMAGE,JMS I (FENTER) /ENTER THE TENTATIVE FILE NAME
+ DCA DSTATE /SET INITIAL DATA STATE
+ JMS I (CLRCHKSUM) /CLEAR OUT CHECKSUM
+ JMS I (DECODIT) /GO DO THE ACTUAL DECODING
+ JMP I (PROCERR) /ERROR WHILE DECODING
+ TAD IMSW /GET IMAGE-MODE SWITCH
+ SZA CLA /SKIP IF CLEAR
+ JMP EXITZAP /JUMP IF SET
+ 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 I (CLSERR) /CLOSE ERROR
+EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
+ JMP I (SBOOT) /EXIT TO MONITOR
+\f/ COMES HERE TO TEST FOR NULL LINE.
+
+TSTMORE,TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD
+ SNA /SKIP IF PRESENT
+ TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD
+ SZA CLA /SKIP IF NO OUTPUT FILES
+ JMP I (OUTERR) /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT
+ TAD I (INFILE) /GET FIRST OUTPUT FILE DEVICE WORD
+ SZA CLA /SKIP IF NO INPUT FILES
+ JMP ODNULL /JUMP IF INPUT WITHOUT OUTPUT
+ CDF PRGFLD /BACK TO OUR FIELD
+ JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST
+
+ PAGE
+\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
+
+/ I/O ERROR WHILE PROCESSING (FILE ) COMMAND.
+
+NIOERR, IAC /SET INCREMENT
+
+/ FORMAT ERROR WHILE PROCESSING (FILE ) COMMAND.
+
+CHARERR,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
+\fDECODIT,.-. /DECODING ROUTINE
+ TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
+ DCA PUTRECORD /STORE IN-LINE
+ DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
+ NL7777 /SETUP THE
+ DCA INITFLAG /INITIALIZE FLAG
+ TAD (GWLOOP) /INITIALIZE THE
+ DCA I (GWNEXT) /DECODE PACK ROUTINE
+PUTNEWR,TAD POUTBUFFER/(OUTBUFFER) /SETUP THE
+ DCA PUTPTR /OUTPUT BUFFER POINTER
+PUTLOOP,JMS I (GETWORD) /GET A WORD
+ DCA I PUTPTR /STORE IT
+ ISZ PUTPTR /BUMP TO NEXT
+ TAD PUTPTR /GET THE POINTER
+ TAD (-2^200-OUTBUFFER) /COMPARE TO LIMIT
+ SZA CLA /SKIP IF AT END
+ JMP PUTLOOP /KEEP GOING
+ ISZ DANGCNT /TOO MANY RECORDS?
+ SKP /SKIP IF NOT
+ JMP I (SIZERROR) /NOT ENOUGH SPACE AVAILABLE
+ JMS I OUTPUT /CALL OUTPUT HANDLER
+ 2^100+WRITE /WRITE LATEST RECORD
+POUTBUF,OUTBUFFER /OUTPUT BUFFER ADDRESS
+PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
+DECERR, JMP I DECODIT /I/O ERROR
+ ISZ PUTRECORD /BUMP TO NEXT RECORD
+ NOP /JUST IN CASE
+ ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
+ JMP PUTNEWRECORD /GO DO ANOTHER ONE
+
+/ GOOD RETURN HERE.
+
+DECBMP, ISZ DECODIT /BUMP TO GOOD RETURN
+ JMP I DECODIT /RETURN
+\f/ OS/8 FILE UNPACK ROUTINE.
+
+GETBYTE,.-. /GET A BYTE ROUTINE
+ SNA CLA /INITIALIZING?
+ JMP I PUTC /NO, GO GET NEXT BYTE
+ TAD INRECORD /GET STARTING RECORD OF INPUT FILE
+ DCA GETRECORD /STORE IN-LINE
+GETNEWR,JMS I INPUT /CALL I/O HANDLER
+ 2^100 /READ TWO PAGES INTO BUFFER
+ INBUFFER /BUFFER ADDRESS
+GETRECO,.-. /WILL BE LATEST RECORD NUMBER
+ JMP I GETBYTE /INPUT ERROR!
+ TAD (INBUFFER) /SETUP THE
+ DCA BUFPTR /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 BUFPTR /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
+ JMP GETNEWRECORD /GO DO ANOTHER ONE
+
+PUTONE, .-. /SEND BACK A BYTE ROUTINE
+ TAD I BUFPTR /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 BUFPTR /GET LATEST WORD AGAIN
+ JMS PUTC /SEND BACK CURRENT BYTE
+ ISZ BUFPTR /BUMP TO NEXT WORD
+ JMP I PUTONE /RETURN
+
+PUTC, .-. /SEND BACK LATEST BYTE ROUTINE
+ AND (177) /KEEP ONLY GOOD BITS
+ TAD (-"Z!300) /COMPARE TO <^Z>
+ SNA /SKIP IF NOT ASCII <EOF>
+ JMP GETEOF /JUMP IF ASCII MODE <EOF>
+ TAD ("Z&37) /RESTORE THE CHARACTER
+ ISZ GETBYTE /BUMP PAST <EOF> RETURN
+GETEOF, ISZ GETBYTE /BUMP PAST I/O ERROR RETURN
+ JMP I GETBYTE /RETURN TO MAIN CALLER
+\f PAGE
+\f/ GET A DECODED WORD ROUTINE.
+
+GETWORD,.-. /GET A WORD ROUTINE
+ JMP I GWNEXT /GO WHERE YOU SHOULD GO
+
+GWNEXT, .-. /EXIT ROUTINE
+ SNL /SKIP IF CHECKSUM PREVENTED
+ JMS I (DOCHECK) /ELSE DO CHECKSUM
+ JMP I GETWORD /RETURN TO MAIN CALLER
+
+/ COMES HERE TO PROCESSED COMPRESSED DATA.
+
+GWX, JMS I (GETCHR) /GET NEXT CHARACTER
+ JMS I (GWORD0) /GET 12-BIT WORD
+ JMS I (DOCHECK) /INCLUDE IN CHECKSUM
+ DCA GWVALUE /SAVE AS COMPRESSED VALUE
+ TAD GWTMP2 /GET LATEST CHARACTER
+ AND [7] /ISOLATE BITS[9-11]
+ CLL RTR;RTR /BITS[9-11] => AC[0-2]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS GBIHEXBINARY /GET A CHARACTER
+ CLL RTL;RTL /BITS[7-11] => AC[3-7]
+ TAD GWTMP1 /ADD ON BITS[0-2]
+ JMS I (DOCHECK) /INCLUDE IN CHECKSUM
+ CLL RTR;RTR /BITS[0-7] => AC[4-11]
+ SNA /SKIP IF NOT 256
+ TAD [400] /000 => 256
+ CIA /INVERT FOR COUNTING
+ DCA GWTMP1 /SAVE AS REPEAT COUNTER
+GWXLUP, TAD GWVALUE /GET THE VALUE
+ STL /PREVENT CHECKSUMMING IT
+ JMS GWNEXT /RETURN IT TO THEM
+ ISZ GWTMP1 /DONE ENOUGH?
+ JMP GWXLUP /NO, KEEP GOING
+\f/ COMES HERE TO INITIATE ANOTHER DATA GROUP.
+
+GWLOOP, JMS I (GETCHR) /GET LATEST FILE CHARACTER
+ TAD (-"Z!200) /COMPARE TO EOF INDICATOR
+ SNA /SKIP IF OTHER
+ JMP GWZ /JUMP IF IT MATCHES
+ TAD (-"X+"Z) /COMPARE TO COMPRESSION INDICATOR
+ SNA CLA /SKIP IF OTHER
+ JMP GWX /JUMP IF IT MATCHES
+ TAD PUTEMP /GET THE CHARACTER BACK
+ JMS I (GWORD0) /GET A 12-BIT WORD
+ JMS GWNEXT /RETURN IT
+ JMS I (GWORD1) /GET NEXT 12-BIT WORD
+ JMS GWNEXT /RETURN IT
+ JMS I (GWORD2) /GET NEXT 12-BIT WORD
+ JMS GWNEXT /RETURN IT
+ JMS I (GWORD3) /GET NEXT 12-BIT WORD
+ JMS GWNEXT /RETURN IT
+ JMS I (GWORD4) /GET NEXT 12-BIT WORD
+ JMS GWNEXT /RETURN IT
+ JMP GWLOOP /KEEP GOING
+
+/ COMES HERE WHEN EOF INDICATOR FOUND.
+
+GWZ, TAD (FCHKSUM-1) /SETUP THE
+ DCA XR1 /CHECKSUM POINTER
+ JMS I (GETCHR) /GET NEXT CHARACTER
+ JMS I (GWORD0) /GET A 12-BIT WORD
+ DCA I XR1 /STORE IT
+ JMS I (GWORD1) /GET NEXT WORD
+ DCA I XR1 /STORE IT
+ JMS I (GWORD2) /GET NEXT WORD
+ DCA I XR1 /STORE IT
+ JMS I (GWORD3) /GET NEXT WORD
+ DCA I XR1 /STORE IT
+ JMS I (GWORD4) /GET NEXT WORD
+ DCA I XR1 /STORE IT
+ TAD (CHKSUM-1) /POINT TO
+ DCA XR1 /CALCULATED CHECKSUM
+ TAD (FCHKSUM-1) /POINT TO
+ DCA XR2 /FILE CHECKSUM
+ TAD [-5] /SETUP THE
+ DCA CCNT /COMPARE COUNT
+ CLL /CLEAR LINK FOR TEST
+GWCMPLP,RAL /GET CARRY
+ TAD I XR1 /GET A CALCULATED WORD
+ TAD I XR2 /COMPARE TO FILE WORD
+ SZA CLA /SKIP IF OK
+ JMP I (DECERR) /ELSE COMPLAIN
+ ISZ CCNT /DONE ALL?
+ JMP GWCMPLP /NO, KEEP GOING
+\f/ THE CHECKSUM IS OK, CHECK IF FILE ENDED IN A PLAUSIBLE PLACE.
+
+ TAD PUTPTR /GET OUTPUT POINTER
+ TAD (-OUTBUFFER-4) /COMPARE TO LIMIT
+ SMA SZA CLA /SKIP IF GOOD VALUE
+ JMP I (DECERROR) /JUMP IF NOT
+
+/ THE FILE ENDED OK, THERE WERE POSSIBLY A FEW CHARACTERS LEFTOVER BECAUSE OF
+/ ALIGNMENT CONSIDERATIONS. THEY SHOULD BE IGNORED SINCE OS/8 FILES ARE
+/ MULTIPLES OF WHOLE RECORDS.
+
+ JMP I (DECBMP) /RETURN WITH ALL OK
+
+GBIHEXB,.-. /GET BINARY VALUE OF BIHEXADECIMAL CHARACTER
+ CLA /CLEAN UP
+ TAD GBIHEXBINARY /GET OUR CALLER
+ DCA BIHEXBINARY /MAKE IT THEIRS
+ JMS I (GETCHR) /GET A CHARACTER
+ SKP /DON'T EXECUTE HEADER!
+
+BIHEXBI,.-. /CONVERT BIHEXADECIMAL TO BINARY
+ TAD (-"A!200) /COMPARE TO ALPHABETIC LIMIT
+ SMA /SKIP IF LESS
+ TAD ("9+1-"A) /ELSE ADD ON ALPHABETIC OFFSET
+ TAD (-"0+"A) /MAKE IT BINARY, NOT ASCII
+ DCA GWTMP2 /SAVE IT
+ TAD GWTMP2 /GET IT BACK
+ JMP I BIHEXBINARY /RETURN
+
+ PAGE
+\f/ GET WORD[0] ROUTINE. AC MUST ALREADY CONTAIN THE FIRST BI-HEXADECIMAL
+/ CHARACTER.
+
+GWORD0, .-. /GET 12-BIT WORD[0]
+ JMS I (BIHEXBINARY) /CONVERT PASSED VALUE TO BINARY
+ CLL RTR;RTR;RTR /BITS[7-11] => AC[0-4]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ CLL RTL /BITS[7-11] => AC[5-9]
+ TAD GWTMP1 /ADD ON BITS[0-4]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ RTR;RAR /BITS[7-8] => AC[10-11]
+ AND [3] /ISOLATE BITS[10-11]
+ TAD GWTMP1 /ADD ON BITS[0-9]
+ CLL /CLEAR LINK
+ JMP I GWORD0 /RETURN
+
+/ GET WORD[1] ROUTINE. GWORD0 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
+/ THE PREVIOUS CHARACTER.
+
+GWORD1, .-. /GET 12-BIT WORD[1]
+ TAD GWTMP2 /GET PREVIOUS CHARACTER
+ AND [7] /ISOLATE BITS[9-11]
+ CLL RTR;RTR /BITS[9-11] => AC[0-2]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ CLL RTL;RTL /BITS[7-11] => AC[3-7]
+ TAD GWTMP1 /ADD ON BITS[0-2]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ CLL RAR /BITS[7-10] => AC[8-11]
+ TAD GWTMP1 /ADD ON BITS[0-7]
+ CLL /CLEAR LINK
+ JMP I GWORD1 /RETURN
+\f/ GET WORD[2] ROUTINE. GWORD1 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
+/ THE PREVIOUS CHARACTER.
+
+GWORD2, .-. /GET 12-BIT WORD[2]
+ TAD GWTMP2 /GET PREVIOUS CHARACTER
+ RAR;CLA RAR /BIT[11] => AC[0]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ CLL RTL;RTL;RTL /BITS[7-11] => AC[1-5]
+ TAD GWTMP1 /ADD ON BIT[0]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ CLL RAL /BITS[7-11] => AC[6-10]
+ TAD GWTMP1 /ADD ON BITS[0-5]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ AND (20) /ISOLATE BIT[7]
+ CLL RTR;RTR /BIT[7] => AC[11]
+ TAD GWTMP1 /ADD ON BITS[0-10]
+ CLL /CLEAR LINK
+ JMP I GWORD2 /RETURN
+
+/ GET WORD[3] ROUTINE. GWORD2 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
+/ THE PREVIOUS CHARACTER.
+
+GWORD3, .-. /GET 12-BIT WORD[3]
+ TAD GWTMP2 /GET PREVIOUS CHARACTER
+ CLL RTR;RTR;RAR /BITS[8-11] => AC[0-3]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ CLL RTL;RAL /BITS[7-11] => AC[4-8]
+ TAD GWTMP1 /ADD ON BITS[0-3]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ RTR /BITS[7-9] => AC[9-11]
+ AND [7] /ISOLATE BITS[9-11]
+ TAD GWTMP1 /ADD ON BITS[0-8]
+ CLL /CLEAR LINK
+ JMP I GWORD3 /RETURN
+\f/ GET WORD[4] ROUTINE. GWORD3 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
+/ THE PREVIOUS CHARACTER.
+
+GWORD4, .-. /GET 12-BIT WORD[4]
+ TAD GWTMP2 /GET PREVIOUS CHARACTER
+ AND [3] /ISOLATE BITS[10-11]
+ CLL RTR;RAR /BITS[10-11] => AC[0-1]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ CLL RTL;RTL;RAL /BITS[7-11] => AC[2-6]
+ TAD GWTMP1 /ADD ON BITS[0-1]
+ DCA GWTMP1 /SAVE FOR NOW
+ JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
+ TAD GWTMP1 /ADD ON BITS[0-6] TO BITS[7-11]
+ CLL /CLEAR LINK
+ JMP I GWORD4 /RETURN
+
+DOCHECK,.-. /CHECKSUM ROUTINE
+ DCA CSUMTMP /SAVE PASSED VALUE
+ TAD (CHKSUM-1) /SETUP THE
+ DCA XR1 /INPUT POINTER
+ TAD (CHKSUM-1) /SETUP THE
+ DCA XR2 /OUTPUT POINTER
+ TAD [-5] /SETUP THE
+ DCA CCNT /SUM COUNT
+ TAD CSUMTMP /GET THE VALUE
+ CLL RAR /ADJUST FOR OPENING ITERATION
+CSUMLUP,RAL /GET CARRY
+ TAD I XR1 /ADD ON A WORD
+ DCA I XR2 /STORE BACK
+ ISZ CCNT /DONE ALL YET?
+ JMP CSUMLUP /NO, KEEP GOING
+ TAD CSUMTMP /GET LATEST VALUE
+ JMP I DOCHECK /RETURN
+
+ PAGE
+\fGETCHR, .-. /GET A VALID CHARACTER ROUTINE
+GETMORE,TAD INITFLAG /GET INITIALIZE FLAG
+ JMS I [GETBYTE] /GET A CHARACTER
+ JMP I (DECERR) /I/O ERROR
+ JMP I (DECERR) /<EOF>
+ DCA PUTEMP /SAVE THE CHARACTER
+ DCA INITFLAG /CLEAR INITIALIZE FLAG
+ TAD DSTATE /GET DATA STATE
+ SPA /SKIP IF NOT ONE OF THE DATA-ORIENTED STATES
+ TAD (4004) /ADD ON DATA-ORIENTED STATES OFFSET
+ TAD (JMP I P) /SETUP JUMP INSTRUCTION
+ DCA .+1 /STORE IN-LINE
+ .-. /AND EXECUTE IT
+
+/ LOOKING FOR OPENING CHARACTER.
+
+SCANIT, TAD PUTEMP /GET THE CHARACTER
+ TAD (-"<!200) /COMPARE TO OPENING DATA CHARACTER
+ SNA /SKIP IF NO MATCH
+ JMP FNDATA /JUMP IF IT MATCHES
+ TAD (-"(+"<) /COMPARE TO OPENING COMMAND CHARACTER
+ SNA CLA /SKIP IF NO MATCH
+ ISZ DSTATE /INDICATE LOOKING FOR END OF COMMAND
+ JMP GETMORE /KEEP GOING
+
+/ FOUND OPENING COMMAND CHARACTER.
+
+FNDCOMM,TAD PUTEMP /GET THE CHARACTER
+ TAD (-")!200) /COMPARE TO CLOSING COMMAND CHARACTER
+ SNA CLA /SKIP IF NO MATCH
+ ISZ DSTATE /INDICATE LOOKING FOR <CR>
+ JMP GETMORE /KEEP GOING
+
+/ FOUND CLOSING COMMAND CHARACTER.
+
+FNDCEND,TAD PUTEMP /GET THE CHARACTER
+ TAD (-"M!300) /COMPARE TO <CR>
+ SNA CLA /SKIP IF NO MATCH
+ ISZ DSTATE /INDICATE LOOKING FOR <LF>
+ JMP GETMORE /KEEP GOING
+
+/ FOUND <CR> AFTER COMMAND.
+
+FNDCR, TAD PUTEMP /GET THE CHARACTER
+ TAD (-"J!300) /COMPARE TO <LF>
+ SNA CLA /SKIP IF NO MATCH
+ DCA DSTATE /RESET TO SCANNING STATE
+ JMP GETMORE /KEEP GOING
+\f/ FOUND OPENING DATA CHARACTER.
+
+FNDATA, TAD (-WIDTH) /SETUP THE
+ DCA DATCNT /DATA COUNTER
+ NL4000 /SETUP THE
+ DCA DSTATE /NEW STATE
+ JMP GETMORE /KEEP GOING
+
+/ PROCESSING ONE OF 69 DATA CHARACTERS.
+
+STORDAT,TAD PUTEMP /GET THE CHARACTER
+ TAD [-140] /SUBTRACT UPPER-CASE LIMIT
+ SPA /SKIP IF LOWER-CASE
+ TAD [40] /RESTORE UPPER-CASE
+ TAD (100) /RESTORE THE CHARACTER
+ DCA PUTEMP /SAVE IT BACK
+ TAD PUTEMP /GET IT AGAIN
+ TAD (-"Z!200-1) /SUBTRACT UPPER LIMIT
+ CLL /CLEAR LINK FOR TEST
+ TAD ("Z-"A+1) /ADD ON RANGE
+ SZL CLA /SKIP IF NOT ALPHABETIC
+ JMP ALPHAOK /JUMP IF ALPHABETIC
+ TAD PUTEMP /GET THE CHARACTER
+ TAD (-"9!200-1) /ADD ON UPPER LIMIT
+ CLL /CLEAR LINK FOR TEST
+ TAD ("9-"0+1) /ADD ON RANGE
+ SNL CLA /SKIP IF OK
+ JMP GETMORE /IGNORE IF NOT
+ALPHAOK,TAD PUTEMP /GET THE CHARACTER
+ ISZ DATCNT /DONE 69 CHARACTERS?
+ SKP /SKIP IF NOT
+ ISZ DSTATE /ADVANCE TO NEXT STATE
+ JMP I GETCHR /RETURN
+
+/ PROCESSED 69 DATA CHARACTERS; NOW LOOKING FOR ENDING DATA CHARACTER.
+
+ENDATA, TAD PUTEMP /GET THE CHARACTER
+ TAD (-">!200) /COMPARE TO ENDING DATA VALUE
+ SNA CLA /SKIP IF NO MATCH
+ ISZ DSTATE /ELSE ADVANCE TO NEXT STATE
+ JMP GETMORE /KEEP GOING
+
+/ FOUND ENDING DATA CHARACTER; NOW LOOKING FOR <CR>.
+
+ENDCR, TAD PUTEMP /GET THE CHARACTER
+ TAD (-"M!300) /COMPARE TO <CR>
+ SNA CLA /SKIP IF NO MATCH
+ ISZ DSTATE /ELSE ADVANCE TO NEXT STATE
+ JMP GETMORE /KEEP GOING
+\f/ FOUND ENDING DATA CHARACTER AND <CR>; NOW LOOKING FOR <LF>.
+
+/ENDLF, TAD PUTEMP /GET THE CHARACTER
+/ TAD (-"J!300) /COMPARE TO <LF>
+/ SNA CLA /SKIP IF NO MATCH
+/ DCA DSTATE /RESET TO SCANNING STATE
+/ JMP GETMORE /KEEP GOING
+
+CLRCHKS,.-. /CLEAR CALCULATED CHECKSUM ROUTINE
+ DCA CHKSUM+0 /CLEAR LOW-ORDER
+ DCA CHKSUM+1 /CLEAR NEXT
+ DCA CHKSUM+2 /CLEAR NEXT
+ DCA CHKSUM+3 /CLEAR NEXT
+ DCA CHKSUM+4 /CLEAR HIGH-ORDER
+ JMP I CLRCHKSUM /RETURN
+
+ PAGE
+\fGEOFILE,.-. /GET OUTPUT FILE ROUTINE
+ TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
+ SZA CLA /SKIP IF NOT ESTABLISHED YET
+ JMP GOTOD /JUMP IF DETERMINED ALREADY
+ TAD ("D^100+"S-300) /GET BEGINNING OF "DSK"
+ DCA DEVNAME /STORE IN-LINE
+ TAD ("K^100) /GET REST OF "DSK"
+ DCA DEVNAME+1 /STORE IN-LINE
+ DCA RETVAL /CLEAR HANDLER ENTRY WORD
+ CDF PRGFLD /INDICATE OUR FIELD
+ CIF USRFLD /GOTO USR FIELD
+ JMS I [USR] /CALL USR ROUTINE
+ INQUIRE /INQUIRE ABOUT HANDLER
+DEVNAME,ZBLOCK 2 /WILL BE DEVICE DSK
+RETVAL, .-. /BECOMES HANDLER ENTRY POINT WORD
+ HLT /DSK: NOT IN SYSTEM IS IMPOSSIBLE!
+ TAD DEVNAME+1 /GET DEVICE NUMBER FOR DSK:
+ AND [17] /JUST DEVICE BITS
+ DCA ODNUMBER /STORE OUTPUT DEVICE
+GOTOD, CDF TBLFLD /BACK TO TABLE FIELD
+ TAD I (OUTFILE+1) /GET OUTPUT FILE FIRST NAME WORD
+ SNA /SKIP IF PRESENT
+ JMP GFLNAME /JUMP IF NOT
+ DCA FNAME /MOVE TO OUR AREA
+ TAD I (OUTFILE+2) /GET SECOND NAME WORD
+ DCA FNAME+1 /MOVE IT
+ TAD I (OUTFILE+3) /GET THIRD NAME WORD
+ DCA FNAME+2 /MOVE IT
+ TAD I (OUTFILE+4) /GET EXTENSION WORD
+ DCA FNAME+3 /MOVE IT
+GEOFXIT,CDF PRGFLD /BACK TO OUR FIELD
+ JMP I GEOFILE /RETURN
+
+/ WE MUST TAKE THE FILENAME FROM THE IMBEDDED (FILE ) COMMAND. THE ONLY
+/ EXCEPTION IS IF WE ARE DOING AN IMAGE TRANSFER.
+
+GFLNAME,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 SET TO SOMETHING
+ JMP DOFLNAME /JUMP IF PARAMETERS NOT SET
+ CMA /INVERT IT
+ DCA DANGCNT /STORE AS DANGER COUNT
+ ISZ IMSW /SET IMAGE-MODE SWITCH
+ TAD I [SWY9] /GET /Y-/9 SWITCHES
+ AND (600) /JUST /1, /2 SWITCHES
+ SNA /SKIP IF EITHER SET
+ JMP GEOFXIT /JUMP IF NEITHER SET
+ AND [400] /JUST /1 SWITCH
+ SNA CLA /SKIP IF /1 SET
+ JMP IM2 /JUMP IF /2 SET
+ TAD I [EQUWRD] /GET EQUALS PARAMETER
+ CLL RAR /%2
+ JMP IMCOMMON /CONTINUE THERE
+\fIM2, TAD I [EQUWRD] /GET EQUALS PARAMETER
+ CLL RAR /%2
+ CIA /SUBTRACT PART 1 VALUE
+ TAD I [EQUWRD] /FROM EQUALS PARAMETER
+IMCOMMO,CMA /INVERT IT
+ DCA DANGCNT /STORE AS DANGER COUNT
+ JMP GEOFXIT /EXIT THERE
+
+DOFLNAM,CDF PRGFLD /BACK TO OUR FIELD
+ NL7777 /SETUP THE
+ DCA INITFLAG /INPUT FILE INITIALIZATION
+ JMS I (SCNFILE) /SCAN OFF "(FILE"
+
+/ HAVING FOUND THE (FILE ) COMMAND, WE MUST FIND THE FILENAME.
+
+/ ZERO OUT THE FILENAME AREA.
+
+ TAD (-10) /SETUP THE
+ DCA CHRCNT /CLEAR COUNTER
+ TAD (ONAME-1) /SETUP THE
+ DCA XR1 /POINTER
+ JMS I (CLRNAME) /CLEAR THE NAME BUFFER
+
+/ SETUP FOR SCANNING THE NAME PORTION.
+
+ TAD (-6) /SETUP THE
+ DCA CHRCNT /SCAN COUNT
+ TAD (ONAME-1) /SETUP THE
+ DCA XR1 /POINTER
+FNCAGN, JMS I (GETAN) /GET A CHARACTER
+ JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD
+ DCA I XR1 /STASH THE CHARACTER
+ ISZ CHRCNT /DONE ALL YET?
+ JMP FNCAGN /NO, KEEP GOING
+
+/ THROW AWAY EXTRA NAME CHARACTERS.
+
+TOSSNAM,JMS I (GETAN) /GET A CHARACTER
+ JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD
+ JMP TOSSNAME /KEEP GOING
+
+/ COMES HERE AFTER "." FOUND.
+
+GOTSEPA,JMS I (CLRNAME) /CLEAR OUT THE REMAINING NAME FIELD
+ NL7776 /SETUP THE
+ DCA CHRCNT /SCAN COUNT
+EXCAGN, JMS I (GETAN) /GET A CHARACTER
+ JMP I [CHARERROR] /GOT "."; COMPLAIN
+ DCA I XR1 /STASH THE CHARACTER
+ ISZ CHRCNT /DONE ENOUGH YET?
+ JMP EXCAGN /NO, KEEP GOING
+\f/ TOSS ANY EXTRA EXTENSION CHARACTERS.
+
+TOSSEXT,JMS I (GETAN) /GET A CHARACTER
+ JMP I [CHARERROR] /GOT "."; COMPLAIN
+ JMP TOSSEXTENSION /KEEP GOING
+
+/ COMES HERE WHEN TRAILING ")" IS FOUND.
+
+GOTRPAR,JMS I (CLRNAME) /CLEAR ANY REMAINING EXTENSION CHARACTERS
+ TAD I (ONAME) /GET THE FIRST CHARACTER
+ SNA CLA /SKIP IF SOMETHING THERE
+ JMP I [CHARERROR] /COMPLAIN IF NONE THERE
+ TAD (ONAME-1) /SETUP POINTER
+ DCA XR1 /TO NAME CHARACTERS
+ TAD (FNAME-1) /SETUP POINTER
+ DCA XR2 /TO PACKED NAME AREA
+ TAD (-4) /SETUP THE
+ DCA CHRCNT /MOVE COUNT
+CHRLOOP,TAD I XR1 /GET FIRST CHARACTER
+ CLL RTL;RTL;RTL /MOVE UP
+ TAD I XR1 /ADD ON SECOND CHARACTER
+ DCA I XR2 /STORE THE PAIR
+ ISZ CHRCNT /DONE YET?
+ JMP CHRLOOP /NO, KEEP GOING
+ JMP I GEOFILE /YES, RETURN
+
+ PAGE
+\fSCNFILE,.-. /SCAN "(FILE" ROUTINE
+MATAGN, JMS GETNSPC /GET A CHARACTER
+ TAD (-"(!200) /COMPARE TO "("
+ SZA CLA /SKIP IF IT MATCHES
+ JMP MATAGN /JUMP IF NOT
+ JMS GETNSPC /GET NEXT CHARACTER
+ TAD (-"F!300) /COMPARE TO "F"
+ SZA CLA /SKIP IF IT MATCHES
+ JMP MATAGN /JUMP IF NOT
+ JMS GETNSPC /GET NEXT CHARACTER
+ TAD (-"I!300) /COMPARE TO "I"
+ SZA CLA /SKIP IF IT MATCHES
+ JMP MATAGN /JUMP IF NOT
+ JMS GETNSPC /GET NEXT CHARACTER
+ TAD (-"L!300) /COMPARE TO "L"
+ SZA CLA /SKIP IF IT MATCHES
+ JMP MATAGN /JUMP IF NOT
+ JMS GETNSPC /GET NEXT CHARACTER
+ TAD (-"E!300) /COMPARE TO "E"
+ SZA CLA /SKIP IF IT MATCHES
+ JMP MATAGN /JUMP IF NOT
+ JMP I SCNFILE /RETURN
+
+CLRNAME,.-. /NAME FIELD CLEARING ROUTINE
+ TAD CHRCNT /GET CHARACTER COUNTER
+ SNA CLA /SKIP IF ANY TO CLEAR
+ JMP I CLRNAME /ELSE JUST RETURN
+ DCA I XR1 /CLEAR A NAME WORD
+ ISZ CHRCNT /COUNT IT
+ JMP .-2 /KEEP GOING
+ JMP I CLRNAME /RETURN
+
+GETNSPC,.-. /GET NON-<SPACE> CHARACTER
+GETNAGN,JMS GETCHAR /GET A CHARACTER
+ TAD (-" !200) /COMPARE TO <SPACE>
+ SNA CLA /SKIP IF OTHER
+ JMP GETNAGN /JUMP IF IT MATCHES
+ TAD PUTEMP /GET THE CHARACTER BACK
+ JMP I GETNSPC /RETURN
+
+GETCHAR,.-. /GET A CHARACTER ROUTINE
+ CLA /CLEAN UP
+ TAD INITFLAG /GET INITIALIZE FLAG
+ JMS I [GETBYTE] /GET A CHARACTER
+ JMP I (NIOERROR) /COMPLAIN IF AN ERROR
+ JMP I [CHARERROR] /COMPLAIN IF <EOF> REACHED
+ TAD [-140] /COMPARE TO LOWER-CASE LIMIT
+ SPA /SKIP IF LOWER-CASE
+ TAD [40] /RESTORE ORIGINAL IF UPPER-CASE
+ AND (77) /JUST SIX-BIT
+ DCA PUTEMP /SAVE IN CASE WE NEED IT
+ DCA INITFLAG /CLEAR INITIALIZE FLAG
+ TAD PUTEMP /GET IT BACK
+ JMP I GETCHAR /RETURN
+\fGETAN, .-. /GET ALPHANUMERIC ROUTINE
+ JMS GETNSPC /GET A NON-<SPACE> CHARACTER
+ TAD (-".!200) /COMPARE TO "."
+ SNA /SKIP IF OTHER
+ JMP I GETAN /TAKE FIRST RETURN IF IT MATCHES
+ TAD (-")+".) /COMPARE TO ")"
+ SNA /SKIP IF OTHER
+ JMP I (GOTRPAREN) /TAKE DEDICATED RETURN IF IT MATCHES
+ TAD (-":+")) /SUBTRACT UPPER LIMIT
+ CLL /CLEAR LINK FOR TEST
+ TAD (":-"0) /ADD ON RANGE
+ SZL CLA /SKIP IF NOT NUMERIC
+ JMP GETANOK /JUMP IF NUMERIC
+ TAD PUTEMP /GET THE CHARACTER BACK
+ TAD (-"[!300) /SUBTRACT UPPER LIMIT
+ CLL /CLEAR LINK FOR TEST
+ TAD ("[-"A) /ADD ON RANGE
+ SNL CLA /SKIP IF ALPHABETIC
+ JMP I [CHARERROR] /ELSE COMPLAIN
+GETANOK,TAD PUTEMP /GET GOOD ALPHANUMERIC CHARACTER
+ ISZ GETAN /BUMP TO SKIP RETURN
+ JMP I GETAN /RETURN
+
+ONAME, ZBLOCK 10 /OUTPUT NAME FIELD
+
+FENTER, .-. /FILE ENTER ROUTINE
+ 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 I (ENTERR) /ENTER ERROR
+ TAD ENTAR2 /GET RETURNED EMPTY LENGTH
+ IAC /ADD 2-1 FOR OS/278 CRAZINESS
+ DCA DANGCNT /STORE AS DANGER COUNT
+ TAD ENTAR1 /GET RETURNED FIRST RECORD
+ DCA OUTRECORD /SETUP OUTPUT RECORD
+ JMP I FENTER /RETURN
+\f PAGE
+
+ $ /THAT'S ALL FOLK!
projects / pdp8.git / blobdiff