From: BT Templeton Date: Thu, 3 Oct 2013 23:14:58 +0000 (-0400) Subject: guile-elisp bootstrap part (C) X-Git-Url: https://git.hcoop.net/bpt/emacs.git/commitdiff_plain/b06bf4dc3ceea6aa39aae5ed64c2b9345eb1920f guile-elisp bootstrap part (C) * src/data.c (Finteractive_form): Switch order of COMPILEDP and scm_procedure_p tests. * src/doc.c (Fdocumentation): Switch order of COMPILEDP and scm_procedure_p tests. * src/eval.c (init_eval_once): Make smobs applicable. (eval_sub_1): Wrap eval_fn, plus a quit. (Ffuncall1): Make static. (apply_lambda): Don't eval_sub args. Don't set backtrace. --- diff --git a/src/data.c b/src/data.c index 7991275cd7..9fb276cc89 100644 --- a/src/data.c +++ b/src/data.c @@ -801,18 +801,18 @@ Value, if non-nil, is a list \(interactive SPEC). */) fun = Fsymbol_function (fun); } - if (scm_is_true (scm_procedure_p (fun))) + if (COMPILEDP (fun)) + { + if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) + return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); + } + else if (scm_is_true (scm_procedure_p (fun))) { Lisp_Object tem = scm_assq (Qinteractive_form, scm_procedure_properties (fun)); if (scm_is_pair (tem)) return list2 (Qinteractive, scm_cdr (tem)); } - else if (COMPILEDP (fun)) - { - if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) - return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); - } else if (AUTOLOADP (fun)) return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil)); else if (CONSP (fun)) diff --git a/src/doc.c b/src/doc.c index 2fa2baffda..e65159dd02 100644 --- a/src/doc.c +++ b/src/doc.c @@ -354,15 +354,7 @@ string is passed through `substitute-command-keys'. */) && (EQ (XCAR (fun), Qmacro) || EQ (XCAR (fun), Qspecial_operator))) fun = XCDR (fun); - if (scm_is_true (scm_procedure_p (fun))) - { - Lisp_Object tem = scm_procedure_property (fun, intern ("emacs-documentation")); - if (scm_is_true (tem)) - doc = tem; - else - return Qnil; - } - else if (COMPILEDP (fun)) + if (COMPILEDP (fun)) { if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING) return Qnil; @@ -377,6 +369,14 @@ string is passed through `substitute-command-keys'. */) return Qnil; } } + else if (scm_is_true (scm_procedure_p (fun))) + { + Lisp_Object tem = scm_procedure_property (fun, intern ("emacs-documentation")); + if (scm_is_true (tem)) + doc = tem; + else + return Qnil; + } else if (STRINGP (fun) || VECTORP (fun)) { return build_string ("Keyboard macro."); diff --git a/src/eval.c b/src/eval.c index aaec6c90e1..011f794aa6 100644 --- a/src/eval.c +++ b/src/eval.c @@ -264,6 +264,8 @@ init_eval_once (void) eval_fn = scm_c_public_ref ("language elisp runtime", "eval-elisp"); funcall_fn = scm_c_public_ref ("elisp-functions", "funcall"); + + scm_set_smob_apply (lisp_vectorlike_tag, apply_lambda, 0, 0, 1); } static struct handler *handlerlist_sentinel; @@ -1595,77 +1597,8 @@ set_lisp_eval_depth (void *data) static Lisp_Object eval_sub_1 (Lisp_Object form) { - Lisp_Object fun, val, original_fun, original_args; - Lisp_Object funcar; - struct gcpro gcpro1, gcpro2, gcpro3; - - if (SYMBOLP (form)) - { - /* Look up its binding in the lexical environment. - We do not pay attention to the declared_special flag here, since we - already did that when let-binding the variable. */ - Lisp_Object lex_binding - = !NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - ? Fassq (form, Vinternal_interpreter_environment) - : Qnil; - if (CONSP (lex_binding)) - return XCDR (lex_binding); - else - return Fsymbol_value (form); - } - - if (!CONSP (form)) - return form; - QUIT; - - GCPRO1 (form); - maybe_gc (); - UNGCPRO; - - scm_dynwind_begin (0); - scm_dynwind_unwind_handler (set_lisp_eval_depth, - (void *) lisp_eval_depth, - SCM_F_WIND_EXPLICITLY); - - if (++lisp_eval_depth > max_lisp_eval_depth) - { - if (max_lisp_eval_depth < 100) - max_lisp_eval_depth = 100; - if (lisp_eval_depth > max_lisp_eval_depth) - error ("Lisp nesting exceeds `max-lisp-eval-depth'"); - } - - original_fun = XCAR (form); - original_args = XCDR (form); - - /* This also protects them from gc. */ - record_in_backtrace (original_fun, &original_args, UNEVALLED); - - if (debug_on_next_call) - do_debug_on_call (Qt); - - /* At this point, only original_fun and original_args - have values that will be used below. */ - retry: - - /* Optimize for no indirection. */ - fun = original_fun; - if (!SYMBOLP (fun)) - fun = Ffunction (Fcons (fun, Qnil)); - else if (!NILP (fun) && (fun = SYMBOL_FUNCTION (fun), SYMBOLP (fun))) - fun = indirect_function (fun); - - if (COMPILEDP (fun)) - val = apply_lambda (fun, original_args); - else - val = scm_call_1 (eval_fn, form); - - if (backtrace_debug_on_exit (specpdl_ptr - 1)) - val = call_debugger (list2 (Qexit, val)); - scm_dynwind_end (); - - return val; + return scm_call_1 (eval_fn, form); } Lisp_Object @@ -2145,7 +2078,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, return Qnil; } -Lisp_Object +static Lisp_Object Ffuncall1 (ptrdiff_t nargs, Lisp_Object *args) { return scm_call_n (funcall_fn, args, nargs); @@ -2178,15 +2111,14 @@ apply_lambda (Lisp_Object fun, Lisp_Object args) for (i = 0; i < numargs; ) { tem = Fcar (args_left), args_left = Fcdr (args_left); - tem = eval_sub (tem); arg_vector[i++] = tem; gcpro1.nvars = i; } UNGCPRO; - set_backtrace_args (specpdl_ptr - 1, arg_vector); - set_backtrace_nargs (specpdl_ptr - 1, i); + //set_backtrace_args (specpdl_ptr - 1, arg_vector); + //set_backtrace_nargs (specpdl_ptr - 1, i); tem = funcall_lambda (fun, numargs, arg_vector); /* Do the debug-on-exit now, while arg_vector still exists. */