www.pudn.com > LexYaccProgs.zip > YREFTABL.PAS

 
unit YRefTables; 
 
(* This module implements the symbol and cross reference table used 
   by the YREF program. *) 
 
interface 
 
const 
 
max_syms = 997; (* symbol table size (prime number!) *) 
 
function lookup ( k : Integer ) : String; 
procedure entry ( k : Integer; symbol : String ); 
(* lookup and entry routines for the symbol table *) 
 
procedure add_ref ( k : Integer; lineno : Integer; mark : Boolean ); 
  (* Enter an occurrence for symbol k into the table; the mark flag indicates 
     whether this occurrence should be marked as a "defining" occurrence. *) 
 
procedure set_type ( k : Integer; t : Integer ); 
  (* set the type of symbol k *) 
 
procedure ref_list; 
  (* Produces the cross reference listing in alphabetical order. *) 
 
var n_undef : Integer; 
  (* number of undefined symbols *) 
 
implementation 
 
uses LexLib, YRefTools; 
 
(* Basic data structures and routines: *) 
 
type 
 
StrPtr  = ^String;               (* dynamic strings *) 
RefList = ^RefNode;              (* symbol occurrence lists *) 
RefNode = record 
            lineno : Integer;    (* line number *) 
            mark   : Boolean;    (* mark flag *) 
            next   : RefList;    (* link to next list element *) 
          end; 
 
function newStr ( str : String ) : StrPtr; 
  (* returns a dynamic copy of str (only the number of bytes actually 
     needed are allocated) *) 
  var strp : StrPtr; 
  begin 
    getmem(strp, succ(length(str))); 
    move(str, strp^, succ(length(str))); 
    newStr := strp; 
  end(*newStr*); 
 
procedure append ( var L : RefList; lineno : Integer; mark : Boolean ); 
  (* append an entry to the given occurrence list (eliminate dups) *) 
  begin 
    if L=nil then 
      begin 
        new(L); 
        L^.lineno := lineno; 
        L^.mark   := mark; 
        L^.next   := nil; 
      end 
    else if L^.lineno=lineno then 
      L^.mark := L^.mark or mark 
    else 
      append(L^.next, lineno, mark); 
  end(*append*); 
 
(* Symbol and cross reference table: *) 
 
var 
 
sym_table : array [1..max_syms] of StrPtr;  (* symbol table (nil denotes 
                                               empty entry) *) 
ref_table : array [1..max_syms] of RefList; (* cross reference table *) 
 
defined   : array [1..max_syms] of Boolean; (* defined symbols *) 
 
sym_type  : array [1..max_syms] of Integer; (* symbol types *) 
 
n_syms    : Integer;                        (* number of symbols in the 
                                               table *) 
sym_no    : array [1..max_syms] of Integer; (* symbol keys sorted in 
                                               alphabetical order *) 
 
(* Comparison and swap routines to sort the symbol table: *) 
 
{$F+} 
function sym_less ( i, j : Integer ) : Boolean; 
{$F-} 
  begin 
    sym_less := sym_table[sym_no[i]]^nil) and (ref_table[k]<>nil) then 
        begin 
          inc(n_syms); 
          sym_no[n_syms] := k; 
        end; 
    quicksort(1, n_syms, sym_less, sym_swap); 
  end(*sort*); 
 
(* Interface routines: *) 
 
function lookup ( k : Integer ) : String; 
  begin 
    if sym_table[k]=nil then 
      lookup := '' 
    else 
      lookup := sym_table[k]^ 
  end(*lookup*); 
 
procedure entry ( k : Integer; symbol : String ); 
  begin 
    sym_table[k] := newStr(symbol) 
  end(*entry*); 
 
procedure add_ref ( k : Integer; lineno : Integer; mark : Boolean ); 
  begin 
    append(ref_table[k], lineno, mark); 
    defined[k] := defined[k] or mark; 
  end(*add_ref*); 
 
procedure set_type ( k : Integer; t : Integer ); 
  begin 
    sym_type[k] := t; 
  end(*set_type*); 
 
procedure ref_list; 
  const tab = #9; 
  var i : Integer; 
      L : RefList; 
  begin 
    sort; 
    writeln(yyoutput); 
    for i := 1 to n_syms do 
      begin 
        write(yyoutput, '  ', sym_table[sym_no[i]]^); 
        if sym_type[sym_no[i]]<>0 then 
          write(yyoutput, ' <', sym_table[sym_type[sym_no[i]]]^, '>'); 
        write(yyoutput, ' '); 
        L := ref_table[sym_no[i]]; 
        while L<>nil do 
          with L^ do 
            begin 
              write(yyoutput, ' ', lineno); 
              if mark then write(yyoutput, '*'); 
              L := next; 
            end; 
        writeln(yyoutput); 
      end; 
    n_undef := 0; 
    for i := 1 to n_syms do 
      if not defined[sym_no[i]] and 
         (sym_table[sym_no[i]]^<>'error') then 
        inc(n_undef); 
    if n_undef>0 then 
      begin 
        writeln(yyoutput); 
        writeln(yyoutput, '  undefined symbols:'); 
        writeln(yyoutput); 
        for i := 1 to n_syms do 
          if not defined[sym_no[i]] and 
             (sym_table[sym_no[i]]^<>'error') then 
            writeln(yyoutput, '  ', sym_table[sym_no[i]]^); 
      end; 
  end(*ref_list*); 
 
var k : Integer; 
begin 
  for k := 1 to max_syms do 
    begin 
      sym_table[k] := nil; 
      ref_table[k] := nil; 
      defined[k]   := false; 
      sym_type[k]  := 0; 
    end; 
end(*YRefTables*).