carray 3.0.2 → 3.0.4

data/ext/carray_histogram.c

@@ -23,13 +23,42 @@
 ---------------------------------------------------------------------------- */
 
 #include "carray.h"
+#include "carray_internal.h"   /* ca_attach_window */
 #include <math.h>
 
-/* Resolve `redges` to a contiguous, attached, 1-D float64 CArray.
-   Returns the CArray* and (via out params) the data pointer + element
-   count.  Caller must ca_detach when done. */
-static CArray *
-histbin_attach_edges (VALUE self, VALUE redges, double **ep_out, ca_size_t *ne_out)
+/* Edges are the bin boundaries and must read as such: no masked edge (its
+   stored value is no boundary), no NaN, and no edge below the one before
+   it.  Equal edges (a bin of zero width) and infinite ones are kept. */
+static void
+histbin_check_edge_mask (CArray *ce, const char *name)
+{
+  if ( ca_has_mask(ce) && ca_is_any_masked(ce) ) {
+    rb_raise(rb_eArgError, "%s: edges has a masked value", name);
+  }
+}
+
+static void
+histbin_check_edge_order (const double *ep, ca_size_t n, const char *name)
+{
+  ca_size_t i;
+  for (i = 0; i < n; i++) {
+    if ( isnan(ep[i]) ) {
+      rb_raise(rb_eArgError, "%s: edges has NaN at %lld", name, (long long) i);
+    }
+    if ( i > 0 && ep[i] < ep[i-1] ) {
+      rb_raise(rb_eArgError, "%s: edges must not decrease "
+               "(%g at %lld after %g)", name, ep[i], (long long) i, ep[i-1]);
+    }
+  }
+}
+
+/* Resolve `redges` to a 1-D float64 CArray of at least two edges, and
+   return it: it may be a view made here, which only the caller can keep
+   alive.  The caller copies the edges out (ca_xfer_all into its own
+   buffer) rather than attaching them: the walk that follows reads the
+   caller's array, and a raise there must not leave the edges attached. */
+static VALUE
+histbin_resolve_edges (VALUE self, VALUE redges)
 {
   CArray *ce;
 
@@ -48,11 +77,9 @@ histbin_attach_edges (VALUE self, VALUE redges, double **ep_out, ca_size_t *ne_o
   if ( ce->elements < 2 ) {
     rb_raise(rb_eArgError, "histbin_ki: edges needs at least 2 values");
   }
+  histbin_check_edge_mask(ce, "bin_to");
 
-  ca_attach(ce);
-  *ep_out = (double *) ce->ptr;
-  *ne_out = ce->elements;
-  return ce;
+  return redges;
 }
 
 /* ---- shared binning helpers (used by histbin_ki + the fused kernel) ---- */
@@ -105,19 +132,24 @@ histbin_index (const histbin_axis_t *ax, double v)
 }
 
 static void
-histbin_axis_setup (histbin_axis_t *ax, CArray *ce, int include_max)
+histbin_axis_setup (histbin_axis_t *ax, const double *ep, ca_size_t ne,
+                    int include_max)
 {
-  ca_size_t ne = ce->elements, kk;
+  ca_size_t kk;
   double    dx, tol;
 
-  ax->ep = (const double *) ce->ptr;
+  ax->ep = ep;
   ax->n  = ne - 1;
   ax->lo = ax->ep[0];
   ax->hi = ax->ep[ne - 1];
   dx     = (ax->hi - ax->lo) / (double) ax->n;
   tol    = fabs(dx) * 1e-9 + 1e-12;
-  ax->uniform = 1;
-  for ( kk = 0; kk <= ax->n; kk++ ) {
+  /* The linearised index needs a width and its reciprocal that are both
+     finite and nonzero: edges spanning more than a double holds make the
+     width infinite, and a subnormal width makes the reciprocal infinite.
+     Either turns the position into NaN, which has no integer. */
+  ax->uniform = isfinite(dx) && dx != 0.0 && isfinite(1.0 / dx);
+  for ( kk = 0; ax->uniform && kk <= ax->n; kk++ ) {
     if ( fabs(ax->ep[kk] - (ax->lo + (double) kk * dx)) > tol ) { ax->uniform = 0; break; }
   }
   ax->inv_dx      = (dx != 0.0) ? 1.0 / dx : 0.0;
@@ -129,8 +161,8 @@ rb_ca_histbin_ki (VALUE self, VALUE redges, VALUE rinclude_max)
 {
   CArray         *ca, *co, *ce;
   VALUE           vout;
+  volatile VALUE  hedges = 0;
   double         *ep;
-  ca_size_t       ne;
   histbin_axis_t  ax;
 
   GetCArray(self, ca);
@@ -140,9 +172,13 @@ rb_ca_histbin_ki (VALUE self, VALUE redges, VALUE rinclude_max)
              ca_type_name[ca->data_type]);
   }
 
-  ce = histbin_attach_edges(self, redges, &ep, &ne);
-  (void) ep; (void) ne;                  /* axis setup reads ce directly */
-  histbin_axis_setup(&ax, ce, RTEST(rinclude_max));
+  redges = histbin_resolve_edges(self, redges);
+  GetCArray(redges, ce);
+  ep = ALLOCV_N(double, hedges, ce->elements);
+  ca_xfer_all(ce, ep, CA_XFER_GET);
+  histbin_check_edge_order(ep, ce->elements, "bin_to");
+  histbin_axis_setup(&ax, ep, ce->elements, RTEST(rinclude_max));
+  RB_GC_GUARD(redges);   /* a view made by histbin_resolve_edges is read through ce */
 
   /* output: fresh contiguous int64, same shape as self. */
   vout = rb_carray_new(CA_INT64, ca->ndim, ca->dim, 0, NULL);
@@ -179,7 +215,7 @@ rb_ca_histbin_ki (VALUE self, VALUE redges, VALUE rinclude_max)
     }
   }
 
-  ca_detach(ce);
+  ALLOCV_END(hedges);
 
   return vout;
 }
@@ -201,6 +237,129 @@ rb_ca_histbin_ki (VALUE self, VALUE redges, VALUE rinclude_max)
        off = fiber_base + Σ_k histbin_index(axis_k, v_{a,k}) * ext_stride[k]
        counts[off] += 1  (or += weight when weighted)
    =========================================================================== */
+/* histogram_scatter_ki reads its edges inside an attach window and walks
+   the samples (and the weights) with two kernel iterators, whose states
+   live here, outside the walk: a sample view that raises as it is read --
+   a lazy source meeting a cell it cannot compute -- leaves neither the
+   edges nor the other walk open. */
+typedef struct {
+  ca_iter_state   states[2];      /* the samples, the weights */
+  CArray         *ca, *cc, *cw;
+  long            M, nf;
+  int             weighted;
+  CArray        **edge_ca;
+  VALUE           rincmax;
+  histbin_axis_t *axes;
+  ca_size_t      *ext_stride;
+  ca_size_t      *fiber_stride;
+} histogram_scatter_t;
+
+static VALUE
+histogram_scatter_walk (VALUE arg)
+{
+  histogram_scatter_t *c = (histogram_scatter_t *) arg;
+  CArray         *ca = c->ca, *cc = c->cc, *cw = c->cw;
+  long            M = c->M, k;
+  int             weighted = c->weighted;
+  histbin_axis_t *axes = c->axes;
+  ca_size_t      *ext_stride = c->ext_stride;
+  ca_size_t      *fiber_stride = c->fiber_stride;
+#define st  (c->states[0])
+#define stw (c->states[1])
+  int64_t      *cpi = (int64_t *) cc->ptr;   /* unweighted */
+  double       *cpd = (double *)  cc->ptr;   /* weighted   */
+  char         *p, *pw = NULL;
+  boolean8_t   *m, *mw = NULL;
+  ca_size_t     cur_outer_idx[CA_RANK_MAX];
+  int8_t        slab_axes[2] = { (int8_t)(ca->ndim - 2), (int8_t)(ca->ndim - 1) };
+  int8_t        w_slab_axes[1] = { (int8_t)(ca->ndim - 2) };  /* weights sample axis */
+  int8_t        mm;
+  int           rc;
+
+  rc = ca_iter_state_init_l2(&st, ca, CA_SLAB_AXES, slab_axes, 2, 0);
+  if ( rc != CA_ITER_OK ) {
+    rb_raise(rb_eRuntimeError, "histogram_scatter_ki: iter init failed rc=%d", rc);
+  }
+  if ( weighted ) {
+    rc = ca_iter_state_init_l2(&stw, cw, CA_SLAB_AXES, w_slab_axes, 1, 0);
+    if ( rc != CA_ITER_OK ) {
+      rb_raise(rb_eRuntimeError, "histogram_scatter_ki: weights iter init failed rc=%d", rc);
+    }
+  }
+  for ( mm = 0; mm < st.outer_ndim; mm++ ) cur_outer_idx[mm] = 0;
+
+  while ( ca_iter_state_next_slab_axes(&st, &p, &m) ) {
+    ca_size_t fiber_base = 0;
+    ca_size_t A, a, kk;
+    ca_size_t ss, cs, sms, cms, ws = 0, wms = 0;
+
+    if ( weighted && ! ca_iter_state_next_slab_axes(&stw, &pw, &mw) ) break;
+
+    for ( mm = 0; mm < st.outer_ndim; mm++ )
+      fiber_base += cur_outer_idx[mm] * fiber_stride[mm];
+
+    A   = st.slab_dims[0];               /* samples */
+    ss  = st.slab_strides[0];            /* sample byte stride */
+    cs  = st.slab_strides[1];            /* channel byte stride */
+    sms = st.slab_mask_strides[0];
+    cms = st.slab_mask_strides[1];
+    if ( weighted ) {
+      ws  = stw.slab_strides[0];
+      wms = stw.slab_mask_strides[0];
+    }
+
+    for ( a = 0; a < A; a++ ) {
+      ca_size_t off = fiber_base;
+      int       masked = 0;
+      for ( kk = 0; kk < (ca_size_t) M; kk++ ) {
+        double v = *(const double *)(p + a * ss + kk * cs);
+        if ( (m && m[a * sms + kk * cms]) || isnan(v) ) { masked = 1; break; }
+        off += histbin_index(&axes[kk], v) * ext_stride[kk];
+      }
+      if ( masked ) continue;
+      if ( weighted ) {
+        double w = *(const double *)(pw + a * ws);
+        if ( (mw && mw[a * wms]) || isnan(w) ) continue;  /* skip masked / NaN weight */
+        cpd[off] += w;
+      }
+      else {
+        cpi[off] += 1;
+      }
+    }
+
+    for ( mm = (int8_t)(st.outer_ndim - 1); mm >= 0; mm-- ) {
+      if ( ++cur_outer_idx[mm] < st.outer_dims[mm] ) break;
+      cur_outer_idx[mm] = 0;
+    }
+  }
+  ca_iter_state_finish(&st);
+  if ( weighted ) ca_iter_state_finish(&stw);
+#undef st
+#undef stw
+  (void) k;
+  return Qnil;
+}
+
+static VALUE
+histogram_scatter_edges (VALUE arg)
+{
+  histogram_scatter_t *c = (histogram_scatter_t *) arg;
+  long k;
+  for ( k = 0; k < c->M; k++ ) {
+    histbin_check_edge_order((const double *) c->edge_ca[k]->ptr,
+                             c->edge_ca[k]->elements, "histogram");
+  }
+  for ( k = 0; k < c->M; k++ ) {
+    histbin_axis_setup(&c->axes[k], (const double *) c->edge_ca[k]->ptr,
+                       c->edge_ca[k]->elements,
+                       RTEST(RARRAY_AREF(c->rincmax, k)));
+  }
+  if ( c->ca->elements > 0 ) {
+    ca_iter_ensure(2, c->states, histogram_scatter_walk, arg);
+  }
+  return Qnil;
+}
+
 static VALUE
 rb_ca_histogram_scatter_ki (VALUE self, VALUE rcounts, VALUE redges,
                             VALUE rincmax, VALUE rweights)
@@ -258,8 +417,7 @@ rb_ca_histogram_scatter_ki (VALUE self, VALUE rcounts, VALUE redges,
   for ( k = 0; k < M; k++ ) {
     VALUE e = RARRAY_AREF(redges, k);
     GetCArray(e, edge_ca[k]);
-    ca_attach(edge_ca[k]);
-    histbin_axis_setup(&axes[k], edge_ca[k], RTEST(RARRAY_AREF(rincmax, k)));
+    histbin_check_edge_mask(edge_ca[k], "histogram");
   }
 
   /* ext strides (row-major within the trailing M bin axes of counts). */
@@ -275,83 +433,19 @@ rb_ca_histogram_scatter_ki (VALUE self, VALUE rcounts, VALUE redges,
     s *= cc->dim[k];
   }
 
-  if ( ca->elements > 0 ) {
-    int64_t      *cpi = (int64_t *) cc->ptr;   /* unweighted */
-    double       *cpd = (double *)  cc->ptr;   /* weighted   */
-    ca_iter_state st, stw;
-    char         *p, *pw = NULL;
-    boolean8_t   *m, *mw = NULL;
-    ca_size_t     cur_outer_idx[CA_RANK_MAX];
-    int8_t        slab_axes[2] = { (int8_t)(ca->ndim - 2), (int8_t)(ca->ndim - 1) };
-    int8_t        w_slab_axes[1] = { (int8_t)(ca->ndim - 2) };  /* weights sample axis */
-    int8_t        mm;
-    int           rc;
-
-    rc = ca_iter_state_init_l2(&st, ca, CA_SLAB_AXES, slab_axes, 2, 0);
-    if ( rc != CA_ITER_OK ) {
-      for ( k = 0; k < M; k++ ) ca_detach(edge_ca[k]);
-      rb_raise(rb_eRuntimeError, "histogram_scatter_ki: iter init failed rc=%d", rc);
-    }
-    if ( weighted ) {
-      rc = ca_iter_state_init_l2(&stw, cw, CA_SLAB_AXES, w_slab_axes, 1, 0);
-      if ( rc != CA_ITER_OK ) {
-        ca_iter_state_finish(&st);
-        for ( k = 0; k < M; k++ ) ca_detach(edge_ca[k]);
-        rb_raise(rb_eRuntimeError, "histogram_scatter_ki: weights iter init failed rc=%d", rc);
-      }
-    }
-    for ( mm = 0; mm < st.outer_ndim; mm++ ) cur_outer_idx[mm] = 0;
-
-    while ( ca_iter_state_next_slab_axes(&st, &p, &m) ) {
-      ca_size_t fiber_base = 0;
-      ca_size_t A, a, kk;
-      ca_size_t ss, cs, sms, cms, ws = 0, wms = 0;
-
-      if ( weighted && ! ca_iter_state_next_slab_axes(&stw, &pw, &mw) ) break;
-
-      for ( mm = 0; mm < st.outer_ndim; mm++ )
-        fiber_base += cur_outer_idx[mm] * fiber_stride[mm];
-
-      A   = st.slab_dims[0];               /* samples */
-      ss  = st.slab_strides[0];            /* sample byte stride */
-      cs  = st.slab_strides[1];            /* channel byte stride */
-      sms = st.slab_mask_strides[0];
-      cms = st.slab_mask_strides[1];
-      if ( weighted ) {
-        ws  = stw.slab_strides[0];
-        wms = stw.slab_mask_strides[0];
-      }
-
-      for ( a = 0; a < A; a++ ) {
-        ca_size_t off = fiber_base;
-        int       masked = 0;
-        for ( kk = 0; kk < (ca_size_t) M; kk++ ) {
-          double v = *(const double *)(p + a * ss + kk * cs);
-          if ( (m && m[a * sms + kk * cms]) || isnan(v) ) { masked = 1; break; }
-          off += histbin_index(&axes[kk], v) * ext_stride[kk];
-        }
-        if ( masked ) continue;
-        if ( weighted ) {
-          double w = *(const double *)(pw + a * ws);
-          if ( (mw && mw[a * wms]) || isnan(w) ) continue;  /* skip masked / NaN weight */
-          cpd[off] += w;
-        }
-        else {
-          cpi[off] += 1;
-        }
-      }
-
-      for ( mm = (int8_t)(st.outer_ndim - 1); mm >= 0; mm-- ) {
-        if ( ++cur_outer_idx[mm] < st.outer_dims[mm] ) break;
-        cur_outer_idx[mm] = 0;
-      }
-    }
-    ca_iter_state_finish(&st);
-    if ( weighted ) ca_iter_state_finish(&stw);
+  {
+    histogram_scatter_t c;
+    char modes[CA_RANK_MAX + 1];
+    for ( k = 0; k < M; k++ ) modes[k] = 'r';
+    modes[M] = '\0';
+    c.ca = ca; c.cc = cc; c.cw = cw;
+    c.M = M; c.nf = nf; c.weighted = weighted;
+    c.edge_ca = edge_ca; c.rincmax = rincmax; c.axes = axes;
+    c.ext_stride = ext_stride; c.fiber_stride = fiber_stride;
+    ca_attach_window((int32_t) M, edge_ca, modes, histogram_scatter_edges,
+                     (VALUE) &c);
   }
 
-  for ( k = 0; k < M; k++ ) ca_detach(edge_ca[k]);
-
   return rcounts;
 }
 
@@ -370,7 +464,16 @@ rb_ca_histogram_scatter_ki (VALUE self, VALUE rcounts, VALUE redges,
      weights = nil OR float64 [fiber..., A] (second iterator in lockstep).
    =========================================================================== */
 
-#define BINCOUNT_ND_BODY(LABEL_T)                                              \
+/* A label at or above the last bin lands in the overflow cell.  An unsigned
+   64-bit label above INT64_MAX must be clamped before it becomes an int64,
+   or it turns negative and indexes before the counts. */
+static inline int64_t
+bincount_nd_label_u64 (uint64_t x)
+{
+  return ( x > (uint64_t) INT64_MAX ) ? INT64_MAX : (int64_t) x;
+}
+
+#define BINCOUNT_ND_BODY(LABEL_T, TO_INT64)                                    \
   do {                                                                         \
     while ( ca_iter_state_next_slab_axes(&st, &p, &m) ) {                      \
       ca_size_t fiber_base = 0, A, a, kk, ss, cs, sms, cms, ws = 0, wms = 0;   \
@@ -383,7 +486,7 @@ rb_ca_histogram_scatter_ki (VALUE self, VALUE rcounts, VALUE redges,
       for ( a = 0; a < A; a++ ) {                                             \
         ca_size_t off = fiber_base; int masked = 0;                           \
         for ( kk = 0; kk < (ca_size_t) M; kk++ ) {                            \
-          int64_t v = (int64_t) *(const LABEL_T *)(p + a * ss + kk * cs);     \
+          int64_t v = TO_INT64(*(const LABEL_T *)(p + a * ss + kk * cs));     \
           if ( m && m[a * sms + kk * cms] ) { masked = 1; break; }            \
           if ( v >= ext_dim[kk] - 1 ) v = ext_dim[kk] - 1;                    \
           off += (ca_size_t) v * ext_stride[kk];                             \
@@ -457,14 +560,14 @@ rb_ca_bincount_nd_count_ki (VALUE self, VALUE rcounts, VALUE rweights)
     for ( mm = 0; mm < st.outer_ndim; mm++ ) cur_outer_idx[mm] = 0;
 
     switch ( ca->data_type ) {
-    case CA_INT8:   BINCOUNT_ND_BODY(int8_t);   break;
-    case CA_UINT8:  BINCOUNT_ND_BODY(uint8_t);  break;
-    case CA_INT16:  BINCOUNT_ND_BODY(int16_t);  break;
-    case CA_UINT16: BINCOUNT_ND_BODY(uint16_t); break;
-    case CA_INT32:  BINCOUNT_ND_BODY(int32_t);  break;
-    case CA_UINT32: BINCOUNT_ND_BODY(uint32_t); break;
-    case CA_INT64:  BINCOUNT_ND_BODY(int64_t);  break;
-    case CA_UINT64: BINCOUNT_ND_BODY(uint64_t); break;
+    case CA_INT8:   BINCOUNT_ND_BODY(int8_t, (int64_t));   break;
+    case CA_UINT8:  BINCOUNT_ND_BODY(uint8_t, (int64_t));  break;
+    case CA_INT16:  BINCOUNT_ND_BODY(int16_t, (int64_t));  break;
+    case CA_UINT16: BINCOUNT_ND_BODY(uint16_t, (int64_t)); break;
+    case CA_INT32:  BINCOUNT_ND_BODY(int32_t, (int64_t));  break;
+    case CA_UINT32: BINCOUNT_ND_BODY(uint32_t, (int64_t)); break;
+    case CA_INT64:  BINCOUNT_ND_BODY(int64_t, (int64_t));  break;
+    case CA_UINT64: BINCOUNT_ND_BODY(uint64_t, bincount_nd_label_u64); break;
     default:
       ca_iter_state_finish(&st);
       if ( weighted ) ca_iter_state_finish(&stw);

data/ext/carray_hold.c

@@ -20,6 +20,7 @@
 #include "carray.h"
 #include "ca_kernel_iterator.h"
 #include "ca_obj_face.h"
+#include "carray_internal.h"   /* ca_normalize_axis_arg */
 
 /* Forward hold along `axis`.  Per fiber along the scan axis:
      - present cell         -> output = cell value, becomes the held value;
@@ -47,21 +48,24 @@ rb_ca_hold_forward (VALUE self, int axis)
   ca_iter_state st_in, st_out;
   int rc = ca_iter_state_init_l2(&st_in, ca, CA_SLAB_AXES, slab_axes, 1, 0);
   if ( rc != CA_ITER_OK ) {
-    rb_raise(rb_eRuntimeError, "__hold__: input init failed rc=%d", rc);
+    rb_raise(rb_eRuntimeError, "hold_forward: input init failed rc=%d", rc);
   }
-  rc = ca_iter_state_init_l2(&st_out, co, CA_SLAB_AXES, slab_axes, 1,
+  rc = ca_iter_state_init_l2_paired(&st_out, &st_in, co, CA_SLAB_AXES,
+                                    slab_axes, 1,
                              CA_KERNEL_WRITE);
   if ( rc != CA_ITER_OK ) {
     ca_iter_state_finish(&st_in);
-    rb_raise(rb_eRuntimeError, "__hold__: output init failed rc=%d", rc);
+    rb_raise(rb_eRuntimeError, "hold_forward: output init failed rc=%d", rc);
   }
 
   /* Output mask allocated lazily on the first leading-masked (UNDEF) cell:
      a fiber can only go UNDEF on a leading masked run, so a fully filled
-     result carries no mask at all.  op_mask parallels the fresh contiguous
-     output value buffer co->ptr. */
+     result carries no mask at all.  The output is a fresh row-major entity
+     and the walk cuts its slabs from a buffer laid out the same way (the
+     output's memory, or the walk's scratch when it delivers by transfer),
+     so a slab's offset from st_out.alias_ptr is its offset in co, which
+     op_mask parallels. */
   boolean8_t *op_mask = NULL;
-  char       *co_root = (char *) co->ptr;
 
   char       *pi, *po;
   boolean8_t *mi, *mo;
@@ -72,7 +76,7 @@ rb_ca_hold_forward (VALUE self, int axis)
     ca_size_t   oS   = st_out.slab_strides[0];       /* output data byte stride */
     ca_size_t   iMS  = st_in.slab_mask_strides[0];   /* input mask element stride */
     ca_size_t   oMStep = oS / K;                     /* output mask element step */
-    ca_size_t   oMBase = (ca_size_t)(po - co_root) / K;
+    ca_size_t   oMBase = (ca_size_t)(po - st_out.alias_ptr) / K;
     const char *held = NULL;   /* last valid cell (points into input slab) */
 
     for ( ca_size_t j = 0; j < N; j++ ) {
@@ -103,7 +107,7 @@ rb_ca_hold_forward (VALUE self, int axis)
   return vout;
 }
 
-/* __hold__(axis): private forward-hold primitive.  axis is a required
+/* hold_forward(axis): private forward-hold primitive.  axis is a required
    Integer (negative counts from the end).  The Ruby wrapper composes
    backward / flatten / linear on top of this. */
 static VALUE
@@ -111,13 +115,7 @@ rb_ca_hold_method (VALUE self, VALUE raxis)
 {
   CArray *ca;
   GetCArray(self, ca);
-  int axis = NUM2INT(raxis);
-  if ( axis < 0 ) axis += ca->ndim;
-  if ( axis < 0 || axis >= ca->ndim ) {
-    rb_raise(rb_eArgError, "__hold__: axis %d out of range for ndim %d",
-             NUM2INT(raxis), ca->ndim);
-  }
-  return rb_ca_hold_forward(self, axis);
+  return rb_ca_hold_forward(self, ca_normalize_axis_arg(raxis, ca->ndim, NULL));
 }
 
 /* first / last: the reduction sibling of hold.  Reduce each fiber to its
@@ -222,7 +220,7 @@ rb_ca_last (int argc, VALUE *argv, VALUE self)
 void
 Init_carray_hold (void)
 {
-  rb_define_private_method(rb_cCArray, "__hold__", rb_ca_hold_method, 1);
+  rb_define_private_method(rb_cCArray, "hold_forward", rb_ca_hold_method, 1);
   rb_define_method(rb_cCArray, "first", rb_ca_first, -1);
   rb_define_method(rb_cCArray, "last",  rb_ca_last,  -1);
 }