(****************************************
*                                       *
*     MODULA-2 Multi-Pass Compiler      *
*     ****************************      *
*                                       *
*       VAX/VMS Implementation          *
*                                       *
*                                       *
*     MVCId3:                           *
*                                       * 
*     Identifier handling in Pass 3     *
*                                       * 
*                                       *
*     Version 3.1 of  1-FEB-1983        *
*                                       *
*                                       *
*                                       *
*     Based on PDP11 Implementation     *
*     Version M22 of 06.01.81           *
*                                       *
*     Institut fuer Informatik          *
*     ETH-Zuerich                       *
*     CH-8092 Zuerich                   *
*                                       *
****************************************)

(****************************************
* Updates:                              *
****************************************)

IMPLEMENTATION MODULE MVCId3;     (* PDP11: LG *)
  (* VAX:   M. Mall *)

  IMPORT MVCompiler, MVCXRef, MVCIO3, Storage;

  MODULE SearchSystem;

    FROM MVCompiler IMPORT Spellix, Idptr, Idclass;
    FROM MVCXRef    IMPORT EnterXRef;
    FROM MVCIO3     IMPORT spix, line;

    EXPORT Locate, Search;


    PROCEDURE Search(list: Idptr; spix: Spellix; VAR ip: Idptr);
      (* search in list until found or spix < name *)

    BEGIN
      ip := NIL;
      WHILE list <> NIL DO
        WITH list^ DO
          IF spix > name THEN
            list := link;
          ELSIF spix < name THEN
            list := NIL
          ELSE (* spix = name *)
            IF klass = indrct THEN
              ip := nxtidp; (* real entry *)
            ELSE ip := list;
            END;
            list := link; (* find last entry with the same name *)
          END
        END (* WITH *)
      END
    END Search;

    PROCEDURE Locate(list: Idptr; VAR ip: Idptr);
      (* Search an identifier in list.       *)
      (* The name spix is taken from MVCIO3. *)
      (* The result (possibly NIL) is        *)
      (* assigned to ip.                     *)

    BEGIN
      Search(list,spix,ip); (* spix from MVCIO3 *)
      EnterXRef ( ip, line, FALSE )
    END Locate;

  END SearchSystem;


  MODULE AmongSystem;

    FROM MVCompiler IMPORT Stptr, Structform, Stset;

    EXPORT FAmong;

    PROCEDURE FAmong(sp: Stptr; forms: Stset): BOOLEAN;

      VAR
        amo : BOOLEAN;

    BEGIN (* form of referenced structure is among forms *)
      amo := FALSE;
      IF sp <> NIL THEN
        WITH sp^ DO
          IF form IN forms THEN
            amo := TRUE
          ELSIF form = subranges THEN
            amo := FAmong(scalp,forms)
          END
        END
      END;
      RETURN amo
    END FAmong;

  END AmongSystem;

  MODULE ImpListSystem;

    FROM MVCompiler IMPORT 
                           Idptr, Stptr, Idclass, Structform,
                           Stset, Spellix, Listptr, root;
    FROM MVCIO3 IMPORT spix, Error;
    FROM Storage IMPORT ALLOCATE, DEALLOCATE;
    FROM SearchSystem IMPORT Search;
    FROM AmongSystem IMPORT FAmong;

    EXPORT 
           NewImpList, TermImpList, EnterImpList, ImpSearch,
           DisposeImpList;

    VAR
      implist : Listptr;

    PROCEDURE NewImpList(imp: Listptr);

    BEGIN
      implist := imp;
    END NewImpList;

    PROCEDURE TermImpList(VAR imp: Listptr);

    BEGIN
      imp := implist;
    END TermImpList;

    PROCEDURE EnterImpList(ip: Idptr);
      (* enter identifier in import list *)

      VAR
        newimp : Listptr;
        collision : BOOLEAN;

      PROCEDURE OneCheck(spix: Spellix);
        (* check on second import list entry of identifier spix *)

        VAR
          lip : Idptr;
          imp : Listptr;

      BEGIN
        IF NOT collision THEN
          imp := implist;
          lip := NIL;
          WHILE (imp <> NIL) AND NOT collision DO
            WITH imp^.element^ DO
              IF name = spix THEN
                lip := imp^.element;
              ELSIF (klass=mods) AND NOT qualexp THEN
                Search(expp,spix,lip);
              ELSIF (klass=types) AND (idtyp<>NIL) THEN
                IF idtyp^.form=enums THEN
                  Search(idtyp^.fcstp,spix,lip);
                END;
              END;
            END; (* WITH *)
            imp := imp^.next;
            collision := lip <> NIL;
          END; (* WHILE *)
        END;
      END OneCheck;

      PROCEDURE ListCheck(ip: Idptr);
        (* check on second import-list entry of *)
        (* identifiers in list ip               *)
        (* enter also nested modules or         *)
        (* enumeration types in import list     *)

        VAR
          lip : Idptr;

      BEGIN
        WHILE ip <> NIL DO
          lip := ip;
          IF lip^.klass = indrct THEN
            lip := lip^.nxtidp
          END;
          WITH lip^ DO
            IF (klass = mods) AND NOT qualexp THEN
              EnterImpList(lip);
            ELSIF (klass = types) AND FAmong(idtyp,Stset{enums}) THEN
              EnterImpList(lip);
            ELSE OneCheck(name);
            END;
          END; (* WITH *)
          ip := ip^.link;
        END;
      END ListCheck;

    BEGIN
      collision := FALSE;
      WITH ip^ DO
        OneCheck(name);
        IF (klass = mods) AND NOT qualexp THEN
          ListCheck(expp)
        ELSIF (klass = types) AND (idtyp <> NIL) THEN
          IF idtyp^.form = enums THEN
            ListCheck(idtyp^.fcstp)
          END;
        END;
      END;
      IF collision THEN
        Error(70)
      END;
      NEW(newimp);
      WITH newimp^ DO
        element := ip;
        next := implist
      END;
      implist := newimp;
    END EnterImpList;

    PROCEDURE ImpSearch(mp: Idptr; VAR ip: Idptr);
      (* search identifier in import list of module mp *)

      VAR
        imp : Listptr;
        lip : Idptr;
        sp : Stptr;

    BEGIN (* spix from MVCIO3 *)
      IF mp <> NIL THEN
        imp := mp^.impp
      ELSE imp := NIL
      END;
      lip := NIL;
      WHILE (lip = NIL) AND (imp <> NIL) DO
        WITH imp^.element^ DO
          IF name = spix THEN
            lip := imp^.element;
          ELSIF (klass = mods) AND NOT qualexp THEN
            Search(expp,spix,lip);
          ELSIF (klass = types) AND FAmong(idtyp,Stset{enums}) THEN
            sp := idtyp;
            IF sp^.form = subranges THEN
              sp := sp^.scalp
            END;
            Search(sp^.fcstp,spix,lip);
          END;
        END; (* WITH *)
        imp := imp^.next;
      END; (* WHILE *)
      IF lip = NIL THEN (* search for pervasives *)
        Search(root^.expp,spix,lip);
      END;
      ip := lip;
    END ImpSearch;

    PROCEDURE DisposeImpList(VAR imp: Listptr);
      (* dispose the whole importlist of a module *)

      VAR
        imp1 : Listptr;

    BEGIN
      WHILE imp <> NIL DO
        imp1 := imp;
        imp := imp^.next;
        DISPOSE(imp1);
      END;
    END DisposeImpList;

  END ImpListSystem;

  MODULE Scope;

    FROM Storage IMPORT DEALLOCATE;
    FROM MVCompiler IMPORT 
                           Idptr, Stptr, Listptr, Idclass,
                           Structform, Stset;
    FROM MVCXRef IMPORT EnterXRef;
    FROM MVCIO3 IMPORT spix, line, Error;
    FROM SearchSystem IMPORT Search;
    FROM AmongSystem IMPORT FAmong;
    FROM ImpListSystem IMPORT ImpSearch;

    EXPORT 
           SearchId, ExportSearch,
           MarkModScope, ReleaseModScope,
           MarkProcScope, ReleaseProcScope,
           MarkWithScope, ReleaseWithScope, FieldIndex,
           BodyMark, BodyScopes;

    CONST
      NoMark = FALSE;

    TYPE
      Scoperange = [0 .. 15];
      Scopeset = SET OF Scoperange;

    VAR
      displ : ARRAY Scoperange OF
                RECORD
                  modp : Idptr; (* reference to module name *)
                  brf : Idptr;
                  msfirst: Listptr;
                END;
      level : Scoperange;          (* current level *)
      foundlevel: Scoperange;      (* level on which identifier was found *)
      (* set in SearchId, used in FieldIndex *)
      modlevel : Scoperange;       (* level of module scope *)
      bodylevel : Scoperange;      (* level of compiled body *)
      maxlevel : Scoperange;       (* maximal level in body *)
      modlevstack : Scopeset;      (* stack of module levels *)

    PROCEDURE SearchId(VAR ip: Idptr);

      VAR
        ls : Listptr;
        clev: Scoperange;
        (* Search an identifier in the current scope. *)
        (* The name spix is taken from MVCIO3.        *)

    BEGIN
      ip := NIL;
      IF level <= 15 THEN
        clev := level;
        LOOP
          Search(displ[clev].brf,spix,ip);
          IF ip = NIL THEN
            ls := displ[clev].msfirst;
            WHILE (ls <> NIL) AND (ip = NIL) DO
              Search(ls^.element,spix,ip);
              ls := ls^.next;
            END;
          END;
          IF (ip <> NIL) OR (clev = modlevel) THEN
            EXIT
          END;
          DEC(clev);
        END;
        IF ip = NIL THEN
          ImpSearch(displ[modlevel].modp,ip)
        END;
      END;
      foundlevel := clev;
      EnterXRef ( ip, line, NoMark )
    END SearchId;

    PROCEDURE ExportSearch(ep: Idptr; VAR ip: Idptr);
      (* search identifier in export list of a module *)

      VAR
        lip : Idptr;
        lep : Idptr;
        sp : Stptr;

    BEGIN (* spix from MVCIO3 *)
      Search(ep,spix,lip);
      IF lip = NIL THEN (*search in enumeration type or nested module*)
        WHILE (lip = NIL) AND (ep <> NIL) DO
          lep := ep;
          IF lep^.klass = indrct THEN
            lep := lep^.nxtidp
          END;
          WITH lep^ DO
            IF (klass = mods) AND NOT qualexp THEN
              ExportSearch(expp,lip);
            ELSIF (klass = types) AND FAmong(idtyp,Stset{enums}) THEN
              sp := idtyp;
              IF sp^.form = subranges THEN
                sp := sp^.scalp
              END;
              Search(sp^.fcstp,spix,lip)
            END;
          END; (* WITH *)
          ep := ep^.link;
        END; (* WHILE *)
      END;
      ip := lip;
      EnterXRef ( ip, line, NoMark )
    END ExportSearch;


    PROCEDURE NewLevel(mp,ip: Idptr; fmsfirst: Listptr);

    BEGIN
      INC(level);
      IF level <= 15 THEN
        WITH displ[level] DO
          modp := mp;
          brf := ip;
          msfirst := fmsfirst;
        END;
      ELSE 
        Error(79);
      END;
    END NewLevel;

    PROCEDURE OldLevel;

      VAR
        mp,mp1 : Listptr;

    BEGIN
      (* dispose ms-table of this block *)
      IF level <= 15 THEN
        mp := displ[level].msfirst;
        WHILE mp <> NIL DO
          mp1 := mp;
          mp := mp^.next;
          DISPOSE(mp1)
        END;
      END;
      IF level > maxlevel THEN
        maxlevel := level
      END;
      DEC(level);
    END OldLevel;

    PROCEDURE MarkModScope(ip : Idptr);

    BEGIN
      WITH ip^ DO
        NewLevel(ip,expp,NIL);
        IF level <= 15 THEN
          modlevel := level;
          INCL(modlevstack,modlevel);
        END;
        NewLevel(NIL,locp,msp);
      END
    END MarkModScope;

    PROCEDURE ReleaseModScope;

    BEGIN
      OldLevel;
      IF level <= 15 THEN
        EXCL(modlevstack,modlevel);
        REPEAT DEC(modlevel)
        UNTIL modlevel IN modlevstack;
      END;
      OldLevel;
    END ReleaseModScope;

    PROCEDURE MarkProcScope(ip: Idptr);
      (* Mark the scope of a procedure *)

    BEGIN
      WITH ip^ DO
        IF klass = mods THEN (* module body *)
          NewLevel(NIL,NIL,NIL);
        ELSE NewLevel(NIL,locp,msp);
        END;
      END;
    END MarkProcScope;

    PROCEDURE ReleaseProcScope;
      (* Release the scope of a procedure *)

    BEGIN
      OldLevel;
    END ReleaseProcScope;

    PROCEDURE MarkWithScope(ip: Idptr);
      (* mark the scope of a with statement *)

    BEGIN
      NewLevel(NIL,ip,NIL);
    END MarkWithScope;

    PROCEDURE ReleaseWithScope;
      (* Release the scope of a with statement *)

    BEGIN
      OldLevel;
    END ReleaseWithScope;

    PROCEDURE FieldIndex(): CARDINAL;
      (* Return the nestlevel of a field in a with statement *)

    BEGIN
      RETURN foundlevel - bodylevel;
    END FieldIndex;

    PROCEDURE BodyMark;
      (* mark level of the body of a procedure *)

    BEGIN
      bodylevel := level;
      maxlevel := bodylevel;
    END BodyMark;

    PROCEDURE BodyScopes(): CARDINAL;
      (* return maximal nesting in body *)

    BEGIN
      RETURN maxlevel - bodylevel;
    END BodyScopes;

  BEGIN (* Scope *)
    level := 0;
    modlevel := 0;
    modlevstack := Scopeset{0};
    bodylevel := 0;
    maxlevel := 0;
    WITH displ[level] DO
      modp := NIL;
      brf := NIL;
      msfirst := NIL
    END;
  END Scope;

END MVCId3.