Copyright (C) 1994, Digital Equipment Corp.
File: Constant.m3
Last Modified On Tue Feb 28 16:58:43 PST 1995 By kalsow
MODULE Constant;
IMPORT M3, M3ID, CG, Value, ValueRep, Type, Expr, Scope, Error;
IMPORT Token, AssignStmt, Scanner, UserProc, Target, M3Buf;
IMPORT Decl, ProcType, Procedure, OpenArrayType, Module, ErrType;
FROM Scanner IMPORT GetToken, Match, MatchID, cur;
TYPE
T = Value.T BRANDED "Constant.T" OBJECT
tipe : Type.T;
value : Expr.T;
offset : INTEGER;
explicit : BOOLEAN;
gen_init : BOOLEAN;
OVERRIDES
typeCheck := Check;
set_globals := SetGlobals;
load := Load;
declare := Declarer;
const_init := ConstInit;
need_init := ValueRep.Never;
lang_init := ValueRep.NoInit;
user_init := ValueRep.NoInit;
toExpr := ToExpr;
toType := ValueRep.NoType;
typeOf := TypeOf;
base := ValueRep.Self;
add_fp_tag := AddFPTag;
fp_type := TypeOf;
END;
PROCEDURE ParseDecl (READONLY att: Decl.Attributes) =
TYPE TK = Token.T;
VAR t: T; id: M3ID.T;
BEGIN
IF att.isInline THEN Error.Msg ("a constant cannot be inline"); END;
IF att.isExternal THEN
Error.Msg ("a constant cannot be external");
ELSIF att.callingConv # NIL THEN
Error.Msg ("a constant does not have a calling convention");
END;
Match (TK.tCONST);
WHILE (cur.token = TK.tIDENT) DO
id := MatchID ();
t := Create (id);
t.unused := att.isUnused;
t.obsolete := att.isObsolete;
IF (cur.token = TK.tCOLON) THEN
GetToken (); (* : *)
t.tipe := Type.Parse ();
END;
Match (TK.tEQUAL);
t.value := Expr.Parse ();
Scope.Insert (t);
Match (TK.tSEMI);
END;
END ParseDecl;
PROCEDURE Create (name: M3ID.T): T =
VAR t: T;
BEGIN
t := NEW (T);
ValueRep.Init (t, name, Value.Class.Expr);
t.readonly := TRUE;
t.tipe := NIL;
t.value := NIL;
t.offset := 0;
t.explicit := FALSE;
t.gen_init := FALSE;
RETURN t;
END Create;
PROCEDURE Declare (name: TEXT; value: Expr.T; reserved: BOOLEAN) =
VAR t: T;
BEGIN
t := Create (M3ID.Add (name));
t.tipe := Expr.TypeOf (value);
t.value := value;
Scope.Insert (t);
IF (reserved) THEN Scanner.NoteReserved (t.name, t) END;
END Declare;
PROCEDURE TypeOf (t: T): Type.T =
BEGIN
IF (t.tipe = NIL) THEN t.tipe := Expr.TypeOf (t.value) END;
RETURN t.tipe;
END TypeOf;
PROCEDURE Check (t: T; VAR cs: Value.CheckState) =
VAR e: Expr.T; proc: Value.T; n_errs0, n_errs1, n_warns: INTEGER;
BEGIN
Error.Count (n_errs0, n_warns);
Expr.TypeCheck (t.value, cs);
t.tipe := Type.Check (TypeOf (t));
Error.Count (n_errs1, n_warns);
IF ProcType.Is (t.tipe)
AND UserProc.IsProcedureLiteral (t.value, proc)
AND Procedure.IsNested (proc) THEN
Error.Msg ("nested procedures are not constants");
END;
IF (t.tipe = ErrType.T) THEN
(* there's no way that we can evaluate the constant *)
t.explicit := FALSE;
IF (n_errs1 <= n_errs0) THEN
(* no error was generated, but we don't have a type! *)
Error.Msg ("value is not a constant expression");
END;
ELSE
AssignStmt.Check (t.tipe, t.value, cs);
e := Expr.ConstValue (t.value);
IF (t.value # NIL) AND (e = NIL)
THEN Error.Msg ("value is not constant");
ELSE t.value := e;
END;
t.explicit := Type.IsStructured (t.tipe);
END;
END Check;
PROCEDURE SetGlobals (t: T) =
VAR size, align, depth: INTEGER; info: Type.Info;
BEGIN
(* Type.SetGlobals (t.tipe); *)
IF (t.offset # 0) OR (NOT t.explicit) THEN RETURN END;
EVAL Type.CheckInfo (t.tipe, info);
size := info.size;
align := info.alignment;
depth := OpenArrayType.OpenDepth (t.tipe);
IF (depth > 0) THEN
(* t.tipe is an open array *)
size := Target.Address.pack + depth * Target.Integer.pack;
align := MAX (Target.Address.align, Target.Integer.align);
END;
t.offset := Module.Allocate (size, align, "constant ", id := t.name);
END SetGlobals;
PROCEDURE Load (t: T) =
Note: because a named constant may be the default value for
a procedure parameter, it is possible for a structured constant
to be used in a compilation unit without anywhere mentioning
its name => its use will not be detected => it won't be
imported => we force the import here by calling Scope.ToUnit.
BEGIN
IF (t.explicit) THEN
SetGlobals (t);
CG.Load_addr_of (Scope.ToUnit (t), t.offset, CG.Max_alignment);
ELSE
Expr.Prep (t.value);
Expr.Compile (t.value);
END;
END Load;
PROCEDURE Declarer (t: T): BOOLEAN =
VAR type: CG.TypeUID; size, depth: INTEGER; info: Type.Info;
BEGIN
IF (t.exported) THEN Type.Compile (t.tipe) END;
IF (NOT t.explicit) THEN RETURN TRUE END;
EVAL Type.CheckInfo (t.tipe, info);
Type.Compile (t.tipe);
type := Type.GlobalUID (t.tipe);
size := info.size;
depth := OpenArrayType.OpenDepth (t.tipe);
IF (depth > 0) THEN
(* t.tipe is an open array *)
size := Target.Address.pack + depth * Target.Integer.pack;
END;
IF (t.imported) THEN
EVAL Scope.ToUnit (t); (* force the module to be imported *)
ELSE
SetGlobals (t);
CG.Declare_global_field (t.name, t.offset, size, type);
t.gen_init := TRUE;
END;
RETURN TRUE;
END Declarer;
PROCEDURE ConstInit (t: T) =
BEGIN
IF t.gen_init THEN
t.gen_init := FALSE;
CG.Comment (t.offset, "constant ", M3ID.ToText (t.name));
Expr.PrepLiteral (t.value, t.tipe);
Expr.GenLiteral (t.value, t.offset, t.tipe);
END;
END ConstInit;
PROCEDURE ToExpr (t: T): Expr.T =
BEGIN
RETURN t.value;
END ToExpr;
PROCEDURE AddFPTag (t: T; VAR x: M3.FPInfo): CARDINAL =
BEGIN
ValueRep.FPStart (t, x, "CONST ", t.offset, global := TRUE);
M3Buf.PutText (x.buf, " = ");
Expr.GenFPLiteral (t.value, x.buf);
RETURN 1;
END AddFPTag;
BEGIN
END Constant.