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