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

fix some overflows in integer handling and ~r option.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2203 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2008-04-03 22:27:29 +00:00
parent a1327cfe9b
commit 282ba60852
3 changed files with 43 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
C/iopreds.c
View File

@ -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);

20
C/scanner.c
View File

@ -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')) {

1
changes-5.1.html
View File

@ -17,6 +17,7 @@ xb
<h2>Yap-5.1.3:</h2>
<ul>
<li> FIXED: scanning very large numbers (obs from Ryszard Szopa).</li>
<li> FIXED: regexp core-dump (obs from Ryszard Szopa).</li>
<li> FIXED: handle message_queue_create/1 with vars right (obs from
Paulo Moura).</li>