diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix extra uses of mpz_ in external code.

Browse Source
This commit is contained in:
Vítor Santos Costa 2010-05-28 15:29:20 +01:00
parent ae2421951b
commit d1599bca8d
5 changed files with 142 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
C/gmp_support.c
View File

@ -19,6 +19,9 @@
#include "Yatom.h"
#include "YapHeap.h"
#include "eval.h"
#if HAVE_STRING_H
#include <string.h>
#endif
#if USE_GMP
@ -1534,6 +1537,63 @@ Yap_gmp_popcount(Term t)
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount");
}
}
char *
Yap_gmp_to_string(Term t, char *s, size_t sz, int base)
{
if (RepAppl(t)[1] == BIG_INT) {
MP_INT *b = Yap_BigIntOfTerm(t);
if (s) {
size_t size = mpz_sizeinbase(b, base);
if (size+2 > sz) {
return NULL;
}
}
return mpz_get_str (s, base, b);
} else if (RepAppl(t)[1] == BIG_RATIONAL) {
MP_RAT *b = Yap_BigRatOfTerm(t);
size_t pos;
size_t siz =
mpz_sizeinbase(mpq_numref(b), base)+
mpz_sizeinbase(mpq_denref(b), base)+
8;
if (s) {
if (siz > sz) {
return NULL;
}
} else {
if (!(s = malloc(siz)))
return NULL;
}
strncpy(s,"rdiv(",sz);
pos = strlen(s);
mpz_get_str (s+pos, base, mpq_numref(b));
pos = strlen(s);
s[pos] = ',';
mpz_get_str (s+(pos+1), base, mpq_denref(b));
pos = strlen(s);
s[pos] = ')';
}
return s;
}
size_t
Yap_gmp_to_size(Term t, int base)
{
if (RepAppl(t)[1] == BIG_INT) {
MP_INT *b = Yap_BigIntOfTerm(t);
return mpz_sizeinbase(b, base);
} else if (RepAppl(t)[1] == BIG_RATIONAL) {
MP_RAT *b = Yap_BigRatOfTerm(t);
return
mpz_sizeinbase(mpq_numref(b), base)+
mpz_sizeinbase(mpq_denref(b), base)+
8;
}
return 1;
}
#endif

65
C/iopreds.c
View File

@ -28,6 +28,7 @@ static char SccsId[] = "%W% %G%";
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include "eval.h"
#include <stdlib.h>
#if HAVE_STDARG_H
#include <stdarg.h>
@ -4914,10 +4915,12 @@ base_dig(Int dig, Int ch)
return (dig-10)+'A';
}
#define TMP_STRING_SIZE 1024
static Int
format(volatile Term otail, volatile Term oargs, int sno)
{
char tmp1[256];
char tmp1[TMP_STRING_SIZE], *tmpbase;
int ch;
int column_boundary;
Term mytargs[8], *targs;
@ -5180,6 +5183,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
{
Int siz = 0;
char *ptr = tmp1;
tmpbase = tmp1;
if (IsIntegerTerm(t)) {
Int il = IntegerOfTerm(t);
@ -5190,20 +5194,29 @@ format(volatile Term otail, volatile Term oargs, int sno)
#endif
siz = strlen(tmp1);
if (il < 0) siz--;
}
#ifdef USE_GMP
else if (IsBigIntTerm(t)) {
MP_INT *dst = Yap_BigIntOfTerm(t);
siz = mpz_sizeinbase (dst, 10);
} else if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) {
char *res;
if (siz+2 > 256) {
goto do_type_int_error;
tmpbase = tmp1;
while (!(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, 10))) {
if (tmpbase == tmp1) {
tmpbase = NULL;
} else {
tmpbase = res;
goto do_type_int_error;
}
}
mpz_get_str (tmp1, 10, dst);
}
tmpbase = res;
ptr = tmpbase;
#endif
if (tmp1[0] == '-') {
siz = strlen(tmpbase);
} else {
goto do_type_int_error;
}
if (tmpbase[0] == '-') {
f_putc(sno, (int) '-');
ptr++;
}
@ -5226,7 +5239,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
}
}
if (repeats) {
if (ptr == tmp1 ||
if (ptr == tmpbase ||
ptr[-1] == '-') {
f_putc(sno, (int) '0');
}
@ -5240,6 +5253,8 @@ format(volatile Term otail, volatile Term oargs, int sno)
repeats--;
}
}
if (tmpbase != tmp1)
free(tmpbase);
break;
case 'r':
case 'R':
@ -5261,24 +5276,24 @@ format(volatile Term otail, volatile Term oargs, int sno)
if (radix > 36 || radix < 2)
goto do_domain_error_radix;
#ifdef USE_GMP
if (IsBigIntTerm(t)) {
MP_INT *dst = Yap_BigIntOfTerm(t);
char *tmp2, *pt;
int ch;
if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) {
char *pt, *res;
siz = mpz_sizeinbase (dst, radix)+2;
if (siz > 256) {
if (!(tmp2 = Yap_AllocCodeSpace(siz)))
tmpbase = tmp1;
while (!(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, radix))) {
if (tmpbase == tmp1) {
tmpbase = NULL;
} else {
tmpbase = res;
goto do_type_int_error;
}
}
else
tmp2 = tmp1;
mpz_get_str (tmp2, radix, dst);
pt = tmp2;
tmpbase = res;
pt = tmpbase;
while ((ch = *pt++))
f_putc(sno, ch);
if (tmp2 != tmp1)
Yap_FreeCodeSpace(tmp2);
if (tmpbase != tmp1)
free(tmpbase);
break;
}
#endif

8
C/parser.c
View File

@ -50,6 +50,7 @@ static char SccsId[] = "%W% %G%";
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include "eval.h"
#if HAVE_STRING_H
#include <string.h>
#endif
@ -448,12 +449,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
t = MkFloatTerm(-FloatOfTerm(t));
#ifdef USE_GMP
else if (IsBigIntTerm(t)) {
mpz_t new;
mpz_init(new);
mpz_neg(new, Yap_BigIntOfTerm(t));
t = Yap_MkBigIntTerm(new);
mpz_clear(new);
t = Yap_gmp_neg_big(t);
}
#endif
else

55
C/stdpreds.c
View File

@ -964,9 +964,8 @@ p_name(void)
#if USE_GMP
} else if (IsBigIntTerm(AtomNameT)) {
String = Yap_PreAllocCodeSpace();
if (String + 1024 > (char *)AuxSp)
if (!Yap_gmp_to_string(AtomNameT, String, ((char *)AuxSp-String)-1024, 10 ))
goto expand_auxsp;
mpz_get_str(String, 10, Yap_BigIntOfTerm(AtomNameT));
#endif
} else {
Yap_Error(TYPE_ERROR_ATOMIC,AtomNameT,"name/2");
@ -1520,19 +1519,18 @@ p_atomic_concat(void)
wcptr += sz;
#if USE_GMP
} else if (IsBigIntTerm(thead)) {
MP_INT *n = Yap_BigIntOfTerm(thead);
int sz, i;
size_t sz, i;
char *tmp = (char *)wcptr;
if ((sz = mpz_sizeinbase (n, 10)) > (wtop-wcptr)-1024) {
sz = Yap_gmp_to_size(thead, 10);
if (!Yap_gmp_to_string(thead, tmp, (wtop-wcptr)-1024, 10 )) {
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
if (!Yap_growheap(FALSE, sz+1024, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto restart;
}
mpz_get_str(tmp, 10, n);
for (i=sz; i>0; i--) {
wcptr[i-1] = tmp[i-1];
}
@ -1614,18 +1612,15 @@ p_atomic_concat(void)
while (*cptr && cptr < top-1024) cptr++;
#if USE_GMP
} else if (IsBigIntTerm(thead)) {
MP_INT *n = Yap_BigIntOfTerm(thead);
int sz;
if ((sz = mpz_sizeinbase (n, 10)) > (top-cptr)-1024) {
if (!Yap_gmp_to_string(thead, cptr, (top-cptr)-1024, 10 )) {
size_t sz = Yap_gmp_to_size(thead, 10);
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
if (!Yap_growheap(FALSE, sz+1024, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto restart;
}
mpz_get_str(cptr, 10, n);
while (*cptr) cptr++;
#endif
}
@ -1956,7 +1951,15 @@ p_number_chars(void)
sprintf(String, Int_FORMAT, LongIntOfTerm(t1));
#if USE_GMP
} else if (IsBigIntTerm(t1)) {
mpz_get_str(String, 10, Yap_BigIntOfTerm(t1));
if (!Yap_gmp_to_string(t1, String, ((char *)AuxSp-String)-1024, 10 )) {
size_t sz = Yap_gmp_to_size(t1, 10);
Yap_ReleasePreAllocCodeSpace((ADDR)String);
if (!Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
goto restart_aux;
}
#endif
}
if (yap_flags[YAP_TO_CHARS_FLAG] == QUINTUS_TO_CHARS) {
@ -2104,7 +2107,13 @@ p_number_atom(void)
#if USE_GMP
} else if (IsBigIntTerm(t1)) {
mpz_get_str(String, 10, Yap_BigIntOfTerm(t1));
while (!Yap_gmp_to_string(t1, String, ((char *)AuxSp-String)-1024, 10 )) {
size_t sz = Yap_gmp_to_size(t1, 10);
if (!(String = Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE))) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, t1, Yap_ErrorMessage);
return FALSE;
}
}
#endif
} else {
Yap_Error(TYPE_ERROR_NUMBER, t1, "number_atom/2");
@ -2160,7 +2169,13 @@ p_number_codes(void)
sprintf(String, Int_FORMAT, LongIntOfTerm(t1));
#if USE_GMP
} else if (IsBigIntTerm(t1)) {
mpz_get_str(String, 10, Yap_BigIntOfTerm(t1));
while (!Yap_gmp_to_string(t1, String, ((char *)AuxSp-String)-1024, 10 )) {
size_t sz = Yap_gmp_to_size(t1, 10);
if (!(String = Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE))) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, t1, Yap_ErrorMessage);
return FALSE;
}
}
#endif
} else {
Yap_Error(TYPE_ERROR_NUMBER, t1, "number_codes/2");
@ -2251,7 +2266,13 @@ p_atom_number(void)
sprintf(String, Int_FORMAT, LongIntOfTerm(t2));
#if USE_GMP
} else if (IsBigIntTerm(t2)) {
mpz_get_str(String, 10, Yap_BigIntOfTerm(t2));
while (!Yap_gmp_to_string(t2, String, ((char *)AuxSp-String)-1024, 10 )) {
size_t sz = Yap_gmp_to_size(t2, 10);
if (!(String = Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE))) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, t2, Yap_ErrorMessage);
return FALSE;
}
}
#endif
} else {
Yap_Error(TYPE_ERROR_NUMBER, t2, "atom_number/2");

3
H/eval.h
View File

@ -303,7 +303,8 @@ Term STD_PROTO(Yap_gmp_lsb,(Term));
Term STD_PROTO(Yap_gmp_msb,(Term));
Term STD_PROTO(Yap_gmp_popcount,(Term));
char * STD_PROTO(Yap_gmp_to_string,(Term, char *, size_t, int));
size_t STD_PROTO(Yap_gmp_to_size,(Term, int));
#endif
inline EXTERN Term Yap_Mk64IntegerTerm(YAP_LONG_LONG);