+ default:
+ {
+ if (COMPILED_FUNCTIONP (obj))
+ {
+ struct Lisp_Compiled_Function *o = XCOMPILED_FUNCTION (obj);
+ Lisp_Object new = make_compiled_function (1);
+ /* How on earth could this code have worked before? -sb */
+ struct Lisp_Compiled_Function *n = XCOMPILED_FUNCTION (new);
+ n->flags = o->flags;
+ n->bytecodes = Fpurecopy (o->bytecodes);
+ n->constants = Fpurecopy (o->constants);
+ n->arglist = Fpurecopy (o->arglist);
+ n->doc_and_interactive = Fpurecopy (o->doc_and_interactive);
+ n->maxdepth = o->maxdepth;
+ return new;
+ }
+#ifdef LRECORD_CONS
+ else if (CONSP (obj))
+ return pure_cons (XCAR (obj), XCDR (obj));
+#endif /* LRECORD_CONS */
+#ifdef LRECORD_VECTOR
+ else if (VECTORP (obj))
+ {
+ struct Lisp_Vector *o = XVECTOR (obj);
+ Lisp_Object new = make_pure_vector (vector_length (o), Qnil);
+ for (i = 0; i < vector_length (o); i++)
+ XVECTOR_DATA (new)[i] = Fpurecopy (o->contents[i]);
+ return new;
+ }
+#endif /* LRECORD_VECTOR */
+#ifdef LRECORD_STRING
+ else if (STRINGP (obj))
+ {
+ return make_pure_string (XSTRING_DATA (obj),
+ XSTRING_LENGTH (obj),
+ XSTRING (obj)->plist,
+ 0);
+ }
+#endif /* LRECORD_STRING */
+#ifdef LISP_FLOAT_TYPE
+ else if (FLOATP (obj))
+ return make_pure_float (float_data (XFLOAT (obj)));
+#endif /* LISP_FLOAT_TYPE */
+ else if (SYMBOLP (obj))
+ {
+ /*
+ * Symbols can't be made pure (and thus read-only),
+ * because assigning to their function, value or plist
+ * slots would produced a SEGV in the dumped XEmacs. So
+ * we previously would just return the symbol unchanged.
+ *
+ * But purified aggregate objects like lists and vectors
+ * can contain uninterned symbols. If there are no
+ * other non-pure references to the symbol, then the
+ * symbol is not protected from garbage collection
+ * because the collector does not mark the contents of
+ * purified objects. So to protect the symbols, an impure
+ * reference has to be kept for each uninterned symbol
+ * that is referenced by a pure object. All such
+ * symbols are stored in the hashtable pointed to by
+ * Vpure_uninterned_symbol_table, which is itself
+ * staticpro'd.
+ */
+ if (!NILP (XSYMBOL (obj)->obarray))
+ return obj;
+ Fputhash (obj, Qnil, Vpure_uninterned_symbol_table);
+ return obj;
+ }
+ else
+ signal_simple_error ("Can't purecopy %S", obj);
+ }