carray 2.0.0 → 3.0.0

data/ext/ca_sort_kernels.h

@@ -0,0 +1,132 @@
+/* ---------------------------------------------------------------------------
+
+  ca_sort_kernels.h
+
+  Portable textbook sort kernels (PROPOSAL_PORTABLE_TEXTBOOK_SORT).
+
+    P.1 / P.2 : quicksort + mergesort over the 10 numeric dtypes
+                (i8 / u8 / i16 / u16 / i32 / u32 / i64 / u64 / f32 / f64)
+    P.3       : NaN pre-partition for f32 / f64
+    P.4       : pair (value + index) variants for argsort kernels —
+                sort_index / sort_addr / partition_index family
+    P.9       : value-level quickselect for partition_copy
+
+  Status: ext-internal.  Signatures may change across 3.x while the
+  textbook sort family evolves.  Included from carray.h so internal
+  consumers (carray_sort_kernel.c, carray_order.c, carray_kernels.c,
+  mkkernel emit) reach it transparently via `#include "carray.h"`.
+
+  Depends on int8_t .. uint64_t / float32_t / double / ca_size_t
+  typedefs from carray.h — when this header is included from carray.h
+  mid-file, those typedefs are already in scope by the time we reach
+  the include site.
+
+  --------------------------------------------------------------------------- */
+
+#ifndef CA_SORT_KERNELS_H
+#define CA_SORT_KERNELS_H 1
+
+/* Needs int8_t .. uint64_t / float32_t / double / ca_size_t.  No longer
+   pulled mid-carray.h (PROPOSAL_CARRAY_H_REORG H.4.1), so include carray.h
+   directly to be self-sufficient when a consumer includes this header.
+   Guard-protected, so the re-entry is a no-op when carray.h is already in
+   flight. */
+#include "carray.h"
+
+/* P.1 / P.2: quicksort over 10 numeric dtypes. */
+void ca_sort_quick_i8  (int8_t    *a, ca_size_t n);
+void ca_sort_quick_u8  (uint8_t   *a, ca_size_t n);
+void ca_sort_quick_i16 (int16_t   *a, ca_size_t n);
+void ca_sort_quick_u16 (uint16_t  *a, ca_size_t n);
+void ca_sort_quick_i32 (int32_t   *a, ca_size_t n);
+void ca_sort_quick_u32 (uint32_t  *a, ca_size_t n);
+void ca_sort_quick_i64 (int64_t   *a, ca_size_t n);
+void ca_sort_quick_u64 (uint64_t  *a, ca_size_t n);
+void ca_sort_quick_f32 (float32_t *a, ca_size_t n);
+void ca_sort_quick_f64 (double    *a, ca_size_t n);
+
+/* P.1 / P.2: mergesort over 10 numeric dtypes (`aux` is caller-supplied
+   scratch buffer of the same length / dtype as `a`). */
+void ca_sort_merge_i8  (int8_t    *a, int8_t    *aux, ca_size_t n);
+void ca_sort_merge_u8  (uint8_t   *a, uint8_t   *aux, ca_size_t n);
+void ca_sort_merge_i16 (int16_t   *a, int16_t   *aux, ca_size_t n);
+void ca_sort_merge_u16 (uint16_t  *a, uint16_t  *aux, ca_size_t n);
+void ca_sort_merge_i32 (int32_t   *a, int32_t   *aux, ca_size_t n);
+void ca_sort_merge_u32 (uint32_t  *a, uint32_t  *aux, ca_size_t n);
+void ca_sort_merge_i64 (int64_t   *a, int64_t   *aux, ca_size_t n);
+void ca_sort_merge_u64 (uint64_t  *a, uint64_t  *aux, ca_size_t n);
+void ca_sort_merge_f32 (float32_t *a, float32_t *aux, ca_size_t n);
+void ca_sort_merge_f64 (double    *a, double    *aux, ca_size_t n);
+
+/* P.3: NaN pre-partition for float dtypes (Hoare 1-pass, returns finite count). */
+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. */
+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);
+
+/* P.9: value-level quickselect for partition_copy.
+   Reorders a[0..n) so that a[kth] is exact + left/right regions
+   satisfy <= / >= contracts.  Order within each region unspecified. */
+void ca_partition_quick_i8  (int8_t    *a, ca_size_t n, ca_size_t kth);
+void ca_partition_quick_u8  (uint8_t   *a, ca_size_t n, ca_size_t kth);
+void ca_partition_quick_i16 (int16_t   *a, ca_size_t n, ca_size_t kth);
+void ca_partition_quick_u16 (uint16_t  *a, ca_size_t n, ca_size_t kth);
+void ca_partition_quick_i32 (int32_t   *a, ca_size_t n, ca_size_t kth);
+void ca_partition_quick_u32 (uint32_t  *a, ca_size_t n, ca_size_t kth);
+void ca_partition_quick_i64 (int64_t   *a, ca_size_t n, ca_size_t kth);
+void ca_partition_quick_u64 (uint64_t  *a, ca_size_t n, ca_size_t kth);
+void ca_partition_quick_f32 (float32_t *a, ca_size_t n, ca_size_t kth);
+void ca_partition_quick_f64 (double    *a, ca_size_t n, ca_size_t kth);
+
+/* P.4: pair sort kernels (= argsort: sort_index / sort_addr).  The pair
+   struct is opaque to mkkernel-emitted callers via void*; each kernel
+   has its own well-defined layout: { TYPE v; ca_size_t i; } with natural
+   alignment padding. */
+struct ca_pair_i8  { int8_t    v; ca_size_t i; };
+struct ca_pair_u8  { uint8_t   v; ca_size_t i; };
+struct ca_pair_i16 { int16_t   v; ca_size_t i; };
+struct ca_pair_u16 { uint16_t  v; ca_size_t i; };
+struct ca_pair_i32 { int32_t   v; ca_size_t i; };
+struct ca_pair_u32 { uint32_t  v; ca_size_t i; };
+struct ca_pair_i64 { int64_t   v; ca_size_t i; };
+struct ca_pair_u64 { uint64_t  v; ca_size_t i; };
+struct ca_pair_f32 { float32_t v; ca_size_t i; };
+struct ca_pair_f64 { double    v; ca_size_t i; };
+typedef struct ca_pair_i8  ca_pair_i8;
+typedef struct ca_pair_u8  ca_pair_u8;
+typedef struct ca_pair_i16 ca_pair_i16;
+typedef struct ca_pair_u16 ca_pair_u16;
+typedef struct ca_pair_i32 ca_pair_i32;
+typedef struct ca_pair_u32 ca_pair_u32;
+typedef struct ca_pair_i64 ca_pair_i64;
+typedef struct ca_pair_u64 ca_pair_u64;
+typedef struct ca_pair_f32 ca_pair_f32;
+typedef struct ca_pair_f64 ca_pair_f64;
+
+void ca_sort_quick_pair_i8  (ca_pair_i8  *a, ca_size_t n);
+void ca_sort_quick_pair_u8  (ca_pair_u8  *a, ca_size_t n);
+void ca_sort_quick_pair_i16 (ca_pair_i16 *a, ca_size_t n);
+void ca_sort_quick_pair_u16 (ca_pair_u16 *a, ca_size_t n);
+void ca_sort_quick_pair_i32 (ca_pair_i32 *a, ca_size_t n);
+void ca_sort_quick_pair_u32 (ca_pair_u32 *a, ca_size_t n);
+void ca_sort_quick_pair_i64 (ca_pair_i64 *a, ca_size_t n);
+void ca_sort_quick_pair_u64 (ca_pair_u64 *a, ca_size_t n);
+void ca_sort_quick_pair_f32 (ca_pair_f32 *a, ca_size_t n);
+void ca_sort_quick_pair_f64 (ca_pair_f64 *a, ca_size_t n);
+
+void ca_sort_merge_pair_i8  (ca_pair_i8  *a, ca_pair_i8  *aux, ca_size_t n);
+void ca_sort_merge_pair_u8  (ca_pair_u8  *a, ca_pair_u8  *aux, ca_size_t n);
+void ca_sort_merge_pair_i16 (ca_pair_i16 *a, ca_pair_i16 *aux, ca_size_t n);
+void ca_sort_merge_pair_u16 (ca_pair_u16 *a, ca_pair_u16 *aux, ca_size_t n);
+void ca_sort_merge_pair_i32 (ca_pair_i32 *a, ca_pair_i32 *aux, ca_size_t n);
+void ca_sort_merge_pair_u32 (ca_pair_u32 *a, ca_pair_u32 *aux, ca_size_t n);
+void ca_sort_merge_pair_i64 (ca_pair_i64 *a, ca_pair_i64 *aux, ca_size_t n);
+void ca_sort_merge_pair_u64 (ca_pair_u64 *a, ca_pair_u64 *aux, ca_size_t n);
+void ca_sort_merge_pair_f32 (ca_pair_f32 *a, ca_pair_f32 *aux, ca_size_t n);
+void ca_sort_merge_pair_f64 (ca_pair_f64 *a, ca_pair_f64 *aux, ca_size_t n);
+
+#endif /* CA_SORT_KERNELS_H */

data/ext/ca_sweep_engine.c

@@ -0,0 +1,430 @@
+/* ---------------------------------------------------------------------------
+
+  Sweep (xfer_all) author-surface engine: shared acquire / release
+  bodies for the ca_call_cfunc trampolines generated by
+  mk_call_cfunc.rb.  See ca_sweep_engine.h for the full lifecycle
+  template.
+
+  Two paths:
+    whole-buffer  ca_sweep_acquire / _release           — xmalloc scratch
+    chunked       ca_sweep_acquire_chunked / _next_chunk / _release_chunked
+                                                        — arena scratch
+
+  Both propagate INPUT masks to OUTPUT masks and honor the NO_MASK
+  form guard (masked INPUT + NO_MASK = raise, since a NO_MASK kernel
+  cannot observe masked cells).
+
+---------------------------------------------------------------------------- */
+
+#include "carray.h"
+#include "carray_internal.h"   /* ca_lazy_arena_* */
+#include "ca_sweep_engine.h"
+#include "ca_for_buffer.h"
+#include <string.h>
+
+void
+ca_sweep_acquire (ca_sweep_state_t *st)
+{
+  int k_op;
+  int any_input_mask = 0;
+
+  if ((int) strlen(st->fsync) != st->n_ops) {
+    rb_raise(rb_eRuntimeError,
+             "[BUG] invalid length of fsync arg in %s (expected %d)",
+             st->src_label ? st->src_label : "ca_sweep_acquire",
+             st->n_ops);
+  }
+
+  for (k_op = 0; k_op < st->n_ops; k_op++) {
+    st->base[k_op]      = NULL;
+    st->owned_buf[k_op] = NULL;
+    st->attached[k_op]  = 0;
+  }
+  st->m0       = NULL;
+  st->n_kernel = 1;
+  /* CAREFUL: do not reset st->no_mask here — caller sets it before
+   * acquire and the NO_MASK guard below consumes it. */
+
+  /* Per-operand acquire:
+   *   OUTPUT (fsync == '1')       -> ca_attach + base = ca->ptr
+   *   INPUT alias                 -> ca_attach + base = ca->ptr
+   *   INPUT non-alias non-scalar  -> xmalloc scratch + ca_xfer_all
+   * INPUT non-alias never attaches the operand itself; the scratch
+   * copy carries the values into the kernel. */
+  for (k_op = 0; k_op < st->n_ops; k_op++) {
+    CArray *ca = st->cx[k_op];
+    if (st->fsync[k_op] == '1') {
+      ca_attach(ca);
+      st->base[k_op]     = (char *) ca->ptr;
+      st->attached[k_op] = 1;
+    } else if (ca_attach_is_alias(ca)) {
+      ca_attach(ca);
+      st->base[k_op]     = (char *) ca->ptr;
+      st->attached[k_op] = 1;
+    } else {
+      ca_size_t bytes_total = ca->elements * ca->bytes;
+      st->owned_buf[k_op] = xmalloc(bytes_total);
+      st->base[k_op]      = st->owned_buf[k_op];
+      ca_xfer_all(ca, st->base[k_op], CA_XFER_GET);
+    }
+  }
+
+  /* compute n_kernel (= broadcast shape) and per-cell strides */
+  for (k_op = 0; k_op < st->n_ops; k_op++) {
+    CArray *ca = st->cx[k_op];
+    if (ca_is_scalar(ca)) {
+      st->stride[k_op] = 0;
+    } else {
+      st->stride[k_op] = ca->bytes;
+      if (st->n_kernel == 1) {
+        st->n_kernel = ca->elements;
+      } else if (ca->elements != st->n_kernel) {
+        rb_raise(rb_eRuntimeError, "data size mismatch in operation");
+      }
+    }
+  }
+
+  /* iter mask m0 = OR of INPUT operand masks, gathered via ca_xfer_all
+     so no operand mask attach happens.  Stays NULL if no INPUT masks. */
+  for (k_op = 0; k_op < st->n_ops; k_op++) {
+    if (st->fsync[k_op] == '0' && ca_has_mask(st->cx[k_op])) {
+      any_input_mask = 1;
+      break;
+    }
+  }
+  if (any_input_mask && st->no_mask) {
+    rb_raise(rb_eRuntimeError,
+             "%s: masked INPUT not allowed in NO_MASK form "
+             "(use the *_MASKED form to handle masked cells explicitly)",
+             st->src_label ? st->src_label : "ca_sweep_acquire");
+  }
+  if (any_input_mask) {
+    st->m0 = xmalloc(st->n_kernel);
+    memset(st->m0, 0, st->n_kernel);
+    for (k_op = 0; k_op < st->n_ops; k_op++) {
+      CArray *ca = st->cx[k_op];
+      if (st->fsync[k_op] != '0') continue;
+      ca_update_mask(ca);
+      if (!ca->mask) continue;
+      if (ca_is_scalar(ca)) {
+        boolean8_t bit = 0;
+        ca_xfer_all(ca->mask, &bit, CA_XFER_GET);
+        if (bit) memset(st->m0, 1, st->n_kernel);
+      } else {
+        boolean8_t *ms = xmalloc(st->n_kernel);
+        ca_size_t j;
+        ca_xfer_all(ca->mask, ms, CA_XFER_GET);
+        for (j = 0; j < st->n_kernel; j++) st->m0[j] |= ms[j];
+        xfree(ms);
+      }
+    }
+  }
+
+  /* Overwrite each OUTPUT mask with the iter mask (creating the
+     OUTPUT mask if it did not exist).  No-op when m0 is NULL. */
+  if (st->m0) {
+    for (k_op = 0; k_op < st->n_ops; k_op++) {
+      CArray *ca = st->cx[k_op];
+      if (st->fsync[k_op] != '1') continue;
+      ca_update_mask(ca);
+      if (!ca->mask) ca_create_mask(ca);
+      memcpy(ca->mask->ptr, st->m0, st->n_kernel);
+    }
+  }
+}
+
+void
+ca_sweep_release (ca_sweep_state_t *st)
+{
+  int k_op;
+  /* sync OUTPUTs (reverse order) */
+  for (k_op = st->n_ops - 1; k_op >= 0; k_op--) {
+    if (st->fsync[k_op] == '1') ca_sync(st->cx[k_op]);
+  }
+  /* detach attached / xfree owned buffers (reverse order) */
+  for (k_op = st->n_ops - 1; k_op >= 0; k_op--) {
+    if (st->attached[k_op]) {
+      ca_detach(st->cx[k_op]);
+    } else if (st->owned_buf[k_op]) {
+      xfree(st->owned_buf[k_op]);
+      st->owned_buf[k_op] = NULL;
+    }
+  }
+  if (st->m0) {
+    xfree(st->m0);
+    st->m0 = NULL;
+  }
+}
+
+/* ===== Chunked path implementation ===== */
+
+void
+ca_sweep_acquire_chunked (ca_sweep_state_t *st)
+{
+  int k_op;
+  int any_input_mask = 0;
+  CArray *shape_donor = NULL;
+
+  if ((int) strlen(st->fsync) != st->n_ops) {
+    rb_raise(rb_eRuntimeError,
+             "[BUG] invalid length of fsync arg in %s (expected %d)",
+             st->src_label ? st->src_label : "ca_sweep_acquire_chunked",
+             st->n_ops);
+  }
+
+  for (k_op = 0; k_op < st->n_ops; k_op++) {
+    st->base[k_op]      = NULL;
+    st->base_orig[k_op] = NULL;
+    st->owned_buf[k_op] = NULL;
+    st->attached[k_op]  = 0;
+  }
+  st->m0            = NULL;
+  st->n_kernel      = 1;
+  st->chunk_off     = 0;
+  st->chunk_n       = 0;
+  st->chunk_n_max   = 0;
+  st->inner         = 1;
+  st->chunked_state = 0;
+
+  /* compute broadcast shape (n_kernel + strides) from operand shapes.
+   * scalar operands collapse to stride 0; non-scalar operands must agree
+   * on element count.  shape_donor is the first non-scalar operand and
+   * defines the chunking inner-axis size. */
+  for (k_op = 0; k_op < st->n_ops; k_op++) {
+    CArray *ca = st->cx[k_op];
+    if (ca_is_scalar(ca)) {
+      st->stride[k_op] = 0;
+    } else {
+      st->stride[k_op] = ca->bytes;
+      if (st->n_kernel == 1) {
+        st->n_kernel = ca->elements;
+        shape_donor  = ca;
+      } else if (ca->elements != st->n_kernel) {
+        rb_raise(rb_eRuntimeError, "data size mismatch in operation");
+      }
+    }
+  }
+
+  /* chunk-size policy: inner = donor's product of dims[1..]; chunk_n_max
+   * = compute_n on donor->bytes (= dtype-dependent 32KB target). */
+  if (shape_donor) {
+    st->inner = ca_chunk_inner_size(shape_donor);
+    st->chunk_n_max = ca_chunk_compute_n(st->n_kernel, st->inner,
+                                         shape_donor->bytes);
+  } else {
+    /* all-scalar: single 1-cell chunk */
+    st->inner       = 1;
+    st->chunk_n_max = 1;
+  }
+
+  /* per-operand acquire:
+   *   OUTPUT (fsync == '1') : ca_attach + base_orig = ca->ptr (legitimate)
+   *   INPUT  alias          : ca_attach + base_orig = ca->ptr (zero-copy)
+   *   INPUT  non-alias non-scalar : arena chunk scratch of chunk_n_max bytes
+   *   INPUT  scalar         : ca_attach + base_orig = ca->ptr (1 cell)
+   */
+  for (k_op = 0; k_op < st->n_ops; k_op++) {
+    CArray *ca = st->cx[k_op];
+    if (st->fsync[k_op] == '1') {
+      ca_attach(ca);
+      st->base_orig[k_op] = (char *) ca->ptr;
+      st->attached[k_op]  = 1;
+    } else if (ca_is_scalar(ca) || ca_attach_is_alias(ca)) {
+      ca_attach(ca);
+      st->base_orig[k_op] = (char *) ca->ptr;
+      st->attached[k_op]  = 1;
+    } else {
+      /* non-alias non-scalar INPUT: arena scratch sized for chunk_n_max */
+      ca_size_t scratch_bytes = st->chunk_n_max * ca->bytes;
+      st->owned_buf[k_op] = (char *) ca_lazy_arena_acquire(scratch_bytes);
+      /* base_orig stays NULL -- per-chunk gather lands the data in
+       * owned_buf[k_op]; base[k_op] will be set to owned_buf[k_op] at
+       * each chunk boundary. */
+    }
+  }
+
+  /* iter mask = OR of INPUT operand masks (full size, n_kernel bytes).
+   * Per-chunk mask gather is a future optim; this MVP gathers once. */
+  for (k_op = 0; k_op < st->n_ops; k_op++) {
+    if (st->fsync[k_op] == '0' && ca_has_mask(st->cx[k_op])) {
+      any_input_mask = 1;
+      break;
+    }
+  }
+  if (any_input_mask && st->no_mask) {
+    rb_raise(rb_eRuntimeError,
+             "%s: masked INPUT not allowed in NO_MASK form "
+             "(use the *_MASKED form to handle masked cells explicitly)",
+             st->src_label ? st->src_label : "ca_sweep_acquire_chunked");
+  }
+  if (any_input_mask) {
+    st->m0 = (boolean8_t *) ca_lazy_arena_acquire(st->n_kernel);
+    memset(st->m0, 0, st->n_kernel);
+    for (k_op = 0; k_op < st->n_ops; k_op++) {
+      CArray *ca = st->cx[k_op];
+      if (st->fsync[k_op] != '0') continue;
+      ca_update_mask(ca);
+      if (!ca->mask) continue;
+      if (ca_is_scalar(ca)) {
+        boolean8_t bit = 0;
+        ca_xfer_all(ca->mask, &bit, CA_XFER_GET);
+        if (bit) memset(st->m0, 1, st->n_kernel);
+      } else {
+        boolean8_t *ms = (boolean8_t *) ca_lazy_arena_acquire(st->n_kernel);
+        ca_size_t j;
+        ca_xfer_all(ca->mask, ms, CA_XFER_GET);
+        for (j = 0; j < st->n_kernel; j++) st->m0[j] |= ms[j];
+        ca_lazy_arena_release(ms);
+      }
+    }
+  }
+
+  /* CAREFUL: m0 -> OUTPUT mask propagation is deferred to release
+   * time so that author per-cell m_out writes during the chunk loop
+   * are captured in the final OUTPUT mask.  Do not fold this into
+   * acquire; doing so would clobber the author's writes. */
+}
+
+int
+ca_sweep_next_chunk (ca_sweep_state_t *st)
+{
+  int k_op;
+  ca_size_t off, n;
+
+  if (st->chunked_state == 0) {
+    /* first chunk */
+    st->chunk_off     = 0;
+    st->chunked_state = 1;
+  } else {
+    /* advance */
+    st->chunk_off += st->chunk_n;
+  }
+
+  if (st->chunk_off >= st->n_kernel) {
+    st->chunked_state = 2;
+    return 0;
+  }
+
+  off = st->chunk_off;
+  n   = st->chunk_n_max;
+  if (off + n > st->n_kernel) n = st->n_kernel - off;
+  st->chunk_n = n;
+
+  /* set up base[] for the upcoming chunk */
+  for (k_op = 0; k_op < st->n_ops; k_op++) {
+    CArray *ca = st->cx[k_op];
+    if (st->stride[k_op] == 0) {
+      /* scalar: stride 0, base is the single-cell ptr (base_orig) */
+      st->base[k_op] = st->base_orig[k_op];
+    } else if (st->base_orig[k_op]) {
+      /* alias INPUT or OUTPUT: walk through ca->ptr by chunk_off */
+      st->base[k_op] = st->base_orig[k_op] + off * st->stride[k_op];
+    } else {
+      /* non-alias INPUT: per-chunk gather into owned_buf (arena) */
+      ca_chunked_gather(ca, off, n, st->owned_buf[k_op]);
+      st->base[k_op] = st->owned_buf[k_op];
+    }
+  }
+
+  return 1;
+}
+
+void
+ca_sweep_release_chunked (ca_sweep_state_t *st)
+{
+  int k_op;
+  /* Propagate (possibly author-mutated) m0 to OUTPUT mask before
+   * sync.  For INOUT_MASKED forms this captures the author's per-cell
+   * m_out writes; other forms behave the same as the whole-buffer
+   * acquire-time propagation. */
+  if (st->m0) {
+    for (k_op = 0; k_op < st->n_ops; k_op++) {
+      CArray *ca = st->cx[k_op];
+      if (st->fsync[k_op] != '1') continue;
+      ca_update_mask(ca);
+      if (!ca->mask) ca_create_mask(ca);
+      memcpy(ca->mask->ptr, st->m0, st->n_kernel);
+    }
+  }
+  /* sync OUTPUTs (reverse order, regardless of whether chunk loop ran) */
+  for (k_op = st->n_ops - 1; k_op >= 0; k_op--) {
+    if (st->fsync[k_op] == '1') ca_sync(st->cx[k_op]);
+  }
+  /* detach attached / release arena scratch buffers (reverse order) */
+  for (k_op = st->n_ops - 1; k_op >= 0; k_op--) {
+    if (st->attached[k_op]) {
+      ca_detach(st->cx[k_op]);
+    } else if (st->owned_buf[k_op]) {
+      ca_lazy_arena_release(st->owned_buf[k_op]);
+      st->owned_buf[k_op] = NULL;
+    }
+  }
+  if (st->m0) {
+    ca_lazy_arena_release(st->m0);
+    st->m0 = NULL;
+  }
+}
+
+/* ===== WHOLE_BUFFER function form (rb_ensure-protected) ===== */
+
+typedef struct {
+  CArray              *ca;
+  int                  writable;
+  ca_with_buffer_body_fn body_fn;
+  void                *user_data;
+} ca_with_buffer_ctx_t;
+
+static VALUE
+ca_with_buffer_body_trampoline (VALUE ctx_val)
+{
+  ca_with_buffer_ctx_t *ctx = (ca_with_buffer_ctx_t *) ctx_val;
+  ctx->body_fn(ctx->user_data, ctx->ca->ptr, ctx->ca->elements);
+  return Qnil;
+}
+
+static VALUE
+ca_with_buffer_ensure_trampoline (VALUE ctx_val)
+{
+  ca_with_buffer_ctx_t *ctx = (ca_with_buffer_ctx_t *) ctx_val;
+  if (ctx->writable) ca_sync(ctx->ca);
+  ca_detach(ctx->ca);
+  return Qnil;
+}
+
+void
+rb_ca_call_with_buffer (VALUE r_ca, int writable,
+                   ca_with_buffer_body_fn body, void *user_data)
+{
+  ca_with_buffer_ctx_t ctx;
+  TypedData_Get_Struct(r_ca, CArray, &carray_data_type, ctx.ca);
+  /* CAREFUL: attach outside rb_ensure.  If attach raises, we are not
+   * yet inside the ensure scope, so the ensure trampoline will not
+   * fire on a not-attached ca (which would try to detach and crash). */
+  ca_attach(ctx.ca);
+  ctx.writable  = writable;
+  ctx.body_fn   = body;
+  ctx.user_data = user_data;
+  rb_ensure(ca_with_buffer_body_trampoline,    (VALUE) &ctx,
+            ca_with_buffer_ensure_trampoline,  (VALUE) &ctx);
+}
+
+void
+ca_sweep_check_same_shape (CArray *ca_in, CArray *ca_out, const char *src_label)
+{
+  int k;
+  const char *lbl = src_label ? src_label : "ca_sweep_check_same_shape";
+  if (ca_in->ndim != ca_out->ndim) {
+    rb_raise(rb_eRuntimeError,
+             "%s: shape mismatch (ndim %d vs %d)",
+             lbl, ca_in->ndim, ca_out->ndim);
+  }
+  for (k = 0; k < ca_in->ndim; k++) {
+    if (ca_in->dim[k] != ca_out->dim[k]) {
+      rb_raise(rb_eRuntimeError,
+               "%s: shape mismatch at dim[%d] (%lld vs %lld)",
+               lbl, k,
+               (long long) ca_in->dim[k],
+               (long long) ca_out->dim[k]);
+    }
+  }
+}