narray-bigmem 0.0.0

data/ext/narray/mknafunc.rb

@@ -0,0 +1,212 @@
+$type_codes = %w(n B I L G F D X C O)
+$data_types = 
+ %w(none u_int8_t int16_t int32_t int64_t float double scomplex dcomplex VALUE)
+$real_types =
+ %w(none u_int8_t int16_t int32_t int64_t float double float double VALUE)
+$int_types  = 
+ %w(none u_int8_t int16_t int32_t int64_t int32_t int32_t scomplex dcomplex VALUE)
+$comp_types =
+ %w(none scomplex scomplex scomplex dcomplex scomplex dcomplex scomplex dcomplex VALUE)
+$swap_types  = 
+ %w(none u_int8_t na_size16_t na_size32_t na_size64_t na_size32_t na_size64_t na_size64_t na_size128_t VALUE)
+$upcast = [
+  [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
+  [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9],
+  [ 0, 2, 2, 3, 4, 5, 6, 7, 8, 9],
+  [ 0, 3, 3, 3, 4, 5, 6, 7, 8, 9],
+  [ 0, 4, 4, 4, 4, 5, 6, 7, 8, 9],
+  [ 0, 5, 5, 5, 5, 5, 6, 7, 8, 9],
+  [ 0, 6, 6, 6, 6, 6, 6, 8, 8, 9],
+  [ 0, 7, 7, 7, 7, 7, 8, 7, 8, 9],
+  [ 0, 8, 8, 8, 8, 8, 8, 8, 8, 9],
+  [ 0, 9, 9, 9, 9, 9, 9, 9, 9, 9] ]
+$data_obj = [
+  [/[O]/,/[O]/,  "
+    *p1 = rb_funcall(*p1,#id,1,*p2);"],
+  [/[O]/,/[BIL]/,"
+    *p1 = rb_funcall(*p1,#id,1,INT2FIX(*p2));"],
+  [/[O]/,/[G]/,"
+    *p1 = rb_funcall(*p1,#id,1,LL2NUM(*p2));"],
+  [/[O]/,/[FD]/, "
+    *p1 = rb_funcall(*p1,#id,1,rb_float_new(*p2));"],
+  [/[O]/,/[XC]/, "
+    *p1 = rb_funcall(*p1,#id,1,rb_complex_new(p2->r,p2->i));"],
+  [/[BIL]/,/[O]/,"
+    *p1 = NUM2INT(rb_funcall(INT2FIX(*p1),#id,1,*p2));"],
+  [/[G]/,/[O]/,"
+    *p1 = NUM2LL(rb_funcall(LL2NUM(*p1),#id,1,*p2));"],
+  [/[FD]/,/[O]/, "
+    *p1 = NUM2DBL(rb_funcall(rb_float_new(*p1),#id,1,*p2));"],
+  [/[XC]/,/[O]/, "VALUE v=rb_funcall(rb_complex_new(p1->r,p1->i),#id,1,*p2);
+    p1->r = NUM2REAL(v); p1->i = NUM2IMAG(v);"] ]
+
+
+def mksetfuncs(name,op,id,funcs)
+
+  print "
+/* ------------------------- #{name} --------------------------- */\n"
+  c  = $type_codes
+  n  = $type_codes.size
+  td = $data_types
+  tr = $real_types
+
+  # Function Definition
+
+  for i in 0...n
+    for j in 0...n
+      funcs.each do |k|
+	if c[i]=~k[0] && c[j]=~k[1]
+	  #if i==j
+	  #  f = "memcpy(p1,p1,sizeof(typed));"
+	  #else
+	    f = k[2]
+	  #end
+	  f = f.
+	    gsub(/p1\./,"((#{td[i]}*)p1)[i].").
+	    gsub(/p2\./,"((#{td[j]}*)p2)[i].").
+	    gsub(/\*p1/,"((#{td[i]}*)p1)[i]").
+	    gsub(/\*p2/,"((#{td[j]}*)p2)[i]").
+	    gsub(/ = /," = (#{tr[i]})").
+            gsub(/#id/,id).
+            gsub(/#op/,op).
+	    gsub(/typed/,td[i]).
+            gsub(/typef/,tr[i])
+	  puts $func_body.
+	    gsub(/typed/,td[i]).
+            gsub(/typef/,tr[i]).
+	    gsub(/#name/,name).
+	    sub(/OPERATION/,f).
+	    gsub(/#CC/,c[i]+c[j])
+	end
+      end
+    end
+  end
+
+  # function pointer array
+  print "\nna_setfunc_t "+name+"Funcs = {\n"
+  m = []
+  for i in 0...n
+    l = []
+    for j in 0...n
+      f = true
+      for k in funcs
+	if c[i]=~k[0] && c[j]=~k[1]
+	  l += [name+c[i]+c[j]]
+	  f = false
+	  break
+	end
+      end
+      if f
+	l += ['TpErr']
+      end
+    end
+    m += ['  { '+l.join(', ')+' }']
+  end
+  print m.join(",\n")+"\n};\n"
+
+end
+
+
+
+def mkfuncs(name,t1,t2,func,idx=["i"]*3)
+
+  print "
+/* ------------------------- #{name} --------------------------- */\n"
+  c  = $type_codes
+  td = $data_types
+  tr = $real_types
+
+  for i in 0...c.size
+    if func[i] != nil && func[i] != "copy"
+      if /Insp/ =~ name
+        f = func[i].
+          gsub(/p2\./,"(*((#{t2[i]}*)p2)).").
+          gsub(/\*p1/,"*((#{t1[i]}*)p1)").
+          gsub(/\*p2/,"*((#{t2[i]}*)p2)")
+      else
+        f = func[i].
+          gsub(/p1\./,"(*((#{t1[i]}*)(p1+#{idx[0]}*i1))).").
+          gsub(/p2\./,"(*((#{t2[i]}*)(p2+#{idx[1]}*i2))).").
+          gsub(/p3\./,"(*((#{t2[i]}*)(p3+#{idx[2]}*i3))).").
+          gsub(/\*p1/,"*((#{t1[i]}*)(p1+#{idx[0]}*i1))").
+          gsub(/\*p2/,"*((#{t2[i]}*)(p2+#{idx[1]}*i2))").
+          gsub(/\*p3/,"*((#{t2[i]}*)(p3+#{idx[2]}*i3))").
+          gsub(/\(u_int8_t\*\)p3/,"(u_int8_t*)(p3+#{idx[2]}*i3)").
+          gsub(/p2;/,'p2+i*i2;')
+      end
+      f = f.
+        gsub(/type1/,td[i]).
+        gsub(/typec/,t1[i]).
+        gsub(/typef/,tr[i])
+      puts $func_body.
+	gsub(/type1/,td[i]).
+	gsub(/typec/,t1[i]).
+	gsub(/typef/,tr[i]).
+	gsub(/#name/,name).
+	gsub(/OPERATION/,f).
+	gsub(/#C/,c[i])
+    end
+  end
+
+  # Function Array
+
+  print "\nna_func_t #{name}Funcs =\n{ "
+  m = []
+  for i in 0...c.size
+    if func[i] == nil
+      m += ['TpErr']
+    elsif func[i]=='copy'
+      m += ['Set'+c[$data_types.index(t1[i])]+c[i]]
+    else
+      m += [name+c[i]]
+    end
+  end
+  print m.join(", ")+" };\n"
+
+end
+
+
+
+def mksortfuncs(bsname,t1,t2,func)
+
+  print "
+/* ------------------------- #{bsname} --------------------------- */\n"
+  c  = $type_codes
+  tf = $real_types
+  name = bsname
+
+  # Function Definition
+  head = "static int #{name}#code(const void *p1, const void *p2)"
+  for i in 0...c.size
+    if func[i] != nil && func[i]=~/^\{/
+      f = func[i].
+	gsub(/p1->/,"((#{t1[i]}*)p1)->").
+	gsub(/p2->/,"((#{t2[i]}*)p2)->").
+	gsub(/\*\*p1/,"**(#{t1[i]}**)p1").
+	gsub(/\*\*p2/,"**(#{t2[i]}**)p2").
+	gsub(/\*p1/,"*(#{t1[i]}*)p1").
+	gsub(/\*p2/,"*(#{t2[i]}*)p2").
+	gsub(/typef/,tf[i])
+      puts( (head+f).gsub(/#code/,c[i]) )
+    end
+  end
+
+  # Function Array
+
+  print "\nna_sortfunc_t #{name}Funcs =\n{ "
+  m = []
+  for i in 0...c.size
+    if func[i] == nil
+      m += ['(int (*)(const void *, const void *))TpErrI']
+    elsif func[i]=='copy'
+      m += ['Set'+c[i]*2]
+    elsif !( func[i] =~ /^\{/ )
+      m += [func[i]]
+    else
+      m += [name+c[i]]
+    end
+  end
+  print m.join(", ")+" };\n"
+
+end
+

data/ext/narray/mkop.rb

@@ -0,0 +1,734 @@
+require "mknafunc"
+
+fname = "na_op.c"
+$> = open(fname,"w")
+
+upcast_ary = $upcast.collect{|i| '  {'+i.join(", ")+'}'}.join(",\n")
+
+print <<EOM
+/*
+  #{fname}
+  Automatically generated code
+  Numerical Array Extention for Ruby
+    (C) Copyright 1999-2008 by Masahiro TANAKA
+
+  This program is free software.
+  You can distribute/modify this program
+  under the same terms as Ruby itself.
+  NO WARRANTY.
+*/
+#include <ruby.h>
+#include "narray.h"
+#include "narray_local.h"
+/* isalpha(3) etc. */
+#include <ctype.h>
+
+const int na_upcast[NA_NTYPES][NA_NTYPES] = {
+#{upcast_ary} };
+
+const int na_no_cast[NA_NTYPES] =
+ { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 };
+const int na_cast_real[NA_NTYPES] =
+ { 0, 1, 2, 3, 4, 5, 4, 5, 8, 9 };
+const int na_cast_comp[NA_NTYPES] =
+ { 0, 7, 7, 7, 7, 7, 8, 7, 8, 9 };
+const int na_cast_round[NA_NTYPES] =
+ { 0, 1, 2, 3, 4, 3, 3, 7, 8, 9 };
+const int na_cast_byte[NA_NTYPES] =
+ { 0, 1, 1, 1, 1, 1, 1, 1, 1, 1 };
+
+
+static void TpErr(void) {
+    rb_raise(rb_eTypeError,"illegal operation with this type");
+}
+static int TpErrI(void) {
+    rb_raise(rb_eTypeError,"illegal operation with this type");
+    return 0;
+}
+static void na_zerodiv() {
+    rb_raise(rb_eZeroDivError, "divided by 0");
+}
+
+static int notnanF(float *n)
+{
+  return *n == *n;
+}
+static int notnanD(double *n)
+{
+  return *n == *n;
+}
+EOM
+
+
+#
+#  Set Fucs
+#
+data = [
+  [/[O]/,/[O]/,          "*p1 = *p2;"],
+  [/[O]/,/[BI]/,         "*p1 = INT2FIX(*p2);"],
+  [/[O]/,/[L]/,          "*p1 = INT2NUM(*p2);"],
+  [/[O]/,/[G]/,          "*p1 = LL2NUM(*p2);"],
+  [/[O]/,/[FD]/,         "*p1 = rb_float_new(*p2);"],
+  [/[O]/,/[XC]/,         "*p1 = rb_complex_new(p2.r,p2.i);"],
+  [/[BIL]/,/[O]/,        "*p1 = NUM2INT(*p2);"],
+  [/[G]/,/[O]/,          "*p1 = NUM2LL(*p2);"],
+  [/[FD]/,/[O]/,         "*p1 = NUM2DBL(*p2);"],
+  [/[XC]/,/[O]/,         "p1.r = NUM2REAL(*p2); p1.i = NUM2IMAG(*p2);"],
+  [/[BILFDG]/,/[BILFDG]/,"*p1 = *p2;"],
+  [/[BILFDG]/,/[XC]/,    "*p1 = p2.r;"],
+  [/[XC]/,/[BILFDG]/,    "p1.r = *p2; p1.i = 0;"],
+  [/[XC]/,/[XC]/,        "p1.r = p2.r; p1.i = p2.i;"] ]
+
+$func_body =
+  "static void #name#CC(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2)
+{
+  int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    OPERATION
+  }
+}
+"
+mksetfuncs('Set','','',data)
+
+
+
+#
+#  Unary Funcs
+#
+$func_body =
+  "static void #name#C(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2)
+{
+  int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    OPERATION
+  }
+}
+"
+
+
+mkfuncs('Swp', $swap_types, $swap_types,
+ [nil] +
+ ["*p1 = *p2;"] + 
+ ["na_size16_t x;  swap16(x,*p2);   *p1 = x;"] + 
+ ["na_size32_t x;  swap32(x,*p2);   *p1 = x;"] + 
+ ["na_size64_t x;  swap64(x,*p2);   *p1 = x;"] + 
+ ["na_size32_t x;  swap32(x,*p2);   *p1 = x;"] + 
+ ["na_size64_t x;  swap64(x,*p2);   *p1 = x;"] + 
+ ["na_size64_t x;  swap64c(x,*p2);  *p1 = x;"] + 
+ ["na_size128_t x; swap128c(x,*p2); *p1 = x;"] + 
+ ["*p1 = *p2;"]
+)
+
+print <<EOM
+
+/* ------------------------- H2N --------------------------- */
+#ifdef WORDS_BIGENDIAN
+
+na_func_t H2NFuncs =
+{ TpErr, SetBB, SetII, SetLL, SetGG, SetFF, SetDD, SetXX, SetCC, SetOO };
+
+na_func_t H2VFuncs =
+{ TpErr, SetBB, SwpI, SwpL, SwpG, SwpF, SwpD, SwpX, SwpC, SetOO };
+
+#else
+#ifdef DYNAMIC_ENDIAN  /* not supported yet */
+#else  /* LITTLE ENDIAN */
+
+na_func_t H2NFuncs =
+{ TpErr, SetBB, SwpI, SwpL, SwpG, SwpF, SwpD, SwpX, SwpC, SetOO };
+
+na_func_t H2VFuncs =
+{ TpErr, SetBB, SetII, SetLL, SetGG, SetFF, SetDD, SetXX, SetCC, SetOO };
+
+#endif
+#endif
+EOM
+
+mkfuncs('Neg', $data_types, $data_types,
+ [nil] +
+ ["*p1 = -*p2;"]*6 + 
+ ["p1.r = -p2.r;
+    p1.i = -p2.i;"]*2 +
+ ["*p1 = rb_funcall(*p2,na_id_minus,0);"]
+)
+
+# method: imag=
+mkfuncs('ImgSet',$data_types,$real_types,
+ [nil]*7 +
+ ["p1.i = *p2;"]*2 +
+ [nil]
+)
+
+
+mkfuncs('Floor',$int_types,$data_types,[nil] +
+ ['copy']*4 + 
+ ["*p1 = (typec)floor(*p2);"]*2 + 
+ [nil]*3
+)
+
+mkfuncs('Ceil',$int_types,$data_types,[nil] +
+ ['copy']*4 + 
+ ["*p1 = (typec)ceil(*p2);"]*2 + 
+ [nil]*3
+)
+
+mkfuncs('Round',$int_types,$data_types,[nil] +
+ ['copy']*4 + 
+# ["*p1 = floor(*p2+0.5);"]*2 + 
+ ["if (*p2 >= 0) *p1 = (typec)floor(*p2+0.5);
+     else *p1 = (typec)ceil(*p2-0.5);"]*2 + 
+ [nil]*3
+)
+
+mkfuncs('Abs',$real_types,$data_types,[nil] +
+ ["*p1 = *p2;"] + 
+ ["*p1 = (*p2<0) ? -*p2 : *p2;"]*5 + 
+ ["*p1 = (typec)hypot(p2.r, p2.i);"]*2 +
+ ["*p1 = rb_funcall(*p2,na_id_abs,0);"]
+)
+
+
+mkfuncs('Real',$real_types,$data_types,[nil] +
+ ['copy']*8 + 
+ [nil]
+)
+
+mkfuncs('Imag',$real_types,$data_types,[nil] +
+ ["*p1 = 0;"]*6 + 
+ ["*p1 = p2.i;"]*2 +
+ [nil]
+)
+
+mkfuncs('Angl',$real_types,$data_types,[nil] +
+ [nil]*6 +
+ ["*p1 = atan2(p2.i,p2.r);"]*2 +
+ [nil]
+)
+
+mkfuncs('ImagMul',$comp_types,$data_types,[nil] +
+ [nil]*4 +
+ ["p1.r = 0; p1.i = *p2;"]*2 + 
+ ["p1.r = -p2.i; p1.i = p2.r;"]*2 +
+ [nil]
+)
+
+mkfuncs('Conj',$data_types,$data_types,[nil] +
+ ['copy']*6 + 
+ ["p1.r = p2.r; p1.i = -p2.i;"]*2 +
+ [nil]
+)
+
+mkfuncs('Not', [$data_types[1]]*10, $data_types,
+ [nil] +
+ ["*p1 = (*p2==0) ? 1:0;"]*6 +
+ ["*p1 = (p2.r==0 && p2.i==0) ? 1:0;"]*2 +
+ ["*p1 = RTEST(*p2) ? 0:1;"]
+)
+
+mkfuncs('BRv', $data_types, $data_types, [nil] +
+ ["*p1 = ~(*p2);"]*4 +
+ [nil]*4 +
+ ["*p1 = rb_funcall(*p2,'~',0);"]
+)
+
+mkfuncs('Min', $data_types, $data_types, [nil] +
+ ["if (*p1>*p2) *p1=*p2;"]*4 +
+ ["if (notnan#C((type1*)p2) && *p1>*p2) *p1=*p2;"]*2 +
+ [nil]*2 +
+ ["if (FIX2INT(rb_funcall(*p1,na_id_compare,1,*p2))>0) *p1=*p2;"]
+)
+
+mkfuncs('Max', $data_types, $data_types, [nil] +
+ ["if (*p1<*p2) *p1=*p2;"]*4 +
+ ["if (notnan#C((type1*)p2) && *p1<*p2) *p1=*p2;"]*2 +
+ [nil]*2 +
+ ["if (FIX2INT(rb_funcall(*p1,na_id_compare,1,*p2))<0) *p1=*p2;"]
+)
+
+
+mksortfuncs('Sort', $data_types, $data_types, [nil] +
+ ["
+{ if (*p1 > *p2) return 1;
+  if (*p1 < *p2) return -1;
+  return 0; }"]*6 +
+ [nil]*2 +
+ ["
+{ VALUE r = rb_funcall(*p1, na_id_compare, 1, *p2);
+  return NUM2INT(r); }"]
+)
+
+mksortfuncs('SortIdx', $data_types, $data_types, [nil] +
+ ["
+{ if (**p1 > **p2) return 1;
+  if (**p1 < **p2) return -1;
+  return 0; }"]*6 +
+ [nil]*2 +
+ ["
+{ VALUE r = rb_funcall(**p1, na_id_compare, 1, **p2);
+  return NUM2INT(r); }"]
+)
+
+$func_body =
+  "static void #name#C(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2)
+{
+  int i;
+  if (i1 != 0) {
+    #pragma omp parallel for
+    for (i=0; i<n; i++) {
+      OPERATION
+    }
+  } else {
+//    #pragma omp parallel for reduction(+:p1)
+    for (i=0; i<n; i++) {
+      OPERATION
+    }
+  }
+}
+"
+
+mkfuncs('AddU', $data_types, $data_types,
+ [nil] +
+ ["*p1 += *p2;"]*6 +
+ ["p1.r += p2.r;
+    p1.i += p2.i;"]*2 +
+ ["*p1 = rb_funcall(*p1,'+',1,*p2);"]
+)
+
+mkfuncs('SbtU', $data_types, $data_types,
+ [nil] +
+ ["*p1 -= *p2;"]*6 +
+ ["p1.r -= p2.r;
+    p1.i -= p2.i;"]*2 +
+ ["*p1 = rb_funcall(*p1,'-',1,*p2);"]
+)
+
+$func_body =
+  "static void #name#C(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2)
+{
+  int i;
+  if (i1 != 0) {
+    #pragma omp parallel for
+    for (i=0; i<n; i++) {
+      OPERATION
+    }
+  } else {
+//    #pragma omp parallel for reduction(*:p1)
+    for (i=0; i<n; i++) {
+      OPERATION
+    }
+  }
+}
+"
+
+mkfuncs('MulU', $data_types, $data_types,
+ [nil] +
+ ["*p1 *= *p2;"]*6 +
+ ["type1 x = *p1;
+    p1.r = x.r*p2.r - x.i*p2.i;
+    p1.i = x.r*p2.i + x.i*p2.r;"]*2 +
+ ["*p1 = rb_funcall(*p1,'*',1,*p2);"]
+)
+
+$func_body =
+  "static void #name#C(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2)
+{
+  int i;
+  if (i1 != 0) {
+    #pragma omp parallel for
+    for (i=0; i<n; i++) {
+      OPERATION
+    }
+  } else {
+//    #pragma omp parallel for reduction(/:p1)
+    for (i=0; i<n; i++) {
+      OPERATION
+    }
+  }
+}
+"
+
+mkfuncs('DivU', $data_types, $data_types,
+ [nil] +
+ ["if (*p2==0) {na_zerodiv();}
+    *p1 /= *p2;"]*4 +
+ ["*p1 /= *p2;"]*2 +
+ ["type1 x = *p1;
+    typef a = p2.r*p2.r + p2.i*p2.i;
+    p1.r = (x.r*p2.r + x.i*p2.i)/a;
+    p1.i = (x.i*p2.r - x.r*p2.i)/a;"]*2 +
+ ["*p1 = rb_funcall(*p1,'/',1,*p2);"]
+)
+
+mkfuncs('ModU', $data_types, $data_types,
+ [nil] +
+ ["if (*p2==0) {na_zerodiv();}
+    *p1 %= *p2;"]*4 +
+ ["*p1 = fmod(*p1, *p2);"]*2 +
+ [nil]*2 +
+ ["*p1 = rb_funcall(*p1,'%',1,*p2);"]
+)
+
+
+# indgen
+$func_body = 
+  "static void #name#C(na_shape_t n, char *p1, na_shape_t i1, int p2, na_shape_t i2)
+{
+  int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    OPERATION
+  }
+}
+"
+mkfuncs('IndGen',$data_types,[$data_types[3]]*9,
+ [nil] +
+ ["*p1 = (typef)p2;"]*6 +
+ ["p1.r = (typef)p2;
+   p1.i = 0;"]*2 +
+ ["*p1 = INT2FIX(p2);"]
+)
+
+
+
+$func_body = 
+"static void #name#C(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2)
+{
+  OPERATION
+}
+"
+mkfuncs('ToStr',['']+[$data_types[9]]*9,$data_types,
+ [nil] +
+ ["char buf[22];
+  int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    sprintf(buf,\"%i\",(int)*p2);
+    *p1 = rb_str_new2(buf);
+  }"]*4 +
+ ["char buf[24];
+  int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    sprintf(buf,\"%.5g\",(double)*p2);
+    *p1 = rb_str_new2(buf);
+  }"] +
+ ["char buf[24];
+  int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    sprintf(buf,\"%.8g\",(double)*p2);
+    *p1 = rb_str_new2(buf);
+  }"] +
+ ["char buf[50];
+  int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    sprintf(buf,\"%.5g%+.5gi\",(double)p2.r,(double)p2.i);
+    *p1 = rb_str_new2(buf);
+  }"] +
+ ["char buf[50];
+  int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    sprintf(buf,\"%.8g%+.8gi\",(double)p2.r,(double)p2.i);
+    *p1 = rb_str_new2(buf);
+  }"] +
+ ["int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    *p1 = rb_obj_as_string(*p2);
+  }"]
+)
+
+
+print <<EOM
+
+/* from numeric.c */
+static void na_str_append_fp(char *buf)
+{
+  if (buf[0]=='-' || buf[0]=='+') ++buf;
+  if (ISALPHA(buf[0])) return; /* NaN or Inf */
+  if (strchr(buf, '.') == 0) {
+      int   len = strlen(buf);
+      char *ind = strchr(buf, 'e');
+      if (ind) {
+          memmove(ind+2, ind, len-(ind-buf)+1);
+          ind[0] = '.';
+	  ind[1] = '0';
+      } else {
+          strcat(buf, ".0");
+      }
+  }
+}
+EOM
+
+$func_body = 
+"static void #name#C(char *p1, char *p2)
+{
+  OPERATION
+}
+"
+mkfuncs('Insp',['']+[$data_types[9]]*9,$data_types,
+ [nil] +
+ ["char buf[22];
+  sprintf(buf,\"%i\",(int)*p2);
+  *p1 = rb_str_new2(buf);"]*4 +
+ ["char buf[24];
+  sprintf(buf,\"%g\",(double)*p2);
+  na_str_append_fp(buf);
+  *p1 = rb_str_new2(buf);"] +
+ ["char buf[24];
+  sprintf(buf,\"%g\",(double)*p2);
+  na_str_append_fp(buf);
+  *p1 = rb_str_new2(buf);"] +
+ ["char buf[50], *b;
+  sprintf(buf,\"%g\",(double)p2.r);
+  na_str_append_fp(buf);
+  b = buf+strlen(buf);
+  sprintf(b,\"%+g\",(double)p2.i);
+  na_str_append_fp(b);
+  strcat(buf,\"i\");
+  *p1 = rb_str_new2(buf);"] +
+ ["char buf[50], *b;
+  sprintf(buf,\"%g\",(double)p2.r);
+  na_str_append_fp(buf);
+  b = buf+strlen(buf);
+  sprintf(b,\"%+g\",(double)p2.i);
+  na_str_append_fp(b);
+  strcat(buf,\"i\");
+  *p1 = rb_str_new2(buf);"] +
+ ["*p1 = rb_inspect(*p2);"]
+)
+
+
+
+#
+#   Binary Funcs
+#
+
+=begin
+# Optimize experiment
+$func_body = 
+  "static void #name#C(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2, char *p3, na_shape_t i3)
+{
+  na_shape_t i;
+  if (i1==sizeof(type1) && i2==sizeof(type1) && i3==sizeof(type1)) {
+    type1 *a1=p1, *a2=p2, *a3=p3;
+    for (i=0; n; --n,++i) {
+      *a1 = *a2 * *a3; +++a1;++a2;++a3;
+    }
+  } else
+    for (; n; --n) {
+      OPERATION
+      p1+=i1; p2+=i2; p3+=i3;
+    }
+}
+"
+mkfuncs('MulB', $data_types, $data_types,
+ [nil] +
+ ["*p1 = *p2 * *p3;"]*5 + [nil]*3
+)
+=end
+
+$func_body = 
+  "static void #name#C(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2, char *p3, na_shape_t i3)
+{
+  int i;
+  #pragma omp parallel for
+  for (i=0; i<n; i++) {
+    OPERATION
+  }
+}
+"
+
+mkfuncs('AddB', $data_types, $data_types,
+ [nil] +
+ ["*p1 = *p2 + *p3;"]*6 + 
+ ["p1.r = p2.r + p3.r;
+    p1.i = p2.i + p3.i;"]*2 +
+ ["*p1 = rb_funcall(*p2,'+',1,*p3);"]
+)
+
+mkfuncs('SbtB', $data_types, $data_types,
+ [nil] +
+ ["*p1 = *p2 - *p3;"]*6 + 
+ ["p1.r = p2.r - p3.r;
+    p1.i = p2.i - p3.i;"]*2 +
+ ["*p1 = rb_funcall(*p2,'-',1,*p3);"]
+)
+
+mkfuncs('MulB', $data_types, $data_types,
+ [nil] +
+ ["*p1 = *p2 * *p3;"]*6 + 
+ ["type1 x = *p2;
+    p1.r = x.r*p3.r - x.i*p3.i;
+    p1.i = x.r*p3.i + x.i*p3.r;"]*2 +
+ ["*p1 = rb_funcall(*p2,'*',1,*p3);"]
+)
+
+mkfuncs('DivB', $data_types, $data_types,
+ [nil] +
+ ["if (*p3==0) {na_zerodiv();};
+    *p1 = *p2 / *p3;"]*4 +
+ ["*p1 = *p2 / *p3;"]*2 +
+ ["type1 x = *p2;
+    typef a = p3.r*p3.r + p3.i*p3.i;
+    p1.r = (x.r*p3.r + x.i*p3.i)/a;
+    p1.i = (x.i*p3.r - x.r*p3.i)/a;"]*2 +
+ ["*p1 = rb_funcall(*p2,'/',1,*p3);"]
+)
+
+mkfuncs('ModB', $data_types, $data_types,
+ [nil] +
+ ["if (*p3==0) {na_zerodiv();};
+    *p1 = *p2 % *p3;"]*4 +
+ ["*p1 = fmod(*p2, *p3);"]*2 + 
+ [nil]*2 +
+ ["*p1 = rb_funcall(*p2,'%',1,*p3);"]
+)
+
+
+$func_body =
+  "static void #name#C(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2, char *p3, na_shape_t i3)
+{
+  int i;
+  if (i1 != 0) {
+    #pragma omp parallel for
+    for (i=0; i<n; i++) {
+      OPERATION
+    }
+  } else {
+//    #pragma omp parallel for reduction(+:p1)
+    for (i=0; i<n; i++) {
+      OPERATION
+    }
+  }
+}
+"
+
+mkfuncs('MulAdd', $data_types, $data_types,
+ [nil] +
+ ["*p1 += *p2 * *p3;"]*6 + 
+ ["type1 x = *p2;
+    p1.r += x.r*p3.r - x.i*p3.i;
+    p1.i += x.r*p3.i + x.i*p3.r;"]*2 +
+ ["*p1 = rb_funcall(*p1,'+',1,
+    rb_funcall(*p2,'*',1,*p3));"]
+)
+
+mkfuncs('MulSbt', $data_types, $data_types,
+ [nil] +
+ ["*p1 -= *p2 * *p3;"]*6 + 
+ ["type1 x = *p2;
+    p1.r -= x.r*p3.r - x.i*p3.i;
+    p1.i -= x.r*p3.i + x.i*p3.r;"]*2 +
+ ["*p1 = rb_funcall(*p1,'-',1,
+    rb_funcall(*p2,'*',1,*p3));"]
+)
+
+
+#
+#   Bit operator
+#
+
+mkfuncs('BAn', $data_types, $data_types,
+ [nil] +
+ ["*p1 = *p2 & *p3;"]*4 + 
+ [nil]*4 +
+ ["*p1 = rb_funcall(*p2,'&',1,*p3);"]
+)
+
+mkfuncs('BOr', $data_types, $data_types,
+ [nil] +
+ ["*p1 = *p2 | *p3;"]*4 + 
+ [nil]*4 +
+ ["*p1 = rb_funcall(*p2,'|',1,*p3);"]
+)
+
+mkfuncs('BXo', $data_types, $data_types,
+ [nil] +
+ ["*p1 = *p2 ^ *p3;"]*4 + 
+ [nil]*4 +
+ ["*p1 = rb_funcall(*p2,'^',1,*p3);"]
+)
+
+
+#
+#   Comparison
+#
+
+mkfuncs('Eql', [$data_types[1]]*10, $data_types,
+ [nil] +
+ ["*p1 = (*p2==*p3) ? 1:0;"]*6 +
+ ["*p1 = (p2.r==p3.r) && (p2.i==p3.i) ? 1:0;"]*2 +
+ ["*p1 = RTEST(rb_equal(*p2, *p3)) ? 1:0;"]
+)
+
+mkfuncs('Cmp', [$data_types[1]]*10, $data_types,
+ [nil] +
+ ["if (*p2>*p3) *p1=1;
+    else if (*p2<*p3) *p1=2;
+    else *p1=0;"]*6 +
+ [nil]*2 +
+ ["int v = NUM2INT(rb_funcall(*p2,na_id_compare,1,*p3));
+    if (v>0) *p1=1; else if (v<0) *p1=2; else *p1=0;"]
+)
+
+mkfuncs('And', [$data_types[1]]*10, $data_types,
+ [nil] +
+ ["*p1 = (*p2!=0 && *p3!=0) ? 1:0;"]*6 +
+ ["*p1 = ((p2.r!=0||p2.i!=0) && (p3.r!=0||p3.i!=0)) ? 1:0;"]*2 +
+ ["*p1 = (RTEST(*p2) && RTEST(*p3)) ? 1:0;"]
+)
+
+mkfuncs('Or_', [$data_types[1]]*10, $data_types,
+ [nil] +
+ ["*p1 = (*p2!=0 || *p3!=0) ? 1:0;"]*6 +
+ ["*p1 = ((p2.r!=0||p2.i!=0) || (p3.r!=0||p3.i!=0)) ? 1:0;"]*2 +
+ ["*p1 = (RTEST(*p2) || RTEST(*p3)) ? 1:0;"]
+)
+
+mkfuncs('Xor', [$data_types[1]]*10, $data_types,
+ [nil] +
+ ["*p1 = ((*p2!=0) == (*p3!=0)) ? 0:1;"]*6 +
+ ["*p1 = ((p2.r!=0||p2.i!=0) == (p3.r!=0||p3.i!=0)) ? 0:1;"]*2 +
+ ["*p1 = (RTEST(*p2) == RTEST(*p3)) ? 0:1;"]
+)
+
+
+#
+#   Atan2
+#
+
+mkfuncs('atan2', $data_types, $data_types,
+ [nil]*5 +
+ ["*p1 = atan2(*p2, *p3);"]*2 +
+ [nil]*3
+)
+
+
+#
+#   Mask
+#
+$func_body =
+  "static void #name#C(na_shape_t n, char *p1, na_shape_t i1, char *p2, na_shape_t i2, char *p3, na_shape_t i3)
+{
+  int i, j=0;
+  for (i=0; i<n; i++) {
+    OPERATION
+  }
+}
+"
+mkfuncs('RefMask',$data_types,$data_types,
+ [nil] +
+ ["if (*(u_int8_t*)p3) { *p1=*p2; j+=1; }"]*9,
+ ["j","i","i"]
+)
+
+mkfuncs('SetMask',$data_types,$data_types,
+ [nil] +
+ ["if (*(u_int8_t*)p3) { *p1=*p2; j+=1; };"]*9,
+ ["i","j","i"]
+)