(* Copyright (C) 1989, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: Abs.m3 *) (* Last Modified On Tue Mar 20 02:44:10 1990 By muller *) (* Modified On Sat Feb 10 19:34:33 1990 By kalsow *) MODULE Abs; IMPORT CallExpr, Expr, Type, Procedure, Emit, Error; IMPORT Int, Reel, Longreal, VarExpr, IntegerExpr; IMPORT RealExpr, LongrealExpr, Temp; VAR Z: CallExpr.MethodList; PROCEDURE Bind (<*UNUSED*> proc: Expr.T; args: Expr.List): Type.T = BEGIN RETURN Type.Base (Expr.TypeOf (args[0])); END Bind; PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List) = VAR t: Type.T; BEGIN t := Type.Base (Expr.TypeOf (args[0])); IF (t # Int.T) AND (t # Reel.T) AND (t # Longreal.T) THEN Error.Msg ("ABS: wrong argument type"); END; END Check; PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T = VAR t: Type.T; e: Expr.T; t1, t2: Temp.T; BEGIN e := args[0]; t := Type.Base (Expr.TypeOf (e)); t1 := Expr.Compile (e); t2 := Temp.AllocEmpty (t); Emit.OpTT ("@ = @;\n", t2, t1); IF (t = Int.T) THEN Emit.OpTTT ("if (@ < 0) @ = - @;\n", t2, t2, t2); ELSE Emit.OpTTT ("if (@ < 0.0) @ = - @;\n", t2, t2, t2); END; Temp.Free (t1); RETURN t2; END Compile; PROCEDURE Fold (<*UNUSED*> proc: Expr.T; args: Expr.List): Expr.T = VAR e: Expr.T; i: INTEGER; r: LONGREAL; BEGIN e := Expr.ConstValue (args[0]); IF (e = NIL) THEN RETURN NIL; ELSIF IntegerExpr.Split (e, i) THEN IF (i < 0) THEN e := IntegerExpr.New ( -i) END; RETURN e; ELSIF RealExpr.Split (e, r) THEN IF (r < 0.0d+0) THEN e := RealExpr.New ( -r) END; RETURN e; ELSIF LongrealExpr.Split (e, r) THEN IF (r < 0.0d+0) THEN e := LongrealExpr.New ( -r) END; RETURN e; ELSE RETURN NIL; END; END Fold; PROCEDURE Initialize () = BEGIN Z := CallExpr.NewMethodList (1, 1, TRUE, Bind, Check, Compile, Fold, CallExpr.IsNever, (* writable *) CallExpr.IsNever(* designator *)); Procedure.Define ("ABS", Z); END Initialize; BEGIN END Abs.