.MCALL	.MODULE
.MODULE	INDGCM,VERSION=08,COMMENT=<Indirect file processor (GCML)>

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; 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 Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
.ENABL	GBL,LC

	.SBTTL	Macro definitions
 
;+
;Macro library calls.
;-

	.MCALL	.CSISPC, .GTLIN, .PRINT
	.MCALL	FERDF$, GCLDF$, RT5DF$, DEFIN$

	GCLDF$				;Define GCML block offsets
	FERDF$				;Define file service error codes
	RT5DF$				;Define RT offsets
	DEFIN$				;Definitions for IND files

	.PSECT	INDGCM
	.SBTTL	$MGCL1 - Get next command line
 
	.ENABL	LSB

$MGCL1::CALL	$SAVAL			;Save registers
	MOV	R0,R1			;Make R1 the block pointer
	BICB	#<GE.IEF>,G.MODE(R1) 	;Clear intermediate end of file flag
	TSTB	G.CDEP(R1)		;Test current depth
	BEQ	LVL0			;Must make special test if at level 0
	BGT	PROMPT			;If .GT. zero, then prompt for command
	BIT	#<ERRPRC>,.LFLG2	;Processing an error?
	BEQ	10$			;No, continue.
	BITB	#<GE.DCL>,G.MODE(R1)	;Yes, then at DCL level?
;	BEQ	10$			;No.
	BNE	OKOUT1			;Yes, just handle the error
10$:	CALL	GETDCL			;Try to get a command line
	BR	CMLSCN			;Line recieved - don't open top-level

LVL0:	TSTB	G.MODE(R1) 		;Was there a command line?
     .ASSUME  GE.DCL EQ 200
	BMI	INTERM			;Yes, branch to INTERM to branch to
					;TOPEOF (process end of file)

;+
;Output prompt (if necessary) and get a command line.
;-

PROMPT:	TSTB	F$FLGS(R1)		;Is the file already open?
	BNE	20$			;Yes, skip the open
	CALL	POPOP1			;No pop the level and open the file
20$:	MOV	#PRPMT,R0		;Point to prompt string (*)
	MOV	G.RBUF(R1),R2		;Get buffer address
	MOV	#<LBSIZE+2>,R3		;R3 = buffer length
	CALL	$RDREC			;Get a command line
	BCS	IOERR0			;Branch if error
	.BR	CLMSCN

	.DSABL	LSB
	.SBTTL	CMLSCN - Scan a command line
;+
;CMLSCN
;Process command line.  If lower case is not enabled, convert to upper case.
;Check if comment.
;-

	.ENABL	LSB

CMLSCN:	MOV	R2,G.CMLD+2(R1)		;Set command line address
	MOV	R3,G.CMLD(R1)		; and length
	BEQ	1$			;Return null lines to user
	CMPB	#<SEMIC>,@R2		;Check for  ";" in column 1
	BNE	OKOUT			;None - return to user
	BITB	#<GE.COM>,G.MODE(R1)	;Are comments permitted?
	BNE	PROMPT			;Yes - get another line
OKOUT1:
1$:	BR	OKOUT			;No  - return it to user

	.DSABL	LSB
	.SBTTL	$MGCL4 - Process an indirect file
 
;+
;$MGCL4
;Set up to process an indirect file.  Look for @ in column 1.
;
; Input: R0 -> GCML control block address
;	 R2 -> command line address
;	 R3 =  command line length
;-
 
	.ENABL	LSB

$MGCL4::CALL	$SAVAL			;Save all registers
	MOV	R0,R1			;Copy block address
	CMPB	#'@,(R2)		;Check for @
	BNE	OKOUT			;No, return line to user
	BIT	#<TRACE>,.LIFLG		;Are we in trace mode?
	BEQ	1$			;No, don't display the line
	TST	LINDS			;Has this line been displayed?
	BNE	1$			;Yes, don't display it a second time
	CALL	DSPLY			;Display the line
1$:	BITB	#<GE.IND>,G.MODE(R1)	;Indirect permitted?
	BEQ	OKOUT			;No, return it to user
	CMPB	G.CDEP(R1),G.MDEP(R1)	;Check depth
	BGE	MDEERR			;Too deep

;+
;Process indirect file.  First, the commsnd string in CMDBUF is stored in
;the GCML buffer (LINBUF).  This is done incase substituted paramater symbols
;are being passed to the next indirect level.  Paramaters are then parsed
;out of the command string (CMDBUF) in preparation to passing the string
;to CSI.
;-

	MOV	G.CMLD+2(R1),R4		;R4 -> command line buffer (LINBUF)
	MOV	R2,R5			;R5 -> command buffer (CMDBUF)
	MOV	R3,R0			;R0 = command line length
2$:	CMPB	@R5,#<HT>		;Tab?
	BNE	21$			; make it a space.
	MOVB	#<SPA>,@R5		;  for CSI's benefit
21$:	MOVB	(R5)+,(R4)+		;Copy the line
	DEC	R0			;Decrement character count
	BNE	2$			;Loop 'til done
	MOV	R3,G.CMLD(R1)		;Set the command line length
	INC	R2			;Skip over @
	DEC	R3			;Decrement character count
	MOV	R2,R5			;Point to string address
	MOV	R3,R4			;Get the string length
3$:	CMPB	(R5)+,#<SPA>		;Space?
	BEQ	4$			;No
	DEC	R4			;Decrement the string count
	BNE	3$			;Check for space
4$:	SUB	R4,R3			;Calculate filespec  characters
	CALL	CSI			;Interpret file name

;+
;Save file id and pointers.
;-

	CALL	PSHCLS			;Push and close file
	CALL	OPEN			;Open new file
	BCS	OPRERR			;Error - report it
5$:	BITB	#<GE.FOP>,G.MODE(R1) 	;Exit after opening file?
	BEQ	PROMPT			;Get a command line
6$:	RETURN

	.DSABL	LSB
	.SBTTL	IOERR0 - I/O error processing

;+
;IOERR0
;I/O error processing.
;-

	.ENABL	LSB

IOERR0:	MOV	F$ERR(R1),R3		;Get error code
	CMP	#<IE.EOF>,R3		;End of file error?
	BNE	IOERR			;No - I/O error
	MOVB	G.CDEP(R1),R0		;Top level indirect control file?
	BEQ	TOPEOF			;Yes, return EOF to caller
	BISB	#<GE.IEF>,G.MODE(R1) 	;Set intermediate EOF seen
	BITB	#<GE.RWD>,G.MODE(R1) 	;Rewind after EOF?
	BEQ	1$			;No
	TST	F$STAT(R1)		;Is the device random access?
    .ASSUME  FILST$  EQ  100000
	BPL	1$			;Branch if yes
	MOV	#<-1>,F$BLKN(R1)	;Re-initialize block number
	CLR	F$BUFP(R1)		; and the buffer pointer
	BR	PROMPT			;Get next command

1$:	DEC	R0			;Decreament level count
	BNE	2$			;If not level 0 just pop pointers
	TSTB	G.MODE(R1)		;If returning to level 0
    .ASSUME  GE.DCL EQ 200
INTERM:	BMI	TOPEOF			; and top was DCL return EOF to caller
2$:	CALL	CLODEL
	CALL	POPOP1			;Pop pointers up one level
	MOV	#DUMCMD,G.CMLD+2(R1)	;Set up a dummy command line
	MOV	#<1>,G.CMLD(R1)		;	...
	BR	OKOUT			;

	.DSABL	LSB
	.SBTTL	TOPEOF - End-of-file processing

;+
;TOPEOF
;End-of-file processing.
;-

	.ENABL	LSB

TOPEOF:	CALL	CLODEL			;Close and delete file if necessary
	BIT	#<ERRPRC>,.LFLG2	;Processing an error?
	BNE	3$			;Yes, do not touch G.MODE
	BICB	#<GE.DCL>,G.MODE(R1) 	;Done, clear DCL bit, and 
3$:	MOVB	#<377>,G.CDEP(R1)	; set depth to -1 for later restart
	MOV	#<GE.EOF>,-(SP)		;Indicate end-of-file
	BR	OUT			;Clean up and exit

OKOUT:	CLR	-(SP)			;Indicate GCML success

;+
;Common exit routine.
;-

OUT:	BITB	#<GE.CLO>,G.MODE(R1) 	;Close file after this get?
	BEQ	1$			;No, set return information
	CALL	CLOCRT			;Yes, close current level
1$:	MOVB	(SP)+,G.ERR(R1)		;Put return code in G.ERR
	BNE	2$			;Error occured
	TST	(PC)+			;Indicate no error by clearing C-bit
2$:	SEC				;Indicate error by setting C-bit
	RETURN

IOERR:	MOV	#<GE.IOR>,-(SP)		;Indicate I/O error
	BR	OUT			;Clean up and exit

OPRERR:	MOV	#<GE.OPR>,-(SP)		;Indicate indirect open err. (default)
	CMP	#<IE.IDU>,F$ERR(R1)	;Invalid device or unit?
	BNE	OUT			;No, have correct error
	MOV	#<GE.IDU>,@SP		;Yes, indicate error
	BR	OUT			;Clean up and exit

MDEERR:	MOV	#<GE.MDE>,-(SP)		;Indicate max indirect depth exceeded
	BR	OUT			;Clean up and exit

	.DSABL	LSB
	.SBTTL	$MGCL5 - Chain to file
 
;+
;$MGCL5
;Close current file and open a "successor" file without changing indirection
;depth.
;
; Input:  R0 -> GCML control block address
;	  R2 -> Command line
;	  R3 =  Command line length
;
; Output:
;	If no errors occur:
;	  C-bit is cleared
;	  G.CMLD	compressed length of command line
;
;	If error did occur:
;	  C-bit is set 
;-
 
	.ENABL	LSB

$MGCL5::CALL	$SAVAL			;Save registers
	MOV	R0,R1			;Get block address
	CALL	CLODEL			;Close and delete file if necessary
	CALL	CSI			;Interpret file name
	CALL	OPEN			;Open new file
	BCS	OPRERR			;Error
	BR	OKOUT			;No error

	.DSABL	LSB
	.SBTTL	CSI - Get CSI string
 
;+
;CSI
;Get string and set appropriate switches.
;
; Input: R0 -> GCML control block address
;	 R2 -> CSI string
;	 R3 =  String size
;
; Output:  Switches are set in .LIFLG
;
;R0,R2, R4, and R5 are destroyed.
;-
 
	.ENABL	LSB

CSI::	MOV	R2,R5		;Point to start of CSI string
	ADD	R3,R5		;Point to end of string
	CLRB	@R5		;End string with zero byte
	.CSISPC	#CSIBLK,#DFBLK,R2 ;Get the command
	BCS	8$		;Error occured
	MOV	.LIFLG,LIFLGA	;Save old mode flag setting
	MOV	.LFLG2,LIFLG2	;Both words
	BIC	#<QUIET!TRACE!DELETE>,.LIFLG ;Set default options
	BIS	#<KMON>,.LIFLG	;Assume DCL is to be executed
	MOV	(SP)+,R5	;Get the option count
	BEQ	6$		;Branch if no switches
1$:	MOV	(SP)+,R4	;Get the switch
	BMI	7$		;If minus switch error
	BIC	#^C<177>,R4	;Make ASCII
	MOV	R4,R2		;Grunt for DCL processing
	CMPB	#'N,R2		;No KMON processing?
	BEQ	3$		;Yes
	CMPB	#'N+40,R2	;How about lowercase?
	BEQ	3$		;Yes
	MOV	#SWITCH,R2	;Point to start of valid switch table
2$:	TST	@R2		;End of table?
	BEQ	7$		;Yes, switch is not valid
	CMP	R4,(R2)+	;Is this the switch?
	BEQ	4$		;Yes, set the bit and continue
	TST	(R2)+		;No, point to next switch
	BR	2$		; and compare it

3$:	BIC	#<KMON>,.LIFLG	;Turn off DCL processing
	BR	5$		;Continue the loop

4$:	BIS	(R2)+,.LIFLG	;Set appropriate switch flag bit
5$:	DEC	R5		;Decrement switch count
	BNE	1$		;If not equal, more switches to process
6$:	RETURN

7$:	TRAP	ERSWT		;Invalid switch
8$:	TRAP	ERCOM		;Invalid command

	.DSABL	LSB
	.SBTTL	POPOPN - Close current file
 
;+
;POPOPN
;This subroutine closes the current file, goes to the next highest level of
;nesting and re-opens that control file.
;
;POPOP1
;Does everything that POPOPN does except close the file.
;-

	.ENABL	LSB

POPOPN::CALL	C$LOSE			;Close the current file
POPOP1::SAVE	<R2,R4>
	SUB	#F$SIZE,G.PPTR(R1) 	;Reset pushdown pointer in GCML block
	MOV	G.PPTR(R1),R4		;Update pushdown pointer
	DECB	G.CDEP(R1)		;Decrease pushdown level
	MOV	R4,R2			;Copy next FDB address
	ADD	#F$DNAM,R2		;Point to RAD50 file specification
	CALL	$OPENR			;Open the file
	BCS	1$			;Error on re-open
	MOV	F$BLKN(R4),F$BLKN(R1)	;Restore the current block number
	MOV	F$BUFP(R4),F$BUFP(R1)	;Restore the buffer pointer
1$:	RESTOR	<R4,R2>
	RETURN

	.DSABL LSB
	.SBTTL	$MGCL3 - Close current command level.

;+
;$MGCL3
;Close out current command level.
;-

	.ENABL	LSB

$MGCL3::CALL	$SAVAL			;Save all registers
	MOV	R0,R1			;Get FDB pointer
CLOCRT:	TSTB	F$FLGS(R1)		;Is file open?
	BEQ	2$			;No, just return

;+
;PSHCLS
;Close and push down current file.
;-

PSHCLS:	CALL	C$LOSE			;Close the current file
	SAVE	<R1>			;Save the FDB address
	INCB	G.CDEP(R1)		;Increase pushdown level
	MOV	G.PPTR(R1),R4		;Next pushdown frame
	MOV	#F$SIZE/2,R2		;Set length of words to save
1$:	MOV	(R1)+,(R4)+		;Save the name block
	DEC	R2			;Done?
	BGT	1$			;No
	RESTOR	<R1>			;Restore FDB address
	MOV	R4,G.PPTR(R1)		;Reset pushdown frame
2$:	RETURN

	.DSABL	LSB
	.SBTTL	OPEN - Open file.
 
;+
;OPEN
;Open file with dataset descriptor in CSIBLK.
;
; Input:  R1 -> GCML control block (also FDB)
;
; Output: C-bit set if error otherwise cleared
;
;Registers altered: R0,R2,R3
;-
 
	.ENABL	LSB

OPEN:	MOV	#CSIBLK+36,R2		;Point to the CSI data ...
	CALL	$OPENR			;Open the file
	BCS	1$			;Error occured
	MOV	R1,R0			;Set pointer to RAD50 filespec
	CALL	FILSTR			;Store filespec in special symbol
1$:	RETURN

	.DSABL	LSB
	.SBTTL	CLODEL - Close and delete file
 
;+
;CLODEL
;Close a file and if the "DELETE" bit (in .LIFLG) is set delete the file.
;-
 
	.ENABL	LSB

CLODEL::CALL	C$LOSE			;Close channel
	BIT	#<DELETE>,.LIFLG	;File to be deleted?
	BEQ	1$			;No
	CALL	$DELET			;Delete the file
	BCS	2$			;Branch if error
;	BIC	#<DELETE>,.LIFLG	;Get rid of delete flag
1$:	RETURN

2$:	MOV	R1,R0			;Set up to process error
	TRAP	ERDFE			;Data file error

	.DSABL LSB
	.SBTTL	GETDCL - Get command line
 
;+
;GETDCL
;This routine prompts for a control file name.  This routine is
;entered only after the 'RUN' command is issued.
;
;*** This routine now determines if it is being passed an unaltered command
;in the chain area.  If it has a command there it throws away the altered
;command and uses the contents starting with location 512.
;
; Input:   R1=GCML block address
;
; Output:  R2 -> start of command buffer
;	   R3 =  string length
;
;Registers changed R0 (if version is requested), R2, R3
;-
 
	.ENABL	LSB

GETDCL::BIS	#<GTLIN$>,@#$JSW	;Set up non-terminating .GTLIN
	MOV	G.RBUF(R1),R2		;Get record buffer address
	CLRB	G.CDEP(R1)		;Set command level to zero
	SAVE	R2			;Save the start of buffer
	MOVB	#<ATSIGN>,(R2)+		;Insert leading "@"
	CMP	@#<$CHAIN>,#<1>		;Anything passed in the chain area?
	BLOS	3$			;Branch if no
	.GTLIN	#SCR			;Throw away converted line
	MOV	#<$CHAIN+2>,R3		;Point to text in chain area
1$:	MOVB	(R3)+,(R2)+		;Store it
	BNE	1$			;Loop till done
	MOV	R2,R3			;R3 -> end of text for common return
	BR	6$			;Enter common exit
	
3$:	.GTLIN	R2,#PRPMT		;Get a line of input
	TSTB	@R2			;Was only carriage return typed?
	BNE	4$			;No
	.PRINT	#VERSON			;Yes, just display the version number
	BR	3$			;and re-prompt for output

4$:	MOV	@SP,R3			;R3 -> start of buffer

;+
;Keep moving R3 (buffer pointer) until it points to end of input string.
;-

5$:	TSTB	(R3)+			;End-of line found?
	BNE	5$			;No
6$:	RESTOR	R2			;Restore start for return
	SUB	R2,R3			;Calculate length of line
	BISB	#<GE.DCL>,G.MODE(R1)	;Set top-level DCL flag
	RETURN
 
	.DSABL	LSB

	.END