.MCALL	.MODULE
.MODULE	INDSU1,VERSION=06,COMMENT=<Subroutines #1> GLOBAL=.ISU1

; 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.
;
;REVISION HISTORY
;
; 005	On 5.6 source kit
;
; 006	11-JUL-97	Tim Shoppa
;			<DATE4Y> now has 4-digit year filled in by TIMDAT
;
.ENABL	GBL,LC

	.SBTTL	Macro definitions.

;+
;System macro calls.
;-

	.MCALL	.GTIM, .DATE
	.MCALL	FDBDF$, GCLDF$, DEFIN$

FDBDF$					;Define FDB offsets.
GCLDF$					;Define GCML offsets.
DEFIN$					;Definitions for IND files

	.PSECT	INDSU1
	.SBTTL	SRSYM - Search symbol table

;+
;SRSYM
;General routine to search for symbol.  If SPCSYM is set, search the special
;symbol table.  Otherwise search the internal symbol table.
;
; Input:  CRNTS = Symbol to look for (RAD-50 packed in 2 words).
;
; Output: R4 - first free hole
;	C-bit set -> R5 - end of symbol table.
;	C-bit clear -> 	R5 - entry for symbol.
;-

	.ENABL	LSB

SRSYM::	TSTB	SPCSYM		;Searching for special symbol?
	BEQ	2$		;No
	MOV	#SPCTAB,R5	;Yes, set start of table
	MOV	SPCEND,R4	;Set end of table

;+
;First see if the symbol is one of the irregular special symbols (FILSPC
;or EXSTRI).
;-

	CMP	CRNTS,#<^RFIL>	;Is this "FILSPC"?
	BNE	1$		;No
	CMP	CRNTS+2,#<^RSPC> ;Check the last three characters
	BNE	1$		;No, it is not "FILSPC"
	MOV	#FILSPC,R5	;Return a pointer to the special symbol
	BR	10$		;Clear c-bit to show symbol found

1$:	CMP	CRNTS,#<^REXS>	;Is this "EXSTRI"?
	BNE	4$		;No
	CMP	CRNTS+2,#<^RTRI> ;Check the last three characters
	BNE	4$		;No, it is not "EXSTRI"
	MOV	#SPSDEV,R5	;Return a pointer to the special symbol
	BR	10$		;Clear c-bit to show symbol found

;+
;If not special symbol check global symbol table (if symbol is global).
;-

2$:	TSTB	GLOBS		;Can it be a global symbol?
	BEQ	3$		;No
	MOV	SYMTB,R5	;Yes, get start of global symbol table
	MOV	SYMFR,R4	;Set address of free space
	CALL	4$		;Try to find symbol in global table
	BCC	10$		;If found exit, else try local symbol table

;+
;Check local symbol table.
;-

3$:	MOV	SYMND,R5	;Start of local table
	MOV	LSYME,R4	;End of local symbol table

;+
;Symbol table search routine for special, global, and local symbols.
;-

4$:	CMP	R5,R4		;End of defined symbols?
	BHIS	11$		;Yes
	CMP	CRNTS,@R5	;First half of symbol name match?
	BNE	5$		;No
	CMP	CRNTS+2,2(R5)	;Second half of symbol name match?
	BEQ	7$		;Yes
5$:	CLR	R3
	BISB	SELEN(R5),R3	;Get length of value field of this entry
	ADD	#SEVAL+1,R3	;Add offset to value field plus 1
	BIC	#<1>,R3		; to round up
6$:	ADD	R3,R5		;Point to next entry
	BR	4$		;Test next symbol

;+
;Symbol found in table.  If the symbol is not a special symbol exit from
;routine.  If the symbol is a special symbol find out which one and get
;stored value.
;-

7$:	TSTB	SPCSYM		;Is it a special symbol?
	BEQ	10$		;No, just exit
	CMP	R5,#<SPACE>	;<SPACE> special symbol?
	BNE	8$		;No
	MOV	SYMND,R1	;Get start of local symbol table
	SUB	SYMFR,R1	;Minus end of global symbols to get # of free
				;bytes in symbol table
	MOV	R1,SEVAL(R5)	;Store the value
	BR	10$		;Return to caller

8$:	CMP	R5,#SPSDAT	;<DATE> special symbol?
	BEQ	9$		;Yes
	CMP	R5,#SPSD4Y	;<DATE4Y> special symbol?
	BEQ	9$		;Yes
	CMP	R5,#SPSTIM	;<TIME> special symbol?
	BNE	10$		;No
9$:	CALL	TIMDAT		;Set up time and date values
10$:	TST	(PC)+		;Make sure c-bit clear to indicate sym found
11$:	SEC			;Make sure c-bit set to indicate sym not found
	RETURN			;Return to caller

	.DSABL LSB
	.SBTTL	GTSYM - Get symbol

;+
;GTSYM
;Get symbol from input buffer.  Special symbols are defined by being bracketed
;with <>.
;
; Input:  R0 - address of input string
;	  At least 1 blank must precede symbol.
;
; Output: R0 - updated
;	  CRNTS - symbol (2 words RAD50 packed)
;	  C-bit is cleared if the syntax is good and set if bad syntax
;	  SPCSYM is set if symbol is a special
;
;GTSY1 (alternate entry)
;Similar to GTSYM, but there must be no blanks preceding the symbol.
;-

	.ENABL	LSB

GTSY1::	MOV	PC,-(SP)	;Set flag non-zero
	BR	GTSYMA		;Goto common routine

GTSYM::	CLR	-(SP)		;Set flag zero
GTSYMA:	CLRB	SPCSYM		;Assume not a special symbol
	CLRB	GLOBS		;Assume not a global symbol
	CALL	$GNBLK		;Get next non-blank
	BCC	1$		;No error so far
	TST	(SP)+		;Clean up stack
	BR	7$		;Set c-bit again and return

1$:	TST	R1		;Was there a blank?
	BNE	2$		;Yes
	TST	(SP)+		;Are blanks required?
	BEQ	7$		;Yes, syntax error
	BR	3$		;Branch around

2$:	TST	(SP)+		;Blanks allowed?
	BNE	7$		;No, syntax error
3$:	CMPB	R2,#'<		;Special symbol?
	BNE	4$		;No
	INCB	SPCSYM		;Yes, set special symbol flag
	BR	5$		;and process as so

4$:	DEC	R0		;Backup pointer
	CMPB	R2,#'$		;Is the first character a $ (global)?
	BNE	5$		;No
	BIT	#<DEFGLS>,.LIFLG ;Are we in global mode?
	BEQ	5$		;Branch if no
	INCB	GLOBS		;Set flag for global symbol
5$:	CALL	CAT5		;Convert to RAD50
	BCS	7$		;Syntax error
	MOV	R1,CRNTS	;Store the first RAD50 word
	MOV	R2,CRNTS+2	;Store the second wor
	TSTB	SPCSYM		;Special symbol?
	BEQ	9$		;No
	CMPB	(R0)+,#'>	;Does it have a proper ending character?
55$:	BNE	7$		;No, syntax error
6$:	TST	(PC)+		;Skip C-bit setting
7$:	SEC			;Set c-bit
8$:	RETURN			;Return to caller

; Check for valid terminating delimiter

9$:	CMPB	@R0,#'[		;'[' is valid
	BEQ	6$
	CMPB	@R0,#']		; so is ']'
	BEQ	6$
	MOV	R0,-(SP)	;Test for valid terminating delimiter by
	CALL	CVTADV		; seeing whether CVTADV advances R0.
	CMP	R0,(SP)+	;  If it advances, then it's an invalid
	BR	55$		;   delimiter.

	.DSABL	LSB
	.SBTTL	ASVALS - Assign string value

;+
;ASVALS
;Assign string value to string symbol.
;
;Input:  R0 -> String to assign to symbol
;	 R1 =  Length of string
;	 R5 -> SYMTAB entry for symbol
;
;Output: If ok:
;	   C-bit cleared
;		R0 -> Beyond string
;		R5 -> New SYMTAB entry
;		(may be different from R5 on input)
;	   If bit LOWCAS in .LIFLG is = 0, any lower case characters
;	   in the input string are converted to upper case.
;
;	  If error: (symbol table overflow)
;	    C-bit is set
;
;Registers altered: R0, R1, R4, R5
;-

	.ENABL	LSB

ASVALS::SAVE	<R2,R1>
	CLR	R4
	BISB	SELEN(R5),R4	;Get length of existing string value
	INC	R4		;Add one to
	BIC	#1,R4		; round up
	INC	R1		;Do same for R1
	BIC	#1,R1		;Get new string value length rounded
	SUB	R4,R1		;Calculate number of bytes entry will increase
	BEQ	8$		;If zero size is right
	MOV	#SPCEND,R2	;Assume special symbol
	CMP	R5,@R2		;Is it?
	BLO	1$		;Yes, SYMTAB entry is below SPCEND)
	MOV	#SYMFR,R2	;No, it is a user symbol
	MOV	SYMND,-(SP)	;Save it
	SUB	@R2,@SP		;Get number of free bytes in SYMTAB
	CMP	R1,(SP)+	;Is there enough room?
	BGT	12$		;NO,symbol table overflow error
1$:	MOV	2(R5),-(SP)	;Save symbol name
	MOV	@R5,-(SP)	;Two words for symbol
	SAVE	<R5>		;Save current SYMTAB pointer
	CMP	R5,SYMND	;Is it a local symbol?
	BHIS	2$		;Yes
	MOV	R5,R4
	CLR	R5
	BISB	SELEN(R4),R5
	ADD	R5,R4		;Get start pointer of block to move
	ADD	#SEVAL+1,R4
	BIC	#1,R4		;Round up to word boundary
	MOV	@R2,R5		;Get end pointer ($SYMFR/SPCEND)
	ADD	R1,@R2		;Set new $SYMFR/SPCEND
	BR	3$

2$:	MOV	SYMND,R4	;Get start pointer of block to move
	NEG	R1		;Get # of bytes SYMTAB entry decreases (may
				;be negative)
	ADD	R1,SYMND	;Get new $SYMND
	ADD	R1,@SP		;Get new SYMTAB entry address
3$:	TST	R1
	BMI	5$		;Bbranch to move downwards
	ADD	R5,R1		;Move up. Get top of block after relocation
4$:	CMP	R5,R4
	BLOS	7$		;Branch if done
	MOVB	-(R5),-(R1)	;Move from top downwards
	BR	4$		;Branch until done

5$:	ADD	R4,R1		;Move down,get start of block after relocation
6$:	CMP	R4,R5
	BHIS	7$		;Branch if done
	MOVB	(R4)+,(R1)+	;Move from bottom upwards
	BR	6$		;Branch until done

7$:	RESTOR	<R5>		;Get new SYMTAB entry
	MOV	(SP)+,@R5	;Insert symbol name
	MOV	(SP)+,2(R5)
	MOVB	#STR,SETYP(R5)	;Symbol type = string
8$:	RESTOR	<R1>		;Get string length
	MOVB	R1,SELEN(R5)	;Store it
	SAVE	<R5>		;Save SYMTAB entry
	ADD	#SEVAL,R5	;Point to value field
9$:	DEC	R1		;Decrement character count
	BMI	11$		;All done.
	MOVB	(R0)+,R4	;Get next character
	BIT	#<LOWCAS>,.LIFLG ;Lower to upper case conversion required?
	BNE	10$		;No, skip conversion routine
	CMPB	R4,#<'A+40>	;Is this a lower case letter?
	BLO	10$		;No, just store it
	CMPB	R4,#<'Z+40>	;Maybe, check high limit
	BHI	10$		;No, just store character
	SUB	#40,R4		;Yes, convert to upper case
10$:	MOVB	R4,(R5)+	;Store the character
	BR	9$		;Get next

11$:	RESTOR	<R5>
	TST	(PC)+		;Clear c-bit
12$:	COM	(SP)+		;Skip saved R1 and set c-bit
	RESTOR	<R2>
	RETURN			;Return to caller

	.DSABL	LSB
	.SBTTL	CAT5/CAT5P - Convert ASCII to RAD50

;+
;CAT5
;Convert ASCII to RADIX-50.
;1 to 6 characters are converted.
;Legal ASCII characters are alphanumeric and $.  A dot character is considered
;an illegal character.
;
; Input:  R0	Pointer to ASCII string
;
; Output: R0	Pointer to first character not converted
;
;	  If at least 1 character converted:
;	  C-bit is cleared
;	  R1	First part of RAD50 representation
;	  R2	second half
;
;	  If no characters converted:
;	 C-bit is set
;
; Registers altered: R0,R1,R2
;-

	.ENABL	LSB

CAT5::	CALL	3$		;Make sure characters are in uppercase form
	CLR	-(SP)		;Clear second half of RAD50
	CLR	R1		;Set flag word for illegal RAD50 dot
	CALL	$CAT5		;Convert first 3 characters
	SAVE	<R1>		;Save first word
	BEQ	2$		;Nothing converted - error
	BCS	1$		;Only 1 or 2 characters converted
	CLR	R1		;Set flag word for illegal RAD50 dot
	CALL	3$		;Make sure characters are in uppercase form
	CALL	$CAT5		;Convert next three characters
	MOV	R1,2(SP)	;Store it
1$:	SBC	R0		;Back up pointer if last conversion < 3 char.
	TST	(PC)+		;Clean up and return
2$:	SEC			;Set c-bit for error
	RESTOR	<R1,R2>		;Get result
	RETURN

;+
;The following routine sees if the character is a lowercase character and
;converts it to uppercase if it is.  If a terminating character such as
;SPACE or TAB is encountered the pointer is not updated and the loop
;continues until the loop count is exhausted.
;-

3$:	JSR	R2,$SAVVR	;Save <R0,R1,R2>
	CALL	CVTADV		;Convert the first character
	CALL	CVTADV		;Convert the second character
				;Convert the third character
CVTADV:
;	CMPB	@R0,#<HT>	;Tab character?
;	BEQ	6$		;Branch out if yes
;	CMPB	@R0,#<SPA>	;Space character?
;	BEQ	6$		;Branch out if yes
	CMPB	@R0,#'$		;Dollar sign?
	BEQ	5$		;Yes, bump pointer
	CMPB	@R0,#60		;Otherwise, any other punctuation/ctrl-char?
	BLO	6$		;Branch if so.
	CMPB	@R0,#71		;Within numeric range?
	BLOS	5$		;Branch if yes
	CMPB	@R0,#'A		;Upper case character?
	BLO	6$		;Branch if no
	CMPB	@R0,#'Z		;Is it in uppercase range?
	BLOS	5$		;Branch if yes
	CMPB	@R0,#<'A+40>	;Is this a lower case letter?
	BLO	5$		;No. Don't convert
	CMPB	@R0,#<'Z+40>	;Beyond the high limit?
	BHI	5$		;Yes, don't convert
	BICB	#40,@R0		;Convert it
5$:	TSTB	(R0)+		;Point to next character
6$:	RETURN

	.DSABL	LSB
	.SBTTL	PSHBLK/POPBLK - Change block context

;+
;PSHBLK
;Push block context onto stack
;
;POPBLK
;Pop block context from stack
;
;Input:  none
;
;Output: none
;
;Side effects:
; Block context pushed or popped as appropriate
; Nesting level adjusted
; Symbol table end remembered
;-
	.ENABL	LSB

PSHBLK::MOV	(SP)+,SCR	;Store the external stack pointer
	MOV	#CONTXT,R4	;Point to block context
	MOV	(R4)+,-(SP)	;Save beginning of GOTO scan
	MOV	(R4)+,-(SP)	;
	MOV	(R4)+,-(SP)	;
	MOV	(R4)+,-(SP)	;Save old end of local symbols
	MOV	SYMND,CONTXT+6	;Remember current end of local symbols
	INCB	BLOCK		;Nesting level deepens
	BR	1$		;Join common code

POPBLK::DECB	BLOCK		;Decrement the nesting level
	BMI	2$		;If minus, nesting error
	MOV	(SP)+,SCR	;Store the external stack pointer
	MOV	CONTXT+6,SYMND	;Restore old end of symbol table
	MOV	#CONTXT+10,R5	;Point past current block context
	MOV	(SP)+,-(R5)	;Restore old end of local symbols
	MOV	(SP)+,-(R5)	;and old positional context
	MOV	(SP)+,-(R5)	;
	MOV	(SP)+,-(R5)	;
1$:	MOV	SCR,-(SP)	;Restore external stack
	RETURN			;Return to caller

2$:	TRAP	ERNST		;Invalid nesting

	.DSABL	LSB
	.SBTTL	$GTNUM - convert an ASCII number to BINARY

;+
;$GTNUM
;Convert a string of ASCII numbers to one BINARY number (one word).  If the
;BINARY number overflows a possible error occurs.  Upon entering this routine
;attempt is made to convert decimal to binary.  Two things are expected on
;return.  R2 contains the next character following the last ASCII numeric
;character.  Also the c-bit is cleared or set depending on the BINARY value
;overflowing the word.  If the c-bit is cleared and the next character is not
;a decimal point the correct conversion was made and control returns to
;caller.  If the c-bit is set and the last character is not a decimal point
;a real error has occured and control is returned to the caller with the
;c-bit set.  If the last character is not decimal independent of the c-bit's
;status the string is processed again as an octal number.  Upon completion of
;the conversion control is returned to the caller with the c-bit set (if
;error) or cleared (success).
;
; Input:  R0 -> buffer address
;
; Output: R0 -> updated buffer pointer
;	  R1 =  Converted number in BINARY
;	  R2 =  last character scanned (not decimal point if found but the
;		character after it).
;	  C-bit set if an error occured
;-

	.ENABL	LSB

$GTNUM::SAVE	<R0>		;Save buffer pointer
	MOV	#5$,-(SP)	;Set up default execution (octal number)
	BIT	#<OCTAL>,.LIFLG	;Are we in octal mode?
	BEQ	1$		;Branch if no
	MOV	#3$,@SP		;Set up for normal mode
1$:	CALL	$CDTB		;Convert DECIMAL to BINARY
	BCS	4$		;Error occured - value too large
	CMPB	R2,#<DOT>	;End in decimal point ?
	BEQ	2$		;Yes
	BIT	#<OCTAL>,.LIFLG	;Are we in octal mode?
	BEQ	3$		;Branch if no
	MOV	#5$,@SP		;Convert octal to binary
	JMP	@(SP)		;Goto to convert routine

2$:	MOVB	(R0)+,R2	;Point beyond it
3$:	CMP	(SP)+,(SP)+	;Clean up stack
	BISB	#<ALTTYP>,LIMTYP ;Set type to decimal
	BR	6$		;Exit without error

4$:	CMPB	R2,#<DOT>	;End in dot?
	BEQ	7$		;Branch if yes
	BIT	#<OCTAL>,.LIFLG	;Octal mode?
	BEQ	7$		;Branch if no
5$:	TST	(SP)+		;Clean stack of routine address
	RESTOR	<R0>		;Get buffer pointer
	CALL	$COTB		;Convert to OCTAL
	CMPB	#'8,R2		;Last character a decimal number?
	BEQ	7$		;Branch if yes - error
	CMPB	#'9,R2		;Last character a decimal number?
	BEQ	7$		;Branch if yes - error
6$:	TST	(PC)+		;Clear C-bit
7$:	SEC			;Set C-bit
	RETURN

	.DSABL	LSB
	.SBTTL	TIMDAT - Get current time and date

;+
;TIMDAT
;Get the current time and date and fill in the special symbols <TIME>
;<DATE4Y>, and <DATE>.
;
; Inputs:  none
;
; Outputs: <TIME>, <DATE4Y>, and <DATE> are filled in.
;-

	.ENABL	LSB

TIMDAT::CALL	$SAVAL		;Save all registers.
	.GTIM	#EMTBLK,#TIMBLK	;Get time in output area.
	MOV	#TASBLK,R5	;R5 -> TIMASC argument block.
	CALL	TIMASC		;Call FTN conversion routine...
				;  this will place the ascii time
				;  in the time special symbol.
	.DATE			;Get the current date in R0.
	TST	R0		;Any date?
	BEQ	1$		;If no date, return and give null string
	SAVE	<R0>		;Copy the date.
	BIC	#<^C37>,@SP	;Isolate the year minus 72
	ADD	#1972.,@SP	;Get the real-world year
	ASR	R0		;Get epoch*32 on byte boundary		;006
	MOV	R0,R3		;keep this for month use		;006
	SWAB	R3		;bring it down to low byte		;006
	BIC	#<^C000140>,R3	;Isolate epoch*32			;006
	ADD	R3,@SP		;And add it to the year			;006
	ASR	R0		;Get month on byte boundary		;006
	MOV	R0,R3		;Get the date
	SWAB	R3		;Put month in low byte
	DEC	R3		;Month minus 1 for month table calculation
	BIC	#<^C17>,R3	;Isolate the month			;006
	ASR	R0		;Get day on byte boundry
	ASR	R0
	ASR	R0
	BIC	#<^C37>,R0	;Isolate the day.
	MOV	R0,R1		;Copy binary day to R0
	MOV	PC,R2		;Set R2 non-zero to allow leading zeros
	MOV	#SCR,R0		;Point to scratch buffer
	CALL	$CBDMG		;Convert and store the ASCII day.
	CMPB	-(R0),-(R0)	;Point to first valid character
	MOV	#SPSD4Y+SEVAL,R1;Point R1 at output area.		;006
	MOVB	(R0)+,(R1)+	;Store the date
	MOVB	(R0)+,(R1)+	;Store the date
	MOV	R1,R0		;Now make R0 the pointer to store area
	MOVB	#'-,(R0)+	;Store day/month seperator.
	ASL	R3		;Get month * 2
	ASL	R3		;Get month * 4
	ADD	#MOTABL,R3	;Index into ASCII month table.

	.REPT	4		;Copy the ASCII month text.
	MOVB	(R3)+,(R0)+
	.ENDR

	RESTOR	<R1>		;Retrieve the year.
	CLR	R2		;Indicate zero supress.
	CALL	$CBDMG		;Convert and store the ASCII year.

	MOV	#SPSDAT+SEVAL,R0;Point R0 at <DATE> area.		;006
	MOV	#SPSD4Y+SEVAL,R3;Point R1 at <DATE4Y> area.		;006

	.REPT 7			;Copy 7 chars of <DATE4Y> into <DATE>	;006
	MOVB	(R3)+,(R0)+						;006
	.ENDR								;006
	CMPB	(R3)+,(R3)+	;Skip the century digits		;006
	MOVB	(R3)+,(R0)+	;And move the last two digits		;006
	MOVB 	(R3)+,(R0)+	;of the year only			;006

1$:	RETURN			;Return to caller

	.DSABL	LSB
	.SBTTL	.MARK - Get information about current index

;+
;.MARK
;Returns the current information about the current index into a file.
;
;Input:  R0 -> FDB
;
;Output: R0 -> FDB 
;	 R1 =  0
;	 R2    Virtual block index into file.
;	 R3    Current byte index into current block.
;-

 
.MARK::	CLR	R1		;Clear R1
	MOV	F$BLKN(R0),R2	;Get VBN.
	MOV	F$BUFP(R0),R3	;Get byte index
	RETURN
	.SBTTL	.POINT - Set file open

;+
;.POINT
;Sets file open on specified FDB to specified index
;
;Input:  R0 -> FDB 
;	 R1 =  0
;	 R2    Virtual block number
;	 R3    Byte index into specified VBN.
;
;Output: none
;
;Effects:
; FDB is updated using supplied information
;
;No registers modified.
;-
 
.POINT::MOV	R2,F$BLKN(R0)	;Set VBN.
	MOV	R3,F$BUFP(R0)	;Set byte index.
	RETURN

	.END