a SUBR with more than 8 arguments, use max_args == MANY.
See the DEFUN macro in lisp.h) */
#define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \
- void (*PF_fn)() = (void (*)()) (fn); \
+ void (*PF_fn)(void) = (void (*)(void)) fn; \
Lisp_Object *PF_av = (av); \
switch (ac) \
{ \
- default: abort(); \
- case 0: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \
+ default:rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \
case 1: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 1); break; \
case 2: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 2); break; \
case 3: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 3); break; \
int max_specpdl_size;
/* Depth in Lisp evaluations and function calls. */
-int lisp_eval_depth;
+static int lisp_eval_depth;
/* Maximum allowed depth in Lisp evaluations and function calls. */
int max_lisp_eval_depth;
write_c_string (trailer, printcharfun);
}
-DEFINE_LRECORD_IMPLEMENTATION ("subr", subr,
- this_one_is_unmarkable, print_subr, 0, 0, 0, 0,
- Lisp_Subr);
+static const struct lrecord_description subr_description[] = {
+ { XD_DOC_STRING, offsetof(Lisp_Subr, doc) },
+ { XD_END }
+};
+
+DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr,
+ this_one_is_unmarkable, print_subr, 0, 0, 0,
+ subr_description,
+ Lisp_Subr);
\f
/************************************************************************/
/* Entering the debugger */
static Lisp_Object
define_function (Lisp_Object name, Lisp_Object defn)
{
- if (purify_flag)
- defn = Fpurecopy (defn);
Ffset (name, defn);
LOADHIST_ATTACH (name);
return name;
if (!NILP (args = XCDR (args)))
{
Lisp_Object doc = XCAR (args);
-#if 0 /* FSFmacs */
- /* #### We should probably do this but it might be dangerous */
- if (purify_flag)
- doc = Fpurecopy (doc);
Fput (sym, Qvariable_documentation, doc);
-#else
- pure_put (sym, Qvariable_documentation, doc);
-#endif
if (!NILP (args = XCDR (args)))
error ("too many arguments");
}
#ifdef I18N3
if (!NILP (Vfile_domain))
- pure_put (sym, Qvariable_domain, Vfile_domain);
+ Fput (sym, Qvariable_domain, Vfile_domain);
#endif
LOADHIST_ATTACH (sym);
if (!NILP (args = XCDR (args)))
{
Lisp_Object doc = XCAR (args);
-#if 0 /* FSFmacs */
- /* #### We should probably do this but it might be dangerous */
- if (purify_flag)
- doc = Fpurecopy (doc);
Fput (sym, Qvariable_documentation, doc);
-#else
- pure_put (sym, Qvariable_documentation, doc);
-#endif
if (!NILP (args = XCDR (args)))
error ("too many arguments");
}
#ifdef I18N3
if (!NILP (Vfile_domain))
- pure_put (sym, Qvariable_domain, Vfile_domain);
+ Fput (sym, Qvariable_domain, Vfile_domain);
#endif
LOADHIST_ATTACH (sym);
return
((INTP (documentation) && XINT (documentation) < 0) ||
- ((STRINGP (documentation)) &&
+ (STRINGP (documentation) &&
(string_byte (XSTRING (documentation), 0) == '*')) ||
/* If (STRING . INTEGER), a negative integer means a user variable. */
\f
/* Used in core lisp functions for efficiency */
-void
+Lisp_Object
signal_void_function_error (Lisp_Object function)
{
- Fsignal (Qvoid_function, list1 (function));
+ return Fsignal (Qvoid_function, list1 (function));
}
-static void
+Lisp_Object
signal_invalid_function_error (Lisp_Object function)
{
- Fsignal (Qinvalid_function, list1 (function));
+ return Fsignal (Qinvalid_function, list1 (function));
}
-static void
+Lisp_Object
signal_wrong_number_of_arguments_error (Lisp_Object function, int nargs)
{
- Fsignal (Qwrong_number_of_arguments, list2 (function, make_int (nargs)));
+ return Fsignal (Qwrong_number_of_arguments,
+ list2 (function, make_int (nargs)));
}
/* Used in list traversal macros for efficiency. */
-void
+DOESNT_RETURN
signal_malformed_list_error (Lisp_Object list)
{
- Fsignal (Qmalformed_list, list1 (list));
+ signal_error (Qmalformed_list, list1 (list));
}
-void
+DOESNT_RETURN
signal_malformed_property_list_error (Lisp_Object list)
{
- Fsignal (Qmalformed_property_list, list1 (list));
+ signal_error (Qmalformed_property_list, list1 (list));
}
-void
+DOESNT_RETURN
signal_circular_list_error (Lisp_Object list)
{
- Fsignal (Qcircular_list, list1 (list));
+ signal_error (Qcircular_list, list1 (list));
}
-void
+DOESNT_RETURN
signal_circular_property_list_error (Lisp_Object list)
{
- Fsignal (Qcircular_property_list, list1 (list));
+ signal_error (Qcircular_property_list, list1 (list));
}
\f
/************************************************************************/
{
Fsignal (Qwrong_type_argument,
Fcons (Qcommandp,
- ((EQ (cmd, final))
+ (EQ (cmd, final)
? list1 (cmd)
: list2 (cmd, final))));
return Qnil;
/* Attempt to avoid consing identical (string=) pure strings. */
file = Fsymbol_name (Fintern (file, Qnil));
}
-
- return Ffset (function,
- Fpurecopy (Fcons (Qautoload, list4 (file,
- docstring,
- interactive,
- type))));
+
+ return Ffset (function, Fcons (Qautoload, list4 (file,
+ docstring,
+ interactive,
+ type)));
}
Lisp_Object
if (max_args == UNEVALLED) /* Optimize for the common case */
{
backtrace.evalargs = 0;
- val = (((Lisp_Object (*) (Lisp_Object)) (subr_function (subr)))
+ val = (((Lisp_Object (*) (Lisp_Object)) subr_function (subr))
(original_args));
}
else if (nargs <= max_args)
backtrace.args = args;
backtrace.nargs = nargs;
- val = (((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
+ val = (((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr))
(nargs, args));
UNGCPRO;
else
{
wrong_number_of_arguments:
- signal_wrong_number_of_arguments_error (fun, nargs);
+ val = signal_wrong_number_of_arguments_error (fun, nargs);
}
}
else if (COMPILED_FUNCTIONP (fun))
else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */
{
invalid_function:
- signal_invalid_function_error (fun);
+ val = signal_invalid_function_error (fun);
}
lisp_eval_depth--;
int max_args = subr->max_args;
Lisp_Object spacious_args[SUBR_MAX_ARGS];
- if (fun_nargs < subr->min_args)
- goto wrong_number_of_arguments;
-
if (fun_nargs == max_args) /* Optimize for the common case */
{
funcall_subr:
FUNCALL_SUBR (val, subr, fun_args, max_args);
}
+ else if (fun_nargs < subr->min_args)
+ {
+ goto wrong_number_of_arguments;
+ }
else if (fun_nargs < max_args)
{
Lisp_Object *p = spacious_args;
}
else if (max_args == MANY)
{
- val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
- (fun_nargs, fun_args);
+ val = SUBR_FUNCTION (subr, MANY) (fun_nargs, fun_args);
}
else if (max_args == UNEVALLED) /* Can't funcall a special form */
{
else
{
wrong_number_of_arguments:
- signal_wrong_number_of_arguments_error (fun, fun_nargs);
+ val = signal_wrong_number_of_arguments_error (fun, fun_nargs);
}
}
else if (COMPILED_FUNCTIONP (fun))
}
else if (UNBOUNDP (fun))
{
- signal_void_function_error (args[0]);
+ val = signal_void_function_error (args[0]);
}
else
{
invalid_function:
- signal_invalid_function_error (fun);
+ val = signal_invalid_function_error (fun);
}
lisp_eval_depth--;
else
{
invalid_function:
- return Fsignal (Qinvalid_function, list1 (function));
+ return signal_invalid_function_error (function);
}
{
return unbind_to (speccount, Fprogn (body));
wrong_number_of_arguments:
- return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs)));
+ return signal_wrong_number_of_arguments_error (fun, nargs);
invalid_function:
- return Fsignal (Qinvalid_function, list1 (fun));
+ return signal_invalid_function_error (fun);
}
\f
}
else
{
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (sym, val);
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object globals = Qnil;
+ GCPRO3 (sym, val, globals);
for (;
CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION)
{
/* t indicates this hook has a local binding;
it means to run the global binding too. */
- Lisp_Object globals = Fdefault_value (sym);
+ globals = Fdefault_value (sym);
if ((! CONSP (globals) || EQ (XCAR (globals), Qlambda)) &&
! NILP (globals))
/* gc_currently_forbidden = 1; Currently no reason to do this; */
cons = noseeum_cons (buffer, form);
- opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+ opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
GCPRO2 (cons, opaque);
/* Qerror not Qt, so you can get a backtrace */
tem = condition_case_1 (Qerror,
catch_them_squirmers_eval_in_buffer, cons,
caught_a_squirmer, opaque);
free_cons (XCONS (cons));
- if (OPAQUEP (opaque))
+ if (OPAQUE_PTRP (opaque))
free_opaque_ptr (opaque);
UNGCPRO;
speccount = specpdl_depth();
specbind (Qinhibit_quit, Qt);
- opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+ opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
GCPRO1 (opaque);
/* Qerror not Qt, so you can get a backtrace */
tem = condition_case_1 (Qerror,
catch_them_squirmers_run_hook, hook_symbol,
caught_a_squirmer, opaque);
- if (OPAQUEP (opaque))
+ if (OPAQUE_PTRP (opaque))
free_opaque_ptr (opaque);
UNGCPRO;
specbind (Qinhibit_quit, Qt);
cons = noseeum_cons (hook_symbol,
- warning_string ? make_opaque_ptr (warning_string)
+ warning_string ? make_opaque_ptr ((void *)warning_string)
: Qnil);
GCPRO1 (cons);
/* Qerror not Qt, so you can get a backtrace */
allow_quit_safe_run_hook_caught_a_squirmer :
safe_run_hook_caught_a_squirmer,
cons);
- if (OPAQUEP (XCDR (cons)))
+ if (OPAQUE_PTRP (XCDR (cons)))
free_opaque_ptr (XCDR (cons));
free_cons (XCONS (cons));
UNGCPRO;
specbind (Qinhibit_quit, Qt);
/* gc_currently_forbidden = 1; Currently no reason to do this; */
- opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+ opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
/* Qerror not Qt, so you can get a backtrace */
tem = condition_case_1 (Qerror,
catch_them_squirmers_call0, function,
caught_a_squirmer, opaque);
- if (OPAQUEP (opaque))
+ if (OPAQUE_PTRP (opaque))
free_opaque_ptr (opaque);
UNGCPRO;
/* gc_currently_forbidden = 1; Currently no reason to do this; */
cons = noseeum_cons (function, object);
- opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+ opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
/* Qerror not Qt, so you can get a backtrace */
tem = condition_case_1 (Qerror,
catch_them_squirmers_call1, cons,
caught_a_squirmer, opaque);
- if (OPAQUEP (opaque))
+ if (OPAQUE_PTRP (opaque))
free_opaque_ptr (opaque);
free_cons (XCONS (cons));
UNGCPRO;
/* gc_currently_forbidden = 1; Currently no reason to do this; */
cons = list3 (function, object1, object2);
- opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+ opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
/* Qerror not Qt, so you can get a backtrace */
tem = condition_case_1 (Qerror,
catch_them_squirmers_call2, cons,
caught_a_squirmer, opaque);
- if (OPAQUEP (opaque))
+ if (OPAQUE_PTRP (opaque))
free_opaque_ptr (opaque);
free_list (cons);
UNGCPRO;
DEFUN ("backtrace", Fbacktrace, 0, 2, "", /*
Print a trace of Lisp function calls currently active.
-Option arg STREAM specifies the output stream to send the backtrace to,
+Optional arg STREAM specifies the output stream to send the backtrace to,
and defaults to the value of `standard-output'. Optional second arg
DETAILED means show places where currently active variable bindings,
catches, condition-cases, and unwind-protects were made as well as
if (!NILP (detailed) && catches && catches->backlist == backlist)
{
int catchpdl = catches->pdlcount;
- if (specpdl[catchpdl].func == condition_case_unwind
- && speccount > catchpdl)
+ if (speccount > catchpdl
+ && specpdl[catchpdl].func == condition_case_unwind)
/* This is a condition-case catchpoint */
catchpdl = catchpdl + 1;
}
void
+reinit_vars_of_eval (void)
+{
+ preparing_for_armageddon = 0;
+ in_warnings = 0;
+ Qunbound_suspended_errors_tag = make_opaque_ptr (&Qunbound_suspended_errors_tag);
+ staticpro_nodump (&Qunbound_suspended_errors_tag);
+
+ specpdl_size = 50;
+ specpdl = xnew_array (struct specbinding, specpdl_size);
+ /* XEmacs change: increase these values. */
+ max_specpdl_size = 3000;
+ max_lisp_eval_depth = 500;
+#if 0 /* no longer used */
+ throw_level = 0;
+#endif
+}
+
+void
vars_of_eval (void)
{
+ reinit_vars_of_eval ();
+
DEFVAR_INT ("max-specpdl-size", &max_specpdl_size /*
Limit on number of Lisp variable bindings & unwind-protects before error.
*/ );
*/ );
Vdebugger = Qnil;
- preparing_for_armageddon = 0;
-
staticpro (&Vpending_warnings);
Vpending_warnings = Qnil;
- Vpending_warnings_tail = Qnil; /* no need to protect this */
-
- in_warnings = 0;
+ pdump_wire (&Vpending_warnings_tail);
+ Vpending_warnings_tail = Qnil;
staticpro (&Vautoload_queue);
Vautoload_queue = Qnil;
staticpro (&Vcurrent_error_state);
Vcurrent_error_state = Qnil; /* errors as normal */
- Qunbound_suspended_errors_tag = make_opaque_long (0);
- staticpro (&Qunbound_suspended_errors_tag);
-
- specpdl_size = 50;
- specpdl_depth_counter = 0;
- specpdl = xnew_array (struct specbinding, specpdl_size);
- /* XEmacs change: increase these values. */
- max_specpdl_size = 3000;
- max_lisp_eval_depth = 500;
-#if 0 /* no longer used */
- throw_level = 0;
-#endif
-
reinit_eval ();
}