.TITLE	MGCML RSX-11M INDIRECT FILE PROCESSOR GCML
	.IDENT	/M10.9/
;
; COPYRIGHT (C) 1974, 1976, 1977
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
; SINGLE COMPUTER SYSTEM AND MAY  BE  COPIED   ONLY  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   EXCEPT FOR  USE ON SUCH
; SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE  TERMS.  TITLE
; TO AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL  TIMES  REMAIN
; IN DEC.
;
; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
; EQUIPMENT CORPORATION.
;
; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
; ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
;         
; VERSION	M10.9
;   
; WRITTEN BY:    
;	R. GROVE 
;	P. KNEUVEN    
;   
; MODIFIED BY:   
;	C.A. D'ELIA	26-NOV-73	001  
;	C.A. D'ELIA	12-JAN-74	002  
;	C.A. D'ELIA	12-MAR-74	003  
;	C.A. D'ELIA	19-MAR-74	004  
;	C.A. D'ELIA	31-MAR-74	005 
;	C.A. D'ELIA	05-APR-74	006 
;	C.A. D'ELIA	04-JUN-74	007 
;	C.A. D'ELIA	01-JUL-74	008 
;	C.A. D'ELIA	01-AUG-74	009 
;	H. LEV		11-NOV-74
;	H. LEV		14-MAY-75
;
;	HJL027	5/18/76	FIX TEST FOR FINIT
;
;	PW001	02-DEC-76	ADDED ENTRY "$MGCL5" TO CLOSE CURRENT
;				COMMAND FILE AND OPEN A "SUCCESSOR" FILE
;				WITHOUT CHANGING INDIRECTION DEPTH.
;
;	PW002	10-JUN-77	ACCEPT SIZE OF COMMAND BUFFER IN OFFSET
;				G.SIZE. SIZE MUST BE .GE. 80(10).
;
;	PW003	28-JUN-77	USE .DLFNB INSTEAD OF DELET$ TO DELETE FILE.
;
;
; LOCAL OFFSET AND SYMBOL DEFINITIONS
	.MCALL	CSI$		;++009
	CSI$	DEF$L
	.MCALL	GCMLD$		;++009
	GCMLD$	DEF$L
	.MCALL	NBOFF$		;++009
	NBOFF$	DEF$L		;++009 DEFINE NAME BLOCK OFFSETS


	.MCALL	CALL,RETURN,DIR$,CSI$1,CSI$2,CLOSE$  ;++003
	.MCALL	ENCP$S,DSCP$S	;++008
										;**-1

	.IF NDF	R$$11M		;++003

	.MCALL	OPEN$R,GET$	;++003

	.IFF			;++003

	.MCALL	OFNB$R,GET$S,FINIT$  ;++003

	.ENDC			;++003


; INTERNAL GCML$ BLOCK OFFSET DEFINITIONS
G.CDEP	==G.ERR+10.;	CURRENT PUSH DOWN DEPTH
G.MDEP	=G.CDEP+1;	MAXIMUM PUSH DOWN DEPTH
G.PPTR	=G.MDEP+1;	PUSH DOWN STORAGE POINTER
G.RBUF	==G.PPTR+2;	RECORD BUFFER POINTER
G.DPRM	=G.RBUF+2;	DEFAULT PROMPT STRING TEXT
G.DFNB	=G.DPRM+6;	DEFAULT FILE NAME BLOCK
G.SIZE	=G.DFNB+S.FNB		; COMMAND BUFFER SIZE				;PW002
G.PDSL = <3*2>+<13.*2>		;++001 PUSH DOWN FRAME SIZE (16 WORDS)

; G.MODE BIT DEFINITIONS
GE.MCR	=200;		G.MODE BIT, SET IF TOP LEVEL IS MCR LINE
GE.IEF	==	20	; SET IF INTERMEDIATE END OF FILE REACHED
GE.RWD	==	40	; SET MEANS REWIND ON HITTING  EOF
GE.FOP	==	100	; SET MEANS EXIT AFTER OPENING FILE

; ASCII CHARACTER DEFINITIONS
CR	=15
TAB	=11
BLANK	=40
ALTMOD	=33

	.MACRO	.SAVR1
	JSR	R5,.SAVR1
	.ENDM	.SAVR1

; GCML$ - ENTRY TO GET NEXT COMMAND LINE

$MGCL1::.SAVR1
	MOV	R0,R5;		BLOCK POINTER ALWAYS IN R5
	BICB	#GE.IEF,G.MODE(R5) ; CLEAR INTERMEDIATE EOF FLAG
	TSTB	G.CDEP(R5)	;++001 TEST CURRENT DEPTH
	BEQ	LVL0		;++001 SPECIAL TEST IF AT LEVEL ZERO
	BGT	PROMPT		;++001 IF .GT. ZERO, THEN PROMPT FOR CMD
	CALL	GETMCR;		TRY TO GET AN MCR LINE
	BCC	CMLSCN;		GOT ONE - DON'T DO TOP-LEVEL OPEN


	.IF NDF	R$$11M		;++002


	OPEN$R	R5;		TOP-LEVEL OPEN

	.IFF			;++002

	MOV	F.DSPT(R5),R2	;++002 GET DESCRIPTOR IN R2
	CALL	GOPEN		;++002 OPEN THE FILE


	.ENDC			;++002


	BCC	LVL0		;++008 SKIP ON SUCCESS
	JMP	IOERR		;++008 ELSE, INITIAL OPEN FAILED
LVL0:	BITB	#GE.MCR,G.MODE(R5) ;++001 DID WE HAVE MCR INPUT?
	BEQ	PROMPT		; NO
	JMP	TOPEOF		; YES, LEVEL 0 IS END

PROMPT:	TST	F.BDB(R5)	;++001 IS FILE ALREADY OPEN?
	BNE	1$		;++001 YES, SKIP THE OPEN
	CALL	POPOP1		;++001 NO, POP IT UP AND OPEN IT
1$:	BITB	#FD.TTY,F.RCTL(R5) ;++001 IS IT A TTY?
	BEQ	4$;		NO - DON'T PROMPT
	DSCP$S			;++008 DISABLE CHECKPOINTING
	MOV	@#$DSW,-(SP)	;++008 SAVE DIRECTIVE STATUS FOR LATER
	MOV	#IO.ATT,R1	;++001 SPECIFY ATTACH
	CLR	R2		;++001 NO EXTRA QIO PARMS NEEDED
	CALL	.XQIO		;++001 USE FCS TO ATTACH THE TTY
	MOV	G.PSDS+2(R5),R1;USER PROMPT STRING ADDRESS
	MOV	G.PSDS(R5),R2;	USER PROMPT STRING LENGTH
	BNE	2$;		USE USER'S STRING
	MOV	R5,R1;		USE DEFAULT PROMPT FROM BLOCK
	ADD	#G.DPRM,R1;
	MOV	#6,R2;		EXACTLY 6 BYTE'S WORTH
2$:				;++001
	MOV	G.RBUF(R5),R3	;++002 PUT ADDR OF BUFFER IN R3
	MOV	R1,(R3)+	;++002 SPECIFY PROMPT STRING ADDR
	MOV	R2,(R3)+	;++002 SPECIFY BYTE COUNT
	CLR	(R3)		;++002 CLEAR CARRIAGE CONTROL
	CMP	-(R3),-(R3)	;++002 POINT R3 TO PARM LIST
	MOV	#3,R2		;++002 SET PARAMETER COUNT
	MOV	#IO.WVB,R1	;++002 SPECIFY WRITE VIRTUAL BLOCK
	CALL	.XQIO		;++002 SEND PROMPT STRING
	BCS	6$;		DETACH AND I/O ERROR HANDLING
4$:				;++002


	.IF NDF	R$$11M		;++002


	GET$	R5,G.RBUF(R5),G.SIZE(R5) ; READ A COMMAND LINE			;PW002
										;**-1
	.IFF			;++002

	GET$S	R5,G.RBUF(R5),G.SIZE(R5) ; READ A COMMAND LINE			;PW002
										;**-1

	.ENDC			;++002


6$:	ROR	R4		;++001 SAVE THE C-BIT
	MOVB	F.ERR(R5),R3	;++001 SAVE FCS RETURN STATUS
	BITB	#FD.TTY,F.RCTL(R5);	DETACH ONLY IF TTY
	BEQ	8$;
	MOV	#IO.DET,R1	;++001 SPECIFY DETACH
	CLR	R2		;++001 NO EXTRA QIO PARMS NEEDED
	CALL	.XQIO		;++001 USE FCS TO DETACH THE TTY
	TST	(SP)+		;++008 EXAMINE 'DSCP$S' STATUS
	BLT	8$		;++008 SKIP IF IT FAILED EARLIER
	ENCP$S			;++008 ELSE, ENABLE CHECKPOINTING AGAIN
8$:	ROL	R4		;++001 RESTORE THE C-BIT (FROM GET$)
	BCS	IOERR0;
	MOV	F.NRBD+2(R5),R1;GET COMMAND LINE ADDRESS
	MOV	F.NRBD(R5),R2;	GET COMMAND LINE LENGTH

; PROCESS COMMAND LINE OBTAINED
;    R1 IS COMMAND LINE ADDRESS
;    R2 IS COMMAND LINE LENGTH
CMLSCN:	MOV	R1,G.CMLD+2(R5);SET COMMAND LINE ADDRESS
	MOV	R2,G.CMLD(R5);	AND LENGTH
	BEQ	OKOUT;		RETURN NULL LINE TO USER
	BITB	#GE.LC,G.MODE(R5) ; PASS LOWER CASE?
	BNE	30$		; YES
	MOV	R2,-(SP)	; NO, SAVE BUFFER SIZE
	ADD	R2,R1		; POINT TO LAST CHARACTER PLUS 1
10$:	CMPB	-(R1),#141	; IS THIS A LOWER CASE CHARACTER
	BLT	20$		; NO
	CMPB	(R1),#172	; MAYBE
	BGT	20$		;NO
	BICB	#40,(R1)	; YES, CONVERT TO UPPER CASE
20$:	DEC	R2		; DONE?
	BGT	10$		; NO, LOOP
	MOV	(SP)+,R2	; YES, RESTORE COUNT
30$:	CMPB	#';,(R1);	CHECK FOR ; IN COLUMN 1
	BNE	OKOUT		; NONE - RETURN TO USER
	BITB	#GE.COM,G.MODE(R5); COMMENTS PERMITTED ?
	BNE	PROMPT;		YES - GET ANOTHER LINE
	BR	OKOUT;		NO  - RETURN IT TO USER

; I/O ERROR AND END-OF-FILE PROCESSING
IOERR0:	CMPB	#IE.EOF,R3	;++001 END OF FILE ERROR?
	BNE	IOERR;		NO - I/O ERROR
	MOVB	G.CDEP(R5),R0;	ARE WE AT TOP LEVEL ALREADY ?
	BEQ	TOPEOF;		YES - RETURN EOF TO CALLER
	BISB	#GE.IEF,G.MODE(R5) ; SET INTERMEDIATE EOF SEEN
	BITB	#GE.RWD,G.MODE(R5) ; REWIND AFTER EOF?
	BEQ	10$		; NO
	MOV	R5,R0		; COPY FCB ADDRESS
	BITB	#FD.REC,F.RCTL(R5) ; YES, IS THIS RECORD DEVICE?
	BNE	10$		; YES, CAN'T REWIND THEN
	CLR	R1		; NO, SET TO READ VBN1
	MOV	#1,R2		;
	CLR	R3		; BYTE ZERO
	CALL	.POINT		; SET TO START OF FILE
	BCS	IOERR		; I/O ERROR
	BR	3$		; GET NEXT COMMAND
10$:	DEC	R0;		IF NOT AT LEVEL 1
	BNE	2$;		POP UP AND CARRY ON
	BITB	#GE.MCR,G.MODE(R5);IF RETURNING TO LEVEL 0
	BNE	TOPEOF		;++001 AND TOP WAS MCR, RETURN EOF TO CALLER
2$:	CALL	POPOPN;		POP UP A LEVEL
3$:	JMP	PROMPT;		TRY FOR ANOTHER COMMAND

; EXITS FROM $MGCL1 AND $MGCL2

OKOUT:	CLR	-(SP)		;++005 INDICATE GCML SUCCESS

OUT:	BITB	#GE.CLO,G.MODE(R5) ;++005 CLOSE FILE AFTER THIS GET?
	BEQ	1$		;++001 NO, SET RETURN INFORMATION
	CALL	CLOCRT		;++001 YES, CLOSE CURRENT LEVEL
1$:	MOVB	(SP),G.ERR(R5)	;++005 PUT RETURN CODE IN G.ERR
	ROL	(SP)+		;++005 SET C-BIT RETURN STATUS
	MOV	R5,R0;		RESTORE R0
	RETURN

TOPEOF:	CALL	CLODEL		; CLOSE OR DELETE FILE				;PW003
20$:	BICB	#GE.MCR,G.MODE(R5) ;++001 ALL DONE, CLEAR MCR BIT, AND ...	;**-5
	DEC	G.CDEP(R5)	;++001 ... SET DEPTH TO -1 FOR LATER RESTART
	MOV	#GE.EOF,-(SP)	;++005 INDICATE END-OF-FILE
	BR	OUT		;++005
IOERR:	MOV	#GE.IOR,-(SP)	;++005 INDICATE I/O ERROR
	BR	OUT		;++005
OPRERR:	MOV	#GE.OPR,-(SP)	;++005 INDICATE INDIRECT OPEN ERROR
	BR	OUT		;++005
BIFERR:	MOV	#GE.BIF,-(SP)	;++005 INDICATE BAD INDIRECT FILE NAME
	BR	OUT		;++005
MDEERR:	MOV	#GE.MDE,-(SP)	;++005 INDICATE MAX INDIRECT DEPTH EXCEEDED
	BR	OUT

$MGCL2::.SAVR1
	MOV	R0,R5;		SET UP BLOCK POINTER
	TSTB	G.CDEP(R5);	AT TOP ALREADY ?
	BLE	OKOUT		;++007 YES -- EXIT
10$:	DECB	G.CDEP(R5)	;++004 DECREMENT CURRENT DEPTH COUNT
	BEQ	20$		;++004 SKIP BEFORE TOP LEVEL (0) PROCESSED
	SUB	#G.PDSL,G.PPTR(R5)  ;++004 BACK UP THE PUSH-DOWN LIST PTR
	BR	10$		;++004 ITERATE
20$:	INCB	G.CDEP(R5)	;++004 INDICATE LEVEL ONE
	CALL	POPOPN;		POP THINGS UP TO LEVEL 0
	BR	OKOUT;		RETURN BLISSFULLY

; SET UP TO PROCESS AN INDIRECT FILE
; LOOK FOR @ IN COLUMN 1
;    R1 IS COMMAND LINE ADDRESS
;    R2 IS COMMAND LINE LENGTH
;    R5 IS GCML CONTROL BLOCK ADDRESS
;
$MGCL4:: .SAVR1
INDIR:	CMPB	#'@,(R1);	CHECK FOR @
	BNE	OKOUT;		NO  - RETURN LINE TO USER
	BITB	#GE.IND,G.MODE(R5); INDIRECT PERMITTED ?
	BEQ	OKOUT;		NO  - RETURN IT TO USER
; PROCESS INDIRECT FILE
	CMPB	G.CDEP(R5),G.MDEP(R5);	CHECK DEPTH
	BGE	MDEERR;		TOO DEEP
	INC	R1;		SKIP OVER @
	DEC	R2;		1 LESS CHARACTER IN LINE
	CALL	CSI		; INTERPRET FILE NAME				;PW001
	INC	G.CMLD(R5)	; ADJUST LENGTH FOR @ IN COLUMN 1		;PW001
	BCS	BIFERR		; ERROR - JUMP					;PW001
; SAVE FILE ID AND POINTERS							;PW001
	CALL	PSHCLS;		PUSH AND CLOSE FILE				;PW001
	CALL	OPEN		; OPEN NEW FILE					;PW001
	BCS	4$;		ERROR - CLEANUP AND REPORT ERROR		;**-33
	BITB	#GE.FOP,G.MODE(R5) ; EXIT AFTER OPENING FILE?
	BNE	2$		; YES
	JMP	PROMPT;		ALL OK - GET A COMMAND LINE
2$:	RETURN			;
4$:	CALL	POPOPN;		RE-OPEN THE LEVEL ABOVE
	BR	OPRERR;		REPORT ERROR ON @ FILE OPEN
	.PAGE									;PW001
;+										;PW001
; *** - $MGCL5 - CLOSE CURRENT FILE AND OPEN A "SUCCESSOR"			;PW001
;	FILE WITHOUT CHANGING INDIRECTION DEPTH.				;PW001
;										;PW001
; INPUT:									;PW001
;	R1	COMMAND LINE ADDRESS						;PW001
;	R2	COMMAND LINE LENGTH						;PW001
;	R5	GCML CONTROL BLOCK ADDRESS					;PW001
;										;PW001
; OUTPUT:									;PW001
;	IF OK:									;PW001
;	CC-C	0								;PW001
;	G.CMLD	COMPRESSED LENGTH OF COMMAND LINE				;PW001
;										;PW001
;	IF ERROR:								;PW001
;	CC-C	1								;PW001
;	G.ERR	ERROR CODE							;PW001
;		GE.BIF	BAD FILE NAME						;PW001
;		GE.OPR	OPEN ERROR						;PW001
;										;PW001
; REGISTERS ALTERED: R0,R2							;PW001
;-										;PW001
;										;PW001
;										;PW001
$MGCL5::.SAVR1									;PW001
	CALL	CLODEL		; CLOSE OR DELETE CURRENT FILE			;PW003
	CALL	CSI		; INTERPRET FILE NAME				;PW001
	BCS	BIFERR		; ERROR - JUMP					;PW001
	CALL	OPEN		; OPEN FILE					;PW001
	BCS	OPRERR		; ERROR - JUMP					;PW001
	BR	OKOUT		; OK - EXIT					;PW001
	.PAGE									;PW001
;+										;PW001
; *** - CSI - INTERPRET FILE NAME						;PW001
;										;PW001
; INPUT:									;PW001
;	R1	FILE NAME STRING ADDRESS					;PW001
;	R2	FILE NAME STRING LENGTH						;PW001
;	R5	GCML CONTROL BLOCK ADDRESS					;PW001
;										;PW001
; OUTPUT:									;PW001
;	IF OK:									;PW001
;	CC-C	0								;PW001
;	$CSIBK AND SWITCH WORDS SPECIFIED BY $SWTAB SET UP			;PW001
;	G.CMLD	COMPRESSED COMMAND LINE LENGTH					;PW001
;										;PW001
;	IF SYNTAX ERROR:							;PW001
;	CC-C	1								;PW001
;										;PW001
; REGISTERS ALTERED: R0								;PW001
;-										;PW001
;										;PW001
;										;PW001
CSI:	CSI$1	#$CSIBK,R1,R2	; CHECK SYNTAX ON FILE SPEC			;PW001
	MOV	C.CMLD(R0),G.CMLD(R5) ; SET COMPRESSED LENGTH			;PW001
	BCS	10$		; BAD SYNTAX					;PW001
	BITB	#CS.EQU,C.STAT(R0)  ; WAS EQUAL SIGN (=) FOUND?			;PW001
	BNE	10$		; ANY INDICATION OF INPUT SPEC IS ERROR		;PW001
	CSI$2	R0,OUTPUT,#$SWTAB ; GET THE OUTPUT FILE				;PW001
	BCS	10$								;PW001
	BITB	#CS.DVF!CS.NMF,C.STAT(R0)					;PW001
	BNE	20$		; OK - JUMP WITH CC-C = 0			;PW001
10$:	SEC									;PW001
20$:	RETURN									;PW001

;
; POPOPN - SUBROUTINE TO CLOSE, POP UP, AND RE-OPEN
;
POPOPN:	CALL	CLODEL		; CLOSE OR DELETE FILE				;PW003
POPOP1:				;++001						;**-5
	MOV	G.PPTR(R5),R4;	UPDATE PUSHDOWN POINTER
	SUB	#G.PDSL,G.PPTR(R5) ;++001 RESET PUSHDOWN PTR IN GCML BLK
	DECB	G.CDEP(R5);	DECREASE PUSHDOWN LEVEL
	BNE	1$;		IF POPPING TO LEVEL 0
	BITB	#GE.MCR,G.MODE(R5) ;++001 AND TOP WAS AN MCR LINE,
	BNE	3$;		DON'T RE-OPEN LEVEL 0
1$:	MOV	R5,R3		;++001 POINT R3
	ADD	#F.FNB+N.UNIT+2,R3 ;  TO END OF NAME BLOCK
	MOV	#<N.UNIT-N.DID+2>/2,R2 ; SET NUMBER OF WORDS TO RESTORE
10$:	MOV	-(R4),-(R3)	; RESTORE NAME BLOCK
	DEC	R2		; DONE?
	BGT	10$		; NO, LOOP
	SUB	#N.DID-N.STAT,R3 ; POINT TO VERSION NUMBER
	MOV	#<N.FVER-N.FID+2>/2,R2 ; GET LENGTH
20$:	MOV	-(R4),-(R3)	; RESTORE REST OF NAME BLOCK
	DEC	R2		; DONE?
	BGT	20$		; NO, LOOP


	.IF NDF	R$$11M		;++002


	OPEN$R	R5;		RE-OPEN THE LEVEL ABOVE

	.IFF			;++002

	OFNB$R	R5		;++003 OPEN FILE BY FILENAME BLOCK


	.ENDC			;++002


	BCS	4$;		ERRROR ON RE-OPEN, VERY BAD
; RESTORE POINTERS INTO THE FILE
	MOV	-(R4),R3;	BYTE-IN-BLOCK
	MOV	-(R4),R2;
	MOV	-(R4),R1;	VIRTUAL BLOCK NUMBER
	CALL	.POINT;		FDB IS IN R0, NOW .POINT
	BCC	3$;		NO ERRORS
	CMPB	#IE.EOF,F.ERR(R5);
	BNE	4$;		ANYTHING EXCEPT EOF IS AN I/O ERROR
3$:	RETURN	;		ALL IS NOW READY FOR NEXT GET$
4$:	TST	(SP)+;		THROW AWAY CALLER'S RETURN ADDRESS
	JMP	IOERR;		CALL IT AN I/O ERROR

;++001
;
; CLOSE CURRENT COMMAND LEVEL
;
;--001
$MGCL3::.SAVR1			;++001 SAVE REGISTERS
	MOV	R0,R5		;++001 SET FDB POINTER
CLOCRT:	TST	F.BDB(R5)	;++001 IS FILE OPEN?
	BEQ	PSHRTN		;++001 NO, JUST RETURN

;
; PSHCLS - SUBROUTINE TO PUSH DOWN AND CLOSE
;
PSHCLS:	INCB	G.CDEP(R5);	INCREASE PUSHDOWN LEVEL
	MOV	G.PPTR(R5),R4;	NEXT PUSHDOWN FRAME
	MOV	R5,R0;		GET FDB FOR .MARK
	CALL	.MARK;		MARK CURRENT PLACE IN FILE FOR .POINT
	MOV	R1,(R4)+;	VIRTUAL BLOCK NUMBER
	MOV	R2,(R4)+;
	MOV	R3,(R4)+;	BYTE-IN-BLOCK
	ADD	#F.FNB+N.FID,R0  ;++001 POINT R0 TO FILE ID IN FDB
	MOV	#<N.FVER-N.FID+2>/2,R2 ; SET LENGTH OF WORDS TO SAVE
10$:	MOV	(R0)+,(R4)+	; SAVE THE NAME BLOCK
	DEC	R2		; DONE?
	BGT	10$		; NO, LOOP
	MOV	#<N.UNIT-N.DID+2>/2,R2 ; SET NUMBER OF WORDS TO SAVE
	ADD	#N.DID-N.STAT,R0 ; POINT TO REST OF NAME BLOCK
20$:	MOV	(R0)+,(R4)+	; SAVE REST OF FNB
	DEC	R2		; DONE?
	BGT	20$		; NO, LOOP
	MOV	R4,G.PPTR(R5);	RESET PUSHDOWN FRAME
	CLOSE$	R5;		CLOSE CURRENT LEVEL
PSHRTN:				;++001
	RETURN

.PAGE										;PW001
;+										;PW001
; *** - OPEN - OPEN FILE WITH DATASET DESCRIPTOR IN $CSIBK			;PW001
;										;PW001
; INPUT:									;PW001
;	R5	GCML CONTROL BLOCK ADDRESS (ALSO FDB ADDRESS)			;PW001
;										;PW001
; OUTPUT:									;PW001
;	CC-C	0 IF OK, 1 IF ERROR						;PW001
;										;PW001
; REGISTERS ALTERED: R0,R1,R2,R3						;PW001
;										;PW001
;-										;PW001
;										;PW001
;										;PW001
OPEN:	MOV	#$CSIBK,R2	; POINT R2 TO THE CSI DATA ...			;PW001
	ADD	#C.DSDS,R2	; ... SET DESCRIPTOR				;PW001
	MOV	#"SY,N.DVNM+G.DFNB(R5);DEFAULT DEVICE IS SY FOR LOWER OPEN'S	;PW001
;										;PW001
	.IF NDF	R$$11M		;						;PW001
;										;PW001
	OPEN$R	R5,,R2		; OPEN THE FILE					;PW001
	RETURN									;PW003
;										;PW003
	.IFF			;						;PW003
;										;PW003
; FALL THRU TO "GOPEN"								;PW003
;										;PW003
										;**-2
;++002
;
; *-GOPEN-* OPEN FILE BY PERFORMING A PARSE, FIND AND AN OPEN BY
; 	    FILE ID.
;
; INPUTS:
;	R2=DATA SET DESCRIPTOR ADDRESS
;	R5=FDB/GCMLB ADDRESS
;
; OUTPUTS:
;	R0	FDB ADDRESS ( = R5 IN)						;PW001
;	R1 AND R3 ARE LOST							;PW001
;	C-BIT CLEAR INDICATES SUCCESS OF ALL THREE STEPS			;**-1
;	C-BIT SET INDICATES FAILURE
;
;--002
GOPEN:	MOV	R5,R0		;++002 PUT FDB ADDR IN R0
	MOV	@#.FSRPT,R1	;++002 MUST DETERMINE IF A '.FINIT' ...
	TST	A.DFUI(R1)	; HAS BEEN PERFORMED
	BNE	1$		;++002 IF SO, THEN SKIP
	FINIT$			;++002 INITIALIZE
1$:	MOV	$TKTCB,R3	; GET OUR TCB ADDRESS
	MOV	T.UCB(R3),R3	; GET TI UCB ADDRESS
	MOV	U.UIC(R3),A.DFUI(R1) ; SET DEFAULT UIC FOR FILES
	ADD	#A.DFDR,R1	; POINT TO DEFAULT DIRECTORY STRING ADDRESS
	CLR	D.DFDV(R1)	; ZERO DEFAULT DEVICE
	MOV	#-1,(R1)	; CAUSE  DIRECTORY STRING TO BE CREATED AGAIN
	MOV	R0,R1		; POINT R1 TO THE
	ADD	#F.FNB,R1	;++002 ... FILE NAME BLOCK
	MOV	F.DFNB(R0),R3	;++002 PNT R3 TO DEFAULT FILE NAME BLOCK
	CALL	.PARSE		;++002 PARSE THE FILE NAME
	BCS	10$		;++002 SKIP ON ERROR
	OFNB$R			;++003 OPEN FILE FOR READ (VIA FNB)
	BCC	10$		;OPENED OK			[RJDK002]
	MOV	#SYSIND,6(R2)	;GET DEFAULT UIC 		[RJDK002]
	MOV	#5,4(R2)	;AND LENGTH			[RJDK002]
	CALL	.PARSE		;PARSE IT			[RJDK002]
	BCS	10$		;BAD INDEED			[RJDK002]
	OFNB$R			;TRY FOR FILE IN DEF UIC	[RJDK002]
10$:	RETURN			;++002
SYSIND:	.ASCII	/[1,5]/		;				[RJDK002]
	.EVEN			;				[RJDK002]


	.ENDC			;++002

; CLODEL - CLOSE OR DELETE CURRENT FILE, DEPENDENT				;PW003
;	ON BIT "DELETE" IN .LIFLG.						;PW003
;										;PW003
CLODEL:	MOV	R5,R0		; GET FDB					;PW003
	BIT	#DELETE,.LIFLG	; FILE TO BE DELETED?				;PW003
	BEQ	10$		; N - JUMP					;PW003
	CALLR	.DLFNB		; Y - DELETE IT					;PW003
10$:	CALLR	.CLOSE		; N - CLOSE IT					;PW003
.PAGE										;PW003
; 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
GETMCR:	MOV	G.RBUF(R5),R1;	GET RECORD BUFFER ADDRESS
	CLRB	G.CDEP(R5)	;++001 SET CMD LEVEL TO ZERO
	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	;++006 GET MCR LINE BYTE COUNT

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;
	BEQ	4$		;
	CMPB	R0,#'@		; INDIRECT FILE SPECIFIER?
	BEQ	6$		; YES
	BNE	2$;
4$:	CALL	NXTBYT;		SKIP TABS AND BLANKS
	BCS	10$;
	CMPB	R0,#TAB
	BEQ	4$
	CMPB	R0,#BLANK
	BEQ	4$

6$:	CMPB	-(R1),(R2)+	;++001 DECR POINTER AND INCR COUNT
	BISB	#GE.MCR,G.MODE(R5);SET TOP-LEVEL MCR FLAG
	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:	SUB	#1,R2		;++001 DECR R2 AND SET CC-C WHEN REACH -1
	MOVB	(R1)+,R0;	GET NEXT BYTE
	RETURN
;


	.END