merge from trunk

1 files changed, 400 insertions, 437 deletions

diff --git a/src/print.c b/src/print.c
index ec14b7be93c..299787d8422 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1,6 +1,6 @@
 /* Lisp object printing and output streams.
 
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
 Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -24,30 +24,21 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include "lisp.h"
 #include "character.h"
+#include "coding.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 "disptab.h"
 #include "intervals.h"
 #include "blockinput.h"
-#include "termhooks.h"		/* For struct terminal.  */
-#include "font.h"
-
-Lisp_Object Qstandard_output;
-
-static Lisp_Object Qtemp_buffer_setup_hook;
-
-/* These are used to print like we read.  */
-
-static Lisp_Object Qfloat_output_format;
 
+#include <c-ctype.h>
 #include <float.h>
 #include <ftoastr.h>
 
+struct terminal;
+
 /* Avoid actual stack overflow in print.  */
 static ptrdiff_t print_depth;
 
@@ -58,6 +49,9 @@ static ptrdiff_t new_backquote_output;
 #define PRINT_CIRCLE 200
 static Lisp_Object being_printed[PRINT_CIRCLE];
 
+/* Last char printed to stdout by printchar.  */
+static unsigned int printchar_stdout_last;
+
 /* When printing into a buffer, first we put the text in this
    block, then insert it all at once.  */
 static char *print_buffer;
@@ -69,9 +63,6 @@ static ptrdiff_t print_buffer_pos;
 /* Bytes stored in print_buffer.  */
 static ptrdiff_t print_buffer_pos_byte;
 
-Lisp_Object Qprint_escape_newlines;
-static Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
-
 /* Vprint_number_table is a table, that keeps objects that are going to
    be printed, to allow use of #n= and #n# to express sharing.
    For any given object, the table can give the following values:
@@ -91,12 +82,11 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
 
 /* Lisp functions to do output using a stream
    must have the stream in a variable called printcharfun
-   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.
+   Use printchar to output one character,
    or call strout to output a block of characters.  */
 
-#define PRINTDECLARE							\
+#define PRINTPREPARE							\
    struct buffer *old = current_buffer;					\
    ptrdiff_t old_point = -1, start_point = -1;				\
    ptrdiff_t old_point_byte = -1, start_point_byte = -1;		\
@@ -104,10 +94,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
    bool free_print_buffer = 0;						\
    bool multibyte							\
      = !NILP (BVAR (current_buffer, enable_multibyte_characters));	\
-   Lisp_Object original
-
-#define PRINTPREPARE							\
-   original = printcharfun;						\
+   Lisp_Object original = printcharfun;					\
    if (NILP (printcharfun)) printcharfun = Qt;				\
    if (BUFFERP (printcharfun))						\
      {									\
@@ -124,7 +111,8 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
          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"); \
+	 signal_error ("Marker is outside the accessible "		\
+		       "part of the buffer", printcharfun);		\
        old_point = PT;							\
        old_point_byte = PT_BYTE;					\
        SET_PT_BOTH (marker_pos,						\
@@ -136,10 +124,10 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
    if (NILP (printcharfun))						\
      {									\
        Lisp_Object string;						\
-       if (NILP (BVAR (current_buffer, enable_multibyte_characters))		\
+       if (NILP (BVAR (current_buffer, enable_multibyte_characters))	\
 	   && ! print_escape_multibyte)					\
          specbind (Qprint_escape_multibyte, Qt);			\
-       if (! NILP (BVAR (current_buffer, enable_multibyte_characters))		\
+       if (! NILP (BVAR (current_buffer, enable_multibyte_characters))	\
 	   && ! print_escape_nonascii)					\
          specbind (Qprint_escape_nonascii, Qt);				\
        if (print_buffer != 0)						\
@@ -166,13 +154,15 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
    if (NILP (printcharfun))						\
      {									\
        if (print_buffer_pos != print_buffer_pos_byte			\
-	   && NILP (BVAR (current_buffer, enable_multibyte_characters)))	\
+	   && NILP (BVAR (current_buffer, enable_multibyte_characters)))\
 	 {								\
-	   unsigned char *temp = alloca (print_buffer_pos + 1);		\
+	   USE_SAFE_ALLOCA;						\
+	   unsigned char *temp = SAFE_ALLOCA (print_buffer_pos + 1);	\
 	   copy_text ((unsigned char *) print_buffer, temp,		\
 		      print_buffer_pos_byte, 1, 0);			\
 	   insert_1_both ((char *) temp, print_buffer_pos,		\
 			  print_buffer_pos, 0, 1, 0);			\
+	   SAFE_FREE ();						\
 	 }								\
        else								\
 	 insert_1_both (print_buffer, print_buffer_pos,			\
@@ -194,8 +184,6 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
 				    ? PT_BYTE - start_point_byte : 0));	\
    set_buffer_internal (old);
 
-#define PRINTCHAR(ch) printchar (ch, printcharfun)
-
 /* This is used to restore the saved contents of print_buffer
    when there is a recursive call to print.  */
 
@@ -205,6 +193,61 @@ print_unwind (Lisp_Object saved_text)
   memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
 }
 
+/* Print character CH to the stdio stream STREAM.  */
+
+static void
+printchar_to_stream (unsigned int ch, FILE *stream)
+{
+  Lisp_Object dv IF_LINT (= Qnil);
+  ptrdiff_t i = 0, n = 1;
+
+  if (CHAR_VALID_P (ch) && DISP_TABLE_P (Vstandard_display_table))
+    {
+      dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table), ch);
+      if (VECTORP (dv))
+	{
+	  n = ASIZE (dv);
+	  goto next_char;
+	}
+    }
+
+  while (true)
+    {
+      if (ASCII_CHAR_P (ch))
+	{
+	  putc (ch, stream);
+#ifdef WINDOWSNT
+	  /* Send the output to a debugger (nothing happens if there
+	     isn't one).  */
+	  if (print_output_debug_flag && stream == stderr)
+	    OutputDebugString ((char []) {ch, '\0'});
+#endif
+	}
+      else
+	{
+	  unsigned char mbstr[MAX_MULTIBYTE_LENGTH];
+	  int len = CHAR_STRING (ch, mbstr);
+	  Lisp_Object encoded_ch =
+	    ENCODE_SYSTEM (make_multibyte_string ((char *) mbstr, 1, len));
+
+	  fwrite (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream);
+#ifdef WINDOWSNT
+	  if (print_output_debug_flag && stream == stderr)
+	    OutputDebugString (SSDATA (encoded_ch));
+#endif
+	}
+
+      i++;
+
+    next_char:
+      for (; i < n; i++)
+	if (CHARACTERP (AREF (dv, i)))
+	  break;
+      if (! (i < n))
+	break;
+      ch = XFASTINT (AREF (dv, i));
+    }
+}
 
 /* Print character CH using method FUN.  FUN nil means print to
    print_buffer.  FUN t means print to echo area or stdout if
@@ -235,7 +278,11 @@ printchar (unsigned int ch, Lisp_Object fun)
 	}
       else if (noninteractive)
 	{
-	  fwrite (str, 1, len, stdout);
+	  printchar_stdout_last = ch;
+	  if (DISP_TABLE_P (Vstandard_display_table))
+	    printchar_to_stream (ch, stdout);
+	  else
+	    fwrite (str, 1, len, stdout);
 	  noninteractive_need_newline = 1;
 	}
       else
@@ -252,8 +299,7 @@ printchar (unsigned int ch, Lisp_Object fun)
 
 
 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
-   method PRINTCHARFUN.  If SIZE < 0, use the string length of PTR for
-   both SIZE and SIZE_BYTE.  PRINTCHARFUN nil means output to
+   method PRINTCHARFUN.  PRINTCHARFUN nil means output to
    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
@@ -266,9 +312,6 @@ static void
 strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
 	Lisp_Object printcharfun)
 {
-  if (size < 0)
-    size_byte = size = strlen (ptr);
-
   if (NILP (printcharfun))
     {
       ptrdiff_t incr = size_byte - (print_buffer_size - print_buffer_pos_byte);
@@ -280,7 +323,19 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
     }
   else if (noninteractive && EQ (printcharfun, Qt))
     {
-      fwrite (ptr, 1, size_byte, stdout);
+      if (DISP_TABLE_P (Vstandard_display_table))
+	{
+	  int len;
+	  for (ptrdiff_t i = 0; i < size_byte; i += len)
+	    {
+	      int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
+					       len);
+	      printchar_to_stream (ch, stdout);
+	    }
+	}
+      else
+	fwrite (ptr, 1, size_byte, stdout);
+
       noninteractive_need_newline = 1;
     }
   else if (EQ (printcharfun, Qt))
@@ -321,7 +376,7 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
 	  while (i < size_byte)
 	    {
 	      int ch = ptr[i++];
-	      PRINTCHAR (ch);
+	      printchar (ch, printcharfun);
 	    }
 	}
       else
@@ -334,7 +389,7 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
 	      int len;
 	      int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
 					       len);
-	      PRINTCHAR (ch);
+	      printchar (ch, printcharfun);
 	      i += len;
 	    }
 	}
@@ -407,11 +462,9 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
       ptrdiff_t i;
       ptrdiff_t size = SCHARS (string);
       ptrdiff_t size_byte = SBYTES (string);
-      struct gcpro gcpro1;
-      GCPRO1 (string);
       if (size == size_byte)
 	for (i = 0; i < size; i++)
-	  PRINTCHAR (SREF (string, i));
+	  printchar (SREF (string, i), printcharfun);
       else
 	for (i = 0; i < size_byte; )
 	  {
@@ -419,10 +472,9 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
 	       corresponding character code before handing it to PRINTCHAR.  */
 	    int len;
 	    int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len);
-	    PRINTCHAR (ch);
+	    printchar (ch, printcharfun);
 	    i += len;
 	  }
-      UNGCPRO;
     }
 }
 
@@ -431,46 +483,45 @@ DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
 PRINTCHARFUN defaults to the value of `standard-output' (which see).  */)
   (Lisp_Object character, Lisp_Object printcharfun)
 {
-  PRINTDECLARE;
-
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   CHECK_NUMBER (character);
   PRINTPREPARE;
-  PRINTCHAR (XINT (character));
+  printchar (XINT (character), printcharfun);
   PRINTFINISH;
   return character;
 }
 
-/* Used from outside of print.c to print a block of SIZE
-   single-byte chars at DATA on the default output stream.
+/* Print the contents of a unibyte C string STRING using PRINTCHARFUN.
+   The caller should arrange to put this inside PRINTPREPARE and PRINTFINISH.
    Do not use this on the contents of a Lisp string.  */
 
-void
-write_string (const char *data, int size)
+static void
+print_c_string (char const *string, Lisp_Object printcharfun)
 {
-  PRINTDECLARE;
-  Lisp_Object printcharfun;
+  ptrdiff_t len = strlen (string);
+  strout (string, len, len, printcharfun);
+}
 
-  printcharfun = Vstandard_output;
+/* Print unibyte C string at DATA on a specified stream PRINTCHARFUN.
+   Do not use this on the contents of a Lisp string.  */
 
+static void
+write_string_1 (const char *data, Lisp_Object printcharfun)
+{
   PRINTPREPARE;
-  strout (data, size, size, printcharfun);
+  print_c_string (data, printcharfun);
   PRINTFINISH;
 }
 
-/* Used to print a block of SIZE single-byte chars at DATA on a
-   specified stream PRINTCHARFUN.
+/* Used from outside of print.c to print a C unibyte
+   string at DATA on the default output stream.
    Do not use this on the contents of a Lisp string.  */
 
-static void
-write_string_1 (const char *data, int size, Lisp_Object printcharfun)
+void
+write_string (const char *data)
 {
-  PRINTDECLARE;
-
-  PRINTPREPARE;
-  strout (data, size, size, printcharfun);
-  PRINTFINISH;
+  write_string_1 (data, Vstandard_output);
 }
 
 
@@ -500,7 +551,7 @@ temp_output_buffer_setup (const char *bufname)
   Ferase_buffer ();
   XSETBUFFER (buf, current_buffer);
 
-  Frun_hooks (1, &Qtemp_buffer_setup_hook);
+  run_hook (Qtemp_buffer_setup_hook);
 
   unbind_to (count, Qnil);
 
@@ -512,19 +563,33 @@ static void print_preprocess (Lisp_Object);
 static void print_preprocess_string (INTERVAL, Lisp_Object);
 static void print_object (Lisp_Object, Lisp_Object, bool);
 
-DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
+DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0,
        doc: /* Output a newline to stream PRINTCHARFUN.
+If ENSURE is non-nil only output a newline if not already at the
+beginning of a line.  Value is non-nil if a newline is printed.
 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.  */)
-  (Lisp_Object printcharfun)
+  (Lisp_Object printcharfun, Lisp_Object ensure)
 {
-  PRINTDECLARE;
+  Lisp_Object val;
 
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   PRINTPREPARE;
-  PRINTCHAR ('\n');
+
+  if (NILP (ensure))
+    val = Qt;
+  /* Difficult to check if at line beginning so abort.  */
+  else if (FUNCTIONP (printcharfun))
+    signal_error ("Unsupported function argument", printcharfun);
+  else if (noninteractive && !NILP (printcharfun))
+    val = printchar_stdout_last == 10 ? Qnil : Qt;
+  else
+    val = NILP (Fbolp ()) ? Qt : Qnil;
+
+  if (!NILP (val))
+    printchar ('\n', printcharfun);
   PRINTFINISH;
-  return Qt;
+  return val;
 }
 
 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
@@ -552,8 +617,6 @@ If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
 is used instead.  */)
   (Lisp_Object object, Lisp_Object printcharfun)
 {
-  PRINTDECLARE;
-
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   PRINTPREPARE;
@@ -578,34 +641,24 @@ a list, a buffer, a window, a frame, etc.
 A printed representation of an object is text which describes that object.  */)
   (Lisp_Object object, Lisp_Object noescape)
 {
-  Lisp_Object printcharfun;
-  bool prev_abort_on_gc;
-  /* struct gcpro gcpro1, gcpro2; */
-  Lisp_Object save_deactivate_mark;
   ptrdiff_t count = SPECPDL_INDEX ();
-  struct buffer *previous;
 
   specbind (Qinhibit_modification_hooks, Qt);
 
-  {
-    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); */
-    prev_abort_on_gc = abort_on_gc;
-    abort_on_gc = 1;
-
-    printcharfun = Vprin1_to_string_buffer;
-    PRINTPREPARE;
-    print (object, printcharfun, NILP (noescape));
-    /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
-    PRINTFINISH;
-  }
+  /* 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.  */
+  Lisp_Object save_deactivate_mark = Vdeactivate_mark;
+  bool prev_abort_on_gc = abort_on_gc;
+  abort_on_gc = true;
+
+  Lisp_Object printcharfun = Vprin1_to_string_buffer;
+  PRINTPREPARE;
+  print (object, printcharfun, NILP (noescape));
+  /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
+  PRINTFINISH;
 
-  previous = current_buffer;
+  struct buffer *previous = current_buffer;
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   object = Fbuffer_string ();
   if (SBYTES (object) == SCHARS (object))
@@ -618,7 +671,6 @@ A printed representation of an object is text which describes that object.  */)
   set_buffer_internal (previous);
 
   Vdeactivate_mark = save_deactivate_mark;
-  /* UNGCPRO; */
 
   abort_on_gc = prev_abort_on_gc;
   return unbind_to (count, object);
@@ -648,8 +700,6 @@ If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
 is used instead.  */)
   (Lisp_Object object, Lisp_Object printcharfun)
 {
-  PRINTDECLARE;
-
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   PRINTPREPARE;
@@ -683,25 +733,16 @@ If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
 is used instead.  */)
   (Lisp_Object object, Lisp_Object printcharfun)
 {
-  PRINTDECLARE;
-  struct gcpro gcpro1;
-
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
-  GCPRO1 (object);
   PRINTPREPARE;
-  PRINTCHAR ('\n');
+  printchar ('\n', printcharfun);
   print (object, printcharfun, 1);
-  PRINTCHAR ('\n');
+  printchar ('\n', printcharfun);
   PRINTFINISH;
-  UNGCPRO;
   return object;
 }
 
-/* The subroutine object for external-debugging-output is kept here
-   for the convenience of the debugger.  */
-Lisp_Object Qexternal_debugging_output;
-
 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
        doc: /* Write CHARACTER to stderr.
 You can call print while debugging emacs, and pass it this function
@@ -709,17 +750,7 @@ to make it write to the debugging output.  */)
   (Lisp_Object character)
 {
   CHECK_NUMBER (character);
-  putc (XINT (character) & 0xFF, stderr);
-
-#ifdef WINDOWSNT
-  /* Send the output to a debugger (nothing happens if there isn't one).  */
-  if (print_output_debug_flag)
-    {
-      char buf[2] = {(char) XINT (character), '\0'};
-      OutputDebugString (buf);
-    }
-#endif
-
+  printchar_to_stream (XINT (character), stderr);
   return character;
 }
 
@@ -795,9 +826,12 @@ safe_debug_print (Lisp_Object arg)
   if (valid > 0)
     debug_print (arg);
   else
-    fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n",
-	     !valid ? "INVALID" : "SOME",
-	     XLI (arg));
+    {
+      EMACS_UINT n = XLI (arg);
+      fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n",
+	       !valid ? "INVALID" : "SOME",
+	       n);
+    }
 }
 
 
@@ -810,7 +844,6 @@ error message is constructed.  */)
 {
   struct buffer *old = current_buffer;
   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
@@ -826,10 +859,8 @@ error message is constructed.  */)
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   value = Fbuffer_string ();
 
-  GCPRO1 (value);
   Ferase_buffer ();
   set_buffer_internal (old);
-  UNGCPRO;
 
   return value;
 }
@@ -844,10 +875,9 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
 		     Lisp_Object caller)
 {
   Lisp_Object errname, errmsg, file_error, tail;
-  struct gcpro gcpro1;
 
   if (context != 0)
-    write_string_1 (context, -1, stream);
+    write_string_1 (context, stream);
 
   /* If we know from where the error was signaled, show it in
    *Messages*.  */
@@ -858,7 +888,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
       USE_SAFE_ALLOCA;
       char *name = SAFE_ALLOCA (cnamelen);
       memcpy (name, SDATA (cname), cnamelen);
-      message_dolog (name, cnamelen, 0, 0);
+      message_dolog (name, cnamelen, 0, STRING_MULTIBYTE (cname));
       message_dolog (": ", 2, 0, 0);
       SAFE_FREE ();
     }
@@ -883,7 +913,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
   /* Print an error message including the data items.  */
 
   tail = Fcdr_safe (data);
-  GCPRO1 (tail);
 
   /* For file-error, make error message by concatenating
      all the data items.  They are all strings.  */
@@ -894,9 +923,9 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
     const char *sep = ": ";
 
     if (!STRINGP (errmsg))
-      write_string_1 ("peculiar error", -1, stream);
+      write_string_1 ("peculiar error", stream);
     else if (SCHARS (errmsg))
-      Fprinc (errmsg, stream);
+      Fprinc (Fsubstitute_command_keys (errmsg), stream);
     else
       sep = NULL;
 
@@ -905,7 +934,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
 	Lisp_Object obj;
 
 	if (sep)
-	  write_string_1 (sep, 2, stream);
+	  write_string_1 (sep, stream);
 	obj = XCAR (tail);
 	if (!NILP (file_error)
 	    || EQ (errname, Qend_of_file) || EQ (errname, Quser_error))
@@ -914,8 +943,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
 	  Fprin1 (obj, stream);
       }
   }
-
-  UNGCPRO;
 }
 
 
@@ -1118,7 +1145,7 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
    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 .  */
+   more than once in OBJ: Qnil at the first time, and Qt after that.  */
 static void
 print_preprocess (Lisp_Object obj)
 {
@@ -1149,12 +1176,7 @@ print_preprocess (Lisp_Object obj)
   if (PRINT_CIRCLE_CANDIDATE_P (obj))
     {
       if (!HASH_TABLE_P (Vprint_number_table))
-	{
-	  Lisp_Object args[2];
-	  args[0] = QCtest;
-	  args[1] = Qeq;
-	  Vprint_number_table = Fmake_hash_table (2, args);
-	}
+	Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq);
 
       /* In case print-circle is nil and print-gensym is t,
 	 add OBJ to Vprint_number_table only when OBJ is a symbol.  */
@@ -1208,7 +1230,8 @@ print_preprocess (Lisp_Object obj)
 	  size = ASIZE (obj);
 	  if (size & PSEUDOVECTOR_FLAG)
 	    size &= PSEUDOVECTOR_SIZE_MASK;
-	  for (i = 0; i < size; i++)
+	  for (i = (SUB_CHAR_TABLE_P (obj)
+		    ? SUB_CHAR_TABLE_OFFSET : 0); i < size; i++)
 	    print_preprocess (AREF (obj, i));
 	  if (HASH_TABLE_P (obj))
 	    { /* For hash tables, the key_and_value slot is past
@@ -1388,119 +1411,82 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	print_string (obj, printcharfun);
       else
 	{
-	  register ptrdiff_t i_byte;
-	  struct gcpro gcpro1;
-	  unsigned char *str;
+	  ptrdiff_t i, i_byte;
 	  ptrdiff_t size_byte;
-	  /* 1 means we must ensure that the next character we output
+	  /* True means we must ensure that the next character we output
 	     cannot be taken as part of a hex character escape.  */
-	  bool need_nonhex = 0;
+	  bool need_nonhex = false;
 	  bool multibyte = STRING_MULTIBYTE (obj);
 
-	  GCPRO1 (obj);
-
 	  if (! EQ (Vprint_charset_text_property, Qt))
 	    obj = print_prune_string_charset (obj);
 
 	  if (string_intervals (obj))
-	    {
-	      PRINTCHAR ('#');
-	      PRINTCHAR ('(');
-	    }
+	    print_c_string ("#(", printcharfun);
 
-	  PRINTCHAR ('\"');
-	  str = SDATA (obj);
+	  printchar ('\"', printcharfun);
 	  size_byte = SBYTES (obj);
 
-	  for (i_byte = 0; i_byte < size_byte;)
+	  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.  */
-	      int len;
+		 corresponding character code before handing it to printchar.  */
 	      int c;
 
-	      if (multibyte)
-		{
-		  c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
-		  i_byte += len;
-		}
-	      else
-		c = str[i_byte++];
+	      FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte);
 
 	      QUIT;
 
-	      if (c == '\n' && print_escape_newlines)
-		{
-		  PRINTCHAR ('\\');
-		  PRINTCHAR ('n');
-		}
-	      else if (c == '\f' && print_escape_newlines)
+	      if (multibyte
+		  ? (CHAR_BYTE8_P (c) && (c = CHAR_TO_BYTE8 (c), true))
+		  : (SINGLE_BYTE_CHAR_P (c) && ! ASCII_CHAR_P (c)
+		     && print_escape_nonascii))
 		{
-		  PRINTCHAR ('\\');
-		  PRINTCHAR ('f');
-		}
-	      else if (multibyte
-		       && (CHAR_BYTE8_P (c)
-			   || (! ASCII_CHAR_P (c) && print_escape_multibyte)))
-		{
-		  /* When multibyte is disabled,
-		     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.  */
-		  char outbuf[50];
-		  int len;
-
-		  if (CHAR_BYTE8_P (c))
-		    len = sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
-		  else
-		    {
-		      len = sprintf (outbuf, "\\x%04x", c);
-		      need_nonhex = 1;
-		    }
-		  strout (outbuf, len, len, printcharfun);
-		}
-	      else if (! multibyte
-		       && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
-		       && print_escape_nonascii)
-		{
-		  /* When printing in a multibyte buffer
-		     or when explicitly requested,
+		  /* When printing a raw 8-bit byte in a multibyte buffer, or
+		     (when requested) a non-ASCII character in a unibyte buffer,
 		     print single-byte non-ASCII string chars
 		     using octal escapes.  */
 		  char outbuf[5];
-		  int len = sprintf (outbuf, "\\%03o", c);
+		  int len = sprintf (outbuf, "\\%03o", c + 0u);
+		  strout (outbuf, len, len, printcharfun);
+		  need_nonhex = false;
+		}
+	      else if (multibyte
+		       && ! ASCII_CHAR_P (c) && print_escape_multibyte)
+		{
+		  /* When requested, print multibyte chars using hex escapes.  */
+		  char outbuf[sizeof "\\x" + INT_STRLEN_BOUND (c)];
+		  int len = sprintf (outbuf, "\\x%04x", c + 0u);
 		  strout (outbuf, len, len, printcharfun);
+		  need_nonhex = true;
 		}
 	      else
 		{
 		  /* If we just had a hex escape, and this character
 		     could be taken as part of it,
 		     output `\ ' to prevent that.  */
-		  if (need_nonhex)
-		    {
-		      need_nonhex = 0;
-		      if ((c >= 'a' && c <= 'f')
-			  || (c >= 'A' && c <= 'F')
-			  || (c >= '0' && c <= '9'))
-			strout ("\\ ", -1, -1, printcharfun);
-		    }
-
-		  if (c == '\"' || c == '\\')
-		    PRINTCHAR ('\\');
-		  PRINTCHAR (c);
+		  if (need_nonhex && c_isxdigit (c))
+		    print_c_string ("\\ ", printcharfun);
+
+		  if (c == '\n' && print_escape_newlines
+		      ? (c = 'n', true)
+		      : c == '\f' && print_escape_newlines
+		      ? (c = 'f', true)
+		      : c == '\"' || c == '\\')
+		    printchar ('\\', printcharfun);
+
+		  printchar (c, printcharfun);
+		  need_nonhex = false;
 		}
 	    }
-	  PRINTCHAR ('\"');
+	  printchar ('\"', printcharfun);
 
 	  if (string_intervals (obj))
 	    {
 	      traverse_intervals (string_intervals (obj),
 				  0, print_interval, printcharfun);
-	      PRINTCHAR (')');
+	      printchar (')', printcharfun);
 	    }
-
-	  UNGCPRO;
 	}
       break;
 
@@ -1541,14 +1527,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	size_byte = SBYTES (name);
 
 	if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
-	  {
-	    PRINTCHAR ('#');
-	    PRINTCHAR (':');
-	  }
+	  print_c_string ("#:", printcharfun);
 	else if (size_byte == 0)
 	  {
-	    PRINTCHAR ('#');
-	    PRINTCHAR ('#');
+	    print_c_string ("##", printcharfun);
 	    break;
 	  }
 
@@ -1566,9 +1548,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 		    || c == ',' || c == '.' || c == '`'
 		    || c == '[' || c == ']' || c == '?' || c <= 040
 		    || confusing)
-		  PRINTCHAR ('\\'), confusing = 0;
+		  {
+		    printchar ('\\', printcharfun);
+		    confusing = false;
+		  }
 	      }
-	    PRINTCHAR (c);
+	    printchar (c, printcharfun);
 	  }
       }
       break;
@@ -1577,111 +1562,105 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
       /* If deeper than spec'd depth, print placeholder.  */
       if (INTEGERP (Vprint_level)
 	  && print_depth > XINT (Vprint_level))
-	strout ("...", -1, -1, printcharfun);
+	print_c_string ("...", printcharfun);
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
-	       && (EQ (XCAR (obj), Qquote)))
+	       && EQ (XCAR (obj), Qquote))
 	{
-	  PRINTCHAR ('\'');
+	  printchar ('\'', printcharfun);
 	  print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
 	}
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
-	       && (EQ (XCAR (obj), Qfunction)))
+	       && EQ (XCAR (obj), Qfunction))
 	{
-	  PRINTCHAR ('#');
-	  PRINTCHAR ('\'');
+	  print_c_string ("#'", printcharfun);
 	  print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
 	}
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
-	       && ((EQ (XCAR (obj), Qbackquote))))
+	       && EQ (XCAR (obj), Qbackquote))
 	{
-	  print_object (XCAR (obj), printcharfun, 0);
+	  printchar ('`', printcharfun);
 	  new_backquote_output++;
 	  print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
 	  new_backquote_output--;
 	}
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
 	       && new_backquote_output
-	       && ((EQ (XCAR (obj), Qbackquote)
-		    || EQ (XCAR (obj), Qcomma)
-		    || EQ (XCAR (obj), Qcomma_at)
-		    || EQ (XCAR (obj), Qcomma_dot))))
+	       && (EQ (XCAR (obj), Qcomma)
+		   || EQ (XCAR (obj), Qcomma_at)
+		   || EQ (XCAR (obj), Qcomma_dot)))
 	{
-	  print_object (XCAR (obj), printcharfun, 0);
+	  print_object (XCAR (obj), printcharfun, false);
 	  new_backquote_output--;
 	  print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
 	  new_backquote_output++;
 	}
       else
 	{
-	  PRINTCHAR ('(');
+	  printchar ('(', printcharfun);
 
-	  {
-	    printmax_t i, print_length;
-	    Lisp_Object halftail = obj;
+	  Lisp_Object halftail = obj;
 
-	    /* 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 = TYPE_MAXIMUM (printmax_t);
+	  /* Negative values of print-length are invalid in CL.
+	     Treat them like nil, as CMUCL does.  */
+	  printmax_t print_length = (NATNUMP (Vprint_length)
+				     ? XFASTINT (Vprint_length)
+				     : TYPE_MAXIMUM (printmax_t));
 
-	    i = 0;
-	    while (CONSP (obj))
-	      {
-		/* Detect circular list.  */
-		if (NILP (Vprint_circle))
-		  {
-		    /* Simple but incomplete way.  */
-		    if (i != 0 && EQ (obj, halftail))
-		      {
-			int len = sprintf (buf, " . #%"pMd, i / 2);
-			strout (buf, len, len, printcharfun);
-			goto end_of_list;
-		      }
-		  }
-		else
-		  {
-		    /* With the print-circle feature.  */
-		    if (i != 0)
-		      {
-			Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
-			if (INTEGERP (num))
-			  {
-			    strout (" . ", 3, 3, printcharfun);
-			    print_object (obj, printcharfun, escapeflag);
-			    goto end_of_list;
-			  }
-		      }
-		  }
+	  printmax_t i = 0;
+	  while (CONSP (obj))
+	    {
+	      /* Detect circular list.  */
+	      if (NILP (Vprint_circle))
+		{
+		  /* Simple but incomplete way.  */
+		  if (i != 0 && EQ (obj, halftail))
+		    {
+		      int len = sprintf (buf, " . #%"pMd, i / 2);
+		      strout (buf, len, len, printcharfun);
+		      goto end_of_list;
+		    }
+		}
+	      else
+		{
+		  /* With the print-circle feature.  */
+		  if (i != 0)
+		    {
+		      Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+		      if (INTEGERP (num))
+			{
+			  print_c_string (" . ", printcharfun);
+			  print_object (obj, printcharfun, escapeflag);
+			  goto end_of_list;
+			}
+		    }
+		}
 
-		if (i)
-		  PRINTCHAR (' ');
+	      if (i)
+		printchar (' ', printcharfun);
 
-		if (print_length <= i)
-		  {
-		    strout ("...", 3, 3, printcharfun);
-		    goto end_of_list;
-		  }
+	      if (print_length <= i)
+		{
+		  print_c_string ("...", printcharfun);
+		  goto end_of_list;
+		}
 
-		i++;
-		print_object (XCAR (obj), printcharfun, escapeflag);
+	      i++;
+	      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);
+	      print_c_string (" . ", printcharfun);
 	      print_object (obj, printcharfun, escapeflag);
 	    }
 
 	end_of_list:
-	  PRINTCHAR (')');
+	  printchar (')', printcharfun);
 	}
       break;
 
@@ -1690,9 +1669,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	{
 	  if (escapeflag)
 	    {
-	      strout ("#<process ", -1, -1, printcharfun);
+	      print_c_string ("#<process ", printcharfun);
 	      print_string (XPROCESS (obj)->name, printcharfun);
-	      PRINTCHAR ('>');
+	      printchar ('>', printcharfun);
 	    }
 	  else
 	    print_string (XPROCESS (obj)->name, printcharfun);
@@ -1700,20 +1679,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
       else if (BOOL_VECTOR_P (obj))
 	{
 	  ptrdiff_t i;
-	  int len;
 	  unsigned char c;
-	  struct gcpro gcpro1;
-	  ptrdiff_t size_in_chars
-	    = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
-	       / BOOL_VECTOR_BITS_PER_CHAR);
-
-	  GCPRO1 (obj);
+	  EMACS_INT size = bool_vector_size (obj);
+	  ptrdiff_t size_in_chars = bool_vector_bytes (size);
+	  ptrdiff_t real_size_in_chars = size_in_chars;
 
-	  PRINTCHAR ('#');
-	  PRINTCHAR ('&');
-	  len = sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size);
+	  int len = sprintf (buf, "#&%"pI"d\"", size);
 	  strout (buf, len, len, printcharfun);
-	  PRINTCHAR ('\"');
 
 	  /* Don't print more characters than the specified maximum.
 	     Negative values of print-length are invalid.  Treat them
@@ -1725,68 +1697,59 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	  for (i = 0; i < size_in_chars; i++)
 	    {
 	      QUIT;
-	      c = XBOOL_VECTOR (obj)->data[i];
+	      c = bool_vector_uchar_data (obj)[i];
 	      if (c == '\n' && print_escape_newlines)
-		{
-		  PRINTCHAR ('\\');
-		  PRINTCHAR ('n');
-		}
+		print_c_string ("\\n", printcharfun);
 	      else if (c == '\f' && print_escape_newlines)
-		{
-		  PRINTCHAR ('\\');
-		  PRINTCHAR ('f');
-		}
+		print_c_string ("\\f", printcharfun);
 	      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));
+		  len = sprintf (buf, "\\%o", c);
+		  strout (buf, len, len, printcharfun);
 		}
 	      else
 		{
 		  if (c == '\"' || c == '\\')
-		    PRINTCHAR ('\\');
-		  PRINTCHAR (c);
+		    printchar ('\\', printcharfun);
+		  printchar (c, printcharfun);
 		}
 	    }
-	  PRINTCHAR ('\"');
 
-	  UNGCPRO;
+	  if (size_in_chars < real_size_in_chars)
+	    print_c_string (" ...", printcharfun);
+	  printchar ('\"', printcharfun);
 	}
       else if (SUBRP (obj))
 	{
-	  strout ("#<subr ", -1, -1, printcharfun);
-	  strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun);
-	  PRINTCHAR ('>');
+	  print_c_string ("#<subr ", printcharfun);
+	  print_c_string (XSUBR (obj)->symbol_name, printcharfun);
+	  printchar ('>', printcharfun);
 	}
       else if (WINDOWP (obj))
 	{
-	  void *ptr = XWINDOW (obj);
-	  int len = sprintf (buf, "#<window %p", ptr);
+	  int len = sprintf (buf, "#<window %"pI"d",
+			     XWINDOW (obj)->sequence_number);
 	  strout (buf, len, len, printcharfun);
 	  if (BUFFERP (XWINDOW (obj)->contents))
 	    {
-	      strout (" on ", -1, -1, printcharfun);
+	      print_c_string (" on ", printcharfun);
 	      print_string (BVAR (XBUFFER (XWINDOW (obj)->contents), name),
 			    printcharfun);
 	    }
-	  PRINTCHAR ('>');
+	  printchar ('>', printcharfun);
 	}
       else if (TERMINALP (obj))
 	{
-	  int len;
 	  struct terminal *t = XTERMINAL (obj);
-	  strout ("#<terminal ", -1, -1, printcharfun);
-	  len = sprintf (buf, "%d", t->id);
+	  int len = sprintf (buf, "#<terminal %d", t->id);
 	  strout (buf, len, len, printcharfun);
 	  if (t->name)
 	    {
-	      strout (" on ", -1, -1, printcharfun);
-	      strout (t->name, -1, -1, printcharfun);
+	      print_c_string (" on ", printcharfun);
+	      print_c_string (t->name, printcharfun);
 	    }
-	  PRINTCHAR ('>');
+	  printchar ('>', printcharfun);
 	}
       else if (HASH_TABLE_P (obj))
 	{
@@ -1796,16 +1759,14 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	  int len;
 #if 0
 	  void *ptr = h;
-	  strout ("#<hash-table", -1, -1, printcharfun);
+	  print_c_string ("#<hash-table", printcharfun);
 	  if (SYMBOLP (h->test))
 	    {
-	      PRINTCHAR (' ');
-	      PRINTCHAR ('\'');
-	      strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun);
-	      PRINTCHAR (' ');
-	      strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun);
-	      PRINTCHAR (' ');
-	      len = sprintf (buf, "%"pD"d/%"pD"d", h->count, ASIZE (h->next));
+	      print_c_string (" '", printcharfun);
+	      print_c_string (SSDATA (SYMBOL_NAME (h->test)), printcharfun);
+	      printchar (' ', printcharfun);
+	      print_c_string (SSDATA (SYMBOL_NAME (h->weak)), printcharfun);
+	      len = sprintf (buf, " %"pD"d/%"pD"d", h->count, ASIZE (h->next));
 	      strout (buf, len, len, printcharfun);
 	    }
 	  len = sprintf (buf, " %p>", ptr);
@@ -1819,29 +1780,29 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 
 	  if (!NILP (h->test.name))
 	    {
-	      strout (" test ", -1, -1, printcharfun);
+	      print_c_string (" test ", printcharfun);
 	      print_object (h->test.name, printcharfun, escapeflag);
 	    }
 
 	  if (!NILP (h->weak))
 	    {
-	      strout (" weakness ", -1, -1, printcharfun);
+	      print_c_string (" weakness ", printcharfun);
 	      print_object (h->weak, printcharfun, escapeflag);
 	    }
 
 	  if (!NILP (h->rehash_size))
 	    {
-	      strout (" rehash-size ", -1, -1, printcharfun);
+	      print_c_string (" rehash-size ", printcharfun);
 	      print_object (h->rehash_size, printcharfun, escapeflag);
 	    }
 
 	  if (!NILP (h->rehash_threshold))
 	    {
-	      strout (" rehash-threshold ", -1, -1, printcharfun);
+	      print_c_string (" rehash-threshold ", printcharfun);
 	      print_object (h->rehash_threshold, printcharfun, escapeflag);
 	    }
 
-	  strout (" data ", -1, -1, printcharfun);
+	  print_c_string (" data ", printcharfun);
 
 	  /* Print the data here as a plist. */
 	  real_size = HASH_TABLE_SIZE (h);
@@ -1852,49 +1813,47 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	      && XFASTINT (Vprint_length) < size)
 	    size = XFASTINT (Vprint_length);
 
-	  PRINTCHAR ('(');
+	  printchar ('(', printcharfun);
 	  for (i = 0; i < size; i++)
 	    if (!NILP (HASH_HASH (h, i)))
 	      {
-		if (i) PRINTCHAR (' ');
+		if (i) printchar (' ', printcharfun);
 		print_object (HASH_KEY (h, i), printcharfun, escapeflag);
-		PRINTCHAR (' ');
+		printchar (' ', printcharfun);
 		print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
 	      }
 
 	  if (size < real_size)
-	    strout (" ...", 4, 4, printcharfun);
+	    print_c_string (" ...", printcharfun);
 
-	  PRINTCHAR (')');
-	  PRINTCHAR (')');
+	  print_c_string ("))", printcharfun);
 
 	}
       else if (BUFFERP (obj))
 	{
 	  if (!BUFFER_LIVE_P (XBUFFER (obj)))
-	    strout ("#<killed buffer>", -1, -1, printcharfun);
+	    print_c_string ("#<killed buffer>", printcharfun);
 	  else if (escapeflag)
 	    {
-	      strout ("#<buffer ", -1, -1, printcharfun);
+	      print_c_string ("#<buffer ", printcharfun);
 	      print_string (BVAR (XBUFFER (obj), name), printcharfun);
-	      PRINTCHAR ('>');
+	      printchar ('>', printcharfun);
 	    }
 	  else
 	    print_string (BVAR (XBUFFER (obj), name), printcharfun);
 	}
       else if (WINDOW_CONFIGURATIONP (obj))
-	{
-	  strout ("#<window-configuration>", -1, -1, printcharfun);
-	}
+	print_c_string ("#<window-configuration>", printcharfun);
       else if (FRAMEP (obj))
 	{
 	  int len;
 	  void *ptr = XFRAME (obj);
 	  Lisp_Object frame_name = XFRAME (obj)->name;
 
-	  strout ((FRAME_LIVE_P (XFRAME (obj))
-		   ? "#<frame " : "#<dead frame "),
-		  -1, -1, printcharfun);
+	  print_c_string ((FRAME_LIVE_P (XFRAME (obj))
+			   ? "#<frame "
+			   : "#<dead frame "),
+			  printcharfun);
 	  if (!STRINGP (frame_name))
 	    {
 	      /* A frame could be too young and have no name yet;
@@ -1915,12 +1874,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	  if (! FONT_OBJECT_P (obj))
 	    {
 	      if (FONT_SPEC_P (obj))
-		strout ("#<font-spec", -1, -1, printcharfun);
+		print_c_string ("#<font-spec", printcharfun);
 	      else
-		strout ("#<font-entity", -1, -1, printcharfun);
+		print_c_string ("#<font-entity", printcharfun);
 	      for (i = 0; i < FONT_SPEC_MAX; i++)
 		{
-		  PRINTCHAR (' ');
+		  printchar (' ', printcharfun);
 		  if (i < FONT_WEIGHT_INDEX || i > FONT_WIDTH_INDEX)
 		    print_object (AREF (obj, i), printcharfun, escapeflag);
 		  else
@@ -1930,15 +1889,15 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	    }
 	  else
 	    {
-	      strout ("#<font-object ", -1, -1, printcharfun);
+	      print_c_string ("#<font-object ", printcharfun);
 	      print_object (AREF (obj, FONT_NAME_INDEX), printcharfun,
 			    escapeflag);
 	    }
-	  PRINTCHAR ('>');
+	  printchar ('>', printcharfun);
 	}
       else if (THREADP (obj))
 	{
-	  strout ("#<thread ", -1, -1, printcharfun);
+	  print_c_string ("#<thread ", printcharfun);
 	  if (STRINGP (XTHREAD (obj)->name))
 	    print_string (XTHREAD (obj)->name, printcharfun);
 	  else
@@ -1946,11 +1905,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	      int len = sprintf (buf, "%p", XTHREAD (obj));
 	      strout (buf, len, len, printcharfun);
 	    }
-	  PRINTCHAR ('>');
+	  printchar ('>', printcharfun);
 	}
       else if (MUTEXP (obj))
 	{
-	  strout ("#<mutex ", -1, -1, printcharfun);
+	  print_c_string ("#<mutex ", printcharfun);
 	  if (STRINGP (XMUTEX (obj)->name))
 	    print_string (XMUTEX (obj)->name, printcharfun);
 	  else
@@ -1958,11 +1917,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	      int len = sprintf (buf, "%p", XMUTEX (obj));
 	      strout (buf, len, len, printcharfun);
 	    }
-	  PRINTCHAR ('>');
+	  printchar ('>', printcharfun);
 	}
       else if (CONDVARP (obj))
 	{
-	  strout ("#<condvar ", -1, -1, printcharfun);
+	  print_c_string ("#<condvar ", printcharfun);
 	  if (STRINGP (XCONDVAR (obj)->name))
 	    print_string (XCONDVAR (obj)->name, printcharfun);
 	  else
@@ -1970,14 +1929,14 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	      int len = sprintf (buf, "%p", XCONDVAR (obj));
 	      strout (buf, len, len, printcharfun);
 	    }
-	  PRINTCHAR ('>');
+	  printchar ('>', printcharfun);
 	}
       else
 	{
 	  ptrdiff_t size = ASIZE (obj);
 	  if (COMPILEDP (obj))
 	    {
-	      PRINTCHAR ('#');
+	      printchar ('#', printcharfun);
 	      size &= PSEUDOVECTOR_SIZE_MASK;
 	    }
 	  if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj))
@@ -1990,38 +1949,45 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 		 Otherwise we'll make a line extremely long, which
 		 results in slow redisplay.  */
 	      if (SUB_CHAR_TABLE_P (obj)
-		  && XINT (XSUB_CHAR_TABLE (obj)->depth) == 3)
-		PRINTCHAR ('\n');
-	      PRINTCHAR ('#');
-	      PRINTCHAR ('^');
+		  && XSUB_CHAR_TABLE (obj)->depth == 3)
+		printchar ('\n', printcharfun);
+	      print_c_string ("#^", printcharfun);
 	      if (SUB_CHAR_TABLE_P (obj))
-		PRINTCHAR ('^');
+		printchar ('^', printcharfun);
 	      size &= PSEUDOVECTOR_SIZE_MASK;
 	    }
 	  if (size & PSEUDOVECTOR_FLAG)
 	    goto badtype;
 
-	  PRINTCHAR ('[');
+	  printchar ('[', printcharfun);
 	  {
-	    register int i;
-	    register Lisp_Object tem;
+	    int i, idx = SUB_CHAR_TABLE_P (obj) ? SUB_CHAR_TABLE_OFFSET : 0;
+	    Lisp_Object tem;
 	    ptrdiff_t real_size = size;
 
+	    /* For a sub char-table, print heading non-Lisp data first.  */
+	    if (SUB_CHAR_TABLE_P (obj))
+	      {
+		i = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth,
+			     XSUB_CHAR_TABLE (obj)->min_char);
+		strout (buf, i, i, printcharfun);
+	      }
+
 	    /* Don't print more elements than the specified maximum.  */
 	    if (NATNUMP (Vprint_length)
 		&& XFASTINT (Vprint_length) < size)
 	      size = XFASTINT (Vprint_length);
 
-	    for (i = 0; i < size; i++)
+	    for (i = idx; i < size; i++)
 	      {
-		if (i) PRINTCHAR (' ');
+		if (i) printchar (' ', printcharfun);
 		tem = AREF (obj, i);
 		print_object (tem, printcharfun, escapeflag);
 	      }
 	    if (size < real_size)
-	      strout (" ...", 4, 4, printcharfun);
+	      print_c_string (" ...", printcharfun);
 	  }
-	  PRINTCHAR (']');
+	  printchar (']', printcharfun);
 	}
       break;
 
@@ -2029,26 +1995,25 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
       switch (XMISCTYPE (obj))
 	{
 	case Lisp_Misc_Marker:
-	  strout ("#<marker ", -1, -1, printcharfun);
+	  print_c_string ("#<marker ", printcharfun);
 	  /* Do you think this is necessary?  */
 	  if (XMARKER (obj)->insertion_type != 0)
-	    strout ("(moves after insertion) ", -1, -1, printcharfun);
+	    print_c_string ("(moves after insertion) ", printcharfun);
 	  if (! XMARKER (obj)->buffer)
-	    strout ("in no buffer", -1, -1, printcharfun);
+	    print_c_string ("in no buffer", printcharfun);
 	  else
 	    {
-	      int len = sprintf (buf, "at %"pD"d", marker_position (obj));
+	      int len = sprintf (buf, "at %"pD"d in ", marker_position (obj));
 	      strout (buf, len, len, printcharfun);
-	      strout (" in ", -1, -1, printcharfun);
 	      print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
 	    }
-	  PRINTCHAR ('>');
+	  printchar ('>', printcharfun);
 	  break;
 
 	case Lisp_Misc_Overlay:
-	  strout ("#<overlay ", -1, -1, printcharfun);
+	  print_c_string ("#<overlay ", printcharfun);
 	  if (! XMARKER (OVERLAY_START (obj))->buffer)
-	    strout ("in no buffer", -1, -1, printcharfun);
+	    print_c_string ("in no buffer", printcharfun);
 	  else
 	    {
 	      int len = sprintf (buf, "from %"pD"d to %"pD"d in ",
@@ -2058,14 +2023,21 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	      print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
 			    printcharfun);
 	    }
-	  PRINTCHAR ('>');
-	  break;
+	  printchar ('>', printcharfun);
+          break;
+
+        case Lisp_Misc_Finalizer:
+          print_c_string ("#<finalizer", printcharfun);
+          if (NILP (XFINALIZER (obj)->function))
+            print_c_string (" used", printcharfun);
+	  printchar ('>', printcharfun);
+          break;
 
 	  /* Remaining cases shouldn't happen in normal usage, but let's
 	     print them anyway for the benefit of the debugger.  */
 
 	case Lisp_Misc_Free:
-	  strout ("#<misc free cell>", -1, -1, printcharfun);
+	  print_c_string ("#<misc free cell>", printcharfun);
 	  break;
 
 	case Lisp_Misc_Save_Value:
@@ -2073,14 +2045,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	    int i;
 	    struct Lisp_Save_Value *v = XSAVE_VALUE (obj);
 
-	    strout ("#<save-value ", -1, -1, printcharfun);
+	    print_c_string ("#<save-value ", printcharfun);
 
 	    if (v->save_type == SAVE_TYPE_MEMORY)
 	      {
 		ptrdiff_t amount = v->data[1].integer;
 
-#if GC_MARK_STACK
-
 		/* valid_lisp_object_p is reliable, so try to print up
 		   to 8 saved objects.  This code is rarely used, so
 		   it's OK that valid_lisp_object_p is slow.  */
@@ -2094,27 +2064,17 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 		for (i = 0; i < limit; i++)
 		  {
 		    Lisp_Object maybe = area[i];
+		    int valid = valid_lisp_object_p (maybe);
 
-		    if (valid_lisp_object_p (maybe) > 0)
-		      {
-			PRINTCHAR (' ');
-			print_object (maybe, printcharfun, escapeflag);
-		      }
+		    printchar (' ', printcharfun);
+		    if (0 < valid)
+		      print_object (maybe, printcharfun, escapeflag);
 		    else
-		      strout (" <invalid>", -1, -1, printcharfun);
+		      print_c_string (valid < 0 ? "<some>" : "<invalid>",
+				      printcharfun);
 		  }
 		if (i == limit && i < amount)
-		  strout (" ...", 4, 4, printcharfun);
-
-#else /* not GC_MARK_STACK */
-
-		/* There is no reliable way to determine whether the objects
-		   are initialized, so do not try to print them.  */
-
-		i = sprintf (buf, "with %"pD"d objects", amount);
-		strout (buf, i, i, printcharfun);
-
-#endif /* GC_MARK_STACK */
+		  print_c_string (" ...", printcharfun);
 	      }
 	    else
 	      {
@@ -2123,7 +2083,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 		for (index = 0; index < SAVE_VALUE_SLOTS; index++)
 		  {
 		    if (index)
-		      PRINTCHAR (' ');
+		      printchar (' ', printcharfun);
 
 		    switch (save_type (v, index))
 		      {
@@ -2159,7 +2119,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 		    strout (buf, i, i, printcharfun);
 		  }
 	      }
-	    PRINTCHAR ('>');
+	    printchar ('>', printcharfun);
 	  }
 	  break;
 
@@ -2174,16 +2134,17 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	int len;
 	/* We're in trouble if this happens!
 	   Probably should just emacs_abort ().  */
-	strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun);
+	print_c_string ("#<EMACS BUG: INVALID DATATYPE ", printcharfun);
 	if (MISCP (obj))
-	  len = sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
+	  len = sprintf (buf, "(MISC 0x%04x)", (unsigned) XMISCTYPE (obj));
 	else if (VECTORLIKEP (obj))
-	  len = sprintf (buf, "(PVEC 0x%08"pD"x)", ASIZE (obj));
+	  len = sprintf (buf, "(PVEC 0x%08zx)", (size_t) ASIZE (obj));
 	else
-	  len = sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
+	  len = sprintf (buf, "(0x%02x)", (unsigned) XTYPE (obj));
 	strout (buf, len, len, printcharfun);
-	strout (" Save your buffers immediately and please report this bug>",
-		-1, -1, printcharfun);
+	print_c_string ((" Save your buffers immediately"
+			 " and please report this bug>"),
+			printcharfun);
       }
     }
 
@@ -2199,12 +2160,12 @@ print_interval (INTERVAL interval, Lisp_Object printcharfun)
 {
   if (NILP (interval->plist))
     return;
-  PRINTCHAR (' ');
+  printchar (' ', printcharfun);
   print_object (make_number (interval->position), printcharfun, 1);
-  PRINTCHAR (' ');
+  printchar (' ', printcharfun);
   print_object (make_number (interval->position + LENGTH (interval)),
 		printcharfun, 1);
-  PRINTCHAR (' ');
+  printchar (' ', printcharfun);
   print_object (interval->plist, printcharfun, 1);
 }
 
@@ -2214,7 +2175,10 @@ print_interval (INTERVAL interval, Lisp_Object printcharfun)
 void
 init_print_once (void)
 {
+  /* The subroutine object for external-debugging-output is kept here
+     for the convenience of the debugger.  */
   DEFSYM (Qexternal_debugging_output, "external-debugging-output");
+
   defsubr (&Sexternal_debugging_output);
 }
 
@@ -2249,7 +2213,6 @@ 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;
-  DEFSYM (Qfloat_output_format, "float-output-format");
 
   DEFVAR_LISP ("print-length", Vprint_length,
 	       doc: /* Maximum length of list to print before abbreviating.
@@ -2268,7 +2231,7 @@ Also print formfeeds as `\\f'.  */);
 
   DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii,
 	       doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
-\(OOO is the octal representation of the character code.)
+(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.  */);
@@ -2276,13 +2239,13 @@ enabled regardless of the value of the variable.  */);
 
   DEFVAR_BOOL ("print-escape-multibyte", print_escape_multibyte,
 	       doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
-\(XXXX is the hex representation of the character code.)
+(XXXX is the hex representation of the character code.)
 This affects only `prin1'.  */);
   print_escape_multibyte = 0;
 
   DEFVAR_BOOL ("print-quoted", print_quoted,
 	       doc: /* Non-nil means print quoted forms with reader syntax.
-I.e., (quote foo) prints as 'foo, (function foo) as #'foo.  */);
+I.e., (quote foo) prints as \\='foo, (function foo) as #\\='foo.  */);
   print_quoted = 0;
 
   DEFVAR_LISP ("print-gensym", Vprint_gensym,