UNIVERSAL IOLIB - PARAMETER FILE FOR IOLIB ROUTINES SUBTTL ROB COOK NOV-73 V:4 IF1,< SEARCH C,IO ;DEFINE A MACRO FOR EACH ROUTINE TO CALL TO SEARCH 'IO' AND TO ;SET THE SEGMENTATION DEFINE IOL$,< SEARCH C,IO TWOSEG RELOC 400000 SALL >;IOL$ ;DEFINE VERSION NUMBERS FOR IOLIB VERSN$ 5,205,2 ;5(205)-2 $$IOL==:BYTE (3)$VCOD (9)$VMAJ (6)$VMIN (18)$VEDT PURGE $VMAJ,$VMIN,$VEDT,$VCOD SUBTTL REVISION HISTORY COMMENT ! REVISIONS MAKING UP V:5 OF IOLIB: 143 BUG IN $MKBUF WHEREBY .BFADR IS WRONGLY ADDRESSED AS .BFHDR IS FIXED 144 REPLACE ALL OCCURENCES OF .BFSTS, .BFHDR AND .BFCNT BY NEW IO SYMBOLS $BFSTS, $BFHDR AND $BFCNT TO DEFEAT C V:7/V:6 CONFLICT 145 TYPO IN $RWORD WHICH HAS CAUSED NO OBSERVED PROBLEMS AND I DOUBT WHETHER IT COULD 146 RESTRUCTURE $ROCT? AND $RDEC? TO PROVIDE A BASIC NUMBER READER WHICH READS AN UNSIGNED INTEGER IN BOTH RADICES ($$RUDO). MAKE BOTH $RDECL AND $ROCTL USE THIS ROUTINE. 147 CHANGE $RCASH TO CALL $$RUDO TO AVOID THE PROBLEM WHEREBY $RDECL GOBBLES THE DECIMAL POINT IN THE CASH VALUE. ALLOW A USER TO SAY $3K. 150 CURE STACK BUG IN $CLRFD (ERROR IF NOT ENOUGH CORE) 151 CURE STACK BUGS IN $INPUT & $OUTPU WHICH WOULD PRODUCE ERRORS IF RUN OUT OF CORE 152 CURE STACK BUG IN $CRGET (SAME PROBLEM) 153 CURE BUG IN $TBUUO WHEREBY NAME OF RUN UUO DOES NOT GET WRITTEN 154 FIX BUG IN $RDATE WHICH GIVES STACK ERROR ON ILLEGAL CHARACTER 155 MAKE $$XCAL AND $$XUUO INTO INTERNALS 156 alter $wword so that it will not stop when it meets a blank character but will proceed until the whole word is empty 157 add new routines $wbwrd, $wcwrd, $wwwrd to write a number of words as a number of blocks, core (according to cpu type), and just words. alter $wpwrd and $wkwrd to write words if not exact multiple of unit 160 make $wdate more efficient 161 rewrite $cnvui a la scan v:6 162 rewrite $savex a la spr #10-13836 163 CORRECT BUG IN $ERRIO WHICH MADE SOME FILENAMES COME OUT IN THE WRONG FORMAT ON SOME ERRORS 164 CORRECT BUG IN $INPUT/$OUTPU WHICH MADE ALL IO ERRORS 'UNKNOWN' 165 CHANGE $BATCH TO USE A GETTAB INSTEAD OF OLD UNRELIABLE GETLCH 166 ADD $APEND AND $APDWT TO IMPLEMENT APPEND IO. (CODED BY RAY MACLEAN) 167 CORRECT NAMES OF $UPDW1 TO $UPDW0 170 CHANGES TO MAKE THE APPROPRIATE ROUTINES USE THE PATH SPEC BLOCK IN THE FDB INSTEAD OF EXPECTING TO HAVE A PATH SPEC BLOCK ALLOCATED FROM THE HEAP. CLEAN UP SOME PATH ORIENTED CODE. 171 INITIALISE THE WORDS $IDJPT AND $IDCPU IN THE IDB. ALTER CORE ROUTINES TO CHECK $IDCPU TO FIND THE PAGE SIZE. 172 CURE BUG IN $WPATH THAT PREVENTED THE NAMES OF SFDS FROM BEING TYPED 173 USE VERSN$ MACRO TO DEFINE VERSION NUMBER 174 IMPLEMENT THE $ADVIS ERROR ROUTINE TO HANDLE ADVISORY MESSAGES E.G. [TBA THIS IS A BIT OF ADVICE] $ADVIS IS NOT YET IMPLEMENTED FOR THE IO OR SYNTAX ERROR ROUTINES. 175 IMPLEMENT 5.07 TYPE VERBOSITY LEVEL HANDLING, WHEREBY YOU GRAB THE VERBOSITY FROM .GTWCH IN THE MONITOR NOTE THAT CONTINUATION LINES ARE 'NOT YET IMPLEMENTED'. 176 FIX $TBMTH SO THAT CODE DOES NOT GET GENERATED IN THE LOW SEGMENT 177 fix bug in edit #175 which gave a stack overflow 200 fix bug in edit #170 which resulted in $fdnmm being zeroed on all calls to $rfile 201 add a module to do MTAPE UUOs with one entry point for each individual function. All UUOs are followed by an MTWAT. to wait for completion, and MTBSF. is followed by a BOT check and MTSKF. over EOF if not. 202 add two new routines, $BEGIN and $BEGCC, to handle most of the stuff done by the BEGIN$ macro. $BEGCC does additional good things for CCL. 203 alter $INIID to get the program name etc etc from the monitor instead of relying on the values set up at run time. 204 add $INIID as an ENTRY to $IDATA 205 make $INIID set up $IDPPN as well as $IDPNM ! COMMENT ; 122 MAKE IOMOD BYTE POINTERS AVAILABLE TO ALL COMERS 123 RENAME 'XUUO' AND 'XCAL' TO '$$XUUO' AND '$$XCAL' FOR CONSISTENCY 124 ADD NEW NAME ENTRY POINTS: $XTCAL = $XTCLI $XTDCL = $XTDVC $CNVUI = $CNTDT $CNVIU = $CNVDT $CNVNU = $CNNOW $INIID = $INIDB 125 ALTER $OPEN TO RECOGNISE THE FC$CSC FLAG, AND START FREE CHANNEL SEARCH AT CHANNEL 1 UNLESS IT IS GIVEN 126 ALTER $RLEAS TO RECOGNISE FC$DBR AND NOT DEALLOCATE BUFFERS IF IT IS SET 127 SAVE JOB NUMBER AND PPN IN IDB AT $IDJNO AND $IJPP 130 ADD $SLEE0 ENTRY TO $SLEEP 131 FIX BUG IN $RSWIT WHICH CAUSES /HELP TO BOMB 132 NEW ENTRY POINTS TO $RFILE AND $RSWIT ($RFIL1 AND $RSWI1) TO SUPPORT QUERY$ BY PASSING ARGS IN A BLOCK POINTED AT BY T1 133 FIX BUG IN $ERRFD WHICH CAUSES ERXXX$ ERRORS TO BE PRINTED AS UNK, WHATEVER THEY WERE! 134 MOVE CODE TO CHECK WHETHER ERROR IS IN ERROR FILE FROM $ERROR TO $ERRIO 135 NEW ROUTINES $SAVET AND $RESTT (IN ONE MODULE) THAT SAVE AND RESTORE 4 TEMPORARIES T1-T4, USING THE STACK. 136 RENAME $TBEVL TO $TBWAD TO HELP SUPPORT QUERY$ AND PRMPT$ 137 ADD RANGE CHECK FOR ERROR TABLE, AND ROUTINE $$CDOR, TO WRITE AN ERROR MESSAGE IF THE CODE IS OUT OF RANGE 140 CHANGE $ENTER SO THAT $FDPRV AND RH($FDEXT) ARE NOT ZEROED UNTIL IT HAS BEEN DECIDED THAT AN ENTER UUO WILL BE EXECUTED 141 MAKE THE $RSWIT ENTRY POINT THE SAME AS $RSWI0. I.E. ASSUME ALWAYS THAT THE CALLER HAS READ THE '/' 142 ADD SECOND ENTRY POINT TO $RLEAS SO THAT DON'T NEED TO LOSE BUFFERS ; SUBTTL SYMBOL AND MACRO DEFINITIONS ; ASSEMBLY SWITCHES ND FT$ECD,-1 ;WRITE CODE WITH IO ERRORS ND $LNSTK,100 ;STANDARD STACK LENGTH ND SLPMIN,5 ;TIME TO SLEEP ; DEFINE DEFAULTS FOR STANDARD SWITCHES DM$ PRO,777,0,157 ;PROTECTION DM$ ROF,7,0,1 ;RUNOFFSET DM$ MXC,^D256,0,^D25 ;MAXCOR DM$ BSZ,^D10000,0,^D4000 ;BLOCKSIZE ; DEFINE A MACRO TO CREATE CODE FOR SETTING UP SYNTAX ERROR CODES DEFINE ERR$$(TXT,COD,TYP,OP),< TMP$$==EC$IND+[+[ASCIZ \'TXT'\]] IFNB ,< TMP$$==TMP$$+<<$ECT'TYP>B11>> OP T1,[TMP$$] PURGE TMP$$> >;IF1 PRGEND TITLE TMPFD - MAKE A TEMPCORE FDB SEARCH IOLIB IOL$ ; TMPFD ; BUILD AN FDB, AND INSERT A FILENAME OF THE FORM ; 'JJJNNN.TMP', WHERE JJJ IS THE ZERO-FILLED JOB ; NUMBER, NNN IS SUPPLIED BY THE CALLER. ; CALL: ; T1 : 3 SIXBIT CHARACTERS, RIGHT JUSTIFIED ; PUSHJ P,$TMPFD OR TMPFD$ ; D : POINT TO FDB ENTRY $TMPFD $TMPFD:: PUSH P,T1 ;SAVE INPUT MOVEI T1,3 ;MAKE JOB NUMBER INTO 6BIT PJOB T2, ;ASK MONITOR FOR JOB NUMBER SETZ T4, ;AC TO RECEIVE STRING TMP10: ;LOOP HERE ON EACH CHARACTER IDIVI T2,^D10 ;STRIP DIGIT ADDI T3,'0' ;TURN TO SIXBIT LSHC T3,-6 ;SHIFT INTO STRING SOJG T1,TMP10 ;BACK FOR MORE HLLM T4,(P) ;ADD INTO NAME MAKFD$ ,,TMP POP P,$FDNAM(D) ;SET NAME POPJ P, ; PRGEND TITLE TMPIN - READ A TEMPCORE FILE SEARCH IOLIB IOL$ ; TMPIN ; IF THE FILE IS REALLY IN TEMPCORE, READ IT AND SET ; FLAG SO THAT $INPUT KNOWS THAT IT HAS BEEN READ. ; OTHERWISE, LET INPUT DO THE HARD WORK. ; CALL: ; D : FILE POINTER ; PUSHJ P,$TMPIN OR TMPIN$ ; ERROR, T1 : ERROR CODE ; OK ENTRY $TMPIN $TMPIN:: HLRZ T1,$FDEXT(D) ;REALLY A 'TMP' FILE? CAIE T1,'TMP' ; JRST TMPFNF ;NO, GIVE FNF RETURN MOVE T1,[1,,203] ;BUFFER STATS MOVEM T1,$FDBUF(D) ; MOVEI T1,$FDIBH(D) ;HEADER ADDRESS MOVEM T1,$FDBHD(D) ; MKBUF$ ;BUILD BUFFER RING JRST TMPERR ;NO MORE CORE HRRZ T2,$FDIBH(D) ;BUFFER ADDRESS ADD T2,[POINT 7,1] ;MAKE UP BYTE POINTER MOVEM T2,<$FDIBH+.BFPTR>(D) ;SET IN HEADER HRLI T2,-200 ;IOWD FOR DUMP INTO BUFFER HRLZ T1,$FDNAM(D) ;LOAD 3 CHARACTER FILE NAME MOVE T3,[.TCRRF,,T1] ;TMPCOR FUNCTION (READ FILE) TMPCOR T3, ;TRY TO READ HIM JRST TMPFNF ;NOT IN TMPCOR IMULI T3,5 ;MAKE BUFFER COUNT INTO MOVEM T3,<$FDIBH+.BFCTR>(D) ; WORDS, AND SET IN HEADER MOVX T1,FC$TCI ;FLAG TEMPCORE INPUT MOVEM T1,$FDCHN(D) ; PJRST $POPJ1## ;GOOD RETURN TMPFNF: ;HERE IF NOT '.TMP' FILE OR NOT IN TMPCOR INPUT$ ;TRY ON DISK POPJ P, ;ERROR POPJ P, ;ENDFILE PJRST $POPJ1## ; TMPERR: ;HERE TO RETURN A TMPCOR ERROR HRLI T1,UUTMP$ ;TMPCOR FLAG POPJ P, ; PRGEND TITLE TMPDL - DELETE A TEMPCORE FILE SEARCH IOLIB IOL$ ; TMPDL ; DELETE A TEMPCORE FILE EITHER FROM DISK OR FROM TMPCOR ; CALL: ; D : FILE POINTER ; PUSHJ P,$TMPDL OR TMPDL$ ; ERROR, T1 : ERROR CODE ; OK ENTRY $TMPDL $TMPDL:: HRLZ T1,$FDNAM(D) ;LOAD 3 CHARACTER NAME SETZ T2, ;USE NO BUFFER MOVE T3,[.TCRDF,,T1] ;TMPCOR FUNCTION (DELETE) TMPCOR T3, ; JFCL ;OK, MUST BE ON DISK DELET$ ;KILL DAT FILE CAMN T1,[UULUK$,,ERFNF%] ;NOT FOUND? SKIPA ; POPJ P, ; RLEAS$ ; PJRST $POPJ1## ; PRGEND TITLE TMPOU - CLOSE A TEMPCORE OUTPUT FILE SEARCH IOLIB IOL$ ; TMPOU ; IF THE FILE IS NOT YET ENTERED (THEREFORE .LT. 1 BLOCK) ; TRY TO WRITE TO TMPCOR. ; IF FAIL, OR IF ENTERED ALREADY, WRITE TO DISK AND CLOSE ; CHANNEL DOWN ; CALL: ; D : FILE POINTER ; PUSHJ P,$TMPOU OR TMPOU$ ; ERROR, T1 : ERROR CODE ; OK ENTRY $TMPOU $TMPOU:: MOVE T1,$FDCHN(D) ;CHANNEL OPEN? TXNE T1,FC$ENT ; OR RATHER ENTERED? JRST TMPREL ;YES, OK RELEAS IS ENOUGH ;TRY TO WRITE INTO TMPCOR HRRZ T2,<$FDOBH+.BFADR>(D) ;BUFFER ADDRESS ADDI T2,1 ;IOWD POINT HRRZ T1,<$FDOBH+.BFPTR>(D) ;ADR OF CURRENT WORD SUB T1,T2 ;WORD COUNT MOVNS T1 ;NEGATIVE FOR IOWD HRL T2,T1 ;FORM FULL IOWD HRLZ T1,$FDNAM(D) ;3 CHARACTER NAME MOVE T3,[.TCRWF,,T1] ;TMPCOR FUNCTION (WRITEFILE) TMPCOR T3, ; SKIPA ;FAIL, SO WRITE TO DISK JRST TMPREL ;OK, RELEASE CHANNEL ANYWAY (LOSE BUFFER) OUTPU$ ;WRITE BUFFER (NEED THIS CALL TO DO ENTER) POPJ P, ;ERROR TMPREL: ;HERE TO RELEASE CHANNEL AND SKIP RETURN RLEAS$ ; PJRST $POPJ1## ; PRGEND TITLE RFILE - READ A FILENAME SEARCH IOLIB IOL$ COMMENT ; THIS ALGORITHM IS LIFTED (WITH SMALL MODIFICATIONS) FROM THE DEC PROGRAM SCAN.MAC. THE PARTS OF A FILENAME ARE: DEVICE NAME EXTENSION PATH SPECIFICATION SWITCHES. THEY MAY BE GIVEN IN ANY ORDER TERMINATED BY AN UNRECOGNISED CHARACTER AS A DELIMITER. PARTS GIVEN BEFORE THE NAME ARE STICKY, AND ARE REMEMBERED IN A DEFAULT FDB. PREVIOUS STICKY DEFAULTS ARE APPLIED TO THE GIVEN SPECIFICATION. SPACES ARE IGNORED WITHIN A FILENAME, AND MAY BE USED TO DELIMIT THE VARIOUS WORDS. THEY ARE NOT IGNORED WITHIN A SWITCH SPECIFICATION. ; ; ; CALL: ; D : FILE POINTER ; T1 : POINT TO 4 WORD BLOCK OF SWITCH TABLE POINTS ; T2 : LENGTH,,ADDRESS OF FDB ; PUSHJ P,$RFILE## OR RFILE$ ; ERROR, T1 : FLAGS,,MESSAGE-POINT ; T1 : DELIMITER ; T2 : FLAGS,,POINT TO FDB ENTRY $RFILE,$RFIL0,$RFIL1 $RFIL1:: ;[132] ENTRY WITH T1 : POINT TO ARG BLOCK JUMPE T1,$RFILE ;[132] IF ZERO, ESCAPE MOVE T2,1(T1) ;[132] PICK UP 2ND ARGUMENT SKIPA T1,0(T1) ;[132] PICK UP 1ST ARGUMENT $RFILE:: SETZB T1,T2 ;CLEAR ARGUMENTS $RFIL0:: EXCH T1,T2 ;CORRECT ARGUMENTS CLRFD$ T1 ;GET A VIRGIN FDB PJRST $$NOCR## ;YOU LOSE IF NEC SAVE2$ ;GRAB 2 PRESERVED HRRZ P1,T1 ;FDB POINT SKIPE T1,$IDDFD(I) ;LOAD DEFAULT FDB ADDRESS JRST RFI10 ;HAVE A GOOD ONE CLRFD$ T1 ;MAKE A NEW ONE PJRST $$NOCR## ;NO CORE MOVEM T1,$IDDFD(I) ;IN IDB RFI10: ;HERE TO SET DEFAULT POINT HRRZ P2,T1 ;AND IN AC PUSH P,T2 ;SAVE SWITCH POINT TXO P1,FF$NUL ;ASSUME NOTHING SPECIFIED RFI20: ;LOOP HERE FOR EACH PART OF A FILENAME SPECIFICATION RUCCH$ ;READ NEW CHARACTER RFI21: ;HERE IF NOTHING YET SPECIFIED RWNAM$ T1 ;READ A WILD NAME CAIE T1,":" ;DEVICE? JRST RFI30 ;NO JUMPE T2,NULDEV ;NULL DEVICES ARE BAD AOJN T3,WILDDV ; AS ARE WILD ONES SKIPE $FDDEV(P1) ;GOT A DEVICE ALREADY? JRST TWODEV ;YES, ERROR. PUSHJ P,$$LEFT## ;JUSTIFY DEVICE NAME MOVEM T2,$FDDEV(P1) ;NO, KEEP THIS ONE TXZ P1,FF$NUL ;SHOW SOMETHING SEEN JRST RFI20 ;BACK FOR MORE RFI30: ;HERE IF NOT A DEVICE THIS TIME JUMPE T2,RFI40 ;NUL MEANS NOT A NAME SKIPE $FDNAM(P1) ;GOT ONE ALREADY? JRST TWONAM ;YES, ERROR PUSHJ P,$$LEFT## ;LH#0 MOVEM T2,$FDNAM(P1) ;NO, SO KEEP THIS ONE MOVEM T3,$FDNMM(P1) ; AND HIS MASK PUSHJ P,MMSTIK ;REMEMBER STICKY PARTS MOVE T3,$FDNMM(P1) ;RECOVER T3 RFI37: ;HERE TO CHECK FOR WILDCARDS AOSE T3 ;WILD? TXO P1,FF$WLD ;YES, SET INDICATOR TXZ P1,FF$NUL ;SET SOMETHING SEEN RFI40: ;HERE IF NEITHER DEVICE OR NAME CAIE T1,"." ;EXTENSION COMING? JRST RFI50 ;NO. RWNAM$ ;READ IT PUSHJ P,$$LEFT## ;LH#0 SKIPE $FDEXT(P1) ;GOT ONE ALREADY? JRST TWOEXT ;YES. ERROR. HLR T2,T3 ;MASK INTO RH MOVEM T2,$FDEXT(P1) ;SAVE EXT,,MASK JRST RFI37 ;ANALYSE DELIMITER RFI50: ;HERE TO TRY FOR A PATH SPECIFICATION CAIE T1,"[" ;SPEC. COMI? JRST RFI60 ;NO. MOVX T1,FM$DIR ;[170] PATH SEEN ALREADY? TDNE T1,$FDMOM(P1) ;[170] JRST TWOPTH ;[170] YEAH! CAN'T TOLERATE THAT MOVEI T1,$FDPTH(P1) ;[170] ADDRESS OF PATH SPEC. BLOCK PUSHJ P,$RPAT1## ;[170] READ PATH SPEC. PJRST $XOPJ## ;ERROR MOVX T2,FM$DIR ;FLAG WHETHER DIRECTORY SEEN IORM T2,$FDMOM(P1) ; IN MODIFIER MASK SKIPGE T4 ;WAS DEFAULT SET? IORM T2,$FDMOD(P1) ;NO, SO FLAG IN MODIFIER TOO TXNE T4,FF$WLD ;[170???] WILD PATH? TXO P1,FF$WLD ;YES, SET WILD FILE SPEC. TXZ P1,FF$NUL ;SET SOMETHING SEEN JRST RFI21 ;AND LOOP BACK RFI60: ;FINALLY, WE MAY HAVE A SWITCH SPEC. COMING CAIE T1,"/" ;WELL? JRST RFI70 ;NO. MOVE T1,(P) ;RECOVER SWITCH IOWD MOVE T2,P1 ;SET UP FDB PUSHJ P,$RSWIT## ;[141] READ SWITCH (AND VALUE) PJRST $XOPJ## ;ERROR. JRST RFI40 ;BACK FOR MORE RFI70: ;MAY STILL BE A SPACE SEPARATOR CAIN T1," " ;IS IT? JRST RFI20 ;YES, BACK FOR MORE ;END OF FILE SPECIFICATION. MOVEM T1,(P) ;SAVE T1 (DELIMITER) SKIPN $FDNAM(P1) ;HAVE NAME YET? PUSHJ P,MMSTIK ;NO, SO EVERYTHING IS STICKY ;APPLY STICKY DEFAULTS MOVE T1,$FDDEV(P2) ;STICKY DEVICE SKIPN $FDDEV(P1) ;GIVEN ONE? MOVEM T1,$FDDEV(P1) ;USE STICKY SKIPE $FDEXT(P1) ;GIVEN EXTENSION? JRST RFI80 ;YES. MOVX T1,FM$NUL ;NO, SO SHOW NUL IORM T1,$FDMOD(P1) ; IORM T1,$FDMOM(P1) ; MOVE T1,$FDEXT(P2) ;USE STICKY EXTENSION MOVEM T1,$FDEXT(P1) ; RFI80: ;NOW FOR THE DIRECTORY MOVX T1,FM$DIR ;DIRECTORY GIVEN? TDNE T1,$FDMOM(P1) ; JRST RFI90 ;YES HRLI T1,$FDPPP(P2) ;[170] COPY STICKY DEFAULTS HRRI T1,$FDPPP(P1) ;[170] BLT T1,$FDPTM+FT$SFD-1(P1) ;[170][200] RFI90: ;HERE TO COPY THE MODIFIERS MOVE T1,$FDMOD(P2) ;GET THEM ANDCM T1,$FDMOM(P1) ;KILL ANY ALREADY SET IORM T1,$FDMOD(P1) ;SET DEFAULTS MOVE T1,$FDMOM(P2) ;SET MASK DEFAULTS IORM T1,$FDMOM(P1) ; ;SET BEFORE AND SINCE DEFAULTS MOVE T1,$FDBFR(P2) ; SKIPN $FDBFR(P1) ; MOVEM T1,$FDBFR(P1) ; MOVE T1,$FDSNC(P2) ; SKIPN $FDSNC(P1) ; MOVEM T1,$FDSNC(P1) ; ;SET DSK IF NO DEVICE GIVEN AT ALL MOVE T2,P1 ;SET UP FDB POINT FOR RETURN MOVEM P2,$IDDFD(I) ;SET UP DEFAULT FDB POINT SKIPE $FDDEV(P1) ;GIVEN? PJRST $TOPJ1## ;YES, RETURN MOVSI T1,'DSK' ;NO, SET DSK MOVEM T1,$FDDEV(P1) ; MOVX T1,FM$NDV ;SET THAT NO DEVICE WAS GIVEN IORM T1,$FDMOD(P1) ; IORM T1,$FDMOM(P1) ; PJRST $TOPJ1## ;GOOD RETURN NULDEV: ;HERE IF A DEVICE WAS GIVEN, BUT WAS NUL ERR$$ ,NDV,,SKIPA WILDDV: ;HERE IF DIRECTORY CONTAINED WILD CHARACTERS ERR$$ ,WDV,WORD,MOVE PJRST $XOPJ## TWODEV: ;HERE IF TWO DEVICES IN THE SAME SPEC. ERR$$ ,2DV,WORD,SKIPA TWONAM: ;HERE IF TWO NAMES IN THE SAME SPEC. ERR$$ ,2NM,WORD,MOVE PJRST $XOPJ## TWOEXT: ;HERE IF TWO EXTENSIONS IN THE SAME SPEC. ERR$$ ,2EX,WORD,SKIPA TWOPTH: ;HERE IF TWO PATH SPECIFICATIONS IN THE SAME FILE SPEC. ERR$$ ,2PT,,MOVE PJRST $XOPJ## MMSTIK: ;HERE TO REMEMBER THE STICKY DEFAULTS IN THE DEFAULT FDB SKIPE T2,$FDDEV(P1) ;DEVICE MOVEM T2,$FDDEV(P2) ; SKIPE T2,$FDEXT(P1) ;EXTENSION MOVEM T2,$FDEXT(P2) ; MOVX T2,FM$DIR ;DIRECTORY GIVEN? TDNN T2,$FDMOM(P1) ; JRST MMS20 ;NO HRLI T2,$FDPPP(P1) ;[170] REMEMBER PATH HRRI T2,$FDPPP(P2) ;[170] BLT T2,$FDPTM+FT$SFD-1(P2) ;[170][200] MMS20: ;HERE FOR THE MODIFIERS MOVE T2,$FDMOD(P1) ; MOVE T3,$FDMOM(P1) ; ANDCAM T3,$FDMOD(P2) ;CLEAR FIELDS SET IORM T2,$FDMOD(P2) ;SET FLAGS GIVEN IORM T3,$FDMOM(P2) ; SKIPE T2,$FDBFR(P1) ;/BEFORE MOVEM T2,$FDBFR(P2) ; SKIPE T2,$FDSNC(P1) ;/SINCE MOVEM T2,$FDSNC(P2) ; POPJ P, ; PRGEND TITLE RDVIC - READ A DEVICE SPECIFICATION SEARCH IOLIB IOL$ ; RDVIC ; READ A DEVICE SPECIFICATION FROM THE CURRENT FILE IN THE ; FORMAT: ; DEV: ; WILD AND NULL DEVICE NAMES ARE FORBIDDEN. ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RDVIC## OR RDVIC$ ; ERROR, T1 : ERROR CODE ; T1 : DELIMITER ; T2 : DEVICE NAME ENTRY $RDVIC,$RDVI0 $RDVIC:: RUCCH$ ;READ LEADING CHARACTER $RDVI0:: RNAME$ T1 ; CAIE T1,":" ;DEVICE? PJRST $$ILCH## ;NO. JUMPE T2,NULDEV ;NUL DEVICE IS BAD RUCCH$ ;GET DELIMITER PJRST $POPJ1## ; NULDEV: ;HERE ON NUL DEVICE NAME ERR$$ ,NDV,,MOVE POPJ P, PRGEND TITLE RPATH - READ A PATH SPECIFICATION SEARCH IOLIB IOL$ ; RPATH ; READ A PATH SPECIFICATION FROM THE CURRENT FILE IN THE FORMAT: ; [PJPG,SFD1,SFD2,...SFDN] ; WHERE PJPG IS THE PROJECT PROGRAMMER NUMBER AS READ BY THE ; $RPJPG ROUTINE, AND SFDX ARE THE VARIOUS SUBFILE DIRECTORIES. ; IF THERE ARE ANY SFDS, A PATH BLOCK IS BUILT SUITABLE FOR ; INPUT TO THE PATH. UUO, AND A DIRECTORY MASK BLOCK THAT ; MIRRORS THE PATH BLOCK. ; SFD SPECIFICATIONS MAY BE WILD ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RPATH## OR RPATH$ ; ERROR, T1 : ERROR CODE ; T1 : DELIMITER ; T2 : PPN OR POINT TO PATH SPEC. ; T3 : MASK OR POINT TO DIRECTORY MASK BLOCK ; T4 : FLAGS (1B0 NON-DEFAULT, 1B1 WILD) ENTRY $RPATH,$RPAT0,$RPAT1 $RPATH:: RUCCH$ ;READ CHARACTER CAIE T1,"[" ;OPEN PATH SPEC.? PJRST $$ILCH## ;NO, SO ILLEGAL CHARACTER $RPAT0:: ;HERE IF '[' ALREADY READ SETZ T1, ;[170] FLAG PAT0 ENTRY $RPAT1:: ;HERE IF PATH SPEC POINT IN AC(T1) SAVE2$ ;[170] MOVE P1,T1 ;[170] SAVE PATH POINT RPJPG$ ;READ THE PROJECT PROGRAMMER POPJ P, ;ERROR. CAME T3,[-1] ;ANY WILDCARDS? TXO T4,FF$WLD ;YES SKIPE P1 ;[170] SAVE PPN IN PATH BLOCK? MOVEM T2,2(P1) ;[170] YES, DO IT IFN FT$SFD,< JUMPGE T4,RPA15 ;[170] END IF DEFAULT SPEC. CAIE T1,"," ;SFD COMING? JRST RPA15 ;[170] NO, SO END ;MAKE A BLOCK TO TAKE THE PATH AND MASK SPECS. JUMPN P1,RPA05 ;[170] SKIP ALLOC IF HAVE PATH BLOCK MOVEI T1,FT$SFD*2+3 ;LONG ENOUGH FOR PATH AND MASKS ALLOC$ ;FIND FREE SPACE PJRST $$NOCR## ;NO SPACE MOVE P1,T1 ;SAVE POINT TO BLOCK RPA05: ;[170] HERE WITH PATH BLOCK MOVEM T2,2(P1) ;SAVE PPN MOVEM T3,(P1) ;SAVE PPN MASK MOVSI P2,-FT$SFD ;PERMITTED NUMBER OF SFDS ADDI P2,3(P1) ;ADDRESS OF FIRST SFD SLOT RPA10: ;LOOP HERE TO READ EACH SFD RWNAM$ ;READ THE NAME PUSHJ P,$$LEFT## ;JUSTIFY NAME JUMPE T2,NULSFD ;NUL NAMES ARE FORBIDDEN MOVEM T2,(P2) ;SAVE NAME MOVEM T3,FT$SFD+1(P2) ; AND MASK AOSE T3 ;SFD NAME WILD? TXO T4,FF$WLD ;YES, SET PATH WILD CAIE T1,"," ;ANOTHER SFD TO COME? JRST RPA15 ;NO, END AOBJN P2,RPA10 ;LOOP TILL SEEN ALL SFDS ;HERE WHEN SEEN TOO MANY SFDS RWNAM$ ;READ THE NAME ERR$$ ,TMS,WORD,SKIPA NULSFD: ;HERE IF SUBFILE DIRECTORY NAME IS EMPTY ERR$$ ,NLS,,MOVE POPJ P, RPA15: ;HERE WHEN LAST SFD READ JUMPE P1,RPA20 ;[170] SKIP IF NO PATH BLOCK MOVE T2,P1 ;SET POINT TO PATH BLOCK MOVEI T3,(P1) ; AND POINT TO MASK BLOCK RPA20: ;HERE WHEN FINISHED READING PATH SPEC. >;FT$SFD CAIE T1,"]" ;CORRECT DELIMITER? PJRST $$ILCH## ;NO RUCCH$ ;READ DELIMITER PJRST $POPJ1## ;GOOD RETURN PRGEND TITLE RPPN - READ A PPN SEARCH IOLIB IOL$ ; RPPN ; READ A PPN FROM THE CURRENT FILE IN THE FORMAT: ; [PJPG] ; WHERE THE PJPG HAS THE FORM DISCUSSED IN $RPJPG. ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RPPN## OR RPPN$ ; ERROR, T1 : ERROR CODE ; T1 : DELIMITER ; T2 : PPN ; T3 : MASK ; T4 : FLAGS (1B0 NON-DEFAULT 1B1 WILD) ENTRY $RPPN,$RPPN0 $RPPN:: RUCCH$ ;READ THE OPEN BRACKET CAIE T1,"[" ;CORRECT? PJRST $$ILCH## ;NO. $RPPN0:: ;ENTRY POINT IF BRACKET ALREADY READ RPJPG$ ;READ THE INTERIOR POPJ P, ;ERROR CAME T3,[-1] ;WILD? TXO T4,FF$WLD ;YES, SHOW SO CAIE T1,"]" ;CORRECT DELIMITER? PJRST $$ILCH## ;NO. RUCCH$ ;READ DELIMITER PJRST $POPJ1## ;GIVE GOOD RETURN PRGEND TITLE RPJPG - READ A PROJECT PROGRAMMER PAIR SEARCH IOLIB IOL$ ; RPJPG ; READ A PROJECT PROGRAMMER PAIR WITHOUT ENCLOSING []. ; THE 'PAIR' MAY BE ONE ALPHANUMERIC WORD, OR TWO OCTAL ; NUMBERS. THE INPUT IS TREATED AS NUMBERS UNLESS THE ; FIRST CHARACTER IS ALPHA. ; EITHER NUMBER MAY BE OMMITTED (OR BOTH) INDICATING ; THAT THE USER'S NUMBER IS TO BE USED. ; WILD CARDS ARE FINE. ; '-' INDICATES THAT THE DEFAULT PATH IS TO BE USED. ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RPJPG## OR RPJPG$ ; ERROR, T1 : ERROR CODE ; T1 : DELIMITER ; T2 : PPN ; T3 : MASK ; T4 : 0 IF DEFAULT, 1B0 OTHERWISE ENTRY $RPJPG,$RPJP0 $RPJPG:: RUCCH$ ;READ CHARACTER $RPJP0:: RWNUM$ T1 ;READ REST OF WILDNESS CAIE T1,"-" ;DEFAULT SPECIFIED? JRST RPJ10 ;NO ;HERE TO RETURN THE DEFAULT SPEC. PJUMPN T4,$$ILCH## ;ILLEGAL CHARACTER IF ANYTHING SEEN RUCCH$ ;READ THE DELIMITER PJRST $POPJ1## ;RETURN RPJ10: ;HERE TO INTERPRET THE PPN PUSHJ P,$$LEFT## ;FILL LH TLNE T3,(1B0) ;WILD? PJUMPL T2,RPJ20 ;NO, GO SET UP T4 AND EXIT IF ALPHA CAIE T1,"," ;CORRECT DELIMITER? PJRST $$ILCH## ;NO PUSH P,T2 ;SAVE PROJ SKIPE T4 ;OK IF NOTHING GIVEN TLNE T2,-1 ; BUT [0,] IS BAD TRNE T2,-1 ;OVERSIZE NUMBER? JRST ILPROJ ;YES+ HLRM T3,(P) ;AND MASK RWNUM$ ;READ PROGRAMMER SKIPE T4 ;OK IF NOTHING GIVEN, TRNE T2,-1 ; BUT [?,0] IS BAD TLNE T2,-1 ;OVERSIZE NUMBER? JRST ILPROG ;YES+ HLL T2,(P) ;MAKE PPN HRL T3,(P) ;MAKE MASK POP P,(P) ;ZAP TEMPORARY RPJ20: ;HERE TO SET NON-DEFAULT FLAG AND GIVE GOOD RETURN TXO T4,FF$NUL ;SHOW NON-DEFAULT PJRST $POPJ1## ;GIVE GOOD RETURN ILPROJ: ;HERE TO RETURN ERROR CODE FOR PROJECT NUMBER TOO BIG ERR$$ ,IPJ,OCTAL,SKIPA ILPROG: ;HERE TO RETURN ERROR CODE FOR PROGRAMMER NUMBER TOO BIG ERR$$ ,IPG,OCTAL,MOVE PJRST $XOPJ## ;POP STACK AND ERROR RETURN PRGEND TITLE RSWIT - READ A SWITCH AND ACT ON IT SEARCH IOLIB IOL$ ; RSWIT ; READ THE SWITCH TEXT AND THEN COMPARE IT WITH A GIVEN TABLE ; OF SWITCH NAMES ; IF A MATCH IS FOUND, READ A VALUE IF ONE IS PRESENT ; CHECK IT, SUPPLY A DEFAULT IF NECESSARY AND DEPOSIT ; IT WHEREVER REQUIRED ; ; CALL: ; D : CURRENT FILE ; T1 : POINT TO 4 WORD BLOCK OF SWITCH TABLE POINTERS ; T2 : POINT TO FDB IF DECODING FILE SWITCHES ; PUSHJ P,$RSWIT## OR RSWIT$ ; ERROR, T1 : ERROR CODE ; T1 : DELIMITER ENTRY $RSWIT,$RSWI0 $RSWIT:: $RSWI0:: ;HERE WITH SLASH READ SAVE3$ ;GET SAFE ACS MOVE P3,T2 ;SAVE FDB MOVE P2,T1 ;SAVE SWITCH TABLE POINT RNAME$ ;READ SWITCH NAME PJUMPE T2,$$ILCH## ;ERROR IF NO NAME PUSH P,T1 ;SAVE THE DELIMITER SETZ P1, ;INITIALISE AGAIN JUMPE P2,RSW10 ;NO USER TABLES IS FINE MOVE T1,$STNAM(P2) ;LOAD IOWD JUMPGE T1,NOTABS ;ERROR IF IOWD ZERO MATCH$ ;MATCH NAME AGAINST TABLE JRST [JUMPL T1,RSW10 ;NO MATCH, TRY USER'S SETO P1, ;SEVERAL. SET FLAG JRST RSW10] ; AND TRY USER'S JUMPL T1,RSW30 ;OK IF EXACT MOVE P1,T1 ;SAVE INDEX RSW10:! ;SEARCH THE STANDARD TABLE SKIPN T3,$IDSWT(I) ;LOAD POINT TO STANDARD TABLES JUMPE P2,NOMATC ;ERROR IF NO USER TABLE EITHER JUMPE T3,RSW20 ;O.K. UNLESS USER DUPLICATE MOVE T1,$STNAM(T3) ;LOAD IOWD JUMPGE T1,NOTABS ;ERROR IF NOT IOWD MATCH$ ;MATCH NAME AGAINST STANDARD TABLE JRST [JUMPG T1,DUPLSW ;DUPLICATE JUMPL P1,DUPLSW ;ALSO JUMPE P1,NOMATC ; UNKNOWN MOVE T1,P1 ;GET USER INDEX BACK JRST RSW30] ;PROCESS IT MOVE P2,$IDSWT(I) ;MUST BE STANDARD TABLE JUMPL T1,RSW30 ;EXACT, THEN OK RSW20: ;HERE WITH NO STANDARD TABLE AND USER AMBIGUITY JUMPL P1,DUPLSW ;ERROR IF DUPLICATE RSW30:! ;SWITCH NAME MATCHED. P2 POINTS TO TABLE. T1 CONTAINS INDEX. MOVE P1,T1 ;SAVE INDEX MOVE T3,@$STMAX(P2) ;PICK UP PROCESSOR DATA HRRZ T2,@$STDFT(P2) ;PICK UP DEFAULT MOVE T1,(P) ;PICK UP DELIMITER CAIN T1,":" ;VALUE COMING? JRST RSW40 ;YES ;HERE IF NO VALUE SPEC. TLNN T3,-1 ;MAX SET? JUMPN T3,(T3) ;NO, THEN PROCESS JUMPGE T3,$SWDPB ;YES, DEPOSIT MAX JRST RSW60 ;IF IOWD, DEPOSIT DEFALUT RSW40:! ;HERE TO READ VALUE JUMPG T3,(T3) ;PROCESS UNLESS IOWD JUMPE T3,VALILL ;VALUE ILLEGAL IF NOTHING THERE ;IOWD GIVES VALUES, SO LOOKUP VALUE IN TABLE RNAME$ ;READ NAME MOVEM T1,(P) ;SET DELIMITER FOR LATER MOVE T1,@$STMAX(P2) ;PICK UP IOWD MATCH$ ;COMPARE NAME WITH GIVEN TABLE JRST RSW50 ;NO MATCH MOVEI T2,(T1) ;SET INDEX FOR DEPOSIT JRST RSW60 ;GO DO IT RSW50:! ;HERE IF VALUE MATCH FAILS CAME T2,['0 '] ;ZERO IS OK JUMPN T2,UNKVAL ;UNKNOWN MOVEI T2,0 ;GIVE ZERO RSW60: ;HERE TO SET AGREED VALUE MOVE T1,@$STPNT(P2) ;LOAD BYTE POINTER TXNE T1,1B12 ;[131] A POINTER? JRST (T1) ;[131] NO. GIVE CONTROL TO USER JRST $SWDP0 ;DEPOSIT LOAD ; ERROR REPORTING CODE FOR ALL ERRORS DETECTED IN THE ABOVE MESS NOTABS: ERR$$ ,STI,,SKIPA DUPLSW: ERR$$ ,ASW,WORD,MOVE PJRST $XOPJ## NOMATC: ERR$$ ,USW,WORD,SKIPA UNKVAL: ERR$$ ,UKW,WORD,MOVE PJRST $XOPJ## VALILL: ERR$$ ,VIL,WORD,MOVE PJRST $XOPJ## ; SWMAX ; ; CHECK THAT THE VALUE READ BY A SWITCH ROUTINE DOES NOT ; EXCEED THE MAXIMUM SPECIFIED IN THE SWITCH TABLES. ; ; CALL: ; T1 : DELIMITER ; T2 : VALUE ; P1,P2 SET TO POINT TO SWITCH TABLES ; JRST $SWMAX $SWMAX:: HLRZ T3,@$STMAX(P2) ;LOAD MAX JUMPE T3,$SWDPB ;DON'T BOTHER IF NONE PJUMPL T2,$$DRNG## ;OUT OF RANGE CAMLE T2,T3 ;CHECK AGAINST MAX JRST $$DRNG## ;OUT OF RANGE ;FALL INTO $SWDPB ; SWDPB ; ; SET THE VALUE OF A SWITCH ACCORDING TO THE BYTE POINTER ; GIVEN FOR THAT SWITCH IN THE SWITCH TABLES ; ; CALL: ; T1 : DELIMITER ; T2 : VALUE ; P1,P2 SET TO POINT TO SWITCH TABLES ; JRST $SWDPB $SWDPB:: MOVEM T1,(P) ;HIDE IT AWAY $SWDP0:: MOVE T1,@$STPNT(P2) ;PICK UP POINT PJUMPE T1,$TOPJ1## ;RETURN IF NO BYTE POINT TLNN T1,-1 ;CATASTOPHE IF NOT HALT . ;BYTE POINTER DPB T2,T1 ;DEPOSIT BYTE PJUMPE P3,$TOPJ1## ;RETURN IF NOT FILE SWITCH SETO T2, ;MAYBE FDMOD HRRZ T3,T1 ;IF FDMOD CAIE T3,$FDMOD ; PJRST $TOPJ1## ; HRRI T1,$FDMOM ;SET MASK IN FDMOM DPB T2,T1 ; PJRST $TOPJ1## ;RETURN PRGEND TITLE SWKWD - READ A KWORD SWITCH VALUE SEARCH IOLIB IOL$ ; SWKWD ; READ A KWORD VALUE AND DISPACK TO CHECK IT AGAINST THE MAXIMUM ENTRY $SWKWD $SWKWD:: RKWRD$ ;READ IT PJRST $XOPJ## ;ERROR PJRST $SWMAX## ;CHECK RESULT PRGEND TITLE SWDEC - READ A DECIMAL SWITCH VALUE SEARCH IOLIB IOL$ ; SWDEC ; READ A DECIMAL VALUE AND DISPACH TO CHECK IT AGAINST THE ; MAXIMUM ENTRY $SWDEC $SWDEC:: RDECL$ ;READ VALUE PJRST $SWMAX## ;CHECK RESULT PRGEND TITLE SWOCT - READ AN OCTAL SWITCH VALUE SEARCH IOLIB IOL$ ; SWOCT ; READ AN OCTAL VALUE FROM THE CURRENT FILE AND DISPACH TO ; CHECK IT AGAINST THE MAXIMUM ALLOWED FOR THIS SWITCH ENTRY $SWOCT $SWOCT:: ROCTL$ ;READ OCTAL NUMBER PJRST $SWMAX## ; PRGEND TITLE SWNAM - READ A NAME VALUE OF A SWITCH SEARCH IOLIB IOL$ ; SWNAM ; READ A SIXBIT NAME FROM THE CURRENT FILE AND DISPACH TO ; DEPOSIT AS REQUIRED ENTRY $SWNAM $SWNAM:: RNAME$ ; PJRST $SWDPB## ; PRGEND TITLE SWTDY - READ A TIME AND DAY SWITCH VALUE SEARCH IOLIB IOL$ ; SWTDY ; READ THE TIME AND DATE FROM THE CURRENT FILE AND DISPACH ; TO HAVE IT DEPOSITED AS THE VALUE OF A SWITCH ENTRY $SWTDY $SWTDY:: RTDAY$ ; PJRST $XOPJ## ;EXIT GRACEFULLY PJRST $SWDPB## ; PRGEND TITLE SWFIL - READ A FILENAME AS A VALUE OF A SWITCH SEARCH IOLIB IOL$ ; SWFIL ; READ A FILENAME FROM THE CURRENT FILE AS THE VALUE OF ; A SWITCH. BE CAREFUL TO SAVE THE OLD SWITCH DEFALUT ; VALUE. ENTRY $SWFIL $SWFIL:: SETZM $IDDFD(I) ;KILL DEFAULT FDB RFILE$ ;READ A FILENAME PJRST $XOPJ## ;ERROR EXCH T1,$IDDFD(I) ;RETURN DEFAULT FDB TO HEAP LOSFD$ ; MOVE T1,$IDDFD(I) ;RECOVER DELIMITER PJRST $SWDPB## ;GO SAVE FDB POINT PRGEND TITLE SWHLP - HELP SWITCH PROCESSING SEARCH IOLIB IOL$ ; SWHLP ; EITHER SEND THE /HELP:TEXT BY WAY OF THE $WHELP ; ROUTINE, OR SEND A LIST OF ALL THE SWITCHES IF GIVEN ; /HELP:SWITCHES ; CALL: ; T2 : INDEX IN TABLE OF /HELP: KEYWORDS ; JRST $SWHLP## ENTRY $SWHLP $SWHLP:: WHELP$ ;ASSUME TEXT FOR NOW PJRST $XOPJ## ;ERROR PJRST $TOPJ1## ;GIVE GOOD RETURN PRGEND TITLE WHELP - WRITE OUT SOME HELP TEXT SEARCH IOLIB IOL$ ; WHELP ; FIND THE FILE CONTAINING THE HELP TEXT BY TRYING FIRST ; ON THE AREA FROM WHICH THE LOW SEGMENT WAS CREATED, AND ; THEN ON HLP:. ; CALL: ; PUSHJ P,$WHELP## OR WHELP$ ENTRY $WHELP $WHELP:: CLRFD$ ;GET AN FDB PJRST $$NOCR## ;ERROR IF NO CORE SKIPN T2,$IDHNM(I) ;USE HELP NAME UNLESS NUL MOVE T2,$IDPNM(I) ; THEN USE PROGRAM NAME MOVEM T2,$FDNAM(T1) ; MOVSI T2,'HLP' ;EXTENSION IS 'HLP' MOVEM T2,$FDEXT(T1) ; MOVE T2,$IDPDV(I) ;SET DEVICE NAME MOVEM T2,$FDDEV(T1) ; MOVE T2,$IDPPN(I) ; AND PPN MOVEM T2,$FDPPN(T1) ; PUSH P,D ;SAVE CURRENT FILE MOVE D,T1 ;USE HELP FILE LUKUP$ ; SKIPA ;FAIL. TRY ON HLP: JRST WHE10 ;GO DO COPY RLEAS$ ;LOSE CHANNEL MOVSI T2,'HLP' ;SET DEVICE MOVEM T2,$FDDEV(D) ; SETZM $FDPPN(D) ;CLEAR PPN LUKUP$ ;TRY AGAIN JRST NOHELP ;NOTHING WHE10: ;HERE TO COPY THE HELP FILE TO THE USER'S TTY: SETZ T2, ;SET OUTPUT TO USER'S TTY WHE20: ;HERE TO COPY EACH CHARACTER RBYTE$ ;READ A BYTE JRST ENDFIL ;ENDFILE EXCH T2,D ;SET OUTPUT FDB WCHAR$ ;SEND CHARACTER EXCH T2,D ;SET INPUT JRST WHE20 ;LOOP BACK FOR MORE NOHELP: ;HERE TO ADVISE THAT WE CAN'T HELP PUSH P,D ;SAVE FDB TRMFD$ ;WRITE TO TTY WARN$ POP P,D ;RECOVER FDB ENDFIL: ;ENDFILE RLEAS$ ;LOSE CHANNEL MOVE T1,D ;LOSE FDB LOSFD$ ; POP P,D ;RECOVER FDB PJRST $POPJ1## ;GIVE GOOD RETURN PRGEND TITLE TBSSW - TABLES OF STANDARD SWITCHES SEARCH IOLIB IOL$ ; TBSSW ; THESE TABLES CONTAIN THE SWITCHES: ; HELP ; MAXCOR ; VERBOSITY ; BLOCKSIZE ; RUN ; RUNOFF ; DENSITY ; PARITY ; PHYSICAL ; PROTECTION ; THE TABLES ARE CREATED BY THE SWTCH$ MACRO ENTRY $TBSSW ;FIRST DEFINE EACH SWITCH BY A SWITCH MACRO DEFINE SWIT$$,< SL$ <*HELP>,<-1,,SWHELP>,HELP,HELPTEXT SP$ ,<$IDTOP(I)>,$SWKWD##,MXC SL$ ,,VERB,VERBSTANDARD SP$ ,,$SWDEC##,BSZ SP$ ,,$SWFIL## SP$ ,,$SWOCT##,ROF SL$ ,,DENS,DENSIN SL$ ,,PAR,PARODD SS$ ,,1 SP$ ,,$SWOCT##,PRO > ;NOW USE THE SWITCH DEFINITION MACRO TO DO ALL THE WORK $TBSSW:: SWTAB$ STD ;USE THE KEYWD MACRO TO CREATE TABLES OF KEYWORDS FOR THOSE THAT NEED IT KEYWD$ HELP, KEYWD$ DENS, KEYWD$ PAR, KEYWD$ VERB, SWHELP: ;ADDRESS OF HELP ROUTINE JRST $SWHLP## ; PRGEND TITLE $LEFT - MAKE LH(WORD AND MASK) NON-ZERO SEARCH IOLIB IOL$ ; $LEFT ; THE WILD CARD READERS MAY LEAVE THE RESULT RIGHT JUSTIFIED ; IN THE ACS WHEREAS MOST ROUTINES REQUIRE THE RESULT LEFT ; JUSTIFIED. $LEFT CHECKS THE JUSTIFICATION AND MOVES ; THE RH LEFT IF THE LEFT IS EMPTY. ; CALL: ; T2 : WORD ; T3 : MASK ; T4 : NULL FLAG ; PUSHJ P,$$LEFT## ; T2 : WORD ; T3 : MASK ; T4 : NULL FLAG ENTRY $$LEFT $$LEFT:: TLNE T2,-1 ;ANYTHING IN LH? POPJ P, ;YES, OK SKIPN T4 ;ANYTHING THERE? SETO T3, ;NO - SET NO WILDS HRLZ T2,T2 ;NO. HRLO T3,T3 ; POPJ P, ; PRGEND TITLE RWNUM - READ A WILD NAME ASSUMING NUMERIC SEARCH IOLIB IOL$ ; RWNUM ; READ A STRING FROM THE CURRENT FILE, AND DECODE IT AS A SET ; OF POSSIBLY WILD OCTAL DIGITS UNLESS THE FIRST CHARACTER IS ; ALPHA. SET THE RESULT AS A NAME. ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RWNUM## OR RWNUM$ ; T1 : DELIMITER ; T2 : WORD CONTAINING VALUE ; T3 : MASK ; T4 : -VE IF SOMETHING SEEN ENTRY $RWNUM,$RWNU0 $RWNUM:: RUCCH$ ;LOOK AT THE FIRST CHARACTER $RWNU0:: SETZB T2,T4 ;CLEAR NUMBER ACCUMULATOR CAIE T1,"*" ;ALL WILD? JRST RWN10 ;NO MOVEI T2,377777 ;FUDGE A SUITABLE NAME JRST RWN15 ; AND RETURN RWN10: ;HERE UNLESS TOTAL WILDCARD SETO T3, ;INITIAISE MASK CAIL T1,"A" ;NUMERIC? JRST RWN20 ;NO JRST RWN40 ;YES ; RWNAM ; READ A NAME FROM THE CURRENT FILE WHERE THE NAME CAN ; INCLUDE WILDCARDS. THE NAME MAY BE ALPHANUMERIC ; OR NUMERIC STARTING WITH # AND ENDING WITH A POSSIBLE ; OCTAL MULTIPLIER ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RWNAM## OR RWNAM$ ; T1 : DELIMITER ; T2 : WORD ; T3 : MASK ; T4 : -VE IF SOMETHING SEEN ENTRY $RWNAM,$RWNA0 $RWNAM:: RUCCH$ ;PICK UP LEADING CHARACTER $RWNA0:: SETZB T2,T4 ;CLEAR RESULT ACCUMULATOR CAIE T1,"*" ;THOROUGHLY WILD? JRST RWN20 ;NO SUCH LUCK MOVSI T2,'* ' ;SET WORD RWN15: ;HERE TO RETURN A TOTALLY WILD WORD SETZ T3, ;CLEAR MASK RUCCH$ ;READ DELIMITER JRST RWN65 ;FINISH UP RWN20: ;HERE UNLESS ALL WILD SETO T3, ;SET MASK TO NO WILDS CAIE T1,"#" ;NUMBER COMING? JRST RWN70 ;YES RWN35: ;LOOP HERE FOR EACH OCTAL DIGIT TXO T4,FF$NUL ;SET NON-NUL RUCCH$ ;READ A CHARACTER RWN40: ;HERE WITH AN OCTAL DIGIT CAIE T1,"?" ;WILD DIGIT? JRST RWN50 ;NO LSHC T2,3 ;MOVE 7 INTO WORD AND 0 INTO MASK JRST RWN35 ;FIND NEXT DIGIT RWN50: ;HERE WITH NON-WILD DIGIT CAIL T1,"0" ;WITHIN RANGE? CAILE T1,"7" ; JRST RWN60 ;NO ROT T3,3 ;7 INTO MASK LSH T2,3 ;MULTIPLY WORD BY 8 ADDI T2,-"0"(T1) ;ADD IN NEW DIGIT JRST RWN35 ;READ NEW DIGIT RWN60: ;HERE TO APPLY OCTAL MULTIPLIERS PUSH P,T4 ;HOLD NUL FLAG PUSH P,T3 ;HOLD MASK MOVE T3,$$OMUL## ;ADDRESS OF OCTAL MULTIPLIERS PUSHJ P,$$MULT## ;APPLY MULTIPLIERS POP P,T3 ;RECOVER MASK IMUL T3,T4 ;SHIFT MASK POP P,(P) ;POP STACK TRNE T4,1B35 ;NO MULTIPLIER IF T4 IS 1 SKIPA T4,1(P) ;RECOVER OLD T4 RWN65: ;HERE TO SET NON-NUL AND EXIT MOVX T4,FF$NUL ;SET NUL RWN66: ;HERE TO EXIT PJUMPL T4,$POPJ## ;OK IF NON-NUL SETZ T3, ;NUL - KILL MASK POPJ P, ;BACK HOME RWN70: ;HERE TO START ALPHNUMERIC WORD SAVE2$ ;NEED SOME PRESERVED MOVE P1,[POINT 6,T2] ;BYTE POINT TO WORD MOVX P2,77B5 ;MASK CHARACTER MASK RWN80: ;HERE FOR EACH CHARACTER RANCH$ T1 ;ALPHANUMERIC? CAIN T1,"?" ;OR WILD? SKIPA ;YES JRST RWN66 ;EXIT PROPERLY TXNN P1,77B5 ;WORD FULL? JRST RWN90 ;YES SUBI T1,"0"-'0' ;NO, SO CONVERT TO SIXBIT IDPB T1,P1 ;ADD INTO WORD CAIN T1,'?' ;WILD CHARACTER? XOR T3,P2 ;ZERO APPROPRIATE BITS IN MASK LSH P2,-6 ;ADVANCE MASK MASK RWN90: ;HERE AFTER EACH CHARACTER RUCCH$ ;READ ANOTHER CHARACTER MOVX T4,FF$NUL ;SET NUL JRST RWN80 ;LOOP BACK PRGEND TITLE RCASH - READ IN MONEY AMOUNT SEARCH IOLIB IOL$ ; RCASH ; ; READ DOLLARS AND CENTS AND CONVERT TO INTEGER CENTS. ; THE POSSIBLE FORMATS ARE: ; CCCCC ; DDD.CC ; $DDD.CC ; $DDD ; ; CALL: ; D : INPUT FDB ; PUSHJ P,$RCASH ; ERROR, T1 : ERROR CODE ; T1 : DELIMITER ; T2 : CENTS ENTRY $RCASH,$RCAS0 $RCASH:: RUCCH$ ;LEADING CHARACTER $RCAS0:: SAVE1$ ;PRESERVED AC MOVEI P1,^D1 ;ASSUME CENTS PUSHJ P,$$SIGN## ;CHECK POSSIBLE SIGN CAIE T1,"$" ;DOLLARS COMING JRST RCA10 ;NO MOVEI P1,^D100 ;YES, SET MULTIPLIER RUCCH$ ;EAT NEXT CHARACTER RCA10: ;HERE WITH 1ST DIGIT READ PUSHJ P,$$RUD0## ;[147] READ AN UNSIGNED NUMBER MOVE T3,$$DMUL## ;[147] SET DECIMAL MULTIPLIERS PUSHJ P,$$MULT## ;[147] APPLY DECIMAL MULTIPLIER CAIN T1,"." ;CENTS DELIMITER? MOVEI P1,^D100 ;FORCE NUMBER READ TO DOLLARS IMUL T2,P1 ;MAKE INTO CENTS CAIE T1,"." ;IF CENTS COMING PJRST $POPJ1## ;NOT, SO GOBACK NOW ;HERE TO READ TWO DIGITS WORTH OF CENTS RUCCH$ ;READ SOME CAIL T1,"0" ;NUMERIC? CAILE T1,"9" ; PJRST $POPJ1## ;OK, 'TIS THE DELIMITER MOVEI T1,-"0"(T1) ;MAKE BINARY IMULI T1,^D10 ;ADD INTO CENTS ADD T2,T1 ; RUCCH$ ;READ SECOND DIGIT CAIL T1,"0" ;NUMERIC? CAILE T1,"9" ; PJRST $$ILCH## ;MUST BE NUMERIC NOW ADDI T2,-"0"(T1) ;ADD INTO CENTS RUCCH$ ;LOAD DELIMITER PJRST $POPJ1## ;RETURN PRGEND TITLE RTDAY - READ THE DATE AND TIME SEARCH IOLIB IOL$ ; RTDAY ; READ THE DATE AND TIME FROM THE CURRENT FILE IN THE FORMAT ; DD-MMM-YY:HH:MM:SS ; EITHER THE DATE OR TIME MAY BE OMMITTED, IN WHICH CASE ; 1-JAN-64 IS ASSUMED FOR THE DATE, AND 00:00:00 FOR THE ; TIME ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RTDAY## OR RTDAY$ ; ERROR, T1 : ERROR CODE ; T1 : DELIMITER ; T2 : TIME IN MILLISECS ; T3 : DATE IN INTERNAL FORM ENTRY $RTDAY,$RTDA0 $RTDAY:: RUCCH$ ;READ LEADING CHARACTER $RTDA0:: ;HERE WITH LEADING CHARACTER RDECL$ T1 ;READ REST OF NUMBER PUSH P,[0] ;SAVE THE NULL DATE CAIE T1,"-" ;WAS NUMBER DATE OR HOUR? JRST RTD10 ;NOT DATE PUSHJ P,$RDAT1## ;READ REST OF DATE PJRST $XOPJ## ;ERROR RETURN EXCH T2,(P) ;SAVE DATE, SET NULL TIME CAIE T1,":" ;TIME COMING? JRST RTD20 ;NO, EXIT CORRECTLY RDECL$ ;READ HOURS RTD10: ;HERE WITH HOURS IN T2 AND DATE ON STACK PUSHJ P,$RTIM1## ;READ REST OF TIME PJRST $XOPJ## ;ERROR RETURN RTD20: ;HERE WITH TIME IN T2 AND DATE ON STACK POP P,T3 ;RECOVER DATE PJRST $POPJ1## ;RETURN PRGEND TITLE RTIME - READ THE TIME SEARCH IOLIB IOL$ ; RTIME ; READ THE TIME FROM THE CURRENT FILE IN THE FORMAT ; HH:MM:SS ; THE MINUTES OR SECONDS FIELDS MAY BE MISSING ; AND IF SO ARE ASSUMED ZERO. ; 24:00 IS INTERPRETED AS 00:00 ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RTIME## OR RTIME$ ; ERROR, T1 : ERROR CODE ; T1 : DELIMITER ; T2 : TIME IN MILLISECS ENTRY $RTIME,$RTIM0,$RTIM1 $RTIME:: RUCCH$ ;READ LEADING CHARACTER $RTIM0:: ;HERE WITH LEADING CHARACTER IN T1 RDECL$ T1 ;READ REST OF HOURS $RTIM1:: ;HERE WITH HOURS IN T2 PJUMPL T2,$$DRNG## ;NUMBER OUT OF RANGE CAIN T2,^D24 ;24 HOUR CLOCK MOVEI T2,0 ;ASSUME 00:00 CAILE T2,^D23 ;WITHIN RANGE? PJRST $$DRNG## ;NUMBER OUT OF RANGE SAVE2$ ;AND PRESERVE ACCUMULATED TIME MOVE P1,T2 ; MOVSI P2,-2 ;NOW READ SAME FORMAT TWICE RTI10: ;LOOP HERE FOR MINUTES AND FOR SECONDS IMULI P1,^D60 ;CONVERT TO MINUTES(SECONDS) CAIE T1,":" ;MINUTES TO COME? JRST RTI20 ;NO. RDECL$ ;READ MINUTES PJUMPL T2,$$DRNG## ;NUMBER OUT OF RANGE CAIL T2,^D60 ;WITHIN RANGE? PJRST $$DRNG## ;NUMBER OUT OF RANGE RTI20: ;HERE WITH HOURS IN P1 AND MINUTES IN T2 ADD P1,T2 ;ADD MINUTES TO HOURS AOBJN P2,RTI10 ;LOOP BACK IF SECONDS TO COME IMULI P1,^D1000 ;CONVERT TOTAL TO MILIISECS MOVE T2,P1 ;RECOVER TIME PJRST $POPJ1## ; PRGEND TITLE RDATE - READ THE DATE SEARCH IOLIB IOL$ ; RDATE ; READ THE DATE FROM THE CURRENT FILE IN THE FORMAT ; DD-MMM-YY ; NO ASSUMPTIONS ARE MADE, AND ALL FIELDS MUST BE PRESENT. ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RDATE## OR RDATE$ ; ERROR, T1 : ERROR CODE ; T1 : DELIMITER ; T2 : DATE IN INTERNAL FORMAT ENTRY $RDATE,$RDAT0,$RDAT1 $RDATE:: RUCCH$ ;READ LEADING CHARACTER $RDAT0:: ;HERE WITH LEADING CHARACTER IN T1 RDECL$ T1 ;READ REST OF DAY $RDAT1:: ;HERE WITH DAYS IN T2 PJUMPL T2,$$DRNG## ;OUT OF RANGE (-VE) CAIE T1,"-" ;CORRECT DELIMITER? PJRST $$ILCH## ;NO PUSH P,T2 ;SAVE DAY RNAME$ ;READ THE MONTH NAME CAIE T1,"-" ;CORRECT DELIMITER? JRST [PUSHJ P,$$ILCH## ;[154] ILLEGAL CHARACTER PJRST $XOPJ##] ;[154] RETURN MOVEI T3,$LNMTH## ;MONTHS PER YEAR HLLZ T2,T2 ;ONLY LOOK AT 3 CHARACTERS RDA10: ;LOOP HERE COMPARING WITH EACH MONTH HLLZ T1,$TBMTH##(T3) ;LOAD MONTH CAMN T2,T1 ;SAME? JRST RDA20 ;YES SOJGE T3,RDA10 ;NO, LOOP BAK ERR$$ ,NMO,TEXT,MOVE PJRST $XOPJ## ;ERROR RETURN RDA20: ;HERE WITH MONTH INDEX IN T3 HRRZ T2,$TBMTH##(T3) ;DAYS IN THIS MONTH CAMGE T2,(P) ;IN RANGE? PJRST $$DRNG## ;NO, ERROR IMULI T3,^D31 ;CONVERT TO INTERNAL FORM SUBI T3,1 ;ADJUST FOR EXTRA DAY IN STACK ADDM T3,(P) ;ADD MONTHS TO DAYS RDECL$ ;READ YEARS PJUMPL T2,$$DRNG## ;EXIT IF OUT OF RANGE CAIGE T2,^D64 ;MUST BE AFTER 1964 PJRST $$DRNG## ; SUBI T2,^D64 ;ADJUST TO INTERNAL FORM IMULI T2,^D31*^D12 ; ADDM T2,(P) ;ADD INTO TOTAL POP P,T2 ;RECOVER DAYS PJRST $POPJ1## ; PRGEND TITLE RREAL - READ A FLOATING POINT NUMBER SEARCH IOLIB IOL$ ; RREAL ; READ A FLOATING POINT NUMBER IN THE FORM ; ; SDDD.DDDDD ; OR S0.DDDDDDDESNN ; CALL: ; D : FILE DESCRIPTOR ADDRESS ; PUSHJ P,$RREAL ; T1 : DELIMITER ; T2 : F.P. NUMBER ENTRY $RREAL,$RREA0 $RREAL:: RUCCH$ ;READ LEADING CHARACTER $RREA0:: ;HERE WITH LEADING CHARACTER IN T1 SAVE2$ ;FIND SOME PRESERVED PUSHJ P,$$SIGN## ;PROCESS THE SIGN (IF ANY) MOVSI P2,(10.0) ;INITIALISE DIGIT MULTIPLIER TDZA P1,P1 ;ZERO NUMBER AND SKIP RRE10:! ;LOOP HERE FOR EACH INTEGER DIGIT RUCCH$ ;NEXT CHAARACTER PUSHJ P,CDIGIT ;CONVERT THIS DIGIT JRST RRE20 ;NO FMPR P1,P2 ;MULTIPLY NUMNER FADR P1,T1 ;ADD NEW DIGIT JRST RRE10 ;LOOP BACK FOR MORE RRE20:! ;HERE FOR FRACTION PART CAIE T1,"." ;CORRECT DELIMITER? JRST RRE40 ;NO RRE30:! ;LOOP HERE FOR EACH FRACTION DIGIT PUSHJ P,RDIGIT ;GET NEXT DIGIT JRST RRE40 ;END OF FRACTION FDVR T1,P2 ;CORRECT BY POWER OF 10 FADR P1,T1 ;ADD INTO NUMBER FMPRI P2,(10.0) ;MULTIPLY CORRECTION FACTOR JRST RRE30 ;LOOP BACK FOR MORE RRE40:! ;HERE TO READ AND APPLY EXPONENT CAIE T1,"E" ;EXPONENT COMING? JRST RRE60 ;NO, END RDECL$ ;READ EXPONENT MOVE T3,[FMPRI P1,(10.0)] ;FOR IF EXP +VE SKIPGE T2 ;IS IT? HRLI T3,(FDVRI P1,) ;NO MOVMS T2 ;MAKE COUNT +VE RRE50:! ;LOOP HERE MULTIPLYING BY EXPONENT SOJL T2,RRE60 ;EXIT IF END XCT T3 ;DO MULTIPLY JRST RRE50 ;LOOP BACK RRE60:! ;END MOVE T2,P1 ;GET ANSWER POPJ P, ;RETURN RDIGIT: ;READ A DECIMAL DIGIT AND CONVERT TO F.P. RUCCH$ ;READ CHARACTER CDIGIT: ;CONVERT DIGIT TO F.P. CAIL T1,"0" ;IN RANGE? CAILE T1,"9" ; POPJ P, ;NO SUBI T1,"0" ;YES. MAKE BINARY FSC T1,233 ;MAKE F.P. PJRST $POPJ1## ;SKIP RETURN PRGEND TITLE RKWRD - READ A K WORD VALUE SEARCH IOLIB IOL$ ; RKWRD ; READ A KWORD VALUE FROM THE CURRENT FILE IN ONE OF THE ; FORMATS: ; 23K 23 * 1024 WORDS ; 57P 57 * 512 WORDS (PAGES) ; 128 SAME AS 128K ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RKWRD## OR RKWRD$ ; ERROR, T1 : CODE ; T1 : DELIMITER ; T2 : VALUE IN WORDS ENTRY $RKWRD,$RKWR0 $RKWRD:: RUCCH$ ;NEXT CHARACTER $RKWR0:: RDECL$ T1 ;READ DECIMAL VALUE PJUMPL T2,$$DRNG## ;NEGATIVE ILLEGAL LSH T2,11 ;ASSUME 'P' CAIE T1,"K" ;DELIMITER 'K'? CAIE T1,"P" ; OR NOT "P"? LSH T2,1 ;YES, SO MAKE INTO KWDS CAIE T1,"K" ;IF 'K' OR 'P' CAIN T1,"P" ; RUCCH$ ;READ A DELIMITER PJRST $POPJ1## ;GOOD RETURN PRGEND TITLE RDECM - READ A DECIMAL NUMBER WITH MULTIPLIER SEARCH IOLIB IOL$ ; RDECM ; READ A DECIMAL NUMBER FROM THE CURRENT FILE IN THE FORMAT ; SDDDDDM ; WHERE S IS AN OPTIONAL SIGN, DDD ARE DECIMAL DIGITS AND ; M IS AN OPTIONAL MULTIPLIER LETTER ; K KILO 1000 ; M MEGA 1000000 ; G GIGA 1000000000 ; IN TRUTH, DDD IS ANYTHING THAT CAN BE READ BY THE $RDECL CODE ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RDECM## OR RDECM$ ; T1 : DELIMITER ; T2 : NUMBER ENTRY $RDECM,$RDCM0 $RDECM:: RUCCH$ ;LEADING CHARACTER $RDCM0:: RDECL$ T1 ;READ REST OF NUMBER PJRST $$MULT## ;APPLY MULTIPLIERS PRGEND TITLE RDECL - READ A DECIMAL NUMBER SEARCH IOLIB IOL$ ; RDECL ; READ A NUMBER FROM THE INPUT STREAM ; - IF 1ST CHARACTER IS '#' ASSUME NUMBER IS OCTAL ; - IF NEXT CHARACTER IS '-' THEN NEGATIVE ; - IF NEXT CHARACTER IS '#' AGAIN OCTAL ; - NEXT CHARACTERS SHOULD BE A DECIMAL NUMBER ; - CAN BE FOLLOWED BY K,M,G FOR KILO,MEGA,GIGA ; CALL: ; D : INPUT F-B POINTER ; PUSHJ P,$RDECL## OR RDECL$ ; T1 : DELIMITER ; T2 : NUMBER ENTRY $RDECL,$RDEC0 $RDECL:: RUCCH$ ;READ LEADING CHARACTER $RDEC0:: CAIN T1,"#" ;OCTAL FLAG? PJRST $ROCTL## ;YES, PROCESS AS OCTAL PUSHJ P,$$SIGN## ;PROCESS SIGN DIGIT CAIN T1,"#" ;OCTAL NOW PJRST $ROCTL## ;[146] YES, PROCESS THIS PUSHJ P,$$RUD0## ;[146] READ NUMERIC PART MOVE T3,$$DMUL## ;[146] DECIMAL MULTIPLIERS CAIN T1,"." ;IGNORE TRAILING DECIMAL POINT RUCCH$ ; POPJ P, ; PRGEND TITLE ROCTM - READ AN OCTAL NUMBER + MULTIPLIERS SEARCH IOLIB IOL$ ; ROCTM ; READ AN OCTAL NUMBER FROM THE CURRENT FILE IN THE FORMAT ; SOOOOOM ; WHERE S IS AN OPTIONAL SIGN DIGIT, OOOOO IS ANY NUMBER ; THAT CAN BE READ BY $ROCTL, AND M IS AN OCTAL MULTIPLIER ; K KILO 1000 (=512 DECIMAL) ; M MEGA 1000000 ; G GIGA 1000000000 ; CALL: ; D : CURRENT FILE ; PUSHJ P,$ROCTM## OR ROCTM$ ; T1 : DELIMITER ; T2 : NUMBER ENTRY $ROCTM,$ROCM0 $ROCTM:: RUCCH$ ;READ LEADING CHARACTER $ROCM0:: ROCTL$ T1 ;READ REST OF NUMBER PJRST $$MULT## ;APPLY MULTIPLIER IF ANY PRGEND TITLE ROCTL - READ AN OCTAL NUMBER SEARCH IOLIB IOL$ ; ROCTL ; READ A NUMBER FROM THE INPUT STREAM ; - IF 1ST CHARACTER IS '-', THEN NEGATIVE ; - NEXT CHARACTERS SHOULD BE AN OCTAL NUMBER ; - CAN BE FOLLOWED BY '.' TO MAKE DECIMAL ; CALL: ; D : CURRENT FILE ; PUSHJ P,$ROCTL## OR ROCTL$ ; T1 : DELIMITER ; T2 : NUMBER ; T3 : POINT TO MULTIPLIER TABLE ENTRY $ROCTL,$ROCT0 $ROCTL:: RUCCH$ ;READ LEADING CHARACTER $ROCT0:: PUSHJ P,$$SIGN## ;[146] CHECK SIGN CHARACTER PUSHJ P,$$RUD0## ;[146] READ NUMERIC PART EXCH T2,T3 ;[146] KEEP REST OF CODE SWEET CAIE T1,"." ;NUMBER REALLY DECIMAL? SKIPA T3,$$OMUL## ;NO, USE OCTAL MULTIPLIERS SKIPA T2,T3 ;YES, USE DECIMAL NUMBER POPJ P, ;RETURN MOVE T3,$$DMUL## ;USE DECIMAL MULTIPLIER PJRST $RUCCH## ; AND READ DELIMITER PRGEND TITLE $RUDO - READ UNSIGNED DIGITS AS DECIMAL AND OCTAL SEARCH IOLIB IOL$ ; $RUDO ; READ UNSIGNED DIGITS AND RETURN RESULTANT VALUE AS IF ; DIGITS WERE DECIMAL AND OCTAL ; CALL: ; PUSHJ P,$$RUDO## ; T1 : DELIMITER ; T2 : VALUE IN DECIMAL ; T3 : VALUE IN OCTAL ENTRY $$RUDO,$$RUD0 $$RUDO:: RUCCH$ ;READ CHARACTER $$RUD0:: SETZB T2,T3 ;CLEAR DECIMAL AND OCTAL NUMBERS RDO10: ;HERE TO ADD IN EACH DIGIT CAIL T1,"0" ;IN RANGE? CAILE T1,"9" ; POPJ P, ;NO LSH T3,3 ;MULTIPLY OCTAL IMULI T2,^D10 ;MULTIPLY DECIMAL ADDI T3,-"0"(T1) ;ADD NEW DIGIT ADDI T2,-"0"(T1) ;ADD NEW DIGIT RUCCH$ ;NEXT CHARACTER JRST RDO10 ;NEW CHARACTER PRGEND TITLE $SIGN - PROCESS A SIGN DIGIT SEARCH IOLIB IOL$ ; $SIGN ; IF CHARACTER NOT + OR -, RETURN ; IF +, READ NEXT CHARACTER AND RETURN ; IF -, READ NEXT CHARACTER AND CALL CALLER AS SUBROUTINE ; ON RETURN, NEGATE NUMBER ; ALWAYS ZERO T2 AND T3 ; CALL: ; T1 : CHARACTER ; PUSHJ P,$$SIGN## ; T1 : UNSIGN CHARACTER ; T2 : ZERO ; T3 : ZERO ENTRY $$SIGN $$SIGN:: SETZB T2,T3 ;ZERO NUMBER COLLECTOR CAIN T1,"+" ;IGNORE "+" PJRST $RUCCH## ;MERELY READ ANOTHER CAIE T1,"-" ;IS IT? POPJ P, ;NO. RUCCH$ ;GET NEXT CHARACTER PUSHJ P,@(P) ;CALL THE REST AS A SUBROUTINE MOVNS T2 ;MAKE NUMBER NEGATIVE PJRST $XOPJ## ;POP RIGTH BACK TO ORIGINAL CALLER PRGEND TITLE $MULT - APPLY A MULTIPLIER TO A NUMBER SEARCH IOLIB IOL$ ; $MULT ; BOTH $RDECM AND $ROCTM ACCEPT A NUMBER FOLLOWED BY AN OPTIONAL ; MULTIPLIER, K,M OR G INDICATING THAT THE NUMBER SHOULD BE ; RAISED TO THE POWER 3,6 OR 9 IN THE RESPECTIVE RADIX. ; $$MULT CHECKS THE DELIMITER AND PERFORMS THE MULTIPLICATION ; ACCORDING TO A TABLE OF MULTIPLIERS ; CALL: ; T1 : DELIMITER ; T2 : NUMBER ; T3 : -LENGTH,,ADDRESS OF MULTIPLIER TABLE ; PUSHJ P,$$MULT## ; T1 : DELIMITER ; T2 : NUMBER ; T3 : ADDRESS OF TABLE ENTRY ; T4 : MULTIPLIER USED ENTRY $$MULT $$MULT:: LDB T4,[POINT 7,(T3),6] ;PICK UP CHARACTER CAMN T1,T4 ;SAME AS DELIMITER? JRST MUL10 ;YES AOBJN T3,$$MULT ;LOOP THROUGH POSSIBLE DELIMITERS MOVEI T4,1 ;NO MATCH USE MULTIPLIER ONE POPJ P, ;AND RETURN MUL10: ;HERE ON MATCH LDB T4,[POINT 29,(T3),35] ;PICK UP MULTIPLIER IMUL T2,T4 ; PJRST $RUCCH## ;READ NEW DELIMITER PRGEND TITLE $DMUL - TABLE OF DECIMAL MULTIPLIERS SEARCH IOLIB IOL$ ; $DMUL ; TABLE OF THE RECOGNISED DECIMAL MULTIPLIER DELIMITERS ; AND THE RESPECTIVE MULTIPLIERS ENTRY $$DMUL $$DMUL:: ;LENGTH,,ADDRESS -LNDMUL,,TBDMUL TBDMUL: RADIX 10 !1000 !1000000 !1000000000 LNDMUL==.-TBDMUL RADIX 8 PRGEND TITLE $OMUL - TABLE OF OCTAL MULTIPLIERS SEARCH IOLIB IOL$ ; $OMUL ; TABLE OF THE RECOGNISED DELIMITERS AND THE RESPECTIVE ; MULTIPLIERS ENTRY $$OMUL $$OMUL:: ;-LENGTH,,ADDRESS -LNOMUL,,TBOMUL TBOMUL: +1000 +1000000 +1000000000 LNOMUL==.-TBOMUL PRGEND TITLE RNAME - READ A WORD OF ALPHANUMERICS INTO SIXBIT SEARCH IOLIB IOL$ ; RNAME ; READ A WORD FROM THE CURRENT FILE. THE WORD MUST BE ; ALPHANUMERICS, AND THE FIRST 6 CHARACTERS ARE STORED ; IN A SIXBIT WORD. THE REST ARE THROWN AWAY ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RNAME## OR RNAME$ ; T1 : DELIMITER ; T2 : 6BIT WORD ENTRY $RNAME,$RNAM0 $RNAME:: RUCCH$ ;READ LEADING CHARACTER $RNAM0:: MOVE T3,[POINT 6,T2] ; SETZ T2, ;KILL 6BIT WORD RNA10:! RANCH$ T1 ;CHECK FOR ALPHANUMERIC POPJ P, ;NO. SUBI T1,"0"-'0' ;TURN TO 6BIT TLNE T3,(77B5) ;6 CHARACTERS SEEN YET? IDPB T1,T3 ;NO. SET THIS ONE RUCCH$ ;READ UC CHARACTER JRST RNA10 ;LOOP BACK PRGEND TITLE RWORD - GET A 6BIT WORD SEARCH IOLIB IOL$ ; RWORD ; READ A 6BIT WORD, NO CHARACTER RESTICTIONS ; CALL: ; D : INPUT F-B POINTER ; PUSHJ P,$RWORD ; T1 : DELIMITER ; T2 : 6BIT WORD ENTRY $RWORD,$RWOR0 $RWORD:: RUCCH$ ;READ AN UC CHARACTER $RWOR0:: MOVE T3,[POINT 6,T2] ;BYTE POINT TO 6BIT WORD TDZA T2,T2 ;KILL 6BIT WORD RWO10:! ;LOOP FOR EACH CHARACTER RUCCH$ ;NEXT UC CHARACTER CAIL T1," " ;IN RANGE? CAILE T1," "+77 ;[145] POPJ P, ;NO. GIVE UP. SUBI T1,"0"-'0' ;TURN TO 6BIT TLNE T3,(77B5) ;ALREADY GOT 6 CHARACTERS? IDPB T1,T3 ;NO, USE THIS ONE JRST RWO10 ;BACK FOR MORE PRGEND TITLE RANCH - READ AN ALPHANUMERIC CHARACTER SEARCH IOLIB IOL$ ; RANCH ; READ A CHARACTER FROM THE CURRENT FILE AND CHECK ; WHETHER IT IS ALPHANUMERIC OR NOT ; CALL: ; T1 : CHARACTER ; PUSHJ P,$RANCH ; ERROR RETURN ; NORMAL REUTRN ENTRY $RANCH,$RANC0 $RANCH:: RUCCH$ ;READ UC CHARACTER $RANC0:: CAIL T1,"0" ;IN OUTER RANGE CAILE T1,"Z" ;? POPJ P, ;NO. CAIGE T1,"A" ;BETWEEN ALPHAS AND NUMS? CAIG T1,"9" ; JRST $POPJ1## ;NO. OK POPJ P, ; PRGEND TITLE RUCCH - READ AN UPPER CASE CHARACTER SEARCH IOLIB IOL$ ; RUCCH ; READ A CHARACTER FROM THE CURRENT FILE, AND IF IT IS ; LOWER CASE ALPHABETIC CHANGE IT TO UPPER CASE ; CALL: ; D : CURRENT FILE ; PUSHJ P,$RUCCH## OR RUCCH$ ; T1 : CHARACTER ENTRY $RUCCH,$RUCC0 $RUCCH:: RCHAR$ ;READ CHARACTER $RUCC0:: CAIL T1,"A"+40 ;LC ALPHA? CAILE T1,"Z"+40 ; POPJ P, SUBI T1,40 ;YES. MAKE UC POPJ P, PRGEND TITLE SYERR - VARIOUS SYNTAX ERROR RETURNS SEARCH IOLIB IOL$ ; $NOCR ; SIDEWAYS RETURN TO $NOCR WHEN THE CORE ALLOCATOR HAS GIVE ; AN ERROR RETURN INDICATING THAT AVAILABLE FREE CORE IS EXHAUSETED ; CALL: ; PJRST $$NOCR## ENTRY $$NOCR ; $ILCH ; SIDEWAYS RETURN TO $$ILCH WITH A BAD CHARACTER AND WE FIX ; UP THE ARGUMENTS SO THAT $ERRSY, THE SYNTAX ERROR REPORTER ; WILL SAY ALL GOOD THINGS ; CALL: ; T1 : BAD CHARACTER ; PJRST $$ILCH## ENTRY $$ILCH $$ILCH:: MOVE T2,T1 ;SET CHARACTER AS ARGUMENT ERR$$ ,ILC,CHAR,SKIPA $$NOCR:: MOVE T1,[EC$IND+<$TBIOE##+ERNEC%>] POPJ P, ; $XRNG ; SIDEWAYS RETURN TO $$DRNG OR $$ORNG WHEN AN INPUT NUMBER ; IS OUTSIDE THE ALLOWED RANGE FOR THE DECIMAL OR OCTAL ; NUMBER. IN PARTICULAR, COME HERE IF A POSITIVE DEFINATE ; NUMBER TURNS OUT TO BE NEGATIVE. ENTRY $$DRNG,$$ORNG $$DRNG:: ERR$$ ,NOR,DECL,SKIPA $$ORNG:: ERR$$ ,NOR,OCTL,MOVE POPJ P, PRGEND TITLE $RCHR - READ A CHARACTER SEARCH IOLIB IOL$ ; RCHR ; ; DUMMY ROUTINE TO SELECT ONE OF THE READ CHARACTER ROUTINES ; FOR USE IN THIS PROGRAM. ; ; CALL: ; D : FILE DESCRIPTOR ; PUSHJ P,$$RCHR ; T1 : CHARACTER ENTRY $$RCHR ;$$RCHR==:$RCALT## ;SELECT COMMAND CHARACTER INPUT $$RCHR::JRST $RCALT## ;AVOID MACRO V47 BUG PRGEND TITLE RCCHR - READ A COMMAND CHARACTER SEARCH IOLIB IOL$ ; RCALT ; IF THE LAST CHARACTER WAS AN ALTMODE, RETURN ANOTHER ; ONE. ; THIS HELPS DIALOG MODE, BECAUSE ENDING A LINE WITH ; AN ALTMODE MEANS ACCEPT DEFAULTS FOR ALL OTHER QUESTIONS ; ; CALL: ; D : FILE DESCRIPTOR ; PUSHJ P,$RCALT ; T1 : CHARACTER ENTRY $RCALT $RCALT:: SKIPN T1,$IDLSC(I) ;PICK UP LAST CHARACTER POPJ P, ;IT WAS ALTMODE ; RCCHR ; ; READ ONE CHARACTER, HANDLING SPACING CONTINUATION AND ; CONTROL CHARACTERS. THIS ROUTINE IS A COROUTINE ; COPIED FROM 'SCAN V:3' WRITTEN BY P.CONKLIN FROM DEC ; - COMPRESS MULTIPLE SPACES ; - IGNORE LEADING SPACES ON A LINE ; - IGNORE TRAILING SPACES ; - IGNORE COMMENTS ; - IGNORE PRECEDED BY HYPHEN ; ; CALL: ; D : FILE DESCRIPTOR ; PUSHJ P,$RCCHR ; T1 : CHARACTER ENTRY $RCCHR $RCCHR:: SKIPE $IDNXC(I) ;NEXT CHARACTER GIVEN? PJRST INTNXC ;YES, HANDLE AND RETURN PUSH P,T2 ;TO HOLD COROUTINE PC HRRE T1,$IDLAC(I) ;PICK UP THE LOOK AHEAD CHARACTER IF ANY SKIPE T2,$IDCPC(I) ;RESTORE COROUTINE PC JRST (T2) ;DISPACH UNLESS HRREI T1,$CHEOL ; FIRST TIME THROUGH RCC10:! ;START OF LINE - REMOVE LEADING BLANKS JSP T2,RNEXTC ;READ NEXT CHARACTER JRST RCC70 ;EOL - DIRECT RETURN JRST RCC10 ;SP - IGNORE LEADING SPACE JRST RCC30 ;HYP - MAYBE CONTINUATION RCC15:! ;RETURN THIS CHARACTER (FIRST ON LINE) JSP T2,RCC65 ;RETURN IT RCC20:! ;TO READ NEXT CHARACTER JSP T2,RNEXTC ;READ NEXT CHARACTER JRST RCC60 ;EOL - REAL END JRST RCC25 ;SP - COMPRESS IF NECESSARY JRST RCC30 ;HYP - MAYBE CONTINUATION JRST RCC15 ;ELSE GIVE TO CALLER RCC25:! ;SPACE SEEN - COMPRESS SPACES JSP T2,RNEXTC ;READ CHARACTER JRST RCC60 ;EOL - THROW SPACE AWAY JRST RCC25 ;SP - THROW IT AWAY TO COMPRESS SKIPA ;HYP - RETURN SP FIRST JRST RCC40 ;ELS - RETURN SP HRLI T1," " ;GIVE USER SPACE JSP T2,RCC55 ; BEFORE LOOKING AT HYP RCC30:! ;HYPHEN SEEN - CHECK FOR END OF LINE JSP T2,RNEXTC ;READ CHARACTER JRST RCC50 ;EOL - FIX UP CONTINUATION JRST RCC35 ;SP - CAN I THROW IT AWAY? JFCL ;HYP - THEREFORE NOT CONTINUATION HRLI T1,"-" ;RETURN ORIGINAL HYPHEN JRST RCC45 ; BEFORE LOOKING AT THIS CHARACTER RCC35:! ; SEEN - READ UNTIL NON-SP JSP T2,RNEXTC ;READ CHARACTER JRST RCC50 ;EOL - FIX UP CONTINUATION JRST RCC35 ;SP - THROW AWAY MULTIPLE SPACE JFCL ;HYP - THEREFORE NOT CONTINUATION HRLI T1,"-" ;RETURN ORIGINAL HYPHEN JSP T2,RCC55 ; BEFORE CHECKING SPACE RCC40:! ; SEEN - RETURN THE HRLI T1," " ; RCC45:! ;<-> SEEN - JSP T2,RCC55 ;SEND CHARACTER CAIN T1,"-" ;WAS IT HYPHEN? JRST RCC30 ;YES, COULD STILL BE EOL JRST RCC15 ;NO, THEN RETURN THIS CHARACTER RCC50:! ;END OF LINE TO BE CONTINUED FDTTY$ ;TTY? JRST RCC10 ;NO OUTSTR [ASCIZ .#.] ;YES - PROMPT JRST RCC10 ;READ NEXT CHARACTER RCC55:! ;LH(T1)=CH-FOR-USER, RH(T1)=LAST-CH MOVEM T1,$IDLAC(I) ;SAVE THE LOT HLRES T1 ;SET TO RETURN CORRECT CHARACTER PJRST RCC65 ;AVOID EOL CHECK RCC60:! ;END OF NON-NULL LINE IFN FT$DBG< JSP T2,RCC65 ;GIVE TO USER HALT RCC10 ;STOP IF SCREW UP > SETZ T2, ;KILL PC RCC65:! ;GIVE CHARACTER TO USER MOVEM T2,$IDCPC(I) ;SAVE COROUTINE PC MOVEM T1,$IDLSC(I) ;SAVE THIS CHARACTER RCC70:! ;POP AND POPJ POP P,T2 ;RESTORE AC POPJ P, ;RETURN ; RNEXTC ; STRIP COMMENTS AND RETURN ACCORDING AS THE CHARACTER IS ; EOL, SPACE, HYPHEN OR ELSE ; ; CALL: ; D : FILE DESCRIPTOR ; JSP T2,RNEXTC ; EOL ; SP ; HYP ; ELSE ;T1 : CHARACTER FOR ALL RETURNS RNEXTC: SKIPLE T1,$IDNXC(I) ;ANYTHING LEFT-OVER? PUSHJ P,INTNXC ;INTERPRET THE CHARACTER REDCH$ ;READ NEXT EDITED CHARACTER JUMPLE T1,(T2) ;EXIT IF EOL CAIN T1," " ;SP? JRST 1(T2) ;YES, SKIP CAIN T1,"-" ;HYP? JRST 2(T2) ;YES, DOUBLE SKIP CAIE T1,";" ;COMMENT? JRST 3(T2) ;NO, TRIPLE SKIP ;DEAL WITH COMMENTS REDCH$ ;READ NEXT EDITED CHARACTER JUMPG T1,.-1 ;BAK UNLESS JRST (T2) ; EOL INTNXC: ;HERE TO CLEAR THE NEXT CHARACTER WORD, AND SUBSTITUTE ;ALTMODE FOR THE FUNNY START CODE SETZM $IDNXC(I) ;CLEAR LAST CHARACTER ; CAIE T1,C.TE ;TEMPORARY EOL? ; MOVEI T1,$CHALX ;YES, USE ALTMODE POPJ P, ; PRGEND TITLE REDCH - READ A CHARACTER AND PERFORM BASIC EDITING SEARCH IOLIB IOL$ ; REDCH ; READ A CHARACTER FROM THE CURRENT FILE AND PERFORM ; BASIC LINE EDITING FUNCTIONS. THESE ARE: ; CR , DEL = NUL ; TAB = SPACE ; ALT , AL1 = ESC ; VT , FF = LF ; LF , CNC , CNZ = EOL ; CALL: ; PUSHJ P,$REDCH ; T1 : CHARACTER ENTRY $REDCH,$REDC0 $REDCH:: PUSHJ P,$$RCH0## ;READ CHARACTER (ERROR FATAL) MOVEI T1,.CHCNZ ;MAKE EOF LOOK LIKE ^Z $REDC0:: ;HERE WITH CHARACTER JUMPE T1,$REDCH ;SKIP PESKY NULS CAIE T1,.CHCRT ;IGNORE CR CAIN T1,.CHDEL ; .. DEL JRST $REDCH CAIN T1,.CHTAB ;TAB=SP MOVEI T1," " ; CKEOL ; CHECK THE CURRENT CHARACTER TO SEE WHETHER IT IS AN END ; OF LINE CHARACTER. ; ; CALL: ; T1 : CHARACTER ; PUSHJ P,$CKEOL ; T1 : -1 IF EOL, -2 IF EOF ENTRY $CKEOL $CKEOL:: CAIE T1,.CHESC ;IF ALTMODE, GIVE CRLF JRST REA10 ;NOT ALTMODE PUSHJ P,$$CRLF## ;FEED HIM A CRLF HRREI T1,$CHALX ;SET END OF RECORD REA10:! ;HERE TO CHECK FOR END OF LINE CAIL T1,.CHLFD ;VT=FF=LF=EOL CAILE T1,.CHFFD SKIPA ; HRREI T1,$CHEOL ;FLAG END-OF-LINE CAIN T1,.CHCNC ;CONTROL-C? JRST [SETZM $IDCPC(I) ;CLEAR COROUTINE PC JRST .+2] ;MAKE LIKE CONTROL-Z CAIN T1,.CHCNZ ;CONTROL-Z? HRREI T1,$CHEOF ;YES, THEN END-OF-FILE MOVEM T1,$IDLSC(I) ;SET LAST CHARACTER POPJ P, ; PRGEND TITLE $RCH0 - READ A CHARACTER DISCARDING ERRORS SEARCH IOLIB IOL$ ; $RCH0 ; READ A CHARACTER FROM THE CURRENT FILE AND TREAT] AN ERROR ; RETURN AS FATAL, BUT RETURN ENDLINE AND NORMAL ; CALL: ; D : CURRENT FILE ; PUSHJ P,$$RCH0## ; ENDLINE ; T1 : CHARACTER ENTRY $$RCH0 $$RCH0:: PJRST $$RBYT## ;SIDESTEP MACRO 47(113) BUG PRGEND TITLE $CRLF - GIVE A FREE CRLF TO TERMINAL FILE SEARCH IOLIB IOL$ ; $CRLF ; ALTMODE TYPED IN COMMAND. FEED THE USER A FREE CRLF ; TO HIS TERMINAL ; THIS ROUTINE IS REPLACEABLE FOR THOSE WHO DO NOT WANTT ; THIS FEATURE ; CALL: ; PUSHJ P,$$CRLF## ENTRY $$CRLF $$CRLF:: OUTSTR [ASCIZ \ \] POPJ P, PRGEND TITLE UNDBG - FIXUPS FOR UNDEBUGGING MODE SEARCH IOLIB IOL$ ; UNDBG ; SOME ROUTINES CONTAIN CALLS WHICH SHOULD GO TO REAL CODE ; WHEN DEBUGGING, BUT BE DUMMIES IF NOT. THIS ROUTINE HAS ; ALL THE DUMMIES. ENTRY $UNDBG ;LOADED BY CALL FROM BEGIN$ MACRO $UNDBG: ; ERDBG ; CALLED FROM $ERROR, TO PRINT THE CALLER'S ADDRESS. ; NO USED IF NO DEBUGGING $ERDBG:: PJRST $POPJ## ;SIDESTEP MACRO 47(113) BUG PRGEND TITLE DEBUG - SPECIAL DEBUGGING CODE SEARCH IOLIB IOL$ ; DEBUG ; DEBUG CONTAINS CODE LOADED ONLY WHEN DEBUGGING. ENTRY $DEBUG ;LOADED BY BEGIN$ MACRO $DEBUG: ; ERDBG ; CALLED FROM $ERROR TO PRINT THE ADDRESS OF THE ERROR ROUTINE ; CALLER $ERDBG:: WCHAR$ "(" ;IN PARENTESES HRRZ T1,-3(P) ;LOOK BACK DOWN THE STACK SUBI T1,1 ;FOR THE CALLING ADDRESS WADDR$ ;WRITE IT MOVEI T1,")" ;END PARENTHESE PJRST $$WCHR## ;RETURN ; PATCH ; ; PATCH PROVIDES 200 WORDS FOR THE USER TO USE FOR DDT ; PATCHING UNDER THE FT$DBG SWITCH. ; PATCH IS INVOKED BY THE BEGIN$ MACRO IF FT$DBG IS SET ; THE SYMBOL $PAT SHOULD BE MOVED TO REPRESENT THE FIRST ; FREE WORD IN THE PATCH AREA AT ALL TIMES RELOC $PATCH:: $PAT:: BLOCK 200 ;ENOUGH ROOM PRGEND TITLE $RBYT - AS $READ BUT TREAT IO ERRORS AS FATAL SEARCH IOLIB IOL$ ; $RBYT ; AS $READ, BUT FOR THOSE WHO LIKE TO TREAT THEIR IO ERRORS AS FATAL ALWAYS. ; CALL: ; D : INPUT FDB POINT ; PUSHJ P,$$RBYT ; ENDFILE ; T1 : BYTE READ ENTRY $$RBYT $$RBYT:: READ$ ;GET BYTE FATAL$ ;IS TROUBLE POPJ P, ;ENDFILE PJRST $POPJ1## ;OK PRGEND TITLE READ - READ THE NEXT BYTE FROM AN INPUT FILE SEARCH IOLIB IOL$ ; READ ; READ PERFORMS ALL THE UUOS NECESSARY TO READ THE NEXT ; BYTE FROM AN INPUT FILE. ; READ CAN INPUT FROM ANY PERIFERAL VIA THE NORMAL CHANNEL ; DRIVEN UUOS, OR THROUGH TTCALL OR IT CAN ; INPUT FROM CORE. ; CALL: ; D : FILE DESCRIPTOR ADRESS ; OR 0, IF TTCALL INPUT (THROUGH INCHWL) ; OR BYTE POINTER IF INPUT FROM CORE ; PUSHJ P,$READ ; ERROR ; END OF FILE ; T1 : BYTE ENTRY $READ $READ:: JUMPN D,REA10 ;TTCALL IO? INCHWL T1 ;YES. READ A CHARACTER PJRST $POPJ2## ;ALWAYS GOOD RETURN REA10: ;HERE IF NOT TTCALL, MAYBE CORE-INPUT TXNN D,7777B11 ;BYTE POINT? JRST REA20 ;NO. ILDB T1,D ;YES, GET BYTE PJUMPN T1,$POPJ2## ;NUL IS END-OF-FILE POPJ P, ; REA20: ;HERE TO READ A BYTE FROM FILE SOSL <.BFCTR+$FDIBH>(D) ;BUFFER EMPTY? JRST REA30 ;NO INPUT$ ;YES. GET ANOTHER BUFFER POPJ P, ;ERROR PJRST $POPJ1## ;END OF FILE JRST REA20 ;DECREMENT BUFFER COUNT REA30: ;GET BYTE AND RETURN ILDB T1,<.BFPTR+$FDIBH>(D) ;GET BYTE PJRST $POPJ2## ;RETURN PRGEND TITLE $WCHR - WRITE A CHARACTER AND EXIT IF ERROR SEARCH IOLIB IOL$ ; $WCHR ; THIS $OUTINE IS CALLED BY ALL THE FORMATTED WRITE ROUTINES ; TO OUTPUT ONE CHARACTER. IT IS EXPECTED THAT USERS WILL ; COMMONLY REDEFINE THIS ROUTINE TO DO WHAT IS WANTED E.G. ; DON'T EXIT ON ERRORS. ; CALL: ; T1 : CHARACTER IN ASCII ; PUSHJ P,$$WCHR ENTRY $$WCHR,$$WBYT $$WBYT:: $$WCHR:: WRITE$ ;SEND CHARACTER FATAL$ ;DEVASTATING ERROR POPJ P, ;OK PRGEND TITLE IOERR - MODULE FOR REPORTING IO ERRORS SEARCH IOLIB IOL$ ; IOERR ; ALL THE BASIC IO ROUTINES WRITE ERROR CODES INTO AC(T1) IN ; THE FORM ; UUO-CODE,,ERROR-CODE ; THE IO ERROR REPORTERS TAKE THESE CODES AND AN FDB AS INPUT ; AND USE TABLES OF UUO NAMES AND ERROR MESSAGES ($TBUUO ; AND $TBIOE) TO PRODUCE AN ARGUMENT BLOCK FOR $ERROR. ; CALL: ; T1 : UUO-CODE,,ERROR-CODE ; D : FDB POINTER ; PUSHJ P,$FTLIO OR FATAL$ OR FATAL$ ,IO ; RETURN FOR $WRNIO ONLY ENTRY $FTLIO,$WRNIO $FTLIO:: PUSHJ P,SETEFD ;[134] SET ERROR FDB JRST $FTLFD ;[134] GO REPORT ERROR $WRNIO:: PUSHJ P,SETEFD ;[134] SET ERROR FDB JRST $WRNFD ;[134] GO REPORT ERROR SETEFD: ;[134] SETUP ERROR FDB SO THAT IF THE IO ERROR IS IN THE ERROR FILE ; THE ERROR WILL BE REPORTED THROUGH TTCALL CAME D,$IDEFD(I) ;SAME? SETZM $IDEFD(I) ;YES, SO RESET ERROR FILE MOVE T2,D ;SET UP AC(T2) FOR $ERRFD POPJ P, ; ; CALL: ; T1 : UUO-CODE,,ERROR-CODE ; T2 : FDB POINTER ; PUSHJ P,$FTLFD OR FATAL$ ,FD ; RETURN ONLY FOR $WRNFD ENTRY $FTLFD,$WRNFD $FTLFD:: TDZA T4,T4 ;FLAG FATAL $WRNFD:: MOVEI T4,1 ;FLAG WARNING HLRZ T3,T1 ;LOAD UUO CODE HRRE T1,T1 ;[133] LOAD ERROR CODE ALONE CAML T1,[-1,,$LNIO0##] ;IN RANGE? CAILE T1,$LNIOE## ;EITHER WAY? MOVEI T1,ERUNK$ ;NO, SO UNKNOWN ERROR ADD T1,[EC$IND!EC$UUO!<<$ECTFI>B17>+$TBIOE##] ;SET STANDARD ARGS SUBI T3,1 ;ZERO NOT USED CAILE T3,$LNUUO## ;UUO CODE IN RANGE? TXZA T1,EC$UUO ;NO, SO DON'T PRINT IT MOVE T3,$TBUUO##(T3) ;LOAD UUO NAME PJRST $FATAL##(T4) ;JUMP TO FATAL OR WARN PRGEND TITLE TBIOE - TABLE OF IO ERROR CODES AND MESSAGES SEARCH IOLIB IOL$ ; TBIOE ; A TABLE DEFINING THE ERROR CODES AND THEIR ASSOCIATED MESSAGES ; THE CODES MERELY REFLECT THE NAMES GIVEN TO THE ERRORS AND ; CORRESPOND TO THOSE IN APPENDIX E OF THE MONITOR CALLS HANDBOOK ; FOR DEC DEFINED CODES, AND TO THOSE DEFINED IN IO.MAC FOR ; IOLIB CODES ENTRY $TBIOE DEFINE ENT(COD,TXT),< +[ASCIZ \'TXT'\]> TABIOE: ENT UNK, ENT NFC, ENT RSD, ENT QTA, ENT IMP, ENT DER, ENT DTE, ENT BKT, ENT EOF, $LNIO0==:TABIOE-. $TBIOE:: ENT FNF, ENT IPP, ENT PRT, ENT FBM, ENT AEF, ENT ISU, ENT TRN, ENT NSF, ENT NEC, ENT DNA, ENT NSD, ENT ILU, ENT NRM, ENT WLK, ENT NET, ENT POA, ENT BNF, ENT CSD, ENT DNE, ENT SNF, ENT SLE, ENT LVL, ENT NCE, ENT SNS, $LNIOE==:.-$TBIOE PRGEND TITLE TBUUO - TABLE OF IO UUO NAMES FOR ERROR PRINT ROUTINES SEARCH IOLIB IOL$ ; TBUUO ; THE BASIC IO ROUTINES RETURN A UUO CODE ON ANY FAILURE AND ; THIS ROUTINE CONTAINS THE NAMES IN SIXBIT SO THAT $ERROR ; MAY PRINT THEM OUT. ENTRY $TBUUO $TBUUO:: 'OPEN ' ; 'ENTER ' ; 'LOOKUP' ; 'RENAME' ; 'INPUT ' ; 'OUTPUT' ; 'RUN ' ;[153] 'GETSEG' ; 'CLOSE ' ; 'TMPCOR' ; $LNUUO==:.-$TBUUO PRGEND TITLE ERRSY - MODULE FOR REPORTING SYNTAX ERRORS SEARCH IOLIB IOL$ ; ERRSY ; ALL THE FORMATTED READ ROUTINES THAT HAVE ERROR RETURNS ; PLACE THE ERROR CODE IN AC(T1) AND THE ERROR DATA IN ; AC(T2). ; ERRSY SETS THE ARGUMENTS FOR $ERROR SO THAT THE UUO NAME ; IS ALWAYS 'SYNTAX'. ; CALL: ; T1 : ERROR CODES ; T2 : ERROR DATA ; PUSHJ P,$FTLSY## OR FATAL$ ,SYNTAX ; RETURN ONLY ON $WRNSY CALLS ENTRY $FTLSY,$WRNSY $FTLSY:: TDZA T4,T4 ;SET FATAL FLAG $WRNSY:: MOVEI T4,1 ;SET WARNING FLAG TXO T1,EC$UUO ;SET TO PRINT A UUO NAME MOVE T3,['SYNTAX'] ;SET UUO NAME PJUMPE T4,$FATAL## ;DISPACH IF FATAL CLLIN$ ;CLEAR INPUT LINE PJRST $WARN## ; PRGEND TITLE ERROR - REPORT AN ERROR SEARCH IOLIB IOL$ ; ERROR ; REPORT AN ERROR IN THE FORM: ; ?(400130)CMLFBM RENAME(3), FILE BUSY:ACCT.SYS ; OR ; S(AAAAAA)CCCFFF NNNNNN(EE), MMMMMMMMM:VVVVVVVV ; WHERE ; S IS THE SEVERITY FLAG, '?' OR '%' ; A IS THE CALLER ADDRESS, ONLY PRINTED IF FT$DBG IS ON ; C IS AN OPTIONAL CODE NAMING THE PROGRAM ; F IS AN OPTIONAL FLAG UNIQUELY IDENTIFYING THE ERROR ; N IS AN OPTIONAL NAME, USED TO IDENTIFY THE FAILING UUO ; E IS THE OPTIONAL ERROR CODE ; M IS THE USER ORIENTED MESSAGE TEXT ; V IS AN OPTIOANL VALUE IN ONE OF A NUMBER OF FORMATS ; CALL: ; T1 : FLAGS,,ADDRESS-OF-TEXT(OR OF [ID,,ADDRESS-OF-TEXT]) ; T2 : VALUE(IF EC$TYP NONZERO) ; T3 : UUO NAME IN SIXBIT(IF EC$UUO SET) ; PUSHJ P,$ERROR ; OR PUSHJ P,$FATAL ; OR PUSHJ P,$WARN ENTRY $ERROR,$FATAL,$WARN,$ADVIS $ADVIS:: MOVEI T4,"[" ;[150] FLAG CHARACTER JRST FWAERR ;[150] DEPOSIT IT $FATAL:: SKIPA T4,["?"] ;[150] FLAG FATAL $WARN:: MOVEI T4,"%" ;[150] FLAG WARNING FWAERR: ;[150] HERE TO SET FLAG DPB T4,[POINT 7,T1,11] ;[150] SET FLAG $ERROR:: PUSH P,D ;SAVE FDB POINT ERRFD$ ;[134] LOAD ERROR FDB POINT MOVE T4,T1 ;COPY FLAG WORD LDB T1,[POINT 7,T4,11] ;[150] LOAD FLAG CHARACTER PUSH P,T2 ;NEED EXTRA TEMP WCHAR$ ;SEND SEVERITY FLAG PUSHJ P,$ERDBG## ;PRINT CALLER ADDRESS IF DEBUG ON HRROI T1,.GTWCH ;[175] ASK MONITOR FOR THIS GETTAB T1, ;[175] JOB'S WATCH BITS MOVX T1,JW.WPR+JW.WFL ;[175] ASSUME (PREFIX,FIRST) TXNN T1,JW.WMS ;[175] MONITOR THINKS HE WANTS ANYTHING? MOVX T1,JW.WPR+JW.WFL ;[175] NO, GIVE HIM (PREFIX,FIRST) PUSH P,T1 ;[175] REMEMBER ERROR BITS TXNN T1,JW.WPR ;[175] USER WANTS TO SEE PREFIX? JRST ERR10 ;[175] NO HLLZ T1,$IDECD(I) ;PICK UP PROGRAM ID TXNE T4,EC$IND ;IS ERROR ID? HLR T1,(T4) ;YES, PICK IT UP TLNN T1,-1 ;PROGRAM ID EXISTS? HRLZ T1,T1 ;NO, SO MOVE ERROR ID LEFT JUMPE T1,ERR10 ;ANYTHING THERE? WWORD$ ;YES, SEND IT WCHAR$ " " ; AND A DELIMITER ERR10: ;IF VERBOSITY LOW, GOTO END POP P,T1 ;[175] RESTORE ERROR BITS TXNN T1,JW.WFL ;[175] USER WANTS TO SEE FIRST LINE? JRST ERR50 ;[175] NO - SKIP REST OF TEXT ;SEND THE UUO NAME AND ERROR CODE TXNN T4,EC$UUO ;IS ONE? JRST ERR20 ;NO MOVE T1,T3 ;GET UUO NAME WWORD$ ;SEND IT WTEXT$ <, > ERR20: ;SEND THE TEXT OF THE MESSAGE TXNE T4,EC$IND ;INDIRECT POINT TO MESSAGE? HRR T4,(T4) ;YES HRRZ T1,T4 ;LOAD MESSAGE POINT WTEXT$ ;SEND IT ;SEND THE VALUE IF THERE IS ONE LDB T2,[POINTR (T4,EC$TYP)] ;GET VALUE TYPE CODE JUMPE T2,ERR50 ;NONE WTEXT$ <: > MOVE T1,(P) ;LOAD VALUE CAIL T2,$LNXAD## ;[137] IN RANGE? MOVEI T2,$ECTER ;[137] ERROR PUSHJ P,@$TBWAD##(T2) ;[136][137] WRITE VALUE ERR50: ;FINISH UP AND GO HOME LDB T4,[POINT 7,T4,11] ;[150] LOAD FLAG CHARACTER MOVEI T1,"]" ;[150] PREPARE TO CLOSE ADVISORY CAIN T4,"[" ;[150] IS MESSAGE ADVISORY? WCHAR$ WCRLF$ ;SEND ENDLINM POP P,T2 ;POP STACK POP P,D ;RECOVER FDB POINT CAIE T4,"?" ;[150] MESSAGE FATAL? POPJ P, ;RETURN ON WARNINGS PJRST $$FERR## ;[150] YES. PRGEND TITLE TBWAD - TABLE OF ADDRESSES OF WRITE ROUTINES SEARCH IOLIB IOL$ ; TBWAD ; THIS IS MERELY A JUMP TABLE. IT CONTAINS ONLY THOSE VALUES ; THAT THE AUTHOR HAS CONSIDERED NECESSARY SO FAR ENTRY $TBWAD,$TBEVL $TBWAD:: $TBEVL:: $$CDOR## ;CODE OUT OF RANGE $WFCHA## ;'FUNNY' CHARACTER $WDECL## ;DECIMAL INTEGER $WFILE## ;FILENAME FROM FDB $WOCTL## ;OCTAL INTEGER $WTEXT## ;ASCIZ STRING $WWORD## ;SIXBIT WORD $LNXAD==:.-$TBWAD PRGEND TITLE $CDOR - ROUTINE TO WRITE A CODE OUT OF RANGE MESSAGE SEARCH IOLIB IOL$ ; $CDOR [137] ; WRITE A MESSAGE '!CODE OUT OF RANGE!' WHEN CALLED ; THIS ROUTINE IS SPECIFICALLY FOR ROUTINES USING $TBXAD ENTRY $$CDOR $$CDOR:: MOVEI T1,[ASCIZ \!CODE OUT OF RANGE!\] PJRST $WTEXT## PRGEND TITLE WFILE - WRITE A FILENAME SEARCH IOLIB IOL$ ; WFILE ; ; WRITE A FILENAME IN DEC FORMAT WHICH IS TO SAY: ; DEV:NAME.EXT[PATH] ; ; CALL: ; T1 : FILE-BLOCK POINT ; D : FILE DESCRIPTOR FOR OUTPUT ; PUSHJ P,$WFILE ENTRY $WFILE $WFILE:: SAVE1$ ;NEED 1 PRESERVED MOVE P1,T1 ;F-B POINT MOVE T1,$FDDEV(P1) ;PICK UP DEVICE NAME JUMPE T1,WFI10 ;IGNORE IF NONE CAME T1,['DSK '] ; ALSO IF DSK PUSHJ P,$WDVIC## ;WRITE THE DEVICE NAME WFI10: ;HERE TO WRITE NAME.EXT[PATH] SKIPE T1,$FDNAM(P1) ;PICK UP NAME WNAME$ ;WRITE IT HLLZ T2,$FDEXT(P1) ;PICK UP EXTENSION MOVX T1,FM$NUL ;SEE IF NULL TDNE T1,$FDMOD(P1) ; EXTENSION SPEC. JRST WFI20 ;NO, SO PRINT NOTHING WPWOR$ "." ;WRITE '.EXT' WFI20: ;HERE FOR DIRECTORY MOVE T1,$FDPPN(P1) ;[170] PICK UP PATH POINT (OR PPN) TLNE T1,-1 ;[170] PATH? MOVEM T1,$FDPPP(P1) ;[170] NO - SET PPN INTO PATH SKIPN T2,$FDPPP(P1) ;[170] LOAD UP PPN POPJ P, ;[170] EMPTY! CAMN T2,$IDJPP(I) ;[170] JOB'S PPN? SKIPE $FDPTH+3(P1) ;[170] YES - ANY SFDS? PJRST $WPATH## ;NO, WRITE THE PATH SPEC. POPJ P, ;OK PRGEND TITLE WDVIC - WRITE A DEVICE NAME SEARCH IOLIB IOL$ ; WDVIC ; WRITE THE DEVICE NAME ; CALL: ; T1 : 6BIT DEVICE NAME ; PUSHJ P,$WDVIC ENTRY $WDVIC $WDVIC:: WWORD$ ;WRITE DEVICE NAME MOVEI T1,":" ; THEN DELIMITER PJRST $$WCHR## ; PRGEND TITLE WNAME - WRITE A NAME, INCLUDING PPN FORM SEARCH IOLIB IOL$ ; WNAME ; WRITE THE FILENAME, INCLUDING THE CASE OF A UFD FORMAT ; FILENAME ; CALL: ; T1 : 6BIT NAME ; PUSHJ P,$WNAME ENTRY $WNAME $WNAME:: TLNN T1,(77B5) ;FIRST CHARACTER EXISTS? PJRST $WXWD## ;BINARY. WRITE AS 2 HALFWORDS PJRST $WWORD## ;JUST NAME PRGEND TITLE WPATH - WRITE OUT A PATH SPEC. SEARCH IOLIB IOL$ ; WPATH ; ; EITHER WRITE THE PPN IN THE HAND OR THE PATH SPEC. ; POINTED AT. ; [30,652,SFD1,SFD2] ; ; CALL: ; T1 : PPN OR POINTER ; D : OUTPUT FILE DESCRIPTOR ; PUSHJ P,$WPATH ENTRY $WPATH $WPATH:: PJUMPE T1,$POPJ## ;GIVE EMPTY SPEC A MISS SAVE1$ ;NEED 1 PRESERVED MOVE P1,T1 ;TO SECURE PPN WCHAR$ "[" ;OPEN SPEC. IFN FT$SFD< TLNE P1,-1 ;PPN? JRST WPA20 ;YES ;HERE TO WRITE OUT PATH SPEC. MOVE T1,2(P1) ;WRITE PPN WNAME$ ;AS NAME OR XWD WPA10: ;LOOP HERE FOR EACH SFD NAME SKIPN T2,3(P1) ;LOAD NEXT NAME JRST WPA30 ;0 IS END WPWOR$ <","> ;[172] PRECEDE BY COMMA AOJA P1,WPA10 ;LOOP BACK FOR NEXT SFD WPA20: ;HERE TP WRITE ONLY PPN >;FT$SFD MOVE T1,P1 ;RECOVER PPN NAME WNAME$ ;WRITE IT WPA30: ;HERE TO CLOSE SPEC. MOVEI T1,"]" ; PJRST $$WCHR## ; PRGEND TITLE WVERS - WRITE ALL FIELDS OF A VERSION NUMBER SEARCH IOLIB IOL$ ; WVERS ; WRITE A VERSION NUMBER IN THE STANDARD FORMAT: 2A(176)-2 ; CALL: ; T1 : VERSION NUMBER ; D : FDB POINTER ; PUSHJ P,$WVERS OR WVERS$ ENTRY $WVERS $WVERS:: PUSH P,T1 ;SAVE NUMBER LDB T1,[POINT 9,(P),11] ;MAJOR VERSION WOCTL$ ;SEND IT LDB T1,[POINT 6,(P),17] ;MINOR VERSION JUMPE T1,WVE10 ;DON'T WRIE IF ZERO ADDI T1,"A" ;MAKE ALPHA WCHAR$ ;SEND IT WVE10: ;HERE FOR EDIT NUMBER HRRZ T2,(P) ;LOAD FIELD JUMPE T2,WVE20 ;DON'T WRITE IF ZERO WCHAR$ "(" ;OPEN PARENTHESES MOVE T1,T2 ;SET UP NUMBER WOCTL$ ;SEND IT WCHAR$ ")" ;CLOSE PARENTHESES WVE20: ;HERE FOR WHO CODES LDB T1,[POINT 3,(P),2] ;LOAD WHO CODE PJUMPE T1,$TOPJ## ;HOME IF NONE WCHAR$ "-" ;DELIMIT MOVE T1,T2 ;SET UP NUMBER WOCTL$ ;WRITE IT PJRST $TOPJ## ; PRGEND TITLE WTDAY - WRITE THE DAYTIME SEARCH IOLIB IOL$ ; WTDAY ; WRITE TIME AND DATE IN THE FORMAT ; ; HH:MM:SS DD-MMM-YY ; CALL: ; T1 : TIME IN MILLISECSS ; T2 : DATE IN INTERNAL FORMAT ; PUSHJ P,$WTDAY ENTRY $WTDAY $WTDAY:: PUSH P,T2 ;KEEP DATE WTIMS$ ;WRITE TIME WCHAR$ " " ;DELIMIT POP P,T1 ;RECOVER DATE PJRST $WDATE## ; PRGEND TITLE WTDNW - WRITE TIME AND DATE NOW SEARCH IOLIB IOL$ ; WTDNW ; ; USE WTNOW AND WDNOW TO OUTPUT NOW TIME AND DATE ; ; CALL: ; D : OUTPUT FILE DESCRIPTOR ; PUSHJ P,$WTDNW ENTRY $WTDNW $WTDNW:: WTNOW$ ;TIME WCHAR$ " " ;DELIMIT PJRST $WDNOW## ; PRGEND TITLE WTMTS - WRITE TIME DOWN TO TENTHS OF SECONDS SEARCH IOLIB IOL$ ; WTMTS ; WRITE THE TIME DOWN TO TENTHS OF A SECOND, IN THE FORMAT ; ; HH:MM:SS.T ; CALL: ; T1 : TIME IN MILLISECSS ; PUSHJ P,$WTMTS ENTRY $WTMTS $WTMTS:: IDIVI T1,^D100 ;STRIP OFF TENTHS PUSH P,T2 ; IMULI T1,^D100 ; WTIMS$ ;WRITE TIME TO SECONDS WCHAR$ "." ;DELIMIT POP P,T1 ;RECOVER TENTHS PJRST $WDECL## ;WRITE THEM PRGEND TITLE WTIMS - WRITE TIME DOWN TO SECONDS SEARCH IOLIB IOL$ ; WTIMS ; WRITE TIME DOWN TO SECONDS IN THE FORMAT ; ; HH:MM:SS ; CALL: ; T1 : TIME IN MILLISECSS ; PUSHJ P,$WTIMS ENTRY $WTIMS,$WTNOW $WTNOW:: MSTIME T1, ;NOW $WTIMS:: IDIVI T1,^D1000 ;REMOVE MILLISECS IDIVI T1,^D60 ;STRIP OFF SECONDS PUSH P,T2 ; AND KEEP THEM PUSHJ P,$WTIM1## ;WRITE THAT WCHAR$ ":" ;DELIMIT POP P,T1 ;RECOVER SECONDS PJRST $W2FL0## ;WRITE AS 2 DIGITS PRGEND TITLE WTIME - WRITE HOURS AND MINUTES SEARCH IOLIB IOL$ ; WTIME ; WRITE HOURS AND MINUTES IN THE FORMAT ; ; HH:MM ; CALL: ; T1 : TIME IN MILLSECSS ; PUSHJ P,$WTIME ENTRY $WTIME,$WTIM1 $WTIME:: IDIVI T1,^D60*^D1000 ;REMOVE SECONDS $WTIM1: ;T1 : TIME IN MINUTES IDIVI T1,^D60 ;SEPARATE HOURS AND MINUTES PUSH P,T2 ;SAVE MINUTES W2FL0$ ;WRITE AS 2 DIGITS FILLED WITH ZERO WCHAR$ ":" ;DELIMIT POP P,T1 ;RECOVER MINUTES PJRST $W2FL0## ;WRITE MINUTES PRGEND TITLE WDATE - WRITE THE DATE SEARCH IOLIB IOL$ ; WDATE ; ; WRITE THE DATE IN THE FORMAT ; ; DD-MMM-YY ; CALL: ; T1 : DATE IN INTERNAL FORM ; PUSHJ P,$WDATE ENTRY $WDATE,$WDNOW $WDNOW:: DATE T1, ;TODAY $WDATE:: SAVE2$ ;GET 2 PRESERVED MOVEI P1,(T1) ;SAVE DATE IDIVI P1,^D31 ;STRIP OFF DAYS MOVEI T1,1(P2) ;WRITE THEM W2FLB$ ;WRITE BLANK FILLED IDIVI P1,^D12 ;STRIP OFF MONTHS HLLZ T2,$TBMTH##(P2) ;PICK UP 3 LETTER ABBREV. WPWOR$ "-" ;DELIMIT AND MONTH MOVnI T1,^D64(P1) ;[160] YEAR PJRST $WDECL## ; PRGEND TITLE WADDR - WRITE AN ADDRESS AS 6 OCTAL DIGITS SEARCH IOLIB IOL$ ; WADDR ; WRITE THE CONTENTS OF A BINARY HALFWORD (E.G. AN ADDRESS) ; AS 6 OCTAL DIGITS, ZERO FILLED. ; CALL: ; T1 : BINARY HALFWORD ; PUSHJ P,$WADDR ENTRY $WADDR $WADDR:: HRLZ T2,T1 ;SET UP FOR COMBINED SHIFT SETO T1, ;FILL T1 WITH FLAGS WAD10: ;LOOP FOR EACH DIGIT LSH T1,3 ;MOVE IN 0 LSHC T1,3 ;MOVE IN 1ST OCTAL DIGIT ADDI T1,'0' ;MAKE 6BIT JUMPL T1,WAD10 ;LOOP TILL 6BIT WORD FULL PJRST $WWORD## ;WRITE THE WORD PRGEND TITLE WFCHA - WRITE A 'FUNNY' CHARACTER SEARCH IOLIB IOL$ ; WFCHA ; WRITE A CHARACTER, BUT USE SPECIAL FORMAT FOR CONTROL ; CHARACTERS E.G. ; ; ; ^A ; CALL: ; T1 : CHARACTER ; D : FILE-BLOCK POINTER ; PUSHJ P,$WFCHA## ENTRY $WFCHA $WFCHA:: CAIL T1," " ;CONTROL CHARACTER? JRST WFC30 ;NO. MOVSI T2,-LNSPC ;LENGTH OF SPECIAL CHARACTER TABLE WFC10: ;LOOP CHECKING FOR EACH SPECIAL CHARACTER HLL T1,SPCHAR(T2) ;MAKE LH THE SAME CAME T1,SPCHAR(T2) ;COMPARE CHARACTERS AOBJN T2,WFC10 ;NO MATCH. LOOP BACK JUMPGE T2,WFC20 ;COMPLETE FAIL. HLLZ T2,SPCHAR(T2) ;LOAD NAME MOVEI T1,"<" ; WPWOR$ ; MOVEI T1,">" ;END BRACKET PJRST $$WCHR## ; WFC20: ; OUTPUT "^" AND CHARACTER REPRESENTATION ADDI T1,100 ;CHARACTER REPN. PUSH P,T1 ;KEEP CHARACTER MOVEI T1,"^" ;FLAG CHARACTER JRST WFC40 ;WRITE IT WFC30: ;MAYBE LOWER CASE CAIGE T1,140 ;IS IT? PJRST $$WCHR## ;NO. JUST WRITE IT SUBI T1,40 ;CONVERT TO UPPPER PUSH P,T1 ;SAVE MOVEI T1,"'" ;FLAG IT WFC40: ;HERE TO WRITE FLAG AND CHARACTER PUSHJ P,$$WCHR## ; POP P,T1 ;WRITE CHARACTER PJRST $$WCHR## ; SPCHAR: ;TABLE OF SPECIAL CHARACTERS AND THEIR NAMES 'EOF',,$CHEOF ;END-OF-FILE 'EOL',,$CHEOL ;END-OF-LINE 'ALT',,$CHALX ;ALTMODE 'BEL',,.CHBEL ;BELL 'LF ',,.CHLFD ;LINEFEED 'VT ',,.CHVTB ;VERTICAL TAB 'FF ',,.CHFFD ;FORM FEED 'CR ',,.CHCRT ;CARRIAGE RETURN 'ESC',,.CHESC ;ESCAPE 'DEL',,.CHDEL ;RUBOUT LNSPC==.-SPCHAR PRGEND TITLE WWORD - WRITE HALFWORD AS 6 OCTAL DIGITS SEARCH IOLIB IOL$ ; WWORD ; WRITE OUT A WORD OF 6BIT CHARACTERS, WITH OR WITHOUT ; A 1 CHARACTER PREFIX ; CALL: ; T1 : 6BIT WORD ; PUSHJ P,$WWORD ; OR ; T1 : PREFIX CHARACTER ; T2 : 6BIT WORD ; PUSHJ P,$WPWOR ENTRY $WWORD,$WPWOR $WWORD:: MOVE T2,T1 ;SAVE WORD WWO10: ;HERE FOR EACH CHARACTER pjumpe t2,$popj## ;[156] finish if all done MOVEI T1,0 ;KILL PREVIOUS CHARACTER lshC T1,6 ;[156] MOVE OUT 1 CHARACTER ADDI T1,"A"-'A' ;CHANGE 6BIT TO ASCII $WPWOR:: WCHAR$ ;WRITE 1 CHARACTER JRST WWO10 ;LOOP BACK FOR EACH CHARACTER PRGEND TITLE WXWD - WRITE A WORD AS 2 OCTAL HALFWORDS SEARCH IOLIB IOL$ ; WXWD ; WRITE A WORD AS 2 HALFWORDS IN THE FORMAT ; ; 30,652 ; CALL: ; T1 : BINARY WORD ; PUSHJ P,$WXWD ENTRY $WXWD $WXWD:: PUSH P,T1 ;SAVE WORD HLRZS T1 ;GET LH WOCTL$ ;WRITE IT WCHAR$ <","> ;DELIMIT HRRZ T1,(P) ;GET RH WOCTL$ ;WRITE THAT PJRST $TOPJ## ; PRGEND TITLE WCASH - WRITE SUM AS DOLLARS AND CENTS SEARCH IOLIB IOL$ ; WCASH ; WRITE A SUM IN DOLLARS AND CENTS IN THE FORMAT ; ; $DDDD.CC ; CALL: ; T1 : CENTS ; D : IO FILE-BLOCK POINT ; PUSHJ P,$WCASH ENTRY $WCASH $WCASH:: SAVE2$ ;NEED 2 PRESERVED MOVEI T2,'-$' ;PREFACE CHARACTERS SKIPL P1,T1 ;-VE? JRST WCA10 ;NO. MOVNS P1 ;MAKE POSITIVE ROTC T1,-6 ;1ST CHARACTER WCA10: ;HERE TO WRITE DELIMITERS ROTC T1,-6 ;NEXT CHARACTER WWORD$ ; IDIVI P1,^D100 ;SPLIT DOLLARS AND CENTS MOVE T1,P1 ;PRINT DOLLARS PUSHJ P,$WDECL## ; WCHAR$ "." ;DELIMIT MOVE T1,P2 ;CENTS PJRST $W2FL0## ;WRITE 2 DIGITS PRGEND TITLE W2FIL - WRITE 2 DECIMAL DIGITS SEARCH IOLIB IOL$ ; W2FIL ; IF NUMBER IS LESS THAN 10, WRITE A 0 TO FILL THE NUMBER ; OUT TO 2 DIGITS ; CALL: ; T1 : NUMBER ; T2 : FILL CHARACTER ; D : FILE DESCRIPTOR ; PUSHJ P,$W2FIL ENTRY $W2FIL,$W2FL0,$W2FLB $W2FLB:: SKIPA T2,[" "] ;FILL WITH A SPACE $W2FL0:: MOVEI T2,"0" ;FILL WITH 0 $W2FIL:: EXCH T1,T2 ;KEEP NUMBER CAIGE T2,^D10 ;2 DIGITS? WCHAR$ ; MOVE T1,T2 ;RESTORE NUMBER PJRST $WDECL## ;WRITE NUMBER PRGEND TITLE WREAL - WRITE A FLOATING POINT NUMBER SEARCH IOLIB IOL$ ; WREAL ; WRITE A REAL NUMBER AS ; ; SDDD.DDDD ; OR S0.DDDDDDESNN ; CALL: ; T1 : F.P. NUMBER ; D : FILE DESCRIPTOR ADDRESS ; PUSHJ P,$WREAL ENTRY $WREAL $WREAL:: SAVE4$ ;4 PRESERVED PLEASE SETZB P2,P3 ;INITIALISE EXPONENTS MOVE P4,[1.0E-9] ;SMALLEST PRINTABLE FRACTION MOVM P1,T1 ;SAVE NUMBER JUMPGE T1,WRE10 ;NO SIGN IF +VE WCHAR$ "-" ;SHOW NEGATIVE WRE10: ;HERE TO DETERMINE DECIMAL EXPONENT JUMPE P1,WRE30 ;SPECIAL TREATMENT FOR 0.0 WRE20: ;LOOP HERE REDUCING NUMBER TO FRACTION + DECIMAL EXPONENT CAMGE P1,[1.0] ;BIGGER THAN RANGE? JRST WRE25 ;NO FDVRI P1,(10.0) ;REDUCE NUMBER AOJA P3,WRE20 ;AND LOOP BACK WRE25: ;LOOP HERE IF NUMBER .LT. 0.1 CAML P1,[0.1] ;IS IT? JRST WRE30 ;NO FMPRI P1,(10.0) ;YES, INCREASE NUMBER SOJA P3,WRE25 ; AND LOOP BACK WRE30: ;HERE WITH EXPONENT IN P3 ADDI P1,1 ;DEFEAT SIMPLE ROUNDING ERRORS MOVM T1,P3 ;MOD. OF EXPONENT CAILE T1,6 ;BIG ENOUGH FOR E FORMAT? EXCH P2,P3 ;YES. DEC EXP=0, E-COUNT=DEC EXP JUMPG P3,WRE40 ;IF EXPONENT .LE. 0 WCHAR$ "0" ;PRECEDE BY ZERO JRST WRE50 ; WRE40: ;HERE TO WRITE INTEGER PART PUSHJ P,WDIGIT ;WRITE ONE DIGIT SOJG P3,WRE40 ;LOOP FOR ALL INTEGER DIGITS WRE50: ;HERE TO START ON FRACTION WCHAR$ "." ;DELIMITER WRE60: ;LOOP HERE WRITING LEADING FRACTION ZEROS JUMPGE P3,WRE70 ;ANY MORE LEADING ZEROS? WCHAR$ "0" ;YES AOJA P3,WRE60 ;LOOP FOR MORE WRE70: ;HERE TO WRITE THE FRACTION PUSHJ P,WDIGIT ;WRITE A DIGIT JUMPN P1,WRE70 ;UNTIL NONE LEFT ;HERE TO WRITE AN E-EXPONENT IF NECESSARY PJUMPE P2,$POPJ## ;FINISHED IF NOT WANTED WCHAR$ "E" ;SHOW E-EXPONENT MOVE T1,P2 ;SET UP EXPONENT PJRST $WDECL## ;WRITE AS DECIMAL INTEGER WDIGIT: ;WRITE NEXT DIGIT FROM NUMBER FMPRI P1,(10.0) ;MAKE A DIGIT FMPRI P4,(10.0) ;MULTIPLY TEST FRACTION MOVE T1,P1 ;COPY NUMBER MULI T1,400 ;SEPARATE OFF EXPONENT ASH T2,-243(T1) ;KEEP TOP DIGIT MOVEI T1,"0"(T2) ;SET FOR OUTPUT FSC T2,233 ;CONVERT DIGIT BACK TO REAL FSBR P1,T2 ; AND REMOVE FROM NUMBER WCHAR$ ;WRITE DIGIT CAMG P1,P4 ;BIGGER THAN SMALLEST ALLOWED? SETZ P1, ; 8 DIGITS WRITTEN POPJ P, ; PRGEND TITLE WXWRD - WRITE A NUMBER AS KWORDS OR PAGES SEARCH IOLIB IOL$ ; WXWRD [157] ; write a number of machine words in different units according ; to the entry point. if the given quantity is not an exact ; multiple of the unit, write in words. tag the written value ; with a letter to show the units. ; $wcwrd selects p or k depending on the processor type. ; entry units tag ; $wbwrd blocks b ; $wcwrd p or k ? ; $wkwrd kcore k ; $wpwrd pages p ; $wwwrd words w ; CALL: ; T1 : NUMBER OF WORDS ; D : CURRENT FILE ; PUSHJ P,$WKWRD## (OR $WPWRD##, $wbwrd##, $wcwrd## or $wwwrd##) ; USES: ; T1,T2,T3,T4 entry $wbwrd $wbwrd:: move t4,["b",,177] ;tag,,unit size jrst wxw10 ;go test input entry $wcwrd ;core (pages for ki, kcore for ka or 166) $wcwrd:: jumpe t1,$wwwrd ;zero is words hrloi t2,-2 ;ka/ki test aobjn t2,$wpwrd ;ki jumps entry $wkwrd $WKWRD:: SKIPA T4,["K",,1777] entry $wpwrd $WPWRD:: MOVE T4,["P",,777] wxw10: ;here to test input for exact multiple of unit trne t1,(t4) ;exact multiple? jrst $wwwrd ;no - use words IDIVI T1,1(T4) ;GET NUMBER OF UNITS skipa ;go write units entry $wwwrd $wwwrd:: movsi t4,"w" ;words flag character WDECL$ ;SEND NUMBER HLRZ T1,T4 ;GET UNIT FLAG PJRST $$WCHR## ;AND SEND THAT PRGEND TITLE WRADX - WRITE A NUMBER IN ANY RADIX SEARCH IOLIB IOL$ ; ROUTINE TO WRITE NUMBERS IN ANY RADIX ; ; CALL: ; T1 : NUMBER IN BINARY ; T2 : RADIX (OPTIONAL) ; PUSHJ P,$WRADX ; OR PUSHJ P,$WDECL ; OR PUSHJ P,$WOCTL ENTRY $WRADX,$WDECL,$WOCTL $WDECL:: ;DECIMAL SKIPA T2,[^D10] ; $WOCTL:: ;OCTAL MOVEI T2,10 ; $WRADX:: ;OTHER RADICES MOVE T3,T2 ;MOVE RADIX OUT OF WAY JUMPGE T1,WRA10 ;NEGATIVE? MOVE T2,T1 ;YES. MOVE NUMBER OUT OF WAY WCHAR$ "-" ;SHOW NEGATIVE MOVN T1,T2 ;REGRAB NUMBER WRA10: ;CALL RECURSIVELY FOR EACH DIGIT IDIV T1,T3 ;GET 1ST DIGIT HRLM T2,(P) ;PUT ON STACK SKIPE T1 ;LOOP TILL NUMBER EXHAUSTED PUSHJ P,WRA10 ; ;HERE TO RECOVER EACH DIGIT FROM STACK HLRZ T1,(P) ;LOAD NEXT DIGIT ADDI T1,"0" ;CONVERT TO ASCII CAILE T1,"9" ;DECIMAL OR LESS? ADDI T1,"A"-"0"-^D10 ;NO. USE LETTERS PJRST $$WCHR## ;WRITE IT AND LOOP BACK PRGEND TITLE WCRLF - WRITE A CRLF SEARCH IOLIB IOL$ ; WCRLF ; WRITE ; CALL: ; PUSHJ P,$WCRLF ENTRY $WCRLF $WCRLF:: PUSH P,T1 ;SAVE T1 MOVEI T1,[ASCIZ / /] WTEXT$ ; PJRST $TOPJ## ;RECOVER T1 PRGEND TITLE WTEXT - WRITE A STRING OF CHARACTERS SEARCH IOLIB IOL$ ; WTEXT ; WRITE A STRING OF CHARACTERS ONTO THE OUTPUT DEVICE ; CALL: ; T1 : POINT TO STRING ; D : FILE-BLOCK POINT ; PUSHJ P,$WTEXT ENTRY $WTEXT $WTEXT:: JUMPN D,WTE10 ;TTCALL IO? OUTSTR (T1) ;YES POPJ P, ; WTE10: ;HERE FOR ALL BUT TTCALL HRLI T1,(POINT 7,) ;MAKE INTO BUFFER POINT PUSH P,T1 ;SAVE POINTER WTE20: ;LOOP HERE FOR EACH CHARACTER ILDB T1,(P) ;LOAD CHARACTER PJUMPE T1,$TOPJ## ;NUL IS END WCHAR$ ;WRITE THE CHARACTER JRST WTE20 ;LOOP BACK FOR MORE PRGEND TITLE WRITE - WRITE THE NEXT BYTE TO AN OUTPUT FILE SEARCH IOLIB IOL$ ; WRITE ; WRITE PERFORMS ALL THE UUOS NECESSARY TO WRITE THE NEXT ; BYTE TO AN OUTPUT FILE. ; WRITE CAN OUTPUT TO ANY PERIFERAL VIA THE NORMAL CHANNEL ; DRIVEN UUOS, OR THROUGH TTCALL, OR IT CAN OUTPUT TO ; CORE ; CALL: ; T1 : BYTE TO WRITE ; D : FILE DESCRIPTOR ADRESS ; PUSHJ P,$WRITE ; ERROR RETURN ; NORMAL RETURN ENTRY $WRITE $WRITE:: JUMPN D,WRI10 ;TTCALL IO? OUTCHR T1 ;YES. SEND CHARACTER PJRST $POPJ1## ;GOOD WRI10: ;HERE IF NOT TTCALL, MAYBE CORE-OUTPUT TXNN D,7777B11 ;BYTE POINT? JRST WRI20 ;NO IDPB T1,D ;SEND BYTE PJRST $POPJ1## ;GOOD WRI20: ;HERE TO WRITE TO FILE SOSL <.BFCTR+$FDOBH>(D) ;BUFFER FULL? JRST WRI30 ;NO OUTPU$ ;YES, SEND IT POPJ P, ;ERROR JRST WRI20 ;DECREMENT BUFFER COUNT WRI30: ;HERE TO PUT BYTE IN BUFFER IDPB T1,<.BFPTR+$FDOBH>(D) ;DEPOSIT BYTE PJRST $POPJ1## ;OK PRGEND TITLE FDTTY - CHECK WHETHER CURRENT FILE IS A TTY SEARCH IOLIB IOL$ ; FDTTY ; CHECK WHETHER THE CURRENT FILE IS A TTY OR NOT ; CALL: ; D : CURRENT FILE ; PUSHJ P,$FDTTY## ; USES: ; NO ACS ENTRY $FDTTY $FDTTY:: PJUMPE D,$POPJ1## ;OK IF TTCALL TXNN D,7777B11 ;NOT IF BYTE POINTER OPEN$ ;OPEN FILE TO GET DEVICE TYPE POPJ P, ;HELL - NOT A TTY PUSH P,T1 ;NEED AN AC NOW LDB T1,$FT.DE## ;LOAD DEVICE TYPE CAIE T1,.TYTTY ;TTY? PJRST $TOPJ## ;NO PJRST $TOPJ1## ;YES PRGEND TITLE APDWT - OPEN A CHANNEL FOR APPENDING. WAIT IF BEING USED. SEARCH IOLIB IOL$ ; APDWT ; OPEN A FILE IN UPDATE MODE AND USETO TO THE LAST BLOCK FOR ; APPENDING. IF THE FILE IS BEING MODIFIED, WAIT FOR A ; SPECIFIED TIME, RETRYING THE APPEND. GIVE UP WHEN TIME ; IS EXHAUSTED. ; CALL: ; T1 : SLEEP SECS,,SLEEP LOOPS ; D : CURRENT FILE ; PUSHJ P,$APDWT ; ERROR, T1 : IO-ERROR CODE ; OK, T1 : NUMBER OF WORDS IN LAST BLOCK ; OK ENTRY $APDWT,$APDW0 $APDWT:: MOVE T1,[SLPMIN,,100] ;STANDARD SLLEP DATA $APDW0:: UPDWT$ T1 ;WAIT ON UPDATE POPJ P, ;FAILURE PJRST $$APEN## ;FIXUP APPEND MODE PRGEND TITLE APEND - OPEN A CHANNEL FOR APPENDING SEARCH IOLIB IOL$ ; APEND ; CALL UPDAT TO OPEN A FILE FOR UPDATING; READ THE LAST BLOCK ; AND FIXUP BUFFER FOR APPENDING FIRST CHARACTER. ; NOTE THAT APPEND ONLY DOES NOT, REPEAT NOT, WORK CORRECTLY ; UNLESS THE FILE IS PROTECTED AGAINST WRITING, BY ; SUPERCEDING OR BY UPDATING. ; CALL: ; D : CURRENT FILE ; PUSHJ P,$APEND ; ERROR, T1 : IO ERROR CODE ; OK, T1 : NO OF WORDS IN BLOCK ENTRY $APEND,$$APEN $APEND:: UPDAT$ ;OPEN UP THE FILE POPJ P, ;WHOOPS! $$APEN:: ;ENTER HERE FROM $APDWT WITH OPEN CHANNEL SAVE2$ ;NEED SOME ACS MOVE P1,$FDSIZ(D) ;SIZE IN WORDS IDIVI P1,200 ;BREAK INTO BLOCKS AND WORDS ADDI P1,1 ; HRROM P1,$FDNBK(D) ;SET TO READ LAST BLOCK MOVE T1,P2 ;WORD COUNT TO RETURN LDB P1,[POINTR ($FDSTS(D),IO.MOD)] ;FILE IO MODE CAILE P1,.IOBIN ;DUMP MODE? PJRST $POPJ1## ;YES. OUTPU$ ;DUMMY OUTPUT POPJ P, ;ERROR - EXIT PJUMPE P2,$POPJ1## ;RETURN IF APPENDING AT START OF BLOCK ADDM P2,$FDOBH+1(D) ;POINT TO 1ST FREE WORD SOSG P1 ;IF AN ASCII MODE IMULI P2,5 ;CONVERT WORDS TO CHARACTERS SUB P2,$FDOBH+2(D) ;MAKE BYTE COUNT REMAINING MOVNM P2,$FDOBH+2(D) ; AND SET INTO HEADER PJRST $POPJ1## ;GOOD RETURN PRGEND TITLE UPDWT - OPEN A CHANNEL FOR UPDATING. WAIT IF BEING USED. SEARCH IOLIB IOL$ ; UPDWT ; OPEN A FILE IN UPDATE MODE. IF THE FILE IS BEIING MODIFIED, ; WAIT A SPECIFIED NUMBER OF TIMES FOR A SPECIFIED TIME, ; RETRYING THE UPDATE FREQUENTLY. GIVE UP IF NEVER SUCCEED. ; CALL: ; T1 : SLEEP SECS,,SLEEP LOOPS ; D : CURRENT FILE ; PUSHJ P,$UPDWT OR UPDWT$ ; ERROR, T1 : IO ERROR CODE ; OK ENTRY $UPDWT,$UPDW0 $UPDWT:: MOVE T1,[SLPMIN,,100] ; $UPDW0:: PUSH P,T1 ;KEEP COUNTS UPD10: ;LOOP HERE ON EACH FAILURE UPDAT$ ;TRY TO OPEN SKIPA ;FAIL PJRST $TOPJ1## ;OK CAME T1,[UUENT$,,ERFBM%] ;'FILE BEING MODIFIED'? PJRST $xOPJ## ;NO. exch t1,(p) ;save code.get data trnn t1,-1 ;any sleeps left? pjrst $topj## ;no. error return movem t1,(p) ;save sleeps hlrz t1,t1 ;get sleep time sleep$ ;go to sleep sos (p) ;reduce count jrst upd10 ;and loop back prgend TITLE UPDAT - OPEN A CHANNEL FOR UPDATING SEARCH IOLIB IOL$ ; UPDAT ; PERFORM A LOOKUP AND ENTER ON THE CURRENT FILE. GIVE ; AN ERROR RETURN IF EITHER THE LOOKUP OR THE ENTER ; FAIL. ; CALL: ; D : CURRENT FILE ; PUSHJ P,$UPDAT OR UPDAT$ ; ERROR, T1 : IO ERROR CODE ; OK ENTRY $UPDAT $UPDAT:: LUKUP$ ;PERFORM LOOKUP POPJ P, ;ERROR RETURN ENTER$ t1 ;NOW ENTER (do not reset .rbprv) SKIPA ;ERROR PJRST $POPJ1## ;GIVE GOOD RETURN RLEAS$ ;GIVE UP THE CHANNEL POPJ P, ; PRGEND TITLE MTAPE - Perform an MTAPE UUO SEARCH IOLIB IOL$ ; MTAPE ; Perform an MTAPE UUO for the current file. There is one entry ; point for each function of the MTAPE UUO. ; All UUOs are followed by a wait for completion. ; BSF if followed by a BOT check, and if false skip the EOF mark. ; Call: ; D : current FDB ; PUSHJ P,$MTxxx## ENTRY $MTWAT,$MTREW,$MTEOF,$MTSKR ENTRY $MTBSR,$MTEOT,$MTUNL,$MTBLK ENTRY $MTSKF,$MTBSF,$MTDEC,$MTIND $MTREW:: ;rewind SKIPA T1,[MTREW.] $MTEOF:: ;write endfile mark MOVE T1,[MTEOF.] JRST MTAPE $MTSKR:: ;skip 1 record SKIPA T1,[MTSKR.] $MTBSR:: ;backspace 1 record MOVE T1,[MTBSR.] JRST MTAPE $MTEOT:: ;skip to logical endtape SKIPA T1,[MTEOT.] $MTUNL:: ;rewind and unload tape MOVE T1,[MTUNL.] JRST MTAPE $MTBSF:: ;backspace 1 file MOVE T1,[MTBSF.] PUSHJ P,$XTUUO## ;do back skip to BOT or EOF PUSHJ P,$MTWAT ;wait for completion PUSHJ P,$GETST## ;get IO channel status TXNE T1,IO.BOT ;back to origin yet? POPJ P, ;yes: just return quietly ;no: fall into $MTSKF to read over EOF $MTSKF:: ;skip forward 1 file SKIPA T1,[MTSKF.] $MTBLK:: ;write 3 inches of blank tape MOVE T1,[MTBLK.] JRST MTAPE $MTDEC:: ;initialise for 9-track DEC compatible tape SKIPA T1,[MTDEC.] $MTIND:: ;initialise for 9-track industry compatible tape MOVE T1,[MTIND.] ;fall into MTAPE MTAPE: ;execute the MTAPE UUO PUSHJ P,$XTUUO## ; $MTWAT:: ;wait for completion of magtape op. MOVE T1,[MTWAT.] PJRST $XTUUO## ;and return PRGEND TITLE IOMOD - MODULE TO PERFORM ALL BASIC IO FUNCTIONS SEARCH IOLIB IOL$ COMMENT ; THIS MODULE CONTAINS ALL THE BASIC ROUTINES LOADED WITH EVERY PROGRAM THAT USES IOLIB. THESE COMPRISE THE $POPJ/$TOPJ ROUTINES, THE $SAVEN ROUTINES AND ALL THE BASIC IO PERFORMING CODE. THE ONLY EXTERNAL ROUTINES REQUIRED ARE THOSE TO GET AND RELEAS A CHUNK OF CORE. ALL IOMOD ROUTINES RETURN TO THE CALLER. THERE ARE NO PECULIAR ERROR RETURNS. ALL NON-SKIP TYPE ERROR RETURNS GIVE AN ERROR CODE INDICATING WHAT UUO CAUSED THE ERROR AND WHAT THE ERROR WAS IN A FORM SUITABLE FOR DIRECT INPUT TO $IOERR, IN AC T1. ALL IOMOD ROUTINES PRESERVE ALL ACS EXCEPT POSSIBLY T1 IF T1 WAS INCLUDED IN THE CALLING SEQUENCE, OR T1 IF THERE IS AN ERROR RETURN. ; SUBTTL INPUT - READ A BLOCK OF A FILE ; INPUT ; READ A BLOCK, BUT FIRST TAKE THE OPPORTUNITY TO OPEN ; THE FILE, DO A LOOKUP AND MAKE A BUFFER RING. ; CALL: ; D : FILE DESCRIPTOR ADRESS ; PUSHJ P,$INPUT ; ERROR ; END OF FILE ; OK ENTRY $INPUT $INPUT:: PUSH P,T1 ;SAVE T1 MOVX T1,FC$TCI ;TEMPCORE INPUT? TDNE T1,$FDCHN(D) ; PJRST $TOPJ1 ;YES. GIVE IMMEDIATE END OF FILE PUSHJ P,$LUKUP ;OPEN THE FILE PJRST $XOPJ ;ERROR ;MAKE A RING IF NECESSARY HRRZ T1,$FDBHD(D) ;INPUT BUFFER HEADER SKIPE T1 ;NOT IF DUMP MODE SKIPE @T1 ;OR IF RING SET UP JRST INP10 ; PUSHJ P,$MKBUF ;BUILD RING JRST [HRLI T1,UUINP$ ;SET CODE PJRST $XOPJ] ;[151] ERROR RETURN INP10: ;FIND BLOCK AND READ IT MOVE T1,$FDNBK(D) ;BLOCK NUMBER PUSHJ P,$USETI ;GO TO IT HRLS $FDNBK(D) ;SET THIS BLOCK NUMBER AOS $FDNBK(D) ;SET NEXT BLOCK NUMBER MOVE T1,[IN @$FDIOW(D)] ;UUO PUSHJ P,$XTUUO ;PERFORM THE INPUT PJRST $TOPJ2 ;DOUBLE SKIP IF GOOD HRLI T1,UUINP$ ;SET INPUT CODE JRST INOUT0 ;GO LOOK AT STATUS SUBTTL OUTPU - WRITE A BLOCK TO A FILE ; OUTPU ; WRITE A BLOCK, BUT FIRST TAKE THE OPPORTUNITY TO OPEN ; THE FILE, DO AN ENTER AND BUILD A BUFFER RING ; CALL: ; D : FILE DESCRIPTOR ADRESS ; PUSHJ P,$OUTPU ; ERROR ; OK ENTRY $OUTPU,$OUTIN $OUTIN:: SOS $FDNBK(D) ;REWRITE BLOCK JUST READ $OUTPU:: PUSHJ P,$ENTER ;ENTER THE FILE POPJ P, ;ERROR PUSH P,T1 ;SAVE T1 ;MAKE BUFFERS IF NECESSARY HLRZ T1,$FDBHD(D) ;BUFFER HEADER SKIPE T1 ;NOT IF DUMP MODE SKIPE @T1 ; OR IF RING ALREADY MADE JRST OUT10 ; PUSHJ P,$MKBUF ;SET UP RING JRST [HRLI T1,UUOUT$ ;ERROR CODE PJRST $XOPJ] ;[151] RETURN HLROS $FDNBK(D) ;DUMMY OUTPUT (-1,,0) JRST OUT20 ;DO DUMMY OUT OUT10: ;HERE TO ENTER FILE MOVE T1,$FDNBK(D) ;BLOCK NUMBER PUSHJ P,$USETO ;GO THERE OUT20: ;DO THE OUTPUT HRLS $FDNBK(D) ;SET THIS BLOCK NUMBER AOS $FDNBK(D) ;SET NEXT BLOCK NUMBER MOVE T1,[OUT @$FDIOW(D)] ;THE UUO PUSHJ P,$XTUUO ; PJRST $TOPJ1 ;GOOD RETURN HRLI T1,UUOUT$ ;ERROR CODE INOUT0: ;HERE TO EXAMINE STATUS AND SET ERROR CODE MOVEM T1,(P) ;STORE UUO CODE PUSHJ P,$GETST ;GET CHANNEL STATUS TRZ T1,IO.ERR!IO.EOF ;CLEAR ERROR AND ENDFILE PUSHJ P,$SETST ; HRRZ T1,$FDSTS(D) ; TXNE T1,IO.EOF ;ENDFILE? AOS -1(P) ;YES, SKIP RETURN PUSH P,T2 ;EXTRA AC JFFO T1,.+2 ;FIND FIRST ERROR BIT MOVEI T2,^D37 ;OFF END HRREI T1,-^D23(T2) ;[164] MAKE NEGATIVE SKIPL T1 ;OK IF -VE MOVEI T1,ERUNK$ ;OTHERWISE UNKNOWN POP P,T2 ;RECOVER AC HRRM T1,(P) ;SAVE CODE PJRST $TOPJ ;RETURN SUBTTL USETX - MOVE TO THE REQUIRED BLOCK OF A FILE ; USETX ; MOVE TO THE REQUIRED BLOCK OF A FILE. INPUT IS THE REQUIRED ; BLOCK NUMBER AND THE LAST BLOCK NUMBER, AND A UUO IS ; ISSUED ONLY IF THE REQUIRED BLOCK IS NOT THE NEXT BLOCK. ; THE BLOCK NUMBER IS SET UP BY USETI/O UUOS FOR DISK AND ; DECTAPE, AND IS IGNORED FOR OTHER DEVICES. LATER, MAYBE, ; THIS ROUTINE WILL WORK FOR MAGTAPES, USING MTAPE UUOS. ; CALL: ; T1 : LAST BLOCK,,THIS BLOCK ; D : FDB ; PUSHJ P,$USETX ;X IS I OR O ENTRY $USETI,$USETO $USETI:: PUSH P,[USETI] ;SAVE UUO SKIPA ; $USETO:: PUSH P,[USETO] ;SAVE UUO HRRM T1,(P) ;SAVE BLOCK NUMBER MOVEM T1,$FDNBK(D) ;SAVE BOTH NUMBERS HRLI T1,-1(T1) ;MAKE LAST BLOCK NUMBER EXCH T1,$FDNBK(D) ;GET SUPPLIED DATA CAMN T1,$FDNBK(D) ;IS THIS THE SAME? PJRST $TOPJ ;YES, SO NO UUO LDB T1,$FT.DE ;[122] PICK UP DEVICE TYPE FROM $FDTYP ; CAIE T1,.TYMTA ;MAGTAPE? ; JRST USE10 ;YES, SORT IT OUT PJUMPG T1,$TOPJ ;EXIT UNLESS DISK POP P,T1 ;RECOVER UUO PJRST $XTUUO ;AND DO IT SUBTTL GETST - GET THE STATUS OF THE IO CHANNEL ; GETST ; READ THE STATUS OF THE IO CHANNEL FROM THE MONITOR ; AND LEAVE IT IN $FDSTS ; CALL: ; D : FDB ; PUSHJ P,$GETST ; T1 : STATUS BITS ENTRY $GETST $GETST:: MOVE T1,[GETSTS T1] ;UUO PUSHJ P,$XTUUO ;PERFORM IT HRRZM T1,$FDSTS(D) ;HOLD IT POPJ P, ; SUBTTL SETST - SET THE IO CHANNEL STATUS WORD ; SETST ; MERELY SET THE IO CHANNEL STATUS WORD ; CALL: ; T1 : STATUS ; D : FDB ; PUSHJ P,$SETST ENTRY $SETST $SETST:: HRLI T1,(SETSTS) ;UUO PJRST $XTUUO ;DO IT SUBTTL DELET - DELETE A FILE ; DELET ; DELETE A FILE BY RENAMING IT TO A NUL NAME ; ; CALL: ; D : FILE DESCRIPTOR ADDRESS ; PUSHJ P,$DELET ; ERROR RENAMING FILE ; OK ENTRY $DELET $DELET:: PUSHJ P,$LUKUP ;OPEN THE FILE POPJ P, ;ERROR RETURN SETZM $FDNAM(D) ;BLANK OUT NAME ;FALL INTO $RENAM SUBTTL RENAM - RENAME A FILE ; RENAM ; ; CHANGE THE NAME, EXTENSION, PPN OR ; ACCESS PRIVILEDGE WORD OF A FILE. ; ; CALL: ; D : FILE DESCRIPTOR ADRESS ; PUSHJ P,$RENAM ; ERROR RENAMING FILE ; OK ENTRY $RENAM $RENAM:: PUSH P,T1 ;SAVE AC MOVX T1, ;SET UUO CODE PUSHJ P,XTELR ;PERFORM RENAME SKIPA T1,$FDEXT(D) ;LOAD ERROR CODE PJRST $TOPJ1 ;OK HRLI T1,UUREN$ ;LOAD RENAME CODE PJRST $XOPJ ;POP STACK AND POPJ SUBTTL LUKUP - LOOKUP AND OPEN A FILE ; LUKUP ; OPEN THE CHANNEL, UNLESS ALREADY OPEN AND PERFORM ; THE FILE LOOKUP. ; ; CALL: ; D : FILE DESCRIPTOR ADRESS ; PUSHJ P,$LUKUP ; LOOKUP FAILURE ; OK ENTRY $LUKUP $LUKUP:: PUSHJ P,$OPEN ;DO AN OPEN POPJ P, ;ERROR RETURN PUSH P,T1 ;SAVE AC MOVX T1,FC$LUK ;CHECK WHETHER LOOKUP DONE TDNE T1,$FDCHN(D) ; BY EXAMING FLAG PJRST $TOPJ1 ;DONE, SO GIVE GOOD RETURN MOVX T1, ;LOOKUP UUO PUSHJ P,XTELR ;PERFORM LOOKUP JRST [HRLI T1,UULUK$ ;LOOKUP ERROR CODE JRST ELRERR] ;LOAD ELR ERROR CODE MOVX T1,FC$LUK ;SET LOOKUP DONE PJRST SETCHN ;SET FLAG IN $FDCHN AND SKIP RETURN SUBTTL ENTER - OPEN AND ENTER A FILE ; ENTER ; OPEN THE CHANNEL UNLESS ALREADY OPEN, AND ENTER THE FILE ; UNLESS ALREADY ENTERED. THE PROTECTION IS TAKEN FROM THE ; THE MODIFIER WORD AND THE CREATE DATE AND TIME FROM THE ; PRIVILEDGE WORD AND EXTENSION (DATE-75 FORMAT) ; ; CALL: ; D : FILE DESCRIPTOR ADRESS ; PUSHJ P,$ENTER ; UUO FAILURE ; OK ENTRY $ENTER,$ENTE0 $ENTER:: PUSH P,T1 ;[140] SAVE T1 NOW HLRO T1,$FDCHN(D) ;[140] PICK UP FLAGS AND SHOW $ENTER ENTRY JRST ENT10 ;[140] CONTINUE $ENTE0:: PUSH P,T1 ;[140] SAVE AC HLRZ T1,$FDCHN(D) ;[140] PICK UP FLAGS AND SHOW $ENTE0 ENT10: ;[140] HERE TO START ENTERING PUSHJ P,$OPEN ;OPEN CHANNEL PJRST $XOPJ ;[140] ERROR, RETURN NOW. TRNE T1,(FC$ENT) ;[140] ENTER ALREADY DONE? PJRST $TOPJ1 ;YES. OK JUMPGE T1,ENT20 ;[140] NO ZEROING IF $ENTE0 SETZM $FDPRV(D) ;[140] ZERO PRIVILEDGE WORD HLLZS $FDEXT(D) ;[140] ZERO DATE75 CREATE DATE ENT20: ;[140] HERE TO EXECUTE UUO MOVX T1, ;ENTER UUO PUSHJ P,XTELR ;PERFORM UUO JRST ENTERR ;UUO FAILURE MOVX T1,FC$ENT ;SET ENTER DONE PJRST SETCHN ;SET BIT IN $FDCHN AND RETURN ENTERR: ;ENTER ERROR HRLI T1,UUENT$ ;ENTER ERROR CODE ELRERR: ;ENTER/LOOKUP/RENAME ERROR HRR T1,$FDEXT(D) ;LOAD ERROR CODE PJRST $XOPJ ; SUBTTL OPEN - OPEN A CHANNEL ; OPEN ; ; FIND A FREE CHANNEL, SET UP ALL DEFAULT VALUES ; FOR BUFFER RINGS AND OPEN THE CHANNEL. ; ; CALL: ; D : FILE DESCRIPTOR ADRESS ; PUSHJ P,$OPEN ; OPEN FAILURE ; OK ENTRY $OPEN $OPEN:: PUSH P,T1 ;SAVE T1 SKIPGE T1,$FDCHN(D) ;LOAD CHANNEL PJRST $TOPJ1 ;ALREADY OPEN PUSH P,T2 ;SAVE T2 TXNN T1,FC$CSC ;[125] USER SUPPLIED CHANNEL NUMBER? SKIPA T1,[1] ;[125] NO, SO START LOOKING AT CHANNEL 1 LDB T1,$FC$CH ;[122] PICK UP CHANNEL NUMBER PUSHJ P,$FRCHN ; JRST [MOVEI T1,ERNFC$ ;NO FREE CHANNEL JRST OPNERR] ;ERROR RETURN DPB T1,$FC$CH ;[122] DEPOSIT CHANNEL NUMBER OPE10: ;HERE TO SET DEFAULTS MOVE T1,[DEVTYP] ;DO A DEVTYP UUO PUSHJ P,$XTDCL ; PHYS OR LOG SETZ T1, ;WHAT THE HELL! JUMPE T1,[MOVEI T1,ERNSD% ;NO SUCH DEVICE JRST OPNERR] MOVEM T1,$FDTYP(D) ;STORE FOR POSTERITY ;CHECK FOR DRS OR DNA TXNN T1,TY.AVL ;DEVICE AVAILABLE? JRST [MOVEI T1,ERDNA% ;NO JRST OPNERR] TXNN T1,TY.SPL ;SPOOLED? TXNN T1,TY.RAS ;NO, RESTRICTED? JRST OPE15 ;EITHER SPOOLED OR NOT RESTRICTED PJOB T2, ;NOW MUST HAVE DEVICE ASSIGNED TO LDB T1,[POINTR (T1,TY.JOB)] ;BE ABLE TO USE IT CAMN T1,T2 ; JRST OPE15 ;OK, WE HAVE THAT DEVICE MOVEI T1,ERRSD$ ;NO - DEVICE IS RESTRICTED JRST OPNERR ; OPE15: ;FIX UP PHYSICAL IO AND BUFFERING DETAILS MOVE T1,[DEVSIZ] ;UUO NAME MOVEI T2,$FDOPN(D) ;ARGUMENT BLOCK PUSHJ P,$XTCAL ;[123] DO CALLI MOVE T1,[2,,203] ;ASSUME 2 BUFFERS, 200 WORDS EACH JUMPE T1,OPE20 ;ERROR OR DUMP MODE JUMPL T1,OPNIMP ;IMPROPER MODE (NSD ALREADY CHECKED) EXCH T1,$FDBUF(D) ;LOAD BUFFER SPEC. TLNE T1,-1 ;NUMBER BUFFERS? HLLM T1,$FDBUF(D) ;NO, SET OURS TRNE T1,-1 ;SIZE SET? HRRM T1,$FDBUF(D) ;NO, SET OURS MOVEI T1,$FDIBH(D) ;BUFFER HEADERS HRLI T1,<$FDOBH-$FDIBH>(T1) ; MOVEM T1,$FDBHD(D) ;SET ADRESSES OPE20: ;SET DENSITY AND PARITY FOR MTA'S LDB T1,$FT.DE ;[122] PICK UP CODE CAIE T1,.TYMTA ;WELL? JRST OPE30 ;NOT MTA LDB T1,$FM$PA ;[122] LOAD PARITY POINT FROM $FDMOM JUMPE T1,OPE25 ;OK IF NOT THERE LDB T1,$FD$PA ;[122] LOAD PARITY FROM $FDMOD DPB T1,$FS.PA ;[122] SET IN $FDSTS OPE25: ;HERE TO DO DENSITY LDB T1,$FM$DE ;[122] LOAD DENSITY MASK FROM $FDMOM JUMPE T1,OPE30 ;OK IF NOT THERE LDB T1,$FD$DE ;[122] LOAD DENSITY FROM $FDMOD DPB T1,$FS.DE ;[122] SET DENSITY IN $FDSTS OPE30: ;HERE TO DO THE OPEN MOVE T1,[OPEN $FDOPN(D)] ;UUO PUSHJ P,$XTUUO ; JRST [MOVEI T1,ERNET% ;MUST BE 'O/S TABLES FULL' E.G. NO DDBS JRST OPNERR] ; SKIPN $FDNBK(D) ;UNLESS BLOCK NUMBER PRESET AOS $FDNBK(D) ;SET TO 1 MOVX T1,FC$OPN ;SET CHANNEL OPEN POP P,T2 ; SETCHN: ;SET A BIT IN $FDCHN TO INDICATE SUCCESS AND RETURN (SKIP) IORM T1,$FDCHN(D) ; PJRST $TOPJ1 ; OPNIMP: ;IMPROPER MODE MOVEI T1,ERIMP$ ;SET IMPROPER MODE OPNERR: ;HERE TO SET OPEN CODE AND GIVE NON-SKIP RETURN HRLI T1,UUOPN$ ;CODE POP P,T2 ; JRST $XOPJ ;POP SUBTTL XOPJ - POP STACK AND RETURN ; XOPJ ; OFTEN IT IS HELPFUL TO BE ABLE TO POP THE STACK TO ; NOWHERE AND THEN TO RETURN ; CALL: ; PJRST $XOPJ ENTRY $XOPJ $XOPJ1:: AOS -1(P) ; $XOPJ:: POP P,(P) ; POPJ P, ; SUBTTL MKBUF - SET UP A BUFFER RING ; MKBUF ; OTHERWISE USE THE INFORMATION STORED IN FDBUF TO GENERATE ; A RING OF BUFFERS AND LINK THEM TO THE BUFFER HEADER. ; CALL: ; T1 : POINT TO BUFFER HEADER ; D : POINT TO FILE DESCRIPTOR ; PUSHJ P,$MKBUF ; NO MORE CORE ; RING BUILT ; ACS: ; T1-T4 DESTROYED ENTRY $MKBUF $MKBUF:: PUSHJ P,$SAVE2 ;GRAB PRESERVED PUSH P,T1 ;SAVE INPUT HRRZ T1,.BFADR(T1) ;PICK UP RING POINT ; HERE TO SET UP RING HLRZ P2,$FDBUF(D) ;LOAD NUMBER OF BUFFERS MOVE T1,(P) ;RESTORE ADDRESS HRRZ P1,$FDBUF(D) ;LOAD SIZE OF BUFFERS HRLZI P1,-2(P1) ;DATA AREA SIZE + 1 HRRI P1,.BFADR(T1) ;[143] POINT TO 'LAST BUFFER' MKB10: ; LOOP HERE TO MAKE EACH BUFFER AND LINK TO LAST HRRZ T1,$FDBUF(D) ;SIZE ALLOC$ ;GET SPACE AND ZERO IT PJRST $XOPJ ;ERROR PUSH P,P2 ;NEED TEMP HRRZI P2,$BFHDR(P1) ;[144] ADDRESS OF LAST BUFFER HRRI P1,<$BFHDR-$BFSTS>(T1) ;[144] ADDRESS OF 2ND WORD MOVEM P1,$BFHDR(P2) ;[144] INTO LAST BUFFER POP P,P2 ;RECOVER AC SOJG P2,MKB10 ;LOOP TILL ALL BUFFERS CHAINED ; HERE WHEN ALL BUFFERS CHAINED. NOW CLOSE RING POP P,T1 ;ADDRESS OF HEADER MOVE P2,.BFADR(T1) ;[143] LOAD POINT TO 1ST BUFFER MOVEM P2,$BFHDR(P1) ;[144] SET IN LAST BUFFER MOVX P2,BF.VBR ;SET RING-USE BIT HLLM P2,.BFADR(T1) ; INTO BUFFER HEADER PJRST $POPJ1 ;GIVE SKIP RETURN SUBTTL CLOSE - CLOSE A CHANNEL ; CLOSE ; CLOSE A CHANNEL, EITHER WITH OR WITHOUT CLOSE BITS. ; BEWARE OF OUTPUT OR INPUT CLOSE INHIBIT, AND IF SET ; DO NOT UNSET FC$ENT OR FC$LUK ; CALL: ; D : FILE-BLOCK POINTER ; PUSHJ P,$CLOSE ; OR ; T1 : CLOSE BITS ; D : FDB POINTER ; PUSHJ P,$CLOS0 ENTRY $CLOSE,$CLOS0 $CLOSE:: PUSH P,T1 ;SAVE T1 TDZA T1,T1 ;CLEAR T1 (NO CLOSE BITS) $CLOS0: ;HERE WITH CLOSE BITS IN AC(T1) PUSH P,T1 ;SAVE T1 HRLI T1,(CLOSE) ;UUO CODE PUSHJ P,$XTUUO ;PERFORM UUO SETZM $FDNBK(D) ;KILL BLOCK NUMBER HLL T1,$FDCHN(D) ;PICK UP STATUS BITS TRNN T1,CL.OUT ;OUTPUT CLOSE INHIBIT? TXZ T1,FC$ENT ;NO. ZERO ENTER BIT TRNN T1,CL.IN ;INPUT CLOSE INHIBIT? TXZ T1,FC$LUK ;NO. ZERO LOOKUP BIT HLLM T1,$FDCHN(D) ;RESET STATUS PJRST $TOPJ ;RESTORE AC(T1) SUBTTL RLEAS - RELEASE A CHANNEL ; RLEAS ; RELEASE A CHANNEL ; CALL: ; D : FILE-BLOCK POINT ; PUSHJ P,$RLEAS ENTRY $RLEAS,$RLEA0 $RLEAS:: PUSH P,T1 ;PRESERVE T1 HLRZ T1,$FDBHD(D) ;RETURN BUFFERS TO HEAP PUSHJ P,$DLBUF ; HRRZ T1,$FDBHD(D) ; PUSHJ P,$DLBUF ;RETURN BUFFERS $RLEA0:: ;[142] ENTRY IF DON'T WANT TO LOSE BUFFERS MOVX T1,RELEAS ;UUO PUSHJ P,$XTUUO ; SETZM $FDCHN(D) ;ZERO CHANNEL NUMBER AND FLAGS PJRST $TOPJ ;RESTORE T1 SUBTTL DLBUF - DELETE A BUFFER RING ; DLBUF ; DELETE A RING OF BUFFERS BY FOLLOWING THE CHAIN AND ; CALLING $$CORE TO HAND EACH BUFFER BACK TO THE HEAP ; IF THE USER IS USING DYNAMIC CORE MANAGEMENT. ; CALL: ; T1 : POINT TO BUFFER HEADER ; PUSHJ P,$DLBUF ENTRY $DLBUF $DLBUF:: PJUMPE T1,$POPJ ;RETURN IF NO HEADER PUSHJ P,$SAVE2 ;NEED SOME PRESERVED HRRZ P1,.BFADR(T1) ;POINT TO 1ST BUFFER PJUMPE P1,$POPJ ;RETURN IF NO BUFFER RING HRRZ T1,P1 ; DLB10: ; LOOP HERE FOR EACH BUFFER IN RING HRRZ P2,$BFHDR(T1) ;[144] LOAD POINT TO NEXT BUFFER MOVEI T1,$BFSTS(T1) ;[144] LOAD POINT TO 1ST WORD OF TH BUFFER DEALC$ ;CALL CORE MANAGER MOVE T1,P2 ;POINT TO NEXT BUFFER CAME T1,P1 ;SAME AS 1ST BUFFER? JRST DLB10 ;NO. RETURN NEXT BUFFER POPJ P, ;YES. FINISH. SUBTTL XTUUO - EXECUTE AN IO UUO ON ANY CHANNEL ; XTELR ; EXECUTE A LOOKUP, ENTER OR RENAME UUO ACCORDING TO ; THE DEVICE TYPE. IF IT IS A DISK, DO A LONG UUO, ; IF IT IS A DECTAPE, DO A SHORT UUO AND IF ; NEITHER, DO NO UUO AT ALL. ; CALL: ; T1 : UUO CODE ; D : FDB POINTER ; PUSHJ P,XTELR ; ERROR RETURN ; NORMAL RETURN XTELR: SAVE1$ ;NEED PRESERVED ADDI T1,$FDRIB ;SET FOR DISK MOVE P1,$FDTYP(D) ;WANT $FDTYP TRNE P1,1B35 ;DECTAPE? HRRI T1,$FDNAM ;YES, SHORT UUO LDB P1,$FM$PR ;[122] PROTECTION GIVEN? JUMPE P1,$XTUUO ;NO LDB P1,$FD$PR ;[122] YES, LOAD IT DPB P1,[POINT 9,$FDPRV(D),8] ; IN LOOKUP/ENTER BLOCK ;FALL INTO $XTUUO ; XTUUO ; EXECUTE THE UUO GIVEN, WHICH SHOULD BE AN IO UUO. ; XTUUO EXTRACTS THE CHANNEL NUMBER FROM $FDCHN IN ; THE FDB AND ORS IT INTO THE UUO INSTRUCTION BEFORE ; EXECUTING THE INSTRUCTION ; CALL: ; T1 : IO UUO ; D : FDB POINTER ; PUSHJ P,$XTUUO ; ERROR (OR NON-SKIP) RETURN ; NORMAL (OR SKIP) RETURN ENTRY $XTUUO $XTUUO:: TLO T1,@$FDCHN(D) ;PICK UP CHANNEL NUMBER $$XUUO::XCT T1 ;[123,155] DO UUO POPJ P, ;NON-SKIP RETURN PJRST $POPJ1 ;SKIP RETURN SUBTTL XTCLI - EXECUTE A LOGICAL OR PHYSICAL DEVICE CALLI ; XTCLI ; SEVERAL CALLI UUOS OBTAIN INFORMATION ABOUT A DEVICE AND ; THESE SHOULD USE THE PHYSICAL DEVICE IF THE BIT IS SET ; EITHER IN BOTH $FDMOD AND $FDMOM, OR IN $FDSTS. ; CHECK $FDMOM AND $FDMOD. SET THE RESULT IN $FDSTS ; AND THEN USE THAT. ; CALL: ; T1 : UUO ; T2 : ARGUMENT ; PUSHJ P,$XTCLI OR XTCLI$ ; ERROR ; T1 : RESULT ENTRY $XTCLI,$XTCDV $XTCDV:: $XTDCL:: ;[124] NEW ENTRY POINT SKIPN T2,$FDDEV(D) ;DEVICE NAME MOVSI T2,'DSK' ;USE DISK MOVEM T2,$FDDEV(D) ;SET DEVICE $XTCLI:: $XTCAL:: ;[124] NEW ENTRY POINT PUSH P,T2 ;SAVE ARGUMENT MOVSI T2,'SYS' ;CHECK WHETHER PHYSICAL IMPLMEMTED DEVCHR T2, ; TRNN T2,-1 ;NOT IF ARG ZERO JRST XTC10 ;UNSET PHYSICAL BIT LDB T2,$FM$PH ;[122] LOAD PHYSICAL BIT JUMPE T2,XTC20 ;UNSET LDB T2,$FD$PH ;[122] XTC10: ;HERE TO SET PHYSICL BIT IN STATUS WORD DPB T2,$FS.PH ;[122] SET IN $FDSTS XTC20: ;HERE TO CHECK PHYSICAL BIT SKIPGE $FDSTS(D) ;SKIP IF UNSET TXC T1,UU.PHY ;ENSURE THAT UUO IS PHYSICAL TLO T1,T1_5 ;ADD IN AC FIELD POP P,T2 ;RECOVER ARGUMENT EXCH T1,T2 ;PICK UP ARGUMENT $$XCAL::XCT T2 ;[123,155] PERFORM UUO POPJ P, ;ERROR RETURN PJRST $POPJ1 ; SUBTTL FRCHN - FIND THE FIRST FREE IO CHANNEL ; FRCHN ; ; SEARCH THOUGH ALL IO CHANNELS AND RETURN THE FIRST AVAILABLE ; ONE. ; CALL: ; T1 : CHANNEL TO START WITH ; PUSHJ P,$FRCHN ; NO FREE CHANNELS ; T1 : FIRST FREE CHANNEL ENTRY $FRCHN $FRCHN:: CAILE T1,17 ;WITHIN RANGE? POPJ P, ;NO, OUT PUSH P,T1 ;SAVE NUMBER DEVCHR T1, ;GET CHARACTARISTICS PJUMPE T1,$TOPJ1 ;OK IF NOT USED POP P,T1 ;RECOVER NUMBER AOJA T1,$FRCHN ;ADD ONE AND LOOP SUBTTL SAVEN - SAVE N PRESERVED ACS ; SAVEN [162] rewrite as spr #10-13836 ; SAVE N PRESERVED ACS AND CALL S/R IN SUCH A WAY THAT ; IT WILL EXIT THROUGH THE RESTORE CODE, THUS RESTORING ; THE PRESERVED ACS ; CALL: ; PUSHJ P,$SAVEN ENTRY $SAVE1,$SAVE2,$SAVE3,$SAVE4 $SAVE1:: exch p1,(p) ;save p1, recover caller pc hrli p1,(p) ;remember where p1 is pushj p,[jra p1,(p1)];restore p1 and dispach to caller sos -1(p) ;compensate for $popj1 jrst resp1 ;restore p1 $save2:: exch p1,(p) ;save p1, recover caller pc hrli p1,(p) ;remember where p1 is push p,p2 ;save p2 pushj p,[jra p1,(p1)];restore p1 and dispach to caller sos -2(p) ;compensate for $popj1 jrst resp2 ;restore p2,p1 $save3:: exch p1,(p) ;save p1, recover caller pc hrli p1,(p) ;remember where p1 is push p,p2 ;save p2 push p,p3 ;save p3 pushj p,[jra p1,(p1)];restore p1 and dispach to caller sos -3(p) ;compensate for $popj1 jrst resp3 ; $save4:: exch p1,(p) ;save p1, restore caller pc hrli p1,(p) ;remember where p1 is push p,p2 ;save p2 push p,p3 ;save p3 push p,p4 ;save p4 pushj p,[jra p1,(p1)];resotore p1 and dispach to caler sos -4(p) ;compensate for $popj1 resp4: pop p,p4 ;recover p4 resp3: pop p,p3 ;recover p3 resp2: pop p,p2 ;recover p2 resp1: pop p,p1 ;recover p1 pjrst $popj1 ;pop back SUBTTL POPJ2 - FOR THOSE WHO NEED 2 EXTRA RETURNS ; POPJ2 ; THIS ONE MERELY UPS THE STACK ONE AND CALLS THE ; POPJ1 CODE ; ##WARNING## ; THIS CODE WILL NOT WORK WITH THE $SAVE1-$SAVE4 ROUTINES ; CALL: ; JRST $POPJ2 OR JRST $TOPJ2 ENTRY $TOPJ2,$POPJ2 $TOPJ2:: POP P,T1 ;RECOVER T1 $POPJ2:: AOSA (P) ;POP STACK ;FALL OVER INTO $POPJ1 SUBTTL POPJ - $POPJS AND $TOPJS ; POPJ/TOPJ/1 ; STANDARD POPJ CODE ; CALL: ; JRST $POPJ OR JRST $POPJ1 OR JRST $TOPJ OR JRST $TOPJ1 ENTRY $TOPJ1,$TOPJ,$POPJ1,$POPJ $TOPJ1:: POP P,T1 ;POP T1 $POPJ1:: AOSA (P) ;FIX TO GIVE SKIP RETURN $TOPJ:: POP P,T1 ;POP T1 $POPJ:: POPJ P, ; SUBTTL USEFUL BYTE POINTERS ;[122] BYTE POINTERS TO BITS IN $FDCHN(D) $FC$CH:: POINTR ($FDCHN(D),FC$CHN) ;CHANNEL NUMBER ; BYTE POINTERS TO BBITS IN $FDTYP(D) $FT.DE:: POINTR ($FDTYP(D),TY.DEV) ;DEVICE CODE ; BYTE POINTERS TO BITS IN $FDSTS(D) $FS.PH:: POINTR ($FDSTS(D),UU.PHS) ;PHYSICAL ONLY FIELD $FS.PA:: POINTR ($FDSTS(D),IO.PAR) ;PARITY FIELD $FS.DE:: POINTR ($FDSTS(D),IO.DEN) ;DENSITY FIELD ; BYTE POINTERS TO BITS IN $FDMOD(D) $FD$PH:: POINTR ($FDMOD(D),FM$PHY) ;PHYSICAL ONLY FIELD $FD$PA:: POINTR ($FDMOD(D),FM$PAR) ;PARITY FIELD $FD$DE:: POINTR ($FDMOD(D),FM$DEN) ;DENSITY FIELD $FD$PR:: POINTR ($FDMOD(D),FM$PRO) ;PROTECTION FIELD ; BYTE POINTERS TO BITS IN $FDMOM(D) $FM$PH:: POINTR ($FDMOM(D),FM$PHY) ;PHYSICAL ONLY FIELD $FM$PA:: POINTR ($FDMOM(D),FM$PAR) ;PARITY FIELD $FM$DE:: POINTR ($FDMOM(D),FM$DEN) ;DENSITY FIELD $FM$PR:: POINTR ($FDMOM(D),FM$PRO) ;PROTECTION FIELD PRGEND TITLE CLRFD - RETURN AN INITIALISED FDB SEARCH IOLIB IOL$ ; CLRFD ; IF AN FDB IS SUPPLIED, CLEAR IT AND SET $FDCNT. ; OTHERWISE, BUILD A NEW FDB AND SET $FDCNT. ; SET $FDBFR AND $FDSNC TOO. ; CALL: ; T1 : LENGTH,,ADDRESS (BOTH OPTIONAL) ; PUSHJ P,$CLRFD## OR CLRFD$ ; ERROR, T1 : ERNEC% (NOT ENOUGH CORE) ; T1 : POINT TO FDB ENTRY $CLRFD,$CLRF0 $CLRFD:: SETZ T1, ; $CLRF0:: SAVE1$ ;[170] NEED AC TLNN T1,-1 ;LENGTH SPECIFIED? HRLI T1,$LNFDB ;NO, SO USE STANDARD PUSH P,T1 ;SAVE LEN,,ADR TRNE T1,-1 ;ADDRESS GIVEN? JRST CLR10 ;YES, SOZERO THAT FDB HLRZ T1,T1 ;SET LENGTH ALLOC$ ;GET SPACE PJRST $XOPJ## ;[150] NONE - ERROR HRRM T1,(P) ;SAVE ADDRESS JRST CLR20 ;INITIALISE FDB CLR10: ;HERE TO ZERO FDB ZERO$ ;DO IT CLR20: ;HERE TO SET INITIAL VALUES POP P,P1 ;[170] RECOVER LEN,,ADR HRRZ T1,P1 ;[170] SET UP ADDRESS OF FDB HLRZ P1,P1 ;[170] SET UP LENGTH SUBI P1,<$FDCNT+1> ;[170] CONVERT TO RIB COUNT MOVEM P1,$FDCNT(T1) ;[170] SET INTO RIB BLOCK MOVEI P1,$FDPTH(T1) ;[170] ADDRESS OF PATH BLOCK MOVEM P1,$FDPPN(T1) ;[170] INTO PATH POINTER SETOM $FDABF(T1) ;[170] CLEAR ACCESS BEFORE SETOM $FDASN(T1) ;[170] CLEAR ACCESS-SINCE SETOM $FDBFR(T1) ;SET /BEFORE SETOM $FDSNC(T1) ;SET /SINCE PJRST $POPJ1## ;RETURN GOOD PRGEND TITLE LOSFD - LOSE AN FDB BACK TO THE SYSTEM SEARCH IOLIB IOL$ ; LOSFD ; THIS ROUTINE ONLY WINS IF DYNAMIC STORAGE ALLOCATION IS ; USED. HAND BACK AN FDB (INCLUDING A POSSIBLE PATH BLOCK) ; TO THE STORAGE MANAGER. ; CALL: ; [170] T1 : POINT TO FDB ; [170] PUSHJ P,$LOSFD## OR LOSFD$ ENTRY $LOSFD $LOSFD:: ;[170] NO NEED TO DEALLOCATE PATH BLOCK NO MORE PJRST $$DALC## ;PERFORM DEALLOCATION PRGEND TITLE $CORE - DUMMY ROUTINE TO SELECT CORE OR HEAP TYPE MANAGEMENT SEARCH IOLIB IOL$ ; $CORE ; THIS ROUTINE SELECTS DYNAMIC HEAP MANAGEMENT BY DEFINING THE ; SYMBOLS $$ALLC AND $$DALC. THE USER IS FREE TO SUBSTITUTE ; HIS OWN DEFINITIONS. ; CALL: ; T1 : 0 OR N, WHERE N IS THE SPACE REQUIRED AND 0 MEANS AS ; MUCH AS POSSIBLE ; PUSHJ P,$$ALLC ; ERROR T1 : ERNEC% ; OK, T1 POINTS TO WORD1 ENTRY $$ALLC $$ALLC:: PJRST $HPGET## ;AVOID MACRO 47(113) BUG ; CALL: ; T1 : POINT TO WORD1 OF FIRST CHUNK OF CHAIN TO DEALLOCATE ; PUSHJ P,$$DALC ENTRY $$DALC $$DALC:: PJRST $HPREL## ;AVOID MACRO 47(113) BUG PRGEND TITLE HEAP - DYNAMIC CORE ALLOCATION AND DEALLOCATION SEARCH IOLIB IOL$ ; HEAP ; THE DYNAMIC CORE ALLOCATOR DIVIDES ALL FREE CORE AVAILABLE ; TO THE PROGRAM INTO CHUNKS, AND CHAINS THESE UNUSED CHUNKS ; ATTACHED TO THE $IDATA BLOCK AT $IDDYC WITH THE SMALLEST CHUNK ; AT THE HEAD OF THE CHAIN AND THE REST IN ORDER. THE FORMAT ; OF THE CHUNK IS: ; WORD 0: WORDS IN CHUNK INCL. WORD 0,,POINT TO NEXT CHUNK ; WORD 1: FIRST DATA WORD ETC ; A. HPGET ; LOOK DOWN THE CHAIN TO FIND A CHUNK BIG ENOUGH FOR THIS ; REQUEST. IF THERE IS ONE, SPLIT IT AND GIVE BACK ANY ; EXCESS WORDS. IF NOT, GARBAGE COLLECT THE CHAIN AND TRY ; AGAIN. IF STILL NOT ENOUGH SPACE, USE THE CORE UUO TO ; FIND SOME MORE. THE PROCESS FINALLY FAILS IF THE CORE ; UUO HITS THE TOP OF AVAILABLE CORE, OR IF WE HIT A ; USER PROGRAM IMPOSED LIMIT IN $IDTOP OF $IDATA. ; B. HPREL ; RELEASE A CHUNK OR CHAIN OF CHUNKS FOR FUTURE USE BY ; ADDING THEM BACK TO THE CHAIN OF FREE CHUNKS. ; HPGET ; CALL: ; T1 : 0 OR +VE, 0 INDICATES TO GET THE LARGEST AVAILABLE CHUNK ; OTHERWISE GET A CHUNK OF T1 WORDS ; PUSHJ P,$HPGET ; ERROR (NOT ENOUGH CORE) T1 : ERNEC% ; OK, T1 : POINT TO WORD 1 OF CHUNK ENTRY $HPGET SUBTTL HPGET - ALLOCATE CHUNK FROM CHAIN OF FREE CORE $HPGET:: SAVE4$ ;NEED 2 PRESERVED JUMPG T1,GTHEAP ;ARG>0 => GET FROM HEAP ; HERE TO GET BIGGEST CHUNK FROM HEAP PUSHJ P,GARBAG ;DO GARBAGE COLLECTION HLRZ T1,(P2) ;SIZE OF BIGGEST SUBI T1,1 ;LESS 1 FOR HEADER GTHEAP: ; HERE TO GET A CHUNK FROM THE HEAP MOVEI P2,$IDDYC(I) ;POINT TO CHAIN HEAD SKIPN P1,(P2) ;HEAP EMPTY? JRST GTH30 ;YES. NEED MORE HEAP SPACE GTH10: ; LOOP HERE THROUGH HEAP UNTIL FIND BIG ENOUGH CHUNK HLRZ P3,(P1) ;SIZE OF REQUESTED CHUNK CAMLE P3,T1 ;IS THIS CHUNK BIG ENOUGH? AOJA T1,GTH50 ;YES. UP REQUEST SIZE TO INCLUDE HEADER MOVE P2,P1 ;ADVANCE ALONG HRRZ P1,(P2) ; CHAIN JUMPN P1,GTH10 ;LOOP UNTIL REACH END OF CHAIN GTH20: ; HERE TO GARBAGE COLLECT CHAIN FOR ANOTHER GO PUSHJ P,GARBAG ;PERFORM GARBAGE COLLECTION HLRZ P1,(P2) ;SIZE OF BIGGEST CHUNK CAMLE P1,T1 ;BIG ENOUGH? JRST GTHEAP ;YES, SO FIND SMALLEST BIG ENOUGH GTH30: ; HERE WHEN NO BLOCK LONG ENOUGH. NEED MORE CORE HRRZ P1,.JBFF ;CURRENT TOP OF PROGRAM HLRZ P2,$IDCPU(I) ;[171] LOAD PAGE SIZE TRNE P1,(P2) ;[171] MULTIPLE OF PAGE SIZE? JRST GTH40 ;NO. ADD REST OF THIS K TO HEAP AOS P2,.JBREL ;YES. GRAB ANOTHER 1K CAMGE P2,$IDTOP(I) ;OVER USER IMPOSED LIMIT? CORE P2, ; FROM THE MONITOR JRST [MOVEI T1,ERNEC% ;SET ERROR CODE POPJ P,] ;NON-SKIP RETURN GTH40: ; HERE WITH MORE CORE TO ADD TO HEAP HRRZ P2,.JBREL ;PICK UP NEW TOP OF CORE SUBI P2,-1(P1) ;FIND SIZE OF NEW CHUNK HRLZM P2,@.JBFF ;TELL CHUNK ITS SIZE ADDB P2,.JBFF ;ADVANCE TOP OF PROGRAM TO TOP OF CORE PUSHJ P,GVH10 ;DONATE CHUNK TO HEAP JRST GTH20 ;SEE IF NEW CHUNK IS BIG ENOUGH GTH50: ; HERE WHEN HAVE FOUND A LARGE ENOUGH CHUNK TO SATISFY US HRRZ P4,(P1) ;EXTRACT CHUNK FROM CHAIN HRRM P4,(P2) ; BY LINKING NEXT CHUNK TO LAST CHUNK HRLZM T1,(P1) ;TELL CHUNK ITS SIZE ; ZERO CHUNK HRRI P4,2(P1) ;3RD WORD HRLI P4,-1(P4) ;2ND WORD HRRZ P2,T1 ;LAST WORD = ADDI P2,-1(P1) ; SIZE+1ST WORD-1 SETZM 1(P1) ;ZERO 2ND WORD BLT P4,(P2) ;ZERO REST ; RETURN ANY LEFTOVERS TO CHAIN PUSH P,P1 ;SAVE ADDRESS OF CHUNK CAML T1,P3 ;EXACT SIZE? JRST GTH60 ;RETURN SUB P3,T1 ;NO. FIND SIZE OF REMAINDER ADD P1,T1 ;ADDRESS OF HEAD OF REMAINDER HRLZM P3,(P1) ;TELL REMAINDER ITS SIZE PUSHJ P,GVH10 ;RETURN REMAINDER TO HEAP GTH60: ;HERE TO RETURN A CHUNK POP P,T1 ;RECOVER CHUNK POINT AOJA T1,$POPJ1## ;POINT TO 1ST DATA WORD & GIVE GOOD RETURN SUBTTL HPREL - RELEASE CHUNKS TO FREE CHAIN ; HPREL ; CALL: ; T1 : POINT TO CHAIN OF CHUNKS(WORD 1) ; PUSHJ P,$HPREL ENTRY $HPREL $HPREL:: GVHEAP: ; HERE TO RETURN CHUNK(S) TO HEAP SAVE4$ ;NEED LOTS OF ACS MOVEI P1,-1(T1) ;POINT TO HEADER WORD GVH10: ; INTERNAL ENTRY POINT SKIPN P2,$IDDYC(I) ;HEAP CHAIN EMPTY? JRST [HRRZM P1,$IDDYC(I) ;YES, SET HEAP CHAIN POPJ P,] ;AND RETURN HLRZ P3,(P1) ;NO. LOAD LENGTH OF DONATED CHUNK MOVEI P4,$IDDYC(I) ;POINT TO CHAIN POINT PUSH P,P1 ;NEED TEMP. GVH20: ; LOOP HERE TO FIND RIGHT SLOT IN CHAIN HLRZ P1,(P2) ;LENGTH OF NEXT CHUNK CAML P1,P3 ;BIGGER THAN NEW CHUNK? JRST GVH30 ;YES. INSERT HERE MOVE P4,P2 ;NO. ADVANCE ALONG HRRZ P2,(P4) ; CHAIN JUMPN P2,GVH20 ;LOOP TILL FALL OFF END GVH30: ; HERE WHEN FOUND PLACE TO INSERT NEW CHUNK POP P,P1 ;RECOVER P1 HRRM P1,(P4) ;CHAIN TO LAST BLOCK HRRZ P4,(P1) ;CHAIN TO NEXT HRRM P2,(P1) ; BLOCK PJUMPE P4,$POPJ## ;RETURN IF NO MORE NEW CHUNKS MOVE P1,P4 ;LOOP BACK WITH NEXT CHUNK JRST GVH10 ; SUBTTL GARBAG - FREE CHAIN GARBAGE COLLECTOR GARBAG: ; HERE TO PERFORM GARBAGE COLLECTION ; FOR EACH CHUNK, TRAVERSE ENTIRE CHAIN LOOKING FOR A ; NEIGHBOUR FOR HIS BOTTOM. ; IF A NEIGHBOUR IS FOUND, JOIN THEM, INSERT COMBINED ; BLOCK AND RESTART GARBAGE COLLECTION. ; FINISH ONLY WHEN A COMPLETE TRAVERSE SUCCEEDS. PUSH P,T1 ;SAVE TEMP. GAR05: ;LOOP HERE FOR EACH COLLECTION MOVEI P2,$IDDYC(I) ;POINT TO CHAIN POINT MOVE P1,(P2) ;POINT TO CHAIN GAR10: ; LOOP HERE FOR EACH CHUNK IN CHAIN MOVEI P3,$IDDYC(I) ;POINT TO CHAIN POINT MOVE P4,(P3) ;POINT TO CHAIN HLRZ T1,(P1) ;LENGTH OF CHUNK ADDI T1,(P1) ;FIRST WORD AFTER CHUNK GAR20: ; LOOP HERE FOR EACH CHUNK IN CHAIN DURING PASS FOR EACH CHUNK CAME P1,P4 ;BOTH POINTS TO SAME CHUNK? CAME T1,P4 ;NO. CHUNKS ADJACENT? JRST GAR40 ;SAME OR NON-ADJACENT ; EXTRACT AND CONNECT THE TWO BLOCKS TAKING CARE WHEN ; THE 4 CHUNKS CURRENTLY POINTED AT OVERLAP HRRZ T1,(P1) ;POINT TO 'NEXT' FIXED CHUNK CAMN P2,P4 ;MOVING CHUNK = 'LAST' FIXED CHUNK? JRST [HRRM T1,(P3) ;YES. JOIN 'NEXT' FIXED TO 'LAST' MOVING JRST GAR30] ;JOIN CHUNKS TOGETHER HRRM T1,(P2) ;NO. JOIN 'NEXT' FIXED TO 'LAST' FIXED HRRZ T1,(P4) ;PICK UP NEXT MOVING CAMN P1,P3 ;FIXED CHUNK = LAST MOVING? JRST [HRRM T1,(P2) ;YES. JOIN NEXT MOVING TO LAST FIXED JRST GAR30] ;JOIN CHUNKS TOGETHER HRRM T1,(P3) ;JOIN NEXT MOVING TO LAST MOVING GAR30: ; HERE TO JOIN TWO ADJACENT CHUNKS TOGETHER HLRZ T1,(P4) ;ADD SIZES TOGETHER HLRZ P3,(P1) ; ADDI T1,(P3) ; HRLZM T1,(P1) ;TELL CHUNK HIS NEW SIZE PUSHJ P,GVH10 ;RETURN CHUNK TO HEAP JRST GAR05 ;RECOMMENCE GARBAGE COLLECT GAR40: ; HERE IF NO MATCH FOR THIS PAIR OF CHUNKS MOVE P3,P4 ;ADVANCE CHAIN SCAN HRRZ P4,(P3) ; JUMPN P4,GAR20 ;LOOP UNTIL REACH END ; HERE IF NO MATCH AT ALL FOR THIS CHUNK MOVE P2,P1 ;ADVANCE CHAIN SCAN HRRZ P1,(P2) ; JUMPN P1,GAR10 ;LOOP UNTIL REACH END PJRST $TOPJ## ; PRGEND TITLE CORE - SIMPLE MINDED GET AND RELEAS A CHUNK OF CORE SEARCH IOLIB IOL$ ; CORE ; A. CRGET ; FIND ENOUGH CORE FOR THE REQUEST ABOVE .JBFF AND ZERO IT. ; IF THERE IS TOO LITTLE CORE BELOW .JBREL, USE THE CORE ; UUO TO FIND SOME MORE. THE LIMIT IS SET EITHER BY THE ; TOTAL PHYSICAL USER CORE AVAILABLE, OR BY A PRESET LIMIT ; KEPT IN THE $IDATA BLOCK. ; ; B. CRREL ; IT IS NOT POSSIBLE TO RELEASE CORE USING THIS SIMPLE CORE ; MANAGEMENT ALGORITHM. ; CRGET ; CALL: ; T1 : SIZE OF CHUNK REQUIRED ; PUSHJ P,$CRGET ; ERROR (NOT ENOUGH CORE), T1 : ERNEC% ; OK, T1 : POINT TO CHUNK ENTRY $CRGET $CRGET:: PUSH P,.JBFF ;[152] SAVE POINT TO CHUNK JUMPLE T1,CORERR ;[152] GIVE ERROR RETURN IF DATA BAD ADDB T1,.JBFF ;RESET TO NEW TOP OF CORE CAMGE T1,.JBREL ;ABOVE PRESENT BOUNDARY? JRST CRG10 ;NO CAMG T1,$IDTOP(I) ;ABOVE ABSOLUTE BOUNDARY? CORE T1, ;NO, GET MORE CORE JRST CORERR ;ABOVE PHYSICAL BOUNDARY! CRG10: ;HERE WITH THE NEW CORE CHUNK HRRZ T1,.JBFF ;LOAD TOP OF CORE SUB T1,(P) ;FIND LENGTH HRL T1,T1 ;MAKE LEN,,ADR HRR T1,(P) ; PUSHJ P,$ZERO## ;CLEAR IT PJRST $TOPJ1## ;AND RETURN CORERR: ;HERE TO RETURN ERNEC% ERROR CODE MOVEI T1,ERNEC% ;SET ERROR CODE PJRST $XOPJ## ; ; CRREL ; CALL: ; T1 : POINT TO CHUNK TO RETURN ; PUSHJ P,$CRREL ENTRY $CRREL ;$CRREL==:$POPJ## $CRREL::JRST $POPJ## ;AVOID MACRO V47 BUG PRGEND TITLE $FERR - STANDARD CODE TO END UP FATAL ERROR SEARCH IOLIB IOL$ ; $FERR ; ; FATAL ERRORS MERELY CLEAR OUT THE INPUT BUFFER AND ; DO A MONRET ; ; CALL: ; JRST $$FERR ENTRY $$FERR $$FERR:: CLRBFI ;CLEAR TERMINAL INPUT MONRT$ ;RETURN TO MONITOR MODE HRRZ T1,.JBSA ;LOAD START ADDRESS JUMPN T1,(T1) ;START OVER EXIT ;UNLESS THWARTED BY CALLER PRGEND TITLE CLLIN - CLEAR LINE OF INPUT SEARCH IOLIB IOL$ ; CLLIN ; CLEAR THE CURRENT LINE OF INPUT SO THAT WE CAN START ANOTHER ; - USED EE.G. AFTER A SYNTAX ERROR ; CALL: ; D : FILE POINTER ; PUSHJ P,$CLLIN OR CLLIN$ ENTRY $CLLIN $CLLIN:: PUSH P,T1 ;SAVE AC CLL10: ;LOOP HERE FOR EACH CHARACTER ON THE LINE SKIPG $IDLSC(I) ;ENDLINE LAST? PJRST $TOPJ## ;YES, OK RCHAR$ ;READ A CHARACTER JRST CLL10 ;BACK FOR ANOTHER TEST PRGEND TITLE CLBUF - CLEAN UP INPUT ON ERROS SEARCH IOLIB IOL$ ; CLBUF ; ; CLEAN UP ALL INPUT ; ; CALL: ; D : FDB ; PUSHJ P,$CLBUF ENTRY $CLBUF $CLBUF:: JUMPN D,CLB10 ;TTCALL? CLRBFI ;YES. CLEAN OUT JRST CLB20 ;END UP CLB10: ;CLEAN OUT LINE OF INPUT FILE MOVE T1,$IDLAC(I) ;LAST CHARACTER SKPINC ;ANYTHING THERE SKIPE D ;NO, TTCALL? JRST .+2 ;SKIP OTHERWISE HRREI T1,$CHEOL ;MAKE EOL JUMPLE T1,CLB20 ;END IF EOL RCHAR$ ;READ CHARACTER JRST CLB10 ;BACK CLB20: ;WASH OUT DATA WORDS SETZM $IDNXC(I) ; SETZM $IDCPC(I) ; CAME T1,[$CHEOF] ;MAKE EOF HRREI T1,$CHEOL ;LOOK LIKE EOL MOVEM T1,$IDLAC(I) ;SET AS LAST CHARACTER POPJ P, ; PRGEND TITLE MONRT - RETURN TO MONITOR MODE SEARCH IOLIB IOL$ ; MONRT ; ; RETURN TO MONITOR MODE, TAKING CARE ABOUT LOGGING ; OUT IF NECESSARY ; CALL: ; PUSHJ P,$MONRT ; ;RETURN IF USER TXPES CONTINUE ENTRY $MONRT JLOG==4 ;JLOG IN JBTSTS $MONRT:: HRROI T1,.GTSTS ;LOGGED IN? GETTAB T1, ; HALT . ;ABSURD TLNN T1,JLOG ;LOGGED IN? JRST MON10 ;NO. LOG OUT RESET MONRT. POPJ P, MON10: ;LOGGED OUT OUTSTR [ASCIZ / .KJOB ./] LOGOUT PRGEND TITLE MATCH - COMPARE STANDARD WITH TABLE SEARCH IOLIB IOL$ ; MATCH ; LOOKUP NAME IN TABLE AND ALLOW FOR UNIQUE ABBREVIATIONS ; 1ST CHARACTER * INDICATES FIRST LETTER IS AN OK ABBREV. ; CALL: ; T1 : IOWD LENGTH,START OF TABLE ; T2 : NAME TO MATCH ; PUSHJ P,$MATCH## OR MATCH$ ; ERROR ;T1 LT 0 =NO MATCH, GE 0=SEVERAL MATCHES ; T1 : INDEX, LH=0 IF ABBREV., LT 0 IF EXACT ; T2 : UNCHANGED ENTRY $MATCH $MATCH:: JUMPGE T1,[SETOM T1 ;UNKNOWN IF BAD IOWD POPJ P,] SAVE2$ ;NEED 2 PRESERVED PUSH P,T1 ;PRESERVE IOWD MOVEI P1,0 ;ZERO MASK MOVX P2,77B5 ;START WITH 1ST CHARACTER MAT05: ;LOOP MAKING MASK FOR EACH CHARACTER TDNE T2,P2 ;BLANK? IOR P1,P2 ;NO, SO SET ONES IN MASK LSH P2,-6 ;ADVANCE TO NEXT CHARACTER JUMPN P2,MAT05 ;LOOP FOR 6 CHARACTERS SETOM P2 ;INITIALISE ABBREV. MATCH COUNT AOS T1 ;POINT TO 1ST OF TABLE MAT10: ;LOOP HERE THROUGH ENTIRE TABLE MOVE T3,(T1) ;PICK UP NEXT MEMBER TXNE T3,3B1 ;* = 12. USE CRUDE MASK! JRST MAT20 ;NOT '*'. PROCEED ;HERE IF 1ST CHARACTER IS UNIQUE ABBREV. LSH T3,6 ;GET RID OF '*' XOR T3,T2 ;ZERO ALL IDENTICAL BITS TRZ T3,77 ;CLEAR LAST CHARACTER AND T3,P1 ;CHECK IF OK JUMPE T3,MAT40 ; JRST MAT30 ;NO. PROCEED TO NEXT MAT20: ;HERE IF NO '*' XOR T3,T2 ;EXACT MATCH? JUMPE T3,MAT40 ;YES. AND T3,P1 ;MAYBE ABBREVIATION PJUMPN T3,MAT30 ;NO MOVE T4,T1 ;REMEMBER IT AOS P2 ;INCREMENT COUNT MAT30: ;HERE TO LOOP UNTIL REACH END OF TABLE AOBJN T1,MAT10 ; HRRZ T1,T4 ;LAST ABBREV SEEN JUMPE P2,MAT40 ;GOOD IF UNIQUE MOVEM P2,(P) ;STACK RETURN PARAMETER PJRST $TOPJ## ; MAT40: ;HERE TO MAKE INDEX AND RETURN POP P,T3 ;RECOVER ORIGINAL IOWD SUBI T1,1(T3) ;MAKE INDEX PJRST $POPJ1## ; PRGEND TITLE CNTDT - CONVERT UNIVERSAL DATE/TIME TO INTERNAL SEARCH IOLIB IOL$ ; CNTDT [161] ; [161] algorithm rewritten along scan v:6 lines ; CONVERT A DATE/TIME IN UNIVERSAL FORMAT TO INTERNAL ; CALL: ; T1 : DATE,,TIME ; PUSHJ P,$CNTDT OR CNTDT$ ; T1 : TIME IN MILLISECS ; T2 : DATE IN INTERNAL FORMAT ENTRY $CNTDT RADIX 10 $CNTDT:: $CNVUI:: ;[124] CONVERT UNIVERSAL TO INTERNAL (NEW ENTRY) PUSH P,T1 ;SAVE INPUTS JUMPL T1,CNT60 ;NEED OUT IF INPUT BAD HLRZ T1,T1 ;DO DATE FIRST (DAYS SINCE 1858) addi t1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17 ;days since 1jan 1501 idivi t1,400*365+400/4-400/100+400/400 ;split into quadracentury lsh t2,2 ;convert to number of quarter days idivi t2,<100*365+100/4-100/100>*4+400/400 ;split into century iori t3,3 ;discard fractions of a day idivi t3,4*365+1 ;separate into years lsh t4,-2 ;number of days this year (t4) lsh t1,2 ;4*number of quadracenturies (t1) add t1,t2 ;number of centuries (t1) imuli t1,100 ;100*number of centuries (t1) addi t1,1501(t2) ;year (t1) : day in year (t4) move t2,t1 ;copy year for leap year test trne t2,3 ;multiple of 4? jrst cnt05 ;no - not leap year idivi t2,100 ;multiple of 100? skipn t3 ;if not, then leap trnn t2,3 ;multiple of 400? tdza t3,t3 ;yes - leap year : flag as such cnt05: ;here to flag un-leap year movei t3,1 ;set flag CNT10: ;HERE TO PROCESS LEAP YEARS (T3 : 0) INDICATES LEAP YEAR SUBI T1,1964 ;SYSTEM ORIGIN IMULI T1,31*12 ;CHANGE TO SYSTEM PSEUDO DAYS JUMPN T3,CNT20 ;EXIT IF NOT LEAP YEAR CAIGE T4,31+29 ;BEYOND FEB 29? JRST CNT50 ;NO, NO PROBLEM SOS T4 ;YES, BACK ONE DAY CNT20: ;HERE TO ADJUST FOR MONTHS MOVSI T2,-11 ;FOR 11 MONTHS CNT30: ;LOOP HERE FOR EACH MONTH CAMGE T4,MONTAB+1(T2) ;BEYOND THIS MONTH? JRST CNT40 ;YES, ESCAPE ADDI T1,31 ;NO, COUNT SYSTEM MONTH AOBJN T2,CNT30 ;BACK TILL FINISHED CNT40: ;INCLUDE THIS MONTH IN RESULT SUB T4,MONTAB(T2) ;GET DAYS IN THIS MONTH CNT50: ;ADD DSY INTO RESULT ADD T1,T4 ;INCLUDE IN FINAL RESULT CNT60: ;HERE DO DO TIME AND FINISH UP EXCH T1,(P) ;SAVE DATE, EXHUME TIME TLZ T1,-1 ;CLEAR DATE MUL T1,[24*60*60*1000] ;CONVERT TO MILLISECS ASHC T1,17 ;POSITION RESULT POP P,T2 ;RECOVER DATE POPJ P, ;EXIT RADIX 8 SUBTTL CNNOW - CONVERT NOWW INTO UNIVERSAL FORMAT ; CNNOW ; GET NOW IN INTERNAL FORMAT FROM THE MONITOR, AND MAKE IT UNIVERSAL ; CALL: ; PUSHJ P,$CNNOW OR CNNOW$ ; T1 : NOW IN UNIVERSAL DATE TIME FORMAT ENTRY $CNNOW $CNNOW:: $CNVNU:: ;[124] CONVERT NOW TO UNIVERSAL (NEW ENTRY) MSTIME T1, ;GET TIME DATE T2, ;GET DATE PJRST $CNVDT ;CONVERT IT SUBTTL CNVDT - CONVERT INTERNAL DATE/TIME TO UNIVERSAL ; CNVDT ; MERELY THE REVERSE OF $CNTDT (BUT SIMPLER) ; CALL: ; T1 : TIME IN MILLISECS ; T2 : DATE IN INTERNAL FORMAT ; PUSHJ P,$CNVDT OR CNVDT$ ; T1 : DATE,,TIME ENTRY $CNVDT RADIX 10 $CNVDT:: $CNVIU:: ;[124] CONVERT INTERNAL TO UNIVERSAL (NEW ENTRY) SAVE1$ ;NEED PRESERVED PUSH P,T1 ;SAVE TIME INPUT IDIVI T2,12*31 ;T2 : YEARS-1964 CAILE T2,2217-1964 ;AFTER 2217 A.D.? JRST CNV20 ;TOO LATE, TOO LATE THE MAIDEN CRIED.. IDIVI T3,31 ;T3 : MONTH-JAN, T4 : DAY-1 ADD T4,MONTAB(T3) ;T4 : DAY- MOVEI P1,0 ;LEAP YEAR ADDITIVE IF JAN,FEB CAIL T3,2 ;CHECK MONTH MOVEI P1,1 ;MAR-DEC MOVE T1,T2 ;COPY YEARS ADDI T2,3 ;OFFSET SINCE LEAP YEAR DOESN'T GET COUNTED IDIVI T2,4 ;HANDLE REGULAR LEAP YEARS CAIE T3,3 ;IS THIS A LEAP YEAR? MOVEI P1,0 ;NO, NO ADDITIVE ADDI T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T2) ;T4 : DAYS BEFORE 1-1-64 + SINCE JAN 1 ; +ALLOWANCE FOR ALL LEAP YEARS SINCE 1964 MOVE T2,T1 ;RESTORE YEARS SINCE 1964 IMULI T2,365 ;DAYS SINCE 1964 ADD T4,T2 ;T4 : DAYS EXCEPT FOR 100 YEAR FUDGE HRREI T2,64-100-1(T1) ;T2 : YEARS SINCE 2001 JUMPLE T2,CNV10 ;ALL DONE IF NOT YET 2001 IDIVI T2,100 ;CENTURIES SINCE 2001 SUB T4,T2 ;ALLOW FOR LOST LEAP YEARS CAIE T3,99 ;IS THIS A LOST LEAP YEAR? CNV10: ;ALLOW FOR LEAP YEAR THIS YEAR ADD T4,P1 ;ADD ADDITIVE CAILE T4,^O377777 ;TOO BIG? CNV20: ;TOO BIG. MAKE -1 SETOM T4 ; POP P,T1 ;RECOVER TIME MOVEI T2,0 ;CLEAR ASHC T1,-17 ;SET UP FOR BIG DIVIDE DIV T1,[24*60*60*1000] ;CONVERT TO 1/2**18 DAYS HRL T1,T4 ;ADD IN DATE POPJ P, MONTAB: ;TABLE OF MONTH LENGTHS EXP 0,31,59,90,120,151,181,212,243,273,304,334,365 RADIX 8 PRGEND TITLE BATCH - DETERMINE WHETHER THE JOB IS RUN THOUGH BATCH SEARCH IOLIB IOL$ ; BATCH ; ASK GETTAB WHETHER THIS IS A BATCH JOB OR NOT ; IF SO, GIVE A SKIP RETURN ; CALL: ; PUSHJ P,$BATCH## OR BATCH$ ; NON-BATCH ; BATCH ENTRY $BATCH $BATCH:: PUSH P,T1 ;NEED AC HRROI T1,.GTLIM ;TIMELIMIT TABLE GETTAB T1, ; SETZ T1, ;ASSUME NOT BATCH (COULD ASK GETLCH) TXNE T1,JB.LBT ;BATCH BIT ON? PJRST $TOPJ1## ;YES PJRST $TOPJ## ;NO PRGEND TITLE SLEEP - SLEEP FOR A FEW SECONDS SEARCH IOLIB IOL$ ; SLEEP ; TRY TO SLEEP USING HIBER UUO, AND IF THAT FAILS, SLEEP ; USING SLEEP ; CALL: ; T1 : SLEEP TIME IN SECONDS ; PUSHJ P,$SLEEP ENTRY $SLEEP $SLEEP:: SETZ T1, ;[130] CLEAR SLEEP TIME $SLEE0:: PUSH P,T2 ;NEED AN AC SKIPN T1 ;DEFAULT NEEDED? MOVEI T1,SLPMIN ;YES. USE STANDARD MOVE T2,T1 ;COPY TIME IMULI T2,^D1000 ;TURN TO MILLISECS HIBER T2, ;ATTEMPT TO HIBER SLEEP T1, ;FAIL, SO SLEEP POP P,T2 ;RECOVER AC POPJ P, ; PRGEND TITLE ZERO - CLEAR A BLOCK OR WORD OF CORE SEARCH IOLIB IOL$ ; ZERO ; CLEAR A BLOCK OF CORE (OR A WORD) GIVEN ITS LENGTH ; AND ADDRESS. BLOCKS OF 1 WORD OR LESS ARE TREATED ; AS ONE WORD. ; CALL: ; T1 : LENGTH,,ADDRESS ; PUSHJ P,$ZERO## OR ZERO$ ; T1 : ADDRESS ENTRY $ZERO $ZERO:: PUSH P,T1 ;PRESERVE ADDRESS PUSH P,T2 ;EXTRA AC SETZM (T1) ;CLEAR 1ST WORD HRLZI T2,1(T1) ;PREPARE FOR BLT ROTC T1,^D18 ;T1 : ADR,,ADR+1 : T2 : 0,,LEN ADDI T2,-2(T1) ;SET T2 TO LAST WORD CAILE T2,-1(T1) ;NO BLT IF LENGTH LE 1 BLT T1,(T2) ; POP P,T2 ; PJRST $TOPJ## ; PRGEND TITLE TBMTH - TABLE OF MONTHS AND THEIR LENGHTS SEARCH IOLIB ;[176] NECESSARY DAMMIT IOL$ ;[176] ; TBMTH ; JUST A TABLE OF THE MONTHS IN SIXBIT ENTRY $TBMTH DEFINE MON(MN,ML)< +ML > RADIX 10 $TBMTH:: MON JAN,31 MON FEB,29 MON MAR,31 MON APR,30 MON MAY,31 MON JUN,30 MON JUL,31 MON AUG,31 MON SEP,30 MON OCT,31 MON NOV,30 MON DEC,31 $LNMTH==:.-$TBMTH RADIX 8 PRGEND TITLE SAVET - SAVE (& RESTORE) 4 TEMPORARIES SEARCH IOLIB IOL$ ; SAVET [135] ; SAVE 4 TEMPORARY ACS ON THE STACK IN ORDER T1-T4. ; CALL: ; PUSHJ P,$SAVET## ENTRY $SAVET $SAVET:: PUSH P,T2 ;SAVE T2 PUSH P,T3 ;SAVE T3 PUSH P,T4 ;SAVE T4 EXCH T1,-3(P) ;SAVE T1 & GET RETURN PUSH P,T1 ;SAVE RETURN MOVE T1,-4(P) ;RESTORE T1 POPJ P, ;RETURN ; RESTT ; RESTORE ALL THE TEMPORARIES SAVED BY $SAVET ; CALL: ; PUSHJ P,$RESTT## ENTRY $RESTT $RESTT:: POP P,T1 ;GET RETURN POP P,T4 ;RESTORE T4 POP P,T3 ; " T3 POP P,T2 ; " T2 EXCH T1,(P) ;RESTORE T1 & RESAVE RETURN POPJ P, ; PRGEND TITLE BEGIN - initialise a program on startup SEARCH IOLIB IOL$ ; BEGIN ; Merely execute a RESET, set up a stack pointer and a ; command FDB pointer and initialise the IDB. ; Call: ; T1 : 0 or tempcore filename (ignored) ; JSP T0,$BEGIN ENTRY $BEGIN $BEGIN:: RESET ;cancel previous IO INSTK$ ;initialise P PUSHJ P,$INIID## ;initialise IDB CMDFD$ ;initialise D JRST @T0 ;return PRGEND TITLE BEGCC - initialise a program with CCL entry SEARCH IOLIB IOL$ ; BEGCC ; do a RESET, setup a stack pointer in ac(P), initialise ; the IDB, check for tempcore command input, and if true ; build an FDB and read the tempcore file. Setup ac(D) to ; read commands ; Call: ; T1 : 0 or tempcore filename ; JSP T0,$BEGCC## ENTRY $BEGCC $BEGCC:: RESET ; INSTK$ ;initialise stack pointer P PUSH P,T1 ;save CCL pointer PUSHJ P,$INIID## ;initialise the IDB POP P,$IDCCL(I) ;save CCL entry code SKIPN T1,$IDCCL(I) ;CCL entry? JRST BEG10 ;no: exit normally PUSHJ P,$TMPFD## ;build a tempcore FDB MOVEM D,$IDIFD(I) ;set it as the command file PUSHJ P,$TMPIN## ;read block 1 FATAL$ ;IO error BEG10: ;here to setup ac(D) CMDFD$ ; JRST @T0 ;return PRGEND TITLE STACK - PUSH DOWN STACK SEARCH IOLIB IOL$ ; STACK ; A DEFAULT PUSH DOWN STACK, AND A POINTER TO THAT STACK ; THE USER MAY DEFINE HIS OWN STACK USING THE SYMBOLS ; $STACK AND $LNSTK AND $PTSTK, AND THEN THE LOADER WILL ; NOT LOAD THIS ROUTINE. ENTRY $PTSTK,$STACK $PTSTK:: IOWD $LNSTK,$STACK ;THE IOWD RELOC $STACK:: BLOCK $LNSTK ;THE STACK PRGEND TITLE IDATA - IOLIB DATA BLOCK SEARCH IOLIB IOL$ ; INIDB ; CODE TO INITIALISE THE IDB. ; CALL: ; PUSHJ P,$INIDB ENTRY $INIDB,$INIID $INIDB:: $INIID:: ;[124] NEW ENTRY SETZM $IDATA ;CLEAR THE IDB MOVE T1,[$IDATA,,$IDATA+1] ; BLT T1,ENDIDB ; MOVEI I,$IDATA ;load the IDB pointer PJOB T1, ;[127] READ JOB NUMBER MOVEM T1,$IDJNO(I) ;[127] AND KEEP IT GETPPN T1, ;[127] READ PPN JFCL ;[127] ** CASE: JACCT ** MOVEM T1,$IDJPP(I) ;[127] KEEP PPN SETOM $IDJPT(I) ;[170] FIND DEFAULT PATH SPEC. MOVE T1,[FT$SFD+3,,$IDJPT+$IDATA] ;[171] PATH. T1, ;[171] JFCL ;[171] UUO FAILURE IS OK HRLOI T1,-2 ;[171] TEST FOR KA/KI CPU AOBJP T1,.+2 ;[171] CRITICAL TEST (KA SKIPS) SKIPA T1,[777,,1] ;[171] KI PAGE SIZE AND FLAG MOVSI T1,1777 ;[171] KA PAGE SIZE MOVEM T1,$IDCPU(I) ;[171] SET INTO IDB MOVSI T1,-LNGETB ;[203] length of GETTAB table INI10: ;[203] loop here for each GETTAB table entry MOVE T2,TBGETB(T1) ;[203] load table index GETTAB T2, ;[203] ask monitor for info. SETZ T2, ;[203] no info. MOVEM T2,$IDATA+$IDPNM(T1) ;[203] set data into IDB AOBJN T1,INI10 ;[203] loop back till finished MOVEI T1,1 ;SET THE VERBOSITY TO MOVEM T1,$IDECD(I) ; STANDARD, AND THE MAXCOR HRLZM T1,$IDTOP(I) ; TO ALL OF CORE SETOM $IDLSC(I) ;SET LAST CHARACTER READ AS ENDLINE POPJ P, TBGETB: ;[203] table of GETTAB codes for setting into IDB XWD -1,.GTPRG ;[203] program name XWD -1,.GTPPN ;[205] program PPN LNGETB==.-TBGETB LIT ; IDATA ; THIS BLOCK IS ACCESSED BY THE BEGIN$ MACRO, AND MUST ; BE LOADED TO USE THE $HEAP, $RCOMC, $RFILE ; ROUTINES RELOC ENTRY $IDATA $IDATA:: BLOCK $LNIDB ;ENOUGH SPAE ENDIDB==.-1 ;LAST WORD IN IDB END /tty ex