#include <config.h>
+#include <inttypes.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
{
Lisp_Object tmp;
tmp = read_vector (readcharfun, 0);
- if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
+ if (XVECTOR_SIZE (tmp) < CHAR_TABLE_STANDARD_SLOTS)
error ("Invalid size char-table");
XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
return tmp;
depth = XINT (AREF (tmp, 0));
if (depth < 1 || depth > 3)
error ("Invalid depth in char-table");
- size = XVECTOR (tmp)->size - 2;
+ size = XVECTOR_SIZE (tmp) - 2;
if (chartab_size [depth] != size)
error ("Invalid size char-table");
XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
build them using function calls. */
Lisp_Object tmp;
tmp = read_vector (readcharfun, 1);
- return Fmake_byte_code (XVECTOR (tmp)->size,
+ return Fmake_byte_code (XVECTOR_SIZE (tmp),
XVECTOR (tmp)->contents);
}
if (c == '(')
if (!quoted && !uninterned_symbol)
{
- register char *p1;
- Lisp_Object result;
- p1 = read_buffer;
- if (*p1 == '+' || *p1 == '-') p1++;
- /* Is it an integer? */
- if ('0' <= *p1 && *p1 <= '9')
- {
- do
- p1++;
- while ('0' <= *p1 && *p1 <= '9');
-
- /* Integers can have trailing decimal points. */
- p1 += (*p1 == '.');
- if (p1 == p)
- {
- /* It is an integer. */
- EMACS_INT n = strtol (read_buffer, NULL, 10);
- if (FIXNUM_OVERFLOW_P (n))
- xsignal (Qoverflow_error,
- list1 (build_string (read_buffer)));
- return make_number (n);
- }
- }
-
- result = string_to_float (read_buffer, 0);
- if (FLOATP (result))
+ Lisp_Object result = string_to_number (read_buffer, 10, 0);
+ if (! NILP (result))
return result;
}
{
}
\f
+static inline int
+digit_to_number (int character, int base)
+{
+ int digit;
+
+ if ('0' <= character && character <= '9')
+ digit = character - '0';
+ else if ('a' <= character && character <= 'z')
+ digit = character - 'a' + 10;
+ else if ('A' <= character && character <= 'Z')
+ digit = character - 'A' + 10;
+ else
+ return -1;
+
+ return digit < base ? digit : -1;
+}
+
#define LEAD_INT 1
#define DOT_CHAR 2
#define TRAIL_INT 4
-#define E_CHAR 8
-#define EXP_INT 16
+#define E_EXP 16
-/* Convert CP to a floating point number. Return a non-float value if CP does
- not have valid floating point syntax. If IGNORE_TRAILING is nonzero,
- consider just the longest prefix of CP that has valid floating point
- syntax. */
+/* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
+ integer syntax and fits in a fixnum, else return the nearest float if CP has
+ either floating point or integer syntax and BASE is 10, else return nil. If
+ IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
+ valid floating point syntax. Signal an overflow if BASE is not 10 and the
+ number has integer syntax but does not fit. */
Lisp_Object
-string_to_float (char const *cp, int ignore_trailing)
+string_to_number (char const *string, int base, int ignore_trailing)
{
int state;
- const char *start = cp;
+ char const *cp = string;
+ int leading_digit;
+ int float_syntax = 0;
+ double value = 0;
/* Compute NaN and infinities using a variable, to cope with compilers that
think they are smarter than we are. */
atof ("-0.0") drops the sign. */
int negative = *cp == '-';
- double value = 0;
+ int signedp = negative || *cp == '+';
+ cp += signedp;
state = 0;
- if (negative || *cp == '+')
- cp++;
- if (*cp >= '0' && *cp <= '9')
+ leading_digit = digit_to_number (*cp, base);
+ if (0 <= leading_digit)
{
state |= LEAD_INT;
- while (*cp >= '0' && *cp <= '9')
- cp++;
+ do
+ ++cp;
+ while (0 <= digit_to_number (*cp, base));
}
if (*cp == '.')
{
state |= DOT_CHAR;
cp++;
}
- if (*cp >= '0' && *cp <= '9')
- {
- state |= TRAIL_INT;
- while (*cp >= '0' && *cp <= '9')
- cp++;
- }
- if (*cp == 'e' || *cp == 'E')
- {
- state |= E_CHAR;
- cp++;
- if (*cp == '+' || *cp == '-')
- cp++;
- }
- if (*cp >= '0' && *cp <= '9')
- {
- state |= EXP_INT;
- while (*cp >= '0' && *cp <= '9')
- cp++;
- }
- else if (cp == start)
- ;
- else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
- {
- state |= EXP_INT;
- cp += 3;
- value = 1.0 / zero;
- }
- else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
+ if (base == 10)
{
- state |= EXP_INT;
- cp += 3;
- value = zero / zero;
-
- /* If that made a "negative" NaN, negate it. */
- {
- int i;
- union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
-
- u_data.d = value;
- u_minus_zero.d = - 0.0;
- for (i = 0; i < sizeof (double); i++)
- if (u_data.c[i] & u_minus_zero.c[i])
+ if ('0' <= *cp && *cp <= '9')
+ {
+ state |= TRAIL_INT;
+ do
+ cp++;
+ while ('0' <= *cp && *cp <= '9');
+ }
+ if (*cp == 'e' || *cp == 'E')
+ {
+ char const *ecp = cp;
+ cp++;
+ if (*cp == '+' || *cp == '-')
+ cp++;
+ if ('0' <= *cp && *cp <= '9')
{
- value = - value;
- break;
+ state |= E_EXP;
+ do
+ cp++;
+ while ('0' <= *cp && *cp <= '9');
}
- }
- /* Now VALUE is a positive NaN. */
+ else if (cp[-1] == '+'
+ && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
+ {
+ state |= E_EXP;
+ cp += 3;
+ value = 1.0 / zero;
+ }
+ else if (cp[-1] == '+'
+ && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
+ {
+ state |= E_EXP;
+ cp += 3;
+ value = zero / zero;
+
+ /* If that made a "negative" NaN, negate it. */
+ {
+ int i;
+ union { double d; char c[sizeof (double)]; }
+ u_data, u_minus_zero;
+ u_data.d = value;
+ u_minus_zero.d = -0.0;
+ for (i = 0; i < sizeof (double); i++)
+ if (u_data.c[i] & u_minus_zero.c[i])
+ {
+ value = -value;
+ break;
+ }
+ }
+ /* Now VALUE is a positive NaN. */
+ }
+ else
+ cp = ecp;
+ }
+
+ float_syntax = ((state & (DOT_CHAR|TRAIL_INT)) == (DOT_CHAR|TRAIL_INT)
+ || state == (LEAD_INT|E_EXP));
}
- if (! (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
- || state == (DOT_CHAR|TRAIL_INT)
- || state == (LEAD_INT|E_CHAR|EXP_INT)
- || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
- || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)))
- return make_number (0); /* Any non-float value will do. */
+ /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
+ any prefix that matches. Otherwise, the entire string must match. */
+ if (! (ignore_trailing
+ ? ((state & LEAD_INT) != 0 || float_syntax)
+ : (!*cp && ((state & ~DOT_CHAR) == LEAD_INT || float_syntax))))
+ return Qnil;
+
+ /* If the number uses integer and not float syntax, and is in C-language
+ range, use its value, preferably as a fixnum. */
+ if (0 <= leading_digit && ! float_syntax)
+ {
+ uintmax_t n;
+
+ /* Fast special case for single-digit integers. This also avoids a
+ glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
+ case some versions of strtoumax accept numbers like "0x1" that Emacs
+ does not allow. */
+ if (digit_to_number (string[signedp + 1], base) < 0)
+ return make_number (negative ? -leading_digit : leading_digit);
+
+ errno = 0;
+ n = strtoumax (string + signedp, NULL, base);
+ if (errno == ERANGE)
+ {
+ /* Unfortunately there's no simple and accurate way to convert
+ non-base-10 numbers that are out of C-language range. */
+ if (base != 10)
+ xsignal (Qoverflow_error, list1 (build_string (string)));
+ }
+ else if (n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM))
+ {
+ EMACS_INT signed_n = n;
+ return make_number (negative ? -signed_n : signed_n);
+ }
+ else
+ value = n;
+ }
+ /* Either the number uses float syntax, or it does not fit into a fixnum.
+ Convert it from string to floating point, unless the value is already
+ known because it is an infinity, a NAN, or its absolute value fits in
+ uintmax_t. */
if (! value)
- value = atof (start + negative);
- if (negative)
- value = - value;
- return make_float (value);
+ value = atof (string + signedp);
+
+ return make_float (negative ? -value : value);
}
\f
len = Flength (tem);
vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
- size = XVECTOR (vector)->size;
+ size = XVECTOR_SIZE (vector);
ptr = XVECTOR (vector)->contents;
for (i = 0; i < size; i++)
{
Lisp_Object
check_obarray (Lisp_Object obarray)
{
- if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
+ if (!VECTORP (obarray) || XVECTOR_SIZE (obarray) == 0)
{
/* If Vobarray is now invalid, force it to be valid. */
if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
Lisp_Object obarray;
obarray = Vobarray;
- if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
+ if (!VECTORP (obarray) || XVECTOR_SIZE (obarray) == 0)
obarray = check_obarray (obarray);
tem = oblookup (obarray, str, len, len);
if (SYMBOLP (tem))
Lisp_Object obarray;
obarray = Vobarray;
- if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
+ if (!VECTORP (obarray) || XVECTOR_SIZE (obarray) == 0)
obarray = check_obarray (obarray);
tem = oblookup (obarray, str, len, len);
if (SYMBOLP (tem))
Lisp_Object bucket, tem;
if (!VECTORP (obarray)
- || (obsize = XVECTOR (obarray)->size) == 0)
+ || (obsize = XVECTOR_SIZE (obarray)) == 0)
{
obarray = check_obarray (obarray);
- obsize = XVECTOR (obarray)->size;
+ obsize = XVECTOR_SIZE (obarray);
}
/* This is sometimes needed in the middle of GC. */
obsize &= ~ARRAY_MARK_FLAG;
register int i;
register Lisp_Object tail;
CHECK_VECTOR (obarray);
- for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
+ for (i = XVECTOR_SIZE (obarray) - 1; i >= 0; i--)
{
tail = XVECTOR (obarray)->contents[i];
if (SYMBOLP (tail))
{
Lisp_Object sym;
sym = intern_c_string (sname->symbol_name);
- XSETPVECTYPE (sname, PVEC_SUBR);
+ XSETTYPED_PVECTYPE (sname, size, PVEC_SUBR);
XSETSUBR (XSYMBOL (sym)->function, sname);
}
HCoop / bpt / emacs.git / blobdiff