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

(* File: Variable.m3                                           *)
(* Last Modified On Thu Jul  2 07:43:40 PDT 1992 By kalsow     *)
(*      Modified On Thu Dec  5 17:21:40 PST 1991 By muller     *)

MODULE Variable;

IMPORT Value, ValueRep, String, Type, Expr, Error, Emit;
IMPORT Scope, Stmt, AssignStmt, NamedExpr, Formal, Temp;
IMPORT OpenArrayType, Target, Token, Void, Ident, MBuf, Module;
IMPORT Decl, ProcType, Null, Int, Fmt, Frame;
IMPORT TextExpr, CallExpr, Tracer;
FROM Scanner IMPORT GetToken, Match, Match1, cur;

CONST
  Big_Local = 512 * 1024 * Target.CHARSIZE;

REVEAL
  T = Value.T BRANDED "Variable.T" OBJECT
        tipe     : Type.T;
        indirect : BOOLEAN;
        init     : Expr.T;
        sibling  : T;
        formal   : Value.T;
        alias    : T;
        no_type  : BOOLEAN;
	initDone : BOOLEAN;
	initZero : BOOLEAN;
	initStmt : Stmt.T;
	initID   : INTEGER;
	minValue : INTEGER;
	maxValue : INTEGER;
        canBeOpenArray : BOOLEAN;
        trace    : Tracer.T;
      OVERRIDES
        typeCheck   := Check;
        declare0    := Declare;
        declare1    := Init;
        declare2    := UserInit;
	class       := MyClass;
        fingerprint := FPrinter;
        load        := Load;
        write       := Write;
	toExpr      := ValueRep.NoExpr;
	toType      := ValueRep.NoType;
        typeOf      := TypeOf;
      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;
    trace : Tracer.T;
  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.tEQUAL) THEN
        Error.Msg ("variable initialization must begin with ':='");
        cur.token := Token.T.tASSIGN;
      END;
      IF (cur.token = Token.T.tASSIGN) THEN
        GetToken (); (* := *)
        expr := Expr.Parse (fail + Token.Set {Token.T.tSEMI});
      END;
      trace := ParseTrace (fail + Token.Set {Token.T.tSEMI});
      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;
        t.no_type  := (type = NIL);
	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);
        BindTrace (t, trace);
      END;
      DEC (Ident.top, n);
      Match1 (Token.T.tSEMI, fail);
    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.inFrame  := FALSE;
    t.extName  := NIL;
    t.no_type  := FALSE;
    t.initDone := FALSE;
    t.initZero := FALSE;
    t.initStmt := NIL;
    t.initID   := -1;
    t.minValue := FIRST (INTEGER);
    t.maxValue := LAST (INTEGER);
    t.trace    := NIL;
    RETURN t;
  END New;

PROCEDURE NewFormal (formal: Value.T;  name: String.T): T =
  VAR t: T;  f_info: Formal.Info;
  BEGIN
    t := New (name, FALSE);
    Formal.Split (formal, f_info);
    t.formal   := formal;
    t.tipe     := f_info.type;
    t.origin   := formal.origin;
    t.indirect := (f_info.mode # Formal.Mode.mVALUE);
    t.readonly := (f_info.mode = Formal.Mode.mCONST);
    t.unused   := f_info.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.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 TypeOf (t: T): Type.T =
  BEGIN
    IF (t.tipe = NIL) THEN
      IF    (t.init # NIL)   THEN t.tipe := Expr.TypeOf (t.init)
      ELSIF (t.formal # NIL) THEN t.tipe := Value.TypeOf (t.formal)
      ELSE  Error.Str (t.name, "variable has no type");  t.tipe := Int.T;
      END;
    END;
    RETURN t.tipe;
  END TypeOf;

PROCEDURE Check (t: T;  VAR cs: Value.CheckState) =
  VAR v, dfault: Expr.T;
  BEGIN
    Type.Check (TypeOf (t));
    IF OpenArrayType.Is (t.tipe) 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.no_type) AND Type.IsEqual (t.tipe, Null.T, NIL) THEN
      Error.WarnStr (1, t.name, "variable has type NULL"); 
    END;
    t.checked := TRUE; (* allow recursions through the init expr *)

    VAR sz := Type.Size (t.tipe); BEGIN
      IF (sz >= Big_Local) AND (NOT t.indirect)
        AND NOT Scope.OuterMost (t.scope) THEN
        Error.WarnStr (1, t.name, "big local variable ("
                           & Fmt.Int (sz DIV Target.CHARSIZE) & " bytes)");
      END;
    END;

    Value.TypeCheck (t.formal, cs);
    IF (t.init # NIL) THEN
      Expr.TypeCheck (t.init, cs);
      t.init := AssignStmt.CheckRHS (t.tipe, t.init, cs);
      dfault := Expr.ConstValue (t.init);
      IF (dfault = 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);
        t.checked := TRUE;
	Stmt.TypeCheck (t.initStmt, cs);
      ELSE (* initialize the variable to an explicit constant *)
        IF NOT t.indirect THEN
          t.initZero := Expr.IsZeroes (dfault);
          IF (NOT t.initZero) AND (NOT Scope.OuterMost (t.scope)) AND
             ProcType.LargeResult (t.tipe) THEN
            t.initID := nextInitID; INC (nextInitID);
          END;
          t.init := dfault;
        END;
      END;
    ELSIF Scope.OuterMost (t.scope) THEN
      (* no explict initialization is given, but the var is global *)
      IF Type.InitCost (t.tipe, TRUE) <= 0 THEN t.initDone := TRUE END;
    END;

    CheckTrace (t.trace, cs);
  END Check;

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

PROCEDURE Load (t: T): Temp.T =
  BEGIN
    t.used := TRUE;
    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
    t.used := TRUE;
    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
    EVAL 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
    Type.Compile (t.tipe);
    Emit.OpF ("@ ", t.tipe);
    IF (t.indirect) THEN Emit.Op ("* ") END;
  END DeclareType;

PROCEDURE Declare (t: T): BOOLEAN =
  BEGIN
    Type.Compile (t.tipe);
    Frame.NoteDeclaration (t.tipe);

    IF t.initID # -1 THEN
      Emit.OpF ("_PRIVATE @ ", t.tipe);
      Emit.OpI ("_init@ = ", t.initID);
      Expr.GenLiteral (Expr.ConstValue (t.init));
      Emit.Op   (";\n");
    END;

    Value.GenStorageClass (t);
    DeclareType (t);
    Emit.OpN ("@", t);
    IF (t.init = NIL) OR (t.imported) OR (NOT Scope.OuterMost (t.scope)) THEN
      (* do nothing *)
    ELSIF (t.initZero) THEN
      (* ok, globals are already zeroed *)
      t.initDone := TRUE;
    ELSIF (t.initID = -1) THEN
      WITH e = Expr.ConstValue (t.init) DO
        IF (e # NIL) THEN
          Emit.Op (" = ");
          Expr.GenLiteral (e);
          t.initDone := TRUE;
        END;
      END;
    END;
    Emit.Op (";\n");

    RETURN TRUE;
  END Declare;

PROCEDURE Init (t: T) =
  VAR p: String.Stack;
  BEGIN
    IF (t.initDone) OR (t.indirect) OR (t.imported) OR (t.external) THEN
      (* do nothing. *)
    ELSE
      p.top := 0;
      Scope.NameToPrefix (t, p);
      Type.InitVariable (t.tipe, FALSE, p);
    END;
    IF (NOT t.imported) THEN Tracer.Schedule (t.trace) END;
  END Init;

PROCEDURE UserInit  (t: T) =
  VAR x: Temp.T;  p: String.Stack;
  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
        p.top := 0;
        Scope.NameToPrefix (t, p);
        Emit.Zero (t.tipe, p);
      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;
      Tracer.Schedule (t.trace);
    END;
  END UserInit;

PROCEDURE GenGlobalMap (s: Scope.T): BOOLEAN =
  (* generate the garbage collector's map-proc for the variables of s *)
  VAR vars: Scope.ValueList; prefix: String.Stack;  header: BOOLEAN := FALSE;
      cnt: INTEGER;  frame: Frame.T;
  BEGIN
    Scope.ToList (s, vars, cnt);
    FOR i := 0 TO cnt - 1 DO
      TYPECASE Value.Base (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
                     Frame.Push (frame, 5);
                     GenGlobalMapHeader ();
                     header := TRUE;
                   END;
                   prefix.top := 0;
                   Scope.NameToPrefix (t, prefix);
                   Type.GenMap (t.tipe, prefix);
                 END;
      ELSE (* do nothing *)
      END;
    END;
    IF (header) THEN Frame.Pop (frame) END;
    RETURN header;
  END GenGlobalMap;

PROCEDURE GenGlobalMapHeader () =
  BEGIN
    Emit.Op ("\n_LOCAL_PROC _VOID _map_ (_p, _arg, _mask)\n");
    Emit.Op  ("_VOID (*_p) ();\n");
    Emit.Op  ("_ADDRESS _arg;\n");
    Emit.Op  ("_MAPPROC_MASK _mask;\n");
    Emit.Op  ("{\001\n");
    Emit.Op  ("_ADDRESS _r = _NIL;\n");
    Emit.Op  ("_ADDRESS _c = _NIL;\n");
    EVAL Emit.SwitchToBody (); Emit.Op  ("\001");
  END GenGlobalMapHeader;

PROCEDURE InitGlobal (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, prefix);
    END;
  END InitGlobal;

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

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

(*--------------------------------------------------------- trace support ---*)

TYPE TraceNode = Tracer.T OBJECT
                   handler : Expr.T := NIL;
                   call    : Expr.T := NIL;
                 OVERRIDES
                   apply := DoTrace;
                 END;

PROCEDURE ParseTrace (READONLY fail: Token.Set): Tracer.T =
  VAR e: Expr.T;
  BEGIN
    IF (cur.token # Token.T.tTRACE) THEN RETURN NIL END;
    Match1 (Token.T.tTRACE, fail);
    e := Expr.Parse (fail + Token.Set {Token.T.tENDPRAGMA});
    Match1 (Token.T.tENDPRAGMA, fail);
    IF (e = NIL) THEN RETURN NIL END;
    RETURN NEW (TraceNode, handler := e);
  END ParseTrace;

PROCEDURE BindTrace (t: T;  xx: Tracer.T) =
  VAR x: TraceNode := xx;  p: String.Stack;  z: String.T;  args: Expr.List;
  BEGIN
    IF (xx = NIL) THEN RETURN END;

    IF (x.call # NIL) THEN
      x := NEW (TraceNode, handler := x.handler);
    END;

    (* get the variable's full name *)
    p.top := 0;
    Scope.GlobalName (t, p);
    z := p.stk[0];
    FOR i := 1 TO p.top - 1 DO z := String.Concat (z, p.stk[i]) END;

    (* build the trace procedure call *)
    args := NEW (Expr.List, 2);
    args[0] := TextExpr.New (z);
    args[1] := NamedExpr.FromValue (t);
    x.call  := CallExpr.New (x.handler, args);

    <*ASSERT t.trace = NIL*>
    t.trace := x;
  END BindTrace;

PROCEDURE DoTrace (x: TraceNode) =
  BEGIN
    EVAL Expr.Compile (x.call);
  END DoTrace;

PROCEDURE CheckTrace (tt: Tracer.T;  VAR cs: Value.CheckState) =
  VAR x: TraceNode := tt;
  BEGIN
    IF (x # NIL) THEN
      Expr.TypeCheck (x.handler, cs);
      Expr.TypeCheck (x.call, cs);
    END;
  END CheckTrace;

PROCEDURE ScheduleTrace (t: T) =
  BEGIN
    Tracer.Schedule (t.trace);
  END ScheduleTrace;

BEGIN
END Variable.