Mercurial > hg > xemacs-beta
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 == '=')