Better integer declaration handling, fixed avma/gmp error - gcl.git - GNU Common Lisp

diff --git a/gcl/h/cmponly.h b/gcl/h/cmponly.h
index 8c0f608e8..38e5af1a3 100755
--- a/gcl/h/cmponly.h
+++ b/gcl/h/cmponly.h

@@ -38,18 +38,36 @@ GEN setq_io(),setq_ii();

typedef MP_INT * GEN;

int obj_to_mpz(object,MP_INT *);

+int obj_to_mpz1(object,MP_INT *,void *);

int mpz_to_mpz(MP_INT *,MP_INT *);

+int mpz_to_mpz1(MP_INT *,MP_INT *,void *);

void isetq_fix(MP_INT *,int);

MP_INT * otoi(object x);

-#define IDECL(a,b,c) MP_INT b; a = (mpz_init(&b),&b) ; object c

+#ifndef HAVE_ALLOCA

+#error Need alloca for GMP

+#endif

+

+#define IDECL(a,b,c) MP_INT b={1,1,alloca(1*sizeof(mp_limb_t))}; a = &b ; object c

#define SETQ_IO(var,alloc,val) { object _xx = (val); \

- obj_to_mpz(_xx,(var));}

+ int _n; \

+ if ((_n=obj_to_mpz(_xx,(var)))) {\

+ obj_to_mpz1(_xx,(var),alloca(_n));}}

#define SETQ_II(var,alloc,val) { MP_INT * _xx = (val); \

- mpz_to_mpz(_xx,(var));}

+ int _n; \

+ if ((_n=mpz_to_mpz(_xx,(var)))) {\

+ mpz_to_mpz1(_xx,(var),alloca(_n));}}

#define ISETQ_FIX(a,b,c) isetq_fix(a,c)

+/* #define IDECL(a,b,c) MP_INT b; a = (mpz_init(&b),&b) ; object c */

+/* #define SETQ_IO(var,alloc,val) { object _xx = (val); \ */

+/* obj_to_mpz(_xx,(var));} */

+/* #define SETQ_II(var,alloc,val) { MP_INT * _xx = (val); \ */

+/* mpz_to_mpz(_xx,(var));} */

+/* #define ISETQ_FIX(a,b,c) isetq_fix(a,c) */

+

+

#endif /* end no GMP */

#define cclosure_call funcall

diff --git a/gcl/h/compbas2.h b/gcl/h/compbas2.h
index f261a5209..736c4b20f 100755
--- a/gcl/h/compbas2.h
+++ b/gcl/h/compbas2.h

@@ -1,4 +1,9 @@

/* if already mp.h has been included skip */

+#ifdef GMP

+#define save_avma

+#define restore_avma

+#endif

+

#ifdef _MP_H

#ifdef GMP

diff --git a/gcl/o/gmp_big.c b/gcl/o/gmp_big.c
index ad612549c..5b353fcb6 100755
--- a/gcl/o/gmp_big.c
+++ b/gcl/o/gmp_big.c

@@ -361,32 +361,65 @@ copy_to_big(x)

int

obj_to_mpz(object x,MP_INT * y) {

- int ret=0;

+ switch(type_of(x)) {

+ case t_fixnum:

+ mpz_set_si(y,fix(x));

+ break;

+ case t_bignum:

+ if (abs(MP(x)->_mp_size)<=y->_mp_alloc)

+ mpz_set(y,MP(x));

+ else

+ return abs(MP(x)->_mp_size)*sizeof(*y->_mp_d);

+ break;

+ default:

+ FEerror("fixnum or bignum expected",0);

+ break;

+ }

+

+ return 0;

+

+}

+

+int

+obj_to_mpz1(object x,MP_INT * y,void *v) {

switch(type_of(x)) {

case t_fixnum:

mpz_set_si(y,fix(x));

break;

case t_bignum:

+ y->_mp_alloc=abs(MP(x)->_mp_size);

+ y->_mp_d=v;

mpz_set(y,MP(x));

break;

default:

FEerror("fixnum or bignum expected",0);

- ret=1;

break;

}

- return ret;

+ return 0;

}

int

mpz_to_mpz(MP_INT * x,MP_INT * y) {

- int ret=0;

+ if (abs(x->_mp_size)<=y->_mp_alloc)

+ mpz_set(y,x);

+ else

+ return abs(x->_mp_size)*sizeof(*y->_mp_d);

+

+ return 0;

+

+}

+

+int

+mpz_to_mpz1(MP_INT * x,MP_INT * y,void *v) {

+ y->_mp_alloc=abs(x->_mp_size);

+ y->_mp_d=v;

mpz_set(y,x);

- return ret;

+ return 0;

}