diff --git a/C/iopreds.c b/C/iopreds.c index e8b7ac7ed..d49319439 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -5035,7 +5035,8 @@ format(volatile Term otail, volatile Term oargs, int sno) case 'r': case 'R': { - Int numb, radix, div = 1, size = 1, i; + Int numb, radix; + UInt divfactor = 1, size = 1, i; wchar_t och; /* print a decimal, using weird . stuff */ @@ -5044,33 +5045,51 @@ format(volatile Term otail, volatile Term oargs, int sno) t = targs[targ++]; if (IsVarTerm(t)) goto do_instantiation_error; - if (!IsIntegerTerm(t)) - goto do_type_int_error; if (!has_repeats) radix = 8; else radix = repeats; 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; + + siz = mpz_sizeinbase (dst, radix)+2; + if (siz > 256) { + if (!(tmp2 = Yap_AllocCodeSpace(siz))) + goto do_type_int_error; + } + else + tmp2 = tmp1; + mpz_get_str (tmp2, radix, dst); + pt = tmp2; + while ((ch = *pt++)) + f_putc(sno, ch); + if (tmp2 != tmp1) + Yap_FreeCodeSpace(tmp2); + break; + } +#endif + if (!IsIntegerTerm(t)) + goto do_type_int_error; numb = IntegerOfTerm(t); if (numb < 0) { numb = -numb; f_putc(sno, (int) '-'); } - while (div < numb) { - div *= radix; + while (numb/divfactor > radix) { + divfactor *= radix; size++; } - if (div != numb) { - div /= radix; - size--; - } for (i = 1; i < size; i++) { - Int dig = numb/div; + Int dig = numb/divfactor; och = base_dig(dig, ch); f_putc(sno, och); - numb %= div; - div /= radix; + numb %= divfactor; + divfactor /= radix; } och = base_dig(numb, ch); f_putc(sno, och); diff --git a/C/scanner.c b/C/scanner.c index c480d234d..13c6d08a9 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -506,14 +506,15 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted while (my_isxdigit(ch, upper_case, lower_case)) { Int oval = val; + int chval = (chtype(ch) == NU ? ch - '0' : + (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; return TermNil; } *sp++ = ch; - val = val * base + (chtype(ch) == NU ? ch - '0' : - (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); - if (oval >= val && oval != 0) /* overflow */ + val = oval * base + chval; + if (oval != (val-chval)/base) /* overflow */ has_overflow = (has_overflow || TRUE); ch = Nxtch(inp_stream); } @@ -528,15 +529,16 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted ch = Nxtch(inp_stream); while (my_isxdigit(ch, 'F', 'f')) { Int oval = val; + int chval = (chtype(ch) == NU ? ch - '0' : + (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; return TermNil; } *sp++ = ch; - val = val * 16 + (chtype(ch) == NU ? ch - '0' : - (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); - if (oval >= val && oval != 0) /* overflow */ - has_overflow = (has_overflow || TRUE); + val = val * 16 + chval; + if (oval != (val-chval)/16) /* overflow */ + has_overflow = TRUE; ch = Nxtch(inp_stream); } *chp = ch; @@ -557,7 +559,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted } while (chtype(ch) == NU) { Int oval = val; - if (!(val == 0 && ch == '0')) { + if (!(val == 0 && ch == '0') || has_overflow) { if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; return (TermNil); @@ -568,7 +570,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted return MkIntegerTerm(val); val = val * base + ch - '0'; if (val/base != oval || val -oval*base != ch-'0') /* overflow */ - has_overflow = (has_overflow || TRUE); + has_overflow = TRUE; ch = Nxtch(inp_stream); } if (might_be_float && (ch == '.' || ch == 'e' || ch == 'E')) { diff --git a/changes-5.1.html b/changes-5.1.html index 3fb93a001..96436acf4 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -17,6 +17,7 @@ xb

Yap-5.1.3: