#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)
{
\f
/* Extract and set components of lists */
-DEFUE ("car", Fcar, Scar, 1, 1, 0,
+DEFUN ("car", Fcar, Scar, 1, 1, 0,
doc: /* Return the car of LIST. If arg is nil, return nil.
Error if arg is not nil and not a cons cell. See also `car-safe'.
return CAR (list);
}
-DEFUE ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
+DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
doc: /* Return the car of OBJECT if it is a cons cell, or else nil. */)
(Lisp_Object object)
{
return CAR_SAFE (object);
}
-DEFUE ("cdr", Fcdr, Scdr, 1, 1, 0,
+DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
doc: /* Return the cdr of LIST. If arg is nil, return nil.
Error if arg is not nil and not a cons cell. See also `cdr-safe'.
return CDR (list);
}
-DEFUE ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
+DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
doc: /* Return the cdr of OBJECT if it is a cons cell, or else nil. */)
(Lisp_Object object)
{
return CDR_SAFE (object);
}
-DEFUE ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
+DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
doc: /* Set the car of CELL to be NEWCAR. Returns NEWCAR. */)
(register Lisp_Object cell, Lisp_Object newcar)
{
return newcar;
}
-DEFUE ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
+DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
doc: /* Set the cdr of CELL to be NEWCDR. Returns NEWCDR. */)
(register Lisp_Object cell, Lisp_Object newcdr)
{
\f
/* Extract and set components of symbols */
-DEFUE ("boundp", Fboundp, Sboundp, 1, 1, 0,
+DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
doc: /* Return t if SYMBOL's value is not void. */)
(register Lisp_Object symbol)
{
return (EQ (valcontents, Qunbound) ? Qnil : Qt);
}
-DEFUE ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
+DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
doc: /* Return t if SYMBOL's function definition is not void. */)
(register Lisp_Object symbol)
{
return symbol;
}
-DEFUE ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
+DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
doc: /* Return SYMBOL's function definition. Error if that is void. */)
(register Lisp_Object symbol)
{
return XSYMBOL (symbol)->plist;
}
-DEFUE ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
+DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
doc: /* Return SYMBOL's name, a string. */)
(register Lisp_Object symbol)
{
return name;
}
-DEFUE ("fset", Ffset, Sfset, 2, 2, 0,
+DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. */)
(register Lisp_Object symbol, Lisp_Object definition)
{
return make_string (name, strlen (name));
}
-DEFUE ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
+DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
doc: /* Return the interactive form of CMD or nil if none.
If CMD is not a command, the return value is nil.
Value, if non-nil, is a list \(interactive SPEC). */)
}
}
-DEFUE ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
+DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
doc: /* Return SYMBOL's value. Error if that is void. */)
(Lisp_Object symbol)
{
xsignal1 (Qvoid_variable, symbol);
}
-DEFUE ("set", Fset, Sset, 2, 2, 0,
+DEFUN ("set", Fset, Sset, 2, 2, 0,
doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL. */)
(register Lisp_Object symbol, Lisp_Object newval)
{
}
}
-DEFUE ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
+DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
doc: /* Return t if SYMBOL has a non-void default value.
This is the value that is seen in buffers that do not have their own values
for this variable. */)
return (EQ (value, Qunbound) ? Qnil : Qt);
}
-DEFUE ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0,
+DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0,
doc: /* Return SYMBOL's default value.
This is the value that is seen in buffers that do not have their own values
for this variable. The default value is meaningful for variables with
xsignal1 (Qvoid_variable, symbol);
}
-DEFUE ("set-default", Fset_default, Sset_default, 2, 2, 0,
+DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
doc: /* Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated.
The default value is seen in buffers that do not have their own values
for this variable. */)
return blv;
}
-DEFUE ("make-variable-buffer-local", Fmake_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,
return variable;
}
-DEFUE ("make-local-variable", Fmake_local_variable, Smake_local_variable,
+DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
1, 1, "vMake Local Variable: ",
doc: /* Make VARIABLE have a separate value in the current buffer.
Other buffers will continue to share a common default value.
return variable;
}
-DEFUE ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
+DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
1, 2, 0,
doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER.
BUFFER defaults to the current buffer. */)
#if 0
extern struct terminal *get_terminal (Lisp_Object display, int);
-DEFUE ("terminal-local-value", Fterminal_local_value,
+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
return result;
}
-DEFUE ("set-terminal-local-value", Fset_terminal_local_value,
+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
return hare;
}
-DEFUE ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
+DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
doc: /* Return the function at the end of OBJECT's function chain.
If OBJECT is not a symbol, just return it. Otherwise, follow all
function indirections to find the final function binding and return it.
\f
/* Extract and set vector and string elements */
-DEFUE ("aref", Faref, Saref, 2, 2, 0,
+DEFUN ("aref", Faref, Saref, 2, 2, 0,
doc: /* Return the element of ARRAY at index IDX.
ARRAY may be a vector, a string, a char-table, a bool-vector,
or a byte-code object. IDX starts at 0. */)
}
}
-DEFUE ("aset", Faset, Saset, 3, 3, 0,
+DEFUN ("aset", Faset, Saset, 3, 3, 0,
doc: /* Store into the element of ARRAY at index IDX the value NEWELT.
Return NEWELT. ARRAY may be a vector, a string, a char-table or a
bool-vector. IDX starts at 0. */)
return arithcompare (num1, num2, equal);
}
-DEFUE ("<", Flss, Slss, 2, 2, 0,
+DEFUN ("<", Flss, Slss, 2, 2, 0,
doc: /* Return t if first arg is less than second arg. Both must be numbers or markers. */)
(register Lisp_Object num1, Lisp_Object num2)
{
return arithcompare (num1, num2, less);
}
-DEFUE (">", Fgtr, Sgtr, 2, 2, 0,
+DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
doc: /* Return t if first arg is greater than second arg. Both must be numbers or markers. */)
(register Lisp_Object num1, Lisp_Object num2)
{
return arithcompare (num1, num2, grtr);
}
-DEFUE ("<=", Fleq, Sleq, 2, 2, 0,
+DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
doc: /* Return t if first arg is less than or equal to second arg.
Both must be numbers or markers. */)
(register Lisp_Object num1, Lisp_Object num2)
return arithcompare (num1, num2, less_or_equal);
}
-DEFUE (">=", Fgeq, Sgeq, 2, 2, 0,
+DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
doc: /* Return t if first arg is greater than or equal to second arg.
Both must be numbers or markers. */)
(register Lisp_Object num1, Lisp_Object num2)
return arithcompare (num1, num2, notequal);
}
-DEFUE ("zerop", Fzerop, Szerop, 1, 1, 0,
+DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
doc: /* Return t if NUMBER is zero. */)
(register Lisp_Object number)
{
return ((XINT (top) << 16) | XINT (bot));
}
\f
-DEFUE ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
+DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
doc: /* Return the decimal representation of NUMBER as a string.
Uses a minus sign if negative.
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;
-}
-
-DEFUE ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
+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.
It ignores leading spaces and tabs, and all trailing chars.
{
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
{
}
-DEFUE ("+", Fplus, Splus, 0, MANY, 0,
+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)
return arith_driver (Aadd, nargs, args);
}
-DEFUE ("-", Fminus, Sminus, 0, MANY, 0,
+DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
doc: /* Negate number or subtract numbers or markers and return the result.
With one arg, negates it. With more than one arg,
subtracts all but the first from the first.
return arith_driver (Asub, nargs, args);
}
-DEFUE ("*", Ftimes, Stimes, 0, MANY, 0,
+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)
return arith_driver (Amult, nargs, args);
}
-DEFUE ("/", Fquo, Squo, 2, MANY, 0,
+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) */)
return arith_driver (Adiv, nargs, args);
}
-DEFUE ("%", Frem, Srem, 2, 2, 0,
+DEFUN ("%", Frem, Srem, 2, 2, 0,
doc: /* Return remainder of X divided by Y.
Both must be integers or markers. */)
(register Lisp_Object x, Lisp_Object y)
return val;
}
-DEFUE ("max", Fmax, Smax, 1, MANY, 0,
+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) */)
return arith_driver (Amax, nargs, args);
}
-DEFUE ("min", Fmin, Smin, 1, MANY, 0,
+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) */)
return val;
}
-DEFUE ("1+", Fadd1, Sadd1, 1, 1, 0,
+DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
doc: /* Return NUMBER plus one. NUMBER may be a number or a marker.
Markers are converted to integers. */)
(register Lisp_Object number)
return number;
}
-DEFUE ("1-", Fsub1, Ssub1, 1, 1, 0,
+DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
doc: /* Return NUMBER minus one. NUMBER may be a number or a marker.
Markers are converted to integers. */)
(register Lisp_Object number)
return number;
}
-DEFUE ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
+DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
doc: /* Return the byteorder for the machine.
Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII
lowercase l) for small endian machines. */)
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)
{
HCoop / bpt / emacs.git / blobdiff