numru-narray 1.0.0

data/ext/numru/narray/mkop.rb

@@ -0,0 +1,733 @@
+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, 6, 5, 6, 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);"]
+)
+
+
+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);"]
+)
+
+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;"]
+)
+$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"]
+)