fda0de1999-10-08Fredrik Noring #include "global.h" #ifdef AUTO_BIGNUM #include "interpret.h" #include "program.h" #include "object.h" #include "svalue.h"
b2d3e42000-12-01Fredrik Hübinette (Hubbe) #include "pike_error.h"
fda0de1999-10-08Fredrik Noring 
e37a3e1999-10-09Fredrik Hübinette (Hubbe) struct svalue auto_bignum_program = { T_INT };
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT int gmp_library_loaded=0;
3905cf1999-11-11Fredrik Hübinette (Hubbe) int gmp_library_resolving=0;
e28b471999-10-25Fredrik Hübinette (Hubbe) 
e37a3e1999-10-09Fredrik Hübinette (Hubbe) static void resolve_auto_bignum_program(void)
fda0de1999-10-08Fredrik Noring {
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  if(auto_bignum_program.type == T_INT) {
df43122000-01-09Fredrik Hübinette (Hubbe)  if(gmp_library_resolving) fatal("Recursive GMP resolving!\n");
3905cf1999-11-11Fredrik Hübinette (Hubbe)  gmp_library_resolving=1;
0957531999-10-25Fredrik Hübinette (Hubbe)  push_text("Gmp.bignum");
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  SAFE_APPLY_MASTER("resolv", 1);
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  if(sp[-1].type != T_FUNCTION && sp[-1].type != T_PROGRAM)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Failed to resolv Gmp.mpz!\n");
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  auto_bignum_program=sp[-1]; sp--;
e801bb1999-10-24Henrik Grubbström (Grubba)  dmalloc_touch_svalue(sp);
3905cf1999-11-11Fredrik Hübinette (Hubbe)  gmp_library_resolving=0;
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  } }
fda0de1999-10-08Fredrik Noring 
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct program *get_auto_bignum_program(void)
8852cb1999-10-25Fredrik Hübinette (Hubbe) { resolve_auto_bignum_program(); return program_from_function(&auto_bignum_program); }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct program *get_auto_bignum_program_or_zero(void)
8852cb1999-10-25Fredrik Hübinette (Hubbe) {
084dd51999-11-24Fredrik Hübinette (Hubbe)  if(!gmp_library_loaded || gmp_library_resolving ||
0e6f461999-11-29Fredrik Hübinette (Hubbe)  !master_object) return 0;
8852cb1999-10-25Fredrik Hübinette (Hubbe)  resolve_auto_bignum_program(); return program_from_function(&auto_bignum_program); }
e37a3e1999-10-09Fredrik Hübinette (Hubbe) void exit_auto_bignum(void) { free_svalue(&auto_bignum_program); auto_bignum_program.type=T_INT;
fda0de1999-10-08Fredrik Noring }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void convert_stack_top_to_bignum(void)
e37a3e1999-10-09Fredrik Hübinette (Hubbe) { resolve_auto_bignum_program(); apply_svalue(&auto_bignum_program, 1);
fda0de1999-10-08Fredrik Noring 
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  if(sp[-1].type != T_OBJECT)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Gmp.mpz conversion failed.\n");
e37a3e1999-10-09Fredrik Hübinette (Hubbe) }
fda0de1999-10-08Fredrik Noring 
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void convert_stack_top_with_base_to_bignum(void)
31ea271999-10-22Fredrik Noring { resolve_auto_bignum_program(); apply_svalue(&auto_bignum_program, 2); if(sp[-1].type != T_OBJECT)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Gmp.mpz conversion failed.\n");
31ea271999-10-22Fredrik Noring }
39ac731999-10-20Fredrik Noring int is_bignum_object(struct object *o) {
e28b471999-10-25Fredrik Hübinette (Hubbe)  /* Note: * This function should *NOT* try to resolv Gmp.mpz unless * it is already loaded into memory. * /Hubbe */
084dd51999-11-24Fredrik Hübinette (Hubbe)  if(!gmp_library_loaded || gmp_library_resolving ||
0e6f461999-11-29Fredrik Hübinette (Hubbe)  !master_object)
3905cf1999-11-11Fredrik Hübinette (Hubbe)  return 0; /* not possible */
e28b471999-10-25Fredrik Hübinette (Hubbe) 
39ac731999-10-20Fredrik Noring  resolve_auto_bignum_program();
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  return o->prog == program_from_svalue(&auto_bignum_program);
39ac731999-10-20Fredrik Noring }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT int is_bignum_object_in_svalue(struct svalue *sv)
39ac731999-10-20Fredrik Noring { return sv->type == T_OBJECT && is_bignum_object(sv->u.object); }
e37a3e1999-10-09Fredrik Hübinette (Hubbe) 
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct object *make_bignum_object(void)
fda0de1999-10-08Fredrik Noring {
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  convert_stack_top_to_bignum();
39ac731999-10-20Fredrik Noring  return (--sp)->u.object;
e37a3e1999-10-09Fredrik Hübinette (Hubbe) }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct object *bignum_from_svalue(struct svalue *s)
e37a3e1999-10-09Fredrik Hübinette (Hubbe) { push_svalue(s); convert_stack_top_to_bignum();
39ac731999-10-20Fredrik Noring  return (--sp)->u.object;
fda0de1999-10-08Fredrik Noring }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct pike_string *string_from_bignum(struct object *o, int base)
ff0d461999-10-15Fredrik Noring { push_int(base); safe_apply(o, "digits", 1); if(sp[-1].type != T_STRING)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Gmp.mpz string conversion failed.\n");
ff0d461999-10-15Fredrik Noring  return (--sp)->u.string; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void convert_svalue_to_bignum(struct svalue *s)
fda0de1999-10-08Fredrik Noring {
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  push_svalue(s); convert_stack_top_to_bignum(); free_svalue(s); *s=sp[-1];
fda0de1999-10-08Fredrik Noring  sp--;
e801bb1999-10-24Henrik Grubbström (Grubba)  dmalloc_touch_svalue(sp);
fda0de1999-10-08Fredrik Noring }
bd35ec1999-10-30Fredrik Noring #ifdef INT64
2fe5651999-10-29Fredrik Noring 
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void push_int64(INT64 i)
2fe5651999-10-29Fredrik Noring {
0a5d062000-08-08Henrik Grubbström (Grubba)  if(i == DO_NOT_WARN((INT_TYPE)i))
2fe5651999-10-29Fredrik Noring  {
0a5d062000-08-08Henrik Grubbström (Grubba)  push_int(DO_NOT_WARN((INT_TYPE)i));
2fe5651999-10-29Fredrik Noring  } else {
173c452001-02-02Per Hedbor  unsigned int neg = 0; if( i < 0 )
2fe5651999-10-29Fredrik Noring  {
173c452001-02-02Per Hedbor  i = -i; neg = 1;
2fe5651999-10-29Fredrik Noring  }
173c452001-02-02Per Hedbor #if PIKE_BYTEORDER == 1234 { char digits[8]; char *ledigits = (char *)&i; digits[7] = ledigits[ 0 ]; digits[6] = ledigits[ 1 ]; digits[5] = ledigits[ 2 ]; digits[4] = ledigits[ 3 ]; digits[3] = ledigits[ 4 ]; digits[2] = ledigits[ 5 ]; digits[1] = ledigits[ 6 ]; digits[0] = ledigits[ 7 ]; push_string( make_shared_binary_string( digits, 8 ) ); } #else push_string( make_shared_binary_string( (char *)&i, 8 ) ); #endif push_int( 256 ); apply_svalue(&auto_bignum_program, 2);
2fe5651999-10-29Fredrik Noring  if(neg) apply_low(sp[-1].u.object,FIND_LFUN(sp[-1].u.object->prog,LFUN_COMPL),0); } }
173c452001-02-02Per Hedbor /* This routines can be optimized quite drastically. */ #define BIGNUM_INT64_MASK 0xffffff #define BIGNUM_INT64_SHIFT 24
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT int int64_from_bignum(INT64 *i, struct object *bignum)
2fe5651999-10-29Fredrik Noring { int neg, pos, rshfun, andfun; *i = 0; push_int(0); apply_low(bignum, FIND_LFUN(bignum->prog, LFUN_LT), 1); if(sp[-1].type != T_INT)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Result from Gmp.bignum->`< not an integer.\n");
2fe5651999-10-29Fredrik Noring  neg = (--sp)->u.integer; if(neg) apply_low(bignum, FIND_LFUN(bignum->prog, LFUN_COMPL), 0); rshfun = FIND_LFUN(bignum->prog, LFUN_RSH); andfun = FIND_LFUN(bignum->prog, LFUN_AND); ref_push_object(bignum); for(pos = 0; sp[-1].type != T_INT; ) { push_int(BIGNUM_INT64_MASK); apply_low(sp[-2].u.object, andfun, 1); if(sp[-1].type != T_INT)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Result from Gmp.bignum->`& not an integer.\n");
2fe5651999-10-29Fredrik Noring  *i |= (INT64)(--sp)->u.integer << (INT64)pos; pos += BIGNUM_INT64_SHIFT; push_int(BIGNUM_INT64_SHIFT); apply_low(sp[-2].u.object, rshfun, 1); stack_swap(); pop_stack(); } *i |= (INT64)(--sp)->u.integer << (INT64)pos; if(neg) *i = ~*i;
bd35ec1999-10-30Fredrik Noring 
2fe5651999-10-29Fredrik Noring  return 1; /* We may someday return 0 if the conversion fails. */ }
856cff1999-10-29Fredrik Noring #endif /* INT64 */
2fe5651999-10-29Fredrik Noring 
fda0de1999-10-08Fredrik Noring #endif /* AUTO_BIGNUM */