TP3/shell/CompilerSymbols.mod

IMPLEMENTATION MODULE CompilerSymbols ;

(* Symbol table and name scoping: storage, insertion, visibility-aware lookup,
   duplicate detection, and hiding a finished procedure's locals.  The lexer's
   current word and lexical level live here because Search and NewSym are the
   only users that define their meaning. *)

FROM CompilerShared IMPORT MaxName, Err, ECompOvf, EUnknown ;
FROM CompilerSource IMPORT Upper ;
FROM CompilerUtil IMPORT NameEq, CopyStr ;

PROCEDURE CopyWord (name : ARRAY OF CHAR) ;
(* stash current word into global wrd (uppercased) *)
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   LOOP
      IF i > HIGH (name) THEN
         wrd [i] := 0C ;
         RETURN
      END ;
      IF i > MaxName THEN
         wrd [MaxName] := 0C ;
         RETURN
      END ;
      IF name [i] = 0C THEN
         wrd [i] := 0C ;
         RETURN
      END ;
      wrd [i] := Upper (name [i]) ;
      INC (i)
   END
END CopyWord ;

PROCEDURE SaveWord (VAR dst : ARRAY OF CHAR) ;
(* copy wrd into dst *)
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   LOOP
      IF i > HIGH (dst) THEN
         dst [HIGH (dst)] := 0C ;
         RETURN
      END ;
      IF i > MaxName THEN
         dst [MaxName] := 0C ;
         RETURN
      END ;
      dst [i] := wrd [i] ;
      IF wrd [i] = 0C THEN
         RETURN
      END ;
      INC (i)
   END
END SaveWord ;

PROCEDURE NewSym (name : ARRAY OF CHAR ; tag : CARDINAL ;
                  cls, size, elem, off : CARDINAL ; v : LONGINT ;
                  local : BOOLEAN) : CARDINAL ;
VAR e : SymEntry ;
BEGIN
   IF symTop >= MaxSym THEN
      Err (ECompOvf) ;
      RETURN 0
   END ;
   CopyWord (name) ;
   CopyStr (e.name, wrd) ;
   e.tag := tag ;
   e.cls := cls ;
   e.size := size ;
   e.elem := elem ;
   e.off := off ;
   e.lval := v ;
   e.lo := 0 ;
   e.hi := 0 ;
   e.fldFirst := 0 ;
   e.fldLast := 0 ;
   e.arrIdx := 0 ;
   e.parmFirst := 0 ;
   e.parmCount := 0 ;
   e.isKbd := FALSE ;
   e.isPort := FALSE ;
   e.isVar := FALSE ;
   e.level := lexnest ;
   e.local := local ;
   e.parent := 0 ;
   e.staticOff := 0 ;
   e.resvar := 0 ;
   e.goPos := 0 ;
   e.defnd := FALSE ;
   e.fwd := FALSE ;
   symtab [symTop] := e ;
   INC (symTop) ;
   RETURN symTop - 1
END NewSym ;

PROCEDURE Search (nm : ARRAY OF CHAR ; VAR idx : CARDINAL) : BOOLEAN ;
(* find nm among symbols visible at the current lexical level *)
VAR p : CARDINAL ;
BEGIN
   CopyWord (nm) ;
   p := symTop ;
   WHILE p > 0 DO
      DEC (p) ;
      IF symtab [p].level <= lexnest THEN
         IF NameEq (symtab [p].name, wrd) THEN
            idx := p ;
            RETURN TRUE
         END
      END
   END ;
   RETURN FALSE
END Search ;

PROCEDURE DupTest (nm : ARRAY OF CHAR) ;
(* A name may be declared twice only in the SAME scope.  This used to reject
   any name Search could see, so a parameter could not shadow a global - legal
   ISO Pascal, and CALC.INC's `procedure IBMCh(var Ch: Char)' does exactly
   that (`Ch' is a global).  Same-level duplicates stay errors: two parameters
   in one list, two locals, or two globals. *)
VAR i : CARDINAL ;
BEGIN
   IF Search (nm, i) THEN
      IF symtab [i].level = lexnest THEN
         Err (EUnknown)
      END
   END
END DupTest ;

PROCEDURE HideLocals (from : CARDINAL) ;
(* Make every symbol from index `from' up invisible to everything outside the
   procedure that declared it.
   Search accepts a symbol when its level is <= lexnest, and every procedure
   body is compiled at the same depth (lexnest 1), so a finished procedure's
   parameters stayed visible to the NEXT procedure: a second `a : integer'
   was a duplicate (err 41) and an unqualified `a' inside procedure two read
   procedure one's argument.  Level 0FFFFH fails `level <= lexnest' at every
   depth a later procedure can be at, and by the time this runs the body that
   could still legitimately see them is finished.
   The symbols are relabelled, not popped: symtab[old].resvar holds an INDEX,
   and a function's result variable is one of the entries being hidden. *)
VAR p : CARDINAL ;
BEGIN
   p := from ;
   WHILE p < symTop DO
      symtab [p].level := 0FFFFH ;
      INC (p)
   END
END HideLocals ;

END CompilerSymbols.