+
+ /* Clear out objects outside the active part of the table. */
+ for (i = index; i < print_number_index; i++)
+ PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
+
+ /* Reset the status field for the next print step. Now this
+ field means whether the object has already been printed. */
+ for (i = start; i < print_number_index; i++)
+ PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
+
+ print_number_index = index;
+ }
+
+ print_depth = 0;
+ print_object (obj, printcharfun, escapeflag);
+}
+
+/* Construct Vprint_number_table according to the structure of OBJ.
+ OBJ itself and all its elements will be added to Vprint_number_table
+ recursively if it is a list, vector, compiled function, char-table,
+ string (its text properties will be traced), or a symbol that has
+ no obarray (this is for the print-gensym feature).
+ The status fields of Vprint_number_table mean whether each object appears
+ more than once in OBJ: Qnil at the first time, and Qt after that . */
+static void
+print_preprocess (obj)
+ Lisp_Object obj;
+{
+ int i;
+ EMACS_INT size;
+ int loop_count = 0;
+ Lisp_Object halftail;
+
+ /* Give up if we go so deep that print_object will get an error. */
+ /* See similar code in print_object. */
+ if (print_depth >= PRINT_CIRCLE)
+ return;
+
+ /* Avoid infinite recursion for circular nested structure
+ in the case where Vprint_circle is nil. */
+ if (NILP (Vprint_circle))
+ {
+ for (i = 0; i < print_depth; i++)
+ if (EQ (obj, being_printed[i]))
+ return;
+ being_printed[print_depth] = obj;
+ }
+
+ print_depth++;
+ halftail = obj;
+
+ loop:
+ if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
+ || COMPILEDP (obj) || CHAR_TABLE_P (obj)
+ || (! NILP (Vprint_gensym)
+ && SYMBOLP (obj)
+ && !SYMBOL_INTERNED_P (obj)))
+ {
+ /* In case print-circle is nil and print-gensym is t,
+ add OBJ to Vprint_number_table only when OBJ is a symbol. */
+ if (! NILP (Vprint_circle) || SYMBOLP (obj))
+ {
+ for (i = 0; i < print_number_index; i++)
+ if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
+ {
+ /* OBJ appears more than once. Let's remember that. */
+ PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
+ return;
+ }
+
+ /* OBJ is not yet recorded. Let's add to the table. */
+ if (print_number_index == 0)
+ {
+ /* Initialize the table. */
+ Vprint_number_table = Fmake_vector (make_number (40), Qnil);
+ }
+ else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
+ {
+ /* Reallocate the table. */
+ int i = print_number_index * 4;
+ Lisp_Object old_table = Vprint_number_table;
+ Vprint_number_table = Fmake_vector (make_number (i), Qnil);
+ for (i = 0; i < print_number_index; i++)
+ {
+ PRINT_NUMBER_OBJECT (Vprint_number_table, i)
+ = PRINT_NUMBER_OBJECT (old_table, i);
+ PRINT_NUMBER_STATUS (Vprint_number_table, i)
+ = PRINT_NUMBER_STATUS (old_table, i);
+ }
+ }
+ PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
+ /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
+ always print the gensym with a number. This is a special for
+ the lisp function byte-compile-output-docform. */
+ if (!NILP (Vprint_continuous_numbering)
+ && SYMBOLP (obj)
+ && !SYMBOL_INTERNED_P (obj))
+ PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
+ print_number_index++;
+ }
+
+ switch (XGCTYPE (obj))
+ {
+ case Lisp_String:
+ /* A string may have text properties, which can be circular. */
+ traverse_intervals_noorder (STRING_INTERVALS (obj),
+ print_preprocess_string, Qnil);
+ break;
+
+ case Lisp_Cons:
+ /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
+ just as in print_object. */
+ if (loop_count && EQ (obj, halftail))
+ break;
+ print_preprocess (XCAR (obj));
+ obj = XCDR (obj);
+ loop_count++;
+ if (!(loop_count & 1))
+ halftail = XCDR (halftail);
+ goto loop;
+
+ case Lisp_Vectorlike:
+ size = XVECTOR (obj)->size;
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ for (i = 0; i < size; i++)
+ print_preprocess (XVECTOR (obj)->contents[i]);
+ break;
+
+ default:
+ break;
+ }
+ }
+ print_depth--;
+}
+
+static void
+print_preprocess_string (interval, arg)
+ INTERVAL interval;
+ Lisp_Object arg;
+{
+ print_preprocess (interval->plist);
+}
+
+static void
+print_object (obj, printcharfun, escapeflag)
+ Lisp_Object obj;
+ register Lisp_Object printcharfun;
+ int escapeflag;
+{
+ char buf[40];
+
+ QUIT;
+
+ /* Detect circularities and truncate them. */
+ if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
+ || COMPILEDP (obj) || CHAR_TABLE_P (obj)
+ || (! NILP (Vprint_gensym)
+ && SYMBOLP (obj)
+ && !SYMBOL_INTERNED_P (obj)))
+ {
+ if (NILP (Vprint_circle) && NILP (Vprint_gensym))
+ {
+ /* Simple but incomplete way. */
+ int i;
+ for (i = 0; i < print_depth; i++)
+ if (EQ (obj, being_printed[i]))
+ {
+ sprintf (buf, "#%d", i);
+ strout (buf, -1, -1, printcharfun, 0);
+ return;
+ }
+ being_printed[print_depth] = obj;
+ }
+ else
+ {
+ /* With the print-circle feature. */
+ int i;
+ for (i = 0; i < print_number_index; i++)
+ if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
+ {
+ if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
+ {
+ /* Add a prefix #n= if OBJ has not yet been printed;
+ that is, its status field is nil. */
+ sprintf (buf, "#%d=", i + 1);
+ strout (buf, -1, -1, printcharfun, 0);
+ /* OBJ is going to be printed. Set the status to t. */
+ PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
+ break;
+ }
+ else
+ {
+ /* Just print #n# if OBJ has already been printed. */
+ sprintf (buf, "#%d#", i + 1);
+ strout (buf, -1, -1, printcharfun, 0);
+ return;
+ }
+ }
+ }