.TITLE	INCLUD - PROCESS INCLUDE STATEMENTS
	.IDENT	/V01/
	.PSECT	INCLUD

;+
; WRITTEN BY: GARY L MAXWELL
;	      U.S. GEOLOGICAL SURVEY
;	      345 MIDDLEFIELD ROAD
;	      MAIL STOP 77
;	      MENLO PARK, CALIFORNIA 94025
;	      30-OCT-79
;-
	.MCALL	FDBDF$,CSI$,CSI$1,CSI$2,CSI$SW,WTSE$S
	.MCALL	CSI$ND,CLOSE$,NMBLK$,OPEN$,GET$,DIR$
	.MCALL	CALL,RETURN
;+
; THE FOLLOWING MACRO IS USED TO ALLOCATE ENOUGH FDB'S
; TO INCLUDE TO A LEVEL DEFINED BY L$$INC. THE MACRO
; CREATES A TABLE OF WORDS POINTING TO A DIFFERENT FDB,
; SO A NEW FDB IS ALLOCATED BY INDEXING AN UNUSED FDB
; IN A STACK ORIENTED FASHION.
;-
	.MACRO	DEFFDB	LEVEL
	.LIST	ME
	.WORD	FDB'LEVEL
	.NLIST	ME
	.IF	GT,LEVEL-1
	DEFFDB	\LEVEL-1
	.ENDC
FDB'LEVEL: FDBDF$
	.ENDM
;+
; THE SYMBOL L$$INC IS BEST CUSTOMIZED BY DEFINING IT IN
; THE PREFIX FILE RSXPRE TO THE DESIRED NESTING LEVEL.
; IF L$$INC IS NOT DEFINED, IT DEFAULTS TO 3. IF L$$INC
; IS DEFINED TO BE ZERO (0), THEN NO CODE IS GENERATED
; FOR PROCESSING INCLUDES, AND ATTEMPTS TO 'INCLUDE'
; WILL CAUSE THE INCLUDE LEVEL OVERFLOW MESSAGE TO BE
; ISSUED.
;-
.IF	NDF	L$$INC
L$$INC = 3
.ENDC

LSTMSK = 1		; MASK FOR INCLUDE /LIST SWITCH
LUNBAS = 4		; FIRST AVAILABLE LUN FOR INCLUDES

INCLEV:: .WORD	0	; CURRENT LEVEL OF INDIRECTION

;+
; DEFINE FDB BLOCKS: FDLST POINTS TO FIRST POINTER IN
; LIST OF POINTERS TO THE FDB'S
;-

.IF	GT	L$$INC
FDLST:
	DEFFDB	\L$$INC
	.EVEN

DEFNAM:	NMBLK$	,FTN,,SY,0	; DEFAULT INPUT: SY0:?.FTN

	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE
	.EVEN

SWTAB:	CSI$SW	LIST,LSTMSK,SWTWD,CLEAR,NEG
	CSI$ND

SWTWD:	.WORD	0	; MASK WORD FOR CSI

.ENDC

	.NLIST 	BEX
LEVMSG:	.WORD	0
	.WORD	LEVLEN
5$:	.ASCII	<12>^IDX -- ALLOWABLE NESTING LEVEL OF INCLUDES EXCEEDED^<15>
LEVLEN = . - 5$
	.EVEN

.IF	GT,L$$INC
CMSGLS:	.WORD	CO
5$:	.ASCII	<12>^IDX -- CLOSE ERROR ON INCLUDE FILE^<15><12>
	.ASCII	^FCS ERROR CODE: ^
CO:	.BLKB	5
	.EVEN

SWTMSG:	.WORD	0
	.WORD	SWTLEN
10$:	.ASCII	<12>^IDX -- ILLEGAL SWITCH ON INCLUDE STATEMENT^<15>
SWTLEN = . - 10$
	.EVEN

SYNMSG:	.WORD	0
	.WORD	SYNLEN
10$:	.ASCII	<12>^IDX -- SYNTAX ERROR ON INCLUDE STATEMENT^<15>
SYNLEN = . - 10$
	.EVEN

OPNMSG:	.WORD	OM
5$:	.ASCII	<12>^IDX -- OPEN FAILURE ON INCLUDE FILE^<15><12>
	.ASCII	^FCS ERROR CODE: ^
OM:	.BLKB	5
	.EVEN

.ENDC
	.LIST	BEX

;+
; EVALUATION ENTRY POINT EVL21
;
; ATTEMPT ALLOCATION OF FDB, OPEN SOURCE, PUSH CURRENT
; STATE OF IDX, AND INVOKE NEWLIN (INDEX MODULE)
;
; IF L$$INC IS DEFINED TO BE ZERO, ONLY ESCAPE CODE IS
; GENERATED.
;-

EVL21::	CMP	#L$$INC,INCLEV	; CAN WE GO ANOTHER LEVEL?
	BLE	LEVERR		; NO, BOMB OUT

.IF	GT	L$$INC

	CALL	ALLINC		; ALLOCATE FDB AND OPEN FILE
	BCS	E21EX		; EXIT IF FAILURE
	INC	INCLEV		; ELSE BUMP INCUDE LEVEL
	MOV	NOSRC,-(SP)	; SAVE /NS FLAG
	BGT	10$		; /NS OVERRIDES INCLUDE'S /LI
	MOV	R2,NOSRC	; ELSE RESET SOURCE FLAG
10$:	MOV	EOF,-(SP)	; SAVE EOF INDICATOR
	CLR	EOF		; CLEAR INDICATOR
	MOV	CURFDB,-(SP)	; SAVE POINTER TO PREVIOUS FDB
	MOV	#MRKLST,R1	; GET LIST OF VALS FROM LAST .MARK
	MOV	(R1)+,-(SP)	; PUSH THE THREE VALUES
	MOV	(R1)+,-(SP)
	MOV	(R1),-(SP)
	MOV	R0,CURFDB	; AND STUFF NEW FDB POINTER
	MOV	F.NRBD+2(R0),INBFPT ; RESET INPUT BUFFER POINTER
	CALL	GETLIN		; GET FIRST LINE IN NEW FILE
	CALL	NEWLIN		; AND INVOKE NEW PARSING LEVEL
	CLOSE$	CURFDB,CLSERR	; CLOSE FILE WHEN THROUGH
CERET:	DEC	INCLEV		; DECREMENT LEVEL OF INCLUDES
	MOV	(SP)+,R3	; GET BYTE LOCATION IN BLOCK
	MOV	(SP)+,R2	; GET LOW ORDER VIRT. BLOCK
	MOV	(SP)+,R1	; GET HIGH ORDER VIRT. BLOCK
	MOV	(SP)+,R0	; GET FDB POINTER TO NEXT OUTER FILE
	MOV	R0,CURFDB	; SET AS CURRENT INPUT FDB
	MOV	(SP)+,EOF	; RECOVER EOF INDICATOR
	MOV	(SP)+,NOSRC	; /NS FLAG
	CALL	.POINT		; POINT FILE TO WHERE WE LEFT OFF
	CALL	GETLIN		; READ IN THAT RECORD
;
.ENDC
E21EX:	RETURN			; AND EXIT

;+
; ERROR CODE
;-

LEVERR:	MOV	#LEVMSG,R3	; NESTING OVERFLOW MESSAGE
	CALL	OUTMS1		; OUTPUT IT
	BR	E21EX		; AND RETURN
;
.IF	GT,L$$INC
CLSERR:	MOV	#CMSGLS,R3	; PROBLEM WITH CLOSING FILE
	CALL	OUTMSG		; OUTPUT IT
	BR	CERET		; RETURN TO RESTORE STACK
.ENDC

;+
; ATTEMPT TO ALLOCATE ONE OF THE FDB'S IN THIS MODULE,
; AND CALL CSI$ TO PARSE THE INCLUDE FILESPEC, TRY OPENING
; THE FILE, AND READ FIRST RECORD IF SUCCESSFUL.
;
; INPUTS: NONE.
;
; OUTPUTS: CARRY SET - OPEN FAILURE ON INPUT FILE
;          CARRY CLEAR - SUCCESSFUL OPEN
;            R0 POINTS TO THE FDB OF THE OPENED FILE
;            R1 IS SET TO THE LUN OF THE OPENED FILE
;            R2 IS THE SWITCH FLAG:
;               0 IF /LIST WAS SPECIFIED OR A SWITCH WAS ABSENT
;               1 IF /NOLIST WAS SPECIFIED
;-
ALLINC:
.IF	GT,L$$INC
	MOV	#FDLST,R3	; POINT TO TOP OF POINTER LIST
	MOV	INCLEV,R2	; LEVEL OF INCLUDES SO FAR
	MOV	#LUNBAS,R1	; GET FIRST LUN WE CAN HAVE
	ADD	R2,R1		; FORM LUN FOR THIS LEVEL
	ASL	R2		; FORM OFFSET INTO POINTER LIST
	ADD	R2,R3		; POINTER TO FDB FOR US
	MOV	(R3),R3		; R3 NOW POINTS TO FDB
	MOV	LINPTR,R4	; GET POINTER TO INCLUDE STATEMENT
	MOVB	(R4)+,R0	; GET CHAR AFTER 'INCLUDE'
	BEQ	BOMB		; NOTHING THERE
	CMP	#'',R0		; IS IT THE EXPECTED "'"?
	BNE	BOMB		; NO, BAIL OUT
	MOV	R4,R5		; YES, SAVE POINTER TO START OF FILESPEC
;
10$:	MOVB	(R4)+,R0	; GET FILE SPEC CHAR
	BEQ	BOMB		; BAIL OUT IF NO ENDING "'"
	CMP	#'',R0		; REACHED THE "'"?
	BNE	10$		; NO, KEEP TRYING
;
	DEC	R4		; POINT BACK TO QUOTE MARK
	SUB	R5,R4		; GET LENGTH OF FILESPEC
	MOV	#CSIBLK,R0	; GET ADDRESS OF CSI BLOCK
	CLR	SWTWD		; CLEAR SWITCH MASK WORD
	CSI$1	R0,R5,R4	; PARSE THE STRING
	BCS	SYNERR		; BAD FORMAT
	CSI$2	R0,OUTPUT,#SWTAB ; GET THE FILESPEC
	BCS	SWTERR		; BAD SWITCH
	MOV	SWTWD,R2	; COPY SWITCH MASK TO INDICATE LISTING
	MOV	R3,R0		; COPY FDB POINTER
	OPEN$	R0,#FO.RD,R1,#CSIBLK+C.DSDS,#DEFNAM,#FD.PLC,#INBUF,#INSIZ
				; OPEN THE FILE
	BCS	OPNERR		; SOMETHING WAS WRONG
;
40$:	CLC			; INDICATE SUCCESS
	BR	ALLEX		; AND RETURN
;
BOMB:	SEC			; INDICATE FAILURE
ALLEX:	RETURN			; AND RETURN
;
SYNERR:	MOV	#SYNMSG,R3	; POINT TO SYNTAX MSG
	CALL	OUTMS1		; OUTPUT IT
	BR	BOMB		; BAIL OUT
;
SWTERR:	MOV	#SWTMSG,R3	; GET BAD SWITCH MSG
	CALL	OUTMS1		; OUTPUT IT
	BR	BOMB
;
OPNERR:	MOV	#OPNMSG,R3	; GET OPEN ERROR MSG
	CALL	OUTMSG		; OUTPUT IT
	BR	BOMB		; AND EXIT
.ENDC

;+
; OUTMSG - OUTPUT ERROR MESSAGE TO TERMINAL
;
; TWO ENTRY POINTS: OUTMSG, IF THE FCS ERROR CODE IS TO BE PRINTED
;		    OUTMS1, IF AN ORDINARY STRING IS TO BE PRINTED
;
; INPUT: R3 POINTS TO A LIST CONTAINING THE MESSAGE:
;   IF OUTMSG IS TO BE USED, THE FIRST WORD THAT R3 POINTS TO IS
;	A POINTER TO WHERE THE ASCII REPRESENTATION OF THE FCS
;	ERROR CODE IS TO BE PLACED. THE ERROR CODE MUST BE THE LAST
;	PART OF THE MESSAGE. THE SECOND WORD BEGINS THE ASCII MESSAGE.
;	R0 MUST POINT TO THE FDB WHICH WAS INVOLVED IN THE ERROR.
;   IF OUTMS1 IS TO BE USED, THE WORD THAT R3 POINTS TO MUST CONTAIN
;	A ZERO. THE WORD AFTER THIS MUST CONTAIN THE LENGTH, IN BYTES,
;	OF THE MESSAGE. THE MESSAGE FOLLOWS THIS WORD.
;-
OUTMSG::
	MOVB	F.ERR(R0),R1	; GET FCS ERROR CODE
OUTMS1::
	MOV	R0,-(SP)	; SAVE FDB POINTER
	MOV	(R3)+,R0	; GET THE FIRST WORD IN THE LIST
	BEQ	10$		; NULL - NO FCS MESSAGE
	BIS	#177400,R1	; MAKE BYTE A NEGATIVE WORD
	CLR	R2		; SUPPRESS LEADING ZEROS
	CALL	$CBDSG		; CONVERT NUMBER
	MOVB	#<15>,(R0)+	; STUFF A CARRAIGE RETURN
	SUB	R3,R0		; GET LENGTH OF MESSAGE
	MOV	R0,QIO+Q.IOPL+2	; STUFF LENGTH
	BR	20$		; SKIP AHEAD
10$:	MOV	(R3)+,QIO+Q.IOPL+2 ; STUFF LENGTH FROM LIST
20$:	MOV	R3,QIO+Q.IOPL	; STUFF BEGINNING ADDRESS
	DIR$	#QIO		; WRITE IT OUT
	BCS	OUTEX		; IGNORE ERROR
	WTSE$S	QIO+Q.IOEF	; WAIT ON FLAG
;
OUTEX:	MOV	(SP)+,R0	; RECOVER FDB POINTER
	RETURN			; AND RETURN
;
	.END