/* * $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_uzpqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uzpqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uzpqid(obj, cp) VALUE obj, cp; { char *i_cp; integer o_idx; VALUE idx; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzpqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uzpqcp(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uzpqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uzpqcl(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uzpqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uzpqit(obj, idx) VALUE obj, idx; { integer i_idx; integer o_itp; VALUE itp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); uzpqit_(&i_idx, &o_itp); itp = INT2NUM(o_itp); return itp; } static VALUE dcl_uzpqvl(obj, idx) VALUE obj, idx; { integer i_idx; integer o_ipara; VALUE ipara; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); uzpqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_uzpsvl(obj, idx, ipara) VALUE obj, idx, ipara; { integer i_idx; integer i_ipara; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) { ipara = rb_funcall(ipara, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); i_ipara = NUM2INT(ipara); uzpsvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_uzpqin(obj, cp) VALUE obj, cp; { char *i_cp; integer o_in; VALUE in; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzpqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uzinit(obj) VALUE obj; { uzinit_(); return Qnil; } static VALUE dcl_uzfact(obj, rfact) VALUE obj, rfact; { real i_rfact; if (TYPE(rfact) != T_FLOAT) { rfact = rb_funcall(rfact, rb_intern("to_f"), 0); } i_rfact = (real)NUM2DBL(rfact); uzfact_(&i_rfact); return Qnil; } static VALUE dcl_uzcget(obj, cp) VALUE obj, cp; { char *i_cp; char *o_cpara; VALUE cpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); o_cpara= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cpara, '\0', DFLT_SIZE+1); uzcget_(i_cp, o_cpara, (ftnlen)strlen(i_cp), (ftnlen)DFLT_SIZE); cpara = rb_str_new2(o_cpara); return cpara; } static VALUE dcl_uzcset(obj, cp, cpara) VALUE obj, cp, cpara; { char *i_cp; char *i_cpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } if (TYPE(cpara) != T_STRING) { cpara = rb_funcall(cpara, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); i_cpara = STR2CSTR(cpara); uzcset_(i_cp, i_cpara, (ftnlen)strlen(i_cp), (ftnlen)strlen(i_cpara)); return Qnil; } static VALUE dcl_uzcstx(obj, cp, cpara) VALUE obj, cp, cpara; { char *i_cp; char *i_cpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } if (TYPE(cpara) != T_STRING) { cpara = rb_funcall(cpara, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); i_cpara = STR2CSTR(cpara); uzcstx_(i_cp, i_cpara, (ftnlen)strlen(i_cp), (ftnlen)strlen(i_cpara)); return Qnil; } static VALUE dcl_uzcqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uzcqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uzcqid(obj, cp) VALUE obj, cp; { char *i_cp; integer o_idx; VALUE idx; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzcqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uzcqcp(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uzcqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uzcqcl(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uzcqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uzcqvl(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cval; VALUE cval; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cval= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cval, '\0', DFLT_SIZE+1); uzcqvl_(&i_idx, o_cval, (ftnlen)DFLT_SIZE); cval = rb_str_new2(o_cval); return cval; } static VALUE dcl_uzcsvl(obj, idx, cval) VALUE obj, idx, cval; { integer i_idx; char *i_cval; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } if (TYPE(cval) != T_STRING) { cval = rb_funcall(cval, rb_intern("to_str"), 0); } i_idx = NUM2INT(idx); i_cval = STR2CSTR(cval); uzcsvl_(&i_idx, i_cval, (ftnlen)strlen(i_cval)); return Qnil; } static VALUE dcl_uzcqin(obj, cp) VALUE obj, cp; { char *i_cp; integer o_in; VALUE in; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzcqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uzcsav(obj, iu) VALUE obj, iu; { integer i_iu; if ((TYPE(iu) != T_BIGNUM) || (TYPE(iu) != T_FIXNUM)) { iu = rb_funcall(iu, rb_intern("to_i"), 0); } i_iu = NUM2INT(iu); uzcsav_(&i_iu); return Qnil; } static VALUE dcl_uzcrst(obj, iu) VALUE obj, iu; { integer i_iu; if ((TYPE(iu) != T_BIGNUM) || (TYPE(iu) != T_FIXNUM)) { iu = rb_funcall(iu, rb_intern("to_i"), 0); } i_iu = NUM2INT(iu); uzcrst_(&i_iu); return Qnil; } static VALUE dcl_uziget(obj, cp) VALUE obj, cp; { char *i_cp; integer o_ipara; VALUE ipara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uziget_(i_cp, &o_ipara, (ftnlen)strlen(i_cp)); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_uziset(obj, cp, ipara) VALUE obj, cp, ipara; { char *i_cp; integer i_ipara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) { ipara = rb_funcall(ipara, rb_intern("to_i"), 0); } i_cp = STR2CSTR(cp); i_ipara = NUM2INT(ipara); uziset_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uzistx(obj, cp, ipara) VALUE obj, cp, ipara; { char *i_cp; integer i_ipara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) { ipara = rb_funcall(ipara, rb_intern("to_i"), 0); } i_cp = STR2CSTR(cp); i_ipara = NUM2INT(ipara); uzistx_(i_cp, &i_ipara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uziqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uziqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uziqid(obj, cp) VALUE obj, cp; { char *i_cp; integer o_idx; VALUE idx; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uziqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uziqcp(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uziqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uziqcl(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uziqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uziqvl(obj, idx) VALUE obj, idx; { integer i_idx; integer o_ipara; VALUE ipara; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); uziqvl_(&i_idx, &o_ipara); ipara = INT2NUM(o_ipara); return ipara; } static VALUE dcl_uzisvl(obj, idx, ipara) VALUE obj, idx, ipara; { integer i_idx; integer i_ipara; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) { ipara = rb_funcall(ipara, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); i_ipara = NUM2INT(ipara); uzisvl_(&i_idx, &i_ipara); return Qnil; } static VALUE dcl_uziqin(obj, cp) VALUE obj, cp; { char *i_cp; integer o_in; VALUE in; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uziqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uzisav(obj, iu) VALUE obj, iu; { integer i_iu; if ((TYPE(iu) != T_BIGNUM) || (TYPE(iu) != T_FIXNUM)) { iu = rb_funcall(iu, rb_intern("to_i"), 0); } i_iu = NUM2INT(iu); uzisav_(&i_iu); return Qnil; } static VALUE dcl_uzirst(obj, iu) VALUE obj, iu; { integer i_iu; if ((TYPE(iu) != T_BIGNUM) || (TYPE(iu) != T_FIXNUM)) { iu = rb_funcall(iu, rb_intern("to_i"), 0); } i_iu = NUM2INT(iu); uzirst_(&i_iu); return Qnil; } static VALUE dcl_uzlget(obj, cp) VALUE obj, cp; { char *i_cp; logical o_lpara; VALUE lpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzlget_(i_cp, &o_lpara, (ftnlen)strlen(i_cp)); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uzlset(obj, cp, lpara) VALUE obj, cp, lpara; { char *i_cp; logical i_lpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_; uzlset_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uzlstx(obj, cp, lpara) VALUE obj, cp, lpara; { char *i_cp; logical i_lpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_; uzlstx_(i_cp, &i_lpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uzlqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uzlqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uzlqid(obj, cp) VALUE obj, cp; { char *i_cp; integer o_idx; VALUE idx; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzlqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uzlqcp(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uzlqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uzlqcl(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uzlqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uzlqvl(obj, idx) VALUE obj, idx; { integer i_idx; logical o_lpara; VALUE lpara; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); uzlqvl_(&i_idx, &o_lpara); lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue; return lpara; } static VALUE dcl_uzlsvl(obj, idx, lpara) VALUE obj, idx, lpara; { integer i_idx; logical i_lpara; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_; uzlsvl_(&i_idx, &i_lpara); return Qnil; } static VALUE dcl_uzlqin(obj, cp) VALUE obj, cp; { char *i_cp; integer o_in; VALUE in; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzlqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uzlsav(obj, iu) VALUE obj, iu; { integer i_iu; if ((TYPE(iu) != T_BIGNUM) || (TYPE(iu) != T_FIXNUM)) { iu = rb_funcall(iu, rb_intern("to_i"), 0); } i_iu = NUM2INT(iu); uzlsav_(&i_iu); return Qnil; } static VALUE dcl_uzlrst(obj, iu) VALUE obj, iu; { integer i_iu; if ((TYPE(iu) != T_BIGNUM) || (TYPE(iu) != T_FIXNUM)) { iu = rb_funcall(iu, rb_intern("to_i"), 0); } i_iu = NUM2INT(iu); uzlrst_(&i_iu); return Qnil; } static VALUE dcl_uzrget(obj, cp) VALUE obj, cp; { char *i_cp; real o_rpara; VALUE rpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzrget_(i_cp, &o_rpara, (ftnlen)strlen(i_cp)); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_uzrset(obj, cp, rpara) VALUE obj, cp, rpara; { char *i_cp; real i_rpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } if (TYPE(rpara) != T_FLOAT) { rpara = rb_funcall(rpara, rb_intern("to_f"), 0); } i_cp = STR2CSTR(cp); i_rpara = (real)NUM2DBL(rpara); uzrset_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uzrstx(obj, cp, rpara) VALUE obj, cp, rpara; { char *i_cp; real i_rpara; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } if (TYPE(rpara) != T_FLOAT) { rpara = rb_funcall(rpara, rb_intern("to_f"), 0); } i_cp = STR2CSTR(cp); i_rpara = (real)NUM2DBL(rpara); uzrstx_(i_cp, &i_rpara, (ftnlen)strlen(i_cp)); return Qnil; } static VALUE dcl_uzrqnp(obj) VALUE obj; { integer o_ncp; VALUE ncp; uzrqnp_(&o_ncp); ncp = INT2NUM(o_ncp); return ncp; } static VALUE dcl_uzrqid(obj, cp) VALUE obj, cp; { char *i_cp; integer o_idx; VALUE idx; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzrqid_(i_cp, &o_idx, (ftnlen)strlen(i_cp)); idx = INT2NUM(o_idx); return idx; } static VALUE dcl_uzrqcp(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uzrqcp_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uzrqcl(obj, idx) VALUE obj, idx; { integer i_idx; char *o_cp; VALUE cp; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); o_cp= ALLOCA_N(char, (DFLT_SIZE+1)); memset(o_cp, '\0', DFLT_SIZE+1); uzrqcl_(&i_idx, o_cp, (ftnlen)DFLT_SIZE); cp = rb_str_new2(o_cp); return cp; } static VALUE dcl_uzrqvl(obj, idx) VALUE obj, idx; { integer i_idx; real o_rpara; VALUE rpara; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } i_idx = NUM2INT(idx); uzrqvl_(&i_idx, &o_rpara); rpara = rb_float_new((double)o_rpara); return rpara; } static VALUE dcl_uzrsvl(obj, idx, rpara) VALUE obj, idx, rpara; { integer i_idx; real i_rpara; if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) { idx = rb_funcall(idx, rb_intern("to_i"), 0); } if (TYPE(rpara) != T_FLOAT) { rpara = rb_funcall(rpara, rb_intern("to_f"), 0); } i_idx = NUM2INT(idx); i_rpara = (real)NUM2DBL(rpara); uzrsvl_(&i_idx, &i_rpara); return Qnil; } static VALUE dcl_uzrqin(obj, cp) VALUE obj, cp; { char *i_cp; integer o_in; VALUE in; if (TYPE(cp) != T_STRING) { cp = rb_funcall(cp, rb_intern("to_str"), 0); } i_cp = STR2CSTR(cp); uzrqin_(i_cp, &o_in, (ftnlen)strlen(i_cp)); in = INT2NUM(o_in); return in; } static VALUE dcl_uzrsav(obj, iu) VALUE obj, iu; { integer i_iu; if ((TYPE(iu) != T_BIGNUM) || (TYPE(iu) != T_FIXNUM)) { iu = rb_funcall(iu, rb_intern("to_i"), 0); } i_iu = NUM2INT(iu); uzrsav_(&i_iu); return Qnil; } static VALUE dcl_uzrrst(obj, iu) VALUE obj, iu; { integer i_iu; if ((TYPE(iu) != T_BIGNUM) || (TYPE(iu) != T_FIXNUM)) { iu = rb_funcall(iu, rb_intern("to_i"), 0); } i_iu = NUM2INT(iu); uzrrst_(&i_iu); return Qnil; } static VALUE dcl_uzpsav(obj) VALUE obj; { uzpsav_(); return Qnil; } static VALUE dcl_uzprst(obj) VALUE obj; { uzprst_(); return Qnil; } void init_grph2_uzpack(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "uzpqnp", dcl_uzpqnp, 0); rb_define_module_function(mDCL, "uzpqid", dcl_uzpqid, 1); rb_define_module_function(mDCL, "uzpqcp", dcl_uzpqcp, 1); rb_define_module_function(mDCL, "uzpqcl", dcl_uzpqcl, 1); rb_define_module_function(mDCL, "uzpqit", dcl_uzpqit, 1); rb_define_module_function(mDCL, "uzpqvl", dcl_uzpqvl, 1); rb_define_module_function(mDCL, "uzpsvl", dcl_uzpsvl, 2); rb_define_module_function(mDCL, "uzpqin", dcl_uzpqin, 1); rb_define_module_function(mDCL, "uzinit", dcl_uzinit, 0); rb_define_module_function(mDCL, "uzfact", dcl_uzfact, 1); rb_define_module_function(mDCL, "uzcget", dcl_uzcget, 1); rb_define_module_function(mDCL, "uzcset", dcl_uzcset, 2); rb_define_module_function(mDCL, "uzcstx", dcl_uzcstx, 2); rb_define_module_function(mDCL, "uzcqnp", dcl_uzcqnp, 0); rb_define_module_function(mDCL, "uzcqid", dcl_uzcqid, 1); rb_define_module_function(mDCL, "uzcqcp", dcl_uzcqcp, 1); rb_define_module_function(mDCL, "uzcqcl", dcl_uzcqcl, 1); rb_define_module_function(mDCL, "uzcqvl", dcl_uzcqvl, 1); rb_define_module_function(mDCL, "uzcsvl", dcl_uzcsvl, 2); rb_define_module_function(mDCL, "uzcqin", dcl_uzcqin, 1); rb_define_module_function(mDCL, "uzcsav", dcl_uzcsav, 1); rb_define_module_function(mDCL, "uzcrst", dcl_uzcrst, 1); rb_define_module_function(mDCL, "uziget", dcl_uziget, 1); rb_define_module_function(mDCL, "uziset", dcl_uziset, 2); rb_define_module_function(mDCL, "uzistx", dcl_uzistx, 2); rb_define_module_function(mDCL, "uziqnp", dcl_uziqnp, 0); rb_define_module_function(mDCL, "uziqid", dcl_uziqid, 1); rb_define_module_function(mDCL, "uziqcp", dcl_uziqcp, 1); rb_define_module_function(mDCL, "uziqcl", dcl_uziqcl, 1); rb_define_module_function(mDCL, "uziqvl", dcl_uziqvl, 1); rb_define_module_function(mDCL, "uzisvl", dcl_uzisvl, 2); rb_define_module_function(mDCL, "uziqin", dcl_uziqin, 1); rb_define_module_function(mDCL, "uzisav", dcl_uzisav, 1); rb_define_module_function(mDCL, "uzirst", dcl_uzirst, 1); rb_define_module_function(mDCL, "uzlget", dcl_uzlget, 1); rb_define_module_function(mDCL, "uzlset", dcl_uzlset, 2); rb_define_module_function(mDCL, "uzlstx", dcl_uzlstx, 2); rb_define_module_function(mDCL, "uzlqnp", dcl_uzlqnp, 0); rb_define_module_function(mDCL, "uzlqid", dcl_uzlqid, 1); rb_define_module_function(mDCL, "uzlqcp", dcl_uzlqcp, 1); rb_define_module_function(mDCL, "uzlqcl", dcl_uzlqcl, 1); rb_define_module_function(mDCL, "uzlqvl", dcl_uzlqvl, 1); rb_define_module_function(mDCL, "uzlsvl", dcl_uzlsvl, 2); rb_define_module_function(mDCL, "uzlqin", dcl_uzlqin, 1); rb_define_module_function(mDCL, "uzlsav", dcl_uzlsav, 1); rb_define_module_function(mDCL, "uzlrst", dcl_uzlrst, 1); rb_define_module_function(mDCL, "uzrget", dcl_uzrget, 1); rb_define_module_function(mDCL, "uzrset", dcl_uzrset, 2); rb_define_module_function(mDCL, "uzrstx", dcl_uzrstx, 2); rb_define_module_function(mDCL, "uzrqnp", dcl_uzrqnp, 0); rb_define_module_function(mDCL, "uzrqid", dcl_uzrqid, 1); rb_define_module_function(mDCL, "uzrqcp", dcl_uzrqcp, 1); rb_define_module_function(mDCL, "uzrqcl", dcl_uzrqcl, 1); rb_define_module_function(mDCL, "uzrqvl", dcl_uzrqvl, 1); rb_define_module_function(mDCL, "uzrsvl", dcl_uzrsvl, 2); rb_define_module_function(mDCL, "uzrqin", dcl_uzrqin, 1); rb_define_module_function(mDCL, "uzrsav", dcl_uzrsav, 1); rb_define_module_function(mDCL, "uzrrst", dcl_uzrrst, 1); rb_define_module_function(mDCL, "uzpsav", dcl_uzpsav, 0); rb_define_module_function(mDCL, "uzprst", dcl_uzprst, 0); }