carray 3.0.2 → 3.0.4

data/ext/carray_address_basis.c

@@ -1,4 +1,5 @@
 #include "carray.h"
+#include "carray_internal.h"
 
 /* ---------------------------------------------------------------------------
 
@@ -8,8 +9,8 @@
   writes a[i] from its own loop, so what it needs from CArray is not element
   delivery but an addressing basis: a pointer, already shifted to cell zero,
   and one byte stride per axis.  That is why this does not sit on the kernel
-  iterator (per-cell / per-slab delivery, and no N-ary form) or on the sweep
-  ELEMENT family (which flattens the array and cannot recover the axis
+  iterator (per-cell / per-slab delivery, and no N-ary form) or on the
+  call_cfunc families (which flatten the array and cannot recover the axis
   structure a stencil needs).
 
   This is a runtime facility at the same layer as ca_attach, not a user
@@ -77,8 +78,16 @@ typedef struct {
   ca_size_t *region_start;    /* count * CA_RANK_MAX */
   ca_size_t *region_count;
   VALUE      bases;
-  VALUE      box_starts;      /* per array, per axis; nil for "all of it" */
-  VALUE      box_counts;
+  int       *has_box;         /* per slot: 1 when box_start/box_count hold a box */
+  ca_size_t *box_start;       /* slots * CA_RANK_MAX; the whole array when */
+  ca_size_t *box_count;       /*   has_box is 0 */
+  int        lent;            /* every basis was acquired and the block entered */
+  int        body_done;       /* the block returned without raising */
+  volatile VALUE put_error;   /* the first write-back that raised, or nil */
+  /* ca_with_address_bases: the caller's body and what it is handed */
+  VALUE    (*c_body)(ca_address_basis_t *bases, VALUE arg);
+  VALUE      c_arg;
+  ca_address_basis_t *c_bases;
 } open_state;
 
 /* The view's own row-major byte layout, which is the address space
@@ -94,6 +103,15 @@ native_steps (CArray *ca, ca_size_t *steps)
   }
 }
 
+/* Whether [start, start + count) leaves [0, dim).  Written so that no sum
+   is formed: a start and a count near the top of the integer range add up
+   to a negative number, which `start + count > dim` lets through. */
+static int
+outside_axis (ca_size_t start, ca_size_t count, ca_size_t dim)
+{
+  return start < 0 || count < 0 || start > dim || count > dim - start;
+}
+
 /* Checks one array's box description, all of it: that it is one start and one
    count per axis, that they are numbers, and that the box they describe is
    inside the array.
@@ -124,39 +142,34 @@ verify_box (VALUE box_starts, VALUE box_counts, int index, CArray *ca)
              "this array has %d", (int) ca->ndim);
   }
   for ( k = 0; k < ca->ndim; k++ ) {
-    ca_size_t start = NUM2LL(rb_ary_entry(starts, k));
-    ca_size_t count = NUM2LL(rb_ary_entry(counts, k));
-    if ( start < 0 || count < 0 || start + count > ca->dim[k] ) {
+    ca_size_t start = ca_integer_arg(rb_ary_entry(starts, k), "a region start",
+                                     "CArray::AddressBasis.open");
+    ca_size_t count = ca_integer_arg(rb_ary_entry(counts, k), "a region count",
+                                     "CArray::AddressBasis.open");
+    if ( outside_axis(start, count, ca->dim[k]) ) {
       rb_raise(rb_eArgError,
                "the requested region falls outside the array on axis %d", (int) k);
     }
   }
 }
 
-/* Reads one array's box out of the Ruby-side description, defaulting to the
-   whole array.  verify_box checked it, and checks it again here because this
-   is the last thing between a caller's numbers and pointer arithmetic. */
+/* Reads one array's box, the whole array when none was given.  The box was
+   checked when it was given, and is checked again here because this is the
+   last thing between a caller's numbers and pointer arithmetic. */
 static void
 read_box (open_state *state, int index, CArray *ca,
           ca_size_t *starts, ca_size_t *counts)
 {
-  VALUE per_array_start = Qnil, per_array_count = Qnil;
   int8_t k;
-
-  if ( ! NIL_P(state->box_starts) ) {
-    per_array_start = rb_ary_entry(state->box_starts, index);
-    per_array_count = rb_ary_entry(state->box_counts, index);
-  }
-
   for ( k = 0; k < ca->ndim; k++ ) {
-    if ( NIL_P(per_array_start) ) {
+    if ( state->has_box[index] ) {
+      starts[k] = state->box_start[index * CA_RANK_MAX + k];
+      counts[k] = state->box_count[index * CA_RANK_MAX + k];
+    } else {
       starts[k] = 0;
       counts[k] = ca->dim[k];
-    } else {
-      starts[k] = NUM2LL(rb_ary_entry(per_array_start, k));
-      counts[k] = NUM2LL(rb_ary_entry(per_array_count, k));
     }
-    if ( starts[k] < 0 || counts[k] < 0 || starts[k] + counts[k] > ca->dim[k] ) {
+    if ( outside_axis(starts[k], counts[k], ca->dim[k]) ) {
       rb_raise(rb_eArgError,
                "the requested region falls outside the array on axis %d", (int) k);
     }
@@ -188,14 +201,14 @@ size_array (ca_size_t *values, int8_t count)
 /* Refuses what a generated kernel cannot express, rather than letting it
    produce quietly wrong numbers. */
 static void
-verify_usable (VALUE object, CArray *ca, int writable)
+verify_usable (VALUE klass, CArray *ca, int writable)
 {
   if ( ca->data_type == CA_OBJECT ) {
     rb_raise(rb_eArgError, "object arrays hold Ruby values, not numbers");
   }
   if ( writable && ca_is_readonly(ca) ) {
-    rb_raise(rb_eRuntimeError, "%"PRIsVALUE" is read-only",
-             rb_obj_class(object));
+    /* read-only-check: names which array a basis was asked to write through */
+    rb_raise(rb_eRuntimeError, "%"PRIsVALUE" is read-only", klass);
   }
 }
 
@@ -217,6 +230,96 @@ folds_to_an_entity (CArray *ca)
   return ca_is_entity(root);
 }
 
+/* A view that reinterprets the element size -- refer(CA_INT32, ...) over
+   a float64 array -- gets a mask of its own shape, but one mask cell of it
+   covers a fraction of a parent cell, so writing cell i's mask also marks
+   its neighbour.  A per-cell kernel writes cells independently and cannot
+   express that.  Checked for every tier: a box transfer moves the same
+   mask, and the neighbour is marked when it is written back. */
+static int
+mask_cells_split (CArray *ca)
+{
+  CArray   *root;
+  ca_size_t strides[CA_RANK_MAX];
+  ca_size_t base = 0;
+  if ( ! ca->mask || ! ca_is_stride_family(ca) ) return 0;
+  ca_stride_compose_to_root((CAStride *) ca, &root, strides, &base);
+  return ca->bytes != root->bytes;
+}
+
+static void
+verify_mask_cells (VALUE klass, CArray *ca)
+{
+  if ( mask_cells_split(ca) ) {
+    rb_raise(rb_eArgError,
+             "%"PRIsVALUE" reinterprets the element size and carries a mask; "
+             "its mask cells do not map one to one onto the parent's",
+             klass);
+  }
+}
+
+/* Why an array would be refused for reading, or NULL. */
+static const char *
+read_refusal (CArray *ca)
+{
+  if ( ca->data_type == CA_OBJECT ) {
+    return "object arrays hold Ruby values, not numbers";
+  }
+  if ( mask_cells_split(ca) ) {
+    return "it reinterprets the element size and carries a mask";
+  }
+  return NULL;
+}
+
+/* CArray::AddressBasis::Failure.  An exception raised while the arrays are
+   checked, lent or taken back is extended with it; one raised by the block
+   they are lent to is not.  Something that hands the arrays to code of its
+   own can then tell a refusal or a failing array (a CAObject whose backing
+   cannot be read) from a fault of that code. */
+static VALUE mFailure;
+
+static void
+mark_failure (VALUE error)
+{
+  if ( RTEST(rb_obj_is_kind_of(error, rb_eException)) && ! OBJ_FROZEN(error) ) {
+    rb_extend_object(error, mFailure);
+  }
+}
+
+typedef struct {
+  VALUE   klass;
+  CArray *ca;
+  int     writable;
+} verify_args;
+
+static VALUE
+verify_array_body (VALUE argument)
+{
+  verify_args *a = (verify_args *) argument;
+  /* A view takes its mask from its parent when first asked for it; one
+     added to the parent after the view was made is not on ca->mask yet. */
+  ca_update_mask(a->ca);
+  verify_usable(a->klass, a->ca, a->writable);
+  verify_mask_cells(a->klass, a->ca);
+  return Qnil;
+}
+
+static void
+verify_array (VALUE klass, CArray *ca, int writable)
+{
+  verify_args a;
+  int         tag = 0;
+  a.klass = klass;
+  a.ca = ca;
+  a.writable = writable;
+  /* protect: marks the exception as a Failure and raises it again; nothing is held */
+  rb_protect(verify_array_body, (VALUE) &a, &tag);
+  if ( tag ) {
+    mark_failure(rb_errinfo());
+    rb_jump_tag(tag);
+  }
+}
+
 static int
 tier_for (CArray *ca)
 {
@@ -239,7 +342,7 @@ acquire_basis (open_state *state, int index, ca_size_t *strides)
   switch ( state->tier[index] ) {
   case TIER_ENTITY: {
     CArray *root = ca;
-    ca_attach(root);
+    ca_attach(root);   /* window: released by open_ensure */
     state->roots[index] = root;
     state->attached_root[index] = 1;
     row_major_strides(ca, strides);
@@ -250,18 +353,7 @@ acquire_basis (open_state *state, int index, ca_size_t *strides)
   case TIER_STRIDE: {
     CArray *root;
     ca_stride_compose_to_root((CAStride *) ca, &root, strides, &base);
-    /* A view that reinterprets the element size -- refer(CA_INT32, ...) over
-       a float64 array -- gets a mask of its own shape, but one mask cell of
-       it covers a fraction of a parent cell, so writing cell i's mask also
-       marks its neighbour.  A per-cell kernel writes cells independently and
-       cannot express that. */
-    if ( ca->mask && ca->bytes != root->bytes ) {
-      rb_raise(rb_eArgError,
-               "%"PRIsVALUE" reinterprets the element size and carries a mask; "
-               "its mask cells do not map one to one onto the parent's",
-               rb_obj_class(rb_ary_entry(state->arrays, index)));
-    }
-    ca_attach(root);
+    ca_attach(root);   /* window: released by open_ensure */
     state->roots[index] = root;
     state->attached_root[index] = 1;
     pointer = root->ptr + base;
@@ -287,12 +379,26 @@ acquire_basis (open_state *state, int index, ca_size_t *strides)
       step *= counts[k];
     }
 
-    buffer = ALLOC_N(char, (elements > 0 ? elements : 1) * ca->bytes);
+    /* Recorded before the read: the read can raise, and open_ensure
+       frees what state->region holds.  The counts stay zero until the
+       read is done, so a buffer that was never filled is not written
+       back. */
+    /* A writable box keeps a second copy of what it read, so that the
+       write-back can send only the cells the kernel changed (see
+       put_changed). */
+    buffer = ALLOC_N(char, (state->writable[index] ? 2 : 1)
+                           * (elements > 0 ? elements : 1) * ca->bytes);
+    for ( k = 0; k < ca->ndim; k++ ) {
+      state->region_count[index * CA_RANK_MAX + k] = 0;
+    }
+    state->region[index] = buffer;
     if ( elements > 0 ) {
       ca_xfer_stride(ca, starts, counts, steps, buffer, CA_XFER_GET);
+      if ( state->writable[index] ) {
+        memcpy(buffer + elements * ca->bytes, buffer, elements * ca->bytes);
+      }
     }
 
-    state->region[index] = buffer;
     for ( k = 0; k < ca->ndim; k++ ) {
       state->region_start[index * CA_RANK_MAX + k] = starts[k];
       state->region_count[index * CA_RANK_MAX + k] = counts[k];
@@ -350,20 +456,96 @@ open_body (VALUE argument)
     }
     rb_ary_push(state->bases, basis);
   }
-  return rb_yield(state->bases);
+  {
+    VALUE result;
+    state->lent = 1;
+    result = rb_yield(state->bases);
+    state->body_done = 1;
+    return result;
+  }
+}
+
+typedef struct {
+  CArray    *ca;
+  ca_size_t *start;
+  ca_size_t *count;
+  ca_size_t *steps;
+  char      *data;
+  char      *read;      /* the box as it was read */
+} write_back_args;
+
+/* Sends back the cells whose bytes differ from what was read, one run
+   along the last axis at a time.  Sending the whole box would also send the
+   cells the kernel never wrote, and those do not come back unchanged
+   through a view that converts -- a float64 array seen through an int32
+   view reads 1.75 as 1 and would be left holding 1.0.  It would also
+   overwrite what the kernel wrote to the same cells through another basis
+   that addresses them in place. */
+static VALUE
+write_back (VALUE argument)
+{
+  write_back_args *w = (write_back_args *) argument;
+  CArray   *ca    = w->ca;
+  int8_t    nd    = ca->ndim;
+  size_t    bytes = ca->bytes;
+  ca_size_t inner = w->count[nd - 1];
+  ca_size_t outer = 1;
+  ca_size_t idx[CA_RANK_MAX], start[CA_RANK_MAX], count[CA_RANK_MAX];
+  ca_size_t o, j, e;
+  int8_t    k;
+
+  for ( k = 0; k < nd - 1; k++ ) {
+    outer *= w->count[k];
+    idx[k] = 0;
+    count[k] = 1;
+  }
+  for ( o = 0; o < outer; o++ ) {
+    char *row  = w->data + o * inner * bytes;
+    char *read = w->read + o * inner * bytes;
+    for ( k = 0; k < nd - 1; k++ ) start[k] = w->start[k] + idx[k];
+    j = 0;
+    while ( j < inner ) {
+      if ( ! memcmp(row + j * bytes, read + j * bytes, bytes) ) { j++; continue; }
+      e = j + 1;
+      while ( e < inner && memcmp(row + e * bytes, read + e * bytes, bytes) ) e++;
+      start[nd - 1] = w->start[nd - 1] + j;
+      count[nd - 1] = e - j;
+      ca_xfer_stride(ca, start, count, w->steps, row + j * bytes, CA_XFER_PUT);
+      j = e;
+    }
+    for ( k = nd - 2; k >= 0; k-- ) {
+      if ( ++idx[k] < w->count[k] ) break;
+      idx[k] = 0;
+    }
+  }
+  return Qnil;
+}
+
+/* Closes in reverse order, and runs whether or not the kernel raised.  A
+   write-back that raises -- the array's own transfer slot failing -- is
+   set aside so that every other region is still written and freed and
+   every root detached; the block's own exception, if it raised, wins. */
+static VALUE
+sync_root (VALUE root)
+{
+  ca_sync((CArray *) root);
+  return Qnil;
 }
 
-/* Closes in reverse order, and runs whether or not the kernel raised. */
 static VALUE
 open_ensure (VALUE argument)
 {
   open_state *state = (open_state *) argument;
   int i;
+  /* Raised before the block was entered: by lending an array */
+  if ( ! state->lent ) mark_failure(rb_errinfo());
   for ( i = state->slots - 1; i >= 0; i-- ) {
     CArray *ca = state->carrays[i];
     if ( ca == NULL ) continue;
-    /* A tier-1 or tier-2 basis addresses the root's own memory, so a write is
-       already where it belongs.  Only a region buffer has to be sent back. */
+    /* A tier-1 or tier-2 basis addresses the root's own memory; the root is
+       synced before it is detached, for the entity that keeps its cells
+       elsewhere while attached (the mask of a CAObject that has mask
+       hooks).  A region buffer is sent back cell by cell. */
     if ( state->region[i] ) {
       ca_size_t elements = 1;
       int8_t k;
@@ -371,19 +553,48 @@ open_ensure (VALUE argument)
         elements *= state->region_count[i * CA_RANK_MAX + k];
       }
       if ( state->writable[i] && elements > 0 ) {
-        ca_size_t steps[CA_RANK_MAX];
+        ca_size_t       steps[CA_RANK_MAX];
+        write_back_args w;
+        int             tag = 0;
         native_steps(ca, steps);
-        ca_xfer_stride(ca, &state->region_start[i * CA_RANK_MAX],
-                       &state->region_count[i * CA_RANK_MAX],
-                       steps, state->region[i], CA_XFER_PUT);
+        w.ca    = ca;
+        w.start = &state->region_start[i * CA_RANK_MAX];
+        w.count = &state->region_count[i * CA_RANK_MAX];
+        w.steps = steps;
+        w.data  = state->region[i];
+        w.read  = state->region[i] + elements * ca->bytes;
+        /* protect: keeps the error so that every region is written back first */
+        rb_protect(write_back, (VALUE) &w, &tag);
+        if ( tag ) {
+          if ( NIL_P(state->put_error) ) {
+            state->put_error = rb_errinfo();
+          }
+          rb_set_errinfo(Qnil);
+        }
       }
       xfree(state->region[i]);
     }
     if ( state->attached_root[i] ) {
+      if ( ! ca_is_readonly(state->roots[i]) ) {
+        int tag = 0;
+        /* protect: keeps the error so that every root is detached first */
+        rb_protect(sync_root, (VALUE) state->roots[i], &tag);
+        if ( tag ) {
+          if ( NIL_P(state->put_error) ) {
+            state->put_error = rb_errinfo();
+          }
+          rb_set_errinfo(Qnil);
+        }
+      }
       ca_detach(state->roots[i]);
     }
   }
   xfree(state->block);
+  if ( state->body_done && RTEST(rb_obj_is_kind_of(state->put_error,
+                                                   rb_eException)) ) {
+    mark_failure(state->put_error);
+    rb_exc_raise(state->put_error);
+  }
   return Qnil;
 }
 
@@ -450,8 +661,98 @@ packed_body (VALUE argument)
       for ( k = 0; k < ca->ndim; k++ ) *mask_stride_slot++ = 0;
     }
   }
+  /* The slots point into the four Strings, and acquire_basis allocates:
+     a String the stack holds is pinned, so compaction leaves it be. */
+  RB_GC_GUARD(pointers);
+  RB_GC_GUARD(strides);
+  RB_GC_GUARD(mask_pointers);
+  RB_GC_GUARD(mask_strides);
 
-  return rb_yield_values(4, pointers, strides, mask_pointers, mask_strides);
+  {
+    VALUE result;
+    state->lent = 1;
+    result = rb_yield_values(4, pointers, strides, mask_pointers, mask_strides);
+    state->body_done = 1;
+    return result;
+  }
+}
+
+/* Allocates the state for n arrays and fills it: the arrays and their masks,
+   their tiers, which ones are written, and the boxes.  The caller has
+   checked every argument already: nothing here raises, so a refusal never
+   finds a block to free.  `box_start` / `box_count` may be NULL (every
+   array whole), and an entry of them may be NULL (that array whole). */
+static void
+ab_prepare (open_state *state, int n, CArray **arrays, const int *writable,
+            const ca_size_t *const *box_start, const ca_size_t *const *box_count)
+{
+  int i;
+
+  state->count = n;
+  state->slots = n * 2;
+  /* One allocation, carved up.  Every array here is the same length in
+     slots and lives exactly as long as the open, so there is nothing for
+     separate lifetimes to buy -- and this is a per-call cost on a path
+     whose whole point is to be cheap enough to cross often.  Zeroed once
+     as a block, which is also what the slots want to start as: a NULL
+     array, a NULL root, not writable, not attached, no region, no box. */
+  {
+    size_t m        = (size_t) state->slots + 1;
+    size_t pointers = ROUND_UP_8(m * sizeof(CArray *));
+    size_t chars    = ROUND_UP_8(m * sizeof(char *));
+    size_t sizes    = ROUND_UP_8(m * CA_RANK_MAX * sizeof(ca_size_t));
+    size_t ints     = ROUND_UP_8(m * sizeof(int));
+    size_t bases    = ROUND_UP_8((size_t) (n + 1) * sizeof(ca_address_basis_t));
+    size_t total = 2 * pointers + chars + 4 * sizes + 4 * ints + bases;
+    char  *p;
+    state->block = ALLOC_N(char, total);
+    MEMZERO(state->block, char, total);
+    p = state->block;
+    state->carrays       = (CArray **)  p; p += pointers;
+    state->roots         = (CArray **)  p; p += pointers;
+    state->region        = (char **)    p; p += chars;
+    state->region_start  = (ca_size_t *) p; p += sizes;
+    state->region_count  = (ca_size_t *) p; p += sizes;
+    state->box_start     = (ca_size_t *) p; p += sizes;
+    state->box_count     = (ca_size_t *) p; p += sizes;
+    state->tier          = (int *)      p; p += ints;
+    state->writable      = (int *)      p; p += ints;
+    state->attached_root = (int *)      p; p += ints;
+    state->has_box       = (int *)      p; p += ints;
+    state->c_bases       = (ca_address_basis_t *) p;
+  }
+  state->lent = 0;
+  state->body_done = 0;
+  state->put_error = Qnil;
+
+  for ( i = 0; i < n; i++ ) {
+    CArray *ca = arrays[i];
+    state->carrays[i]  = ca;
+    state->writable[i] = writable ? writable[i] : 0;
+    state->tier[i]     = tier_for(ca);
+    if ( box_start && box_start[i] ) {
+      state->has_box[i] = 1;
+      memcpy(&state->box_start[i * CA_RANK_MAX], box_start[i],
+             ca->ndim * sizeof(ca_size_t));
+      memcpy(&state->box_count[i * CA_RANK_MAX], box_count[i],
+             ca->ndim * sizeof(ca_size_t));
+    }
+    if ( ca->mask ) {
+      CArray *mask = ca->mask;
+      state->carrays[n + i]  = mask;
+      state->writable[n + i] = state->writable[i];
+      state->tier[n + i]     = tier_for(mask);
+      /* The mask is the array's shape, so the array's box is its box: a
+         tier-3 mask moves the cells the kernel asked for, not all of them. */
+      if ( state->has_box[i] ) {
+        state->has_box[n + i] = 1;
+        memcpy(&state->box_start[(n + i) * CA_RANK_MAX], box_start[i],
+               ca->ndim * sizeof(ca_size_t));
+        memcpy(&state->box_count[(n + i) * CA_RANK_MAX], box_count[i],
+               ca->ndim * sizeof(ca_size_t));
+      }
+    }
+  }
 }
 
 /*
@@ -468,7 +769,7 @@ address_basis_open (int argc, VALUE *argv, VALUE module)
 {
   VALUE arrays, writable_flags, box_start, box_count, packed;
   open_state state;
-  int i;
+  int i, n;
 
   rb_scan_args(argc, argv, "23", &arrays, &writable_flags, &box_start,
                &box_count, &packed);
@@ -488,63 +789,140 @@ address_basis_open (int argc, VALUE *argv, VALUE module)
   if ( RARRAY_LEN(arrays) != RARRAY_LEN(writable_flags) ) {
     rb_raise(rb_eArgError, "one writable flag per array is required");
   }
+  n = (int) RARRAY_LEN(arrays);
 
-  state.count         = (int) RARRAY_LEN(arrays);
-  state.slots         = state.count * 2;
-  state.arrays        = arrays;
-  state.bases         = rb_ary_new_capa(state.count);
-  /* One allocation, carved up, rather than eight.  Every array here is the
-     same length in slots and lives exactly as long as the open, so there is
-     nothing for eight separate lifetimes to buy -- and this is a per-call
-     cost on a path whose whole point is to be cheap enough to cross often.
-     Zeroed once as a block, which is also what the slots want to start as:
-     a NULL array, a NULL root, not writable, not attached, no region. */
-  {
-    size_t n        = (size_t) state.slots + 1;
-    size_t pointers = ROUND_UP_8(n * sizeof(CArray *));
-    size_t chars    = ROUND_UP_8(n * sizeof(char *));
-    size_t sizes    = ROUND_UP_8(n * CA_RANK_MAX * sizeof(ca_size_t));
-    size_t ints     = ROUND_UP_8(n * sizeof(int));
-    size_t total = 2 * pointers + chars + 2 * sizes + 3 * ints;
-    char  *p;
-    state.block = ALLOC_N(char, total);
-    MEMZERO(state.block, char, total);
-    p = state.block;
-    state.carrays       = (CArray **)  p; p += pointers;
-    state.roots         = (CArray **)  p; p += pointers;
-    state.region        = (char **)    p; p += chars;
-    state.region_start  = (ca_size_t *) p; p += sizes;
-    state.region_count  = (ca_size_t *) p; p += sizes;
-    state.tier          = (int *)      p; p += ints;
-    state.writable      = (int *)      p; p += ints;
-    state.attached_root = (int *)      p;
-  }
-  state.box_starts    = box_start;
-  state.box_counts    = box_count;
-
-  for ( i = 0; i < state.count; i++ ) {
+  /* Every argument is checked before the state is allocated: a refusal
+     raises, and it must find nothing to free. */
+  for ( i = 0; i < n; i++ ) {
     VALUE   object = rb_ary_entry(arrays, i);
     CArray *ca;
     GetCArray(object, ca);
-    state.carrays[i]  = ca;
-    state.writable[i] = RTEST(rb_ary_entry(writable_flags, i));
-    verify_usable(object, ca, state.writable[i]);
+    verify_array(rb_obj_class(object), ca, RTEST(rb_ary_entry(writable_flags, i)));
     verify_box(box_start, box_count, i, ca);
-    state.tier[i] = tier_for(ca);
+  }
 
-    if ( ca->mask ) {
-      CArray *mask = ca->mask;
-      state.carrays[state.count + i]  = mask;
-      state.writable[state.count + i] = state.writable[i];
-      state.tier[state.count + i] = tier_for(mask);
+  {
+    /* The boxes and flags in C form, on the stack: they are copied into
+       the state, and nothing below raises before that. */
+    /* Laid out widest first, so every part is aligned. */
+    VALUE      vholder = 0;
+    CArray   **carrays = (CArray **) ALLOCV(vholder, (size_t) n * (sizeof(CArray *)
+                           + 2 * sizeof(ca_size_t *)
+                           + 2 * CA_RANK_MAX * sizeof(ca_size_t)
+                           + sizeof(int)) + 1);
+    const ca_size_t **bs = (const ca_size_t **) (carrays + n);
+    const ca_size_t **bc = bs + n;
+    ca_size_t *cells   = (ca_size_t *) (bc + n);
+    int       *flags   = (int *) (cells + (size_t) n * 2 * CA_RANK_MAX);
+    for ( i = 0; i < n; i++ ) {
+      VALUE   object = rb_ary_entry(arrays, i);
+      VALUE   starts = NIL_P(box_start) ? Qnil : rb_ary_entry(box_start, i);
+      VALUE   counts = NIL_P(box_count) ? Qnil : rb_ary_entry(box_count, i);
+      int8_t  k;
+      GetCArray(object, carrays[i]);
+      flags[i] = RTEST(rb_ary_entry(writable_flags, i));
+      bs[i] = bc[i] = NULL;
+      if ( ! NIL_P(starts) ) {
+        ca_size_t *s0 = cells + (size_t) i * 2 * CA_RANK_MAX;
+        ca_size_t *c0 = s0 + CA_RANK_MAX;
+        for ( k = 0; k < carrays[i]->ndim; k++ ) {
+          s0[k] = NUM2LL(rb_ary_entry(starts, k));
+          c0[k] = NUM2LL(rb_ary_entry(counts, k));
+        }
+        bs[i] = s0;
+        bc[i] = c0;
+      }
+    }
+    ab_prepare(&state, n, carrays, flags, bs, bc);
+    ALLOCV_END(vholder);
+  }
+  /* Our own copy: the caller's Array can be emptied inside the block, and
+     the arrays it held are attached until open_ensure has run. */
+  state.arrays = rb_ary_dup(arrays);
+  state.bases  = rb_ary_new_capa(n);
+
+  {
+    VALUE result = RTEST(packed)
+      ? rb_ensure(packed_body, (VALUE) &state, open_ensure, (VALUE) &state)
+      : rb_ensure(open_body, (VALUE) &state, open_ensure, (VALUE) &state);
+    RB_GC_GUARD(state.arrays);
+    return result;
+  }
+}
+
+/* The body of ca_with_address_bases: lends each array's basis, then runs
+   the caller's body on them. */
+static VALUE
+c_body (VALUE argument)
+{
+  open_state *state = (open_state *) argument;
+  int i;
+  for ( i = 0; i < state->count; i++ ) {
+    ca_address_basis_t *b = &state->c_bases[i];
+    b->ptr      = acquire_basis(state, i, b->strides);
+    b->writable = state->writable[i];
+    if ( state->carrays[state->count + i] ) {
+      b->mask = (boolean8_t *) acquire_basis(state, state->count + i,
+                                             b->mask_strides);
     }
   }
+  {
+    VALUE result;
+    state->lent = 1;
+    result = state->c_body(state->c_bases, state->c_arg);
+    state->body_done = 1;
+    return result;
+  }
+}
 
-  if ( RTEST(packed) ) {
-    return rb_ensure(packed_body, (VALUE) &state, open_ensure, (VALUE) &state);
-  } else {
-    return rb_ensure(open_body, (VALUE) &state, open_ensure, (VALUE) &state);
+VALUE
+ca_with_address_bases (int32_t n, CArray **arrays, const int *writable,
+                       const ca_size_t *const *box_start,
+                       const ca_size_t *const *box_count,
+                       VALUE (*body)(ca_address_basis_t *bases, VALUE arg),
+                       VALUE arg)
+{
+  open_state state;
+  int32_t    i;
+  int8_t     k;
+
+  if ( n < 0 || (n > 0 && arrays == NULL) || body == NULL ) {
+    rb_raise(rb_eArgError, "ca_with_address_bases: no arrays or no body");
+  }
+  if ( (box_start == NULL) != (box_count == NULL) ) {
+    rb_raise(rb_eArgError, "a region needs both starts and counts");
   }
+  /* Every argument is checked before the state is allocated. */
+  for ( i = 0; i < n; i++ ) {
+    CArray *ca = arrays[i];
+    VALUE   klass;
+    if ( ca == NULL ) {
+      rb_raise(rb_eArgError, "ca_with_address_bases: array %d is NULL", (int) i);
+    }
+    /* a CAObject (a Face among them) is named by its own class */
+    klass = ca_is_caobject(ca) ? rb_obj_class(((CAObject *) ca)->self)
+                               : ca_class[ca->obj_type];
+    verify_array(klass, ca, writable ? writable[i] : 0);
+    if ( box_start && ((box_start[i] == NULL) != (box_count[i] == NULL)) ) {
+      rb_raise(rb_eArgError, "a region needs both starts and counts");
+    }
+    if ( box_start && box_start[i] ) {
+      for ( k = 0; k < ca->ndim; k++ ) {
+        if ( outside_axis(box_start[i][k], box_count[i][k], ca->dim[k]) ) {
+          rb_raise(rb_eArgError,
+                   "the requested region falls outside the array on axis %d",
+                   (int) k);
+        }
+      }
+    }
+  }
+
+  ab_prepare(&state, (int) n, arrays, writable, box_start, box_count);
+  state.arrays = Qnil;
+  state.bases  = Qnil;
+  state.c_body = body;
+  state.c_arg  = arg;
+  return rb_ensure(c_body, (VALUE) &state, open_ensure, (VALUE) &state);
 }
 
 /* Reports how an array would be opened, without opening it. */
@@ -556,6 +934,7 @@ address_basis_classify (VALUE module, VALUE object)
   int     tier;
 
   GetCArray(object, ca);
+  ca_update_mask(ca);
   tier = tier_for(ca);
 
   result = rb_hash_new();
@@ -568,9 +947,24 @@ address_basis_classify (VALUE module, VALUE object)
   rb_hash_aset(result, ID2SYM(rb_intern("dim")), size_array(ca->dim, ca->ndim));
   rb_hash_aset(result, ID2SYM(rb_intern("bytes")), LL2NUM((long long) ca->bytes));
   rb_hash_aset(result, ID2SYM(rb_intern("data_type")), INT2NUM(ca->data_type));
+  {
+    const char *refusal = read_refusal(ca);
+    rb_hash_aset(result, ID2SYM(rb_intern("refusal")),
+                 refusal ? rb_str_new_cstr(refusal) : Qnil);
+  }
   return result;
 }
 
+/* The tier alone, for a caller that only wants to know which of the three
+   an array would be opened at: classify builds a Hash to say it. */
+static VALUE
+address_basis_tier (VALUE module, VALUE object)
+{
+  CArray *ca;
+  GetCArray(object, ca);
+  return INT2NUM(tier_for(ca));
+}
+
 /* ------------------------------------------------------------------- */
 /* Init_carray_address_basis                                            */
 /* ------------------------------------------------------------------- */
@@ -583,8 +977,11 @@ Init_carray_address_basis (void)
   rb_define_singleton_method(mAddressBasis, "open", address_basis_open, -1);
   rb_define_singleton_method(mAddressBasis, "classify",
                              address_basis_classify, 1);
+  rb_define_singleton_method(mAddressBasis, "tier", address_basis_tier, 1);
 
   rb_define_const(mAddressBasis, "TIER_ENTITY", INT2NUM(TIER_ENTITY));
   rb_define_const(mAddressBasis, "TIER_STRIDE", INT2NUM(TIER_STRIDE));
   rb_define_const(mAddressBasis, "TIER_XFER", INT2NUM(TIER_XFER));
+
+  mFailure = rb_define_module_under(mAddressBasis, "Failure");
 }