(* Copyright (C) 1989, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* File: M3LinkerChk.m3                                        *)
(* Last Modified On Wed Feb 12 09:01:45 PST 1992 By kalsow         *)

MODULE M3LinkerChk EXPORTS M3Linker, M3LinkerRep;

IMPORT Text, Wr, Thread, M3LinkMap;
<*FATAL Wr.Failure, Thread.Alerted*>

CONST
  Margin = 72;

TYPE
  State = RECORD
    unit        : Unit;
    map         : M3LinkMap.T;
    interfaces  : M3LinkMap.T;
    modules     : M3LinkMap.T;
    revelations : M3LinkMap.T;
    errors      : Wr.T;
    failed      : BOOLEAN;
    all_units   : UnitList;
  END;

(*------------------------------------------------------------------------*)


PROCEDURE MergeUnit (unit   : Unit;
                     base   : LinkSet;
                     errors : Wr.T): LinkSet =
  VAR s: State;  map: M3LinkMap.T;  v: Unit;
  BEGIN
    IF (unit = NIL) THEN RETURN base END;

    s.unit   := unit;
    s.errors := errors;
    s.failed := FALSE;
    s.all_units := NEW (UnitList, unit := unit, next := NIL);
    IF (base = NIL) THEN
      s.map         := M3LinkMap.New (6001);
      s.interfaces  := M3LinkMap.New (1001);
      s.modules     := M3LinkMap.New (1001);
      s.revelations := M3LinkMap.New (1001);
    ELSE
      s.map         := base.stamps;
      s.interfaces  := base.interfaces;
      s.modules     := base.modules;
      s.revelations := base.revelations;
      s.all_units.next := base.all_units;
    END;

 
    IF (base # NIL) THEN
      (* check the existing version stamps with the new ones *)
      CheckStamps (s, unit.imported_symbols);
      IF (NOT s.failed) THEN
        CheckStamps (s, unit.exported_symbols);
      END;
      IF (NOT s.failed) THEN
        CheckRevelations (s, unit.revelations, FALSE);
      END;
      IF (s.failed) THEN
        IF (errors # NIL) THEN
          DumpErrors (s, unit.imported_symbols);
          DumpErrors (s, unit.exported_symbols);
          CheckRevelations (s, unit.revelations, TRUE);
        END;
        RETURN NIL;
      END;
    END;

    (* add the new unit *)
    IF (unit.interface)
      THEN map := s.interfaces;
      ELSE map := s.modules;
    END;
    v := M3LinkMap.Get (map, unit.name);
    IF (v # NIL)
      THEN DuplicateUnit (s, unit, v); RETURN NIL;
      ELSE M3LinkMap.Insert (map, unit.name, unit);
    END;

    (* add the new version stamps *)
    AddStamps (s, unit.exported_symbols);
    AddStamps (s, unit.imported_symbols);

    (* merge the new revelations *)
    AddRevelations (s, unit.revelations);

    (* return the modified link set *)
    IF (base = NIL) THEN base := NEW (LinkSet) END;

    base.mode        := Mode.Units;
    base.all_units   := s.all_units;
    base.stamps      := s.map;
    base.modules     := s.modules;
    base.interfaces  := s.interfaces;
    base.revelations := s.revelations;
    base.types       := NIL;
    base.revealed    := NIL;
    base.refany      := NIL;
    base.address     := NIL;
    base.null        := NIL;
    base.text        := NIL;
    base.root        := NIL;
    base.un_root     := NIL;
    base.main        := NIL;
    base.builtin     := NIL;

    (* success! *)
    RETURN base;
  END MergeUnit;
 
(*------------------------------------------------------------------------*)

PROCEDURE DuplicateUnit (VAR s: State;  u, v: Unit) =
  BEGIN
    s.failed := TRUE;
    IF (s.errors = NIL) THEN RETURN END;
    Out (s, "duplicate ", UnitName (u), ":\n");
    Out (s, "  in ", u.file.name, "\n");
    Out (s, " and ", v.file.name, "\n");
  END DuplicateUnit;

(*------------------------------------------------------------------------*)

PROCEDURE CheckStamps (VAR s: State;  vs: VersionStamp) =
  VAR x: VersionStamp;
  BEGIN
    WHILE (vs # NIL) AND (NOT s.failed) DO
      x := M3LinkMap.Get (s.map, vs.symbol);
      IF (x # NIL) THEN
        s.failed := (x.stamp # vs.stamp) OR (x.export AND vs.export);
      END;
      vs := vs.next;
    END;
  END CheckStamps;

(*------------------------------------------------------------------------*)

PROCEDURE AddStamps (VAR s: State;  vs: VersionStamp) =
  VAR z: VersionStamp;
  BEGIN
    WHILE (vs # NIL) DO
      z := M3LinkMap.Get (s.map, vs.symbol);
      IF (z = NIL) OR (vs.export AND NOT z.export) THEN
        M3LinkMap.Insert (s.map, vs.symbol, vs);
      END;
      vs := vs.next;
    END;
  END AddStamps;

(*------------------------------------------------------------------------*)

PROCEDURE DumpErrors (VAR s: State;  vs: VersionStamp) =
  VAR x: VersionStamp;
  BEGIN
    WHILE (vs # NIL) DO
      x := M3LinkMap.Get (s.map, vs.symbol);
      IF (x # NIL) THEN
        IF (x.stamp # vs.stamp) THEN BadStamps (s, vs) END;
        IF (x.export AND vs.export) THEN MultipleDefn (s, vs) END;
      END;
      vs := vs.next;
    END;
  END DumpErrors;

TYPE
  StampList = REF RECORD
    vs   : VersionStamp;
    unit : Unit;
    next : StampList;
  END;

PROCEDURE BadStamps (VAR s: State;  vs: VersionStamp) =
  VAR stamps := FindStamps (s, vs);  new, match, tmp: StampList;
  BEGIN
    Out (s, "version stamp mismatch: ", vs.symbol.text, "\n");
    WHILE (stamps # NIL) DO
      new := NIL;  match := NIL;
      WHILE (stamps # NIL) DO
        tmp := stamps.next;
        IF (match = NIL) OR (stamps.vs.stamp = match.vs.stamp)
          THEN stamps.next := match; match := stamps;
          ELSE stamps.next := new;   new   := stamps;
        END;
        stamps := tmp;
      END;
      DumpStampList (s, match);
      stamps := new;
    END;
  END BadStamps;

PROCEDURE DumpStampList (VAR s: State;  x: StampList) =
  VAR width := 999999;  name: TEXT;  len: INTEGER;
  BEGIN
    OutX (s, x.vs.stamp);
    WHILE (x # NIL) DO
      name := UnitName (x.unit);
      len  := Text.Length (name);
      IF (width + len > Margin) THEN Out (s, "\n     ");  width := 5 END;
      Out (s, name, "  "); INC (width, len + 2);
      x := x.next;
    END;
    Out (s, "\n");
  END DumpStampList;

PROCEDURE MultipleDefn (VAR s: State;  vs: VersionStamp) =
  VAR x := FindStamps (s, vs);
  BEGIN
    Out (s, "version stamp multiply defined: ", vs.symbol.text, ":\n");
    WHILE (x # NIL) DO
      IF (x.vs.export) THEN
        OutX (s, x.vs.stamp);
        Out  (s, " in ", UnitName (x.unit), "\n");
      END;
      x := x.next;
    END;
  END MultipleDefn;

PROCEDURE FindStamps (VAR s: State;  vs: VersionStamp): StampList =
  VAR x: UnitList;  u: Unit;  z: VersionStamp;  match: StampList := NIL;
  BEGIN
    x := s.all_units;
    WHILE (x # NIL) DO
      u := x.unit;

      z := u.imported_symbols;
      WHILE (z # NIL) DO
        IF Text.Equal (z.symbol.text, vs.symbol.text) THEN
          match := NEW (StampList, vs := z, next := match, unit := u);
        END;
        z := z.next;
      END;

      z := u.exported_symbols;
      WHILE (z # NIL) DO
        IF Text.Equal (z.symbol.text, vs.symbol.text) THEN
          match := NEW (StampList, vs := z, next := match, unit := u);
        END;
        z := z.next;
      END;

      x := x.next;
    END;
    RETURN match;
  END FindStamps;

(*------------------------------------------------------------------------*)

PROCEDURE CheckRevelations (VAR s: State;  r: Revelation;
                             dump_errs: BOOLEAN) =
  VAR
    v: Unit;
    rr, ss: Revelation;
    x: RevelationList;
    rn: RevelationNode;
  BEGIN
    (* first, make sure that anyone importing from me got the right stuff *)
    IF (s.unit.interface) THEN
      x := M3LinkMap.Get (s.revelations, s.unit.name);
      IF (x # NIL) THEN (* somebody imported something *)
        rn := x.revealed;
        WHILE (rn # NIL) DO (* for each imported revelation *)
          ss := rn.revelation;
          rr := r;
          LOOP (* for each of my revelations *)
            IF (rr = NIL) THEN (* we didn't find a match *)
              MissingRevelation (s, ss, dump_errs);
              EXIT;
            END;
            IF (rr.export) AND RevelationEQ (rr, ss) THEN EXIT END;
            rr := rr.next;
          END;
          rn := rn.next;
        END;
      END;
    END;

    (* then, see if everything I import is consistent *)
    rr := r;
    WHILE (rr # NIL) DO
      IF (NOT rr.export) THEN
        v := M3LinkMap.Get (s.interfaces, rr.unit);
        IF (v # NIL) THEN (* the exporter is already defined *)
          x := M3LinkMap.Get (s.revelations, rr.unit);
          IF (x = NIL) THEN (* but, it doesn't export any revelations *)
            MissingRevelation (s, rr, dump_errs);
          ELSE (* search for the matching revelation *)
            rn := x.revealed;
            LOOP
              IF (rn = NIL) THEN
                MissingRevelation (s, rr, dump_errs);
                EXIT;
              END;
              ss := rn.revelation;
              IF (ss.export) AND RevelationEQ (rr, ss) THEN EXIT END;
              rn := rn.next;
            END;
          END;
        END;
      END;
      rr := rr.next;
    END;
  END CheckRevelations;

PROCEDURE RevelationEQ (a, b: Revelation): BOOLEAN =
  BEGIN
    RETURN (a.partial = b.partial)
       AND Text.Equal (a.lhs.text, b.lhs.text)
       AND Text.Equal (a.rhs.text, b.rhs.text);
  END RevelationEQ;

PROCEDURE MissingRevelation (VAR s: State;  r: Revelation;  dump: BOOLEAN) =
  CONST op = ARRAY BOOLEAN OF TEXT { " = ", " <: " };
  BEGIN
    s.failed := TRUE;
    IF dump THEN
      Out (s, UnitName (s.unit), ": missing imported revelation: ");
      Out (s, r.lhs.text, op[r.partial], r.rhs.text);
      Out (s, " from ", r.unit.text, ".i3\n");
    END;
  END MissingRevelation;

(*------------------------------------------------------------------------*)

PROCEDURE AddRevelations (VAR s: State;  r: Revelation) =
  VAR
    rr, ss: Revelation;
    x: RevelationList;
    rn: RevelationNode;
  BEGIN
    IF (r = NIL) THEN RETURN END;

    IF (s.unit.interface) THEN
      x := M3LinkMap.Get (s.revelations, s.unit.name);
      IF (x = NIL) THEN (* there's no import list yet *)
        x := NEW (RevelationList, unit := s.unit.name, revealed := NIL);
        M3LinkMap.Insert (s.revelations, x.unit, x);
      ELSE (* somebody's already importing some of my revelations *)
        (* upgrade them... *)
        rn := x.revealed;
        WHILE (rn # NIL) DO (* for each imported revelation *)
          ss := rn.revelation;
          rr := r;
          WHILE NOT (rr.export AND RevelationEQ (rr, ss)) DO rr := rr.next END;
          rn.revelation := rr;
          rn := rn.next;
        END;
      END;
    END;

    (* finally, add all revelations from interfaces and all imported
       revelations from modules to the table *)
    rr := r;
    WHILE (rr # NIL) DO
      IF (s.unit.interface) OR (NOT rr.export) THEN
        x := M3LinkMap.Get (s.revelations, rr.unit);
        IF (x = NIL) THEN
          x := NEW (RevelationList, unit := rr.unit, revealed := NIL);
          M3LinkMap.Insert (s.revelations, x.unit, x);
        END;

        (* search for the matching revelation *)
        rn := x.revealed;
        LOOP
          IF (rn = NIL) THEN
            (* this is a new revelation *)
            x.revealed := NEW (RevelationNode, next:=x.revealed, revelation:=rr);
            EXIT;
          END;
          IF RevelationEQ (rr, rn.revelation) THEN EXIT END;
          rn := rn.next;
        END;
      END;
      rr := rr.next;
    END;
  END AddRevelations;

(*------------------------------------------------------------------------*)

PROCEDURE OutX (VAR s: State;  READONLY x: StampData) =
  BEGIN
    IF (s.errors = NIL) THEN RETURN END;
    Wr.PutText (s.errors, "  <");
    WriteStamp (s.errors, x);
    Wr.PutText (s.errors, ">");
  END OutX;

PROCEDURE Out (VAR s: State;  a, b, c, d: TEXT := NIL) =
  BEGIN
    IF (s.errors = NIL) THEN RETURN END;
    IF (a # NIL) THEN Wr.PutText (s.errors, a); END;
    IF (b # NIL) THEN Wr.PutText (s.errors, b); END;
    IF (c # NIL) THEN Wr.PutText (s.errors, c); END;
    IF (d # NIL) THEN Wr.PutText (s.errors, d); END;
  END Out;

BEGIN
END M3LinkerChk.