Mercurial > hg > xemacs-beta
diff src/symbols.c @ 5125:b5df3737028a ben-lisp-object
merge
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Wed, 24 Feb 2010 01:58:04 -0600 |
parents | 623d57b7fbe8 4234fd5a7b17 |
children | a9c41067dd88 |
line wrap: on
line diff
--- a/src/symbols.c Wed Jan 20 07:05:57 2010 -0600 +++ b/src/symbols.c Wed Feb 24 01:58:04 2010 -0600 @@ -1,6 +1,6 @@ /* "intern" and friends -- moved here from lread.c and data.c Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc. - Copyright (C) 1995, 2000, 2001, 2002 Ben Wing. + Copyright (C) 1995, 2000, 2001, 2002, 2010 Ben Wing. This file is part of XEmacs. @@ -54,6 +54,8 @@ #include <config.h> #include "lisp.h" +#include "bytecode.h" /* for COMPILED_FUNCTION_ANNOTATION_HACK, + defined in bytecode.h and used here. */ #include "buffer.h" /* for Vbuffer_defaults */ #include "console-impl.h" #include "elhash.h" @@ -177,7 +179,7 @@ } Lisp_Object -intern_int (const Ibyte *str) +intern_istring (const Ibyte *str) { Bytecount len = qxestrlen (str); Lisp_Object obarray = Vobarray; @@ -197,7 +199,7 @@ Lisp_Object intern (const CIbyte *str) { - return intern_int ((Ibyte *) str); + return intern_istring ((Ibyte *) str); } Lisp_Object @@ -210,7 +212,7 @@ for (i = 0; i < len; i++) if (tmp[i] == '_') tmp[i] = '-'; - return intern_int ((Ibyte *) tmp); + return intern_istring ((Ibyte *) tmp); } DEFUN ("intern", Fintern, 1, 2, 0, /* @@ -600,7 +602,10 @@ !(unloading_module && UNBOUNDP(newval)) && #endif (symbol_is_constant (sym, val) - || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))) +#ifndef NO_NEED_TO_HANDLE_21_4_CODE + || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)) +#endif + )) signal_error_1 (Qsetting_constant, UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval)); } @@ -713,12 +718,19 @@ DEFUN ("define-function", Fdefine_function, 2, 2, 0, /* Set SYMBOL's function definition to NEWDEF, and return NEWDEF. Associates the function with the current load file, if any. +If NEWDEF is a compiled-function object, stores the function name in +the `annotated' slot of the compiled-function (retrievable using +`compiled-function-annotation'). */ (symbol, newdef)) { /* This function can GC */ Ffset (symbol, newdef); LOADHIST_ATTACH (Fcons (Qdefun, symbol)); +#ifdef COMPILED_FUNCTION_ANNOTATION_HACK + if (COMPILED_FUNCTIONP (newdef)) + XCOMPILED_FUNCTION (newdef)->annotated = symbol; +#endif /* COMPILED_FUNCTION_ANNOTATION_HACK */ return newdef; } @@ -728,20 +740,20 @@ */ (subr)) { - const char *name; + const Ascbyte *name; CHECK_SUBR (subr); name = XSUBR (subr)->name; return make_string ((const Ibyte *)name, strlen (name)); } -DEFUN ("special-form-p", Fspecial_form_p, 1, 1, 0, /* -Return whether SUBR is a special form. - -A special form is a built-in function (a subr, that is a function +DEFUN ("special-operator-p", Fspecial_operator_p, 1, 1, 0, /* +Return whether SUBR is a special operator. + +A special operator is a built-in function (a subr, that is a function implemented in C, not Lisp) which does not necessarily evaluate all its arguments. Much of the basic XEmacs Lisp syntax is implemented by means of -special forms; examples are `let', `condition-case', `defun', `setq' and so +special operators; examples are `let', `condition-case', `setq', and so on. If you intend to write a Lisp function that does not necessarily evaluate @@ -771,6 +783,65 @@ /* symbol-value */ /**********************************************************************/ +/* + NOTE NOTE NOTE: + --------------- + + There are various different uses of "magic" with regard to symbols, + and they need to be distinguished: + + 1. `symbol-value-magic' class of objects (struct symbol_value_magic): + A set of Lisp object types used as the value of a variable with any + behavior other than just a plain repository of a value. This + includes buffer-local variables, console-local variables, read-only + variables, variable aliases, variables that are linked to a C + variable, etc. The more specific types are: + + -- `symbol-value-forward': Variables that forward to a C variable. + NOTE:This includes built-in buffer-local and console-local + variables, since they forward to an element in a buffer or + console structure. + + -- `symbol-value-buffer-local': Variables on which + `make-local-variable' or `make-variable-buffer-local' have + been called. + + -- `symbol-value-lisp-magic': See below. + + -- `symbol-value-varalias': Variable aliases. + + 2. `symbol-value-lisp-magic': Variables on which + `dontusethis-set-symbol-value-handler' have been called. These + variables are extra-magic in that operations that would normally + change their value instead get forwarded out to Lisp handlers, + which can do anything they want. (NOTE: Handlers for getting a + variable's value aren't implemented yet.) + + 3. "magicfun" handlers on C-forwarding variables, declared with any + of the following: + + -- DEFVAR_LISP_MAGIC + -- DEFVAR_INT_MAGIC + -- DEFVAR_BOOL_MAGIC, + -- DEFVAR_BUFFER_LOCAL_MAGIC + -- DEFVAR_BUFFER_DEFAULTS_MAGIC + -- DEFVAR_CONSOLE_LOCAL_MAGIC + -- DEFVAR_CONSOLE_DEFAULTS_MAGIC + + Here, the "magic function" is a handler that is notified whenever the + value of a variable is changed, so that some other updating can take + place (e.g. setting redisplay-related dirty bits, updating a cache, + etc.). + + Note that DEFVAR_LISP_MAGIC does *NOT* have anything to do with + `symbol-value-lisp-magic'. The former refers to variables that can + hold an arbitrary Lisp object and forward to a C variable declared + `Lisp_Object foo', and have a "magicfun" as just described; the + latter are variables that have Lisp-level handlers that function + in *PLACE* of normal variable-setting mechanisms, and are established + with `dontusethis-set-symbol-value-handler', as described above. +*/ + /* If the contents of the value cell of a symbol is one of the following three types of objects, then the symbol is "magic" in that setting and retrieving its value doesn't just set or retrieve the raw @@ -1116,29 +1187,29 @@ return *((Lisp_Object *)symbol_value_forward_forward (fwd)); case SYMVAL_DEFAULT_BUFFER_FORWARD: - return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults) - + ((char *)symbol_value_forward_forward (fwd) - - (char *)&buffer_local_flags)))); + return (*((Lisp_Object *)((Rawbyte *) XBUFFER (Vbuffer_defaults) + + ((Rawbyte *)symbol_value_forward_forward (fwd) + - (Rawbyte *)&buffer_local_flags)))); case SYMVAL_CURRENT_BUFFER_FORWARD: case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: assert (buffer); - return (*((Lisp_Object *)((char *)buffer - + ((char *)symbol_value_forward_forward (fwd) - - (char *)&buffer_local_flags)))); + return (*((Lisp_Object *)((Rawbyte *)buffer + + ((Rawbyte *)symbol_value_forward_forward (fwd) + - (Rawbyte *)&buffer_local_flags)))); case SYMVAL_DEFAULT_CONSOLE_FORWARD: - return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults) - + ((char *)symbol_value_forward_forward (fwd) - - (char *)&console_local_flags)))); + return (*((Lisp_Object *)((Rawbyte *) XCONSOLE (Vconsole_defaults) + + ((Rawbyte *)symbol_value_forward_forward (fwd) + - (Rawbyte *)&console_local_flags)))); case SYMVAL_SELECTED_CONSOLE_FORWARD: case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: assert (console); - return (*((Lisp_Object *)((char *)console - + ((char *)symbol_value_forward_forward (fwd) - - (char *)&console_local_flags)))); + return (*((Lisp_Object *)((Rawbyte *)console + + ((Rawbyte *)symbol_value_forward_forward (fwd) + - (Rawbyte *)&console_local_flags)))); case SYMVAL_UNBOUND_MARKER: return valcontents; @@ -1164,13 +1235,13 @@ Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); - int offset = ((char *) symbol_value_forward_forward (fwd) - - (char *) &buffer_local_flags); + int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) + - (Rawbyte *) &buffer_local_flags); int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object, int flags) = symbol_value_forward_magicfun (fwd); - *((Lisp_Object *) (offset + (char *) XBUFFER (Vbuffer_defaults))) + *((Lisp_Object *) (offset + (Rawbyte *) XBUFFER (Vbuffer_defaults))) = value; if (mask > 0) /* Not always per-buffer */ @@ -1183,7 +1254,7 @@ { if (magicfun) magicfun (sym, &value, wrap_buffer (b), 0); - *((Lisp_Object *) (offset + (char *) b)) = value; + *((Lisp_Object *) (offset + (Rawbyte *) b)) = value; } } } @@ -1204,13 +1275,13 @@ Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); - int offset = ((char *) symbol_value_forward_forward (fwd) - - (char *) &console_local_flags); + int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) + - (Rawbyte *) &console_local_flags); int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object, int flags) = symbol_value_forward_magicfun (fwd); - *((Lisp_Object *) (offset + (char *) XCONSOLE (Vconsole_defaults))) + *((Lisp_Object *) (offset + (Rawbyte *) XCONSOLE (Vconsole_defaults))) = value; if (mask > 0) /* Not always per-console */ @@ -1223,7 +1294,7 @@ { if (magicfun) magicfun (sym, &value, console, 0); - *((Lisp_Object *) (offset + (char *) d)) = value; + *((Lisp_Object *) (offset + (Rawbyte *) d)) = value; } } } @@ -1300,9 +1371,9 @@ case SYMVAL_CURRENT_BUFFER_FORWARD: if (magicfun) magicfun (sym, &newval, wrap_buffer (current_buffer), 0); - *((Lisp_Object *) ((char *) current_buffer - + ((char *) symbol_value_forward_forward (fwd) - - (char *) &buffer_local_flags))) + *((Lisp_Object *) ((Rawbyte *) current_buffer + + ((Rawbyte *) symbol_value_forward_forward (fwd) + - (Rawbyte *) &buffer_local_flags))) = newval; return; @@ -1313,9 +1384,9 @@ case SYMVAL_SELECTED_CONSOLE_FORWARD: if (magicfun) magicfun (sym, &newval, Vselected_console, 0); - *((Lisp_Object *) ((char *) XCONSOLE (Vselected_console) - + ((char *) symbol_value_forward_forward (fwd) - - (char *) &console_local_flags))) + *((Lisp_Object *) ((Rawbyte *) XCONSOLE (Vselected_console) + + ((Rawbyte *) symbol_value_forward_forward (fwd) + - (Rawbyte *) &console_local_flags))) = newval; return; @@ -1992,18 +2063,18 @@ { const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); - return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults) - + ((char *)symbol_value_forward_forward (fwd) - - (char *)&buffer_local_flags)))); + return (*((Lisp_Object *)((Rawbyte *) XBUFFER (Vbuffer_defaults) + + ((Rawbyte *)symbol_value_forward_forward (fwd) + - (Rawbyte *)&buffer_local_flags)))); } case SYMVAL_SELECTED_CONSOLE_FORWARD: { const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); - return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults) - + ((char *)symbol_value_forward_forward (fwd) - - (char *)&console_local_flags)))); + return (*((Lisp_Object *)((Rawbyte *) XCONSOLE (Vconsole_defaults) + + ((Rawbyte *)symbol_value_forward_forward (fwd) + - (Rawbyte *)&console_local_flags)))); } case SYMVAL_BUFFER_LOCAL: @@ -2439,8 +2510,8 @@ { const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); - int offset = ((char *) symbol_value_forward_forward (fwd) - - (char *) &buffer_local_flags); + int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) + - (Rawbyte *) &buffer_local_flags); int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); @@ -2450,10 +2521,10 @@ Lisp_Object in_object, int flags) = symbol_value_forward_magicfun (fwd); Lisp_Object oldval = * (Lisp_Object *) - (offset + (char *) XBUFFER (Vbuffer_defaults)); + (offset + (Rawbyte *) XBUFFER (Vbuffer_defaults)); if (magicfun) (magicfun) (variable, &oldval, wrap_buffer (current_buffer), 0); - *(Lisp_Object *) (offset + (char *) current_buffer) + *(Lisp_Object *) (offset + (Rawbyte *) current_buffer) = oldval; current_buffer->local_var_flags &= ~mask; } @@ -2533,8 +2604,8 @@ { const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (valcontents); - int offset = ((char *) symbol_value_forward_forward (fwd) - - (char *) &console_local_flags); + int offset = ((Rawbyte *) symbol_value_forward_forward (fwd) + - (Rawbyte *) &console_local_flags); int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); @@ -2544,10 +2615,10 @@ Lisp_Object in_object, int flags) = symbol_value_forward_magicfun (fwd); Lisp_Object oldval = * (Lisp_Object *) - (offset + (char *) XCONSOLE (Vconsole_defaults)); + (offset + (Rawbyte *) XCONSOLE (Vconsole_defaults)); if (magicfun) magicfun (variable, &oldval, Vselected_console, 0); - *(Lisp_Object *) (offset + (char *) XCONSOLE (Vselected_console)) + *(Lisp_Object *) (offset + (Rawbyte *) XCONSOLE (Vselected_console)) = oldval; XCONSOLE (Vselected_console)->local_var_flags &= ~mask; } @@ -3525,8 +3596,8 @@ } static void -defsymbol_massage_name_1 (Lisp_Object *location, const char *name, int dump_p, - int multiword_predicate_p) +defsymbol_massage_name_1 (Lisp_Object *location, const Ascbyte *name, + int dump_p, int multiword_predicate_p) { char temp[500]; int len = strlen (name) - 1; @@ -3547,63 +3618,64 @@ temp[i] = '-'; *location = Fintern (make_string ((const Ibyte *) temp, len), Qnil); if (dump_p) - staticpro (location); + staticpro_1 (location, name); else - staticpro_nodump (location); + staticpro_nodump_1 (location, name); } void -defsymbol_massage_name_nodump (Lisp_Object *location, const char *name) +defsymbol_massage_name_nodump (Lisp_Object *location, const Ascbyte *name) { defsymbol_massage_name_1 (location, name, 0, 0); } void -defsymbol_massage_name (Lisp_Object *location, const char *name) +defsymbol_massage_name (Lisp_Object *location, const Ascbyte *name) { defsymbol_massage_name_1 (location, name, 1, 0); } void defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location, - const char *name) + const Ascbyte *name) { defsymbol_massage_name_1 (location, name, 0, 1); } void -defsymbol_massage_multiword_predicate (Lisp_Object *location, const char *name) +defsymbol_massage_multiword_predicate (Lisp_Object *location, + const Ascbyte *name) { defsymbol_massage_name_1 (location, name, 1, 1); } void -defsymbol_nodump (Lisp_Object *location, const char *name) +defsymbol_nodump (Lisp_Object *location, const Ascbyte *name) { *location = Fintern (make_string_nocopy ((const Ibyte *) name, strlen (name)), Qnil); - staticpro_nodump (location); + staticpro_nodump_1 (location, name); } void -defsymbol (Lisp_Object *location, const char *name) +defsymbol (Lisp_Object *location, const Ascbyte *name) { *location = Fintern (make_string_nocopy ((const Ibyte *) name, strlen (name)), Qnil); - staticpro (location); + staticpro_1 (location, name); } void -defkeyword (Lisp_Object *location, const char *name) +defkeyword (Lisp_Object *location, const Ascbyte *name) { defsymbol (location, name); Fset (*location, *location); } void -defkeyword_massage_name (Lisp_Object *location, const char *name) +defkeyword_massage_name (Lisp_Object *location, const Ascbyte *name) { char temp[500]; int len = strlen (name); @@ -3696,7 +3768,7 @@ \ newsubr = xnew (Lisp_Subr); \ memcpy (newsubr, subr, sizeof (Lisp_Subr)); \ - subr->doc = (const char *)newsubr; \ + subr->doc = (const CIbyte *)newsubr; \ subr = newsubr; \ } \ } while (0) @@ -3783,7 +3855,7 @@ } static void -deferror_1 (Lisp_Object *symbol, const char *name, const char *messuhhj, +deferror_1 (Lisp_Object *symbol, const Ascbyte *name, const Ascbyte *messuhhj, Lisp_Object inherits_from, int massage_p) { Lisp_Object conds; @@ -3798,25 +3870,25 @@ /* NOT build_msg_string (). This function is called at load time and the string needs to get translated at run time. (This happens in the function (display-error) in cmdloop.el.) */ - Fput (*symbol, Qerror_message, build_msg_string (messuhhj)); + Fput (*symbol, Qerror_message, build_defer_string (messuhhj)); } void -deferror (Lisp_Object *symbol, const char *name, const char *messuhhj, +deferror (Lisp_Object *symbol, const Ascbyte *name, const Ascbyte *messuhhj, Lisp_Object inherits_from) { deferror_1 (symbol, name, messuhhj, inherits_from, 0); } void -deferror_massage_name (Lisp_Object *symbol, const char *name, - const char *messuhhj, Lisp_Object inherits_from) +deferror_massage_name (Lisp_Object *symbol, const Ascbyte *name, + const Ascbyte *messuhhj, Lisp_Object inherits_from) { deferror_1 (symbol, name, messuhhj, inherits_from, 1); } void -deferror_massage_name_and_message (Lisp_Object *symbol, const char *name, +deferror_massage_name_and_message (Lisp_Object *symbol, const Ascbyte *name, Lisp_Object inherits_from) { char temp[500]; @@ -3893,7 +3965,7 @@ DEFSUBR (Fdefine_function); Ffset (intern ("defalias"), intern ("define-function")); DEFSUBR (Fsubr_name); - DEFSUBR (Fspecial_form_p); + DEFSUBR (Fspecial_operator_p); DEFSUBR (Fsetplist); DEFSUBR (Fsymbol_value_in_buffer); DEFSUBR (Fsymbol_value_in_console); @@ -3920,7 +3992,8 @@ /* Create and initialize a Lisp variable whose value is forwarded to C data */ void -defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic) +defvar_magic (const Ascbyte *symbol_name, + const struct symbol_value_forward *magic) { Lisp_Object sym; @@ -3932,7 +4005,7 @@ */ if (initialized) { - sym = Fintern (build_string (symbol_name), Qnil); + sym = Fintern (build_ascstring (symbol_name), Qnil); LOADHIST_ATTACH (sym); } else