home *** CD-ROM | disk | FTP | other *** search
/ The Education Master 1994 (4th Edition) / EDUCATIONS_MASTER_4TH_EDITION.bin / files / progscal / tinypasc / tusyms.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-02-17  |  3.9 KB  |  145 lines
  1.   { TUSYMS:  Symbol table handling for skeleton files. }
  2.   { Copyright (C) 1986 by QCAD Systems Inc., All Rights Reserved. }
  3.  
  4.   {*******************}
  5.   function HASHIT(FSYM: symbol): int;
  6.     var K, S: integer;
  7.   begin
  8.     s:=0;
  9.     for k:=1 to length(fsym) do
  10.       s:=s + ord(fsym[k]);   {just the sum of the characters}
  11.     hashit := s mod hashsize;
  12.   end;
  13.  
  14.   {********************}
  15.   function NEW_SYM(SYT: symtype): symtabp;
  16.     var TSYM: symtabp;
  17.   begin
  18.     new(tsym);
  19.     new_sym:=tsym;
  20.     with tsym^ do begin
  21.       next:=nil;
  22.       symt:=syt;
  23.       case syt of
  24.         reserved: tokval:=1;
  25.         var_type: vaddr:=0;
  26.         func_type: begin
  27.           faddr:=0;
  28.           pbytes:=0;
  29.           is_actual:=false;
  30.           is_system:=false;
  31.           end;
  32.         ELSE ;
  33.         end
  34.       end
  35.     end;
  36.         
  37.   {*****************}
  38.   function FINDSYM(var SYMTAB: symtable; FSYM: symbol): symtabp;
  39.     { Finds a symbol, returning NIL if not there.  Use this for
  40.       variable references, calling error if it returns NIL. }
  41.     var SP: symtabp;
  42.   begin
  43.     findsym := nil;
  44.     sp := symtab[hashit(fsym)];
  45.     while sp <> nil do begin
  46.       with sp^ do begin
  47.         if sym <> fsym then
  48.           sp := next
  49.         else begin
  50.           findsym := sp;
  51.           sp := nil
  52.         end
  53.       end
  54.     end
  55.   end;
  56.  
  57.   {************************}
  58.   procedure REMOVESYM(var SYMTAB: symtable; SYMP: symtabp);
  59.     var SP: symtabp;
  60.         HX: integer;
  61.   begin  {remove and dispose the symtab entry SYMP}
  62.     hx:=hashit(symp^.sym);
  63.     sp := symtab[hx];
  64.     if sp<>nil then begin  {may not be in table}
  65.       if sp=symp then
  66.       symtab[hx]:=sp^.next
  67.       else begin
  68.         while (sp<>nil) and (sp^.next<>symp) do sp:=sp^.next;
  69.         if (sp<>nil) and (sp^.next=symp) then
  70.           sp^.next:=symp^.next;  {point around it}
  71.         end;
  72.       dispose(symp);
  73.       end
  74.     end;
  75.  
  76.   {**********************}
  77.   function MAKESYM(var SYMTAB: symtable;
  78.                    FSYM: symbol;  SYT: symtype;  LEV: int):  symtabp;
  79.     { this returns a symbol entry if there; makes a new one if not.
  80.       Useful for FORTRAN-style variable declaration -- declare name
  81.       on first appearance, whether in a declaration or not. }
  82.     var SP: symtabp;
  83.         HX: int;
  84.   begin
  85.     sp := findsym(symtab, fsym);
  86.     if sp = nil then begin
  87.       sp:=new_sym(syt);  { need a new one if here }
  88.       with sp^ do begin
  89.         { put at the head of the hash list}
  90.         sym := fsym;
  91.         hx := hashit(fsym);
  92.         next := symtab[hx];
  93.         symtab[hx] := sp;
  94.         level := lev;
  95.       end
  96.     end;
  97.     makesym := sp
  98.   end;
  99.  
  100.   {**********************}
  101.   function FORCESYM(var SYMTAB: symtable;
  102.                     FSYM: symbol;  SYT: symtype;  LEV: int):  symtabp;
  103.     { This forces a new symbol entry.  Use this for declarations
  104.       to cover a previous declaration with the same name. }
  105.     var SP: symtabp;
  106.         HX: int;
  107.   begin
  108.     hx := hashit(fsym);
  109.     sp:=new_sym(syt);
  110.     with sp^ do begin
  111.       { put at the head of the hash list. }
  112.       sym := fsym;
  113.       next := symtab[hx];
  114.       symtab[hx] := sp;
  115.       level := lev;
  116.     end;
  117.     forcesym := sp;
  118.   end;
  119.  
  120.   {********************}
  121.   procedure CLEARSYM(var SYMTAB: symtable; CLEVEL: int);
  122.     { Sets the symbol table pointers to remove references to
  123.       everything at level >= CLEVEL, assuming that level numbers
  124.       are monotonic.  Prepares for a RELEASE of memory. }
  125.     var HX: int;
  126.         SP, KEEP: symtabp;
  127.   begin
  128.     { Don't clear the reserved words -- check, just in case }
  129.     if clevel<0 then clevel := 0;
  130.     for hx := 0 to hlimit do begin
  131.       sp := symtab[hx];  
  132.       keep := nil;
  133.       while sp <> nil do begin
  134.         if sp^.level >= clevel then sp := sp^.next
  135.         else begin
  136.           keep := sp;
  137.           sp := nil;
  138.           end
  139.         end;
  140.       symtab[hx] := keep;
  141.       end
  142.     end;
  143.  
  144.  
  145.