Trailing-Edge
-
PDP-10 Archives
-
bb-jr93e-bb
-
7,6/ap018/batctl.x18
There is 1 other file named batctl.x18 in the archive. Click here to see a list.
TITLE BATCTL - GALAXY-10 Batch controller control file logic
SUBTTL C.D.O'Toole, D.P.Mastrovito /CDO/DPM 27-Jul-87
;
;
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1974,1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1986,1987.
; ALL RIGHTS RESERVED.
;
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH BATMAC ;BATCON SYMBOLS
SEARCH GLXMAC ;GALAXY SYMBOLS
SEARCH QSRMAC ;QUASAR SYMBOLS
SEARCH ORNMAC ;ORION SYMBOLS
PROLOG (BATCTL) ;SET UP
%%.BAT==:%%.BAT ;FORCE VERSION INTO SYMBOL TABLE
TOPS10 <IF1,<PRINTX [Assembling GALAXY-10 BATCTL]>>
TOPS20 <IF1,<PRINTX [Assembling GALAXY-20 BATCTL]>>
.TEXT |,OPRPAR/SEGMENT:LOW| ;LOAD THE GALAXY PARSER
GLOB <JIBTXT>
SUBTTL Table of contents
; TABLE OF CONTENTS FOR BATCTL
;
;
; SECTION PAGE
; 1. Table of contents......................................... 2
; 2. Batch step header parse tables............................ 3
; 3. Batch step header command scanner......................... 4
; 4. Batch step header commands
; 4.1 $ACCOUNT.......................................... 5
; 4.2 Simple keywords................................... 6
; 4.3 $TIME............................................. 7
; 4.4 $ALLOCATE and $MOUNT.............................. 8
; 4.5 $ENDHDR........................................... 9
; 4.6 $STEP............................................. 10
; 5. C$SCAN - Command scanner.................................. 11
; 6. Label logic............................................... 12
; 7. Comment/Vertical motion/User/DDT mode..................... 15
; 8. RDNMOD - Random first character checking.................. 16
; 9. Monitor mode.............................................. 17
; 10. Batch step mode........................................... 18
; 11. C$OPEN - Open the control file............................ 19
; 12. Control file positioning routines......................... 21
; 13. C$DISP - Dispose of control file at EOJ................... 22
; 14. C$CLOS - Close control file............................... 23
; 15. C$READ - Read a line from the control file................ 24
; 16. C$STRT - Find the starting point in the control file...... 25
; 17. C$COPY - Re-copy a command line........................... 26
; 18. Miscellaneous scanner routines............................ 28
; 19. Batch command set up and dispatching...................... 29
; 20. Macros to generate Batch command tables................... 30
; 21. Batch command tables...................................... 31
; 22. Batch commands
; 22.1 ABORT and STATUS.................................. 32
; 22.2 BACKTO and GOTO................................... 33
; 22.3 CHKPNT and REQUEUE................................ 34
; 22.4 DUMP.............................................. 35
; 22.5 ERROR and OPERATOR................................ 37
; 22.6 IF................................................ 38
; 22.7 MESSAGE and PLEASE................................ 42
; 22.8 NOERROR, NOOPERATOR, REVIVE, and SILENCE.......... 43
; 23. MOUNT parser
; 23.1 ALLOCATE and MOUNT command syntax tables.......... 44
; 23.2 MOUNT and ALLOCATE option tables.................. 45
; 23.3 General routines.................................. 56
; 23.4 Data Storage...................................... 61
; 24. End....................................................... 62
SUBTTL Batch step header parse tables
JSP010: $INIT (JSP020)
JSP020: $KEYDSP (JSP030)
JSP030: $STAB
IFN FTMODIFY,< DSPTAB (ACC010,$ACCT,<ACCOUNT>)>
TOPS10 < DSPTAB (ALL010,$ALLOCATE,<ALLOCATE>)>
TOPS20 < DSPTAB (,$ALLOCATE,<ALLOCATE>)>
;IFN FTMODIFY,< DSPTAB (ASS010,$ASSIST,<ASSISTANCE>)>
;IFN FTMODIFY,< DSPTAB (BAT010,$BATLOG,<BATLOG>)>
DSPTAB (END010,$ENDHDR,<ENDHDR>)
TOPS10 < DSPTAB (MOU010,$MOUNT,<MOUNT>)>
TOPS20 < DSPTAB (,$MOUNT,<MOUNT>)>
IFN FTMODIFY,< DSPTAB (OUT010,$OUTPUT,<OUTPUT>)>
IFN FTMODIFY,< DSPTAB (RES010,$RESTART,<RESTART>)>
DSPTAB (STP010,$STEP,<STEP>)
IFN FTMODIFY,< DSPTAB (TIM010,$BTIME,<TIME>)>
IFN FTMODIFY,< DSPTAB (UNI010,$UNIQUE,<UNIQUE>)>
$ETAB
ACC010: $ACCOU (ACC020,,)
ACC020: $CRLF
END010: $CRLF
STP010: $FIELD (STP020,,)
STP020: $CRLF
ASS010: $KEY (ASS030,ASS020)
ASS020: $STAB
KEYTAB (.OPINN,<NO>)
KEYTAB (.OPINY,<YES>)
$ETAB
ASS030: $CRLF
BAT010: $KEY (BAT030,BAT020)
BAT020: $STAB
KEYTAB (%BAPND,<APPEND>)
KEYTAB (%BSPOL,<SPOOL>)
KEYTAB (%BSCDE,<SUPERSEDE>)
$ETAB
BAT030: $CRLF
OUT010: $KEY (OUT030,OUT020)
OUT020: $STAB
KEYTAB (%EQOLE,<ERROR>)
KEYTAB (%EQOLG,<LOG>)
KEYTAB (%EQONL,<NOLOG>)
$ETAB
OUT030: $CRLF
RES010: $KEY (RES030,RES020)
RES020: $STAB
KEYTAB (%EQRNO,<NO>)
KEYTAB (%EQRYE,<YES>)
$ETAB
RES030: $CRLF
TIM010: $TIME (TIM020)
TIM020: $CRLF
UNI010: $KEY (UNI030,UNI020)
UNI020: $STAB
KEYTAB (%EQUNO,<NO>)
KEYTAB (%EQUYE,<YES>)
$ETAB
UNI030: $CRLF
SUBTTL Batch step header command scanner
C$STEP::AOS .JSSTP(R) ;COUNT THE LINE
$IDENT (HEADER,<^T/.JSCTL(R)/^A>) ;YES - ECHO STEP HEADER LINE
ILDB S1,.JSCTB(R) ;GET THE FIRST CHARACTER
CAIE S1,";" ;OLD STYLE COMMENT?
CAIN S1,"!" ;NEW STYLE COMMENT?
$RETT ;YES TO EITHER - RETURN SUCESSFUL
MOVEI S1,JSP010 ;GET ADDRESS OF PARSE TABLES
MOVEM S1,.JSPAR+PAR.TB(R) ;STORE IT
MOVE T1,.JSCMD(R) ;GET ADDRESS OF COMMAND BLOCK
MOVEM T1,.JSPAR+PAR.CM(R) ;STORE IT
SETZM (T1) ;CLEAR THE FIRST WORD FO THE BLOCK
HRLZI S1,(T1) ;BUILD BLT POINTER
HRRI S1,1(T1) ;SO WE CAN CLEAR THE ENTIRE BLOCK
BLT S1,PAGSIZ-1(T1) ;ZAP THE COMMAND BLOCK
MOVX S1,COM.SZ-1 ;GET INITIAL SIZE OF MESSAGE
HRLZM S1,.MSTYP(T1) ;STORE IT
MOVE S1,.JSCTB(R) ;GET THE BUFFER POINTER
MOVEM S1,.JSPAR+PAR.SR(R) ;TELL THE PARSER
SETZB S1,S2 ;NO TIMER INTERRUPTS
PUSHJ P,P$INIT## ;INIT THE PARSER
MOVX S1,PAR.SZ ;GET LENGTH OF PARSE BLOCK
MOVEI S2,.JSPAR(R) ;GET ADDRESS OF PARSE BLOCK
PUSHJ P,PARSER## ;PARSE THE COMMAND
JUMPF STEP.E ;ANY ERRORS?
MOVE T1,.JSCMD(R) ;GET COMMAND BLOCK ADDRESS
MOVEI S1,COM.SZ(T1) ;POINT OT THE FIRST BLOCK
PUSHJ P,P$SETU## ;SETUP TO EAT THE PARSE BLOCKS
PUSHJ P,P$KEYW## ;GET THE PARAMETER KEYWORD
JUMPF STEP.E ;ANY ERRORS?
PUSHJ P,(S1) ;DISPATCH
$RET ;PROPAGATE TRUE/FALSE RETURN BACK
STEP.E: TXO R,RL.JIE ;SET JOB IN ERROR
$IDENT (BATSSE,<? Step header syntax error - ^T/@PRT.EM(S2)/>)
$RETF ;RETURN UNSUCESSFUL
SUBTTL Batch step header commands -- $ACCOUNT
$ACCT: SKIPN .JLSTP(R) ;WAS $STEP SEEN?
$RETF ;NO
SKIPN .JBSPS(R) ;DOING ONLY A STEP HEADER SCAN?
$RETT ;NO - THEN NOTHING TO DO
PUSHJ P,B$MODP## ;SET UP MODIFY PAGE
MOVEI P1,.MQACT(S1) ;POINT TO START OF ACCOUNT BLOCK
HRLZI S1,(P1) ;GET SOURCE ADDRESS
HRRI S1,1(P1) ;+1
SETZM (P1) ;CLEAR FIRST WORD
BLT S1,7(P1) ;CLEAR ENTIRE ACCOUNT STRING BLOCK
PUSHJ P,P$ACCT## ;GET AN ACCOUNT STRING
$RETIF ;RETURN IF WE COULDN'T
MOVEI S1,ARG.DA(S1) ;POINT TO THE ACCOUNT STRING
HRLI S1,(P1) ;GET DESTINATION ADDRESS ON LH
MOVSS S1 ;MAKE A BLT POINTER
ADDI S2,-ARG.DA(P1) ;COMPUTE END ADDRESS
BLT S1,-1(S2) ;COPY INTO MODIFY BLOCK
MOVEI P2,.JQACT(R) ;GET ADDRESS OF ACCOUNT STRING IN THE EQ
MOVEI S1,10 ;SET UP A COUNTER
ACCT.1: MOVE S2,(P1) ;GET A WORD
CAME S2,(P2) ;THE SAME?
JRST ACCT.2 ;NO - CHANGE THE COUNT
ADDI P1,1 ;+1
ADDI P2,1 ;+1
SOJG S1,ACCT.1 ;LOOP FOR ALL WORDS
$RETT ;Return
ACCT.2: AOS .JMODC(R) ;INDICATE NEED FOR MODIFY
$RETT ;RETURN
SUBTTL Batch step header commands -- Simple keywords
$ASSIST:MOVEI P1,.MQAST
MOVE P2,[GETLIM S2,.JQLIM(R),OINT]
PJRST STPKEY
$BATLOG:MOVEI P1,.MQBLG
MOVE P2,[GETLIM S2,.JQLIM(R),BLOG]
PJRST STPKEY
$OUTPUT:MOVEI P1,.MQOUT
MOVE P2,[GETLIM S2,.JQLIM(R),OUTP]
PJRST STPKEY
$RESTART:MOVEI P1,.MQRST
MOVE P2,[GETLIM S2,.JQLIM(R),REST]
PJRST STPKEY
$UNIQUE:MOVEI P1,.MQUNI
MOVE P2,[GETLIM S2,.JQLIM(R),UNIQ]
PJRST STPKEY
;CALL:
; P1/ modify page offset
; P2/ instruction to XCT to load old value into S2
; PUSHJ P,STPKEY
STPKEY: SKIPN .JLSTP(R) ;WAS $STEP SEEN?
$RETF ;NO
SKIPN .JBSPS(R) ;DOING ONLY A STEP HEADER SCAN?
$RETT ;NO - THEN NOTHING TO DO
PUSHJ P,B$MODP## ;SET UP MODIFY PAGE
ADDI P1,(S1) ;ADD IN BASE PAGE
PUSHJ P,P$KEYW## ;GET A KEYWORD
$RETIF ;RETURN IF WE COULDN'T
XCT P2 ;LOAD THE VALUE
CAMN S2,S1 ;SEE IF DIFERENT
$RETT ;NO CHANGE
MOVEM S1,(P1) ;YES--STORE NEW VALUE
AOS .JMODC(R) ;INDICATE NEED FOR MODIFY
$RETT ;RETURN
SUBTTL Batch step header commands -- $TIME
$BTIME: SKIPN .JLSTP(R) ;WAS $STEP SEEN?
$RETF ;NO
SKIPN .JBSPS(R) ;DOING ONLY A STEP HEADER SCAN?
$RETT ;NO - THEN NOTHING TO DO
PUSHJ P,B$MODP## ;SET UP MODIFY PAGE
MOVEI P1,.MQTIM(S1) ;SAVE POINTER TO TIME
PUSHJ P,P$TIME## ;GET A TIME
$RETIF ;RETURN IF WE COULDN'T
TLZ S1,-1 ;REMOVE DATE PART
MUL S1,[^D24*^D60*^D60*^D1000];CONVERT
ASHC S1,^D17 ;POSITION
IDIVI S1,^D1000 ;MAKE SECONDS
CAIL S2,^D500 ;NEED TO ROUND?
ADDI S1,1 ;YES!
GETLIM S2,.JQLIM(R),TIME ;GET TIME
CAMN S2,S1 ;SEE IF DIFERENT
$RETT ;NO CHANGE
MOVEM S1,(P1) ;YES--STORE NEW VALUE
AOS .JMODC(R) ;INDICATE NEED FOR MODIFY
$RETT ;RETURN
SUBTTL Batch step header commands -- $ALLOCATE and $MOUNT
$ALLOCATE:
TOPS10 <SKIPA P1,[.ALLOC]> ;ALLOCATE ROUTINE ADDRESS
$MOUNT:
TOPS10 <MOVEI P1,.MOUNT> ;MOUNT ROUTINE ADDRESS
SKIPE G$MDA## ;MDA TURNED ON?
JRST MOUN.1 ;YES
$IDENT (BATMDF,<[Mountable device facilities not supported - line ignored]>)
$RETT ;RETURN
MOUN.1: SKIPN .JLSTP(R) ;WAS $STEP SEEN?
$RETF ;NO
SKIPN .JBSPS(R) ;DOING ONLY A STEP HEADER SCAN?
JRST MOUN.3 ;NO - SEND MDA REQUEST TO THE PTY
PUSHJ P,B$MDAP## ;GET MDA PAGE IF WE NEED ONE
$CALL M%GPAG ;GET A TEMPORARY PAGE FOR MNTPAR TO USE
MOVEM S1,.JMDAT(R) ;STORE PAGE ADDRESS FOR LATER
PUSHJ P,(P1) ;DO SOMETHING WITH THE ARGUMENTS
SKIPT ;ANY ERRORS?
JRST [MOVE S1,.JMDAT(R) ;GET TEMPORARY PAGE ADDRESS
$CALL M%RPAG ;REMOVE THE PAGE
$RETF] ;RETURN UNSUCESSFUL
MOVE T1,.JMDAP(R) ;GET MDA PAGE BASE ADDRESS
MOVE T2,.JMDAF(R) ;GET MDA PAGE FIRST FREE POINTER
MOVE T3,.JMDAT(R) ;GET MNTPAR TEMPORARY PAGE ADDRESS
LOAD S1,.MSTYP(T3),MS.CNT ;GET LENGTH OF THIS MESSAGE
SUBX S1,.MMHSZ ;STRIP OFF THE MOUNT MESSAGE HEADER
LOAD S2,.MSTYP(T1),MS.CNT ;GET LENGTH OF THIS MESSAGE SO FAR
ADDI S2,(S1) ;GET NEW TOTAL LENGTH
CAXG S2,PAGSIZ ;WILL IT FIT IN A PAGE?
JRST MOUN.2 ;YES
$IDENT (BATTMM,<? Too may ALLOCATE/MOUNT requests to process>)
$RETF ;RETURN UNSUCESSFUL
MOUN.2: STORE S2,.MSTYP(T1),MS.CNT ;STORE NEW TOTAL LENGTH
HRLI S2,.MMHSZ(T3) ;MOVE FROM FIRST ME IN MNTPAR PAGE
HRRI S2,(T2) ;TO FIRST FREE IN MDA PAGE
ADDI T2,(S1) ;COMPUTE NEW FIRST FREE ADDRESS
MOVEM T2,.JMDAF(R) ;REMEMBER NEW FIRST FREE LOCATION
BLT S2,-1(T2) ;MOVE DATA TO MDA PAGE
LOAD S2,.MMARC(T3) ;GET THE NUMBER OF ME'S IN THIS LINE
ADDM S2,.MMARC(T1) ;UPDATE MDA PAGE
MOVE S1,T3 ;GET ADDRESS OF TEMPORARY PAGE
$CALL M%RPAG ;REMOVE PAGE
$RETT ;RETURN SUCESSFUL
MOUN.3: PUSHJ P,B$RTYO## ;ECHO THE RESPONSE BUFFER
PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
ILDB S1,.JSCTB(R) ;EAT THE STEP PROMPT CHARACTER
PUSHJ P,B$XFER## ;TRANSFER THE LINE TO THE PTY
PUSHJ P,IOWAIT## ;GET RESPONSE
$RETT ;RETURN SUCESSFUL
; Dummy routines to keep MNTPAR happy
;
CHKMNT::
HELPER::
ERROR:: $RETF
SUBTTL Batch step header commands -- $ENDHDR
$ENDHDR:
SKIPN .JLSTP(R) ;WAS $STEP SEEN?
$RETF ;NO
POP P,(P) ;TRIM STACK
$IDENT (HEADER,<[^D/.JSSTP(R)/ lines processed in step ^W/.JLSTP(R)/ header]>)
TXO R,RL.DRT ;DELAY THE RESPONSE BUFFER OUTPUT
PUSHJ P,B$EOJ## ;PROCESS END OF JOB (STEP) HEADER
$RETT ;RETURN
SUBTTL Batch step header commands -- $STEP
$STEP: SKIPE .JLSTP(R) ;WAS $STEP ALREADY SEEN?
JRST STPE.0 ;YES - CAN'T HAVE THAT
PUSHJ P,P$SIXF## ;RETURN A SIXBIT VALUE
JUMPF STPE.1 ;ERROR?
JUMPE S1,STPE.1 ;MAKE SURE WE HAVE ONE
MOVEM S1,.JLSTP(R) ;STORE STEP LABEL
LSH S1,-^D30 ;RIGHT JUSTIFY THE FIRST CHARACTER
CAIN S1,'%' ;IS IT A RESERVED LABEL?
JRST STPE.2 ;YES - CAN'T HAVE THAT
PUSHJ P,P$CFM## ;GET CONFIRMATION
JUMPF STPE.3 ;ERROR?
SKIPN .JBSPS(R) ;SKIP IF ONLY STEP HEADER SCAN
$WTOJ (<Starting step ^W/.JLSTP(R)/>,<^R/.JQJBB(R)/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
$RETT ;RETURN SUCESSFUL
STPE.0: $IDENT (BATMSI,<? Multiple $STEP lines illegal in a single step>)
$RETF ;RETURN UNSUCESSFUL
STPE.1: $IDENT (BATMSL,<? Missing $STEP label>)
SETOM .JLSTP(R) ;FAKE OUT ERROR RECOVERY CODE
$RETF ;RETURN UNSUCESSFUL
STPE.2: $IDENT (BATISL,<? Illegal $STEP label>)
SETOM .JLSTP(R) ;FAKE OUT ERROR RECOVERY CODE
$RETF ;RETURN UNSUCESSFUL
STPE.3: $IDENT (BATSSE,<? Step header syntax error>)
$RETF ;RETURN UNSUCESSFUL
SUBTTL C$SCAN - Command scanner
C$SCAN::TXO F,FL.LSL ;FORCE LABEL TYPE OUT IF WE FIND ONE
TXZ F,FL.SUP!FL.UKJ ;CLEAR EOL SUPRESSION AND USER KJOB
ILDB S1,.JSCTB(R) ;GET FIRST CHARACTER
JUMPE S1,.POPJ ;RETURN ON NULL LINE
SETZM .JPEOL(R) ;CLEAR EOL SENT
MOVEI S2,CHRTAB ;POINT TO CHARACTER DISPATCH TABLE
SCAN.1: SKIPN (S2) ;END OF TABLE?
JRST SCAN.2 ;YES
HLRZ T1,(S2) ;GET A CHARACTER
CAME S1,T1 ;A MATCH?
AOJA S2,SCAN.1 ;NO - TRY ANOTHER
MOVE T1,(S2) ;GET DISPATCH ADDRESS
HRRZM T1,.JSCDP(R) ;STORE IT
JRST SCAN.3 ;SKIP LABEL CHECKS
SCAN.2: MOVEI T1,RNDMOD ;ASSUME RANDOM MODE IF NO LABEL
MOVEM T1,.JSCDP(R) ;STORE ADDRESS
PUSHJ P,LABEL ;TRY TO GET A LABEL
JRST SCAN.3 ;CAN'T
POPJ P, ;GOT IT - RETURN
SCAN.3: TXZ F,FL.LSL ;CLEAR LABEL TYPE OUT FLAG
PUSHJ P,@.JSCDP(R) ;DISPATCH TO PROCESSOR
JFCL
MOVE S1,.JSCFL(R) ;GET COMMAND FLAGS
SETZM .JSCFL(R) ;AND CLEAR FOR NEXT POSSIBLE PASS
TXNE S1,BC.CIC ;PARSE COMMAND IN CORE?
TXO F,FL.RCL ;YES - REMEMBER TO RE-EAT COMMAND LINE
POPJ P, ;RETURN
; Character table
; Format: XWD character,processor address
;
CHRTAB: XWD .CHLFD,VRTMOD ;LINE-FEED
XWD .CHVTB,VRTMOD ;VERTICAL-TAB
XWD .CHFFD,VRTMOD ;FORM-FEED
XWD .CHCRT,CRTMOD ;CARRIAGE-RETURN
XWD ";",COMENT ;OLD STYLE COMMENT
XWD "!",COMENT ;NEW STYLE COMMENT
XWD MONCHR,MONMOD ;BATCH OR MONITOR MODE COMMAND
XWD STPCHR,STPMOD ;BATCH STEP MODE
XWD "*",USRMOD ;USER MODE COMMAND
XWD "=",DDTMOD ;DDT MODE COMMAND
XWD "%",LABUSR ;RESERVED LABEL
XWD 0,0 ;END TABLE WITH A ZERO WORD
SUBTTL Label logic
; Here from command scanner top level to parse a label
;
LABEL: PUSHJ P,B$SETB## ;RESET BYTE POINTER
PUSHJ P,LABINP ;GET A LABEL
PJRST B$SETB## ;CAN'T - RESET BYTE POINTER AND RETURN
TXO R,RL.DRT ;DELAY RESPONSE BUFFER OUTPUT
PUSHJ P,FLUSH ;FLUSH LEADING TABS AND SPACES
JFCL ;ALWAYS SKIPS
PUSHJ P,EOLTST ;CHECK FOR EOL
JRST LABE.1 ;YES - SPECIAL CASE
PUSHJ P,BACKUP ;BACKUP THE BYTE POINTER 1 CHARACTER
PJRST C$COPY ;RE-COPY COMMAND AND RETURN SUCESSFUL
LABE.1: PUSHJ P,B$SETB ;RESET THE BYTE POINTER
SETZM .JSCTL(R) ;ZAP THE LINE
JRST .POPJ1 ;RETURN SUCESSFUL
;[4707] Input a label into .JLLBL(R) (:: required after label)
;
LABINP: PUSHJ P,SIXINP ;READ A SIXBIT WORD
JUMPE S1,.POPJ ;HAVE A LABEL?
MOVE T1,S1 ;COPY LABEL NAME
PUSHJ P,TYI ;READ NEXT CHARACTER
CAIN S1,":" ;A COLON?
CAIE S2,":" ;NEED TWO TO BE A LABEL
POPJ P, ;NOT A LABEL
CAME T1,['%FIN '] ;IS THIS %FIN?
JRST LABI.1 ;NO
HRRZ TF,.JSCDP(R) ;GET COMMAND DISPATCH ADDRESS
CAIE TF,.BACKTO ;ARE WE PROCESSING A .BACKTO COMMAND?
TXO F,FL.LSL ;NO - TURN ON LISTING OF LINES
LABI.1: TXNN F,FL.LSL ;LISTING SKIPPED LINES?
CAMN T1,.JLABL(R) ;OR IS THIS THE LABEL WE WANT?
$IDENT (LABEL,<^W/T1/::^A>) ;YES TO EITHER - LOG THE LABEL
MOVEM T1,.JLLBL(R) ;STORE LAST LABEL ENCOUNTERED
JRST .POPJ1 ;RETURN SUCESSFUL
; Input a label into .JLABL(R)
;
LABARG: PUSHJ P,SIXINP ;READ A SIXBIT WORD
MOVEM S1,.JLABL(R) ;STORE IT
JUMPE S1,.POPJ ;RETURN IF NO LABEL INPUT
; Check for legal label
;
LABCHK: LSH S1,-^D30 ;GET THE FIRST CHARACTER
CAIG S1,'Z' ;MUST BEGIN WITH A
CAIGE S1,'A' ;LETTER FROM A THROUGH Z
JRST LABERR ;NO GOOD
POPJ P, ;RETURN
; Search for %CERR or %ERR after user error occured
;
LABUSR::TXO F,FL.LSL ;LIST SKIPPED LINES
TXZ F,FL.FIN ;WE CAN'T SKIP OVER A %FIN
TXNN R,RL.JIE ;JOB IN ERROR?
JRST LABFIN ;YES - SEARCH FOR %FIN
TOPS10 < ;TOPS-10 ONLY
HRL S1,J ;GET JOB NUMBER
HRRI S1,.GTLIM ;BATCH TIME LIMIT TABLE
GETTAB S1, ;GET LIMIT WORD
SKIPA ;CAN'T
TXNE S1,JB.LSY ;PROGRAM COME FROM PHYSICAL SYS:?
SKIPA S1,['%CERR '] ;YES - USER %CERR LABEL
> ;END OF TOPS10 CONDITIONAL
MOVX S1,'%ERR ' ;NO - USE %ERR LABEL
MOVEM S1,.JLABL(R) ;STORE IT
PUSHJ P,LABSRC ;SEARCH FOR THE APPROPRIATE LABEL
TXZ R,RL.JIE ;CLEAR JOB IN ERROR CONDITION
POPJ P, ;RETURN
; Search for %FIN
;
LABFIN::SKIPA S1,['%FIN '] ;GET LABEL TO SEARCH FOR
; Search for %TERR
;
LABTER::MOVX S1,'%TERR ' ;GET LABEL TO SEARCH FOR
MOVEM S1,.JLABL(R) ;STORE IT AND FALL INTO LABSRC
TXO F,FL.LSL ;LIST SKIPPED LINES
TXZ F,FL.FIN ;WE CAN'T SKIP OVER A %FIN
;FALL INTO LABSRC
; Search for the label stored in .JLABL(R)
;
LABSRC::SETZM G$FAIR## ;INITIALIZE FAIRNESS COUNT
PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
JRST LABS.2 ;SKIP INITIAL CALL TO C$READ
LABS.1: PUSHJ P,C$READ ;READ A LINE FROM THE CONTROL FILE
JUMPF LABEOF ;END OF FILE?
LABS.2: PUSHJ P,LABEL ;TRY TO INPUT A LABEL
JRST LABS.4 ;CAN'T
MOVE S1,.JLLBL(R) ;GET LABEL JUST FOUND
CAXN S1,<'%FIN '> ;SPECIAL %FIN LABEL?
JRST LABS.5 ;YES
CAMN S1,.JLABL(R) ;FOUND WHAT WE WANT?
POPJ P, ;YES - RETURN
LABS.4: TXNE F,FL.LSL ;LISTING SKIPPED LINES?
$IDENT (IGNORE,<^T/.JSCTL(R)/^A>) ;YES - DO IT
AOS S1,G$FAIR## ;COUNT THE LINE
CAXGE S1,CTLFCT ;EXCEEDED FAIRNESS COUNT?
JRST LABS.1 ;TRY ANOTHER LINE
AOS G$FFLG## ;REMEMBER FAIRNESS COUNT EXPIRED
PUSHJ P,QTS## ;ON TO THE NEXT STREAM
SETZM G$FAIR## ;RESET COUNTER
JRST LABS.1 ;TRY ANOTHER LINE
LABS.5: TXNE F,FL.FIN ;ALLOWED TO SKIP OVER %FIN?
JRST LABS.1 ;YES - KEEP SEARCHING
CAME S1,.JLABL(R) ;FOUND %FIN WHILE SEARCHING FOR %FIN?
$IDENT (BATFFS,<[Found %FIN while searching for ^W/.JLABL(R)/ - proceeding from %FIN]^A>)
PUSHJ P,B$DUMP## ;SEE IS A CLOSE/DUMP IS REQUIRED
POPJ P, ;NOPE
LABEOF: MOVE S1,.JLABL(R) ;GET LABEL WE'RE SEARCHING FOR
CAMN S1,['%TERR '] ;TIME LIMIT EXCEEDED?
$WTOJ (<Batch error>,<^I/JIBTXT/^I/LABTX1/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
$IDENT (BATECF,<? ^I/LABTX2/>) ;LOG EOF ERROR
TXO F,FL.TXT ;MESSAGE TEXT AVAILABLE
MOVE S1,.JLABL(R) ;GET LABEL AGAIN
CAME S1,['%TERR '] ;CHECK AGAIN
SKIPA S1,[[ASCIZ ||]] ;NULL TEXT
MOVEI S1,[ASCIZ |Time limit exceeded; |]
$TEXT (<-1,,.JWTOP(R)>,<^T/(S1)/Label ^W/.JLABL(R)/ not found^0>)
PJRST CLOSJB## ;DISMISS THE JOB
LABTX1: ITEXT (<Time limit exceeded; end of control file while searching for label %TERR>)
LABTX2: ITEXT (<End of control file while searching for label ^W/.JLABL(R)/>)
SUBTTL Comment/Vertical motion/User/DDT mode
; Put comments into the log file
;
COMENT: TXO R,RL.DRT ;DELAY RESPONSE BUFFER OUTPUT
$IDENT (COMENT,<^T/.JSCTL(R)/^A>)
JRST .POPJ1 ;RETURN SUCESSFUL
; Here on vertical motion characters
;
VRTMOD: PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
TXNN J,JL.UML ;JOB AT USER LEVEL?
JRST USRMOD ;NOPE
TXZ F,FL.SUP ;CLEAR EOL SUPRESSION
ILDB S1,.JSCTB(R) ;GET THE VERTICAL MOTION CHARACTER
PUSHJ P,L$PLOG## ;LOG IT
SETZM .JLTIM(R) ;CLEAR TIME STAMP NEEDED FLAG
TXO R,RL.DRT ;DELAY RESPONSE BUFFER OUTPUT
JRST .POPJ1 ;RETURN SUCESSFUL
; Here on carriage returns
;
CRTMOD: PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
; Send a line of user data
;
USRMOD: TXZA F,FL.SUP ;CLEAR EOL SUPRESSION
; DDT mode (suppress EOL characters)
;
DDTMOD: TXO F,FL.SUP ;SET EOL SUPPRESSION
TXNN R,RL.JIE ;IS JOB IN ERROR?
TXNE J,JL.UML ;JOB AT MONITOR LEVEL?
PJRST IGNORE ;YES - IGNORE THE LINE
TXZE R,RL.DRT ;WAS RESPONSE BUFFER OUTPUT DELAYED?
PUSHJ P,B$RTYO ;YES - OUTPUT IT NOW
PUSHJ P,B$XFER## ;SEND DATA TO THE PTY
TXZ F,FL.SUP ;MAKE EOL SUPRESSION IS OFF
JRST .POPJ1 ;RETURN SUCESSFUL
; Here when a job is at monitor level and a user level line is given
;
IGNORE: TXO R,RL.DRT ;DELAY RESPONSE BUFFER OUTPUT
$IDENT (IGNORE,<^T/.JSCTL(R)/^A>)
JRST .POPJ1 ;RETURN SUCESSFUL
SUBTTL RDNMOD - Random first character checking
RNDMOD: PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
LDB S1,[POINT 7,.JSCTL(R),6] ;GET THE FIRST CHARACTER
CAIG S1,"Z" ;CHECK FOR ALPHA
CAIGE S1,"A"
SKIPA ;NO MATCH
JRST RNDM.1 ;YES
CAIG S1,"Z"+40 ;CHECK FOR LOWER CASE ALPHA
CAIGE S1,"A"+40
JRST USRMOD ;NO MATCH - TREAT AS USER MODE
RNDM.1: TXNN J,JL.UML ;USER MODE?
JRST RNDM.2 ;YES - THEN SEND LINE TO JOB
PUSHJ P,BATSET ;TRY TO SET UP A BATCH COMMAND
JUMPT BATPRC ;GOT ONE - GO PROCESS IT
RNDM.2: PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
TXNE R,RL.JIE ;JOB IN ERROR?
JRST RNDM.3 ;YES - MAKE SPECIAL CHECKS
TXZ J,JL.UML ;FAKE OUT USRMOD BY CLEAING FLAG
JRST USRMOD ;TREAT LINE AS USER DATA
RNDM.3: TXNE J,JL.UML ;AT MONITOR LEVEL?
JRST LABUSR ;YES - SEARCH FOR ERROR PACKETS
JRST IGNORE ;NO - IGNORE THE LINE
SUBTTL Monitor mode
; Here on a Batch or monitor mode command
;
MONMOD: PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
ILDB S1,.JSCTB(R) ;EAT THE FIRST CHARACTER
PUSHJ P,FLUSH ;GET THE NEXT CHARACTER
JFCL ;ALWAYS SKIPS
IFE <MONCHR-".">,< ;IF MONITOR PROMPT IS A PERIOD
CAIG S1,"9" ;CHECK FOR A DIGIT
CAIGE S1,"0" ;A FLOATING POINT NUMBER IS USER DATA
SKIPA ;NO MATCH
JRST MONM.2 ;SEND LINE IN USER MODE
> ;END OF IFE <MONCHR-"."> CONDITIONAL
CAIG S1,"Z" ;CHECK FOR UPPER CASE ALPHA
CAIGE S1,"A"
SKIPA ;NO MATCH
JRST MONM.1 ;COULD BE A BATCH OR MONITOR COMMAND
CAIGE S1,"Z"+40 ;CHECK FOR LOWER CASE ALPHA
CAIGE S1,"A"+40
JRST MONCMD ;NO MATCH
MONM.1: PUSHJ P,BACKUP ;BACKUP THE BYTE POINTER ONE CHARACTER
PUSHJ P,BATSET ;SET UP BATCH COMMAND IF POSSIBLE
JUMPT BATPRC ;PROCESS COMMAND IF NO ERRORS
TXNE R,RL.JIE ;JOB IN ERROR?
JRST LABUSR ;YES - LOOK FOR ERROR PACKETS
JRST MONCMD ;SEND THE LINE TO THE MONITOR
MONM.2: TXNE R,RL.JIE ;IS THE JOB IN ERROR?
JRST LABUSR ;YES - SEARCH FOR ERROR PACKETS
PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
JRST USRMOD ;SEND THE LINE AT USER MODE
MONCMD: TXNN J,JL.UDI ;CAN JOB DO REAL INPUT?
POPJ P, ;NO - DON'T FORCE IT TO MONITOR MODE
PUSHJ P,B$SETB## ;YES - RESET THE BYTE POINTER
TXNE J,JL.UDI ;CAN JOB DO REAL INPUT?
JRST MONM.3 ;YES - GO DO IT
TXO F,FL.RCL ;NO - RE-EAT THE COMMAND LINE
POPJ P, ;DON'T FORCE TO MONITOR MODE AFTER ALL
MONM.3: LDB S1,[POINT 7,.JSCTL(R),6] ;GET THE FIRST CHARACTER
CAXN S1,MONCHR ;A NORMAL LINE?
ILDB S1,.JSCTB(R) ;YES - EAT THE PROMPT CHARACTER
TXZE R,RL.DRT ;WAS RESPONSE BUFFER OUTPUT DELAYED?
PUSHJ P,B$RTYO ;YES - OUTPUT IT NOW
PUSHJ P,P$STOP## ;PUT THE JOB IN MONITOR MODE
SKIPE .JLTIM(R) ;DO WE NEED A TIME STAMP?
TXNE F,FL.SIL ;YES - SUBJOB SILENCED?
SKIPA ;DON'T DO THE TIME STAMP
PUSHJ P,L$LSTP## ;INCLUDE THE TIME STAMP
PJRST B$XFER## ;TRANSFER THE LINE TO THE PTY
SUBTTL Batch step mode
STPMOD: AOSN .JSSPP(R) ;IS STEP PROCESSING PENDING?
JRST STPM.1 ;YES
$IDENT (HEADER,<^T/.JSCTL(R)/>) ;FAKE A LINE IN THE CONTROL FILE
$IDENT (BATMOS,<? More than one job step encountered - job canceled>)
JRST CLOSJB## ;DISMISS THE JOB
STPM.1: PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
TXO R,RL.DRT ;DELAY THE RESPONSE BUFFER OUTPUT
PUSHJ P,STPPRC## ;CALL THE JOB STEP PROCESSOR
PUSHJ P,B$RTYO## ;OUTPUT THE RESPONSE BUFFER
$RETT ;RETURN SUCESSFUL
SUBTTL C$OPEN - Open the control file
C$OPEN::TXNE F,FL.KST ;KSYS STREAM?
POPJ P, ;RETURN
MOVEI S1,.JQCFD(R) ;GET FD FOR CTL
MOVEM S1,.JCFOB+FOB.FD(R) ;STORAGE AREA
MOVX S1,FB.LSN ;NO LINE SEQ NUMBERS
ADDI S1,7 ;PLACE BYTE SIZE IN S1
MOVEM S1,.JCFOB+FOB.CW(R) ;SAVE CONTROL WORD
MOVX S1,FP.SPL ;GET THE SPOOLED BIT
TDNE S1,.JQCFP+.FPINF(R) ;/DISP:REN?
JRST OPEN.1 ;YES
TOPS10 <
MOVE S1,.JQPPN(R) ;GET PPN FOR USER
MOVEI S2,0 ;MAKE ZERO FOR CONSISTENCY
>;END TOPS10
TOPS20 <
HRROI S1,.JQNAM(R) ;USER NAME FROM CREATE
HRROI S2,.JQCON(R) ;CONNECTED DIRECTORY
>;END TOPS20
MOVEM S1,.JCFOB+FOB.US(R) ;SAVE USER IN BEHALF
MOVEM S2,.JCFOB+FOB.CD(R) ;SAVE IN FOB
MOVEI S1,FOB.SZ ;SIZE OF THE BLOCK
MOVX T1,EQ.PRV ;GET PRIVILEGE FLAG
TDNE T1,.JQJBB+JIB.SQ(R) ;WAS IT SET
OPEN.1: MOVEI S1,FOB.MZ ;NO IN BEHALF NEEDED
MOVEI S2,.JCFOB(R) ;ADDRESS OF THE BLOCK
$CALL F%IOPN ;OPEN THE FILE
JUMPF FNDC.E ;ERROR EXIT
MOVEM S1,.JCIFN(R) ;Save IFN
POPJ P, ;Return
; Fix up CTL filespec (remove generation number)
;
C$FILE::
TOPS10 <POPJ P,> ;NOT NEEDED FOR TOPS-10
TOPS20 < ;TOPS-20 ONLY
MOVX S1,GJ%SHT ;SHORT FORM
HRROI S2,.JQCFD+.FDSTG(R) ;POINT TO FILESPEC
GTJFN ;GET A JFN
POPJ P, ;CAN'T
MOVE S2,S1 ;COPY THE JFN
HRROI S1,.JQCFD+.FDSTG(R) ;POINT TO THE FILESPEC
MOVE T1,[1B2+1B5+1B8+1B11+JS%PAF] ;GET SOME FLAGS
JFNS ;EXTRACT ALL BUT THE GENERATION NUMBER
ERJMP .+1 ;CAN'T
MOVE S1,S2 ;GET THE JFN
RLJFN ;RELEASE IT
JFCL ;IGNORE ERRORS
POPJ P, ;RETURN
> ;END OF TOPS-20 CONDITIONAL
; Here on CTL file open errors
;
FNDC.E: $IDENT (BATCFE,<Control file error for ^F/.JQCFD(R)/ - ^E/[-1]/>)
$IDENT (BATBJC,<[Batch job has been canceled]>)
SETZM .JLTIM(R) ;NO TIME STAMP
JRST B$ABOR## ;ABORT THE JOB
SUBTTL Control file positioning routines
; Save the current position in the control file
;
C$SPOS::SKIPN S1,.JCIFN(R) ;IS CTL FILE OPEN?
JRST SPOS.1 ;NO - DO IT NOW
$CALL F%CHKP ;TAKE CHECKPOINT
JUMPF POSERR ;CAN'T
MOVEM S1,.JCPOS(R) ;SAVE RELATIVE POSITION
POPJ P, ;RETURN TO PROCESSING
SPOS.1: PUSHJ P,C$OPEN ;OPEN THE CTL FILE
SETZM .JCPOS(R) ;POSITION TO BEGINNING
POPJ P, ;RETURN TO MAINLINE
; Reposition to saved location in the CTL file
;
C$RPOS::SKIPN S1,.JCIFN(R) ;GET IFN (UNLESS NOT OPENED)
PJRST SPOS.1 ;GO OPEN FILE AND RETURN
MOVE S2,.JCPOS(R) ;GET RELATIVE POSITION
$CALL F%POS ;POSITION FILE TO PROPER PLACE
JUMPF POSERR ;CAN'T
POPJ P, ;RETURN
; Rewind the control file
;
C$ZPOS::MOVE S1,.JCIFN(R) ;GET IFN
MOVEI S2,.-. ;BYTE 0
$CALL F%POS ;REWIND THE FILE
JUMPF POSERR ;CAN'T
POPJ P, ;RETURN
; Here on positioning errors
;
POSERR: $WTO (<Batch error>,<^R/.JQJBB(R)/^I/POSTXT/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
$RETF ;RETURN FAILURE
POSTXT: ITEXT (<
Control file positioning error ^E/[-1]/ for file ^F/.JQCFD(R)/; job canceled>)
SUBTTL C$DISP - Dispose of control file at EOJ
C$DISP::TXNE F,FL.PST!FL.KST ;PRESCAN OR KSYS STREAM?
POPJ P, ;YES
MOVX S2,FP.DEL!FP.REN ;GET /DISP:DEL AND /DISP:REN
SKIPE S1,.JCIFN(R) ;IS THE FILE OPENED?
TDNN S2,.JQCFP+.FPINF(R) ;WANT TO DELETE FILE?
POPJ P, ;NO - RETURN
$CALL F%DREL ;RELEASE AND DELETE FILE
SETZM .JCIFN(R) ;MARK THE IFN CLOSED
POPJ P, ;RETURN
SUBTTL C$CLOS - Close control file
C$CLOS::TXNN F,FL.KST ;KSYS STREAM?
SKIPN S1,.JCIFN(R) ;IS THE FILE OPENED?
POPJ P, ;NO - RETURN
$CALL F%REL ;RELEASE CONTROL FILE
SETZM .JCIFN(R) ;MARK THE IFN CLOSED
SKIPT ;ERRORS CLOSING CHANNEL OR JFN?
$WTO (<Batch error>,<^R/.JQJBB(R)/^I/CLSTXT/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
POPJ P, ;RETURN
CLSTXT: ITEXT (<^M^JErrors closing ^F/.JQCFD(R)/>)
SUBTTL C$READ - Read a line from the control file
C$READ::PUSHJ P,B$CINI## ;INITIALIZE THE COMMAND BUFFER
READ.1: PUSHJ P,GETCHR ;READ A CHARACTER FROM THE CONTROL FILE
JUMPF READ.5 ;EOF
CAIE S1,"^" ;WAS IT AN UP-ARROW?
JRST READ.3 ;NO
PUSHJ P,GETCHR ;YES - GET ANOTHER CHARACTER
JUMPF READ.5 ;EOF
CAIN S1,"^" ;ANOTHER UP-ARROW?
JRST READ.3 ;YES - THEN USE IT
CAIG S1,"Z"+40 ;NEED TO CONVERT
CAIGE S1,"A"+40 ; TO LOWER CASE?
SKIPA ;NO
SUBI S1," " ;YES - DO IT
CAIG S1,"_" ;CAN THIS CHARACTER BE
CAIGE S1,"A" ; A CONTROL CHARACTER?
JRST READ.2 ;NO - SEND UP-ARROW AND NEW CHARACTER
TRZ S1,"@" ;YES - CONVERT IT
JRST READ.3 ;SEND CONTROL CHARACTER
READ.2: PUSH P,S1 ;SAVE SECOND CHARACTER
MOVEI S1,"^" ;GET AN UP-ARROW
PUSHJ P,B$CPUT## ;SEND THE UP-ARROW
JUMPF READ.4 ;BUFFER MUST BE FULL
POP P,S1 ;RESTORE CHARACTER
READ.3: PUSHJ P,B$CPUT## ;STORE THE CHARACTER
JUMPF READ.4 ;BUFFER MUST BE FULL
CAXG S1,.CHFFD ;CHECK FOR A LINE TERMINATOR
CAXGE S1,.CHLFD ;CAN BE <LF>, <VT>, OR <FF>
JRST READ.1 ;LOOP FOR MORE
MOVX S1,.CHNUL ;GET A <NUL>
PUSHJ P,B$CPUT## ;TERMINATE STRING
PUSHJ P,B$SETB## ;SET UP THE BYTE POINTER
LDB S1,[POINT 7,.JSCTL(R),6] ;GET THE FIRST CHARACTER IN THE LINE
$RETT ;RETURN WITH TEXT IN .JSCTL(R)
READ.4: $IDENT (BATLEL,<? Control file line exceeds ^D/[CTLSIZ]/ characters, job canceled^A>)
JRST CLOSJB## ;DISMISS THE JOB
READ.5: SKIPE .JSCTL(R) ;DID WE GET A PARTIAL LINE?
$IDENT (BATILL,<% Incomplete last line in control file>)
$RETF ;RETURN UNSUCESSFUL
SUBTTL C$STRT - Find the starting point in the control file
C$STRT::SKIPN S1,.JBCRQ+1(R) ;GET STARTING PARAMETER
MOVE S1,.JQCFP+.FPFST(R) ;GET /BEGIN OR /TAG VALUE (NO CHKPNT)
TLNN S1,777777 ;IS IT A RESTART LABEL?
JRST STRT.1 ;NO - TRY A LINE NUMBER
MOVEM S1,.JLABL(R) ;SAVE FOR LABEL SEARCH
$IDENT (BATBLA,<[Beginning processing at label ^W/.JLABL(R)/]^A>)
PUSHJ P,LABCHK ;CHECK FOR LEGAL LABEL
TXO R,RL.DRT ;DELAY RESPONSE BUFFER OUTPUT
TXO F,FL.FIN ;THIS SEARCH MAY SKIP %FIN LABEL
PUSHJ P,LABSRC ;SEARCH FOR THE LABEL
TXO F,FL.RCL ;RE-EAT THE COMMAND LINE
POPJ P, ;RETURN
STRT.1: CAIG S1,1 ;IS THE STARTING LINE GREATER THAN 1?
POPJ P, ;NO - JUST A NORMAL START
MOVEM S1,.JLABL(R) ;STORE LINE COUNT
$IDENT (BATBLI,<[Beginning processing at line ^D/.JLABL(R)/]^A>)
TXO R,RL.DRT ;DELAY RESPONSE BUFFER OUTPUT
STRT.2: SOSG .JLABL(R) ;DID WE EAT ENOUGH LINES YET?
POPJ P, ;YES
PUSHJ P,C$READ ;NO - READ A LINE
SKIPF ;EOF?
JRST STRT.2 ;GO BACK FOR MORE
SKIPN S1,.JBCRQ+1(R) ;GET STARTING PARAMETER
MOVE S1,.JQCFP+.FPFST(R) ;GET /BEGIN OR /TAG VALUE (NO CHKPNT)
$IDENT (BATECF,<? End of control file while searching for line ^D/S1/>)
PJRST CLOSJB## ;DISMISS JOB
SUBTTL C$COPY - Re-copy a command line
; This routine will copy a portion of a command back into the command buffer
; using .JSCTB(R) as a pointer to the first character and terminating on a
; <NUL>. After the copy is completed, .JSCTB(R) will be reset to the start of
; the command buffer and FL.RCL in AC 'F' (re-eat command line) will be turned
; on so that the next command scan will use the command in core.
;
C$COPY: MOVE S1,[POINT 7,.JSCTL(R)] ;POINT TO START OF THE COMMAND BUFFER
COPY.1: ILDB S2,.JSCTB(R) ;GET A CHARACTER
IDPB S2,S1 ;PUT A CHARACTER
JUMPN S2,COPY.1 ;LOOP BACK
PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
TXO F,FL.RCL ;REMEMBER TO RE-EAT THE COMMAND
JRST .POPJ1 ;Return sucessful
; Read a character from the control file
;
GETCHR: SKIPN S1,.JCIFN(R) ;IS CONTROL FILE OPEN?
PUSHJ P,C$OPEN ;NO - OPEN IT NOW
$CALL F%IBYT ;READ A BYTE
JUMPF GETC.E ;PROCESS ERROR
JUMPE S2,GETCHR ;FLUSH <NUL>
MOVE S1,S2 ;PUT CHARACTER IN A BETTER PLACE
$RETT ;RETURN SUCESSFUL
GETC.E: SKIPN .JBSPS(R) ;DOING ONLY A STEP HEADER SCAN?
CAXN S1,EREOF$ ;WAS IT EOF?
$RETF ;YES - JUST RETURN FALSE
$IDENT (BATCFE,<? ^I/CTLTXT/>)
$IDENT (BATBJC,<[Batch job has been canceled]>)
$WTOJ (<Batch error>,<^R/.JQJBB(R)/^M^J^I/CTLTXT/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
JRST CLOSJB## ;DISMISS JOB
CTLTXT: ITEXT (<Control file error for ^F/.JQCFD(R)/ - ^E/[-1]/>)
SUBTTL Miscellaneous scanner routines
; Get a character from the text buffer
;
; On return, S1 will contain a character. The following will have
; happened:
; a) All nulls stripped out
; b) Carriage returns ignored
; c) Lower case converted to upper case
;
TYI:: ILDB S1,.JSCTB(R) ;LOAD A CHARACTER
JUMPE S1,TYI ;IGNORE <NUL>
CAXN S1,.CHCRT ;<CR>?
JRST TYI ;YES - IGNORE IT
CAXN S1,.CHTAB ;<TAB>?
MOVEI S1," " ;YES - CONVERT TO A SPACE
CAIG S1,"Z"+40 ;CHECK FOR A LOWER CASE
CAIGE S1,"A"+40 ; CHARACTER THAT NEEDS TO BE
SKIPA ; CONVERTED TO AN UPPER CASE
TRZ S1," " ; CHARACTER
POPJ P, ;RETURN
; Test for End Of Line
; Returns .POPJ1 if no EOL, .POPJ if EOL
;
EOLTST: CAIG S1,.CHFFD ;CHECK FOR <LF>, <VT>
CAIGE S1,.CHLFD ; OR <FF>
SKIPA ;NOT EOL
POPJ P, ;RETURN
CAIE S1,.CHBEL ;BELL
CAIN S1,.CHCNZ ;CONTROL-Z
POPJ P, ;EOL
CAIE S1,.CHESC ;ESCAPE
CAIN S1,.CHCNC ;CONTROL-C
POPJ P, ;EOL
JRST .POPJ1 ;NOT EOL
; Flush leading spaces and tabs (always returns .POPJ1)
;
FLUSH: PUSHJ P,TYI ;GET A CHARACTER
CAIN S1," " ;SPACE?
JRST FLUSH ;YES - EAT IT
JRST .POPJ1 ;SKIP ALWAYS
; Back up the text byte pointer 1 character
;
BACKUP: MOVE S1,.JSCTB(R) ;GET THE BYTE POINTER
ADD S1,[XWD 70000,0] ;BACK UP 1 CHARACTER
SKIPG S1 ;OVER A WORD BOUNDRY?
SUB S1,[XWD 430000,1] ;YES - ADJUST POINTER
MOVEM S1,.JSCTB(R) ;STORE NEW BYTE POINTER
LDB S1,.JSCTB(R) ;LOAD THE PREVIOUS CHARACTER
POPJ P, ;RETURN
; Input a sixbit word into S1, terminating character into S2
;
; Destroys ACs T1 and T2
;
SIXINP: MOVE T1,[POINT 6,T2] ;BYTE POINTER TO STORE WORD
SETZB S2,T2 ;CLEAR COUNTER AND DESTINATION
PUSHJ P,FLUSH ;EAT LEADING SPACES AND TABS
SIXI.1: PUSHJ P,TYI ;GET A CHARACTER
CAIN S1,"%" ;SPECIAL CHECK
JRST SIXI.2 ;GO STORE IT
CAIL S1,"0" ;RANGE CHECK THE CHARACTER
CAILE S1,"9"
CAIL S1,"A"
CAILE S1,"Z"
JRST SIXI.3 ;NO MATCH - FINISH UP
SIXI.2: CAIL S2,6 ;TOO MANY CHARACTERS?
JRST SIXI.1 ;YES - IGNORE THE REST
SUBI S1," " ;CONVERT TO SIXBIT
IDPB S1,T1 ;STORE CHARACTER
AOJA S2,SIXI.1 ;LOOP FOR MORE
SIXI.3: MOVE S2,S1 ;SAVE TERMINATING CHARACTER
MOVE S1,T2 ;GET RESULTS
POPJ P, ;RETURN
; Input a keyword into the address pointed to by S1
; Call: MOVE S1,address to store string
; MOVE S2,maximum length of string
; PUSHJ P,KEYINP
; <return>
;
; On return, S1 will contain the terminating character and S2 the number
; of characters input. ACs T1, T2, and T3 are destroyed.
;
KEYINP: DMOVE T1,S1 ;GET ARGUMENTS
HRLI T1,(POINT 7) ;MAKE A BYTE POINTER
SETZ T3, ;CLEAR CHARACTER COUNT
PUSHJ P,FLUSH ;EAT LEADING TABS AND SPACES
KEYI.1: PUSHJ P,TYI ;GET A CHARACTER
CAIN S1,"%" ;SPECIAL CHECK
JRST KEYI.2 ;GO STORE IT
CAIL S1,"0" ;RANGE CHECK THE CHARACTER
CAILE S1,"9"
CAIL S1,"A"
CAILE S1,"Z"
JRST KEYI.3 ;NO MATCH - GO FINISH UP
KEYI.2: CAML T3,T2 ;IS THERE ROOM IN THE BUFFER?
JRST KEYI.1 ;NO - IGNORE IT
IDPB S1,T1 ;STORE CHARACTER
AOJA T3,KEYI.1 ;NO - LOOP
KEYI.3: CAXE S1,.CHTAB ;A TAB?
CAIN S1," " ;OR A SPACE?
SKIPA ;YES TO EITHER
PUSHJ P,BACKUP ;NOPE - BACKUP 1 CHARACTER
MOVX S2,.CHNUL ;GET A <NUL>
IDPB S2,T1 ;STORE IT
MOVE S2,T3 ;GET CHARACTER COUNT
POPJ P, ;RETURN
SUBTTL Batch command set up and dispatching
; Set up a Batch command
;
BATSET: MOVEI S1,.JSKEY(R) ;ADDRESS TO STORE KEYWORD
MOVEI S2,^D10 ;MAXIMUM NUMBER OF CHARACTERS
PUSHJ P,KEYINP ;INPUT A KEYWORD
MOVEI S1,BATCMD ;POINT TO COMMAND TABLE
MOVEI S2,.JSKEY(R) ;POINT TO KEYWORD
$CALL S%TBLK ;SEARCH THE TABLE
TXNN S2,TL%ABR!TL%EXM ;ABBREVIATION OR EXACT MATCH?
$RETF ;NOPE
LDB TF,[POINT 7,.JSKEY(R),13] ;GET SECOND CHARACTER OF COMMAND
TXNE S2,TL%ABR ;ABBREVIATED COMMAND?
JUMPE TF,.RETF ;AND MUST BE NON-ZERO OR THATS ILLEGAL
HRRZ S2,(S1) ;GET TABLE INDEX
MOVE S1,BATDSP(S2) ;GET THE FLAGS AND DISPATCH ADDRESS
HRRZM S1,.JSCDP(R) ;STORE IT
HLLZM S1,.JSCFL(R) ;STORE FLAGS
TXNE S1,BC.KJB ;SPECIAL KJOB PROCESSING?
TXO F,FL.UKJ ;REMEMBER USER REQUESTED KJOB
TXNN S1,BC.ERR ;IS COMMAND LEGAL IF JOB IN ERROR?
TXNN R,RL.JIE ;NOT VALID, IS THE JOB IN ERROR?
$RETT ;NO - RETURN SUCESSFUL
$RETF ;CAN'T PROCESS THIS COMMAND
; Here on a Batch command. The following is set up:
; a) .JSCTL(R) contains the command line.
; b) .JSCTB(R) contains the byte pointer to the command line.
; and it points to the character immediately following the
; last character of the command.
; c) .JSCDP(R) contains the command processor address.
; d) S1 contains the command flags.
;
BATPRC: HRLZI S1,.JSKEY(R) ;GET ADDRESS OF KEYWORD BUFFER
HRRI S1,.JSCNM(R) ;GET ADDRESS OF THE COMMAND NAME BUFFER
BLT S1,.JSCNM+<KEYSIZ/5>(R) ;COPY COMMAND NAME
MOVE S1,.JSCFL(R) ;GET COMMAND FLAGS
TXNN S1,BC.MON ;IS THIS REALLY A MONITOR COMMAND?
JRST BATP.1 ;NO
PUSHJ P,B$SETB## ;RESET THE BYTE POINTER
ILDB S1,.JSCTB(R) ;EAT THE MONITOR PROMPT CHARACTER
PJRST MONCMD ;YES
BATP.1: TXNN S1,BC.NEC ;"NOECHO" THIS COMMAND?
$IDENT (BATCH,<^T/.JSCTL(R)/^A>) ;NO - ECHO BATCH COMMAND LINE
TXO R,RL.DRT ;DELAY THE RESPONSE BUFFER OUTPUT
PJRST @.JSCDP(R) ;DISPATCH TO THE COMMAND PROCESSOR
SUBTTL Macros to generate Batch command tables
; Batch command flags
;
BC.ERR==1B0 ;COMMAND IS LEGAL IF JOB IN ERROR
BC.CIC==1B1 ;PARSE COMMAND IN CORE ON COMMAND EXIT
BC.NEC==1B2 ;"NOECHO" BATCH COMMAND LINE BY BATPRC
BC.MON==1B3 ;MONITOR COMMAND
BC.KJB==1B4 ;KJOB
; Macro to generate Batch command tables
;
DEFINE $BAT,<
DEFINE $MKBAT,<
$ ABORT,.ABORT,<BC.ERR>
$ BACKSPACE,,<BC.MON>
$ BACKTO,.BACKTO,<BC.CIC>
$ CHKPNT,.CHKPNT,0
$ DU,.DUMP,<BC.ERR>
$ DUMP,.DUMP,<BC.ERR>
$ ER,.ERROR,0
$ ERROR,.ERROR,0
$ GO,.GOTO,<BC.CIC>
$ GOTO,.GOTO,<BC.CIC>
$ I,,<BC.MON>
$ IF,.IF,<BC.ERR!BC.NEC>
TOPS10 < $ KJOB,,<BC.KJB!BC.MON>
$ KJO,,<BC.KJB!BC.MON>
$ KJ,,<BC.KJB!BC.MON>
$ K,,<BC.KJB!BC.MON>
> ;END TOPS10
TOPS20 < $ LOGOUT,,<BC.KJB!BC.MON>>
$ NOERROR,.NOERROR,0
$ NOOPERATOR,.NOOPERATOR,<BC.ERR>
$ OPERATOR,.OPERATOR,0
$ PLEASE,.PLEASE,0
$ REQUEUE,.REQUEUE,0
$ REVIVE,.REVIVE,0
$ SILENCE,.SILENCE,0
$ START,,<BC.MON>
$ STATUS,.STATUS,0
> ;END OF $MKBAT MACRO
...BA1==0 ;CLEAR COUNTER
DEFINE $ (NAME,DISP,FLAGS),<
...BA1==...BA1+1 ;COUNT ENTRIES
> ;END OF $ MACRO
$MKBAT ;BUILD THE COMMAND NAME TABLE
...BA2==0 ;CLEAR COUNTER
BATCMD: XWD ...BA1,...BA1 ;TABLE LENGTH
DEFINE $ (NAME,DISP,FLAGS),<
XALL
[ASCIZ |NAME|],,...BA2 ;'NAME COMMAND TABLE
SALL
...BA2==...BA2+1 ;COUNT ENTRIES
> ;END OF $ MACRO
$MKBAT ;BUILD THE COMMAND TABLE
BATDSP: DEFINE $ (NAME,DISP,FLAGS),<
XALL
EXP FLAGS+DISP ;'NAME DISPATCH TABLE
SALL
> ;END OF $ MACRO
$MKBAT ;BUILD THE FLAG TABLE
> ;END OF $BAT MACRO
SUBTTL Batch command tables
$BAT
SUBTTL Batch commands -- ABORT and STATUS
; ABORT command
;
.ABORT: $IDENT (ABORT,<?Job aborted by batch ABORT command>)
TXOA R,RL.JIE ;FLAG ERROR CONDITION
.STATUS:TXZ R,RL.JIE ;NON-FATAL
PUSHJ P,B$WINI## ;INIT WTO BUFFER
PUSHJ P,FLUSH ;EAT SPACES
ABOR.1: ILDB S1,.JSCTB(R) ;GET A CHAR
JUMPE S1,ABOR.2 ;END
PUSHJ P,B$WPUT## ;STASH IT IN WTO BUFFER
JRST ABOR.1 ;AND LOOP
ABOR.2: PUSHJ P,B$WEOL## ;END WTO MESSAGE
TXO F,FL.TXT ;MESSAGE TEXT AVAILABLE
TXZE R,RL.JIE ;AVOID CLOSE/DUMP
TXOA F,FL.UHE ;UNEXPECTED ERROR, TEXT AVAILABLE
TXZA F,FL.UHE ;NO ERRORS
JRST B$CLOSE## ;AND FINISH OFF THE JOB
JRST .POPJ1 ;RETURN SUCESSFUL
SUBTTL Batch commands -- BACKTO and GOTO
; BACKTO command
;
.BACKTO:
PUSHJ P,LABARG ;GET A LABEL ARGUMENT
SKIPN .JLABL(R) ;WAS THERE ONE
PJRST LABERR ;NO - GIVE AN ERROR
HRRZ S1,J ;GET THE MONITOR JOB NUMBER
MOVX S2,JI.RTM ;GET THE RUNTIME
PUSHJ P,I%JINF ;GET THE JOB INFO
CAMG S2,.JBRTM(R) ;USER MUST DO SOMETHING TO GET RUNTIME
JRST BACK.1 ;OTHERWISE COULD BE A::.BACKTO A
MOVEM S2,.JBRTM(R) ;SAVE FOR NEXT BACKTO COMMAND
TXO F,FL.FIN ;OK TO PASS %FIN DURING SEARCH
PUSHJ P,C$ZPOS ;REWIND THE CONTROL FILE
JRST LABSRC ;GO FIND THE LABEL
BACK.1: $IDENT (BATEPL,<? BACKTO command has entered a possible loop>)
JRST BATERR ;ENTER COMMON BATCH COMMAND ERROR CODE
; GOTO command
;
.GOTO: PUSHJ P,LABARG ;GET A LABEL ARGUMENT
SKIPN .JLABL(R) ;WAS THERE A LABEL?
PJRST LABERR ;NO - ISSUE LABEL ERROR
PJRST LABSRC ;SEARCH FOR LABEL
SUBTTL Batch commands -- CHKPNT and REQUEUE
; CHKPNT command
;
.CHKPNT:
PUSHJ P,LABARG ;GET A LABEL ARGUMENT
MOVX S1,BA.CHK ;GET CHECKPOINT FLAG
IORM S1,.JBCRQ(R) ;TURN ON CHECKPOINT FLAG IN CHECK WORDS
SKIPN S1,.JLABL(R) ;WAS THERE A LABEL
JRST LABERR ;NO, IS AN ERROR
MOVEM S1,.JBCRQ+1(R) ;STORE THE RESTART LABEL
TXO F,FL.CHK ;UPDATE CHECKPOINT DATA TO DISK
SETZM .JBCHK(R) ;FORCE A CHECKPOINT
PUSHJ P,QTS## ;WAIT A SCHEDULER PASS
JRST .POPJ1 ;RETURN SUCESSFUL
; REQUEUE command
;
.REQUEUE:
PUSHJ P,LABARG ;GET A LABEL ARGUMENT
MOVX S1,BA.URQ ;GET REQUEUE BY USER
IORM S1,.JBCRQ(R) ;STORE IT
SKIPE S1,.JLABL(R) ;WAS A LABEL SPECIFIED?
MOVEM S1,.JBCRQ+1(R) ;YES - STORE FOR QUASAR
$IDENT (BATJRQ,<[Job requeued by user]>)
MOVEI S1,REQTIM ;GET REQUEUE TIME
STORE S1,.JBRQF(R),RQ.TIM ;SET IT
MOVX T1,%REQUE ;GET REQUEUE CODE
PUSHJ P,B$UPDA## ;UPDATE QUASAR
$WTOJ (<Requeue request queued by user>,<^R/.JQJBB(R)/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
TXO R,RL.REQ ;MARK JOB AS BEING REQUEUED
JRST B$CLOS## ;DISMISS JOB
; Here on label argument errors
;
LABERR: $IDENT (BATNLS,<? No label specified or illegal syntax>)
; Here on Batch command errors
;
BATERR: TXO F,FL.LSL ;LIST LINES SKIPPED
PJRST LABFIN ;SEARCH FOR %FIN
SUBTTL Batch commands -- DUMP
; DUMP command
;
.DUMP:: $IDENT (DUMP,< -- Batch Stream and Job Data -->)
$IDENT (DUMP,<Stream:^A>)
SETZ P1, ;CLEAR INDEX
DUMP.1: SKIPN DMPTAB(P1) ;END OF TABLE?
JRST DUMP.2 ;YES
HLLZ S1,DMPTAB(P1) ;GET BITS TO TEST
HRRZ S2,DMPTAB(P1) ;GET ADDRESS OF ASCIZ TEXT
TDNE R,S1 ;BIT SET?
$IDENT (DUMP,< ^T/(S2)/^A>) ;OUTPUT TEXT
AOJA P1,DUMP.1 ;LOOP FOR MORE
DUMP.2: SKIPN T1,.JBECH(R) ;GET THE ERROR CHARACTER
MOVEI T1," " ;NONE - LOAD A SPACE
SKIPN T2,.JBOCH(R) ;GET THE OPERATOR CHARACTER
MOVEI T2," " ;NONE - LOAD A SPACE
MOVEI T3,[ASCIZ /No/] ;ASSUME NOT SILENCED
TXNE F,FL.SIL ;JOB SILENCED?
MOVEI T3,[ASCIZ /Yes/] ;YES
$IDENT (DUMP,< Error: ^7/T1/ Operator: ^7/T2/ Silenced: ^T/(T3)/^A>)
$IDENT (DUMP,< Processing node: ^N/.JQOBJ+OBJ.ND(R)/^A>)
$IDENT (DUMP,< Last step: ^W/.JLSTP(R)/^A>)
$IDENT (DUMP,< Last label: ^W/.JLLBL(R)/^A>) ;[4707]
$IDENT (DUMP,< Last CHKPNT: ^W/.JBCRQ+1(R)/^A>)
$IDENT (DUMP,< Last line to job: ^T/.JSCTL(R)/^A>)
$IDENT (DUMP,< Last line from job: ^T/.JBRSP(R)/^A>)
$IDENT (DUMP,< Last line to OPR: ^T/.JWTOP(R)/^A>)
$IDENT (DUMP,< Last line from OPR: ^T/.JWFOP(R)/^A>)
$IDENT (DUMP,< Last Batch command: ^T/.JSCNM(R)/^A>)
$IDENT (DUMP,<Job:^A>)
HRRZ S1,J ;GET JOB NUMBER
$IDENT (DUMP,< Job: ^D/S1/^A>) ;DISPALY IT
MOVEI P1,JOBTAB ;POINT TO THE JOB TABLE
DUMP.3: SKIPN T1,(P1) ;END OF TABLE?
JRST DUMP.X ;YES
HRRZ S1,J ;LOAD JOB NUMBER
HLRZ S2,(P1) ;LOAD I%JINF ARGUMENT
$CALL I%JINF ;READ A VALUE
SKIPT ;ANY ERRORS?
AOJA P1,DUMP.3 ;YES - IGNORE IT
HRRZ T1,(P1) ;GET ITEXT BLOCK POINTER
$IDENT (DUMP,< ^I/(T1)/^A>) ;OUTPUT SOME DATA
AOJA P1,DUMP.3 ;LOOP FOR MORE
DUMP.X: $IDENT (DUMP,< -- End of Dump -->)
JRST .POPJ1 ;RETURN SUCESSFUL
; Table of bits to test and messages to output
; Format: bits in LH AC 'R',[asciz string]
;
DMPTAB: EXP RL.OPR+[ASCIZ /Waiting for operator response/]
EXP RL.JIE+[ASCIZ /Job in error/]
EXP RL.KJB+[ASCIZ /Logout in pending/]
EXP RL.LGI+[ASCIZ /Login in progress/]
EXP RL.DIA+[ASCIZ /Job in dialogue mode/]
EXP RL.STP+[ASCIZ /Stopped by the operator/]
EXP RL.MIP+[ASCIZ /Operator message being processed/]
EXP RL.FLS+[ASCIZ /Request to flush job/]
EXP 0 ;END TABLE WITH A ZERO WORD
; Table of job parameter values
; Format: XWD I%JINF arguments,[ITEXT (string)]
;
JOBTAB: XWD JI.TNO,[ITEXT (TTY^O/S2/)]
XWD JI.USR,[ITEXT (User: ^P/S2/)]
XWD JI.PRG,[ITEXT (Program: ^W/S2/)]
XWD JI.LOC,[ITEXT (Located at: ^N/S2/)]
XWD 0,0 ;End table with a zero word
SUBTTL Batch commands -- ERROR and OPERATOR
; ERROR command
;
.ERROR: TXZ F,FL.NER ;CLEAR NOERROR STATE
SETZ T1, ;DEFAULT CHARACTER
MOVEI T2,.JBECH(R) ;STORAGE ADDRESS
PJRST CHRSET ;GO ENTER COMMON ERROR/OPERATOR CODE
; OPERATOR command
;
.OPERATOR:
MOVEI T1,"$" ;DEFAULT CHARACTER
MOVEI T2,.JBOCH(R) ;STORAGE ADDRESS
; Common character setting routine
;
CHRSET: MOVEM T1,(T2) ;STORE DEFAULT CHARACTER
PUSHJ P,FLUSH ;FLUSH LEADING TABS AND SPACES
JFCL ;ALWAYS SKIPS
PUSHJ P,EOLTST ;OR TERMINATING CHARACTER?
JRST .POPJ1 ;YES - RETURN
CAIE S1,";" ;OLD STYLE COMMENT?
CAIN S1,"!" ;NEW STYLE COMMENT?
JRST .POPJ1 ;YES - RETURN
CAIG S1," " ;NON-CONTROL NON-SPACE CHARACTER?
JRST ILLCHR ;ILLEGAL CHARACTER
MOVEM S1,(T2) ;STORE IT
JRST .POPJ1 ;RETURN
; Here on an illegal character
;
ILLCHR: SETZM (T2) ;CLEAR DEFAULT CHARACTER CURRENTLY SET
$IDENT (BATICS,<? Illegal character specified for ^T/.JSCNM(R)/ command^A>)
JRST LABFIN ;GO SEARCH FOR %FIN
SUBTTL Batch commands -- IF
; Perform error testing
;
.IF: PUSHJ P,FLUSH ;EAT LEADING TABS AND SPACES
JFCL ;ALWAYS SKIPS
CAIE S1,"(" ;NEED THE OPENING PARENTHESIS
JRST IF.ERR ;BAD IF COMMAND
MOVEI S1,.JSKEY(R) ;POINT TO STORAGE LOCATION
MOVEI S2,KEYSIZ ;MAXIMUM NUMBER OF CHARACTERS
PUSHJ P,KEYINP ;READ A KEYWORD
PUSHJ P,FLUSH ;EAT LEADING TABS AND SPACES
JFCL ;ALWAYS SKIPS
CAIE S1,")" ;NEED THE CLOSING PARENTHESIS
JRST IF.ERR ;BAD IF COMMAND
MOVEI S1,IFTAB ;POINT TO KEYWORD TABLE
MOVEI S2,.JSKEY(R) ;POINT TO KEYWORD
$CALL S%TBLK ;SCAN THE TABLE
TXNN S2,TL%ABR!TL%EXM ;ABBREVIATION OR EXACT MATCH?
JRST IF.ERR ;NOPE
HRRZ S1,(S1) ;GET DISPATCH ADDRESS
JRST (S1) ;PROCESS THE IF COMMAND
IF.ERR: $IDENT (BATIIC,<? Illegal IF command argument or syntax error>)
JRST BATERR ;TAKE ERROR RETURN
; Here on IF (ERROR)
;
IFERRO: TXZN R,RL.JIE ;JOB IN ERROR?
JRST IFFALS ;NO - IF (ERROR) IS FALSE
; Here if condition tested is TRUE
;
IFTRUE: $IDENT (TRUE,<^A>) ;IDENTIFY THE LINE
PUSHJ P,IFCOPY ;COPY THE IF COMMAND AND ARGUMENTS
TXO R,RL.DRT ;DELAY THE RESPONSE BUFFER OUTPUT
PJRST C$COPY ;RE-COPY COMMAND AND RETURN SUCESSFUL
; Here on IF (NOERROR)
;
IFNOER: TXZN R,RL.JIE ;JOB IN ERROR?
JRST IFTRUE ;NO - IF (NOERROR) IS TRUE
; Here if condition tested is FALSE
;
IFFALS: $IDENT (FALSE,<^A>) ;IDENTIFY THE LINE
TXO R,RL.DRT ;DELAY THE RESPONSE BUFFER OUTPUT
PUSHJ P,IFCOPY ;COPY THE IF COMMAND AND ARGUMENTS
JRST .POPJ1 ;RETURN SUCESSFUL
; Copy the IF command and arguments
;
IFCOPY: PUSHJ P,B$SETB## ;RESET BYTE POINTER TO START OF LINE
IFCO.1: ILDB S1,.JSCTB(R) ;GET A CHARACTER
PUSHJ P,L$PLOG## ;LOG IT
CAIE S1,")" ;END OF CONDITIONAL?
JRST IFCO.1 ;NO - LOOP BACK
PUSHJ P,L$CRLF## ;END THE LINE
PUSHJ P,FLUSH ;GET NEXT CHARACTER (NO SPACES OR TABS)
JFCL ;ALWAYS SKIPS
PUSHJ P,EOLTST ;AT EOL ALREADY?
POPJ P, ;YES - THEN DON'T BACKUP
PJRST BACKUP ;BACKUP 1 CHARACTER AND RETURN
; Macros to generate the IF argument tables
;
DEFINE $IF,<
DEFINE $MKIF,<
$ ERROR,IFERRO
$ NOERROR,IFNOER
> ;END OF $MKIF MACRO
...IF==0 ;CLEAR COUNTER
DEFINE $ (NAME,DISP),<
...IF==...IF+1 ;COUNT THE ENTRY
> ;END OF $ MACRO
$MKIF ;BUILD THE ARGUMENT NAME TABLE
IFTAB: XWD ...IF,...IF ;TABLE LENGTH
DEFINE $ (NAME,DISP),<
XALL
[ASCIZ |'NAME|],,DISP ;'NAME ARGUMENT
SALL
> ;END OF $ MACRO
$MKIF ;BUILD THE ARGUMENT TABLE
> ;END OF $IF MACRO
; Invoke the IF argument table building macros
;
$IF
SUBTTL Batch commands -- MESSAGE and PLEASE
; MESSAGE and PLEASE commands
;
.MESSAGE:
.PLEASE:
PUSHJ P,B$WINI## ;SET UP WTO/WTOR BUFFER
PUSHJ P,FLUSH ;EAT LEADING SPACES AND TABS
PLEA.1: ILDB S1,.JSCTB(R) ;GET A CHARACTER
CAIN S1,.CHESC ;ESCAPE?
JRST PLEA.2 ;YES - SEND LINE TO OPERATOR
PUSHJ P,B$WPUT## ;STORE IN THE WTO/WTOR BUFFER
JUMPE S1,PLEA.3 ;END OF LINE
JRST PLEA.1 ;LOOP BACK FOR ANOTHER
PLEA.2: PUSHJ P,B$WEOL## ;END THE LINE
PUSHJ P,B$WTO## ;DO A WTO
JRST .POPJ1 ;RETURN SUCESSFUL
PLEA.3: PUSHJ P,B$WEOL## ;End the line
PUSHJ P,B$WTOR## ;Do a WTOR
PUSHJ P,B$WRSP## ;GET OPERATOR RESPONSE
$IDENT (OPERAT,<From operator: ^T/.JWFOP(R)/^A>)
JRST .POPJ1 ;RETURN SUCESSFUL
SUBTTL Batch commands -- NOERROR, NOOPERATOR, REVIVE, and SILENCE
; NOERROR command
;
.NOERROR:
TXO F,FL.NER ;SET NOERROR IN EFFECT
JRST .POPJ1 ;RETURN SUCESSFUL
; NOOPERATOR command
;
.NOOPERATOR:
SETZM .JBOCH(R) ;CLEAR THE DIALOGUE CHARACTER
JRST .POPJ1 ;RETURN SUCESSFUL
; REVIVE command
;
.REVIVE:
TXZA F,FL.SIL ;CLEAR SILENCE MODE
; SILENCE command
;
.SILENCE:
TXO F,FL.SIL ;SET SILENCE MODE
JRST .POPJ1 ;RETURN SUCESSFUL
SUBTTL MOUNT parser -- ALLOCATE and MOUNT command syntax tables
;ALLOCATE and MOUNT syntax tables
MOU010:: ;Mount and allocate share common syntax
ALL010::$SWITCH(,MOU011,$ALTER(MOU015))
MOU015: $CRLF ($ALTER (MOU020))
MOU020: $FIELD(MOU022,<volume set name>,$BREAK(VSNBRK))
MOU022: $TOKEN(MOU023,<(>,$ALTER(MOU026))
MOU023: $FIELD(MOU024,<volume identifier>)
MOU024: $COMMA(MOU023,$ALTER(MOU025))
MOU025: $TOKEN(MOU026,<)>)
MOU026: $TOKEN(MOU030,<:>,$ALTER(MOU030))
MOU030: $FIELD(MOU032,<logical name>)
MOU032: $TOKEN(MOU040,<:>,$ALTER(MOU040))
MOU040: $SWITCH(,MOU041,$ALTER(MOU050))
MOU050: $COMMA(MOU020,$ALTER(MOU060))
MOU060: $CRLF
;Character set allowed for VOLUME-SET-NAME
VSNBRK::
777777,,777760 ;Break on all control
777754,,001760 ;Allow - and 0-9
400000,,000760 ;Allow A-Z
400000,,000760 ;Allow LC A-Z
SUBTTL MOUNT parser -- MOUNT and ALLOCATE option tables
MOU011: $STAB
DSPTAB(MOU010,MO$CHE,<CHECK>)
DSPTAB(MOU010,MO$DIS,<DISK>)
DSPTAB(,HELPER,<HELP>)
DSPTAB(MOU010,MO$NNT,<NONOTIFY>)
DSPTAB(MOU010,MO$NOT,<NOTIFY>)
DSPTAB(MOU010,MO$NOW,<NOWAIT>)
DSPTAB(MOU010,MO$TAP,<TAPE>)
DSPTAB(MOU010,MO$WAI,<WAIT>)
$ETAB
MOU041: $STAB
DSPTAB(MOU040,MO$ACT,<ACTIVE>)
DSPTAB(MOU040,MO$CRE,<CREATE>)
DSPTAB(M$DEN1,MO$DEN,<DENSITY>)
DSPTAB(M$FLD1,MO$DEV,<DEVICE>)
DSPTAB(MOU040,MO$DIS,<DISK>)
DSPTAB(MOU040,MO$EXC,<EXCLUSIVE>)
DSPTAB(M$LAB1,MO$LAB,<LABEL-TYPE>)
DSPTAB(MOU040,MO$SHA,<MULTI>) ;Ala SHARABLE
DSPTAB(MOU040,MO$NEW,<NEW-VOLUME-SET>)
DSPTAB(MOU040,MO$NOC,<NOCREATE>)
DSPTAB(MOU040,MO$NNT,<NONOTIFY>)
DSPTAB(MOU040,MO$NOT,<NOTIFY>)
DSPTAB(MOU040,MO$NOW,<NOWAIT>)
DSPTAB(MOU040,MO$PAS,<PASSIVE>)
DSPTAB(M$PRO1,MO$PRO,<PROTECTION>)
DSPTAB(MOU040,MO$QTA,<QUOTA>)
DSPTAB(MOU040,MO$REA,<READ-ONLY>)
DSPTAB(M$VOL1,MO$VOL,<REELID>) ;Ala VOLID
DSPTAB(M$REM1,MO$REM,<REMARK>)
DSPTAB(MOU040,MO$REA,<RONLY>) ;Ala READ-ONLY
DSPTAB(MOU040,MO$SCR,<SCRATCH>)
DSPTAB(MOU040,MO$SHA,<SHARABLE>)
DSPTAB(MOU040,MO$EXC,<SINGLE>) ;Ala EXCLUSIVE
DSPTAB(MOU040,MO$TAP,<TAPE>)
DSPTAB(M$TRA1,MO$TRA,<TRACKS>)
DSPTAB(M$REM1,MO$REM,<VID>) ;Ala REMARK
DSPTAB(M$VOL1,MO$VOL,<VOLID>)
DSPTAB(MOU040,MO$WAI,<WAIT>)
DSPTAB(MOU040,MO$WRI,<WENABLE>) ;Ala WRITE-ENABLE
DSPTAB(MOU040,MO$REA,<WLOCK>) ;Ala READ-ONLY
DSPTAB(M$WRI1,MO$WRI,<WRITE-ENABLE>) ;Also WRITE:YES and WRITE:NO
$ETAB
;ALLOCATE and MOUNT options syntax tables
M$DAT1: $DATE(MOU040)
M$DEN1: $KEY(MOU040,M$DEN2)
M$DEN2: $STAB
KEYTAB(.TFD16,<1600-BPI>)
KEYTAB(.TFD20,<200-BPI>)
KEYTAB(.TFD55,<556-BPI>)
KEYTAB(.TFD62,<6250-BPI>)
KEYTAB(.TFD80,<800-BPI>)
$ETAB
M$FLD1: $FIELD(MOU040)
M$LAB1: $KEY(MOU040,M$LAB2)
M$LAB2: $STAB
KEYTAB(%TFANS,<ANSI>)
KEYTAB(%TFLBP,<BLP>)
KEYTAB(%TFLBP,<BYPASS-LABEL-PROCESSING>)
KEYTAB(%TFEBC,<EBCDIC>)
KEYTAB(%TFEBC,<IBM>)
KEYTAB(%TFUNL,<NOLABELS>)
KEYTAB(%TFUNL,<NONE>)
KEYTAB(%TFUNL,<UNLABELED>)
KEYTAB(%TFUNV,<USER-EOT>)
$ETAB
M$NUM1: $NUMBER(MOU040,^D10)
M$PRO1: $NUMBER(MOU040,^D8)
M$REM1: $QUOTE(MOU040,,$ALTER(M$REM2))
M$REM2: $FIELD(MOU040,,$BREAK(REMBRK))
REMBRK: 777777,,777760 ;Break on all control
777754,,001760 ;Allow - and 0-9
400000,,000760 ;Allow A-Z
400000,,000760 ;Allow LC A-Z
M$TRA1: $KEY(MOU040,M$TRA2)
M$TRA2: $STAB
KEYTAB(.TMDR7,<7-TRACK>)
KEYTAB(.TMDR9,<9-TRACK>)
$ETAB
M$VOL1: $TOKEN(M$VOL2,<(>,$ALTER(M$VOL5))
M$VOL2: $FIELD(M$VOL3)
M$VOL3: $COMMA(M$VOL2,$ALTER(M$VOL4))
M$VOL4: $TOKEN(MOU040,<)>,$ALTER(MOU040))
M$VOL5: $FIELD(MOU040)
M$WRI1: $KEY(MOU040,M$WRI2,<$DEFAULT(YES),$ALTER(MOU040)>)
M$WRI2: $STAB
KEYTAB(FALSE,<NO>)
KEYTAB(TRUE,<YES>)
$ETAB
;MOUNT and ALLOCATE commands
;These routines will parse a MOUNT or an ALLOCATE command.
; The parse blocks are built in a page of data supplied by the caller
;Call -
; S1/ Adrs of a page into which the mount message
; will be built
;Return -
; TRUE always.
; If there are ANY errors, these routines pull a $ERR macro
; which JSPs to a caller-defined ERROR label (external from here)
; which should handle the error condition.
.ALLOC::
TDZA F,F ;CLEAR FLAG WORD
.MOUNT::
MOVX F,FL.MOU+FL.WAT ;Set Mount and Wait flags
$SAVE <P1,P2,P3,P4> ;Preserve some AC's
$SAVE <T1,T2,T3,T4> ;SAVE THE TEMP ACS
MOVE P1,S1 ;Save the incoming page adrs
MOVE S1,['MOUNT '] ;Assume mount
TXNN F,FL.MOU
MOVE S1,['ALLOCA']
MOVEM S1,CMDNAM ;Save incase /HELP was typed
MOUN05: PUSHJ P,P$CFM ;Try to get EOL
SKIPF ;User didn't type CRLF yet
TXO F,FL.LST ;Default to /LIST if EOL already
$CALL DOSWS ;Parse leading switches
MOVEM F,DEFSWS ;Save sticky options
MOVEI P2,.MMHSZ(P1) ;P2 contains first free address
MOVEI S2,.QOMNT ;Get mount message type
STORE S2,.MSTYP(P1),MS.TYP ;Save in the message
MOVX S2,MF.ACK ;Get ACK request flag
MOVEM S2,.MSFLG(P1)
$CALL P$CFM ;Get confirmation
JUMPT MOUN80 ;Yes..just return
JUMPE S1,MOUN80 ;Return at end of command (MOUNT/CHECK)
HRROI T1,.GTNM1 ;Get user name
GETTAB T1, ;May I?
SETZ T1, ;No..
HRROI T2,.GTNM2 ;Get second half
GETTAB T2, ;May I?
SETZ T2, ;No..
DMOVEM T1,.MMUSR(P1) ;Store in message
MOVEI T1,2 ;Get arg count for account
SETO T2, ;My Job
HRROI T3,.MMUAS(P1) ;Store in message
MOVE S2,[.ACTRD,,T1] ;Get the account
ACCT. S2,
JFCL
MOUN10: INCR .MMARC(P1) ;Increment total message arg count
MOVE P3,P2 ;P3 points to current entry
ADDI P2,.MEHSZ ;P2 points to first free word
MOVE F,DEFSWS ;Get default options
SETZ S1, ;Initially, no flags
TXNN F,FL.MOU ;Is this a mount request?
MOVX S1,ME%ALC ;Get the allocate-only bit
MOVEM S1,.MEFLG(P3) ;Stash the flags
SETZM VOLCNT ;Clear the count of VOLIDS
MOUN20: $CALL P$FLD ;Was VSN specified?
SKIPN ARG.DA(S1) ;Make sure its not null
$ERR (<Volume set name must be specified>)
MOVEM S1,VSNADR ;Save address of Volume set name
HRROI S1,ARG.DA(S1) ;Point to volume set name string
$CALL DEVCHK ;See if actual device name given
MOVEM S2,VSNAME ;Save SIXBIT volume set name
MOVE T1,S2 ;Save Device name
CAIN S1,.TYDSK ;Is it a disk?
DEVNAM T1, ;Yes, translate logical name.
JRST MOUN21 ;Failed, or not a disk.
MOVE T3,VSNADR ;Get device name address.
MOVEI T2,2 ;Arg block is only 2 long now.
STORE T2,ARG.HD(T3),AR.LEN ;So stuff it.
SETZM ARG.DA(T3) ;Zap the current name
ADD T3,[POINT 7,ARG.DA] ;Make into byte pointer
TRZ T1,7777 ;Ensure only 4 characters
MOLO: SETZ T2, ;Loop to change SIXBIT to ASCIZ
ROTC T1,6 ;Shift a character into T2
ADDI T2,"A"-'A' ;Make into ASCII
IDPB T2,T3 ;Stuff into name
JUMPN T1,MOLO ;Continue until done
MOUN21: TXNE F,FL.TAP!FL.DSK ;Request type known?
JRST MOUN25 ;Yes..then allow it
JUMPF [CAIN S1,ER$EZD ; ersatz device?
$ERR(<Ersatz device ^W/S2/ may not be mounted>)
CAIN S1,ER$PLD ; pathological name?
$ERR(<Pathological device ^W/S2/ may not be mounted>)
CAIN S1,ER$ASN ; ambigious?
$ERR(<Ambigious structure name ^W/S2/>)
CAIN S1,ER$ISN ; illegal?
$ERR(<Illegal structure name ^W/S2/>)
CAIN S1,ER$GDN ; generic?
$ERR(<Generic device ^W/S2/ may not be mounted>)
JRST MOUN25] ;No..process as VSN
CAIN S1,.TYMTA ;Yes..was it tape?
TXO F,FL.TAP ;Yes..specify tape
CAIN S1,.TYDSK ;Was it disk?
TXO F,FL.DSK
MOUN25: $CALL P$TOK ;Was it terminated by a token?
JUMPF MOUN30 ;No..on to parse logical name
MOVE S1,ARG.DA(S1) ;Get the token
CAMN S1,[ASCIZ/:/] ;Was VSN: specified?
JRST MOUN30 ;Yes..on to get logical name
$CALL P$PREV ;Backup to token again
$CALL MO$VOL ;Process VOLID list
JRST MOUN25 ;See if VSN(list): was specified!
MOUN30: $CALL P$SIXF ;Get locical name
JUMPF MOUN40 ;Don't store junk
MOVEM S1,LOGNAM ;Save logical name
$CALL P$TOK ;Get optional ":"
MOUN40: $CALL DOSWS
TXNN F,FL.DSK ;Is this a disk request ?
TXNE F,FL.TRK ;Was /TRACK specified ?
JRST MOUN41 ;Yes, skip this
SETZM S1 ;clear S1
MOVE S2,VSNAME ;Get the volume set name in sixbit
CAMN S2,[SIXBIT/M9/] ;Did he specify M9 ?
MOVX S1,.TMDR9 ;Yes, get 9 track code
CAMN S2,[SIXBIT/M7/] ;Did he specify M7 ?
MOVX S1,.TMDR7 ;Yes, get 7 track code
JUMPE S1,MOUN41 ;Neither,,skip this
MOVEI S2,.TMDRV ;Get /TRACK: block type
PUSHJ P,ADDSUB ;Add /TRACK:x to message
MOUN41: PUSHJ P,BLDVSN ;Build the VSN
PUSHJ P,LOGCHK ;No - check out the logical name
SETZ S1, ;Clear entry flags
TXNE F,FL.SCR ;Scratch volume wanted?
TXO S1,TM%SCR!TM%WEN ;Yes
TXNE F,FL.NEW ;New volume set wanted?
TXO S1,TM%NEW!TM%WEN ;Yes
TXNE F,FL.WRT ;Write enabled?
TXO S1,TM%WEN ;Yes
TXNE F,FL.WLK ;Write locked?
TXO S1,TM%WLK ;Yes
TXNE F,FL.BYP ;Bypass labels?
TXO S1,TM%BYP ;Yes
TXNE F,FL.PAS ;Was /PASSIVE specified?
TXO S1,SM%PAS ;Yes
TXNE F,FL.NOC ;Was /NOCREATE specified?
TXO S1,SM%NOC ;Yes
TXNE F,FL.EXC ;Was /EXCLUSIVE specified?
TXO S1,SM%EXC ;Yes
TXNE F,FL.QTA ;Was /QUOTA specified?
TXO S1,SM%ARD ;Yes
IORM S1,.MEFLG(P3) ;Save the entry flags
MOVEI S1,.MNUNK ;Get unknown entry type
TXNE F,FL.TAP ;Was it a tape request?
MOVEI S1,.MNTTP ;Yes..then use tape entry type
TXNE F,FL.DSK ;Was it a disk request?
MOVEI S1,.MNTST ;Yes..then use disk entry type
MOUN52: STORE S1,ARG.HD(P3),AR.TYP ;Save request type
MOVE S1,P2 ;Close current entry
SUB S1,P3 ;Compute entry length
STORE S1,ARG.HD(P3),AR.LEN ;Save in entry header
$CALL P$COMMA ;No..then must be a comma
JUMPT MOUN10 ;Yes..Back to try again
$CALL P$CFM ;Confirmed?
JUMPT MOUN80 ;Yes..send what we have
$ERR (<Unrecognized command syntax>)
MOUN80: SETZB S1,.MMFLG(P1) ;Clear message flag word
TXNE F,FL.WAT ;Want to wait for the mount?
TXO S1,MM.WAT ;Yes..light the flag
TXNE F,FL.NOT ;Want terminal notification?
TXO S1,MM.NOT ;Yes..light the flag
MOVEM S1,.MMFLG(P1) ;Set the message flags
SUB P2,P1 ;Compute message length
STORE P2,.MSTYP(P1),MS.CNT ;Save it
MOVEI S1,PAGSIZ ;Send of the page
MOVE S2,P1
$RETT
;MOUNT option processors
DOSWS:: $CALL P$SWIT ;Get a switch if any
$RETIF ;No, return
$CALL 0(S1) ; Else call the processor
JRST DOSWS ;Process next switch
;ACTIVE option places disk in jobs active search list
MO$ACT: MOVX S1,TXT(/ACTIVE) ;Get error prefix
$CALL DSKCHK ;Must be disk
TXZ F,FL.PAS ;Clear Passive flag
$RETT
;CHECK option lists the mount queues
MO$CHE: TXO F,FL.CHK ;Set the flag
$RETT
;CREATE option
MO$CRE: MOVX S1,TXT(/CREATE) ;Get error prefix
$CALL DSKCHK ;Must be disk
TXZ F,FL.PAS!FL.NOC ;Clear Passive and Nocreate
$RETT
;DENSITY option requests specific tape density
MO$DEN: MOVX S1,TXT(/DENSITY) ;Get error prefix
$CALL TAPCHK ;Must be tape
$CALL P$KEYW ;Get proper density
MOVEI S2,.TMDEN
PJRST ADDSUB
;DEVICE option requests specific device type
MO$DEV: $CALL P$SIXF ;Get requested device
$RETT
;DISK option declares disk devices
MO$DIS: MOVX S1,TXT(/DISK)
$CALL DSKCHK ;Must be disk request
$RETT
;EXCLUSIVE option declares that exclusive ownership is requested
MO$EXC: MOVX S1,TXT(/EXCLUSIVE)
$CALL DSKCHK ;Must be disk
TXO F,FL.EXC ;Set the flag
$RETT
;LABEL-TYPE option
MO$LAB: MOVX S1,TXT(/LABEL-TYPE) ;Get error prefix
$CALL TAPCHK ;Must be a tape request
$CALL P$KEYW ;Get the LABEL type
MO$LA1: CAXN S1,%TFLBP ;Was it BYPASS?
TXO F,FL.BYP ;Yes..set the flag
TXO F,FL.LAB ;Note that something was said
MOVEI S2,.TMLT ;Create label type entry
PJRST ADDSUB
;NEW-VOLUME-SET option
MO$NEW: MOVX S1,TXT(/NEW-VOLUME-SET)
$CALL TAPCHK ;Tape requests only
TXO F,FL.NEW ;Set the flag
$RETT
;NOCREATE option
MO$NOC: MOVX S1,TXT(/NOCREATE)
$CALL DSKCHK ;Disk requests only
TXO F,FL.NOC
$RETT
;NOWAIT option
;
;NOTIFY option
MO$NOW: TXZ F,FL.WAT ;Clear the wait flag,,imply notify
MO$NOT: TXOA F,FL.NOT ;Notify on completion
MO$NNT: TXZ F,FL.NOT ;No notify
$RETT
;PASSIVE option
MO$PAS: MOVX S1,TXT(/PASSIVE) ;Get error prefix
$CALL DSKCHK ;Must be dsk
TXO F,FL.PAS ;Set the PASSIVE flag
$RETT
;PROTECTION option
MO$PRO: MOVX S1,TXT(/PROTECTION) ;Get error prefix
$CALL TAPCHK ;Must be tape
$CALL P$NUM ;Get the value
CAIL S1,0 ;Check the range
CAILE S1,MAXPRO
$ERR (<Protection out of range>)
MOVEI S2,.TMVPR ;Create protection entry
PJRST ADDSUB ; and return
;QUOTA option
MO$QTA: MOVX S1,TXT(/QUOTA) ;Get error prefix
PUSHJ P,DSKCHK ;Must be dsk
TXO F,FL.QTA ;Set the quota flag
$RETT
;READ-ONLY option
MO$REA: TXO F,FL.WLK ;Set write lock flag
$RETT
;REMARK option
MO$REM: TXO F,FL.REM ;Remember we saw it
$CALL P$QSTR ;Get quoted string
SKIPT
$CALL P$FLD ;Or simple field
$CALL CPYSUB ;Create .TMRMK subentry
MOVEI S1,.TMRMK ;Make entry type remark
STORE S1,ARG.HD(S2),AR.TYP
$RETT
;SCRATCH option
MO$SCR: MOVX S1,TXT(/SCRATCH) ;Get error prefix
$CALL TAPCHK ;Must be tape
TXO F,FL.SCR ;Set the flag
$RETT
;SHARABLE option
MO$SHA: MOVX S1,TXT(/SHARABLE)
$CALL DSKCHK ;Must be disk
TXZ F,FL.EXC ;Clear Exclusive
$RETT
;TAPE option
MO$TAP: MOVX S1,TXT(/TAPE)
$CALL TAPCHK
$RETT
;TRACKS option
MO$TRA: MOVX S1,TXT(/TRACKS) ;Get error prefix
$CALL TAPCHK ;Must be tape
$CALL P$KEYW ;Get the track type
TXO F,FL.TRK ;Set /TRACK: flag
MOVEI S2,.TMDRV
PJRST ADDSUB
;WAIT option
MO$WAI: TXO F,FL.WAT ;Set the flag
$RETT
;WRITE-ENABLE option
MO$WRI: $CALL P$KEYW ;Get YES or NO
JUMPF [TXO F,FL.WRT ;Default is WRITE:YES
$RETT]
JUMPE S1,[TXO F,FL.WLK ;Set write lock if WRITE:NO
$RETT]
TXO F,FL.WRT ;Set write enable if WRITE:YES
$RETT
;VOLID option
MO$VOL: MOVX S1,TXT(Volume identifier) ;Get the error prefix
SKIPE VOLCNT ;Have we been here before?
$ERR (<Only one volume identifier list is allowed>)
INCR .MECNT(P3) ;Bump subentry count
MOVE P4,P2 ;Save free address
ADDI P2,1 ;Reserve a word for header
$CALL P$TOK ;Get optional list token
JUMPF [$CALL MO$VO3 ;Allow only one volume
JRST MO$VO2] ;If no token is found
MO$VO1: $CALL MO$VO3 ;Get volume identifier
$CALL P$COMMA ;More to come?
JUMPT MO$VO1 ;Yes..get the whole list
$CALL P$TOK ;Check optional list token
JUMPF [$ERR(<Missing volume identifier list terminator>)]
MO$VO2: MOVE S1,P2 ;Get final free address
SUB S1,P4 ;Compute argument length
MOVS S1,S1 ;Put length in Left half
HRRI S1,.TMVOL ;Get Volume subtype entry
MOVEM S1,ARG.HD(P4) ;Store in subentry header
MOVE S1,P4 ;Point to argument
$CALL UNICHK ;Check VOLID uniqueness
SKIPT ;All OK?
$ERR (<Volume identifiers must be unique>)
$RETT
;Routine to store and individual volume identifier
MO$VO3: $CALL P$SIXF ;Get the first volume
JUMPF [$ERR(<Invalid volume identifier>)]
JUMPE S1,[$ERR(<Volume identifier must not be null>)]
MOVEM S1,0(P2) ;Store the volume name
AOS VOLCNT ;Increment volume count
ADDI P2,1 ;Increment free address
$RETT
SUBTTL MOUNT parser -- General routines
;ADDARG - Routine to add a 2 word argument to general message
;ADDSUB - Routine to add a 2 word subentry argument to MOUNT message
;ACCEPTS S1/ Data word to be stored in message
; S2/ argument type code
; P1/ Address of message header
; P2/ Address of first free word in message
; P3/ Address of current mount entry
ADDARG::
AOSA .OARGC(P1) ;Increment message arg count
ADDSUB::
INCR .MECNT(P3) ;Increment subargument count
MOVEM S1,ARG.DA(P2) ;Store data word
HRLI S2,ARG.SZ ;Get size of 2
MOVEM S2,ARG.HD(P2) ;Store in header
ADDI P2,ARG.SZ ;Point to next free word
$RETT
;CPYARG - Routine to copy argument to general message
;CPYSUB - Routine to copy subargument to MOUNT message
;ACCEPTS S1/ Address of argument header word
; S2/ Number of words in argument
;RETURNS S2/ Address of argument header in message
CPYARG::
AOSA .OARGC(P1) ;Increment message arg count
CPYSUB::
INCR .MECNT(P3) ;Increment subargument count
MOVS S1,S1 ;Create BLT pointer
HRR S1,P2
ADD S2,P2 ;Get Next Free address
BLT S1,-1(S2) ;Copy the whole argument
EXCH P2,S2 ;P2 points to next free address
$RETT ;S2 points to stored argument
;CPYSTR - routine to store asciz string
;ACCEPTS S1/ Pointer to source string
; S2/ Pointer to destination string
CPYSTR::
ILDB TF,S1
IDPB TF,S2
JUMPN TF,CPYSTR
$RETT
;TAPCHK - routine to ensure that we are processing a tape request
;DSKCHK - routine to ensure that we are processing a disk request
;ACCEPTS S1/ Pointer to error prefix
TAPCHK: TXNE F,FL.DSK ;Disk request?
$ERR (<^Q/S1/ is only valid for tape>)
TXO F,FL.TAP ;Remember we have a tape request
$RETT
DSKCHK: TXNE F,FL.TAP ;Tape request?
$ERR (<^Q/S1/ is only valid for disk>)
TXO F,FL.DSK ;Remember we have a disk request
$RETT
;LOGCHK - check and add LOGICAL name to mount request
LOGCHK: SKIPN S1,LOGNAM ;See if logical name
$RETT ;No--Just return
TXNE F,FL.DSK ;Disk request?
JRST LOGC.1 ;Yes--No logical name
DEVCHR S1, ;See if logical name in use
JUMPE S1,LOGC.2 ;No--Thats OK
TXNN S1,DV.ASC!DV.ASP ;Assigned by console or program?
JRST LOGC.2 ;No
SKIPE BATJOB ;Batch job?
$TEXT (,<% Specified logical name "^W/LOGNAM/" already in use>) ;Yes--Tell him
MOVX S1,<INSVL.(.FORED,FO.FNC)!FO.ASC>;Get a new channel
MOVEM S1,FBLK+.FOFNC ;Store
SETZM FBLK+.FOIOS ;No mode
MOVE S1,LOGNAM ;Get device
MOVEM S1,FBLK+.FODEV ;Store device
SETZM FBLK+.FOBRH ;And no buffers
MOVE S1,[.FOBRH+1,,FBLK] ;Point to FILOP.
FILOP. S1, ;Open the device
JRST LOGC.2 ;Cant
LOAD S1,FBLK+.FOFNC,FO.CHN ;Get channel
MOVEI S2,0 ;Clear logical name
DEVLNM S1, ;Zap it
JFCL ;We tried
MOVX S1,.FOREL ;Release function
STORE S1,FBLK+.FOFNC,FO.FNC ;Store it
MOVE S1,[1,,FBLK] ;Point to FILOP.
FILOP. S1, ;Release channel
JFCL ;Cant
LOGC.2: MOVE S1,LOGNAM ;Get logical name
MOVX S2,.TMLNM ;And block type
$CALL ADDSUB ;Add it
$RETT ;And return
LOGC.1: SKIPE BATJOB ;Batch job?
$TEXT (,<% Logical name "^W/LOGNAM/" ignored on disk structure ^W/VSNAME/:>) ;
$RETT ;Error and return
; Routine to build a volume set name into a MOUNT message block
; Call: PUSHJ P,BLDVSN
; <return>
;
; If the VSN is a generic device, then a VSN of DEV-xxxxxx (where xxxxxx
; is a random alpha-numeric value guaranteed to be unique) will be created.
; Otherwise, the existing VSN will be used.
;
BLDVSN: MOVEI TF,0 ;Clear character count
MOVEI S1,.TMSET ;Get subentry type
STORE S1,ARG.HD(P2),AR.TYP ;Store it
INCR .MECNT(P3) ;Increment subargument count
MOVEI S2,@VSNADR ;Get atring address - ARG.DA
ADD S2,[POINT 7,ARG.DA] ;Get byte pointer to read characters
MOVEI T1,ARG.DA(P2) ;Get storage address
HRLI T1,(POINT 7) ;Make a byte pointer
BLDV.1: ILDB S1,S2 ;Get a character
JUMPE S1,BLDV.2 ;Done ?
PUSHJ P,BLDV.C ;Store it
JRST BLDV.1 ;Loop back for another
BLDV.2: TXNE F,FL.GDV ;Generic device ?
PUSHJ P,BLDV.3 ;Yes - generate a special VSN
MOVX S1,.CHNUL ;Get a <NUL>
PUSHJ P,BLDV.C ;Store it
IDIVI TF,5 ;Count words in the VSN
ADDI TF,ARG.DA+1 ;Round up to the next full word
HRLM TF,(P2) ;Update word count
ADD P2,TF ;Get new first free word pointer
POPJ P, ;Return
BLDV.3: TXNE F,FL.MOU ;If ALLOCATE,,thats an error
SKIPN BATJOB ;If a batch pre-scan,,thats an error
$ERR (<Illegal volume set name specified for MOUNT/ALLOCATE command>)
MOVEI S1,"-" ;Get a funny character
PUSHJ P,BLDV.C ;Store it
$CALL I%NOW ;Get the current time
MOVEI T2,6 ;Only 6 characters
BLDV.4: IDIVI S1,^D36 ;Radix 36
PUSH P,S2 ;Save the remainder
SOSE T2 ;Count characters
PUSHJ P,BLDV.4 ;Recurse if not done
POP P,S1 ;Get a digit
ADDI S1,"0" ;Make it ASCII
CAILE S1,"9" ;A number ?
ADDI S1,"A"-"9"-1 ;No - make it a letter
BLDV.C: IDPB S1,T1 ;Store it
ADDI TF,1 ;Count characters
POPJ P, ;Return
;UNICHK - routine to ensure uniqueness among argument entries
;ACCEPTS S1/ Address of argument header
UNICHK: LOAD T2,ARG.HD(S1),AR.LEN ;Get argument length
MOVE T1,S1 ;Save beginning address
ADDI T2,-1(S1) ;Compute end test address
UNICH1: ADDI T1,1 ;Compute next address
CAML T1,T2 ;Done?
$RETT ;Yes..all are unique
MOVEI S2,1(T1) ;S2 points to comparision entry
MOVE S1,0(T1) ;Get entry to check
UNICH2: CAMLE S2,T2 ;Finished checking this entry?
JRST UNICH1 ;Yes..back for next
CAME S1,0(S2) ;No..is it unique?
AOJA S2,UNICH2 ;Yes..back to check next entry
$RETF ;No..return the failure
;DEVCHK - routine to ensure device string is valid
;ACCEPTS S1/ Pointer to device name string
;RETURNS S1/ Device type (.TYDSK or .TYMTA)
; S2/ Sixbit device name (abbrv of name string)
;ERRORS ER$IDN Invalid device name
; ER$NSD No such device
; ER$USD Unsupported device
; ER$EZD Ersatz device
; ER$PLD Pathological device
; ER$ASN Ambigious structure name
; ER$ISN Illegal structure name
; ER$GDN Generic device name
DEVCHK: $CALL S%SIXB ;Convert to sixbit
ILDB S1,S1 ;Get terminator
JUMPN S1,[$RETER(ER$IDN)] ;Invalid device name
$SAVE <S2,P1,P2,P3> ;Save sixbit for return
MOVE P1,S2 ;Save the device name
MOVE TF,[1,,P1] ;Yes, get DSKCHR parms
DSKCHR TF, ;Get structure status bits
JRST DEVC.1 ;Not a disk
LOAD TF,TF,DC.TYP ;Get the device type
CAXN TF,.DCTAB ;Ambigious?
$RETER(ER$ASN) ;Yes, say so
CAXE TF,.DCTUF ;Unit within strcuture?
CAXN TF,.DCTCN ;Controller class?
$RETER(ER$ISN) ;Yes, illegal structure
CAXE TF,.DCTCC ;Controller class?
CAXN TF,.DCTPU ;Physical unit?
$RETER(ER$ISN) ;Yes, illegal structure
CAXN TF,.DCTDS ;Generic or ersatz?
JRST DEVC.2 ;Yes, check it out some more
MOVX S1,.TYDSK ;Its a disk
$RETT ;And return
DEVC.2: MOVE TF,[3,,P1] ;Get PATH. args
PATH. TF, ;Find out some more
$RETT ;Ignore any error
TXNE P2,PT.DLN!PT.EDA ;Pathological name?
$RETER(ER$PLD) ;Yes, say so
TXNE P2,PT.IPP ;Implied PPN? (ersatz)
$RETER(ER$EZD) ;Yes, say so
$RETER(ER$GDN) ;Else call it generic
DEVC.1: DEVTYP S2, ;Get device type
$RETER(ER$NSD) ;Unknown device
JUMPE S2,[$RETER(ER$NSD)] ;Unknown device
TXNE S2,TY.GEN ;A generic device ?
TXO F,FL.GDV ;Yes - remember it
LOAD S1,S2,TY.DEV ;Load the device type
CAIE S1,.TYMTA ;Is it a tape??
$RETER(ER$USD) ;No,,Unsupported device
;(DSKCHR would win if a disk)
$RETT ;Yes,,return
SUBTTL MOUNT parser -- Data Storage
XLIST ;Turn listing off
LIT ;Dump literals
LIST ;Turn listing on
$DATA DEFSWS,1 ;Sticky mount switches
$DATA VOLCNT,1 ;Number of volume identifiers specifed
$DATA LOGNAM,1 ;Logical name
$DATA FBLK,.FOMAX ;FILOP. UUO block
;Global data
$GDATA VSNAME,1 ;6bit Volume set name
$GDATA VSNDEV,1 ;6 bit device name
$GDATA VSNADR,1 ;Address of ASCIZ Volume set name argnt
$GDATA CMDNAM,1 ;Address of parsed command name
$GDATA BATJOB,1 ;Batch job flag (0 = batch job)
SUBTTL End
END