Copyright (C) 1994, Digital Equipment Corp.
File: Expr.m3
Last Modified On Tue Jun 20 15:44:34 PDT 1995 By kalsow
Modified On Thu Jun 15 13:07:24 PDT 1995 By ericv
Modified On Fri Dec 21 01:21:51 1990 By muller
MODULE Expr EXPORTS Expr, ExprRep;
IMPORT M3, M3Buf, CG, Type, Scanner, ExprParse;
IMPORT Target, TInt, ErrType, Error;
******************************************************************
PROCEDURE Parse (): T =
BEGIN
RETURN ExprParse.E0 (FALSE);
END Parse;
PROCEDURE Init (t: T) =
BEGIN
t.origin := Scanner.offset;
t.type := NIL;
t.checked := FALSE;
t.direct_ok := FALSE;
t.do_direct := FALSE;
END Init;
******************************************************************
PROCEDURE TypeOf (t: T): Type.T =
BEGIN
IF (t = NIL) THEN RETURN ErrType.T END;
IF (t.type = NIL) THEN t.type := t.typeOf () END;
RETURN t.type;
END TypeOf;
PROCEDURE TypeCheck (t: T; VAR cs: CheckState) =
VAR save: INTEGER;
BEGIN
IF (t = NIL) THEN RETURN END;
IF (t.checked) THEN RETURN END;
save := Scanner.offset;
Scanner.offset := t.origin;
t.check (cs);
Scanner.offset := save;
t.checked := TRUE;
END TypeCheck;
******************************************************************
PROCEDURE ConstValue (t: T): T =
VAR new: T; cs: CheckState;
BEGIN
IF (t = NIL) THEN RETURN NIL END;
(*** <* ASSERT t.checked *> ***)
new := t.evaluate ();
IF (new # t) THEN
cs := M3.OuterCheckState; (* OK since constants don't raise exceptions *)
TypeCheck (new, cs);
END;
RETURN new;
END ConstValue;
PROCEDURE GetBounds (t: T; VAR min, max: Target.Int) =
BEGIN
IF (t = NIL) THEN min := TInt.Zero; max := TInt.MOne; RETURN END;
<* ASSERT t.checked *>
t.getBounds (min, max);
END GetBounds;
PROCEDURE IsDesignator (t: T): BOOLEAN =
BEGIN
IF (t = NIL) THEN RETURN TRUE END;
<* ASSERT t.checked *>
RETURN t.isDesignator ();
END IsDesignator;
PROCEDURE IsWritable (t: T): BOOLEAN =
BEGIN
IF (t = NIL) THEN RETURN TRUE END;
<* ASSERT t.checked *>
RETURN t.isWritable ()
END IsWritable;
PROCEDURE IsZeroes (t: T): BOOLEAN =
BEGIN
IF (t = NIL) THEN RETURN TRUE END;
<* ASSERT t.checked *>
RETURN t.isZeroes ()
END IsZeroes;
PROCEDURE GetSign (t: T): CG.Sign =
VAR min, max: Target.Int;
BEGIN
GetBounds (t, min, max);
IF TInt.LE (TInt.Zero, min) THEN RETURN CG.Sign.Positive;
ELSIF TInt.LE (max, TInt.Zero) THEN RETURN CG.Sign.Negative;
ELSE RETURN CG.Sign.Unknown;
END;
END GetSign;
******************************************************************
PROCEDURE NeedsAddress (t: T) =
BEGIN
IF (t = NIL) THEN RETURN END;
<*ASSERT t.checked *>
t.need_addr ();
END NeedsAddress;
******************************************************************
PROCEDURE SupportsDirectAssignment (t: T): BOOLEAN =
BEGIN
RETURN (t # NIL) AND (t.direct_ok);
END SupportsDirectAssignment;
PROCEDURE MarkForDirectAssignment (t: T) =
BEGIN
<*ASSERT t.direct_ok*>
t.do_direct := TRUE;
END MarkForDirectAssignment;
PROCEDURE IsMarkedForDirectAssignment (t: T): BOOLEAN =
BEGIN
RETURN (t # NIL) AND (t.do_direct);
END IsMarkedForDirectAssignment;
******************************************************************
PROCEDURE Prep (t: T) =
BEGIN
IF (t = NIL) THEN RETURN END;
<* ASSERT t.checked *>
t.prep ();
END Prep;
PROCEDURE Compile (t: T) =
BEGIN
IF (t = NIL) THEN RETURN END;
<* ASSERT t.checked *>
t.compile ();
END Compile;
PROCEDURE PrepLValue (t: T) =
BEGIN
IF (t = NIL) THEN RETURN END;
Type.Compile (t.type);
<* ASSERT t.checked *>
t.prepLV ();
END PrepLValue;
PROCEDURE CompileLValue (t: T) =
BEGIN
IF (t = NIL) THEN RETURN END;
<* ASSERT t.checked *>
t.compileLV ();
END CompileLValue;
PROCEDURE CompileAddress (t: T) =
BEGIN
IF (t = NIL) THEN RETURN END;
<* ASSERT t.checked *>
t.compileLV ();
CG.Check_byte_aligned ();
END CompileAddress;
PROCEDURE PrepBranch (t: T; true, false: CG.Label; freq: CG.Frequency) =
BEGIN
IF (t = NIL) THEN RETURN END;
<* ASSERT t.checked *>
<* ASSERT (true = CG.No_label) OR (false = CG.No_label) *>
Type.Compile (t.type);
t.prepBR (true, false, freq);
END PrepBranch;
PROCEDURE CompileBranch (t: T; true, false: CG.Label; freq: CG.Frequency) =
BEGIN
IF (t = NIL) THEN RETURN END;
<* ASSERT t.checked *>
<* ASSERT (true = CG.No_label) OR (false = CG.No_label) *>
t.compileBR (true, false, freq);
END CompileBranch;
PROCEDURE NoteWrite (t: T) =
BEGIN
IF (t = NIL) THEN RETURN END;
t.note_write ();
END NoteWrite;
PROCEDURE IsEqual (a, b: T; x: M3.EqAssumption): BOOLEAN =
BEGIN
IF (a = b) THEN RETURN TRUE END;
IF (a = NIL) OR (b = NIL) THEN RETURN FALSE END;
RETURN a.isEqual (b, x);
END IsEqual;
PROCEDURE PrepLiteral (t: T; type: Type.T) =
BEGIN
IF (t = NIL) THEN RETURN END;
<* ASSERT t.checked *>
Type.Compile (t.type);
t.prepLiteral (type);
END PrepLiteral;
PROCEDURE GenLiteral (t: T; offset: INTEGER; type: Type.T) =
BEGIN
IF (t = NIL) THEN RETURN END;
<* ASSERT t.checked *>
Type.Compile (t.type);
t.genLiteral (offset, type);
END GenLiteral;
PROCEDURE GenFPLiteral (t: T; mbuf: M3Buf.T) =
VAR u := ConstValue (t);
BEGIN
IF (u = NIL) THEN
Error.Msg ("INTERNAL ERROR: fingerprint of a non-constant expression");
END;
<* ASSERT u.checked *>
u.genFPLiteral (mbuf);
END GenFPLiteral;
PROCEDURE BadOperands (op: TEXT; a, b: M3.Type := NIL): M3.Type =
BEGIN
IF (a # ErrType.T) AND (b # ErrType.T) THEN
Error.Msg ("illegal operand(s) for " & op);
END;
RETURN ErrType.T;
END BadOperands;
******************* default methods ***********************************
PROCEDURE NoType (<*UNUSED*> t: T): Type.T =
BEGIN
<* ASSERT FALSE *>
END NoType;
PROCEDURE NoCheck (<*UNUSED*> t: T; <*UNUSED*> VAR cs: CheckState) =
BEGIN
END NoCheck;
PROCEDURE NoValue (<*UNUSED*> t: T): T =
BEGIN
RETURN NIL;
END NoValue;
PROCEDURE NoFPLiteral (<*UNUSED*> t: T; <*UNUSED*>mbuf: M3Buf.T) =
BEGIN
<*ASSERT FALSE*>
END NoFPLiteral;
PROCEDURE Self (t: T): T =
BEGIN
RETURN t;
END Self;
PROCEDURE NoBounds (t: T; VAR min, max: Target.Int) =
BEGIN
EVAL Type.GetBounds (t.type, min, max);
END NoBounds;
PROCEDURE IsNever (<*UNUSED*> t: T): BOOLEAN =
BEGIN
RETURN FALSE;
END IsNever;
PROCEDURE IsAlways (<*UNUSED*> t: T): BOOLEAN =
BEGIN
RETURN TRUE;
END IsAlways;
PROCEDURE NeverEq (<*UNUSED*> a, b: T;
<*UNUSED*> x: M3.EqAssumption): BOOLEAN =
BEGIN
RETURN FALSE;
END NeverEq;
PROCEDURE NoPrepLiteral (<*UNUSED*> t: T; <*UNUSED*> type: Type.T) =
BEGIN
END NoPrepLiteral;
PROCEDURE NoLiteral (<*UNUSED*> t: T;
<*UNUSED*> offset: INTEGER;
<*UNUSED*> type: Type.T) =
BEGIN
<* ASSERT FALSE *>
END NoLiteral;
PROCEDURE NoPrep (<*UNUSED*> t: T) =
BEGIN
END NoPrep;
PROCEDURE NoCompile (<*UNUSED*> t: T) =
BEGIN
<*ASSERT FALSE*>
END NoCompile;
PROCEDURE NotLValue (<*UNUSED*> t: T) =
BEGIN
<* ASSERT FALSE *>
END NotLValue;
PROCEDURE NotBoolean (<*UNUSED*> t: T;
<*UNUSED*> true, false: CG.Label;
<*UNUSED*> freq: CG.Frequency) =
BEGIN
<* ASSERT FALSE *>
END NotBoolean;
PROCEDURE PrepNoBranch (t: T; true, false: CG.Label; freq: CG.Frequency) =
BEGIN
t.prep ();
t.compile ();
IF (true = CG.No_label)
THEN CG.If_false (false, freq);
ELSE CG.If_true (true, freq);
END;
END PrepNoBranch;
PROCEDURE NoBranch (<*UNUSED*> t: T;
<*UNUSED*> true, false: CG.Label;
<*UNUSED*> freq: CG.Frequency) =
BEGIN
(* prep did all the work *)
END NoBranch;
PROCEDURE NotAddressable (<*UNUSED*> t: T) =
BEGIN
<*ASSERT FALSE*>
END NotAddressable;
PROCEDURE NotWritable (<*UNUSED*> t: T) =
BEGIN
(* skip *)
END NotWritable;
PROCEDURE EqCheckA (a: Ta; e: T; x: M3.EqAssumption): BOOLEAN =
BEGIN
TYPECASE e OF
| NULL => RETURN FALSE;
| Ta(b) => RETURN (TYPECODE (a) = TYPECODE (e)) AND IsEqual (a.a, b.a, x);
ELSE RETURN FALSE;
END;
END EqCheckA;
PROCEDURE EqCheckAB (a: Tab; e: T; x: M3.EqAssumption): BOOLEAN =
BEGIN
TYPECASE e OF
| NULL => RETURN FALSE;
| Tab(b) => RETURN (TYPECODE (a) = TYPECODE (b)) AND
IsEqual (a.a, b.a, x) AND IsEqual (a.b, b.b, x);
ELSE RETURN FALSE;
END;
END EqCheckAB;
BEGIN
END Expr.