File: LIB.PA of Tape: Sources/Focal/s6
(Source file text)
/&0 /DEFINITIONS OF FOC AND FLT IF NEEDED IFNZRO FFNASS < INTRPT=2604 GOSWIT=7157 XOUTL=2653 OUTDEV=63 TELSW=16 P=10 L=0 T=20 V=10 OUTECH=1345 OCHAR=1343 PROC=610 XINTEG=7166 EOF=1360 INDEV=64 ICHARF=6172 PRINTC=4552 CHIN=515 XI33=2701 EVAL=1607 HORD=45 FLTONE=2402 FLAC=44 MMINSK=1162 FLARG=7514 MGETC=1411 BUFR=60 PGETLN=2371 ERR2=2742 TERMER=1156 NMBSGN=3251 EXCLA=3257 QUOTS=3265 INPUTX=232 > IFNZRO LIBLST <XLIST> IFZERO LTNASS < EJECT OS-8 FOCAL IN-OUT AND UTILITY /&1 FIELD 0 *1 /INTERRUPT SERVICE ROUTINE JMP I .+1 INTSTO INTRPD, INTRPT 0 0 /FOR OD 0 *7 TSORTJ=JMS I . MSORTJ AUTO1, 0 /AUTO-INDEX REGISTERS...ACTUALLY USE SOME AUTO2, 0 AUTO3, 0 AUTO4, 0 AUTO5, 0 /COMPARE AUTO6, 0 /COMPARE AUTO7, 0 AUTO8, 0 XCNTR, 0 /GENERAL COUNTER- USR, 7700 /POINTER TO MONITOR (200 IF IN CORE) EXITOS, JMS I [DISMIS /NORMAL RETURN FOR PS/8 COMMANDS ION CDF CIF 10 JMP I .+1 GOSWITCH-3 NAMLOC, ZBLOCK 3 /USED BY NAME EXTENS, 0 /"FC", "FD", OR "FN" DERR, ERROR1 /DEVICE ERROR NEWDEV, ZBLOCK 2 /USED BY NAME TEM7, 0 ATEM, 0 /DEFINE LOWER FIELD INSTRUCTIONS . . . TGETC=JMS I . XGETC TPOPA=JMS I . MPOPA TPUSHA=JMS I . MPUSHA TPUSHF=JMS I . MPUSHF TPOPF=JMS I . MPOPF TPUSHJ=JMS I . MPUSHJ TPOPJ=JMP I . MPOPJ /&2 COMFLG, 0 /1:WRITE;0:READ ECHFLG, 0 /-1:NO ECHO OPNFLG, 0 /OOPEN:-1;OCLOSE:0 IPNFLG, 0 /IOPEN:-1;EOF:0 FLNGTH, 0 /SET BY OPEN STBLK, 0 /SET BY OPEN DEVNO, 0 /SET BY HANDAD LIBBLK, 0 /FOR DEVICE NAME 0 7200 /LOAD POINT 0 /FOR DEVICE # LIBHND, 0 /HANDLER ENTRY TESTRM=JMS I . MSORTC TINTEG=JMS I . MINTEG ERROR1=JMS I . ERROR CHAR, 0 /FOR OBSCURE FAKING REASONS INBLK, 0 0 6600 0 INHND, 0 OUTBLK, 0 0 6200 0 OUTHND, 0 COMBLK, 0 0 5600 COHLD, 0 COMHND, 0 TSPNOR=JMS I . XTSPNOR LIBFIL, 0 /STARTING BLOCK OF SAVED PROG;UNSAVED = 0 DEVHLD, 0 /OOPEN:DEV. NO. FOR CLOSE DCHAR, CHAR CLNGTH, 0 /SET BY COMMON SETBLK, 0 /THE RELATIVE BLOCK IN USE COWRIT, 1 /WRITE:1 READ:0 PAGE /&3 /PS/8 FOCAL FILE ROUTINES JMP .+4 /ALTERNATIVE FLD 0 ENTRY POINT CIF CDF P /OVERLAY CHAIN ENTRY POINT ION JMP I [PROC CIF CDF P JMP .-5 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' TPUSHJ NOCHAR TAD OPTR1 /PAD BUFFER WITH ZEROS TAD (-OUTBUF /(AND WRITE IT OUT) SZA CLA JMP .-5 TAD DEVHLD /SAVED DEVICE # IOF CIF 10 JMS I USR 4 /CLOSE ONMTMP /POINTER TO SAVED NAME BLKCNT, 0 /FILE LENGTH (BLOCKS);ZEROED BY OOPEN ERROR1 /HUH? DCA OPNFLG /CLEAR 'FILE OPEN' FLAG ION CDF 10 TAD [XOUTL /RESTORE TELETYPE OUTPUT ROUTINE DCA I [OUTDEV CDF JMP I OCLOSE /DO WHATEVER ELSE NEEDS TO BE DONE /&4 /OS/8 3/2 BUFFERED CHARACTER OUTPUT;PUSHJ HANDLES 2 FLD ACCES NOCHAR, AND (377 /MASK OUT GARBAGE ISZ O3 /WHICH CHAR OF THREE?;-3 INITIALLY 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 TPOPJ 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 OUTBUF OBLK, 0 /SET BY OOPEN JMP DERR /DEVICE ERROR ISZ OBLK /BUMP OUTPUT BLOCK ISZ BLKCNT /AND COUNT OF BLOCKS SO FAR JMS OSETUP /RESET POINTERS FOR NEXT BUFFER ION TPOPJ O2, DCA I OPTR1 /NORMAL PACKING IS EASY! ISZ OPTR1 /BUMP POINTER TPOPJ /&5 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 /SET BY OOPEN OCHCT, 0 IOWAIT, 0 /WAIT FOR TTY TO FINISH ION CDF P TAD I (TELSW /BUSY FLAG IS 0 WHEN THROUGH SZA CLA JMP .-2 CDF L IOF JMP I IOWAIT PAGE /&6 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 JMP TTYOUT /'OPEN OUTPUT TTY:' JMP I (OCLCHK /SEE IF FILE OPEN JMS I [DISMISS /KICK USR OUT TPUSHF /SAVE NAME AND EXTENSION NAMLOC TPOPF ONMTMP TAD STBLK /STARTING BLOCK DCA I (OBLK /IN NOCHAR TAD FLNGTH /-MAXIMUM ALLOWABLE LENGTH DCA I (OLNGTH /IN NOCHAR 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 /(SKP CLA) DCA I (OUTECH /SET OUTPUT ROUTINE TAD (OCHAR /POINTER TO FILE OUTPUT ROUTINE CIF CDF 10 DCA I [OUTDEV /FOR EACH CHAR. TO NOCHAR ION JMP I [PROC /FINISH THE LINE TTYOUT, TAD [XOUTL /SWITCH OUTPUT TO TELETYPE (INTERRUPT) JMP .-5 MINTEG, 0 /INTEGER FAKE CIF CDF P JMS I [XINTEG JMP I MINTEG /&7 ICHAR, 0 /GET A CHARACTER FROM A FILE CLA CLL /MAKE SURE ISZ INCHT /DO WE NEED ANOTHER BUFFER?;-1 INITIALLY JMP I RDPTR /NO, UNPACK THE CHARACTER IOF JMS I INHND /YES, GO GET IT 0200 INBUFF IBLK, 0 /SET BY IOPEN SMA CLA /ONLY BOTHER WITH FATAL ERRORS SKP CLA /REFERENCED! JMP 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 /&8 ITEMP, 0 IPNTR, 0 INCHT, 0 /SET TO -1 BY IOPEN ONMTMP, ZBLOCK 4 FILEST, TAD (604 /HERE'S WHERE FILES START! DCA EXTENSION /SET '.FD' ASSUMED 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 PAGE /&9 FILIST, "I /INPUT "O /OUTPUT "C /CLOSE "R /RESTORE "A /ARRAY=COMMON "T /TERMINATE(COMMON) 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 /IN ICHAR CLA CLL CMA DCA IPNFLG CLA CLL CMA DCA I (INCHT /IN ICHAR 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 (CHIN+6 ION JMP I [PROC TTYIN, TAD (XI33 /'OPEN INPUT TTY:' JMP TTYIN-7 FLD0=CLA CMA /PDL SATELLITES;FIELD 0 MPOPA, 0 MQL FLD0 CIF T JMS I .+1 ZPOPA MPUSHA, 0 MQL FLD0 CIF T JMS I .+1 ZPUSHA MPUSHF, 0 MQL FLD0 CIF T JMS I .+1 ZPUSHF /&10 MPOPF, 0 MQL FLD0 CIF T JMS I .+1 ZPOPF MPUSHJ, 0 MQL FLD0 CIF T JMS I .+1 ZPUSHJ MPOPJ, CIF CDF T JMP I .+1 ZPOPJ /THE FOLLOWING CODE WILL RECOGNIZE FOR EX.L C DATA(X) /AND LOOK FOR DATA99 IF X=99 NAMEVL, TAD I (NAMECT /CHECK NUMBER OF CHARS SNA /AT LEAST ONE ASCII IN FRONT JMP EVLERR TAD [-4 /AND AT MOST 4 SMA SZA CLA JMP EVLERR DCA TENS /CLEAR TEN COUNTER CDF P /GO TO EVAL TPUSHJ /'('READY,DUMP ')' EVAL TINTEG TAD (-144 /.LT. 100 (DEC) SZL /NOW WE HAVE X-100 EVLERR, ERROR1 TAD [12 /X-100+TENS*10 ISZ TENS SPA JMP .-3 MQL /OVERFLOW IS LOW ORDER TAD TENS /TENS IS 10 - HIGH ORDER CIA /HIGH ORDER - 10 TAD [12 /HIGH ORDER SNA /IS IT ZERO? JMP .+3 /YES!WRITE ONLY ONE DIGIT TAD [60 /6-BIT ASCII JMS I (NAMSTO MQA /LOW ORDER AGAIN TAD [60 JMS I (NAMSTO JMP I (NAMEC+1 TENS, 0 /&11 XSGN, CDF P /REAL SIGNUM FUNCTION TAD I [HORD SNA CLA TPOPJ /FSGN(0)=0 TPUSHF /DF P! FLTONE CDF P TPOPF FLAC XABS, CDF V /TAKE ABS OF FLAC TAD I FLARGH SMA CLA TPOPJ CDF P TPUSHJ MMINSK TPOPJ FLARGH, FLARG+1 TTYTXT, DEVICE TTY PAGE /&12 /LIBRARY COMMAND PROCESSOR /****** STORAGE ALLOCATION MAP ****** /***** ***** /* 200 RESTORE,OCLOSE,NOCHAR,IOWAIT /* 400 OOPEN,ICHAR,FILEST /* 600 IOPEN,POPUS,NAMEVL,XABS,XSGN /* 1000 NAME,GTMON,DISMISS /* 1200 HANDAD,COMPARE,LOADER,XTSPNO /* 1400 LOWLIB,SAVER,RETOUR /* 1600 CHAINER,FETCHER,GOSUB /* 2000 OPEN,BUMP,INTERRUPT /* 2200 ARRAY (COMMON) /* COMBUF=2600 OUTBUF=4600 INBUFF=5200 /* 5600 COMMON HANDLER /* 6200 OUTPUT HANDLER /* 6600 INPUT HANDLER /* 7200 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 /&13 NAMEC, TGETC /MAIN LOOP TAD CHAR /LOWER FIELD COPY, OF COURSE TAD [-"( /FILENUMBER TO EVALUATE? SNA JMP I (NAMEVL /GO DO IT 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 /6-BIT ASCII JMS NAMSTO JMP NAMEC /CONTINUE LOOP NAMSTO, 0 DCA DECODE /TEMPORARY STORAGE TAD NAMECT /NO MORE THAN 6 CHARACTERS/NAME TAD [-6 US7700, SMA CLA JMP NAMEC TAD NAMECT /BUILD POINTER TO CHARACTER POSITION CLL RAR TAD NMBASE DCA TT TAD DECODE /LEFT OR RIGHT HALF? SNL BSW /LEFT, SHIFT OVER TAD I TT /ADD IN OTHER HALF DCA I TT ISZ NAMECT /BUMP COUNT JMP I NAMSTO 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 /&14 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 /IF YES ISZ RETURN TAD [-"9-1 CLL TAD ["9+1-"0 SZL JMP DCDYES /NUMBER;CHAR-260;L=1 TAD ["0-"Z-1 CLL CML TAD ["Z-"A+1 SNL DCDYES, ISZ DECODE /ALPHA;CHAR-301;L=0 JMP I DECODE NMBASE, 0 PERDSW, 0 NAMECT, 0 TT, 0 /&15 XGETC, 0 /FAKE CDF P TPUSHJ MGETC JMP I XGETC GTMON, 0 /LOCK THE USR IN CORE IOF /(NOP IF ALREADY IN CORE) CDF L CIF P 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 IOF CDF L /MAKE SURE TAD USR /CHECK POINTER TO FIND OUT SPA CLA JMP I DISMIS CIF P JMS I USR 11 TAD US7700 /RESET POINTER DCA USR JMP I DISMIS PAGE /&16 /HANDAD CALL: HANDAD /SLOT /SETS DEVNO; DEVICE NO. IN SLOT; ENTRYPOINT IN SLOT 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 IAC /TWO PAGE HANDLER! DCA DLOAD CIF P JMS I USR /CALL MONITOR (ALREADY IN CORE) TABCPT, 1 /FETCH BY NAME DEVC, 0 /NAME 0 /RETURNS DEVICE NO. DLOAD, 0 /RETURNS ENTRY POINT ERROR1 /DEVICE NOT AVAILABLE CLL /&17 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 INTR76 /(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 NO MATCH TAD I COMPARE /RETURN IF 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 /&18 LOADER, JMS I [IOWAIT /THIS IS FOR CHAINING TO ANOTHER PROGRAM JMS I [NAME /OR FOR OVERLAYING FOCAL ITSELF(ST.ADD:00200) TAD [2326 /EXTENSION "SV" IS FORCED ON DCA EXTENSION /:IT HAS TO BE A SAVE FILE FOR USR CHAIN JMS I [OCHK /DON'T FORGET TO CLOSE THE FILES TAD [NAMLOC /POINTER TO NAME DCA .+10 TAD [2 DCA .+5 IAC /USR CHAIN EXPECTS IT TO BE ON SYS: DEV.#1 IOF /MAKE DOUBLY SURE! CIF P JMS I USR 2 /LOOKUP RETURNS FILE START IN ARG.2 NAMLOC 0 ERROR1 /USR DID NOT FIND IT DCA LIBBLK /KILL LIB HANDLER;CHAIN DOES RESET TAD [6 /OK! CHANGE USR FUNCTION TO CHAIN = 6 DCA .-6 JMP .-12 /BY-BY!! WILL SEE YOU SOME OTHER TIME! INTR76, 7600 XTSPNO, 0 /DUPLICATE SPNOR TAD CHAR TAD [-240 SZA CLA JMP I XTSPNO TGETC JMP XTSPNO+1 MSORTC, 0 CDF P TPUSHJ TERMER ISZ MSORTC JMP I MSORTC COMLIST,"S /SAVE "C /CALL "R /RUN "D /DELETE "G /GOSUB " /FAKE A 'LIBRARY RETURN' WITH A SPACE "E /EXIT "L /LOAD; CHAIN A PROGRAM USROUT, 7700 /ENDS LIST PAGE /&19 /ACTUAL LIBRARY PROCESSOR /STARTING WITH COMMAND DECODE: LOWLIB, JMS I [IOWAIT 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 APPROPRIATE ROUTINE COMLIST-1 COMPO-COMLIST ERROR1 /SORRY, CHARLIE! COMPO, SAVER FETCHER CHAINER BUMP GOSUB RETOUR C7600, 7600 LOADER SAVER, JMS I [NAME /GET NAME FOR SAVE JMS SAVPR /DO IT JMP EXITOS /EASY, WASN'T IT? SAVPR, 0 /CALLED BY 'SAVER' AND 'GOSUB' JMS I [OCHK /CLOSE OUTPUT FILE TO AVOID TROUBLE TAD [NAMLOC /POINTER TO NAME DCA SAVEPT CDF 10 TAD I [BUFR /GET PROGRAM LENGTH MQL JMS I [GTMON /CALL THE MONITOR JMS I [HANDAD /AND THE HANDLER LIBBLK-1 CDF T MQA /PROGRAM LENGTH DCA I (LINE0-1 /SAVE IT WITH IT MQA /&20 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':BITS 0-7 TAD RECORD /GET DESIRED LENGTH TAD DEVNO /(SET BY 'HANDAD') CDF L CIF P 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 /CLOSE NAMLOC SAVBLK, 0 /NO. OF BLOCKS 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 TAD (4021 /GET FUNCTION WORD TAD BLOCK /HOW MUCH TO WRITE DCA BLLL JMS I LIBHND BLLL, 0 /WRITE (BLOCK) BLOCKS FROM FIELD 2 200 /FROM 200 UP POINT4, 0 JMP DERR /GO COMPLAIN ABOUT DEVICE JMP I SAVPR /&21 LIBLEN, 0 /SAVED LENGTH LIBDEV, ZBLOCK 2 RECORD, 0 BLOCK, 0 RETOUR, TPOPA /GET BACK ALL THE JUNK WE SAVED CDF 10 /FOR THE LAST GOSUB DCA I DCHAR /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 I .+1 /LOAD THE PROGRAM LOADGO OCLOSR, JMS I [OCLOSE /CLOSE OUTPUT FILE CIF CDF P JMP I [PROC /ANOTHER EASY ONE! DCWBM, 7757 GETDEV, 0 /GET DEVICE TYPE FROM MONITOR TABLE TAD DCWBM /DCB-1 TAD DEVNO DCA BLOCK CDF P TAD I BLOCK CDF L JMP I GETDEV FOCTXT, FILENAME FOCAL.TM /USED BY GOSUB PAGE /&22 /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 CDF P TPUSHJ PGETLN /SOME COMMANDS HAVE LINE NUMBERS LOADGO, JMS I [DISMISS /ONLY USED BY 'RETURN' TAD STBLK /BLOCK TO READ FROM DCA POINT6 CDF T TAD I (PDLXR /BOTTOM OF PDL TAD MIN200 AND MIN200 /PAGES BSW CLL RTR /BLOCKS TAD FLNGTH /NOW COMPARE WITH LENGTH OF FILE SPA CLA ERROR1 /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 DCHAR /YES, SAVE PROGRAM NAME, ETC. CDF TPUSHA /PDL NOW CONTAINS: TAD [215 /CHAR,DEVICE,FILE LENGTH,START BLOCK CDF 10 DCA I DCHAR CDF TAD FLNGTH /COMPUTE FUNCTION WORD CIA BSW CLL CML RAL /SET TO SEARCH FORWARD TAD (20 /FIELD 2 DCA LENF1 JMS I LIBHND /GET THE PROGRAM LENF1, 1221 200 POINT6, 0 JMP DERR /&23 TAD NEWDEV /SAVE THIS STUFF SO WE DCA I (LIBDEV /KNOW WHERE WE ARE TAD NEWDEV+1 DCA I (LIBDEV+1 TAD STBLK DCA LIBFIL TAD FLNGTH DCA I (LIBLEN CIF CDF T TAD CODENU TAD I (PC0+2 DCA MSORTJ TAD I (PC0+2 SZA JMP I MSORTJ TAD I (LINE0-1 CDF P DCA I [BUFR CIF CDF L JMP EXITOS 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 I (SAVPR /SAVE FILE (THIS WILL LEAVE USR IN CORE) TAD [603 /RESET EXTENSION TO 'FC' DCA EXTENSION TAD LIBFIL /STARTING BLOCK NOSAVE, TPUSHA /'LIBFIL' STILL IN AC TAD I (LIBLEN TPUSHA TPUSHF LIBDEV JMP GOSUB1 /&24 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 MIN200, 7600 JMP I MSORTJ CODENU, 0 PAGE /&25 /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 /DEV # IN AC JMS I USR /2: LOOKUP CALL, 0 /3: ENTER NAMPT, NAMLOC /POINTER TO NAME;RETURNS START BLOCK LNGTH, 0 /RETURNS -FILE LENGTH IN BLOCKS;TENTATIVE FOR ENTER 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 /&26 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 BUMP, JMS I [NAME /DELETE IS AN EASY ONE (THANK GOD!) JMS I [GTMON JMS I [HANDAD LIBBLK-1 JMS I [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 EXITOS OCLCHK, TAD OPNFLG SNA CLA ERROR1 JMS I [OCLOSE TAD (YINT DCA OPEN JMP OTHER PUTPNT, 0 PUTDEV, 0 /TELL THE MONITOR A HANDLER IS IN OR OUT TAD I PUTDEV /GET POINTER TO DEV# AND ENTRY DCA ERROR TAD I ERROR /DEVICE# ISZ ERROR /BUMP POINTER TO ENTRY TAD (7646 /MONITOR TABLE DCA PUTPNT /POINTER TO 'HANDLER IN CORE' FLAG TAD I ERROR /FLAG IS HANDLER ENTRY CDF P /TABLE IS IN FIELD ONE DCA I PUTPNT CDF L ISZ PUTDEV JMP I PUTDEV /&27 FILGO, IOPEN OOPEN OCLOSR RESTOR ARRAY CCLOSR INTSTO, DCA ACSV /FLD L INTERRUPT HANDLER GTF DCA FLAGS CIF CDF P JMS I INTRPD JMP MORE1 /IT WAS'NT A TTY INTRPT;CHECK OTHER INTEXI, CLA CLL TAD FLAGS RTF CLA TAD ACSV JMP I 0 ACSV, 0 FLAGS, 0 MORE1, NOP /SKIP1 JMP MORE2 /VAR. FLD STILL ON DCA I XNMBSG /CLEARS HORD VAR "#" NOP /CLEAR1 JMP INTEXI MORE2, NOP /SKIP2 JMP MORE3 DCA I XEXCLA /VARIABLE "!" NOP /CLEAR2 JMP INTEXI MORE3, NOP /SKIP3 JMP NOMORE DCA I XQUOTS /VARIABLE """ NOP /CLEAR3 JMP INTEXI NOMORE, CAF ISZ IZER JMP .-1 JMP INTEXI IZER, 0 XNMBSG, NMBSGN XEXCLA, EXCLA XQUOTS, QUOTS PAGE /&28 XCOM, TINTEG /COMMON FOR 2048 4-W. VARIABLES DCA BLKTMP TAD BLKTMP AND (377 /ADRESS IN BUFFER CLL RTL /*4 : 4-WORD TAD I (COSTA /START OF BUFFER TPUSHA TAD BLKTMP AND [7400 /EFFECTIVELY AND 3400:8 BUFFERS BSW /OF 4 BLOCKS EACH TPUSHA /STORE RECURSIVELY TPUSHJ /PUT OR GET? ARG CLA CMA /GET DCA GEPUSW /PUT TPOPA /GET BLOCK # TPUSHJ COMEXT /GET BLOCK ISZ GEPUSW JMP COMPUT TPOPA /NOW GET ADRESS DCA GEPUSW TPUSHF GEPUSW, COMBUF CDF P TPOPF FLAC TPOPJ COMPUT, TPOPA DCA BLKTMP CDF P TPUSHF FLAC TPOPF BLKTMP, COMBUF IAC DCA COWRIT TPOPJ ARG, TAD CHAR TAD [-", SZA CLA TPOPJ CDF P TPUSHJ EVAL-1 IAC TPOPJ /&29 COMEXT, DCA THSBLK /ASKED FOR BLOCK TAD THSBLK CIA TAD SETBLK /IS IT ALLREADY HERE? SNA CLA TPOPJ /YES.EXIT CLL CML IAC RAL /+3 SO THAT WE DON'T WRITE ON ANOTHER FILE TAD THSBLK TAD CLNGTH /SET TO 0 BY CCLOSE SMA CLA ERROR1 /WE ARE ASKING FOR TO MUCH! JMS CORITE /WRITE OUT IF ANY MODIFICATIONS OR ZEROING TAD COMFLG /IN OR OUT? SNA CLA JMP COINPT TAD COCNT /LARGEST SO FAR CIA TAD THSBLK SPA CLA JMP COINPT /THSBLK .LT. COCNT;ALREADY OUT TAD COCNT DCA SETBLK /SET TO WRITE AND CLEAR NEXT BUFFER JMP COMEXT+1 COINPT, CLA CLL /LNK=0 FOR READ TAD THSBLK /READ ASKED FOR BLOCK MQL JMS I (COHNDL TAD THSBLK DCA SETBLK /NOW RESET DCA COWRIT /CLEAR WRITE FLAG TPOPJ /&30 CORITE, 0 /ALSO CALLED BY CCLOSE TAD COWRIT SNA CLA /ONLY WRITE IF NEW DATA JMP I CORITE CLA CLL CML /LNK=1 FOR WRITE TAD SETBLK /WRITE BLOCK IN CORE MQL JMS I (COHNDL CLA CMA /NOW CLEAR BUFFER TAD I (COSTA DCA AUTO3 TAD [-2000 DCA XCNTR DCA I AUTO3 ISZ XCNTR JMP .-2 TAD SETBLK CIA TAD COCNT /CHECK IF LAST BUFFER SZA CLA JMP I CORITE CLA CLL IAC RTL /4 TAD COCNT DCA COCNT /UPDATE COCNT JMP I CORITE CCLOSE, 0 /SUBROUTINE CALLED BY 'OPEN TERMINATE' AND 'OCHK' ISZ COWRIT /FORCE A LAST WRITE JMS CORITE TAD COMFLG SNA CLA JMP CLOOUT /ONLY CLOSE INTERNALLY JMS I [IOWAIT TAD COHLD /DEVICE NUMBER IOF CIF P JMS I USR 4 /CLOSE CNMTMP COCNT, 0 ERROR1 ION CLOOUT, DCA CLNGTH DCA SETBLK JMP I CCLOSE THSBLK, 0 PAGE /&31 COHNDL, 0 /SUB FOR READING OR WRITING ARRAY BUFFER SZL JMP .+6 /WRITE TAD SETBLK /READ TAD [12 /IF LAST WRITTEN BLOCK+4+7 CMA TAD I (THSBLK /IS SMALLER THAN ASKED FOR BLOCK CLA RTL /THEN ROTATE LINK FOR SEARCH FORWARD TAD [2000 /HERE LNK=0:READ;1:WRITE RAR /5000:WRITE;1000:READ;8 PAGES DCA COARG /1001:READ FORWARD MQA /BLOCK TAD CBLOCK /FIRST OF FILE DCA COSTA+1 JMS I [IOWAIT IOF JMS I COMHND COARG, 0 COSTA, COMBUF 0 SMA CLA /ONLY FATAL ERRORS SKP CLA JMP DERR ION JMP I COHNDL CBLOCK, 0 CNMTMP, ZBLOCK 4 REDFLG, 0 /&32 ARRAY, JMS I [IOWAIT /"OPEN ARRAY" TAD CLNGTH SZA CLA /FILE STILL OPEN? JMS I [CCLOSE /YES.CLOSE IT TAD (0601 /ASSUMED EXTENSION .FA DCA EXTENS JMS I [OPEN COMBLK-1 2 /FIRST DO A LOOKUP JMP NODIR /IT'S DIFFICULT TO READ FROM THE TTY SKP /THERE WAS'NT ANY FILE OF THAT NAME JMP COMON /FOUND IT! TAD ARPNT /FAKE 'OPEN' FOR ENTER DCA I [OPEN JMP I (OTHER COMBLK-1 3 /ENTER ARPNT, .-2 /IT CAN'T COME HERE;ALREADY TESTED ERROR1 /DEFINITELY AN ERROR CLA CLL CML IAC RAL /3 COMON, DCA REDFLG /SET TEMP FLAG JMS I [DISMIS JMS I [GETDEV /STILL WORSE FROM A DISPLAY SMA CLA NODIR, ERROR1 TPUSHF /EVERYTHING IS OK NAMLOC TPOPF CNMTMP /SAVE NAME FOR CLOSE TAD STBLK DCA CBLOCK /SAVE FIRST BLOCK CLL TAD FLNGTH TAD [100 /IS LENGTH GREATER THAN 100BLOCKS? SNL CLA CLL /YES;IGNORE TAD NODIR-1 /-100 DCA CLNGTH /STORE LENGTH .LE. 100 (NEG) TAD REDFLG CLL RAR /SET LINK IF OUT DCA COMFLG DCA I (THSBLK SZL JMP .+3 TPUSHJ COINPT /READ FIRST BUFFER IF INPUT DCA I (COCNT CIF CDF P ION JMP I [PROC /RETURN TO MAIN /&33 OCHK, 0 /IF ANY FILE EXISTS CLOSE IT TAD CLNGTH SZA CLA JMS I [CCLOSE JMS I [OCLOSE JMP I OCHK CCLOSR, TAD CLNGTH SZA CLA JMS I [CCLOSE CIF CDF P JMP I [PROC PAGE /&34 *COMBUF ZBLOCK 2000 /GET OUT THE PAGE 0 LITERALS > FIELD 2 IFNZRO LIBLST <XLIST>