.IIF	NDF	RSX	RSX	=	1	;Assume RSX	;01+
	.TITLE	AS3G
	.IDENT	"X01.02"
	.ENABL	LC,GBL
	.NLIST	BEX,TOC
	.LIST	MEB
;+
; AS assembler -- Hashed user symbol table.
;
; These routines handle initialization and operation of the user
; symbol table as a "bucket hash". The object of this is to speed
; AS up and make the symbol table dynamically allocated.  The '.'
; and register symbols are statically initialized here.
;
; Martin Minow
; 07-Aug-82
;
; Edits:
; 00 26-Feb-82 RBD	Initial edit
; 01 01-Mar-82 RBD	Dumb bug fixed
; 02 07-Aug-82 MM	Make hash of Bob's binary tree table
;-
	.GLOBL	USTCLR		; Clear User symbol table (between files)
	.GLOBL	SRCUST		; Lookup (and/or insert) in UST
	.GLOBL	$DENY		; Out of memory
	.GLOBL	SYWALK		; Scan entire user symbol table
;									;09+
; The following macros are used to built the static part of the user
; symobl table.  The symbol table is a linked list rooted in a "bucket". 
;
; The datum is hashed by summing all bytes.  The datum, as stored, includes
; the length (to the trailing NULL) which should shorten the number of
; bytes that must be tested.  This algorithm is essentially identical
; to the symbol table algorithm in Decus C.
;
; The following macros initialize the static part of the symbol table.
;
; The sum of the letters of the symbol is used to determine an initial
; hash value.  Members of the same hash category are chained together.
;
; For debugging, the number of members of each hash category are
; recorded.
;
; The "bucket" parameter defines the number of hash buckets.
; It must be a power of 2.
;
bucket	=	64.			; Number of pst buckets
bmask	=	<bucket-1>		; Select initial bucket
;
; Set initial values of the link words and counters.
; This sequence sets us.0, us.1 etc to zero (the NULL link)
; and initializes counters un.0, un.1, etc.  At any point in
; the process, us.N points to the head of the chain of nodes for
; the symbol whose name hashes to N, while un.N counts the number
; of nodes in this hash bucket.
;
$	=	0			; '$' is a general counter
.rept	bucket
 .irp	z,<\$>
  us.'z	=	0
  un.'z =	0
 .endm
$	=	$+1
.endr

;
; Hash the name by summing all characters in the name.  This code
; obviously must track the run-time code in SRCPST.  The horsing around
; with nested .irp's is needed to generate the value of computed symbols.
;
.macro	hash	s,name			; Link in the name
$	=	0			; This will sum the characters
 .irpc	x,<s>				; For each character in name
  $	=	$ + ''x
 .endm
 $	=	$ & bmask		; '$' now names the hash entry
 .irp	z,<\$>
	.word	us.'z			; S.L Link to previous
us.'z	=	name			; Set new link
un.'z	=	un.'z+1			; Count links for this hash
 .endm
.endm	hash

;
; This macro writes the asciz text of each symbol to the psttxt
; program section, and a pointer to that string in the symbol table
; node itself.  The length of each symbol preceeds the symbol text
; itself.  (Note that S.N points to the text, the length byte is
; only interesting to the lookup routine.)
;
.macro	uset	s, n			; Store asciz symbol name
	.psect	usttxt
	.nchr	q,s
	.byte	q			; Length of "s"
u'n:	.asciz	"s"
	.psect
	.word	u'n			; S.N -> "s"
.endm	uset

;
; The usym macro builds each ust entry with an appropriate name, type,
; and value, calling the set and hash macros to perform necessary
; storage computations.
;
.macro	usym	name, type, value	; Build a symbol.
ust...	=	ust...+1		; Count each symbol
tag...	=	tag...+1
	ugen	<name>, type, value, \ust...
.endm	usym

.macro	ugen	name, type, value, s
ust's:	hash	<name>,ust's		; S.L set link, set new link
	.word	value			; S.V
	.word	type			; S.T
	.word	0			; S.F (flags)
	uset	<name>,s		; S.N Output string and pointer
	.word	tag...			; S.U (tag for relocation computation)
.endm	ugen

;
; Build the static user symbol table
;
ust...	=	0
tag...	=	1000
perbeg:					; Start of permanent ust entries
dot::	usym	<.>	ST.REL	0
	usym	<r0>	ST.REG	0
	usym	<r1>	ST.REG	1
	usym	<r2>	ST.REG	2
	usym	<r3>	ST.REG	3
	usym	<r4>	ST.REG	4
	usym	<r5>	ST.REG	5
	usym	<sp>	ST.REG	6
	usym	<pc>	ST.REG	7
perend	=	.			; Last static symbol

$	=	0
link..	=	0			; Summary counter
ust::					; User symbol table (buckets)
.rept	bucket
 .irp	z,<\$>
  .irp	x,<\un.'z>
	.word	us.'z			; 'x links for hash value 'z
link..	=	link..+'x
  .endm
 .endm
  $	=	$+1
.endr
ustend	=	.
;
; And now for a little paranoia
;
.iif ne	<link..-ust...>	.error	; UST messed up, links don't sum	;09-
;
; Next tak to assign.  This 'tag' is used in place of the linear table
; offset value used with PC and symbol relative types in the binary table
; version.  This was a real hack.  Sorry.  (Can it be done away with?)
;
nxtag:	.word	TAG...+1


;+
;** SRCUST	Search and insert in User Symbol Table
;
; This routine implements a symbol table built out of a set of linked
; lists.  The initial chain is determined by hashing the symbol text.
; This algorithm is functionally identical to LOOKUP in Decus C (CC101.MAC).
;
; Symbol table node:
;	00 S.L	Link to next symbol -- must be at offset 0
;	02 S.V	Symbol value
;	04 S.T	Symbol type
;	06 S.F	Symbol flags
;	10 S.N	Pointer to symbol name
;	12 S.U	"tag" value.
;
; Input:
;	IDBUF	Symbol to search for as an .asciz string
;	R5	Non-zero to insert new symbol if not found.
;		Zero, do not insert.
;
; Return:
;	R5	-> symbol in table or zero if insert disabled.
; Other registers preserved.
;
;-

srcust:	jsr	r5,savreg		; save registers
;
; Get a hash code of the name string.  This is the sum of the bytes
; in the string, masked to serve as an index into UST.  The name is
; null terminated.
;
	mov	#idbuf,r3		; r3 -> symbol to lookup
.if ne	0
	mov	r0,-(sp)
	.mcall .print,.ttyout
	.ttyout	#'*
	mov	r3,r0
	.print
	mov	(sp)+,r0
.iftf
	clr	r4			; r4 := hash
10$:	movb	(r3)+,r0		; get the byte
	beq	20$			; exit at the null
	add	r0,r4			; add in the hash
	br	10$			; and get another
;
; The hash has been formed in r4,  Note that r3 points to the byte AFTER
; the trailing null byte.
;
20$:	bic	#^C<bmask>,r4		; Form the index
	asl	r4			; Form an offset
	sub	#idbuf+1,r3		; Get (true) length
	movb	r3,idbuf-1		; And save in id buffer
	add	#ust,r4			; Get pointer to first node
	br	60$			; Enter at "get next"
;
; Search (or continue searching) this chain for a match.
;
30$:	mov	#idbuf-1,r1		; r1 -> argument @ length byte
	mov	S.N(r5),r0		; r0 -> symbol name
.ift
	.ttyout	#':
	.print	r0
	mov	S.N(r5),r0
.iftf
	cmpb	(r1)+,-1(r0)		; Same length?
	bne	50$			; Don't compare string if not.

40$:	cmpb	(r1)+,(r0)		; Bytes match?
	bne	50$			; No, go for another
	tstb	(r0)+			; At the end?
	bne	40$			; No, go for another.
	mov	r5,14(sp)		; Found it, stuff returned r5
	return				; And back to caller

50$:
	mov	r5,r4			; Save "last"
;;	add	#S.L,r4			; r4 -> previous link (S.L == 0)
60$:	mov	(r4),r5			; Get another symbol node
	bne	30$			; back if there is one
.ift
	.print	#999$
.iftf
;
; No symbol matches this one. r4 -> where to stuff the link to the new node
;
srcent:	tst	14(sp)			; Caller's r5, non-zero to insert
	beq	20$			; exit if no insert wanted.
.ift
	.mcall	.ttyout, .print
	.ttyout	#'+
	.print	#idbuf
.iftf
	mov	#S.SIZE,r0		; Symbol table size
	call	$alloc			; Allocate a new node
	mov	r0,14(sp)		; Return new node to caller
	mov	r0,r5			; Retain a pointer to the node
	mov	r0,r2			; And a working pointer
;
; Initialize the new node.
;
	mov	(r4),(r2)+		; 00 S.L -> (old) next
	mov	r5,(r4)			; Link in the new one
	clr	(r2)+			; 02 S.V := 0
	mov	#ST.UND,(r2)+		; 04 S.T := Undefined
	clr	(r2)+			; 06 S.F := 0
	mov	#10.,r0			; Need 8 bytes + size + null trailer
	call	$alloc			; Go for it
	mov	#IDBUF-1,r1		; r1 -> symbol @ length
	movb	(r1)+,(r0)+		; Put out the length
	mov	r0,(r2)+		; 10 S.N -> symbol name @ text
10$:	movb	(r1)+,(r0)+		; Output the symbol
	cmp	r1,#IDBUF+9.		; till the
	blo	10$			; very end.
	mov	nxtag,(r2)		; 12 S.U "tag" (unique symbol value)
	inc	nxtag			; Increment unique value
20$:	return				; Savreg (co-routine) will setup r5

.ift
999$:	.asciz	/no match/
	.even
.endc

;+
; ** $DENY - Abort assembly if out of dynamic memory
;
; Cuts off the stack, causing a return to ASEMBL.
; Called from $ALLOC if tough stuff.
;-
$DENY::
.if ne rsx
	tst	argv+2		; 1 File?
	beq	10$		; (yes)
	mov	@argvpt,r4	; Point to current file name
	beq	10$		; (huh?)
	mov	#colon,r5
	call	fmsg
10$:	mov	#stfull,r5	; Point to error message
	call	msg		; Show it
.iff
	mov	#stfull,r0
	call	$msg
.endc
	mov	spsave,sp	; Cause return to ASEMBL
	return

stfull:	.asciz	"?AS-F-Insufficient memory. Symbol table overflow."
.if ne rsx
colon:	.asciz	":"
.endc
	.even

;+
; ** USTCLR	Initialize symbol table between files.
;
; This is a kind of hack.
;

.IF NE RSX
	.MCALL	EXTK$S
.ENDC

USTCLR::
	mov	#10$,r5			; Setup to walk the table
	call	sywalk			; do it.
	clr	hilocn			; Reinitialize ALLOC
	mov	#TAG...+1,nxtag		; Reset the tag counter
.IF NE RSX
	EXTK$S	#0			; Shrink task back to static size
.ENDC
	return

10$:	cmp	r5,#perend		; Is it still static?
	blo	20$			; yup.
	clr	(r4)			; S.L -- Clear next of last
	mov	r4,r5			; and tell sywalk to stop this chain.
20$:	return				; done.

;+
; ** SYWALK
;
; Walk through the entire symbol table calling a subroutine
; for each node.  Calling sequence:
;
;	mov	#routine,r5		; Routine to call
;	call	sywalk			; do it
;	... All symbols processed.
;	r4 has original value.
;	r0..r3 have whatever user routine left there.
;
; The subroutine can terminate the process early by the "simple" but
; quite ugly expedient of
;
;	ADD	#SY.STK,sp	;Trash the stack
;	RETURN
;
; Routine:
;	r5 -> current symbol node
;	r4 -> previous symbol (for ustclr -- this is why S.L must be at 0)
;	other registers unchanged from original call.
;	... process ...
;	return (don't change r4 or r5 without malice aforethought)
;
SY.STK	==	8.			; How much stack to pop

sywalk:	mov	r4,-(sp)		; Save original r4
	mov	r5,-(sp)		; Save routine to call.
	mov	#ust,-(sp)		; Bucket header
;
; New bucket
;
10$:	mov	(sp),r5			; Next bucket start
	cmp	r5,#ustend		; At the end?
	bhis	30$			; exit if so
	add	#2,(sp)			; Nope, fix for next go-around
;
; Chain through this bucket
;
20$:
	mov	r5,r4			; r4 -> last symbol
	mov	(r4),r5			; S.L r5 -> new current symbol
	beq	10$			; go for new bucket at chain end
	call	@2(sp)			; call user routine
	br	20$			; do entire chain.
;
; Done
;
30$:	cmp	(sp)+,(sp)+		; Dump temps
	mov	(sp)+,r4		; Restore r4 for original caller
	return				; and exit there.
	.end

