#include "keymap.h"
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
+Lisp_Object Qnil_, Qt_;
static Lisp_Object Qsubr;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
xsignal2 (Qwrong_type_argument, predicate, value);
}
-void
-pure_write_error (Lisp_Object obj)
-{
- xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj);
-}
-
void
args_out_of_range (Lisp_Object a1, Lisp_Object a2)
{
for example, (type-of 1) returns `integer'. */)
(Lisp_Object object)
{
- switch (XTYPE (object))
+ if (INTEGERP (object))
+ return Qinteger;
+ else if (SYMBOLP (object))
+ return Qsymbol;
+ else if (STRINGP (object))
+ return Qstring;
+ else if (CONSP (object))
+ return Qcons;
+ else if (MISCP (object))
{
- case_Lisp_Int:
- return Qinteger;
-
- case Lisp_Symbol:
- return Qsymbol;
-
- case Lisp_String:
- return Qstring;
-
- case Lisp_Cons:
- return Qcons;
-
- case Lisp_Misc:
switch (XMISCTYPE (object))
{
case Lisp_Misc_Marker:
return Qfloat;
}
emacs_abort ();
-
- case Lisp_Vectorlike:
+ }
+ else if (VECTORLIKEP (object))
+ {
if (WINDOW_CONFIGURATIONP (object))
return Qwindow_configuration;
if (PROCESSP (object))
if (FONT_OBJECT_P (object))
return Qfont_object;
return Qvector;
-
- case Lisp_Float:
- return Qfloat;
-
- default:
- emacs_abort ();
}
+ else if (FLOATP (object))
+ return Qfloat;
+ else
+ return Qt;
}
DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
return Qnil;
}
+static bool
+SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
+{
+ /* Should be initial_obarray */
+ Lisp_Object tem = Ffind_symbol (SYMBOL_NAME (sym), Vobarray);
+ return (! NILP (scm_c_value_ref (tem, 1))
+ && (EQ (sym, scm_c_value_ref (tem, 0))));
+}
+
/* Define this in C to avoid unnecessarily consing up the symbol
name. */
DEFUN ("keywordp", Fkeywordp, Skeywordp, 1, 1, 0,
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
+ return NILP (SYMBOL_FUNCTION (symbol)) ? Qnil : Qt;
}
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return XSYMBOL (symbol)->function;
+ return SYMBOL_FUNCTION (symbol);
}
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return XSYMBOL (symbol)->plist;
+ return symbol_plist (symbol);
}
DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
register Lisp_Object function;
CHECK_SYMBOL (symbol);
- function = XSYMBOL (symbol)->function;
+ function = SYMBOL_FUNCTION (symbol);
if (!NILP (Vautoload_queue) && !NILP (function))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function));
+ /* Convert to eassert or remove after GC bug is found. In the
+ meantime, check unconditionally, at a slight perf hit. */
+ if (valid_lisp_object_p (definition) < 1)
+ emacs_abort ();
+
set_symbol_function (symbol, definition);
return definition;
The optional third argument DOCSTRING specifies the documentation string
for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
determined by DEFINITION.
+
+Internally, this normally uses `fset', but if SYMBOL has a
+`defalias-fset-function' property, the associated value is used instead.
+
The return value is undefined. */)
(register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
{
{ /* Only add autoload entries after dumping, because the ones before are
not useful and else we get loads of them from the loaddefs.el. */
- if (AUTOLOADP (XSYMBOL (symbol)->function))
+ if (AUTOLOADP (SYMBOL_FUNCTION (symbol)))
/* Remember that the function was already an autoload. */
LOADHIST_ATTACH (Fcons (Qt, symbol));
LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
{
if (!SYMBOLP (hare) || NILP (hare))
break;
- hare = XSYMBOL (hare)->function;
+ hare = SYMBOL_FUNCTION (hare);
if (!SYMBOLP (hare) || NILP (hare))
break;
- hare = XSYMBOL (hare)->function;
+ hare = SYMBOL_FUNCTION (hare);
- tortoise = XSYMBOL (tortoise)->function;
+ tortoise = SYMBOL_FUNCTION (tortoise);
if (EQ (hare, tortoise))
xsignal1 (Qcyclic_function_indirection, object);
/* Optimize for no indirection. */
result = object;
if (SYMBOLP (result) && !NILP (result)
- && (result = XSYMBOL (result)->function, SYMBOLP (result)))
+ && (result = SYMBOL_FUNCTION (result), SYMBOLP (result)))
result = indirect_function (result);
if (!NILP (result))
return result;
arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
enum Arith_Comparison comparison)
{
- for (ptrdiff_t argnum = 1; argnum < nargs; ++argnum)
+ ptrdiff_t argnum;
+ for (argnum = 1; argnum < nargs; ++argnum)
{
- if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison)))
+ if (EQ (Qnil, arithcompare (args[argnum - 1], args[argnum], comparison)))
return Qnil;
}
return Qt;
}
DEFUN ("<", Flss, Slss, 1, MANY, 0,
- doc: /* Return t if each arg is less than the next arg. All must be numbers or markers.
+ doc: /* Return t if each arg (a number or marker), is less than the next arg.
usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
}
DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
- doc: /* Return t if each arg is greater than the next arg. All must be numbers or markers.
+ doc: /* Return t if each arg (a number or marker) is greater than the next arg.
usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
}
DEFUN ("<=", Fleq, Sleq, 1, MANY, 0,
- doc: /* Return t if each arg is less than or equal to the next arg.
-All must be numbers or markers.
+ doc: /* Return t if each arg (a number or marker) is less than or equal to the next.
usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
}
DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
- doc: /* Return t if each arg is greater than or equal to the next arg.
-All must be numbers or markers.
-usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
+ doc: /* Return t if each arg (a number or marker) is greater than or equal to the next.
+usage: (>= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL);
{
return arithcompare (num1, num2, ARITH_NOTEQUAL);
}
-
-DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
- doc: /* Return t if NUMBER is zero. */)
- (register Lisp_Object number)
-{
- CHECK_NUMBER_OR_FLOAT (number);
-
- if (FLOATP (number))
- {
- if (XFLOAT_DATA (number) == 0.0)
- return Qt;
- return Qnil;
- }
-
- if (!XINT (number))
- return Qt;
- return Qnil;
-}
\f
/* 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
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.
+Ignore leading spaces and tabs, and all trailing chars. Return 0 if
+STRING cannot be parsed as an integer or floating point number.
If BASE, interpret STRING as a number in that base. If BASE isn't
present, base 10 is used. BASE must be between 2 and 16 (inclusive).
-If the base used is not 10, STRING is always parsed as integer. */)
+If the base used is not 10, STRING is always parsed as an integer. */)
(register Lisp_Object string, Lisp_Object base)
{
register char *p;
if (XINT (count) >= BITS_PER_EMACS_INT)
XSETINT (val, 0);
else if (XINT (count) > 0)
- XSETINT (val, XINT (value) << XFASTINT (count));
+ XSETINT (val, XUINT (value) << XFASTINT (count));
else if (XINT (count) <= -BITS_PER_EMACS_INT)
XSETINT (val, XINT (value) < 0 ? -1 : 0);
else
/* Info about unsigned long long, falling back on unsigned long
if unsigned long long is not available. */
-#if HAVE_UNSIGNED_LONG_LONG_INT
+#if HAVE_UNSIGNED_LONG_LONG_INT && defined ULLONG_MAX
enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long long) };
+# define ULL_MAX ULLONG_MAX
#else
enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long) };
-# define ULLONG_MAX ULONG_MAX
+# define ULL_MAX ULONG_MAX
# define count_one_bits_ll count_one_bits_l
+# define count_trailing_zeros_ll count_trailing_zeros_l
#endif
/* Shift VAL right by the width of an unsigned long long.
{
int i = 0, count = 0;
while (count += count_one_bits_ll (w),
- BITS_PER_BITS_WORD <= (i += BITS_PER_ULL))
+ (i += BITS_PER_ULL) < BITS_PER_BITS_WORD)
w = shift_right_ull (w);
return count;
}
return count_trailing_zeros (val);
if (BITS_WORD_MAX == ULONG_MAX)
return count_trailing_zeros_l (val);
- if (BITS_WORD_MAX == ULLONG_MAX)
+ if (BITS_WORD_MAX == ULL_MAX)
return count_trailing_zeros_ll (val);
/* The rest of this code is for the unlikely platform where bits_word differs
count < BITS_PER_BITS_WORD - BITS_PER_ULL;
count += BITS_PER_ULL)
{
- if (val & ULLONG_MAX)
+ if (val & ULL_MAX)
return count + count_trailing_zeros_ll (val);
val = shift_right_ull (val);
}
{
Lisp_Object error_tail, arith_tail;
+#include "data.x"
+
DEFSYM (Qquote, "quote");
DEFSYM (Qlambda, "lambda");
DEFSYM (Qsubr, "subr");
DEFSYM (Qinteractive_form, "interactive-form");
DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
- defsubr (&Sindirect_variable);
- defsubr (&Sinteractive_form);
- defsubr (&Seq);
- defsubr (&Snull);
- defsubr (&Stype_of);
- defsubr (&Slistp);
- defsubr (&Snlistp);
- defsubr (&Sconsp);
- defsubr (&Satom);
- defsubr (&Sintegerp);
- defsubr (&Sinteger_or_marker_p);
- defsubr (&Snumberp);
- defsubr (&Snumber_or_marker_p);
- defsubr (&Sfloatp);
- defsubr (&Snatnump);
- defsubr (&Ssymbolp);
- defsubr (&Skeywordp);
- defsubr (&Sstringp);
- defsubr (&Smultibyte_string_p);
- defsubr (&Svectorp);
- defsubr (&Schar_table_p);
- defsubr (&Svector_or_char_table_p);
- defsubr (&Sbool_vector_p);
- defsubr (&Sarrayp);
- defsubr (&Ssequencep);
- defsubr (&Sbufferp);
- defsubr (&Smarkerp);
- defsubr (&Ssubrp);
- defsubr (&Sbyte_code_function_p);
- defsubr (&Schar_or_string_p);
- defsubr (&Scar);
- defsubr (&Scdr);
- defsubr (&Scar_safe);
- defsubr (&Scdr_safe);
- defsubr (&Ssetcar);
- defsubr (&Ssetcdr);
- defsubr (&Ssymbol_function);
- defsubr (&Sindirect_function);
- defsubr (&Ssymbol_plist);
- defsubr (&Ssymbol_name);
- defsubr (&Smakunbound);
- defsubr (&Sfmakunbound);
- defsubr (&Sboundp);
- defsubr (&Sfboundp);
- defsubr (&Sfset);
- defsubr (&Sdefalias);
- defsubr (&Ssetplist);
- defsubr (&Ssymbol_value);
- defsubr (&Sset);
- defsubr (&Sdefault_boundp);
- defsubr (&Sdefault_value);
- defsubr (&Sset_default);
- defsubr (&Ssetq_default);
- defsubr (&Smake_variable_buffer_local);
- defsubr (&Smake_local_variable);
- defsubr (&Skill_local_variable);
- defsubr (&Smake_variable_frame_local);
- defsubr (&Slocal_variable_p);
- defsubr (&Slocal_variable_if_set_p);
- defsubr (&Svariable_binding_locus);
-#if 0 /* XXX Remove this. --lorentey */
- defsubr (&Sterminal_local_value);
- defsubr (&Sset_terminal_local_value);
-#endif
- defsubr (&Saref);
- defsubr (&Saset);
- defsubr (&Snumber_to_string);
- defsubr (&Sstring_to_number);
- defsubr (&Seqlsign);
- defsubr (&Slss);
- defsubr (&Sgtr);
- defsubr (&Sleq);
- defsubr (&Sgeq);
- defsubr (&Sneq);
- defsubr (&Szerop);
- defsubr (&Splus);
- defsubr (&Sminus);
- defsubr (&Stimes);
- defsubr (&Squo);
- defsubr (&Srem);
- defsubr (&Smod);
- defsubr (&Smax);
- defsubr (&Smin);
- defsubr (&Slogand);
- defsubr (&Slogior);
- defsubr (&Slogxor);
- defsubr (&Slsh);
- defsubr (&Sash);
- defsubr (&Sadd1);
- defsubr (&Ssub1);
- defsubr (&Slognot);
- defsubr (&Sbyteorder);
- defsubr (&Ssubr_arity);
- defsubr (&Ssubr_name);
-
- defsubr (&Sbool_vector_exclusive_or);
- defsubr (&Sbool_vector_union);
- defsubr (&Sbool_vector_intersection);
- defsubr (&Sbool_vector_set_difference);
- defsubr (&Sbool_vector_not);
- defsubr (&Sbool_vector_subsetp);
- defsubr (&Sbool_vector_count_consecutive);
- defsubr (&Sbool_vector_count_population);
-
- set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function);
+ set_symbol_function (Qwholenump, SYMBOL_FUNCTION (Qnatnump));
DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
doc: /* The largest value that is representable in a Lisp integer. */);
HCoop / bpt / emacs.git / blobdiff