;
.TITLE SGCML- SOOPER GCML
.IDENT /SGCM03/
;
;
; 01-16-APR-75
; 03-6-MAY-75
;	REWIND ON .GOTO
;
; THE CREDIT FOR THE ORIGINAL GCML IMPLEMENTATION GOES TO
; RBG AND CD'E AT DEC.
; THE 'DOT' COMMAND PROCESSOR IS FROM RSX11M IND BY HL AT DEC.
;
;--CREDIT WHERE CREDIT IS DUE---
;
;
;
; THIS IMPLEMENTATION PROVIDES THE SAME CAPABILITES OF THE DEC
; IMPLEMENTATION VERSION 08 PLUS THE FOLLOWING
;
;	-THE .GCML3 CLOSE FEATURE OF LATER GCMLS
;	-COMPLETE SEPARATION OF THE FDB AND GCML TABLE SO THIS
;		ROUTINE MAY BE USED WITH FORTRAN OTS(AND PDS)
;	-THE 'IND' COMMAND PROCESSOR FROM RSX11-M
;	-DOUBLD FDB/LUN CAPABILITY FOR IAS/PDS AND FORTRAN
;		PROGRAMS WISHING TO COMMUNICATE WITH THE TERMINAL AND
;		THE INDIRECT FILES SIMULTANIOUSLY.
;	-THE FOLLOWING MACROS ARE ASSOCITAED WITH THIS ROUTINE
;
;	GCML$	GET COMMAND LINE
;	RCML$	RESET GCML TABLE
;	CCML$	CLOSE TOP LEVEL
;	SCML$	FORCE THE NEXT LINE TO A PRESET ASCIZ TEXT
;	GCMLD$	TABLE OFFSET AND BIT DEFINITIONS
;	GCMLB$	TABLE GENERATION
;
;
;
; J.E. POLLACK  U. OF WASHINGTON SEATTLE 16-APR-75
;
;
;
	P$$CMD=1			;INCLUDE CODE FOR '.' COMMANDS
	I$$DCT=1			;INCLUDE CODE FOR '@' CGMMANDS
;
;
;
	.MCALL QIOSY$
	QIOSY$
;
	.MCALL FDOFF$,FCSBT$,CSI$,NMBLK$
	FDOFF$	DEF$L
	FCSBT$	DEF$L
	CSI$	DEF$L
;
;	.MCALL GCMLD$
	GCMLD$	DEF$L
;
	.MCALL CALL,RETURN
	;.MCALL ALUN$S		;CAN'T BE USED ALONE
	.MCALL DIR$
	.MCALL CSI$1,CSI$2,CSI$SW,CSI$ND
	.MCALL	FDOP$R,FDRC$R
;
	.MCALL	OFID$R,OPEN$R,CLOSE$,PUT$,GET$
;
;
	.MACRO SAVAL
	CALL	$SAVAL
	.ENDM
;
	.MACRO SAVNVR
	JSR	R5,$SAVRG
	.ENDM
;
;
	.MACRO PUSH X
	MOV	X,-(SP)
	.ENDM
	.MACRO POP X
	MOV	(SP)+,X
	.ENDM
;
;
	.PSECT $CODE0,I,CON,LCL		;ALL CODE IS PURE
;
;
.PAGE
.SBTTL GCML -GET NEXT COMMAND LINE
;
; GET COMMAND LINE CALLED WITH R0=ADDRESS OF GCML TABLE
;
.GCML1::
	SAVAL			;SAVE ALL REGISTERS
	MOV	R0,R5		;R5=TABLE ADDRESS ALWAYS
;
; GET NEXT LINE FROM MCR, USER,PRESET LINE, OR INDIRECT FILE
;
10$:
	CALL	GETLIN
	BCS	30$		;BR IF ERROR, R0 HAS CODE
;
20$:
	; PROCESS LINE OBTAINED
	CALL	PROLIN
	MOV	R1,G.CMLD+2(R5)	;RETURN LINE DESCRIPTOR
	MOV	R2,G.CMLD+0(R5)	;
	BCC	40$		;C-CLR => PASS LINE TO USER
	TST	R0		;IF RO=0, THEN LINE IS PROCESSED ALREADY
	BEQ	10$		;GO FOR ANOTHER
;
30$:
	MOVB	R0,G.ERR(R5)	;SET RETURN ERROR CODE
	SEC			;RESET ERROR FLAG
	BR	60$		;RETURN
;
40$:
	BIT	#GS.TRA!GS.TRC,G.CMDF(R5)	;TRACING?
	BEQ	42$
	MOV	R5,R0
	CALL	.GCML4			;USE WIRED IN ECHO ROUTINE
42$:	BITB	#GE.CLO,G.MODE(R5); CLOSE FILE ON EXIT?
	BEQ	50$		;NO
	MOV	G.FFDB(R5),R0	;GET FDB ADDRESS
	TST	F.BDB(R0)	;IS IT REALLY OPEN?
	BEQ	50$		;BR IF NOT
	CALL	PSHCLO		;CLOSE FLE
	BCS	30$		;IF CLOSE ERROR
;
50$:	CLC
60$:	RETURN			;RETURN TO USER
;
;
.PAGE
.SBTTL RCML  RESET COMMAND NEST TO TOP LEVEL
;
; CALLED WITH R0=GCML TABLE ADDRESS
;
.GCML2::
	SAVAL		;SAVE REGS AND SETUP
	MOV	R0,R5
	TSTB	G.LEVL(R5)
	BLE	20$		;DON'T RESET BOTTOM LEVEL
;
	MOV	G.FFDB(R5),R0	;GET INDIRECT FILE FDB POINTER
	CLOSE$		;CLOSE IT IF OPEN
;
	MOV	R5,R0
	ADD	#G.PDSA+G.PDSL,R0;POINT TO BASE OF PUSHDOWN STACK
	MOV	R0,G.PPTR(R5)	;AND RESET IT TO BOOTOM
;
	MOVB	#1,G.LEVL(R5)	;RESET TO  LEVEL TO FORCE TERMINAL OPEN
	CLC
20$:	RETURN
;
;
.PAGE
.SBTTL CCML  CLOSE TOP LEVEL TO FREE BUFFER
;
;
; CALLED WITH R0=GCML TABLE ADDRESS
;
.GCML3::
	SAVAL
	MOV	R0,R5
;
	CALL	PSHCLO		;PUSH AND CLOSE
	BCC	15$
	MOVB	R0,G.ERR(R5)	;SET RETURN ERROR CODE
;
15$:	RETURN
;
;
.PAGE
.SBTTL ECML  ECHO COMMAND LINE TO TERMINAL
;
;
; CALLED WITH R0=GCML TABLE ADDRESS
;
;
.GCML4::
	SAVAL
	MOV	R0,R5
	;
	CALL	TYCRLF
	MOV	G.CMLD+2(R5),R3	;GET LINE ADDRSS
	MOV	G.CMLD+0(R5),R4	;GET SIZE
	CALL	PUTLIN
	JMP	TYCRLF
.PAGE
.SBTTL GETLIN GET NEXT LINE
;
; INTERNAL SUB CALLED WITH R5=GCML TABLE
;
; RETURNS C-CLR IF R1/R2 CONTAINS DESCRIPTOR OF LINE OBTAINED
;			WITH NULL AT END OF LINE
;         C-SET AND R0=ERROR CODE IF ERROR ENCOUNTERED
;
GETLIN:
	SAVNVR				;SAVE R3,R4,R5
5$:
	TSTB	G.LEVL(R5)		;WHAT LEVEL ARE WE AT?
	BGT	20$		;BR IF NESTED
	BMI	10$		;BR IF WE HAVEN'T DONE MCR YET
;
	MOV	#GE.EOF,R0	;SET CODE
	SEC
	BR	100$		;EOF EXIT
;
10$:
	BIC	#GS.DIS,G.CMDF(R5)	;CLEAR LINE DISPLAYED FLAG
;
	;INITAL ENTRY PROCESS MCR LINE IF ANY
;
	INCB	G.LEVL(R5)	;NEVER COME HERE AGAIN
	CALL	GETMCR		;GET THE LINE
	BCC	95$		;RETURN IF GOT IT,(R1,R2) DESCRIBES LIE
	INCB	G.LEVL(R5)	;ADVANCE TO LEVEL 1 FOR TERMINAL OPEN
	FDOP$R	G.FFDB(R5),,,#DFLTNB;SET ADDRESS OF DEFAULT FILE NAME BLOCK
	FDRC$R	,,G.RBUF(R5),#80.;SET USER LINE BUFFER ADDRESS
	OPEN$R				;AND OPEN THE FILE
	MOV	#GE.OPR,R0	;SET OPEN ERROR CODE
	BCS	100$		;RETURN WITH IT
;
20$:
	MOV	G.PLIN(R5),R0	;GET PRESET LINE POINTER IF ANY
	BEQ	25$		;NO PRESET LINE
	CALL	PLXFER		;SHIFT STRING TO BUFFER AND ADVANCE
				;OR RESET STRING
	MOV	R0,G.PLIN(R5)	;RESET POINTER
	BCS	25$		;BR IF NOE
	BR	95$		;AND GO PROCESS IT
;
25$:
	MOV	G.FFDB(R5),R0	;GET FDBA DDRESS FOR GETTING COMMANDS
	TST	F.BDB(R0)	;IS IT OPEN?
	BNE	30$		;BR IF NOT
;
	CALL	POPOPN		;OPEN TOP LEVEL
	BCS	100$
;
30$:
				;NOW GET A LINE VIA THE FILE FDB
				;ATTATCH/DETATCH IF THE DEVICE IS
				;A TERMINAL  SO AS TO BE NEAT.
	BITB	#FD.TTY,F.RCTL(R0)	;THIS WILL TELL US
	BEQ	34$
;
	JSR	R5,DOAQIO	;DO ATTATCH
	+IO.ATT
;
	MOV	G.PSDS+2(R5),R1		;GET PROMPT STRING ADDRESS
	MOV	G.PSDS+0(R5),R2		;AND LENGTH
	BNE	32$			;BR IF THE USER SUPPLIED NOE
	MOV	R5,R1		;OTHERWISE USE THE DEFAULT
	ADD	#G.DPRM,R1	;POINT TO IT
	MOV	#6,R2
32$:
	BICB	#FD.FTN!FD.CR,F.RATT(R0);FORCE THE RIGHT KIND OF LINE CONTROL
	PUT$	R0,R1,R2	;PUT PROMPT
	BCS	36$		;BUZ OUT IF ERROR
34$:
	GET$	R0,G.RBUF(R5),#80.; READ A LINE
	MOVB	F.ERR(R0),R4	;SAVE FOR ERROR TEST
36$:
	ROR	R5		;SAVE ERROR CARRY BIT
	BITB	#FD.TTY,F.RCTL(R0); HOW ABOUT DETATCH
	BEQ	38$		;NOT TODAY
	JSR	R5,DOAQIO
	+IO.DET
38$:
	ROL	R5		;RESTORE CARRY
	BCC	90$		;BR IF OK
;
	CMPB	#IE.EOF,R4	; WAS IT AN EOF?
	BNE	45$		;NOPE, WUSS.
	CLOSE$	R0		;DONE WITH THIS LEVEL
	BR	5$		;AND TRY AGAIN
;
45$:
	MOV	#GE.IOR,R0	;SET I/O ERROR
	SEC
	BR	100$		;AND RETURN
;
;
90$:
	MOV	F.NRBD+2(R0),R1	;GET RESULTING LINE
	MOV	F.NRBD+0(R0),R2
	MOV	R1,R3		;GET POINTER TO LAST CHAR+1
	ADD	R2,R3
	CLRB	(R3)		;AND ENSURE A NULL
;
95$:
	MOV	R1,R0
	CALL	DISPLY		;TRACE DISPLAY
;
	CLC
100$:
	RETURN
;
;
;
.PAGE
.SBTTL PROLIN PROCESS LINE OBTAINED BY GETLIN
;
;
; ON ENTRY R5=TABLE ADDRESS,(R0,R1,R2) CONTAIN LINE DESCRIPTOR
; AT EXIT (R1,R2) DESCRIBES LINE TO BE RETURNED TO USE
; OR R0 HAS ERROR CODE
;
; 
; 4 LINE TYPES ARE DISTINGUISHED
;  ';' COMMENT LINES
;  '@' INDIRECT FILE SPECIFICATION WITH TRACE SWITCHES
;  '.' IND PROCESSOR COMMANDS
;  ALL OTHERS ARE RETURNED TO THE CALLER
;
;
PROLIN:
;
.IF DF P$$CMD
;
; PROCESS '.' COMMAND LINES
3$:
	CMPB	#'.,(R1)		;IS IT A COMMAND?
	BNE	5$			;NO, TRY THEOTHERS
	BITB	#GE.CMD,G.MODE(R5)	;? LEGAL?
	BEQ	100$			;BR IF NOT
	CALL	PROCMD			;PROCESS IT
	BCS	110$			;BR IF LINE DONE OR ERROR
	BR	3$			;SEE IF A DOT COMMAND IS WAITING
5$:
	BIT	#GS.SKP,G.CMDF(R5)	;AR WE SKIPPINT?
	BNE	90$			;YES, SAY LINE DONE
					;OTHERWISE FALL THROUGH FOR
					;MORE PROCESSING
.ENDC
;
;
; PROCESS COMMENTS
;
10$:
	CMPB	#';,(R1)		;A COMMENT?
	BNE	20$
	BITB	#GE.COM,G.MODE(R5)	;LEGAL?
	BEQ	100$			;NO RETURN TO USER
	BR	90$			;SIGNAL LINE PROCESSING DONE
;
20$:
	.IF DF I$$DCT			;INDIRECT FILES ?
	.IFT
	CMPB	#'@,(R1)		;INDIRECT FILE SPEC?
	BNE	100$			;NOPE
	BITB	#GE.IND,G.MODE(R5)	;LEGAL?
	BEQ	100$			;NO, RETURN IT TO USER
;
; PROCESS INDIRECT FILE SPEC
;
	CMPB	G.LEVL(R5),G.MAXD(R5)	;HOW DEEP ARE WE?
	BGE	50$			;BR IF TOO DEEP
	SUB	#C.SIZE,SP		;ALLOCATE A CSI BLOCK ON THE STACK
;
	INC	R1			;BUMP PAST @
	DEC	R2			;
	BEQ	52$			;NULL FILE SPEC
;
	MOV	SP,R0			;POINT TO CSI BLOCK
	CSI$1	R0,R1,R2		;SYNTAX CHECK
	MOV	C.CMLD(R0),G.CMLD(R5)	;SAVE COMPRESSED STRING LENGTH
	INC	G.CMLD(R5)		;ALLOW FOR @
	BCS	52$			;AND BR IF SYNTAX ERROR
;
	CSI$2	R0,INPUT		;LOOK FOR AN INPUT SPEC
	BCS	52$			;SYNTAX ERROR
	BITB	#CS.DVF!CS.DIF!CS.NMF!CS.WLD!CS.MOR,C.STAT(R0)
	BNE	52$			;NO INPUT SPECS ARE ALLOWED
;
	CSI$2	R0,OUTPUT,#GCMLSW	;LOOK FOR OUTPUT SPEC
	BCS	52$
	BITB	#CS.WLD!CS.MOR,C.STAT(R0);NO WILD OR SECOND FILE SPEC
	BNE	52$
	BITB	#CS.DVF!CS.NMF,C.STAT(R0);FILE OR DEVICE REQUIRED
	BEQ	52$
;
	MOV	G.FFDB(R5),R0		;GET FILE FDB
	CALL	PSHCLO			;CLOSE TOP FILE
;
	MOV	SP,R1			;POINT TO DATASET DESCRIPTOR
	ADD	#C.DSDS,R1
;
	FDOP$R	R0,,R1,#DFLTNB		;SET DATASET POINTER AND DFNB POINTER
	OPEN$R	R0
	BIS	C.MKW1-C.DSDS(R1),G.CMDF(R5);SAVE SWITCHES IF ANY
	ROR	R5			;SAVE CARRY
	ADD	#C.SIZE,SP		;CLEAR STACK OF CSI BLOCK
	ROL	R5			;RESTORE CARRY
	BCC	90$			;INDICATE LINE PROCESSING COMPLETE
					;
	CALL	POPOPN			;OPEN ERROR, REVERT TO LAST
	BR	54$			;BR TO INDICATE ERROR
;
;
50$:	MOV	#GE.MDE,R0		;MAX DEPTHE EXCEEDED
	BR	92$
52$:	MOV	#GE.BIF,R0		;BAD INPUT FILE
	BR	92$
54$:	MOV	#GE.OPR,R0		;OPEN ERROR
	BR	92$
;
	.IFF
	BR	100$
	.ENDC
;
;
;
;
; EXITS TO CALLER
;
90$:	CLR	R0			;LINE DONE
92$:	SEC				;ERROR
	RETURN
100$:	CLC
110$:	RETURN
;
;
;
.PAGE
.SBTTL PROCMD '.'-COMMAND PROCESSOR
;
;
	.IF DF P$$CMD		;DO WE WANT COMMANDS?
	.IFT
;
	.MCALL MRKT$S,WTSE$S
	EFN1=1				;EVENT FLAG FOR WAITS
;
;	THESE COMMANDS ARE FLAGGED BY A PERIOD (.) IN CHARACTER 
;	POSITION ONE OF THE LINE.
; INPUT:
;	R0=ADDRESS OF FIRST CHAR IN LINE
;	R1 - ADDRESS OF FIRST CHARACTER IN LINE (PERIOD)
;	R2 - BYTE COUNT OF CHARS IN LINE
;	R5 - GCML TABLE ADDRESS
;OUTPUT:
;	C-CLR
;	R1,R2 AS ABOVE POINTING TO REMAINING LINE TO BE
;       PASSED TO USER
;	C-SET
;	R0=0 FOR LINE DONE,=ERRCODE FOR ERROR
;
;
;-
PROCMD:
	BIT	#GS.SKP,G.CMDF(R5)	;ARE WE SKIPPING?
	BEQ	5$
	JMP	LABEL
5$:
	MOV	R0,R4		;SAVE FOR LABEL TEST
	TSTB	(R0)+		; SKIP PERIOD
INDC:	MOV	#CMDTAB,R2	; POINT TO VALID COMMANDS
	CLR	R1		; ZERO INDEX
10$:	MOV	R0,R3		; COPY COMMAND POINTER
	CALL	COMPAR		; IS THIS THE COMMAND?
	BCC	40$		; YES
20$:	TSTB	(R2)+		; END OF COMMAND TEMPLATE?
	BNE	20$		; NO, LOOP
	TST	(R1)+		; INCREMENT INDEX
	TSTB	(R2)		; END OF VALID COMMANDS?
	BNE	10$		; NO, TRY NEXT OPCODE
	MOV	R4,R2		; GET STARTING ADDRESS OF BUFFER
	INC	R2		; POINT TO SECOND CHARACTER
	CMP	R0,R2		; ARE WE AT THE SECOND CHARACTER?
	BEQ	50$		; YES, IT MUST BE A LABEL
	JMP	SYNERR		; NO, SYNTAX ERROR
40$:	MOV	R3,R0		; UPDATE BUFFER POINTER
50$:	JMP	@PROTAB(R1)	; PROCESS COMMAND
;
.PAGE
	.SBTTL	PAUSE AND DELAY PROCESSING
;
; DELAY COMMAND  - FORMAT "DELAY NNNU" NNN - COUNT, U - UNIT
;
DELAY:	CALL	$GNBLK		; GET NEXT NON-BLANK
	BCS	20$		; EOL IS ERROR
	DEC	R0		; BACK UP TO POINT TO FIRST CHARACTER
	CALL	$GTNUM		; GET COUNT OF UNITS
	MOV	#1,R3		; SET UNIT TO TICKS
	CMPB	R2,#'T		; TICKS?
	BEQ	10$		; YES
	INC	R3		;
	CMPB	R2,#'S		; SECONDS?
	BEQ	10$		; YES
	INC	R3		; NO
	CMPB	R2,#'M		; MINUTES?
	BEQ	10$		; YES
	INC	R3		; NO
	CMPB	R2,#'H		; HOURS?
	BNE	20$		; NO ERROR
10$:
;	MOV	#DELMSG,R0
;	CALL	MSGPUT
;
	MRKT$S   #EFN1,R1,R3
	WTSE$S	#EFN1		; WAIT TILL TIME IS UP
;
;	MOV	#RESMSG,R0
;	CALL	MSGPUT
;
	JMP	NOLINE
20$:	JMP	SYNERR
.PAGE
	.SBTTL	 SET PROCESSOR
;
; .SET COMMAND IS '.SET L T' TO SET L AS .TRUE.
;
;
SET:
	CALL	$GNBLK		;GET NEXT NON BLANK CHAR
	BCS	10$		;BR IF ERROR (EOL)
	DEC	R1		;ANY BLANKS?
	BNE	10$		;MUST BE ONE
	CALL	SRCSYM		;GET SYMBOL
	BCS	10$
	CLRB	(R4)		;SET FALSE
	CALL	$GNBLK		;GET T/F LETTER
	BCS	10$		;IF ERROR
	DEC	R1		;MUST BE ONE BLANK
	BNE	10$
	CMPB	-(R0),#'F	;FALSE
	BEQ	5$		;YES, DONE
	INCB	(R4)		;ANYTHING ELSE IS TRUE
5$:	JMP	NOLINE		;DONE
10$:	JMP	SYNERR
;
;
.PAGE
	.SBTTL	 DATA PROCESSOR
;
;   .DATA COMMAND
;	.DATA ['PREFIX'][PROMPT]
;
;
DATA:
	MOV	G.RBUF(R5),R4		;POINT TO RETURN BUFFER ADDRESS
	CALL	$GNBLK		;GET NEXT NON-BLANK CHARACTER
	BCS	35$			;BR IF EOL
	CMPB	R2,#''			;IS THERE A PREFIX STRING?
	BNE	20$			;BR IF NOT
5$:	MOVB	(R0)+,(R4)
	BEQ	20$			;EOL, PROCEED TO PROMPT
	CMPB	(R4)+,#''		;END OF PREFIX?
	BNE	5$			;BR IF NOT
	DEC	R4
20$:
	MOV	R0,R1			;SAVE ADDR OF START OF PROMPT
24$:	TSTB	(R0)+			;LOOK FOR END OF LINE
	BNE	24$			;NOT YET
	MOV	R0,R2
	SUB	R1,R2
	DEC	R2			;(R1,R2) NOW DESCRIBES PROMPT
	BNE	28$			;GO PROMPT USER
;
	MOV	R5,R1			;USE DEFAULT PROMPT INSTEAD
	ADD	#G.DPRM,R1
	MOV	#6,R2
;
28$:	PUSH	R4			;SAVE OUTPUT STRING ADDR
	MOV	R1,R3
	MOV	R2,R4			;SHUFFLE FOR PUTLIN CALL
	CALL	PUTLIN
	POP	R4			;RESTORE OUTPUT POINTER
	BCS	35$
	CALL	REDLIN			;GET HIS RESPONSE
30$:	MOVB	(R1)+,(R4)+		;SHUFFLE LINE TO RETURN BUFFER
	BNE	30$
	DEC	R4			;BACKUP OVER NULL
	MOV	G.RBUF(R5),R0		;POINT TO BUFFER
	INC	R0
	JMP	RETLIN			;AND RETURN CONCATINATED LINES 
35$:
	JMP	SYNERR			;SYNTAX IF ERRORS
.PAGE
	.SBTTL 	ASK PROCESSOR
;
; GET SYMBOL AND SEARCH SYMBOL TABLE FOR IT
;
ASK:	CALL	$GNBLK		; GET NEXT NON-BLANK
	BCS	3$		; EOL IS AN ERROR
	TST	R1		; A BLANK SEEN?
	BNE	5$		; YES
3$:	JMP	SYNERR		; NO, SYNTAX ERROR
5$:	CALL	SRCSYM		; SEARCH SYMBOL TABLE FOR SYMBOL
	BCC	10$		; FOUND IT
	JMP	SYMOFL		;NO,ILLEGAL SYMBOL
;
; SLOT FOUND,ASK QUESTION
;
10$:
	CLRB	(R4)		; SET VALUE TO FALSE
	MOV	G.RBUF(R5),R1	; SET OUTPUT BUFFER ADDRESS
	MOVB	#CR,(R1)+	; PUT A CRLF FIRST
	MOVB	#LF,(R1)+
	MOVB	#'*,(R1)+	; PUT IN QUESTION INDICATOR
20$:	MOVB	(R0)+,R3	; GET NEXT CHARACTER
	BEQ	30$		; YES
	MOVB	R3,(R1)+	; NO, PUT IN CHARCTER
	BR	20$		; LOOP
30$:	MOV	#YESNO,R2	; SET QUESTION TEXT
	CALL	MOVE		; MOVE IT TO BUFFER RETURN WIH TERM NULL
40$:	MOV	G.RBUF(R5),R0	; RESET POINTER TO LINE
	CALL	MSGPUT		;ASK QUESTION
;
;
; READ ANSWER AND SET TRUE/FALSE FLAG
;
	CALL	REDLIN		;READ THE ANSWER
				; R0 POINTS TO FIRST CHARACTER
	BCS	40$		; TRY AGAIN IF ERROR (KLUDGE)
	TSTB	(R0)		;ANY CHARACTERS?
	BEQ	60$		; NO, THIS DEFAULTS TO NO
	CMPB	#'Y,(R0)		; IS IT YES?
	BEQ	50$		; YES
	CMPB	#'N,(R0)	; NO, IS IT NO?
	BEQ	60$		; YES
	MOV	#INVMSG,R0
	CALL	MSGPUT
	BR	40$		; LOOP
50$:	INCB	(R4)		; SET TRUE (=1)
60$:
	BR	NOLINE		;RETURN, DONE.
.PAGE
	.SBTTL	IFT, IFF, AND GOTO PROCESSOR
IFT:	MOV	#1,-(SP)		; SET UP TRUE CONDITION
	BR	IF		;
IFF:	CLR	-(SP)		; SET UP FALSE CONDITION
IF:	CALL	$GNBLK		; GET NEXT NON-BLANK
	BCS	IFERR		; EOL IS AN ERROR
	TST	R1		; ANY BANKS SEEN?
	BEQ	IFERR		; NO, SYNTAX ERROR
10$:	CALL	SRCSYM		; LOCATE SYMBOL IN SYMBOL TABLE
	BCC	20$		; FOUND IT
	BR	UDFSYM		; UNDEFINED SYMBOL
20$:	CMPB	(SP)+,(R4)	; CONDITION MET?
	BEQ	30$		; YES
	BR	NOLINE		; END OF LINE
;
; PROCESS NEXT PART OF COMMAND
;
30$:	CALL	DISPLY		; DISPLAY COMMAND
	CALL	$GNBLK		; GET NEXT NON-BLANK
	BCS	IFERR		; EOL IS AN ERROR
	TST	R1		; ANY BLANKS?
	BNE	RETLIN		; GO RETURN LINE FOR MORE PROCESSING
IFERR:	BR	SYNERR		; SYNTAX ERROR
;
.PAGE
.SBTTL	GOTO PROCESSOR
; SET UP GOTO HERE
;
GOTO:
				;ALWAYS REWIND FILE FIRST. THIS DOESN'T
				;TAKE 'ANY' TIME AND PERMITS BRANCH BACKS
	PUSH	R0		;SAVE LINE POINTER
	MOV	G.FFDB(R5),R0	;GET FILE FDB
	CLR	R1		;HVBN
	MOV	#1,R2		;LVBN
	CLR	R3
	CALL	.POINT		;REWIND FILE
	POP	R0
	BCS	SYNERR
;
	CALL	$GNBLK		; GET NEXT NON-BLANK
	BCS	5$		; EOL IS ERROR
	TST	R1		; BLANK SEEN?
	BNE	10$		; YES
5$:	BR	SYNERR		; NO, SYNTAX ERRROR
10$:
	MOV	R5,R3		; GET ADDRESS OF SEARCH ARGUMENT
	ADD	#G.LABL,R3	; POINT TO SAVE AREA
	MOV	R3,-(SP)	; DERIVE POINTER TO LAST POSITION
	ADD	#6,(SP)
20$:	CMP	R3,(SP)		; END OF LABEL?
	BEQ	40$		; YES, USE FIRST SIX CHATCARETS
	MOVB	R2,(R3)+	; STORE NEXT CHARACTER
	CALL	$GNBLK		; GET NEXT NON-BLANK
	BCS	30$		; EOL
	TST	R1		; BLANK?
	BEQ	20$		; NO, LOOP
30$:	CMP	R3,(SP)		; END OF LABEL?
	BEQ	40$		; YES
	CLRB	(R3)+		; NO, CLEAR NEXT BYTE
	BR	30$		; LOOP
40$:
	INC	(SP)+		; REMOVE END POINTER
	BIS	#GS.SKP,G.CMDF(R5)	;SET SKIPPING FLAG
	BR	NOLINE		;SAY LINE DONE
;
; LABEL PROCESSING
;
LABEL:
	BIT	#GS.SKP,G.CMDF(R5)	;SEARCHING?
	BNE	30$		; YES
10$:	CMPB	(R0)+,#':	; END OF LABEL?
	BEQ	20$		; YES
	TSTB	(R0)		; END OF LINE?
	BNE	10$		; NO, LOOP
	BR	NOLINE		; LABEL DONE, GO FOR NEXT LINE
20$:	CALL	$GNBLK		; GET NEXT NON-BLANK
	BR	RETLIN		; RETURN LINE TO CALLER
;
; COMPARE LABEL FOR SEARCH ARGUMENT
;
30$:	MOV	R0,R3		; COPY POINTER
	MOV	R5,R2		; SET ADDRESS OF ARGUMENT
	ADD	#G.LABL,R2
	CALL	COMPAR		; COMPARE THEM
	BCS	40$		; NOT THE SAME
	BIC	#GS.SKP,G.CMDF(R5);SET SEARCH MODE OFF
	BR	10$		; AND EXECUTE THE COMMAND
40$:	BR	NOLINE		; READ IN NEXT COMMAND
;
;
;
;
.SBTTL	COMMENT PROCESSOR
;
;
COMMNT:
	MOV	R0,-(SP)
	CALL	TYCRLF
	MOV	(SP)+,R0
	CALL	MSGPUT		; R0 POINTS TO FIRST CHARACTER
	BR	NOLINE		; LINE IS DONE
	.PAGE
;
; RETURN EXIT POINTS
;
RETLIN:
	DEC	R0		; POINT TO LAST CHARACTER
	MOV	R0,R1
	MOV	R1,R2		; RE-ESTABLIST POINTERS FOR RETURN
45$:	TSTB	(R2)+
	BNE	45$		; LOOK FOR NULL
	SUB	R1,R2
	BR	OKRET
;
SYNERR:
SYMOFL:
UDFSYM:
	MOV	#GE.CER,R0	;SET ERROR CODE
	BR	ERXIT
;
OKRET:
	CLC
	RETURN
NOLINE:	CLR	R0
ERXIT:	SEC
	RETURN
;
.PAGE
	.SBTTL	MISC COMMAND ROUTINES
;+
; *** - COMPAR  - COMPARES TWO STRINGS
;
; INPUT:
;	R2 - TEMPLATE, ENDS WITH ZERO BYTE
;	R3 - STRING TO BE COMPARED
;
; OUTPUT:
;	CARRY CLEAR
;		R2 - END OF STRING
;		R3 - UPDATED PAST LAST CAHARCTER OF STRING
;	CARRY SET
;		R2 - CHARACTER AFTER FIRST NON-MATCHING ONE
;		R3 - CHARACTER AFTER FIRST NON-MATCHING ONE
;
;-
COMPAR:	CMPB	(R3)+,(R2)+	; DO THEY MATCH?
	BNE	10$		; NO
	TSTB	(R2)		; END OF STRING?
	BNE	COMPAR		; NO, LOOP 
	BR	20$		; YES, DONE
10$:	SEC			; SET CARRY BIT
20$:	RETURN			;
;
;
;
;
;+
; *** - MOVE  -  MOVE CHARACTERS INTO BUFFER
;
; INPUT:
;	R1 - OUTPUT BUFFER POINTER
;	R3 - INPUT BUFFER POINTER - ENDS IN ZERO BYTE
;
; OUTPUT:
;	R1, R3  - UPDATED
;
;-
MOVE:
	MOVB	(R2)+,(R1)+
	BNE	MOVE
	DEC	R1		;LEAVE A CLEAR BYTE NEXT
	RETURN			;
 
;+
; *** - SRCSYM   -   SEARCH SYMBOL TABLE
;
; INPUT:
;	R2 - SYMBOL WE'RE LOOKING FOR
;
; OUTPUT:
;	R2 - SYMBOL-#'A
;	CARRY SET
;		ILLEGAL SYMBOL
;	CARRY CLEAR
;		R4 - ENTRY FOR SYMBOL
;
;-
SRCSYM:
	MOV	R2,R4
	SUB	#'A,R4		; CONVERT SYMBOL TO OFFSET
	BLO	10$		; IF OUT OF RANGE
	CMP	#G.MAXS,R4	;  OR OVER SIZE OF TABLE
	BLOS	10$
	ADD	R5,R4
	ADD	#G.STAB,R4	;POINT TO ENTRY
	CLC
	RETURN
10$:	SEC
	RETURN
;
;
 
.PAGE
;+
; *** - $GNBLK  - GET NEXT CHARACTER FROM BUFFER AND FIND NEXT NON-BLANK
; *** - $NNBLK  - STARTING WITH CHARACTER IN R2, FIND NEXT NON-BLANK
;	THIS SUBROUTINE GETS THE NEXT NON-BLANK CHARACTER AND
;	TESTS IT FOR BEING AN END OF LINE CHARACTER.
;
; INPUT:
;	R0 - BUFFER POINTER
;	R2 - $NNBLK ONLY - THE FIRST CHARACTER TO BE TESTED
;
; OUTPUT:
;	R0 - UPDATED TO POINT TO NEXT CHARACTER IN BUFFER
;	R2 - FIRST NON-BLANK FOUND
;	CARRY CLEAR - NO END OF LINE FOUND
;	CARRY SET - END OF LINE (CR, ESC) FOUND, ITS IN R2.
;
SPA=40
CR=15
LF=12
ESC=33
;-
$GNBLK:	MOVB	(R0)+,R2	; GET NEXT CHARACTER
$NNBLK:	CLR	R1		; ZERO BLANK COUNT
5$:	CMPB	R2,#SPA		; IS IT BLANK?
	BNE	10$		; NO
	INC	R1		; YES, SET BLANK FOUND
	MOVB	(R0)+,R2	; GET NEXT CHARACTER
	BR	5$		; LOOP UNTIL NON-BLANK
10$:	CMPB	R2,#CR		; IS IT CARRIAGE RETURN (EOL)?
	BEQ	20$		; YES
	CMPB	R2,#ESC		; NO, IS IT ESCAPE (EOL)?
	BEQ	20$		; YES
	TST	R2		; ZERO BYTE?
	BEQ	20$		; YES
	CLC			; NO, SET NOT EOL FLAG
	BR	30$		;
20$:	SEC			; SET END OF LINE FLAG
30$:	RETURN			;
;
;+
; *** - $GTNUM  - CONVERT AN ASCII NUMBER TO BINARY.
;		IF NUMBER ENDS WITH DECIMAL POINT INTERPRET
;		AS A DECIMAL NUMBER.  IF NOT, INTERPRET AS AN
;		OCTAL NUMBER
;
; INPUT:
;	R0 - BUFFER ADDRESS
;
; OUTPUT:
;	R0 - UPDATED BUFFER POINTER
;	R1 - CONVERT NUMBER IN BINARY
;	R2 - LAST CHAR SCANNED (NOT DECIMAL POINT IF FOUND
;		BUT CHAR AFTER IT).
;
;-
$GTNUM:	MOV	R0,-(SP)	; SAVE BUFFER POINTER
	CALL	$CDTB		; CONVERT DECIMAL TO BINARY
	CMPB	R2,#'.		; END IN DECIMAL POINT ?
	BNE	10$		; NO
	MOVB	(R0)+,R2	; YES, POINT BEYOND IT
	BR	20$		;
10$:	MOV	(SP),R0		; RETIEVE BUFFER POINTER
	CALL	$COTB		; CONVERT TO OCTAL
20$:	TST	(SP)+		; POP BUFFER ADDRESS
	RETURN
;
;
.PAGE
;
	.PSECT $PDATA,D,LCL,CON
;
; INDIRECT FILE PROCESSOR COMMANDS
;
CMDTAB:	.ASCIZ	/DELAY/		;
	.ASCIZ	/ASK/		;
	.ASCIZ	/IFT/		;
	.ASCIZ	/IFF/		;
	.ASCIZ	/GOTO/		;
	.ASCIZ  /SET/		;SET LOGICAL VALUE
	.ASCIZ  /DATA/		;GET USER RESPONSE
	.ASCIZ /;/		;COMMENT
	.BYTE	0		; END OF TABLE
	.EVEN
;
;
; ADDRESS OF COMMAND PROCESSING ROUTINES
;
PROTAB:	.WORD	DELAY		;
	.WORD	ASK		;
	.WORD	IFT		;
	.WORD	IFF		;
	.WORD	GOTO		;
	.WORD	SET
	.WORD	DATA
	.WORD	COMMNT
	.WORD	LABEL		;
;
 
; MISCELANEOUS STRINGS
;
YESNO:	.ASCIZ	%? [Y/N]:%	; QUESTION SUFFIX
;DELMSG:	.BYTE CR,LF
;	.ASCIZ /DELAYING/<CR><LF>
;RESMSG:	.ASCIZ /RESUMING/<CR><LF>
INVMSG:	.BYTE CR,LF
	.ASCII /INVALID COMMAND/
CRLFMG:	.BYTE	CR,LF,0
	.EVEN		
;
;
	.PSECT $CODE0,I,LCL,CON
	.ENDC
;
	.PAGE
;
;
;
.SBTTL POPOPN POP PREVIOUS FILE INFORMATION AND OPEN
;
;
; R0 POINTS TO A FDB. CLOSE THE PREVIOUS FILE, RESTORE INFORMATION
; RE-OPEN PREVIOUS FILE AND POSITION IT TO WHERE WE LEFT OFF.
; R1-R4 ARE FREE FOR MODIFICATION.
;
POPOPN:
	DECB	G.LEVL(R5)
	TSTB	G.LEVL(R5)		;DEC IS UNSIGNED SUBTRACT
	BGT	3$			;BR IF OK TO POP
	MOV	#GE.EOF,R0		;SAY END FILE
	BR	21$			;RETURN 'ERROR'
3$:	MOV	G.PPTR(R5),R4		;GET PUSH POINTER
	SUB	#G.PDSL,G.PPTR(R5)	;UPDATE SAVED VALUE
;
	MOV	R5,R1
	ADD	#G.CMDF+G.CMDV,R1
	MOV	#G.CMDV,R2		;COUNT OF STUFF TO RESTORE
5$:	MOVB	-(R4),-(R1)		;RESTORE STUFF
	SOB	R2,5$
;
	MOV	-(R4),F.FNB+N.UNIT(R0)	;RESTORE DEVICE/UNIT
	MOV	(R4),-(SP)		;GET UNIT
	MOV	-(R4),F.FNB+N.DVNM(R0)
	MOV	(R4),-(SP)		;GET DEVICE
;
	MOV	-(R4),F.FNB+N.FID+4
	MOV	-(R4),F.FNB+N.FID+2(R0)
	MOV	-(R4),F.FNB+N.FID+0(R0)
;
	MOVB	F.LUN(R0),-(SP)		;GET LUN
	CLRB	1(SP)
;	ALUN$S				;PERFORM ASSIGN
	MOV	(PC)+,-(SP)		;MUST BE MANUALLY EXPANDED
	.BYTE	7,4
	DIR$
	BCS	19$
;
	OFID$R	R0			;OPEN BY FID SINCE WE HAVE IT
	BCS	18$
;
	BITB	#FD.DIR,F.RCTL(R0)	;IS THIS A DIRECTORY DEVICE?
	BEQ	20$			;IF SO, DONT POSITION IT.
	MOV	-(R4),R3
	MOV	-(R4),R2
	MOV	-(R4),R1		;GET POSITONING DATA
	CALL	.POINT			;AND ADJUST FDB
	BCC	20$
;
18$:	CMPB	#IE.EOF,F.ERR(R0)	;WAS THIS AN EOF?
	BEQ	20$			;IF SO RETURN, GETLIN WILL SOLVE IT
19$:	MOV	#GE.OPR,R0		;SET OPEN ERROR
21$:	SEC
20$:
	RETURN				;RETURN TO CALLER
.PAGE
.SBTTL PSHCLO  PUSH AND CLOSE FILE INFORMATION
;
;
; RETURNS C-SET IF PUSH WOULD OVERFLOW STACK
;
;
PSHCLO:
	CMPB	G.LEVL(R5),G.MAXD(R5)	;ROOM FOR MORE?
	BGE	10$			;BR IF NOT
	INCB	G.LEVL(R5)		;PUSH IT
	MOV	G.PPTR(R5),R4		;GET POINTER
	ADD	#G.PDSL,G.PPTR(R5)	;ADJUST SAVED VALUE
	CALL	.MARK			;GET POSITON INFORMATION
	MOV	R1,(R4)+
	MOV	R2,(R4)+
	MOV	R3,(R4)+		;SAVE POSITION
	MOV	F.FNB+N.FID+0(R0),(R4)+	;PUT FID+0,+2,+4
	MOV	F.FNB+N.FID+2(R0),(R4)+
	MOV	F.FNB+N.FID+4(R0),(R4)+
	MOV	F.FNB+N.DVNM(R0),(R4)+
	MOV	F.FNB+N.UNIT(R0),(R4)+	;AND DEVICE AND UNIT
;
	MOV	R5,R1			;POINT TO STUFF TO SAVE
	ADD	#G.CMDF,R1
	MOV	#G.CMDV,R2		;START WITH HIGH ORDER FLAGS
6$:	MOVB	(R1)+,(R4)+
	SOB	R2,6$
	CLRB	G.CMDF+1(R5)		;CLEAR HIGH ORDER BYTE
;
;
	CLOSE$	R0			;CLOSE FILE
	CLC
	RETURN
;
10$:
	MOV	#GE.MDE,R0		;SET ERROR CODE
	SEC
	RETURN
;
;
.PAGE
.SBTTL
.SBTTL		----MISC ROUTINES----
.SBTTL DOAQIO
;
;
; DO ATTACH/DETATCH QIO FOR GETLIN
;
DOAQIO:
	PUSH	R2	;SAVE A REG
	CLR	R2	;NO FURTHER ARGUMENTS
	MOV	(R5)+,R1;GET FUNCTION
	CALL	.XQIO	;USE FCS
	POP	R2
	RTS	R5
;
;
.SBTTL PLXFER
;
; PRESET LINE TRANSFER
;
; R0 POINTS TO A TEXT STRING. EACH LINE OF WHICH IS TERMINATED WITH A
; NULL THE LAST LINE OF THE SERIES IS TEMINATED WITH TWO NULLS.
; THE NEXT LINE IS SHUFFLED TO THE USER BUFFER AS THOUGH IT
; HAD BEEN READ FROM A TERMINAL OR FILE.
; R5=GCML TABLE ADDRESS
; R1/R2 FREE ON ENTRY
;
PLXFER:
	MOV	R0,R2			;POINT TO BUFFER
	MOV	R0,R1			;POINT TO BEGINNING OF LINE
5$:
	TSTB	(R2)+			;LOOK FOR ENDOF LINE
	BNE	5$
;
	MOV	R2,R0			;RETURN POINTER
	DEC	R2			;BACKUP TO REAL CHARACTER
	SUB	R1,R2			;GET BYCT
	BGT	10$			;NOT NULL LINE
	CLR	R0			;RETURN END OF LINES
	SEC
	RETURN
10$:
	RETURN
;
;
.SBTTL MISC OUTPUT ROUTINES
;
;
;
DISPLY:
	SAVNVR
	BIT	G.CMDF(R5),#GS.TRA!GS.TRC	;IN TRACE MODE?
	BEQ	10$		; NO
	TSTB	G.CMDF(R5)	; LINE DISPLAYED?
	BMI	10$		; YES
	MOV	G.CMLD+0(R5),R4		;SET SIZE
	MOV	G.CMLD+2(R5),R3		;SET ADDRESS
	BIS	#GS.DIS,G.CMDF(R5); REMBER DISPLAYING
	BR	PUTLIN
10$:	RETURN			;
;
;
;
;
TYPRMT:	SAVNVR				;SAVE R3,4,5
	MOV	R5,R3
	ADD	#G.DPRM,R3		;ADDRESS OF PROMPT
	MOV	#6,R4
;
PUTLIN:
	PUSH	R0
	MOV	G.CFDB(R5),R0	;ADDRESS FDB
	MOVB	F.RATT(R0),-(SP)	;SAVE HOST CCTL
	BICB	#FD.FTN!FD.CR,F.RATT(R0);PROPER CR CONTROL
	PUT$	,R3,R4
	MOVB	(SP)+,F.RATT(R0)
	POP	R0
	RETURN
;
;
TYCRLF:	MOV	#CRLFMG,R0
MSGPUT:
	SAVNVR
	MOV	R0,R3		;COPY POINTER TO TEXT STRING
	MOV	R3,R4		;SET BYTECOUNT
5$:	TSTB	(R4)+		;LOOK FOR NULL
	BNE	5$
	SUB	R3,R4
	DEC	R4
	BR	PUTLIN		;PUT IT
;
;
REDLIN:
	GET$	G.CFDB(R5)	;GET USERS RESPONSE
	MOV	F.NRBD+2(R0),R1	;POINT TO ANSWER STRING
	MOV	F.NRBD+0(R0),R0	;GET BCT
	ADD	R1,R0
	CLRB	(R0)		; ENSURE A NULL TERM
	MOV	R1,R0		;RESTORE POINTER TO FIRST CHAR
	RETURN
;
;
;
;
;
.PAGE
.SBTTL GETMCR
;
; GETMCR - SUBROUTINE CONDITIONALLY GETS AN MCR LINE
;    RETURNS
;    C=1 IF NO MCR LINE, C=0 OTHERWISE
;    R1=STRING ADDRESS
;    R2=STRING LENGTH
;    REGISTERS CHANGED R0-R4
TAB=14
BLANK=40
;
GETMCR:	MOV	G.RBUF(R5),R1;	GET RECORD BUFFER ADDRESS
	MOV	(PC)+,(R1);	SET UP "GET MCR LINE" DPB
	.BYTE	127.,41.;
	DIR$	R1;		TRY TO GET AN MCR LINE
	BCS	10$;		TASK NOT INVOKED AS MCR FUNCTION
	TST	(R1)+;		POINT TO MCR LINE IN BUFFER
	MOV	@#$DSW,R2;	GET BYTE COUNT FOR MCR LINE
2$:	CALL	NXTBYT;		SCAN TO A TAB OR BLANK
	BCS	10$;		NO COMMAND LINE FOLLOWING MCR FUNCTION
	CMPB	R0,#TAB;
	BEQ	4$;
	CMPB	R0,#BLANK;
	BNE	2$;
4$:	CALL	NXTBYT;		SKIP TABS AND BLANKS
	BCS	10$;
	CMPB	R0,#TAB
	BEQ	4$
	CMPB	R0,#BLANK
	BEQ	4$
	MOV	R1,R3;		R1 POINTS TO 2ND BYTE OF COMMAND STRING
	DEC	R3;		SAVE COMMAND LINE START ADDRESS
	CLR	R4;		INITIALIZE STRING COUNT
6$:	INC	R4;		SCAN TO END OF COMMAND STRING
	CALL	NXTBYT
	BCC	6$
	MOV	G.RBUF(R5),R0;	LEFT-JUSTIFY COMMAND STRING IN BUFFER
	MOV	R0,R1;		SET STRING ADDRESS AND LENGTH
	MOV	R4,R2;		AS GETMCR OUTPUTS IN R1,R2
8$:	MOVB	(R3)+,(R0)+;	MOVE COMMAND STRING
	SOB	R4,8$;		TO FINAL POSITION IN BUFFER
	CLC	;		AND INDICATE MCR LINE GOTTEN
10$:	RETURN
;
;
; NXTBYT - GET NEXT BYTE FROM MCR LINE
;    INPUT - R1 IS STRING POINTER, R2 IS REMAINING BYTE COUNT
;    OUTPUT- R1,R2 UPDATED, R0 IS THE BYTE
;    SETS C=1 ON END OF LINE
NXTBYT:	DEC	R2;		CHECK BYTE COUNT
	BLT	2$;		TERMINATE ON BYTE COUNT
	MOVB	(R1)+,R0;	GET NEXT BYTE
	CLC
	RETURN
2$:	SEC	;		INDICATE END-OF-LINE
	RETURN
;
.PAGE
.SBTTL DATA TABLES
;
	.PSECT $PDATA,D,CON,LCL
;
GCMLSW:
	CSI$SW	TR,GS.TRC
	CSI$SW	TA,GS.TRA
	CSI$ND
;
DFLTNB:	NMBLK$	CMD,CMD,,TI,0
;
;
;
;
	.END;