{============================================================================}
{=                                                                          =}
{=      'SymTab.Pas'                                                        =}
{=                                                                          =}
{=          Pascal compiler symbol table routines.                          =}
{=                                                                          =}
{=              12/14/86 - Bruce Tomlin                                     =}
{=                                                                          =}
{============================================================================}

UNIT SymTab;

INTERFACE

USES
    MacDefs,
    Files;

CONST
    symTabSiz = 101;    { Number of entries in a symbol table }
                        { 101 was chosen because it is the first prime }
                        { number greater than 100 }
    intSize  = 2;       { Size in bytes of an integer }
    realSize = 4;       { Size in bytes of a real }


TYPE
    { Token needs to be defined before SymEntry }

    Token =     (intConst,realConst,strConst,ident,noSym,
                 becomes,range,eq,neq,lt,leq,gt,geq,comma,dot,
                 lparen,rparen,lbrack,rbrack,colon,semicolon,
                 plus,minus,times,divide,kARRAY,kBEGIN,kCONST,
                 kDIV,kDO,kELSE,kEND,kFOR,kFUNCTION,kIF,kOF,
                 kPROCEDURE,kPROGRAM,kRECORD,kTHEN,kTO,kTYPE,
                 kVAR,kWHILE,kWriteLn,damnSetBug);

    SymPtr =    ^SymEntry;      { SymEntry and ParamRec are circularly dependent }

    ParamPtr =  ^ParamRec;
    ParamRec =  RECORD
                    next:       ParamPtr;   { Pointer to next parameter }
                    name:       StringPtr;  { Pointer to parameter name }
                    typ:        SymPtr;     { Pointer to parameter type entry }
                    isVar:      BOOLEAN;    { True if a VAR parameter }
                END;

    SymType =   (tKeyword,tCONST,tTYPE,tVAR,tPROC,tFUNC,tRecElem,tArrayTyp);
    IDType =    (tNoType,tINT,tREAL,tRECORD,tARRAY,tSubrange,tEnum);

    SymTabPtr = ^SymTabRec;     { SymEntry and SymTabRec are circularly dependent }

    SymEntry =  RECORD
                    name:       StringPtr;  { Symbol name }
                    next:       SymPtr;     { Next symbol with same hashing }
                CASE typ: SymType OF        { Symbol type }
                    tKeyword:   (kwSym: Token); { Keyword token value }
                    tCONST,
                    tTYPE,
                    tVAR,
                    tPROC,
                    tFUNC:
                        (idTyp:     IDType;     { Identifier type }
                         size:      INTEGER;    { how big is it? }
                         offset:    INTEGER;    { where is it stored? }
                         parent:    SymTabPtr;  { Parent symbol table }
                        CASE SymType OF
                            tCONST: (realValue: REAL;       { Value if real }
                                     intValue:  INTEGER;    { Value if integer }
                                     nextEnum:  SymPtr;     { If enum member, points to next const in list }
                                     eParent:   SymPtr);    { If enum member, points to parent enum entry }
                            tRecElem,
                            tArrayTyp,
                            tTYPE,
                            tVAR:   (varParm:   BOOLEAN; { True if symbol is a VAR parameter }
                                     CASE IDType OF
                                        tRECORD:    (firstElem: SymPtr;     { Ptr to list of elements   }
                                                     rDetached: BOOLEAN);   { TRUE if firstElem is not copied }
                                        tARRAY:     (loBound:   INTEGER;    { Lower bound }
                                                     hiBound:   INTEGER;    { Upper bound }
                                                     arrayTyp:  SymPtr;     { Pointer to array type   }
                                                     aDetached: BOOLEAN);   { TRUE if arrayTyp is not copied }
                                        tSubrange:  (loVal:     INTEGER;    { Lower bound }
                                                     hiVal:     INTEGER);   { Upper bound }
                                        tEnum:      (hiEnum:    INTEGER;    { Highest constant in enum }
                                                     consts:    SymPtr);    { Points to first constant in enum }
                                    );
                            tPROC,
                            tFUNC:  (parms:     ParamPtr;   { Pointer to parameter list }
                                     funcType:  SymPtr;     { Pointer to type of function }
                                     parmSize:  INTEGER;    { Size of parameters }
                                     varSize:   INTEGER);   { Size of variables }
                        );
                END;

        {   points to a SymEntry which is may not be part of a symbol table }
        { If the 'detached' boolean is true, the list should be freed up    }
        { when the symbol table is freed up.                                }

    SymTabRec = RECORD
                    parent:     SymTabPtr;  { Parent symbol table }
                    hashHits:   INTEGER;    { Number of hash collisions }
                    numSyms:    INTEGER;    { Number of symbols entered }
                    entry:      ARRAY[1..symTabSiz] OF SymPtr;
                    level:      INTEGER;    { Declaration level }
                END;

VAR
    symTab:     SymTabPtr;  { Pointer to the main symbol table }

FUNCTION  HeapString(str: Str255): StringPtr;
FUNCTION  FindSym(symName: Str255): SymPtr;
FUNCTION  AddSym(symName: Str255; symTyp: SymType): SymPtr;
FUNCTION  NewSymTab: SymTabPtr;
PROCEDURE AddSymTab(newSymTab: SymTabPtr; lev: INTEGER);
PROCEDURE FreeSymTab(oldSymTab: SymTabPtr);



IMPLEMENTATION

{============================================================================}
{=                                                                          =}
{=      HASHPJW                                                             =}
{=                                                                          =}
{=          Return a hash value for a given symbol using the Weinberger's   =}
{=      'hashpjw' algorithm on page 436.                                    =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          SYMNAME     The symbol to hash                                  =}
{=                                                                          =}
{=      Returns an index to the symbol table for the symbol.                =}
{=                                                                          =}
{============================================================================}

FUNCTION HashPJW(symName: Str255): INTEGER;

{ Declare BitAnd0 and BitXor0 to work around their corresponding  }
{ compiler implemented procedures, because of a bug in TML Pascal }

FUNCTION BitAnd0(value1,value2: LONGINT): LONGINT;  INLINE $A858;
FUNCTION BitXor0(value1,value2: LONGINT): LONGINT;  INLINE $A859;

VAR
    h:      LONGINT;
    g:      LONGINT;
    i:      INTEGER;

BEGIN
    h := 0;
    FOR i := 1 TO Length(symName) DO BEGIN
        h := BitSL(h,4) + ORD(symName[i]);
        g := BitAnd0(h,$F0000000);
        IF g<>0 THEN BEGIN
            h := BitXor0(h,BitSR(g,24));
            h := BitXor0(h,g);
        END;
    END;
    HashPJW := (ABS(h) MOD symTabSiz) + 1;
END;



{$R+}   { Turn on range checking in this module for everything but 'HashPJW' }



{============================================================================}
{=                                                                          =}
{=      HEAPSTRING                                                          =}
{=                                                                          =}
{=          Copies a string into a heap block and returns a pointer to it.  =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          STR         The string to copy into the heap                    =}
{=                                                                          =}
{=      Returns a pointer to the new string in the heap.                    =}
{=                                                                          =}
{============================================================================}

FUNCTION HeapString(str: Str255): StringPtr;

VAR
    p:      StringPtr;

BEGIN
    { Create the heap block for the string }

    p := StringPtr(NewPtr(Length(str)+1));

    { Copy the symbol name into the heap block.           }
    { BlockMove must be used because string assignment    }
    { in TML Pascal copies the ENTIRE size of the string, }
    { and the heap would be trashed VERY quickly here!    }

    BlockMove(@str,POINTER(p),Length(str)+1);

    { Return a pointer to the new string in the heap }

    HeapString := p;
END;



{============================================================================}
{=                                                                          =}
{=      FINDSYM                                                             =}
{=                                                                          =}
{=          Locate a symbol in the symbol table.                            =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          SYMNAME     The name of the symbol to find                      =}
{=                                                                          =}
{=      Returns a pointer to the symbol's entry in the symbol table.        =}
{=                                                                          =}
{============================================================================}

FUNCTION FindSym(symName: Str255): SymPtr;

VAR
    p:          SymPtr;     { Pointer to a symbol table entry }
    found:      BOOLEAN;    { Flag to indicate that the symbol has been found }
    table:      SymTabPtr;  { Pointer to the current symbol table }

BEGIN
    { The symbol has not been found yet, set up to return NIL }

    FindSym := NIL;
    found := FALSE;

    { Search all the symbol tables to find the entry }

    table := symTab;
    WHILE (table<>NIL) AND NOT found DO BEGIN

        { Get the pointer to the symbols in this hash table entry }

        p := table^.entry[HashPJW(symName)];

        { Traverse the list of symbols to find the one we are looking for }

        WHILE (p<>NIL) AND NOT found DO
            WITH p^ DO BEGIN

                { If the symbol was found, return a pointer to it, }
                { otherwise, go to the next symbol in the list.    }

                IF name^=symName THEN BEGIN
                    FindSym := p;
                    found := TRUE;
                END
                ELSE p := next;
            END;

        table := table^.parent; { Get ready to search the next symbol table }
    END;
END;



{============================================================================}
{=                                                                          =}
{=      ADDSYM                                                              =}
{=                                                                          =}
{=          Add a symbol to the symbol table.                               =}
{=          AddSym does not check if a symbol already exists.               =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          SYMNAME     The name of the new symbol                          =}
{=          SYMTYP      The symbol type of the symbol                       =}
{=                                                                          =}
{=      Returns a pointer to the new symbol's entry in the symbol table.    =}
{=                                                                          =}
{============================================================================}

FUNCTION AddSym(symName: Str255; symTyp: SymType): SymPtr;

VAR
    p:          SymPtr;     { Pointer to the new symbol table entry }
    hashVal:    INTEGER;    { Hash value of the symbol }

BEGIN
    { Create a new symbol table entry and fill it in }

    New(p);
    WITH p^ DO BEGIN
        name := HeapString(symName);
        next := NIL;
        typ  := symTyp;

        { Fill in default values for symbol fields }

        IF symTyp<>tKeyword THEN BEGIN
            idTyp  := tNoType;
            size   := 0;
            offset := 0;
            parent := symTab;
        END;
    END;

    WITH symTab^ DO BEGIN

        { Count this symbol in the hash statistics }

        numSyms := numSyms + 1;

        { Get the hash value for the symbol }

        hashVal := HashPJW(symName);

        { If this hash table entry is used, link the new }
        { symbol table entry into it and count a heap    }
        { collision.  Otherwise, just set the previously }
        { unused hash table entry to the new symbol.     }

        IF entry[hashVal]<>NIL THEN BEGIN
            p^.next := entry[hashVal];
            hashHits := hashHits + 1;
        END;
        entry[hashVal] := p;
    END;

    { Return a pointer to the symbol to the caller }

    AddSym := p;
END;



{============================================================================}
{=                                                                          =}
{=      NEWSYMTAB                                                           =}
{=                                                                          =}
{=          Creates a new symbol table and initializes it.                  =}
{=                                                                          =}
{=      Returns a pointer to the new symbol table.                          =}
{=                                                                          =}
{============================================================================}

FUNCTION NewSymTab: SymTabPtr;

VAR
    p:      SymTabPtr;  { Pointer to the new symbol table }
    i:      INTEGER;

BEGIN
    { Allocate the new symbol table }

    New(p);

    WITH p^ DO BEGIN

        { No parent symbol table (yet) }

        parent := NIL;

        { No level defined, set it to zero just to be safe }

        level  := 0;

        { Clear out all of its entries }

        FOR i := 1 TO symTabSiz DO entry[i] := NIL;

        { Initialize the hash statistics }

        hashHits := 0;
        numSyms  := 0;
    END;

    { Return a pointer to the new symbol table }

    NewSymTab := p;
END;



{============================================================================}
{=                                                                          =}
{=      ADDSYMTAB                                                           =}
{=                                                                          =}
{=          Makes a symbol table the current symbol table, linking it       =}
{=      into the list of symbol tables.                                     =}
{=                                                                          =}
{=              It can be called as:    AddSymTab(NewSymTab,level);         =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          NEWSYMTAB   A pointer to the symbol table to make current       =}
{=          LEV         The block level of this symbol table                =}
{=                                                                          =}
{============================================================================}

PROCEDURE AddSymTab(newSymTab: SymTabPtr; lev: INTEGER);

BEGIN
    newSymTab^.parent := symTab;    { Set parent to current symbol table }
    newSymTab^.level  := lev;       { Set symbol table level }
    symtab := newSymTab;            { Link in the new symbol table }
END;



{============================================================================}
{=                                                                          =}
{=      FREESYMTAB                                                          =}
{=                                                                          =}
{=          Disposes of a symbol table.  If the symbol table is the         =}
{=      current symbol table, it's parent is made current.                  =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          OLDSYMTAB   Pointer to the symbol table to free up              =}
{=                                                                          =}
{============================================================================}

PROCEDURE FreeSymTab(oldSymTab: SymTabPtr);

BEGIN
    { If the symbol table is the current symbol table, unlink it }

    IF oldSymTab=symTab THEN symTab := symTab^.parent;

    { The symbol table entries can be freed up here }

    { Get rid of the symbol table }

    Dispose(oldSymTab);
END;

END.