/* * $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_vifna(obj, ix, n, jx, jy, ifna) VALUE obj, ix, n, jx, jy, ifna; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ifna; VALUE iy; 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(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(ifna) != T_BIGNUM) || (TYPE(ifna) != T_FIXNUM)) { ifna = rb_funcall(ifna, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ifna = NUM2INT(ifna); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); vifna_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ifna); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_vifna0(obj, ix, n, jx, jy, ifna) VALUE obj, ix, n, jx, jy, ifna; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ifna; VALUE iy; 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(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(ifna) != T_BIGNUM) || (TYPE(ifna) != T_FIXNUM)) { ifna = rb_funcall(ifna, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ifna = NUM2INT(ifna); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); vifna0_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ifna); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_vifna1(obj, ix, n, jx, jy, ifna) VALUE obj, ix, n, jx, jy, ifna; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ifna; VALUE iy; 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(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(ifna) != T_BIGNUM) || (TYPE(ifna) != T_FIXNUM)) { ifna = rb_funcall(ifna, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ifna = NUM2INT(ifna); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); vifna1_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ifna); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_viinc(obj, ix, n, jx, jy, ii) VALUE obj, ix, n, jx, jy, ii; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ii; VALUE iy; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ii = NUM2INT(ii); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); viinc_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ii); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_viinc0(obj, ix, n, jx, jy, ii) VALUE obj, ix, n, jx, jy, ii; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ii; VALUE iy; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ii = NUM2INT(ii); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); viinc0_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ii); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_viinc1(obj, ix, n, jx, jy, ii) VALUE obj, ix, n, jx, jy, ii; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ii; VALUE iy; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ii = NUM2INT(ii); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); viinc1_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ii); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_vifct(obj, ix, n, jx, jy, ii) VALUE obj, ix, n, jx, jy, ii; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ii; VALUE iy; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ii = NUM2INT(ii); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); vifct_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ii); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_vifct0(obj, ix, n, jx, jy, ii) VALUE obj, ix, n, jx, jy, ii; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ii; VALUE iy; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ii = NUM2INT(ii); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); vifct0_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ii); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_vifct1(obj, ix, n, jx, jy, ii) VALUE obj, ix, n, jx, jy, ii; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ii; VALUE iy; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ii = NUM2INT(ii); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); vifct1_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ii); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_vicon(obj, ix, n, jx, jy, ii) VALUE obj, ix, n, jx, jy, ii; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ii; VALUE iy; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ii = NUM2INT(ii); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); vicon_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ii); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_vicon0(obj, ix, n, jx, jy, ii) VALUE obj, ix, n, jx, jy, ii; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ii; VALUE iy; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ii = NUM2INT(ii); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); vicon0_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ii); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_vicon1(obj, ix, n, jx, jy, ii) VALUE obj, ix, n, jx, jy, ii; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; integer i_ii; VALUE iy; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ii = NUM2INT(ii); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); vicon1_(i_ix, o_iy, &i_n, &i_jx, &i_jy, &i_ii); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_viset(obj, ix, n, jx, jy) VALUE obj, ix, n, jx, jy; { integer *i_ix; integer *o_iy; integer i_n; integer i_jx; integer i_jy; VALUE iy; 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(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); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_ix = dcl_obj2cintegerary(ix); o_iy= ALLOCA_N(integer, i_jy*(i_n-1)+1); viset_(i_ix, o_iy, &i_n, &i_jx, &i_jy); {int array_shape[1] = {i_jy*(i_n-1)+1}; iy = dcl_cintegerary2obj(o_iy, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(i_ix); return iy; } static VALUE dcl_iadd(obj, ix, n, jx, ii) VALUE obj, ix, n, jx, ii; { integer *io_ix; integer i_n; integer i_jx; integer i_ii; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_ii = NUM2INT(ii); io_ix = dcl_obj2cintegerary(ix); iadd_(io_ix, &i_n, &i_jx, &i_ii); {int array_shape[1] = {i_jx*(i_n-1)+1}; ix = dcl_cintegerary2obj(io_ix, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(io_ix); return ix; } static VALUE dcl_iadd0(obj, ix, n, jx, ii) VALUE obj, ix, n, jx, ii; { integer *io_ix; integer i_n; integer i_jx; integer i_ii; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_ii = NUM2INT(ii); io_ix = dcl_obj2cintegerary(ix); iadd0_(io_ix, &i_n, &i_jx, &i_ii); {int array_shape[1] = {i_jx*(i_n-1)+1}; ix = dcl_cintegerary2obj(io_ix, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(io_ix); return ix; } static VALUE dcl_iadd1(obj, ix, n, jx, ii) VALUE obj, ix, n, jx, ii; { integer *io_ix; integer i_n; integer i_jx; integer i_ii; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_ii = NUM2INT(ii); io_ix = dcl_obj2cintegerary(ix); iadd1_(io_ix, &i_n, &i_jx, &i_ii); {int array_shape[1] = {i_jx*(i_n-1)+1}; ix = dcl_cintegerary2obj(io_ix, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(io_ix); return ix; } static VALUE dcl_imlt(obj, ix, n, jx, ii) VALUE obj, ix, n, jx, ii; { integer *io_ix; integer i_n; integer i_jx; integer i_ii; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_ii = NUM2INT(ii); io_ix = dcl_obj2cintegerary(ix); imlt_(io_ix, &i_n, &i_jx, &i_ii); {int array_shape[1] = {i_jx*(i_n-1)+1}; ix = dcl_cintegerary2obj(io_ix, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(io_ix); return ix; } static VALUE dcl_imlt0(obj, ix, n, jx, ii) VALUE obj, ix, n, jx, ii; { integer *io_ix; integer i_n; integer i_jx; integer i_ii; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_ii = NUM2INT(ii); io_ix = dcl_obj2cintegerary(ix); imlt0_(io_ix, &i_n, &i_jx, &i_ii); {int array_shape[1] = {i_jx*(i_n-1)+1}; ix = dcl_cintegerary2obj(io_ix, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(io_ix); return ix; } static VALUE dcl_imlt1(obj, ix, n, jx, ii) VALUE obj, ix, n, jx, ii; { integer *io_ix; integer i_n; integer i_jx; integer i_ii; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_ii = NUM2INT(ii); io_ix = dcl_obj2cintegerary(ix); imlt1_(io_ix, &i_n, &i_jx, &i_ii); {int array_shape[1] = {i_jx*(i_n-1)+1}; ix = dcl_cintegerary2obj(io_ix, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(io_ix); return ix; } static VALUE dcl_iset(obj, ix, n, jx, ii) VALUE obj, ix, n, jx, ii; { integer *io_ix; integer i_n; integer i_jx; integer i_ii; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_ii = NUM2INT(ii); io_ix = dcl_obj2cintegerary(ix); iset_(io_ix, &i_n, &i_jx, &i_ii); {int array_shape[1] = {i_jx*(i_n-1)+1}; ix = dcl_cintegerary2obj(io_ix, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(io_ix); return ix; } static VALUE dcl_iset0(obj, ix, n, jx, ii) VALUE obj, ix, n, jx, ii; { integer *io_ix; integer i_n; integer i_jx; integer i_ii; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_ii = NUM2INT(ii); io_ix = dcl_obj2cintegerary(ix); iset0_(io_ix, &i_n, &i_jx, &i_ii); {int array_shape[1] = {i_jx*(i_n-1)+1}; ix = dcl_cintegerary2obj(io_ix, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(io_ix); return ix; } static VALUE dcl_iset1(obj, ix, n, jx, ii) VALUE obj, ix, n, jx, ii; { integer *io_ix; integer i_n; integer i_jx; integer i_ii; 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(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(ii) != T_BIGNUM) || (TYPE(ii) != T_FIXNUM)) { ii = rb_funcall(ii, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_ii = NUM2INT(ii); io_ix = dcl_obj2cintegerary(ix); iset1_(io_ix, &i_n, &i_jx, &i_ii); {int array_shape[1] = {i_jx*(i_n-1)+1}; ix = dcl_cintegerary2obj(io_ix, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecintegerary(io_ix); return ix; } void init_math1_vialib(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "vifna", dcl_vifna, 5); rb_define_module_function(mDCL, "vifna0", dcl_vifna0, 5); rb_define_module_function(mDCL, "vifna1", dcl_vifna1, 5); rb_define_module_function(mDCL, "viinc", dcl_viinc, 5); rb_define_module_function(mDCL, "viinc0", dcl_viinc0, 5); rb_define_module_function(mDCL, "viinc1", dcl_viinc1, 5); rb_define_module_function(mDCL, "vifct", dcl_vifct, 5); rb_define_module_function(mDCL, "vifct0", dcl_vifct0, 5); rb_define_module_function(mDCL, "vifct1", dcl_vifct1, 5); rb_define_module_function(mDCL, "vicon", dcl_vicon, 5); rb_define_module_function(mDCL, "vicon0", dcl_vicon0, 5); rb_define_module_function(mDCL, "vicon1", dcl_vicon1, 5); rb_define_module_function(mDCL, "viset", dcl_viset, 4); rb_define_module_function(mDCL, "iadd", dcl_iadd, 4); rb_define_module_function(mDCL, "iadd0", dcl_iadd0, 4); rb_define_module_function(mDCL, "iadd1", dcl_iadd1, 4); rb_define_module_function(mDCL, "imlt", dcl_imlt, 4); rb_define_module_function(mDCL, "imlt0", dcl_imlt0, 4); rb_define_module_function(mDCL, "imlt1", dcl_imlt1, 4); rb_define_module_function(mDCL, "iset", dcl_iset, 4); rb_define_module_function(mDCL, "iset0", dcl_iset0, 4); rb_define_module_function(mDCL, "iset1", dcl_iset1, 4); }