- 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);
- }