]> code.delx.au - gnu-emacs/blobdiff - src/print.c
(Fbyte_code): Use BEFORE_POTENTIAL_GC and
[gnu-emacs] / src / print.c
index ecd146808edd2a732c3a8bc73eb15a958f8f0811..fe6ec51039999b7ecf1db2d500df9ca082ee2b34 100644 (file)
@@ -1,5 +1,5 @@
 /* Lisp object printing and output streams.
-   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998
+   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999
        Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -60,7 +60,6 @@ Lisp_Object Vfloat_output_format, Qfloat_output_format;
 
 #if STDC_HEADERS
 #include <float.h>
-#include <stdlib.h>
 #endif
 
 /* Default to values appropriate for IEEE floating point.  */
@@ -143,17 +142,33 @@ Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
 
 int print_quoted;
 
-/* Non-nil means print #: before uninterned symbols.
-   Neither t nor nil means so that and don't clear Vprint_gensym_alist
-   on entry to and exit from print functions.  */
+/* Non-nil means print #: before uninterned symbols.  */
 
 Lisp_Object Vprint_gensym;
 
-/* Association list of certain objects that are `eq' in the form being
-   printed and which should be `eq' when read back in, using the #n=object
-   and #n# reader forms.  Each element has the form (object . n).  */
+/* Non-nil means print recursive structures using #n= and #n# syntax.  */
 
-Lisp_Object Vprint_gensym_alist;
+Lisp_Object Vprint_circle;
+
+/* Non-nil means keep continuous number for #n= and #n# syntax
+   between several print functions.  */
+
+Lisp_Object Vprint_continuous_numbering;
+
+/* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
+   where OBJn are objects going to be printed, and STATn are their status,
+   which may be different meanings during process.  See the comments of
+   the functions print and print_preprocess for details.
+   print_number_index keeps the last position the next object should be added,
+   twice of which is the actual vector position in Vprint_number_table.  */
+int print_number_index;
+Lisp_Object Vprint_number_table;
+
+/* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
+   PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
+   See the comment of the variable Vprint_number_table.  */
+#define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
+#define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
 
 /* Nonzero means print newline to stdout before next minibuffer message.
    Defined in xdisp.c */
@@ -237,9 +252,7 @@ void print_interval ();
        print_buffer_pos_byte = 0;                                      \
      }                                                                 \
    if (EQ (printcharfun, Qt))                                          \
-     setup_echo_area_for_printing (multibyte);                         \
-   if (!CONSP (Vprint_gensym))                                         \
-     Vprint_gensym_alist = Qnil
+     setup_echo_area_for_printing (multibyte);
 
 #define PRINTFINISH                                                    \
    if (NILP (printcharfun))                                            \
@@ -272,19 +285,10 @@ void print_interval ();
                  old_point_byte + (old_point_byte >= start_point_byte  \
                               ? PT_BYTE - start_point_byte : 0));      \
    if (old != current_buffer)                                          \
-     set_buffer_internal (old);                                                \
-   if (!CONSP (Vprint_gensym))                                         \
-     Vprint_gensym_alist = Qnil
+     set_buffer_internal (old);
 
 #define PRINTCHAR(ch) printchar (ch, printcharfun)
 
-/* Nonzero if there is no room to print any more characters
-   so print might as well return right away.  */
-
-#define PRINTFULLP()                                   \
- (EQ (printcharfun, Qt) && !noninteractive             \
-  && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
-
 /* This is used to restore the saved contents of print_buffer
    when there is a recursive call to print.  */
 
@@ -384,7 +388,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
         print_chars += size;
 #endif /* MAX_PRINT_CHARS */
     }
-  else if (noninteractive)
+  else if (noninteractive && EQ (printcharfun, Qt))
     {
       fwrite (ptr, 1, size_byte, stdout);
       noninteractive_need_newline = 1;
@@ -498,8 +502,8 @@ print_string (string, printcharfun)
            /* Here, we must convert each multi-byte form to the
               corresponding character code before handing it to PRINTCHAR.  */
            int len;
-           int ch = STRING_CHAR_AND_CHAR_LENGTH (XSTRING (string)->data + i,
-                                                 size_byte - i, len);
+           int ch = STRING_CHAR_AND_LENGTH (XSTRING (string)->data + i,
+                                            size_byte - i, len);
            if (!CHAR_VALID_P (ch, 0))
              {
                ch = XSTRING (string)->data[i];
@@ -664,6 +668,11 @@ buffer and calling the hook.  It gets one argument, the buffer to display.")
 
 \f
 static void print ();
+static void print_preprocess ();
+#ifdef USE_TEXT_PROPERTIES
+static void print_preprocess_string ();
+#endif /* USE_TEXT_PROPERTIES */
+static void print_object ();
 
 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
   "Output a newline to stream PRINTCHARFUN.\n\
@@ -697,7 +706,6 @@ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   PRINTPREPARE;
-  print_depth = 0;
   print (object, printcharfun, 1);
   PRINTFINISH;
   return object;
@@ -727,7 +735,6 @@ second argument NOESCAPE is non-nil.")
 
   printcharfun = Vprin1_to_string_buffer;
   PRINTPREPARE;
-  print_depth = 0;
   print (object, printcharfun, NILP (noescape));
   /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
   PRINTFINISH;
@@ -756,7 +763,6 @@ Output stream is PRINTCHARFUN, or value of standard-output (which see).")
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   PRINTPREPARE;
-  print_depth = 0;
   print (object, printcharfun, 0);
   PRINTFINISH;
   return object;
@@ -781,7 +787,6 @@ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
     printcharfun = Vstandard_output;
   GCPRO1 (object);
   PRINTPREPARE;
-  print_depth = 0;
   PRINTCHAR ('\n');
   print (object, printcharfun, 1);
   PRINTCHAR ('\n');
@@ -836,17 +841,17 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
      Lisp_Object obj;
 {
   struct buffer *old = current_buffer;
-  Lisp_Object original, printcharfun, value;
+  Lisp_Object value;
   struct gcpro gcpro1;
 
   /* If OBJ is (error STRING), just return STRING.
      That is not only faster, it also avoids the need to allocate
      space here when the error is due to memory full.  */
-  if (CONSP (obj) && EQ (XCONS (obj)->car, Qerror)
-      && CONSP (XCONS (obj)->cdr)
-      && STRINGP (XCONS (XCONS (obj)->cdr)->car)
-      && NILP (XCONS (XCONS (obj)->cdr)->cdr))
-    return XCONS (XCONS (obj)->cdr)->car;
+  if (CONSP (obj) && EQ (XCAR (obj), Qerror)
+      && CONSP (XCDR (obj))
+      && STRINGP (XCAR (XCDR (obj)))
+      && NILP (XCDR (XCDR (obj))))
+    return XCAR (XCDR (obj));
 
   print_error_message (obj, Vprin1_to_string_buffer);
 
@@ -896,7 +901,7 @@ print_error_message (data, stream)
   /* For file-error, make error message by concatenating
      all the data items.  They are all strings.  */
   if (!NILP (file_error) && CONSP (tail))
-    errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
+    errmsg = XCAR (tail), tail = XCDR (tail);
 
   if (STRINGP (errmsg))
     Fprinc (errmsg, stream);
@@ -954,6 +959,19 @@ float_to_string (buf, data)
   /* Check for NaN in a way that won't fail if there are no NaNs.  */
   if (! (data * 0.0 >= 0.0))
     {
+      /* Prepend "-" if the NaN's sign bit is negative.
+        The sign bit of a double is the bit that is 1 in -0.0.  */
+      int i;
+      union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
+      u_data.d = data;
+      u_minus_zero.d = - 0.0;
+      for (i = 0; i < sizeof (double); i++)
+       if (u_data.c[i] & u_minus_zero.c[i])
+         {
+           *buf++ = '-';
+           break;
+         }
+      
       strcpy (buf, "0.0e+NaN");
       return;
     }
@@ -1048,27 +1066,194 @@ print (obj, printcharfun, escapeflag)
      register Lisp_Object printcharfun;
      int escapeflag;
 {
-  char buf[30];
+  print_depth = 0;
 
-  QUIT;
+  /* Reset print_number_index and Vprint_number_table only when
+     the variable Vprint_continuous_numbering is nil.  Otherwise,
+     the values of these variables will be kept between several
+     print functions.  */
+  if (NILP (Vprint_continuous_numbering))
+    {
+      print_number_index = 0;
+      Vprint_number_table = Qnil;
+    }
 
-#if 1  /* I'm not sure this is really worth doing.  */
-  /* Detect circularities and truncate them.
-     No need to offer any alternative--this is better than an error.  */
-  if (CONSP (obj) || VECTORP (obj) || COMPILEDP (obj))
+  /* Construct Vprint_number_table for print-gensym and print-circle.  */
+  if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
     {
-      int i;
-      for (i = 0; i < print_depth; i++)
-       if (EQ (obj, being_printed[i]))
+      int i, start, index;
+      /* Construct Vprint_number_table.  */
+      start = index = print_number_index;
+      print_preprocess (obj);
+      /* Remove unnecessary objects, which appear only once in OBJ;
+        that is, whose status is Qnil.  */
+      for (i = start; i < print_number_index; i++)
+       if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
          {
-           sprintf (buf, "#%d", i);
-           strout (buf, -1, -1, printcharfun, 0);
-           return;
+           PRINT_NUMBER_OBJECT (Vprint_number_table, index)
+             = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
+           /* Reset the status field for the next print step.  Now this
+              field means whether the object has already been printed.  */
+           PRINT_NUMBER_STATUS (Vprint_number_table, index) = Qnil;
+           index++;
          }
+      print_number_index = index;
+    }
+
+  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, size;
+
+ loop:
+  if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
+      || COMPILEDP (obj) || CHAR_TABLE_P (obj)
+      || (! NILP (Vprint_gensym)
+         && SYMBOLP (obj) && NILP (XSYMBOL (obj)->obarray)))
+    {
+      /* 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 (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)
+             && NILP (XSYMBOL (obj)->obarray))
+           PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
+         print_number_index++;
+       }
+
+      switch (XGCTYPE (obj))
+       {
+       case Lisp_String:
+#ifdef USE_TEXT_PROPERTIES
+         /* A string may have text properties, which can be circular.  */
+         traverse_intervals (XSTRING (obj)->intervals, 0, 0,
+                             print_preprocess_string, Qnil);
+#endif /* USE_TEXT_PROPERTIES */
+         break;
+
+       case Lisp_Cons:
+         print_preprocess (XCAR (obj));
+         obj = XCDR (obj);
+         goto loop;
+
+       case Lisp_Vectorlike:
+         size = XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK;
+         for (i = 0; i < size; i++)
+           print_preprocess (XVECTOR (obj)->contents[i]);
+       }
+    }
+}
+
+#ifdef USE_TEXT_PROPERTIES
+static void
+print_preprocess_string (interval, arg)
+     INTERVAL interval;
+     Lisp_Object arg;
+{
+  print_preprocess (interval->plist);
+}
+#endif /* USE_TEXT_PROPERTIES */
+
+static void
+print_object (obj, printcharfun, escapeflag)
+     Lisp_Object obj;
+     register Lisp_Object printcharfun;
+     int escapeflag;
+{
+  char buf[30];
+
+  QUIT;
+
+  /* Detect circularities and truncate them.  */
+  if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
+      || COMPILEDP (obj) || CHAR_TABLE_P (obj)
+      || (! NILP (Vprint_gensym)
+         && SYMBOLP (obj) && NILP (XSYMBOL (obj)->obarray)))
+    {
+      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 (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;
+                 }
+             }
+       }
     }
-#endif
 
-  being_printed[print_depth] = obj;
   print_depth++;
 
   if (print_depth > PRINT_CIRCLE)
@@ -1087,7 +1272,7 @@ print (obj, printcharfun, escapeflag)
       if (sizeof (int) == sizeof (EMACS_INT))
        sprintf (buf, "%d", XINT (obj));
       else if (sizeof (long) == sizeof (EMACS_INT))
-       sprintf (buf, "%ld", XINT (obj));
+       sprintf (buf, "%ld", (long) XINT (obj));
       else
        abort ();
       strout (buf, -1, -1, printcharfun, 0);
@@ -1098,7 +1283,7 @@ print (obj, printcharfun, escapeflag)
       {
        char pigbuf[350];       /* see comments in float_to_string */
 
-       float_to_string (pigbuf, XFLOAT(obj)->data);
+       float_to_string (pigbuf, XFLOAT_DATA (obj));
        strout (pigbuf, -1, -1, printcharfun, 0);
       }
       break;
@@ -1110,7 +1295,6 @@ print (obj, printcharfun, escapeflag)
       else
        {
          register int i, i_byte;
-         register unsigned char c;
          struct gcpro gcpro1;
          unsigned char *str;
          int size_byte;
@@ -1141,8 +1325,8 @@ print (obj, printcharfun, escapeflag)
 
              if (STRING_MULTIBYTE (obj))
                {
-                 c = STRING_CHAR_AND_CHAR_LENGTH (str + i_byte,
-                                                  size_byte - i_byte, len);
+                 c = STRING_CHAR_AND_LENGTH (str + i_byte,
+                                             size_byte - i_byte, len);
                  if (CHAR_VALID_P (c, 0))
                    i_byte += len;
                  else
@@ -1250,35 +1434,8 @@ print (obj, printcharfun, escapeflag)
        else
          confusing = 0;
 
-       /* If we print an uninterned symbol as part of a complex object and
-          the flag print-gensym is non-nil, prefix it with #n= to read the
-          object back with the #n# reader syntax later if needed.  */
        if (! NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray))
          {
-           if (print_depth > 1)
-             {
-               Lisp_Object tem;
-               tem = Fassq (obj, Vprint_gensym_alist);
-               if (CONSP (tem))
-                 {
-                   PRINTCHAR ('#');
-                   print (XCDR (tem), printcharfun, escapeflag);
-                   PRINTCHAR ('#');
-                   break;
-                 }
-               else
-                 {
-                   if (CONSP (Vprint_gensym_alist))
-                     XSETFASTINT (tem, XFASTINT (XCDR (XCAR (Vprint_gensym_alist))) + 1);
-                   else
-                     XSETFASTINT (tem, 1);
-                   Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist);
-
-                   PRINTCHAR ('#');
-                   print (tem, printcharfun, escapeflag);
-                   PRINTCHAR ('=');
-                 }
-             }
            PRINTCHAR ('#');
            PRINTCHAR (':');
          }
@@ -1320,14 +1477,14 @@ print (obj, printcharfun, escapeflag)
               && (EQ (XCAR (obj), Qquote)))
        {
          PRINTCHAR ('\'');
-         print (XCAR (XCDR (obj)), printcharfun, escapeflag);
+         print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
        }
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
               && (EQ (XCAR (obj), Qfunction)))
        {
          PRINTCHAR ('#');
          PRINTCHAR ('\'');
-         print (XCAR (XCDR (obj)), printcharfun, escapeflag);
+         print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
        }
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
               && ((EQ (XCAR (obj), Qbackquote)
@@ -1335,8 +1492,8 @@ print (obj, printcharfun, escapeflag)
                    || EQ (XCAR (obj), Qcomma_at)
                    || EQ (XCAR (obj), Qcomma_dot))))
        {
-         print (XCAR (obj), printcharfun, 0);
-         print (XCAR (XCDR (obj)), printcharfun, escapeflag);
+         print_object (XCAR (obj), printcharfun, 0);
+         print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
        }
       else
        {
@@ -1351,21 +1508,47 @@ print (obj, printcharfun, escapeflag)
            while (CONSP (obj))
              {
                /* Detect circular list.  */
-               if (i != 0 && EQ (obj, halftail))
+               if (NILP (Vprint_circle))
                  {
-                   sprintf (buf, " . #%d", i / 2);
-                   strout (buf, -1, -1, printcharfun, 0);
-                   obj = Qnil;
-                   break;
+                   /* Simple but imcomplete way.  */
+                   if (i != 0 && EQ (obj, halftail))
+                     {
+                       sprintf (buf, " . #%d", i / 2);
+                       strout (buf, -1, -1, printcharfun, 0);
+                       goto end_of_list;
+                     }
+                 }
+               else
+                 {
+                   /* With the print-circle feature.  */
+                   if (i != 0)
+                     {
+                       int i;
+                       for (i = 0; i < print_number_index; i++)
+                         if (PRINT_NUMBER_OBJECT (Vprint_number_table, i) == obj)
+                           {
+                             if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
+                               {
+                                 strout (" . ", 3, 3, printcharfun, 0);
+                                 print_object (obj, printcharfun, escapeflag);
+                               }
+                             else
+                               {
+                                 sprintf (buf, " . #%d#", i + 1);
+                                 strout (buf, -1, -1, printcharfun, 0);
+                               }
+                             goto end_of_list;
+                           }
+                     }
                  }
                if (i++)
                  PRINTCHAR (' ');
                if (print_length && i > print_length)
                  {
                    strout ("...", 3, 3, printcharfun, 0);
-                   break;
+                   goto end_of_list;
                  }
-               print (XCAR (obj), printcharfun, escapeflag);
+               print_object (XCAR (obj), printcharfun, escapeflag);
                obj = XCDR (obj);
                if (!(i & 1))
                  halftail = XCDR (halftail);
@@ -1374,8 +1557,9 @@ print (obj, printcharfun, escapeflag)
          if (!NILP (obj))
            {
              strout (" . ", 3, 3, printcharfun, 0);
-             print (obj, printcharfun, escapeflag);
+             print_object (obj, printcharfun, escapeflag);
            }
+       end_of_list:
          PRINTCHAR (')');
        }
       break;
@@ -1539,7 +1723,7 @@ print (obj, printcharfun, escapeflag)
              {
                if (i) PRINTCHAR (' ');
                tem = XVECTOR (obj)->contents[i];
-               print (tem, printcharfun, escapeflag);
+               print_object (tem, printcharfun, escapeflag);
              }
          }
          PRINTCHAR (']');
@@ -1601,22 +1785,22 @@ print (obj, printcharfun, escapeflag)
 
        case Lisp_Misc_Objfwd:
          strout ("#<objfwd to ", -1, -1, printcharfun, 0);
-         print (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
+         print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
          PRINTCHAR ('>');
          break;
 
        case Lisp_Misc_Buffer_Objfwd:
          strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
-         print (*(Lisp_Object *)((char *)current_buffer
-                                 + XBUFFER_OBJFWD (obj)->offset),
+         print_object (*(Lisp_Object *)((char *)current_buffer
+                                        + XBUFFER_OBJFWD (obj)->offset),
                 printcharfun, escapeflag);
          PRINTCHAR ('>');
          break;
 
        case Lisp_Misc_Kboard_Objfwd:
          strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
-         print (*(Lisp_Object *)((char *) current_kboard
-                                 + XKBOARD_OBJFWD (obj)->offset),
+         print_object (*(Lisp_Object *)((char *) current_kboard
+                                        + XKBOARD_OBJFWD (obj)->offset),
                 printcharfun, escapeflag);
          PRINTCHAR ('>');
          break;
@@ -1628,28 +1812,29 @@ print (obj, printcharfun, escapeflag)
          strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
        do_buffer_local:
          strout ("[realvalue] ", -1, -1, printcharfun, 0);
-         print (XBUFFER_LOCAL_VALUE (obj)->realvalue, printcharfun, escapeflag);
+         print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
+                       printcharfun, escapeflag);
          if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
            strout ("[local in buffer] ", -1, -1, printcharfun, 0);
          else
            strout ("[buffer] ", -1, -1, printcharfun, 0);
-         print (XBUFFER_LOCAL_VALUE (obj)->buffer,
-                printcharfun, escapeflag);
+         print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
+                       printcharfun, escapeflag);
          if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
            {
              if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
                strout ("[local in frame] ", -1, -1, printcharfun, 0);
              else
                strout ("[frame] ", -1, -1, printcharfun, 0);
-             print (XBUFFER_LOCAL_VALUE (obj)->frame,
-                    printcharfun, escapeflag);
+             print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
+                           printcharfun, escapeflag);
            }
          strout ("[alist-elt] ", -1, -1, printcharfun, 0);
-         print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->car,
-                printcharfun, escapeflag);
+         print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
+                       printcharfun, escapeflag);
          strout ("[default-value] ", -1, -1, printcharfun, 0);
-         print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr,
-                printcharfun, escapeflag);
+         print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
+                       printcharfun, escapeflag);
          PRINTCHAR ('>');
          break;
 
@@ -1690,12 +1875,12 @@ print_interval (interval, printcharfun)
      Lisp_Object printcharfun;
 {
   PRINTCHAR (' ');
-  print (make_number (interval->position), printcharfun, 1);
+  print_object (make_number (interval->position), printcharfun, 1);
   PRINTCHAR (' ');
-  print (make_number (interval->position + LENGTH (interval)),
+  print_object (make_number (interval->position + LENGTH (interval)),
         printcharfun, 1);
   PRINTCHAR (' ');
-  print (interval->plist, printcharfun, 1);
+  print_object (interval->plist, printcharfun, 1);
 }
 
 #endif /* USE_TEXT_PROPERTIES */
@@ -1773,22 +1958,35 @@ forms print in the new syntax.");
   DEFVAR_LISP ("print-gensym", &Vprint_gensym,
     "Non-nil means print uninterned symbols so they will read as uninterned.\n\
 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
-When the uninterned symbol appears within a larger data structure,\n\
-in addition use the #...# and #...= constructs as needed,\n\
-so that multiple references to the same symbol are shared once again\n\
-when the text is read back.\n\
-\n\
-If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
-clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
-so that the use of #...# and #...= can carry over for several separately\n\
-printed objects.");
+When the uninterned symbol appears within a recursive data structure\n\
+and the symbol appears more than once, in addition use the #N# and #N=\n\
+constructs as needed, so that multiple references to the same symbol are\n\
+shared once again when the text is read back.");
   Vprint_gensym = Qnil;
 
-  DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist,
-    "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\
-In each element, GENSYM is an uninterned symbol that has been associated\n\
-with #N= for the specified value of N.");
-  Vprint_gensym_alist = Qnil;
+  DEFVAR_LISP ("print-circle", &Vprint_circle,
+    "*Non-nil means print recursive structures using #N= and #N# syntax.\n\
+If nil, printing proceeds recursively and may lead to\n\
+`max-lisp-eval-depth' being exceeded or an error may occur:\n\
+\"Apparently circular structure being printed.\"  Also see\n\
+`print-length' and `print-level'.\n\
+If non-nil, shared substructures anywhere in the structure are printed\n\
+with `#N=' before the first occurrence (in the order of the print\n\
+representation) and `#N#' in place of each subsequent occurrence,\n\
+where N is a positive decimal integer.");
+  Vprint_circle = Qnil;
+
+  DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
+  "*Non-nil means keep numbering between several print functions.\n\
+See `print-gensym' nad `print-circle'.  See also `print-number-table'.");
+  Vprint_continuous_numbering = Qnil;
+
+  DEFVAR_LISP ("print-number-table", &Vprint_number_table,
+  "A vector keeping the information of the current printed object.\n\
+This variable shouldn't be modified in Lisp level, but should be binded\n\
+with nil using let at the same position with `print-continuous-numbering',\n\
+so that the value of this variable can be freed after printing.");
+  Vprint_number_table = Qnil;
 
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
   staticpro (&Vprin1_to_string_buffer);