Google
 

Trailing-Edge - PDP-10 Archives - cuspmar86binsrc_2of2_bb-fp63a-sb - 10,7/galaxy/batcon/batctl.mac
There are 3 other files named batctl.mac in the archive. Click here to see a list.
TITLE	BATCTL	- GALAXY-10 Batch controller control file logic
SUBTTL	C.D.O'Toole, D.P.Mastrovito /CDO/DPM  12-SEP-85


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


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

	PROLOG	(BATCTL)		;SET UP

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

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


	.TEXT	|,OPRPAR/SEGMENT:LOW|	;LOAD THE GALAXY PARSER
TOPS10	<.TEXT	|,MNTPAR/SEGMENT:LOW|>	;LOAD THE ALLOCATE/MOUNT PARSER

	GLOB	<JIBTXT>
SUBTTL	Table of contents


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


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

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

END010:	$CRLF

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

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

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

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

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

TIM010:	$TIME	(TIM020)
TIM020:	$CRLF

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


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


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


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

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

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

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

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

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

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

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


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

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


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


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


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

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

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

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

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


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


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


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

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

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

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

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


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

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

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

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



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


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

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

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

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


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


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

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

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


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


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

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

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

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

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


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

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


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


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


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


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


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


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


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

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

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

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


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

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

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

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

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

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

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


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

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


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

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

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

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

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


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


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

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


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


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


; Here on positioning errors
;
POSERR:	$WTO	(<Batch error>,<^R/.JQJBB(R)/^I/POSTXT/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
	JRST	B$ABOR##		;ABORT THE JOB

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


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


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


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


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

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

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

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

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

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


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

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

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


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

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

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

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


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


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


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


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


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

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

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

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


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

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

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

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


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


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

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


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


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

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

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

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

>					;END OF $BAT MACRO
SUBTTL	Batch command tables


$BAT
SUBTTL	Batch commands -- ABORT and STATUS

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

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

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

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


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

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


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


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


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


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


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


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

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

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

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

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


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


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


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


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


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


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

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


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


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


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


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

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

	...IF==0			;CLEAR COUNTER

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

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

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


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

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

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

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


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


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


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


; SILENCE command
;
.SILENCE:
	TXO	F,FL.SIL		;SET SILENCE MODE
	JRST	.POPJ1			;RETURN SUCESSFUL
SUBTTL	End


	END