File: K12DEB.PA of Disk: Disks/PDP8-Net/diag-games-kermit
(Source file text)
/ 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.
/ .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.
/ 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
/ 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
*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
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
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
/ 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
/ 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
DECODIT,.-. /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
/ 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
DATOUT, .-. /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
PUTBYTE,.-. /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
/ 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
PAGE
GEOFILE,.-. /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
SCANAME,.-. /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
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
PAGE
GETCHAR,.-. /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
$ /THAT'S ALL FOLK!