File FOCLIB.PA (PAL assembler source file)

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


/PS/8 FOCAL LIBRARY ROUTINES FIELD 0 *1 /INTERRUPT SERVICE ROUTINE CIF CDF 10 JMP I .+1 2603 RMF /RETURN FROM INTERRUPT ION JMP I 0 *10 AUTO1, 0 /AUTO-INDEX REGISTERS...ACTUALLY USE SOME AUTO2, 0 AUTO3, 0 AUTO4, 0 AUTO5, 0 AUTO6, 0 AUTO7, 0 AUTO8, 0 XCNTR, 0 /GENERAL COUNTER--SUCH AS FOR MPD2,MPD3 USR, 7700 /POINTER TO MONITOR (200 IF IN CORE) EXIT, JMS I [DISMIS /NORMAL RETURN FOR PS/8 COMMANDS ION CDF CIF 10 JMP I .+1 GOSWITCH-3 NAMLOC, ZBLOCK 3 EXTENSION, 0 /"FC" OR "FD" LISTFLG, 0 NEWDEV, ZBLOCK 2 TEM7, 0 ATEM, 0 XCHAR, CHAR SHNDLR, 7607 /DEFINE LOWER FIELD INSTRUCTIONS . . . TGETC=JMS I . XGETC TPOPA=JMS I . MPOPA TPUSHA=JMS I . MPUSHA TPUSHF=JMS I . MPD2 TPOPF=JMS I . MPD3 TSORTJ=JMS I . MSORTJ ECHFLG, 0 OPNFLG, 0 IPNFLG, 0 FLNGTH, 0 STBLK, 0 DEVNO, 0 LIBBLK, 0 /FOR DEVICE NAME 0 7400 /LOAD POINT 0 /FOR DEVICE # LIBHND, 0 /HANDLER ENTRY TESTRM=JMS I . MSORTC ERROR1=JMS I . ERROR *66 CHAR, 0 /FOR OBSCURE FAKING REASONS INBLK, 0 0 5000 0 INHND, 0 OUTBLK, 0 0 5200 0 OUTHND, 0 TPRINTC=JMS I . MPRINTC TGETLN=JMS I . MGETLN TSPNOR=JMS I . XTSPNOR LIBFIL, 0 DEVHLD, 0 PAGE
/INITIAL TEXT FOR PS/8 FOCAL *200 PC0, 0 0 0 0 0 5051 BUFR LINE1 LINE0, 0 0 TEXT "C-PS/8 FOCAL, 1971" *.-1 7715 /DUMMY CR LINE1=. PAGE
/PS/8 FOCAL FILE ROUTINES *3614 RESTORE,TSPNOR /'OPEN RESTORE' COMMAND TAD CHAR /SAVE COMMAND CHAR (3 WORD COMMAND!) TPUSHA TGETC TESTRM /GO TO END OF COMMAND WORD SKP CLA JMP .-3 CLA CLL CMA /INITIALIZE ECHO SWITCH DCA ECHFLG JMS I [NAME /JUST TO SET ECHO MODE TPOPA TAD [-"I /OPEN RESTORE INPUT? SNA JMP I [IRST /YES TAD ["I-"O /NO, MUST BE OUTPUT SZA CLA ERROR1 /NEITHER ONE! JMP I [ORST OCLOSE, 0 /CLOSE THE OPEN OUTPUT FILE TAD OPNFLG SNA CLA /DON'T BOTHER IF IT ISN'T OPEN JMP I OCLOSE TAD [232 /WRITE '^Z' JMS NOCHAR TAD OPTR1 /PAD BUFFER WITH ZEROS TAD (-4400 /(AND WRITE IT OUT) SZA CLA JMP .-4 TAD DEVHLD /SAVED DEVICE # IOF CIF 10 JMS I USR 4 ONMTMP /POINTER TO SAVED NAME BLKCNT, 0 /FILE LENGTH (BLOCKS) ERROR1 /HUH? DCA OPNFLG /CLEAR 'FILE OPEN' FLAG ION CDF 10 TAD [OUTL /RESTORE TELETYPE OUTPUT ROUTINE DCA I [OUTDEV CDF JMP I OCLOSE /DO WHATEVER ELSE NEEDS TO BE DONE NOCHAR, 0 /PS/8 3/2 BUFFERED CHARACTER OUTPUT JMS I [FLDSET /CALLED FROM EITHER FIELD DCA CCIF /SAVE CALLING FIELD CDF TAD ATEM /CHARACTER TO BE OUTPUT AND (377 /MASK OUT GARBAGE ISZ O3 /WHICH CHAR OF THREE? JMP O2 /STRAIGHT PACKING JMS RT /HALF WORD PACKING - PACK FIRST HALF TAD ATEM /GET SAVED ARG JMS RT /PACK SECOND HALF CLA CLL CMA RTL /RESET 3-WAY SWITCH DCA O3 ISZ OCHCT /BUFFER CAN ONLY BE FILLED WITH 3RD CHAR OF 3 JMP CCIF /NOT FULL YET, RETURN TO CALLING ROUTINE JMS I [PUTDEV /TELL THE MONITOR THIS HANDLER'S IN CORE OUTHND-1 /POINTER TO DEVICE # AND ENTRY CLA CLL TAD OLNGTH /-MAXIMUM ALLOWABLE LENGTH TAD BLKCNT /LENGTH SO FAR SZL CLA /HAS HE GONE TOO FAR? JMP OOVER /YES, KILL HIM IOF JMS I OUTHND /WRITE ONE BLOCK BUFFER 4200 4400 OBLK, 0 JMP I [DERR /DEVICE ERROR ISZ OBLK /BUMP OUTPUT BLOCK ISZ BLKCNT /AND COUNT OF BLOCKS SO FAR JMS OSETUP /RESET POINTERS FOR NEXT BUFFER ION JMP CCIF O2, DCA I OPTR1 /NORMAL PACKING IS EASY! ISZ OPTR1 /BUMP POINTER CCIF, HLT /FILLED WITH CIF CDF JMP I NOCHAR O3=. /WHY NOT? RT, 0 /HALF-WORD PACK ROUTINE CLL RTL RTL DCA ATEM /SAVE FOR SECOND HALF TAD ATEM AND [7400 TAD I OPTR2 /ADD IN CHARACTER IN RIGHT HALF DCA I OPTR2 /PACK IT ISZ OPTR2 /BUMP POINTER AGAIN JMP I RT OOVER, DCA OPNFLG /HE BLEW IT - KILL THE FILE!! TAD DEVHLD IOF CIF 10 JMS I USR 4 ONMTMP 0 /LENGTH OF ZERO TO DELETE O7600, 7600 /IGNORE ERRORS ERROR1 /BECAUSE WE ALREADY KNOW ABOUT THEM OSETUP, 0 /RESET ALL THE POINTERS (WHAT FUN!) TAD OBLK-1 DCA OPTR1 TAD OBLK-1 DCA OPTR2 CLA CLL CMA RTL DCA O3 TAD O7600 DCA OCHCT JMP I OSETUP OPTR1, 0 OPTR2, 0 OLNGTH, 0 OCHCT, 0 PAGE
*5400 OOPEN, JMS I [IOWAIT /WAIT FOR TELETYPE TO FINISH (DECTAPES ARE SLOW!) JMS I [OPEN /CALL USR, HANDLER; ENTER OUTPUT FILE YINT, OUTBLK-1 /OUTPUT HANDLER BLOCK 3 /MONITOR 'ENTER' CODE YBLK, JMP TTYOUT /'OPEN OUTPUT TTY:' JMP OCLCHK /ERROR ON ENTER - SEE IF FILE ALREADY OPEN JMS I [DISMISS /KICK USR OUT TPUSHF /SAVE NAME AND OTHER CRAP NAMLOC TPOPF ONMTMP TAD STBLK /STARTING BLOCK DCA I (OBLK TAD FLNGTH /-MAXIMUM ALLOWABLE LENGTH DCA I (OLNGTH JMS I (OSETUP /SET UP PACKING POINTERS CLA CLL CMA /THERE'S A FILE OPEN! DCA OPNFLG TAD DEVNO /SAVE FOR CLOSE DCA DEVHLD DCA I (BLKCNT /DITTO ORST, TAD OPNFLG /ENTRY FOR 'OPEN RESTORE OUTPUT' SNA CLA /IF 'OPEN OUTPUT', FLAG IS ALREADY SET ERROR1 /NO OUTPUT FILE TO RESTORE CDF 10 ISZ ECHFLG /SKIP IF NO ECHO TAD IBLK+2 DCA I (OUTECH /SET OUTPUT ROUTINE TAD (OCHAR /POINTER TO FILE OUTPUT ROUTINE CIF CDF 10 DCA I [OUTDEV ION JMP I [PROC /FINISH THE LINE TTYOUT, TAD [OUTL /SWITCH OUTPUT TO TELETYPE (INTERRUPT) JMP .-5 FILEST, TAD I XCHAR /HERE'S WHERE FILES START!! DCA CHAR /GET NEXT CHAR CDF TAD (604 /SET '.FD' ASSUMED EXTENSION DCA EXTENSION TSPNOR /SKIP SPACES TAD CHAR /SAVE COMMAND CHAR TPUSHA TGETC TESTRM /GO TO END OF COMMAND WORD SKP CLA JMP .-3 TPOPA TSORTJ /GO DO COMMAND FILIST-1 FILGO-FILIST ERROR1 /OOPS - BAD 'O' COMMAND ICHAR, 0 /GET A CHARACTER FROM A FILE CLA CLL /MAKE SURE ISZ INCHT /DO WE NEED ANOTHER BUFFER? JMP I RDPTR /NO, UNPACK THE CHARACTER IOF JMS I INHND /YES, GO GET IT 0200 4000 IBLK, 0 SMA CLA /ONLY BOTHER WITH FATAL ERRORS SKP CLA JMP I [DERR /WE'VE GOT ONE ION ISZ IBLK /BUMP TO NEXT BLOCK TAD IBLK-1 /AND RESTORE POINTERS DCA IPNTR TAD [7200 DCA INCHT ICHAR1, TAD I IPNTR /STRAIGHTFORWARD UNPACK ROUTINE JMS RDPTR /DO COMMON CRAP ICHAR2, TAD I IPNTR /SAVE LEFT HALF FOR LATER AND [7400 DCA ITEMP ISZ IPNTR /INCREMENT TO NEXT WORD TAD I IPNTR /ANOTHER EASY ONE JMS RDPTR ICHAR3, TAD I IPNTR /THIS IS THE TRICKY ONE! ISZ IPNTR /GET LOW-ORDER HALF AND [7400 CLL RTR /SHIFT RIGHT RTR TAD ITEMP /GET HIGH-ORDER HALF (REMEMBER?) RTR /SHIFT SOME MORE RTR JMS RDPTR /GOT IT! JMP ICHAR1 /1-2-3-1-2-3-1-2-3 ... RDPTR, 0 /IF YOU DIDN'T KNOW, THIS IS A COROUTINE! AND [177 /ISN'T THAT AMAZING? SNA /IGNORE NULLS AND PARITY JMP ICHAR+1 TAD (-32 /END OF FILE? (^Z) SZA JMP .+5 /NO DCA IPNFLG /YES, CLEAR OPEN FILE FLAG CDF 10 /AND SET UP CLEVER KLUDGE TAD (EOF /TO CHECK FOR A STUPID DCA I [INDEV /'ATTEMPT-TO-READ-PAST-EOF'! TAD [232 /PASS ^Z TO PROGRAM (MIGHT COME IN HANDY) CIF CDF 10 JMP I ICHAR ITEMP, 0 IPNTR, 0 INCHT, 0 ONMTMP, ZBLOCK 4 PAGE
IOPEN, JMS I [IOWAIT /WAIT FOR TELETYPE (DECTAPES ARE STILL SLOW!) JMS I [OPEN /CALL THAT AMAZING GENERAL-PURPOSE SUBROUTINE INBLK-1 2 /MONITOR 'LOOKUP' JMP TTYIN /'OPEN INPUT TTY:' ERROR1 /WHOOPS - FILE NOT FOUND JMS I [DISMISS /BOOT THE USR OUT TAD STBLK /SET POINTERS AND OTHER CRAP DCA I (IBLK CLA CLL CMA DCA IPNFLG CLA CLL CMA DCA I (INCHT IRST, TAD IPNFLG /'OPEN RESTORE INPUT' COMES HERE SNA CLA /FLAG IS SET ALREADY IF 'OPEN INPUT' ERROR1 /NO INPUT FILE TO RESTORE TAD (ICHARF /SET I/O POINTERS CIF CDF 10 DCA I [INDEV ISZ ECHFLG /AND ECHO MODE TAD [PRINTC DCA I [2163 ION JMP I [PROC TTYIN, TAD [X133 /'OPEN INPUT TTY:' JMP TTYIN-7 MPUSHA, 0 /PUSH THE AC ON THE STACK JMS FLDSET /CALLED FROM EITHER FIELD DCA ACDF CDF 10 /DO SOME CRAZY, MIXED-UP POINTER SCRAMBLING TAD I (PDLXR DCA TEM7 CMA TAD TEM7 DCA I (PDLXR TAD TEM7 CIA CLL TAD I [BUFR SZL CLA PDERR, ERROR1 /PUSHDOWN OVERFLOW TAD I (PDLXR CDF DCA AUTO2 TAD ATEM DCA I TEM7 ACDF, CIF CDF JMP I MPUSHA MPD2, 0 /PUSH 4 WORDS ON THE STACK TAD I MPD2 /GET POINTER TO FIRST WORD TAD [3 /PUSH IN REVERSE ORDER DCA MPD3 ISZ MPD2 JMS FLDSET DCA FCDF CDF TAD [-4 DCA XCNTR FCDF, HLT /CHANGE FIELD TO CALLING FIELD TAD I MPD3 /GET THE NEXT WORD CIF CDF JMS MPUSHA /PUSH IT CLA CLL CMA /BACK UP POINTER TAD MPD3 DCA MPD3 ISZ XCNTR JMP FCDF /GET THE NEXT ONE TAD FCDF DCA .+1 0 /RESTORE CALLING FIELD JMP I MPD2 MPD3, 0 /POP 4 WORDS CLA CLL CMA /GET POINTER-1 TAD I MPD3 DCA AUTO3 ISZ MPD3 TAD (CDF RDF DCA FCIF TAD [-4 /FOUR WORDS DCA XCNTR CDF JMS MPOPA /GET ONE FCIF, CDF DCA I AUTO3 /PUT IT AWAY ISZ XCNTR /ALL DONE? JMP FCIF-2 /NO, GET ANOTHER CLL CLA CML RTL /YES, CHANGE CDF TO CIF CDF TAD FCIF DCA .+1 0 /CHANGE FIELD AND EXIT JMP I MPD3 MPOPA, 0 /POP A WORD JMS FLDSET /(THIS ONE'S EASY) DCA ACIF CDF 10 ISZ I (PDLXR CDF TAD I AUTO2 ACIF, CIF CDF JMP I MPOPA FLDSET, 0 DCA ATEM TAD FCDF+2 RDF JMP I FLDSET XRESTOR,TAD LISTFLG /PART OF ERROR ROUTINE TO RESET I/O TO TELETYPE SZA CLA JMS I [SWAPIN /RESTORE CORE SWAPPED BY DIRECTORY LIST CIF CDF 10 TAD [PRINTC /'OPEN INPUT TTY:,ECHO;OPEN OUTPUT TTY:' DCA I [2163 TAD [X133 DCA I [INDEV TAD [OUTL DCA I [OUTDEV JMP I .+1 RECOVX+3 MSORTC, 0 /CHECK FOR TERMINATOR CIF CDF 10 JMS I [TERMER ISZ MSORTC JMP I MSORTC PAGE
/LIBRARY COMMAND PROCESSOR /****** STORAGE ALLOCATION MAP ****** /***** ***** /* 3600 FILES (OUTPUT AND RESTORE) /* 4000 INPUT BUFFER (PAGE 1) /* 4200 INPUT BUFFER (PAGE 2) /* 4400 OUTPUT BUFFER (PAGE 1) /* 4600 OUTPUT BUFFER (PAGE 2) /* 5000 INPUT HANDLER /* 5200 OUTPUT HANDLER /* 5400 FILES (INPUT AND OPEN) /* /* 5600 PUSHDOWN LIST CONTROLS /* 6000 NAME, GTMON, DISMISS, IOWAIT /* 6200 HANDAD, COMPARE /* 6400 LOWLIB, SAVER, RETURN /* 6600 CHAINER, FETCHER, GOSUB /* 7000 LIBRARIAN /* 7200 MISCELLANEOUS /* 7400 LIBRARY HANDLER /***** ***** /************************************ NAME, 0 /READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV' JMS DISMIS /'GETC' WON'T WITH THE USR IN CORE TAD (5723 /CODE FOR 'DSK:' DCA NEWDEV /(DEFAULT DEVICE) DCA NEWDEV+1 JMS GNAME /GET FIRST PART (MIGHT BE DEVICE) TAD ["A-": /WAS IT A DEVICE? SZA CLA JMP I NAME /NO, ALL SET UP TGETC /YES, MOVE PAST ':' TAD NAMLOC /MOVE TO DEVICE AREA DCA NEWDEV TAD NAMLOC+1 JMP NAME+4 /GET FILENAME GNAME, 0 /READ A NAME INTO 'NAMLOC' DCA NAMLOC /CLEAR NAME AREA DCA NAMLOC+1 /(DON'T CLEAR ASSUMED EXTENSION) DCA NAMLOC+2 TAD [NAMLOC /INITIALIZE POINTERS DCA NMBASE CLA CMA DCA PERDSW DCA NAMECT TSPNOR SKP NAMEC, TGETC /MAIN LOOP TAD CHAR /LOWER FIELD COPY, OF COURSE TAD [-". /EXTENSION? SNA JMP PERD /YES, CLEAR DEFAULT EXTENSION TAD [".-", /COMMA? SNA CLA JMP ECHCHK /YES, CHECK FOR ECHO ECHGO, JMS DECODE /MUST BE A-Z, 0-9 JMP I GNAME /IT WASN'T, MUST BE END OF NAME SZL /RESTORE CHARACTER TAD [57 IAC DCA DECODE /TEMPORARY STORAGE TAD NAMECT /NO MORE THAN 6 CHARACTERS/NAME TAD [-6 SMA CLA JMP NAMEC TAD NAMECT /BUILD POINTER TO CHARACTER POSITION CLL RAR TAD NMBASE DCA TT TAD DECODE /LEFT OR RIGHT HALF? SZL JMP .+4 CLL RTL /LEFT, SHIFT OVER RTL RTL TAD I TT /ADD IN OTHER HALF DCA I TT ISZ NAMECT /BUMP COUNT JMP NAMEC /CONTINUE LOOP PERD, TAD NAMLOC /FOUND A PERIOD IN STRING SZA CLA ISZ PERDSW ERROR1 /DOUBLE PERIODS OR NO FILE NAME DCA EXTENSION /CLEAR EXTENSION TGETC /MOVE PAST PERIOD ISZ NMBASE /FAKE OUT POINTERS TAD [4 JMP NAMEC-3 ECHCHK, TGETC /MOVE PAST COMMA TSPNOR TAD CHAR /MUST BE FOLLOWED BY 'ECHO' TAD [-"E SZA CLA JMP I GNAME DCA ECHFLG /SET ECHO FLAG TGETC /MOVE TO END OF WORD JMS DECODE JMP I GNAME CLA CLL JMP .-4 DECODE, 0 /CHECK FOR A-Z, 0-9 TAD CHAR TAD [-"9-1 CLL TAD ["9+1-"0 SZL JMP DCDYES TAD ["0-"Z-1 CLL CML TAD ["Z-"A+1 SNL DCDYES, ISZ DECODE /IT WAS! JMP I DECODE NMBASE, 0 PERDSW, 0 NAMECT, 0 TT, 0 IOWAIT, 0 /WAIT FOR TELETYPE TO FINISH ION CDF 10 TAD I (TELSW /BUSY FLAG IS ZERO WHEN THROUGH SZA CLA JMP .-2 CDF IOF JMP I IOWAIT GTMON, 0 /LOCK THE USR IN CORE IOF /(NOP IF ALREADY IN CORE) CIF 10 JMS I USR 10 TAD [200 /SET POINTER FOR LATER CALLS DCA USR JMP I GTMON DISMIS, 0 /IF THE USR IS IN, KICK IT OUT CLA CLL TAD USR /CHECK POINTER TO FIND OUT SPA CLA JMP I DISMIS IOF CIF 10 JMS I USR 11 TAD ECHGO+10 /RESET POINTER DCA USR JMP I DISMIS PAGE
HANDAD, 0 /LOADS HANDLER INTO PROPER SLOT TAD I HANDAD /WHICH SLOT? ISZ HANDAD DCA SLOT JMS COMPARE /IF THE HANDLER HAS THE SAME NAME, -2 /DON'T LOAD IT AGAIN SLOT, 0 NEWDEV-1 JMP NOTEQ /DIFFERENT NAMES, LOAD NEW HANDLER ISZ AUTO5 TAD I AUTO5 /(SET BY 'COMPARE') DCA DEVNO /MOVE DEVICE # (FOR SAVE AND CLOSE) TAD AUTO5 /POINTS TO DEVICE # DCA .+2 JMS I [PUTDEV /SO USR KNOWS IT'S IN CORE 0 JMP I HANDAD NOTEQ, ISZ SLOT /BUMP POINTER TO SAVE NAME TAD NEWDEV /MOVE NEW DEVICE NAME TO TABLE DCA I SLOT ISZ SLOT TAD NEWDEV+1 DCA I SLOT ISZ SLOT JMS I [GTMON /WE MUST CALL THE USR, MIGHT AS WELL LOCK IT IN RETRY, TAD NEWDEV /MOVE DEVICE NAME FOR MONITOR CALL DCA DEVC TAD NEWDEV+1 DCA DEVC+1 TAD I SLOT /MOVE LOAD POINT DCA DLOAD CIF 10 JMS I USR /CALL MONITOR (ALREADY IN CORE) TABCPT, 1 DEVC, 0 0 DLOAD, 0 ERROR1 /DEVICE NOT AVAILABLE OR TWO PAGE HANDLER CLL TAD DLOAD /ENTRY POINT FOR HANDLER TAD [200 /IF THIS HANDLER IS IN PAGE 7600, SZL CLA /DON'T BOTHER TO CHECK FOR LEGALITY JMP HANDOK /SYSTEM HANDLER TAD DLOAD /IF THE HANDLER WAS NOT LOADED AND [7600 /INTO THE PROPER PAGE, RELOAD IT! CLL CIA TAD I SLOT /PROPER LOADING ADDRESS SNA CLA JMP HANDOK /EVERYTHING'S ALL RIGHT DCA DLOAD /CLEAR ENTRY POINT JMS I [PUTDEV /TELL USR THE HANDLER IS NOT DEVC+1 /IN CORE ANYMORE JMP RETRY /LOAD IT THIS TIME HANDOK, ISZ SLOT /BUMP POINTER TO DEVICE # TAD DEVC+1 /SAVE IT DCA I SLOT ISZ SLOT /MOVE TO ENTRY POINT TAD DLOAD /SAVE ENTRY DCA I SLOT TAD DEVC+1 /GET DEVICE # DCA DEVNO /SAVE IT AND EXIT JMP I HANDAD COMPARE,0 /COMPARE TWO BLOCKS OF INDEFINITE LENGTH TAD I COMPARE /CALLING SEQUENCE: ISZ COMPARE /JMS COMPARE DCA XCNTR / -# OF WORDS TO CHECK TAD I COMPARE / FIRST-1 ISZ COMPARE / SECOND-1 DCA AUTO5 /RETURN IF MATCH TAD I COMPARE /RETURN IF NO MATCH ISZ COMPARE DCA AUTO6 AGAIN, TAD I AUTO5 /COMPARE TWO WORDS CIA TAD I AUTO6 SZA CLA JMP I COMPARE /NO MATCH ISZ XCNTR /FINISHED? JMP AGAIN /NO, CHECK NEXT TWO ISZ COMPARE /YES, BUMP RETURN POINTER JMP I COMPARE MPRINTC,0 /CROSS-FIELD 'PRINTC' CIF CDF 10 JMS I (CPRNT JMP I MPRINTC TABCNT, 0 /TAB COUNTER (ONLY PRINTING CHARACTERS) TAD (-15 /7-BIT CR MEANS RETURN ONLY SNA JMP CRONLY TAD [-200 /CHECK FOR CR SNA JMP NEWLIN /TYPE CR,LF ISZ TABCNT TAD (215-240 SMA ISZ I TABCPT /IT PRINTS, INCREMENT COUNT NOP /IT JUST MIGHT SKIP TAD [240 CIF 10 JMP I TABCNT CRONLY, TAD [215 CIF 10 JMS I [PRINTX DCA I TABCPT TAD [200 /NULL FOR DELAY JMP TABCNT+1 NEWLIN, DCA I TABCPT JMP CRONLY-2 COMLIST,"S /SAVE "C /CALL "R /RUN "L /LIST "D /DELETE "G /GOSUB " /FAKE A 'LIBRARY RETURN' WITH A SPACE "E /EXIT FILGO, IOPEN OOPEN OCLOSR RESTOR PAGE
/ACTUAL LIBRARY PROCESSOR /STARTING WITH COMMAND DECODE: LOWLIB, CDF 10 /CLEAR SWITCH FOR NORMAL RETURN DCA I [GOSWITCH /I.E. TO 'PROC' FOR REST OF LINE TAD I XCHAR /MOVE CURRENT CHARACTER DOWN CDF DCA CHAR TAD CHAR /SAVE FOR COMMAND SORT TPUSHA TAD [603 /'.FC' ASSUMED EXTENSION DCA EXTENSION SKP CLA /MIGHT BE A TERMINATOR ALREADY TGETC /MOVE TO END OF COMMAND WORD TESTRM SKP JMP .-3 TPOPA /RESTORE COMMAND CHAR TSORTJ /AND BRANCH TO APPROIATE ROUTINE COMLIST-1 COMGO-COMLIST ERROR1 /SORRY, CHARLIE! COMGO, SAVER FETCHER CHAINER LIBRARIAN DELETE GOSUB RETURN C7600, 7600 SAVER, JMS I [NAME /GET NAME FOR SAVE JMS SAVE /DO IT JMP EXIT /EASY, WASN'T IT? SAVE, 0 /CALLED BY 'SAVE' AND 'GOSUB' JMS OCHK /CLOSE OUTPUT FILE TO AVOID TROUBLE TAD [NAMLOC /POINTER TO NAME DCA SAVEPT CDF 10 TAD I [BUFR /GET PROGRAM LENGTH CDF DCA I [207 /SAVE IT WITH THE PROGRAM JMS I [GTMON /CALL THE MONITOR JMS I [HANDAD /AND THE HANDLER LIBBLK-1 TAD I [207 /SAVED LENGTH, REMEMBER? AND C7600 /MASK OFF CLL RAR /CONVERT TO PAGES DCA BLOCK /FOR HANDLER TAD BLOCK /ROUND UP TO BLOCKS TAD [100 AND C7600 CLL RTR RAR DCA RECORD /FOR MONITOR 'ENTER' TAD RECORD /GET DESIRED LENGTH TAD DEVNO /(SET BY 'HANDAD') CIF 10 JMS I USR /ENTER OUTPUT FILE 3 SAVEPT, NAMLOC 0 ERROR1 /NO ROOM ON DEVICE TAD RECORD /SHIFT FOR CLOSING LENGTH CLL RTR RTR DCA SAVBLK TAD DEVNO /CLOSE THE FILE BEFORE WE WRITE IT! CIF 10 /(SURE, IT'S CHEATING, BUT JMS I USR /IT SAVES TIME!) 4 NAMLOC SAVBLK, 0 ERROR1 /IMPOSSIBLE ERROR! TAD SAVBLK /SAVE THIS CRAP TO REMEMBER CIA /WHERE THIS PROGRAM IS DCA LIBLEN /IN CASE WE WANT TO GOSUB TAD SAVEPT DCA LIBFIL TAD NEWDEV DCA LIBDEV TAD NEWDEV+1 DCA LIBDEV+1 TAD SAVEPT /MOVE STARTING BLOCK FOR WRITE DCA POINT4 CLL CML RAR /COMPUTE FUNCTION WORD IAC /SET TO SEARCH FORWARD TAD BLOCK /HOW MUCH TO WRITE DCA BLLL JMS I LIBHND BLLL, 0 /WRITE (BLOCK) BLOCKS FROM FIELD 0 200 /FROM 200 UP POINT4, 0 JMP I [DERR /GO COMPLAIN ABOUT DEVICE JMP I SAVE LIBLEN, 0 LIBDEV, ZBLOCK 2 RECORD, 0 BLOCK, 0 RETURN, TPOPA /GET BACK ALL THE JUNK WE SAVED CDF 10 /FOR THE LAST GOSUB DCA I XCHAR /IN-LINE CHARACTER CDF TPOPF /DEVICE NAME NEWDEV TPOPA /FILE LENGTH DCA FLNGTH TPOPA /STARTING BLOCK DCA STBLK JMS I [HANDAD /GET THE HANDLER BACK LIBBLK-1 JMP LOADGO /LOAD THE PROGRAM OCLOSR, JMS I [OCLOSE /CLOSE OUTPUT FILE CIF CDF 10 JMP I [PROC /ANOTHER EASY ONE! PUTDEV, 0 /TELL THE MONITOR A HANDLER IS IN OR OUT TAD I PUTDEV /GET POINTER TO DEV # AND ENTRY DCA RECORD TAD I RECORD /DEVICE # ISZ RECORD /BUMP POINTER TO ENTRY TAD (7646 /MONITOR TABLE DCA BLOCK /POINTER TO 'HANDLER-IN-CORE' FLAG TAD I RECORD /FLAG IS HANDLER ENTRY CDF 10 /TABLE IS IN FIELD 1 DCA I BLOCK CDF ISZ PUTDEV JMP I PUTDEV PAGE
/LOOKUP AND LOAD ROUTINES CHAINER,IAC /THESE ALL DO THE SAME THING GOSUB1, IAC /AND THEN GO TO DIFFERENT PLACES FETCHER,IAC CDF 10 DCA I [GOSWITCH CDF LOAD, JMS I [OPEN /CALL THE HANDLER AND LOOKUP THE FILE LIBBLK-1 2 JMP .+5 /TTY: NOT A DIRECTORY DEVICE ERROR1 JMS I [DISMISS JMS I (GETDEV /GET DEVICE TYPE SMA CLA ERROR1 /NOT A DIRECTORY DEVICE TGETLN /SOME COMMANDS HAVE LINE NUMBERS LOADGO, JMS I [DISMISS /ONLY USED BY 'RETURN' TAD STBLK /BLOCK TO READ FROM DCA POINT6 TAD AUTO2 /GET PUSHDOWN POINTER TAD [-200 /DIDDLE IT AND [7600 CLL RAL RTL RTL TAD FLNGTH /NOW COMPARE WITH LENGTH OF FILE SPA CLA JMP PDERR /PROGRAM TOO LONG CDF 10 CLA CLL CMA RAL /(=-2) TAD I [GOSWITCH /IS THIS A GOSUB? SZA CLA JMP .+7 /NO, SKIP THIS GARBAGE TAD I XCHAR /YES, SAVE PROGRAM NAME, ETC. CDF TPUSHA TAD [215 CDF 10 DCA I XCHAR CDF TAD FLNGTH /COMPUTE FUNCTION WORD CIA CLL RTL RTL RTL CLL CML RAL /SET TO SEARCH FORWARD DCA LENF1 JMS I LIBHND /GET THE PROGRAM LENF1, 3600 0200 POINT6, 0 JMP I [DERR TAD NEWDEV /SAVE THIS STUFF SO WE DCA LIBDEV /KNOW WHERE WE ARE TAD NEWDEV+1 DCA LIBDEV+1 TAD STBLK DCA LIBFIL TAD FLNGTH DCA LIBLEN TAD I [207 /MOVE PROGRAM LENGTH CDF 10 DCA I [BUFR CDF JMP EXIT /GO TO APPROPRIATE ROUTINE GOSUB, TAD LIBFIL /CHECK FOR CURRENT PROGRAM SZA JMP NOSAVE /NO NEED TO SAVE CORE TPUSHF /MOVE 'FOCAL.TM' TO NAME AREA FOCTXT TPOPF NAMLOC TAD (5723 /DEVICE 'DSK' FOR SAVE DCA NEWDEV DCA NEWDEV+1 JMS SAVE /SAVE FILE (THIS WILL LEAVE USR IN CORE) TAD [603 /RESET EXTENSION TO 'FC' DCA EXTENSION JMS I [DISMISS /KICK MONITOR OUT TO SAVE STARTING BLOCK TAD LIBFIL NOSAVE, TPUSHA /'LIBFIL' STILL IN AC TAD LIBLEN TPUSHA TPUSHF LIBDEV JMP GOSUB1 XTSPNOR,0 /DUPLICATE UPPER FIELD ROUTINE TAD CHAR TAD [-240 SZA CLA JMP I XTSPNOR TGETC JMP XTSPNOR+1 TTYTXT, DEVICE TTY /HANDY THING TO HAVE MSORTJ, 0 /ANOTHER DUPLICATE CIA DCA ATEM TAD I MSORTJ ISZ MSORTJ DCA AUTO4 TAD I AUTO4 SPA JMP MSEX TAD ATEM SZA CLA JMP .-5 TAD AUTO4 TAD I MSORTJ DCA ATEM TAD I ATEM DCA ATEM JMP I ATEM MSEX, ISZ MSORTJ CLA CLL JMP I MSORTJ FILIST, "I /INPUT "O /OUTPUT "C /CLOSE "R /RESTORE PAGE
/THIS SECTION DOES THE DIRTY WORK OF LISTING /ALL "FC"'S AND "FD"'S ON THE DEVICE REFERENCED /IT WAS FUN... LIBRARIAN, JMS I [NAME /GET DEVICE TO LIST JMS I [HANDAD /GET THE HANDLER LIBBLK-1 JMS I [DISMISS /KICK OUT USR (IN CASE HANDAD CALLED IT) JMS GETDEV /FIND DEVICE TYPE SMA CLA ERROR1 /CAN'T LIST A NON-DIRECTORY DEVICE JMS I SHNDLR /SWAP OUT CORE TO MAKE ROOM FOR DIRECTORY 4200 1000 40 /SYSTEM SCRATCH AREA JMP I [DERR /WHOOPS! CLA IAC /SET FLAG TO SWAP BACK IN DCA LISTFLG CLL CLA IAC /DIRECTORY BEGINS WITH BLOCK 1 BLOKLP, DCA LBLOCK IOF JMS I LIBHND 0200 1000 LBLOCK, 1 JMP I [DERR TAD (1004 /FIRST 5 WORDS ARE INFORMATION DCA AUTO4 LOOP2, TAD AUTO4 /SAVE FOR LATER DCA AUTO8 TAD AUTO4 DCA LIBX TAD I AUTO4 /LOOKING FOR .FC & .FD FILES SNA CLA JMP PATCH /ZERO FILE ISZ AUTO4 ISZ AUTO4 TAD I AUTO4 /PICK UP EXTENSION DCA LBLOCK TAD I (1004 /WASTE WORDS (NEGATIVE) CIA /THANKS FOR TELLING US, RITCHIE TAD AUTO4 /SKIP TO LENGTH DCA AUTO4 TAD I AUTO4 /ZERO LENGTH MEANS TEMPORARY FILE SNA JMP LOOP3 /IGNORE SUCH THINGS CLL CIA DCA FLNGTH /SAVE POSITIVE LENGTH TAD NAMLOC /IF A NAME WAS GIVEN, SEE IF WE SNA CLA /HAVE REACHED IT YET JMP TESTGO /NO NAME JMS I [COMPARE /COMPARE THIS NAME WITH ARG -4 LIBX, 0 NAMLOC-1 JMP LOOP3 /NON-MATCHING DCA NAMLOC /WE FOUND IT, DON'T CHECK ANY MORE TESTGO, TAD LBLOCK /COMPARE EXTENSION TAD (-604 /DO WE WANT THIS ONE? SZA IAC SZA CLA JMP LOOP3 /GUESS NOT DIRLIST,CLA CLL CMA RTL /PRINT 3 WORDS DCA COUNT TAD I AUTO8/SET BEFORE THIS JMS NPACK /PRINT 2 CHARS ISZ COUNT JMP .-3 TAD (". TPRINTC TAD I AUTO8 /PRINT EXTENSION JMS NPACK TAD (TABLE /SET UP FOR DECIMAL LENGTH PRINT DCA POINT ZLOOP, DCA ZERSW DCA COUNT NLOOP, TAD I POINT /FINISHED ALL POWERS OF 10? SNA JMP NEND /YES, ALL DONE TAD FLNGTH /NO, SUBTRACT THIS POWER SPA /UNDERFLOW? JMP DIGIT /YES, PRINT THIS DIGIT DCA FLNGTH /NO, GO THROUGH THE LOOP AGAIN ISZ COUNT /ADD ONE TO THIS DIGIT JMP NLOOP /ANOTHER DIVIDE CYCLE DIGIT, CLA CLL /CRAP IN AC ISZ POINT /NEXT POWER OF TEN TAD COUNT /IF THIS DIGIT IS ZERO, ISZ ZERSW /AND NO OTHER DIGITS HAVE BEEN NON-ZERO, SZA /PRINT A SPACE INSTEAD JMP NPRNT TAD [240 TPRINTC JMP ZLOOP NPRNT, TAD [260 /CHANGE TO ASCII TPRINTC CLA CLL CMA /SET ZERO SWITCH JMP ZLOOP NEND, TAD [215 /DONE WITH THIS LINE (WHEW!) TPRINTC JMP LOOP3 PATCH, ISZ AUTO4 /BUMP PAST EMPTY LENGTH LOOP3, ISZ I LBLOCK-1 /DONE WITH THIS BLOCK? JMP LOOP2 /NO, KEEP GOING LEXIT, JMS I [IOWAIT /WAIT FOR I/O TAD I [1002 /LINK TO NEXT BLOCK SZA /LAST BLOCK? JMP BLOKLP /NO, GET THE NEXT JMS SWAPIN /YES, RESTORE SWAPPED CORE AND EXIT JMP EXIT GETDEV, 0 /GET DEVICE TYPE FROM MONITOR TABLE TAD [7757 /DCB-1 TAD DEVNO DCA COUNT CDF 10 TAD I COUNT CDF JMP I GETDEV DECIMAL TABLE, -1000 -100 -10 -1 0 OCTAL POINT=NEWDEV ZERSW=NEWDEV+1 POINT7, 0 COUNT, 0 PAGE
/MISCELLANEOUS GENERAL-PURPOSE ROUTINES /THIS IS THE GENERAL OPEN SUBROUTINE /CALLNG SEQUENCE: /JMS I [OPEN /HANDLER BLOCK /MONITOR CALL CODE /RETURN IF TTY: IS DEVICE /ERROR RETURN /NORMAL RETURN /SETS STBLK, FLNGTH ON PAGE ZERO OPEN, 0 CLA CLL CMA /INITIALIZE ECHO FLAG TO OFF DCA ECHFLG JMS I [NAME /GET DEVICE AND FILENAME JMS I [COMPARE /DEVICE 'TTY:' IS SPECIAL -2 NEWDEV-1 TTYTXT-1 JMP OTHER /DEVICE OTHER THAN TTY ISZ OPEN /INCREMENT TO PROPER RETURN ISZ OPEN JMP I OPEN OTHER, TAD I OPEN /GET HANDLER BLOCK TO USE DCA HND ISZ OPEN TAD [NAMLOC /POINTER TO NAME DCA NAMPT JMS I [GTMON JMS I [HANDAD /GET THE HANDLER HND, 0 /SET TO HANDLER BLOCK TAD I OPEN /GET MONITOR CALL CODE (2 OR 3) ISZ OPEN DCA CALL DCA LNGTH /FOR MONITOR KLUDGE (IT FALLS THROUGH ON ERROR) TAD DEVNO /DO THE CALL CIF 10 JMS I USR CALL, 0 NAMPT, NAMLOC LNGTH, 0 JMP OTHER-2 /LET THE CALLING ROUTINE DECIDE ERROR PROCEDURE TAD LNGTH /MOVE PARAMETERS TO PAGE ZERO DCA FLNGTH TAD NAMPT DCA STBLK JMP OTHER-3 /AND TAKE NORMAL RETURN ERROR, 0 /LOWER FIELD ERROR ROUTINE JMS I [DISMIS /MAKE SURE TAD ERROR /FAKE OUT ERROR ROUTINE CIF CDF 10 /AND GO TO IT DCA I (ERR2 JMP I (ERR2+1 DELETE, JMS I [NAME /DELETE IS AN EASY ONE (THANK GOD!) JMS I [GTMON JMS I [HANDAD LIBBLK-1 JMS OCHK /CLOSE ANY OPEN OUTPUT FILE CIF 10 /DELETE THE FILE TAD DEVNO JMS I USR 4 NAMLOC 0 ERROR1 DCA LIBFIL /IN CASE HE JUST DELETED THIS PROGRAM JMP EXIT OCHK, 0 /IF ANY FILE EXISTS, CLOSE IT TAD DEVHLD SZA CLA JMS OCLOSE JMP I OCHK SWAPIN, 0 /RESTORE CORE AFTER DIRECTORY LIST DCA LISTFLG IOF JMS I SHNDLR 200 1000 40 DERR, ERROR1 /DEVICE ERROR JMP I SWAPIN NPACK, 0 /STANDARD 6-BIT UNPACK ROUTINE DCA OCHK TAD OCHK RTR RTR RTR JMS XFORM TAD OCHK JMS XFORM JMP I NPACK XFORM, 0 AND [77 SZA /PRINT SPACES FOR NULLS TAD (-40 SPA TAD [100 TAD [240 TPRINTC JMP I XFORM OCLCHK, TAD OPNFLG /MAKE 'OPEN OUTPUT' WITH AN ALREADY OPEN FILE SNA CLA /THE SAME AS 'OUTPUT CLOSE;OPEN OUTPUT' ERROR1 JMS OCLOSE TAD (YINT /FAKE OUT 'OPEN' DCA OPEN JMP OTHER MGETLN, 0 /CROSS-FIELD FAKE CIF CDF 10 JMS I (PGETLN JMP I MGETLN FOCTXT, FILENAME FOCAL.TM /USED BY 'GOSUB' XGETC, 0 /ANOTHER FAKE CIF CDF 10 JMS I (MGETC TAD I XCHAR CDF DCA CHAR JMP I XGETC PAGE $



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