// symtab-s.txt

//	  for som v2.3    21 Jan 2006
//	  one hash table + local shadow buffer
//	  search and insert O(1), no linear search for local

// interface:
//    install str	  -- search and insert string in symtab
//                    -- return index to table
//    enterLocal idx  -- enter local, shadow gvar if exist
//					  -- error if duplicate
//	  clearLocal	  -- clear local table
//    init_symtab

//    alloc iden string from a fixed array "nmstr"
//    to separate compiler/user allocation
//    12 June 2006
//    Celebrating H.M.King 60 years accend to the throne.

enum
	1009 tablesize	  // a prime number
enum
	64 localsize
enum
	5000 namesize

// symentry is (name,type,ref,arity,lv)
enum
	5 elesize

// access functions by index

: getName a = symtab[a]
: getType a = symtab[a+1]
: getRef a = symtab[a+2]
: getArity a = symtab[a+3]
: getLv a = symtab[a+4]

: setName a nm = symtab[a] = nm
: setType a v = symtab[a+1] = v
: setRef a v = symtab[a+2] = v
: setArity a v = symtab[a+3] = v
: setLv a v = symtab[a+4] = v

to init_symtab | i k =
	symtab = array (tablesize*elesize)
	lvtab = array (localsize*elesize)
	nmstr = array namesize	// identifier string
	Nmprt = 0				// pointer to nmstr
	Nlv = 0
	k = 0
	for i 0 tablesize-1		// zero symtab name
		setName k 0
		k = k + elesize

// hast string to v  0..tablesize-1
to hash s1 | i v a =
	i = 0
	v = 0
	a = s1[i]
	while a != 0
		v = v + a	// add all int
		i = i + 1
		a = s1[i]
	if (v < 0) v = 0 - v
	v % tablesize

// alloc space for string from nmstr[]
to makename nm | s =
	s = Nmprt
	Nmprt = Nmprt + (strlen nm) + 1
	if Nmprt >= namesize
		seterror "string space in symbol table is full"
	s = nmstr + s	// pointer to name string
	strcpy s nm
	s

// hash with linear probe
//   if new, insert name, return index
//   i 0..tablesize-1, k = i*elesize
to install nm | key i k nm2 =
	key = hash nm
	i = key
	while 1
		k = i * elesize
		nm2 = getName k
		if streq nm2 nm	// found
			break
		if nm2 == 0		// new, insert name
//			nm2 = array ((strlen nm) + 1)
//			strcpy nm2 nm
			nm2 = makename nm
			setName k nm2
			setType k tyNEW
			break
		if getType k == tyNEW	// new but change nm
//			nm2 = array ((strlen nm) + 1)
//			strcpy nm2 nm
			nm2 = makename nm
			setName k nm2
			break
		i = (i+1) % tablesize
		if i == key		// wrap around
			seterror "symbol table full" // impossible case
	k	// return index

to enterLocal idx | k =
	Nlv = Nlv + 1
	if Nlv >= localsize
		seterror "too many local"
	k = Nlv * elesize
	case getType idx
		tyNEW:
			lvtab[k] = idx	// back pointer
			lvtab[k+1] = tyLOCAL
		tyGVAR:				// shadowed, copy to lvtab
			lvtab[k] = idx	// back pointer
			lvtab[k+1] = getType idx
			lvtab[k+2] = getRef idx
			lvtab[k+3] = getArity idx
			lvtab[k+4] = getLv idx
		else:
			seterror "invalid local"	// duplicate
	setType idx tyLOCAL
	setRef idx Nlv

to clearLocal | i idx k =
	for i 1 Nlv
		k = i * elesize
		idx = lvtab[k]			// back pointer
		if lvtab[k+1] == tyGVAR	// restore shadow
			setType idx tyGVAR
			setRef idx lvtab[k+2]
			setArity idx lvtab[k+3]
			setLv idx lvtab[k+4]
		else
			setType idx tyNEW	// null it
	Nlv = 0

// for debugging
to dumpSym2 | i k nm type =
	prints "symbol table" nl
	for i 0 tablesize-1
		k = i * elesize
		nm = getName k
		if nm != 0
			type = getType k
//			if (type != tyKEY) & (type != tyENUM)
			if (type != tyENUM)
				print k space
				prints nm space
				print getType k space
				print getRef k nl

to dumpLocal | i k idx nm =
	prints "local symbol " print Nlv nl
	for i 1 Nlv
		k = i * elesize
		idx = lvtab[k]
		prints getName idx space
		print getRef idx nl

// list index of export symbol (tyFUNC, tyGVAR)
// return num of sym
to getExportSym ar | i k ty n =
	n = 0
	for i 0 tablesize-1
		k = i * elesize
		ty = getType k
		if (ty == tyFUNC) | (ty == tyGVAR)
			ar[n] = k
			n = n + 1
	n

// exsym = array 200
// nxsym = 0	 num of export sym

// must getExportSym first
to findName type ref | i a k =
	a = 0
	for i 0 nxsym-1
		k = exsym[i]
		if ((getType k) == type) & ((getRef k) == ref)
			a = getName k
			break
	a

// update value of gvar
to dumpSym | i k type ref =
	fprint FO nxsym fnl
	for i 0 nxsym-1
		k = exsym[i]
		type = getType k
		ref = getRef k
		if type == tyGVAR
			setLv k M[ref]
		fprints FO getName k fspace
		fprint FO type fspace
		fprint FO ref fspace
		fprint FO getArity k fspace
		fprint FO getLv k fnl

to countsym | i k cnt =
	cnt = 0
	for i 0 tablesize-1
		k = i * elesize
		if (getName k) != 0  cnt = cnt + 1
	prints "sym " print cnt nl

// End
