.MCALL	.MODULE
.MODULE	IND,VERSION=07,COMMENT=<Entry into the world of IND>

; 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	Process indirect file

;+
;INDEP - This program is entered when the following command is issued in
;response to the CSI prompt (*):
;
;	FILSPEC[/x]<RET>
;
;		where:
;		 FILSPEC is a valid file specifier
;			/x is one of the following valid switches:
;				/T  List IND commands on console terminal
;				/D  Delete file when done
;				/N  Don't execute KMON commands
;
;IND files contain variable length ASCII records.  These records come in two
;forms.  Each record is either a KMON command or an IND command string.
;
;	KMON command: If the command is a KMON command IND inserts the string
;	into KMON's message area and then forces a chain to exit IND and allow
;	KMON to execute the command.
;
;	IND command: Must always be preceded by a dot (.).  These commands are
;	not displayed on the console unless the /T switch is set.
;-
	.SBTTL	Macro definitions

;+
;System macro calls.
;-

	.MCALL	.EXIT, .CRAW, .CRRG, .ELRG, .RDBDF, .WDBDF
	.MCALL	GCLDF$, RT5DF$, DEFIN$, FERDF$

.RDBDF				;Define region symbols
.WDBDF				;Define window symbols
FERDF$				;Define file errors
GCLDF$				;Define GCML block offsets and symbols
RT5DF$				;Define RT offsets
DEFIN$				;Definitions for IND files

	.PSECT	IND

	.NLIST	BEX

DSATXT:	.ASCIZ	/DISABLE/
	.BYTE	0
DATTXT:	.ASCIZ	/DATA/
	.BYTE	0
BEG:	.ASCIZ	/BEGIN/
ENDSTR:	.ASCIZ	/END/
	.EVEN

	.LIST	BEX
	.SBTTL	INDEP - Initial entry point
 
;+
;INDEP
;Entry point to IND.  The symbol table overlay is read into memory.  A JMP
;instruction is used to bring the symbol table into memory and return.
;This is because the internal stack is in the symbol table overlay and has
;not yet been set up.  Once the overlay has been read the stack is set up.
;Then initialize the data area and the special symbols.
;-

	.ENABL	LSB

INDEP::	CLR	(PC)+
REGCRE:: .WORD	0
	MOV	@#SYSPTR,R0	;Get pointer to start of RMON
	BIT	#<KT11$>,$CONFG(R0) ;Running in XM environment?
	BEQ	25$		;Branch if no
	TST	(PC)+		;Do they want to allow symbol table in high
				;memory?
..ALRG:: .WORD	1		;= bypass creating region for symbol table
				;<> create region for symbol table
	BEQ	25$		;Don't create region - use traditional method
	.CRRG	#EMTBLK,#REGION	;Create a region for the symbol table (IND)
	BCS	25$		;If any error - just treat as SJ/FB
	BIT	#<RS.NEW>,REGION+R.GSTS	;Did we just create the global region?
	BNE	15$		;Branch if first time - not just an attach

;*****************************************************************************

;+
;Fake a transfer vector (OVERLAY READ without reading).  The first time that
;any overlay is read in all the overlay regions are clear.  Then the overlay
;region that you are calling in is read in.  To avoid clearing out the symbol
;table global region we must fake a transfer vector.  This is based on the
;whole of IND is mapped in low memory.  This routine is courtesy of Don.
;-

	MOV	$OVTAB,-(SP)	;Save core address of first overlay
	MOV	#5$,$OVTAB	;Put in dummy
	JSR	R5,$OVRH	;Enter overlay handler for first time call
5$:	 .WORD	<1.*6.>
	 .WORD	10$
10$:	MOV	(SP)+,$OVTAB	;Return here andrestore core address

;*****************************************************************************

15$:	MOV	REGION+R.GID,WINDOW+W.NRID ;Put region ID in the WDB
	.CRAW	#EMTBLK,#WINDOW	;Create a window and map to it
	BCC	20$		;No error
	.ELRG	#EMTBLK,#REGION	;Eliminate region
	BR	25$		;Got to use the SJ/FB method

20$:	MOV	SP,REGCRE	;Set flag telling that we are using region
	BIT	#<RS.NEW>,REGION+R.GSTS	;Did we just create the global region?
	BEQ	RTN		;Branch if not
25$:	JMP	TBLSYM		;Bring the symbol table overlay into memory
RTN::				;Returned here from symbol table
	MOV	#REF,R0		;Get address of JSR R5 of overlay handler
	MOV	-4(R0),R0
	ADD	#$ODF2-4,R0	;Get pointer into overlay table
	MOV	R0,SYMOVL	;Save it for later
	MOV	@#SYSPTR,R0	;Get address of start of RMON
	MOV	R0,RMON		;Save start address for later
	BITB	#<IN$RUN>,$INDIR(R0) ;Forced to run by KMON?
	BNE	30$		;Yes, get saved current stack pointer
	MOV	#IND$SK,ISTACK	;Get starting address of internal stack	
30$:	MOV	ISTACK,SP	;Set up internal stack pointer
	CALL	INDIN0		;Continue initialization (R0 must contain
				;start of RMON upon entering INDIN)

	.DSABL	LSB

	.BR	INDRD
	.SBTTL	INDRD and INDRD1 - Get command string

;+
;INDRD
;Point to buffer and get next command line.
;-

	.ENABL	LSB
INDRD::	BICB	#<SEENIF>,BLKFLG ;Initialize to no .IF seen
	MOV	#GCML,R0	;Point to GCML control block
1$:	CALL	$MGCL1		;Call GCML to get command line
	.BR	INDRD1

;+
;INDRD1
;Check for error.  If no error continue processing.  If error,
;trap with appropriate message.
;-

INDRD1::MOVB	G.ERR(R0),R1	;Get success/error code
	BMI	3$		;Error occured
2$:	CMPB	G.CDEP(R0),INDDEP ;Has file depth changed?
	BEQ	IND2		;No
9$:	JMP	INDFDC		;Process file depth change

;+
;Error occured if reached here.  Determine the type of error.
;-

3$:	CMPB	R1,#<GE.IOR>	;I/O error?
	BNE	4$		;No
	TRAP	ERFRD		;File read error

4$:	CMPB	R1,#<GE.OPR>	;Open error?
	BNE	6$		;No
	CMPB	F$ERR(R0),#<IE.NOS> ;Was error for no space to fetch handler?
	BNE	5$		;No
	TRAP	ERFRD		;File read error - No room for fetch

5$:	TRAP	ERFNF		;File not found

6$:	CMPB	R1,#<GE.IDU>	;Invalid device or unit?
	BNE	7$		;No
	TRAP	ERDEV		;Invalid device or unit

7$:	CMPB	R1,#<GE.MDE>	;Maximum depth exceeded?
	BNE	8$		;No
	TRAP	ERIDE		;Too deep indirection

8$:	TSTB	G.CDEP(R0)	;Is the file depth at top level?
	BNE	2$		;No, unknown error. Ignore it

;+
;Exit the program.
;-

	MOV	SPSEXS+SEVAL,R0	;Get exit status
	INC	EXFL		;Set exiting state
	.BR	ATEX1

	.DSABL	LSB
	.SBTTL	ATEX1 - Indirect EXIT routine

;+
;ATEX1
;Routine to clean house before exiting in any matter other than KMON command
;(which is INDDCL).
;-

	.ENABL LSB

ATEX1::	TSTB	EXFL		;Are we exiting?
	BNE	2$		;Yes, exit directly.
	TST	ERLBL		;Is an error routine specified?
	BNE	3$		;Yes
	MOV	#DATDN,R1	;Get first data file FDB.
	MOV	#NDATF,R5	;Get the number of files to close.
1$:	CALL	$PURGE		;Purge all open data file
	ADD	#F$SIZE,R1	;Point to next FDB to close
	DEC	R5		;Decrement file count
	BGT	1$		;Loop til done.
2$:	MOV	@#SYSPTR,R0	;Point to start of RMON
	BICB	#CC$IND,$INDIR(R0) ;Enable control/c
	CLR	@#TRAPPC	;Reset trap vector address.
	CLR	@#TRAPPS	;Reset trap PSW.
	BIS	#<RS.EGR>,REGION+R.GSTS ;Set eliminate global region bit
	.ELRG	#EMTBLK,#REGION	;Return region to free list
	.EXIT			;Exit

;+
;Error routine was specified.  Set up label and jump back in.
;-

3$:	MOV	ERLBL,LABL	;Set up the label to search for...
	MOV	ERLBL+2,LABL+2	;
	MOV	ERLBL+4,LABL+4	;
	CLR	ERLBL		;Assure no circular error trapping.
	JMP	GO2ER		;Jump to GOTO code to find and goto label

	.DSABL	LSB

	.SBTTL	IND2, INTST, WDATA, XDCL

;+
;Command ready
;-

	.ENABL	LSB

IND2::	MOV	G.CMLD(R0),R1	;Get buffer length
	MOV	R1,LINBL	;Save it
	MOV	G.CMLD+2(R0),R0 ;Get buffer address
	CALL	CKDDAT		;Default to data?
	BEQ	1$		;Branch if not data
	CALL	CHKLIN		;Check for .DISABLE DATA directive
	BCS	9$		;Branch if we have a data string
1$:	BITB	#<GE.IEF>,GCML+G.MODE 	;Intermediate eof? (will only occur
				; if skipping to a label).
	BEQ	2$		;No
	BICB	#<GE.RWD>,GCML+G.MODE 	;Don't rewind any more
2$:	CALL	$GNBLK		;Skip leading blanks ?
	BCS	INDRD		;EOL found - get next command line
	DEC	R0		;Back up a character
	TSTB	SKIP		;Skipping to label?
	BEQ	8$		;No
	MOV	R0,R3		;Copy pointer
	CMPB	(R3)+,#<DOT>	;First character a dot?
	BNE	5$		;No
	BITB	#<LEAVE>,BLKFLG	;Leave this block?
	BNE	4$		;Yes
	MOV	#LABL,R2	;Set address of label we look for
	CALL	CMPAR		;Compare them
	BCS	3$		;Not the same if c-bit set
	CMPB	(R3)+,#<COLON>	;Label terminator?
	BNE	3$		;No
	BITB	#<GSUB>,BLKFLG	;Looking for subroutine label?
	BNE	7$		;Yes
	CMPB	SCAN,BLOCK	;Is label on this level?
	BEQ	7$		;Yes
3$:	BITB	#<GSUB>,BLKFLG	;Looking for subroutine?
	BNE	5$		;Yes
4$:	MOV	#BEG,R1		;Point at a BEGIN directive
	CALL	KEYWD		;Does line contain one?
	BCS	6$		;No
	INCB	SCAN		;Scan nesting gets deeper
5$:	JMP	INDRD		;Get next line

6$:	MOV	#ENDSTR,R1	;Point to an END directive
	CALL	KEYWD		;Does line contain one?
	BCS	5$		;No, get next line
	DECB	SCAN		;Scan nesting gets more shallow
	CMPB	SCAN,BLOCK	;Out of block?
	BGE	5$		;No
	BITB	#<LEAVE>,BLKFLG	;Leaving block?
	BEQ	13$		;No, undefined label
7$:	BICB	#<GSUB>,BLKFLG	;No longer looking for subroutine
	CLRB	SKIP		;Turn search mode off
	BICB	#<GE.RWD>,GCML+G.MODE 	;Set to not rewind
	BISB	#<GE.IND>,GCML+G.MODE 	;Enable deeper indirect control files
8$:	CMPB	@R0,#<DOT>	;Is it an internal comment?
	BNE	9$		;No
	CMPB	1(R0),#<SEMIC>	;Maybe
	BEQ	5$		;Yes, ignore it
9$:	CALL	STRSB		;Substitute strings in line
	TST	SBERR		;Was there an error?
	BNE	12$		;Yes
	TST	CMDBL		;Check output string length
	BEQ	5$		;Equal no string just ignore
	CLR	LINDS		;Reset line displayed flag
INTST::	CMPB	@R0,#<DOT>	;Process the command?
	BEQ	11$		;Yes, go parse it
	CALL	CKDDAT		;Default all lines to data?
	BEQ	XDCL		;Go pass it to CSI
WDATA::	MOV	R1,R3		;Get length of data buffer to write.
	CMPB	#<FF>,@R0	;Line feed character?
	BEQ	10$		;Yes, don't append <CR><LF> characters
	CMPB	#<VT>,@R0	;Vertical tab?
	BEQ	10$		;Yes, don't append <CR><LF> characters
	ADD	R0,R1		;Point to the last character.
	MOVB	#<CR>,(R1)+	;Append a carriage return
	MOVB	#<LF>,(R1)+	; and a line feed.
	ADD	#2,R3		;Account for the addtional characters.
10$:	MOV	R5,R1		;Point to FDB.
	MOV	R0,R2		;Get start of data buffer
	CALL	$WRREC		;Write buffer to file
	MOV	#<SPFIR+SEVAL>,R0 ;Point to area to store status code
	MOVB	F$ERR(R5),(R0)+	;Store only the low byte
	CLRB	@R0		;And make sure the high byte is cleared
	CMPB	#<1>,-(R0)	;Success?
	BEQ	5$		;Yes
	MOV	R1,R0		;No, get FDB for error routine
	TRAP	ERDFE		;Data file error

11$:	CMPB	1(R0),#<SEMIC>	;Is it an internal comment? (.;)
	BEQ	5$		;Yes, ignore the line
	JMP	PRCMD		;No, go parse indirect command

12$:	TRAP	ERSUB		;String substitution error

13$:	TRAP	ERUDL		;Undefined label error

XDCL::	JMP	INDCL		;Process KMON command

	.DSABL	LSB
	.SBTTL	CKDDAT - check if data lines

;+
;CKDDAT
;Check if all lines default to data.
;
; Input:  none
;
; Output: if answer is yes:
;		Z-bit cleared
;		R5 -> FDB of default data file
;
;	  if answer is no:
;		Z-bit is set
;
; Registers altered: R5
;-

	.ENABL	LSB

CKDDAT::MOV	ENDAT,R5	;Default all lines to data?
				;(if so get data file FDB in R5)
	BEQ	1$		;No
	TSTB	F$FLGS(R5)	;Data file open?
1$:	RETURN			;Return to caller

	.DSABL	LSB
	.SBTTL	CMPAR - compare two strings

;+
;CMPAR
;Compares two strings.  The characters in the buffer pointed to by R3
;may be in lowercase the template is always in uppercase.  Therefore,
;The string of characters in R3 must be converted to uppercase before
;comparing.
;
; Input:  R2 -> Template to compare with.  Ends with zero byte.
;	  R3 -> String to be compared.
;
; Output: If a match:
;		C-bit clear
;		R2 -> End of string
;		R3 -> Past last character of string
;	  If no match:
;		C-bit set
;		R2 -> Character after first non-matching one
;		R3 -> Character after first non-matching one
;-

	.ENABL	LSB

CMPAR::	MOVB	(R3)+,-(SP)	;Get a character
	CMPB	@SP,#<'A+40>	;Lower case character?
	BLT	1$		;No
	CMPB	@SP,#<'Z+40>	;Check high end
	BGT	1$		;No need to convert
	BICB	#40,@SP		;Convert to uppercase before compare
1$:	CMPB	(SP)+,(R2)+	;Do they match?
	SEC			;Assume no match
	BNE	2$		;No
	TSTB	@R2		;End of string?
	BNE	CMPAR		;No, continuing comparing
2$:	RETURN			;Return to caller

	.DSABL	LSB
	.SBTTL	CHKLIN - Check for DISABLE DATA directive

;+
;CHKLIN
;See if ".DISABLE DATA" is first on line.  If it is, the command satring is
;treated as a normal directive command.  If it is not the first occurance in
;the command string (blank characters are parsed).  If there is no match the
;string is treated as data to be stored.
;
; Input:  R0 -> command buffer
;
; Output: R0 -> command buffer
;	  C-bit cleared if .DISABLE DATA is present
;	  C-bit set if not present
;-

	.ENABL	LSB

CHKLIN:	SAVE	<R0>		;Save buffer pointer
	CALL	$GNBLK		;Get next non-blank character
	BCS	2$		;No characters (remember blank lines)
	CMPB	#<DOT>,R2	;First character a dot?
	BNE	2$		;Branch if no
	MOV	#DSATXT,R2	;Point to DISABLE string
	MOV	R0,R3		;Point to command string
	CALL	CMPAR		;Check if match
	BCS	2$		;Branch if no match
	MOV	R3,R0		;Get new pointer
	CALL	$GNBLK		;Get next non-blank character
	BCS	2$		;No characters followed
	TST	R1		;Any blank characters?
	BEQ	2$		;Branch if no
	DEC	R0		;Reset pointer
	MOV	#DATTXT,R2	;Point to DATA ASCII string
	MOV	R0,R3		;Point to start of next set of characters
	CALL	CMPAR		;Check for match
	BCS	2$		;Branch if no match
	MOV	R3,R0		;Set up for last check
	CALL	$GNBLK		;Get next non-blank character
	BCS	1$		;End of line detected
	TST	R1		;Any blank characters?
	BEQ	2$		;Branch if no
1$:	TST	(PC)+		;Clear c-bit
2$:	SEC			;C-bit set for data
	RESTOR	<R0>
	RETURN

	.DSABL	LSB

	.END	INDEP