fix some overflows in integer handling and ~r option.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2203 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

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) {
+	      while (numb/divfactor > radix) {
-		div *= 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;
+		numb %= divfactor;
-		div /= radix;
+		divfactor /= radix;
 	      }
 	      och = base_dig(numb, ch);
 	      f_putc(sno, och);

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' :
+	val = oval * base + chval;
-			    (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
+	if (oval != (val-chval)/base) /* overflow */
-	if (oval >= val && oval != 0) /* 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' :
+      val = val * 16 + chval;
-			(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
+      if (oval != (val-chval)/16) /* overflow */
-      if (oval >= val && oval != 0) /* overflow */
+	has_overflow = TRUE;
-	has_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')) {

changes-5.1.html

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