Mercurial > hg > xemacs-beta

comparison src/lread.c @ 5864:750fab17b299

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
5844:83e5c3cd6be6 5864:750fab17b299
1920 Lstream_flush (XLSTREAM (Vread_buffer_stream)); 1920 Lstream_flush (XLSTREAM (Vread_buffer_stream));
1921 1921
1922 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1; 1922 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
1923 } 1923 }
1924 1924
1925 static Lisp_Object parse_integer (const Ibyte *buf, Bytecount len, int base);
1926
1927 static Lisp_Object 1925 static Lisp_Object
1928 read_atom (Lisp_Object readcharfun, 1926 read_atom (Lisp_Object readcharfun,
1929 Ichar firstchar, 1927 Ichar firstchar,
1930 int uninterned_symbol) 1928 int uninterned_symbol)
1931 { 1929 {
1956 /* Integers can have trailing decimal points. */ 1954 /* Integers can have trailing decimal points. */
1957 if (p1 > read_ptr && p1 < p && *p1 == '.') 1955 if (p1 > read_ptr && p1 < p && *p1 == '.')
1958 p1++; 1956 p1++;
1959 if (p1 == p) 1957 if (p1 == p)
1960 { 1958 {
1959 Ibyte *buf_end;
1961 /* It is an integer. */ 1960 /* It is an integer. */
1962 if (p1[-1] == '.') 1961 if (p1[-1] == '.')
1963 p1[-1] = '\0'; 1962 {
1964 #if 0 1963 len -= 1;
1965 { 1964 }
1966 int number = 0; 1965
1967 if (sizeof (int) == sizeof (EMACS_INT)) 1966 return parse_integer ((Ibyte *) read_ptr, &buf_end, len, 10,
1968 number = atoi (read_buffer); 1967 0, Qnil);
1969 else if (sizeof (long) == sizeof (EMACS_INT))
1970 number = atol (read_buffer);
1971 else
1972 ABORT ();
1973 return make_fixnum (number);
1974 }
1975 #else
1976 return parse_integer ((Ibyte *) read_ptr, len, 10);
1977 #endif
1978 } 1968 }
1979 } 1969 }
1980 #ifdef HAVE_RATIO 1970 #ifdef HAVE_RATIO
1981 if (isratio_string (read_ptr)) 1971 if (isratio_string (read_ptr))
1982 { 1972 {
2009 } 1999 }
2010 return sym; 2000 return sym;
2011 } 2001 }
2012 } 2002 }
2013 2003
2014
2015 static Lisp_Object
2016 parse_integer (const Ibyte *buf, Bytecount len, int base)
2017 {
2018 const Ibyte *lim = buf + len;
2019 const Ibyte *p = buf;
2020 EMACS_UINT num = 0;
2021 int negativland = 0;
2022
2023 if (*p == '-')
2024 {
2025 negativland = 1;
2026 p++;
2027 }
2028 else if (*p == '+')
2029 {
2030 p++;
2031 /* GMP deals with a leading plus sign, badly, make sure it doesn't see
2032 it. */
2033 buf++;
2034 }
2035
2036 if (p == lim)
2037 goto loser;
2038
2039 for (; (p < lim) && (*p != '\0'); p++)
2040 {
2041 int c = *p;
2042 EMACS_UINT onum;
2043
2044 if (isdigit (c))
2045 c = c - '0';
2046 else if (isupper (c))
2047 c = c - 'A' + 10;
2048 else if (islower (c))
2049 c = c - 'a' + 10;
2050 else
2051 goto loser;
2052
2053 if (c < 0 || c >= base)
2054 goto loser;
2055
2056 onum = num;
2057 num = num * base + c;
2058 if (num < onum)
2059 goto overflow;
2060 }
2061
2062 {
2063 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
2064 Lisp_Object result = make_fixnum (int_result);
2065 if (num && ((XFIXNUM (result) < 0) != negativland))
2066 goto overflow;
2067 if (XFIXNUM (result) != int_result)
2068 goto overflow;
2069 return result;
2070 }
2071 overflow:
2072 #ifdef HAVE_BIGNUM
2073 {
2074 bignum_set_string (scratch_bignum, (const char *) buf, base);
2075 return make_bignum_bg (scratch_bignum);
2076 }
2077 #else
2078 return Fsignal (Qinvalid_read_syntax,
2079 list3 (build_msg_string
2080 ("Integer constant overflow in reader"),
2081 make_string (buf, len),
2082 make_fixnum (base)));
2083 #endif /* HAVE_BIGNUM */
2084 loser:
2085 return Fsignal (Qinvalid_read_syntax,
2086 list3 (build_msg_string
2087 ("Invalid integer constant in reader"),
2088 make_string (buf, len),
2089 make_fixnum (base)));
2090 }
2091
2092
2093 static Lisp_Object 2004 static Lisp_Object
2094 read_integer (Lisp_Object readcharfun, int base) 2005 read_integer (Lisp_Object readcharfun, int base)
2095 { 2006 {
2096 /* This function can GC */ 2007 /* This function can GC */
2097 int saw_a_backslash; 2008 int saw_a_backslash;
2009 Ibyte *buf_end;
2098 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash); 2010 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
2099 return (parse_integer 2011 return (parse_integer
2100 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)), 2012 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2101 ((saw_a_backslash) 2013 &buf_end, len, base, 0, Qnil));
2102 ? 0 /* make parse_integer signal error */
2103 : len),
2104 base));
2105 } 2014 }
2106 2015
2107 static Lisp_Object 2016 static Lisp_Object
2108 read_bit_vector (Lisp_Object readcharfun) 2017 read_bit_vector (Lisp_Object readcharfun)
2109 { 2018 {
2698 case '0': case '1': case '2': case '3': case '4': 2607 case '0': case '1': case '2': case '3': case '4':
2699 case '5': case '6': case '7': case '8': case '9': 2608 case '5': case '6': case '7': case '8': case '9':
2700 /* Reader forms that can reuse previously read objects. */ 2609 /* Reader forms that can reuse previously read objects. */
2701 { 2610 {
2702 Lisp_Object parsed, found; 2611 Lisp_Object parsed, found;
2612 Ibyte *buf_end;
2703 2613
2704 Lstream_rewind (XLSTREAM (Vread_buffer_stream)); 2614 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
2705 2615
2706 /* Using read_integer() here is impossible, because it 2616 /* Using read_integer() here is impossible, because it
2707 chokes on `='. */ 2617 chokes on `='. */
2716 Lstream_put_ichar (XLSTREAM (Vread_buffer_stream), 0); 2626 Lstream_put_ichar (XLSTREAM (Vread_buffer_stream), 0);
2717 Lstream_flush (XLSTREAM (Vread_buffer_stream)); 2627 Lstream_flush (XLSTREAM (Vread_buffer_stream));
2718 2628
2719 parsed 2629 parsed
2720 = parse_integer (resizing_buffer_stream_ptr 2630 = parse_integer (resizing_buffer_stream_ptr
2721 (XLSTREAM (Vread_buffer_stream)), 2631 (XLSTREAM (Vread_buffer_stream)), &buf_end,
2722 Lstream_byte_count (XLSTREAM 2632 Lstream_byte_count (XLSTREAM
2723 (Vread_buffer_stream)) 2633 (Vread_buffer_stream))
2724 - 1, 10); 2634 - 1, 10, 0, Qnil);
2725 2635
2726 found = assoc_no_quit (parsed, Vread_objects); 2636 found = assoc_no_quit (parsed, Vread_objects);
2727 if (c == '=') 2637 if (c == '=')
2728 { 2638 {
2729 /* #n=object returns object, but associates it with 2639 /* #n=object returns object, but associates it with