/*****************************************************************************
* tables -- the files that handle definitions and lookups
*
*	contains:	instal	places definition on table
*			find	finds definition
*			delete	deletes a previous definition
*			grbcol	garbage collects the table
*			hash	finds the hash value of the name
*			nhash	finds the next hash value of the name
*
* tested: 24-Jul-79
*****************************************************************************/
include ratfor.def		#covers the constants of the whole file

/*****************************************************************************
* instal -- this places definitions into the table
*
*	use:	bool =  instal(name,defn)
*		where:	bool	is a logical value returned indicating success
*			name	is the token being defined
*			defn	is the definition of that token
*
* written by: Gary Beckmann, 3-Jul-79
****************************************************************************/
logical function instal(name,defn)
include clook.cmm
character name(MAXTOKEN),defn(MAXTOKEN)
character altdef(MAXTOKEN)
integer length
integer hash
integer nhash,q,r
integer dlen,nlen,i
logical find

instal = .FALSE.
if (.NOT.find(name,altdef))	[	#tests that the definition is not 
	nlen = iindex(name,EOS)		#length of the name
	dlen = iindex(defn,EOS)		#length of the definition
 #	if there is not enough space, do garbage collection
	if(lastt + nlen + dlen > MAXTBL)
		call grbcol
	if(lastt + nlen + dlen > MAXTBL) [
		call synerr (S_OVRFL_TBL)
		return
		]
#	find new location for this  entry
	for(i = hash(name,q,r);namptr(i) ^= 0 & namptr(i) ^= GARBAGE;
		i = nhash(q,r,i))
			;
	namptr(i) = lastt + 1		#places definition in
	for (j=1;j<=MAXPTR;j=j+1)	#checks for room on
		if(namptr(j)==0)	#pointer table
			break
	if(j<=MAXPTR) [
		call scopy(name,1,table,lastt+1)#table
		lastt = lastt + nlen
		call scopy(defn,1,table,lastt+1)
		lastt = lastt + dlen
		instal = .TRUE.
		]
	else	[
		namptr(i) = 0
		call synerr (S_2_MANY_DEF)
		]
	]
return
end

/*****************************************************************************
* find -- this function returns logical true and the definition if it exists
*
*	uses:	log = find(name,defn)
*		where:	log 	is a logical value
*			name	is the name of the token
*			defn	is the definition of the token
*
* written by: Gary Beckmann, 3-Jul-79
*****************************************************************************/
logical function find(name,defn)
include clook.cmm
logical compar
character name(MAXTOKEN),defn(MAXTOKEN)
integer i,j,k
integer hash
integer nhash,p,q

find = .FALSE.			#assumed guilty until proven innocent
for(i = hash(name,p,q);namptr(i) ^= 0;i = nhash(p,q,i)) [
	j = namptr(i)
#	type *,'	namptr(i)',j,' i',i	#*#
	if(j > 0) [
		if(compar(name,table(j))) [
			while(table(j) ^= EOS)		#look past eos
				j = j + 1
			call scopy(table,j+1,defn,1)
			find = .TRUE.
			break
			]
		]
	]
return
end

/*****************************************************************************
* delete -- allows for deletion of definitions
*
*	useage	call delete(name)
*
* written by: Gary Beckmann, 10-Jul-79
*****************************************************************************/
subroutine delete(name)
include clook.cmm
character name(MAXTOKEN),defn(MAXTOKEN)
logical find
logical compar
integer hash
integer nhash,q,r
integer iceos				#flag for EOS count
integer i,j				#random counters

for(i = hash(name,q,r);namptr(i) ^= 0;i = nhash(q,r,i)) [
	j = namptr(i)
	if (j > 0) [			#allows for previous deletions
		if(compar(name,table(j))) [
			namptr(i) = GARBAGE
			iceos = 0
			while(iceos < 2) [
				if (table(j) == EOS)
					iceos = iceos + 1
				table(j) = GARBAGE
				j = j + 1
				]
			break		#found entry, no need to continue
			]
		]
	]
return
end

/*****************************************************************************
* grbcol -- a new and different method of garbage collection		     *
*							      		     *
*	useage:	call grbcol						     *
*	notes:	This garbage collector uses a two pass system.		     *
*		the first pass squeezes the table of names and definitions,  *
*		and the second pass "rehashes" the names to be placed into   *
*		namptr.							     *
*									     *
* written by:	Gary Beckmann, 19-Jul-79	 			     *
*****************************************************************************/
subroutine grbcol
include clook.cmm
integer hash,nhash
integer q,r,hon

do i = 1, MAXPTR			#zero out namptr
	namptr(i) = 0

j = 1					#first pass
for(i = 1;;i = i + 1) [			# j and i are used to 'squeeze the
	while(table(j) == GARBAGE)	#garbage out of table
		j = j + 1
	if(j > lastt) 
		break
	table (i) = table (j)
	j = j + 1
	]

lastt = i				#second pass
i = 1
while(i < lastt) [
	j = 0				#counter for grbcol exit
	for(hon = hash(table(i),q,r);namptr(hon) ^= 0;hon = nhash(q,r,hon))[
		j = j + 1
		if(j > MAXPTR)[
			call ratout
			]
		]			#find empty space in namptr
	namptr(hon) = i			#install new pointer
	k = 0
	while(k < 2) [			#find second EOS
		if(table(i) == EOS)k = k + 1
		i = i + 1
		]
	]
return
end

/*****************************************************************************
* hash  --  the hashing function for installing and looking up definitions.
*
*	uses:	i = hash(name,q,r)
*	where:
*		name	=the name used to generate q and r.
*		q	=a magic number used in nhash, integer, do not alter.
*		r	=the same sort of magic as q
*		hash	=the first value to probe.
*
* written by: Gary Beckmann, 3-Jul-79
* modified:   M. Sasaki,G. Beckmann,M. Patton, 16-Jul-79
*		major change in algorithm, uses algorithm "A" from
*		"Software" (vol 3, page 171) [also see "nhash" below]
****************************************************************************/
integer function hash(name,q,r)
character name(MAXTOKEN)
integer i,k
integer q,r

k = 0
for (i=1;name(i) ^= EOS;i = i + 1)
	k = k + name(i)
 
r = mod(k,MAXPTR)
q = k/MAXPTR
if(mod(q,MAXPTR) == 0)q = 1
hash= r
if(hash == 0) hash = MAXPTR
return
end
 
/*************************************************************************
*	nhash	-what to do after hash
*
*	useage:	foo = nhash(q,r,h)
*	where:	q,r	=the magic from above.
*		h	=the previous probe value (nhash(q,r,hash(q,r))
*		nhash	=the value for other probes.
*	notes:	for algorithm see documentation above
*
* written by: M. Sasaki, 16-Jul-79
*****************************************************************************/
integer function nhash(q,r,h)
integer q,r,h
 
nhash = mod((h+q),MAXPTR)
if(nhash == 0)nhash = MAXPTR
return
end