X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/8289296548281f6fa4c8b6b1ee9ead764c4c9aa3..da85a02af7585384008d3ebec836a7b8571f175d:/src/data.c
diff --git a/src/data.c b/src/data.c
index ba7ae58d7b..76a54547a5 100644
--- a/src/data.c
+++ b/src/data.c
@@ -22,6 +22,9 @@ along with GNU Emacs. If not, see . */
#include
#include
#include
+
+#include
+
#include "lisp.h"
#include "puresize.h"
#include "character.h"
@@ -29,14 +32,11 @@ along with GNU Emacs. If not, see . */
#include "keyboard.h"
#include "frame.h"
#include "syssignal.h"
-#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
+#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
#include "font.h"
-#ifdef STDC_HEADERS
#include
-#endif
-
-/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
+/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
#ifndef IEEE_FLOATING_POINT
#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
&& FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
@@ -48,30 +48,33 @@ along with GNU Emacs. If not, see . */
#include
-#if !defined (atof)
-extern double atof (const char *);
-#endif /* !atof */
-
-Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
+Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
+static Lisp_Object Qsubr;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
-Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
-Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection;
-Lisp_Object Qcyclic_variable_indirection, Qcircular_list;
-Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
+Lisp_Object Qerror, Qquit, Qargs_out_of_range;
+static Lisp_Object Qwrong_type_argument;
+Lisp_Object Qvoid_variable, Qvoid_function;
+static Lisp_Object Qcyclic_function_indirection;
+static Lisp_Object Qcyclic_variable_indirection;
+Lisp_Object Qcircular_list;
+static Lisp_Object Qsetting_constant;
+Lisp_Object Qinvalid_read_syntax;
Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
Lisp_Object Qtext_read_only;
-Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
+Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp;
+static Lisp_Object Qnatnump;
Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
-Lisp_Object Qbuffer_or_string_p, Qkeywordp;
-Lisp_Object Qboundp, Qfboundp;
+Lisp_Object Qbuffer_or_string_p;
+static Lisp_Object Qkeywordp, Qboundp;
+Lisp_Object Qfboundp;
Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
Lisp_Object Qcdr;
-Lisp_Object Qad_advice_info, Qad_activate_internal;
+static Lisp_Object Qad_advice_info, Qad_activate_internal;
Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
Lisp_Object Qoverflow_error, Qunderflow_error;
@@ -83,8 +86,9 @@ Lisp_Object Qinteger;
static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
Lisp_Object Qwindow;
static Lisp_Object Qfloat, Qwindow_configuration;
-Lisp_Object Qprocess;
-static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
+static Lisp_Object Qprocess;
+static Lisp_Object Qcompiled_function, Qframe, Qvector;
+Lisp_Object Qbuffer;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
static Lisp_Object Qsubrp, Qmany, Qunevalled;
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
@@ -94,13 +98,6 @@ Lisp_Object Qinteractive_form;
static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
-void
-circular_list_error (Lisp_Object list)
-{
- xsignal (Qcircular_list, list);
-}
-
-
Lisp_Object
wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
{
@@ -703,7 +700,7 @@ SUBR must be a built-in function. */)
const char *name;
CHECK_SUBR (subr);
name = XSUBR (subr)->symbol_name;
- return make_string (name, strlen (name));
+ return build_string (name);
}
DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
@@ -745,7 +742,9 @@ Value, if non-nil, is a list \(interactive SPEC). */)
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
- if (EQ (funcar, Qlambda))
+ if (EQ (funcar, Qclosure))
+ return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
+ else if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (XCDR (fun)));
else if (EQ (funcar, Qautoload))
{
@@ -1391,7 +1390,7 @@ for this variable. */)
{
struct buffer *b;
- for (b = all_buffers; b; b = b->next)
+ for (b = all_buffers; b; b = b->header.next.buffer)
if (!PER_BUFFER_VALUE_P (b, idx))
PER_BUFFER_VALUE (b, offset) = value;
}
@@ -1431,7 +1430,7 @@ usage: (setq-default [VAR VALUE]...) */)
do
{
- val = Feval (Fcar (Fcdr (args_left)));
+ val = eval_sub (Fcar (Fcdr (args_left)));
symbol = XCAR (args_left);
Fset_default (symbol, val);
args_left = Fcdr (XCDR (args_left));
@@ -1477,8 +1476,8 @@ make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents
return blv;
}
-DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local,
- 1, 1, "vMake Variable Buffer Local: ",
+DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local,
+ Smake_variable_buffer_local, 1, 1, "vMake Variable Buffer Local: ",
doc: /* Make VARIABLE become buffer-local whenever it is set.
At any time, the value for the current buffer is in effect,
unless the variable has never been set in this buffer,
@@ -1953,7 +1952,8 @@ If the current binding is global (the default), the value is nil. */)
#if 0
extern struct terminal *get_terminal (Lisp_Object display, int);
-DEFUN ("terminal-local-value", Fterminal_local_value, Sterminal_local_value, 2, 2, 0,
+DEFUN ("terminal-local-value", Fterminal_local_value,
+ Sterminal_local_value, 2, 2, 0,
doc: /* Return the terminal-local value of SYMBOL on TERMINAL.
If SYMBOL is not a terminal-local variable, then return its normal
value, like `symbol-value'.
@@ -1970,7 +1970,8 @@ selected frame's terminal device). */)
return result;
}
-DEFUN ("set-terminal-local-value", Fset_terminal_local_value, Sset_terminal_local_value, 3, 3, 0,
+DEFUN ("set-terminal-local-value", Fset_terminal_local_value,
+ Sset_terminal_local_value, 3, 3, 0,
doc: /* Set the terminal-local binding of SYMBOL on TERMINAL to VALUE.
If VARIABLE is not a terminal-local variable, then set its normal
binding, like `set'.
@@ -2093,15 +2094,15 @@ or a byte-code object. IDX starts at 0. */)
{
int size = 0;
if (VECTORP (array))
- size = XVECTOR (array)->size;
+ size = ASIZE (array);
else if (COMPILEDP (array))
- size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK;
+ size = ASIZE (array) & PSEUDOVECTOR_SIZE_MASK;
else
wrong_type_argument (Qarrayp, array);
if (idxval < 0 || idxval >= size)
args_out_of_range (array, idx);
- return XVECTOR (array)->contents[idxval];
+ return AREF (array, idxval);
}
}
@@ -2120,7 +2121,7 @@ bool-vector. IDX starts at 0. */)
if (VECTORP (array))
{
- if (idxval < 0 || idxval >= XVECTOR (array)->size)
+ if (idxval < 0 || idxval >= ASIZE (array))
args_out_of_range (array, idx);
XVECTOR (array)->contents[idxval] = newelt;
}
@@ -2144,61 +2145,62 @@ bool-vector. IDX starts at 0. */)
CHECK_CHARACTER (idx);
CHAR_TABLE_SET (array, idxval, newelt);
}
- else if (STRING_MULTIBYTE (array))
+ else
{
- EMACS_INT idxval_byte, prev_bytes, new_bytes, nbytes;
- unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
+ int c;
if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
CHECK_CHARACTER (newelt);
+ c = XFASTINT (newelt);
- nbytes = SBYTES (array);
-
- idxval_byte = string_char_to_byte (array, idxval);
- p1 = SDATA (array) + idxval_byte;
- prev_bytes = BYTES_BY_CHAR_HEAD (*p1);
- new_bytes = CHAR_STRING (XINT (newelt), p0);
- if (prev_bytes != new_bytes)
+ if (STRING_MULTIBYTE (array))
{
- /* We must relocate the string data. */
- EMACS_INT nchars = SCHARS (array);
- unsigned char *str;
- USE_SAFE_ALLOCA;
-
- SAFE_ALLOCA (str, unsigned char *, nbytes);
- memcpy (str, SDATA (array), nbytes);
- allocate_string_data (XSTRING (array), nchars,
- nbytes + new_bytes - prev_bytes);
- memcpy (SDATA (array), str, idxval_byte);
+ EMACS_INT idxval_byte, prev_bytes, new_bytes, nbytes;
+ unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
+
+ nbytes = SBYTES (array);
+ idxval_byte = string_char_to_byte (array, idxval);
p1 = SDATA (array) + idxval_byte;
- memcpy (p1 + new_bytes, str + idxval_byte + prev_bytes,
- nbytes - (idxval_byte + prev_bytes));
- SAFE_FREE ();
- clear_string_char_byte_cache ();
+ prev_bytes = BYTES_BY_CHAR_HEAD (*p1);
+ new_bytes = CHAR_STRING (c, p0);
+ if (prev_bytes != new_bytes)
+ {
+ /* We must relocate the string data. */
+ EMACS_INT nchars = SCHARS (array);
+ unsigned char *str;
+ USE_SAFE_ALLOCA;
+
+ SAFE_ALLOCA (str, unsigned char *, nbytes);
+ memcpy (str, SDATA (array), nbytes);
+ allocate_string_data (XSTRING (array), nchars,
+ nbytes + new_bytes - prev_bytes);
+ memcpy (SDATA (array), str, idxval_byte);
+ p1 = SDATA (array) + idxval_byte;
+ memcpy (p1 + new_bytes, str + idxval_byte + prev_bytes,
+ nbytes - (idxval_byte + prev_bytes));
+ SAFE_FREE ();
+ clear_string_char_byte_cache ();
+ }
+ while (new_bytes--)
+ *p1++ = *p0++;
}
- while (new_bytes--)
- *p1++ = *p0++;
- }
- else
- {
- if (idxval < 0 || idxval >= SCHARS (array))
- args_out_of_range (array, idx);
- CHECK_NUMBER (newelt);
-
- if (XINT (newelt) >= 0 && ! SINGLE_BYTE_CHAR_P (XINT (newelt)))
+ else
{
- int i;
-
- for (i = SBYTES (array) - 1; i >= 0; i--)
- if (SREF (array, i) >= 0x80)
- args_out_of_range (array, newelt);
- /* ARRAY is an ASCII string. Convert it to a multibyte
- string, and try `aset' again. */
- STRING_SET_MULTIBYTE (array);
- return Faset (array, idx, newelt);
+ if (! SINGLE_BYTE_CHAR_P (c))
+ {
+ int i;
+
+ for (i = SBYTES (array) - 1; i >= 0; i--)
+ if (SREF (array, i) >= 0x80)
+ args_out_of_range (array, newelt);
+ /* ARRAY is an ASCII string. Convert it to a multibyte
+ string, and try `aset' again. */
+ STRING_SET_MULTIBYTE (array);
+ return Faset (array, idx, newelt);
+ }
+ SSET (array, idxval, c);
}
- SSET (array, idxval, XINT (newelt));
}
return newelt;
@@ -2323,33 +2325,110 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
return Qnil;
}
-/* Convert between long values and pairs of Lisp integers.
- Note that long_to_cons returns a single Lisp integer
- when the value fits in one. */
+/* Convert the cons-of-integers, integer, or float value C to an
+ unsigned value with maximum value MAX. Signal an error if C does not
+ have a valid format or is out of range. */
+uintmax_t
+cons_to_unsigned (Lisp_Object c, uintmax_t max)
+{
+ int valid = 0;
+ uintmax_t val IF_LINT (= 0);
+ if (INTEGERP (c))
+ {
+ valid = 0 <= XINT (c);
+ val = XINT (c);
+ }
+ else if (FLOATP (c))
+ {
+ double d = XFLOAT_DATA (c);
+ if (0 <= d
+ && d < (max == UINTMAX_MAX ? (double) UINTMAX_MAX + 1 : max + 1))
+ {
+ val = d;
+ valid = 1;
+ }
+ }
+ else if (CONSP (c) && NATNUMP (XCAR (c)))
+ {
+ uintmax_t top = XFASTINT (XCAR (c));
+ Lisp_Object rest = XCDR (c);
+ if (top <= UINTMAX_MAX >> 24 >> 16
+ && CONSP (rest)
+ && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24
+ && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16)
+ {
+ uintmax_t mid = XFASTINT (XCAR (rest));
+ val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest));
+ valid = 1;
+ }
+ else if (top <= UINTMAX_MAX >> 16)
+ {
+ if (CONSP (rest))
+ rest = XCAR (rest);
+ if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16)
+ {
+ val = top << 16 | XFASTINT (rest);
+ valid = 1;
+ }
+ }
+ }
-Lisp_Object
-long_to_cons (long unsigned int i)
-{
- unsigned long top = i >> 16;
- unsigned int bot = i & 0xFFFF;
- if (top == 0)
- return make_number (bot);
- if (top == (unsigned long)-1 >> 16)
- return Fcons (make_number (-1), make_number (bot));
- return Fcons (make_number (top), make_number (bot));
+ if (! (valid && val <= max))
+ error ("Not an in-range integer, float, or cons of integers");
+ return val;
}
-unsigned long
-cons_to_long (Lisp_Object c)
+/* Convert the cons-of-integers, integer, or float value C to a signed
+ value with extrema MIN and MAX. Signal an error if C does not have
+ a valid format or is out of range. */
+intmax_t
+cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
{
- Lisp_Object top, bot;
+ int valid = 0;
+ intmax_t val IF_LINT (= 0);
if (INTEGERP (c))
- return XINT (c);
- top = XCAR (c);
- bot = XCDR (c);
- if (CONSP (bot))
- bot = XCAR (bot);
- return ((XINT (top) << 16) | XINT (bot));
+ {
+ val = XINT (c);
+ valid = 1;
+ }
+ else if (FLOATP (c))
+ {
+ double d = XFLOAT_DATA (c);
+ if (min <= d
+ && d < (max == INTMAX_MAX ? (double) INTMAX_MAX + 1 : max + 1))
+ {
+ val = d;
+ valid = 1;
+ }
+ }
+ else if (CONSP (c) && INTEGERP (XCAR (c)))
+ {
+ intmax_t top = XINT (XCAR (c));
+ Lisp_Object rest = XCDR (c);
+ if (INTMAX_MIN >> 24 >> 16 <= top && top <= INTMAX_MAX >> 24 >> 16
+ && CONSP (rest)
+ && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24
+ && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16)
+ {
+ intmax_t mid = XFASTINT (XCAR (rest));
+ val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest));
+ valid = 1;
+ }
+ else if (INTMAX_MIN >> 16 <= top && top <= INTMAX_MAX >> 16)
+ {
+ if (CONSP (rest))
+ rest = XCAR (rest);
+ if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16)
+ {
+ val = top << 16 | XFASTINT (rest);
+ valid = 1;
+ }
+ }
+ }
+
+ if (! (valid && min <= val && val <= max))
+ error ("Not an in-range integer, float, or cons of integers");
+ return val;
}
DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
@@ -2370,35 +2449,10 @@ NUMBER may be an integer or a floating point number. */)
return build_string (pigbuf);
}
- if (sizeof (int) == sizeof (EMACS_INT))
- sprintf (buffer, "%d", (int) XINT (number));
- else if (sizeof (long) == sizeof (EMACS_INT))
- sprintf (buffer, "%ld", (long) XINT (number));
- else
- abort ();
+ sprintf (buffer, "%"pI"d", XINT (number));
return build_string (buffer);
}
-INLINE static int
-digit_to_number (int character, int base)
-{
- int digit;
-
- if (character >= '0' && character <= '9')
- digit = character - '0';
- else if (character >= 'a' && character <= 'z')
- digit = character - 'a' + 10;
- else if (character >= 'A' && character <= 'Z')
- digit = character - 'A' + 10;
- else
- return -1;
-
- if (digit >= base)
- return -1;
- else
- return digit;
-}
-
DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
doc: /* Parse STRING as a decimal number and return the number.
This parses both integers and floating point numbers.
@@ -2411,7 +2465,6 @@ If the base used is not 10, STRING is always parsed as integer. */)
{
register char *p;
register int b;
- int sign = 1;
Lisp_Object val;
CHECK_STRING (string);
@@ -2426,40 +2479,13 @@ If the base used is not 10, STRING is always parsed as integer. */)
xsignal1 (Qargs_out_of_range, base);
}
- /* Skip any whitespace at the front of the number. Some versions of
- atoi do this anyway, so we might as well make Emacs lisp consistent. */
p = SSDATA (string);
while (*p == ' ' || *p == '\t')
p++;
- if (*p == '-')
- {
- sign = -1;
- p++;
- }
- else if (*p == '+')
- p++;
-
- if (isfloat_string (p, 1) && b == 10)
- val = make_float (sign * atof (p));
- else
- {
- double v = 0;
-
- while (1)
- {
- int digit = digit_to_number (*p++, b);
- if (digit < 0)
- break;
- v = v * b + digit;
- }
-
- val = make_fixnum_or_float (sign * v);
- }
-
- return val;
+ val = string_to_number (p, b, 1);
+ return NILP (val) ? make_number (0) : val;
}
-
enum arithop
{
@@ -2474,16 +2500,20 @@ enum arithop
Amin
};
-static Lisp_Object float_arith_driver (double, size_t, enum arithop,
- size_t, Lisp_Object *);
+static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop,
+ ptrdiff_t, Lisp_Object *);
static Lisp_Object
-arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args)
+arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object val;
- register size_t argnum;
+ ptrdiff_t argnum;
register EMACS_INT accum = 0;
register EMACS_INT next;
+ int overflow = 0;
+ ptrdiff_t ok_args;
+ EMACS_INT ok_accum;
+
switch (SWITCH_ENUM_CAST (code))
{
case Alogior:
@@ -2504,25 +2534,48 @@ arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args)
for (argnum = 0; argnum < nargs; argnum++)
{
+ if (! overflow)
+ {
+ ok_args = argnum;
+ ok_accum = accum;
+ }
+
/* Using args[argnum] as argument to CHECK_NUMBER_... */
val = args[argnum];
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
if (FLOATP (val))
- return float_arith_driver ((double) accum, argnum, code,
+ return float_arith_driver (ok_accum, ok_args, code,
nargs, args);
args[argnum] = val;
next = XINT (args[argnum]);
switch (SWITCH_ENUM_CAST (code))
{
case Aadd:
+ if (INT_ADD_OVERFLOW (accum, next))
+ {
+ overflow = 1;
+ accum &= INTMASK;
+ }
accum += next;
break;
case Asub:
+ if (INT_SUBTRACT_OVERFLOW (accum, next))
+ {
+ overflow = 1;
+ accum &= INTMASK;
+ }
accum = argnum ? accum - next : nargs == 1 ? - next : next;
break;
case Amult:
- accum *= next;
+ if (INT_MULTIPLY_OVERFLOW (accum, next))
+ {
+ EMACS_UINT a = accum, b = next, ab = a * b;
+ overflow = 1;
+ accum = ab & INTMASK;
+ }
+ else
+ accum *= next;
break;
case Adiv:
if (!argnum)
@@ -2562,8 +2615,8 @@ arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args)
#define isnan(x) ((x) != (x))
static Lisp_Object
-float_arith_driver (double accum, register size_t argnum, enum arithop code,
- size_t nargs, register Lisp_Object *args)
+float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
+ ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object val;
double next;
@@ -2625,7 +2678,7 @@ float_arith_driver (double accum, register size_t argnum, enum arithop code,
DEFUN ("+", Fplus, Splus, 0, MANY, 0,
doc: /* Return sum of any number of arguments, which are numbers or markers.
usage: (+ &rest NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Aadd, nargs, args);
}
@@ -2635,7 +2688,7 @@ DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
With one arg, negates it. With more than one arg,
subtracts all but the first from the first.
usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Asub, nargs, args);
}
@@ -2643,7 +2696,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
doc: /* Return product of any number of arguments, which are numbers or markers.
usage: (* &rest NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Amult, nargs, args);
}
@@ -2652,9 +2705,9 @@ DEFUN ("/", Fquo, Squo, 2, MANY, 0,
doc: /* Return first argument divided by all the remaining arguments.
The arguments must be numbers or markers.
usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
- size_t argnum;
+ ptrdiff_t argnum;
for (argnum = 2; argnum < nargs; argnum++)
if (FLOATP (args[argnum]))
return float_arith_driver (0, 0, Adiv, nargs, args);
@@ -2680,8 +2733,7 @@ Both must be integers or markers. */)
#ifndef HAVE_FMOD
double
-fmod (f1, f2)
- double f1, f2;
+fmod (double f1, double f2)
{
double r = f1;
@@ -2736,7 +2788,7 @@ DEFUN ("max", Fmax, Smax, 1, MANY, 0,
doc: /* Return largest of all the arguments (which must be numbers or markers).
The value is always a number; markers are converted to numbers.
usage: (max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Amax, nargs, args);
}
@@ -2745,7 +2797,7 @@ DEFUN ("min", Fmin, Smin, 1, MANY, 0,
doc: /* Return smallest of all the arguments (which must be numbers or markers).
The value is always a number; markers are converted to numbers.
usage: (min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Amin, nargs, args);
}
@@ -2754,7 +2806,7 @@ DEFUN ("logand", Flogand, Slogand, 0, MANY, 0,
doc: /* Return bitwise-and of all the arguments.
Arguments may be integers, or markers converted to integers.
usage: (logand &rest INTS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Alogand, nargs, args);
}
@@ -2763,7 +2815,7 @@ DEFUN ("logior", Flogior, Slogior, 0, MANY, 0,
doc: /* Return bitwise-or of all the arguments.
Arguments may be integers, or markers converted to integers.
usage: (logior &rest INTS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Alogior, nargs, args);
}
@@ -2772,7 +2824,7 @@ DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
doc: /* Return bitwise-exclusive-or of all the arguments.
Arguments may be integers, or markers converted to integers.
usage: (logxor &rest INTS-OR-MARKERS) */)
- (size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
return arith_driver (Alogxor, nargs, args);
}
@@ -2813,11 +2865,11 @@ In this case, zeros are shifted in on the left. */)
if (XINT (count) >= BITS_PER_EMACS_INT)
XSETINT (val, 0);
else if (XINT (count) > 0)
- XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count));
+ XSETINT (val, XUINT (value) << XFASTINT (count));
else if (XINT (count) <= -BITS_PER_EMACS_INT)
XSETINT (val, 0);
else
- XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count));
+ XSETINT (val, XUINT (value) >> -XINT (count));
return val;
}
@@ -2877,74 +2929,75 @@ syms_of_data (void)
{
Lisp_Object error_tail, arith_tail;
- Qquote = intern_c_string ("quote");
- Qlambda = intern_c_string ("lambda");
- Qsubr = intern_c_string ("subr");
- Qerror_conditions = intern_c_string ("error-conditions");
- Qerror_message = intern_c_string ("error-message");
- Qtop_level = intern_c_string ("top-level");
-
- Qerror = intern_c_string ("error");
- Qquit = intern_c_string ("quit");
- Qwrong_type_argument = intern_c_string ("wrong-type-argument");
- Qargs_out_of_range = intern_c_string ("args-out-of-range");
- Qvoid_function = intern_c_string ("void-function");
- Qcyclic_function_indirection = intern_c_string ("cyclic-function-indirection");
- Qcyclic_variable_indirection = intern_c_string ("cyclic-variable-indirection");
- Qvoid_variable = intern_c_string ("void-variable");
- Qsetting_constant = intern_c_string ("setting-constant");
- Qinvalid_read_syntax = intern_c_string ("invalid-read-syntax");
-
- Qinvalid_function = intern_c_string ("invalid-function");
- Qwrong_number_of_arguments = intern_c_string ("wrong-number-of-arguments");
- Qno_catch = intern_c_string ("no-catch");
- Qend_of_file = intern_c_string ("end-of-file");
- Qarith_error = intern_c_string ("arith-error");
- Qbeginning_of_buffer = intern_c_string ("beginning-of-buffer");
- Qend_of_buffer = intern_c_string ("end-of-buffer");
- Qbuffer_read_only = intern_c_string ("buffer-read-only");
- Qtext_read_only = intern_c_string ("text-read-only");
- Qmark_inactive = intern_c_string ("mark-inactive");
-
- Qlistp = intern_c_string ("listp");
- Qconsp = intern_c_string ("consp");
- Qsymbolp = intern_c_string ("symbolp");
- Qkeywordp = intern_c_string ("keywordp");
- Qintegerp = intern_c_string ("integerp");
- Qnatnump = intern_c_string ("natnump");
- Qwholenump = intern_c_string ("wholenump");
- Qstringp = intern_c_string ("stringp");
- Qarrayp = intern_c_string ("arrayp");
- Qsequencep = intern_c_string ("sequencep");
- Qbufferp = intern_c_string ("bufferp");
- Qvectorp = intern_c_string ("vectorp");
- Qchar_or_string_p = intern_c_string ("char-or-string-p");
- Qmarkerp = intern_c_string ("markerp");
- Qbuffer_or_string_p = intern_c_string ("buffer-or-string-p");
- Qinteger_or_marker_p = intern_c_string ("integer-or-marker-p");
- Qboundp = intern_c_string ("boundp");
- Qfboundp = intern_c_string ("fboundp");
-
- Qfloatp = intern_c_string ("floatp");
- Qnumberp = intern_c_string ("numberp");
- Qnumber_or_marker_p = intern_c_string ("number-or-marker-p");
-
- Qchar_table_p = intern_c_string ("char-table-p");
- Qvector_or_char_table_p = intern_c_string ("vector-or-char-table-p");
-
- Qsubrp = intern_c_string ("subrp");
- Qunevalled = intern_c_string ("unevalled");
- Qmany = intern_c_string ("many");
-
- Qcdr = intern_c_string ("cdr");
-
- /* Handle automatic advice activation */
- Qad_advice_info = intern_c_string ("ad-advice-info");
- Qad_activate_internal = intern_c_string ("ad-activate-internal");
+ DEFSYM (Qquote, "quote");
+ DEFSYM (Qlambda, "lambda");
+ DEFSYM (Qsubr, "subr");
+ DEFSYM (Qerror_conditions, "error-conditions");
+ DEFSYM (Qerror_message, "error-message");
+ DEFSYM (Qtop_level, "top-level");
+
+ DEFSYM (Qerror, "error");
+ DEFSYM (Qquit, "quit");
+ DEFSYM (Qwrong_type_argument, "wrong-type-argument");
+ DEFSYM (Qargs_out_of_range, "args-out-of-range");
+ DEFSYM (Qvoid_function, "void-function");
+ DEFSYM (Qcyclic_function_indirection, "cyclic-function-indirection");
+ DEFSYM (Qcyclic_variable_indirection, "cyclic-variable-indirection");
+ DEFSYM (Qvoid_variable, "void-variable");
+ DEFSYM (Qsetting_constant, "setting-constant");
+ DEFSYM (Qinvalid_read_syntax, "invalid-read-syntax");
+
+ DEFSYM (Qinvalid_function, "invalid-function");
+ DEFSYM (Qwrong_number_of_arguments, "wrong-number-of-arguments");
+ DEFSYM (Qno_catch, "no-catch");
+ DEFSYM (Qend_of_file, "end-of-file");
+ DEFSYM (Qarith_error, "arith-error");
+ DEFSYM (Qbeginning_of_buffer, "beginning-of-buffer");
+ DEFSYM (Qend_of_buffer, "end-of-buffer");
+ DEFSYM (Qbuffer_read_only, "buffer-read-only");
+ DEFSYM (Qtext_read_only, "text-read-only");
+ DEFSYM (Qmark_inactive, "mark-inactive");
+
+ DEFSYM (Qlistp, "listp");
+ DEFSYM (Qconsp, "consp");
+ DEFSYM (Qsymbolp, "symbolp");
+ DEFSYM (Qkeywordp, "keywordp");
+ DEFSYM (Qintegerp, "integerp");
+ DEFSYM (Qnatnump, "natnump");
+ DEFSYM (Qwholenump, "wholenump");
+ DEFSYM (Qstringp, "stringp");
+ DEFSYM (Qarrayp, "arrayp");
+ DEFSYM (Qsequencep, "sequencep");
+ DEFSYM (Qbufferp, "bufferp");
+ DEFSYM (Qvectorp, "vectorp");
+ DEFSYM (Qchar_or_string_p, "char-or-string-p");
+ DEFSYM (Qmarkerp, "markerp");
+ DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
+ DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
+ DEFSYM (Qboundp, "boundp");
+ DEFSYM (Qfboundp, "fboundp");
+
+ DEFSYM (Qfloatp, "floatp");
+ DEFSYM (Qnumberp, "numberp");
+ DEFSYM (Qnumber_or_marker_p, "number-or-marker-p");
+
+ DEFSYM (Qchar_table_p, "char-table-p");
+ DEFSYM (Qvector_or_char_table_p, "vector-or-char-table-p");
+
+ DEFSYM (Qsubrp, "subrp");
+ DEFSYM (Qunevalled, "unevalled");
+ DEFSYM (Qmany, "many");
+
+ DEFSYM (Qcdr, "cdr");
+
+ /* Handle automatic advice activation. */
+ DEFSYM (Qad_advice_info, "ad-advice-info");
+ DEFSYM (Qad_activate_internal, "ad-activate-internal");
error_tail = pure_cons (Qerror, Qnil);
- /* ERROR is used as a signaler for random errors for which nothing else is right */
+ /* ERROR is used as a signaler for random errors for which nothing else is
+ right. */
Fput (Qerror, Qerror_conditions,
error_tail);
@@ -2981,8 +3034,7 @@ syms_of_data (void)
Fput (Qcyclic_variable_indirection, Qerror_message,
make_pure_c_string ("Symbol's chain of variable indirections contains a loop"));
- Qcircular_list = intern_c_string ("circular-list");
- staticpro (&Qcircular_list);
+ DEFSYM (Qcircular_list, "circular-list");
Fput (Qcircular_list, Qerror_conditions,
pure_cons (Qcircular_list, error_tail));
Fput (Qcircular_list, Qerror_message,
@@ -3049,11 +3101,11 @@ syms_of_data (void)
Fput (Qtext_read_only, Qerror_message,
make_pure_c_string ("Text is read-only"));
- Qrange_error = intern_c_string ("range-error");
- Qdomain_error = intern_c_string ("domain-error");
- Qsingularity_error = intern_c_string ("singularity-error");
- Qoverflow_error = intern_c_string ("overflow-error");
- Qunderflow_error = intern_c_string ("underflow-error");
+ DEFSYM (Qrange_error, "range-error");
+ DEFSYM (Qdomain_error, "domain-error");
+ DEFSYM (Qsingularity_error, "singularity-error");
+ DEFSYM (Qoverflow_error, "overflow-error");
+ DEFSYM (Qunderflow_error, "underflow-error");
Fput (Qdomain_error, Qerror_conditions,
pure_cons (Qdomain_error, arith_tail));
@@ -3080,93 +3132,29 @@ syms_of_data (void)
Fput (Qunderflow_error, Qerror_message,
make_pure_c_string ("Arithmetic underflow error"));
- staticpro (&Qrange_error);
- staticpro (&Qdomain_error);
- staticpro (&Qsingularity_error);
- staticpro (&Qoverflow_error);
- staticpro (&Qunderflow_error);
-
staticpro (&Qnil);
staticpro (&Qt);
- staticpro (&Qquote);
- staticpro (&Qlambda);
- staticpro (&Qsubr);
staticpro (&Qunbound);
- staticpro (&Qerror_conditions);
- staticpro (&Qerror_message);
- staticpro (&Qtop_level);
-
- staticpro (&Qerror);
- staticpro (&Qquit);
- staticpro (&Qwrong_type_argument);
- staticpro (&Qargs_out_of_range);
- staticpro (&Qvoid_function);
- staticpro (&Qcyclic_function_indirection);
- staticpro (&Qcyclic_variable_indirection);
- staticpro (&Qvoid_variable);
- staticpro (&Qsetting_constant);
- staticpro (&Qinvalid_read_syntax);
- staticpro (&Qwrong_number_of_arguments);
- staticpro (&Qinvalid_function);
- staticpro (&Qno_catch);
- staticpro (&Qend_of_file);
- staticpro (&Qarith_error);
- staticpro (&Qbeginning_of_buffer);
- staticpro (&Qend_of_buffer);
- staticpro (&Qbuffer_read_only);
- staticpro (&Qtext_read_only);
- staticpro (&Qmark_inactive);
-
- staticpro (&Qlistp);
- staticpro (&Qconsp);
- staticpro (&Qsymbolp);
- staticpro (&Qkeywordp);
- staticpro (&Qintegerp);
- staticpro (&Qnatnump);
- staticpro (&Qwholenump);
- staticpro (&Qstringp);
- staticpro (&Qarrayp);
- staticpro (&Qsequencep);
- staticpro (&Qbufferp);
- staticpro (&Qvectorp);
- staticpro (&Qchar_or_string_p);
- staticpro (&Qmarkerp);
- staticpro (&Qbuffer_or_string_p);
- staticpro (&Qinteger_or_marker_p);
- staticpro (&Qfloatp);
- staticpro (&Qnumberp);
- staticpro (&Qnumber_or_marker_p);
- staticpro (&Qchar_table_p);
- staticpro (&Qvector_or_char_table_p);
- staticpro (&Qsubrp);
- staticpro (&Qmany);
- staticpro (&Qunevalled);
-
- staticpro (&Qboundp);
- staticpro (&Qfboundp);
- staticpro (&Qcdr);
- staticpro (&Qad_advice_info);
- staticpro (&Qad_activate_internal);
/* Types that type-of returns. */
- Qinteger = intern_c_string ("integer");
- Qsymbol = intern_c_string ("symbol");
- Qstring = intern_c_string ("string");
- Qcons = intern_c_string ("cons");
- Qmarker = intern_c_string ("marker");
- Qoverlay = intern_c_string ("overlay");
- Qfloat = intern_c_string ("float");
- Qwindow_configuration = intern_c_string ("window-configuration");
- Qprocess = intern_c_string ("process");
- Qwindow = intern_c_string ("window");
- /* Qsubr = intern_c_string ("subr"); */
- Qcompiled_function = intern_c_string ("compiled-function");
- Qbuffer = intern_c_string ("buffer");
- Qframe = intern_c_string ("frame");
- Qvector = intern_c_string ("vector");
- Qchar_table = intern_c_string ("char-table");
- Qbool_vector = intern_c_string ("bool-vector");
- Qhash_table = intern_c_string ("hash-table");
+ DEFSYM (Qinteger, "integer");
+ DEFSYM (Qsymbol, "symbol");
+ DEFSYM (Qstring, "string");
+ DEFSYM (Qcons, "cons");
+ DEFSYM (Qmarker, "marker");
+ DEFSYM (Qoverlay, "overlay");
+ DEFSYM (Qfloat, "float");
+ DEFSYM (Qwindow_configuration, "window-configuration");
+ DEFSYM (Qprocess, "process");
+ DEFSYM (Qwindow, "window");
+ /* DEFSYM (Qsubr, "subr"); */
+ DEFSYM (Qcompiled_function, "compiled-function");
+ DEFSYM (Qbuffer, "buffer");
+ DEFSYM (Qframe, "frame");
+ DEFSYM (Qvector, "vector");
+ DEFSYM (Qchar_table, "char-table");
+ DEFSYM (Qbool_vector, "bool-vector");
+ DEFSYM (Qhash_table, "hash-table");
DEFSYM (Qfont_spec, "font-spec");
DEFSYM (Qfont_entity, "font-entity");
@@ -3174,25 +3162,6 @@ syms_of_data (void)
DEFSYM (Qinteractive_form, "interactive-form");
- staticpro (&Qinteger);
- staticpro (&Qsymbol);
- staticpro (&Qstring);
- staticpro (&Qcons);
- staticpro (&Qmarker);
- staticpro (&Qoverlay);
- staticpro (&Qfloat);
- staticpro (&Qwindow_configuration);
- staticpro (&Qprocess);
- staticpro (&Qwindow);
- /* staticpro (&Qsubr); */
- staticpro (&Qcompiled_function);
- staticpro (&Qbuffer);
- staticpro (&Qframe);
- staticpro (&Qvector);
- staticpro (&Qchar_table);
- staticpro (&Qbool_vector);
- staticpro (&Qhash_table);
-
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
defsubr (&Seq);
@@ -3301,6 +3270,10 @@ syms_of_data (void)
XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
}
+#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
+static void arith_error (int) NO_RETURN;
+#endif
+
static void
arith_error (int signo)
{
@@ -3322,8 +3295,4 @@ init_data (void)
return;
#endif /* CANNOT_DUMP */
signal (SIGFPE, arith_error);
-
-#ifdef uts
- signal (SIGEMT, arith_error);
-#endif /* uts */
}