home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 541a.lha / M2Pascal / src / IdLookup.mod < prev    next >
Encoding:
Modula Implementation  |  1991-08-10  |  8.9 KB  |  268 lines
  1. IMPLEMENTATION MODULE IdLookup;
  2.  
  3.  
  4. (*
  5.  
  6.      By: Greg Mumm
  7.  
  8.      This module allows the lookup of identifiers.  It's especially
  9.      useful for the simple substitutions that occur when translating
  10.      module-2 into pascal. For instance, looking up the symbol "MODULE"
  11.      will result in the new symbol-to-exchange "program".
  12. *)
  13.  
  14. FROM SYSTEM       IMPORT ADDRESS,        ADR;
  15.  
  16. FROM Strings      IMPORT CompareString,  Relation,   CopyString ;
  17.  
  18. FROM Heap         IMPORT ALLOCATE ;
  19.  
  20. FROM InOut        IMPORT WriteString,    WriteInt;
  21.  
  22. FROM errors       IMPORT FatalError,     ErrorType,     internal;
  23.  
  24. FROM scan         IMPORT STRING ;
  25.  
  26.  
  27. CONST
  28.         DEBUG     = FALSE;
  29.         TableSize = 277;     
  30.  
  31.  
  32. TYPE
  33.  
  34.  
  35.         HashRecPtr   = POINTER TO HashRecType;
  36.  
  37.         HashRecType  = RECORD
  38.          symbol         : STRING;
  39.         ProcessCode    : ProcessType;
  40.         ExchangeString : STRING;   (* only used if ProcessCode
  41.                           is "exchange"  *)
  42.             next           : HashRecPtr;
  43.            END;
  44.  
  45.  
  46. VAR     
  47.         table        : ARRAY [ 0 .. TableSize -1 ] OF  HashRecPtr;
  48.         i            : INTEGER;
  49.  
  50.  
  51.  
  52.  
  53. PROCEDURE HashFunction ( KeyString  : STRING   ) : INTEGER;
  54.  VAR i : INTEGER;  ch : CHAR;  sum : CARDINAL;
  55. BEGIN
  56.   sum  := 1;
  57.   i    := 0;
  58.  
  59.   REPEAT
  60.         ch  := KeyString [ i ];
  61.         sum := sum +  ORD ( ch ) ;
  62.  
  63.         INC ( i );
  64.   UNTIL ( ( i = 5 ) OR ( ch = 0C ) );
  65.  
  66.   RETURN sum MOD (TableSize -1);
  67. END HashFunction;
  68.  
  69.  
  70. (* This procedure will add your hash record to the table, currently
  71.    this is not alphabetized                                          *)
  72. PROCEDURE InsertRecordInTable ( index : INTEGER; VAR   ptr : HashRecPtr );
  73. BEGIN
  74.         ptr ^.next := table [ index ]; (* ptr to prev. first record in list *)
  75.  
  76.         table [ index ] := ptr;        (* new first ptr in list *)
  77. END InsertRecordInTable;
  78.  
  79.  
  80.                                                         
  81. (* This procedure will set up the hash table one symbol at a time. This
  82.    is run before the execution of the main line.
  83. *)
  84. PROCEDURE SetHash  (     KeyString : STRING;      ProcessCode : ProcessType; 
  85.                      ReplaceString : STRING                              );
  86.  VAR     index : INTEGER;                 ptr  : HashRecPtr;
  87. BEGIN
  88.     index := HashFunction ( KeyString ) ;
  89.  
  90.     ALLOCATE ( ptr , SIZE ( HashRecType ) );
  91.  
  92.  
  93.     IF ptr <> NIL THEN
  94.             CopyString ( ptr^. symbol , KeyString );
  95.             ptr^. next        := NIL;
  96.             IF ProcessCode = exchange THEN
  97.                 CopyString ( ptr^ . ExchangeString, ReplaceString );
  98.                 ptr^ . ProcessCode    := exchange;
  99.             ELSIF ProcessCode = special THEN
  100.                 ptr^ . ExchangeString := 0C;   (*  don't use this  *)
  101.                 ptr^ . ProcessCode    := special;               
  102.             ELSIF ProcessCode = NoSupport THEN
  103.                 ptr^ . ExchangeString := 0C;   (*  don't use this  *)
  104.                 ptr^ . ProcessCode    := NoSupport;
  105.             ELSE
  106.                 internal ( "Unknown ProcessCode in IdLookup" );
  107.             END;
  108.            
  109.             InsertRecordInTable ( index, ptr );
  110.     ELSE
  111.             FatalError ( OutOfMemory );
  112.     END;
  113. END SetHash;
  114.  
  115.  
  116.  
  117. (* This function will search the hash table for the requested symbol
  118.    and send back the appropriate record if found. If the symbol is not
  119.    found in the table it will return a FALSE       *)
  120.  
  121. PROCEDURE SearchHash ( VAR IdInfo     : IdInfoType  ;  
  122.                        SearchSymbol   : STRING )    : BOOLEAN;
  123.  VAR index : INTEGER;   TempPtr : HashRecPtr;    WordFound : BOOLEAN;
  124. BEGIN
  125.         index                 := HashFunction ( SearchSymbol );
  126.         TempPtr               := table [ index ];
  127.         WordFound             := FALSE;
  128.         
  129.         WHILE ( TempPtr <> NIL) AND ( NOT WordFound ) DO
  130.                 IF  CompareString ( TempPtr^.symbol , SearchSymbol ) = equal
  131.                 THEN WordFound := TRUE;
  132.                 ELSE TempPtr := TempPtr^.next;
  133.                 END;
  134.         END;
  135.  
  136.         IF WordFound THEN        
  137.              IdInfo.ProcessCode    := TempPtr^.ProcessCode;
  138.              CopyString (IdInfo.ExchangeString, TempPtr^.ExchangeString ) ;
  139.         ELSE
  140.              IdInfo.ProcessCode    := NotFound;
  141.         END;
  142.  
  143.         RETURN WordFound;                
  144. END SearchHash;
  145.  
  146.  
  147.  
  148. PROCEDURE DebugPrintTable ;
  149.  VAR i : INTEGER;    ptr : HashRecPtr;
  150. BEGIN
  151.      FOR i := 0 TO TableSize -1 DO
  152.         IF table [ i ] <>  NIL THEN
  153.            ptr := table [ i ];
  154.            WriteInt ( i, 4 ); WriteString(" ");
  155.            WHILE ptr <> NIL DO
  156.                 WriteString(ptr^.symbol); WriteString(" ");
  157.                 IF ptr^.ProcessCode = exchange THEN
  158.                         WriteString("exchange | ");
  159.                         WriteString(ptr^.ExchangeString);
  160.                 ELSIF ptr^.ProcessCode = special THEN
  161.                         WriteString("special");
  162.                 ELSIF ptr^.ProcessCode = NoSupport THEN
  163.                         WriteString("NoSupport");
  164.                 ELSE
  165.                         WriteString("NotFound");
  166.                 END;
  167.                 WriteString(" , ");
  168.                 ptr := ptr^.next;
  169.            END;
  170.            WriteString("\n");
  171.         END;
  172.      END;
  173. END DebugPrintTable;
  174.  
  175.  
  176. BEGIN (* main *)
  177.  
  178.    FOR i := 0 TO TableSize -1 DO
  179.         table [ i ] := NIL;
  180.    END;
  181.  
  182.    SetHash ( "MODULE" ,    special,   ""  );
  183.    (*         ^^^^^^^
  184.               key          ^^^^^
  185.                            ProcessCode  
  186.                                     ^^^^^^
  187.                                     Replacement Symbol 
  188.                                     if  of type "exchange"    *)
  189.    
  190.  
  191.  
  192.  
  193.    SetHash (  "ABS" ,        exchange,     "abs"  );
  194.    SetHash (  "AND" ,        exchange,     "and"  );
  195.    SetHash (  "ARRAY" ,      exchange,     "array"  );
  196.    SetHash (  "BEGIN" ,      exchange,     "begin"  );
  197.    SetHash (  "BOOLEAN" ,    exchange,     "boolean"  );
  198.    SetHash (  "CARDINAL" ,   exchange,     "integer"  );
  199.    SetHash (  "CHAR" ,       exchange,     "char"  );
  200.    SetHash (  "CONST" ,      exchange,     "const"  );
  201.    SetHash (  "DIV" ,        exchange,     "div"  );
  202.    SetHash (  "ELSIF" ,      exchange,     "else if"  );
  203.    SetHash (  "FALSE" ,      exchange,     "false"  );
  204.    SetHash (  "FOR" ,        exchange,     "for"  );
  205.    SetHash (  "HALT" ,       exchange,     "halt"  );
  206.    SetHash (  "IF" ,         exchange,     "if"  );
  207.    SetHash (  "IN" ,         exchange,     "in"  );
  208.    SetHash (  "INTEGER" ,    exchange,     "integer"  );
  209.    SetHash (  "NIL" ,        exchange,     "nil"  );
  210.    SetHash (  "NOT" ,        exchange,     "not"  );
  211.    SetHash (  "ODD" ,        exchange,     "odd"  );
  212.    SetHash (  "OF" ,         exchange,     "of"  );
  213.    SetHash (  "OR" ,         exchange,     "or"  );
  214.    SetHash (  "ORD" ,        exchange,     "ord"  );
  215.    SetHash (  "Read" ,       exchange,     "read"  );
  216.    SetHash (  "ReadString" , exchange,     "read"  );
  217.    SetHash (  "ReadInt" ,    exchange,     "read"  );
  218.    SetHash (  "ReadCard",    exchange,     "read"  );
  219.    SetHash (  "ReadWrd" ,    exchange,     "read"  );
  220.    SetHash (  "REAL" ,       exchange,     "real"  );
  221.    SetHash (  "RECORD" ,     exchange,     "record"  );
  222.    SetHash (  "REPEAT" ,     exchange,     "repeat"  );
  223.    SetHash (  "TO" ,         exchange,     "to"  );
  224.    SetHash (  "TRUE" ,       exchange,     "true"  );
  225.    SetHash (  "TYPE" ,       exchange,     "type"  );
  226.    SetHash (  "UNTIL" ,      exchange,     "until"  );
  227.    SetHash (  "VAR" ,        exchange,     "var"  );
  228.    SetHash (  "WHILE" ,      exchange,     "while"  );
  229.    SetHash (  "WITH" ,       exchange,     "with"  );
  230.    SetHash (  "WriteLn",     exchange,     "writeln"  );
  231.    SetHash (  "#" ,          exchange,     "<>"  );
  232.    SetHash (  "&" ,          exchange,     "AND"  );
  233.    SetHash (  "{" ,          exchange,     "["  );
  234.    SetHash (  "}" ,          exchange,     "]"  );
  235.    SetHash (  "|" ,          exchange,     "end;"  );   (* CASE *)
  236.  
  237.  
  238.  
  239.    SetHash (  "ALLOCATE",    special,     ""  );
  240.    SetHash (  "CASE"  ,      special,     ""  );
  241.    SetHash (  "DEALLOCATE",  special,     ""  );
  242.    SetHash (  "DEC"  ,       special,     ""  );
  243.    SetHash (  "DO"  ,        special,     ""  );
  244.    SetHash (  "ELSE"  ,      special,     ""  );
  245.    SetHash (  "END"  ,       special,     ""  );
  246.    SetHash (  "FROM" ,       special,     ""  );
  247.    SetHash (  "INC"  ,       special,     ""  );
  248.    SetHash (  "POINTER" ,    special,     ""  );
  249.    SetHash (  "PROCEDURE" ,  special,     ""  );
  250.    SetHash (  "RETURN" ,     special,     ""  );
  251.    SetHash (  "THEN" ,       special,     ""  );
  252.    SetHash (  "WriteString", special,     ""  );
  253.    SetHash (  "WriteInt",    special,     ""  );
  254.    SetHash (  "WriteOct",    special,     ""  );
  255.    SetHash (  "WriteCard",   special,     ""  );
  256.    SetHash (  "WriteHex",    special,     ""  );
  257.    SetHash (  "WriteWrd",    special,     ""  );
  258.  
  259.  
  260.    SetHash (  "DEFINITION"     ,       NoSupport,     ""  );
  261.    SetHash (  "IMPLEMENTATION" ,       NoSupport,     ""  );  
  262.    SetHash (  "LOOP"           ,       NoSupport,     ""  );
  263.  
  264.  
  265.    IF DEBUG THEN DebugPrintTable   END;
  266.  
  267. END IdLookup.
  268.