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

(* File: Subarray.m3                                           *)
(* Last Modified On Thu Apr  5 00:45:01 1990 By muller         *)
(*      Modified On Tue Jan 16 15:31:24 1990 By kalsow         *)


MODULE Subarray;

IMPORT CallExpr, Expr, Type, Procedure, Error, ArrayType, Card;
IMPORT Emit, Int, OpenArray, SubscriptExpr, DerefExpr, VarExpr;
IMPORT AddExpr, SubrangeType, IntegerExpr, Tipe, Temp, CheckExpr;
IMPORT Target;

VAR
  Z: CallExpr.MethodList;

PROCEDURE Bind (<*UNUSED*> proc: Expr.T; args: Expr.List): Type.T =
  BEGIN
    RETURN ArrayType.OpenCousin (Type.Base (Expr.TypeOf (args[0])));
  END Bind;

PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List) =
  VAR t, u, v, index, elt: Type.T;
  BEGIN
    t := Type.Base (Expr.TypeOf (args[0]));
    u := Expr.TypeOf (args[1]);
    v := Expr.TypeOf (args[2]);
    IF (NOT ArrayType.Split (t, index, elt)) THEN
      Error.Msg ("SUBARRAY: first argument must be an array");
    ELSIF (NOT Type.IsAssignable (Card.T, u)) THEN
      Error.Msg ("SUBARRAY: second argrment must be assignable to CARDINAL");
    ELSIF (NOT Type.IsAssignable (Card.T, v)) THEN
      Error.Msg ("SUBARRAY: third argument must be assignable to CARDINAL");
    ELSE
      args[1] := CheckExpr.NewLower (args[1], 0);
      args[2] := CheckExpr.NewLower (args[2], 0);
      FOR i := 1 TO 2 DO
        Expr.Bind (args[i]);
        Expr.TypeCheck (args[i]);
      END;
    END;
  END Check;

PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T =
  VAR
    result, start, len, arg0, arg1, arg2: Temp.T;
    array, index, element, open: Type.T;
    j, depth: INTEGER;
  BEGIN
    array := Type.Base (Expr.TypeOf (args[0]));
    open  := ArrayType.OpenCousin (array);
    arg0 := Expr.Compile (args[0]);
    arg1 := Expr.Compile (args[1]);
    arg2 := Expr.Compile (args[2]);
    result := Temp.AllocEmpty (ArrayType.OpenImpl (open), TRUE);
    start := Temp.Alloc (args[1]);
    len := Temp.Alloc (args[2]);
    depth := ArrayType.OpenDepth (array);
    VAR b: BOOLEAN := ArrayType.Split (array, index, element);
    BEGIN <* ASSERT b *> END;
    Emit.Op ("{\001\n");
    IF (depth = 0) THEN
      (* source array is a fixed array *)
      Emit.OpTT ("@ = @;\n", start, arg1);
      Emit.OpTT ("@ = @;\n", len, arg2);
      Emit.OpTT ("if ((@+@) > ", start, len);
      Emit.OpI ("@) RANGEFAULT;\n", Type.Number (index));
      Emit.OpTT ("@.size[0] = @;\n", result, len);
      Emit.OpTT ("@.elts = ((char*)(& @)) + ", result, arg0);
      Emit.OpTI ("(@ * @);\n", start, Type.Size (element) DIV Target.CHARSIZE);
    ELSE
      (* source array is an open array *)
      j := Type.Name (ArrayType.OpenImpl (open));
      Emit.OpIT ("register t@* array = & @;\n", j, arg0);
      Emit.OpTT ("@ = @;\n", start, arg1);
      Emit.OpTT ("@ = @;\n", len, arg2);
      Emit.OpTT ("if ((@+@) > array->size[0]) RANGEFAULT;\n", start, len);
      Emit.OpTT ("@.size[0] = @;\n", result, len);
      FOR i := 1 TO depth - 1 DO
        Emit.OpTI ("@.size[@] = ", result, i);
        Emit.OpI ("array->size[@];\n", i);
      END;
      Emit.OpTT ("@.elts = array->elts + (@ * ", result, start);
      FOR i := 1 TO depth - 1 DO Emit.OpI ("(array->size[@]) * ", i); END;
      Emit.OpI ("@);\n",
                Type.Size (ArrayType.OpenType (open)) DIV Target.CHARSIZE);
    END;
    Emit.Op ("\002};\n");
    (* free the temporaries *)
    Temp.Free (arg0);
    Temp.Free (arg1);
    Temp.Free (arg2);
    Temp.Free (start);
    Temp.Free (len);
    RETURN result;
  END Compile;

PROCEDURE IsWritable (<*UNUSED*> proc: Expr.T; args: Expr.List): BOOLEAN =
  BEGIN
    RETURN Expr.IsWritable (args[0]);
  END IsWritable;

PROCEDURE IsDesignator (<*UNUSED*> proc: Expr.T; args: Expr.List): BOOLEAN =
  BEGIN
    RETURN Expr.IsDesignator (args[0]);
  END IsDesignator;

PROCEDURE Initialize () =
  BEGIN
    Z := CallExpr.NewMethodList (3, 3, TRUE, Bind, Check, Compile,
                                 CallExpr.NoValue, IsWritable, IsDesignator);
    Procedure.Define ("SUBARRAY", Z);
  END Initialize;

BEGIN
END Subarray.