.MCALL	.MODULE
.MODULE	INDTES,VERSION=19,COMMENT=<Entry point for TEST directive>

; 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.
	.SBTTL	Edit History

;+
;
; (019) 11-Aug-91 MBG	Extended magtape error checking
;
;-

	.ENABL	GBL,LC
	.SBTTL	Macro definitions and internal data

	.LIBRARY "SRC:SYSTEM.MLB"

	.MCALL	.READW, .CLOSE, .RELEASE, .HERR, .SPFUN
	.MCALL	DEFIN$, RT5DF$, GCLDF$, FERDF$

	.MCALL	.ERMDF	.SFMDF	.SYCDF

	GCLDF$				;Define GCML block offsets and symbols
	DEFIN$				;Definitions for IND files
	FERDF$				;Define file service error codes
	RT5DF$				;RT11 definitions

	.ERMDF				;Magtape error codes
	.SFMDF				;Magtape special functions
	.SYCDF				;System communications area

	OPSECT	INDTES

ERRBLK:	.BLKW	4			; SPFUN error return block
	.SBTTL	TEST - Determine symbol type
;+
;TEST
;The following routine determines the symbol type and sets various special
;symbols depending on the type of symbol being examined.
;
;If the symbol is a logical symbol:
;	<SYMTYP> = 0
;
;If the symbol being tested is numeric:
;	<SYMTYP> = 2
;	<OCTAL> = T if value is octal, F if the value is decimal
;
;If the symbol being tested is a string symbol:
;	<SYMTYP> = 4
;	<RAD50> and <ALPHAN> set T or F depending on the string containing
;	all RAD50 or alphanumeric characters.
;	<STRLEN> :
;		If the string symbol is specified without a substring
;		STRLEN contains the length of the string assigned to the
;		symbol.  If a substring is specified, STRLEN contains the
;		character position where the substring begins.  If the
;		substring is not found, STRLEN contains 0.
;-

	.ENABL	LSB

TEST::	CALL	$GNBLK		;Get next non blank
	BCS	10$		;Syntax error
	DEC	R0		;Reset pointer to start
	MOV	SYMND,-(SP)	;Save start of local symbol table
	CMPB	#<DQUOT>,R2	;Control string in second field?
	BNE	1$		;No, keep processing

;+
;If the first character of the command string (at this point) is a quote
;assume a string follows.  If it is a string, make a temporary symbol entry
;in the local symbol table.  This entry will be reset before leaving this
;routine.
;-

	CALL	GSVAL		;Get string value
	SUB	#6,SYMND	;Get start of local sym tbl, expand downwards
	MOV	SYMND,R5	;Get new start
	SAVE	<R0,R5>		;Save updated CMDBUF pointer and symbol table
	CLR	(R5)+		;Enter null string symbol name
	CLR	(R5)+		;Two words
	MOV	#4,@R5		;Store symbol type
	RESTOR	<R5>
	MOV	#SCR1,R0	;Point to string to store
	CALL	ASVALS		;Assign value in symbol table
	BCS	12$		;Symbol table overflow
	RESTOR	<R0>		;Get the command string pointer
	BR	2$		;Go to common SYMTYP check



;+
;General routine for all symbols.  Get a symbol from the command string and
;search the symbol table for it.
;-

1$:	CALL	GTSY1		;Get the symbol (no check for non blank)
	BCS	10$		;Syntax error
	CALL	SRSYM		;Find the symbol in the symbol table
	BCS	11$		;Symbol not found - error
2$:	MOVB	SETYP(R5),-(SP)	;Get the symbol type
	BIC	#^C<376>,@SP	;Isolate the symbol type.
	MOV	(SP)+,SPSTP+SEVAL ;Store the results in <SYMTYP>
	CMPB	SETYP(R5),#<STR> ;String symbol?
	BEQ	4$		;Branch if yes
	BITB	#<NUM>,SETYP(R5) ;Numeric symbol?
	BEQ	3$		;Branch if logical
	CLRB	SPSOCT+SETYP	;Assume octal (TRUE)
	.ASSUME	<LOGT> EQ 0
	BITB	#1,SETYP(R5)	;Test bit for decimal
	BEQ	3$		;Branch out if octal
	INCB	SPSOCT+SETYP	;Set <OCTAL> to FALSE
	.ASSUME <LOGF> EQ 1
3$:	CALL	$GNBLK		;Check for further data on a line
	TST	R2		;Anything following?
	BEQ	8$		;Yes, exit routine
	CMPB	#<DOT>,R2	;Dot for internal comment (legal)
	BNE	10$		;No, error
	CMPB	#<SEMIC>,@R0	;Next character a semi-colon?
	BNE	10$		;Syntax error
	BR	8$		;Branch out if done.

4$:	MOVB	SELEN(R5),SPSSL+SEVAL ;Store the string length in <STRLEN>
	SAVE	<R5>		;Save start of symbol entry for CKTYPE
	CALL	$GNBLK		;Get next non blank character
	BCS	7$		;Branch out if end of string
	DEC	R0		;Reset pointer
	CLR	SPSSL+SEVAL	;Initialize <STRLEN>
	CLR	-(SP)
	BISB	SELEN(R5),@SP	;Get string count
	SAVE	<R5>		;Save pointer to temporary symbol
	ADD	#6,@SP		;Point to string
	CALL	GSVAL		;Get the string value of the symbol
	CLRB	SCR1(R1)	;End template string with zero byte
	RESTOR	<R3>		;Restore pointer to temporary symbol (prev R5)
	MOV	R3,R1		;Save pointer to search string for later
	MOVB	(SP)+,R4	;Get length of search string
5$:	MOV	R5,R2		;Point to template to compare to
	SAVE	<R3>		;Save updated pointer to string to search
	CALL	CPAR		;Is there a match?
	BEQ	6$		;Branch out if yes
	RESTOR	<R3>		;Get pointer to where string search started
	INC	R3		;Update pointer to start again
	DECB	R4		;Decreament the string count
	BGT	5$		;Branch to search if not at end of string
	BR	7$		;Else exit

6$:	SUB	R1,@SP		;Get diff between start of string and
				;where the match begins
	INC	@SP		;Adjust for position
	MOV	(SP)+,SPSSL+SEVAL ;Store it in <STRLEN>
7$:	RESTOR	<R0>		;Get start of symbol entry
	CLR	R1
	BISB	SELEN(R0),R1	;Get length of string
	ADD	#SEVAL,R0	;Get address of string in R0
	CALL	CKTYPE		;Set <ALPHAN> and <RAD50>
8$:	MOV	(SP)+,SYMND	;Get old pointer to end of symbol table
9$:	JMP	INDRD		;Done, get next command

10$:	TRAP	ERSYN		;Syntax error
11$:	TRAP	ERUDS		;Undefined symbol
12$:	TRAP	ERSOV		;Symbol table overflow

	.DSABL	LSB
	.SBTTL	CPAR - Convert to uppercase

;+
;CPAR
;If lowercase is disabled convert to all lowercase characters to uppercase.
;-

	.ENABL	LSB

CPAR::	MOVB	(R3)+,-(SP)	;Get a character
	CALL	2$		;Convert to uppercase if lowercase is disabled
	MOVB	(R2)+,-(SP)	;Save character
	CALL	2$		;Convert next to uppercase if lowercase dsabl
	CMPB	(SP)+,(SP)+	;Do they match?
	BNE	1$		;No return with Z-bit clear
	TSTB	@R2		;End of string?
	BNE	CPAR		;No check next value
1$:	RETURN			;Return to caller

2$:	BIT	#LOWCAS,.LIFLG	;Lowercase disabled?
	BNE	3$		;Branch if no
	CMPB	@SP,#<'A+40>	;Lower case character?
	BLT	3$		;No
	CMPB	@SP,#<'Z+40>	;Check high end
	BGT	3$		;No need to convert
	BICB	#40,@SP		;Convert to uppercase before compare
3$:	RETURN

	.DSABL	LSB
	.SBTTL	VOL/STRUCTURE - Return volume ID or file type in string symbol
	.GLOBL	BOOTCD,VOLFLG,REDBLK,DVSTAT

;+
;VOL
;Routine to store the volume id string in the symbol table.  Only the volume
;id is stored the owner is not included.
;-

VOL::
	MOVB	#<STR>,SYMTP	;Must be string symbol
	CALL	PRSYM		;Parse symbol table for symbol
	MOV	#HOMBLK,REDBLK	;Need to read home block
	CALL	VOLSTR		;Go read the block
	BCS	AHPOOP		;Didn't work, give error
;+
;Get the offset into the buffer for the start of the VOLID.  Also get the
;character count.  The offset and count are different for magtape.  Call
;ASVALS to store the string in the symbol table.
;
; R2 is the input buffer.
;-
	MOV	#DK.VID,R0	;Assume we want the VOLID of a disk
	MOV	#DK.VSZ,R1	;Get offset to end of volid
	BIT	#<SPECL$>,DVINFO ;Non-file structured device?
	BEQ	1$		;Branch if no
	MOV	#MT.VID,R0	;Get offset to magtape VOLID
	MOV	#MT.VSZ,R1	;Get offset to end of volid
1$:	ADD	R2,R0		;Adjust to point at string to store
	CALL	ASVALS		;Store the string in symbol table

GOODEX:	TST	DVINFO+4	;Was handler FETCHed?
	BNE	1$		;Branch if no
	.RELEAS	#WRKFDB+F$DNAM	;Yes, then release it
1$:	JMP	INDRD		;Return for next command

AHPOOP:	SAVE	<R0,R1,R5>	;Save some registers
	MOV	#SCR1,R0	;Get a scratch area
	MOVB	#DQUOT,@R0	; to hold two quotes
	MOVB	@R0,1(R0)	;  ""
	CLR	R1		;Indicate length=0
	CALL	ASVALS		;Assign "" to .VOL string
	RESTOR	<R5,R1,R0>	;Restore the registers

	BIT	#<ATTFLG>,DVSTAT ;Is this device attached to another job?
	BNE	1$
	CMPB	#<IE.RER>,SPFIR+SEVAL ;Read error from .VOL?
	BEQ	GOODEX		;Yes, caller will process error
	CMPB	#<IE.NOS>,SPFIR+SEVAL ;Handler couldn't be fetched?
	BEQ	GOODEX		;Yes, caller will process error
	TRAP	ERDFE		;device error
1$:	TRAP	ERATT		;device is attached, give error

;+
;STRUCTURE
;Routine to store the file type string in the symbol table.
;This routine is based on the boot rom spec published by Simon Szeto
;on 23-Sep-83. The data is found as follows.
;
;	Byte 0 		240 or 0
;	Byte 1		0 or 20
;	Byte 2		Offset to identification area - this is BOFFID
;	Byte 3		1 - system, 0 - data
;	Byte N*2	CPU instruction set type
;	Byte N*2+1	Controller type
;	Byte N*2+2	File structure type - See INDSYM at BOOTCD: for list
;	Byte N*2+3	Checksum of bytes N*2 thru N*2+2, complement of sum
;	Byte N*2+4	0
;	Byte N*2+5	version number of standard 1xx - one sided, 2xx - two sided
;-
	BOFFID	= 2	;Byte 2 -> offset value
	BOFFIL  = 2	;Byte N*2+2 -> File structure type

	.ENABL LSB

STRUCT::CLR	REDBLK		;Need to read block zero.
	MOVB	#<NUMOCT>,SYMTP	;Must be octal symbol
	CALL	PRSYM		;Parse symbol table for symbol
	CALL	VOLSTR		;Go read the block
	BCC	5$		;Branch if no error
	CLR	R0		;Set condition unknown
	BR	25$		;Branch out to give unknown condition

;+
;Get the offset into the buffer for the file type. 
;
; R2 is the input buffer.
; R1,R3 are workers
; R0 is answer to routine 
;-

5$:	CLR	R0		;Start unknown
	BIT	#<SPECL$>,DVINFO ;Non-file structured device?
	BNE	25$		;Say UNKNOWN if yes

	MOVB	BOFFID(R2),R1	;Get pointer to id area
	ASL	R1		;Multiply by two for word offset
	ADD	R1,R2		;Point to Byte N*2 in input buffer
	MOVB	(R2)+,R1	;Get value in Byte N*2
	MOVB	(R2)+,R3	;Get value in Byte N*2+1
	ADD	R3,R1		;Add em
	MOVB	(R2)+,R3	;Get value in Byte N*2+2
	ADD	R3,R1		;Add it in
	COM	R1		;Complement it
	CMPB	@R2,R1		;Is this a valid boot standard
	BNE	25$		;Not valid, file structure unknown, R0=0	

	CLR	R1		;On to next calc
	MOVB	-(R2),R1	;Get file value from disk.
	BMI	20$		;If NEG, User file structure
	MOV	#BOOTCD,R2	;Get table start
	ASR	R1
	ASR	R1
	ASR	R1		;divide by 10 for range check.
15$:	TSTB	(R2)		;End of table yet?
	BEQ	25$		;If fall off table, unknown
	CMPB	R1,(R2)+	;Is this it
	BNE	15$		;No continue
20$:	MOVB	R3,R0		;This is it
25$:	MOVB	R0,SEVAL(R5)	;Store value in table
	MOVB	#<NUMOCT>,SETYP(R5) ; Say its octal
;	BIS	#<OCTAL>,.LIFLG ;Set octal
	BR	GOODEX


	.DSABL	LSB

.SBTTL VOLSTR	Routine to read a block
;+
; This is a common subroutine used to read either block 1 or 0.  The
; symbol is located, the device is fetched and a read is done.
;-
	.ENABL LSB

VOLSTR:	MOV	SP,VOLFLG		; Prevent GETHDL from calling INDDEV
	CALL	GDSTAT			; Get device status
	BCS	30$			; Device not found in tables
	MOV	DVINFO,R0		; Get it
	BIC	#^C<FILST$!SPECL$>,R0	; Isolate these bits	
	BEQ	20$			; Error if NEITHER set
	CMP	#<FILST$!SPECL$>,R0
	BEQ	30$			; Error if BOTH set
10$:	BIS	#<LOKFLG>,DVSTAT	; Want LOOKUP
	CALL	GETHDL			; Get handler in core and do LOOKUP
	CMPB	#<IE.NOS>,SPFIR+SEVAL	; No room for handler?
	BEQ	50$			; Yes, return empty handlerd.
	CMPB	#<IE.RER>,SPFIR+SEVAL	; Read error?
	BEQ	50$			; Yes, device offline.
	BIT	#<ATTFLG>,DVSTAT 	; Is device attached to another job?
	BNE	20$			; YES, give error
	MOV	R1,$IOWNR		; Take ownership of input buffer
	MOV	#$INPBF,R2		; R2 = Start address of read buffer
;+
;Read in the home block for .VOL and the zero boot block for .STRUCTURE.  
;Once the block is read into the input buffer the channel is not needed.  
;Close it.
;-
	BIT	#<TAPEFG>,DVSTAT	; Is device a TAPE?
	BEQ	15$			; Branch to READW if not
	.SPFUN	#EMTBLK,@R1,#SF.MRD,R2,#256.,#ERRBLK,#0	; Read VOL1 label
	BCC	16$
	TSTB	@#$ERRBY		;Hard error?
	BEQ	20$			;Nope, EOF or EOT indicator
	CMP	ERRBLK,#EM.SML		;Short block read?
	BEQ	16$			; those are ok.
	BR	20$			; bad things occurred.

15$:	.READW	#EMTBLK,@R1,R2,#256.,REDBLK
    .ASSUME  F$CHAN EQ 0		; F$CHAN(R1)
	BCS	20$			; Branch if error
16$:	.CLOSE	@R1			; Get rid of channel
    .ASSUME  F$CHAN EQ 0		; F$CHAN(R1)
	MOV	#<IS.SUC>,F$ERR(R1)	; Assume that everything is fine
	BR	60$

20$:	MOV	#<IE.RER>,F$ERR(R1)	; Device read error
	BR	40$			; Process rest of error

30$:	MOV	#<IE.IDU>,F$ERR(R1)	; invalid device or unit error
40$:	MOVB	F$ERR(R1),SPFIR+SEVAL	; Store error code in special symbol
	.HERR				; Make monitor handle serious errors
	.CLOSE	@R1			; Get rid of channel
    .ASSUME  F$CHAN EQ 0		; F$CHAN(R1)
	MOV	R1,R0			; R0 -> FDB on error
50$:	SEC
60$:	RETURN

	.DSABL	LSB

	ROUNDUP				; Check for overflow and roundup

	.END