Trailing-Edge
-
PDP-10 Archives
-
BB-F493Z-DD_1986
-
10,7/batctl.mac
There are 3 other files named batctl.mac 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 12-SEP-85
;
;
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1974,1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1986.
; 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
TOPS10 <.TEXT |,MNTPAR/SEGMENT:LOW|> ;LOAD THE ALLOCATE/MOUNT 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 $ALLOCATE and $MOUNT.............................. 6
; 4.3 $ENDHDR........................................... 7
; 4.4 $STEP............................................. 8
; 5. C$SCAN - Command scanner.................................. 9
; 6. Label logic............................................... 10
; 7. Comment/Vertical motion/User/DDT mode..................... 13
; 8. RDNMOD - Random first character checking.................. 14
; 9. Monitor mode.............................................. 15
; 10. Batch step mode........................................... 16
; 11. C$OPEN - Open the control file............................ 17
; 12. Control file positioning routines......................... 19
; 13. C$DISP - Dispose of control file at EOJ................... 20
; 14. C$CLOS - Close control file............................... 21
; 15. C$READ - Read a line from the control file................ 22
; 16. C$STRT - Find the starting point in the control file...... 23
; 17. C$COPY - Re-copy a command line........................... 24
; 18. Miscellaneous scanner routines............................ 26
; 19. Batch command set up and dispatching...................... 27
; 20. Macros to generate Batch command tables................... 28
; 21. Batch command tables...................................... 29
; 22. Batch commands
; 22.1 BACKTO and GOTO................................... 30
; 22.2 CHKPNT and REQUEUE................................ 31
; 22.3 DUMP.............................................. 32
; 22.4 ERROR and OPERATOR................................ 34
; 22.5 IF................................................ 35
; 22.6 MESSAGE and PLEASE................................ 39
; 22.7 NOERROR, NOOPERATOR, REVIVE, and SILENCE.......... 40
; 23. End....................................................... 41
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))>)
JRST B$ABOR## ;ABORT THE JOB
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 End
END