(* Copyright (C) 1992, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: AddExpr.m3 *) (* Last modified on Mon Mar 2 10:38:40 PST 1992 by kalsow *) (* modified on Thu Nov 29 03:30:20 1990 by muller *) MODULE AddExpr; IMPORT Expr, ExprRep, Type, Int, Reel, LReel, EReel, SetType; IMPORT Addr, Emit, Module, Temp, MBuf, Error; IMPORT AddressExpr, SetExpr, IntegerExpr, ReelExpr; TYPE Class = { cINT, cREAL, cLONG, cEXTND, cADDR, cSET }; TYPE P = ExprRep.Tab BRANDED "AddExpr.P" OBJECT class: Class; OVERRIDES typeOf := TypeOf; check := Check; compile := Compile; evaluate := Fold; fprint := FPrinter; write := Writer; isEqual := ExprRep.EqCheckAB; getBounds := ExprRep.NoBounds; isWritable := ExprRep.IsNever; isDesignator := ExprRep.IsNever; isZeroes := ExprRep.IsNever; note_write := ExprRep.NotWritable; genLiteral := ExprRep.NoLiteral; END; PROCEDURE New (a, b: Expr.T): Expr.T = VAR p: P; BEGIN p := NEW (P); ExprRep.Init (p); p.a := a; p.b := b; RETURN p; END New; PROCEDURE TypeOf (p: P): Type.T = VAR ta: Type.T; BEGIN ta := Expr.TypeOf (p.a); Type.Check (ta); IF Type.IsSubtype (ta, Addr.T) THEN ta := Addr.T END; RETURN Type.Base (ta); END TypeOf; PROCEDURE Check (p: P; VAR cs: Expr.CheckState) = VAR ta, tb, range: Type.T; BEGIN Expr.TypeCheck (p.a, cs); Expr.TypeCheck (p.b, cs); ta := Type.Base (Expr.TypeOf (p.a)); tb := Type.Base (Expr.TypeOf (p.b)); IF (ta = Int.T) AND (tb = Int.T) THEN p.class := Class.cINT; ELSIF (ta = Reel.T) AND (tb = Reel.T) THEN p.class := Class.cREAL; ELSIF (ta = LReel.T) AND (tb = LReel.T) THEN p.class := Class.cLONG; ELSIF (ta = EReel.T) AND (tb = EReel.T) THEN p.class := Class.cEXTND; ELSIF SetType.Split (ta, range) THEN p.class := Class.cSET; IF NOT Type.IsEqual (ta, tb, NIL) THEN Err () END; ELSIF Type.IsSubtype (ta, Addr.T) AND (tb = Int.T) THEN p.class := Class.cADDR; ta := Addr.T; IF Module.IsSafe () THEN Error.Msg ("unsafe \'+\'"); END; ELSE Err (); END; p.type := ta; END Check; PROCEDURE Err () = BEGIN Error.Msg ("illegal operands for \'+\'"); END Err; PROCEDURE Compile (p: P): Temp.T = VAR t1, t2, t3: Temp.T; BEGIN t1 := Expr.Compile (p.a); t2 := Expr.Compile (p.b); IF (p.class = Class.cSET) THEN t3 := Temp.Alloc (p); SetExpr.CompileUnion (t1, t2, t3, p.type); Temp.Free (t1); Temp.Free (t2); ELSE t3 := Temp.AllocMacro (p, FALSE); Temp.Depend (t3, t1); Temp.Depend (t3, t2); END; RETURN t3; END Compile; PROCEDURE Writer (p: P; t1, t2: Temp.T) = BEGIN CASE p.class OF | Class.cSET => <* ASSERT FALSE *> | Class.cADDR => Emit.OpTT ("(((char*)@) + @)", t1, t2); ELSE Emit.OpTT ("(@ + @)", t1, t2); END; END Writer; PROCEDURE Fold (p: P): Expr.T = VAR e1, e2, e3: Expr.T; BEGIN e1 := Expr.ConstValue (p.a); e2 := Expr.ConstValue (p.b); e3 := NIL; IF (e1 = NIL) OR (e2 = NIL) THEN ELSIF IntegerExpr.Add (e1, e2, e3) THEN ELSIF ReelExpr.Add (e1, e2, e3) THEN ELSIF AddressExpr.Add (e1, e2, e3) THEN ELSIF SetExpr.Union (e1, e2, e3) THEN END; RETURN e3; END Fold; PROCEDURE FPrinter (p: P; map: Type.FPMap; wr: MBuf.T) = BEGIN MBuf.PutText (wr, "+ "); Expr.Fingerprint (p.a, map, wr); Expr.Fingerprint (p.b, map, wr); END FPrinter; BEGIN END AddExpr.