.MCALL	.MODULE
.MODULE	INDERA,VERSION=03,COMMENT=<Erase local and global symbols> GLOBAL=.IERA

; 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	Macro and data definitions

	.MCALL	DEFIN$, RT5DF$

DEFIN$				;Definitions for IND files
RT5DF$				;RT specific definitions

	OPSECT	INDERA
	.SBTTL	DATA - INDERA local data.

;+
;Local data
;-

	.NLIST	BEX

TEXT:	.ASCIZ	/LOCAL/		;Local command
	.ASCIZ	/GLOBAL/	;Global command
	.BYTE	0		;End of table
	.EVEN
SPCND:	.WORD	SPCEND
	.SBTTL	ERASE - Erase local or global symbols

;+
;ERASE
;There are three fields to an ERASE directive.  The first is the ESASE
;directive itself.  The second is the symbol type (GLOBAL or LOCAL).
;These two fields must be present.  If the symbol type is not present
;a syntax error is generated.  The third field is the symbol name.  This
;field is optional.  If symbol name field is blank, all symbols in the
;symbol type table are deleted.  There are exceptions to the .ERASE LOCAL
;command which is explained in the appropriate routine.  If a symbol name
;is specified only that symbol is removed.
;-

	.ENABL	LSB

ERASE::	CALL	$GNBLK		;Get next non-blank
	BCS	1$		;Syntax error if c-bit set
	TST	R1		;Any blanks seen?
	BNE	2$		;Yes, no error
1$:	TRAP 	ERSYN		;Syntax error

2$:	MOV	#TEXT,R2	;Point to start of valid symbol type names
	DEC	R0		;Point to first character
	CALL	TBSRC		;Search table for name
	BCS	1$		;Branch if not found

;+
;*****CAUTION*****
;The following is based on the assumption that there are only two symbol
;types and the ASCII strings are in the following order:
;	.ASCIZ	LOCAL
;	.ASCIZ	GLOBAL
;-

	MOV	#SYMFR,R4	;Point to end of global table (assume global)
	MOV	SYMTB,R5	;Get start address of global table
	MOVB	R1,GBLERA	;If clear - LOCAL. If not equal - GLOBAL
	BNE	3$		;Branch if global
	MOV	#LSYME,R4	;Point to end of local table 
	MOV	SYMND,R5	;Get start of local symbol table
3$:	CALL	$GNBLK		;Get next non-blank character
	BCC	FIELD3		;More characters to follow
	MOV	#SYMTB,R5	;R5 -> beginning of global table (assume glb)
	TSTB	GBLERA		;Erase all globals?
	BNE	4$		;Branch if yes
	MOV	#SYMND,R5	;R5 -> beginning of local table
	TSTB	BLOCK		;Within a block?
	BEQ	4$		;Branch if no
	MOV	CONTXT+6,SYMND	;Undefine all locals defined within block
	BR	5$		;Go get next command

4$:	MOV	@R4,@R5		;Erase symbols in table
5$:	JMP	INDRD		;Go get next command

	.DSABL	LSB
	.SBTTL	FIELD3 - Process symbol in third field

;+
;FIELD3
;This routine is entered if there is a third field (erase a specific symbol
;in either the local or global table.
;
;R4 points to the word containing the end of table.  If the symbol is to
;be deleted in the local table R4 = LSYME.  If the symbol is to be deleted
;from the global table R4 = SYMFR.
;-

	.ENABL	LSB

FIELD3:	DEC	R0		;Point to first character to process
	CALL	GTSY1		;Look for symbol
	BCS	11$		;Symbol not found
	TSTB	SPCSYM		;Trying to delete a special symbol?
	BEQ	1$		;Branch if no
	MOV	#SPCTAB,R5	;Point to start of special symbol table
	MOV	#SPCND,R4	;Point to the end

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

1$:	CMP	R5,@R4		;End of defined symbols?
	BHIS	11$		;Yes, symbol not defined
	CMP	R1,@R5		;First half of symbol name match?
	BNE	2$		;No
	CMP	R2,2(R5)	;Second half of symbol name match?
	BEQ	3$		;Yes
2$:	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
	ADD	R3,R5		;Point to next entry
	BR	1$		;Test next symbol

;+
;Symbol found in table.  Calculate the area that the symbol entry uses in
;the symbol table.  Determine if the symbol is global or local.  Shift
;the rest of the table accordingly.  Down for local and up for global.
;-

3$:	TSTB	SPCSYM		;Is this a special symbol?
	BNE	12$		;Yes, give error
	CLR	R2		;Initialize accumulator
	BISB	SELEN(R5),R2	;Get string length
	ADD	#SEVAL+1,R2	;Add in offset
	BIC	#<1>,R2		;Round off
	MOV	R5,R3		;Get pointer to start of symbol
	TSTB	GBLERA		;Erasing a local or global symbol
	BNE	7$		;Branch if global
	TSTB	BLOCK		;Within a BEGIN/END block?
	BEQ	4$		;Branch if no
	CMP	R5,CONTXT+6	;Are we trying to erase a symbol out of block?
	BHIS	13$		;Branch if yes - error
4$:	ADD	R2,R3		;Make it the pointer to end of symbol
	CMP	R5,SYMND	;Was it the latest entry?
	BEQ	6$		;Branch if yes
5$:	MOV	-(R5),-(R3)	;Slide symbol table entries down
	CMP	R5,SYMND	;Was it the latest entry?
	BHI	5$		;No, do some more
6$:	MOV	R3,SYMND	;Update the start of the local symbol area
	BR	10$		;Do common exit

;+
;Symbol is global so shift contents of table up.
;-

7$:	ADD	R2,R5		;Make it pointer to end of symbol
	CMP	R5,SYMFR	;Latest entry in table?
	BEQ	9$		;Branch if yes
8$:	MOV	(R5)+,(R3)+	;Shift contents up
	CMP	R5,SYMFR	;End of table?
	BLO	8$		;Branch if no
9$:	MOV	R3,SYMFR	;Update the start of the global symbol area
10$:	JMP	INDRD		;Go get next command

11$:	TRAP	ERUDS		;Undefined symbol

12$:	TRAP	ERDSP		;Deleting a special symbol

13$:	TRAP	ERAES		;Invalid attempt to erase symbol

	.DSABL	LSB

	ROUNDUP			;Check for overflow and roundup

	.END