--- /dev/null
+/ OS/8 BOO DECODING PROGRAM
+
+/ LAST EDIT: 22-OCT-1991 12:00:00 CJL
+
+/ MAY BE ASSEMBLED WITH '/F' SWITCH SET.
+
+/ PROGRAM TO DECODE OS/8 FILES FROM "PRINTABLE" ASCII (".BOO") 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 "K12DEB.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 CERTAIN "WHITE SPACE" MODIFICATIONS SUCH AS LINE WIDTH REFORMATTING AS
+/ LONG AS ALL PRINTING CHARACTERS ARE UNMODIFIED. EXTRANEOUS <CR>/<LF> PAIRS
+/ AND ALL OTHER CONTROL CHARACTERS (<FF>, <VT>, ETC.) ARE IGNORED.
+
+/ 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 DEBOO 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:.
+/ *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.
+
+/ INPUT FILE ASSUMES .BO 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.
+\f/ .BOO FORMAT IMPLEMENTATION DESCRIPTION.
+
+/ THIS PROGRAM SUPPORTS STANDARD .BOO FORMAT ENCODED FILES AND OPTIONALLY THE
+/ USE OF LENGTH CORRECTION BYTES AT THE FILE'S END TO ENSURE PROPER LENGTH. IF
+/ NO LENGTH CORRECTION FIELDS ARE FOUND, IT IS ASSUMED THEY AREN'T NEEDED; IT
+/ IS THE RESPONIBILITY OF THE ENCODER TO INSERT THESE FIELDS IF NECESSARY. OS/8
+/ FILES PROPERLY ENCODED BY THE COMPANION ENBOO-ING PROGRAM (ENBOO AKA K12ENB)
+/ WILL CONTAIN SUCH BYTES AS NECESSARY, AND WILL BE PROPERLY DECODED INTO THEIR
+/ ORIGINAL FORM WITHOUT LOSS. ALL OTHER FILES WILL BE <NUL>-PADDED AS NECESSARY
+/ TO ROUND-UP THE FILE SIZE TO A NUMBER OF COMPLETE OS/8 RECORDS; THEIR
+/ ORIGINAL LENGTH WILL BE LOST.
+
+/ **** WARNING **** USE OF ENBOO-ING PROGRAMS NOT COMPATIBLE WITH THE OPTIONAL
+/ LENGTH CORRECTION SCHEME CAN PRODUCE FILES DRASTICALLY DIFFERENT FROM THE
+/ ORIGINAL; AN ENTIRE OS/8 RECORD CONTAINING <NUL> CHARACTERS COULD BE APPENDED
+/ TO THE END OF THE FILES. BEYOND THE WASTE OF DISK SPACE, THESE DEFECTIVE
+/ FILES COULD ACTUALLY BE DANGEROUS TO USE UNDER OS/8.
+
+/ ORDINARILY THESE FILES SHOULDN'T EXIST, BUT COULD BE CREATED BY METHODS SUCH
+/ AS DECODING ON OTHER SYSTEMS FOLLOWED BY USE OF ENCODERS INCOMPATIBLE WITH THE
+/ LENGTH CORRECTION SCHEME. THIS TENDS TO MAKE THE FILE SIZE WRONG BY ONE OR
+/ TWO BYTES, WHICH WHEN DECODED HERE WILL CAUSE THE CREATION OF AN ENTIRE
+/ ERRONEOUS RECORD. IT IS RECOMMENDED THAT FILES STORED ON OTHER SYSTEMS FOR
+/ EVENTUALLY DELIVERY TO OS/8 SYSTEMS BE MAINTAINED IN .BOO FORMAT TO PREVENT
+/ THIS FORM OF FILE CORRUPTION.
+
+/ 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.
+
+/ 9 OUTPUT ERROR WHILE DECODING FILE DATA.
+\f/ ASSEMBLY INSTRUCTIONS.
+
+/ IT IS ASSUMED THE SOURCE FILE K12DEB.PAL HAS BEEN MOVED AND RENAMED TO
+/ DSK:DEBOO.PA.
+
+/ .PAL DEBOO<DEBOO/E/F ASSEMBLE SOURCE PROGRAM
+/ .LOAD DEBOO LOAD THE BINARY FILE
+/ .SAVE DEV DEBOO=0 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= 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
+ 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= 7700 /USR ENTRY POINT
+ USRFLD= 10 /USR FIELD
+ 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, .-. /INPUT BUFFER POINTER
+BYTES, ZBLOCK 3 /DATA BYTES
+CHRCNT, .-. /CHARACTER COUNTER
+CMPCNT, .-. /COMPRESSION COUNTER
+DANGCNT,.-. /DANGER COUNT
+DATCNT, .-. /DATA COUNTER
+IDNUMBE,.-. /INPUT DEVICE NUMBER
+INPUT, .-. /INPUT HANDLER POINTER
+INRECOR,.-. /INPUT RECORD
+FNAME, ZBLOCK 4 /OUTPUT FILENAME
+GETBERR,.-. /ERROR ROUTINE POINTER FOR GETBYTE ROUTINE
+LATEST, .-. /LATEST OUTPUT BYTE
+ODNUMBE,.-. /OUTPUT DEVICE NUMBER
+ONAME, ZBLOCK 10 /OUTPUT NAME FIELD
+OUTPUT, .-. /OUTPUT HANDLER POINTER
+OUTRECO,.-. /OUTPUT RECORD
+PUTEMP, .-. /INPUT TEMPORARY
+PUTPTR, .-. /OUTPUT POINTER
+TEMPTR, .-. /TERMPORARY OUTPUT POINTER
+THIRD, .-. /THIRD BYTE TEMPORARY
+
+\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
+ "B^100+"O-300 /.BO 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
+ 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 OUTERR /ELSE COMPLAIN
+ 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+2) /GET SECOND INPUT FILE DEVICE WORD
+ SZA CLA /SKIP IF ONLY ONE INPUT FILE
+ JMP 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 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 FERROR /FETCH ERROR
+ TAD OHPTR /GET RETURNED ADDRESS
+ DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
+ 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 (DECODIT) /GO DO THE ACTUAL DECODING
+ JMP PROCERR /ERROR WHILE DECODING
+ 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.
+
+OERROR, 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
+
+/ I/O ERROR WHILE PROCESSING IMBEDDED FILENAME.
+
+NIOERR, IAC /SET INCREMENT
+
+/ FORMAT ERROR WHILE PROCESSING IMBEDDED FILENAME.
+
+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
+\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 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
+\fDECODIT,.-. /DECODING ROUTINE
+ TAD (DECERR) /SETUP THE
+ DCA GETBERROR /GETBYTE ERROR ROUTINE
+ DCA DATCNT /CLEAR DATA COUNT
+ NL7777 /SETUP FOR INITIALIZING
+ JMS I (PUTBYTE) /INITIALIZE OUTPUT FILE
+LOOP, JMS GETCHR /GET A CHARACTER
+ JMP ENDIT /WEREN'T ANY MORE
+ TAD (-176) /COMPARE TO TILDE
+ SZA CLA /SKIP IF IT MATCHES
+ JMP DATPROCESS /JUMP IF NOT
+ JMS GETCHR /GET A CHARACTER
+DECERR, JMP I DECODIT /WASN'T ANY
+ TAD (-"0!200) /REMOVE PRINTING OFFSET
+ SNA /SKIP IF SIGNIFICENT COMPRESSION
+ JMP DATCORRECT /JUMP IF NOT
+ CIA /INVERT FOR COUNTING
+ DCA CMPCNT /SAVE COMPRESSION COUNT
+ JMS DATOUT /OUTPUT DATA FIELD (IF ANY) AND CLEAR DATA COUNT
+COMPLP, JMS I (PUTBYTE) /OUTPUT A <NUL> BYTE
+ ISZ CMPCNT /DONE YET?
+ JMP COMPLP /NO, KEEP GOING
+ JMP LOOP /YES, GO BACK FOR MORE FILE ITEMS
+
+/ ZERO-LENGTH COMPRESSION (CORRECTION) FIELD FOUND.
+
+DATCORR,NL7777 /BACKUP
+ TAD DATCNT /NOW HAVE CORRECTED DATA COUNT
+ SPA /SKIP IF COUNT WASN'T ZERO
+ JMP LOOP /IGNORE BECAUSE THERE IS NO DATA
+ SNA /SKIP IF ENOUGH TO CORRECT
+ JMP I DECODIT /TAKE ERROR RETURN IF NOT
+ DCA DATCNT /STORE CORRECTED COUNT
+ JMP LOOP /GO BACK FOR MORE FILE ITEMS
+\f/ UN-COMPRESSED DATA FOUND.
+
+DATPROC,JMS DATOUT /OUTPUT PREVIOUS DATA FIELD (IF ANY), CLEAR DATA COUNT
+ TAD PUTEMP /GET LATEST BACK
+ TAD (-"0!200) /REMOVE DIGIT OFFSET
+ CLL RTL /MOVE UP
+ DCA BYTES /STORE IT
+ JMS GETCHR /GET NEXT CHARACTER
+ JMP I DECODIT /WASN'T ANY
+ AND (17) /JUST LOW-ORDER BITS
+ CLL RTL;RTL /MOVE UP
+ DCA BYTES+1 /STORE IT
+ TAD PUTEMP /GET IT AGAIN
+ RTR;RTR /MOVE DOWN
+ IAC /REMOVE DIGIT BIAS
+ AND (3) /JUST GOOD BITS
+ TAD BYTES /GET OLD BITS
+ DCA BYTES /STORE COMPOSITE
+ JMS GETCHR /GET NEXT CHARACTER
+ JMP I DECODIT /WASN'T ANY
+ TAD (-"0!200) /REMOVE DIGIT OFFSET
+ RTR /MOVE DOWN
+ AND (17) /ISOLATE GOOD BITS
+ TAD BYTES+1 /GET OLD BITS
+ DCA BYTES+1 /STORE COMPOSITE
+ TAD PUTEMP /GET IT AGAIN
+ AND (3) /ISOLATE GOOD BITS
+ CLL RTL;RTL;RTL /MOVE UP
+ DCA BYTES+2 /STORE IT
+ JMS GETCHR /GET NEXT CHARACTER
+ JMP I DECODIT /WASN'T ANY
+ TAD (-"0!200) /REMOVE DIGIT OFFSET
+ TAD BYTES+2 /GET OLD BITS
+ DCA BYTES+2 /STORE COMPOSITE
+ TAD (3) /SETUP THE
+ DCA DATCNT /DATA COUNT
+ JMP LOOP /GO GET NEXT FILE ITEM
+
+/ COMES HERE AT END-OF-FILE.
+
+ENDIT, JMS DATOUT /OUTPUT ANY LEFTOVER DATA
+ SKP /DON'T OUTPUT YET
+CLOSLUP,JMS I (PUTBYTE) /OUTPUT A <NUL> BYTE
+ TAD PUTPTR /GET THE OUTPUT BUFFER POINTER
+ TAD (-OUTBUFFER) /COMPARE TO RESET VALUE
+ SZA CLA /SKIP IF IT MATCHES
+ JMP CLOSLUP /ELSE KEEP GOING
+ ISZ DECODIT /BUMP TO GOOD RETURN
+ JMP I DECODIT /RETURN TO CALLER
+\fDATOUT, .-. /DATA OUTPUT ROUTINE
+ TAD DATCNT /GET CURRENT DATA COUNT
+ CMA /SETUP FOR COUNTING
+ DCA DATCNT /STORE IT
+ TAD (BYTES-1) /POINT TO
+ DCA XR1 /DATA AREA
+ JMP DATEST /CHECK BEFORE OUTPUTTING
+
+DATLUP, TAD I XR1 /GET A BYTE
+ JMS I (PUTBYTE) /OUTPUT IT
+DATEST, ISZ DATCNT /DONE YET?
+ JMP DATLUP /NO, KEEP GOING
+ JMP I DATOUT /YES, RETURN TO CALLER
+
+GETCHR, .-. /GET A CHARACTER ROUTINE
+GETCAGN,CLA /GET A CHARACTER
+ JMS I [GETBYTE] /GET A CHARACTER FROM FILE
+ JMP I GETCHR /WASN'T ANY, TAKE IMMEDIATE RETURN
+ TAD [-" !200] /COMPARE TO <SPACE>
+ SPA SNA CLA /SKIP IF NOT CONTROL CHARACTER OR <SPACE>
+ JMP GETCAGN /GO GET ANOTHER ONE
+ TAD PUTEMP /GET GOOD CHARACTER
+ ISZ GETCHR /BUMP RETURN ADDRESS
+ JMP I GETCHR /RETURN TO CALLER
+
+ PAGE
+\fPUTBYTE,.-. /OUTPUT A BYTE ROUTINE
+ SPA /ARE WE INITIALIZING?
+ JMP PUTINITIALIZE /YES
+ AND (377) /JUST IN CASE
+ DCA LATEST /SAVE LATEST CHARACTER
+ TAD LATEST /GET LATEST CHARACTER
+ JMP I PUTNEXT /GO WHERE YOU SHOULD GO
+
+PUTNEXT,.-. /EXIT ROUTINE
+ 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 POUTBUFFER/(OUTBUFFER) /SETUP THE
+ DCA PUTPTR /BUFFER POINTER
+PUTLOOP,JMS PUTNEXT /GET A CHARACTER
+ DCA I PUTPTR /STORE IT
+ TAD PUTPTR /GET POINTER VALUE
+ DCA TEMPTR /SAVE FOR LATER
+ ISZ PUTPTR /BUMP TO NEXT
+ JMS PUTNEXT /GET A CHARACTER
+ DCA I PUTPTR /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 PUTPTR /ADD ON SECOND BYTE
+ DCA I PUTPTR /STORE COMPOSITE
+ ISZ PUTPTR /BUMP TO NEXT
+ TAD PUTPTR /GET LATEST POINTER VALUE
+ 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 (SIZERR) /JUMP IF SO
+ JMS I OUTPUT /CALL I/O HANDLER
+ 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER
+POUTBUF,OUTBUFFER /BUFFER ADDRESS
+PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
+ JMP I (OERROR) /OUTPUT ERROR!
+ ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
+ ISZ PUTRECORD /BUMP TO NEXT RECORD
+ JMP PUTNEWRECORD /KEEP GOING
+\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
+PINBUFF,INBUFFER /BUFFER ADDRESS
+GETRECO,.-. /WILL BE LATEST RECORD NUMBER
+ JMP I GETBERROR /INPUT ERROR!
+ TAD PINBUFFER/(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
+ DCA PUTEMP /SAVE IT
+ TAD PUTEMP /GET IT BACK
+ TAD (-"Z!300) /COMPARE TO <^Z>
+ SNA CLA /SKIP IF NOT ASCII <EOF>
+ JMP I GETBYTE /RETURN IF ASCII MODE <EOF>
+ TAD PUTEMP /RESTORE THE CHARACTER
+ ISZ GETBYTE /BUMP PAST <EOF> RETURN
+ JMP I GETBYTE /RETURN TO MAIN CALLER
+\f 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, JMS SCANAME /SCAN OFF FILE NAME
+ 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
+ CDF PRGFLD /BACK TO OUR FIELD
+ JMP I GEOFILE /RETURN
+
+/ WE MUST TAKE THE FILENAME FROM THE IMBEDDED FILENAME SUPPLIED.
+
+GFLNAME,CDF PRGFLD /BACK TO OUR FIELD
+ TAD 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
+\fSCANAME,.-. /SCAN OFF FILENAME ROUTINE
+ TAD (NIOERROR) /SETUP THE
+ DCA GETBERROR /I/O ERROR HANDLER
+
+/ ZERO OUT THE FILENAME AREA.
+
+ TAD (-10) /SETUP THE
+ DCA CHRCNT /CLEAR COUNTER
+ TAD (ONAME-1) /SETUP THE
+ DCA XR1 /POINTER
+ JMS 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
+ NL7777 /MAKE IT INITIALIZE
+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
+ CLA /THROW AWAY THE CHARACTER
+ JMP TOSSNAME /KEEP GOING
+
+/ COMES HERE AFTER "." FOUND.
+
+GOTSEPA,JMS 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
+
+/ TOSS ANY EXTRA EXTENSION CHARACTERS.
+
+TOSSEXT,JMS I (GETAN) /GET A CHARACTER
+ JMP I (CHARERROR) /GOT "."; COMPLAIN
+ CLA /THROW AWAY THE CHARACTER
+ JMP TOSSEXTENSION /KEEP GOING
+
+/ COMES HERE WHEN TRAILING <CR> IS FOUND.
+
+GOTCR, JMS CLRNAME /CLEAR ANY REMAINING EXTENSION CHARACTERS
+ JMP I SCANAME /RETURN
+\fCLRNAME,.-. /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
+
+ PAGE
+\fGETCHAR,.-. /GET A CHARACTER ROUTINE
+ JMS I [GETBYTE] /GET A CHARACTER
+ JMP I (CHARERROR) /COMPLAIN IF <EOF> REACHED
+ TAD (-"M!300) /COMPARE TO <CR>
+ SNA /SKIP IF OTHER
+ JMP I (GOTCR) /JUMP IF IT MATCHES
+ TAD (-140+"M-300) /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
+ TAD PUTEMP /GET IT BACK
+ JMP I GETCHAR /RETURN
+
+GETAN, .-. /GET ALPHANUMERIC ROUTINE
+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
+ TAD (-".!200) /COMPARE TO "."
+ SNA /SKIP IF OTHER
+ JMP I GETAN /TAKE FIRST 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
+
+ PAGE
+\f $ /THAT'S ALL FOLK!
projects / pdp8.git / blobdiff