m3front/src/builtinWord/Insert.mg


 Copyright (C) 1992, Digital Equipment Corporation           
 All rights reserved.                                        
 See the file COPYRIGHT for a full description.              

GENERIC MODULE Insert (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)];

PROCEDURE Check (ce: CallExpr.T;  VAR cs: Expr.CheckState) =
  BEGIN
    EVAL Formal.CheckArgs (cs, ce.args, formals, ce.proc);
    ce.type := T;
  END Check;

PROCEDURE Compile (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;

PROCEDURE GetBitIndex (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;

PROCEDURE Fold (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;

PROCEDURE Initialize (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.

interface Type is in:


interface Card is in:


interface Value is in: