]> code.delx.au - gnu-emacs/blobdiff - src/print.c
(remove-overlays): Fix last change.
[gnu-emacs] / src / print.c
index 163c23cb8be22d9eac39b37c0b0f44d41e5a6ca2..c81f99f6436cf2e0f4d04c99c324c445e19549e3 100644 (file)
@@ -1,6 +1,7 @@
 /* Lisp object printing and output streams.
 /* Lisp object printing and output streams.
-   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998
-       Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
+                 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+                 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 
 This file is part of GNU Emacs.
 
@@ -16,8 +17,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 
 #include <config.h>
 
 
 #include <config.h>
@@ -25,16 +26,13 @@ Boston, MA 02111-1307, USA.  */
 #include "lisp.h"
 #include "buffer.h"
 #include "charset.h"
 #include "lisp.h"
 #include "buffer.h"
 #include "charset.h"
+#include "keyboard.h"
 #include "frame.h"
 #include "window.h"
 #include "process.h"
 #include "dispextern.h"
 #include "termchar.h"
 #include "frame.h"
 #include "window.h"
 #include "process.h"
 #include "dispextern.h"
 #include "termchar.h"
-#include "keyboard.h"
-
-#ifdef USE_TEXT_PROPERTIES
 #include "intervals.h"
 #include "intervals.h"
-#endif
 
 Lisp_Object Vstandard_output, Qstandard_output;
 
 
 Lisp_Object Vstandard_output, Qstandard_output;
 
@@ -43,7 +41,6 @@ Lisp_Object Qtemp_buffer_setup_hook;
 /* These are used to print like we read.  */
 extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
 
 /* These are used to print like we read.  */
 extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
 
-#ifdef LISP_FLOAT_TYPE
 Lisp_Object Vfloat_output_format, Qfloat_output_format;
 
 /* Work around a problem that happens because math.h on hpux 7
 Lisp_Object Vfloat_output_format, Qfloat_output_format;
 
 /* Work around a problem that happens because math.h on hpux 7
@@ -60,7 +57,6 @@ Lisp_Object Vfloat_output_format, Qfloat_output_format;
 
 #if STDC_HEADERS
 #include <float.h>
 
 #if STDC_HEADERS
 #include <float.h>
-#include <stdlib.h>
 #endif
 
 /* Default to values appropriate for IEEE floating point.  */
 #endif
 
 /* Default to values appropriate for IEEE floating point.  */
@@ -93,11 +89,12 @@ Lisp_Object Vfloat_output_format, Qfloat_output_format;
 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
 #endif
 
 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
 #endif
 
-#endif /* LISP_FLOAT_TYPE */
-
 /* Avoid actual stack overflow in print.  */
 int print_depth;
 
 /* Avoid actual stack overflow in print.  */
 int print_depth;
 
+/* Nonzero if inside outputting backquote in old style.  */
+int old_backquote_output;
+
 /* Detect most circularities to print finite output.  */
 #define PRINT_CIRCLE 200
 Lisp_Object being_printed[PRINT_CIRCLE];
 /* Detect most circularities to print finite output.  */
 #define PRINT_CIRCLE 200
 Lisp_Object being_printed[PRINT_CIRCLE];
@@ -185,6 +182,9 @@ static int max_print;
 
 void print_interval ();
 
 
 void print_interval ();
 
+/* GDB resets this to zero on W32 to disable OutputDebugString calls.  */
+int print_output_debug_flag = 1;
+
 \f
 /* Low level output routines for characters and strings */
 
 \f
 /* Low level output routines for characters and strings */
 
@@ -193,13 +193,13 @@ void print_interval ();
    and must start with PRINTPREPARE, end with PRINTFINISH,
    and use PRINTDECLARE to declare common variables.
    Use PRINTCHAR to output one character,
    and must start with PRINTPREPARE, end with PRINTFINISH,
    and use PRINTDECLARE to declare common variables.
    Use PRINTCHAR to output one character,
-   or call strout to output a block of characters. */ 
+   or call strout to output a block of characters. */
 
 #define PRINTDECLARE                                                   \
    struct buffer *old = current_buffer;                                        \
 
 #define PRINTDECLARE                                                   \
    struct buffer *old = current_buffer;                                        \
-   int old_point = -1, start_point;                                    \
-   int old_point_byte, start_point_byte;                               \
-   int specpdl_count = specpdl_ptr - specpdl;                          \
+   int old_point = -1, start_point = -1;                               \
+   int old_point_byte = -1, start_point_byte = -1;                     \
+   int specpdl_count = SPECPDL_INDEX ();                               \
    int free_print_buffer = 0;                                          \
    int multibyte = !NILP (current_buffer->enable_multibyte_characters);        \
    Lisp_Object original
    int free_print_buffer = 0;                                          \
    int multibyte = !NILP (current_buffer->enable_multibyte_characters);        \
    Lisp_Object original
@@ -215,13 +215,17 @@ void print_interval ();
      }                                                                 \
    if (MARKERP (printcharfun))                                         \
      {                                                                 \
      }                                                                 \
    if (MARKERP (printcharfun))                                         \
      {                                                                 \
-       if (!(XMARKER (original)->buffer))                              \
+       EMACS_INT marker_pos;                                           \
+       if (! XMARKER (printcharfun)->buffer)                           \
          error ("Marker does not point anywhere");                     \
          error ("Marker does not point anywhere");                     \
-       if (XMARKER (original)->buffer != current_buffer)               \
-         set_buffer_internal (XMARKER (original)->buffer);             \
+       if (XMARKER (printcharfun)->buffer != current_buffer)           \
+         set_buffer_internal (XMARKER (printcharfun)->buffer);         \
+       marker_pos = marker_position (printcharfun);                    \
+       if (marker_pos < BEGV || marker_pos > ZV)                       \
+        error ("Marker is outside the accessible part of the buffer"); \
        old_point = PT;                                                 \
        old_point_byte = PT_BYTE;                                       \
        old_point = PT;                                                 \
        old_point_byte = PT_BYTE;                                       \
-       SET_PT_BOTH (marker_position (printcharfun),                    \
+       SET_PT_BOTH (marker_pos,                                                \
                    marker_byte_position (printcharfun));               \
        start_point = PT;                                               \
        start_point_byte = PT_BYTE;                                     \
                    marker_byte_position (printcharfun));               \
        start_point = PT;                                               \
        start_point_byte = PT_BYTE;                                     \
@@ -252,7 +256,7 @@ void print_interval ();
        print_buffer_pos = 0;                                           \
        print_buffer_pos_byte = 0;                                      \
      }                                                                 \
        print_buffer_pos = 0;                                           \
        print_buffer_pos_byte = 0;                                      \
      }                                                                 \
-   if (EQ (printcharfun, Qt))                                          \
+   if (EQ (printcharfun, Qt) && ! noninteractive)                      \
      setup_echo_area_for_printing (multibyte);
 
 #define PRINTFINISH                                                    \
      setup_echo_area_for_printing (multibyte);
 
 #define PRINTFINISH                                                    \
@@ -271,6 +275,7 @@ void print_interval ();
        else                                                            \
         insert_1_both (print_buffer, print_buffer_pos,                 \
                        print_buffer_pos_byte, 0, 1, 0);                \
        else                                                            \
         insert_1_both (print_buffer, print_buffer_pos,                 \
                        print_buffer_pos_byte, 0, 1, 0);                \
+       signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
      }                                                                 \
    if (free_print_buffer)                                              \
      {                                                                 \
      }                                                                 \
    if (free_print_buffer)                                              \
      {                                                                 \
@@ -284,7 +289,7 @@ void print_interval ();
      SET_PT_BOTH (old_point + (old_point >= start_point                        \
                               ? PT - start_point : 0),                 \
                  old_point_byte + (old_point_byte >= start_point_byte  \
      SET_PT_BOTH (old_point + (old_point >= start_point                        \
                               ? PT - start_point : 0),                 \
                  old_point_byte + (old_point_byte >= start_point_byte  \
-                              ? PT_BYTE - start_point_byte : 0));      \
+                                   ? PT_BYTE - start_point_byte : 0)); \
    if (old != current_buffer)                                          \
      set_buffer_internal (old);
 
    if (old != current_buffer)                                          \
      set_buffer_internal (old);
 
@@ -297,7 +302,8 @@ static Lisp_Object
 print_unwind (saved_text)
      Lisp_Object saved_text;
 {
 print_unwind (saved_text)
      Lisp_Object saved_text;
 {
-  bcopy (XSTRING (saved_text)->data, print_buffer, XSTRING (saved_text)->size);
+  bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
+  return Qnil;
 }
 
 
 }
 
 
@@ -320,11 +326,11 @@ printchar (ch, fun)
     call1 (fun, make_number (ch));
   else
     {
     call1 (fun, make_number (ch));
   else
     {
-      unsigned char work[4], *str;
-      int len = CHAR_STRING (ch, work, str);
-    
+      unsigned char str[MAX_MULTIBYTE_LENGTH];
+      int len = CHAR_STRING (ch, str);
+
       QUIT;
       QUIT;
-      
+
       if (NILP (fun))
        {
          if (print_buffer_pos_byte + len >= print_buffer_size)
       if (NILP (fun))
        {
          if (print_buffer_pos_byte + len >= print_buffer_size)
@@ -343,10 +349,8 @@ printchar (ch, fun)
        {
          int multibyte_p
            = !NILP (current_buffer->enable_multibyte_characters);
        {
          int multibyte_p
            = !NILP (current_buffer->enable_multibyte_characters);
-         
-         if (!message_buf_print)
-           setup_echo_area_for_printing (multibyte_p);
 
 
+         setup_echo_area_for_printing (multibyte_p);
          insert_char (ch);
          message_dolog (str, len, 0, multibyte_p);
        }
          insert_char (ch);
          message_dolog (str, len, 0, multibyte_p);
        }
@@ -360,7 +364,10 @@ printchar (ch, fun)
    print_buffer.  PRINTCHARFUN t means output to the echo area or to
    stdout if non-interactive.  If neither nil nor t, call Lisp
    function PRINTCHARFUN for each character printed.  MULTIBYTE
    print_buffer.  PRINTCHARFUN t means output to the echo area or to
    stdout if non-interactive.  If neither nil nor t, call Lisp
    function PRINTCHARFUN for each character printed.  MULTIBYTE
-   non-zero means PTR contains multibyte characters.  */
+   non-zero means PTR contains multibyte characters.
+
+   In the case where PRINTCHARFUN is nil, it is safe for PTR to point
+   to data in a Lisp string.  Otherwise that is not safe.  */
 
 static void
 strout (ptr, size, size_byte, printcharfun, multibyte)
 
 static void
 strout (ptr, size, size_byte, printcharfun, multibyte)
@@ -389,7 +396,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
         print_chars += size;
 #endif /* MAX_PRINT_CHARS */
     }
         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;
     {
       fwrite (ptr, 1, size_byte, stdout);
       noninteractive_need_newline = 1;
@@ -402,16 +409,14 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
       int i;
       int multibyte_p
        = !NILP (current_buffer->enable_multibyte_characters);
       int i;
       int multibyte_p
        = !NILP (current_buffer->enable_multibyte_characters);
-      
-      if (!message_buf_print)
-       setup_echo_area_for_printing (multibyte_p);
-      
+
+      setup_echo_area_for_printing (multibyte_p);
       message_dolog (ptr, size_byte, 0, multibyte_p);
       message_dolog (ptr, size_byte, 0, multibyte_p);
-      
+
       if (size == size_byte)
        {
          for (i = 0; i < size; ++i)
       if (size == size_byte)
        {
          for (i = 0; i < size; ++i)
-           insert_char (*ptr++);
+           insert_char ((unsigned char) *ptr++);
        }
       else
        {
        }
       else
        {
@@ -422,7 +427,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
              insert_char (ch);
            }
        }
              insert_char (ch);
            }
        }
-      
+
 #ifdef MAX_PRINT_CHARS
       if (max_print)
         print_chars += size;
 #ifdef MAX_PRINT_CHARS
       if (max_print)
         print_chars += size;
@@ -471,43 +476,77 @@ print_string (string, printcharfun)
       int chars;
 
       if (STRING_MULTIBYTE (string))
       int chars;
 
       if (STRING_MULTIBYTE (string))
-       chars = XSTRING (string)->size;
+       chars = SCHARS (string);
       else if (EQ (printcharfun, Qt)
               ? ! NILP (buffer_defaults.enable_multibyte_characters)
               : ! NILP (current_buffer->enable_multibyte_characters))
       else if (EQ (printcharfun, Qt)
               ? ! NILP (buffer_defaults.enable_multibyte_characters)
               : ! NILP (current_buffer->enable_multibyte_characters))
-       chars = multibyte_chars_in_text (XSTRING (string)->data,
-                                        STRING_BYTES (XSTRING (string)));
+       {
+         /* If unibyte string STRING contains 8-bit codes, we must
+            convert STRING to a multibyte string containing the same
+            character codes.  */
+         Lisp_Object newstr;
+         int bytes;
+
+         chars = SBYTES (string);
+         bytes = parse_str_to_multibyte (SDATA (string), chars);
+         if (chars < bytes)
+           {
+             newstr = make_uninit_multibyte_string (chars, bytes);
+             bcopy (SDATA (string), SDATA (newstr), chars);
+             str_to_multibyte (SDATA (newstr), bytes, chars);
+             string = newstr;
+           }
+       }
       else
       else
-       chars = STRING_BYTES (XSTRING (string));
+       chars = SBYTES (string);
+
+      if (EQ (printcharfun, Qt))
+       {
+         /* Output to echo area.  */
+         int nbytes = SBYTES (string);
+         char *buffer;
+
+         /* Copy the string contents so that relocation of STRING by
+            GC does not cause trouble.  */
+         USE_SAFE_ALLOCA;
+
+         SAFE_ALLOCA (buffer, char *, nbytes);
+         bcopy (SDATA (string), buffer, nbytes);
 
 
-      /* strout is safe for output to a frame (echo area) or to print_buffer.  */
-      strout (XSTRING (string)->data,
-             chars, STRING_BYTES (XSTRING (string)),
-             printcharfun, STRING_MULTIBYTE (string));
+         strout (buffer, chars, SBYTES (string),
+                 printcharfun, STRING_MULTIBYTE (string));
+
+         SAFE_FREE ();
+       }
+      else
+       /* No need to copy, since output to print_buffer can't GC.  */
+       strout (SDATA (string),
+               chars, SBYTES (string),
+               printcharfun, STRING_MULTIBYTE (string));
     }
   else
     {
       /* Otherwise, string may be relocated by printing one char.
         So re-fetch the string address for each character.  */
       int i;
     }
   else
     {
       /* Otherwise, string may be relocated by printing one char.
         So re-fetch the string address for each character.  */
       int i;
-      int size = XSTRING (string)->size;
-      int size_byte = STRING_BYTES (XSTRING (string));
+      int size = SCHARS (string);
+      int size_byte = SBYTES (string);
       struct gcpro gcpro1;
       GCPRO1 (string);
       if (size == size_byte)
        for (i = 0; i < size; i++)
       struct gcpro gcpro1;
       GCPRO1 (string);
       if (size == size_byte)
        for (i = 0; i < size; i++)
-         PRINTCHAR (XSTRING (string)->data[i]);
+         PRINTCHAR (SREF (string, i));
       else
       else
-       for (i = 0; i < size_byte; i++)
+       for (i = 0; i < size_byte; )
          {
            /* Here, we must convert each multi-byte form to the
               corresponding character code before handing it to PRINTCHAR.  */
            int len;
          {
            /* 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_LENGTH (XSTRING (string)->data + i,
+           int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
                                             size_byte - i, len);
            if (!CHAR_VALID_P (ch, 0))
              {
                                             size_byte - i, len);
            if (!CHAR_VALID_P (ch, 0))
              {
-               ch = XSTRING (string)->data[i];
+               ch = SREF (string, i);
                len = 1;
              }
            PRINTCHAR (ch);
                len = 1;
              }
            PRINTCHAR (ch);
@@ -518,16 +557,16 @@ print_string (string, printcharfun)
 }
 \f
 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
 }
 \f
 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
-  "Output character CHARACTER to stream PRINTCHARFUN.\n\
-PRINTCHARFUN defaults to the value of `standard-output' (which see).")
-  (character, printcharfun)
+       doc: /* Output character CHARACTER to stream PRINTCHARFUN.
+PRINTCHARFUN defaults to the value of `standard-output' (which see).  */)
+     (character, printcharfun)
      Lisp_Object character, printcharfun;
 {
   PRINTDECLARE;
 
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
      Lisp_Object character, printcharfun;
 {
   PRINTDECLARE;
 
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
-  CHECK_NUMBER (character, 0);
+  CHECK_NUMBER (character);
   PRINTPREPARE;
   PRINTCHAR (XINT (character));
   PRINTFINISH;
   PRINTPREPARE;
   PRINTCHAR (XINT (character));
   PRINTFINISH;
@@ -573,9 +612,9 @@ write_string_1 (data, size, printcharfun)
 
 void
 temp_output_buffer_setup (bufname)
 
 void
 temp_output_buffer_setup (bufname)
-    char *bufname;
+    const char *bufname;
 {
 {
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   register struct buffer *old = current_buffer;
   register Lisp_Object buf;
 
   register struct buffer *old = current_buffer;
   register Lisp_Object buf;
 
@@ -583,18 +622,22 @@ temp_output_buffer_setup (bufname)
 
   Fset_buffer (Fget_buffer_create (build_string (bufname)));
 
 
   Fset_buffer (Fget_buffer_create (build_string (bufname)));
 
+  Fkill_all_local_variables ();
+  delete_all_overlays (current_buffer);
   current_buffer->directory = old->directory;
   current_buffer->read_only = Qnil;
   current_buffer->filename = Qnil;
   current_buffer->undo_list = Qt;
   current_buffer->directory = old->directory;
   current_buffer->read_only = Qnil;
   current_buffer->filename = Qnil;
   current_buffer->undo_list = Qt;
-  current_buffer->overlays_before = Qnil;
-  current_buffer->overlays_after = Qnil;
+  eassert (current_buffer->overlays_before == NULL);
+  eassert (current_buffer->overlays_after == NULL);
   current_buffer->enable_multibyte_characters
     = buffer_defaults.enable_multibyte_characters;
   current_buffer->enable_multibyte_characters
     = buffer_defaults.enable_multibyte_characters;
+  specbind (Qinhibit_read_only, Qt);
+  specbind (Qinhibit_modification_hooks, Qt);
   Ferase_buffer ();
   XSETBUFFER (buf, current_buffer);
 
   Ferase_buffer ();
   XSETBUFFER (buf, current_buffer);
 
-  call1 (Vrun_hooks, Qtemp_buffer_setup_hook);
+  Frun_hooks (1, &Qtemp_buffer_setup_hook);
 
   unbind_to (count, Qnil);
 
 
   unbind_to (count, Qnil);
 
@@ -603,11 +646,11 @@ temp_output_buffer_setup (bufname)
 
 Lisp_Object
 internal_with_output_to_temp_buffer (bufname, function, args)
 
 Lisp_Object
 internal_with_output_to_temp_buffer (bufname, function, args)
-     char *bufname;
+     const char *bufname;
      Lisp_Object (*function) P_ ((Lisp_Object));
      Lisp_Object args;
 {
      Lisp_Object (*function) P_ ((Lisp_Object));
      Lisp_Object args;
 {
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   Lisp_Object buf, val;
   struct gcpro gcpro1;
 
   Lisp_Object buf, val;
   struct gcpro gcpro1;
 
@@ -626,43 +669,47 @@ internal_with_output_to_temp_buffer (bufname, function, args)
   return unbind_to (count, val);
 }
 
   return unbind_to (count, val);
 }
 
-DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
+DEFUN ("with-output-to-temp-buffer",
+       Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
        1, UNEVALLED, 0,
        1, UNEVALLED, 0,
-  "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
-The buffer is cleared out initially, and marked as unmodified when done.\n\
-All output done by BODY is inserted in that buffer by default.\n\
-The buffer is displayed in another window, but not selected.\n\
-The value of the last form in BODY is returned.\n\
-If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\
-\n\
-The hook `temp-buffer-setup-hook' is run before BODY,\n\
-with the buffer BUFNAME temporarily current.\n\
-The hook `temp-buffer-show-hook' is run after the buffer is displayed,\n\
-with the buffer temporarily current, and the window that was used\n\
-to display it temporarily selected.\n\
-\n\
-If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
-to get the buffer displayed instead of just displaying the non-selected\n\
-buffer and calling the hook.  It gets one argument, the buffer to display.")
-  (args)
+       doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
+The buffer is cleared out initially, and marked as unmodified when done.
+All output done by BODY is inserted in that buffer by default.
+The buffer is displayed in another window, but not selected.
+The value of the last form in BODY is returned.
+If BODY does not finish normally, the buffer BUFNAME is not displayed.
+
+The hook `temp-buffer-setup-hook' is run before BODY,
+with the buffer BUFNAME temporarily current.
+The hook `temp-buffer-show-hook' is run after the buffer is displayed,
+with the buffer temporarily current, and the window that was used
+to display it temporarily selected.
+
+If variable `temp-buffer-show-function' is non-nil, call it at the end
+to get the buffer displayed instead of just displaying the non-selected
+buffer and calling the hook.  It gets one argument, the buffer to display.
+
+usage: (with-output-to-temp-buffer BUFNAME BODY ...)  */)
+     (args)
      Lisp_Object args;
 {
   struct gcpro gcpro1;
   Lisp_Object name;
      Lisp_Object args;
 {
   struct gcpro gcpro1;
   Lisp_Object name;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   Lisp_Object buf, val;
 
   GCPRO1(args);
   name = Feval (Fcar (args));
   Lisp_Object buf, val;
 
   GCPRO1(args);
   name = Feval (Fcar (args));
-  UNGCPRO;
-
-  CHECK_STRING (name, 0);
-  temp_output_buffer_setup (XSTRING (name)->data);
+  CHECK_STRING (name);
+  temp_output_buffer_setup (SDATA (name));
   buf = Vstandard_output;
   buf = Vstandard_output;
+  UNGCPRO;
 
 
-  val = Fprogn (Fcdr (args));
+  val = Fprogn (XCDR (args));
 
 
+  GCPRO1 (val);
   temp_output_buffer_show (buf);
   temp_output_buffer_show (buf);
+  UNGCPRO;
 
   return unbind_to (count, val);
 }
 
   return unbind_to (count, val);
 }
@@ -670,14 +717,12 @@ buffer and calling the hook.  It gets one argument, the buffer to display.")
 \f
 static void print ();
 static void print_preprocess ();
 \f
 static void print ();
 static void print_preprocess ();
-#ifdef USE_TEXT_PROPERTIES
 static void print_preprocess_string ();
 static void print_preprocess_string ();
-#endif /* USE_TEXT_PROPERTIES */
 static void print_object ();
 
 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
 static void print_object ();
 
 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
-  "Output a newline to stream PRINTCHARFUN.\n\
-If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
+       doc: /* Output a newline to stream PRINTCHARFUN.
+If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.  */)
   (printcharfun)
      Lisp_Object printcharfun;
 {
   (printcharfun)
      Lisp_Object printcharfun;
 {
@@ -692,11 +737,29 @@ If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
 }
 
 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
 }
 
 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
-  "Output the printed representation of OBJECT, any Lisp object.\n\
-Quoting characters are printed when needed to make output that `read'\n\
-can handle, whenever this is possible.\n\
-Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
-  (object, printcharfun)
+       doc: /* Output the printed representation of OBJECT, any Lisp object.
+Quoting characters are printed when needed to make output that `read'
+can handle, whenever this is possible.  For complex objects, the behavior
+is controlled by `print-level' and `print-length', which see.
+
+OBJECT is any of the Lisp data types: a number, a string, a symbol,
+a list, a buffer, a window, a frame, etc.
+
+A printed representation of an object is text which describes that object.
+
+Optional argument PRINTCHARFUN is the output stream, which can be one
+of these:
+
+   - a buffer, in which case output is inserted into that buffer at point;
+   - a marker, in which case output is inserted at marker's position;
+   - a function, in which case that function is called once for each
+     character of OBJECT's printed representation;
+   - a symbol, in which case that symbol's function definition is called; or
+   - t, in which case the output is displayed in the echo area.
+
+If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
+is used instead.  */)
+     (object, printcharfun)
      Lisp_Object object, printcharfun;
 {
   PRINTDECLARE;
      Lisp_Object object, printcharfun;
 {
   PRINTDECLARE;
@@ -716,47 +779,86 @@ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
 Lisp_Object Vprin1_to_string_buffer;
 
 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
 Lisp_Object Vprin1_to_string_buffer;
 
 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
-  "Return a string containing the printed representation of OBJECT,\n\
-any Lisp object.  Quoting characters are used when needed to make output\n\
-that `read' can handle, whenever this is possible, unless the optional\n\
-second argument NOESCAPE is non-nil.")
-  (object, noescape)
+       doc: /* Return a string containing the printed representation of OBJECT.
+OBJECT can be any Lisp object.  This function outputs quoting characters
+when necessary to make output that `read' can handle, whenever possible,
+unless the optional second argument NOESCAPE is non-nil.  For complex objects,
+the behavior is controlled by `print-level' and `print-length', which see.
+
+OBJECT is any of the Lisp data types: a number, a string, a symbol,
+a list, a buffer, a window, a frame, etc.
+
+A printed representation of an object is text which describes that object.  */)
+     (object, noescape)
      Lisp_Object object, noescape;
 {
      Lisp_Object object, noescape;
 {
-  PRINTDECLARE;
   Lisp_Object printcharfun;
   Lisp_Object printcharfun;
-  struct gcpro gcpro1, gcpro2;
-  Lisp_Object tem;
+  /* struct gcpro gcpro1, gcpro2; */
+  Lisp_Object save_deactivate_mark;
+  int count = specpdl_ptr - specpdl;
+  struct buffer *previous;
 
 
-  /* Save and restore this--we are altering a buffer
-     but we don't want to deactivate the mark just for that.
-     No need for specbind, since errors deactivate the mark.  */
-  tem = Vdeactivate_mark;
-  GCPRO2 (object, tem);
+  specbind (Qinhibit_modification_hooks, Qt);
 
 
-  printcharfun = Vprin1_to_string_buffer;
-  PRINTPREPARE;
-  print (object, printcharfun, NILP (noescape));
-  /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
-  PRINTFINISH;
+  {
+    PRINTDECLARE;
+
+    /* Save and restore this--we are altering a buffer
+       but we don't want to deactivate the mark just for that.
+       No need for specbind, since errors deactivate the mark.  */
+    save_deactivate_mark = Vdeactivate_mark;
+    /* GCPRO2 (object, save_deactivate_mark); */
+    abort_on_gc++;
+
+    printcharfun = Vprin1_to_string_buffer;
+    PRINTPREPARE;
+    print (object, printcharfun, NILP (noescape));
+    /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
+    PRINTFINISH;
+  }
+
+  previous = current_buffer;
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   object = Fbuffer_string ();
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   object = Fbuffer_string ();
+  if (SBYTES (object) == SCHARS (object))
+    STRING_SET_UNIBYTE (object);
 
 
+  /* Note that this won't make prepare_to_modify_buffer call
+     ask-user-about-supersession-threat because this buffer
+     does not visit a file.  */
   Ferase_buffer ();
   Ferase_buffer ();
-  set_buffer_internal (old);
+  set_buffer_internal (previous);
 
 
-  Vdeactivate_mark = tem;
-  UNGCPRO;
+  Vdeactivate_mark = save_deactivate_mark;
+  /* UNGCPRO; */
 
 
-  return object;
+  abort_on_gc--;
+  return unbind_to (count, object);
 }
 
 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
 }
 
 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
-  "Output the printed representation of OBJECT, any Lisp object.\n\
-No quoting characters are used; no delimiters are printed around\n\
-the contents of strings.\n\
-Output stream is PRINTCHARFUN, or value of standard-output (which see).")
-  (object, printcharfun)
+       doc: /* Output the printed representation of OBJECT, any Lisp object.
+No quoting characters are used; no delimiters are printed around
+the contents of strings.
+
+OBJECT is any of the Lisp data types: a number, a string, a symbol,
+a list, a buffer, a window, a frame, etc.
+
+A printed representation of an object is text which describes that object.
+
+Optional argument PRINTCHARFUN is the output stream, which can be one
+of these:
+
+   - a buffer, in which case output is inserted into that buffer at point;
+   - a marker, in which case output is inserted at marker's position;
+   - a function, in which case that function is called once for each
+     character of OBJECT's printed representation;
+   - a symbol, in which case that symbol's function definition is called; or
+   - t, in which case the output is displayed in the echo area.
+
+If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
+is used instead.  */)
+     (object, printcharfun)
      Lisp_Object object, printcharfun;
 {
   PRINTDECLARE;
      Lisp_Object object, printcharfun;
 {
   PRINTDECLARE;
@@ -770,11 +872,29 @@ Output stream is PRINTCHARFUN, or value of standard-output (which see).")
 }
 
 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
 }
 
 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
-  "Output the printed representation of OBJECT, with newlines around it.\n\
-Quoting characters are printed when needed to make output that `read'\n\
-can handle, whenever this is possible.\n\
-Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
-  (object, printcharfun)
+       doc: /* Output the printed representation of OBJECT, with newlines around it.
+Quoting characters are printed when needed to make output that `read'
+can handle, whenever this is possible.  For complex objects, the behavior
+is controlled by `print-level' and `print-length', which see.
+
+OBJECT is any of the Lisp data types: a number, a string, a symbol,
+a list, a buffer, a window, a frame, etc.
+
+A printed representation of an object is text which describes that object.
+
+Optional argument PRINTCHARFUN is the output stream, which can be one
+of these:
+
+   - a buffer, in which case output is inserted into that buffer at point;
+   - a marker, in which case output is inserted at marker's position;
+   - a function, in which case that function is called once for each
+     character of OBJECT's printed representation;
+   - a symbol, in which case that symbol's function definition is called; or
+   - t, in which case the output is displayed in the echo area.
+
+If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
+is used instead.  */)
+     (object, printcharfun)
      Lisp_Object object, printcharfun;
 {
   PRINTDECLARE;
      Lisp_Object object, printcharfun;
 {
   PRINTDECLARE;
@@ -805,26 +925,79 @@ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
 Lisp_Object Qexternal_debugging_output;
 
 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
 Lisp_Object Qexternal_debugging_output;
 
 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
-  "Write CHARACTER to stderr.\n\
-You can call print while debugging emacs, and pass it this function\n\
-to make it write to the debugging output.\n")
-  (character)
+       doc: /* Write CHARACTER to stderr.
+You can call print while debugging emacs, and pass it this function
+to make it write to the debugging output.  */)
+     (character)
      Lisp_Object character;
 {
      Lisp_Object character;
 {
-  CHECK_NUMBER (character, 0);
+  CHECK_NUMBER (character);
   putc (XINT (character), stderr);
 
 #ifdef WINDOWSNT
   /* Send the output to a debugger (nothing happens if there isn't one).  */
   putc (XINT (character), stderr);
 
 #ifdef WINDOWSNT
   /* Send the output to a debugger (nothing happens if there isn't one).  */
-  {
-    char buf[2] = {(char) XINT (character), '\0'};
-    OutputDebugString (buf);
-  }
+  if (print_output_debug_flag)
+    {
+      char buf[2] = {(char) XINT (character), '\0'};
+      OutputDebugString (buf);
+    }
 #endif
 
   return character;
 }
 
 #endif
 
   return character;
 }
 
+/* This function is never called.  Its purpose is to prevent
+   print_output_debug_flag from being optimized away.  */
+
+void
+debug_output_compilation_hack (x)
+     int x;
+{
+  print_output_debug_flag = x;
+}
+
+#if defined (GNU_LINUX)
+
+/* This functionality is not vitally important in general, so we rely on
+   non-portable ability to use stderr as lvalue.  */
+
+#define WITH_REDIRECT_DEBUGGING_OUTPUT 1
+
+FILE *initial_stderr_stream = NULL;
+
+DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
+       1, 2,
+       "FDebug output file: \nP",
+       doc: /* Redirect debugging output (stderr stream) to file FILE.
+If FILE is nil, reset target to the initial stderr stream.
+Optional arg APPEND non-nil (interactively, with prefix arg) means
+append to existing target file.  */)
+     (file, append)
+     Lisp_Object file, append;
+{
+  if (initial_stderr_stream != NULL)
+    fclose (stderr);
+  stderr = initial_stderr_stream;
+  initial_stderr_stream = NULL;
+
+  if (STRINGP (file))
+    {
+      file = Fexpand_file_name (file, Qnil);
+      initial_stderr_stream = stderr;
+      stderr = fopen (SDATA (file), NILP (append) ? "w" : "a");
+      if (stderr == NULL)
+       {
+         stderr = initial_stderr_stream;
+         initial_stderr_stream = NULL;
+         report_file_error ("Cannot open debugging output stream",
+                            Fcons (file, Qnil));
+       }
+    }
+  return Qnil;
+}
+#endif /* GNU_LINUX */
+
+
 /* This is the interface for debugging printing.  */
 
 void
 /* This is the interface for debugging printing.  */
 
 void
@@ -834,11 +1007,33 @@ debug_print (arg)
   Fprin1 (arg, Qexternal_debugging_output);
   fprintf (stderr, "\r\n");
 }
   Fprin1 (arg, Qexternal_debugging_output);
   fprintf (stderr, "\r\n");
 }
+
+void
+safe_debug_print (arg)
+     Lisp_Object arg;
+{
+  int valid = valid_lisp_object_p (arg);
+
+  if (valid > 0)
+    debug_print (arg);
+  else
+    fprintf (stderr, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
+            !valid ? "INVALID" : "SOME",
+#ifdef NO_UNION_TYPE
+            (unsigned long) arg
+#else
+            (unsigned long) arg.i
+#endif
+            );
+}
+
 \f
 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
        1, 1, 0,
 \f
 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
        1, 1, 0,
-  "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
-  (obj)
+       doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
+See Info anchor `(elisp)Definition of signal' for some details on how this
+error message is constructed.  */)
+     (obj)
      Lisp_Object obj;
 {
   struct buffer *old = current_buffer;
      Lisp_Object obj;
 {
   struct buffer *old = current_buffer;
@@ -854,7 +1049,7 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
       && NILP (XCDR (XCDR (obj))))
     return XCAR (XCDR (obj));
 
       && NILP (XCDR (XCDR (obj))))
     return XCAR (XCDR (obj));
 
-  print_error_message (obj, Vprin1_to_string_buffer);
+  print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
 
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   value = Fbuffer_string ();
 
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   value = Fbuffer_string ();
@@ -867,31 +1062,51 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
   return value;
 }
 
   return value;
 }
 
-/* Print an error message for the error DATA
-   onto Lisp output stream STREAM (suitable for the print functions).  */
+/* Print an error message for the error DATA onto Lisp output stream
+   STREAM (suitable for the print functions).
+   CONTEXT is a C string describing the context of the error.
+   CALLER is the Lisp function inside which the error was signaled.  */
 
 void
 
 void
-print_error_message (data, stream)
+print_error_message (data, stream, context, caller)
      Lisp_Object data, stream;
      Lisp_Object data, stream;
+     char *context;
+     Lisp_Object caller;
 {
   Lisp_Object errname, errmsg, file_error, tail;
   struct gcpro gcpro1;
   int i;
 
 {
   Lisp_Object errname, errmsg, file_error, tail;
   struct gcpro gcpro1;
   int i;
 
+  if (context != 0)
+    write_string_1 (context, -1, stream);
+
+  /* If we know from where the error was signaled, show it in
+   *Messages*.  */
+  if (!NILP (caller) && SYMBOLP (caller))
+    {
+      Lisp_Object cname = SYMBOL_NAME (caller);
+      char *name = alloca (SBYTES (cname));
+      bcopy (SDATA (cname), name, SBYTES (cname));
+      message_dolog (name, SBYTES (cname), 0, 0);
+      message_dolog (": ", 2, 0, 0);
+    }
+
   errname = Fcar (data);
 
   if (EQ (errname, Qerror))
     {
       data = Fcdr (data);
   errname = Fcar (data);
 
   if (EQ (errname, Qerror))
     {
       data = Fcdr (data);
-      if (!CONSP (data)) data = Qnil;
+      if (!CONSP (data))
+       data = Qnil;
       errmsg = Fcar (data);
       file_error = Qnil;
     }
   else
     {
       errmsg = Fcar (data);
       file_error = Qnil;
     }
   else
     {
+      Lisp_Object error_conditions;
       errmsg = Fget (errname, Qerror_message);
       errmsg = Fget (errname, Qerror_message);
-      file_error = Fmemq (Qfile_error,
-                         Fget (errname, Qerror_conditions));
+      error_conditions = Fget (errname, Qerror_conditions);
+      file_error = Fmemq (Qfile_error, error_conditions);
     }
 
   /* Print an error message including the data items.  */
     }
 
   /* Print an error message including the data items.  */
@@ -909,27 +1124,31 @@ print_error_message (data, stream)
   else
     write_string_1 ("peculiar error", -1, stream);
 
   else
     write_string_1 ("peculiar error", -1, stream);
 
-  for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
+  for (i = 0; CONSP (tail); tail = XCDR (tail), i++)
     {
     {
+      Lisp_Object obj;
+
       write_string_1 (i ? ", " : ": ", 2, stream);
       write_string_1 (i ? ", " : ": ", 2, stream);
-      if (!NILP (file_error))
-       Fprinc (Fcar (tail), stream);
+      obj = XCAR (tail);
+      if (!NILP (file_error) || EQ (errname, Qend_of_file))
+       Fprinc (obj, stream);
       else
       else
-       Fprin1 (Fcar (tail), stream);
+       Fprin1 (obj, stream);
     }
     }
+
   UNGCPRO;
 }
   UNGCPRO;
 }
-\f
-#ifdef LISP_FLOAT_TYPE
 
 
+
+\f
 /*
  * The buffer should be at least as large as the max string size of the
  * largest float, printed in the biggest notation.  This is undoubtedly
  * 20d float_output_format, with the negative of the C-constant "HUGE"
  * from <math.h>.
 /*
  * The buffer should be at least as large as the max string size of the
  * largest float, printed in the biggest notation.  This is undoubtedly
  * 20d float_output_format, with the negative of the C-constant "HUGE"
  * from <math.h>.
- * 
+ *
  * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
  * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
- * 
+ *
  * I assume that IEEE-754 format numbers can take 329 bytes for the worst
  * case of -1e307 in 20d float_output_format. What is one to do (short of
  * re-writing _doprnt to be more sane)?
  * I assume that IEEE-754 format numbers can take 329 bytes for the worst
  * case of -1e307 in 20d float_output_format. What is one to do (short of
  * re-writing _doprnt to be more sane)?
@@ -943,7 +1162,7 @@ float_to_string (buf, data)
 {
   unsigned char *cp;
   int width;
 {
   unsigned char *cp;
   int width;
-      
+
   /* Check for plus infinity in a way that won't lose
      if there is no plus infinity.  */
   if (data == data / 2 && data > 1.0)
   /* Check for plus infinity in a way that won't lose
      if there is no plus infinity.  */
   if (data == data / 2 && data > 1.0)
@@ -960,6 +1179,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))
     {
   /* 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;
     }
       strcpy (buf, "0.0e+NaN");
       return;
     }
@@ -989,7 +1221,7 @@ float_to_string (buf, data)
       /* Check that the spec we have is fully valid.
         This means not only valid for printf,
         but meant for floats, and reasonable.  */
       /* Check that the spec we have is fully valid.
         This means not only valid for printf,
         but meant for floats, and reasonable.  */
-      cp = XSTRING (Vfloat_output_format)->data;
+      cp = SDATA (Vfloat_output_format);
 
       if (cp[0] != '%')
        goto lose;
 
       if (cp[0] != '%')
        goto lose;
@@ -1019,7 +1251,7 @@ float_to_string (buf, data)
       if (cp[1] != 0)
        goto lose;
 
       if (cp[1] != 0)
        goto lose;
 
-      sprintf (buf, XSTRING (Vfloat_output_format)->data, data);
+      sprintf (buf, SDATA (Vfloat_output_format), data);
     }
 
   /* Make sure there is a decimal point with digit after, or an
     }
 
   /* Make sure there is a decimal point with digit after, or an
@@ -1046,7 +1278,7 @@ float_to_string (buf, data)
        }
     }
 }
        }
     }
 }
-#endif /* LISP_FLOAT_TYPE */
+
 \f
 static void
 print (obj, printcharfun, escapeflag)
 \f
 static void
 print (obj, printcharfun, escapeflag)
@@ -1054,7 +1286,7 @@ print (obj, printcharfun, escapeflag)
      register Lisp_Object printcharfun;
      int escapeflag;
 {
      register Lisp_Object printcharfun;
      int escapeflag;
 {
-  print_depth = 0;
+  old_backquote_output = 0;
 
   /* Reset print_number_index and Vprint_number_table only when
      the variable Vprint_continuous_numbering is nil.  Otherwise,
 
   /* Reset print_number_index and Vprint_number_table only when
      the variable Vprint_continuous_numbering is nil.  Otherwise,
@@ -1070,24 +1302,35 @@ print (obj, printcharfun, escapeflag)
   if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
     {
       int i, start, index;
   if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
     {
       int i, start, index;
-      /* Construct Vprint_number_table.  */
       start = index = print_number_index;
       start = index = print_number_index;
+      /* Construct Vprint_number_table.
+        This increments print_number_index for the objects added.  */
+      print_depth = 0;
       print_preprocess (obj);
       print_preprocess (obj);
+
       /* Remove unnecessary objects, which appear only once in OBJ;
       /* Remove unnecessary objects, which appear only once in OBJ;
-        that is, whose status is Qnil.  */
+        that is, whose status is Qnil.  Compactify the necessary objects.  */
       for (i = start; i < print_number_index; i++)
        if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
          {
            PRINT_NUMBER_OBJECT (Vprint_number_table, index)
              = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
       for (i = start; i < print_number_index; i++)
        if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
          {
            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++;
          }
            index++;
          }
+
+      /* 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_number_index = index;
     }
 
+  print_depth = 0;
   print_object (obj, printcharfun, escapeflag);
 }
 
   print_object (obj, printcharfun, escapeflag);
 }
 
@@ -1102,24 +1345,47 @@ static void
 print_preprocess (obj)
      Lisp_Object obj;
 {
 print_preprocess (obj)
      Lisp_Object obj;
 {
-  int i, size;
+  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)
+    error ("Apparently circular structure being printed");
+
+  /* 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)
 
  loop:
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
       || COMPILEDP (obj) || CHAR_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
-         && SYMBOLP (obj) && NILP (XSYMBOL (obj)->obarray)))
+         && 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++)
     {
       /* 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)
+           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;
              {
                /* OBJ appears more than once.  Let's remember that.  */
                PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
-               return;
+                print_depth--;
+                return;
              }
 
          /* OBJ is not yet recorded.  Let's add to the table.  */
              }
 
          /* OBJ is not yet recorded.  Let's add to the table.  */
@@ -1146,8 +1412,9 @@ print_preprocess (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 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))
+         if (!NILP (Vprint_continuous_numbering)
+             && SYMBOLP (obj)
+             && !SYMBOL_INTERNED_P (obj))
            PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
          print_number_index++;
        }
            PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
          print_number_index++;
        }
@@ -1155,27 +1422,38 @@ print_preprocess (obj)
       switch (XGCTYPE (obj))
        {
        case Lisp_String:
       switch (XGCTYPE (obj))
        {
        case Lisp_String:
-#ifdef USE_TEXT_PROPERTIES
          /* A string may have text properties, which can be circular.  */
          /* 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 */
+         traverse_intervals_noorder (STRING_INTERVALS (obj),
+                                     print_preprocess_string, Qnil);
          break;
 
        case Lisp_Cons:
          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);
          print_preprocess (XCAR (obj));
          obj = XCDR (obj);
+         loop_count++;
+         if (!(loop_count & 1))
+           halftail = XCDR (halftail);
          goto loop;
 
        case Lisp_Vectorlike:
          goto loop;
 
        case Lisp_Vectorlike:
-         size = XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK;
+         size = XVECTOR (obj)->size;
+         if (size & PSEUDOVECTOR_FLAG)
+           size &= PSEUDOVECTOR_SIZE_MASK;
          for (i = 0; i < size; i++)
            print_preprocess (XVECTOR (obj)->contents[i]);
          for (i = 0; i < size; i++)
            print_preprocess (XVECTOR (obj)->contents[i]);
+         break;
+
+       default:
+         break;
        }
     }
        }
     }
+  print_depth--;
 }
 
 }
 
-#ifdef USE_TEXT_PROPERTIES
 static void
 print_preprocess_string (interval, arg)
      INTERVAL interval;
 static void
 print_preprocess_string (interval, arg)
      INTERVAL interval;
@@ -1183,7 +1461,6 @@ print_preprocess_string (interval, arg)
 {
   print_preprocess (interval->plist);
 }
 {
   print_preprocess (interval->plist);
 }
-#endif /* USE_TEXT_PROPERTIES */
 
 static void
 print_object (obj, printcharfun, escapeflag)
 
 static void
 print_object (obj, printcharfun, escapeflag)
@@ -1191,7 +1468,7 @@ print_object (obj, printcharfun, escapeflag)
      register Lisp_Object printcharfun;
      int escapeflag;
 {
      register Lisp_Object printcharfun;
      int escapeflag;
 {
-  char buf[30];
+  char buf[40];
 
   QUIT;
 
 
   QUIT;
 
@@ -1199,7 +1476,8 @@ print_object (obj, printcharfun, escapeflag)
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
       || COMPILEDP (obj) || CHAR_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
       || COMPILEDP (obj) || CHAR_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
-         && SYMBOLP (obj) && NILP (XSYMBOL (obj)->obarray)))
+         && SYMBOLP (obj)
+         && !SYMBOL_INTERNED_P (obj)))
     {
       if (NILP (Vprint_circle) && NILP (Vprint_gensym))
        {
     {
       if (NILP (Vprint_circle) && NILP (Vprint_gensym))
        {
@@ -1219,7 +1497,7 @@ print_object (obj, printcharfun, escapeflag)
          /* With the print-circle feature.  */
          int i;
          for (i = 0; i < print_number_index; i++)
          /* 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 (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
              {
                if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
                  {
              {
                if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
                  {
@@ -1244,6 +1522,7 @@ print_object (obj, printcharfun, escapeflag)
 
   print_depth++;
 
 
   print_depth++;
 
+  /* See similar code in print_preprocess.  */
   if (print_depth > PRINT_CIRCLE)
     error ("Apparently circular structure being printed");
 #ifdef MAX_PRINT_CHARS
   if (print_depth > PRINT_CIRCLE)
     error ("Apparently circular structure being printed");
 #ifdef MAX_PRINT_CHARS
@@ -1266,7 +1545,6 @@ print_object (obj, printcharfun, escapeflag)
       strout (buf, -1, -1, printcharfun, 0);
       break;
 
       strout (buf, -1, -1, printcharfun, 0);
       break;
 
-#ifdef LISP_FLOAT_TYPE
     case Lisp_Float:
       {
        char pigbuf[350];       /* see comments in float_to_string */
     case Lisp_Float:
       {
        char pigbuf[350];       /* see comments in float_to_string */
@@ -1275,7 +1553,6 @@ print_object (obj, printcharfun, escapeflag)
        strout (pigbuf, -1, -1, printcharfun, 0);
       }
       break;
        strout (pigbuf, -1, -1, printcharfun, 0);
       }
       break;
-#endif
 
     case Lisp_String:
       if (!escapeflag)
 
     case Lisp_String:
       if (!escapeflag)
@@ -1289,20 +1566,19 @@ print_object (obj, printcharfun, escapeflag)
          /* 1 means we must ensure that the next character we output
             cannot be taken as part of a hex character escape.  */
          int need_nonhex = 0;
          /* 1 means we must ensure that the next character we output
             cannot be taken as part of a hex character escape.  */
          int need_nonhex = 0;
+         int multibyte = STRING_MULTIBYTE (obj);
 
          GCPRO1 (obj);
 
 
          GCPRO1 (obj);
 
-#ifdef USE_TEXT_PROPERTIES
-         if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
+         if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
            {
              PRINTCHAR ('#');
              PRINTCHAR ('(');
            }
            {
              PRINTCHAR ('#');
              PRINTCHAR ('(');
            }
-#endif
 
          PRINTCHAR ('\"');
 
          PRINTCHAR ('\"');
-         str = XSTRING (obj)->data;
-         size_byte = STRING_BYTES (XSTRING (obj));
+         str = SDATA (obj);
+         size_byte = SBYTES (obj);
 
          for (i = 0, i_byte = 0; i_byte < size_byte;)
            {
 
          for (i = 0, i_byte = 0; i_byte < size_byte;)
            {
@@ -1311,7 +1587,7 @@ print_object (obj, printcharfun, escapeflag)
              int len;
              int c;
 
              int len;
              int c;
 
-             if (STRING_MULTIBYTE (obj))
+             if (multibyte)
                {
                  c = STRING_CHAR_AND_LENGTH (str + i_byte,
                                              size_byte - i_byte, len);
                {
                  c = STRING_CHAR_AND_LENGTH (str + i_byte,
                                              size_byte - i_byte, len);
@@ -1335,16 +1611,22 @@ print_object (obj, printcharfun, escapeflag)
                  PRINTCHAR ('\\');
                  PRINTCHAR ('f');
                }
                  PRINTCHAR ('\\');
                  PRINTCHAR ('f');
                }
-             else if (! SINGLE_BYTE_CHAR_P (c) && print_escape_multibyte)
+             else if (multibyte
+                      && ! ASCII_BYTE_P (c)
+                      && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
                {
                  /* When multibyte is disabled,
                {
                  /* When multibyte is disabled,
-                    print multibyte string chars using hex escapes.  */
+                    print multibyte string chars using hex escapes.
+                    For a char code that could be in a unibyte string,
+                    when found in a multibyte string, always use a hex escape
+                    so it reads back as multibyte.  */
                  unsigned char outbuf[50];
                  sprintf (outbuf, "\\x%x", c);
                  strout (outbuf, -1, -1, printcharfun, 0);
                  need_nonhex = 1;
                }
                  unsigned char outbuf[50];
                  sprintf (outbuf, "\\x%x", c);
                  strout (outbuf, -1, -1, printcharfun, 0);
                  need_nonhex = 1;
                }
-             else if (SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
+             else if (! multibyte
+                      && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
                       && print_escape_nonascii)
                {
                  /* When printing in a multibyte buffer
                       && print_escape_nonascii)
                {
                  /* When printing in a multibyte buffer
@@ -1376,14 +1658,12 @@ print_object (obj, printcharfun, escapeflag)
            }
          PRINTCHAR ('\"');
 
            }
          PRINTCHAR ('\"');
 
-#ifdef USE_TEXT_PROPERTIES
-         if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
+         if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
            {
            {
-             traverse_intervals (XSTRING (obj)->intervals,
-                                 0, 0, print_interval, printcharfun);
+             traverse_intervals (STRING_INTERVALS (obj),
+                                 0, print_interval, printcharfun);
              PRINTCHAR (')');
            }
              PRINTCHAR (')');
            }
-#endif
 
          UNGCPRO;
        }
 
          UNGCPRO;
        }
@@ -1392,13 +1672,13 @@ print_object (obj, printcharfun, escapeflag)
     case Lisp_Symbol:
       {
        register int confusing;
     case Lisp_Symbol:
       {
        register int confusing;
-       register unsigned char *p = XSYMBOL (obj)->name->data;
-       register unsigned char *end = p + STRING_BYTES (XSYMBOL (obj)->name);
+       register unsigned char *p = SDATA (SYMBOL_NAME (obj));
+       register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
        register int c;
        int i, i_byte, size_byte;
        Lisp_Object name;
 
        register int c;
        int i, i_byte, size_byte;
        Lisp_Object name;
 
-       XSETSTRING (name, XSYMBOL (obj)->name);
+       name = SYMBOL_NAME (obj);
 
        if (p != end && (*p == '-' || *p == '+')) p++;
        if (p == end)
 
        if (p != end && (*p == '-' || *p == '+')) p++;
        if (p == end)
@@ -1422,24 +1702,19 @@ print_object (obj, printcharfun, escapeflag)
        else
          confusing = 0;
 
        else
          confusing = 0;
 
-       if (! NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray))
+       if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
          {
            PRINTCHAR ('#');
            PRINTCHAR (':');
          }
 
          {
            PRINTCHAR ('#');
            PRINTCHAR (':');
          }
 
-       size_byte = STRING_BYTES (XSTRING (name));
+       size_byte = SBYTES (name);
 
        for (i = 0, i_byte = 0; i_byte < size_byte;)
          {
            /* Here, we must convert each multi-byte form to the
               corresponding character code before handing it to PRINTCHAR.  */
 
        for (i = 0, i_byte = 0; i_byte < size_byte;)
          {
            /* Here, we must convert each multi-byte form to the
               corresponding character code before handing it to PRINTCHAR.  */
-
-           if (STRING_MULTIBYTE (name))
-             FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
-           else
-             c = XSTRING (name)->data[i_byte++];
-
+           FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
            QUIT;
 
            if (escapeflag)
            QUIT;
 
            if (escapeflag)
@@ -1475,6 +1750,7 @@ print_object (obj, printcharfun, escapeflag)
          print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
        }
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
          print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
        }
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
+              && ! old_backquote_output
               && ((EQ (XCAR (obj), Qbackquote)
                    || EQ (XCAR (obj), Qcomma)
                    || EQ (XCAR (obj), Qcomma_at)
               && ((EQ (XCAR (obj), Qbackquote)
                    || EQ (XCAR (obj), Qcomma)
                    || EQ (XCAR (obj), Qcomma_at)
@@ -1486,13 +1762,41 @@ print_object (obj, printcharfun, escapeflag)
       else
        {
          PRINTCHAR ('(');
       else
        {
          PRINTCHAR ('(');
+
+         /* If the first element is a backquote form,
+            print it old-style so it won't be misunderstood.  */
+         if (print_quoted && CONSP (XCAR (obj))
+             && CONSP (XCDR (XCAR (obj)))
+             && NILP (XCDR (XCDR (XCAR (obj))))
+             && EQ (XCAR (XCAR (obj)), Qbackquote))
+           {
+             Lisp_Object tem;
+             tem = XCAR (obj);
+             PRINTCHAR ('(');
+
+             print_object (Qbackquote, printcharfun, 0);
+             PRINTCHAR (' ');
+
+             ++old_backquote_output;
+             print_object (XCAR (XCDR (tem)), printcharfun, 0);
+             --old_backquote_output;
+             PRINTCHAR (')');
+
+             obj = XCDR (obj);
+           }
+
          {
          {
-           register int i = 0;
-           register int print_length = 0;
+           int print_length, i;
            Lisp_Object halftail = obj;
 
            Lisp_Object halftail = obj;
 
-           if (INTEGERP (Vprint_length))
-             print_length = XINT (Vprint_length);
+           /* Negative values of print-length are invalid in CL.
+              Treat them like nil, as CMUCL does.  */
+           if (NATNUMP (Vprint_length))
+             print_length = XFASTINT (Vprint_length);
+           else
+             print_length = 0;
+
+           i = 0;
            while (CONSP (obj))
              {
                /* Detect circular list.  */
            while (CONSP (obj))
              {
                /* Detect circular list.  */
@@ -1513,7 +1817,8 @@ print_object (obj, printcharfun, escapeflag)
                      {
                        int i;
                        for (i = 0; i < print_number_index; i++)
                      {
                        int i;
                        for (i = 0; i < print_number_index; i++)
-                         if (PRINT_NUMBER_OBJECT (Vprint_number_table, i) == obj)
+                         if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
+                                 obj))
                            {
                              if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
                                {
                            {
                              if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
                                {
@@ -1529,24 +1834,31 @@ print_object (obj, printcharfun, escapeflag)
                            }
                      }
                  }
                            }
                      }
                  }
+
                if (i++)
                  PRINTCHAR (' ');
                if (i++)
                  PRINTCHAR (' ');
+
                if (print_length && i > print_length)
                  {
                    strout ("...", 3, 3, printcharfun, 0);
                    goto end_of_list;
                  }
                if (print_length && i > print_length)
                  {
                    strout ("...", 3, 3, printcharfun, 0);
                    goto end_of_list;
                  }
+
                print_object (XCAR (obj), printcharfun, escapeflag);
                print_object (XCAR (obj), printcharfun, escapeflag);
+
                obj = XCDR (obj);
                if (!(i & 1))
                  halftail = XCDR (halftail);
              }
          }
                obj = XCDR (obj);
                if (!(i & 1))
                  halftail = XCDR (halftail);
              }
          }
+
+         /* OBJ non-nil here means it's the end of a dotted list.  */
          if (!NILP (obj))
            {
              strout (" . ", 3, 3, printcharfun, 0);
              print_object (obj, printcharfun, escapeflag);
            }
          if (!NILP (obj))
            {
              strout (" . ", 3, 3, printcharfun, 0);
              print_object (obj, printcharfun, escapeflag);
            }
+
        end_of_list:
          PRINTCHAR (')');
        }
        end_of_list:
          PRINTCHAR (')');
        }
@@ -1570,20 +1882,23 @@ print_object (obj, printcharfun, escapeflag)
          register unsigned char c;
          struct gcpro gcpro1;
          int size_in_chars
          register unsigned char c;
          struct gcpro gcpro1;
          int size_in_chars
-           = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
+           = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+              / BOOL_VECTOR_BITS_PER_CHAR);
 
          GCPRO1 (obj);
 
          PRINTCHAR ('#');
          PRINTCHAR ('&');
 
          GCPRO1 (obj);
 
          PRINTCHAR ('#');
          PRINTCHAR ('&');
-         sprintf (buf, "%d", XBOOL_VECTOR (obj)->size);
+         sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
          strout (buf, -1, -1, printcharfun, 0);
          PRINTCHAR ('\"');
 
          strout (buf, -1, -1, printcharfun, 0);
          PRINTCHAR ('\"');
 
-         /* Don't print more characters than the specified maximum.  */
-         if (INTEGERP (Vprint_length)
-             && XINT (Vprint_length) < size_in_chars)
-           size_in_chars = XINT (Vprint_length);
+         /* Don't print more characters than the specified maximum.
+            Negative values of print-length are invalid.  Treat them
+            like a print-length of nil.  */
+         if (NATNUMP (Vprint_length)
+             && XFASTINT (Vprint_length) < size_in_chars)
+           size_in_chars = XFASTINT (Vprint_length);
 
          for (i = 0; i < size_in_chars; i++)
            {
 
          for (i = 0; i < size_in_chars; i++)
            {
@@ -1599,6 +1914,14 @@ print_object (obj, printcharfun, escapeflag)
                  PRINTCHAR ('\\');
                  PRINTCHAR ('f');
                }
                  PRINTCHAR ('\\');
                  PRINTCHAR ('f');
                }
+             else if (c > '\177')
+               {
+                 /* Use octal escapes to avoid encoding issues.  */
+                 PRINTCHAR ('\\');
+                 PRINTCHAR ('0' + ((c >> 6) & 3));
+                 PRINTCHAR ('0' + ((c >> 3) & 7));
+                 PRINTCHAR ('0' + (c & 7));
+               }
              else
                {
                  if (c == '\"' || c == '\\')
              else
                {
                  if (c == '\"' || c == '\\')
@@ -1619,7 +1942,7 @@ print_object (obj, printcharfun, escapeflag)
       else if (WINDOWP (obj))
        {
          strout ("#<window ", -1, -1, printcharfun, 0);
       else if (WINDOWP (obj))
        {
          strout ("#<window ", -1, -1, printcharfun, 0);
-         sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number));
+         sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
          strout (buf, -1, -1, printcharfun, 0);
          if (!NILP (XWINDOW (obj)->buffer))
            {
          strout (buf, -1, -1, printcharfun, 0);
          if (!NILP (XWINDOW (obj)->buffer))
            {
@@ -1636,12 +1959,12 @@ print_object (obj, printcharfun, escapeflag)
            {
              PRINTCHAR (' ');
              PRINTCHAR ('\'');
            {
              PRINTCHAR (' ');
              PRINTCHAR ('\'');
-             strout (XSYMBOL (h->test)->name->data, -1, -1, printcharfun, 0);
+             strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
              PRINTCHAR (' ');
              PRINTCHAR (' ');
-             strout (XSYMBOL (h->weak)->name->data, -1, -1, printcharfun, 0);
+             strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
              PRINTCHAR (' ');
              PRINTCHAR (' ');
-             sprintf (buf, "%d/%d", XFASTINT (h->count),
-                      XVECTOR (h->next)->size);
+             sprintf (buf, "%ld/%ld", (long) XFASTINT (h->count),
+                      (long) XVECTOR (h->next)->size);
              strout (buf, -1, -1, printcharfun, 0);
            }
          sprintf (buf, " 0x%lx", (unsigned long) h);
              strout (buf, -1, -1, printcharfun, 0);
            }
          sprintf (buf, " 0x%lx", (unsigned long) h);
@@ -1671,13 +1994,13 @@ print_object (obj, printcharfun, escapeflag)
                   ? "#<frame " : "#<dead frame "),
                  -1, -1, printcharfun, 0);
          print_string (XFRAME (obj)->name, printcharfun);
                   ? "#<frame " : "#<dead frame "),
                  -1, -1, printcharfun, 0);
          print_string (XFRAME (obj)->name, printcharfun);
-         sprintf (buf, " 0x%lx\\ ", (unsigned long) (XFRAME (obj)));
+         sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
          strout (buf, -1, -1, printcharfun, 0);
          PRINTCHAR ('>');
        }
       else
        {
          strout (buf, -1, -1, printcharfun, 0);
          PRINTCHAR ('>');
        }
       else
        {
-         int size = XVECTOR (obj)->size;
+         EMACS_INT size = XVECTOR (obj)->size;
          if (COMPILEDP (obj))
            {
              PRINTCHAR ('#');
          if (COMPILEDP (obj))
            {
              PRINTCHAR ('#');
@@ -1701,11 +2024,12 @@ print_object (obj, printcharfun, escapeflag)
          {
            register int i;
            register Lisp_Object tem;
          {
            register int i;
            register Lisp_Object tem;
+           int real_size = size;
 
            /* Don't print more elements than the specified maximum.  */
 
            /* Don't print more elements than the specified maximum.  */
-           if (INTEGERP (Vprint_length)
-               && XINT (Vprint_length) < size)
-             size = XINT (Vprint_length);
+           if (NATNUMP (Vprint_length)
+               && XFASTINT (Vprint_length) < size)
+             size = XFASTINT (Vprint_length);
 
            for (i = 0; i < size; i++)
              {
 
            for (i = 0; i < size; i++)
              {
@@ -1713,6 +2037,8 @@ print_object (obj, printcharfun, escapeflag)
                tem = XVECTOR (obj)->contents[i];
                print_object (tem, printcharfun, escapeflag);
              }
                tem = XVECTOR (obj)->contents[i];
                print_object (tem, printcharfun, escapeflag);
              }
+           if (size < real_size)
+             strout (" ...", 4, 4, printcharfun, 0);
          }
          PRINTCHAR (']');
        }
          }
          PRINTCHAR (']');
        }
@@ -1725,8 +2051,8 @@ print_object (obj, printcharfun, escapeflag)
          strout ("#<marker ", -1, -1, printcharfun, 0);
          /* Do you think this is necessary?  */
          if (XMARKER (obj)->insertion_type != 0)
          strout ("#<marker ", -1, -1, printcharfun, 0);
          /* Do you think this is necessary?  */
          if (XMARKER (obj)->insertion_type != 0)
-           strout ("(before-insertion) ", -1, -1, printcharfun, 0);
-         if (!(XMARKER (obj)->buffer))
+           strout ("(moves after insertion) ", -1, -1, printcharfun, 0);
+         if (! XMARKER (obj)->buffer)
            strout ("in no buffer", -1, -1, printcharfun, 0);
          else
            {
            strout ("in no buffer", -1, -1, printcharfun, 0);
          else
            {
@@ -1740,7 +2066,7 @@ print_object (obj, printcharfun, escapeflag)
 
        case Lisp_Misc_Overlay:
          strout ("#<overlay ", -1, -1, printcharfun, 0);
 
        case Lisp_Misc_Overlay:
          strout ("#<overlay ", -1, -1, printcharfun, 0);
-         if (!(XMARKER (OVERLAY_START (obj))->buffer))
+         if (! XMARKER (OVERLAY_START (obj))->buffer)
            strout ("in no buffer", -1, -1, printcharfun, 0);
          else
            {
            strout ("in no buffer", -1, -1, printcharfun, 0);
          else
            {
@@ -1761,7 +2087,7 @@ print_object (obj, printcharfun, escapeflag)
          break;
 
        case Lisp_Misc_Intfwd:
          break;
 
        case Lisp_Misc_Intfwd:
-         sprintf (buf, "#<intfwd to %d>", *XINTFWD (obj)->intvar);
+         sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
          strout (buf, -1, -1, printcharfun, 0);
          break;
 
          strout (buf, -1, -1, printcharfun, 0);
          break;
 
@@ -1779,17 +2105,17 @@ print_object (obj, printcharfun, escapeflag)
 
        case Lisp_Misc_Buffer_Objfwd:
          strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
 
        case Lisp_Misc_Buffer_Objfwd:
          strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
-         print_object (*(Lisp_Object *)((char *)current_buffer
-                                        + XBUFFER_OBJFWD (obj)->offset),
-                printcharfun, escapeflag);
+         print_object (PER_BUFFER_VALUE (current_buffer,
+                                         XBUFFER_OBJFWD (obj)->offset),
+                       printcharfun, escapeflag);
          PRINTCHAR ('>');
          break;
 
        case Lisp_Misc_Kboard_Objfwd:
          strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
          PRINTCHAR ('>');
          break;
 
        case Lisp_Misc_Kboard_Objfwd:
          strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
-         print_object (*(Lisp_Object *)((char *) current_kboard
-                                        + XKBOARD_OBJFWD (obj)->offset),
-                printcharfun, escapeflag);
+         print_object (*(Lisp_Object *) ((char *) current_kboard
+                                         + XKBOARD_OBJFWD (obj)->offset),
+                       printcharfun, escapeflag);
          PRINTCHAR ('>');
          break;
 
          PRINTCHAR ('>');
          break;
 
@@ -1826,6 +2152,15 @@ print_object (obj, printcharfun, escapeflag)
          PRINTCHAR ('>');
          break;
 
          PRINTCHAR ('>');
          break;
 
+       case Lisp_Misc_Save_Value:
+         strout ("#<save_value ", -1, -1, printcharfun, 0);
+         sprintf(buf, "ptr=0x%08lx int=%d",
+                 (unsigned long) XSAVE_VALUE (obj)->pointer,
+                 XSAVE_VALUE (obj)->integer);
+         strout (buf, -1, -1, printcharfun, 0);
+         PRINTCHAR ('>');
+         break;
+
        default:
          goto badtype;
        }
        default:
          goto badtype;
        }
@@ -1852,7 +2187,6 @@ print_object (obj, printcharfun, escapeflag)
   print_depth--;
 }
 \f
   print_depth--;
 }
 \f
-#ifdef USE_TEXT_PROPERTIES
 
 /* Print a description of INTERVAL using PRINTCHARFUN.
    This is part of printing a string that has text properties.  */
 
 /* Print a description of INTERVAL using PRINTCHARFUN.
    This is part of printing a string that has text properties.  */
@@ -1866,12 +2200,11 @@ print_interval (interval, printcharfun)
   print_object (make_number (interval->position), printcharfun, 1);
   PRINTCHAR (' ');
   print_object (make_number (interval->position + LENGTH (interval)),
   print_object (make_number (interval->position), printcharfun, 1);
   PRINTCHAR (' ');
   print_object (make_number (interval->position + LENGTH (interval)),
-        printcharfun, 1);
+               printcharfun, 1);
   PRINTCHAR (' ');
   print_object (interval->plist, printcharfun, 1);
 }
 
   PRINTCHAR (' ');
   print_object (interval->plist, printcharfun, 1);
 }
 
-#endif /* USE_TEXT_PROPERTIES */
 \f
 void
 syms_of_print ()
 \f
 void
 syms_of_print ()
@@ -1880,100 +2213,109 @@ syms_of_print ()
   staticpro (&Qtemp_buffer_setup_hook);
 
   DEFVAR_LISP ("standard-output", &Vstandard_output,
   staticpro (&Qtemp_buffer_setup_hook);
 
   DEFVAR_LISP ("standard-output", &Vstandard_output,
-    "Output stream `print' uses by default for outputting a character.\n\
-This may be any function of one argument.\n\
-It may also be a buffer (output is inserted before point)\n\
-or a marker (output is inserted and the marker is advanced)\n\
-or the symbol t (output appears in the echo area).");
+              doc: /* Output stream `print' uses by default for outputting a character.
+This may be any function of one argument.
+It may also be a buffer (output is inserted before point)
+or a marker (output is inserted and the marker is advanced)
+or the symbol t (output appears in the echo area).  */);
   Vstandard_output = Qt;
   Qstandard_output = intern ("standard-output");
   staticpro (&Qstandard_output);
 
   Vstandard_output = Qt;
   Qstandard_output = intern ("standard-output");
   staticpro (&Qstandard_output);
 
-#ifdef LISP_FLOAT_TYPE
   DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
   DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
-    "The format descriptor string used to print floats.\n\
-This is a %-spec like those accepted by `printf' in C,\n\
-but with some restrictions.  It must start with the two characters `%.'.\n\
-After that comes an integer precision specification,\n\
-and then a letter which controls the format.\n\
-The letters allowed are `e', `f' and `g'.\n\
-Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
-Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
-Use `g' to choose the shorter of those two formats for the number at hand.\n\
-The precision in any of these cases is the number of digits following\n\
-the decimal point.  With `f', a precision of 0 means to omit the\n\
-decimal point.  0 is not allowed with `e' or `g'.\n\n\
-A value of nil means to use the shortest notation\n\
-that represents the number without losing information.");
+              doc: /* The format descriptor string used to print floats.
+This is a %-spec like those accepted by `printf' in C,
+but with some restrictions.  It must start with the two characters `%.'.
+After that comes an integer precision specification,
+and then a letter which controls the format.
+The letters allowed are `e', `f' and `g'.
+Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
+Use `f' for decimal point notation \"DIGITS.DIGITS\".
+Use `g' to choose the shorter of those two formats for the number at hand.
+The precision in any of these cases is the number of digits following
+the decimal point.  With `f', a precision of 0 means to omit the
+decimal point.  0 is not allowed with `e' or `g'.
+
+A value of nil means to use the shortest notation
+that represents the number without losing information.  */);
   Vfloat_output_format = Qnil;
   Qfloat_output_format = intern ("float-output-format");
   staticpro (&Qfloat_output_format);
   Vfloat_output_format = Qnil;
   Qfloat_output_format = intern ("float-output-format");
   staticpro (&Qfloat_output_format);
-#endif /* LISP_FLOAT_TYPE */
 
   DEFVAR_LISP ("print-length", &Vprint_length,
 
   DEFVAR_LISP ("print-length", &Vprint_length,
-    "Maximum length of list to print before abbreviating.\n\
-A value of nil means no limit.");
+              doc: /* Maximum length of list to print before abbreviating.
+A value of nil means no limit.  See also `eval-expression-print-length'.  */);
   Vprint_length = Qnil;
 
   DEFVAR_LISP ("print-level", &Vprint_level,
   Vprint_length = Qnil;
 
   DEFVAR_LISP ("print-level", &Vprint_level,
-    "Maximum depth of list nesting to print before abbreviating.\n\
-A value of nil means no limit.");
+              doc: /* Maximum depth of list nesting to print before abbreviating.
+A value of nil means no limit.  See also `eval-expression-print-level'.  */);
   Vprint_level = Qnil;
 
   DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
   Vprint_level = Qnil;
 
   DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
-    "Non-nil means print newlines in strings as backslash-n.\n\
-Also print formfeeds as backslash-f.");
+              doc: /* Non-nil means print newlines in strings as `\\n'.
+Also print formfeeds as `\\f'.  */);
   print_escape_newlines = 0;
 
   DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
   print_escape_newlines = 0;
 
   DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
-    "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.\n\
-\(OOO is the octal representation of the character code.)\n\
-Only single-byte characters are affected, and only in `prin1'.");
+              doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
+\(OOO is the octal representation of the character code.)
+Only single-byte characters are affected, and only in `prin1'.
+When the output goes in a multibyte buffer, this feature is
+enabled regardless of the value of the variable.  */);
   print_escape_nonascii = 0;
 
   DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
   print_escape_nonascii = 0;
 
   DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
-    "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
-\(XXX is the hex representation of the character code.)\n\
-This affects only `prin1'.");
+              doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
+\(XXXX is the hex representation of the character code.)
+This affects only `prin1'.  */);
   print_escape_multibyte = 0;
 
   DEFVAR_BOOL ("print-quoted", &print_quoted,
   print_escape_multibyte = 0;
 
   DEFVAR_BOOL ("print-quoted", &print_quoted,
-    "Non-nil means print quoted forms with reader syntax.\n\
-I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
-forms print in the new syntax.");
+              doc: /* Non-nil means print quoted forms with reader syntax.
+I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
+forms print as in the new syntax.  */);
   print_quoted = 0;
 
   DEFVAR_LISP ("print-gensym", &Vprint_gensym,
   print_quoted = 0;
 
   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 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.");
+              doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
+I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
+When the uninterned symbol appears within a recursive data structure,
+and the symbol appears more than once, in addition use the #N# and #N=
+constructs as needed, so that multiple references to the same symbol are
+shared once again when the text is read back.  */);
   Vprint_gensym = Qnil;
 
   DEFVAR_LISP ("print-circle", &Vprint_circle,
   Vprint_gensym = 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.");
+              doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
+If nil, printing proceeds recursively and may lead to
+`max-lisp-eval-depth' being exceeded or an error may occur:
+\"Apparently circular structure being printed.\"  Also see
+`print-length' and `print-level'.
+If non-nil, shared substructures anywhere in the structure are printed
+with `#N=' before the first occurrence (in the order of the print
+representation) and `#N#' in place of each subsequent occurrence,
+where N is a positive decimal integer.  */);
   Vprint_circle = Qnil;
 
   DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
   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'.");
+              doc: /* *Non-nil means number continuously across print calls.
+This affects the numbers printed for #N= labels and #M# references.
+See also `print-circle', `print-gensym', and `print-number-table'.
+This variable should not be set with `setq'; bind it with a `let' instead.  */);
   Vprint_continuous_numbering = Qnil;
 
   DEFVAR_LISP ("print-number-table", &Vprint_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.");
+              doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
+The Lisp printer uses this vector to detect Lisp objects referenced more
+than once.
+
+When you bind `print-continuous-numbering' to t, you should probably
+also bind `print-number-table' to nil.  This ensures that the value of
+`print-number-table' can be garbage-collected once the printing is
+done.  If all elements of `print-number-table' are nil, it means that
+the printing done so far has not found any shared structure or objects
+that need to be recorded in the table.  */);
   Vprint_number_table = Qnil;
 
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
   Vprint_number_table = Qnil;
 
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
@@ -1987,6 +2329,9 @@ so that the value of this variable can be freed after printing.");
   defsubr (&Sterpri);
   defsubr (&Swrite_char);
   defsubr (&Sexternal_debugging_output);
   defsubr (&Sterpri);
   defsubr (&Swrite_char);
   defsubr (&Sexternal_debugging_output);
+#ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
+  defsubr (&Sredirect_debugging_output);
+#endif
 
   Qexternal_debugging_output = intern ("external-debugging-output");
   staticpro (&Qexternal_debugging_output);
 
   Qexternal_debugging_output = intern ("external-debugging-output");
   staticpro (&Qexternal_debugging_output);
@@ -2002,3 +2347,6 @@ so that the value of this variable can be freed after printing.");
 
   defsubr (&Swith_output_to_temp_buffer);
 }
 
   defsubr (&Swith_output_to_temp_buffer);
 }
+
+/* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
+   (do not change this comment) */