Copyright (C) 1994, Digital Equipment Corp.
File: Variable.m3
Last Modified On Tue Jun 20 09:58:08 PDT 1995 By kalsow
Modified On Thu Jun 15 12:45:02 PDT 1995 By ericv
Modified On Thu Dec 5 17:21:40 PST 1991 By muller
MODULE Variable;
IMPORT M3, M3ID, CG, Value, ValueRep, Type, Expr, Error, Runtime;
IMPORT Scope, AssignStmt, Formal, M3RT, IntegerExpr, TipeMap, M3String;
IMPORT OpenArrayType, Target, TInt, Token, Ident, Module, CallExpr;
IMPORT Decl, Null, Int, Fmt, Procedure, Tracer, TextExpr, NamedExpr;
FROM Scanner IMPORT GetToken, Match, cur;
CONST
Big_Local = 8192; (* x Target.Char.size *)
Big_Param = 8; (* x Target.Integer.size *)
Max_zero_global = 64; (* x Target.Integer.size *)
REVEAL
T = Value.T BRANDED "Variable.T" OBJECT
tipe : Type.T;
init : Expr.T;
sibling : T;
formal : Value.T;
alias : T;
trace : Tracer.T;
bounds : BoundPair;
cg_var : CG.Var;
bss_var : CG.Var;
init_var : INTEGER;
offset : INTEGER;
size : INTEGER;
align : AlignVal;
cg_align : AlignVal;
mem_type : BITS 4 FOR CG.Type;
stk_type : BITS 4 FOR CG.Type;
indirect : M3.Flag;
open_ok : M3.Flag;
need_addr : M3.Flag;
no_type : M3.Flag;
global : M3.Flag;
initDone : M3.Flag;
initZero : M3.Flag;
initPending : M3.Flag;
initStatic : M3.Flag;
OVERRIDES
typeCheck := Check;
set_globals := SetGlobals;
load := Load;
declare := Declare;
const_init := ConstInit;
need_init := NeedInit;
lang_init := LangInit;
user_init := UserInit;
toExpr := ValueRep.NoExpr;
toType := ValueRep.NoType;
typeOf := TypeOf;
base := ValueRep.Self;
add_fp_tag := AddFPTag;
fp_type := TypeOf;
END;
TYPE
AlignVal = [0..255];
TYPE
BoundPair = REF RECORD
min : Target.Int;
max : Target.Int;
END;
PROCEDURE ParseDecl (READONLY att: Decl.Attributes) =
TYPE TK = Token.T;
VAR
t : T;
type : Type.T;
expr : Expr.T;
j, n : INTEGER;
trace : Tracer.T;
alias : M3ID.T;
BEGIN
IF att.isInline THEN Error.Msg ("a variable cannot be inline"); END;
Match (TK.tVAR);
WHILE (cur.token = TK.tIDENT) DO
n := Ident.ParseList ();
type := NIL;
expr := NIL;
IF (cur.token = TK.tCOLON) THEN
GetToken (); (* : *)
type := Type.Parse ();
END;
IF (cur.token = TK.tEQUAL) THEN
Error.Msg ("variable initialization must begin with ':='");
cur.token := TK.tASSIGN;
END;
IF (cur.token = TK.tASSIGN) THEN
GetToken (); (* := *)
expr := Expr.Parse ();
END;
trace := ParseTrace ();
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 # M3ID.NoID AND n > 1 THEN
Error.WarnID (2, att.alias,
"EXTERNAL alias applies to first variable");
END;
alias := att.alias;
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 (alias # M3ID.NoID)
THEN t.extName := alias; alias := M3ID.NoID;
ELSE t.extName := t.name;
END;
END;
Scope.Insert (t);
BindTrace (t, trace);
END;
DEC (Ident.top, n);
Match (TK.tSEMI);
END;
END ParseDecl;
PROCEDURE New (name: M3ID.T; used: BOOLEAN): T =
VAR t: T;
BEGIN
t := NEW (T);
ValueRep.Init (t, name, Value.Class.Var);
t.used := used;
t.tipe := NIL;
t.init := NIL;
t.readonly := FALSE;
t.indirect := FALSE;
t.global := FALSE;
t.formal := NIL;
t.alias := NIL;
t.extName := M3ID.NoID;
t.open_ok := FALSE;
t.need_addr := FALSE;
t.no_type := FALSE;
t.initDone := FALSE;
t.initZero := FALSE;
t.initPending := FALSE;
t.initStatic := FALSE;
t.bounds := NIL;
t.cg_align := 0;
t.cg_var := NIL;
t.bss_var := NIL;
t.init_var := 0;
t.offset := 0;
t.size := 0;
t.align := 0;
t.mem_type := CG.Type.Void;
t.stk_type := CG.Type.Void;
t.trace := NIL;
RETURN t;
END New;
PROCEDURE NewFormal (formal: Value.T; name: M3ID.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;
t.imported := FALSE; (* in spite of Module.depth *)
IF (NOT t.indirect) AND (OpenArrayType.Is (t.tipe)) THEN
t.indirect := TRUE;
END;
t.trace := NIL; (* the caller must call BindTrace after the variable
is inserted into a scope *)
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, open_array_ok, needs_init: BOOLEAN) =
BEGIN
<* ASSERT t.tipe = NIL *>
t.tipe := type;
t.readonly := readonly;
t.indirect := indirect;
t.open_ok := open_array_ok;
IF NOT needs_init THEN t.initDone := TRUE END;
END BindType;
PROCEDURE NeedsAddress (t: T) =
BEGIN
IF (t = NIL) THEN RETURN END;
t.need_addr := TRUE;
END NeedsAddress;
PROCEDURE IsFormal (t: T): BOOLEAN =
BEGIN
RETURN (t # NIL) AND (t.formal # NIL);
END IsFormal;
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.ID (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 dfault: Expr.T; min, max: Target.Int; info: Type.Info; ref: Type.T;
BEGIN
t.tipe := Type.CheckInfo (TypeOf (t), info);
t.size := info.size;
t.align := info.alignment;
t.mem_type := info.mem_type;
t.stk_type := info.stk_type;
IF (info.class = Type.Class.OpenArray)
AND (t.formal = NIL) AND (NOT t.open_ok) THEN
Error.ID (t.name, "variable cannot be an open array");
END;
IF (info.isEmpty) THEN
Error.ID (t.name, "variable has empty type");
END;
IF (t.no_type) AND Type.IsEqual (t.tipe, Null.T, NIL) THEN
Error.WarnID (1, t.name, "variable has type NULL");
END;
t.global := Scope.OuterMost (t.scope);
t.checked := TRUE; (* allow recursions through the init expr *)
IF (NOT t.indirect) AND (NOT t.global) THEN
IF (t.formal # NIL) AND (info.size > Big_Param * Target.Integer.size) THEN
Error.WarnID (1, t.name, "large parameter passed by value ("
& Fmt.Int (info.size DIV Target.Char.size) & " bytes)");
ELSIF (info.size > Big_Local * Target.Char.size) THEN
Error.WarnID (1, t.name, "large local variable ("
& Fmt.Int (info.size DIV Target.Char.size) & " bytes)");
END;
ELSIF (t.formal # NIL) AND (info.class = Type.Class.OpenArray)
AND Formal.RefOpenArray (t.formal, ref) THEN
Error.WarnID (1, t.name, "open array passed by value");
END;
IF Type.IsStructured (t.tipe) THEN
t.need_addr := TRUE; (* every load requires an address *)
END;
Value.TypeCheck (t.formal, cs);
IF (t.external) THEN
IF (t.init # NIL) THEN
Error.Msg ("<*EXTERNAL*> variables cannot be initialized");
Expr.TypeCheck (t.init, cs);
AssignStmt.Check (t.tipe, t.init, cs);
END;
ELSIF (t.init # NIL) THEN
Expr.TypeCheck (t.init, cs);
AssignStmt.Check (t.tipe, t.init, cs);
dfault := Expr.ConstValue (t.init);
IF (dfault = NIL) THEN
IF Module.IsInterface () THEN
Error.ID (t.name, "initial value is not a constant");
END;
IF (t.global) AND (info.size > Max_zero_global * Target.Integer.size) THEN
<*ASSERT NOT t.indirect*>
t.indirect := TRUE;
END;
ELSE (* initialize the variable to an explicit constant *)
IF NOT t.indirect THEN
t.initZero := Expr.IsZeroes (dfault);
IF (t.global) THEN
IF (t.initZero) THEN
t.initDone := TRUE;
IF (info.size > Max_zero_global * Target.Integer.size) THEN
<*ASSERT NOT t.indirect*>
t.indirect := TRUE;
END;
END;
ELSIF (NOT t.initZero) AND Type.IsStructured (t.tipe) THEN
t.initStatic := TRUE;
END;
t.init := dfault;
END;
END;
ELSIF (t.global) THEN
(* no explict initialization is given, but the var is global *)
IF Type.InitCost (t.tipe, TRUE) <= 0 THEN
IF (info.size > Max_zero_global * Target.Integer.size) THEN
<*ASSERT NOT t.indirect*>
t.indirect := TRUE;
END;
t.initDone := TRUE;
ELSIF Type.GetBounds (t.tipe, min, max) THEN
(* synthesize an initialization expression *)
t.init := IntegerExpr.New (min);
END;
END;
CheckTrace (t.trace, cs);
END Check;
PROCEDURE Load (t: T) =
VAR v: CG.Var; align: INTEGER;
BEGIN
t.used := TRUE;
Value.Declare (t);
IF (t.initPending) THEN ForceInit (t); END;
v := t.cg_var;
align := t.cg_align;
IF (v = NIL) THEN v := Scope.ToUnit (t); align := CG.Max_alignment END;
IF Type.IsStructured (t.tipe) THEN
(* the runtime representation is an address *)
IF (t.bss_var # NIL) THEN
CG.Load_addr_of (t.bss_var, 0, align);
ELSIF (t.indirect) THEN
CG.Load_addr (v, t.offset);
CG.Boost_alignment (t.align);
ELSE
CG.Load_addr_of (v, t.offset, align);
END;
ELSE (* simple scalar *)
IF (t.bss_var # NIL) THEN
CG.Load (t.bss_var, 0, t.size, align, t.stk_type);
ELSIF (t.indirect) THEN
CG.Load_addr (v, t.offset);
CG.Boost_alignment (t.align);
CG.Load_indirect (t.stk_type, 0, t.size);
ELSE
CG.Load (v, t.offset, t.size, align, t.stk_type);
END;
END;
END Load;
PROCEDURE LoadLValue (t: T) =
VAR v: CG.Var; align: INTEGER;
BEGIN
t.used := TRUE;
Value.Declare (t);
IF (t.initPending) THEN ForceInit (t); END;
v := t.cg_var;
align := t.cg_align;
IF (v = NIL) THEN v := Scope.ToUnit (t); align := CG.Max_alignment END;
IF (t.bss_var # NIL) THEN
CG.Load_addr_of (t.bss_var, 0, align);
ELSIF (t.indirect) THEN
CG.Load_addr (v, t.offset);
CG.Boost_alignment (t.align);
ELSE
CG.Load_addr_of (v, t.offset, align);
END;
END LoadLValue;
PROCEDURE SetLValue (t: T) =
VAR v: CG.Var; align: INTEGER;
BEGIN
t.used := TRUE;
Value.Declare (t);
IF (t.initPending) THEN t.initPending := FALSE; END;
v := t.cg_var;
align := t.cg_align;
IF (v = NIL) THEN v := Scope.ToUnit (t); align := CG.Max_alignment END;
<*ASSERT t.indirect *>
CG.Boost_alignment (t.align);
CG.Store_addr (v, t.offset);
END SetLValue;
PROCEDURE CGName (t: T; VAR unit: CG.Var; VAR offset: INTEGER) =
BEGIN
t.used := TRUE;
Value.Declare (t);
IF (t.initPending) THEN ForceInit (t); END;
IF (t.cg_var = NIL)
THEN unit := Scope.ToUnit (t); offset := t.offset;
ELSE unit := t.cg_var; offset := 0;
END;
END CGName;
PROCEDURE SetBounds (t: T; READONLY min, max: Target.Int) =
BEGIN
IF (t.bounds = NIL) THEN t.bounds := NEW (BoundPair) END;
t.bounds.min := min;
t.bounds.max := max;
END SetBounds;
PROCEDURE GetBounds (t: T; VAR min, max: Target.Int) =
VAR xx := t.bounds;
BEGIN
EVAL Type.GetBounds (t.tipe, min, max);
IF (xx = NIL) THEN RETURN; END;
IF TInt.LT (min, xx.min) THEN min := xx.min; END;
IF TInt.LT (xx.max, max) THEN max := xx.max; END;
END GetBounds;
PROCEDURE SetGlobals (t: T) =
VAR size, align: INTEGER;
BEGIN
(* Type.SetGlobals (t.tipe); *)
(* IF (t.init # NIL) THEN Type.SetGlobals (Expr.TypeOf (t.init)) END; *)
IF (t.offset # 0) OR (NOT t.global) OR (t.external) THEN RETURN END;
EVAL Type.Check (t.tipe);
IF (t.indirect) THEN
size := Target.Address.size;
align := Target.Address.align;
ELSIF OpenArrayType.Is (t.tipe) THEN
align := MAX (Target.Address.align, Target.Integer.align);
size := Target.Address.pack
+ OpenArrayType.OpenDepth(t.tipe) * Target.Integer.pack;
ELSE
size := t.size;
align := t.align;
END;
(* declare the actual variable *)
t.offset := Module.Allocate (size, align, id := t.name);
END SetGlobals;
PROCEDURE Declare (t: T): BOOLEAN =
VAR
size := t.size;
align := t.align;
type := Type.GlobalUID (t.tipe);
mtype := Type.CGType (t.tipe, in_memory := TRUE);
is_struct := Type.IsStructured (t.tipe);
name : TEXT;
extern_name : M3ID.T;
BEGIN
Type.Compile (t.tipe);
t.cg_var := NIL;
t.bss_var := NIL;
IF (is_struct) THEN mtype := CG.Type.Struct; END;
IF (t.indirect) THEN
type := CG.Declare_indirect (type);
size := Target.Address.size;
align := Target.Address.align;
mtype := CG.Type.Addr;
END;
(* declare the actual variable *)
IF (t.external) THEN
name := Value.GlobalName (t, dots := FALSE, with_module := FALSE);
extern_name := M3ID.Add (name);
t.cg_var := CG.Import_global (extern_name, size, align,
mtype, 0(*no mangling*));
t.cg_align := align;
ELSIF (t.imported) THEN
<*ASSERT t.offset # 0*>
ELSIF (t.global) THEN
<*ASSERT t.offset # 0*>
CG.Declare_global_field (t.name, t.offset, size, type);
IF (t.initZero) THEN t.initDone := TRUE END;
t.cg_align := align;
IF (t.indirect) THEN
t.cg_align := t.align;
t.bss_var := CG.Declare_global (M3ID.NoID, t.size, t.cg_align,
CG.Type.Struct, Type.GlobalUID (t.tipe),
exported := FALSE, init := FALSE);
CG.Init_var (t.offset, t.bss_var, 0);
END;
ELSIF (t.formal = NIL) THEN
(* simple local variable *)
IF (size < 0) THEN
(* it's an open array local introduced by a WITH statement *)
align := MAX (Target.Address.align, Target.Integer.align);
size := Target.Address.pack
+ OpenArrayType.OpenDepth(t.tipe) * Target.Integer.pack;
END;
t.cg_align := align;
t.cg_var := CG.Declare_local (t.name, size, align, mtype, type,
t.need_addr, t.up_level, CG.Maybe);
ELSIF (t.indirect) THEN
(* formal passed by reference => param is an address *)
t.cg_align := align;
t.cg_var := CG.Declare_param (t.name, size, align, mtype, type,
t.need_addr, t.up_level, CG.Maybe);
ELSE
(* simple parameter *)
t.cg_align := align;
t.cg_var := CG.Declare_param (t.name, size, align, mtype, type,
t.need_addr, t.up_level, CG.Maybe);
END;
RETURN TRUE;
END Declare;
PROCEDURE ConstInit (t: T) =
VAR
size := t.size;
align := t.align;
type : INTEGER;
init_expr : Expr.T;
name : TEXT;
init_name : M3ID.T;
BEGIN
IF t.external OR t.imported THEN RETURN END;
IF (NOT t.initStatic) AND (NOT t.global) THEN RETURN END;
type := Type.GlobalUID (t.tipe);
IF (t.indirect) THEN
type := CG.Declare_indirect (type);
size := Target.Address.size;
align := Target.Address.align;
END;
IF (t.initStatic) THEN
(* declare the holder for the initial value *)
name := "_INIT_" & M3ID.ToText (t.name);
init_name := M3ID.Add (name);
t.init_var := Module.Allocate (size, align, "initial value for ",t.name);
CG.Declare_global_field (init_name, t.init_var, size, type);
CG.Comment (t.init_var, "init expr for ", Value.GlobalName(t,TRUE,TRUE));
init_expr := Expr.ConstValue (t.init);
Expr.PrepLiteral (init_expr, t.tipe);
Expr.GenLiteral (init_expr, t.init_var, t.tipe);
END;
IF (t.global) THEN
(* try to statically initialize the variable *)
<*ASSERT t.offset # 0*>
init_expr := NIL;
IF (t.init # NIL) AND (NOT t.initDone) AND (NOT t.initStatic) THEN
init_expr := Expr.ConstValue (t.init);
END;
IF (init_expr # NIL) THEN
Expr.PrepLiteral (init_expr, t.tipe);
Expr.GenLiteral (init_expr, t.offset, t.tipe);
t.initDone := TRUE;
END;
END;
END ConstInit;
PROCEDURE NeedInit (t: T): BOOLEAN =
VAR ref: Type.T;
BEGIN
IF (t.imported) OR (t.external) OR (t.initDone) THEN
RETURN FALSE;
ELSIF (t.formal # NIL) THEN
RETURN (t.indirect) AND Formal.RefOpenArray (t.formal, ref);
ELSIF (t.indirect) AND (NOT t.global) THEN
RETURN FALSE;
ELSIF (t.global) AND (t.init # NIL) AND (NOT t.initStatic)
AND (Expr.ConstValue (t.init) # NIL) THEN
RETURN FALSE;
ELSIF (t.init # NIL) THEN
RETURN TRUE;
ELSE
RETURN Type.InitCost (t.tipe, FALSE) > 0;
END;
END NeedInit;
PROCEDURE LangInit (t: T) =
VAR ref: Type.T;
BEGIN
IF (t.imported) OR (t.external) THEN
t.initDone := TRUE;
ELSIF (t.formal # NIL) THEN
IF (t.indirect) AND Formal.RefOpenArray (t.formal, ref) THEN
(* a by-value open array! *)
CG.Gen_location (t.origin);
CopyOpenArray (t, ref);
END;
(* formal parameters don't need any further initialization *)
Tracer.Schedule (t.trace);
t.initDone := TRUE;
ELSIF (t.indirect) AND (NOT t.global) THEN
(* is a WITH variable bound to a designator *)
Tracer.Schedule (t.trace);
t.initDone := TRUE;
END;
IF (t.initDone) THEN RETURN END;
(* initialize the value *)
IF (t.init # NIL) AND (NOT t.up_level) AND (NOT t.imported) THEN
(* variable has a user specified init value and isn't referenced
by any nested procedures => try to avoid the language defined
init and wait until we get to the user defined initialization. *)
t.initPending := TRUE;
ELSE
IF Type.InitCost (t.tipe, FALSE) > 0 THEN
CG.Gen_location (t.origin);
LoadLValue (t);
Type.InitValue (t.tipe, FALSE);
END;
IF (t.trace # NIL) AND (NOT t.imported) THEN
IF (t.init = NIL) OR (t.initDone) THEN
(* there's no explicit user init => might as well trace it now *)
CG.Gen_location (t.origin);
Tracer.Schedule (t.trace);
END;
END;
END;
END LangInit;
PROCEDURE ForceInit (t: T) =
BEGIN
t.initPending := FALSE;
CG.Gen_location (t.origin);
LoadLValue (t);
Type.InitValue (t.tipe, FALSE);
END ForceInit;
PROCEDURE CopyOpenArray (t: T; ref: Type.T) =
VAR
ptr : CG.Val;
depth := OpenArrayType.OpenDepth (t.tipe);
align := OpenArrayType.EltAlign (t.tipe);
pack := OpenArrayType.EltPack (t.tipe);
sizes := CG.Declare_temp (Target.Address.pack + Target.Integer.pack,
Target.Address.align, CG.Type.Struct,
in_memory := TRUE);
proc : Procedure.T;
BEGIN
(* build the dope vector that describes the array *)
Load (t);
CG.Add_offset (M3RT.OA_sizes);
(*** CG.Check_byte_aligned (); ****)
CG.Store_addr (sizes, M3RT.OA_elt_ptr);
CG.Load_intt (depth);
CG.Store_int (sizes, M3RT.OA_size_0);
(* allocate the storage *)
proc := Runtime.LookUpProc (Runtime.Hook.NewTracedArray);
Procedure.StartCall (proc);
IF Target.DefaultCall.args_left_to_right THEN
Type.LoadInfo (ref, -1);
CG.Pop_param (CG.Type.Addr);
CG.Load_addr_of (sizes, 0, Target.Address.align);
CG.Pop_param (CG.Type.Addr);
ELSE
CG.Load_addr_of (sizes, 0, Target.Address.align);
CG.Pop_param (CG.Type.Addr);
Type.LoadInfo (ref, -1);
CG.Pop_param (CG.Type.Addr);
END;
ptr := Procedure.EmitCall (proc);
(* load the destination and source addresses *)
CG.Push (ptr);
CG.Boost_alignment (t.align);
CG.Open_elt_ptr (align);
CG.Force ();
Load (t);
CG.Open_elt_ptr (align);
CG.Force ();
(* compute the number of elements *)
FOR i := 0 TO depth - 1 DO
Load (t); (* CG.Load_addr (sizes, M3RT.OA_elt_ptr); *)
CG.Open_size (i);
IF (i # 0) THEN CG.Multiply (CG.Type.Word) END;
END;
(* copy the actual argument into the new storage *)
CG.Copy_n (pack, overlap := FALSE);
(* set the formal parameter to refer to the new storage *)
CG.Push (ptr);
CG.Boost_alignment (t.align);
CG.Store_addr (t.cg_var);
(* free our temps *)
CG.Free_temp (sizes);
CG.Free (ptr);
END CopyOpenArray;
PROCEDURE UserInit (t: T) =
BEGIN
IF (t.init # NIL) AND (NOT t.initDone) AND (NOT t.imported) THEN
CG.Gen_location (t.origin);
IF (t.initZero) THEN
t.initPending := FALSE;
LoadLValue (t);
Type.Zero (t.tipe);
ELSIF (t.init_var # 0) THEN
t.initPending := FALSE;
LoadLValue (t);
CG.Load_addr_of (Scope.ToUnit (t), t.init_var, CG.Max_alignment);
CG.Copy (t.size, overlap := FALSE);
ELSE
t.initPending := FALSE;
AssignStmt.PrepForEmit (t.tipe, t.init, initializing := TRUE);
LoadLValue (t);
AssignStmt.Emit (t.tipe, t.init);
END;
t.initDone := TRUE;
Tracer.Schedule (t.trace);
END;
END UserInit;
PROCEDURE GenGlobalMap (s: Scope.T): INTEGER =
(* generate the garbage collector's map-proc for the variables of s *)
VAR started := FALSE; info: Type.Info; v := Scope.ToList (s);
BEGIN
WHILE (v # NIL) DO
TYPECASE Value.Base (v) OF
| NULL => (* do nothing *)
| T(t) => IF (NOT t.imported)
AND (NOT t.external) THEN
EVAL Type.CheckInfo (t.tipe, info);
IF (info.isTraced) THEN
IF (NOT started) THEN
TipeMap.Start ();
started := TRUE;
END;
t.used := TRUE;
Value.Declare (t);
IF (t.indirect) THEN
TipeMap.Add (t.offset, TipeMap.Op.PushPtr, 0);
Type.GenMap (t.tipe, 0, -1, refs_only := TRUE);
TipeMap.Add (t.size, TipeMap.Op.Return, 0);
TipeMap.SetCursor (t.offset + Target.Address.size);
ELSE
Type.GenMap (t.tipe, t.offset, -1, refs_only := TRUE);
END;
END;
END;
ELSE (* do nothing *)
END;
v := v.next;
END;
IF (started)
THEN RETURN TipeMap.Finish ("global type map");
ELSE RETURN -1;
END;
END GenGlobalMap;
PROCEDURE NeedGlobalInit (t: T): BOOLEAN =
BEGIN
RETURN (NOT t.initDone) AND (NOT t.external);
END NeedGlobalInit;
PROCEDURE InitGlobal (t: T) =
BEGIN
IF (NOT t.initDone) AND (NOT t.external) THEN
LoadLValue (t);
Type.InitValue (t.tipe, TRUE);
END;
END InitGlobal;
PROCEDURE AddFPTag (t: T; VAR x: M3.FPInfo): CARDINAL =
BEGIN
ValueRep.FPStart (t, x, "VAR ", t.offset, global := TRUE);
RETURN 1;
END AddFPTag;
--------------------------------------------------------- trace support ---
TYPE TraceNode = Tracer.T OBJECT
handler : Expr.T := NIL;
call : Expr.T := NIL;
OVERRIDES
apply := DoTrace;
END;
PROCEDURE ParseTrace (): Tracer.T =
TYPE TK = Token.T;
VAR e: Expr.T;
BEGIN
IF (cur.token # TK.tTRACE) THEN RETURN NIL END;
Match (TK.tTRACE);
e := Expr.Parse ();
Match (TK.tENDPRAGMA);
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: Scope.IDStack; z: M3String.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.NameToPrefix (t, p, dots := TRUE, with_module := TRUE);
z := M3String.Add (Scope.StackToText (p));
(* 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
Expr.Prep (x.call);
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.