PROCEDURE	<RNSYM -- MANAGE SYMBOL TABLE>,010001
;+
; Abstract:	RNSYM
;
;	This module has support for the RUNOFF symbol table,
;	including variable creation, lookup, table initialisation,
;	and variable modification. Variable names may have up to
;	6 characters and may take on numeric or character
;	quantities. A variable which is of CHARACTER type may
;	not take on a numeric quantity and vice-versa.
;
; Calling sequence:
;
;	MOV	#VARIABLE_NAME_BUFFER,R1
;	MOV	#VARIABLE_VALUE,R0
;	CALL	SETINT		; Add or modify existing integer
;
	.IF	DF	A$$RAP
;	MOV	NUMBER_OF_CHARACTERS,R2
	.ENDC
;	MOV	#VARIABLE_NAME_BUFFER,R1
;	MOV	#VARIABLE_VALUE_BUFFER,R0
;	CALL	SETCHA		; Add or modify existing character
;
;	MOV	#VARIABLE_NAME_BUFFER,R1
;	CALL	RETCHA		; Retrieve a character representation
;				; of a character or integer variable
;
;	MOV	#VARIABLE_NAME_BUFFER,R1
;	CALL	RETINT		; Retrieve a numeric representation
;				; of an integer variable.  Result is
;				; in R0, and CC-C is set if the
;				; variable does not exist or is of
;				; the wrong type.
;	
;	MOV	#VARIABLE_NAME_BUFFER,R1
;	CALL	DELSYM		; Delete existing symbol
;
;	CALL	INISYM		; Initialise symbol table
;
	.IF	DF	A$$RAP
; *** note ***
;
;	Variable deletion (DELSYM), and the various character
;	functions (including character variables) are not yet
;	implemented in their entirity because no syntactic
;	method has yet been devised for their use !!!
;
	.ENDC
; Written: 12-Apr-80, -1.0.0-, Bruce C. Wright
; Modified: 05-Nov-80, -1.0.1-, John D. Leonard
;	Added SETCHA and DELSYM for use with .SUBD and .SUB
;	SUBSYM is the routine to substitute the symbols with their
;	character string representations.
;-

;
; Format of symbol table list
;
SYMNXT	=	0	; Pointer to next symbol in list.
SYMNAM	=	2	; Beginning of symbol name (6 bytes)
SYMTYP	=	10	; Symbol type
	.IF	NDF	A$$RAP
  INTSYM=    0		; Integer type
  CHASYM=    1		; Character type
	.IFF
  INTSYM=    1		; Integer type flag bit
  CHASYM=    2		; Character type flag bit
  DLTSYM==   4		; Indicates how character string is to be matched -
			; If off, any match warrants replacement -
			; If on , only delimited matches get replaced.
  TMPSYM==  10		; On indicates a temporary symbol, Off 'permanent'
			; Character strings defined within .EQ/.EEQ commands
			; are temporary strings.
;
; A delimited match is one where the string being searched for is surrounded
; by something other than A-Z, a-z, 0-9. If the string is imbedded in another
; string it will not be substituted.
;
;
SYMLEN	==	6.	; Length of symbol
	.ENDC
;
; Portion for Integer symbols only
;
INTVAL	=	12	; Value for integer symbols
INTLEN	=	14	; Total size of entry for Integer variable
;
; Portion for Character symbols only
;
CHASIZ	=	12	; Size of character symbol
CHAHDR	=	14	; Length of header (total size variable)
	.IF	DF	A$$RAP
CHAVAL	=	14	; start of character symbol
	.ENDC
;
	DATA	RNSYMD,LCL
;
; The list header
;
;
SYMHDR:	.WORD	0	; Header of list of table entries
CHABUF:	.ASCII	"        " ; Buffer for character conversion.
;
; External subroutine to initialise the symbol table listhead.
;
	CODE	RNSYM
INISYM::
	CLR	SYMHDR		; Clear out the symbol table.
	RETURN			; And return to the caller.
;
; External subroutine to set an integer variable.  It will
; return with CC-C set if the variable specified is not an
; integer.
;
SETINT::
	MOV	R1,-(SP)	; Save the buffer address.
	CALL	LOCSYM		; Lookup the symbol.
	BCC	10$		; Skip if no error.
	MOV	R0,-(SP)	; Save R0
	MOV	#INTLEN,R0	; Get the symbol size.
	CALL	CRESYM		; And create the symbol.
	MOV	(SP)+,R0	; Recover R0
	MOV	#INTSYM,SYMTYP(R1) ; Set symbol type.
	.IF	NDF	A$$RAP
10$:	CMP	#INTSYM,SYMTYP(R1) ; Is it an integer?
	BNE	20$		; No -- error.
	.IFF
10$:	BITEQ	#INTSYM,SYMTYP(R1),20$	; Not integer type, error
	.ENDC
	MOV	R0,INTVAL(R1)	; Save the value into the table.
	BR	30$		; And return.
20$:	DIAG	INVSYM		; Invalid use of symbol
30$:	MOV	(SP)+,R1	; Recover R1
	RETURN			; And return to the caller.
	.IF	DF	A$$RAP
;
; External subroutine to set a character variable. The length of
; the string can be any length subject to the buffer size allocated
; in RNCMD.MAC in the .SETS command processing section. If the
; symbol exists the old symbol is deleted (DELSYM) and a new one created.
; If the symbol exists and but is not a character symbol a diagnostic
; message is issued and the new symbol ignored.
;
SETCHA::
	MOV	R1,-(SP)	; Save the buffer address
	CALL	LOCSYM		; Lookup the symbol
	BCS	20$		; non-existent symbol, CRESYM
	BITEQ	#CHASYM,SYMTYP(R1),100$	; Not character - report error
	MOV	(SP),R1		; It's character symbol - delete it
	CALL	DELSYM		;
20$:	MOV	R0,-(SP)	; Save R0 for create
	MOV	#CHAHDR,R0	; Length of header for character symbol +
	ADD	R2,R0		; length of string
	MOV	R2,-(SP)	; Save R2
	CALL	CRESYM		; Create the symbol
	MOV	(SP)+,R2	; Restore length of string
	MOV	(SP)+,R0	; and address of string
	MOV	#CHASYM,SYMTYP(R1)	; Indicate character symbol type
	BIS	SYMMSK,SYMTYP(R1)	; Or in compare type and temp flag
	MOV	R2,CHASIZ(R1)	; Save size of string
	BLE	200$		; May be a null string, that's ok
	ADD	#CHAVAL,R1	; start of string
30$:
	MOVB	(R0)+,(R1)+	; Move string to symbol area
	SOB	R2,30$		; Loop till done
	BR	200$		;
100$:	DIAG	INVSYM		; Invalid use of symbol
200$:	MOV	(SP)+,R1	; Restore R1
	RETURN
	.ENDC
;
; External subroutine to retrieve an integer representation of
; a variable. It will return with CC-C set if the variable does
; not exist or is not an integer.
;
RETINT::
	MOV	R1,-(SP)	; Save the buffer address
	CLR	R0		; Clear R0 in case no symbol.
	CALL	LOCSYM		; Lookup the symbol
	BCS	10$		; Skip if error occurred.
	.IF	DF	A$$RAP
	BITEQ	#INTSYM,SYMTYP(R1),99$	; Error if not integer type
	.ENDC
	MOV	INTVAL(R1),R0	; Return the value of the symbol.
	BR	20$		; And return.
10$:	DIAG	UNDSYM		; Undefined symbol
20$:	MOV	(SP)+,R1	; Recover R1
	BR	25$		;
99$:	DIAG	INVSYM		; Invalid use of symbol
25$:
	RETURN			; And return to the caller.
;
; External subroutine to return a character representation.
; If the variable is a character variable, the character buffer
; is simply returned.  If the variable is an integer, the integer
; is first transformed into a character string and then returned.
;
	.REPT	0		; Comment out for now.
RETCHA::
	MOV	R1,-(SP)	; Save the name buffer address.
	CALL	LOCSYM		; Lookup the symbol.
	BCS	99$		; Skip if error occurred.
	.IF	NDF	A$$RAP
	CMP	SYMTYP(R1),#SYMINT ; Is it an integer?
	BNE	99$		; No - for now, only integers allowed.
	.IFF
	BITEQ	#INTSYM,SYMTYP(R1),199$	; If not integer symbol, error
	.ENDC
	MOV	R0,-(SP)	; Save some registers.
	MOV	R2,-(SP)	; ...
	MOV	INTVAL(R1),R0	; Get the value of the integer.
	MOV	#CHABUF,R2	; Get buffer to place it in.
	CALL	DECIML		; Convert to decimal.
	CLRB	(R2)+		; End it with a <NUL>
	MOV	(SP)+,R2	; Recover registers.
	MOV	(SP)+,R0	; ...
	MOV	#CHABUF,R1	; Point to the buffer.
	CLC			; Show success.
99$:	MOV	(SP)+,R1	; Recover R1
	BR	200$		;
199$:	DIAG	INVSYM		; Invalid use of symbol
200$:
	RETURN			; And return to the caller.
	.ENDR

;
; Internal subroutine to create a symbol and place it on the
; symbol table list.  It requires two parameters, the new
; symbol name buffer in R1 and the size of the entry in R0
;
CRESYM:	MOV	R1,-(SP)	; Save R1
	MOV	R0,R1		; Put length to create into R1
	CALL	ALLOC		; Allocate the length to create.
	MOV	(SP)+,R0	; Remember address of name.
	MOV	R2,-(SP)	; Save some registers.
	MOV	R3,-(SP)	; ...
	.IF	NDF	A$$RAP
	MOV	#6.,R3		; Set maximum size of symbols.
	.IFF
	MOV	#SYMLEN,R3	; Set maximun sixe of symbols.
	.ENDC
	MOV	R1,R2		; Point to beginning of block.
	ADD	#SYMNAM,R2	; Increment up to name.
10$:	MOVB	(R0)+,(R2)+	; Move in until a 0 is moved.
	BEQ	20$		; ...
	SOB	R3,10$		; or until count is exhausted.
	BR	40$		; Skip if the count was exhausted first.
20$:	DEC	R2		; Point to the 0 just moved.
30$:	CLRB	(R2)+		; Output blanks until end of name.
	SOB	R3,30$		; ...
40$:	MOV	SYMHDR,(R1)	; Link into the chain.
	MOV	R1,SYMHDR	; ...
	MOV	(SP)+,R3	; Recover registers.
	MOV	(SP)+,R2	; ...
	RETURN			; And return to the caller.
;
; Internal subroutine to locate a symbol table entry.  It
; requires only one input, R1 pointing to the symbol name
; and returns with R1 pointing to the symbol table entry
; or with CC-C set if no such symbol was found.
;
LOCSYM:	MOV	R0,-(SP)	; Save some registers.
	MOV	R2,-(SP)	; ...
	MOV	R3,-(SP)	; ...
	MOV	R4,-(SP)	; ...
	MOV	R5,-(SP)	; ...
	MOV	SYMHDR,R2	; Point to the symbol table.
	BEQ	45$		; Skip if nothing there.
10$:	MOV	R2,R3		; Point to beginning of entry.
	ADD	#SYMNAM,R3	; Point to beginning of name.
	MOV	R1,R4		; Point to beginning of lookup name.
	.IF	NDF	A$$RAP
	MOV	#6,R5		; Get maximum size of entry.
	.IFF
	MOV	#SYMLEN,R5		; Get maximum size of entry.
	.ENDC
20$:	MOVB	(R4)+,R0	; Get lookup character.
	BEQ	30$		; Got it -- ensure at end of lookup.
	CMPB	R0,(R3)+	; Does it match the entry?
	BNE	40$		; No -- next entry.
	SOB	R5,20$		; And loop over whole string.
	BR	50$		; At end of string.
30$:	TSTB	(R3)+		; at the end of the other string?
	BEQ	50$		; Yes -- match.
40$:	MOV	(R2),R2		; Get to next symbol table entry.
	BNE	10$		; Loop if still more in table.
45$:	SEC			; Show error.
	BR	99$		; And return.
50$:	MOV	R2,R1		; Return the pointer.
	CLC			; Show success.
99$:	MOV	(SP)+,R5	; Recover registers.
	MOV	(SP)+,R4	; ...
	MOV	(SP)+,R3	; ...
	MOV	(SP)+,R2	; ...
	MOV	(SP)+,R0	; ...
	RETURN			; And return to the caller.
	.IF	DF	A$$RAP
;
; Internal subroutine to delete a symbol table entry.  It
; requires only one input, R1 pointing to the symbol name.
; It returns with CC-C set if no such symbol was found.
;
DELSYM:	MOV	R0,-(SP)	; Save some registers.
      	MOV	R1,-(SP)	; ...
	MOV	R2,-(SP)	; ...
	MOV	R3,-(SP)	; ...
	MOV	R4,-(SP)	; ...
	MOV	R5,-(SP)	; ...
	MOV	#SYMHDR,-(SP)	; First pointer address
	MOV	SYMHDR,R2	; Any entries ?
	BEQ	45$		; Skip if nothing there.
10$:	MOV	R2,R3		; Point to beginning of entry.
	ADD	#SYMNAM,R3	; Point to beginning of name.
	MOV	R1,R4		; Point to beginning of lookup name.
	MOV	#SYMLEN,R5	; Get maximum size of entry.
20$:	MOVB	(R4)+,R0	; Get lookup character.
	BEQ	30$		; Got it -- ensure at end of lookup.
	CMPB	R0,(R3)+	; Does it match the entry?
	BNE	40$		; No -- next entry.
	SOB	R5,20$		; And loop over whole string.
	BR	50$		; At end of string.
30$:	TSTB	(R3)+		; at the end of the other string?
	BEQ	50$		; Yes -- match.
40$:	MOV	R2,(SP)		; Save old pointer
	MOV	(R2),R2		; Get to next symbol table entry.
	BNE	10$		; Loop if still more in table.
45$:	SEC			; Show error.
	BR	99$		; And return.
50$:	MOV	(SP),R1		; R1 old entry
	MOV	(R2),(R1)	; Update entry pointing to this entry
	MOV	R2,R1		; For free
	CALL	FREE		; Deallocate entry's allocated space
	CLC			; Show success.
99$:	TST	(SP)+		; Clear stack
	MOV	(SP)+,R5	; Recover registers.
	MOV	(SP)+,R4	; ...
	MOV	(SP)+,R3	; ...
	MOV	(SP)+,R2	; ...
	MOV	(SP)+,R1	; ...
	MOV	(SP)+,R0	; ...
	RETURN			; And return to the caller.
;
; EXTERNAL SUBROUTINE TO SCAN LIST OF SYMBOLS AND DELETE ALL THAT ARE
; MARKED AS TEMPORARY
;
DELTMP::
	MOV	R1,-(SP)	; Save R1
	MOV	#SYMHDR,-(SP)	; First pointers address
	MOV	SYMHDR,R1	; Address of first entry, 0 means no symbols
	BEQ	100$		;
50$:
	BITEQ	#TMPSYM,SYMTYP(R1),80$	; Not temporary, skip to next symbol
	MOV	(R1),@(SP)	; Unlink this symbol by updating previous pointer
	CALL	FREE		; Free the space used by this symbol
	BR	90$		;
80$:
	MOV	R1,(SP)		; Save old entries address
90$:	MOV	@(SP),R1	; and get pointer to next entry
	BNE	50$		; NE, more entries
100$:
	TST	(SP)+		; Clean stack
	MOV	(SP)+,R1	; Restore R1
	RETURN			; All done, return to caller
	.ENDC
;
; Internal subroutine to convert to decimal for output.
;
	.REPT	0		; Comment out for now
DECIML:
	.IF NDF	R$$EIS		; If not an EIS machine ...
	MOV	#10.,R1		; Get 10. to divide by
	CALL	$DIV		; Do the division the hard way.
	.IFF			; Otherwise, if an EIS machine ...
	MOV	R0,R1		; Get quantity into low order.
	CLR	R0		; Clear out high order.
	DIV	#10.,R0		; Divide by 10.
	.ENDC	;R$$EIS		; End of conditional EIS code.
	MOV	R1,-(SP)	; Save remainder.
	TST	R0		; Anything left?
	BEQ	10$		; No -- just return it
	CALL	DECIML		; Yes -- call ourselves recursively.
10$:	MOV	(SP)+,R1	; Recover remainder.
	ADD	#'0,R1		; Make it into a printable digit.
	MOVB	R1,(R2)+	; And output it.
	RETURN			; And return to the caller.
	.ENDR
	.IF	DF	A$$RAP

SUBSYM::
	SAVE	R0,R1,R2,R4
	CMPEQB	@HFIN+BF.PTR,#PD,910$	; If period, command so ignore subs
	MOV	HFIN1+BF.ADR,HFIN1+BF.PTR	; Initialize secondary buffer
	MOV	SYMHDR,R4	; Start of symbol table
	BEQ	910$		; No symbols, return
10$:
	BITEQ	#CHASYM,SYMTYP(R4),900$	; Not character string type symbol
	BITEQ	#DLTSYM,SYMTYP(R4),15$	; Not a delimited search
	MOV	#4,MODE		; Indicate delimited symbol search
	BR	17$		;
15$:	MOV	#3,MODE		; Indicate any match is OK
17$:
	MOV	#SYMLEN,R0	; Count # of characters in symbol
	MOV	#SYMNAM,R2	; Offset to symbol name
	ADD	R4,R2		; Points to start of string
	MOV	R2,ADR2		; Save address for JCCHR call
	ADD	R0,R2		; Plus max length of symbol
20$:
	TSTNEB	-(R2),30$	; Non-zero byte indicates last valid character
	SOB	R0,20$		; Loop till end
30$:
	MOV	R0,END2		; Save length of string for JCCHR call
	MOV	HFIN+BF.PTR,ADR1; Address of input line to scan for symbols
	MOV	#1,STR1		; Start pointer relative to 1 not 0
	MOV	HFIN+BF.LEN,END1; Length of input line
	MOV	#ARGLST,R5	; R5 fortran call for JCCHR
	MOV	HFIN1+BF.PTR,R2	; R2 points to auxilliary buffer
;
35$:
	SAVE	R2,R4,R5
	CALL	JCCHR		; Scan the input line
	UNSAVE	R2,R4,R5
	TSTEQ	R0,200$		; R0 cleared if symbol not found
;
;	Move from HFIN buffer to HFIN1 temporary buffer till all instances
;	of this symbol are found
;
	MOV	ADR1,R1		; Input buffer address
	ADD	STR1,R1		; Point to beginnin of scan
	DEC	R1		; From 0 not 1 relative
	MOV	R0,-(SP)	;
	SUB	STR1,R0		; Minus starting position
	BLE	55$		; Matched at start of scanning position
50$:	MOVB	(R1)+,(R2)+	; Move string until match location
	SOB	R0,50$		; Loop till done
;
;	Move the symbols equivalent character string to secondary buffer
;
55$:
	MOV	(SP)+,STR1	; Set start position to where symbol matched
	MOV	CHASIZ(R4),R0	; # of characters in string
	BEQ	70$		; May be a null symbol representation
	MOV	R4,R1		; Point to the string
	ADD	#CHAVAL,R1	; and move the string
60$:	MOVB	(R1)+,(R2)+	;
	SOB	R0,60$		; Loop till done
;
70$:	ADD	END2,STR1	; Point input start point past matched symbol
	CMP	STR1,END1	; At end of input string ?
	BGT	240$		; Yes - swap buffers
	BR	35$		; See if more of same symbol on this line
;
;	No more symbols found - complete move to secondary buffer if
;	necessary
;
200$:
	CMPEQ	HFIN1+BF.PTR,R2,900$	; If equal this symbol did not match
	MOV	END1,R0		; Length of remaining part of string
	SUB	STR1,R0		; minus starting position
	INC	R0		; STR1 relative to 1
	MOV	ADR1,R1		;
	ADD	STR1,R1		;
	DEC	R1		;
210$:	MOVB	(R1)+,(R2)+	; Move remaining part of input string
	SOB	R0,210$		; Loop till done
240$:
	MOV	HFIN1+BF.PTR,HFIN+BF.PTR	; Set new buffer pointer
	SUB	HFIN1+BF.PTR,R2		; And length of string
	MOV	R2,HFIN+BF.LEN		;
	CMPEQ	HFIN1+BF.PTR,HFIN1+BF.ADR,250$	; Swap scatch buffers
	MOV	HFIN1+BF.ADR,HFIN1+BF.PTR	;
	BR	270$
250$:	MOV	HFIN+BF.ADR,HFIN1+BF.PTR	;
270$:
;
;	Loop through symbol table
;
900$:
	MOV	(R4),R4		; Point to next symbol
	BNE	10$		;
;
910$:
	UNSAVE	R0,R1,R2,R4
	RETURN
	DATA	RNSYMD,LCL
;
;	Parm list for FORTRAN IV-PLUS call to JCCHR
;
ARGLST:	.WORD	7		; # of parameters in call
ADR1:	.BLKW			; address of input record
	.WORD	STR1		; Start position (relative to 1)
	.WORD	END1		; End position (relative to 1)
ADR2:	.BLKW			;
	.WORD	ONE		;
	.WORD	END2		;
	.WORD	MODE		;
;
ONE:	.WORD	1		;
STR1:	.BLKW			;
END1:	.BLKW			;
END2:	.BLKW			;
MODE:	.BLKW			;
	CODE	RNSYM
	.ENDC
	.END