// 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.

//    separate symtab to htab and symtab 	24 Aug 2007

enum
    2003 htabsize	  // a prime number
enum
    1000 tablesize
enum
    5000 namesize

// sym-entry is   (name,type,ref,arity,lv)
// local sym use: (name,type,ref,gv,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 =
    htab = array htabsize
    symtab = array (tablesize*elesize)
    nmstr = array namesize	// identifier string
    Namep = 0				// pointer to nmstr
    freeSym = 0				// pointer to symtab
    lvlis = array MAXLV		// list of lv
    clearlis lvlis
    Nlv = 0

// 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 % htabsize

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

// alloc a space in symtab
to newSym nm ty | k =
    freeSym = freeSym + elesize
    if freeSym >= (tablesize*elesize)
        seterror "symbol table full (symtab)"
    k = freeSym
    setName k nm
    setType k ty
    k

// hash with linear probe
//   if new, insert name, return index
//   i 0..tablesize-1, k point to symtab
to install nm | key i k =
    key = hash nm
    i = key
    while 1
        k = htab[i]
        if k == 0				// new, insert name
            k = newSym (makename nm) tyNEW
            htab[i] = k
            setLv k i			// back pointer to htab
            break
        if streq (getName k) nm	// found
            break
        i = (i+1) % htabsize
        if i == key		// wrap around, impossible
            seterror "symbol table full (htab)"
    k	// return index to symtab

to enterLocal idx | k h =
    Nlv = Nlv + 1
    case getType idx
        tyNEW:
            setType idx tyLOCAL
            setRef idx Nlv
            setArity idx 0		// not shadow
        tyGVAR:					// shadow
            h = getLv idx 		// pointer to htab
            k = newSym (getName idx) tyLOCAL
            setRef k Nlv
            setArity k idx		// point to gv
            htab[h] = k			// htab point here
            idx = k
        else:
            seterror "invalid local (enter)" // duplicate
    addlis lvlis idx

to clearLocal | idx i k =
    for i 1 (sizeoflis lvlis)
        k = lvlis[i]
        setType k tyNEW			// null it
        idx = getArity k
        if idx != 0				// shadow gv
            htab[getLv idx] = idx	// htab to gv
    clearlis lvlis
    Nlv = 0

// list index of export symbol (tyFUNC, tyGVAR)
// return num of sym
to getExportSym ar | k ty n =
    n = 0
    k = elesize
    while k <= freeSym
        ty = getType k
        if (ty == tyFUNC) | (ty == tyGVAR)
            ar[n] = k
            n = n + 1
        k = k + elesize
    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

// nmstr[] has unique symbols (494 for this compiler)
//to dumpName | s n =
//	n = 0
//	s = nmstr
//	while s < (nmstr + Namep)
//		prints s space
//		s = s + (strlen s) + 1
//		n = n + 1
//	nl print n nl

// 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

// End