title	atom management routines
	include	asm.inc


	public	add_atom		; add string atom to hash table
	public	add_binary_atom		; add binary atom to hash table
	public	find_atom		; search for string atom
	public	find_binary_atom	; search for binary atom
	public	get_atom_name		; copy atom text
	public	init_atom_table		; initialize atom table


atom_str struc
  at_atom_count		dw  ?		; number of atoms (including NULL)
  at_hash_divisor	dw  ?		; prime divisor (table entry max)
  at_hash_to_atom	dw  ?		; offset of hash to atom index table
  at_atom_to_text	dw  ?		; offset of index to symbol text table
  at_end_of_text	dw  ?		; first free byte in symbol table
  at_storage_size	dw  ?		; dynamic storage byte count 
atom_str ends


	.data?
atom_table	dw	?		; storage handle for hash table


	.const
ertx_bad_atom_index	db	'Bad atom index',0
ertx_atom_table_full	db	'Atom table full',0
ertx_atom_too_big	db	'Atom too big',0


	.code
	extn	global_calloc,global_free,global_lock,global_realloc
	extn	global_unlock,save_most,strlen,strncpy,set_strerror


;;	add atom
;
;	entry	DS:SI	string to hash
;	exit	AX	atom index
;		Cf	if table full
;
add_atom proc
	push	cx			; add null terminated string to
	call	strlen			;  atom table
	call	add_binary_atom
	pop	cx
	ret
add_atom endp


;;	add binary atom
;
;	entry	DS:SI	bytes to hash
;		CX	byte count (<256)
;	exit	AX	atom index
;		Cf	if table full or atom too big
;
add_binary_atom proc
	call	find_binary_atom
	jnc	aba5			;  if duplicate atom

	or	ch,ch
	jnz	aba6			;  if atom is too long

	call	save_most
	mov	ax,ds			; use ES:DI as atom pointer
	mov	es,ax
	mov	di,si
	call	compute_atom_hash

	mov	bx,atom_table[bp]	; get pointer to atom table
	call	global_lock

	mov	ax,at_atom_count[si]	; check atom count
	inc	ax
	cmp	ax,at_hash_divisor[si]
	jae	aba7			;  if too many symbols

	mov	ax,at_storage_size[si]	; check empty text space
	sub	ax,at_end_of_text[si]
	cmp	cx,ax
	jae	aba8			;  if no space for new atom text

aba1:	mov	ax,at_end_of_text[si]	; set text pointer in index table
	mov	bx,at_atom_count[si]
	add	bx,bx
	add	bx,at_atom_to_text[si]
	mov	[si+bx],ax

	mov	bx,ax			; copy atom text
aba2:	mov	al,es:[di]
	mov	[si+bx],al
	inc	di
	inc	bx
	loop	aba2
	mov	[si+bx],cl		;  (delimit atom text \0)
	inc	bx
	mov	at_end_of_text[si],bx	;  update end of text pointer

	mov	cx,dx			; find free entry in hash table
aba3:	mov	ax,cx
	inc	cx			;  (bump hash for possible collision)
	mov	dx,ZER0
	div	at_hash_divisor[si]
	mov	bx,dx
	add	bx,bx
	add	bx,at_hash_to_atom[si]
	cmp	word ptr [si+bx],ZER0	;  (Cf=0)
	jnz	aba3			;  if hash table collision

	mov	ax,at_atom_count[si]	; set atom index in hash table
	mov	[si+bx],ax
	inc	ax			; advance atom count
	mov	at_atom_count[si],ax
	dec	ax			;  (Cf cleared above)

aba4:	mov	bx,atom_table[bp]	; unlock atom table
	call	global_unlock
aba5:	ret

aba6:	lea	ax,ertx_atom_too_big	; *Atom too big*
	call	set_strerror
	jmp	aba5

aba7:	lea	ax,ertx_atom_table_full	; *Atom table full*
	call	set_strerror
	jmp	aba4

aba8:	mov	ax,at_storage_size[si]	; increase size of atom table
	add	ax,1024			;  (by 1k)
	jc	aba7			;  if storage would exceed 64k

	push	cx
	mov	cx,ax
	call	global_unlock
	call	global_realloc
	pop	cx
	jc	aba5			;  if realloc failed
	call	global_lock
	mov	at_storage_size[si],ax
	jmp	aba1
add_binary_atom endp


;;	compute atom hash
;
;	entry	DS:SI	atom pointer
;		CX	byte count
;	exit	DX	case insensitive hash
;	uses	SI
;
compute_atom_hash proc
	push	cx
	xor	dx,dx
	jcxz	cah2			; if null atom
cah1:	xor	dl,[si]
	inc	si
	or	dl,20h			; (make hash case insensitive)
	add	dx,cx
	rol	dx,1
	rol	dx,1
	rol	dx,1
	rol	dx,1
	loop	cah1
	xor	dl,dh
cah2:	pop	cx
	ret
compute_atom_hash endp


;;	find atom
;
;	entry	DS:SI	string to find
;	exit	AX	atom index
;		Cf	if not found
;
find_atom proc
	push	cx			; find null terminated string in
	call	strlen			;  atom table
	call	find_binary_atom
	pop	cx
	ret
find_atom endp


;;	find binary atom
;
;	entry	DS:SI	bytes to hash
;		CX	byte count (<256)
;	exit	AX	atom index (or 0)
;		Cf	if not found
;
find_binary_atom proc
	xor	ax,ax			; zero is null symbol index (Cf=0)
	jcxz	fba3			;  if null symbol
	or	ch,ch
	jnz	fba4			;  if atom too big

	pushm	bx,dx,di,es
	mov	ax,ds			; ES:DI is target symbol text
	mov	es,ax
	mov	di,si
	call	compute_atom_hash
	inc	cx			;   (include \0 in compares)

	mov	bx,atom_table[bp]	; get pointer to atom table
	call	global_lock
	mov	bx,si

fba1:	xchg	ax,dx			; divide hash by table size (prime #)
	mov	si,ax
	xor	dx,dx
	div	at_hash_divisor[bx]
	xchg	dx,si			; use remainder as hash table index
	inc	dx			;  (advance to next hash entry)
	add	si,si			;  get atom index from hash table
	add	si,bx
	add	si,at_hash_to_atom[bx]

	lodsw
	cmpx	ax,0
	stc
	je	fba2			;  if entry empty, symbol not found

	mov	si,at_atom_to_text[bx]	; translate index in AX to
	add	si,ax			;   displacement from beginning of
	add	si,ax			;   symbol text table
	mov	si,[bx+si]
	add	si,bx

	pushm	cx,di			; compare target symbol & table entry
	repe	cmpsb			;  (CX includes \0 delimiter)
	popm	di,cx
	jne	fba1			;  if no match, try next table entry

fba2:	mov	bx,atom_table[bp]
	call	global_unlock

	dec	cx			;  (restore CX adjusted for \0)
	mov	dx,es
	mov	ds,dx
	mov	si,di
	popm	es,di,dx,bx
fba3:	ret

fba4:	lea	ax,ertx_atom_too_big	; *Atom too big*
	jmp	set_strerror
find_binary_atom endp


;;	get atom name
;
;	entry	AX	atom index
;		CX	buffer size
;		ES:DI	output buffer
;	exit	DI	updated (points to \0)
;		CX	updated
;		Cf	if bad atom index
;	uses	AX
;
get_atom_name proc
	pushm	bx,si,ds
	mov	bx,atom_table[bp]	; access atom table
	call	global_lock

	cmp	ax,at_atom_count[si]	; check atom index
	jae	gan1			;  if too high - bad index

	add	ax,ax			; use atom index to find atom text
	mov	bx,ax
	add	bx,at_atom_to_text[si]
	mov	bx,[si+bx]
	mov	si,bx

	call	strncpy			; write atom to output buffer
	clc
	jmp	gan2

gan1:	lea	ax,ertx_bad_atom_index	; *bad atom index*
	call	set_strerror

gan2:	mov	bx,atom_table[bp]	; unlock atom table (Cf unchanged)
	call	global_unlock
	popm	ds,si,bx
	ret
get_atom_name endp


;;	init atom table
;
;	entry	AX	prime number approximate twice maximum atom count
;	exit	Cf	if no memory
;	uses	AX
;
init_atom_table proc
	call	save_most
	mov	di,ax			; compute table size
	mov	dx,4			;  (space for atom_to_text and
	mul	dx			;   hash_to_atom tables)
	add	ax,size atom_str+1024	;  (space for atom_str & symbol_table)
	adc	dx,dx
	stc
	jnz	iat1			;  if table > 64k
	mov	cx,ax

	mov	bx,ZER0			; free old atom table
	xchg	bx,atom_table[bp]
	call	global_free		;  (OK if BX==0)

	call	global_calloc		; allocate and zero atom table
	jc	iat1			;  if not enough memory
	mov	atom_table[bp],bx

	call	global_lock
	mov	at_storage_size[si],ax
	mov	at_atom_count[si],1
	mov	at_hash_divisor[si],di
	mov	ax,size atom_str	; hash_to_atom table follows structure
	mov	at_hash_to_atom[si],ax
	add	di,di			; followed by atom_to_text table
	add	ax,di
	mov	at_atom_to_text[si],ax
	add	ax,di			; symbol table is last
	inc	ax
	mov	at_end_of_text[si],ax

	call	global_unlock
iat1:	ret
init_atom_table endp

	end