diff src/lread.c @ 5864:750fab17b299

Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits. src/ChangeLog addition: 2015-02-25 Aidan Kehoe <kehoea@parhasard.net> * lread.c (read_atom): Use the new calling convention for parse_integer(). * lisp.h: Change the declaration of parse_integer (). * number.h (bignum_set_emacs_int, make_bignum_emacs_uint): New #defines, used in data.c. * lread.c (read_integer): Ditto. * lread.c (read1): Ditto. * data.c (find_highest_value): New. * data.c (fill_ichar_array): New. * data.c (build_fixnum_to_char_map): New. * data.c (Fset_digit_fixnum_map): New. * data.c (Fdigit_char_p): Moved from cl-extra.el. * data.c (Fdigit_char): Moved from cl-extra.el. * data.c (parse_integer): Moved from lread.c. * data.c (Fparse_integer): Made available to Lisp. * data.c (syms_of_data): Make the new subrs available. * data.c (vars_of_data): Make the new vars available. Expose parse_integer to Lisp, make it follow the Common Lisp API (with some extensions, to allow us to support non ASCII digit characters). lisp/ChangeLog addition: 2015-02-25 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (digit-char-p): Moved to data.c. * cl-extra.el (digit-char): Moved to data.c. tests/ChangeLog addition: 2015-02-25 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: parse_integer(), used in #'read, now signals invalid-argument rather than invalid-read-syntax, check for that. * automated/lisp-tests.el: Check #'parse-integer now it's available to Lisp, check #'digit-char, #'digit-char-p and the congruence in behaviour, check the XEmacs-specific RADIX-TABLE argument behaviour.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 25 Feb 2015 11:47:12 +0000
parents a216b3c2b09e
children 6174848f3e6c
line wrap: on
line diff
--- a/src/lread.c	Sat Jan 10 19:43:28 2015 +0900
+++ b/src/lread.c	Wed Feb 25 11:47:12 2015 +0000
@@ -1922,8 +1922,6 @@
   return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
 }
 
-static Lisp_Object parse_integer (const Ibyte *buf, Bytecount len, int base);
-
 static Lisp_Object
 read_atom (Lisp_Object readcharfun,
            Ichar firstchar,
@@ -1958,23 +1956,15 @@
 	    p1++;
           if (p1 == p)
             {
+	      Ibyte *buf_end;
               /* It is an integer. */
 	      if (p1[-1] == '.')
-		p1[-1] = '\0';
-#if 0
-	      {
-		int number = 0;
-		if (sizeof (int) == sizeof (EMACS_INT))
-		  number = atoi (read_buffer);
-		else if (sizeof (long) == sizeof (EMACS_INT))
-		  number = atol (read_buffer);
-		else
-		  ABORT ();
-		return make_fixnum (number);
-	      }
-#else
-              return parse_integer ((Ibyte *) read_ptr, len, 10);
-#endif
+                {
+                  len -= 1;
+                }
+
+              return parse_integer ((Ibyte *) read_ptr, &buf_end, len, 10,
+                                    0, Qnil);
 	    }
 	}
 #ifdef HAVE_RATIO
@@ -2011,97 +2001,16 @@
   }
 }
 
-
-static Lisp_Object
-parse_integer (const Ibyte *buf, Bytecount len, int base)
-{
-  const Ibyte *lim = buf + len;
-  const Ibyte *p = buf;
-  EMACS_UINT num = 0;
-  int negativland = 0;
-
-  if (*p == '-')
-    {
-      negativland = 1;
-      p++;
-    }
-  else if (*p == '+')
-    {
-      p++;
-      /* GMP deals with a leading plus sign, badly, make sure it doesn't see
-	 it. */
-      buf++;
-    }
-
-  if (p == lim)
-    goto loser;
-
-  for (; (p < lim) && (*p != '\0'); p++)
-    {
-      int c = *p;
-      EMACS_UINT onum;
-
-      if (isdigit (c))
-	c = c - '0';
-      else if (isupper (c))
-	c = c - 'A' + 10;
-      else if (islower (c))
-	c = c - 'a' + 10;
-      else
-	goto loser;
-
-      if (c < 0 || c >= base)
-	goto loser;
-
-      onum = num;
-      num = num * base + c;
-      if (num < onum)
-	goto overflow;
-    }
-
-  {
-    EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
-    Lisp_Object result = make_fixnum (int_result);
-    if (num && ((XFIXNUM (result) < 0) != negativland))
-      goto overflow;
-    if (XFIXNUM (result) != int_result)
-      goto overflow;
-    return result;
-  }
- overflow:
-#ifdef HAVE_BIGNUM
-  {
-    bignum_set_string (scratch_bignum, (const char *) buf, base);
-    return make_bignum_bg (scratch_bignum);
-  }
-#else
-  return Fsignal (Qinvalid_read_syntax,
-                  list3 (build_msg_string
-			 ("Integer constant overflow in reader"),
-                         make_string (buf, len),
-                         make_fixnum (base)));
-#endif /* HAVE_BIGNUM */
- loser:
-  return Fsignal (Qinvalid_read_syntax,
-                  list3 (build_msg_string
-			 ("Invalid integer constant in reader"),
-                         make_string (buf, len),
-                         make_fixnum (base)));
-}
-
-
 static Lisp_Object
 read_integer (Lisp_Object readcharfun, int base)
 {
   /* This function can GC */
   int saw_a_backslash;
+  Ibyte *buf_end;
   Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
   return (parse_integer
 	  (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
-	   ((saw_a_backslash)
-	    ? 0 /* make parse_integer signal error */
-	    : len),
-	   base));
+           &buf_end, len, base, 0, Qnil));
 }
 
 static Lisp_Object
@@ -2700,6 +2609,7 @@
 	    /* Reader forms that can reuse previously read objects.  */
 	    {
 	      Lisp_Object parsed, found;
+	      Ibyte *buf_end;
 
 	      Lstream_rewind (XLSTREAM (Vread_buffer_stream));
 
@@ -2718,10 +2628,10 @@
 
 	      parsed
 		= parse_integer (resizing_buffer_stream_ptr
-				 (XLSTREAM (Vread_buffer_stream)),
+				 (XLSTREAM (Vread_buffer_stream)), &buf_end,
 				 Lstream_byte_count (XLSTREAM
 						     (Vread_buffer_stream))
-				 - 1, 10);
+				 - 1, 10, 0, Qnil);
 
 	      found = assoc_no_quit (parsed, Vread_objects);
 	      if (c == '=')