diff options
Diffstat (limited to 'src/data.c')
| -rw-r--r-- | src/data.c | 207 |
1 files changed, 191 insertions, 16 deletions
diff --git a/src/data.c b/src/data.c index 38cde0ff8b2..ffca7e75355 100644 --- a/src/data.c +++ b/src/data.c @@ -88,12 +88,6 @@ XOBJFWD (lispfwd a) } static void -CHECK_SUBR (Lisp_Object x) -{ - CHECK_TYPE (SUBRP (x), Qsubrp, x); -} - -static void set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found) { eassert (found == !EQ (blv->defcell, blv->valcell)); @@ -259,6 +253,8 @@ for example, (type-of 1) returns `integer'. */) } case PVEC_MODULE_FUNCTION: return Qmodule_function; + case PVEC_NATIVE_COMP_UNIT: + return Qnative_comp_unit; case PVEC_XWIDGET: return Qxwidget; case PVEC_XWIDGET_VIEW: @@ -585,8 +581,8 @@ DEFUN ("condition-variable-p", Fcondition_variable_p, Scondition_variable_p, /* Extract and set components of lists. */ 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'. + doc: /* Return the car of LIST. If LIST is nil, return nil. +Error if LIST is not nil and not a cons cell. See also `car-safe'. See Info node `(elisp)Cons Cells' for a discussion of related basic Lisp concepts such as car, cdr, cons cell and list. */) @@ -603,8 +599,8 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 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'. + doc: /* Return the cdr of LIST. If LIST is nil, return nil. +Error if LIST is not nil and not a cons cell. See also `cdr-safe'. See Info node `(elisp)Cons Cells' for a discussion of related basic Lisp concepts such as cdr, car, cons cell and list. */) @@ -779,6 +775,13 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, eassert (valid_lisp_object_p (definition)); +#ifdef HAVE_NATIVE_COMP + if (comp_enable_subr_trampolines + && SUBRP (function) + && !SUBR_NATIVE_COMPILEDP (function)) + CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol); +#endif + set_symbol_function (symbol, definition); return definition; @@ -824,6 +827,8 @@ The return value is undefined. */) Ffset (symbol, definition); } + maybe_defer_native_compilation (symbol, definition); + if (!NILP (docstring)) Fput (symbol, Qfunction_documentation, docstring); /* We used to return `definition', but now that `defun' and `defmacro' expand @@ -870,6 +875,72 @@ SUBR must be a built-in function. */) return build_string (name); } +DEFUN ("subr-native-elisp-p", Fsubr_native_elisp_p, Ssubr_native_elisp_p, 1, 1, + 0, doc: /* Return t if the object is native compiled lisp +function, nil otherwise. */) + (Lisp_Object object) +{ + return SUBR_NATIVE_COMPILEDP (object) ? Qt : Qnil; +} + +DEFUN ("subr-native-lambda-list", Fsubr_native_lambda_list, + Ssubr_native_lambda_list, 1, 1, 0, + doc: /* Return the lambda list for a native compiled lisp/d +function or t otherwise. */) + (Lisp_Object subr) +{ + CHECK_SUBR (subr); + + return SUBR_NATIVE_COMPILED_DYNP (subr) + ? XSUBR (subr)->lambda_list[0] + : Qt; +} + +DEFUN ("subr-type", Fsubr_type, + Ssubr_type, 1, 1, 0, + doc: /* Return the type of SUBR. */) + (Lisp_Object subr) +{ + CHECK_SUBR (subr); +#ifdef HAVE_NATIVE_COMP + return SUBR_TYPE (subr); +#else + return Qnil; +#endif +} + +#ifdef HAVE_NATIVE_COMP + +DEFUN ("subr-native-comp-unit", Fsubr_native_comp_unit, + Ssubr_native_comp_unit, 1, 1, 0, + doc: /* Return the native compilation unit. */) + (Lisp_Object subr) +{ + CHECK_SUBR (subr); + return XSUBR (subr)->native_comp_u[0]; +} + +DEFUN ("native-comp-unit-file", Fnative_comp_unit_file, + Snative_comp_unit_file, 1, 1, 0, + doc: /* Return the file of the native compilation unit. */) + (Lisp_Object comp_unit) +{ + CHECK_TYPE (NATIVE_COMP_UNITP (comp_unit), Qnative_comp_unit, comp_unit); + return XNATIVE_COMP_UNIT (comp_unit)->file; +} + +DEFUN ("native-comp-unit-set-file", Fnative_comp_unit_set_file, + Snative_comp_unit_set_file, 2, 2, 0, + doc: /* Return the file of the native compilation unit. */) + (Lisp_Object comp_unit, Lisp_Object new_file) +{ + CHECK_TYPE (NATIVE_COMP_UNITP (comp_unit), Qnative_comp_unit, comp_unit); + XNATIVE_COMP_UNIT (comp_unit)->file = new_file; + return comp_unit; +} + +#endif + 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. @@ -895,6 +966,9 @@ Value, if non-nil, is a list (interactive SPEC). */) if (SUBRP (fun)) { + if (SUBR_NATIVE_COMPILEDP (fun) && !NILP (XSUBR (fun)->native_intspec)) + return XSUBR (fun)->native_intspec; + const char *spec = XSUBR (fun)->intspec; if (spec) return list2 (Qinteractive, @@ -904,7 +978,17 @@ Value, if non-nil, is a list (interactive SPEC). */) else if (COMPILEDP (fun)) { if (PVSIZE (fun) > COMPILED_INTERACTIVE) - return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); + { + Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); + if (VECTORP (form)) + /* The vector form is the new form, where the first + element is the interactive spec, and the second is the + command modes. */ + return list2 (Qinteractive, AREF (form, 0)); + else + /* Old form -- just the interactive spec. */ + return list2 (Qinteractive, form); + } } #ifdef HAVE_MODULES else if (MODULE_FUNCTIONP (fun)) @@ -920,10 +1004,83 @@ Value, if non-nil, is a list (interactive SPEC). */) else if (CONSP (fun)) { Lisp_Object funcar = XCAR (fun); - if (EQ (funcar, Qclosure)) - return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); - else if (EQ (funcar, Qlambda)) - return Fassq (Qinteractive, Fcdr (XCDR (fun))); + if (EQ (funcar, Qclosure) + || EQ (funcar, Qlambda)) + { + Lisp_Object form = Fcdr (XCDR (fun)); + if (EQ (funcar, Qclosure)) + form = Fcdr (form); + Lisp_Object spec = Fassq (Qinteractive, form); + if (NILP (Fcdr (Fcdr (spec)))) + return spec; + else + return list2 (Qinteractive, Fcar (Fcdr (spec))); + } + } + return Qnil; +} + +DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0, + doc: /* Return the modes COMMAND is defined for. +If COMMAND is not a command, the return value is nil. +The value, if non-nil, is a list of mode name symbols. */) + (Lisp_Object command) +{ + Lisp_Object fun = indirect_function (command); /* Check cycles. */ + + if (NILP (fun)) + return Qnil; + + /* Use a `command-modes' property if present, analogous to the + function-documentation property. */ + fun = command; + while (SYMBOLP (fun)) + { + Lisp_Object modes = Fget (fun, Qcommand_modes); + if (!NILP (modes)) + return modes; + else + fun = Fsymbol_function (fun); + } + + if (COMPILEDP (fun)) + { + Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); + if (VECTORP (form)) + /* New form -- the second element is the command modes. */ + return AREF (form, 1); + else + /* Old .elc file -- no command modes. */ + return Qnil; + } +#ifdef HAVE_MODULES + else if (MODULE_FUNCTIONP (fun)) + { + Lisp_Object form + = module_function_command_modes (XMODULE_FUNCTION (fun)); + if (! NILP (form)) + return form; + } +#endif + else if (AUTOLOADP (fun)) + { + Lisp_Object modes = Fnth (make_int (3), fun); + if (CONSP (modes)) + return modes; + else + return Qnil; + } + else if (CONSP (fun)) + { + Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qclosure) + || EQ (funcar, Qlambda)) + { + Lisp_Object form = Fcdr (XCDR (fun)); + if (EQ (funcar, Qclosure)) + form = Fcdr (form); + return Fcdr (Fcdr (Fassq (Qinteractive, form))); + } } return Qnil; } @@ -1506,6 +1663,7 @@ All writes to aliases of SYMBOL will call WATCH-FUNCTION too. */) (Lisp_Object symbol, Lisp_Object watch_function) { symbol = Findirect_variable (symbol); + CHECK_SYMBOL (symbol); set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE); map_obarray (Vobarray, harmonize_variable_watchers, symbol); @@ -2042,7 +2200,9 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) 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. */) +BUFFER defaults to the current buffer. + +Also see `buffer-local-boundp'.*/) (Lisp_Object variable, Lisp_Object buffer) { struct buffer *buf = decode_buffer (buffer); @@ -3741,6 +3901,7 @@ syms_of_data (void) DEFSYM (Qerror, "error"); DEFSYM (Quser_error, "user-error"); DEFSYM (Qquit, "quit"); + DEFSYM (Qminibuffer_quit, "minibuffer-quit"); DEFSYM (Qwrong_length_argument, "wrong-length-argument"); DEFSYM (Qwrong_type_argument, "wrong-type-argument"); DEFSYM (Qargs_out_of_range, "args-out-of-range"); @@ -3813,6 +3974,7 @@ syms_of_data (void) Fput (sym, Qerror_message, build_pure_c_string (msg)) PUT_ERROR (Qquit, Qnil, "Quit"); + PUT_ERROR (Qminibuffer_quit, pure_cons (Qquit, Qnil), "Quit"); PUT_ERROR (Quser_error, error_tail, ""); PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument"); @@ -3877,6 +4039,7 @@ syms_of_data (void) DEFSYM (Qoverlay, "overlay"); DEFSYM (Qfinalizer, "finalizer"); DEFSYM (Qmodule_function, "module-function"); + DEFSYM (Qnative_comp_unit, "native-comp-unit"); DEFSYM (Quser_ptr, "user-ptr"); DEFSYM (Qfloat, "float"); DEFSYM (Qwindow_configuration, "window-configuration"); @@ -3906,8 +4069,11 @@ syms_of_data (void) DEFSYM (Qinteractive_form, "interactive-form"); DEFSYM (Qdefalias_fset_function, "defalias-fset-function"); + DEFSYM (Qbyte_code_function_p, "byte-code-function-p"); + defsubr (&Sindirect_variable); defsubr (&Sinteractive_form); + defsubr (&Scommand_modes); defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); @@ -3998,6 +4164,14 @@ syms_of_data (void) defsubr (&Sbyteorder); defsubr (&Ssubr_arity); defsubr (&Ssubr_name); + defsubr (&Ssubr_native_elisp_p); + defsubr (&Ssubr_native_lambda_list); + defsubr (&Ssubr_type); +#ifdef HAVE_NATIVE_COMP + defsubr (&Ssubr_native_comp_unit); + defsubr (&Snative_comp_unit_file); + defsubr (&Snative_comp_unit_set_file); +#endif #ifdef HAVE_MODULES defsubr (&Suser_ptrp); #endif @@ -4030,6 +4204,7 @@ This variable cannot be set; trying to do so will signal an error. */); DEFSYM (Qunlet, "unlet"); DEFSYM (Qset, "set"); DEFSYM (Qset_default, "set-default"); + DEFSYM (Qcommand_modes, "command-modes"); defsubr (&Sadd_variable_watcher); defsubr (&Sremove_variable_watcher); defsubr (&Sget_variable_watchers); |