github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-05 02:34:56 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/galaxy/batcon/batctl.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

2394 lines
73 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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
Reference in New Issue View Git Blame Copy Permalink