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

(* File: Variable.m3                                           *)
(* Last Modified On Tue May 15 06:29:31 1990 By muller         *)
(*      Modified On Wed Feb 14 09:25:02 1990 By kalsow         *)

MODULE Variable;

IMPORT Value, ValueRep, String, Type, Expr, Error, Emit;
IMPORT Scope, Stmt, AssignStmt, NamedExpr, Formal, Temp;
IMPORT ArrayType, Target, Token, Void, Ident, Wr, Module;
IMPORT LongrealExpr, QualifyExpr, Decl, ProcType, Host;
FROM Scanner IMPORT GetToken, Fail, Match, MatchID, cur;

REVEAL
  T = Value.T BRANDED OBJECT
        tipe     : Type.T;
        indirect : BOOLEAN;
        init     : Expr.T;
        sibling  : T;
        formal   : Value.T;
        alias    : T;
        root     : BOOLEAN;
	initStmt : Stmt.T;
	initDone : BOOLEAN;
	initZero : BOOLEAN;
	initID   : INTEGER;
	minValue : INTEGER;
	maxValue : INTEGER;
        canBeOpenArray : BOOLEAN;
      METHODS
        bind        := Bind;
        typeCheck   := Check;
        declare0    := Declare;
        declare1    := Init;
        declare2    := UserInit;
	class       := MyClass;
        fingerprint := FPrinter;
        load        := Load;
        write       := Write;
        select      := ValueRep.NoDuplicates;
        needsDecl   := ValueRep.Always;
	toExpr      := ValueRep.NoExpr;
	toType      := ValueRep.NoType;
      END;

VAR
  nextInitID : INTEGER := 0;
  Star: String.T;

PROCEDURE ParseDecl (READONLY fail: Token.Set; att: Decl.Attributes) =
  VAR
    t: T;
    type: Type.T;
    expr: Expr.T;
    j, n: INTEGER;
  BEGIN
    IF att.isInline THEN Error.Msg ("a variable cannot be inline"); END;

    Match (Token.T.tVAR, fail, Token.Set {Token.T.tIDENT});
    WHILE (cur.token = Token.T.tIDENT) DO
      n := Ident.ParseList (fail + Token.Set {Token.T.tCOLON, Token.T.tASSIGN,
                                            Token.T.tSEMI} + Token.ExprStart);
      type := NIL;
      expr := NIL;
      IF (cur.token = Token.T.tCOLON) THEN
        GetToken (); (* : *)
        type := Type.Parse (fail + Token.Set {Token.T.tASSIGN, Token.T.tSEMI}
                                                + Token.ExprStart);
      END;
      IF (cur.token = Token.T.tASSIGN) THEN
        GetToken (); (* := *)
        expr := Expr.Parse (fail + Token.Set {Token.T.tSEMI});
      END;
      IF (expr = NIL) AND (type = NIL) THEN
        Error.Msg("variable declaration must include a type or initial value");
      END;
      IF att.isExternal AND att.alias # NIL AND n > 1 THEN
        Error.WarnStr (2, att.alias,
                       "EXTERNAL alias applies to first variable");
      END;
      j := Ident.top - n;
      FOR i := 0 TO n - 1 DO
        t := New (Ident.stack[j + i], FALSE);
        t.origin   := Ident.offset[j + i];
	t.external := att.isExternal;
        t.unused   := att.isUnused;
        t.obsolete := att.isObsolete;
        t.tipe     := type;
        t.init     := expr;
	IF (att.isExternal) THEN
	  IF (att.alias # NIL)
	    THEN t.extName := att.alias;  att.alias := NIL;
	    ELSE t.extName := t.name;
	  END;
	END;
        Scope.Insert (t);
      END;
      DEC (Ident.top, n);
      Match (Token.T.tSEMI, fail, Token.Set {});
    END;
  END ParseDecl;

PROCEDURE New (name: String.T;  used: BOOLEAN): T =
  VAR t: T;
  BEGIN
    t := NEW (T);
    ValueRep.Init (t, name);
    t.used     := used;
    t.tipe     := NIL;
    t.init     := NIL;
    t.readonly := FALSE;
    t.indirect := FALSE;
    t.formal   := NIL;
    t.alias    := NIL;
    t.root     := TRUE;
    t.inFrame  := FALSE;
    t.extName  := NIL;
    t.initStmt := NIL;
    t.initDone := FALSE;
    t.initZero := FALSE;
    t.initID   := -1;
    t.minValue := FIRST (INTEGER);
    t.maxValue := LAST (INTEGER);
    RETURN t;
  END New;

PROCEDURE NewFormal (formal: Value.T): T =
  VAR t: T;  mode: Formal.Mode;  offset: INTEGER;
      default: Expr.T;  unused: BOOLEAN;
  BEGIN
    t := New (formal.name, FALSE);
    VAR b: BOOLEAN := Formal.Split (formal, offset, mode, t.tipe,
                                    default, unused);
    BEGIN <* ASSERT b *> END;
    t.origin   := formal.origin;
    t.indirect := (mode # Formal.Mode.mVALUE);
    t.readonly := (mode = Formal.Mode.mCONST);
    t.formal   := formal;
    t.unused   := unused;
    t.initDone := TRUE;
    RETURN t;
  END NewFormal;

PROCEDURE Split (t: T;  VAR type: Type.T;  VAR indirect, readonly: BOOLEAN) =
  BEGIN
    <* ASSERT t.checked *>
    type     := t.tipe;
    indirect := t.indirect;
    readonly := t.readonly;
  END Split;

PROCEDURE BindType (t: T; type: Type.T; 
                    indirect, readonly, allowOpenArray: BOOLEAN := FALSE) =
  BEGIN
    <* ASSERT t.tipe = NIL OR t.tipe = Void.T *>
    t.tipe     := type;
    t.readonly := readonly;
    t.indirect := indirect;
    t.type     := type;
    t.canBeOpenArray := allowOpenArray;
  END BindType;

PROCEDURE IsFormal (t: T): BOOLEAN =
  BEGIN
    RETURN (t # NIL) AND (t.formal # NIL);
  END IsFormal;

PROCEDURE IsIndirect (t: T): BOOLEAN =
  BEGIN
    RETURN (t # NIL) AND t.indirect;
  END IsIndirect;

PROCEDURE HasClosure (t: T): BOOLEAN =
  BEGIN
    RETURN (t # NIL) AND (t.formal # NIL) AND Formal.HasClosure (t.formal);
  END HasClosure;

PROCEDURE Bind (t: T) =
  BEGIN
    Expr.Bind (t.init);
    Value.Bind (t.formal);
    IF (t.tipe # NIL) THEN
      t.tipe := Type.Bind (t.tipe);
    ELSIF t.init # NIL THEN
      t.tipe := Type.Bind (Expr.TypeOf (t.init));
    ELSIF t.formal # NIL THEN
      t.tipe := Value.TypeOf (t.formal);
    ELSE
      <* ASSERT FALSE *>
    END;
    t.type := t.tipe;
  END Bind;

PROCEDURE Check (t: T) =
  VAR index, elt: Type.T;  v, default: Expr.T;
  BEGIN
    Value.TypeCheck (t.formal);
    Type.Check (t.tipe);
    IF ArrayType.Split (t.tipe, index, elt) AND index = NIL AND
        t.formal = NIL AND NOT t.canBeOpenArray THEN
      Error.Str (t.name, "variable cannot be an open array");
    END;
    IF Type.IsEmpty (t.tipe) THEN
      Error.Str (t.name, "variable has empty type");
    END;
    IF (t.init # NIL) THEN
      t.init := AssignStmt.CheckRHS (t.tipe, t.init);
      default := Expr.ConstValue (t.init);
      IF (default = NIL) THEN
        IF Module.IsInterface () THEN
          Error.Str (t.name, "initial value is not a constant");
	END;
        v := NamedExpr.FromValue (t);
        t.initStmt := AssignStmt.New (v, t.init);
	Stmt.Bind (t.initStmt);
        t.checked := TRUE;
	Stmt.TypeCheck (t.initStmt);
      ELSE
        IF NOT t.indirect THEN
          t.initZero := Expr.IsZeroes (default);
          IF (NOT t.initZero) AND (NOT Scope.OuterMost (t.scope)) AND
             ProcType.LargeResult (t.tipe) THEN
            t.initID := nextInitID; INC (nextInitID);
          END;
        t.init := default;
        END;
      END;
    END;
  END Check;

PROCEDURE LoadName (t: T) =
  BEGIN
    Scope.GenName (t);
  END LoadName;

PROCEDURE Load (t: T): Temp.T =
  BEGIN
    RETURN Temp.FromValue (t, TRUE);
  END Load;

PROCEDURE Write (t: T) =
  BEGIN
    IF (t.indirect)
      THEN Emit.Op ("(*"); LoadName (t); Emit.Op (")");
      ELSE LoadName (t);
    END;
  END Write;

PROCEDURE LoadLValue (t: T) =
  BEGIN
    IF (t.indirect)
      THEN LoadName (t);
      ELSE Emit.Op ("(& "); LoadName (t); Emit.Op (")");
    END;
  END LoadLValue;

PROCEDURE SetBounds (t: T;  min, max: INTEGER) =
  BEGIN
    t.minValue := min;
    t.maxValue := max;
  END SetBounds;

PROCEDURE GetBounds (t: T;  VAR min, max: INTEGER) =
  VAR a, b: INTEGER;
  BEGIN
    Type.GetBounds (t.tipe, a, b);
    min := MAX (a, t.minValue);
    max := MIN (b, t.maxValue);
  END GetBounds;

PROCEDURE MyClass (<*UNUSED*> t: T): Value.Class =
  BEGIN
    RETURN Value.Class.Var;
  END MyClass;

PROCEDURE DeclareType (t: T) =
  BEGIN
    Emit.OpI ("t@ ", Type.Name (t.tipe));
    IF (t.indirect) THEN Emit.Op ("* ") END;
  END DeclareType;

PROCEDURE Declare (t: T): BOOLEAN =
  BEGIN
    IF t.initID # -1 THEN
      Emit.OpII ("PRIVATE t@ init@ = ", Type.Name (t.tipe), t.initID);
      Expr.GenLiteral (Expr.ConstValue (t.init));
      Emit.Op   (";\n");
    END;

    Value.GenStorageClass (t);
    DeclareType (t);
    Emit.OpN ("@", t);
    Emit.Op (";\n");
    RETURN TRUE;
  END Declare;

PROCEDURE Init (t: T) =
  VAR p: String.Stack;
  BEGIN
    IF NOT t.initDone AND NOT t.indirect AND NOT t.imported THEN
      p.top := 0;
      Scope.NameToPrefix (t, p);
      Type.InitVariable (t.tipe, FALSE, p);
    END;
  END Init;

PROCEDURE UserInit  (t: T) =
  VAR x: Temp.T;
  BEGIN
    IF (t.init # NIL) AND (NOT t.initDone) AND NOT t.imported THEN
      IF (t.initStmt # NIL) THEN
        EVAL Stmt.Compile (t.initStmt);
      ELSIF (t.initZero) THEN
        Emit.ZeroL (Type.Size (t.tipe) DIV Target.CHARSIZE, "@", t);
      ELSIF (t.initID >= 0) THEN
        Emit.OpI ("COPY (& init@, ", t.initID);
	LoadLValue (t);
	Emit.OpI (", @);\n", Type.Size (t.tipe) DIV Target.CHARSIZE);
      ELSE
        x := Expr.Compile (t.init);
        LoadName (t);
        Emit.Op (" = ");
        IF (t.indirect) THEN Emit.Op ("& ") END;
        Emit.OpT ("@;\n", x);
        Temp.Free (x);
      END;
      t.initDone := TRUE;
    END;
  END UserInit;

PROCEDURE GenGlobalMap (module: String.T;  interface: BOOLEAN;  s: Scope.T) =
  (* generate the garbage collector's map-proc for the variables of s *)
  VAR vars: Scope.ValueList; prefix: String.Stack;  header: BOOLEAN := FALSE;
      cnt: INTEGER;
  BEGIN
    Scope.ToList (s, vars, cnt);
    FOR i := 0 TO cnt - 1 DO
      TYPECASE vars[i] OF
      | NULL =>  (* do nothing *)
      | T(t) =>
        IF (NOT t.imported) AND Type.IsTraced (t.tipe) THEN
          <* ASSERT t.formal = NIL AND t.indirect = FALSE *>

          IF (NOT header) THEN
            Temp.PushSet ();
	    IF (interface) THEN
              IF Host.incrementalVersion = 0 THEN
                Emit.OpS ("EXPORT void (*@__IMap_relay) () = 0;\n", module);
              ELSIF Host.incrementalVersion > 0 THEN
                Emit.OpS ("IMPORT void (*@__IMap_relay) ();\n", module);
              END;
	      Emit.OpS ("\nvoid @__IMap (p)\n", module);
            ELSE
              IF Host.incrementalVersion = 0 THEN
                Emit.OpS ("EXPORT void (*@__MMap_relay) () = 0;\n", module);
                Emit.OpS ("\nvoid @__MMap (p)\n", module);
              ELSIF Host.incrementalVersion > 0 THEN
                Emit.OpS ("IMPORT void (*@__MMap_relay) ();\n", module);
                Emit.OpS ("\nPRIVATE void @__MMap (p)\n", module);
              ELSE
                Emit.OpS ("\nvoid @__MMap (p)\n", module);
              END;
            END;
            Emit.Op  ("void (*p) ();\n");
            Emit.Op  ("{\001\n");
            Emit.Op  ("ADDRESS r = NIL;\n");
            Emit.Op  ("ADDRESS c = NIL;\n");
            IF Host.incrementalVersion = 0 THEN
              IF interface THEN
                Emit.OpSS ("if (@__IMap_relay != 0) { @__IMap_relay (p); };\n",
                           module, module);
              ELSE
                Emit.OpSS ("if (@__MMap_relay != 0) { @__MMap_relay (p); };\n",
                           module, module);
              END;
            END;

            Emit.Op  ("CHECKSTACKOVERFLOW;\n");
            header := TRUE;
          END;
          prefix.top := 0;
          Scope.NameToPrefix (t, prefix);
          Type.GenMap (t.tipe, prefix);
        END;
      ELSE (* do nothing *)
      END;
    END;

    IF (header) THEN
      Emit.Op ("\002};\n\n");
      Temp.PopSet ();
    END;
  END GenGlobalMap;

PROCEDURE InitGlobal (<*UNUSED*> module: String.T; t: T) =
  VAR prefix: String.Stack;
  BEGIN
    IF (NOT t.initDone) AND (NOT t.external) THEN
      prefix.top := 0;
      Scope.NameToPrefix (t, prefix);
      Type.InitVariable (t.tipe, (* TRUE *) FALSE, prefix);
    END;
  END InitGlobal;

PROCEDURE FPrinter (t: T;  map: Type.Map;  wr: Wr.T) =
  VAR s: String.Stack;
  BEGIN
    Wr.PutText (wr, "VAR ");
    s.top := 0;
    Scope.NameToPrefix (t, s, FALSE);
    String.PutStack (wr, s);
    Wr.PutText (wr, " ");
    Type.Fingerprint (t.tipe, map, wr);
  END FPrinter;

PROCEDURE Initialize () =
  BEGIN
    Star := String.Add ("*");
  END Initialize;

BEGIN
END Variable.