carray 3.0.2 → 3.0.3

data/ext/ca_obj_object.c

@@ -34,6 +34,7 @@
  */
 
 #include "carray.h"
+#include "carray_internal.h"
 #include "ca_obj_face.h"  /* ca_face_* helpers for Face mode shortcuts */
 
 static size_t
@@ -82,11 +83,21 @@ ca_objectmask_dsize (const void *ap)
   return sizeof(CAObjectMask) + ca->ndim * sizeof(ca_size_t);
 }
 
+/* The mask reads and writes through its CAObject, and its cache is the
+   CAObject's; it keeps the CAObject alive. */
+static void
+ca_objmask_mark (void *ap)
+{
+  CAObjectMask *ca = (CAObjectMask *) ap;
+  rb_gc_mark(ca->array);
+  ca_mark(ap);
+}
+
 const rb_data_type_t caobjectmask_data_type = {
     .parent = &carray_data_type,
     .wrap_struct_name = "CAObjectMask",
     .function = {
-        .dmark = ca_mark,
+        .dmark = ca_objmask_mark,
         .dfree = ca_free,
         .dsize = ca_objectmask_dsize,
         .dcompact = NULL
@@ -110,6 +121,8 @@ ca_objmask_new (VALUE array, int8_t ndim, ca_size_t *dim)
   ca_wrap_setup_null((CArray *)ca, CA_BOOLEAN, ndim, dim, 0, NULL);
   ca->obj_type = CA_OBJ_OBJECT_MASK;
   ca->array = array;
+  ca->cache = NULL;
+  ca->holds = 0;
 
   return ca;
 }
@@ -122,125 +135,358 @@ ca_objmask_mask_data (void *ap)
                     rb_intern("mask"), 0);
 }
 
+/* Calls recv.mid(arg(ap)) with *slot pointing at a caller's buffer for
+   the duration, and puts *slot back however the call leaves.  The bulk
+   bridge lends the buffer this way so that copy_data / sync_data write
+   straight into it; a raise that skipped the restore would leave the
+   array pointing at a buffer its caller is about to free. */
+
+typedef struct {
+  char  **slot;
+  char   *saved;
+  VALUE   recv;
+  ID      mid;
+  VALUE (*arg)(void *);
+  void   *ap;
+} ca_object_lend_t;
+
+static VALUE
+ca_object_lend_body (VALUE varg)
+{
+  ca_object_lend_t *l = (ca_object_lend_t *) varg;
+  return rb_funcall(l->recv, l->mid, 1, l->arg(l->ap));
+}
+
+static VALUE
+ca_object_lend_restore (VALUE varg)
+{
+  ca_object_lend_t *l = (ca_object_lend_t *) varg;
+  *l->slot = l->saved;
+  return Qnil;
+}
+
+static void
+ca_object_call_lending (char **slot, void *ptr, VALUE recv, const char *mid,
+                        VALUE (*arg)(void *), void *ap)
+{
+  ca_object_lend_t l;
+  l.slot  = slot;
+  l.saved = *slot;
+  l.recv  = recv;
+  l.mid   = rb_intern(mid);
+  l.arg   = arg;
+  l.ap    = ap;
+  *slot = (char *) ptr;
+  rb_ensure(ca_object_lend_body, (VALUE) &l,
+            ca_object_lend_restore, (VALUE) &l);
+}
+
+/* Calls recv.mid(*argv), where some of argv are transient wraps of a
+   caller's buffer (ca_object_wrap_transient), and takes the buffer back
+   from each of them however the call leaves.  The caller frees its buffer
+   when it returns, and a wrap outlives the call: the collector scans the
+   machine stack conservatively and still finds it there, and an object
+   wrap is marked cell by cell -- through a buffer that is gone.  A wrap
+   taken back points at nothing; a hook that kept it holds an empty
+   handle, not a stale one. */
+
+typedef struct {
+  VALUE        recv;
+  ID           mid;
+  int          argc;
+  const VALUE *argv;
+  int          ntrans;
+  const VALUE *trans;
+} ca_object_hook_t;
+
+static VALUE
+ca_object_hook_body (VALUE varg)
+{
+  ca_object_hook_t *h = (ca_object_hook_t *) varg;
+  return rb_funcallv(h->recv, h->mid, h->argc, h->argv);
+}
+
+static VALUE
+ca_object_hook_release (VALUE varg)
+{
+  ca_object_hook_t *h = (ca_object_hook_t *) varg;
+  int i;
+  for ( i = 0; i < h->ntrans; i++ ) {
+    ((CArray *) DATA_PTR(h->trans[i]))->ptr = NULL;
+  }
+  return Qnil;
+}
+
+static void
+ca_object_call_transient (VALUE recv, const char *mid,
+                          int argc, const VALUE *argv,
+                          int ntrans, const VALUE *trans)
+{
+  ca_object_hook_t h;
+  h.recv   = recv;
+  h.mid    = rb_intern(mid);
+  h.argc   = argc;
+  h.argv   = argv;
+  h.ntrans = ntrans;
+  h.trans  = trans;
+  rb_ensure(ca_object_hook_body, (VALUE) &h,
+            ca_object_hook_release, (VALUE) &h);
+}
+
+static VALUE
+ca_object_data_of (void *ap)
+{
+  return rb_ivar_get(((CAObject *) ap)->self, rb_intern("__data__"));
+}
+
+
+/* Forward declaration: ca_object_wrap_transient (defined further down,
+   near the data-side xfer functions). */
+static VALUE
+ca_object_wrap_transient (int8_t data_type, ca_size_t bytes,
+                          int8_t ndim, ca_size_t *dim, void *data, int dir);
+
 static void *
 ca_objmask_func_clone (void *ap)
 {
   CAObjectMask *ca = (CAObjectMask *) ap;
-  return ca_objmask_new(ca->array, ca->ndim, ca->dim);
+  CAObjectMask *co = ca_objmask_new(ca->array, ca->ndim, ca->dim);
+  co->cache = ca->cache;
+  return co;
 }
 
-/* per-cell cores: objmask reads/writes its own CA_BOOLEAN bit storage
-   (a contiguous wrap over the shared mask bytes) AND mirrors through the
-   user's Ruby mask_fetch_* / mask_store_* callbacks.  Entity bit access
-   goes through ca_array_func_xfer_index / xfer_addrs.  GET/PUT
-   direction-unified; the slots below forward. */
-static void
-ca_objmask_xfer_addr_one (CAObjectMask *ca, ca_size_t addr, void *ptr, int dir)
+/* Whether the CAObject answers one of the mask hooks.  A copy made by dup
+   holds its own bits and answers none (array is nil). */
+static int
+ca_objmask_answers (CAObjectMask *ca, const char *mid)
 {
-  volatile VALUE ridx, raddr, rval;
+  return ! NIL_P(ca->array) && rb_obj_respond_to(ca->array, rb_intern(mid), Qtrue);
+}
+
+static VALUE
+ca_objmask_index_of (CAObjectMask *ca, ca_size_t addr)
+{
+  ca_size_t idx[CA_RANK_MAX];
+  VALUE ridx;
   int i;
-  if ( dir == CA_XFER_GET ) {
-    if ( rb_obj_respond_to(ca->array, rb_intern("mask_fetch_addr"), Qtrue) ) {
-      raddr = SIZE2NUM(addr);
-      rval = rb_funcall(ca->array, rb_intern("mask_fetch_addr"), 1, raddr);
-      *(uint8_t*) ptr = NUM2INT(rval) == 0 ? 0 : 1;
-      ca_array_func_xfer_addrs(ca, 1, &addr, ptr, CA_XFER_PUT);
-    }
-    else if ( rb_obj_respond_to(ca->array, rb_intern("mask_fetch_index"), Qtrue) ) {
-      ca_size_t idx[CA_RANK_MAX];
-      ca_addr2index((CArray *)ca, addr, idx);
-      ridx = rb_ary_new2(ca->ndim);
-      for (i=0; i<ca->ndim; i++) {
-        rb_ary_store(ridx, i, SIZE2NUM(idx[i]));
-      }
-      rval = rb_funcall(ca->array, rb_intern("mask_fetch_index"), 1, ridx);
-      *(uint8_t*) ptr = NUM2INT(rval) == 0 ? 0 : 1;
-      ca_array_func_xfer_index(ca, idx, ptr, CA_XFER_PUT);
-    }
-    else {
-      ca_array_func_xfer_addrs(ca, 1, &addr, ptr, CA_XFER_GET);
-    }
+  ca_addr2index((CArray *) ca, addr, idx);
+  ridx = rb_ary_new2(ca->ndim);
+  for (i=0; i<ca->ndim; i++) {
+    rb_ary_store(ridx, i, SIZE2NUM(idx[i]));
+  }
+  return ridx;
+}
+
+/* The bit the per-cell hooks give for addr (1 / 0 / true / false), or -1
+   when the object has neither mask_fetch_addr nor mask_fetch_index. */
+static int
+ca_objmask_fetch_one (CAObjectMask *ca, ca_size_t addr)
+{
+  volatile VALUE rval;
+  if ( ca_objmask_answers(ca, "mask_fetch_addr") ) {
+    rval = rb_funcall(ca->array, rb_intern("mask_fetch_addr"), 1, SIZE2NUM(addr));
+  }
+  else if ( ca_objmask_answers(ca, "mask_fetch_index") ) {
+    rval = rb_funcall(ca->array, rb_intern("mask_fetch_index"), 1,
+                      ca_objmask_index_of(ca, addr));
   }
   else {
-    ca_array_func_xfer_addrs(ca, 1, &addr, ptr, CA_XFER_PUT);
-    rval = INT2NUM( *(uint8_t*)ptr );
-    if ( rb_obj_respond_to(ca->array, rb_intern("mask_store_addr"), Qtrue) ) {
-      raddr = SIZE2NUM(addr);
-      rb_funcall(ca->array, rb_intern("mask_store_addr"), 2, raddr, rval);
+    return -1;
+  }
+  if ( rval == Qtrue || rval == Qfalse ) {
+    return RTEST(rval);
+  }
+  return NUM2INT(rval) != 0;
+}
+
+/* Hands one bit to the per-cell hooks; 0 when the object has neither
+   mask_store_addr nor mask_store_index. */
+static int
+ca_objmask_store_one (CAObjectMask *ca, ca_size_t addr, boolean8_t bit)
+{
+  if ( ca_objmask_answers(ca, "mask_store_addr") ) {
+    rb_funcall(ca->array, rb_intern("mask_store_addr"), 2,
+               SIZE2NUM(addr), INT2NUM(bit ? 1 : 0));
+    return 1;
+  }
+  if ( ca_objmask_answers(ca, "mask_store_index") ) {
+    rb_funcall(ca->array, rb_intern("mask_store_index"), 2,
+               ca_objmask_index_of(ca, addr), INT2NUM(bit ? 1 : 0));
+    return 1;
+  }
+  return 0;
+}
+
+static int
+ca_objmask_stores_cells (CAObjectMask *ca)
+{
+  return ca_objmask_answers(ca, "mask_store_addr") ||
+         ca_objmask_answers(ca, "mask_store_index");
+}
+
+/* Brings the cache up to date from the hooks that give the mask: the bulk
+   one, else the per-cell one.  With neither, the cache is the mask. */
+static void
+ca_objmask_refresh (CAObjectMask *ca)
+{
+  boolean8_t *c = (boolean8_t *) ca->cache;
+  ca_size_t addr;
+  int bit;
+  if ( ca_objmask_answers(ca, "mask_copy_data") ) {
+    rb_funcall(ca->array, rb_intern("mask_copy_data"), 1,
+               ca_objmask_mask_data(ca));
+    return;
+  }
+  for ( addr = 0; addr < ca->elements; addr++ ) {
+    if ( ( bit = ca_objmask_fetch_one(ca, addr) ) < 0 ) {
+      return;
     }
-    else if ( rb_obj_respond_to(ca->array, rb_intern("mask_store_index"), Qtrue) ) {
-      ca_size_t idx[CA_RANK_MAX];
-      ca_addr2index((CArray *)ca, addr, idx);
-      ridx = rb_ary_new2(ca->ndim);
-      for (i=0; i<ca->ndim; i++) {
-        rb_ary_store(ridx, i, SIZE2NUM(idx[i]));
-      }
-      rb_funcall(ca->array, rb_intern("mask_store_index"), 2, ridx, rval);
+    c[addr] = (boolean8_t) bit;
+  }
+}
+
+/* Hands the whole cache to the hooks that take the mask: the bulk one,
+   else the per-cell one. */
+static void
+ca_objmask_push (CAObjectMask *ca)
+{
+  const boolean8_t *c = (const boolean8_t *) ca->cache;
+  ca_size_t addr;
+  if ( ca_objmask_answers(ca, "mask_sync_data") ) {
+    rb_funcall(ca->array, rb_intern("mask_sync_data"), 1,
+               ca_objmask_mask_data(ca));
+    return;
+  }
+  for ( addr = 0; addr < ca->elements; addr++ ) {
+    if ( ! ca_objmask_store_one(ca, addr, c[addr]) ) {
+      return;
     }
   }
 }
 
+/* Reads n bits at addrs while the mask is closed: mask_copy_addrs, else
+   the per-cell hooks, else the whole mask brought up to date. */
 static void
-ca_objmask_xfer_index_one (CAObjectMask *ca, ca_size_t *idx, void *ptr, int dir)
+ca_objmask_get_cells (CAObjectMask *ca, ca_size_t n, ca_size_t *addrs,
+                      boolean8_t *bits)
 {
-  volatile VALUE ridx, raddr, rval;
-  int i;
-  if ( dir == CA_XFER_GET ) {
-    if ( rb_obj_respond_to(ca->array, rb_intern("mask_fetch_index"), Qtrue) ) {
-      ridx = rb_ary_new2(ca->ndim);
-      for (i=0; i<ca->ndim; i++) {
-        rb_ary_store(ridx, i, SIZE2NUM(idx[i]));
-      }
-      rval = rb_funcall(ca->array, rb_intern("mask_fetch_index"), 1, ridx);
-      *(uint8_t*) ptr = NUM2INT(rval) == 0 ? 0 : 1;
-      ca_array_func_xfer_index(ca, idx, ptr, CA_XFER_PUT);
+  boolean8_t *c = (boolean8_t *) ca->cache;
+  ca_size_t i;
+  int bit;
+  if ( n > 0 && ca_objmask_answers(ca, "mask_copy_addrs") ) {
+    volatile VALUE raddrs, rdata;
+    ca_size_t dim1[1] = { n };
+    raddrs = ca_object_wrap_transient(CA_SIZE, sizeof(ca_size_t),
+                                      1, dim1, addrs, CA_XFER_PUT);
+    rdata  = ca_object_wrap_transient(CA_BOOLEAN, 1, 1, dim1, bits,
+                                      CA_XFER_GET);
+    {
+      VALUE args[2];
+      args[0] = raddrs;
+      args[1] = rdata;
+      ca_object_call_transient(ca->array, "mask_copy_addrs", 2, args, 2, args);
     }
-    else if ( rb_obj_respond_to(ca->array, rb_intern("mask_fetch_addr"), Qtrue) ) {
-      ca_size_t addr = ca_index2addr((CArray *)ca, idx);
-      raddr = SIZE2NUM(addr);
-      rval = rb_funcall(ca->array, rb_intern("mask_fetch_addr"), 1, raddr);
-      *(uint8_t*) ptr = NUM2INT(rval) == 0 ? 0 : 1;
-      ca_array_func_xfer_addrs(ca, 1, &addr, ptr, CA_XFER_PUT);
+    return;
+  }
+  if ( n > 0 && ( bit = ca_objmask_fetch_one(ca, addrs[0]) ) >= 0 ) {
+    c[addrs[0]] = bits[0] = (boolean8_t) bit;
+    for ( i = 1; i < n; i++ ) {
+      c[addrs[i]] = bits[i] = (boolean8_t) ca_objmask_fetch_one(ca, addrs[i]);
     }
-    else {
-      ca_array_func_xfer_index(ca, idx, ptr, CA_XFER_GET);
+    return;
+  }
+  ca_objmask_refresh(ca);
+  for ( i = 0; i < n; i++ ) {
+    bits[i] = c[addrs[i]];
+  }
+}
+
+/* Writes n bits at addrs while the mask is closed, and hands them over:
+   one by one to the per-cell hooks, as a list to mask_sync_addrs, or else
+   the whole mask to mask_sync_data -- brought up to date first, so that
+   the cells not written go back as they were. */
+static void
+ca_objmask_put_cells (CAObjectMask *ca, ca_size_t n, ca_size_t *addrs,
+                      const boolean8_t *bits)
+{
+  boolean8_t *c = (boolean8_t *) ca->cache;
+  ca_size_t i;
+  if ( ca_objmask_stores_cells(ca) ) {
+    for ( i = 0; i < n; i++ ) {
+      c[addrs[i]] = bits[i] ? 1 : 0;
+      ca_objmask_store_one(ca, addrs[i], c[addrs[i]]);
     }
+    return;
   }
-  else {
-    ca_array_func_xfer_index(ca, idx, ptr, CA_XFER_PUT);
-    rval = INT2NUM( *(uint8_t*)ptr );
-    if ( rb_obj_respond_to(ca->array, rb_intern("mask_store_index"), Qtrue) ) {
-      ridx = rb_ary_new2(ca->ndim);
-      for (i=0; i<ca->ndim; i++) {
-        rb_ary_store(ridx, i, SIZE2NUM(idx[i]));
-      }
-      rb_funcall(ca->array, rb_intern("mask_store_index"), 2, ridx, rval);
+  if ( n > 0 && ca_objmask_answers(ca, "mask_sync_addrs") ) {
+    volatile VALUE raddrs, rdata;
+    ca_size_t dim1[1] = { n };
+    for ( i = 0; i < n; i++ ) {
+      c[addrs[i]] = bits[i] ? 1 : 0;
     }
-    else if ( rb_obj_respond_to(ca->array, rb_intern("mask_store_addr"), Qtrue) ) {
-      ca_size_t addr = ca_index2addr((CArray *)ca, idx);
-      raddr = SIZE2NUM(addr);
-      rb_funcall(ca->array, rb_intern("mask_store_addr"), 2, raddr, rval);
+    raddrs = ca_object_wrap_transient(CA_SIZE, sizeof(ca_size_t),
+                                      1, dim1, addrs, CA_XFER_PUT);
+    rdata  = ca_object_wrap_transient(CA_BOOLEAN, 1, 1, dim1, (void *) bits,
+                                      CA_XFER_PUT);
+    {
+      VALUE args[2];
+      args[0] = raddrs;
+      args[1] = rdata;
+      ca_object_call_transient(ca->array, "mask_sync_addrs", 2, args, 2, args);
     }
+    return;
+  }
+  if ( ca_objmask_answers(ca, "mask_sync_data") ) {
+    ca_objmask_refresh(ca);
   }
+  for ( i = 0; i < n; i++ ) {
+    c[addrs[i]] = bits[i] ? 1 : 0;
+  }
+  ca_objmask_push(ca);
+}
+
+/* Open: the cache is published in ptr, and it is the mask until the sync
+   hands it over.  The first attach reads the mask in; an allocate does
+   not, since whoever allocates writes every cell. */
+static void
+ca_objmask_open (CAObjectMask *ca, int refresh)
+{
+  if ( ca->holds == 0 ) {
+    if ( refresh ) {
+      ca_objmask_refresh(ca);
+    }
+    ca->ptr = ca->cache;
+  }
+  ca->holds++;
+}
+
+static void
+ca_objmask_func_allocate (void *ap)
+{
+  ca_objmask_open((CAObjectMask *) ap, 0);
 }
 
 static void
 ca_objmask_func_attach (void *ap)
+{
+  ca_objmask_open((CAObjectMask *) ap, 1);
+}
+
+static void
+ca_objmask_func_sync (void *ap)
 {
   CAObjectMask *ca = (CAObjectMask *) ap;
-  if ( rb_obj_respond_to(ca->array, rb_intern("mask_copy_data"), Qtrue) ) {
-    rb_funcall(ca->array, rb_intern("mask_copy_data"), 
-                        1, ca_objmask_mask_data(ca));
+  if ( ca->ptr ) {
+    ca_objmask_push(ca);
   }
 }
 
-void
-ca_objmask_func_sync (void *ap)
+static void
+ca_objmask_func_detach (void *ap)
 {
   CAObjectMask *ca = (CAObjectMask *) ap;
-  if ( rb_obj_respond_to(ca->array, rb_intern("mask_sync_data"), Qtrue) ) {
-    rb_funcall(ca->array, rb_intern("mask_sync_data"), 
-                          1, ca_objmask_mask_data(ca));
+  if ( ca->holds > 0 && --ca->holds == 0 ) {
+    ca->ptr = NULL;
   }
 }
 
@@ -248,83 +494,76 @@ static void
 ca_objmask_func_xfer_all (void *ap, void *data, int dir)
 {
   CAObjectMask *ca = (CAObjectMask *) ap;
+  size_t len = (size_t) ca->elements * (size_t) ca->bytes;
   if ( dir == CA_XFER_GET ) {
-    if ( rb_obj_respond_to(ca->array, rb_intern("mask_copy_data"), Qtrue) ) {
-      char *ptr0 = ca->ptr;
-      ca->ptr = (char *) data;
-      rb_funcall(ca->array, rb_intern("mask_copy_data"),
-                            1, ca_objmask_mask_data(ca));
-      ca->ptr = ptr0;
-    }
-    else {
-      ca_array_func_xfer_all(ca, data, CA_XFER_GET);
+    if ( ! ca->ptr ) {
+      ca_objmask_refresh(ca);
     }
+    memcpy(data, ca->cache, len);
   }
   else {
-    if ( rb_obj_respond_to(ca->array, rb_intern("mask_copy_data"), Qtrue) ) {
-      char *ptr0 = ca->ptr;
-      ca->ptr = (char *) data;
-      rb_funcall(ca->array, rb_intern("mask_sync_data"),
-                            1, ca_objmask_mask_data(ca));
-      ca->ptr = ptr0;
-    }
-    else {
-      ca_array_func_xfer_all(ca, data, CA_XFER_PUT);
+    memcpy(ca->cache, data, len);
+    if ( ! ca->ptr ) {
+      ca_objmask_push(ca);
     }
   }
 }
 
-void
-ca_objmask_func_fill_data (void *ap, void *val)
+static void
+ca_objmask_func_xfer_addrs (void *ap, ca_size_t n, ca_size_t *addrs,
+                            void *data, int dir)
 {
   CAObjectMask *ca = (CAObjectMask *) ap;
-  ca_array_func_fill_data(ca, val);
-  if ( rb_obj_respond_to(ca->array, rb_intern("mask_fill_data"), Qtrue) ) {
-    rb_funcall(ca->array, rb_intern("mask_fill_data"),
-                          1, INT2NUM(*(uint8_t*)val));
+  boolean8_t *c = (boolean8_t *) ca->cache;
+  boolean8_t *d = (boolean8_t *) data;
+  ca_size_t i;
+  if ( ca->ptr ) {
+    for ( i = 0; i < n; i++ ) {
+      if ( dir == CA_XFER_GET ) { d[i] = c[addrs[i]]; }
+      else                      { c[addrs[i]] = d[i] ? 1 : 0; }
+    }
+    return;
+  }
+  if ( dir == CA_XFER_GET ) {
+    ca_objmask_get_cells(ca, n, addrs, d);
+  }
+  else {
+    ca_objmask_put_cells(ca, n, addrs, d);
   }
 }
 
 static void
 ca_objmask_func_xfer_index (void *ap, ca_size_t *idx, void *data, int dir)
 {
-  ca_objmask_xfer_index_one((CAObjectMask *) ap, idx, data, dir);
+  ca_size_t addr = ca_index2addr((CArray *) ap, idx);
+  ca_objmask_func_xfer_addrs(ap, 1, &addr, data, dir);
 }
 
-/* Forward declaration: ca_object_wrap_transient (defined further down,
-   near the data-side xfer functions). */
-static VALUE
-ca_object_wrap_transient (int8_t data_type, ca_size_t bytes,
-                          int8_t ndim, ca_size_t *dim, void *data, int dir);
-
-/* Mask parallel of the bulk-addrs path.  When `mask_copy_addrs` /
-   `mask_sync_addrs` is defined, 1-call bulk dispatch; else per-cell loop. */
 static void
-ca_objmask_func_xfer_addrs (void *ap, ca_size_t n, ca_size_t *addrs,
-                            void *data, int dir)
+ca_objmask_func_fill_data (void *ap, void *val)
 {
   CAObjectMask *ca = (CAObjectMask *) ap;
-  ID         mid = (dir == CA_XFER_GET) ? rb_intern("mask_copy_addrs")
-                                        : rb_intern("mask_sync_addrs");
-
-  if ( n > 0 && rb_obj_respond_to(ca->array, mid, Qtrue) ) {
-    volatile VALUE raddrs, rdata;
-    ca_size_t dim1[1] = { n };
-    raddrs = ca_object_wrap_transient(CA_SIZE, sizeof(ca_size_t),
-                                      1, dim1, addrs, CA_XFER_PUT);
-    rdata  = ca_object_wrap_transient(ca->data_type, ca->bytes,
-                                      1, dim1, data, dir);
-    rb_funcall(ca->array, mid, 2, raddrs, rdata);
+  boolean8_t bit = *(boolean8_t *) val ? 1 : 0;
+  memset(ca->cache, bit, (size_t) ca->elements);
+  if ( ca->ptr ) {
     return;
   }
-
-  {
-    char     *d = (char *) data;
-    ca_size_t i;
-    for ( i = 0; i < n; i++ ) {
-      ca_objmask_xfer_addr_one(ca, addrs[i], d + i * ca->bytes, dir);
-    }
+  if ( ca_objmask_answers(ca, "mask_fill_data") ) {
+    rb_funcall(ca->array, rb_intern("mask_fill_data"), 1, INT2NUM(bit));
+    return;
   }
+  ca_objmask_push(ca);
+}
+
+static void
+ca_objmask_func_fill_addrs (void *ap, ca_size_t n, ca_size_t *addrs, void *val)
+{
+  CAObjectMask *ca = (CAObjectMask *) ap;
+  volatile VALUE hold = 0;
+  boolean8_t *bits = ALLOCV_N(boolean8_t, hold, n > 0 ? n : 1);
+  memset(bits, *(boolean8_t *) val ? 1 : 0, (size_t) n);
+  ca_objmask_func_xfer_addrs(ca, n, addrs, bits, CA_XFER_PUT);
+  ALLOCV_END(hold);
 }
 
 /* Mask parallel of the partial-region path.  Same per-axis index-step
@@ -335,6 +574,7 @@ static void
 ca_objmask_func_xfer_stride (void *ap, ca_size_t *starts, ca_size_t *counts,
                              ca_size_t *strides, void *data, int dir)
 {
+  if ( ca_region_is_empty(((CArray *) ap)->ndim, counts) ) return;
   CAObjectMask *ca = (CAObjectMask *) ap;
   int8_t     ndim = ca->ndim;
   ca_size_t  native[CA_RANK_MAX], steps[CA_RANK_MAX], idx[CA_RANK_MAX];
@@ -351,7 +591,8 @@ ca_objmask_func_xfer_stride (void *ap, ca_size_t *starts, ca_size_t *counts,
 
   if ( n == 0 ) return;
 
-  if ( rb_obj_respond_to(ca->array, mid_block, Qtrue) ) {
+  if ( ! ca->ptr && ca_objmask_answers(ca, dir == CA_XFER_GET ? "mask_copy_block"
+                                                            : "mask_sync_block") ) {
     /* The request is over the view's addresses, so a transposed / flat
        request is legal; the per-axis copy_block dispatch below would
        misread it.  See ca_xfer_stride_request_is_axis_box (carray.h). */
@@ -372,7 +613,15 @@ ca_objmask_func_xfer_stride (void *ap, ca_size_t *starts, ca_size_t *counts,
       }
       rdata = ca_object_wrap_transient(ca->data_type, ca->bytes,
                                        ndim, counts, data, dir);
-      rb_funcall(ca->array, mid_block, 4, rstarts, rcounts, rsteps, rdata);
+      {
+        VALUE args[4];
+        args[0] = rstarts;
+        args[1] = rcounts;
+        args[2] = rsteps;
+        args[3] = rdata;
+        ca_object_call_transient(ca->array, rb_id2name(mid_block),
+                                 4, args, 1, args + 3);
+      }
       return;
     }
   }
@@ -390,15 +639,27 @@ ca_objmask_func_xfer_stride (void *ap, ca_size_t *starts, ca_size_t *counts,
   ALLOCV_END(holder);
 }
 
+/* A mask copied by dup holds its own bits, and frees them. */
+static void
+ca_objmask_free (void *ap)
+{
+  CAObjectMask *ca = (CAObjectMask *) ap;
+  if ( ca != NULL && NIL_P(ca->array) && ca->cache ) {
+    xfree(ca->cache);
+    ca->cache = NULL;
+  }
+  free_ca_wrap(ap);
+}
+
 static ca_operation_function_t ca_objmask_func = {
   -1, /* CA_OBJ_OBJECT_MASK */
   CA_REAL_ARRAY,
-  free_ca_wrap,
+  ca_objmask_free,
   ca_objmask_func_clone,
-  ca_array_func_allocate,
+  ca_objmask_func_allocate,
   ca_objmask_func_attach,
   ca_objmask_func_sync,
-  ca_array_func_detach,
+  ca_objmask_func_detach,
   ca_objmask_func_fill_data,
   ca_array_func_create_mask,
   ca_objmask_func_xfer_index,
@@ -406,6 +667,7 @@ static ca_operation_function_t ca_objmask_func = {
   NULL,                       /* fold_stride: never-fold (callback boundary) */
   ca_objmask_func_xfer_stride,
   ca_objmask_func_xfer_all,
+  .fill_addrs = ca_objmask_func_fill_addrs,
 };
 
 static VALUE
@@ -421,11 +683,18 @@ rb_ca_objmask_initialize_copy (VALUE self, VALUE other)
   CAObjectMask *ca, *cs;
 
   TypedData_Get_Struct(self,  CAObjectMask, &caobjectmask_data_type, ca);
+  ca_check_uninitialized(ca);
   TypedData_Get_Struct(other, CAObjectMask, &caobjectmask_data_type, cs);
 
+  /* A copy of the mask as it reads now, with bits of its own: writing to
+     it does not reach the CAObject's hooks. */
   carray_setup((CArray *)ca, CA_BOOLEAN, cs->ndim, cs->dim, 0, NULL);
   ca->obj_type = CA_OBJ_OBJECT_MASK;
-  ca->array = cs->array;
+  ca->array = Qnil;
+  ca->cache = ca->ptr;
+  ca->holds = 0;
+  ca_copy_data((CArray *) cs, ca->cache);
+  ca->ptr = NULL;
 
   return self;
 }
@@ -437,7 +706,6 @@ ca_object_setup (CAObject *ca,
                int8_t data_type, int8_t ndim, ca_size_t *dim, ca_size_t bytes)
 {
   ca_size_t elements;
-  double  length;
   int8_t i;
 
   /* check arguments */
@@ -449,16 +717,7 @@ ca_object_setup (CAObject *ca,
 
   /* calculate total number of elements */
 
-  elements = 1;
-  length = bytes;
-  for (i=0; i<ndim; i++) {
-    elements *= dim[i];
-    length   *= dim[i];
-  }
-  
-  if ( length > CA_LENGTH_MAX ) {
-    rb_raise(rb_eRuntimeError, "too large byte length");
-  }
+  elements = ca_shape_elements(ndim, dim, bytes);
 
   ca->obj_type  = CA_OBJ_OBJECT;
   ca->data_type = data_type;
@@ -519,6 +778,17 @@ ca_object_func_clone (void *ap)
 #define ca_object_func_ptr_at_addr ca_array_func_ptr_at_addr
 #define ca_object_func_ptr_at_index ca_array_func_ptr_at_index
 
+/* The bytes of this array's mask.  A fetcher that answers UNDEF marks the
+   cell there, whether or not the mask is open. */
+static boolean8_t *
+ca_object_mask_bytes (CAObject *ca)
+{
+  if ( ca->mask->obj_type == CA_OBJ_OBJECT_MASK ) {
+    return (boolean8_t *) ((CAObjectMask *) ca->mask)->cache;
+  }
+  return (boolean8_t *) ca->mask->ptr;
+}
+
 /* per-cell cores: the addr- and index-primary Ruby-callback bridge logic,
    direction-unified.  The fetch_* / store_* slots below are thin
    forwarders onto these. */
@@ -532,18 +802,15 @@ ca_object_xfer_addr_one (CAObject *ca, ca_size_t addr, void *ptr, int dir)
       raddr = SIZE2NUM(addr);
       rval = rb_funcall(ca->self, rb_intern("fetch_addr"), 1, raddr);
       if ( rval == CA_UNDEF ) {
-        ca_update_mask(ca);
-        if ( ! ca->mask ) {
-          ca_create_mask(ca);
-        }
-        *((boolean8_t*)ca->mask->ptr + addr) = 1;
+        ca_create_mask(ca);
+        ca_object_mask_bytes(ca)[addr] = 1;
         if ( ca->data_type == CA_OBJECT ) {
           rb_ca_obj2ptr(ca->self, INT2NUM(0), ptr);
         }
       }
       else {
         if ( ca_has_mask(ca) ) {
-          *((boolean8_t*)ca->mask->ptr + addr) = 0;
+          ca_object_mask_bytes(ca)[addr] = 0;
         }
         rb_ca_obj2ptr(ca->self, rval, ptr);
       }
@@ -557,18 +824,15 @@ ca_object_xfer_addr_one (CAObject *ca, ca_size_t addr, void *ptr, int dir)
       }
       rval = rb_funcall(ca->self, rb_intern("fetch_index"), 1, ridx);
       if ( rval == CA_UNDEF ) {
-        ca_update_mask(ca);
-        if ( ! ca->mask ) {
-          ca_create_mask(ca);
-        }
-        *((boolean8_t*)ca->mask->ptr + ca_index2addr(ca->mask, idx)) = 1;
+        ca_create_mask(ca);
+        ca_object_mask_bytes(ca)[ca_index2addr(ca->mask, idx)] = 1;
         if ( ca->data_type == CA_OBJECT ) {
           rb_ca_obj2ptr(ca->self, INT2NUM(0), ptr);
         }
       }
       else {
         if ( ca_has_mask(ca) ) {
-          *((boolean8_t*)ca->mask->ptr + ca_index2addr(ca->mask, idx)) = 0;
+          ca_object_mask_bytes(ca)[ca_index2addr(ca->mask, idx)] = 0;
         }
         rb_ca_obj2ptr(ca->self, rval, ptr);
       }
@@ -606,18 +870,15 @@ ca_object_xfer_index_one (CAObject *ca, ca_size_t *idx, void *ptr, int dir)
       }
       rval = rb_funcall(ca->self, rb_intern("fetch_index"), 1, ridx);
       if ( rval == CA_UNDEF ) {
-        ca_update_mask(ca);
-        if ( ! ca->mask ) {
-          ca_create_mask(ca);
-        }
-        *((boolean8_t*)ca->mask->ptr + ca_index2addr(ca->mask, idx)) = 1;
+        ca_create_mask(ca);
+        ca_object_mask_bytes(ca)[ca_index2addr(ca->mask, idx)] = 1;
         if ( ca->data_type == CA_OBJECT ) {
           rb_ca_obj2ptr(ca->self, INT2NUM(0), ptr);
         }
       }
       else {
         if ( ca_has_mask(ca) ) {
-          *((boolean8_t*)ca->mask->ptr + ca_index2addr(ca->mask, idx)) = 0;
+          ca_object_mask_bytes(ca)[ca_index2addr(ca->mask, idx)] = 0;
         }
         rb_ca_obj2ptr(ca->self, rval, ptr);
       }
@@ -627,18 +888,15 @@ ca_object_xfer_index_one (CAObject *ca, ca_size_t *idx, void *ptr, int dir)
       raddr = SIZE2NUM(addr);
       rval = rb_funcall(ca->self, rb_intern("fetch_addr"), 1, raddr);
       if ( rval == CA_UNDEF ) {
-        ca_update_mask(ca);
-        if ( ! ca->mask ) {
-          ca_create_mask(ca);
-        }
-        *((boolean8_t*)ca->mask->ptr + addr) = 1;
+        ca_create_mask(ca);
+        ca_object_mask_bytes(ca)[addr] = 1;
         if ( ca->data_type == CA_OBJECT ) {
           rb_ca_obj2ptr(ca->self, INT2NUM(0), ptr);
         }
       }
       else {
         if ( ca_has_mask(ca) ) {
-          *((boolean8_t*)ca->mask->ptr + addr) = 0;
+          ca_object_mask_bytes(ca)[addr] = 0;
         }
         rb_ca_obj2ptr(ca->self, rval, ptr);
       }
@@ -697,11 +955,8 @@ static void
 ca_object_dispatch_copy (CAObject *ca, void *ptr)
 {
   if ( rb_obj_respond_to(ca->self, rb_intern("copy_data"), Qtrue) ) {
-    char *ptr0 = ca->data->ptr;
-    ca->data->ptr = ptr;
-    rb_funcall(ca->self, rb_intern("copy_data"),
-               1, rb_ivar_get(ca->self, rb_intern("__data__")));
-    ca->data->ptr = ptr0;
+    ca_object_call_lending(&ca->data->ptr, ptr, ca->self, "copy_data",
+                           ca_object_data_of, ca);
   }
   else {
     ca_size_t addr;
@@ -716,11 +971,8 @@ static void
 ca_object_dispatch_sync (CAObject *ca, void *ptr)
 {
   if ( rb_obj_respond_to(ca->self, rb_intern("sync_data"), Qtrue) ) {
-    char *ptr0 = ca->data->ptr;
-    ca->data->ptr = ptr;
-    rb_funcall(ca->self, rb_intern("sync_data"),
-               1, rb_ivar_get(ca->self, rb_intern("__data__")));
-    ca->data->ptr = ptr0;
+    ca_object_call_lending(&ca->data->ptr, ptr, ca->self, "sync_data",
+                           ca_object_data_of, ca);
   }
   else {
     ca_size_t addr;
@@ -778,10 +1030,7 @@ ca_object_func_attach (void *ap)
   ca->ptr = ca->data->ptr;
   ca_object_dispatch_copy(ca, ca->ptr);
   if ( ca_has_mask(ca->data) ) {
-    ca_update_mask(ca);
-    if ( ! ca->mask ) {
-      ca_create_mask(ca);
-    }
+    ca_create_mask(ca);
   }
 }
 
@@ -822,7 +1071,8 @@ ca_object_func_detach (void *ap)
    [n] for addrs) before invoking copy_block / sync_block / copy_addrs /
    sync_addrs.  Lifecycle: buffer is owned by the slot caller; the wrapper
    installs free_ca_wrap as dfree, so the underlying ptr is NOT freed when
-   the wrapper is GC'd.
+   the wrapper is GC'd.  Call the hook through ca_object_call_transient,
+   which takes the buffer back from the wrapper when the hook returns.
 
    Object data_type GC safety: for GET (dir == CA_XFER_GET) the buffer may be
    uninitialized garbage on entry, so we INT2NUM(0) zero-fill before
@@ -880,7 +1130,12 @@ ca_object_func_xfer_addrs (void *ap, ca_size_t n, ca_size_t *addrs,
                                       1, dim1, addrs, CA_XFER_PUT);
     rdata  = ca_object_wrap_transient(ca->data_type, ca->bytes,
                                       1, dim1, data, dir);
-    rb_funcall(ca->self, mid, 2, raddrs, rdata);
+    {
+      VALUE args[2];
+      args[0] = raddrs;
+      args[1] = rdata;
+      ca_object_call_transient(ca->self, rb_id2name(mid), 2, args, 2, args);
+    }
     return;
   }
 
@@ -917,6 +1172,7 @@ static void
 ca_object_func_xfer_stride (void *ap, ca_size_t *starts, ca_size_t *counts,
                             ca_size_t *strides, void *data, int dir)
 {
+  if ( ca_region_is_empty(((CArray *) ap)->ndim, counts) ) return;
   CAObject  *ca = (CAObject *) ap;
   int8_t     ndim;
   ca_size_t  native[CA_RANK_MAX], steps[CA_RANK_MAX], idx[CA_RANK_MAX];
@@ -969,7 +1225,15 @@ ca_object_func_xfer_stride (void *ap, ca_size_t *starts, ca_size_t *counts,
       }
       rdata = ca_object_wrap_transient(ca->data_type, ca->bytes,
                                        ndim, counts, data, dir);
-      rb_funcall(ca->self, mid_block, 4, rstarts, rcounts, rsteps, rdata);
+      {
+        VALUE args[4];
+        args[0] = rstarts;
+        args[1] = rcounts;
+        args[2] = rsteps;
+        args[3] = rdata;
+        ca_object_call_transient(ca->self, rb_id2name(mid_block),
+                                 4, args, 1, args + 3);
+      }
       return;
     }
   }
@@ -1040,7 +1304,12 @@ ca_object_func_fill_addrs (void *ap, ca_size_t n, ca_size_t *addrs, void *ptr)
     raddrs = ca_object_wrap_transient(CA_SIZE, sizeof(ca_size_t),
                                       1, dim1, addrs, CA_XFER_PUT);
     rval = rb_ca_ptr2obj(ca->self, ptr);
-    rb_funcall(ca->self, mid, 2, raddrs, rval);
+    {
+      VALUE args[2];
+      args[0] = raddrs;
+      args[1] = rval;
+      ca_object_call_transient(ca->self, rb_id2name(mid), 2, args, 1, args);
+    }
     return;
   }
 
@@ -1108,31 +1377,32 @@ ca_object_func_create_mask (void *ap)
   CAObject *ca = (CAObject *) ap;
   volatile VALUE rmask;
   if ( ca_is_face(ca) ) {
-    /* Face: the mask refers to the parent's mask (same as the C-level Face
-       create_mask, e.g. ca_time_func_create_mask). Storage is the
-       parent, so the mask must be the parent's, not the internal __data__. */
-    ca_update_mask(ca->parent);
-    if ( ! ca->parent->mask ) {
-      ca_create_mask(ca->parent);
-    }
-    ca->mask = (CArray *) ca_refer_new(ca->parent->mask,
-                                       CA_BOOLEAN, ca->ndim, ca->dim, 0, 0);
+    /* Face: storage is the parent, so the mask is the parent's (as for the
+       C-level Faces), not the internal __data__'s. */
+    ca_view_func_create_mask(ca);
     return;
   }
   if ( rb_obj_respond_to(ca->self, rb_intern("create_mask"), Qtrue) ) {
     rb_funcall(ca->self, rb_intern("create_mask"), 0);
   }
   else {
-    rb_raise(rb_eRuntimeError, "can't create mask for CAObject");
+    rb_raise(rb_eTypeError, "can't create mask for CAObject");
   }
-  ca_update_mask(ca->data);
-  if ( ! ca->data->mask ) {
-    ca_create_mask(ca->data);
+  ca_create_mask(ca->data);
+  {
+    CAObjectMask *cm = ca_objmask_new(ca->self, ca->ndim, ca->dim);
+    cm->cache = ca->data->mask->ptr;
+    ca->mask = (CArray *) cm;
+    rmask = ca_wrap_struct(ca->mask);
+    rb_ivar_set(ca->self, rb_intern("mask"), rmask);
+    /* Made while this array is attached, the mask joins it at its level:
+       ca_create_mask attaches it once more when this returns. */
+    if ( ca->attach > 1 ) {
+      ca_objmask_refresh(cm);
+      cm->ptr   = cm->cache;
+      cm->holds = ca->attach - 1;
+    }
   }
-  ca->mask = (CArray*) ca_objmask_new(ca->self, ca->ndim, ca->dim);
-  ca->mask->ptr = ca->data->mask->ptr;
-  rmask = ca_wrap_struct(ca->mask);
-  rb_ivar_set(ca->self, rb_intern("mask"), rmask);
 }
 
 ca_operation_function_t ca_object_func = {
@@ -1171,6 +1441,7 @@ rb_ca_object_initialize_copy (VALUE self, VALUE other)
   CAObject *ca, *cs;
 
   TypedData_Get_Struct(self,  CAObject, &caobject_data_type, ca);
+  ca_check_uninitialized(ca);
   TypedData_Get_Struct(other, CAObject, &caobject_data_type, cs);
 
   if ( ca_func[CA_OBJ_OBJECT].pool_init ) {
@@ -1212,20 +1483,21 @@ rb_ca_object_initialize (int argc, VALUE *argv, VALUE self)
 {
   volatile VALUE rtype, rdim, ropt, rbytes = Qnil, rrdonly = Qnil,
                  rparent = Qnil, rface = Qnil, rstorage = Qnil, rdata,
-                 rorderable = Qnil, rcomparable = Qnil;
+                 rorderable = Qnil, rcomparable = Qnil, rnumeric = Qnil;
   CAObject *ca;
   int8_t data_type, ndim;
   ca_size_t dim[CA_RANK_MAX];
   ca_size_t bytes;
   int i;
+  int storage_named = 0;   /* :storage given by the caller */
 
   rb_scan_args(argc, argv, "21", (VALUE *) &rtype, (VALUE *) &rdim, (VALUE *) &ropt);
-  rb_scan_options(ropt, "bytes,read_only,parent,face,storage,orderable_storage,comparable_storage",
+  rb_scan_options(ropt, "bytes,read_only,parent,face,storage,orderable_storage,comparable_storage,numeric",
                   &rbytes, &rrdonly, &rparent, &rface, &rstorage,
-                  &rorderable, &rcomparable);
+                  &rorderable, &rcomparable, &rnumeric);
 
   if ( ( ! NIL_P(rparent) ) && ( ! rb_obj_is_carray(rparent) ) ) {
-    rb_raise(rb_eRuntimeError, "option :parent should be a carray");
+    rb_raise(rb_eTypeError, "option :parent should be a carray");
   }
 
   /* :storage is meaningful only under face: true (= it documents the
@@ -1246,6 +1518,16 @@ rb_ca_object_initialize (int argc, VALUE *argv, VALUE self)
              "meaningful with face: true");
   }
 
+  if ( ! NIL_P(rnumeric) && ! RTEST(rface) ) {
+    rb_raise(rb_eArgError,
+             "CAObject: :numeric is only meaningful with face: true");
+  }
+  if ( ! NIL_P(rnumeric) && ! NIL_P(rstorage) ) {
+    rb_raise(rb_eArgError,
+             "CAObject: give either :numeric or :storage, not both "
+             "(:storage declares a surface of its own)");
+  }
+
   /* face: true requires :parent.  Under Face semantics the parent is the
      true storage owner and CAObject itself carries the semantic identity.
      The declared data_type is the SURFACE (= what dispatch sees);
@@ -1262,7 +1544,30 @@ rb_ca_object_initialize (int argc, VALUE *argv, VALUE self)
 
   rb_ca_guess_type_and_bytes(rtype, rbytes, &data_type, &bytes);
 
+  /* Without :storage the data_type argument names the storage of a Face.
+     A numeric storage is gated by default: the surface becomes CA_FIXLEN,
+     so arithmetic, math and reductions raise instead of computing on the
+     stored numbers, which the Face exists to give another meaning.
+     numeric: true lets them through.  An object or fixlen storage keeps
+     its own data_type: fixlen kernels already raise, and an object cell
+     may not be read as bytes. */
+  storage_named = ! NIL_P(rstorage);
+  if ( RTEST(rface) && NIL_P(rstorage) ) {
+    if ( data_type == CA_OBJECT || data_type == CA_FIXLEN ) {
+      if ( ! NIL_P(rnumeric) ) {
+        rb_raise(rb_eArgError,
+                 "CAObject Face: :numeric applies to a numeric storage only "
+                 "(the storage is %s)", ca_type_name[data_type]);
+      }
+    }
+    else if ( ! RTEST(rnumeric) ) {
+      rstorage = INT2NUM(data_type);
+      data_type = CA_FIXLEN;
+    }
+  }
+
   Check_Type(rdim, T_ARRAY);
+  CA_CHECK_RANK(RARRAY_LEN(rdim));     /* before dim[] is filled */
 
   ndim = RARRAY_LEN(rdim);
   for (i=0; i<ndim; i++) {
@@ -1270,6 +1575,7 @@ rb_ca_object_initialize (int argc, VALUE *argv, VALUE self)
   }
 
   TypedData_Get_Struct(self, CAObject, &caobject_data_type, ca);
+  ca_check_uninitialized(ca);
   ca_object_setup(ca, data_type, ndim, dim, bytes);
   ca->self = self;
 
@@ -1287,17 +1593,11 @@ rb_ca_object_initialize (int argc, VALUE *argv, VALUE self)
     ca->parent = cp;
     rb_ca_set_parent(self, rparent);
 
-    /* Face mode invariants.  The check the author opts into depends on
-       whether :storage is explicit:
-       - :storage omitted  → "surface == storage" contract:
-                             surface (= declared data_type) must equal
-                             parent.data_type.  This catches typos for
-                             Numeric Face authors who didn't intend
-                             surface/storage to differ.
-       - :storage given    → "surface != storage" opted-in:
-                             surface is free (= e.g. CA_FIXLEN for
-                             NonNumeric Face), :storage must agree with
-                             parent.data_type, and bytes must match. */
+    /* Face mode invariants: bytes match the parent's, and the storage
+       (:storage, or the data_type argument when :storage was omitted)
+       is the parent's data_type.  The surface is the data_type argument
+       under :storage, CA_FIXLEN for a gated numeric storage (decided
+       above), and the storage itself otherwise. */
     if ( RTEST(rface) ) {
       if ( bytes != cp->bytes ) {
         rb_raise(rb_eTypeError,
@@ -1306,12 +1606,12 @@ rb_ca_object_initialize (int argc, VALUE *argv, VALUE self)
                  (long long) bytes, (long long) cp->bytes);
       }
       if ( NIL_P(rstorage) ) {
-        /* surface == storage contract */
+        /* The data_type argument names the storage. */
         if ( cp->data_type != data_type ) {
           rb_raise(rb_eTypeError,
                    "CAObject Face: parent data_type mismatch "
                    "(declared=%d, parent=%d).  Use :storage option to "
-                   "opt into surface != storage (NonNumeric Face).",
+                   "declare a surface that differs from the storage.",
                    (int) data_type, (int) cp->data_type);
         }
       }
@@ -1323,10 +1623,20 @@ rb_ca_object_initialize (int argc, VALUE *argv, VALUE self)
                                    &declared_storage, &declared_storage_bytes);
         if ( cp->data_type != declared_storage ) {
           rb_raise(rb_eTypeError,
-                   "CAObject Face: :storage mismatch "
-                   "(declared=%d, parent.data_type=%d)",
+                   storage_named
+                   ? "CAObject Face: :storage mismatch "
+                     "(declared=%d, parent.data_type=%d)"
+                   : "CAObject Face: parent data_type mismatch "
+                     "(declared=%d, parent=%d)",
                    (int) declared_storage, (int) cp->data_type);
         }
+        /* An object cell is a VALUE: reading it under another surface hands
+           out its address, and writing one forges it. */
+        if ( ca_is_object_type(cp) && data_type != CA_OBJECT ) {
+          rb_raise(rb_eTypeError,
+                   "CAObject Face: an object storage can't be given "
+                   "another surface data_type");
+        }
       }
       ca_set_flag(ca, CA_FLAG_IS_FACE);
       if ( RTEST(rorderable) ) {