Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50362/iolib.mac
There are no other files named iolib.mac in the archive.
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+[<SIXBIT \'COD'\>+[ASCIZ \'TXT'\]]
IFNB <TYP>,<
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$$ <Null device>,NDV,,SKIPA
WILDDV: ;HERE IF DIRECTORY CONTAINED WILD CHARACTERS
ERR$$ <Wild device>,WDV,WORD,MOVE
PJRST $XOPJ##
TWODEV: ;HERE IF TWO DEVICES IN THE SAME SPEC.
ERR$$ <Two devices>,2DV,WORD,SKIPA
TWONAM: ;HERE IF TWO NAMES IN THE SAME SPEC.
ERR$$ <Two names>,2NM,WORD,MOVE
PJRST $XOPJ##
TWOEXT: ;HERE IF TWO EXTENSIONS IN THE SAME SPEC.
ERR$$ <Two extensions>,2EX,WORD,SKIPA
TWOPTH: ;HERE IF TWO PATH SPECIFICATIONS IN THE SAME FILE SPEC.
ERR$$ <Two path specs.>,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$$ <Nul device>,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,<FT$SFD+3>(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$$ <Two many SFDs>,TMS,WORD,SKIPA
NULSFD: ;HERE IF SUBFILE DIRECTORY NAME IS EMPTY
ERR$$ <Nul SFD>,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,<FT$SFD+1>(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$$ <Project too big>,IPJ,OCTAL,SKIPA
ILPROG: ;HERE TO RETURN ERROR CODE FOR PROGRAMMER NUMBER TOO BIG
ERR$$ <Programmer too big>,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$$ <Switch tables built incorrectly>,STI,,SKIPA
DUPLSW:
ERR$$ <Ambiguous switch>,ASW,WORD,MOVE
PJRST $XOPJ##
NOMATC:
ERR$$ <Unknown switch>,USW,WORD,SKIPA
UNKVAL:
ERR$$ <Unknown keyword>,UKW,WORD,MOVE
PJRST $XOPJ##
VALILL:
ERR$$ <Value illegal>,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$ <No help available>
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$ <MAXCOR>,<$IDTOP(I)>,$SWKWD##,MXC
SL$ <VERBOSITY>,<POINT 18,$IDECD(I),35>,VERB,VERBSTANDARD
SP$ <BLOCKSIZE>,<POINT 18,$FDBUF(P3),35>,$SWDEC##,BSZ
SP$ <RUN>,<POINT 18,$IDRUN(I),35>,$SWFIL##
SP$ <RUNOFFSET>,<POINT 18,$IDRUN(I),17>,$SWOCT##,ROF
SL$ <DENSITY>,<POINTR ($FDMOD(P3),FM$DEN)>,DENS,DENSIN
SL$ <PARITY>,<POINTR ($FDMOD(P3),FM$PAR)>,PAR,PARODD
SS$ <PHYSICAL>,<POINTR ($FDMOD(P3),FM$PHY)>,1
SP$ <PROTECTION>,<POINTR ($FDMOD(P3),FM$PRO)>,$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,<TEXT,SWITCHES>
KEYWD$ DENS,<INSTALLATION,200,556,800>
KEYWD$ PAR,<ODD,EVEN>
KEYWD$ VERB,<LOW,STANDARD,HIGH>
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$$ <Not a month>,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
<ASCII \K\>!1000
<ASCII \M\>!1000000
<ASCII \G\>!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:
<ASCII \K\>+1000
<ASCII \M\>+1000000
<ASCII \G\>+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$$ <Illegal character>,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$$ <Number out of range>,NOR,DECL,SKIPA
$$ORNG::
ERR$$ <Number out of range>,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 <LF> 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:! ;<HYP><SP> 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:! ;<SP><X> SEEN - RETURN THE <SP>
HRLI T1," " ;
RCC45:! ;<-><SP><X> 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),<
<SIXBIT \'COD'\>+[ASCIZ \'TXT'\]>
TABIOE:
ENT UNK,<Unknown error>
ENT NFC,<No free channels>
ENT RSD,<Restricted device>
ENT QTA,<No room>
ENT IMP,<Improper mode>
ENT DER,<Device error>
ENT DTE,<Data error>
ENT BKT,<Block too large>
ENT EOF,<Endfile>
$LNIO0==:TABIOE-.
$TBIOE::
ENT FNF,<No file>
ENT IPP,<No directory>
ENT PRT,<Access denied>
ENT FBM,<File busy>
ENT AEF,<Already exists>
ENT ISU,<UUO error>
ENT TRN,<Device error>
ENT NSF,<Not binary>
ENT NEC,<Not enough core>
ENT DNA,<Device busy>
ENT NSD,<No device>
ENT ILU,<No KT10A>
ENT NRM,<No room>
ENT WLK,<Write-lock>
ENT NET,<O/S tables full>
ENT POA,<No room>
ENT BNF,<Block busy>
ENT CSD,<Already exists>
ENT DNE,<Not empty>
ENT SNF,<No directory>
ENT SLE,<Search list empty>
ENT LVL,<Too many SFDs>
ENT NCE,<Create denied>
ENT SNS,<No segment>
$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.
; <CR>
; <EOF>
; ^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 <CR><LF>
; 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,<RENAME (D)> ;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 (D)> ;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 (D)> ;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-<JAN 1>
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)<
<SIXBIT \MN\>+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