/ OS/8 ENCODING PROGRAM / LAST EDIT: 08-JUL-1992 22:00:00 CJL / MUST BE ASSEMBLED WITH '/F' SWITCH SET. / PROGRAM TO ENCODE OS/8 FILES INTO "PRINTABLE" ASCII FORMAT ("ENCODE"). / DISTRIBUTED BY CUCCA AS "K12ENC.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE. / WRITTEN BY: / CHARLES LASNER (CJL) / CLA SYSTEMS / 72-55 METROPOLITAN AVENUE / MIDDLE VILLAGE, NEW YORK 11379-2107 / (718) 894-6499 / USAGE: / .RUN DEV ENCODE INVOKE PROGRAM / *OUTPUT) / *OUTPUT) / . PROGRAM EXITS NORMALLY / INPUT FILE ASSUMES .SV EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION. IF / IMAGE MODE IS USED, THERE IS NO INPUT FILE SPECIFICATION; ONLY A DEVICE IS / GIVEN ALONG WITH A LENGTH AND THE MANDATORY /I SWITCH. / 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 / CHARACTER. / THIS PROGRAM SUPPORTS A SUBSET OF THE ASCII FILE ENCODING SCHEME DEVELOPED 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) NO SUPPORT FOR MULTIPLE DECODABLE FILES PER ENCODED FILE. / B) CREATES ENCODED PDP-8 60-BIT CHECKSUM AT END OF FILE. / C) CUSTOMIZED (REMARK) COMMANDS MUST BE SEPARATELY ADDED BY THE USER. / D) THE FILENAME IN THE (FILE ) AND (END ) COMMANDS WILL BE IDENTICAL TO / THE ACTUAL INVOKED INPUT FILE. THE USER MUST SEPARATELY MODIFY THESE / COMMANDS WHEN EXPORTING THE ENCODED FILE TO A SYSTEM WITH DIFFERENT / NAMING CONVENTIONS. / ERROR MESSAGES. / ERROR MESSAGES ARE ONE OF TWO VARIETIES: COMMAND DECODER MESSAGES AND USER / (PROGRAM-SIGNALLED) MESSAGES. / COMMAND DECODER MESSAGES ARE NON-FATAL AND MERELY REQUIRE RETYPING THE / COMMAND. ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE WILL YIELD THE COMMAND / DECODER MESSAGE "TOO MANY FILES" AND CAUSE A REPEAT OF THE COMMAND DECODER / PROMPT REQUIRING USER INPUT. THE USER IS DIRECTED TO OTHER DOCUMENTATION OF / THE "SPECIAL" MODE OF THE COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY / THIS UTILITY PROGRAM. / ANY USER MESSAGE PRINTED IS A FATAL ERROR MESSAGE CAUSED BY A PROBLEM BEYOND / THE SCOPE OF THE COMMAND DECODER. ALL USER MESSAGES ARE THE STANDARD OS/8 / "USER" ERROR MESSAGES OF THE FORM: "USER ERROR X AT AAAAA", WHERE X IS THE / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED. / THE FOLLOWING USER ERRORS ARE DEFINED: / ERROR NUMBER PROBABLE CAUSE / 0 NO OUTPUT FILE. / 1 INPUT FILE ERROR (CAN'T FIND INPUT FILE) OR NO INPUT / FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED. / 2 ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED). / 3 NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED). / 4 ERROR WHILE FETCHING FILE HANDLER. / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE. / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE. / 7 ERROR WHILE CLOSING THE OUTPUT FILE. / 8 I/O ERROR WHILE ENCODING FILE DATA. / ASSEMBLY INSTRUCTIONS. / IT IS ASSUMED THE SOURCE FILE K12ENC.PAL HAS BEEN MOVED AND RENAMED TO / DSK:ENCODE.PA. / .PAL ENCODE TERMINATED THE LINE DCA EXITZAP /ELSE CAUSE EXIT LATER DCA IMSW /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH TAD I (OUTFILE) /GET OUTPUT FILE DEVICE WORD SNA /SKIP IF OUTPUT FILE PRESENT JMP TSTMORE /JUMP IF NOT THERE AND [17] /JUST DEVICE BITS DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD SNA /SKIP IF PRESENT JMP INERR /JUMP IF NOT AND [17] /JUST DEVICE BITS DCA IDNUMBER /SAVE INPUT DEVICE NUMBER TAD I (INFILE+5) /GET SECOND INPUT FILE DEVICE WORD SZA CLA /SKIP IF ONLY ONE INPUT FILE JMP INERR /ELSE COMPLAIN JMS I (MIFNAME) /MOVE INPUT FILENAME WITH ADJUSTED EXTENSION TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD SNA CLA /SKIP IF NAME PRESENT JMP NONAMERROR /JUMP IF DEVICE ONLY JMS I (MOFNAME) /MOVE OUTPUT FILENAME CDF PRGFLD /BACK TO OUR FIELD CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE RESET /RESET SYSTEM TABLES TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT DCA OHPTR /STORE IN-LINE TAD ODNUMBER /GET OUTPUT DEVICE NUMBER CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE FETCH /FETCH HANDLER OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT JMP FERROR /FETCH ERROR TAD OHPTR /GET RETURNED ADDRESS DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT DCA IHPTR /STORE IN-LINE TAD IDNUMBER /GET INPUT DEVICE NUMBER CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE FETCH /FETCH HANDLER IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT JMP FERROR /FETCH ERROR TAD IHPTR /GET RETURNED ADDRESS DCA INPUT /STORE AS INPUT HANDLER ADDRESS TAD IMSW /GET IMAGE-MODE SWITCH SNA CLA /SKIP IF IMAGE MODE SET JMS I (GEIFILE) /GO LOOKUP INPUT FILE TAD (FNAME) /POINT TO DCA ENTAR1 /STORED FILENAME DCA ENTAR2 /CLEAR SECOND ARGUMENT JMS I (INDATE) /GET INPUT FILE'S DATE 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 (CLRCHKSUM) /CLEAR THE CHECKSUM JMS I (ENCODIT) /GO DO THE ACTUAL ENCODING JMP PROCERR /ERROR WHILE ENCODING TAD ODNUMBER /GET OUTPUT DEVICE NUMBER CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE CLOSE /CLOSE OUTPUT FILE FNAME /POINTER TO FILENAME OUTCNT, .-. /WILL BE ACTUAL COUNT JMP CLSERR /CLOSE ERROR EXITZAP,JMP START /**** TERMINATION **** 0000 JMP I (SBOOT) /EXIT TO MONITOR / ERROR WHILE PROCESSING INPUT FILE. PROCERR,NL0002 /SET INCREMENT SKP /DON'T USE NEXT / ERROR WHILE CLOSING THE OUTPUT FILE. CLSERR, NL0001 /SET INCREMENT SKP /DON'T CLEAR IT / OUTPUT FILE TOO LARGE ERROR. SIZERR, CLA /CLEAN UP TAD [3] /SET INCREMENT SKP /DON'T USE NEXT / ENTER ERROR. ENTERR, NL0002 /SET INCREMENT SKP /DON'T USE NEXT / HANDLER FETCH ERROR. FERROR, NL0001 /SET INCREMENT / NO OUTPUT FILENAME ERROR. NONAMER,IAC /SET INCREMENT / ILLEGAL OUTPUT FILE NAME ERROR. BADNAME,IAC /SET INCREMENT / INPUT FILESPEC ERROR. INERR, IAC /SET INCREMENT / OUTPUT FILESPEC ERROR. OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER CDF PRGFLD /ENSURE OUR FIELD CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE USERROR /USER ERROR ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER / COMES HERE TO TEST FOR NULL LINE. TSTMORE,TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD SZA CLA /SKIP NO INPUT OR OUTPUT GIVEN JMP OUTERR /ELSE COMPLAIN CDF PRGFLD /BACK TO OUR FIELD JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST PAGE ENCODIT,.-. /ENCODING ROUTINE TAD INRECORD /GET INPUT FILE STARTING RECORD DCA INREC /STORE IN-LINE NL7777 /SETUP INITIALIZE VALUE JMS I [DOBYTE] /INITIALIZE OUTPUT ROUTINE JMS I (TDMESSAGE) /OUTPUT TODAY'S DATE MESSAGE JMS I (FDMESSAGE) /OUTPUT FILE DATE MESSAGE JMS I [SCRIBE] /OUTPUT THE FILMSG /(FILE MESSAGE JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME JMS I [SCRIBE] /OUTPUT THE EMSG /LINE ENDING TAD [-WIDTH] /SETUP THE DCA WIDCNT /LINE WIDTH COUNTER JMS I (OUTSETUP) /SETUP PACKING ROUTINE AND CLEAR FILL TAD [-5] /INITIALIZE DCA OBOUND /BOUNDARY COUNTER ENCLOOP,JMS I INPUT /CALL INPUT HANDLER 2^100 /READ TWO PAGES PINBUFF,INBUFFER /INTO INPUT BUFFER INREC, .-. /WILL BE LATEST INPUT FILE RECORD ENCERRO,JMP I ENCODIT /INPUT ERROR, TAKE IMMEDIATE RETURN ISZ INREC /BUMP TO NEXT RECORD NOP /JUST IN CASE TAD PINBUFFER/(INBUFFER) /SETUP THE DCA INPTR /BUFFER POINTER LOOP, JMS I (CHKBND) /CHECK IF ON A GOOD BOUNDARY JMP NOCOMPRESSION /COMPRESS IS NOT ALLOWED AT THIS TIME TAD INPTR /GET CURRENT POINTER DCA XR1 /STASH FOR SEARCH DCA CMPCNT /CLEAR MATCH COUNT CMPLUP, TAD XR1 /GET INDEX VALUE TAD (-2^200-INBUFFER+1) /COMPARE TO LIMIT SNA CLA /SKIP IF NOT AT END OF BUFFER JMP CMPEND /JUMP IF AT END OF BUFFER TAD I XR1 /GET A CANDIDATE WORD CIA /INVERT FOR TEST TAD I INPTR /COMPARE TO CURRENT TEST VALUE SZA CLA /SKIP IF IT MATCHES JMP CMPEND /JUMP IF THIS IS NOT A REPEAT ISZ CMPCNT /BUMP MATCH COUNT JMP CMPLUP /TRY TO FIND MORE / COMES HERE POSSIBLY WITH SOME COMPRESSED VALUES COUNTED. CMPEND, NL7776 /-2 TAD CMPCNT /DID WE FIND ENOUGH MATCHES? SPA CLA /SKIP IF SO JMP NOCOMPRESSION /FORGET IT TAD ("X-"0) /SETUP COMPRESSION INDICATOR JMS I (OUTSETUP) /SETUP SPECIAL MODE JMS I (PUT5) /OUTPUT "X" JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE TAD I INPTR /GET THE VALUE JMS I [PUTIT] /OUTPUT IT ISZ CMPCNT /ACCOUNT FOR ORIGINAL TAD CMPCNT /GET COMPRESSION COUNT CLL RTL;RTL /*16 JMS I [PUTIT] /OUTPUT BITS[0-7] ONLY JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE AGAIN TAD INPTR /GET INPUT POINTER TAD CMPCNT /UPDATE PAST ALL COMPRESSED VALUES DCA INPTR /STORE BACK JMP TEST /CONTINUE THERE / COMES HERE IF NO COMPRESSION FOUND (OR NOT ALLOWED). NOCOMPR,TAD I INPTR /GET LATEST VALUE JMS I [PUTIT] /OUTPUT IT ISZ INPTR /BUMP TO NEXT ISZ OBOUND /BUMP TO NEXT WORD JMP TEST /KEEP GOING TAD [-5] /RESET THE DCA OBOUND /BOUNDARY COUNTER TEST, TAD INPTR /GET INPUT POINTER TAD (-2^200-INBUFFER) /COMPARE TO UPPER LIMIT SZA CLA /SKIP IF AT END OF BUFFER JMP LOOP /ELSE JUST KEEP GOING ISZ INLEN /DONE ALL INPUT RECORDS? JMP ENCLOOP /NO, KEEP GOING / WE MUST FINISH THE LAST [5 WORDS => 12 BYTES] SEQUENCE. ENDLUP, JMS I (CHKBND) /AT A GOOD BOUNDARY? SKP /SKIP IF NOT JMP ENDONE /JUMP IF SO JMS I [PUTIT] /OUTPUT SOME WASTE BYTES ISZ OBOUND /AT A GOOD BOUNDARY NOW? JMP ENDLUP /NO, TRY AGAIN ENDONE, TAD ("Z-"0) /GET END INDICATOR JMS I (OUTSETUP) /SETUP SPECIAL MODE JMS I (PUT5) /OUTPUT A "Z" JMS I (INVCHKSUM) /INVERT THE CHECKSUM JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE JMS I (CHKOUT) /OUTPUT THE CHECKSUM JMS I [SCRIBE] /OUTPUT THE ENDMSG /END MESSAGE JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME JMS I [SCRIBE] /OUTPUT THE EMSG /LINE ENDING JMS I [SCRIBE] /OUTPUT THE EOFMSG /FINAL MESSAGE TAD ("Z&37) /GET <^Z> CLOSLUP,JMS I [DOBYTE] /OUTPUT A BYTE (^Z OR NULL) TAD BUFPTR /GET THE OUTPUT BUFFER POINTER TAD (-OUTBUFFER) /COMPARE TO RESET VALUE SZA CLA /SKIP IF IT MATCHES JMP CLOSLUP /ELSE KEEP GOING ISZ ENCODIT /NO ERRORS JMP I ENCODIT /RETURN PAGE PUTIT, .-. /WORD OUTPUT ROUTINE DCA PUTEMP /SAVE PASSED VALUE JMS I (CALCHKSUM) /UPDATE CHECKSUM JMP I PUTNXT /GO WHERE YOU SHOULD GO PUTNXT, PUT0 /OUTPUT EXIT ROUTINE TAD PUTEMP /GET LATEST VALUE DCA PUTPREV /SAVE FOR NEXT TIME JMP I PUTIT /RETURN TO MAIL CALLER PUTLUP, JMS PUTNXT /GET ANOTHER WORD PUT0, TAD PUTEMP /GET WORD[0] RTL;RTL;RTL /BITS[0-4] => AC[7-11] JMS PUT5 /OUTPUT A CHARACTER TAD PUTEMP /GET WORD[0] AGAIN RTR /BITS[5-9] => AC[7-11] JMS PUT5 /OUTPUT A CHARACTER JMS PUTNXT /GET ANOTHER WORD PUT1, TAD PUTPREV /GET WORD[0] AND [3] /ISOLATE BITS[10-11] CLL RTL;RAL /BITS[10-11] => AC[7-8] DCA PUTPREV /SAVE FOR NOW TAD PUTEMP /GET WORD[1] RTL;RTL /BITS[0-2] => AC[9-11] AND [7] /ISOLATE DESIRED BITS TAD PUTPREV /ADD ON WORD[0] BITS IN AC[7-8] JMS PUT5 /OUTPUT A CHARACTER TAD PUTEMP /GET WORD[1] RTR;RTR /BITS[3-7] => AC[7-11] JMS PUT5 /OUTPUT A CHARACTER JMS PUTNXT /GET ANOTHER WORD PUT2, TAD PUTEMP /GET WORD[2] RAL /BIT[0] => L CLA /CLEAN UP TAD PUTPREV /GET WORD[1] RAL /BITS[8-11],L => AC[7-11] JMS PUT5 /OUTPUT A CHARACTER TAD PUTEMP /GET WORD[2] RTR;RTR;RTR /BITS[1-5] => AC[7-11] JMS PUT5 /OUTPUT A CHARACTER TAD PUTEMP /GET WORD[2] RAR /BITS[6-10] => AC[7-11] JMS PUT5 /OUTPUT A CHARACTER JMS PUTNXT /GET ANOTHER WORD PUT3, TAD PUTPREV /GET WORD[2] RAR /BIT[11] => L CLA /CLEAN UP TAD PUTEMP /GET WORD[3] RTL;RTL;RAL /L, BITS[0-3] => AC[7-11] JMS PUT5 /OUTPUT A CHARACTER TAD PUTEMP /GET WORD[3] RTR;RAR /BITS[4-8] => AC[7-11] JMS PUT5 /OUTPUT A CHARACTER JMS PUTNXT /GET ANOTHER WORD PUT4, TAD PUTPREV /GET WORD[3] AND [7] /ISOLATE BITS[9-11] CLL RTL /BITS[9-11] => AC[7-9] DCA PUTPREV /SAVE FOR NOW TAD PUTEMP /GET WORD[4] RTL;RAL /BITS[0-1] => AC[10-11] AND [3] /ISOLATE BITS[10-11] TAD PUTPREV /ADD ON WORD[3] BITS IN AC[7-9] JMS PUT5 /OUTPUT A CHARACTER TAD PUTEMP /GET WORD[4] RTR;RTR;RAR /BITS[2-6] => AC[7-11] JMS PUT5 /OUTPUT A CHARACTER TAD PUTEMP /GET WORD[4] BITS[7-11] IN AC[7-11] JMS PUT5 /OUTPUT A CHARACTER JMP PUTLUP /GO DO ANOTHER GROUP OF FIVE WORDS CHKNL, .-. /CHECK IF AT NEW LINE ROUTINE TAD WIDCNT /GET LINE WIDTH COUNTER TAD (WIDTH) /COMPARE TO MAXIMIM VALUE SZA CLA /SKIP IF AT MAXIMUM ISZ CHKNL /TAKE SKIP RETURN IF NOT AT MAXIMUM JMP I CHKNL /RETURN EITHER WAY OUTSETU,.-. /OUTPUT SETUP ROUTINE DCA FILLVALUE /STORE PASSED FILL VALUE TAD (PUT0) /SETUP THE DCA PUTNXT /OUTPUT CO-ROUTINE JMP I OUTSETUP /RETURN PUT5, .-. /FIVE-BIT OUTPUT ROUTINE AND [37] /JUST 5 BITS DCA PUTLATEST /SAVE IT JMS CHKNL /CHECK IF AT BEGINNING OF LINE SKP /SKIP IF NOT JMP PUTNORMAL /JUMP IF SO TAD ("<&177) /GET BEGINNING BRACKET JMS I [DOBYTE] /OUTPUT IT PUTNORM,TAD PUTLATEST /GET LATEST VALUE TAD ("0-"9-1) /COMPARE TO FIRST LIMIT SMA CLA /SKIP IF LESS TAD ["A-"9-1] /CONVERT LARGER VALUES TO A-V TAD PUTLATEST /ADD ON LATEST VALUE TAD ["0&177] /MAKE IT ASCII TAD FILLVALUE /ADD ON FILL VALUE FOR SPECIAL MODE JMS I [DOBYTE] /OUTPUT IT ISZ WIDCNT /BUMP LINE COUNTER TAD WIDCNT /GET LINE COUNTER SZA CLA /SKIP IF AT END OF LINE JMP I PUT5 /ELSE JUST RETURN TAD (">&177) /GET DATA CLOSING CHARACTER JMS I [DOBYTE] /OUTPUT IT TAD ["M&37] /GET A JMS I [DOBYTE] /OUTPUT IT TAD ["J&37] /GET A JMS I [DOBYTE] /OUTPUT IT TAD [-WIDTH] /RESET THE DCA WIDCNT /LINE WIDTH COUNTER JMP I PUT5 /RETURN PAGE / MESSAGE PRINT ROUTINE. SCRIBE, .-. /MESSAGE PRINT ROUTINE TAD I SCRIBE /GET IN-LINE POINTER ARGUMENT DCA SCRPTR /STASH THE POINTER ISZ SCRIBE /BUMP PAST ARGUMENT TAD (140) /INITIALIZE TO DCA SCRCASE /LOWER-CASE SCRLUP, TAD I SCRPTR /GET LEFT HALF-WORD RTR;RTR;RTR /MOVE OVER JMS SCRPRNT /PRINT IT TAD I SCRPTR /GET RIGHT HALF-WORD JMS SCRPRNT /PRINT IT ISZ SCRPTR /BUMP TO NEXT PAIR JMP SCRLUP /KEEP GOING SCRPRNT,.-. /CHARACTER PRINT ROUTINE AND [77] /JUST SIX BITS SNA /END OF MESSAGE? JMP I SCRIBE /YES, RETURN TO ORIGINAL CALLER DCA SCRCHAR /NO, SAVE FOR NOW TAD SCRCHAR /GET IT BACK TAD (-"%!200) /IS IT "%"? SNA /SKIP IF NOT JMP SCRCRLF /JUMP IF IT MATCHES TAD (-"^+100+"%) /IS IT "^" SNA CLA /SKIP IF NOT JMP SCRFLIP /JUMP IF IT MATCHES TAD SCRCHAR /GET THE CHARACTER AND [40] /DOES CASE MATTER? SNA CLA /SKIP IF NOT TAD SCRCASE /ELSE GET PREVAILING CASE TAD SCRCHAR /GET THE CHARACTER SCRPRLF,JMS I [DOBYTE] /OUTPUT THE CHARACTER JMP I SCRPRNT /RETURN SCRCRLF,TAD ["M&37] /GET A JMS I [DOBYTE] /OUTPUT IT TAD ["J&37] /GET A JMP SCRPRLF /CONTINUE THERE SCRFLIP,TAD SCRCASE /GET CURRENT CASE CIA /INVERT IT TAD (140+100) /ADD SUM OF POSSIBLE VALUES DCA SCRCASE /STORE NEW INVERTED CASE JMP I SCRPRNT /RETURN PUTBYTE,.-. /OUTPUT A BYTE ROUTINE SPA /ARE WE INITIALIZING? JMP PUTINITIALIZE /YES AND (177) /JUST IN CASE DCA LATEST /SAVE LATEST CHARACTER TAD LATEST /GET LATEST CHARACTER JMP I PUTNEXT /GO WHERE YOU SHOULD GO PUTNEXT,.-. /EXIT ROUTINE ISZ PUTBYTE /BUMP TO GOOD RETURN PUTERRO,CLA CLL /CLEAN UP JMP I PUTBYTE /RETURN TO MAIN CALLER PUTINIT,CLA /CLEAN UP TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE DCA PUTRECORD /STORE IN-LINE DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH PUTNEWR,TAD (OUTBUFFER) /SETUP THE DCA BUFPTR /BUFFER POINTER PUTLOOP,JMS PUTNEXT /GET A CHARACTER DCA I BUFPTR /STORE IT TAD BUFPTR /GET POINTER VALUE DCA TEMPTR /SAVE FOR LATER ISZ BUFPTR /BUMP TO NEXT JMS PUTNEXT /GET A CHARACTER DCA I BUFPTR /STORE IT JMS PUTNEXT /GET A CHARACTER RTL;RTL /MOVE UP AND [7400] /ISOLATE HIGH NYBBLE TAD I TEMPTR /ADD ON FIRST BYTE DCA I TEMPTR /STORE COMPOSITE TAD LATEST /GET LATEST CHARACTER RTR;RTR;RAR /MOVE UP AND AND [7400] /ISOLATE LOW NYBBLE TAD I BUFPTR /ADD ON SECOND BYTE DCA I BUFPTR /STORE COMPOSITE ISZ BUFPTR /BUMP TO NEXT TAD BUFPTR /GET LATEST POINTER VALUE TAD (-2^200-OUTBUFFERR) /COMPARE TO LIMIT SZA CLA /SKIP IF AT END JMP PUTLOOP /KEEP GOING ISZ DANGCNT /TOO MANY RECORDS? SKP /SKIP IF NOT JMP I (SIZERR) /JUMP IF SO JMS I OUTPUT /CALL I/O HANDLER 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER OUTBUFFER /BUFFER ADDRESS PUTRECO,.-. /WILL BE LATEST RECORD NUMBER JMP PUTERROR /OUTPUT ERROR! ISZ I (OUTCNT) /BUMP ACTUAL LENGTH ISZ PUTRECORD /BUMP TO NEXT RECORD JMP PUTNEWRECORD /KEEP GOING DOBYTE, .-. /OUTPUT A BYTE ROUTINE JMS PUTBYTE /OUTPUT PASSED VALUE JMP I (ENCERROR) /COULDN'T DO IT JMP I DOBYTE /RETURN PAGE / INPUT FILE ROUTINE. GEIFILE,.-. /GET INPUT FILE ROUTINE JMS LUKUP /TRY TO LOOKUP THE FILE SKP /SKIP IF IT WORKED JMP TRYNULL /TRY NULL EXTENSION VERSION NULLOK, TAD LARG2 /GET NEGATED LENGTH DCA INLEN /STASH IT TAD LARG1 /GET FIRST INPUT RECORD DCA INRECORD /STASH IT JMP I GEIFILE /RETURN / COMES HERE IF LOOKUP FAILED. TRYNULL,CDF TBLFLD /GOTO TABLE FIELD TAD I [INFILE+4] /GET ORIGINAL FILENAME'S EXTENSION CDF PRGFLD /BACK TO OUR FIELD SZA CLA /SKIP IF IT WAS NULL ORIGINALLY JMP I (INERR) /ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE DCA IFNAME+3 /NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION JMS LUKUP /TRY TO LOOK IT UP AGAIN JMP NULLOK /THAT WORKED! JMP I (INERR) /COMPLAIN OF LOOKUP FAILURE LUKUP, .-. /LOW-LEVEL LOOKUP ROUTINE TAD (IFNAME) /GET OUR FILENAME POINTER DCA LARG1 /STORE IN-LINE DCA LARG2 /CLEAR SECOND ARGUMENT TAD IDNUMBER /GET INPUT DEVICE NUMBER CIF USRFLD /GOTO USR FIELD JMS I [USR] /CALL USR ROUTINE LOOKUP /WANT LOOKUP FUNCTION LARG1, .-. /WILL BE POINTER TO OUR FILENAME LARG2, .-. /WILL RETURN FILE LENGTH (HOPEFULLY) ISZ LUKUP /LOOKUP FAILED, SO BUMP RETURN ADDRESS JMP I LUKUP /RETURN EITHER WAY / INPUT FILENAME PRINT ROUTINE. PIFNAME,.-. /PRINT INPUT FILENAME ROUTINE TAD IMSW /GET IMAGE-MODE SWITCH SNA CLA /SKIP IF SET JMP DOIFNAME /JUMP IF NOT JMS I [SCRIBE] /OUTPUT THE IFMSG /IMAGE MESSAGE CDF TBLFLD /GOTO TABLE FIELD TAD I [EQUWRD] /GET EQUALS PARAMETER CDF PRGFLD /BACK TO OUR FIELD JMS I (OCTOUT) /OUTPUT IT CDF TBLFLD /GOTO TABLE FIELD TAD I [SWY9] /GET /Y-/9 SWITCHES CDF PRGFLD /BACK TO OUR FIELD AND [600] /JUST /1, /2 BITS SNA /SKIP IF SOMETHING SET JMP I PIFNAME /JUST RETURN IF NOT AND [400] /JUST /1 BIT SNA CLA /SKIP IF /1 SET JMP PIFPT2 /JUMP IF /2 SET JMS I [SCRIBE] /OUTPUT THE PT1MSG /PART ONE MESSAGE JMP I PIFNAME /RETURN PIFPT2, JMS I [SCRIBE] /OUTPUT THE PT2MSG /PART TWO MESSAGE JMP I PIFNAME /RETURN DOIFNAM,TAD IFNAME /GET FIRST PAIR JMS PIF2 /PRINT IT TAD IFNAME+1 /GET SECOND PAIR JMS PIF2 /PRINT IT TAD IFNAME+2 /GET THIRD PAIR JMS PIF2 /PRINT IT TAD (".&177) /GET SEPARATOR JMS PIFOUT /PRINT IT TAD IFNAME+3 /GET FOURTH PAIR JMS PIF2 /PRINT IT JMP I PIFNAME /RETURN PIF2, .-. /PRINT A PAIR ROUTINE DCA SCRCHAR /SAVE PASSED PAIR TAD SCRCHAR /GET IT BACK RTR;RTR;RTR /MOVE DOWN JMS PIFOUT /PRINT HIGH-ORDER FIRST TAD SCRCHAR /GET IT AGAIN JMS PIFOUT /PRINT LOW-ORDER JMP I PIF2 /RETURN PIFOUT, .-. /FILENAME CHARACTER OUTPUT ROUTINE AND [77] /JUST SIXBIT SNA /SKIP IF SOMETHING THERE JMP I PIFOUT /ELSE IGNORE IT TAD [40] /INVERT IT AND [77] /REMOVE EXCESS TAD [40] /INVERT IT AGAIN JMS I [DOBYTE] /OUTPUT IT JMP I PIFOUT /RETURN MOFNAME,.-. /MOVE OUTPUT FILENAME ROUTINE TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD JMS CHKNAME /CHECK IF LEGAL DCA FNAME /STASH IT TAD I (OUTFILE+2) /GET SECOND OUTPUT FILENAME WORD JMS CHKNAME /CHECK IF LEGAL DCA FNAME+1 /STASH IT TAD I (OUTFILE+3) /GET THIRD OUTPUT FILENAME WORD JMS CHKNAME /CHECK IF LEGAL DCA FNAME+2 /STASH IT TAD I (OUTFILE+4) /GET FOURTH OUTPUT FILENAME WORD JMS CHKNAME /CHECK IF LEGAL DCA FNAME+3 /STASH IT JMP I MOFNAME /RETURN / OUTPUT NAME CHECK ROUTINE. CHKNAME,.-. /OUTPUT NAME CHECK ROUTINE DCA LUKUP /SAVE PASSED VALUE TAD LUKUP /GET IT BACK RTR;RTR;RTR /MOVE DOWN JMS CHKIT /CHECK HIGH-ORDER AND GET IT BACK JMS CHKIT /CHECK LOW-ORDER AND GET IT BACK JMP I CHKNAME /RETURN CHKIT, .-. /ONE CHARACTER CHECK ROUTINE AND [77] /JUST SIX BITS TAD (-"?!200) /COMPARE TO "?" SZA /SKIP IF ALREADY BAD TAD (-"*+"?) /ELSE COMPARE TO "*" SNA CLA /SKIP IF NEITHER BAD CASE JMP I (BADNAME) /COMPLAIN OF WILD CHARACTER TAD LUKUP /GET THE PAIR BACK FOR NEXT TIME JMP I CHKIT /RETURN PAGE CALCHKS,.-. /CALCULATE CHECKSUM ROUTINE TAD CHKFLG /SHOULD WE CHECKSUM? SZA CLA /SKIP IF SO JMP I CALCHKSUM /JUMP IF NOT JMS CHKSETUP /SETUP TAD PUTEMP /GET PASSED VALUE CLL RAR /CLEAR LINK AND MOVE OVER ADDLUP, RAL /MOVE OVER CARRY TAD I XR1 /ADD A WORD DCA I XR2 /STORE BACK ISZ CCNT /DONE ENOUGH? JMP ADDLUP /NO, KEEP GOING JMP I CALCHKSUM /YES, RETURN CHKOUT, .-. /OUTPUT THE CHECKSUM ROUTINE JMS CHKSETUP /SETUP ISZ CHKFLG /DISABLE CHECKSUMMING TAD I XR1 /GET A WORD JMS I [PUTIT] /OUTPUT IT ISZ CCNT /DONE YET? JMP .-3 /NO, KEEP GOING JMP I CHKOUT /YES, WE'RE DONE CLRCHKS,.-. /CLEAR CHECKSUM ROUTINE JMS CHKSETUP /SETUP DCA I XR1 /CLEAR A WORD ISZ CCNT /DONE YET? JMP .-2 /NO, DO ANOTHER DCA CHKFLG /ENABLE CHECKSUMMING JMP I CLRCHKSUM /RETURN INVCHKS,.-. /CHECKSUM INVERSION ROUTINE JMS CHKSETUP /SETUP STL /FORCE INITIAL CARRY COMLUP, TAD I XR1 /GET A WORD CMA /INVERT IT SZL /SKIP IF NO CARRY CLL IAC /ELSE ADD ONE AND CLEAR CARRY FOR NEXT TIME DCA I XR2 /STORE BACK ISZ CCNT /DONE ALL YET? JMP COMLUP /NO, KEEP GOING JMP I INVCHKSUM /YES, RETURN CHKSETU,.-. /CHECKSUM SETUP ROUTINE TAD (CHKSUM-1) /POINT TO DCA XR1 /CHECKSUM AREA TAD (CHKSUM-1) /POINT TO DCA XR2 /CHECKSUM AREA TAD [-5] /SETUP THE DCA CCNT /CHECKSUM COUNT JMP I CHKSETUP /RETURN / FILE DATE ROUTINE. FDMESSA,.-. /PUT FILE DATE IN MESSAGE ROUTINE TAD FDATE /GET INPUT FILE'S DATE SNA CLA /SKIP IF ANY JMP I FDMESSAGE /RETURN IF NONE JMS I [SCRIBE] /PRINT OUT THE DATMSG /DATE BLURB TAD FDATE /GET IT BACK JMS PRDATE /PRINT THE DATE JMS I [SCRIBE] /PRINT THE EMSG /END MESSAGE JMP I FDMESSAGE /RETURN TDMESSA,.-. /PUT TODAY'S DATE IN MESSAGE ROUTINE JMS I [SCRIBE] /OUTPUT THE REMMSG /OPENING REMARKS CDF TBLFLD /GOTO TABLE FIELD TAD I (DATWRD) /GET DATE WORD CDF PRGFLD /BACK TO OUR FIELD SNA /SKIP IF THERE JMP NOTDATE /JUMP IF NOT DCA TDATE /SAVE TODAY'S DATE JMS I [SCRIBE] /OUTPUT THE ONMSG /BRIDGING MESSAGE TAD TDATE /GET TODAY'S DATE JMS PRDATE /PRINT TODAY'S DATE NOTDATE,JMS I [SCRIBE] /OUTPUT THE EMSG /END MESSAGE JMP I TDMESSAGE /RETURN PRDATE, .-. /DATE PRINT ROUTINE DCA PRTEMP /SAVE PASSED VALUE TAD PRTEMP /GET IT BACK RTR;RAR /MOVE DOWN AND [37] /JUST DAY BITS JMS I (DEC2) /PRINT AS TWO DIGITS TAD PRTEMP /GET DATE AGAIN AND [7400] /JUST MONTH BITS CLL RTL;RTL;RTL /MOVE DOWN TAD (MONLST-2-1) /POINT TO PROPER ELEMENT DCA XR1 /STASH THE POINTER TAD I XR1 /GET FIRST PAIR DCA I (MMSG+1) /STORE IN MESSAGE TAD I XR1 /GET SECOND PAIR DCA I (MMSG+2) /STORE IN MESSAGE JMS I [SCRIBE] /OUTPUT THE MMSG /MONTH MESSAGE TAD PRTEMP /GET DATE AGAIN AND [7] /JUST YEAR BITS DCA TEMP /SAVE IT CDF TBLFLD /GOTO TABLE FIELD TAD I (DATWRD) /GET CURRENT DATE WORD CDF PRGFLD /BACK TO OUR FIELD AND [7] /JUST YEAR BITS CIA /INVERT FOR TEST TAD TEMP /COMPARE TO DESIRED YEAR SMA SZA CLA /SKIP IF THEY MATCH OR ARE EARLIER TAD (-10) /ELSE BACKUP A GROUP TAD TEMP /ADD TO YEAR DCA TEMP /STORE BACK TAD I (DATEXT) /GET EXTENSION WORD AND [600] /JUST EXTENSION BITS CLL RTR;RTR /MAKE IT GROUP COUNT TAD TEMP /ADD ON RELATIVE YEAR TAD (106) /MAKE IT ABSOLUTE YEAR (70-99) JMS I (DEC2) /PRINT AS TWO DIGITS JMP I PRDATE /RETURN PAGE DEC2, .-. /PRINT TWO DIGITS ROUTINE JMS DIVIDE /DIVIDE 12 /BY 10 TAD ["0&177] /MAKE IT ASCII JMS I [DOBYTE] /OUTPUT IT TAD REM /GET SECOND DIGIT TAD ["0&177] /MAKE IT ASCII JMS I [DOBYTE] /OUTPUT IT JMP I DEC2 /RETURN / DIVIDE ROUTINE. DIVIDE, .-. /DIVIDE ROUTINE DCA REM /SAVE IN REMAINDER DCA QUO /CLEAR QUOTIENT TAD REM /GET IT BACK STL CIA /INVERT SKP /DON'T FIRST TIME DVLOOP, ISZ QUO /BUMP UP QUOTIENT TAD I DIVIDE /ADD ON ARGUMENT SNA SZL /UNDERFLOW? JMP DVLOOP /NO, KEEP GOING CIA /YES, INVERT IT BACK TAD I DIVIDE /RESTORE LOST VALUE DCA REM /SAVE AS REMAINDER TAD QUO /GET THE QUOTIENT ISZ DIVIDE /BUMP PAST ARGUMENT JMP I DIVIDE /RETURN INDATE, .-. /GET INPUT FILE'S DATE WORD CDF TBLFLD /GOTO TABLE FIELD TAD IMSW /GET IMAGE-MODE SWITCH SNA CLA /SKIP IF SET JMP NOIMG /JUMP IF NOT TAD I (DATWRD) /USE TODAY'S DATE JMP NOAIW /CONTINUE THERE NOIMG, TAD I (AIWCNT) /GET AIW COUNT SNA /SKIP IF ANY JMP NOAIW /JUMP IF NOT TAD I [AIWXR] /GET ENTRY POINTER DCA TEMP /STASH FIRST AIW POINTER TAD I TEMP /GET FIRST AIW NOAIW, DCA FDATE /SAVE AS FILE'S DATE CDF PRGFLD /BACK TO OUR FIELD JMP I INDATE /RETURN / INPUT FILENAME MOVE ROUTINE; USES DEFAULT EXTENSION IF NONE PROVIDED BY USER. MIFNAME,.-. /MOVE INPUT FILENAME ROUTINE TAD I (INFILE+1) /GET FIRST INPUT FILENAME WORD SNA /SKIP IF SOMETHING THERE JMP IMTEST /JUMP IF NOT IFNAMOK,DCA IFNAME /STASH IT TAD I (INFILE+2) /GET SECOND INPUT FILENAME WORD DCA IFNAME+1 /STASH IT TAD I (INFILE+3) /GET THIRD INPUT FILENAME WORD DCA IFNAME+2 /STASH IT TAD I [INFILE+4] /GET FOURTH INPUT FILENAME WORD SNA /SKIP IF SOMETHING THERE TAD ("S^100+"V-300) /ELSE USE DEFAULT EXTENSION VALUE DCA IFNAME+3 /STASH IT EITHER WAY JMP I MIFNAME /RETURN / TEST IF IMAGE-MODE IS SET. ASSUME /1 AND /2 ARE NOT SET. IMTEST, 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 SOMETHING THERE JMP I (INERR) /ELSE COMPLAIN CIA /INVERT IT DCA INLEN /USE AS INPUT RECORD COUNT DCA INRECORD /START AT THE BEGINNING OF THE DEVICE ISZ IMSW /INDICATE IMAGE-MODE SET / TEST IF /1 OR /2 IS SET. TAD I [SWY9] /GET /Y-/9 SWITCHES AND [600] /JUST /1, /2 SWITCHES SNA /SKIP IF EITHER SET JMP IFNAMOK /JUMP IF NEITHER SET / TEST IF /1 IS SET. IF NOT, /2 MUST BE SET. AND [400] /JUST /1 SWITCH SNA CLA /SKIP IF /1 SET JMP IM2 /JUMP IF /2 SET / FOR A FIRST HALF, USE THE ROUNDED-DOWN FIRST HALF LENGTH. THE DATA STARTS AT / RECORD ZERO (ALREADY SET). TAD I [EQUWRD] /GET EQUALS PARAMETER CLL RAR /%2 IM2ENTR,CIA /INVERT IT DCA INLEN /SET COUNT FOR HALF OF THE DEVICE JMP IFNAMOK /KEEP GOING / FOR A SECOND HALF, THE DATA STARTS AT THE HALFWAY POINT (ROUNDED DOWN). IM2, TAD I [EQUWRD] /GET EQUALS PARAMETER CLL RAR /%2 DCA INRECORD /SETUP STARTING RECORD / FOR A SECOND HALF, THE COUNT IS THE ORIGINAL AMOUNT MINUS THE COUNT FOR THE / FIRST HALF. TAD I [EQUWRD] /GET EQUALS PARAMETER CLL RAR /%2 CIA /INVERT IT TAD I [EQUWRD] /SUBTRACT FROM EQUALS PARAMETER JMP IM2ENTRY /CONTINUE THERE CHKBND, .-. /CHECK IF ON GOOD OUTPUT BOUNDARY ROUTINE TAD OBOUND /GET BOUNDARY COUNTER TAD (5) /COMPARE TO BEGINNING VALUE SNA CLA /SKIP IF NOT AT BEGINNING ISZ CHKBND /SET SKIP RETURN IF AT BEGINNING JMP I CHKBND /RETURN EITHER WAY OCTOUT, .-. /OCTAL OUTPUT ROUTINE DCA OCTEMP /SAVE IT TAD (-4) /SETUP THE DCA OCTCNT /DIGIT COUNTER OCTLUP, TAD OCTEMP /GET THE VALUE RTL;RAL /MOVE UP A DIGIT DCA OCTEMP /STORE BACK TAD OCTEMP /GET IT AGAIN RAL /PUT INTO CORRECT BITS AND [7] /JUST ONE DIGIT TAD ["0&177] /MAKE IT ASCII JMS I [DOBYTE] /OUTPUT IT ISZ OCTCNT /DONE ENOUGH? JMP OCTLUP /NO, GO BACK FOR MORE JMP I OCTOUT /YES, RETURN TO CALLER PAGE / FILE TEXT MESSAGES. DATMSG, TEXT "(^REMARK F^ILE ^D^ATE: " EMSG, TEXT ")%^" ENDMSG, TEXT ">%(^END ^" EOFMSG, TEXT "(^REMARK E^ND OF ^F^ILE)%" FILMSG, TEXT "(^FILE " IFMSG, TEXT "^B^LOCK-^I^MAGE-^F^ILE =^" MMSG, TEXT "-^D^EC-19" ONMSG, TEXT ": ^" PT1MSG, TEXT " ^F^IRST ^H^ALF" PT2MSG, TEXT " ^S^ECOND ^H^ALF^" REMMSG, TEXT "(^REMARK PDP-8/DEC^MATE ^E^NCODING ^P^ROGRAM ^V^ERSION ^" "0+VERSION^100+".-200; "0+REVISION^100+" -200 TEXT " C^HARLES ^L^ASNER)%" TEXT "(^REMARK I^MAGE ^F^ILE ^C^REATED BY ^PDP^-8" / MONTH TEXT TABLE. MONLST, TEXT "J^AN" /JANUARY TEXT "F^EB" /FEBRUARY TEXT "M^AR" /MARCH TEXT "A^PR" /APRIL TEXT "M^AY" /MAY TEXT "J^UN" /JUNE TEXT "J^UL" /JULY TEXT "A^UG" /AUGUST TEXT "S^EP" /SEPTEMBER TEXT "O^CT" /OCTOBER TEXT "N^OV" /NOVEMBER TEXT "D^EC" /DECEMBER $ /THAT'S ALL FOLK!