File: Ord.m3 Last Modified On Tue May 3 16:32:32 PDT 1994 By kalsow Modified On Sat Dec 8 00:54:19 1990 By muller
MODULE; IMPORT CallExpr, Expr, ExprRep, Type, Procedure, Int, LInt, Error; IMPORT IntegerExpr, EnumExpr, CheckExpr, Target, TInt, CG; VAR Z: CallExpr.MethodList; PROCEDURE Ord Check (ce: CallExpr.T; VAR cs: Expr.CheckState) = VAR e := ce.args[0]; t := Expr.TypeOf (e); emin, emax: Target.Int; BEGIN IF NOT Type.IsOrdinal (t) THEN Error.Msg ("ORD: argument must be an ordinal"); END; ce.type := Int.T; IF Type.IsSubtype (t, LInt.T) AND ce.type = Int.T THEN (* must bound check the result *) Expr.GetBounds (e, emin, emax); IF TInt.LT (emin, Target.Integer.min) THEN (* we need a lower bound check *) IF TInt.LT (Target.Integer.max, emax) THEN (* we also need an upper bound check *) e := CheckExpr.New (e, Target.Integer.min, Target.Integer.max, CG.RuntimeError.ValueOutOfRange); Expr.TypeCheck (e, cs); ce.args[0] := e; ELSE e := CheckExpr.NewLower (e, Target.Integer.min, CG.RuntimeError.ValueOutOfRange); Expr.TypeCheck (e, cs); ce.args[0] := e; END; ELSIF TInt.LT (Target.Integer.max, emax) THEN (* we need an upper bound check *) e := CheckExpr.NewUpper (e, Target.Integer.max, CG.RuntimeError.ValueOutOfRange); Expr.TypeCheck (e, cs); ce.args[0] := e; END; END; END Check; PROCEDURECompile (ce: CallExpr.T) = VAR e := ce.args[0]; t := Expr.TypeOf (e); BEGIN Expr.Compile (e); IF Type.IsSubtype (t, LInt.T) THEN CG.Loophole (Target.Longint.cg_type, Target.Integer.cg_type); END; END Compile; PROCEDUREFold (ce: CallExpr.T): Expr.T = VAR e: Expr.T; i: Target.Int; t: Type.T; BEGIN e := Expr.ConstValue (ce.args[0]); IF (e = NIL) THEN RETURN NIL; ELSIF EnumExpr.Split (e, i, t) THEN RETURN IntegerExpr.New (Int.T, i); ELSIF IntegerExpr.Split (e, i, t) THEN RETURN IntegerExpr.New (Int.T, i); ELSE RETURN NIL; END; END Fold; PROCEDUREGetBounds (ce: CallExpr.T; VAR min, max: Target.Int) = VAR e := ce.args[0]; BEGIN Expr.GetBounds (e, min, max); IF TInt.LT (min, Target.Integer.min) THEN min := Target.Integer.min END; IF TInt.LT (Target.Integer.max, max) THEN max := Target.Integer.max END; END GetBounds; PROCEDUREInitialize () = BEGIN Z := CallExpr.NewMethodList (1, 1, TRUE, FALSE, TRUE, Int.T, NIL, CallExpr.NotAddressable, Check, CallExpr.PrepArgs, Compile, CallExpr.NoLValue, CallExpr.NoLValue, CallExpr.NotBoolean, CallExpr.NotBoolean, Fold, GetBounds, CallExpr.IsNever, (* writable *) CallExpr.IsNever, (* designator *) CallExpr.NotWritable (* noteWriter *)); Procedure.Define ("ORD", Z, TRUE); END Initialize; BEGIN END Ord.