Copyright (C) 1994, Digital Equipment Corp.File: DerefExpr.m3
MODULE; IMPORT Expr, ExprRep, RefType, Error, Type; IMPORT NilChkExpr, CG, ErrType; TYPE P = ExprRep.Ta BRANDED "DerefExpr.P" OBJECT OVERRIDES typeOf := TypeOf; check := Check; need_addr := NeedsAddress; prep := Prep; compile := Compile; prepLV := Prep; compileLV := CompileLV; prepBR := ExprRep.PrepNoBranch; compileBR := ExprRep.NoBranch; evaluate := ExprRep.NoValue; isEqual := ExprRep.EqCheckA; getBounds := ExprRep.NoBounds; isWritable := ExprRep.IsAlways; isDesignator := ExprRep.IsAlways; isZeroes := ExprRep.IsNever; genFPLiteral := ExprRep.NoFPLiteral; prepLiteral := ExprRep.NoPrepLiteral; genLiteral := ExprRep.NoLiteral; note_write := NoteWrites; END; PROCEDURE DerefExpr New (a: Expr.T): Expr.T = VAR p: P; BEGIN p := NEW (P); ExprRep.Init (p); p.a := NilChkExpr.New (a); p.origin := p.a.origin; RETURN p; END New; PROCEDURESetOffset (e: Expr.T; n: INTEGER) = BEGIN TYPECASE e OF | NULL => (* nothing *) | P(p) => NilChkExpr.SetOffset (p.a, n); ELSE (* nothing *) END; END SetOffset; PROCEDURETypeOf (p: P): Type.T = VAR ta, target: Type.T; BEGIN ta := Expr.TypeOf (p.a); IF RefType.Split (ta, target) THEN RETURN target; ELSE RETURN ErrType.T; END; END TypeOf; PROCEDURECheck (p: P; VAR cs: Expr.CheckState) = VAR ta, target: Type.T; BEGIN Expr.TypeCheck (p.a, cs); ta := Type.Base (Expr.TypeOf (p.a)); target := NIL; IF (ta = ErrType.T) THEN (* already an error, don't generate any more *) target := ErrType.T; ELSIF NOT RefType.Split (ta, target) THEN Error.Msg ("cannot dereference a non-REF value"); target := ErrType.T; ELSIF (target = NIL) THEN Error.Msg ("cannot dereference REFANY, ADDRESS, or NULL"); target := ErrType.T; END; p.type := target; END Check; PROCEDURENeedsAddress (<*UNUSED*> p: P) = BEGIN (* ok *) END NeedsAddress; PROCEDUREPrep (p: P) = BEGIN Expr.Prep (p.a); END Prep; PROCEDURECompile (p: P) = VAR t := p.type; info: Type.Info; BEGIN Expr.Compile (p.a); EVAL Type.CheckInfo (t, info); CG.Force (); (*'cause alignment applies to the referent, not the pointer*) CG.Boost_alignment (info.alignment); Type.LoadScalar (t); END Compile; PROCEDURECompileLV (p: P) = VAR info: Type.Info; BEGIN Expr.Compile (p.a); EVAL Type.CheckInfo (p.type, info); CG.Force (); (*'cause alignment applies to the referent, not the pointer*) CG.Boost_alignment (info.alignment); END CompileLV; PROCEDURENoteWrites (p: P) = BEGIN Expr.NoteWrite (p.a); END NoteWrites; BEGIN END DerefExpr.