carray 3.0.4 → 3.0.6

data/ext/ca_obj_window.c

@@ -801,16 +801,40 @@ ca_window_create_bounds_mask (VALUE view)
   return Qnil;
 }
 
+typedef struct {
+  CAWindow  *ca;
+  CArray    *parent;
+  ca_size_t *start;
+  ca_size_t *count;
+  uint8_t   *bounds;
+  char      *fill;
+} ca_window_new_arg;
+
+static VALUE
+ca_window_new_setup (VALUE varg)
+{
+  ca_window_new_arg *a = (ca_window_new_arg *) varg;
+  ca_window_setup(a->ca, a->parent, a->start, a->count, a->bounds, a->fill);
+  return Qnil;
+}
+
+/* The setup allocates the fill value after the struct and its pool: when
+   that fails, the struct goes too. */
 CAWindow *
 ca_window_new (CArray *parent,
                ca_size_t *start, ca_size_t *count, uint8_t *bounds, char *fill)
 {
-  CAWindow *ca;
+  ca_window_new_arg a;
   ca_window_setup(NULL, parent, start, count, bounds, fill);
-  ca = (CAWindow *) ca_array_alloc(CA_OBJ_WINDOW, parent->ndim);
-  ca_window_setup(ca, parent, start, count, bounds, fill);
-  ca_fill_or_free((CArray *) ca, ca_window_create_bounds_mask, (VALUE) ca);
-  return ca;
+  a.ca     = (CAWindow *) ca_array_alloc(CA_OBJ_WINDOW, parent->ndim);
+  a.parent = parent;
+  a.start  = start;
+  a.count  = count;
+  a.bounds = bounds;
+  a.fill   = fill;
+  ca_fill_or_free((CArray *) a.ca, ca_window_new_setup, (VALUE) &a);
+  ca_fill_or_free((CArray *) a.ca, ca_window_create_bounds_mask, (VALUE) a.ca);
+  return a.ca;
 }
 
 static void
@@ -1674,51 +1698,56 @@ rb_ca_window (int argc, VALUE *argv, VALUE self)
     if ( SYMBOL_P(rbounds) ) {
       rbounds = rb_sym2str(rbounds);
     }
-    switch ( TYPE(rbounds) ) {
-    case T_STRING:
-      cbounds = StringValuePtr(rbounds);
-      if ( rfval == CA_UNDEF && strncmp(cbounds, "fill", 4) 
-                             && strncmp(cbounds, "mask", 4) ) {
-        rb_raise(rb_eArgError, "conflicted bounds and fill_value");
-      }
-      if ( ! strncmp(cbounds, "ruby", 4) ) {
-        bounds = CA_BOUNDS_RUBY;
-      }
-      else if ( ! strncmp(cbounds, "strict", 6) ) {
-        bounds = CA_BOUNDS_STRICT;
-      }
-      else if ( ! strncmp(cbounds, "nearest", 7) ) {
-        bounds = CA_BOUNDS_NEAREST;
-      }
-      else if ( ! strncmp(cbounds, "periodic", 8) ) {
-        rb_raise(rb_eArgError,
-                 "bounds=>'periodic' removed in 3.0; "
-                 "use CArray#roll(...) for cyclic shift "
-                 "(returns a CARoll view)");
-      }
-      else if ( ! strncmp(cbounds, "reflect", 7) ) {
-        rb_raise(rb_eArgError,
-                 "bounds=>'reflect' removed in 3.0; "
-                 "there is no view-based alternative");
-      }
-      else if ( ! strncmp(cbounds, "mask", 4) ) {
-        rb_warn("CAWindow option :bounds=>\"mask\" will be obsolete");
-        rb_warn("use ca.window(..., fill_value: UNDEF)");
-        bounds = CA_BOUNDS_MASK;
-      }
-      else if ( ! strncmp(cbounds, "fill", 4) ) {
-        bounds = CA_BOUNDS_FILL;
-      }
-      else {
-        rb_raise(rb_eArgError, 
-                 "unknown option value '%s' for :bounds", cbounds);        
-      }
-      break;
-    case T_FIXNUM:
-      bounds = NUM2INT(rbounds);
-      break;
-    default:
-      rb_raise(rb_eArgError, "invalid option value for :bounds");
+    if ( ! RB_TYPE_P(rbounds, T_STRING) ) {
+      rb_raise(rb_eTypeError,
+               "window: bounds: must be a Symbol or a String (got %s)",
+               rb_obj_classname(rbounds));
+    }
+    cbounds = StringValueCStr(rbounds);
+    if ( ! strcmp(cbounds, "ruby") ) {
+      bounds = CA_BOUNDS_RUBY;
+    }
+    else if ( ! strcmp(cbounds, "strict") ) {
+      bounds = CA_BOUNDS_STRICT;
+    }
+    else if ( ! strcmp(cbounds, "nearest") ) {
+      bounds = CA_BOUNDS_NEAREST;
+    }
+    else if ( ! strcmp(cbounds, "periodic") ) {
+      rb_raise(rb_eArgError,
+               "bounds=>'periodic' removed in 3.0; "
+               "use CArray#roll(...) for cyclic shift "
+               "(returns a CARoll view)");
+    }
+    else if ( ! strcmp(cbounds, "reflect") ) {
+      rb_raise(rb_eArgError,
+               "bounds=>'reflect' removed in 3.0; "
+               "there is no view-based alternative");
+    }
+    else if ( ! strcmp(cbounds, "mask") ) {
+      rb_warn("CAWindow option :bounds=>\"mask\" will be obsolete");
+      rb_warn("use ca.window(..., fill_value: UNDEF)");
+      bounds = CA_BOUNDS_MASK;
+    }
+    else if ( ! strcmp(cbounds, "fill") ) {
+      bounds = ( rfval == CA_UNDEF ) ? CA_BOUNDS_MASK : CA_BOUNDS_FILL;
+    }
+    else {
+      rb_raise(rb_eArgError,
+               "window: unknown bounds: '%s'", cbounds);
+    }
+    /* A fill value says what the cells outside the array are; the other
+       policies say something else about them. */
+    if ( rfval != CA_UNSPECIFIED
+         && bounds != CA_BOUNDS_FILL && bounds != CA_BOUNDS_MASK ) {
+      rb_raise(rb_eArgError,
+               "window: fill_value: is for bounds: :fill, not :%s", cbounds);
+    }
+    if ( rfval != CA_UNSPECIFIED && rfval != CA_UNDEF
+         && bounds == CA_BOUNDS_MASK ) {
+      rb_raise(rb_eArgError,
+               "window: fill_value: %+"PRIsVALUE" conflicts with bounds: :mask "
+               "(use fill_value: UNDEF to mask the cells outside)", rfval);
     }
   }
 
@@ -1953,6 +1982,7 @@ Init_ca_obj_window (void)
   		                      &cawindow_data_type, 
 				      rb_cCAWindowMask,
 				      &cawindow_mask_data_type, &ca_window_func, sizeof(ca_window_func));
+  ca_register_cell_moving_view(CA_OBJ_WINDOW);
   rb_define_const(rb_cObject, "CA_OBJ_WINDOW", INT2NUM(CA_OBJ_WINDOW));
 
   rb_define_method(rb_cCArray, "window", rb_ca_window, -1);

data/ext/ca_op_ipower.c

@@ -110,9 +110,9 @@ ca_binop_func_t ca_binop_ipower[CA_NTYPE] = {
 
 static void
 ca_ipower_float32_t (ca_size_t n, boolean8_t *m,
-                     char *ptr1, int32_t ipow, char *ptr2)
+                     char *ptr1, int64_t ipow, char *ptr2)
 {
-  float32_t *p1 = (float32_t *) ptr1, *p2 = (float32_t *) ptr2;
+  ca_u_float32_t *p1 = (ca_u_float32_t *) ptr1, *p2 = (ca_u_float32_t *) ptr2;
   if ( m ) {
     while (n--) {
       if ( ! *m++ ) { *p2 = op_powi_float32_t(*p1, ipow); }
@@ -125,9 +125,9 @@ ca_ipower_float32_t (ca_size_t n, boolean8_t *m,
 
 static void
 ca_ipower_float64_t (ca_size_t n, boolean8_t *m,
-                     char *ptr1, int32_t ipow, char *ptr2)
+                     char *ptr1, int64_t ipow, char *ptr2)
 {
-  float64_t *p1 = (float64_t *) ptr1, *p2 = (float64_t *) ptr2;
+  ca_u_float64_t *p1 = (ca_u_float64_t *) ptr1, *p2 = (ca_u_float64_t *) ptr2;
   if ( m ) {
     while (n--) {
       if ( ! *m++ ) { *p2 = op_powi_float64_t(*p1, ipow); }
@@ -140,9 +140,9 @@ ca_ipower_float64_t (ca_size_t n, boolean8_t *m,
 
 static void
 ca_ipower_cmplx64_t (ca_size_t n, boolean8_t *m,
-                     char *ptr1, int32_t ipow, char *ptr2)
+                     char *ptr1, int64_t ipow, char *ptr2)
 {
-  cmplx64_t *p1 = (cmplx64_t *) ptr1, *p2 = (cmplx64_t *) ptr2;
+  ca_u_cmplx64_t *p1 = (ca_u_cmplx64_t *) ptr1, *p2 = (ca_u_cmplx64_t *) ptr2;
   if ( m ) {
     while (n--) {
       if ( ! *m++ ) { *p2 = op_powi_cmplx64_t(*p1, ipow); }
@@ -155,9 +155,9 @@ ca_ipower_cmplx64_t (ca_size_t n, boolean8_t *m,
 
 static void
 ca_ipower_cmplx128_t (ca_size_t n, boolean8_t *m,
-                     char *ptr1, int32_t ipow, char *ptr2)
+                     char *ptr1, int64_t ipow, char *ptr2)
 {
-  cmplx128_t *p1 = (cmplx128_t *) ptr1, *p2 = (cmplx128_t *) ptr2;
+  ca_u_cmplx128_t *p1 = (ca_u_cmplx128_t *) ptr1, *p2 = (ca_u_cmplx128_t *) ptr2;
   if ( m ) {
     while (n--) {
       if ( ! *m++ ) { *p2 = op_powi_cmplx128_t(*p1, ipow); }
@@ -195,10 +195,10 @@ rb_ca_ipower (VALUE self, VALUE other)
 {
   volatile VALUE obj;
   CArray *ca, *co;
-  int32_t ipow;
+  int64_t ipow;
   boolean8_t *m;
 
-  ipow = NUM2INT(other);
+  ipow = NUM2LL(other);
 
   TypedData_Get_Struct(self, CArray, &carray_data_type, ca);
 
@@ -252,10 +252,10 @@ static VALUE
 rb_ca_ipower_bang (VALUE self, VALUE other)
 {
   CArray *ca;
-  int32_t ipow;
+  int64_t ipow;
   boolean8_t *m;
 
-  ipow = NUM2INT(other);
+  ipow = NUM2LL(other);
 
   TypedData_Get_Struct(self, CArray, &carray_data_type, ca);
 

data/ext/ca_sort_kernels.h

@@ -62,11 +62,14 @@ void ca_sort_merge_f64 (double    *a, double    *aux, ca_size_t n);
 ca_size_t ca_partition_nan_f32 (float32_t *a, ca_size_t n);
 ca_size_t ca_partition_nan_f64 (double    *a, ca_size_t n);
 
-/* P.4: pair variant of NaN pre-partition for float argsort kernels. */
+/* Pair variant of NaN pre-partition for float argsort kernels.  scratch
+   holds n pairs; its contents on return are unspecified. */
 struct ca_pair_f32;
 struct ca_pair_f64;
-ca_size_t ca_partition_nan_pair_f32 (struct ca_pair_f32 *a, ca_size_t n);
-ca_size_t ca_partition_nan_pair_f64 (struct ca_pair_f64 *a, ca_size_t n);
+ca_size_t ca_partition_nan_pair_f32 (struct ca_pair_f32 *a, ca_size_t n,
+                                     struct ca_pair_f32 *scratch);
+ca_size_t ca_partition_nan_pair_f64 (struct ca_pair_f64 *a, ca_size_t n,
+                                     struct ca_pair_f64 *scratch);
 
 /* P.9: value-level quickselect for partition_copy.
    Reorders a[0..n) so that a[kth] is exact + left/right regions

data/ext/caframe_csv_reader.c

@@ -1,4 +1,4 @@
-/* CSV body reader for CAFrame.from_csv.
+/* CSV body reader for CAFrame.read_csv.
 
    CArray.__csv_read_body_as_string_cells__(text, sep, quote, ncol, keep)
      -> [ncol, cells, records]

data/ext/carray.h

@@ -173,6 +173,39 @@ typedef int8_t boolean8_t;
 #define CA_ALIGN_CMPLX128 offsetof(struct { char c; cmplx128_t x; }, x)
 #define CA_ALIGN_OBJECT   offsetof(struct { char c; VALUE      x; }, x)
 
+/* Cell types that may sit at any byte.  A view's cells need not be aligned
+   to their size: a struct member at offset 1, a refer with a byte offset,
+   a wrapped external buffer.  Reading a cell through a plain `double *`
+   there is undefined (x86 vector code may assume the alignment), so a
+   kernel reads and writes cells through these.  Same size and value as the
+   plain type; only the alignment the compiler may assume is 1. */
+#if defined(__GNUC__) || defined(__clang__)
+#  define CA_UNALIGNED __attribute__((aligned(1)))
+#else
+#  define CA_UNALIGNED
+#endif
+typedef boolean8_t ca_u_boolean8_t;
+typedef int8_t     ca_u_int8_t;
+typedef uint8_t    ca_u_uint8_t;
+typedef int16_t    ca_u_int16_t    CA_UNALIGNED;
+typedef uint16_t   ca_u_uint16_t   CA_UNALIGNED;
+typedef int32_t    ca_u_int32_t    CA_UNALIGNED;
+typedef uint32_t   ca_u_uint32_t   CA_UNALIGNED;
+typedef int64_t    ca_u_int64_t    CA_UNALIGNED;
+typedef uint64_t   ca_u_uint64_t   CA_UNALIGNED;
+typedef float32_t  ca_u_float32_t  CA_UNALIGNED;
+typedef float64_t  ca_u_float64_t  CA_UNALIGNED;
+typedef cmplx64_t  ca_u_cmplx64_t  CA_UNALIGNED;
+typedef cmplx128_t ca_u_cmplx128_t CA_UNALIGNED;
+typedef VALUE      ca_u_VALUE      CA_UNALIGNED;
+
+typedef ca_u_float32_t ca_u_float;
+typedef ca_u_float64_t ca_u_double;
+
+/* CA_U(float64_t) is ca_u_float64_t (and CA_U(double) ca_u_double): for a
+   macro that takes the cell type. */
+#define CA_U(type) ca_u_##type
+
 /* -------------------------------------------------------------------- */
 
 #define CA_OBJ_TYPE_MAX  256
@@ -204,7 +237,8 @@ typedef int8_t boolean8_t;
    routines that walk a single ->parent test this flag and instead fold over
    the parents[] exposed by the CAMultiParent layout convention. */
 #define CA_FLAG_MULTI_PARENTS   32
-#define CA_FLAG_CYCLE_CHECK     64
+/* bit 64 (formerly CA_FLAG_CYCLE_CHECK) is free: a cyclic read is found
+   without writing to the array (ca_test_cyclic_check). */
 #define CA_FLAG_IS_FACE        128
 /* Face opt-in ordering/search flags.
    A Face declares that its numeric storage may be descended to for kernel

data/ext/carray_access.c

@@ -193,6 +193,14 @@ rb_ca_fill (VALUE self, VALUE rval)
   TypedData_Get_Struct(self, CArray, &carray_data_type, ca);
 
   if ( ca_is_empty(ca) ) {
+    /* No cell to fill, but a value no cell could hold is refused, as an
+       assignment to the empty array refuses it. */
+    if ( rval != CA_UNDEF && ca->bytes > 0 ) {
+      volatile VALUE holder;
+      char *fval = ALLOCV_N(char, holder, ca->bytes);
+      rb_ca_obj2ptr(self, rval, fval);
+      ALLOCV_END(holder);
+    }
     return self;                /* empty = no-op fill; return self for chaining */
   }
 
@@ -884,9 +892,9 @@ rb_ca_index_restruct_block (int16_t *ndimp, ca_size_t *shrink, ca_size_t *dim,
 
   offset = 0;
 
-  if ( idx[0] == -1 ) {
-    j = 0;
-    while ( idx[++j] ) {
+  if ( ndim0 > 0 && idx[0] == -1 ) {
+    /* j = the number of leading axes collapsed by a scalar index */
+    for (j=1; j<ndim0 && idx[j] == -1; j++) {
       ;
     }
 
@@ -1365,6 +1373,7 @@ rb_ca_fetch_newaxis (int argc, VALUE *argv, VALUE self, CArray *ca)
      element, which is what the shape rules then hold it to. */
   if ( nscalar == nclean ) {
     VALUE blocks[CA_RANK_MAX];
+    ca_check_rank_fits(nunder, NULL);   /* the result has the :_ axes only */
     for (i = 0; i < nclean; i++) {
       blocks[i] = rb_assoc_new(clean[i], INT2FIX(1));
     }
@@ -1379,6 +1388,10 @@ rb_ca_fetch_newaxis (int argc, VALUE *argv, VALUE self, CArray *ca)
 
   TypedData_Get_Struct(base, CArray, &carray_data_type, cb);
 
+  /* The result has the base's axes and one for each :_, before any is
+     written into final_dims. */
+  ca_check_rank_fits((long) nunder + cb->ndim, NULL);
+
   /* Reconstruct final shape: walk original argv.  :_ -> size-1, scalar
      (Integer) -> dropped (skip), else -> base.dim[cursor].  A key gives one
      axis, except an integer CArray read alone (a mapping), which gives as
@@ -1541,75 +1554,37 @@ rb_ca_fetch_slab_sigil (int argc, VALUE *argv, VALUE self)
   return rb_funcall(klass, rb_intern("new"), 2, base, slab_axes);
 }
 
+/* A CScalar is one cell and takes no index: s[] and s[0] name that cell,
+   anything else is refused. */
+
+static void
+rb_cs_check_index (int argc, VALUE *argv, const char *op)
+{
+  if ( argc == 0 ) {
+    return;
+  }
+  if ( argc == 1 && FIXNUM_P(argv[0]) && FIX2LONG(argv[0]) == 0 ) {
+    return;
+  }
+  rb_raise(rb_eArgError,
+           "CScalar%s takes no index other than [] or [0]", op);
+}
+
 static VALUE
 rb_cs_fetch_method (int argc, VALUE *argv, VALUE self)
 {
-  volatile VALUE obj = Qnil;
-  CArray *ca;
-  CAIndexInfo info;
-
-  TypedData_Get_Struct(self, CArray, &carray_data_type, ca);
-
-  info.range_check = 0;
-  rb_ca_scan_index(ca->ndim, ca->dim, ca->elements, argc, argv, &info);
+  rb_cs_check_index(argc, argv, "#[]");
+  return rb_ca_fetch_addr(self, 0);
+}
 
-  switch ( info.type ) {
-  case CA_REG_ADDRESS_COMPLEX:
-    obj = rb_ca_fetch_addr(self, 0);
-    break;
-  case CA_REG_ADDRESS:
-    obj = rb_ca_fetch_addr(self, 0);
-    break;
-  case CA_REG_FLATTEN:
-    obj = self; /* rb_funcall(self, rb_intern("refer"), 0); */
-    break;
-  case CA_REG_POINT:
-    obj = rb_ca_fetch_addr(self, 0);
-    break;
-  case CA_REG_ALL:
-    obj = self; /* rb_funcall(self, rb_intern("refer"), 0); */
-    break;
-  case CA_REG_BLOCK:
-    obj = self; /* rb_funcall(self, rb_intern("refer"), 0); */
-    break;
-  case CA_REG_SELECT:
-    obj = rb_ca_select_new(self, argv[0]);
-    break;
-  case CA_REG_ITERATOR:
-    obj = rb_ca_slab_iter_new(self, &info);
-    break;
-  case CA_REG_REPEAT:
-    obj = rb_ca_repeat(argc, argv, self);
-    break;
-  case CA_REG_MAPPING:
-    obj = rb_ca_fancy_index_chain(self, argv[0]);
-    break;
-  case CA_REG_GRID:
-    obj = rb_ca_grid(argc, argv, self);
-    break;
-  case CA_REG_METHOD_CALL: {
-    volatile VALUE idx;
-    idx = rb_funcallv_public(self, SYM2ID(info.symbol), argc-1, argv+1);
-    obj = rb_ca_fetch(self, idx);
-    break;
-  }
-  case CA_REG_MEMBER: {
-    volatile VALUE data_class = rb_ca_data_class(self);
-    if ( ! NIL_P(data_class) ) {
-      obj = rb_ca_face_field(self, info.symbol);
-      break;
-    }
-    else {
-      rb_raise(rb_eIndexError, 
-               "can't refer member of carray doesn't have data_class");
-    }
-    break;
-  }
-  default:
-    rb_raise(rb_eIndexError, "invalid index specified");
-  }
+static VALUE rb_ca_store_method (int argc, VALUE *argv, VALUE self);
 
-  return obj;
+static VALUE
+rb_cs_store_method (int argc, VALUE *argv, VALUE self)
+{
+  rb_check_arity(argc, 1, UNLIMITED_ARGUMENTS);
+  rb_cs_check_index(argc - 1, argv, "#[]=");
+  return rb_ca_store_method(argc, argv, self);
 }
 
 /* Recursively convert a store rvalue's surface value objects into
@@ -2430,6 +2405,7 @@ Init_carray_access (void)
   rb_define_method(rb_cCArray, "[]=", rb_ca_store_method, -1);
 
   rb_define_method(rb_cCScalar, "[]", rb_cs_fetch_method, -1);
+  rb_define_method(rb_cCScalar, "[]=", rb_cs_store_method, -1);
 
   rb_define_method(rb_cCArray, "fill", rb_ca_fill, 1);
   rb_define_method(rb_cCArray, "fill_copy", rb_ca_fill_copy, 1);

data/ext/carray_address_basis.c

@@ -965,6 +965,139 @@ address_basis_tier (VALUE module, VALUE object)
   return INT2NUM(tier_for(ca));
 }
 
+/* ------------------------------------------------------------------- */
+
+/*
+ * call-seq:
+ *   CArray::AddressBasis.sweep(function, fsync, arrays, *parts) -> nil
+ *
+ * Runs ca_call_cslab_N_r over `arrays` with the slab function at the address
+ * `function`, and hands it as `userdata` a table of pointers to the bytes of
+ * each of `parts`, in order.
+ *
+ * This is what a consumer did through Fiddle: copy the parts into memory
+ * from malloc, write the table in front of them, and call the family member
+ * for the arity.  The copy was there because a String's bytes may be moved
+ * by GC compaction, and the sweep allocates -- so a collection can run
+ * between taking an address and the slab reading it.  It is not needed
+ * here: every part is also held in an array on the machine stack for the
+ * length of this call, and an object referenced from there is pinned.  The
+ * VM stack is not enough by itself -- a splat of 128 or more arguments
+ * reaches a C method as a heap array, whose elements compaction moves.
+ * The machine stack is why the parts are limited to 1024.
+ *
+ * A part that is not frozen is the slab's to write (an error slot), and is
+ * made unshared first so the write lands in that String alone.  A frozen
+ * part is read only.  Each part has to start on an 8-byte boundary, since a
+ * slab reads doubles and int64s out of them.
+ */
+static VALUE
+address_basis_sweep (int argc, VALUE *argv, VALUE module)
+{
+  volatile VALUE rfunction, rfsync, rarrays;
+  ca_cslab_r_t function;
+  const char *fsync;
+  VALUE vholder = 0;
+  void **table;
+  VALUE *arrays;
+  volatile VALUE *parts;
+  int i, n, nparts;
+
+  rb_check_arity(argc, 3, UNLIMITED_ARGUMENTS);
+  rfunction = argv[0];
+  rfsync    = argv[1];
+  rarrays   = argv[2];
+  nparts    = argc - 3;
+
+  if ( nparts > 1024 ) {
+    rb_raise(rb_eArgError, "%s: a sweep takes at most 1024 parts, got %d",
+             ca_calling_method_name(), nparts);
+  }
+  /* Held on the machine stack, which the GC scans conservatively and so
+     pins.  argv is not written: it may be the storage of a heap array. */
+  parts = ALLOCA_N(VALUE, nparts > 0 ? nparts : 1);
+  for ( i = 0; i < nparts; i++ ) {
+    parts[i] = argv[3 + i];
+  }
+
+  Check_Type(rarrays, T_ARRAY);
+  n = (int) RARRAY_LEN(rarrays);
+  if ( n < 1 || n > 7 ) {
+    rb_raise(rb_eArgError, "%s: a sweep takes 1 to 7 arrays, got %d",
+             ca_calling_method_name(), n);
+  }
+  fsync = StringValueCStr(rfsync);
+  if ( (int) strlen(fsync) != n ) {
+    rb_raise(rb_eArgError, "%s: fsync has %d characters for %d arrays",
+             ca_calling_method_name(), (int) strlen(fsync), n);
+  }
+  for ( i = 0; i < n; i++ ) {
+    if ( fsync[i] != '0' && fsync[i] != '1' ) {
+      rb_raise(rb_eArgError,
+               "%s: fsync character %d is '%c', not '0' (read) or '1' (written)",
+               ca_calling_method_name(), i, fsync[i]);
+    }
+  }
+  function = (ca_cslab_r_t) (uintptr_t) NUM2ULL(rfunction);
+  if ( ! function ) {
+    rb_raise(rb_eArgError, "%s: the slab function's address is zero",
+             ca_calling_method_name());
+  }
+
+  arrays = RARRAY_PTR(rarrays);
+  for ( i = 0; i < n; i++ ) {
+    if ( ! rb_obj_is_kind_of(arrays[i], rb_cCArray) ) {
+      rb_raise(rb_eTypeError, "%s: array %d is not a CArray",
+               ca_calling_method_name(), i);
+    }
+  }
+
+  for ( i = 0; i < nparts; i++ ) {
+    VALUE part = parts[i];
+    StringValue(part);
+    parts[i] = part;
+    if ( ! OBJ_FROZEN(part) ) {
+      rb_str_modify(part);
+    }
+    if ( (uintptr_t) RSTRING_PTR(part) & 7 ) {
+      rb_raise(rb_eArgError, "%s: part %d does not start on an 8-byte boundary",
+               ca_calling_method_name(), i);
+    }
+  }
+
+  /* Taken after every check, so a refusal has nothing to free.  The sweep
+     itself can raise (a shape that will not broadcast); then the table is
+     left to ALLOCV's own holder, which the GC reclaims. */
+  table = ALLOCV_N(void *, vholder, nparts > 0 ? nparts : 1);
+  for ( i = 0; i < nparts; i++ ) {
+    table[i] = RSTRING_PTR(parts[i]);
+  }
+
+  switch ( n ) {
+  case 1: ca_call_cslab_1_r(function, fsync, arrays[0], table); break;
+  case 2: ca_call_cslab_2_r(function, fsync, arrays[0], arrays[1], table); break;
+  case 3: ca_call_cslab_3_r(function, fsync, arrays[0], arrays[1], arrays[2],
+                            table); break;
+  case 4: ca_call_cslab_4_r(function, fsync, arrays[0], arrays[1], arrays[2],
+                            arrays[3], table); break;
+  case 5: ca_call_cslab_5_r(function, fsync, arrays[0], arrays[1], arrays[2],
+                            arrays[3], arrays[4], table); break;
+  case 6: ca_call_cslab_6_r(function, fsync, arrays[0], arrays[1], arrays[2],
+                            arrays[3], arrays[4], arrays[5], table); break;
+  case 7: ca_call_cslab_7_r(function, fsync, arrays[0], arrays[1], arrays[2],
+                            arrays[3], arrays[4], arrays[5], arrays[6],
+                            table); break;
+  }
+
+  ALLOCV_END(vholder);
+  for ( i = 0; i < nparts; i++ ) {
+    RB_GC_GUARD(parts[i]);
+  }
+  RB_GC_GUARD(rarrays);
+  RB_GC_GUARD(rfsync);
+  return Qnil;
+}
+
 /* ------------------------------------------------------------------- */
 /* Init_carray_address_basis                                            */
 /* ------------------------------------------------------------------- */
@@ -978,6 +1111,7 @@ Init_carray_address_basis (void)
   rb_define_singleton_method(mAddressBasis, "classify",
                              address_basis_classify, 1);
   rb_define_singleton_method(mAddressBasis, "tier", address_basis_tier, 1);
+  rb_define_singleton_method(mAddressBasis, "sweep", address_basis_sweep, -1);
 
   rb_define_const(mAddressBasis, "TIER_ENTITY", INT2NUM(TIER_ENTITY));
   rb_define_const(mAddressBasis, "TIER_STRIDE", INT2NUM(TIER_STRIDE));

data/ext/carray_attribute.c

@@ -223,6 +223,14 @@ ca_is_readonly (void *ap)
         return 1;
       }
     }
+    if ( ca_test_flag(ca, CA_FLAG_FOLDED) ) {
+      /* a folded reshape: its source is not on the parent chain */
+      CArray *src = ca_fold_source(ca);
+      if ( src && ca_is_readonly(src) ) {
+        ca_set_flag(ca, CA_FLAG_READ_ONLY);
+        return 1;
+      }
+    }
     return 0;                                            /* all test -> false */
   }
 }
@@ -520,10 +528,34 @@ rb_ca_inherit_attr (VALUE dst, VALUE src)
    it up after this (an ivar, a lift that moves it onto another parent), and
    writes through it are refused by ca_is_readonly, which walks to the
    frozen root and finds CA_FLAG_READ_ONLY there. */
+static void
+ca_note_view_of_lent (CArray *p)
+{
+  if ( ca_test_flag(p, CA_FLAG_LENT) ) {
+    ca_set_flag(p, CA_FLAG_LENT_VIEWED);
+  }
+}
+
 VALUE
 rb_ca_set_parent (VALUE self, VALUE obj)
 {
   rb_ivar_set(self, id_parent, obj);
+  /* A view of an array lent to a CAObject hook outlives the hook: tell the
+     array, so that it keeps its cells when the hook returns.  A view of
+     several arrays names one here and holds the rest in parents[]. */
+  if ( rb_obj_is_carray(obj) ) {
+    ca_note_view_of_lent((CArray *) DATA_PTR(obj));
+  }
+  if ( rb_obj_is_carray(self) ) {
+    CArray *ca = (CArray *) DATA_PTR(self);
+    if ( ca_test_flag(ca, CA_FLAG_MULTI_PARENTS) ) {
+      CAMultiParent *mp = (CAMultiParent *) ca;
+      int32_t k;
+      for ( k = 0; k < mp->n_parents; k++ ) {
+        ca_note_view_of_lent(mp->parents[k]);
+      }
+    }
+  }
   return obj;
 }
 

data/ext/carray_broadcast.c

@@ -85,13 +85,12 @@ ca_broadcast_to_destination (VALUE dst, volatile VALUE *src)
     for ( i = 0; agree && i < dst_ndim; i++ ) {
       if ( dst_dim[i] != src_dim[i] ) agree = 0;
     }
-    if ( ! agree ) ca_broadcast_refuse_write(dst, *src);
-    return;
+    if ( agree ) return;
   }
 
   /* A size-1 axis repeated onto an axis of length 0 leaves the source
-     larger than an empty destination; the axes say it is a repeat all
-     the same. */
+     larger than an empty destination, or as large when it is empty too
+     ((1,0) onto (2,0)); the axes say it is a repeat all the same. */
   if ( ( cs->elements < cd->elements || cd->elements == 0 )
        && cs->ndim == cd->ndim ) {
     int i;