(*1:*)IMPLEMENTATION MODULE TABLEHANDLER;
(*2:*)FROM Strings IMPORT Length , Assign ;
(*:2*)(*6:*)FROM Storage IMPORT ALLOCATE,DEALLOCATE, Available ;
FROM SYSTEM IMPORT TSIZE;(*:6*)CONST(*3:*)MAXCARD=65535;
(*:3*)TYPE(*4:*)TREEPTR=POINTER TO TREERECORD;
TREERECORD=RECORD STR:SYMBOLSTRINGPTR;NUM:CARDINAL;DEFINED:BOOLEAN;
LEFT,RIGHT:TREEPTR;END;
(*:4*)(*5:*)TABLERECORD=RECORD NEXTENTRY:CARDINAL;THETREE:TREEPTR;
USERERRROUTINE:ERRORPROC;LASTENTRYFOUND:TREEPTR;CASESENSITIVE:BOOLEAN;
END;TABLEPTR=POINTER TO TABLERECORD;SYMBOLTABLE=TABLEPTR;
(*:5*)(*14:*)RELATION=(LESS,EQUAL,GREATER);
(*:14*)(*:1*)(*7:*)PROCEDURE GETVALUEOFSYMBOL(THETABLE:SYMBOLTABLE;
TARGETSYMBOL:ARRAY OF CHAR;THISISADEFINITION:BOOLEAN;
VAR STRINGPTR:SYMBOLSTRINGPTR):CARDINAL;
(*11:*)PROCEDURE SEARCH(P:TREEPTR):TREEPTR;VAR Q:TREEPTR;R:RELATION;
I:CARDINAL;SLEN:CARDINAL;BEGIN Q:=P^.RIGHT;R:=GREATER;
WHILE Q<>NIL DO P:=Q;R:=RELATIONOF(P^.STR);
IF R=EQUAL THEN RETURN P ELSIF R=LESS THEN Q:=P^.LEFT ELSE Q:=P^.RIGHT
END END;(*12:*)Q:=NIL;SLEN:= Length (CURRENTSYMBOL)+1;
IF Available (TSIZE(TREERECORD)+SLEN)THEN Q:=NIL;
IF Available (TSIZE(TREERECORD))THEN NEW(Q);WITH Q^DO STR:=NIL;
LEFT:=NIL;RIGHT:=NIL;DEFINED:=FALSE;NUM:=MAXCARD;END;
ELSE THETABLE^.USERERRROUTINE(MEMORYEXHAUSTED,' ');END;;
WITH Q^DO ALLOCATE(STR,SLEN); Assign (CURRENTSYMBOL,STR^);END;
(*13:*)IF R=LESS THEN P^.LEFT:=Q;ELSE P^.RIGHT:=Q;END;(*:13*);
ELSE THETABLE^.USERERRROUTINE(MEMORYEXHAUSTED,' ');END;(*:12*);RETURN Q;
END SEARCH;
(*:11*)(*15:*)PROCEDURE RELATIONOF(K:SYMBOLSTRINGPTR):RELATION;
VAR I:CARDINAL;R:RELATION;X,Y:CHAR;BEGIN I:=0;R:=EQUAL;
LOOP X:=CURRENTSYMBOL[I];Y:=K^[I];IF CAP(X)<>CAP(Y)THEN EXIT;END;
IF X<=' 'THEN RETURN R END;
IF X<Y THEN R:=LESS ELSIF X>Y THEN R:=GREATER END;I:=I+1;END;
(*16:*)IF CAP(X)>CAP(Y)THEN RETURN GREATER ELSE RETURN LESS END;(*:16*);
END RELATIONOF;(*:15*)VAR P:TREEPTR;N:CARDINAL;
CURRENTSYMBOL:SYMBOLSTRING;BEGIN THETABLE^.LASTENTRYFOUND:=NIL;
Assign (TARGETSYMBOL,CURRENTSYMBOL);
(*8:*)IF NOT THETABLE^.CASESENSITIVE THEN FOR N:=0 TO Length (
CURRENTSYMBOL)-1 DO CURRENTSYMBOL[N]:=CAP(CURRENTSYMBOL[N]);END;END;
(*:8*);P:=SEARCH(THETABLE^.THETREE);
IF P=NIL THEN THETABLE^.USERERRROUTINE(MEMORYEXHAUSTED,' ');
RETURN MAXCARD;
ELSE(*9:*)IF THISISADEFINITION THEN IF P^.DEFINED THEN THETABLE^.
USERERRROUTINE(DUPLICATESYMBOL,CURRENTSYMBOL);RETURN MAXCARD;
ELSE P^.DEFINED:=TRUE;END;END;
(*:9*)(*10:*)IF P^.NUM=MAXCARD THEN P^.NUM:=THETABLE^.NEXTENTRY;
INC(THETABLE^.NEXTENTRY);END;(*:10*)STRINGPTR:=P^.STR;
THETABLE^.LASTENTRYFOUND:=P;RETURN P^.NUM;END;END GETVALUEOFSYMBOL;
(*:7*)(*17:*)PROCEDURE SETVALUEOFSYMBOL(THETABLE:SYMBOLTABLE;
TARGETSYMBOL:ARRAY OF CHAR;THISISADEFINITION:BOOLEAN;
VAR STRINGPTR:SYMBOLSTRINGPTR;THEVAL:CARDINAL);VAR ENT:CARDINAL;
BEGIN THETABLE^.LASTENTRYFOUND:=NIL;
ENT:=GETVALUEOFSYMBOL(THETABLE,TARGETSYMBOL,THISISADEFINITION,STRINGPTR)
;IF THETABLE^.LASTENTRYFOUND<>NIL THEN THETABLE^.LASTENTRYFOUND^.NUM:=
THEVAL;END;END SETVALUEOFSYMBOL;
(*:17*)(*18:*)PROCEDURE SYMBOLISDEFINED(THETABLE:SYMBOLTABLE;
TARGETSYMBOL:ARRAY OF CHAR):BOOLEAN;VAR ENT:CARDINAL;
STRINGPTR:SYMBOLSTRINGPTR;BEGIN THETABLE^.LASTENTRYFOUND:=NIL;
ENT:=GETVALUEOFSYMBOL(THETABLE,TARGETSYMBOL,FALSE,STRINGPTR);
IF THETABLE^.LASTENTRYFOUND<>NIL THEN RETURN THETABLE^.LASTENTRYFOUND^.
DEFINED;ELSE RETURN FALSE;END;END SYMBOLISDEFINED;
(*:18*)(*19:*)PROCEDURE UNDEFINEDSYMBOLSINTABLE(THETABLE:SYMBOLTABLE;
UNDEFINEDSYMBOLHANDLINGROUTINE:ERRORPROC):BOOLEAN;
(*20:*)PROCEDURE THISNODEISUNDEFINED(P:TREEPTR):BOOLEAN;
VAR UNDEFINEDWASFOUND,UNDEFINEDSYMBOLINLEFTSUBTREE,
UNDEFINEDSYMBOLINRIGHTSUBTREE:BOOLEAN;BEGIN UNDEFINEDWASFOUND:=FALSE;
IF P<>NIL THEN IF NOT P^.DEFINED THEN UNDEFINEDSYMBOLHANDLINGROUTINE(
UNDEFINEDSYMBOL,P^.STR^);END;
UNDEFINEDSYMBOLINLEFTSUBTREE:=THISNODEISUNDEFINED(P^.LEFT);
UNDEFINEDSYMBOLINRIGHTSUBTREE:=THISNODEISUNDEFINED(P^.RIGHT);
UNDEFINEDWASFOUND:=(NOT P^.DEFINED)OR UNDEFINEDSYMBOLINLEFTSUBTREE OR
UNDEFINEDSYMBOLINRIGHTSUBTREE;END;RETURN UNDEFINEDWASFOUND;
END THISNODEISUNDEFINED;
(*:20*)BEGIN RETURN THISNODEISUNDEFINED(THETABLE^.THETREE^.RIGHT);
END UNDEFINEDSYMBOLSINTABLE;
(*:19*)(*21:*)PROCEDURE SEARCHSYMBOLTABLE(THETABLE:SYMBOLTABLE;
USERACTIONROUTINE:TABLEPROC);(*22:*)PROCEDURE SEARCHANODE(P:TREEPTR);
BEGIN IF P<>NIL THEN SEARCHANODE(P^.LEFT);
USERACTIONROUTINE(P^.NUM,P^.STR,P^.DEFINED);SEARCHANODE(P^.RIGHT);END;
END SEARCHANODE;(*:22*)BEGIN SEARCHANODE(THETABLE^.THETREE^.RIGHT);
END SEARCHSYMBOLTABLE;
(*:21*)(*23:*)PROCEDURE DELETESYMBOLTABLE(VAR THETABLE:SYMBOLTABLE);
BEGIN IF THETABLE<>NIL THEN DELETEANODE(THETABLE^.THETREE^.RIGHT);
DISPOSE(THETABLE);THETABLE:=NIL;END;END DELETESYMBOLTABLE;
(*:23*)(*24:*)PROCEDURE DELETEANODE(VAR P:TREEPTR);VAR SLEN:CARDINAL;
BEGIN IF P<>NIL THEN WITH P^DO DELETEANODE(LEFT);DELETEANODE(RIGHT);
SLEN:= Length (STR^)+1;DEALLOCATE(STR,SLEN);END;DISPOSE(P);P:=NIL;END;
END DELETEANODE;
(*:24*)(*25:*)PROCEDURE CREATESYMBOLTABLE(VAR THETABLE:SYMBOLTABLE;
CASESENS:BOOLEAN;USERERRORROUTINE:ERRORPROC);
BEGIN(*26:*)IF Available (TSIZE(TABLERECORD)+TSIZE(TREERECORD))THEN NEW(
THETABLE);WITH THETABLE^DO USERERRROUTINE:=USERERRORROUTINE;
THETREE:=NIL;IF Available (TSIZE(TREERECORD))THEN NEW(THETREE);
WITH THETREE^DO STR:=NIL;LEFT:=NIL;RIGHT:=NIL;DEFINED:=FALSE;
NUM:=MAXCARD;END;ELSE THETABLE^.USERERRROUTINE(MEMORYEXHAUSTED,' ');END;
;NEXTENTRY:=0;CASESENSITIVE:=CASESENS;END;
ELSE USERERRORROUTINE(MEMORYEXHAUSTED,' ');END;
(*:26*)END CREATESYMBOLTABLE;
(*:25*)(*27:*)PROCEDURE SETERRORHANDLER(THETABLE:SYMBOLTABLE;
USERERRORROUTINE:ERRORPROC);
BEGIN THETABLE^.USERERRROUTINE:=USERERRORROUTINE;END SETERRORHANDLER;
(*:27*)(*28:*)END TABLEHANDLER.(*:28*)