#include <math.h>
-#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;
static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
Lisp_Object Qwindow;
static Lisp_Object Qfloat, Qwindow_configuration;
-Lisp_Object Qprocess;
+static Lisp_Object Qprocess;
static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
static Lisp_Object Qsubrp, Qmany, Qunevalled;
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)
{
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))
{
(Lisp_Object object)
{
if (SYMBOLP (object))
- XSETSYMBOL (object, indirect_variable (XSYMBOL (object)));
+ {
+ struct Lisp_Symbol *sym = indirect_variable (XSYMBOL (object));
+ XSETSYMBOL (object, sym);
+ }
return object;
}
This does not handle buffer-local variables; use
swap_in_symval_forwarding for that. */
-#define do_blv_forwarding(blv) \
- ((blv)->forwarded ? do_symval_forwarding (BLV_FWD (blv)) : BLV_VALUE (blv))
-
Lisp_Object
do_symval_forwarding (register union Lisp_Fwd *valcontents)
{
BUF non-zero means set the value in buffer BUF instead of the
current buffer. This only plays a role for per-buffer variables. */
-#define store_blv_forwarding(blv, newval, buf) \
- do { \
- if ((blv)->forwarded) \
- store_symval_forwarding (BLV_FWD (blv), (newval), (buf)); \
- else \
- SET_BLV_VALUE (blv, newval); \
- } while (0)
-
static void
store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newval, struct buffer *buf)
{
for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object buf;
+ Lisp_Object lbuf;
struct buffer *b;
- buf = Fcdr (XCAR (tail));
- if (!BUFFERP (buf)) continue;
- b = XBUFFER (buf);
+ lbuf = Fcdr (XCAR (tail));
+ if (!BUFFERP (lbuf)) continue;
+ b = XBUFFER (lbuf);
if (! PER_BUFFER_VALUE_P (b, idx))
PER_BUFFER_VALUE (b, offset) = newval;
/* Return the default value of SYMBOL, but don't check for voidness.
Return Qunbound if it is void. */
-Lisp_Object
+static Lisp_Object
default_value (Lisp_Object symbol)
{
struct Lisp_Symbol *sym;
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));
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,
{
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
- union Lisp_Val_Fwd valcontents;
- int forwarded;
+ union Lisp_Val_Fwd valcontents IF_LINT (= {0});
+ int forwarded IF_LINT (= 0);
CHECK_SYMBOL (variable);
sym = XSYMBOL (variable);
(register Lisp_Object variable)
{
register Lisp_Object tem;
- int forwarded;
- union Lisp_Val_Fwd valcontents;
+ int forwarded IF_LINT (= 0);
+ union Lisp_Val_Fwd valcontents IF_LINT (= {0});
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
#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'.
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'.
if (idxval < 0 || idxval >= size)
args_out_of_range (array, idx);
- return XVECTOR (array)->contents[idxval];
+ return AREF (array, idxval);
}
}
enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal };
-Lisp_Object
+static Lisp_Object
arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
{
double f1 = 0, f2 = 0;
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.
{
register char *p;
register int b;
- int sign = 1;
Lisp_Object val;
CHECK_STRING (string);
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;
}
-
\f
enum arithop
{
Amin
};
-static Lisp_Object float_arith_driver (double, int, enum arithop,
- int, Lisp_Object *);
-Lisp_Object
-arith_driver (enum arithop code, int nargs, register Lisp_Object *args)
+static Lisp_Object float_arith_driver (double, size_t, enum arithop,
+ size_t, Lisp_Object *);
+static Lisp_Object
+arith_driver (enum arithop code, size_t nargs, register Lisp_Object *args)
{
register Lisp_Object val;
- register int argnum;
+ register size_t argnum;
register EMACS_INT accum = 0;
register EMACS_INT next;
#define isnan(x) ((x) != (x))
static Lisp_Object
-float_arith_driver (double accum, register int argnum, enum arithop code, int nargs, register Lisp_Object *args)
+float_arith_driver (double accum, register size_t argnum, enum arithop code,
+ size_t nargs, register Lisp_Object *args)
{
register Lisp_Object val;
double next;
DEFUN ("+", Fplus, Splus, 0, MANY, 0,
doc: /* Return sum of any number of arguments, which are numbers or markers.
usage: (+ &rest NUMBERS-OR-MARKERS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return arith_driver (Aadd, nargs, args);
}
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) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return arith_driver (Asub, nargs, args);
}
DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
doc: /* Return product of any number of arguments, which are numbers or markers.
usage: (* &rest NUMBERS-OR-MARKERS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return arith_driver (Amult, nargs, args);
}
doc: /* Return first argument divided by all the remaining arguments.
The arguments must be numbers or markers.
usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
- int argnum;
+ size_t argnum;
for (argnum = 2; argnum < nargs; argnum++)
if (FLOATP (args[argnum]))
return float_arith_driver (0, 0, Adiv, nargs, args);
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) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return arith_driver (Amax, nargs, args);
}
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) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return arith_driver (Amin, nargs, args);
}
doc: /* Return bitwise-and of all the arguments.
Arguments may be integers, or markers converted to integers.
usage: (logand &rest INTS-OR-MARKERS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return arith_driver (Alogand, nargs, args);
}
doc: /* Return bitwise-or of all the arguments.
Arguments may be integers, or markers converted to integers.
usage: (logior &rest INTS-OR-MARKERS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return arith_driver (Alogior, nargs, args);
}
doc: /* Return bitwise-exclusive-or of all the arguments.
Arguments may be integers, or markers converted to integers.
usage: (logxor &rest INTS-OR-MARKERS) */)
- (int nargs, Lisp_Object *args)
+ (size_t nargs, Lisp_Object *args)
{
return arith_driver (Alogxor, nargs, args);
}
XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
}
-SIGTYPE
+#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
+static void arith_error (int) NO_RETURN;
+#endif
+
+static void
arith_error (int signo)
{
sigsetmask (SIGEMPTYMASK);
HCoop / bpt / emacs.git / blobdiff