xemacs-beta: src/symbols.c comparison

comparison src/symbols.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29

author	cvs
date	Mon, 13 Aug 2007 11:13:30 +0200
parents	aabb7f5b1c81
children	a86b2b5e0111

comparison

equal deleted inserted replaced

-:f4aeb21a5bad
+:74fd4e045ea6
 Lisp_Object Qad_advice_info, Qad_activate;
 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
 Lisp_Object Qlocal_predicate, Qmake_local;
-Lisp_Object Qboundp, Qfboundp, Qglobally_boundp, Qmakunbound;
+Lisp_Object Qboundp, Qglobally_boundp, Qmakunbound;
 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
 Lisp_Object Qset_default, Qsetq_default;
 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable;
 Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
 static Lisp_Object *value_slot_past_magic (Lisp_Object sym);
 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol,
 					     Lisp_Object follow_past_lisp_magic);
-#ifdef LRECORD_SYMBOL
 static Lisp_Object
-mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_symbol (Lisp_Object obj)
 {
-struct Lisp_Symbol *sym = XSYMBOL (obj);
+Lisp_Symbol *sym = XSYMBOL (obj);
 Lisp_Object pname;
-markobj (sym->value);
+mark_object (sym->value);
-markobj (sym->function);
+mark_object (sym->function);
-/* No need to mark through ->obarray, because it only holds nil or t.  */
-/* markobj (sym->obarray);*/
 XSETSTRING (pname, sym->name);
-markobj (pname);
+mark_object (pname);
 if (!symbol_next (sym))
 return sym->plist;
 else
 {
-markobj (sym->plist);
+mark_object (sym->plist);
 /* Mark the rest of the symbols in the obarray hash-chain */
 sym = symbol_next (sym);
 XSETSYMBOL (obj, sym);
 return obj;
 }
 }
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
+static const struct lrecord_description symbol_description[] = {
-				     mark_symbol, print_symbol, 0, 0, 0,
+{ XD_LISP_OBJECT, offsetof (Lisp_Symbol, next) },
-				     struct Lisp_Symbol);
+{ XD_LISP_OBJECT, offsetof (Lisp_Symbol, name) },
-#endif /* LRECORD_SYMBOL */
+{ XD_LISP_OBJECT, offsetof (Lisp_Symbol, value) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Symbol, function) },
+{ XD_LISP_OBJECT, offsetof (Lisp_Symbol, plist) },
+{ XD_END }
+};
+/* Symbol plists are directly accessible, so we need to protect against
+invalid property list structure */
+static Lisp_Object
+symbol_getprop (Lisp_Object symbol, Lisp_Object property)
+{
+return external_plist_get (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME);
+}
+static int
+symbol_putprop (Lisp_Object symbol, Lisp_Object property, Lisp_Object value)
+{
+external_plist_put (&XSYMBOL (symbol)->plist, property, value, 0, ERROR_ME);
+return 1;
+}
+static int
+symbol_remprop (Lisp_Object symbol, Lisp_Object property)
+{
+return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME);
+}
+DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("symbol", symbol,
+						mark_symbol, print_symbol,
+						0, 0, 0, symbol_description,
+						symbol_getprop,
+						symbol_putprop,
+						symbol_remprop,
+						Fsymbol_plist,
+						Lisp_Symbol);
 /**********************************************************************/
 /*                              Intern				      */
 /**********************************************************************/
 }
 return obarray;
 }
 Lisp_Object
-intern (CONST char *str)
+intern (const char *str)
 {
 Bytecount len = strlen (str);
-CONST Bufbyte *buf = (CONST Bufbyte *) str;
+const Bufbyte *buf = (const Bufbyte *) str;
 Lisp_Object obarray = Vobarray;
 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
 obarray = check_obarray (obarray);
 Lisp_Object tem = oblookup (obarray, buf, len);
 if (SYMBOLP (tem))
 return tem;
 }
-return Fintern ((purify_flag
+return Fintern (make_string (buf, len), obarray);
-		   ? make_pure_pname (buf, len, 0)
-		   : make_string (buf, len)),
-		  obarray);
 }
 DEFUN ("intern", Fintern, 1, 2, 0, /*
 Return the canonical symbol whose name is STRING.
 If there is none, one is created by this function and returned.
 A second optional argument specifies the obarray to use;
 it defaults to the value of `obarray'.
 */
 (string, obarray))
 {
-Lisp_Object sym, *ptr;
+Lisp_Object object, *ptr;
+Lisp_Symbol *symbol;
 Bytecount len;
 if (NILP (obarray)) obarray = Vobarray;
 obarray = check_obarray (obarray);
 CHECK_STRING (string);
 len = XSTRING_LENGTH (string);
-sym = oblookup (obarray, XSTRING_DATA (string), len);
+object = oblookup (obarray, XSTRING_DATA (string), len);
-if (!INTP (sym))
+if (!INTP (object))
 /* Found it */
-return sym;
+return object;
-ptr = &XVECTOR_DATA (obarray)[XINT (sym)];
+ptr = &XVECTOR_DATA (obarray)[XINT (object)];
-if (purify_flag && ! purified (string))
+object = Fmake_symbol (string);
-string = make_pure_pname (XSTRING_DATA (string), len, 0);
+symbol = XSYMBOL (object);
-sym = Fmake_symbol (string);
-/* FSFmacs places OBARRAY here, but it is pointless because we do
-not mark through this slot, so it is not usable later (because
-the obarray might have been collected).  Marking through the
-->obarray slot is an even worse idea, because it would keep
-obarrays from being collected because of symbols pointed to them.
-NOTE: We place Qt here only if OBARRAY is actually Vobarray.  It
-is safer to do it this way, to avoid hosing with symbols within
-pure objects.  */
-if (EQ (obarray, Vobarray))
-XSYMBOL (sym)->obarray = Qt;
 if (SYMBOLP (*ptr))
-symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr);
+symbol_next (symbol) = XSYMBOL (*ptr);
 else
-symbol_next (XSYMBOL (sym)) = 0;
+symbol_next (symbol) = 0;
-*ptr = sym;
+*ptr = object;
-return sym;
+if (string_byte (symbol_name (symbol), 0) == ':' && EQ (obarray, Vobarray))
+{
+/* The LISP way is to put keywords in their own package, but we
+	 don't have packages, so we do something simpler.  Someday,
+	 maybe we'll have packages and then this will be reworked.
+	 --Stig. */
+symbol_value (symbol) = object;
+}
+return object;
 }
 DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
-Return the canonical symbol whose name is STRING, or nil if none exists.
+Return the canonical symbol named NAME, or nil if none exists.
+NAME may be a string or a symbol.  If it is a symbol, that exact
+symbol is searched for.
 A second optional argument specifies the obarray to use;
 it defaults to the value of `obarray'.
 */
-(string, obarray))
+(name, obarray))
 {
+/* #### Bug!  (intern-soft "nil") returns nil.  Perhaps we should
+add a DEFAULT-IF-NOT-FOUND arg, like in get.  */
 Lisp_Object tem;
+Lisp_String *string;
 if (NILP (obarray)) obarray = Vobarray;
 obarray = check_obarray (obarray);
-CHECK_STRING (string);
+if (!SYMBOLP (name))
+{
-tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
+CHECK_STRING (name);
-return !INTP (tem) ? tem : Qnil;
+string = XSTRING (name);
+}
+else
+string = symbol_name (XSYMBOL (name));
+tem = oblookup (obarray, string_data (string), string_length (string));
+if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
+return Qnil;
+else
+return tem;
 }
 DEFUN ("unintern", Funintern, 1, 2, 0, /*
 Delete the symbol named NAME, if any, from OBARRAY.
 The value is t if a symbol was found and deleted, nil otherwise.
 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
 OBARRAY defaults to the value of the variable `obarray'
 */
 (name, obarray))
 {
-Lisp_Object string, tem;
+Lisp_Object tem;
+Lisp_String *string;
 int hash;
 if (NILP (obarray)) obarray = Vobarray;
 obarray = check_obarray (obarray);
 if (SYMBOLP (name))
-XSETSTRING (string, XSYMBOL (name)->name);
+string = symbol_name (XSYMBOL (name));
 else
 {
 CHECK_STRING (name);
-string = name;
+string = XSTRING (name);
 }
-tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
+tem = oblookup (obarray, string_data (string), string_length (string));
 if (INTP (tem))
 return Qnil;
 /* If arg was a symbol, don't delete anything but that symbol itself.  */
 if (SYMBOLP (name) && !EQ (name, tem))
 return Qnil;
 	      XSYMBOL (tail)->next = XSYMBOL (following)->next;
 	      break;
 	    }
 	}
 }
-XSYMBOL (tem)->obarray = Qnil;
 return Qt;
 }
 /* Return the symbol in OBARRAY whose names matches the string
 of SIZE characters at PTR.  If there is no such symbol in OBARRAY,
 return the index into OBARRAY that the string hashes to.
 Also store the bucket number in oblookup_last_bucket_number.  */
 Lisp_Object
-oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
+oblookup (Lisp_Object obarray, const Bufbyte *ptr, Bytecount size)
 {
 int hash, obsize;
-struct Lisp_Symbol *tail;
+Lisp_Symbol *tail;
 Lisp_Object bucket;
 if (!VECTORP (obarray) ||
 (obsize = XVECTOR_LENGTH (obarray)) == 0)
 {
 obarray = check_obarray (obarray);
 obsize = XVECTOR_LENGTH (obarray);
 }
-#if 0 /* FSFmacs */
-/* #### Huh? */
-/* This is sometimes needed in the middle of GC.  */
-obsize &= ~ARRAY_MARK_FLAG;
-#endif
 hash = hash_string (ptr, size) % obsize;
 oblookup_last_bucket_number = hash;
 bucket = XVECTOR_DATA (obarray)[hash];
 if (ZEROP (bucket))
 ;
 return make_int (hash);
 }
 #if 0 /* Emacs 19.34 */
 int
-hash_string (CONST Bufbyte *ptr, Bytecount len)
+hash_string (const Bufbyte *ptr, Bytecount len)
 {
-CONST Bufbyte *p = ptr;
+const Bufbyte *p = ptr;
-CONST Bufbyte *end = p + len;
+const Bufbyte *end = p + len;
 Bufbyte c;
 int hash = 0;
 while (p != end)
 {
 }
 #endif
 /* derived from hashpjw, Dragon Book P436. */
 int
-hash_string (CONST Bufbyte *ptr, Bytecount len)
+hash_string (const Bufbyte *ptr, Bytecount len)
 {
 int hash = 0;
 while (len-- > 0)
 {
 {
 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
 if (SYMBOLP (tail))
 	while (1)
 	  {
-	    struct Lisp_Symbol *next;
+	    Lisp_Symbol *next;
 	    if ((*fn) (tail, arg))
 	      return;
 	    next = symbol_next (XSYMBOL (tail));
 	    if (!next)
 	      break;
 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
 signal_simple_error ("Use `set-specifier' to change a specifier's value",
 			 sym);
 if (symbol_is_constant (sym, val)
-|| (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)
+|| (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym)))
-	  && !NILP (XSYMBOL (sym)->obarray)))
 signal_error (Qsetting_constant,
 		  UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
 }
 /* Verify that it's ok to make SYM buffer-local.  This rejects
 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
 be changed.
 SYMVAL_CONST_SPECIFIER_FORWARD:
 (declare with DEFVAR_SPECIFIER)
-Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
+Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
-you get when attempting to set the value says to use
+message you get when attempting to set the value says to use
 `set-specifier' instead.
 SYMVAL_CURRENT_BUFFER_FORWARD:
 (declare with DEFVAR_BUFFER_LOCAL)
 This is used for built-in buffer-local variables -- i.e.
 low-level functions below do not accept them; you need
 to call follow_varalias_pointers to get the actual
 symbol to operate on.  */
 static Lisp_Object
-mark_symbol_value_buffer_local (Lisp_Object obj,
+mark_symbol_value_buffer_local (Lisp_Object obj)
-				void (*markobj) (Lisp_Object))
 {
 struct symbol_value_buffer_local *bfwd;
 #ifdef ERROR_CHECK_TYPECHECK
 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
 	  XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
 #endif
 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
-markobj (bfwd->default_value);
+mark_object (bfwd->default_value);
-markobj (bfwd->current_value);
+mark_object (bfwd->current_value);
-markobj (bfwd->current_buffer);
+mark_object (bfwd->current_buffer);
 return bfwd->current_alist_element;
 }
 static Lisp_Object
-mark_symbol_value_lisp_magic (Lisp_Object obj,
+mark_symbol_value_lisp_magic (Lisp_Object obj)
-			      void (*markobj) (Lisp_Object))
 {
 struct symbol_value_lisp_magic *bfwd;
 int i;
 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
 {
-markobj (bfwd->handler[i]);
+mark_object (bfwd->handler[i]);
-markobj (bfwd->harg[i]);
+mark_object (bfwd->harg[i]);
 }
 return bfwd->shadowed;
 }
 static Lisp_Object
-mark_symbol_value_varalias (Lisp_Object obj,
+mark_symbol_value_varalias (Lisp_Object obj)
-			    void (*markobj) (Lisp_Object))
 {
 struct symbol_value_varalias *bfwd;
 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
-markobj (bfwd->shadowed);
+mark_object (bfwd->shadowed);
 return bfwd->aliasee;
 }
 /* Should never, ever be called. (except by an external debugger) */
 void
 	   XSYMBOL_VALUE_MAGIC_TYPE (obj),
 	   (long) XPNTR (obj));
 write_c_string (buf, printcharfun);
 }
+static const struct lrecord_description symbol_value_forward_description[] = {
+{ XD_END }
+};
+static const struct lrecord_description symbol_value_buffer_local_description[] = {
+{ XD_LISP_OBJECT,  offsetof (struct symbol_value_buffer_local, default_value) },
+{ XD_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 },
+{ XD_END }
+};
+static const struct lrecord_description symbol_value_lisp_magic_description[] = {
+{ XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
+{ XD_END }
+};
+static const struct lrecord_description symbol_value_varalias_description[] = {
+{ XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
+{ XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
+{ XD_END }
+};
 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
 			       symbol_value_forward,
 			       this_one_is_unmarkable,
 			       print_symbol_value_magic, 0, 0, 0,
+			       symbol_value_forward_description,
 			       struct symbol_value_forward);
 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
 			       symbol_value_buffer_local,
 			       mark_symbol_value_buffer_local,
 			       print_symbol_value_magic, 0, 0, 0,
+			       symbol_value_buffer_local_description,
 			       struct symbol_value_buffer_local);
 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
 			       symbol_value_lisp_magic,
 			       mark_symbol_value_lisp_magic,
 			       print_symbol_value_magic, 0, 0, 0,
+			       symbol_value_lisp_magic_description,
 			       struct symbol_value_lisp_magic);
 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
 			       symbol_value_varalias,
 			       mark_symbol_value_varalias,
 			       print_symbol_value_magic, 0, 0, 0,
+			       symbol_value_varalias_description,
 			       struct symbol_value_varalias);
 /* Getting and setting values of symbols */
 static Lisp_Object
 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
 		      struct console *console)
 {
-CONST struct symbol_value_forward *fwd;
+const struct symbol_value_forward *fwd;
 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
 return valcontents;
 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
 */
 /* At this point, the value cell may not contain a symbol-value-varalias
 or symbol-value-buffer-local, and if there's a handler, we should
 have already called it. */
 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
-CONST struct symbol_value_forward *fwd
+const struct symbol_value_forward *fwd
 = XSYMBOL_VALUE_FORWARD (valcontents);
 int offset = ((char *) symbol_value_forward_forward (fwd)
 		- (char *) &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,
 */
 /* At this point, the value cell may not contain a symbol-value-varalias
 or symbol-value-buffer-local, and if there's a handler, we should
 have already called it. */
 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
-CONST struct symbol_value_forward *fwd
+const struct symbol_value_forward *fwd
 = XSYMBOL_VALUE_FORWARD (valcontents);
 int offset = ((char *) symbol_value_forward_forward (fwd)
 		- (char *) &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,
 	      || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
 *store_pointer = newval;
 }
 else
 {
-CONST struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
+const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
 		       Lisp_Object in_object, int flags)
 	= symbol_value_forward_magicfun (fwd);
 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
 	case SYMVAL_BOOLEAN_FORWARD:
 	  if (magicfun)
 	    magicfun (sym, &newval, Qnil, 0);
 	  *((int *) symbol_value_forward_forward (fwd))
-	    = ((NILP (newval)) ? 0 : 1);
+	    = !NILP (newval);
 	  return;
 	case SYMVAL_OBJECT_FORWARD:
 	  if (magicfun)
 	    magicfun (sym, &newval, Qnil, 0);
 else
 {
 /* This can also get called while we're preparing to shutdown.
 #### What should really happen in that case?  Should we
 actually fix things so we can't get here in that case? */
+#ifndef PDUMP
 assert (!initialized || preparing_for_armageddon);
+#endif
 con = 0;
 }
 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
 }
 else
 {
 /* This can also get called while we're preparing to shutdown.
 #### What should really happen in that case?  Should we
 actually fix things so we can't get here in that case? */
+#ifndef PDUMP
 assert (!initialized || preparing_for_armageddon);
+#endif
 con = 0;
 }
 return find_symbol_value_1 (sym, current_buffer, con, 1,
 			      find_it_p ? symbol_cons : Qnil,
 Set SYMBOL's value to NEWVAL, and return NEWVAL.
 */
 (symbol, newval))
 {
 REGISTER Lisp_Object valcontents;
-struct Lisp_Symbol *sym;
+Lisp_Symbol *sym;
 /* remember, we're called by Fmakunbound() as well */
 CHECK_SYMBOL (symbol);
 retry:
 }
 reject_constant_symbols (symbol, newval, 0,
 			   UNBOUNDP (newval) ? Qmakunbound : Qset);
-retry_2:
 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
 {
 case SYMVAL_LISP_MAGIC:
 {
-	Lisp_Object retval;
 	if (UNBOUNDP (newval))
-	  retval = maybe_call_magic_handler (symbol, Qmakunbound, 0);
+	  {
+	    maybe_call_magic_handler (symbol, Qmakunbound, 0);
+	    return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
+	  }
 	else
-	  retval = maybe_call_magic_handler (symbol, Qset, 1, newval);
+	  {
-	if (!UNBOUNDP (retval))
+	    maybe_call_magic_handler (symbol, Qset, 1, newval);
-	  return newval;
+	    return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval;
-	valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
+	  }
-	/* semi-change-o */
-	goto retry_2;
 }
 case SYMVAL_VARALIAS:
 symbol = follow_varalias_pointers (symbol,
 					 UNBOUNDP (newval)
 /* case SYMVAL_UNBOUND_MARKER: break; */
 case SYMVAL_CURRENT_BUFFER_FORWARD:
 {
-	CONST struct symbol_value_forward *fwd
+	const struct symbol_value_forward *fwd
 	  = XSYMBOL_VALUE_FORWARD (valcontents);
 	int mask = XINT (*((Lisp_Object *)
 			   symbol_value_forward_forward (fwd)));
 	if (mask > 0)
 	  /* Setting this variable makes it buffer-local */
 	break;
 }
 case SYMVAL_SELECTED_CONSOLE_FORWARD:
 {
-	CONST struct symbol_value_forward *fwd
+	const struct symbol_value_forward *fwd
 	  = XSYMBOL_VALUE_FORWARD (valcontents);
 	int mask = XINT (*((Lisp_Object *)
 			   symbol_value_forward_forward (fwd)));
 	if (mask > 0)
 	  /* Setting this variable makes it console-local */
 case SYMVAL_UNBOUND_MARKER:
 return valcontents;
 case SYMVAL_CURRENT_BUFFER_FORWARD:
 {
-	CONST struct symbol_value_forward *fwd
+	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))));
 }
 case SYMVAL_SELECTED_CONSOLE_FORWARD:
 {
-	CONST struct symbol_value_forward *fwd
+	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))));
 }
 }
 {
 struct symbol_value_buffer_local *bfwd
 = alloc_lcrecord_type (struct symbol_value_buffer_local,
-			     lrecord_symbol_value_buffer_local);
+			     &lrecord_symbol_value_buffer_local);
 Lisp_Object foo;
 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
 bfwd->default_value = find_symbol_value (variable);
 bfwd->current_value = valcontents;
 	}
 }
 /* Make sure variable is set up to hold per-buffer values */
 bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
-			      lrecord_symbol_value_buffer_local);
+			      &lrecord_symbol_value_buffer_local);
 bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
 bfwd->current_buffer = Qnil;
 bfwd->current_alist_element = Qnil;
 bfwd->current_value = valcontents;
 /* presto change-o! */
 goto retry;
 case SYMVAL_CURRENT_BUFFER_FORWARD:
 {
-	CONST struct symbol_value_forward *fwd
+	const struct symbol_value_forward *fwd
 	  = XSYMBOL_VALUE_FORWARD (valcontents);
 	int offset = ((char *) symbol_value_forward_forward (fwd)
 			       - (char *) &buffer_local_flags);
 	int mask =
 	  XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
 /* presto change-o! */
 goto retry;
 case SYMVAL_SELECTED_CONSOLE_FORWARD:
 {
-	CONST struct symbol_value_forward *fwd
+	const struct symbol_value_forward *fwd
 	  = XSYMBOL_VALUE_FORWARD (valcontents);
 	int offset = ((char *) symbol_value_forward_forward (fwd)
 			       - (char *) &console_local_flags);
 	int mask =
 	  XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
 	  /* presto change-o! */
 	  goto retry;
 	case SYMVAL_CURRENT_BUFFER_FORWARD:
 	  {
-	    CONST struct symbol_value_forward *fwd
+	    const struct symbol_value_forward *fwd
 	      = XSYMBOL_VALUE_FORWARD (valcontents);
 	    int mask = XINT (*((Lisp_Object *)
 			       symbol_value_forward_forward (fwd)));
 	    if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
 	      /* Already buffer-local */
 int i;
 enum lisp_magic_handler htype;
 Lisp_Object legerdemain;
 struct symbol_value_lisp_magic *bfwd;
-assert (nargs >= 0 && nargs < 20);
+assert (nargs >= 0 && nargs < countof (args));
 legerdemain = XSYMBOL (sym)->value;
 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
 va_start (vargs, nargs);
 htype = decode_magic_handler_type (handler_type);
 valcontents = XSYMBOL (variable)->value;
 if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents))
 {
 bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
-				  lrecord_symbol_value_lisp_magic);
+				  &lrecord_symbol_value_lisp_magic);
 bfwd->magic.type = SYMVAL_LISP_MAGIC;
 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
 	{
 	  bfwd->handler[i] = Qnil;
 	  bfwd->harg[i] = Qnil;
 && !UNBOUNDP (valcontents))
 signal_simple_error ("Variable is magic and cannot be aliased", variable);
 reject_constant_symbols (variable, Qunbound, 0, Qt);
 bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
-			      lrecord_symbol_value_varalias);
+			      &lrecord_symbol_value_varalias);
 bfwd->magic.type = SYMVAL_VARALIAS;
 bfwd->aliasee = alias;
 bfwd->shadowed = valcontents;
 XSETSYMBOL_VALUE_MAGIC (valcontents, bfwd);
 Lisp_Object Qnull_pointer;
 #endif
 /* some losing systems can't have static vars at function scope... */
 static struct symbol_value_magic guts_of_unbound_marker =
-{ { symbol_value_forward_lheader_initializer, 0, 69},
+{ /* struct symbol_value_magic */
-SYMVAL_UNBOUND_MARKER };
+{ /* struct lcrecord_header */
+{ /* struct lrecord_header */
-Lisp_Object Vpure_uninterned_symbol_table;
+1, /* type - index into lrecord_implementations_table */
+0, /* mark */
+0, /* c_readonly */
+0, /* lisp_readonly */
+},
+0, /* next */
+0, /* uid  */
+0, /* free */
+},
+0, /* value */
+SYMVAL_UNBOUND_MARKER
+};
 void
 init_symbols_once_early (void)
 {
-#ifndef Qzero
+reinit_symbols_once_early ();
-Qzero = make_int (0);	/* Only used if Lisp_Object is a union type */
-#endif
+/* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
-#ifndef Qnull_pointer
-/* C guarantees that Qnull_pointer will be initialized to all 0 bits,
-so the following is actually a no-op.  */
-XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
-#endif
-/* see comment in Fpurecopy() */
-Vpure_uninterned_symbol_table =
-make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
-staticpro (&Vpure_uninterned_symbol_table);
-Qnil = Fmake_symbol (make_pure_pname ((CONST Bufbyte *) "nil", 3, 1));
-/* Bootstrapping problem: Qnil isn't set when make_pure_pname is
 called the first time. */
+Qnil = Fmake_symbol (make_string_nocopy ((const Bufbyte *) "nil", 3));
 XSYMBOL (Qnil)->name->plist = Qnil;
 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
 XSYMBOL (Qnil)->plist = Qnil;
 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
 staticpro (&initial_obarray);
 /* Intern nil in the obarray */
 {
 int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3);
 XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil;
-XSYMBOL (Qnil)->obarray = Qt;
 }
 {
 /* Required to get around a GCC syntax error on certain
 architectures */
 struct symbol_value_magic *tem = &guts_of_unbound_marker;
 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
 }
-if ((CONST void *) XPNTR (Qunbound) !=
+if ((const void *) XPNTR (Qunbound) !=
-(CONST void *)&guts_of_unbound_marker)
+(const void *)&guts_of_unbound_marker)
 {
 /* This might happen on DATA_SEG_BITS machines. */
 /* abort (); */
 /* Can't represent a pointer to constant C data using a Lisp_Object.
 	 So heap-allocate it. */
 XSYMBOL (Qnil)->function = Qunbound;
 defsymbol (&Qt, "t");
 XSYMBOL (Qt)->value = Qt;	/* Veritas aetera */
 Vquit_flag = Qnil;
+pdump_wire (&Qnil);
+pdump_wire (&Qunbound);
+pdump_wire (&Vquit_flag);
 }
 void
-defsymbol (Lisp_Object *location, CONST char *name)
+reinit_symbols_once_early (void)
 {
-*location = Fintern (make_pure_pname ((CONST Bufbyte *) name,
+#ifndef Qzero
-strlen (name), 1),
+Qzero = make_int (0);	/* Only used if Lisp_Object is a union type */
+#endif
+#ifndef Qnull_pointer
+/* C guarantees that Qnull_pointer will be initialized to all 0 bits,
+so the following is actually a no-op.  */
+XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
+#endif
+}
+void
+defsymbol_nodump (Lisp_Object *location, const char *name)
+{
+*location = Fintern (make_string_nocopy ((const Bufbyte *) name,
+					   strlen (name)),
+		       Qnil);
+staticpro_nodump (location);
+}
+void
+defsymbol (Lisp_Object *location, const char *name)
+{
+*location = Fintern (make_string_nocopy ((const Bufbyte *) name,
+					   strlen (name)),
 		       Qnil);
 staticpro (location);
 }
 void
-defkeyword (Lisp_Object *location, CONST char *name)
+defkeyword (Lisp_Object *location, const char *name)
 {
 defsymbol (location, name);
 Fset (*location, *location);
 }
 * it if required.
 *
 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
 * a guru to check.
 */
-#define check_module_subr()                                             \
+#define check_module_subr()						\
-do {                                                                    \
+do {									\
-if (initialized) {                                                    \
+if (initialized) {							\
-struct Lisp_Subr *newsubr;                                          \
+Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr));	\
-newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr));           \
+memcpy (newsubr, subr, sizeof (Lisp_Subr));				\
-memcpy (newsubr, subr, sizeof(struct Lisp_Subr));                   \
+subr->doc = (const char *)newsubr;					\
-subr->doc = (CONST char *)newsubr;                                  \
+subr = newsubr;							\
-subr = newsubr;                                                     \
+}									\
-}                                                                     \
 } while (0)
 #else /* ! HAVE_SHLIB */
 #define check_module_subr()
 #endif
 XSETSUBR (fun, subr);
 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
 }
 void
-deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
+deferror (Lisp_Object *symbol, const char *name, const char *messuhhj,
 	  Lisp_Object inherits_from)
 {
 Lisp_Object conds;
 defsymbol (symbol, name);
 assert (SYMBOLP (inherits_from));
 conds = Fget (inherits_from, Qerror_conditions, Qnil);
-pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds));
+Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
 /* NOT build_translated_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.) */
-pure_put (*symbol, Qerror_message, build_string (messuhhj));
+Fput (*symbol, Qerror_message, build_string (messuhhj));
 }
 void
 syms_of_symbols (void)
 {
 defsymbol (&Qmake_unbound, "make-unbound");
 defsymbol (&Qlocal_predicate, "local-predicate");
 defsymbol (&Qmake_local, "make-local");
 defsymbol (&Qboundp, "boundp");
-defsymbol (&Qfboundp, "fboundp");
 defsymbol (&Qglobally_boundp, "globally-boundp");
 defsymbol (&Qmakunbound, "makunbound");
 defsymbol (&Qsymbol_value, "symbol-value");
 defsymbol (&Qset, "set");
 defsymbol (&Qsetq_default, "setq-default");
 DEFSUBR (Fdontusethis_set_symbol_value_handler);
 }
 /* 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 char *symbol_name, const struct symbol_value_forward *magic)
 {
 Lisp_Object sym, kludge;
 /* Check that `magic' points somewhere we can represent as a Lisp pointer */
 XSETOBJ (kludge, Lisp_Type_Record, magic);
 */
 if (initialized)
 sym = Fintern (build_string (symbol_name), Qnil);
 else
 #endif
-sym = Fintern (make_pure_pname ((CONST Bufbyte *) symbol_name,
+sym = Fintern (make_string_nocopy ((const Bufbyte *) symbol_name,
-strlen (symbol_name), 1), Qnil);
+				       strlen (symbol_name)), Qnil);
 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
 }
 void

Mercurial > hg > xemacs-beta

comparison src/symbols.c @ 398:74fd4e045ea6 r21-2-29