--- a/src/data.c	Mon Aug 13 11:33:40 2007 +0200
+++ b/src/data.c	Mon Aug 13 11:35:02 2007 +0200
@@ -1,6 +1,7 @@
 /* Primitive operations on Lisp data types for XEmacs Lisp interpreter.
    Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995
    Free Software Foundation, Inc.
+   Copyright (C) 2000 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -39,17 +40,22 @@
 
 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
 Lisp_Object Qerror_conditions, Qerror_message;
-Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
+Lisp_Object Qerror, Qquit, Qsyntax_error, Qinvalid_read_syntax;
+Lisp_Object Qlist_formation_error;
+Lisp_Object Qmalformed_list, Qmalformed_property_list;
+Lisp_Object Qcircular_list, Qcircular_property_list;
+Lisp_Object Qinvalid_argument, Qwrong_type_argument, Qargs_out_of_range;
+Lisp_Object Qwrong_number_of_arguments, Qinvalid_function, Qno_catch;
+Lisp_Object Qinternal_error, Qinvalid_state;
 Lisp_Object Qvoid_variable, Qcyclic_variable_indirection;
 Lisp_Object Qvoid_function, Qcyclic_function_indirection;
-Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
-Lisp_Object Qmalformed_list, Qmalformed_property_list;
-Lisp_Object Qcircular_list, Qcircular_property_list;
-Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
+Lisp_Object Qinvalid_operation, Qinvalid_change;
+Lisp_Object Qsetting_constant;
+Lisp_Object Qediting_error;
+Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
 Lisp_Object Qio_error, Qend_of_file;
 Lisp_Object Qarith_error, Qrange_error, Qdomain_error;
 Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error;
-Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
 Lisp_Object Qintegerp, Qnatnump, Qsymbolp;
 Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp;
 Lisp_Object Qconsp, Qsubrp;
@@ -357,7 +363,7 @@
 */
        (subr))
 {
-  CONST char *prompt;
+  const char *prompt;
   CHECK_SUBR (subr);
   prompt = XSUBR (subr)->prompt;
   return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil;
@@ -638,10 +644,11 @@
    return it.  If there is a cycle in the function chain, signal a
    cyclic-function-indirection error.
 
-   This is like Findirect_function, except that it doesn't signal an
-   error if the chain ends up unbound.  */
+   This is like Findirect_function when VOID_FUNCTION_ERRORP is true.
+   When VOID_FUNCTION_ERRORP is false, no error is signaled if the end
+   of the chain ends up being Qunbound. */
 Lisp_Object
-indirect_function (Lisp_Object object, int errorp)
+indirect_function (Lisp_Object object, int void_function_errorp)
 {
 #define FUNCTION_INDIRECTION_SUSPICION_LENGTH 16
   Lisp_Object tortoise, hare;
@@ -659,7 +666,7 @@
 	return Fsignal (Qcyclic_function_indirection, list1 (object));
     }
 
-  if (errorp && UNBOUNDP (hare))
+  if (void_function_errorp && UNBOUNDP (hare))
     return signal_void_function_error (object);
 
   return hare;
@@ -1064,7 +1071,7 @@
     p++;
 
 #ifdef LISP_FLOAT_TYPE
-  if (isfloat_string (p))
+  if (isfloat_string (p) && b == 10)
     return make_float (atof (p));
 #endif /* LISP_FLOAT_TYPE */
 
@@ -1744,6 +1751,23 @@
 		}
 	      break;
 
+	    case WEAK_LIST_FULL_ASSOC:
+	      if (!CONSP (elem))
+		{
+		  /* just leave bogus elements there */
+		  need_to_mark_cons = 1;
+		  need_to_mark_elem = 1;
+		}
+	      else if (marked_p (XCAR (elem)) ||
+		       marked_p (XCDR (elem)))
+		{
+		  need_to_mark_cons = 1;
+		  /* We still need to mark elem and XCAR (elem);
+		     marking elem does both */
+		  need_to_mark_elem = 1;
+		}
+	      break;
+
 	    default:
 	      abort ();
 	    }
@@ -1884,6 +1908,7 @@
   if (EQ (symbol, Qold_assoc))	 return WEAK_LIST_ASSOC;  /* EBOLA ALERT! */
   if (EQ (symbol, Qkey_assoc))	 return WEAK_LIST_KEY_ASSOC;
   if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC;
+  if (EQ (symbol, Qfull_assoc))  return WEAK_LIST_FULL_ASSOC;
 
   signal_simple_error ("Invalid weak list type", symbol);
   return WEAK_LIST_SIMPLE; /* not reached */
@@ -1898,6 +1923,7 @@
     case WEAK_LIST_ASSOC:       return Qassoc;
     case WEAK_LIST_KEY_ASSOC:   return Qkey_assoc;
     case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc;
+    case WEAK_LIST_FULL_ASSOC:  return Qfull_assoc;
     default:
       abort ();
     }
@@ -1936,6 +1962,8 @@
 		and the car is not pointed to.
 `value-assoc'	Objects in the list disappear if they are conses
 		and the cdr is not pointed to.
+`full-assoc'	Objects in the list disappear if they are conses
+		and neither the car nor the cdr is pointed to.
 */
        (type))
 {
@@ -2006,8 +2034,8 @@
 void
 init_errors_once_early (void)
 {
-  defsymbol (&Qerror_conditions, "error-conditions");
-  defsymbol (&Qerror_message, "error-message");
+  DEFSYMBOL (Qerror_conditions);
+  DEFSYMBOL (Qerror_message);
 
   /* We declare the errors here because some other deferrors depend
      on some of the errors below. */
@@ -2015,96 +2043,100 @@
   /* ERROR is used as a signaler for random errors for which nothing
      else is right */
 
-  deferror (&Qerror, "error", "error", Qnil);
-  deferror (&Qquit, "quit", "Quit", Qnil);
+  DEFERROR (Qerror, "error", Qnil);
+  DEFERROR_STANDARD (Qquit, Qnil);
 
-  deferror (&Qwrong_type_argument, "wrong-type-argument",
-	    "Wrong type argument", Qerror);
-  deferror (&Qargs_out_of_range, "args-out-of-range", "Args out of range",
-	    Qerror);
-  deferror (&Qvoid_function, "void-function",
-	    "Symbol's function definition is void", Qerror);
-  deferror (&Qcyclic_function_indirection, "cyclic-function-indirection",
-	    "Symbol's chain of function indirections contains a loop", Qerror);
-  deferror (&Qvoid_variable, "void-variable",
-	    "Symbol's value as variable is void", Qerror);
-  deferror (&Qcyclic_variable_indirection, "cyclic-variable-indirection",
-	    "Symbol's chain of variable indirections contains a loop", Qerror);
-  deferror (&Qsetting_constant, "setting-constant",
-	    "Attempt to set a constant symbol", Qerror);
-  deferror (&Qinvalid_read_syntax, "invalid-read-syntax",
-	    "Invalid read syntax", Qerror);
+  DEFERROR (Qunimplemented, "Feature not yet implemented", Qerror);
+  DEFERROR_STANDARD (Qsyntax_error, Qerror);
+  DEFERROR_STANDARD (Qinvalid_read_syntax, Qsyntax_error);
+  DEFERROR_STANDARD (Qlist_formation_error, Qsyntax_error);
 
   /* Generated by list traversal macros */
-  deferror (&Qmalformed_list, "malformed-list",
-	    "Malformed list", Qerror);
-  deferror (&Qmalformed_property_list, "malformed-property-list",
-	    "Malformed property list", Qmalformed_list);
-  deferror (&Qcircular_list, "circular-list",
-	    "Circular list", Qerror);
-  deferror (&Qcircular_property_list, "circular-property-list",
-	    "Circular property list", Qcircular_list);
+  DEFERROR_STANDARD (Qmalformed_list, Qlist_formation_error);
+  DEFERROR_STANDARD (Qmalformed_property_list, Qmalformed_list);
+  DEFERROR_STANDARD (Qcircular_list, Qlist_formation_error);
+  DEFERROR_STANDARD (Qcircular_property_list, Qcircular_list);
 
-  deferror (&Qinvalid_function, "invalid-function", "Invalid function",
-	    Qerror);
-  deferror (&Qwrong_number_of_arguments, "wrong-number-of-arguments",
-	    "Wrong number of arguments", Qerror);
-  deferror (&Qno_catch, "no-catch", "No catch for tag",
+  DEFERROR_STANDARD (Qinvalid_argument, Qerror);
+  DEFERROR_STANDARD (Qwrong_type_argument, Qinvalid_argument);
+  DEFERROR_STANDARD (Qargs_out_of_range, Qinvalid_argument);
+  DEFERROR_STANDARD (Qwrong_number_of_arguments, Qinvalid_argument);
+  DEFERROR_STANDARD (Qinvalid_function, Qinvalid_argument);
+  DEFERROR (Qno_catch, "No catch for tag", Qinvalid_argument);
+
+  DEFERROR_STANDARD (Qinternal_error, Qerror);
+
+  DEFERROR (Qinvalid_state, "Properties or values have been set incorrectly",
 	    Qerror);
-  deferror (&Qbeginning_of_buffer, "beginning-of-buffer",
-	    "Beginning of buffer", Qerror);
-  deferror (&Qend_of_buffer, "end-of-buffer", "End of buffer", Qerror);
-  deferror (&Qbuffer_read_only, "buffer-read-only", "Buffer is read-only",
-	    Qerror);
-
-  deferror (&Qio_error, "io-error", "IO Error", Qerror);
-  deferror (&Qend_of_file, "end-of-file", "End of stream", Qio_error);
+  DEFERROR (Qvoid_function, "Symbol's function definition is void",
+	    Qinvalid_state);
+  DEFERROR (Qcyclic_function_indirection,
+	    "Symbol's chain of function indirections contains a loop",
+	    Qinvalid_state);
+  DEFERROR (Qvoid_variable, "Symbol's value as variable is void",
+	    Qinvalid_state);
+  DEFERROR (Qcyclic_variable_indirection,
+	    "Symbol's chain of variable indirections contains a loop",
+	    Qinvalid_state);
 
-  deferror (&Qarith_error, "arith-error", "Arithmetic error", Qerror);
-  deferror (&Qrange_error, "range-error", "Arithmetic range error",
-	    Qarith_error);
-  deferror (&Qdomain_error, "domain-error", "Arithmetic domain error",
-	    Qarith_error);
-  deferror (&Qsingularity_error, "singularity-error",
-	    "Arithmetic singularity error", Qdomain_error);
-  deferror (&Qoverflow_error, "overflow-error",
-	    "Arithmetic overflow error", Qdomain_error);
-  deferror (&Qunderflow_error, "underflow-error",
-	    "Arithmetic underflow error", Qdomain_error);
+  DEFERROR (Qinvalid_operation,
+	    "Operation not allowed or error during operation", Qerror);
+  DEFERROR (Qinvalid_change, "Attempt to set properties or values incorrectly",
+	    Qinvalid_operation);
+  DEFERROR (Qsetting_constant, "Attempt to set a constant symbol",
+	    Qinvalid_change);
+
+  DEFERROR (Qediting_error, "Invalid operation during editing",
+	    Qinvalid_operation);
+  DEFERROR_STANDARD (Qbeginning_of_buffer, Qediting_error);
+  DEFERROR_STANDARD (Qend_of_buffer, Qediting_error);
+  DEFERROR (Qbuffer_read_only, "Buffer is read-only", Qediting_error);
+
+  DEFERROR (Qio_error, "IO Error", Qinvalid_operation);
+  DEFERROR (Qend_of_file, "End of file or stream", Qio_error);
+
+  DEFERROR (Qarith_error, "Arithmetic error", Qinvalid_operation);
+  DEFERROR (Qrange_error, "Arithmetic range error", Qarith_error);
+  DEFERROR (Qdomain_error, "Arithmetic domain error", Qarith_error);
+  DEFERROR (Qsingularity_error, "Arithmetic singularity error", Qdomain_error);
+  DEFERROR (Qoverflow_error, "Arithmetic overflow error", Qdomain_error);
+  DEFERROR (Qunderflow_error, "Arithmetic underflow error", Qdomain_error);
 }
 
 void
 syms_of_data (void)
 {
-  defsymbol (&Qquote, "quote");
-  defsymbol (&Qlambda, "lambda");
-  defsymbol (&Qlistp, "listp");
-  defsymbol (&Qtrue_list_p, "true-list-p");
-  defsymbol (&Qconsp, "consp");
-  defsymbol (&Qsubrp, "subrp");
-  defsymbol (&Qsymbolp, "symbolp");
-  defsymbol (&Qintegerp, "integerp");
-  defsymbol (&Qcharacterp, "characterp");
-  defsymbol (&Qnatnump, "natnump");
-  defsymbol (&Qstringp, "stringp");
-  defsymbol (&Qarrayp, "arrayp");
-  defsymbol (&Qsequencep, "sequencep");
-  defsymbol (&Qbufferp, "bufferp");
-  defsymbol (&Qbitp, "bitp");
-  defsymbol (&Qbit_vectorp, "bit-vector-p");
-  defsymbol (&Qvectorp, "vectorp");
-  defsymbol (&Qchar_or_string_p, "char-or-string-p");
-  defsymbol (&Qmarkerp, "markerp");
-  defsymbol (&Qinteger_or_marker_p, "integer-or-marker-p");
-  defsymbol (&Qinteger_or_char_p, "integer-or-char-p");
-  defsymbol (&Qinteger_char_or_marker_p, "integer-char-or-marker-p");
-  defsymbol (&Qnumberp, "numberp");
-  defsymbol (&Qnumber_char_or_marker_p, "number-char-or-marker-p");
-  defsymbol (&Qcdr, "cdr");
-  defsymbol (&Qweak_listp, "weak-list-p");
+  INIT_LRECORD_IMPLEMENTATION (weak_list);
+
+  DEFSYMBOL (Qquote);
+  DEFSYMBOL (Qlambda);
+  DEFSYMBOL (Qlistp);
+  DEFSYMBOL (Qtrue_list_p);
+  DEFSYMBOL (Qconsp);
+  DEFSYMBOL (Qsubrp);
+  DEFSYMBOL (Qsymbolp);
+  DEFSYMBOL (Qintegerp);
+  DEFSYMBOL (Qcharacterp);
+  DEFSYMBOL (Qnatnump);
+  DEFSYMBOL (Qstringp);
+  DEFSYMBOL (Qarrayp);
+  DEFSYMBOL (Qsequencep);
+  DEFSYMBOL (Qbufferp);
+  DEFSYMBOL (Qbitp);
+  DEFSYMBOL_MULTIWORD_PREDICATE (Qbit_vectorp);
+  DEFSYMBOL (Qvectorp);
+  DEFSYMBOL (Qchar_or_string_p);
+  DEFSYMBOL (Qmarkerp);
+  DEFSYMBOL (Qinteger_or_marker_p);
+  DEFSYMBOL (Qinteger_or_char_p);
+  DEFSYMBOL (Qinteger_char_or_marker_p);
+  DEFSYMBOL (Qnumberp);
+  DEFSYMBOL (Qnumber_char_or_marker_p);
+  DEFSYMBOL (Qcdr);
+  DEFSYMBOL_MULTIWORD_PREDICATE (Qweak_listp);
 
 #ifdef LISP_FLOAT_TYPE
-  defsymbol (&Qfloatp, "floatp");
+  DEFSYMBOL (Qfloatp);
 #endif /* LISP_FLOAT_TYPE */
 
   DEFSUBR (Fwrong_type_argument);