IMPLEMENTATION MODULE TableManager;

    FROM Tools IMPORT ENDSTR, Character, String, Strcmp, Strlen,
                      PutStr, PutQStr  , FatalError;

    FROM InOut   IMPORT WriteCard, WriteLn;

    FROM Storage IMPORT ALLOCATE, DEALLOCATE;

    CONST
        MAXCHARS = 2500;
        HASHSIZE = 53;

    TYPE
        charpos = [ 1..MAXCHARS ];
        charbuf = ARRAY [ 1..MAXCHARS ] OF Character;
        ndptr   = POINTER TO ndblock;  (* pointer to a name-def-value block *)
        ndblock = 
            RECORD
                namepos : charpos;
                defpos  : charpos;
                namevalue : REAL;
                kind    : sttype;
                nextptr : ndptr
            END;

    VAR
        hashtab : ARRAY [ 1..HASHSIZE ] OF ndptr;
        ndtable : charbuf;
        nexttab : charpos; (* 1st free position in ndtable *)

    PROCEDURE sccopy(
                     VAR s  : String  (* in *);
                     VAR cb : charbuf (* out *);
                     i  : charpos (* in/out *) );
        (*
        copies a string into charbuf beginning at i.
        *)

        VAR
            j : CARDINAL;

        BEGIN
            j := 1;
            WHILE s[ j ] # ENDSTR DO
                cb[ i ] := s[ j ];
                INC( i );
                INC( j )
            END;
            cb[ i ] := ENDSTR
        END sccopy;

    PROCEDURE cscopy(
                     VAR cb : charbuf (* in *);
                     i  : charpos (* in *);
                     VAR s  : String  (* out *) );
        (*
        does the opposite of sccopy.
        *)

        VAR
            j : CARDINAL;

        BEGIN
            j := 1;
            WHILE cb[ i ] # ENDSTR DO
                s[ j ] := cb[ i ];
                INC( i );
                INC( j )
            END;
            s[ j ] := ENDSTR
        END cscopy;

    (* hash -- compute hash function of a name *)

    PROCEDURE hash( VAR name : String (* in *) ): CARDINAL;

        VAR
            c, i, h : CARDINAL;

        BEGIN
            h := 0;
            FOR i := 1 TO Strlen( name ) DO
                c := name[ i ];
              (* modula doesnot like name[i] in expressions *)
                h := ( 3*h + c ) MOD HASHSIZE
            END;

            IF TabDebug THEN
                PutQStr(" %TabDebug, ");
                PutStr( name );
                PutQStr( " hashindex " );
                WriteCard( h+1, 3 );
                WriteLn
            END;

            RETURN h+1
        END hash;

    PROCEDURE Install(
                      VAR name  : String (* in *);
                      VAR defn  : String (* in *);
                      Value  : REAL   (* in *);
                      t      : sttype (* in *) );
        (*
         Installs "name" and "defn" "value" and type "t" into the table. 
        *)

        VAR
            h, dlen, nlen : CARDINAL;
            p : ndptr;

        BEGIN
            nlen := Strlen( name ) + 1;  (* 1 for ENDSTR *)
            dlen := Strlen( defn ) + 1;

            IF nexttab+nlen+dlen > MAXCHARS THEN
                PutQStr("%PIC-F-TABOVFL, at '");
                PutStr( name );
                FatalError("' table overflow in Install." )
            END;

            (* else, put it at front of chain *)
            h            := hash( name );
            NEW( p );
            p^.nextptr   := hashtab[ h ];
            hashtab[ h ] := p;
            p^.namepos   := nexttab;
            sccopy( name, ndtable, nexttab );
            nexttab      := nexttab + nlen;
            p^.defpos    := nexttab;
            sccopy( defn, ndtable, nexttab );
            nexttab      := nexttab + dlen;
            p^.namevalue := Value;
            p^.kind      := t
        END Install;

    PROCEDURE LookUp(
                     VAR name   : String     (* in *);
                     VAR defn   : String     (* out *);
                     VAR Value  : REAL       (* out *);
                     VAR t      : sttype     (* out *)) : BOOLEAN;
        (*
        This procedure function can be used to lookup and retireve an
        entry present in the table. If found, the function returns
        TRUE, FALSE otherwise.
        *)

        PROCEDURE hashfind( VAR name : String (* in *) ): ndptr;
            (*
            find name in hash table, invoked by LookUp only.
            *)

            VAR
                p : ndptr;
                tempname : String;

            BEGIN
                p := hashtab[ hash( name ) ];
                WHILE p # NIL DO
                    cscopy( ndtable, p^.namepos, tempname );
                    IF Strcmp( name, tempname ) = 0 THEN
                        IF TabDebug THEN
                            PutQStr(" %TabDebug, ");
                            PutStr( name );
                            PutQStr( " = " );
                            PutStr( tempname );
                            WriteLn
                        END;

                        RETURN p
                    END;

                    p := p^.nextptr
                END;
                RETURN p   (* NIL *)
            END hashfind;

        VAR
            p : ndptr;

        BEGIN
            p := hashfind( name );
            IF p = NIL THEN
                RETURN FALSE
            END;

            cscopy( ndtable, p^.defpos, defn );   (* assoc definition *)
            Value := p^.namevalue;                (* and the real value *)
            t     := p^.kind;                     (* and the kind *)
            RETURN TRUE
        END LookUp;

(* Begin intialization of Table module
Initialize hash table to nil. Make "NullDef".
*)
VAR
    i : [ 1..HASHSIZE ];
BEGIN
    NullDef[1] := ENDSTR;
    TabDebug   := FALSE;

    nexttab := 1; (* 1st free slot in table *)
    FOR i := 1 TO HASHSIZE DO
        hashtab[ i ] := NIL
    END

END TableManager.