GENERIC MODULEShift (Rep); IMPORT CG, CallExpr, Expr, ExprRep, Procedure, Type, SubrangeType, Formal; IMPORT Int, IntegerExpr, Value, ProcType, CheckExpr, Target, TInt, TWord; FROM Rep IMPORT T; FROM TargetMap IMPORT Word_types; VAR Z, ZL, ZR: CallExpr.MethodList; VAR formals, formalsL, formalsR: Value.T; VAR rep: [FIRST (Word_types) .. LAST (Word_types)]; VAR max: Target.Int; PROCEDURECheck (ce: CallExpr.T; VAR cs: Expr.CheckState) = BEGIN EVAL Formal.CheckArgs (cs, ce.args, formals, ce.proc); ce.type := T; END Check; PROCEDURECheckL (ce: CallExpr.T; VAR cs: Expr.CheckState) = BEGIN EVAL Formal.CheckArgs (cs, ce.args, formalsL, ce.proc); ce.type := T; END CheckL; PROCEDURECheckR (ce: CallExpr.T; VAR cs: Expr.CheckState) = BEGIN EVAL Formal.CheckArgs (cs, ce.args, formalsR, ce.proc); ce.type := T; END CheckR; PROCEDURECompile (ce: CallExpr.T) = BEGIN Expr.Compile (ce.args[0]); Expr.Compile (ce.args[1]); CG.Shift (Word_types[rep].cg_type); END Compile; PROCEDURECompileL (ce: CallExpr.T) = BEGIN Expr.Compile (ce.args[0]); CheckExpr.EmitChecks (ce.args[1], TInt.Zero, max, CG.RuntimeError.ValueOutOfRange); CG.Shift_left (Word_types[rep].cg_type); END CompileL; PROCEDURECompileR (ce: CallExpr.T) = BEGIN Expr.Compile (ce.args[0]); CheckExpr.EmitChecks (ce.args[1], TInt.Zero, max, CG.RuntimeError.ValueOutOfRange); CG.Shift_right (Word_types[rep].cg_type); END CompileR; PROCEDUREFold (ce: CallExpr.T): Expr.T = VAR e0, e1: Expr.T; w0, result: Target.Int; i1: INTEGER; t: Type.T; BEGIN e0 := Expr.ConstValue (ce.args[0]); e1 := Expr.ConstValue (ce.args[1]); IF (e0 # NIL) AND IntegerExpr.Split (e0, w0, t) AND (e1 # NIL) AND IntegerExpr.ToInt (e1, i1) THEN TWord.And (w0, Word_types[rep].max, w0); TWord.Shift (w0, i1, result); EVAL TInt.Extend (result, Word_types[rep].bytes, result); RETURN IntegerExpr.New (T, result); END; RETURN NIL; END Fold; PROCEDUREFoldL (ce: CallExpr.T): Expr.T = VAR e0, e1: Expr.T; w0, result: Target.Int; i1: INTEGER; t: Type.T; BEGIN e0 := Expr.ConstValue (ce.args[0]); e1 := Expr.ConstValue (ce.args[1]); IF (e0 # NIL) AND IntegerExpr.Split (e0, w0, t) AND (e1 # NIL) AND IntegerExpr.ToInt (e1, i1) AND 0 <= i1 AND i1 < Word_types[rep].size THEN TWord.And (w0, Word_types[rep].max, w0); TWord.Shift (w0, i1, result); EVAL TInt.Extend (result, Word_types[rep].bytes, result); RETURN IntegerExpr.New (T, result); END; RETURN NIL; END FoldL; PROCEDUREFoldR (ce: CallExpr.T): Expr.T = VAR e0, e1: Expr.T; w0, result: Target.Int; i1: INTEGER; t: Type.T; BEGIN e0 := Expr.ConstValue (ce.args[0]); e1 := Expr.ConstValue (ce.args[1]); IF (e0 # NIL) AND IntegerExpr.Split (e0, w0, t) AND (e1 # NIL) AND IntegerExpr.ToInt (e1, i1) AND 0 <= i1 AND i1 < Word_types[rep].size THEN TWord.And (w0, Word_types[rep].max, w0); TWord.Shift (w0, -i1, result); EVAL TInt.Extend (result, Word_types[rep].bytes, result); RETURN IntegerExpr.New (T, result); END; RETURN NIL; END FoldR; PROCEDUREInitialize (r: INTEGER) = VAR b := TInt.FromInt (Word_types[r].size-1, max); sub := SubrangeType.New (TInt.Zero, max, Int.T, FALSE); f0 := Formal.NewBuiltin ("x", 0, T); f1 := Formal.NewBuiltin ("n", 1, Int.T); t := ProcType.New (T, f0, f1); Lf0 := Formal.NewBuiltin ("x", 0, T); Lf1 := Formal.NewBuiltin ("n", 1, sub); Lt := ProcType.New (T, Lf0, Lf1); Rf0 := Formal.NewBuiltin ("x", 0, T); Rf1 := Formal.NewBuiltin ("n", 1, sub); Rt := ProcType.New (T, Rf0, Rf1); BEGIN <*ASSERT b*> rep := r; Z := CallExpr.NewMethodList (2, 2, TRUE, TRUE, TRUE, T, NIL, CallExpr.NotAddressable, Check, CallExpr.PrepArgs, Compile, CallExpr.NoLValue, CallExpr.NoLValue, CallExpr.NotBoolean, CallExpr.NotBoolean, Fold, CallExpr.NoBounds, CallExpr.IsNever, (* writable *) CallExpr.IsNever, (* designator *) CallExpr.NotWritable (* noteWriter *)); Procedure.Define ("Shift", Z, FALSE, t); formals := ProcType.Formals (t); ZL := CallExpr.NewMethodList (2, 2, TRUE, TRUE, TRUE, T, NIL, CallExpr.NotAddressable, CheckL, CallExpr.PrepArgs, CompileL, CallExpr.NoLValue, CallExpr.NoLValue, CallExpr.NotBoolean, CallExpr.NotBoolean, FoldL, CallExpr.NoBounds, CallExpr.IsNever, (* writable *) CallExpr.IsNever, (* designator *) CallExpr.NotWritable (* noteWriter *)); Procedure.Define ("LeftShift", ZL, FALSE, Lt); formalsL := ProcType.Formals (Lt); ZR := CallExpr.NewMethodList (2, 2, TRUE, TRUE, TRUE, T, NIL, CallExpr.NotAddressable, CheckR, CallExpr.PrepArgs, CompileR, CallExpr.NoLValue, CallExpr.NoLValue, CallExpr.NotBoolean, CallExpr.NotBoolean, FoldR, CallExpr.NoBounds, CallExpr.IsNever, (* writable *) CallExpr.IsNever, (* designator *) CallExpr.NotWritable (* noteWriter *)); Procedure.Define ("RightShift", ZR, FALSE, Rt); formalsR := ProcType.Formals (Rt); END Initialize; BEGIN END Shift.