/* * $Id: p_header,v 1.4 2000/11/27 01:57:01 keiko Exp $ */ #include #include "ruby.h" #include "libtinyf2c.h" #include "narray.h" #define DFLT_SIZE 32 extern char *dcl_obj2ccharary(VALUE, int, int); extern integer *dcl_obj2cintegerary(VALUE); extern real *dcl_obj2crealary(VALUE); extern complex *dcl_obj2ccomplexary(VALUE); extern logical *dcl_obj2clogicalary(VALUE); extern VALUE dcl_ccharary2obj(char *, int, int); extern VALUE dcl_cintegerary2obj(integer *, int, int, int *); extern VALUE dcl_crealary2obj(real *, int, int, int *); extern VALUE dcl_ccomplexary2obj(complex *, int, char *); extern VALUE dcl_clogicalary2obj(logical *, int, int, int *); extern void dcl_freeccharary(char *); extern void dcl_freecintegerary(integer *); extern void dcl_freecrealary(real *); extern void dcl_freeccomplexary(complex *); extern void dcl_freeclogicalary(logical *); /* for functions which return doublereal */ /* fnclib */ extern doublereal rd2r_(real *); extern doublereal rr2d_(real *); extern doublereal rexp_(real *, integer *, integer *); extern doublereal rfpi_(void); extern doublereal rmod_(real *, real *); /* gnmlib */ extern doublereal rgnlt_(real *); extern doublereal rgnle_(real *); extern doublereal rgngt_(real *); extern doublereal rgnge_(real *); /* rfalib */ extern doublereal rmax_(real *, integer *, integer *); extern doublereal rmin_(real *, integer *, integer *); extern doublereal rsum_(real *, integer *, integer *); extern doublereal rave_(real *, integer *, integer *); extern doublereal rvar_(real *, integer *, integer *); extern doublereal rstd_(real *, integer *, integer *); extern doublereal rrms_(real *, integer *, integer *); extern doublereal ramp_(real *, integer *, integer *); /* rfblib */ extern doublereal rprd_(real *, real *, integer *, integer *, integer *); extern doublereal rcov_(real *, real *, integer *, integer *, integer *); extern doublereal rcor_(real *, real *, integer *, integer *, integer *); extern VALUE mDCL; static VALUE dcl_vifnb(obj, ix, iy, n, jx, jy, jz, ifnb) VALUE obj, ix, iy, n, jx, jy, jz, ifnb; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; integer i_ifnb; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } if ((TYPE(ifnb) != T_BIGNUM) || (TYPE(ifnb) != T_FIXNUM)) { ifnb = rb_funcall(ifnb, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ifnb = NUM2INT(ifnb); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); vifnb_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz, &i_ifnb); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_vifnb0(obj, ix, iy, n, jx, jy, jz, ifnb) VALUE obj, ix, iy, n, jx, jy, jz, ifnb; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; integer i_ifnb; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } if ((TYPE(ifnb) != T_BIGNUM) || (TYPE(ifnb) != T_FIXNUM)) { ifnb = rb_funcall(ifnb, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ifnb = NUM2INT(ifnb); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); vifnb0_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz, &i_ifnb); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_vifnb1(obj, ix, iy, n, jx, jy, jz, ifnb) VALUE obj, ix, iy, n, jx, jy, jz, ifnb; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; integer i_ifnb; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } if ((TYPE(ifnb) != T_BIGNUM) || (TYPE(ifnb) != T_FIXNUM)) { ifnb = rb_funcall(ifnb, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ifnb = NUM2INT(ifnb); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); vifnb1_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz, &i_ifnb); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_viadd(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); viadd_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_viadd0(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); viadd0_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_viadd1(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); viadd1_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_visub(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); visub_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_visub0(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); visub0_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_visub1(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); visub1_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_vimlt(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); vimlt_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_vimlt0(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); vimlt0_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_vimlt1(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); vimlt1_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_vidiv(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); vidiv_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_vidiv0(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); vidiv0_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } static VALUE dcl_vidiv1(obj, ix, iy, n, jx, jy, jz) VALUE obj, ix, iy, n, jx, jy, jz; { integer *i_ix; integer *i_iy; integer *o_iz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE iz; if ((TYPE(ix) == T_BIGNUM) || (TYPE(ix) == T_FIXNUM)) { ix = rb_Array(ix); } /* if ((TYPE(ix) != T_ARRAY) && (rb_obj_is_kind_of(ix, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(iy) == T_BIGNUM) || (TYPE(iy) == T_FIXNUM)) { iy = rb_Array(iy); } /* if ((TYPE(iy) != T_ARRAY) && (rb_obj_is_kind_of(iy, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if ((TYPE(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_ix = dcl_obj2cintegerary(ix); i_iy = dcl_obj2cintegerary(iy); o_iz= ALLOCA_N(integer, i_jz*(i_n-1)+1); vidiv1_(i_ix, i_iy, o_iz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; iz = dcl_cintegerary2obj(o_iz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); dcl_freecintegerary(i_iy); return iz; } void init_math1_viblib(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "vifnb", dcl_vifnb, 7); rb_define_module_function(mDCL, "vifnb0", dcl_vifnb0, 7); rb_define_module_function(mDCL, "vifnb1", dcl_vifnb1, 7); rb_define_module_function(mDCL, "viadd", dcl_viadd, 6); rb_define_module_function(mDCL, "viadd0", dcl_viadd0, 6); rb_define_module_function(mDCL, "viadd1", dcl_viadd1, 6); rb_define_module_function(mDCL, "visub", dcl_visub, 6); rb_define_module_function(mDCL, "visub0", dcl_visub0, 6); rb_define_module_function(mDCL, "visub1", dcl_visub1, 6); rb_define_module_function(mDCL, "vimlt", dcl_vimlt, 6); rb_define_module_function(mDCL, "vimlt0", dcl_vimlt0, 6); rb_define_module_function(mDCL, "vimlt1", dcl_vimlt1, 6); rb_define_module_function(mDCL, "vidiv", dcl_vidiv, 6); rb_define_module_function(mDCL, "vidiv0", dcl_vidiv0, 6); rb_define_module_function(mDCL, "vidiv1", dcl_vidiv1, 6); }