cumo 0.1.0

data/ext/cumo/narray/gen/tmpl/pow.c

@@ -0,0 +1,97 @@
+<% unless type_name == 'robject' %>
+void <%="cumo_#{c_iter}_kernel_launch"%>(char *p1, char *p2, char *p3, ssize_t s1, ssize_t s2, ssize_t s3, uint64_t n);
+void <%="cumo_#{c_iter}_int32_kernel_launch"%>(char *p1, char *p2, char *p3, ssize_t s1, ssize_t s2, ssize_t s3, uint64_t n);
+<% end %>
+
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    size_t  i;
+    char    *p1, *p2, *p3;
+    ssize_t s1, s2, s3;
+    INIT_COUNTER(lp, i);
+    INIT_PTR(lp, 0, p1, s1);
+    INIT_PTR(lp, 1, p2, s2);
+    INIT_PTR(lp, 2, p3, s3);
+    <% if type_name == 'robject' %>
+    {
+        dtype x, y;
+        SHOW_SYNCHRONIZE_FIXME_WARNING_ONCE("<%=name%>", "<%=type_name%>");
+        for (; i--;) {
+            GET_DATA_STRIDE(p1,s1,dtype,x);
+            GET_DATA_STRIDE(p2,s2,dtype,y);
+            x = m_pow(x,y);
+            SET_DATA_STRIDE(p3,s3,dtype,x);
+        }
+    }
+    <% else %>
+    <%="cumo_#{c_iter}_kernel_launch"%>(p1,p2,p3,s1,s2,s3,i);
+    <% end %>
+}
+
+static void
+<%=c_iter%>_int32(na_loop_t *const lp)
+{
+    size_t  i;
+    char   *p1, *p2, *p3;
+    ssize_t s1, s2, s3;
+    INIT_COUNTER(lp, i);
+    INIT_PTR(lp, 0, p1, s1);
+    INIT_PTR(lp, 1, p2, s2);
+    INIT_PTR(lp, 2, p3, s3);
+    <% if type_name == 'robject' %>
+    {
+        dtype   x;
+        int32_t y;
+        SHOW_SYNCHRONIZE_FIXME_WARNING_ONCE("<%=name%>_int32", "<%=type_name%>");
+        for (; i--;) {
+            GET_DATA_STRIDE(p1,s1,dtype,x);
+            GET_DATA_STRIDE(p2,s2,int32_t,y);
+            x = m_pow_int(x,y);
+            SET_DATA_STRIDE(p3,s3,dtype,x);
+        }
+    }
+    <% else %>
+    <%="cumo_#{c_iter}_int32_kernel_launch"%>(p1,p2,p3,s1,s2,s3,i);
+    <% end %>
+}
+
+static VALUE
+<%=c_func%>_self(VALUE self, VALUE other)
+{
+    ndfunc_arg_in_t ain[2] = {{cT,0},{cT,0}};
+    ndfunc_arg_in_t ain_i[2] = {{cT,0},{cumo_cInt32,0}};
+    ndfunc_arg_out_t aout[1] = {{cT,0}};
+    ndfunc_t ndf = { <%=c_iter%>, STRIDE_LOOP, 2, 1, ain, aout };
+    ndfunc_t ndf_i = { <%=c_iter%>_int32, STRIDE_LOOP, 2, 1, ain_i, aout };
+
+    // fixme : use na.integer?
+    if (FIXNUM_P(other) || rb_obj_is_kind_of(other,cumo_cInt32)) {
+        return na_ndloop(&ndf_i, 2, self, other);
+    } else {
+        return na_ndloop(&ndf, 2, self, other);
+    }
+}
+
+/*
+  Binary power.
+  @overload <%=op_map%> other
+  @param [Cumo::NArray,Numeric] other
+  @return [Cumo::NArray] self to the other-th power.
+*/
+static VALUE
+<%=c_func(1)%>(VALUE self, VALUE other)
+{
+    <% if is_object %>
+    return <%=c_func%>_self(self,other);
+    <% else %>
+    VALUE klass, v;
+    klass = na_upcast(CLASS_OF(self),CLASS_OF(other));
+    if (klass==cT) {
+        return <%=c_func%>_self(self,other);
+    } else {
+        v = rb_funcall(klass, id_cast, 1, self);
+        return rb_funcall(v, id_pow, 1, other);
+    }
+    <% end %>
+}

data/ext/cumo/narray/gen/tmpl/pow_kernel.cu

@@ -0,0 +1,29 @@
+<% unless type_name == 'robject' %>
+__global__ void <%="cumo_#{c_iter}_kernel"%>(char *p1, char *p2, char *p3, ssize_t s1, ssize_t s2, ssize_t s3, uint64_t n)
+{
+    for (uint64_t i = blockIdx.x * blockDim.x + threadIdx.x; i < n; i += blockDim.x * gridDim.x) {
+        *(dtype*)(p3 + (i * s3)) = m_pow(*(dtype*)(p1 + (i * s1)), *(dtype*)(p2 + (i * s2)));
+    }
+}
+
+__global__ void <%="cumo_#{c_iter}_int32_kernel"%>(char *p1, char *p2, char *p3, ssize_t s1, ssize_t s2, ssize_t s3, uint64_t n)
+{
+    for (uint64_t i = blockIdx.x * blockDim.x + threadIdx.x; i < n; i += blockDim.x * gridDim.x) {
+        *(dtype*)(p3 + (i * s3)) = m_pow_int(*(dtype*)(p1 + (i * s1)), *(int32_t*)(p2 + (i * s2)));
+    }
+}
+
+void <%="cumo_#{c_iter}_kernel_launch"%>(char *p1, char *p2, char *p3, ssize_t s1, ssize_t s2, ssize_t s3, uint64_t n)
+{
+    size_t gridDim = get_gridDim(n);
+    size_t blockDim = get_blockDim(n);
+    <%="cumo_#{c_iter}_kernel"%><<<gridDim, blockDim>>>(p1,p2,p3,s1,s2,s3,n);
+}
+
+void <%="cumo_#{c_iter}_int32_kernel_launch"%>(char *p1, char *p2, char *p3, ssize_t s1, ssize_t s2, ssize_t s3, uint64_t n)
+{
+    size_t gridDim = get_gridDim(n);
+    size_t blockDim = get_blockDim(n);
+    <%="cumo_#{c_iter}_int32_kernel"%><<<gridDim, blockDim>>>(p1,p2,p3,s1,s2,s3,n);
+}
+<% end %>

data/ext/cumo/narray/gen/tmpl/powint.c

@@ -0,0 +1,17 @@
+static dtype pow_<%=type_name%>(dtype x, int p)
+{
+    dtype r = m_one;
+    switch(p) {
+    case 2: return m_square(x);
+    case 3: return m_mul(m_square(x),x);
+    case 1: return x;
+    case 0: return m_one;
+    }
+    if (p<0)  return m_zero;
+    while (p) {
+        if ((p%2) == 1) r = m_mul(r,x);
+        x = m_square(x);
+        p /= 2;
+    }
+    return r;
+}

data/ext/cumo/narray/gen/tmpl/qsort.c

@@ -0,0 +1,212 @@
+/*
+  qsort.c
+  Numerical Array Extension for Ruby
+    modified by Masahiro TANAKA
+*/
+
+/*
+ *      qsort.c: standard quicksort algorithm
+ *
+ *      Modifications from vanilla NetBSD source:
+ *        Add do ... while() macro fix
+ *        Remove __inline, _DIAGASSERTs, __P
+ *        Remove ill-considered "swap_cnt" switch to insertion sort,
+ *        in favor of a simple check for presorted input.
+ *
+ *      CAUTION: if you change this file, see also qsort_arg.c
+ *
+ *      $PostgreSQL: pgsql/src/port/qsort.c,v 1.12 2006/10/19 20:56:22 tgl Exp $
+ */
+
+/*      $NetBSD: qsort.c,v 1.13 2003/08/07 16:43:42 agc Exp $   */
+
+/*-
+ * Copyright (c) 1992, 1993
+ *      The Regents of the University of California.  All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *        notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *        notice, this list of conditions and the following disclaimer in the
+ *        documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of the University nor the names of its contributors
+ *        may be used to endorse or promote products derived from this software
+ *        without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.      IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#ifndef QSORT_INCL
+#define QSORT_INCL
+#define Min(x, y)               ((x) < (y) ? (x) : (y))
+
+/*
+ * Qsort routine based on J. L. Bentley and M. D. McIlroy,
+ * "Engineering a sort function",
+ * Software--Practice and Experience 23 (1993) 1249-1265.
+ * We have modified their original by adding a check for already-sorted input,
+ * which seems to be a win per discussions on pgsql-hackers around 2006-03-21.
+ */
+#define swapcode(TYPE, parmi, parmj, n)         \
+    do {                                        \
+        size_t i = (n) / sizeof (TYPE);         \
+        TYPE *pi = (TYPE *)(void *)(parmi);     \
+        TYPE *pj = (TYPE *)(void *)(parmj);     \
+        do {                                    \
+            TYPE    t = *pi;                    \
+            *pi++ = *pj;                        \
+            *pj++ = t;                          \
+        } while (--i > 0);                      \
+    } while (0)
+
+#define SWAPINIT(a, es) swaptype = ((char *)(a) - (char *)0) % sizeof(long) || \
+        (es) % sizeof(long) ? 2 : (es) == sizeof(long)? 0 : 1;
+
+static inline void
+swapfunc(a, b, n, swaptype)
+     char       *a,
+     *b;
+     size_t          n;
+     int                     swaptype;
+{
+    if (swaptype <= 1)
+        swapcode(long, a, b, n);
+    else
+        swapcode(char, a, b, n);
+}
+
+#define swap(a, b)                                      \
+    if (swaptype == 0) {                                \
+        long t = *(long *)(void *)(a);                  \
+        *(long *)(void *)(a) = *(long *)(void *)(b);    \
+        *(long *)(void *)(b) = t;                       \
+    } else                                              \
+        swapfunc(a, b, es, swaptype)
+
+#define vecswap(a, b, n) if ((n) > 0) swapfunc((a), (b), (size_t)(n), swaptype)
+
+#define med3(a,b,c,_cmp)                                \
+    (cmpgt(b,a) ?                                       \
+     (cmpgt(c,b) ? b : (cmpgt(c,a) ? c : a))            \
+     : (cmpgt(b,c) ? b : (cmpgt(c,a) ? a : c)))
+#endif
+
+#undef qsort_dtype
+#define qsort_dtype <%=dtype%>
+#undef qsort_cast
+#define qsort_cast <%=dcast%>
+<% if "#{suffix}" != "" %>
+#undef cmp
+#undef cmpgt
+#define cmp(a,b) cmp<%=suffix%>(a,b)
+#define cmpgt(a,b) cmpgt<%=suffix%>(a,b)
+<% end %>
+<% c_func(:nodef)%>
+
+static void
+<%=type_name%>_qsort<%=suffix%>(void *a, size_t n, ssize_t es)
+{
+    char       *pa,
+        *pb,
+        *pc,
+        *pd,
+        *pl,
+        *pm,
+        *pn;
+    int                     d,
+        r,
+        swaptype,
+        presorted;
+
+ loop:SWAPINIT(a, es);
+    if (n < 7)
+        {
+            for (pm = (char *) a + es; pm < (char *) a + n * es; pm += es)
+                for (pl = pm; pl > (char *) a && cmpgt(pl - es, pl);
+                     pl -= es)
+                    swap(pl, pl - es);
+            return;
+        }
+    presorted = 1;
+    for (pm = (char *) a + es; pm < (char *) a + n * es; pm += es)
+        {
+            if (cmpgt(pm - es, pm))
+                {
+                    presorted = 0;
+                    break;
+                }
+        }
+    if (presorted)
+        return;
+    pm = (char *) a + (n / 2) * es;
+    if (n > 7)
+        {
+            pl = (char *) a;
+            pn = (char *) a + (n - 1) * es;
+            if (n > 40)
+                {
+                    d = (n / 8) * es;
+                    pl = med3(pl, pl + d, pl + 2 * d, cmp);
+                    pm = med3(pm - d, pm, pm + d, cmp);
+                    pn = med3(pn - 2 * d, pn - d, pn, cmp);
+                }
+            pm = med3(pl, pm, pn, cmp);
+        }
+    swap(a, pm);
+    pa = pb = (char *) a + es;
+    pc = pd = (char *) a + (n - 1) * es;
+    for (;;)
+        {
+            while (pb <= pc && (r = cmp(pb, a)) <= 0)
+                {
+                    if (r == 0)
+                        {
+                            swap(pa, pb);
+                            pa += es;
+                        }
+                    pb += es;
+                }
+            while (pb <= pc && (r = cmp(pc, a)) >= 0)
+                {
+                    if (r == 0)
+                        {
+                            swap(pc, pd);
+                            pd -= es;
+                        }
+                    pc -= es;
+                }
+            if (pb > pc)
+                break;
+            swap(pb, pc);
+            pb += es;
+            pc -= es;
+        }
+    pn = (char *) a + n * es;
+    r = Min(pa - (char *) a, pb - pa);
+    vecswap(a, pb - r, r);
+    r = Min(pd - pc, pn - pd - es);
+    vecswap(pb, pn - r, r);
+    if ((r = pb - pa) > es)
+        <%=type_name%>_qsort<%=suffix%>(a, r / es, es);
+    if ((r = pd - pc) > es)
+        {
+            /* Iterate rather than recurse to save stack space */
+            a = pn - r;
+            n = r / es;
+            goto loop;
+        }
+    /*              qsort(pn - r, r / es, es, cmp);*/
+}

data/ext/cumo/narray/gen/tmpl/rand.c

@@ -0,0 +1,168 @@
+<%
+if is_int && !is_object
+  if /Int64$/ =~ class_name
+    rand_bit = 64
+  else
+    rand_bit = 32
+  end
+  m_rand = "m_rand(max,shift)"
+  shift_def = "int shift;"
+  shift_set = "shift = #{rand_bit-1} - msb_pos(max);"
+  rand_type = "uint#{rand_bit}_t"
+%>
+
+#define HWID (sizeof(dtype)*4)
+
+static int msb_pos(<%=rand_type%> a)
+{
+    int width = HWID;
+    int pos = 0;
+    <%=rand_type%> mask = (((dtype)1 << HWID)-1) << HWID;
+
+    if (a==0) {return -1;}
+
+    while (width) {
+        if (a & mask) {
+            pos += width;
+        } else {
+            mask >>= width;
+        }
+        width >>= 1;
+        mask &= mask << width;
+    }
+    return pos;
+}
+
+/* generates a random number on [0,max) */
+<% if rand_bit == 64 %>
+inline static dtype m_rand(uint64_t max, int shift)
+{
+    uint64_t x;
+    do {
+        x = gen_rand32();
+        x <<= 32;
+        x |= gen_rand32();
+        x >>= shift;
+    } while (x >= max);
+    return x;
+}
+<% else %>
+inline static dtype m_rand(uint32_t max, int shift)
+{
+    uint32_t x;
+    do {
+        x = gen_rand32();
+        x >>= shift;
+    } while (x >= max);
+    return x;
+}
+<% end %>
+<%
+else
+  m_rand = "m_rand(max)"
+  shift_def = ""
+  shift_set = ""
+  rand_type = "dtype"
+end
+%>
+
+typedef struct {
+    dtype low;
+    <%=rand_type%> max;
+} rand_opt_t;
+
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    size_t   i;
+    char    *p1;
+    ssize_t  s1;
+    size_t  *idx1;
+    dtype    x;
+    rand_opt_t *g;
+    dtype    low;
+    <%=rand_type%> max;
+    <%=shift_def%>
+
+    INIT_COUNTER(lp, i);
+    INIT_PTR_IDX(lp, 0, p1, s1, idx1);
+    g = (rand_opt_t*)(lp->opt_ptr);
+    low = g->low;
+    max = g->max;
+    <%=shift_set%>
+
+    SHOW_SYNCHRONIZE_FIXME_WARNING_ONCE("<%=name%>", "<%=type_name%>");
+    SHOW_SYNCHRONIZE_WARNING_ONCE("<%=name%>", "<%=type_name%>");
+    cumo_cuda_runtime_check_status(cudaDeviceSynchronize());
+    if (idx1) {
+        for (; i--;) {
+            x = m_add(<%=m_rand%>,low);
+            SET_DATA_INDEX(p1,idx1,dtype,x);
+        }
+    } else {
+        for (; i--;) {
+            x = m_add(<%=m_rand%>,low);
+            SET_DATA_STRIDE(p1,s1,dtype,x);
+        }
+    }
+}
+
+
+/*
+  Generate uniformly distributed random numbers on self narray.
+  @overload rand([[low],high])
+  @param [Numeric] low  lower inclusive boundary of random numbers. (default=0)
+  @param [Numeric] high  upper exclusive boundary of random numbers. (default=1 or 1+1i for complex types)
+  @return [Cumo::<%=class_name%>] self.
+  @example
+    Cumo::DFloat.new(6).rand
+    => Cumo::DFloat#shape=[6]
+       [0.0617545, 0.373067, 0.794815, 0.201042, 0.116041, 0.344032]
+    Cumo::DComplex.new(6).rand(5+5i)
+    => Cumo::DComplex#shape=[6]
+       [2.69974+3.68908i, 0.825443+0.254414i, 0.540323+0.34354i, 4.52061+2.39322i, ...]
+    Cumo::Int32.new(6).rand(2,5)
+    => Cumo::Int32#shape=[6]
+       [4, 3, 3, 2, 4, 2]
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE *args, VALUE self)
+{
+    rand_opt_t g;
+    VALUE v1=Qnil, v2=Qnil;
+    dtype high;
+    ndfunc_arg_in_t ain[1] = {{OVERWRITE,0}};
+    ndfunc_t ndf = {<%=c_iter%>, FULL_LOOP, 1,0, ain,0};
+
+    <% if is_int && !is_object %>
+    rb_scan_args(argc, args, "11", &v1, &v2);
+    if (v2==Qnil) {
+        g.low = m_zero;
+        g.max = high = m_num_to_data(v1);
+    <% else %>
+    rb_scan_args(argc, args, "02", &v1, &v2);
+    if (v2==Qnil) {
+        g.low = m_zero;
+        if (v1==Qnil) {
+            <% if is_complex %>
+            g.max = high = c_new(1,1);
+            <% else %>
+            g.max = high = m_one;
+            <% end %>
+        } else {
+            g.max = high = m_num_to_data(v1);
+        }
+    <% end %>
+    } else {
+        g.low = m_num_to_data(v1);
+        high = m_num_to_data(v2);
+        g.max = m_sub(high,g.low);
+    }
+    <% if is_int && !is_object %>
+    if (high <= g.low) {
+        rb_raise(rb_eArgError,"high must be larger than low");
+    }
+    <% end %>
+    na_ndloop3(&ndf, &g, 1, self);
+    return self;
+}