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

(* File: Subarray.m3                                           *)
(* Last Modified On Tue Jun 30 09:38:35 PDT 1992 By kalsow     *)
(*      Modified On Thu Mar  7 20:18:53 1991 By muller         *)

MODULE Subarray;

IMPORT CallExpr, Expr, Type, Procedure, Error, ArrayType, Card;
IMPORT Emit, OpenArrayType, Temp, CheckExpr, Host, Addr, Fault;

VAR Z: CallExpr.MethodList;

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

PROCEDURE Check (<*UNUSED*> proc: Expr.T; VAR args: Expr.List;  VAR cs: Expr.CheckState): Type.T =
  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] := CheckPositive (args[1], cs);
      args[2] := CheckPositive (args[2], cs);
    END;
    t := ArrayType.OpenCousin (t);
    Type.Check (t);
    RETURN t;
  END Check;

PROCEDURE CheckPositive (e: Expr.T;  VAR cs: Expr.CheckState): Expr.T =
  VAR min, max: INTEGER;
  BEGIN
    Expr.GetBounds (e, min, max);
    IF (min < 0) OR (max < min) THEN
      e := CheckExpr.NewLower (e, 0);
      Expr.TypeCheck (e, cs);
    END;
    RETURN e;
  END CheckPositive;

PROCEDURE Compile (<*UNUSED*> proc: Expr.T; args: Expr.List): Temp.T =
  VAR
    result, start, len, arg0, arg1, arg2, ptr: Temp.T;
    array, index, element, open: Type.T;
    depth: INTEGER;
  BEGIN
    array := Type.Base (Expr.TypeOf (args[0]));
    EVAL ArrayType.Split (array, index, element);
    Type.Compile (array);

    open  := ArrayType.OpenCousin (array);
    depth := OpenArrayType.OpenDepth (array);
    Type.Compile (open);

    arg0 := Expr.Compile (args[0]);
    arg1 := Expr.Compile (args[1]);
    arg2 := Expr.Compile (args[2]);
    result := Temp.AllocEmpty (open, TRUE);
    start := Temp.Alloc (args[1]);
    len := Temp.Alloc (args[2]);

    IF (depth = 0) THEN
      (* source array is a fixed array *)
      Emit.OpTT ("@ = @;\n", start, arg1);
      Emit.OpTT ("@ = @;\n", len, arg2);
      IF Host.doRangeChk THEN
        Emit.OpTT ("if ((@+@) > ", start, len);
        Emit.OpI  ("@) ", Type.Number (index));
        Fault.Range ();
      END;
      Emit.OpTT ("@.size[0] = @;\n", result, len);
      Emit.OpT  ("@.elts = ", result);
      Emit.OpTT ("(@).elts + @;\n", arg0, start);
    ELSE
      (* source array is an open array *)
      ptr := Temp.AllocEmpty (Addr.T);
      Emit.OpTT ("@ = (_ADDRESS) & @;\n", ptr, arg0);
      Emit.OpTT ("@ = @;\n", start, arg1);
      Emit.OpTT ("@ = @;\n", len, arg2);
      IF Host.doRangeChk THEN
        Emit.OpTT ("if ((@+@) > ", start, len);
        Emit.OpFT ("((@*)@)->size[0]) ", open, ptr);
        Fault.Range ();
      END;
      Emit.OpTT ("@.size[0] = @;\n", result, len);
      FOR i := 1 TO depth - 1 DO
        Emit.OpTI ("@.size[@] = ", result, i);
        Emit.OpFT ("((@*)@)", open, ptr);
        Emit.OpI  ("->size[@];\n", i);
      END;
      Emit.OpT  ("@.elts = ", result);
      Emit.OpFT ("((@*)@)->elts + (", open, ptr);
      FOR i := 1 TO depth - 1 DO
        Emit.OpFT ("((@*)@)", open, ptr);
        Emit.OpI  ("->size[@] *", i);
      END;
      Emit.OpT ("@);\n", start);
      Temp.Free (ptr);
    END;

    (* 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 NoteWrites (<*UNUSED*> proc: Expr.T;  args: Expr.List) =
  BEGIN
    Expr.NoteWrite (args[0]);
  END NoteWrites;

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

BEGIN
END Subarray.