GENERIC MODULEInsert (Rep); IMPORT CG, CallExpr, Expr, ExprRep, Procedure; IMPORT IntegerExpr, Type, ProcType, Host, Card; IMPORT Target, TInt, TWord, Value, Formal, CheckExpr, Error; FROM Rep IMPORT T; FROM TargetMap IMPORT Word_types; VAR Z: CallExpr.MethodList; VAR formals: Value.T; VAR rep: [FIRST (Word_types) .. LAST (Word_types)]; PROCEDURECheck (ce: CallExpr.T; VAR cs: Expr.CheckState) = BEGIN EVAL Formal.CheckArgs (cs, ce.args, formals, ce.proc); ce.type := T; END Check; PROCEDURECompile (ce: CallExpr.T) = VAR t2, t3: CG.Val; max: Target.Int; b, x2, x3: BOOLEAN; i2, i3: INTEGER; BEGIN x2 := GetBitIndex (ce.args[2], i2); x3 := GetBitIndex (ce.args[3], i3); IF x2 AND x3 THEN (* we can use the insert_mn operator *) IF (i2 + i3 > Word_types[rep].size) THEN Error.Warn (2, "Word.Insert: i+n value out of range"); CG.Load_integer (Target.Integer.cg_type, TInt.One); CG.Check_hi (Target.Integer.cg_type, TInt.Zero, CG.RuntimeError.ValueOutOfRange); ELSE Expr.Compile (ce.args[0]); Expr.Compile (ce.args[1]); CG.Insert_mn (Word_types[rep].cg_type, i2, i3); END; ELSIF x3 THEN (* we can use the insert_n operator *) b := TInt.FromInt (Word_types[rep].size - i3, max); <*ASSERT b*> Expr.Compile (ce.args[0]); CG.Force (); Expr.Compile (ce.args[1]); CheckExpr.EmitChecks (ce.args[2], TInt.Zero, max, CG.RuntimeError.ValueOutOfRange); CG.Insert_n (Word_types[rep].cg_type, i3); ELSIF x2 THEN (* we need the general purpose insert operator, but can simplify the range checking code *) b := TInt.FromInt (Word_types[rep].size - i2, max); <*ASSERT b*> Expr.Compile (ce.args[0]); CG.Force (); Expr.Compile (ce.args[1]); CG.Force (); CG.Load_intt (i2); CheckExpr.EmitChecks (ce.args[3], TInt.Zero, max, CG.RuntimeError.ValueOutOfRange); CG.Insert (Word_types[rep].cg_type); ELSE (* we need the general purpose insert operator *) CheckExpr.EmitChecks (ce.args[2], TInt.Zero, Target.Integer.max, CG.RuntimeError.ValueOutOfRange); t2 := CG.Pop (); CheckExpr.EmitChecks (ce.args[3], TInt.Zero, Target.Integer.max, CG.RuntimeError.ValueOutOfRange); t3 := CG.Pop (); IF Host.doRangeChk THEN b := TInt.FromInt (Word_types[rep].size, max); <*ASSERT b*> CG.Push (t2); CG.Push (t3); CG.Add (Target.Integer.cg_type); CG.Check_hi (Target.Integer.cg_type, max, CG.RuntimeError.ValueOutOfRange); CG.Discard (Target.Integer.cg_type); END; Expr.Compile (ce.args[0]); CG.Force (); Expr.Compile (ce.args[1]); CG.Force (); CG.Push (t2); CG.Push (t3); CG.Insert (Word_types[rep].cg_type); CG.Free (t2); CG.Free (t3); END; END Compile; PROCEDUREGetBitIndex (e: Expr.T; VAR i: INTEGER): BOOLEAN = BEGIN e := Expr.ConstValue (e); IF (e = NIL) THEN RETURN FALSE END; RETURN IntegerExpr.ToInt (e, i) AND (0 <= i) AND (i <= Word_types[rep].size); END GetBitIndex; PROCEDUREFold (ce: CallExpr.T): Expr.T = VAR e0, e1: Expr.T; w0, w1, result: Target.Int; i2, i3: INTEGER; t: Type.T; BEGIN e0 := Expr.ConstValue (ce.args[0]); e1 := Expr.ConstValue (ce.args[1]); IF (e0 = NIL) OR (e1 = NIL) OR NOT IntegerExpr.Split (e0, w0, t) OR NOT IntegerExpr.Split (e1, w1, t) OR NOT GetBitIndex (ce.args[2], i2) OR NOT GetBitIndex (ce.args[3], i3) OR i2 + i3 > Word_types[rep].size OR NOT TWord.Insert (w0, w1, i2, i3, result) THEN RETURN NIL; END; EVAL TInt.Extend (result, Word_types[rep].bytes, result); RETURN IntegerExpr.New (T, result); END Fold; PROCEDUREInitialize (r: INTEGER) = VAR f0 := Formal.NewBuiltin ("x", 0, T); f1 := Formal.NewBuiltin ("y", 1, T); f2 := Formal.NewBuiltin ("i", 2, Card.T); f3 := Formal.NewBuiltin ("n", 3, Card.T); t := ProcType.New (T, f0, f1, f2, f3); BEGIN rep := r; Z := CallExpr.NewMethodList (4, 4, 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 ("Insert", Z, FALSE, t); formals := ProcType.Formals (t); END Initialize; BEGIN END Insert.