Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93e-bb - 7,6/ap018/batctl.x18
There is 1 other file named batctl.x18 in the archive. Click here to see a list.
TITLE	BATCTL	- GALAXY-10 Batch controller control file logic
SUBTTL	C.D.O'Toole, D.P.Mastrovito /CDO/DPM  27-Jul-87


;
;
;	      COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
;     1974,1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1986,1987.
;			ALL RIGHTS RESERVED.
;                    
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.


	SEARCH	BATMAC			;BATCON SYMBOLS
	SEARCH	GLXMAC			;GALAXY SYMBOLS
	SEARCH	QSRMAC			;QUASAR SYMBOLS
	SEARCH	ORNMAC			;ORION SYMBOLS

	PROLOG	(BATCTL)		;SET UP


	%%.BAT==:%%.BAT			;FORCE VERSION INTO SYMBOL TABLE

TOPS10	<IF1,<PRINTX [Assembling GALAXY-10 BATCTL]>>
TOPS20	<IF1,<PRINTX [Assembling GALAXY-20 BATCTL]>>


	.TEXT	|,OPRPAR/SEGMENT:LOW|	;LOAD THE GALAXY PARSER

	GLOB	<JIBTXT>
SUBTTL	Table of contents

;               TABLE OF CONTENTS FOR BATCTL
;
;
;                        SECTION                                   PAGE
;    1. Table of contents.........................................   2
;    2. Batch step header parse tables............................   3
;    3. Batch step header command scanner.........................   4
;    4. Batch step header commands
;         4.1   $ACCOUNT..........................................   5
;         4.2   Simple keywords...................................   6
;         4.3   $TIME.............................................   7
;         4.4   $ALLOCATE and $MOUNT..............................   8
;         4.5   $ENDHDR...........................................   9
;         4.6   $STEP.............................................  10
;    5. C$SCAN - Command scanner..................................  11
;    6. Label logic...............................................  12
;    7. Comment/Vertical motion/User/DDT mode.....................  15
;    8. RDNMOD - Random first character checking..................  16
;    9. Monitor mode..............................................  17
;   10. Batch step mode...........................................  18
;   11. C$OPEN - Open the control file............................  19
;   12. Control file positioning routines.........................  21
;   13. C$DISP - Dispose of control file at EOJ...................  22
;   14. C$CLOS - Close control file...............................  23
;   15. C$READ - Read a line from the control file................  24
;   16. C$STRT - Find the starting point in the control file......  25
;   17. C$COPY - Re-copy a command line...........................  26
;   18. Miscellaneous scanner routines............................  28
;   19. Batch command set up and dispatching......................  29
;   20. Macros to generate Batch command tables...................  30
;   21. Batch command tables......................................  31
;   22. Batch commands
;        22.1   ABORT and STATUS..................................  32
;        22.2   BACKTO and GOTO...................................  33
;        22.3   CHKPNT and REQUEUE................................  34
;        22.4   DUMP..............................................  35
;        22.5   ERROR and OPERATOR................................  37
;        22.6   IF................................................  38
;        22.7   MESSAGE and PLEASE................................  42
;        22.8   NOERROR, NOOPERATOR, REVIVE, and SILENCE..........  43
;   23. MOUNT parser
;        23.1   ALLOCATE and MOUNT command syntax tables..........  44
;        23.2   MOUNT and ALLOCATE option tables..................  45
;        23.3   General routines..................................  56
;        23.4   Data Storage......................................  61
;   24. End.......................................................  62

SUBTTL	Batch step header parse tables


JSP010:	$INIT	(JSP020)
JSP020:	$KEYDSP	(JSP030)
JSP030:	$STAB
IFN FTMODIFY,<	DSPTAB	(ACC010,$ACCT,<ACCOUNT>)>
TOPS10	<	DSPTAB	(ALL010,$ALLOCATE,<ALLOCATE>)>
TOPS20	<	DSPTAB	(,$ALLOCATE,<ALLOCATE>)>
;IFN FTMODIFY,<	DSPTAB	(ASS010,$ASSIST,<ASSISTANCE>)>
;IFN FTMODIFY,<	DSPTAB	(BAT010,$BATLOG,<BATLOG>)>
		DSPTAB	(END010,$ENDHDR,<ENDHDR>)
TOPS10	<	DSPTAB	(MOU010,$MOUNT,<MOUNT>)>
TOPS20	<	DSPTAB	(,$MOUNT,<MOUNT>)>
IFN FTMODIFY,<	DSPTAB	(OUT010,$OUTPUT,<OUTPUT>)>
IFN FTMODIFY,<	DSPTAB	(RES010,$RESTART,<RESTART>)>
		DSPTAB	(STP010,$STEP,<STEP>)
IFN FTMODIFY,<	DSPTAB	(TIM010,$BTIME,<TIME>)>
IFN FTMODIFY,<	DSPTAB	(UNI010,$UNIQUE,<UNIQUE>)>
	$ETAB

ACC010:	$ACCOU	(ACC020,,)
ACC020:	$CRLF

END010:	$CRLF

STP010:	$FIELD	(STP020,,)
STP020:	$CRLF

ASS010:	$KEY	(ASS030,ASS020)
ASS020:	$STAB
	 KEYTAB	(.OPINN,<NO>)
	 KEYTAB	(.OPINY,<YES>)
	$ETAB
ASS030:	$CRLF

BAT010:	$KEY	(BAT030,BAT020)
BAT020:	$STAB
	 KEYTAB	(%BAPND,<APPEND>)
	 KEYTAB	(%BSPOL,<SPOOL>)
	 KEYTAB	(%BSCDE,<SUPERSEDE>)
	$ETAB
BAT030:	$CRLF

OUT010:	$KEY	(OUT030,OUT020)
OUT020:	$STAB
	 KEYTAB	(%EQOLE,<ERROR>)
	 KEYTAB	(%EQOLG,<LOG>)
	 KEYTAB	(%EQONL,<NOLOG>)
	$ETAB
OUT030:	$CRLF

RES010:	$KEY	(RES030,RES020)
RES020:	$STAB
	 KEYTAB	(%EQRNO,<NO>)
	 KEYTAB	(%EQRYE,<YES>)
	$ETAB
RES030:	$CRLF

TIM010:	$TIME	(TIM020)
TIM020:	$CRLF

UNI010:	$KEY	(UNI030,UNI020)
UNI020:	$STAB
	 KEYTAB	(%EQUNO,<NO>)
	 KEYTAB	(%EQUYE,<YES>)
	$ETAB
UNI030:	$CRLF
SUBTTL	Batch step header command scanner


C$STEP::AOS	.JSSTP(R)		;COUNT THE LINE
	$IDENT	(HEADER,<^T/.JSCTL(R)/^A>) ;YES - ECHO STEP HEADER LINE
	ILDB	S1,.JSCTB(R)		;GET THE FIRST CHARACTER
	CAIE	S1,";"			;OLD STYLE COMMENT?
	CAIN	S1,"!"			;NEW STYLE COMMENT?
	$RETT				;YES TO EITHER - RETURN SUCESSFUL
	MOVEI	S1,JSP010		;GET ADDRESS OF PARSE TABLES
	MOVEM	S1,.JSPAR+PAR.TB(R)	;STORE IT
	MOVE	T1,.JSCMD(R)		;GET ADDRESS OF COMMAND BLOCK
	MOVEM	T1,.JSPAR+PAR.CM(R)	;STORE IT
	SETZM	(T1)			;CLEAR THE FIRST WORD FO THE BLOCK
	HRLZI	S1,(T1)			;BUILD BLT POINTER
	HRRI	S1,1(T1)		;SO WE CAN CLEAR THE ENTIRE BLOCK
	BLT	S1,PAGSIZ-1(T1)		;ZAP THE COMMAND BLOCK
	MOVX	S1,COM.SZ-1		;GET INITIAL SIZE OF MESSAGE
	HRLZM	S1,.MSTYP(T1)		;STORE IT
	MOVE	S1,.JSCTB(R)		;GET THE BUFFER POINTER
	MOVEM	S1,.JSPAR+PAR.SR(R)	;TELL THE PARSER
	SETZB	S1,S2			;NO TIMER INTERRUPTS
	PUSHJ	P,P$INIT##		;INIT THE PARSER
	MOVX	S1,PAR.SZ		;GET LENGTH OF PARSE BLOCK
	MOVEI	S2,.JSPAR(R)		;GET ADDRESS OF PARSE BLOCK
	PUSHJ	P,PARSER##		;PARSE THE COMMAND
	  JUMPF	STEP.E			;ANY ERRORS?
	MOVE	T1,.JSCMD(R)		;GET COMMAND BLOCK ADDRESS
	MOVEI	S1,COM.SZ(T1)		;POINT OT THE FIRST BLOCK
	PUSHJ	P,P$SETU##		;SETUP TO EAT THE PARSE BLOCKS
	PUSHJ	P,P$KEYW##		;GET THE PARAMETER KEYWORD
	  JUMPF	STEP.E			;ANY ERRORS?
	PUSHJ	P,(S1)			;DISPATCH
	$RET				;PROPAGATE TRUE/FALSE RETURN BACK


STEP.E:	TXO	R,RL.JIE		;SET JOB IN ERROR
	$IDENT	(BATSSE,<? Step header syntax error - ^T/@PRT.EM(S2)/>)
	$RETF				;RETURN UNSUCESSFUL
SUBTTL	Batch step header commands -- $ACCOUNT


$ACCT:	SKIPN	.JLSTP(R)		;WAS $STEP SEEN?
	$RETF				;NO
	SKIPN	.JBSPS(R)		;DOING ONLY A STEP HEADER SCAN?
	$RETT				;NO - THEN NOTHING TO DO
	PUSHJ	P,B$MODP##		;SET UP MODIFY PAGE
	MOVEI	P1,.MQACT(S1)		;POINT TO START OF ACCOUNT BLOCK
	HRLZI	S1,(P1)			;GET SOURCE ADDRESS
	HRRI	S1,1(P1)		;+1
	SETZM	(P1)			;CLEAR FIRST WORD
	BLT	S1,7(P1)		;CLEAR ENTIRE ACCOUNT STRING BLOCK
	PUSHJ	P,P$ACCT##		;GET AN ACCOUNT STRING
	  $RETIF			;RETURN IF WE COULDN'T
	MOVEI	S1,ARG.DA(S1)		;POINT TO THE ACCOUNT STRING
	HRLI	S1,(P1)			;GET DESTINATION ADDRESS ON LH
	MOVSS	S1			;MAKE A BLT POINTER
	ADDI	S2,-ARG.DA(P1)		;COMPUTE END ADDRESS
	BLT	S1,-1(S2)		;COPY INTO MODIFY BLOCK
	MOVEI	P2,.JQACT(R)		;GET ADDRESS OF ACCOUNT STRING IN THE EQ
	MOVEI	S1,10			;SET UP A COUNTER

ACCT.1:	MOVE	S2,(P1)			;GET A WORD
	CAME	S2,(P2)			;THE SAME?
	JRST	ACCT.2			;NO - CHANGE THE COUNT
	ADDI	P1,1			;+1
	ADDI	P2,1			;+1
	SOJG	S1,ACCT.1		;LOOP FOR ALL WORDS
	$RETT				;Return

ACCT.2:	AOS	.JMODC(R)		;INDICATE NEED FOR MODIFY
	$RETT				;RETURN
	SUBTTL	Batch step header commands -- Simple keywords

$ASSIST:MOVEI	P1,.MQAST
	MOVE	P2,[GETLIM S2,.JQLIM(R),OINT]
	PJRST	STPKEY

$BATLOG:MOVEI	P1,.MQBLG
	MOVE	P2,[GETLIM S2,.JQLIM(R),BLOG]
	PJRST	STPKEY

$OUTPUT:MOVEI	P1,.MQOUT
	MOVE	P2,[GETLIM S2,.JQLIM(R),OUTP]
	PJRST	STPKEY

$RESTART:MOVEI	P1,.MQRST
	MOVE	P2,[GETLIM S2,.JQLIM(R),REST]
	PJRST	STPKEY

$UNIQUE:MOVEI	P1,.MQUNI
	MOVE	P2,[GETLIM S2,.JQLIM(R),UNIQ]
	PJRST	STPKEY


;CALL:
;	P1/ modify page offset
;	P2/ instruction to XCT to load old value into S2
;	PUSHJ	P,STPKEY

STPKEY:	SKIPN	.JLSTP(R)		;WAS $STEP SEEN?
	$RETF				;NO
	SKIPN	.JBSPS(R)		;DOING ONLY A STEP HEADER SCAN?
	$RETT				;NO - THEN NOTHING TO DO
	PUSHJ	P,B$MODP##		;SET UP MODIFY PAGE
	ADDI	P1,(S1)			;ADD IN BASE PAGE
	PUSHJ	P,P$KEYW##		;GET A KEYWORD
	$RETIF				;RETURN IF WE COULDN'T
	XCT	P2			;LOAD THE VALUE
	CAMN	S2,S1			;SEE IF DIFERENT
	 $RETT				;NO CHANGE
	MOVEM	S1,(P1)			;YES--STORE NEW VALUE
	AOS	.JMODC(R)		;INDICATE NEED FOR MODIFY
	$RETT				;RETURN
SUBTTL	Batch step header commands -- $TIME


$BTIME:	SKIPN	.JLSTP(R)		;WAS $STEP SEEN?
	$RETF				;NO
	SKIPN	.JBSPS(R)		;DOING ONLY A STEP HEADER SCAN?
	$RETT				;NO - THEN NOTHING TO DO
	PUSHJ	P,B$MODP##		;SET UP MODIFY PAGE
	MOVEI	P1,.MQTIM(S1)		;SAVE POINTER TO TIME
	PUSHJ	P,P$TIME##		;GET A TIME
	$RETIF				;RETURN IF WE COULDN'T
	TLZ	S1,-1			;REMOVE DATE PART
	MUL	S1,[^D24*^D60*^D60*^D1000];CONVERT
	ASHC	S1,^D17			;POSITION
	IDIVI	S1,^D1000		;MAKE SECONDS
	CAIL	S2,^D500		;NEED TO ROUND?
	 ADDI	S1,1			;YES!
	GETLIM	S2,.JQLIM(R),TIME	;GET TIME
	CAMN	S2,S1			;SEE IF DIFERENT
	 $RETT				;NO CHANGE
	MOVEM	S1,(P1)			;YES--STORE NEW VALUE
	AOS	.JMODC(R)		;INDICATE NEED FOR MODIFY
	$RETT				;RETURN
SUBTTL	Batch step header commands -- $ALLOCATE and $MOUNT


$ALLOCATE:
TOPS10	<SKIPA	P1,[.ALLOC]>		;ALLOCATE ROUTINE ADDRESS


$MOUNT:
TOPS10	<MOVEI	P1,.MOUNT>		;MOUNT ROUTINE ADDRESS
	SKIPE	G$MDA##			;MDA TURNED ON?
	JRST	MOUN.1			;YES
	$IDENT	(BATMDF,<[Mountable device facilities not supported - line ignored]>)
	$RETT				;RETURN

MOUN.1:	SKIPN	.JLSTP(R)		;WAS $STEP SEEN?
	$RETF				;NO
	SKIPN	.JBSPS(R)		;DOING ONLY A STEP HEADER SCAN?
	JRST	MOUN.3			;NO - SEND MDA REQUEST TO THE PTY
	PUSHJ	P,B$MDAP##		;GET MDA PAGE IF WE NEED ONE
	$CALL	M%GPAG			;GET A TEMPORARY PAGE FOR MNTPAR TO USE
	MOVEM	S1,.JMDAT(R)		;STORE PAGE ADDRESS FOR LATER
	PUSHJ	P,(P1)			;DO SOMETHING WITH THE ARGUMENTS
	SKIPT				;ANY ERRORS?
	  JRST	[MOVE	S1,.JMDAT(R)	;GET TEMPORARY PAGE ADDRESS
		 $CALL	M%RPAG		;REMOVE THE PAGE
		 $RETF]			;RETURN UNSUCESSFUL

	MOVE	T1,.JMDAP(R)		;GET MDA PAGE BASE ADDRESS
	MOVE	T2,.JMDAF(R)		;GET MDA PAGE FIRST FREE POINTER
	MOVE	T3,.JMDAT(R)		;GET MNTPAR TEMPORARY PAGE ADDRESS
	LOAD	S1,.MSTYP(T3),MS.CNT	;GET LENGTH OF THIS MESSAGE
	SUBX	S1,.MMHSZ		;STRIP OFF THE MOUNT MESSAGE HEADER
	LOAD	S2,.MSTYP(T1),MS.CNT	;GET LENGTH OF THIS MESSAGE SO FAR
	ADDI	S2,(S1)			;GET NEW TOTAL LENGTH
	CAXG	S2,PAGSIZ		;WILL IT FIT IN A PAGE?
	JRST	MOUN.2			;YES
	$IDENT	(BATTMM,<? Too may ALLOCATE/MOUNT requests to process>)
	$RETF				;RETURN UNSUCESSFUL

MOUN.2:	STORE	S2,.MSTYP(T1),MS.CNT	;STORE NEW TOTAL LENGTH
	HRLI	S2,.MMHSZ(T3)		;MOVE FROM FIRST ME IN MNTPAR PAGE
	HRRI	S2,(T2)			;TO FIRST FREE IN MDA PAGE
	ADDI	T2,(S1)			;COMPUTE NEW FIRST FREE ADDRESS
	MOVEM	T2,.JMDAF(R)		;REMEMBER NEW FIRST FREE LOCATION
	BLT	S2,-1(T2)		;MOVE DATA TO MDA PAGE
	LOAD	S2,.MMARC(T3)		;GET THE NUMBER OF ME'S IN THIS LINE
	ADDM	S2,.MMARC(T1)		;UPDATE MDA PAGE
	MOVE	S1,T3			;GET ADDRESS OF TEMPORARY PAGE
	$CALL	M%RPAG			;REMOVE PAGE
	$RETT				;RETURN SUCESSFUL

MOUN.3:	PUSHJ	P,B$RTYO##		;ECHO THE RESPONSE BUFFER
	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	ILDB	S1,.JSCTB(R)		;EAT THE STEP PROMPT CHARACTER
	PUSHJ	P,B$XFER##		;TRANSFER THE LINE TO THE PTY
	PUSHJ	P,IOWAIT##		;GET RESPONSE
	$RETT				;RETURN SUCESSFUL


; Dummy routines to keep MNTPAR happy
;
CHKMNT::
HELPER::
ERROR::	$RETF
SUBTTL	Batch step header commands -- $ENDHDR


$ENDHDR:
	SKIPN	.JLSTP(R)		;WAS $STEP SEEN?
	$RETF				;NO
	POP	P,(P)			;TRIM STACK
	$IDENT	(HEADER,<[^D/.JSSTP(R)/ lines processed in step ^W/.JLSTP(R)/ header]>)
	TXO	R,RL.DRT		;DELAY THE RESPONSE BUFFER OUTPUT
	PUSHJ	P,B$EOJ##		;PROCESS END OF JOB (STEP) HEADER
	$RETT				;RETURN
SUBTTL	Batch step header commands -- $STEP


$STEP:	SKIPE	.JLSTP(R)		;WAS $STEP ALREADY SEEN?
	 JRST	STPE.0			;YES - CAN'T HAVE THAT
	PUSHJ	P,P$SIXF##		;RETURN A SIXBIT VALUE
	  JUMPF	STPE.1			;ERROR?
	JUMPE	S1,STPE.1		;MAKE SURE WE HAVE ONE
	MOVEM	S1,.JLSTP(R)		;STORE STEP LABEL
	LSH	S1,-^D30		;RIGHT JUSTIFY THE FIRST CHARACTER
	CAIN	S1,'%'			;IS IT A RESERVED LABEL?
	  JRST	STPE.2			;YES - CAN'T HAVE THAT
	PUSHJ	P,P$CFM##		;GET CONFIRMATION
	  JUMPF	STPE.3			;ERROR?
	SKIPN	.JBSPS(R)		;SKIP IF ONLY STEP HEADER SCAN
	$WTOJ	(<Starting step ^W/.JLSTP(R)/>,<^R/.JQJBB(R)/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
	$RETT				;RETURN SUCESSFUL

STPE.0:	$IDENT	(BATMSI,<? Multiple $STEP lines illegal in a single step>)
	$RETF				;RETURN UNSUCESSFUL

STPE.1:	$IDENT	(BATMSL,<? Missing $STEP label>)
	SETOM	.JLSTP(R)		;FAKE OUT ERROR RECOVERY CODE
	$RETF				;RETURN UNSUCESSFUL

STPE.2:	$IDENT	(BATISL,<? Illegal $STEP label>)
	SETOM	.JLSTP(R)		;FAKE OUT ERROR RECOVERY CODE
	$RETF				;RETURN UNSUCESSFUL

STPE.3:	$IDENT	(BATSSE,<? Step header syntax error>)
	$RETF				;RETURN UNSUCESSFUL
SUBTTL	C$SCAN - Command scanner


C$SCAN::TXO	F,FL.LSL		;FORCE LABEL TYPE OUT IF WE FIND ONE
	TXZ	F,FL.SUP!FL.UKJ		;CLEAR EOL SUPRESSION AND USER KJOB
	ILDB	S1,.JSCTB(R)		;GET FIRST CHARACTER
	JUMPE	S1,.POPJ		;RETURN ON NULL LINE
	SETZM	.JPEOL(R)		;CLEAR EOL SENT
	MOVEI	S2,CHRTAB		;POINT TO CHARACTER DISPATCH TABLE

SCAN.1:	SKIPN	(S2)			;END OF TABLE?
	  JRST	SCAN.2			;YES
	HLRZ	T1,(S2)			;GET A CHARACTER
	CAME	S1,T1			;A MATCH?
	  AOJA	S2,SCAN.1		;NO - TRY ANOTHER
	MOVE	T1,(S2)			;GET DISPATCH ADDRESS
	HRRZM	T1,.JSCDP(R)		;STORE IT
	JRST	SCAN.3			;SKIP LABEL CHECKS

SCAN.2:	MOVEI	T1,RNDMOD		;ASSUME RANDOM MODE IF NO LABEL
	MOVEM	T1,.JSCDP(R)		;STORE ADDRESS
	PUSHJ	P,LABEL			;TRY TO GET A LABEL
	  JRST	SCAN.3			;CAN'T
	POPJ	P,			;GOT IT - RETURN

SCAN.3:	TXZ	F,FL.LSL		;CLEAR LABEL TYPE OUT FLAG
	PUSHJ	P,@.JSCDP(R)		;DISPATCH TO PROCESSOR
	  JFCL
	MOVE	S1,.JSCFL(R)		;GET COMMAND FLAGS
	SETZM	.JSCFL(R)		;AND CLEAR FOR NEXT POSSIBLE PASS
	TXNE	S1,BC.CIC		;PARSE COMMAND IN CORE?
	TXO	F,FL.RCL		;YES - REMEMBER TO RE-EAT COMMAND LINE
	POPJ	P,			;RETURN



; Character table
; Format: XWD	character,processor address
;
CHRTAB:	XWD	.CHLFD,VRTMOD		;LINE-FEED
	XWD	.CHVTB,VRTMOD		;VERTICAL-TAB
	XWD	.CHFFD,VRTMOD		;FORM-FEED
	XWD	.CHCRT,CRTMOD		;CARRIAGE-RETURN
	XWD	";",COMENT		;OLD STYLE COMMENT
	XWD	"!",COMENT		;NEW STYLE COMMENT
	XWD	MONCHR,MONMOD		;BATCH OR MONITOR MODE COMMAND
	XWD	STPCHR,STPMOD		;BATCH STEP MODE
	XWD	"*",USRMOD		;USER MODE COMMAND
	XWD	"=",DDTMOD		;DDT MODE COMMAND
	XWD	"%",LABUSR		;RESERVED LABEL
	XWD	0,0			;END TABLE WITH A ZERO WORD
SUBTTL	Label logic


; Here from command scanner top level to parse a label
;
LABEL:	PUSHJ	P,B$SETB##		;RESET BYTE POINTER
	PUSHJ	P,LABINP		;GET A LABEL
	  PJRST	B$SETB##		;CAN'T - RESET BYTE POINTER AND RETURN
	TXO	R,RL.DRT		;DELAY RESPONSE BUFFER OUTPUT
	PUSHJ	P,FLUSH			;FLUSH LEADING TABS AND SPACES
	  JFCL				;ALWAYS SKIPS
	PUSHJ	P,EOLTST		;CHECK FOR EOL
	JRST	LABE.1			;YES - SPECIAL CASE
	PUSHJ	P,BACKUP		;BACKUP THE BYTE POINTER 1 CHARACTER
	PJRST	C$COPY			;RE-COPY COMMAND AND RETURN SUCESSFUL

LABE.1:	PUSHJ	P,B$SETB		;RESET THE BYTE POINTER
	SETZM	.JSCTL(R)		;ZAP THE LINE
	JRST	.POPJ1			;RETURN SUCESSFUL

;[4707]  Input a label into .JLLBL(R) (:: required after label)
;
LABINP:	PUSHJ	P,SIXINP		;READ A SIXBIT WORD
	JUMPE	S1,.POPJ		;HAVE A LABEL?
	MOVE	T1,S1			;COPY LABEL NAME
	PUSHJ	P,TYI			;READ NEXT CHARACTER
	CAIN	S1,":"			;A COLON?
	CAIE	S2,":"			;NEED TWO TO BE A LABEL
	  POPJ	P,			;NOT A LABEL
	CAME	T1,['%FIN  ']		;IS THIS %FIN?
	JRST	LABI.1			;NO
	HRRZ	TF,.JSCDP(R)		;GET COMMAND DISPATCH ADDRESS
	CAIE	TF,.BACKTO		;ARE WE PROCESSING A .BACKTO COMMAND?
	TXO	F,FL.LSL		;NO - TURN ON LISTING OF LINES

LABI.1:	TXNN	F,FL.LSL		;LISTING SKIPPED LINES?
	CAMN	T1,.JLABL(R)		;OR IS THIS THE LABEL WE WANT?
	$IDENT	(LABEL,<^W/T1/::^A>)	;YES TO EITHER - LOG THE LABEL
	MOVEM	T1,.JLLBL(R)		;STORE LAST LABEL ENCOUNTERED
	JRST	.POPJ1			;RETURN SUCESSFUL


; Input a label into .JLABL(R)
;
LABARG:	PUSHJ	P,SIXINP		;READ A SIXBIT WORD
	MOVEM	S1,.JLABL(R)		;STORE IT
	JUMPE	S1,.POPJ		;RETURN IF NO LABEL INPUT


; Check for legal label
;
LABCHK:	LSH	S1,-^D30		;GET THE FIRST CHARACTER
	CAIG	S1,'Z'			;MUST BEGIN WITH A
	CAIGE	S1,'A'			;LETTER FROM A THROUGH Z
	JRST	LABERR			;NO GOOD
	POPJ	P,			;RETURN
; Search for %CERR or %ERR after user error occured
;
LABUSR::TXO	F,FL.LSL		;LIST SKIPPED LINES
	TXZ	F,FL.FIN		;WE CAN'T SKIP OVER A %FIN
	TXNN	R,RL.JIE		;JOB IN ERROR?
	  JRST	LABFIN			;YES - SEARCH FOR %FIN

TOPS10	<				;TOPS-10 ONLY
	HRL	S1,J			;GET JOB NUMBER
	HRRI	S1,.GTLIM		;BATCH TIME LIMIT TABLE
	GETTAB	S1,			;GET LIMIT WORD
	  SKIPA				;CAN'T
	TXNE	S1,JB.LSY		;PROGRAM COME FROM PHYSICAL SYS:?
	SKIPA	S1,['%CERR ']		;YES - USER %CERR LABEL
>					;END OF TOPS10 CONDITIONAL

	MOVX	S1,'%ERR  '		;NO - USE %ERR LABEL
	MOVEM	S1,.JLABL(R)		;STORE IT
	PUSHJ	P,LABSRC		;SEARCH FOR THE APPROPRIATE LABEL
	TXZ	R,RL.JIE		;CLEAR JOB IN ERROR CONDITION
	POPJ	P,			;RETURN


; Search for %FIN
;
LABFIN::SKIPA	S1,['%FIN  ']		;GET LABEL TO SEARCH FOR


; Search for %TERR
;
LABTER::MOVX	S1,'%TERR '		;GET LABEL TO SEARCH FOR
	MOVEM	S1,.JLABL(R)		;STORE IT AND FALL INTO LABSRC
	TXO	F,FL.LSL		;LIST SKIPPED LINES
	TXZ	F,FL.FIN		;WE CAN'T SKIP OVER A %FIN
					;FALL INTO LABSRC
; Search for the label stored in .JLABL(R)
;
LABSRC::SETZM	G$FAIR##		;INITIALIZE FAIRNESS COUNT
	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	JRST	LABS.2			;SKIP INITIAL CALL TO C$READ

LABS.1:	PUSHJ	P,C$READ		;READ A LINE FROM THE CONTROL FILE
	  JUMPF	LABEOF			;END OF FILE?

LABS.2:	PUSHJ	P,LABEL			;TRY TO INPUT A LABEL
	  JRST	LABS.4			;CAN'T
	MOVE	S1,.JLLBL(R)		;GET LABEL JUST FOUND
	CAXN	S1,<'%FIN  '>		;SPECIAL %FIN LABEL?
	JRST	LABS.5			;YES
	CAMN	S1,.JLABL(R)		;FOUND WHAT WE WANT?
	POPJ	P,			;YES - RETURN

LABS.4:	TXNE	F,FL.LSL		;LISTING SKIPPED LINES?
	$IDENT	(IGNORE,<^T/.JSCTL(R)/^A>) ;YES - DO IT
	AOS	S1,G$FAIR##		;COUNT THE LINE
	CAXGE	S1,CTLFCT		;EXCEEDED FAIRNESS COUNT?
	JRST	LABS.1			;TRY ANOTHER LINE
	AOS	G$FFLG##		;REMEMBER FAIRNESS COUNT EXPIRED
	PUSHJ	P,QTS##			;ON TO THE NEXT STREAM
	SETZM	G$FAIR##		;RESET COUNTER
	JRST	LABS.1			;TRY ANOTHER LINE

LABS.5:	TXNE	F,FL.FIN		;ALLOWED TO SKIP OVER %FIN?
	JRST	LABS.1			;YES - KEEP SEARCHING
	CAME	S1,.JLABL(R)		;FOUND %FIN WHILE SEARCHING FOR %FIN?
	$IDENT	(BATFFS,<[Found %FIN while searching for ^W/.JLABL(R)/ - proceeding from %FIN]^A>)
	PUSHJ	P,B$DUMP##		;SEE IS A CLOSE/DUMP IS REQUIRED
	POPJ	P,			;NOPE


LABEOF:	MOVE	S1,.JLABL(R)		;GET LABEL WE'RE SEARCHING FOR
	CAMN	S1,['%TERR ']		;TIME LIMIT EXCEEDED?
	$WTOJ	(<Batch error>,<^I/JIBTXT/^I/LABTX1/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
	$IDENT	(BATECF,<? ^I/LABTX2/>)	;LOG EOF ERROR
	TXO	F,FL.TXT		;MESSAGE TEXT AVAILABLE
	MOVE	S1,.JLABL(R)		;GET LABEL AGAIN
	CAME	S1,['%TERR ']		;CHECK AGAIN
	SKIPA	S1,[[ASCIZ ||]]		;NULL TEXT
	MOVEI	S1,[ASCIZ |Time limit exceeded; |]
	$TEXT	(<-1,,.JWTOP(R)>,<^T/(S1)/Label ^W/.JLABL(R)/ not found^0>)
	PJRST	CLOSJB##		;DISMISS THE JOB

LABTX1:	ITEXT	(<Time limit exceeded; end of control file while searching for label %TERR>)
LABTX2:	ITEXT	(<End of control file while searching for label ^W/.JLABL(R)/>)
SUBTTL	Comment/Vertical motion/User/DDT mode


; Put comments into the log file
;
COMENT:	TXO	R,RL.DRT		;DELAY RESPONSE BUFFER OUTPUT
	$IDENT	(COMENT,<^T/.JSCTL(R)/^A>)
	JRST	.POPJ1			;RETURN SUCESSFUL


; Here on vertical motion characters
;
VRTMOD:	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	TXNN	J,JL.UML		;JOB AT USER LEVEL?
	JRST	USRMOD			;NOPE
	TXZ	F,FL.SUP		;CLEAR EOL SUPRESSION
	ILDB	S1,.JSCTB(R)		;GET THE VERTICAL MOTION CHARACTER
	PUSHJ	P,L$PLOG##		;LOG IT
	SETZM	.JLTIM(R)		;CLEAR TIME STAMP NEEDED FLAG
	TXO	R,RL.DRT		;DELAY RESPONSE BUFFER OUTPUT
	JRST	.POPJ1			;RETURN SUCESSFUL


; Here on carriage returns
;
CRTMOD:	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER


; Send a line of user data
;
USRMOD:	TXZA	F,FL.SUP		;CLEAR EOL SUPRESSION


; DDT mode (suppress EOL characters)
;
DDTMOD:	TXO	F,FL.SUP		;SET EOL SUPPRESSION
	TXNN	R,RL.JIE		;IS JOB IN ERROR?
	TXNE	J,JL.UML		;JOB AT MONITOR LEVEL?
	  PJRST	IGNORE			;YES - IGNORE THE LINE
	TXZE	R,RL.DRT		;WAS RESPONSE BUFFER OUTPUT DELAYED?
	PUSHJ	P,B$RTYO		;YES - OUTPUT IT NOW
	PUSHJ	P,B$XFER##		;SEND DATA TO THE PTY
	TXZ	F,FL.SUP		;MAKE EOL SUPRESSION IS OFF
	JRST	.POPJ1			;RETURN SUCESSFUL


; Here when a job is at monitor level and a user level line is given
;
IGNORE:	TXO	R,RL.DRT		;DELAY RESPONSE BUFFER OUTPUT
	$IDENT	(IGNORE,<^T/.JSCTL(R)/^A>)
	JRST	.POPJ1			;RETURN SUCESSFUL
SUBTTL	RDNMOD - Random first character checking


RNDMOD:	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	LDB	S1,[POINT 7,.JSCTL(R),6] ;GET THE FIRST CHARACTER
	CAIG	S1,"Z"			;CHECK FOR ALPHA
	CAIGE	S1,"A"
	  SKIPA				;NO MATCH
	JRST	RNDM.1			;YES
	CAIG	S1,"Z"+40		;CHECK FOR LOWER CASE ALPHA
	CAIGE	S1,"A"+40
	  JRST	USRMOD			;NO MATCH - TREAT AS USER MODE

RNDM.1:	TXNN	J,JL.UML		;USER MODE?
	JRST	RNDM.2			;YES - THEN SEND LINE TO JOB
	PUSHJ	P,BATSET		;TRY TO SET UP A BATCH COMMAND
	JUMPT	BATPRC			;GOT ONE - GO PROCESS IT

RNDM.2:	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	TXNE	R,RL.JIE		;JOB IN ERROR?
	JRST	RNDM.3			;YES - MAKE SPECIAL CHECKS
	TXZ	J,JL.UML		;FAKE OUT USRMOD BY CLEAING FLAG
	JRST	USRMOD			;TREAT LINE AS USER DATA

RNDM.3:	TXNE	J,JL.UML		;AT MONITOR LEVEL?
	JRST	LABUSR			;YES - SEARCH FOR ERROR PACKETS
	JRST	IGNORE			;NO - IGNORE THE LINE
SUBTTL	Monitor mode


; Here on a Batch or monitor mode command
;
MONMOD:	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	ILDB	S1,.JSCTB(R)		;EAT THE FIRST CHARACTER
	PUSHJ	P,FLUSH			;GET THE NEXT CHARACTER
	  JFCL				;ALWAYS SKIPS

IFE <MONCHR-".">,<			;IF MONITOR PROMPT IS A PERIOD
	CAIG	S1,"9"			;CHECK FOR A DIGIT
	CAIGE	S1,"0"			;A FLOATING POINT NUMBER IS USER DATA
	  SKIPA				;NO MATCH
	JRST	MONM.2			;SEND LINE IN USER MODE
>					;END OF IFE <MONCHR-"."> CONDITIONAL

	CAIG	S1,"Z"			;CHECK FOR UPPER CASE ALPHA
	CAIGE	S1,"A"
	  SKIPA				;NO MATCH
	JRST	MONM.1			;COULD BE A BATCH OR MONITOR COMMAND
	CAIGE	S1,"Z"+40		;CHECK FOR LOWER CASE ALPHA
	CAIGE	S1,"A"+40
	  JRST	MONCMD			;NO MATCH

MONM.1:	PUSHJ	P,BACKUP		;BACKUP THE BYTE POINTER ONE CHARACTER
	PUSHJ	P,BATSET		;SET UP BATCH COMMAND IF POSSIBLE
	JUMPT	BATPRC			;PROCESS COMMAND IF NO ERRORS
	TXNE	R,RL.JIE		;JOB IN ERROR?
	  JRST	LABUSR			;YES - LOOK FOR ERROR PACKETS
	JRST	MONCMD			;SEND THE LINE TO THE MONITOR

MONM.2:	TXNE	R,RL.JIE		;IS THE JOB IN ERROR?
	  JRST	LABUSR			;YES - SEARCH FOR ERROR PACKETS
	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	JRST	USRMOD			;SEND THE LINE AT USER MODE

MONCMD:	TXNN	J,JL.UDI		;CAN JOB DO REAL INPUT?
	POPJ	P,			;NO - DON'T FORCE IT TO MONITOR MODE
	PUSHJ	P,B$SETB##		;YES - RESET THE BYTE POINTER
	TXNE	J,JL.UDI		;CAN JOB DO REAL INPUT?
	JRST	MONM.3			;YES - GO DO IT
	TXO	F,FL.RCL		;NO - RE-EAT THE COMMAND LINE
	POPJ	P,			;DON'T FORCE TO MONITOR MODE AFTER ALL

MONM.3:	LDB	S1,[POINT 7,.JSCTL(R),6] ;GET THE FIRST CHARACTER
	CAXN	S1,MONCHR		;A NORMAL LINE?
	ILDB	S1,.JSCTB(R)		;YES - EAT THE PROMPT CHARACTER
	TXZE	R,RL.DRT		;WAS RESPONSE BUFFER OUTPUT DELAYED?
	PUSHJ	P,B$RTYO		;YES - OUTPUT IT NOW
	PUSHJ	P,P$STOP##		;PUT THE JOB IN MONITOR MODE
	SKIPE	.JLTIM(R)		;DO WE NEED A TIME STAMP?
	 TXNE	F,FL.SIL		;YES - SUBJOB SILENCED?
	  SKIPA				;DON'T DO THE TIME STAMP
	   PUSHJ P,L$LSTP##		;INCLUDE THE TIME STAMP
	PJRST	B$XFER##		;TRANSFER THE LINE TO THE PTY
SUBTTL	Batch step mode


STPMOD:	AOSN	.JSSPP(R)		;IS STEP PROCESSING PENDING?
	JRST	STPM.1			;YES
	$IDENT	(HEADER,<^T/.JSCTL(R)/>) ;FAKE A LINE IN THE CONTROL FILE
	$IDENT	(BATMOS,<? More than one job step encountered - job canceled>)
	JRST	CLOSJB##		;DISMISS THE JOB

STPM.1:	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	TXO	R,RL.DRT		;DELAY THE RESPONSE BUFFER OUTPUT
	PUSHJ	P,STPPRC##		;CALL THE JOB STEP PROCESSOR
	PUSHJ	P,B$RTYO##		;OUTPUT THE RESPONSE BUFFER
	$RETT				;RETURN SUCESSFUL
SUBTTL	C$OPEN - Open the control file


C$OPEN::TXNE	F,FL.KST		;KSYS STREAM?
	POPJ	P,			;RETURN
	MOVEI	S1,.JQCFD(R)		;GET FD FOR CTL
	MOVEM	S1,.JCFOB+FOB.FD(R)	;STORAGE AREA
	MOVX	S1,FB.LSN		;NO LINE SEQ NUMBERS
	ADDI	S1,7			;PLACE BYTE SIZE IN S1
	MOVEM	S1,.JCFOB+FOB.CW(R)	;SAVE CONTROL WORD
	MOVX	S1,FP.SPL		;GET THE SPOOLED BIT
	TDNE	S1,.JQCFP+.FPINF(R)	;/DISP:REN?
	JRST	OPEN.1			;YES

TOPS10	<
	MOVE	S1,.JQPPN(R)		;GET PPN FOR USER
	MOVEI	S2,0			;MAKE ZERO FOR CONSISTENCY
>;END TOPS10

TOPS20	<
	HRROI	S1,.JQNAM(R)		;USER NAME FROM CREATE
	HRROI	S2,.JQCON(R)		;CONNECTED DIRECTORY
>;END TOPS20

	MOVEM	S1,.JCFOB+FOB.US(R)	;SAVE USER IN BEHALF
	MOVEM	S2,.JCFOB+FOB.CD(R)	;SAVE IN FOB
	MOVEI	S1,FOB.SZ		;SIZE OF THE BLOCK
	MOVX	T1,EQ.PRV		;GET PRIVILEGE FLAG
	TDNE	T1,.JQJBB+JIB.SQ(R)	;WAS IT SET

OPEN.1:	MOVEI	S1,FOB.MZ		;NO IN BEHALF NEEDED
	MOVEI	S2,.JCFOB(R)		;ADDRESS OF THE BLOCK
	$CALL	F%IOPN			;OPEN THE FILE
	  JUMPF	FNDC.E			;ERROR EXIT
	MOVEM	S1,.JCIFN(R)		;Save IFN
	POPJ	P,			;Return
; Fix up CTL filespec (remove generation number)
;
C$FILE::
TOPS10	<POPJ	P,>			;NOT NEEDED FOR TOPS-10
TOPS20	<				;TOPS-20 ONLY
	MOVX	S1,GJ%SHT		;SHORT FORM
	HRROI	S2,.JQCFD+.FDSTG(R)	;POINT TO FILESPEC
	GTJFN				;GET A JFN
	  POPJ	P,			;CAN'T
	MOVE	S2,S1			;COPY THE JFN
	HRROI	S1,.JQCFD+.FDSTG(R)	;POINT TO THE FILESPEC
	MOVE	T1,[1B2+1B5+1B8+1B11+JS%PAF] ;GET SOME FLAGS
	JFNS				;EXTRACT ALL BUT THE GENERATION NUMBER
	  ERJMP	.+1			;CAN'T
	MOVE	S1,S2			;GET THE JFN
	RLJFN				;RELEASE IT
	  JFCL				;IGNORE ERRORS
	POPJ	P,			;RETURN
>					;END OF TOPS-20 CONDITIONAL


; Here on CTL file open errors
;
FNDC.E:	$IDENT	(BATCFE,<Control file error for ^F/.JQCFD(R)/ - ^E/[-1]/>)
	$IDENT	(BATBJC,<[Batch job has been canceled]>)
	SETZM	.JLTIM(R)		;NO TIME STAMP
	JRST	B$ABOR##		;ABORT THE JOB
SUBTTL	Control file positioning routines


; Save the current position in the control file
;
C$SPOS::SKIPN	S1,.JCIFN(R)		;IS CTL FILE OPEN?
	JRST	SPOS.1			;NO - DO IT NOW
	$CALL	F%CHKP			;TAKE CHECKPOINT
	  JUMPF	POSERR			;CAN'T
	MOVEM	S1,.JCPOS(R)		;SAVE RELATIVE POSITION
	POPJ	P,			;RETURN TO PROCESSING

SPOS.1:	PUSHJ	P,C$OPEN		;OPEN THE CTL FILE
	SETZM	.JCPOS(R)		;POSITION TO BEGINNING
	POPJ	P,			;RETURN TO MAINLINE


; Reposition to saved location in the CTL file
;
C$RPOS::SKIPN	S1,.JCIFN(R)		;GET IFN (UNLESS NOT OPENED)
	PJRST	SPOS.1			;GO OPEN FILE AND RETURN
	MOVE	S2,.JCPOS(R)		;GET RELATIVE POSITION
	$CALL	F%POS			;POSITION FILE TO PROPER PLACE
	  JUMPF	POSERR			;CAN'T
	POPJ	P,			;RETURN


; Rewind the control file
;
C$ZPOS::MOVE	S1,.JCIFN(R)		;GET IFN
	MOVEI	S2,.-.			;BYTE 0
	$CALL	F%POS			;REWIND THE FILE
	  JUMPF	POSERR			;CAN'T
	POPJ	P,			;RETURN


; Here on positioning errors
;
POSERR:	$WTO	(<Batch error>,<^R/.JQJBB(R)/^I/POSTXT/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
	$RETF				;RETURN FAILURE

POSTXT:	ITEXT	(<
Control file positioning error ^E/[-1]/ for file ^F/.JQCFD(R)/; job canceled>)
SUBTTL	C$DISP - Dispose of control file at EOJ


C$DISP::TXNE	F,FL.PST!FL.KST		;PRESCAN OR KSYS STREAM?
	POPJ	P,			;YES
	MOVX	S2,FP.DEL!FP.REN	;GET /DISP:DEL AND /DISP:REN
	SKIPE	S1,.JCIFN(R)		;IS THE FILE OPENED?
	TDNN	S2,.JQCFP+.FPINF(R)	;WANT TO DELETE FILE?
	  POPJ	P,			;NO - RETURN
	$CALL	F%DREL			;RELEASE AND DELETE FILE
	SETZM	.JCIFN(R)		;MARK THE IFN CLOSED
	POPJ	P,			;RETURN
SUBTTL	C$CLOS - Close control file


C$CLOS::TXNN	F,FL.KST		;KSYS STREAM?
	SKIPN	S1,.JCIFN(R)		;IS THE FILE OPENED?
	POPJ	P,			;NO - RETURN
	$CALL	F%REL			;RELEASE CONTROL FILE
	SETZM	.JCIFN(R)		;MARK THE IFN CLOSED
	SKIPT				;ERRORS CLOSING CHANNEL OR JFN?
	$WTO	(<Batch error>,<^R/.JQJBB(R)/^I/CLSTXT/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
	POPJ	P,			;RETURN


CLSTXT:	ITEXT	(<^M^JErrors closing ^F/.JQCFD(R)/>)
SUBTTL	C$READ - Read a line from the control file


C$READ::PUSHJ	P,B$CINI##		;INITIALIZE THE COMMAND BUFFER

READ.1:	PUSHJ	P,GETCHR		;READ A CHARACTER FROM THE CONTROL FILE
	  JUMPF	READ.5			;EOF
	CAIE	S1,"^"			;WAS IT AN UP-ARROW?
	JRST	READ.3			;NO
	PUSHJ	P,GETCHR		;YES - GET ANOTHER CHARACTER
	  JUMPF	READ.5			;EOF
	CAIN	S1,"^"			;ANOTHER UP-ARROW?
	JRST	READ.3			;YES - THEN USE IT
	CAIG	S1,"Z"+40		;NEED TO CONVERT
	CAIGE	S1,"A"+40		; TO LOWER CASE?
	  SKIPA				;NO
	SUBI	S1," "			;YES - DO IT
	CAIG	S1,"_"			;CAN THIS CHARACTER BE
	CAIGE	S1,"A"			; A CONTROL CHARACTER?
	  JRST	READ.2			;NO - SEND UP-ARROW AND NEW CHARACTER
	TRZ	S1,"@"			;YES - CONVERT IT
	JRST	READ.3			;SEND CONTROL CHARACTER

READ.2:	PUSH	P,S1			;SAVE SECOND CHARACTER
	MOVEI	S1,"^"			;GET AN UP-ARROW
	PUSHJ	P,B$CPUT##		;SEND THE UP-ARROW
	  JUMPF	READ.4			;BUFFER MUST BE FULL
	POP	P,S1			;RESTORE CHARACTER

READ.3:	PUSHJ	P,B$CPUT##		;STORE THE CHARACTER
	  JUMPF	READ.4			;BUFFER MUST BE FULL
	CAXG	S1,.CHFFD		;CHECK FOR A LINE TERMINATOR
	CAXGE	S1,.CHLFD		;CAN BE <LF>, <VT>, OR <FF>
	JRST	READ.1			;LOOP FOR MORE
	MOVX	S1,.CHNUL		;GET A <NUL>
	PUSHJ	P,B$CPUT##		;TERMINATE STRING
	PUSHJ	P,B$SETB##		;SET UP THE BYTE POINTER
	LDB	S1,[POINT 7,.JSCTL(R),6] ;GET THE FIRST CHARACTER IN THE LINE
	$RETT				;RETURN WITH TEXT IN .JSCTL(R)

READ.4:	$IDENT	(BATLEL,<? Control file line exceeds ^D/[CTLSIZ]/ characters, job canceled^A>)
	JRST	CLOSJB##		;DISMISS THE JOB

READ.5:	SKIPE	.JSCTL(R)		;DID WE GET A PARTIAL LINE?
	$IDENT	(BATILL,<% Incomplete last line in control file>)
	$RETF				;RETURN UNSUCESSFUL
SUBTTL	C$STRT - Find the starting point in the control file


C$STRT::SKIPN	S1,.JBCRQ+1(R)		;GET STARTING PARAMETER
	  MOVE	S1,.JQCFP+.FPFST(R)	;GET /BEGIN OR /TAG VALUE (NO CHKPNT)
	TLNN	S1,777777		;IS IT A RESTART LABEL?
	  JRST	STRT.1			;NO - TRY A LINE NUMBER
	MOVEM	S1,.JLABL(R)		;SAVE FOR LABEL SEARCH
	$IDENT	(BATBLA,<[Beginning processing at label ^W/.JLABL(R)/]^A>)
	PUSHJ	P,LABCHK		;CHECK FOR LEGAL LABEL
	TXO	R,RL.DRT		;DELAY RESPONSE BUFFER OUTPUT
	TXO	F,FL.FIN		;THIS SEARCH MAY SKIP %FIN LABEL
	PUSHJ	P,LABSRC		;SEARCH FOR THE LABEL
	TXO	F,FL.RCL		;RE-EAT THE COMMAND LINE
	POPJ	P,			;RETURN

STRT.1:	CAIG	S1,1			;IS THE STARTING LINE GREATER THAN 1?
	POPJ	P,			;NO - JUST A NORMAL START
	MOVEM	S1,.JLABL(R)		;STORE LINE COUNT
	$IDENT	(BATBLI,<[Beginning processing at line ^D/.JLABL(R)/]^A>)
	TXO	R,RL.DRT		;DELAY RESPONSE BUFFER OUTPUT

STRT.2:	SOSG	.JLABL(R)		;DID WE EAT ENOUGH LINES YET?
	POPJ	P,			;YES
	PUSHJ	P,C$READ		;NO - READ A LINE
	  SKIPF				;EOF?
	JRST	STRT.2			;GO BACK FOR MORE
	SKIPN	S1,.JBCRQ+1(R)		;GET STARTING PARAMETER
	MOVE	S1,.JQCFP+.FPFST(R)	;GET /BEGIN OR /TAG VALUE (NO CHKPNT)
	$IDENT	(BATECF,<? End of control file while searching for line ^D/S1/>)
	PJRST	CLOSJB##		;DISMISS JOB
SUBTTL	C$COPY - Re-copy a command line


; This routine will copy a portion of a command back into the command buffer
; using .JSCTB(R) as a pointer to the first character and terminating on a
; <NUL>. After the copy is completed, .JSCTB(R) will be reset to the start of
; the command buffer and FL.RCL in AC 'F' (re-eat command line) will be turned
; on so that the next command scan will use the command in core.
;
C$COPY:	MOVE	S1,[POINT 7,.JSCTL(R)]	;POINT TO START OF THE COMMAND BUFFER

COPY.1:	ILDB	S2,.JSCTB(R)		;GET A CHARACTER
	IDPB	S2,S1			;PUT A CHARACTER
	JUMPN	S2,COPY.1		;LOOP BACK
	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	TXO	F,FL.RCL		;REMEMBER TO RE-EAT THE COMMAND
	JRST	.POPJ1			;Return sucessful
; Read a character from the control file
;
GETCHR:	SKIPN	S1,.JCIFN(R)		;IS CONTROL FILE OPEN?
	PUSHJ	P,C$OPEN		;NO - OPEN IT NOW
	$CALL	F%IBYT			;READ A BYTE
	  JUMPF	GETC.E			;PROCESS ERROR
	JUMPE	S2,GETCHR		;FLUSH <NUL>
	MOVE	S1,S2			;PUT CHARACTER IN A BETTER PLACE
	$RETT				;RETURN SUCESSFUL

GETC.E:	SKIPN	.JBSPS(R)		;DOING ONLY A STEP HEADER SCAN?
	CAXN	S1,EREOF$		;WAS IT EOF?
	$RETF				;YES - JUST RETURN FALSE
	$IDENT	(BATCFE,<? ^I/CTLTXT/>)
	$IDENT	(BATBJC,<[Batch job has been canceled]>)
	$WTOJ	(<Batch error>,<^R/.JQJBB(R)/^M^J^I/CTLTXT/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
	JRST	CLOSJB##		;DISMISS JOB

CTLTXT:	ITEXT	(<Control file error for ^F/.JQCFD(R)/ - ^E/[-1]/>)
SUBTTL	Miscellaneous scanner routines


; Get a character from the text buffer
;
; On return, S1 will contain a character. The following will have
; happened:
;	a) All nulls stripped out
;	b) Carriage returns ignored
;	c) Lower case converted to upper case
;
TYI::	ILDB	S1,.JSCTB(R)		;LOAD A CHARACTER
	JUMPE	S1,TYI			;IGNORE <NUL>
	CAXN	S1,.CHCRT		;<CR>?
	JRST	TYI			;YES - IGNORE IT
	CAXN	S1,.CHTAB		;<TAB>?
	MOVEI	S1," "			;YES - CONVERT TO A SPACE
	CAIG	S1,"Z"+40		;CHECK FOR A LOWER CASE
	CAIGE	S1,"A"+40		; CHARACTER THAT NEEDS TO BE
	  SKIPA				;  CONVERTED TO AN UPPER CASE
	TRZ	S1," "			;   CHARACTER
	POPJ	P,			;RETURN


; Test for End Of Line
; Returns .POPJ1 if no EOL, .POPJ if EOL
;
EOLTST:	CAIG	S1,.CHFFD		;CHECK FOR <LF>, <VT>
	CAIGE	S1,.CHLFD		; OR <FF>
	SKIPA				;NOT EOL
	POPJ	P,			;RETURN
	CAIE	S1,.CHBEL		;BELL
	CAIN	S1,.CHCNZ		;CONTROL-Z
	POPJ	P,			;EOL
	CAIE	S1,.CHESC		;ESCAPE
	CAIN	S1,.CHCNC		;CONTROL-C
	POPJ	P,			;EOL
	JRST	.POPJ1			;NOT EOL


; Flush leading spaces and tabs (always returns .POPJ1)
;
FLUSH:	PUSHJ	P,TYI			;GET A CHARACTER
	CAIN	S1," "			;SPACE?
	JRST	FLUSH			;YES - EAT IT
	JRST	.POPJ1			;SKIP ALWAYS


; Back up the text byte pointer 1 character
;
BACKUP:	MOVE	S1,.JSCTB(R)		;GET THE BYTE POINTER
	ADD	S1,[XWD	70000,0]	;BACK UP 1 CHARACTER
	SKIPG	S1			;OVER A WORD BOUNDRY?
	SUB	S1,[XWD	430000,1]	;YES - ADJUST POINTER
	MOVEM	S1,.JSCTB(R)		;STORE NEW BYTE POINTER
	LDB	S1,.JSCTB(R)		;LOAD THE PREVIOUS CHARACTER
	POPJ	P,			;RETURN


; Input a sixbit word into S1, terminating character into S2
;
; Destroys ACs T1 and T2
;
SIXINP:	MOVE	T1,[POINT 6,T2]		;BYTE POINTER TO STORE WORD
	SETZB	S2,T2			;CLEAR COUNTER AND DESTINATION
	PUSHJ	P,FLUSH			;EAT LEADING SPACES AND TABS

SIXI.1:	PUSHJ	P,TYI			;GET A CHARACTER
	CAIN	S1,"%"			;SPECIAL CHECK
	JRST	SIXI.2			;GO STORE IT
	CAIL	S1,"0"			;RANGE CHECK THE CHARACTER
	CAILE	S1,"9"
	CAIL	S1,"A"
	CAILE	S1,"Z"
	JRST	SIXI.3			;NO MATCH - FINISH UP

SIXI.2:	CAIL	S2,6			;TOO MANY CHARACTERS?
	  JRST	SIXI.1			;YES - IGNORE THE REST
	SUBI	S1," "			;CONVERT TO SIXBIT
	IDPB	S1,T1			;STORE CHARACTER
	AOJA	S2,SIXI.1		;LOOP FOR MORE

SIXI.3:	MOVE	S2,S1			;SAVE TERMINATING CHARACTER
	MOVE	S1,T2			;GET RESULTS
	POPJ	P,			;RETURN


; Input a keyword into the address pointed to by S1
; Call:	MOVE	S1,address to store string
;	MOVE	S2,maximum length of string
;	PUSHJ	P,KEYINP
;	<return>
;
; On return, S1 will contain the terminating character and S2 the number
; of characters input. ACs T1, T2, and T3 are destroyed.
;
KEYINP:	DMOVE	T1,S1			;GET ARGUMENTS
	HRLI	T1,(POINT 7)		;MAKE A BYTE POINTER
	SETZ	T3,			;CLEAR CHARACTER COUNT
	PUSHJ	P,FLUSH			;EAT LEADING TABS AND SPACES

KEYI.1:	PUSHJ	P,TYI			;GET A CHARACTER
	CAIN	S1,"%"			;SPECIAL CHECK
	JRST	KEYI.2			;GO STORE IT
	CAIL	S1,"0"			;RANGE CHECK THE CHARACTER
	CAILE	S1,"9"
	CAIL	S1,"A"
	CAILE	S1,"Z"
	JRST	KEYI.3			;NO MATCH - GO FINISH UP

KEYI.2:	CAML	T3,T2			;IS THERE ROOM IN THE BUFFER?
	JRST	KEYI.1			;NO - IGNORE IT
	IDPB	S1,T1			;STORE CHARACTER
	AOJA	T3,KEYI.1		;NO - LOOP

KEYI.3:	CAXE	S1,.CHTAB		;A TAB?
	CAIN	S1," "			;OR A SPACE?
	SKIPA				;YES TO EITHER
	PUSHJ	P,BACKUP		;NOPE - BACKUP 1 CHARACTER
	MOVX	S2,.CHNUL		;GET A <NUL>
	IDPB	S2,T1			;STORE IT
	MOVE	S2,T3			;GET CHARACTER COUNT
	POPJ	P,			;RETURN
SUBTTL	Batch command set up and dispatching


; Set up a Batch command
;
BATSET:	MOVEI	S1,.JSKEY(R)		;ADDRESS TO STORE KEYWORD
	MOVEI	S2,^D10			;MAXIMUM NUMBER OF CHARACTERS
	PUSHJ	P,KEYINP		;INPUT A KEYWORD
	MOVEI	S1,BATCMD		;POINT TO COMMAND TABLE
	MOVEI	S2,.JSKEY(R)		;POINT TO KEYWORD
	$CALL	S%TBLK			;SEARCH THE TABLE
	TXNN	S2,TL%ABR!TL%EXM	;ABBREVIATION OR EXACT MATCH?
	  $RETF				;NOPE
	LDB	TF,[POINT 7,.JSKEY(R),13] ;GET SECOND CHARACTER OF COMMAND
	TXNE	S2,TL%ABR		;ABBREVIATED COMMAND?
	JUMPE	TF,.RETF		;AND MUST BE NON-ZERO OR THATS ILLEGAL
	HRRZ	S2,(S1)			;GET TABLE INDEX
	MOVE	S1,BATDSP(S2)		;GET THE FLAGS AND DISPATCH ADDRESS
	HRRZM	S1,.JSCDP(R)		;STORE IT
	HLLZM	S1,.JSCFL(R)		;STORE FLAGS
	TXNE	S1,BC.KJB		;SPECIAL KJOB PROCESSING?
	TXO	F,FL.UKJ		;REMEMBER USER REQUESTED KJOB
	TXNN	S1,BC.ERR		;IS COMMAND LEGAL IF JOB IN ERROR?
	TXNN	R,RL.JIE		;NOT VALID, IS THE JOB IN ERROR?
	$RETT				;NO - RETURN SUCESSFUL
	$RETF				;CAN'T PROCESS THIS COMMAND


; Here on a Batch command. The following is set up:
;	a) .JSCTL(R) contains the command line.
;	b) .JSCTB(R) contains the byte pointer to the command line.
;	   and it points to the character immediately following the
;	   last character of the command.
;	c) .JSCDP(R) contains the command processor address.
;	d) S1 contains the command flags.
;
BATPRC:	HRLZI	S1,.JSKEY(R)		;GET ADDRESS OF KEYWORD BUFFER
	HRRI	S1,.JSCNM(R)		;GET ADDRESS OF THE COMMAND NAME BUFFER
	BLT	S1,.JSCNM+<KEYSIZ/5>(R)	;COPY COMMAND NAME
	MOVE	S1,.JSCFL(R)		;GET COMMAND FLAGS
	TXNN	S1,BC.MON		;IS THIS REALLY A MONITOR COMMAND?
	JRST	BATP.1			;NO
	PUSHJ	P,B$SETB##		;RESET THE BYTE POINTER
	ILDB	S1,.JSCTB(R)		;EAT THE MONITOR PROMPT CHARACTER
	PJRST	MONCMD			;YES

BATP.1:	TXNN	S1,BC.NEC		;"NOECHO" THIS COMMAND?
	$IDENT	(BATCH,<^T/.JSCTL(R)/^A>) ;NO - ECHO BATCH COMMAND LINE
	TXO	R,RL.DRT		;DELAY THE RESPONSE BUFFER OUTPUT
	PJRST	@.JSCDP(R)		;DISPATCH TO THE COMMAND PROCESSOR
SUBTTL	Macros to generate Batch command tables


; Batch command flags
;
	BC.ERR==1B0			;COMMAND IS LEGAL IF JOB IN ERROR
	BC.CIC==1B1			;PARSE COMMAND IN CORE ON COMMAND EXIT
	BC.NEC==1B2			;"NOECHO" BATCH COMMAND LINE BY BATPRC
	BC.MON==1B3			;MONITOR COMMAND
	BC.KJB==1B4			;KJOB


; Macro to generate Batch command tables
;
DEFINE	$BAT,<
  DEFINE $MKBAT,<
		$ ABORT,.ABORT,<BC.ERR>
		$ BACKSPACE,,<BC.MON>
		$ BACKTO,.BACKTO,<BC.CIC>
		$ CHKPNT,.CHKPNT,0
		$ DU,.DUMP,<BC.ERR>
		$ DUMP,.DUMP,<BC.ERR>
		$ ER,.ERROR,0
		$ ERROR,.ERROR,0
		$ GO,.GOTO,<BC.CIC>
		$ GOTO,.GOTO,<BC.CIC>
		$ I,,<BC.MON>
		$ IF,.IF,<BC.ERR!BC.NEC>
TOPS10	<	$ KJOB,,<BC.KJB!BC.MON>
		$ KJO,,<BC.KJB!BC.MON>
		$ KJ,,<BC.KJB!BC.MON>
		$ K,,<BC.KJB!BC.MON>
> ;END TOPS10
TOPS20	<	$ LOGOUT,,<BC.KJB!BC.MON>>
		$ NOERROR,.NOERROR,0
		$ NOOPERATOR,.NOOPERATOR,<BC.ERR>
		$ OPERATOR,.OPERATOR,0
		$ PLEASE,.PLEASE,0
		$ REQUEUE,.REQUEUE,0
		$ REVIVE,.REVIVE,0
		$ SILENCE,.SILENCE,0
		$ START,,<BC.MON>
		$ STATUS,.STATUS,0
  >					;END OF $MKBAT MACRO

	...BA1==0			;CLEAR COUNTER
	DEFINE	$ (NAME,DISP,FLAGS),<
	...BA1==...BA1+1		;COUNT ENTRIES
	>				;END OF $ MACRO
	$MKBAT				;BUILD THE COMMAND NAME TABLE

	...BA2==0			;CLEAR COUNTER
BATCMD:	XWD	...BA1,...BA1		;TABLE LENGTH
	DEFINE	$ (NAME,DISP,FLAGS),<
	XALL
	[ASCIZ	|NAME|],,...BA2		;'NAME COMMAND TABLE
	SALL
	...BA2==...BA2+1		;COUNT ENTRIES
	>				;END OF $ MACRO
	$MKBAT				;BUILD THE COMMAND TABLE

BATDSP:	DEFINE	$ (NAME,DISP,FLAGS),<
	XALL
	EXP	FLAGS+DISP		;'NAME DISPATCH TABLE
	SALL
	>				;END OF $ MACRO
	$MKBAT				;BUILD THE FLAG TABLE

>					;END OF $BAT MACRO
SUBTTL	Batch command tables


$BAT
SUBTTL	Batch commands -- ABORT and STATUS

; ABORT command
;
.ABORT:	$IDENT	(ABORT,<?Job aborted by batch ABORT command>)
	TXOA	R,RL.JIE		;FLAG ERROR CONDITION

.STATUS:TXZ	R,RL.JIE		;NON-FATAL
	PUSHJ	P,B$WINI##		;INIT WTO BUFFER
	PUSHJ	P,FLUSH			;EAT SPACES

ABOR.1:	ILDB	S1,.JSCTB(R)		;GET A CHAR
	JUMPE	S1,ABOR.2		;END
	PUSHJ	P,B$WPUT##		;STASH IT IN WTO BUFFER
	JRST	ABOR.1			;AND LOOP

ABOR.2:	PUSHJ	P,B$WEOL##		;END WTO MESSAGE
	TXO	F,FL.TXT		;MESSAGE TEXT AVAILABLE
	TXZE	R,RL.JIE		;AVOID CLOSE/DUMP
	TXOA	F,FL.UHE		;UNEXPECTED ERROR, TEXT AVAILABLE
	TXZA	F,FL.UHE		;NO ERRORS
	JRST	B$CLOSE##		;AND FINISH OFF THE JOB
	JRST	.POPJ1			;RETURN SUCESSFUL
SUBTTL	Batch commands -- BACKTO and GOTO


; BACKTO command
;
.BACKTO:
	PUSHJ	P,LABARG		;GET A LABEL ARGUMENT
	SKIPN	.JLABL(R)		;WAS THERE ONE
	  PJRST	LABERR			;NO - GIVE AN ERROR
	HRRZ	S1,J			;GET THE MONITOR JOB NUMBER
	MOVX	S2,JI.RTM		;GET THE RUNTIME
	PUSHJ	P,I%JINF		;GET THE JOB INFO
	CAMG	S2,.JBRTM(R)		;USER MUST DO SOMETHING TO GET RUNTIME
	  JRST	BACK.1			;OTHERWISE COULD BE A::.BACKTO A
	MOVEM	S2,.JBRTM(R)		;SAVE FOR NEXT BACKTO COMMAND
	TXO	F,FL.FIN		;OK TO PASS %FIN DURING SEARCH
	PUSHJ	P,C$ZPOS		;REWIND THE CONTROL FILE
	JRST	LABSRC			;GO FIND THE LABEL

BACK.1:	$IDENT	(BATEPL,<? BACKTO command has entered a possible loop>)
	JRST	BATERR			;ENTER COMMON BATCH COMMAND ERROR CODE


; GOTO command
;
.GOTO:	PUSHJ	P,LABARG		;GET A LABEL ARGUMENT
	SKIPN	.JLABL(R)		;WAS THERE A LABEL?
	  PJRST	LABERR			;NO - ISSUE LABEL ERROR
	PJRST	LABSRC			;SEARCH FOR LABEL
SUBTTL	Batch commands -- CHKPNT and REQUEUE


; CHKPNT command
;
.CHKPNT:
	PUSHJ	P,LABARG		;GET A LABEL ARGUMENT
	MOVX	S1,BA.CHK		;GET CHECKPOINT FLAG
	IORM	S1,.JBCRQ(R)		;TURN ON CHECKPOINT FLAG IN CHECK WORDS
	SKIPN	S1,.JLABL(R)		;WAS THERE A LABEL
	  JRST	LABERR			;NO, IS AN ERROR
	MOVEM	S1,.JBCRQ+1(R)		;STORE THE RESTART LABEL
	TXO	F,FL.CHK		;UPDATE CHECKPOINT DATA TO DISK
	SETZM	.JBCHK(R)		;FORCE A CHECKPOINT
	PUSHJ	P,QTS##			;WAIT A SCHEDULER PASS
	JRST	.POPJ1			;RETURN SUCESSFUL


; REQUEUE command
;
.REQUEUE:
	PUSHJ	P,LABARG		;GET A LABEL ARGUMENT
	MOVX	S1,BA.URQ		;GET REQUEUE BY USER
	IORM	S1,.JBCRQ(R)		;STORE IT
	SKIPE	S1,.JLABL(R)		;WAS A LABEL SPECIFIED?
	MOVEM	S1,.JBCRQ+1(R)		;YES - STORE FOR QUASAR
	$IDENT	(BATJRQ,<[Job requeued by user]>)
	MOVEI	S1,REQTIM		;GET REQUEUE TIME
	STORE	S1,.JBRQF(R),RQ.TIM	;SET IT
	MOVX	T1,%REQUE		;GET REQUEUE CODE
	PUSHJ	P,B$UPDA##		;UPDATE QUASAR
	$WTOJ	(<Requeue request queued by user>,<^R/.JQJBB(R)/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
	TXO	R,RL.REQ		;MARK JOB AS BEING REQUEUED
	JRST	B$CLOS##		;DISMISS JOB


; Here on label argument errors
;
LABERR:	$IDENT	(BATNLS,<? No label specified or illegal syntax>)


; Here on Batch command errors
;
BATERR:	TXO	F,FL.LSL		;LIST LINES SKIPPED
	PJRST	LABFIN			;SEARCH FOR %FIN
SUBTTL	Batch commands -- DUMP


; DUMP command
;
.DUMP::	$IDENT	(DUMP,<	-- Batch Stream and Job Data -->)
	$IDENT	(DUMP,<Stream:^A>)
	SETZ	P1,			;CLEAR INDEX
DUMP.1:	SKIPN	DMPTAB(P1)		;END OF TABLE?
	JRST	DUMP.2			;YES
	HLLZ	S1,DMPTAB(P1)		;GET BITS TO TEST
	HRRZ	S2,DMPTAB(P1)		;GET ADDRESS OF ASCIZ TEXT
	TDNE	R,S1			;BIT SET?
	$IDENT	(DUMP,<	^T/(S2)/^A>)	;OUTPUT TEXT
	AOJA	P1,DUMP.1		;LOOP FOR MORE

DUMP.2:	SKIPN	T1,.JBECH(R)		;GET THE ERROR CHARACTER
	  MOVEI	T1," "			;NONE - LOAD A SPACE
	SKIPN	T2,.JBOCH(R)		;GET THE OPERATOR CHARACTER
	  MOVEI	T2," "			;NONE - LOAD A SPACE
	MOVEI	T3,[ASCIZ /No/]		;ASSUME NOT SILENCED
	TXNE	F,FL.SIL		;JOB SILENCED?
	MOVEI	T3,[ASCIZ /Yes/]	;YES
	$IDENT	(DUMP,<	Error: ^7/T1/   Operator: ^7/T2/   Silenced: ^T/(T3)/^A>)
	$IDENT	(DUMP,<	Processing node: ^N/.JQOBJ+OBJ.ND(R)/^A>)
	$IDENT	(DUMP,<	Last step: ^W/.JLSTP(R)/^A>)
	$IDENT	(DUMP,<	Last label: ^W/.JLLBL(R)/^A>)	;[4707]
	$IDENT	(DUMP,<	Last CHKPNT: ^W/.JBCRQ+1(R)/^A>)
	$IDENT	(DUMP,<	Last line to job: ^T/.JSCTL(R)/^A>)
	$IDENT	(DUMP,<	Last line from job: ^T/.JBRSP(R)/^A>)
	$IDENT	(DUMP,<	Last line to OPR: ^T/.JWTOP(R)/^A>)
	$IDENT	(DUMP,<	Last line from OPR: ^T/.JWFOP(R)/^A>)
	$IDENT	(DUMP,<	Last Batch command: ^T/.JSCNM(R)/^A>)

	$IDENT	(DUMP,<Job:^A>)
	HRRZ	S1,J			;GET JOB NUMBER
	$IDENT	(DUMP,<	Job: ^D/S1/^A>)	;DISPALY IT
	MOVEI	P1,JOBTAB		;POINT TO THE JOB TABLE

DUMP.3:	SKIPN	T1,(P1)			;END OF TABLE?
	  JRST	DUMP.X			;YES
	HRRZ	S1,J			;LOAD JOB NUMBER
	HLRZ	S2,(P1)			;LOAD I%JINF ARGUMENT
	$CALL	I%JINF			;READ A VALUE
	SKIPT				;ANY ERRORS?
	  AOJA	P1,DUMP.3		;YES - IGNORE IT
	HRRZ	T1,(P1)			;GET ITEXT BLOCK POINTER
	$IDENT	(DUMP,<	^I/(T1)/^A>)	;OUTPUT SOME DATA
	AOJA	P1,DUMP.3		;LOOP FOR MORE

DUMP.X:	$IDENT	(DUMP,<		-- End of Dump -->)
	JRST	.POPJ1			;RETURN SUCESSFUL
; Table of bits to test and messages to output
; Format: bits in LH AC 'R',[asciz string]
;
DMPTAB:	EXP	RL.OPR+[ASCIZ /Waiting for operator response/]
	EXP	RL.JIE+[ASCIZ /Job in error/]
	EXP	RL.KJB+[ASCIZ /Logout in pending/]
	EXP	RL.LGI+[ASCIZ /Login in progress/]
	EXP	RL.DIA+[ASCIZ /Job in dialogue mode/]
	EXP	RL.STP+[ASCIZ /Stopped by the operator/]
	EXP	RL.MIP+[ASCIZ /Operator message being processed/]
	EXP	RL.FLS+[ASCIZ /Request to flush job/]
	EXP	0			;END TABLE WITH A ZERO WORD


; Table of job parameter values
; Format: XWD	I%JINF arguments,[ITEXT (string)]
;
JOBTAB:	XWD	JI.TNO,[ITEXT	(TTY^O/S2/)]
	XWD	JI.USR,[ITEXT	(User: ^P/S2/)]
	XWD	JI.PRG,[ITEXT	(Program: ^W/S2/)]
	XWD	JI.LOC,[ITEXT	(Located at: ^N/S2/)]
	XWD	0,0			;End table with a zero word
SUBTTL	Batch commands -- ERROR and OPERATOR


; ERROR command
;
.ERROR:	TXZ	F,FL.NER		;CLEAR NOERROR STATE
	SETZ	T1,			;DEFAULT CHARACTER
	MOVEI	T2,.JBECH(R)		;STORAGE ADDRESS
	PJRST	CHRSET			;GO ENTER COMMON ERROR/OPERATOR CODE


; OPERATOR command
;
.OPERATOR:
	MOVEI	T1,"$"			;DEFAULT CHARACTER
	MOVEI	T2,.JBOCH(R)		;STORAGE ADDRESS


; Common character setting routine
;
CHRSET:	MOVEM	T1,(T2)			;STORE DEFAULT CHARACTER
	PUSHJ	P,FLUSH			;FLUSH LEADING TABS AND SPACES
	  JFCL				;ALWAYS SKIPS
	PUSHJ	P,EOLTST		;OR TERMINATING CHARACTER?
	  JRST	.POPJ1			;YES - RETURN
	CAIE	S1,";"			;OLD STYLE COMMENT?
	CAIN	S1,"!"			;NEW STYLE COMMENT?
	  JRST	.POPJ1			;YES - RETURN
	CAIG	S1," "			;NON-CONTROL NON-SPACE CHARACTER?
	  JRST	ILLCHR			;ILLEGAL CHARACTER
	MOVEM	S1,(T2)			;STORE IT
	JRST	.POPJ1			;RETURN


; Here on an illegal character
;
ILLCHR:	SETZM	(T2)			;CLEAR DEFAULT CHARACTER CURRENTLY SET
	$IDENT	(BATICS,<? Illegal character specified for ^T/.JSCNM(R)/ command^A>)
	JRST	LABFIN			;GO SEARCH FOR %FIN
SUBTTL	Batch commands -- IF


; Perform error testing
;
.IF:	PUSHJ	P,FLUSH			;EAT LEADING TABS AND SPACES
	  JFCL				;ALWAYS SKIPS
	CAIE	S1,"("			;NEED THE OPENING PARENTHESIS
	  JRST	IF.ERR			;BAD IF COMMAND
	MOVEI	S1,.JSKEY(R)		;POINT TO STORAGE LOCATION
	MOVEI	S2,KEYSIZ		;MAXIMUM NUMBER OF CHARACTERS
	PUSHJ	P,KEYINP		;READ A KEYWORD
	PUSHJ	P,FLUSH			;EAT LEADING TABS AND SPACES
	  JFCL				;ALWAYS SKIPS
	CAIE	S1,")"			;NEED THE CLOSING PARENTHESIS
	  JRST	IF.ERR			;BAD IF COMMAND
	MOVEI	S1,IFTAB		;POINT TO KEYWORD TABLE
	MOVEI	S2,.JSKEY(R)		;POINT TO KEYWORD
	$CALL	S%TBLK			;SCAN THE TABLE
	TXNN	S2,TL%ABR!TL%EXM	;ABBREVIATION OR EXACT MATCH?
	  JRST	IF.ERR			;NOPE
	HRRZ	S1,(S1)			;GET DISPATCH ADDRESS
	JRST	(S1)			;PROCESS THE IF COMMAND

IF.ERR:	$IDENT	(BATIIC,<? Illegal IF command argument or syntax error>)
	JRST	BATERR			;TAKE ERROR RETURN
; Here on IF (ERROR)
;
IFERRO:	TXZN	R,RL.JIE		;JOB IN ERROR?
	  JRST	IFFALS			;NO - IF (ERROR) IS FALSE


; Here if condition tested is TRUE
;
IFTRUE:	$IDENT	(TRUE,<^A>)		;IDENTIFY THE LINE
	PUSHJ	P,IFCOPY		;COPY THE IF COMMAND AND ARGUMENTS
	TXO	R,RL.DRT		;DELAY THE RESPONSE BUFFER OUTPUT
	PJRST	C$COPY			;RE-COPY COMMAND AND RETURN SUCESSFUL


; Here on IF (NOERROR)
;
IFNOER:	TXZN	R,RL.JIE		;JOB IN ERROR?
	  JRST	IFTRUE			;NO - IF (NOERROR) IS TRUE


; Here if condition tested is FALSE
;
IFFALS:	$IDENT	(FALSE,<^A>)		;IDENTIFY THE LINE
	TXO	R,RL.DRT		;DELAY THE RESPONSE BUFFER OUTPUT
	PUSHJ	P,IFCOPY		;COPY THE IF COMMAND AND ARGUMENTS
	JRST	.POPJ1			;RETURN SUCESSFUL


; Copy the IF command and arguments
;
IFCOPY:	PUSHJ	P,B$SETB##		;RESET BYTE POINTER TO START OF LINE

IFCO.1:	ILDB	S1,.JSCTB(R)		;GET A CHARACTER
	PUSHJ	P,L$PLOG##		;LOG IT
	CAIE	S1,")"			;END OF CONDITIONAL?
	  JRST	IFCO.1			;NO - LOOP BACK
	PUSHJ	P,L$CRLF##		;END THE LINE
	PUSHJ	P,FLUSH			;GET NEXT CHARACTER (NO SPACES OR TABS)
	  JFCL				;ALWAYS SKIPS
	PUSHJ	P,EOLTST		;AT EOL ALREADY?
	  POPJ	P,			;YES - THEN DON'T BACKUP
	PJRST	BACKUP			;BACKUP 1 CHARACTER AND RETURN
; Macros to generate the IF argument tables
;
DEFINE	$IF,<
  DEFINE $MKIF,<
		$ ERROR,IFERRO
		$ NOERROR,IFNOER
  >					;END OF $MKIF MACRO

	...IF==0			;CLEAR COUNTER

	DEFINE	$ (NAME,DISP),<
	...IF==...IF+1			;COUNT THE ENTRY
	>				;END OF $ MACRO
	$MKIF				;BUILD THE ARGUMENT NAME TABLE

IFTAB:	XWD	...IF,...IF		;TABLE LENGTH
	DEFINE	$ (NAME,DISP),<
	XALL
	[ASCIZ	|'NAME|],,DISP		;'NAME ARGUMENT
	SALL
	>				;END OF $ MACRO
	$MKIF				;BUILD THE ARGUMENT TABLE

>					;END OF $IF MACRO
; Invoke the IF argument table building macros
;
$IF
SUBTTL	Batch commands -- MESSAGE and PLEASE


; MESSAGE and PLEASE commands
;
.MESSAGE:
.PLEASE:
	PUSHJ	P,B$WINI##		;SET UP WTO/WTOR BUFFER
	PUSHJ	P,FLUSH			;EAT LEADING SPACES AND TABS

PLEA.1:	ILDB	S1,.JSCTB(R)		;GET A CHARACTER
	CAIN	S1,.CHESC		;ESCAPE?
	JRST	PLEA.2			;YES - SEND LINE TO OPERATOR
	PUSHJ	P,B$WPUT##		;STORE IN THE WTO/WTOR BUFFER
	JUMPE	S1,PLEA.3		;END OF LINE
	JRST	PLEA.1			;LOOP BACK FOR ANOTHER

PLEA.2:	PUSHJ	P,B$WEOL##		;END THE LINE
	PUSHJ	P,B$WTO##		;DO A WTO
	JRST	.POPJ1			;RETURN SUCESSFUL

PLEA.3:	PUSHJ	P,B$WEOL##		;End the line
	PUSHJ	P,B$WTOR##		;Do a WTOR
	PUSHJ	P,B$WRSP##		;GET OPERATOR RESPONSE
	$IDENT	(OPERAT,<From operator: ^T/.JWFOP(R)/^A>)
	JRST	.POPJ1			;RETURN SUCESSFUL
SUBTTL	Batch commands -- NOERROR, NOOPERATOR, REVIVE, and SILENCE


; NOERROR command
;
.NOERROR:
	TXO	F,FL.NER		;SET NOERROR IN EFFECT
	JRST	.POPJ1			;RETURN SUCESSFUL


; NOOPERATOR command
;
.NOOPERATOR:
	SETZM	.JBOCH(R)		;CLEAR THE DIALOGUE CHARACTER
	JRST	.POPJ1			;RETURN SUCESSFUL


; REVIVE command
;
.REVIVE:
	TXZA	F,FL.SIL		;CLEAR SILENCE MODE


; SILENCE command
;
.SILENCE:
	TXO	F,FL.SIL		;SET SILENCE MODE
	JRST	.POPJ1			;RETURN SUCESSFUL
SUBTTL	MOUNT parser -- ALLOCATE and MOUNT command syntax tables


;ALLOCATE and MOUNT syntax tables

MOU010::	;Mount and allocate share common syntax
ALL010::$SWITCH(,MOU011,$ALTER(MOU015))
MOU015:	$CRLF	($ALTER (MOU020))

MOU020:	$FIELD(MOU022,<volume set name>,$BREAK(VSNBRK))
MOU022:	$TOKEN(MOU023,<(>,$ALTER(MOU026))
MOU023:	$FIELD(MOU024,<volume identifier>)
MOU024:	$COMMA(MOU023,$ALTER(MOU025))
MOU025:	$TOKEN(MOU026,<)>)
MOU026:	$TOKEN(MOU030,<:>,$ALTER(MOU030))

MOU030:	$FIELD(MOU032,<logical name>)
MOU032:	$TOKEN(MOU040,<:>,$ALTER(MOU040))

MOU040:	$SWITCH(,MOU041,$ALTER(MOU050))

MOU050:	$COMMA(MOU020,$ALTER(MOU060))

MOU060:	$CRLF

;Character set allowed for VOLUME-SET-NAME

VSNBRK::
	777777,,777760			;Break on all control
	777754,,001760			;Allow - and 0-9
	400000,,000760			;Allow A-Z
	400000,,000760			;Allow LC A-Z
SUBTTL  MOUNT parser -- MOUNT and ALLOCATE option tables


MOU011:	$STAB
	DSPTAB(MOU010,MO$CHE,<CHECK>)
	DSPTAB(MOU010,MO$DIS,<DISK>)
	DSPTAB(,HELPER,<HELP>)
	DSPTAB(MOU010,MO$NNT,<NONOTIFY>)
	DSPTAB(MOU010,MO$NOT,<NOTIFY>)
	DSPTAB(MOU010,MO$NOW,<NOWAIT>)
	DSPTAB(MOU010,MO$TAP,<TAPE>)
	DSPTAB(MOU010,MO$WAI,<WAIT>)
	$ETAB

MOU041:	$STAB
	DSPTAB(MOU040,MO$ACT,<ACTIVE>)
	DSPTAB(MOU040,MO$CRE,<CREATE>)
	DSPTAB(M$DEN1,MO$DEN,<DENSITY>)
	DSPTAB(M$FLD1,MO$DEV,<DEVICE>)
	DSPTAB(MOU040,MO$DIS,<DISK>)
	DSPTAB(MOU040,MO$EXC,<EXCLUSIVE>)
	DSPTAB(M$LAB1,MO$LAB,<LABEL-TYPE>)
	DSPTAB(MOU040,MO$SHA,<MULTI>)		;Ala SHARABLE
	DSPTAB(MOU040,MO$NEW,<NEW-VOLUME-SET>)
	DSPTAB(MOU040,MO$NOC,<NOCREATE>)
	DSPTAB(MOU040,MO$NNT,<NONOTIFY>)
	DSPTAB(MOU040,MO$NOT,<NOTIFY>)
	DSPTAB(MOU040,MO$NOW,<NOWAIT>)
	DSPTAB(MOU040,MO$PAS,<PASSIVE>)
	DSPTAB(M$PRO1,MO$PRO,<PROTECTION>)
	DSPTAB(MOU040,MO$QTA,<QUOTA>)
	DSPTAB(MOU040,MO$REA,<READ-ONLY>)
	DSPTAB(M$VOL1,MO$VOL,<REELID>)		;Ala VOLID
	DSPTAB(M$REM1,MO$REM,<REMARK>)
	DSPTAB(MOU040,MO$REA,<RONLY>)		;Ala READ-ONLY
	DSPTAB(MOU040,MO$SCR,<SCRATCH>)
	DSPTAB(MOU040,MO$SHA,<SHARABLE>)
	DSPTAB(MOU040,MO$EXC,<SINGLE>)		;Ala EXCLUSIVE
	DSPTAB(MOU040,MO$TAP,<TAPE>)
	DSPTAB(M$TRA1,MO$TRA,<TRACKS>)
	DSPTAB(M$REM1,MO$REM,<VID>)		;Ala REMARK
	DSPTAB(M$VOL1,MO$VOL,<VOLID>)
	DSPTAB(MOU040,MO$WAI,<WAIT>)
	DSPTAB(MOU040,MO$WRI,<WENABLE>)		;Ala WRITE-ENABLE
	DSPTAB(MOU040,MO$REA,<WLOCK>)		;Ala READ-ONLY	
	DSPTAB(M$WRI1,MO$WRI,<WRITE-ENABLE>)	;Also WRITE:YES and WRITE:NO
	$ETAB
;ALLOCATE and MOUNT options syntax tables

M$DAT1:	$DATE(MOU040)

M$DEN1:	$KEY(MOU040,M$DEN2)
M$DEN2:	$STAB
	KEYTAB(.TFD16,<1600-BPI>)
	KEYTAB(.TFD20,<200-BPI>)
	KEYTAB(.TFD55,<556-BPI>)
	KEYTAB(.TFD62,<6250-BPI>)
	KEYTAB(.TFD80,<800-BPI>)
	$ETAB

M$FLD1:	$FIELD(MOU040)


M$LAB1:	$KEY(MOU040,M$LAB2)
M$LAB2:	$STAB
	KEYTAB(%TFANS,<ANSI>)
	KEYTAB(%TFLBP,<BLP>)
	KEYTAB(%TFLBP,<BYPASS-LABEL-PROCESSING>)
	KEYTAB(%TFEBC,<EBCDIC>)
	KEYTAB(%TFEBC,<IBM>)
	KEYTAB(%TFUNL,<NOLABELS>)
	KEYTAB(%TFUNL,<NONE>)
	KEYTAB(%TFUNL,<UNLABELED>)
	KEYTAB(%TFUNV,<USER-EOT>)
	$ETAB

M$NUM1:	$NUMBER(MOU040,^D10)

M$PRO1:	$NUMBER(MOU040,^D8)

M$REM1:	$QUOTE(MOU040,,$ALTER(M$REM2))
M$REM2:	$FIELD(MOU040,,$BREAK(REMBRK))

REMBRK:	777777,,777760			;Break on all control
	777754,,001760			;Allow - and 0-9
	400000,,000760			;Allow A-Z
	400000,,000760			;Allow LC A-Z

M$TRA1:	$KEY(MOU040,M$TRA2)
M$TRA2:	$STAB
	KEYTAB(.TMDR7,<7-TRACK>)
	KEYTAB(.TMDR9,<9-TRACK>)
	$ETAB

M$VOL1:	$TOKEN(M$VOL2,<(>,$ALTER(M$VOL5))
M$VOL2:	$FIELD(M$VOL3)
M$VOL3:	$COMMA(M$VOL2,$ALTER(M$VOL4))
M$VOL4:	$TOKEN(MOU040,<)>,$ALTER(MOU040))
M$VOL5:	$FIELD(MOU040)

M$WRI1:	$KEY(MOU040,M$WRI2,<$DEFAULT(YES),$ALTER(MOU040)>)
M$WRI2:	$STAB
	KEYTAB(FALSE,<NO>)
	KEYTAB(TRUE,<YES>)
	$ETAB

;MOUNT and ALLOCATE commands

;These routines will parse a MOUNT or an ALLOCATE command.
; The parse blocks are built in a page of data supplied by the caller
;Call -
;	S1/	Adrs of a page into which the mount message
;		will be built
;Return -
;	TRUE	always.
;	If there are ANY errors, these routines pull a $ERR macro
;	which JSPs to a caller-defined ERROR label (external from here)
;	which should handle the error condition.

.ALLOC::
	TDZA	F,F			;CLEAR FLAG WORD
.MOUNT::
	MOVX	F,FL.MOU+FL.WAT		;Set Mount and Wait flags
	$SAVE	<P1,P2,P3,P4>		;Preserve some AC's
	$SAVE	<T1,T2,T3,T4>		;SAVE THE TEMP ACS
	MOVE	P1,S1			;Save the incoming page adrs
	MOVE	S1,['MOUNT ']		;Assume mount
	TXNN	F,FL.MOU
	MOVE	S1,['ALLOCA']
	MOVEM	S1,CMDNAM		;Save incase /HELP was typed

MOUN05:	PUSHJ	P,P$CFM			;Try to get EOL
	  SKIPF				;User didn't type CRLF yet
	TXO	F,FL.LST		;Default to /LIST if EOL already
	$CALL	DOSWS			;Parse leading switches
	MOVEM	F,DEFSWS		;Save sticky options
	MOVEI	P2,.MMHSZ(P1)		;P2 contains first free address
	MOVEI	S2,.QOMNT		;Get mount message type
	STORE	S2,.MSTYP(P1),MS.TYP	;Save in the message
	MOVX	S2,MF.ACK		;Get ACK request flag
	MOVEM	S2,.MSFLG(P1)
	$CALL	P$CFM			;Get confirmation
	 JUMPT	MOUN80			;Yes..just return
	JUMPE	S1,MOUN80		;Return at end of command (MOUNT/CHECK)

	HRROI	T1,.GTNM1		;Get user name
	GETTAB	T1,			;May I?
	 SETZ	T1,			;No..
	HRROI	T2,.GTNM2		;Get second half
	GETTAB	T2,			;May I?
	 SETZ	T2,			;No..
	DMOVEM	T1,.MMUSR(P1)		;Store in message
	MOVEI	T1,2			;Get arg count for account
	SETO	T2,			;My Job
	HRROI	T3,.MMUAS(P1)		;Store in message
	MOVE	S2,[.ACTRD,,T1]		;Get the account
	ACCT.	S2,
	 JFCL

MOUN10:	INCR	.MMARC(P1)		;Increment total message arg count
	MOVE	P3,P2			;P3 points to current entry
	ADDI	P2,.MEHSZ		;P2 points to first free word
	MOVE	F,DEFSWS		;Get default options
	SETZ	S1,			;Initially, no flags
	TXNN	F,FL.MOU		;Is this a mount request?
	MOVX	S1,ME%ALC		;Get the allocate-only bit
	MOVEM	S1,.MEFLG(P3)		;Stash the flags
	SETZM	VOLCNT			;Clear the count of VOLIDS

MOUN20:	$CALL	P$FLD			;Was VSN specified?
	SKIPN	ARG.DA(S1)		;Make sure its not null
	 $ERR	(<Volume set name must be specified>)
	MOVEM	S1,VSNADR		;Save address of Volume set name
	HRROI	S1,ARG.DA(S1)		;Point to volume set name string
	$CALL	DEVCHK			;See if actual device name given
	MOVEM	S2,VSNAME		;Save SIXBIT volume set name
	MOVE	T1,S2			;Save Device name
	CAIN	S1,.TYDSK		;Is it a disk?
	DEVNAM	T1,			;Yes, translate logical name.
	 JRST	MOUN21			;Failed, or not a disk.
	MOVE	T3,VSNADR		;Get device name address.
	MOVEI	T2,2			;Arg block is only 2 long now.
	STORE	T2,ARG.HD(T3),AR.LEN	;So stuff it.
	SETZM	ARG.DA(T3)		;Zap the current name
	ADD	T3,[POINT 7,ARG.DA]	;Make into byte pointer
	TRZ	T1,7777			;Ensure only 4 characters
MOLO:	SETZ	T2,			;Loop to change SIXBIT to ASCIZ
	ROTC	T1,6			;Shift a character into T2
	ADDI	T2,"A"-'A'		;Make into ASCII
	IDPB	T2,T3			;Stuff into name
	JUMPN	T1,MOLO			;Continue until done
MOUN21:	TXNE	F,FL.TAP!FL.DSK		;Request type known?
	JRST	MOUN25			;Yes..then allow it
	JUMPF	[CAIN	S1,ER$EZD	;  ersatz device?
		  $ERR(<Ersatz device ^W/S2/ may not be mounted>)
		 CAIN	S1,ER$PLD	;  pathological name?
		  $ERR(<Pathological device ^W/S2/ may not be mounted>)
		 CAIN	S1,ER$ASN	;  ambigious?
		  $ERR(<Ambigious structure name ^W/S2/>)
		 CAIN	S1,ER$ISN	;  illegal?
		  $ERR(<Illegal structure name ^W/S2/>)
		 CAIN	S1,ER$GDN	;  generic?
	 	  $ERR(<Generic device ^W/S2/ may not be mounted>)
		 JRST	MOUN25]		;No..process as VSN

	CAIN	S1,.TYMTA		;Yes..was it tape?
	TXO	F,FL.TAP		;Yes..specify tape
	CAIN	S1,.TYDSK		;Was it disk?
	TXO	F,FL.DSK

MOUN25:	$CALL	P$TOK			;Was it terminated by a token?
	 JUMPF	MOUN30			;No..on to parse logical name
	MOVE	S1,ARG.DA(S1)		;Get the token
	CAMN	S1,[ASCIZ/:/]		;Was VSN: specified?
	JRST	MOUN30			;Yes..on to get logical name
	$CALL	P$PREV			;Backup to token again
	$CALL	MO$VOL			;Process VOLID list
	JRST	MOUN25			;See if VSN(list): was specified!

MOUN30:	$CALL	P$SIXF			;Get locical name
	  JUMPF	MOUN40			;Don't store junk
	MOVEM	S1,LOGNAM		;Save logical name
	$CALL	P$TOK			;Get optional ":"

MOUN40:	$CALL	DOSWS
	TXNN	F,FL.DSK		;Is this a disk request ?
	TXNE	F,FL.TRK		;Was /TRACK specified ?
	JRST	MOUN41			;Yes, skip this
	SETZM	S1			;clear S1
	MOVE	S2,VSNAME		;Get the volume set name in sixbit
	CAMN	S2,[SIXBIT/M9/]		;Did he specify M9 ?
	MOVX	S1,.TMDR9		;Yes, get 9 track code
	CAMN	S2,[SIXBIT/M7/]		;Did he specify M7 ?
	MOVX	S1,.TMDR7		;Yes, get 7 track code
	JUMPE	S1,MOUN41		;Neither,,skip this
	MOVEI	S2,.TMDRV		;Get /TRACK: block type
	PUSHJ	P,ADDSUB		;Add /TRACK:x to message

MOUN41:	PUSHJ	P,BLDVSN		;Build the VSN
	PUSHJ	P,LOGCHK		;No - check out the logical name
	SETZ	S1,			;Clear entry flags
	TXNE	F,FL.SCR		;Scratch volume wanted?
	TXO	S1,TM%SCR!TM%WEN	;Yes
	TXNE	F,FL.NEW		;New volume set wanted?
	TXO	S1,TM%NEW!TM%WEN	;Yes
	TXNE	F,FL.WRT		;Write enabled?
	TXO	S1,TM%WEN		;Yes
	TXNE	F,FL.WLK		;Write locked?
	TXO	S1,TM%WLK		;Yes
	TXNE	F,FL.BYP		;Bypass labels?
	TXO	S1,TM%BYP		;Yes
	TXNE	F,FL.PAS		;Was /PASSIVE specified?
	TXO	S1,SM%PAS		;Yes
	TXNE	F,FL.NOC		;Was /NOCREATE specified?
	TXO	S1,SM%NOC		;Yes
	TXNE	F,FL.EXC		;Was /EXCLUSIVE specified?
	TXO	S1,SM%EXC		;Yes
	TXNE	F,FL.QTA		;Was /QUOTA specified?
	TXO	S1,SM%ARD		;Yes
	IORM	S1,.MEFLG(P3)		;Save the entry flags
	MOVEI	S1,.MNUNK		;Get unknown entry type
	TXNE	F,FL.TAP		;Was it a tape request?
	MOVEI	S1,.MNTTP		;Yes..then use tape entry type
	TXNE	F,FL.DSK		;Was it a disk request?
	MOVEI	S1,.MNTST		;Yes..then use disk entry type
MOUN52:	STORE	S1,ARG.HD(P3),AR.TYP	;Save request type
	MOVE	S1,P2			;Close current entry
	SUB	S1,P3			;Compute entry length
	STORE	S1,ARG.HD(P3),AR.LEN	;Save in entry header
	$CALL	P$COMMA			;No..then must be a comma
	JUMPT	MOUN10			;Yes..Back to try again
	$CALL	P$CFM			;Confirmed?
	JUMPT	MOUN80			;Yes..send what we have
	 $ERR	(<Unrecognized command syntax>)

MOUN80:	SETZB	S1,.MMFLG(P1)		;Clear message flag word
	TXNE	F,FL.WAT		;Want to wait for the mount?
	TXO	S1,MM.WAT		;Yes..light the flag
	TXNE	F,FL.NOT		;Want terminal notification?
	TXO	S1,MM.NOT		;Yes..light the flag
	MOVEM	S1,.MMFLG(P1)		;Set the message flags
	SUB	P2,P1			;Compute message length
	STORE	P2,.MSTYP(P1),MS.CNT	;Save it
	MOVEI	S1,PAGSIZ		;Send of the page
	MOVE	S2,P1
	$RETT

;MOUNT option processors

DOSWS::	$CALL	P$SWIT			;Get a switch if any
	 $RETIF				;No, return
	$CALL	0(S1)			; Else call the processor
	JRST	DOSWS			;Process next switch


;ACTIVE option places disk in jobs active search list

MO$ACT:	MOVX	S1,TXT(/ACTIVE)		;Get error prefix
	$CALL	DSKCHK			;Must be disk
	TXZ	F,FL.PAS		;Clear Passive flag
	$RETT


;CHECK option lists the mount queues

MO$CHE:	TXO	F,FL.CHK		;Set the flag
	$RETT


;CREATE option

MO$CRE:	MOVX	S1,TXT(/CREATE)		;Get error prefix
	$CALL	DSKCHK			;Must be disk
	TXZ	F,FL.PAS!FL.NOC		;Clear Passive and Nocreate
	$RETT


;DENSITY option requests specific tape density

MO$DEN:	MOVX	S1,TXT(/DENSITY)	;Get error prefix
	$CALL	TAPCHK			;Must be tape
	$CALL	P$KEYW			;Get proper density
	MOVEI	S2,.TMDEN
	PJRST	ADDSUB


;DEVICE option requests specific device type

MO$DEV:	$CALL	P$SIXF			;Get requested device
	$RETT


;DISK option declares disk devices

MO$DIS:	MOVX	S1,TXT(/DISK)
	$CALL	DSKCHK			;Must be disk request
	$RETT


;EXCLUSIVE option declares that exclusive ownership is requested

MO$EXC:	MOVX	S1,TXT(/EXCLUSIVE)
	$CALL	DSKCHK			;Must be disk
	TXO	F,FL.EXC		;Set the flag
	$RETT



;LABEL-TYPE option

MO$LAB:	MOVX	S1,TXT(/LABEL-TYPE)	;Get error prefix
	$CALL	TAPCHK			;Must be a tape request
	$CALL	P$KEYW			;Get the LABEL type
MO$LA1:	CAXN	S1,%TFLBP		;Was it BYPASS?
	TXO	F,FL.BYP		;Yes..set the flag
	TXO	F,FL.LAB		;Note that something was said
	MOVEI	S2,.TMLT		;Create  label type entry
	PJRST	ADDSUB


;NEW-VOLUME-SET option

MO$NEW:	MOVX	S1,TXT(/NEW-VOLUME-SET)
	$CALL	TAPCHK			;Tape requests only
	TXO	F,FL.NEW		;Set the flag
	$RETT


;NOCREATE option

MO$NOC:	MOVX	S1,TXT(/NOCREATE)
	$CALL	DSKCHK			;Disk requests only
	TXO	F,FL.NOC
	$RETT


;NOWAIT option
;
;NOTIFY option

MO$NOW:	TXZ	F,FL.WAT		;Clear the wait flag,,imply notify
MO$NOT:	TXOA	F,FL.NOT		;Notify on completion
MO$NNT:	TXZ	F,FL.NOT		;No notify
	$RETT

;PASSIVE option

MO$PAS:	MOVX	S1,TXT(/PASSIVE)	;Get error prefix
	$CALL	DSKCHK			;Must be dsk
	TXO	F,FL.PAS		;Set the PASSIVE flag
	$RETT


;PROTECTION option

MO$PRO:	MOVX	S1,TXT(/PROTECTION)	;Get error prefix
	$CALL	TAPCHK			;Must be tape
	$CALL	P$NUM			;Get the value
	CAIL	S1,0			;Check the range
	CAILE	S1,MAXPRO
	 $ERR	(<Protection out of range>)
	MOVEI	S2,.TMVPR		;Create protection entry
	PJRST	ADDSUB			;  and return


;QUOTA option

MO$QTA:	MOVX	S1,TXT(/QUOTA)		;Get error prefix
	PUSHJ	P,DSKCHK		;Must be dsk
	TXO	F,FL.QTA		;Set the quota flag
	$RETT

;READ-ONLY option

MO$REA:	TXO	F,FL.WLK		;Set write lock flag
	$RETT


;REMARK option

MO$REM:	TXO	F,FL.REM		;Remember we saw it
	$CALL	P$QSTR			;Get quoted string
	SKIPT
	$CALL	P$FLD			;Or simple field
	$CALL	CPYSUB			;Create .TMRMK subentry
	MOVEI	S1,.TMRMK		;Make entry type remark
	STORE	S1,ARG.HD(S2),AR.TYP
	$RETT


;SCRATCH option

MO$SCR:	MOVX	S1,TXT(/SCRATCH)	;Get error prefix
	$CALL	TAPCHK			;Must be tape
	TXO	F,FL.SCR		;Set the flag
	$RETT

;SHARABLE option

MO$SHA:	MOVX	S1,TXT(/SHARABLE)
	$CALL	DSKCHK			;Must be disk
	TXZ	F,FL.EXC		;Clear Exclusive
	$RETT
;TAPE option

MO$TAP:	MOVX	S1,TXT(/TAPE)
	$CALL	TAPCHK
	$RETT


;TRACKS option

MO$TRA:	MOVX	S1,TXT(/TRACKS)		;Get error prefix
	$CALL	TAPCHK			;Must be tape
	$CALL	P$KEYW			;Get the track type
	TXO	F,FL.TRK		;Set /TRACK: flag
	MOVEI	S2,.TMDRV
	PJRST	ADDSUB


;WAIT option

MO$WAI:	TXO	F,FL.WAT		;Set the flag
	$RETT


;WRITE-ENABLE option

MO$WRI:	$CALL	P$KEYW			;Get YES or NO
	JUMPF	[TXO	F,FL.WRT	;Default is WRITE:YES
		 $RETT]
	JUMPE	S1,[TXO	F,FL.WLK	;Set write lock if WRITE:NO
		    $RETT]
	TXO	F,FL.WRT		;Set write enable if WRITE:YES
	$RETT

;VOLID option

MO$VOL:	MOVX	S1,TXT(Volume identifier)	;Get the error prefix
	SKIPE	VOLCNT			;Have we been here before?
	 $ERR	(<Only one volume identifier list is allowed>)
	INCR	.MECNT(P3)		;Bump subentry count
	MOVE	P4,P2			;Save free address
	ADDI	P2,1			;Reserve a word for header
	$CALL	P$TOK			;Get optional list token
	JUMPF	[$CALL	MO$VO3		;Allow only one volume
		 JRST	MO$VO2]		;If no token is found
MO$VO1:	$CALL	MO$VO3			;Get volume identifier
	$CALL	P$COMMA			;More to come?
	JUMPT	MO$VO1			;Yes..get the whole list
	$CALL	P$TOK			;Check optional list token
	JUMPF	[$ERR(<Missing volume identifier list terminator>)]
MO$VO2:	MOVE	S1,P2			;Get final free address
	SUB	S1,P4			;Compute argument length
	MOVS	S1,S1			;Put length in Left half
	HRRI	S1,.TMVOL		;Get Volume subtype entry
	MOVEM	S1,ARG.HD(P4)		;Store in subentry header
	MOVE	S1,P4			;Point to argument
	$CALL	UNICHK			;Check VOLID uniqueness
	SKIPT				;All OK?
	 $ERR	(<Volume identifiers must be unique>)
	$RETT

;Routine to store and individual volume identifier

MO$VO3:	$CALL	P$SIXF			;Get the first volume
	JUMPF	[$ERR(<Invalid volume identifier>)]
	JUMPE	S1,[$ERR(<Volume identifier must not be null>)]
	MOVEM	S1,0(P2)		;Store the volume name
	AOS	VOLCNT			;Increment volume count
	ADDI	P2,1			;Increment free address
	$RETT
SUBTTL	MOUNT parser -- General routines

;ADDARG - Routine to add a 2 word argument to general message
;ADDSUB - Routine to add a 2 word subentry argument to MOUNT message

;ACCEPTS	S1/ Data word to be stored in message
;		S2/ argument type code
;		P1/ Address of message header
;		P2/ Address of first free word in message
;		P3/ Address of current mount entry

ADDARG::
	AOSA	.OARGC(P1)		;Increment message arg count
ADDSUB::
	INCR	.MECNT(P3)		;Increment subargument count
	MOVEM	S1,ARG.DA(P2)		;Store data word
	HRLI	S2,ARG.SZ		;Get size of 2
	MOVEM	S2,ARG.HD(P2)		;Store in header
	ADDI	P2,ARG.SZ		;Point to next free word
	$RETT

;CPYARG - Routine to copy argument to general message
;CPYSUB - Routine to copy subargument to MOUNT message

;ACCEPTS	S1/ Address of argument header word
;		S2/ Number of words in argument

;RETURNS	S2/ Address of argument header in message

CPYARG::
	AOSA	.OARGC(P1)		;Increment message arg count
CPYSUB::
	INCR	.MECNT(P3)		;Increment subargument count
	MOVS	S1,S1			;Create BLT pointer
	HRR	S1,P2
	ADD	S2,P2			;Get Next Free address
	BLT	S1,-1(S2)		;Copy the whole argument
	EXCH	P2,S2			;P2 points to next free address
	$RETT				;S2 points to stored argument

;CPYSTR - routine to store asciz string

;ACCEPTS	S1/ Pointer to source string
;		S2/ Pointer to destination string

CPYSTR::
	ILDB	TF,S1
	IDPB	TF,S2
	JUMPN	TF,CPYSTR
	$RETT
;TAPCHK	- routine to ensure that we are processing a tape request
;DSKCHK - routine to ensure that we are processing a disk request

;ACCEPTS	S1/ Pointer to error prefix

TAPCHK:	TXNE	F,FL.DSK		;Disk request?
	 $ERR	(<^Q/S1/ is only valid for tape>)
	TXO	F,FL.TAP		;Remember we have a tape request
	$RETT

DSKCHK:	TXNE	F,FL.TAP		;Tape request?
	 $ERR	(<^Q/S1/ is only valid for disk>)
	TXO	F,FL.DSK		;Remember we have a disk request
	$RETT

;LOGCHK - check and add LOGICAL name to mount request

LOGCHK:	SKIPN	S1,LOGNAM		;See if logical name
	 $RETT				;No--Just return
	TXNE	F,FL.DSK		;Disk request?
	 JRST	LOGC.1			;Yes--No logical name
	DEVCHR	S1,			;See if logical name in use
	JUMPE	S1,LOGC.2		;No--Thats OK
	TXNN	S1,DV.ASC!DV.ASP	;Assigned by console or program?
	JRST	LOGC.2			;No
	SKIPE	BATJOB			;Batch job?
	$TEXT	(,<% Specified logical name "^W/LOGNAM/" already in use>)	;Yes--Tell him
	MOVX	S1,<INSVL.(.FORED,FO.FNC)!FO.ASC>;Get a new channel
	MOVEM	S1,FBLK+.FOFNC		;Store
	SETZM	FBLK+.FOIOS		;No mode
	MOVE	S1,LOGNAM		;Get device
	MOVEM	S1,FBLK+.FODEV		;Store device
	SETZM	FBLK+.FOBRH		;And no buffers
	MOVE	S1,[.FOBRH+1,,FBLK]	;Point to FILOP.
	FILOP.	S1,			;Open the device
	 JRST	LOGC.2			;Cant
	LOAD	S1,FBLK+.FOFNC,FO.CHN	;Get channel
	MOVEI	S2,0			;Clear logical name
	DEVLNM	S1,			;Zap it
	 JFCL				;We tried
	MOVX	S1,.FOREL		;Release function
	STORE	S1,FBLK+.FOFNC,FO.FNC	;Store it
	MOVE	S1,[1,,FBLK]		;Point to FILOP.
	FILOP.	S1,			;Release channel
	 JFCL				;Cant

LOGC.2:	MOVE	S1,LOGNAM		;Get logical name
	MOVX	S2,.TMLNM		;And block type
	$CALL	ADDSUB			;Add it
	$RETT				;And return

LOGC.1:	SKIPE	BATJOB			;Batch job?
	$TEXT	(,<% Logical name "^W/LOGNAM/" ignored on disk structure ^W/VSNAME/:>)	;
	$RETT				;Error and return
; Routine to build a volume set name into a MOUNT message block
; Call:	PUSHJ	P,BLDVSN
;	<return>
;
; If the VSN is a generic device, then a VSN of DEV-xxxxxx (where xxxxxx
; is a random alpha-numeric value guaranteed to be unique) will be created.
; Otherwise, the existing VSN will be used.
;
BLDVSN:	MOVEI	TF,0			;Clear character count
	MOVEI	S1,.TMSET		;Get subentry type
	STORE	S1,ARG.HD(P2),AR.TYP	;Store it
	INCR	.MECNT(P3)		;Increment subargument count
	MOVEI	S2,@VSNADR		;Get atring address - ARG.DA
	ADD	S2,[POINT 7,ARG.DA]	;Get byte pointer to read characters
	MOVEI	T1,ARG.DA(P2)		;Get storage address
	HRLI	T1,(POINT 7)		;Make a byte pointer

BLDV.1:	ILDB	S1,S2			;Get a character
	JUMPE	S1,BLDV.2		;Done ?
	PUSHJ	P,BLDV.C		;Store it
	JRST	BLDV.1			;Loop back for another

BLDV.2:	TXNE	F,FL.GDV		;Generic device ?
	PUSHJ	P,BLDV.3		;Yes - generate a special VSN
	MOVX	S1,.CHNUL		;Get a <NUL>
	PUSHJ	P,BLDV.C		;Store it
	IDIVI	TF,5			;Count words in the VSN
	ADDI	TF,ARG.DA+1		;Round up to the next full word
	HRLM	TF,(P2)			;Update word count
	ADD	P2,TF			;Get new first free word pointer
	POPJ	P,			;Return

BLDV.3:	TXNE	F,FL.MOU		;If ALLOCATE,,thats an error
	SKIPN	BATJOB			;If a batch pre-scan,,thats an error
	 $ERR	(<Illegal volume set name specified for MOUNT/ALLOCATE command>)
	MOVEI	S1,"-"			;Get a funny character
	PUSHJ	P,BLDV.C		;Store it
	$CALL	I%NOW			;Get the current time
	MOVEI	T2,6			;Only 6 characters

BLDV.4:	IDIVI	S1,^D36			;Radix 36
	PUSH	P,S2			;Save the remainder
	SOSE	T2			;Count characters
	PUSHJ	P,BLDV.4		;Recurse if not done
	POP	P,S1			;Get a digit
	ADDI	S1,"0"			;Make it ASCII
	CAILE	S1,"9"			;A number ?
	ADDI	S1,"A"-"9"-1		;No - make it a letter

BLDV.C:	IDPB	S1,T1			;Store it
	ADDI	TF,1			;Count characters
	POPJ	P,			;Return
;UNICHK	- routine to ensure uniqueness among argument entries

;ACCEPTS	S1/ Address of argument header

UNICHK:	LOAD	T2,ARG.HD(S1),AR.LEN	;Get argument length
	MOVE	T1,S1			;Save beginning address
	ADDI	T2,-1(S1)		;Compute end test address
UNICH1:	ADDI	T1,1			;Compute next address
	CAML	T1,T2			;Done?
	 $RETT				;Yes..all are unique
	MOVEI	S2,1(T1)		;S2 points to comparision entry
	MOVE	S1,0(T1)		;Get entry to check
UNICH2:	CAMLE	S2,T2			;Finished checking this entry?
	 JRST	UNICH1			;Yes..back for next
	CAME	S1,0(S2)		;No..is it unique?
	AOJA	S2,UNICH2		;Yes..back to check next entry
	 $RETF				;No..return the failure
;DEVCHK - routine to ensure device string is valid

;ACCEPTS	S1/ Pointer to device name string

;RETURNS	S1/ Device type (.TYDSK or .TYMTA)
;		S2/ Sixbit device name (abbrv of name string)

;ERRORS		ER$IDN	Invalid device name
;		ER$NSD	No such device
;		ER$USD	Unsupported device
;		ER$EZD	Ersatz device
;		ER$PLD	Pathological device
;		ER$ASN	Ambigious structure name
;		ER$ISN	Illegal structure name
;		ER$GDN	Generic device name


DEVCHK:	$CALL	S%SIXB			;Convert to sixbit
	ILDB	S1,S1			;Get terminator
	JUMPN	S1,[$RETER(ER$IDN)]	;Invalid device name
	$SAVE	<S2,P1,P2,P3>		;Save sixbit for return
	MOVE	P1,S2			;Save the device name
	MOVE	TF,[1,,P1]		;Yes, get DSKCHR parms
	DSKCHR	TF,			;Get structure status bits
	 JRST	DEVC.1			;Not a disk
	LOAD	TF,TF,DC.TYP		;Get the device type
	CAXN	TF,.DCTAB		;Ambigious?
	 $RETER(ER$ASN)			;Yes, say so
	CAXE	TF,.DCTUF		;Unit within strcuture?
	CAXN	TF,.DCTCN		;Controller class?
	 $RETER(ER$ISN)			;Yes, illegal structure
	CAXE	TF,.DCTCC		;Controller class?
	CAXN	TF,.DCTPU		;Physical unit?
	 $RETER(ER$ISN)			;Yes, illegal structure
	CAXN	TF,.DCTDS		;Generic or ersatz?
	 JRST	DEVC.2			;Yes, check it out some more
	MOVX	S1,.TYDSK		;Its a disk
	$RETT				;And return

DEVC.2:	MOVE	TF,[3,,P1]		;Get PATH. args
	PATH.	TF,			;Find out some more
	 $RETT				;Ignore any error
	TXNE	P2,PT.DLN!PT.EDA	;Pathological name?
	 $RETER(ER$PLD)			;Yes, say so
	TXNE	P2,PT.IPP		;Implied PPN? (ersatz)
	 $RETER(ER$EZD)			;Yes, say so
	$RETER(ER$GDN)			;Else call it generic

DEVC.1:	DEVTYP	S2,			;Get device type
	 $RETER(ER$NSD)			;Unknown device
	JUMPE	S2,[$RETER(ER$NSD)]	;Unknown device
	TXNE	S2,TY.GEN		;A generic device ?
	TXO	F,FL.GDV		;Yes - remember it
	LOAD	S1,S2,TY.DEV		;Load the device type
	CAIE	S1,.TYMTA		;Is it a tape??
	 $RETER(ER$USD)			;No,,Unsupported device
					;(DSKCHR would win if a disk)
	$RETT				;Yes,,return
SUBTTL	MOUNT parser -- Data Storage


	XLIST			;Turn listing off
	LIT			;Dump literals
	LIST			;Turn listing on


$DATA	DEFSWS,1		;Sticky mount switches
$DATA	VOLCNT,1		;Number of volume identifiers specifed
$DATA	LOGNAM,1		;Logical name
$DATA	FBLK,.FOMAX		;FILOP. UUO block

;Global data
$GDATA	VSNAME,1		;6bit Volume set name
$GDATA	VSNDEV,1		;6 bit device name
$GDATA	VSNADR,1		;Address of ASCIZ Volume set name argnt
$GDATA	CMDNAM,1		;Address of parsed command name
$GDATA	BATJOB,1		;Batch job flag (0 = batch job)
SUBTTL	End


	END