File K12DEB.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/	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!



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search