File: Constant.m3 Last Modified On Tue Feb 28 16:58:43 PST 1995 By kalsow
MODULE; 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; REVEAL T = Value.T BRANDED "Constant.T" OBJECT tipe : Type.T; value : Expr.T; offset : INTEGER; coffset : INTEGER; calign : 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 Constant ParseDecl (READONLY att: Decl.Attributes) = TYPE TK = Token.T; VAR t: T; id: M3ID.T; BEGIN 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; PROCEDURECreate (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.coffset := 0; t.calign := 0; t.explicit := FALSE; t.gen_init := FALSE; RETURN t; END Create; PROCEDUREDeclare (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; PROCEDURETypeOf (t: T): Type.T = BEGIN IF (t.tipe = NIL) THEN t.tipe := Expr.TypeOf (t.value) END; RETURN t.tipe; END TypeOf; PROCEDURECheck (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; PROCEDURESetGlobals (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.calign := align; t.coffset := Module.Allocate (size, align, TRUE, "constant ", id := t.name); t.offset := Module.Allocate (Target.Address.size, Target.Address.align, FALSE, "constant", id := t.name); END SetGlobals; PROCEDURELoad (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); IF (t.imported) THEN Module.LoadGlobalAddr (Scope.ToUnit (t), t.offset, is_const := FALSE); CG.Load_indirect (CG.Type.Addr, 0, Target.Address.size); CG.Boost_alignment (t.calign); ELSE Module.LoadGlobalAddr (Scope.ToUnit (t), t.coffset, is_const := TRUE); END; ELSE Expr.Prep (t.value); Expr.Compile (t.value); END; END Load; PROCEDUREDeclarer (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, Target.Address.size, CG.Declare_indirect (type), is_const := FALSE); CG.Declare_global_field (t.name, t.coffset, size, type, is_const := TRUE); t.gen_init := TRUE; END; RETURN TRUE; END Declarer; PROCEDUREConstInit (t: T) = BEGIN IF t.gen_init THEN t.gen_init := FALSE; CG.Comment (t.offset, FALSE, "constant ", M3ID.ToText (t.name)); CG.Init_var (t.offset, Module.GlobalData (TRUE), t.coffset, FALSE); CG.Comment (t.coffset, TRUE, "constant ", M3ID.ToText (t.name)); Expr.PrepLiteral (t.value, t.tipe, TRUE); Expr.GenLiteral (t.value, t.coffset, t.tipe, TRUE); END; END ConstInit; PROCEDUREToExpr (t: T): Expr.T = BEGIN RETURN t.value; END ToExpr; PROCEDUREAddFPTag (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.