print.c

/* Lisp object printing and output streams.

Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2017 Free Software
Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */


#include <config.h>
#include "sysstdio.h"

#include "lisp.h"
#include "character.h"
#include "coding.h"
#include "buffer.h"
#include "charset.h"
#include "frame.h"
#include "process.h"
#include "disptab.h"
#include "intervals.h"
#include "blockinput.h"
#include "xwidget.h"

#include <c-ctype.h>
#include <float.h>
#include <ftoastr.h>

#ifdef WINDOWSNT
# include <sys/socket.h> /* for F_DUPFD_CLOEXEC */
#endif

struct terminal;

/* Avoid actual stack overflow in print.  */
static ptrdiff_t print_depth;

/* Level of nesting inside outputting backquote in new style.  */
static ptrdiff_t new_backquote_output;

/* Detect most circularities to print finite 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;

/* Size allocated in print_buffer.  */
static ptrdiff_t print_buffer_size;
/* Chars stored in print_buffer.  */
static ptrdiff_t print_buffer_pos;
/* Bytes stored in print_buffer.  */
static ptrdiff_t print_buffer_pos_byte;

/* 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:
     t    the object will be printed only once.
     -N   the object will be printed several times and will take number N.
     N    the object has been printed so we can refer to it as #N#.
   print_number_index holds the largest N already used.
   N has to be striclty larger than 0 since we need to distinguish -N.  */
static ptrdiff_t print_number_index;
static void print_interval (INTERVAL interval, Lisp_Object printcharfun);

/* GDB resets this to zero on W32 to disable OutputDebugString calls.  */
bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;


/* Low level output routines for characters and strings.  */

/* 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.
   Use printchar to output one character,
   or call strout to output a block of characters.  */

#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;		\
   ptrdiff_t specpdl_count = SPECPDL_INDEX ();				\
   bool free_print_buffer = 0;						\
   bool multibyte							\
     = !NILP (BVAR (current_buffer, enable_multibyte_characters));	\
   Lisp_Object original = printcharfun;					\
   if (NILP (printcharfun)) printcharfun = Qt;				\
   if (BUFFERP (printcharfun))						\
     {									\
       if (XBUFFER (printcharfun) != current_buffer)			\
	 Fset_buffer (printcharfun);					\
       printcharfun = Qnil;						\
     }									\
   if (MARKERP (printcharfun))						\
     {									\
       ptrdiff_t marker_pos;						\
       if (! XMARKER (printcharfun)->buffer)				\
         error ("Marker does not point anywhere");			\
       if (XMARKER (printcharfun)->buffer != current_buffer)		\
         set_buffer_internal (XMARKER (printcharfun)->buffer);		\
       marker_pos = marker_position (printcharfun);			\
       if (marker_pos < BEGV || marker_pos > ZV)			\
	 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,						\
		    marker_byte_position (printcharfun));		\
       start_point = PT;						\
       start_point_byte = PT_BYTE;					\
       printcharfun = Qnil;						\
     }									\
   if (NILP (printcharfun))						\
     {									\
       Lisp_Object string;						\
       if (NILP (BVAR (current_buffer, enable_multibyte_characters))	\
	   && ! print_escape_multibyte)					\
         specbind (Qprint_escape_multibyte, Qt);			\
       if (! NILP (BVAR (current_buffer, enable_multibyte_characters))	\
	   && ! print_escape_nonascii)					\
         specbind (Qprint_escape_nonascii, Qt);				\
       if (print_buffer != 0)						\
	 {								\
	   string = make_string_from_bytes (print_buffer,		\
					    print_buffer_pos,		\
					    print_buffer_pos_byte);	\
	   record_unwind_protect (print_unwind, string);		\
	 }								\
       else								\
	 {								\
	   int new_size = 1000;						\
	   print_buffer = xmalloc (new_size);				\
	   print_buffer_size = new_size;				\
	   free_print_buffer = 1;					\
	 }								\
       print_buffer_pos = 0;						\
       print_buffer_pos_byte = 0;					\
     }									\
   if (EQ (printcharfun, Qt) && ! noninteractive)			\
     setup_echo_area_for_printing (multibyte);

#define PRINTFINISH							\
   if (NILP (printcharfun))						\
     {									\
       if (print_buffer_pos != print_buffer_pos_byte			\
	   && NILP (BVAR (current_buffer, enable_multibyte_characters)))\
	 {								\
	   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,			\
			print_buffer_pos_byte, 0, 1, 0);		\
       signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
     }									\
   if (free_print_buffer)						\
     {									\
       xfree (print_buffer);						\
       print_buffer = 0;						\
     }									\
   unbind_to (specpdl_count, Qnil);					\
   if (MARKERP (original))						\
     set_marker_both (original, Qnil, PT, PT_BYTE);			\
   if (old_point >= 0)							\
     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));	\
   set_buffer_internal (old);

/* This is used to restore the saved contents of print_buffer
   when there is a recursive call to print.  */

static void
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 UNINIT;
  ptrdiff_t i = 0, n = 1;
  Lisp_Object coding_system = Vlocale_coding_system;
  bool encode_p = false;

  if (!NILP (Vcoding_system_for_write))
    coding_system = Vcoding_system_for_write;
  if (!NILP (coding_system))
    encode_p = true;

  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 =
	    make_multibyte_string ((char *) mbstr, 1, len);

	  if (encode_p)
	    encoded_ch = code_convert_string_norecord (encoded_ch,
						       coding_system, true);
	  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
   non-interactive.  If FUN is neither nil nor t, call FUN with CH as
   argument.  */

static void
printchar (unsigned int ch, Lisp_Object fun)
{
  if (!NILP (fun) && !EQ (fun, Qt))
    call1 (fun, make_number (ch));
  else
    {
      unsigned char str[MAX_MULTIBYTE_LENGTH];
      int len = CHAR_STRING (ch, str);

      maybe_quit ();

      if (NILP (fun))
	{
	  ptrdiff_t incr = len - (print_buffer_size - print_buffer_pos_byte);
	  if (incr > 0)
	    print_buffer = xpalloc (print_buffer, &print_buffer_size,
				    incr, -1, 1);
	  memcpy (print_buffer + print_buffer_pos_byte, str, len);
	  print_buffer_pos += 1;
	  print_buffer_pos_byte += len;
	}
      else if (noninteractive)
	{
	  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
	{
	  bool multibyte_p
	    = !NILP (BVAR (current_buffer, enable_multibyte_characters));

	  setup_echo_area_for_printing (multibyte_p);
	  insert_char (ch);
	  message_dolog ((char *) str, len, 0, multibyte_p);
	}
    }
}


/* Output SIZE characters, SIZE_BYTE bytes from string PTR using
   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
   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 (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
	Lisp_Object printcharfun)
{
  if (NILP (printcharfun))
    {
      ptrdiff_t incr = size_byte - (print_buffer_size - print_buffer_pos_byte);
      if (incr > 0)
	print_buffer = xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
      memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
      print_buffer_pos += size;
      print_buffer_pos_byte += size_byte;
    }
  else if (noninteractive && EQ (printcharfun, Qt))
    {
      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))
    {
      /* Output to echo area.  We're trying to avoid a little overhead
	 here, that's the reason we don't call printchar to do the
	 job.  */
      int i;
      bool multibyte_p
	= !NILP (BVAR (current_buffer, enable_multibyte_characters));

      setup_echo_area_for_printing (multibyte_p);
      message_dolog (ptr, size_byte, 0, multibyte_p);

      if (size == size_byte)
	{
	  for (i = 0; i < size; ++i)
	    insert_char ((unsigned char) *ptr++);
	}
      else
	{
	  int len;
	  for (i = 0; i < size_byte; i += len)
	    {
	      int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
					       len);
	      insert_char (ch);
	    }
	}
    }
  else
    {
      /* PRINTCHARFUN is a Lisp function.  */
      ptrdiff_t i = 0;

      if (size == size_byte)
	{
	  while (i < size_byte)
	    {
	      int ch = ptr[i++];
	      printchar (ch, printcharfun);
	    }
	}
      else
	{
	  while (i < size_byte)
	    {
	      /* 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 ((const unsigned char *) ptr + i,
					       len);
	      printchar (ch, printcharfun);
	      i += len;
	    }
	}
    }
}

/* Print the contents of a string STRING using PRINTCHARFUN.
   It isn't safe to use strout in many cases,
   because printing one char can relocate.  */

static void
print_string (Lisp_Object string, Lisp_Object printcharfun)
{
  if (EQ (printcharfun, Qt) || NILP (printcharfun))
    {
      ptrdiff_t chars;

      if (print_escape_nonascii)
	string = string_escape_byte8 (string);

      if (STRING_MULTIBYTE (string))
	chars = SCHARS (string);
      else if (! print_escape_nonascii
	       && (EQ (printcharfun, Qt)
		   ? ! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))
		   : ! NILP (BVAR (current_buffer, enable_multibyte_characters))))
	{
	  /* If unibyte string STRING contains 8-bit codes, we must
	     convert STRING to a multibyte string containing the same
	     character codes.  */
	  Lisp_Object newstr;
	  ptrdiff_t bytes;

	  chars = SBYTES (string);
	  bytes = count_size_as_multibyte (SDATA (string), chars);
	  if (chars < bytes)
	    {
	      newstr = make_uninit_multibyte_string (chars, bytes);
	      memcpy (SDATA (newstr), SDATA (string), chars);
	      str_to_multibyte (SDATA (newstr), bytes, chars);
	      string = newstr;
	    }
	}
      else
	chars = SBYTES (string);

      if (EQ (printcharfun, Qt))
	{
	  /* Output to echo area.  */
	  ptrdiff_t nbytes = SBYTES (string);

	  /* Copy the string contents so that relocation of STRING by
	     GC does not cause trouble.  */
	  USE_SAFE_ALLOCA;
	  char *buffer = SAFE_ALLOCA (nbytes);
	  memcpy (buffer, SDATA (string), nbytes);

	  strout (buffer, chars, nbytes, printcharfun);

	  SAFE_FREE ();
	}
      else
	/* No need to copy, since output to print_buffer can't GC.  */
	strout (SSDATA (string), chars, SBYTES (string), printcharfun);
    }
  else
    {
      /* Otherwise, string may be relocated by printing one char.
	 So re-fetch the string address for each character.  */
      ptrdiff_t i;
      ptrdiff_t size = SCHARS (string);
      ptrdiff_t size_byte = SBYTES (string);
      if (size == size_byte)
	for (i = 0; i < size; i++)
	  printchar (SREF (string, i), printcharfun);
      else
	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;
	    int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len);
	    printchar (ch, printcharfun);
	    i += len;
	  }
    }
}

DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
       doc: /* Output character CHARACTER to stream PRINTCHARFUN.
PRINTCHARFUN defaults to the value of `standard-output' (which see).  */)
  (Lisp_Object character, Lisp_Object printcharfun)
{
  if (NILP (printcharfun))
    printcharfun = Vstandard_output;
  CHECK_NUMBER (character);
  PRINTPREPARE;
  printchar (XINT (character), printcharfun);
  PRINTFINISH;
  return character;
}

/* 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.  */

static void
print_c_string (char const *string, Lisp_Object printcharfun)
{
  ptrdiff_t len = strlen (string);
  strout (string, len, len, printcharfun);
}

/* 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;
  print_c_string (data, printcharfun);
  PRINTFINISH;
}

/* 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.  */

void
write_string (const char *data)
{
  write_string_1 (data, Vstandard_output);
}


void
temp_output_buffer_setup (const char *bufname)
{
  ptrdiff_t count = SPECPDL_INDEX ();
  register struct buffer *old = current_buffer;
  register Lisp_Object buf;

  record_unwind_current_buffer ();

  Fset_buffer (Fget_buffer_create (build_string (bufname)));

  Fkill_all_local_variables ();
  delete_all_overlays (current_buffer);
  bset_directory (current_buffer, BVAR (old, directory));
  bset_read_only (current_buffer, Qnil);
  bset_filename (current_buffer, Qnil);
  bset_undo_list (current_buffer, Qt);
  eassert (current_buffer->overlays_before == NULL);
  eassert (current_buffer->overlays_after == NULL);
  bset_enable_multibyte_characters
    (current_buffer, BVAR (&buffer_defaults, enable_multibyte_characters));
  specbind (Qinhibit_read_only, Qt);
  specbind (Qinhibit_modification_hooks, Qt);
  Ferase_buffer ();
  XSETBUFFER (buf, current_buffer);

  run_hook (Qtemp_buffer_setup_hook);

  unbind_to (count, Qnil);

  specbind (Qstandard_output, buf);
}

static void print (Lisp_Object, Lisp_Object, bool);
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, 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 ensure)
{
  Lisp_Object val;

  if (NILP (printcharfun))
    printcharfun = Vstandard_output;
  PRINTPREPARE;

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

DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
       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.  */)
  (Lisp_Object object, Lisp_Object printcharfun)
{
  if (NILP (printcharfun))
    printcharfun = Vstandard_output;
  PRINTPREPARE;
  print (object, printcharfun, 1);
  PRINTFINISH;
  return object;
}

/* a buffer which is used to hold output being built by prin1-to-string */
Lisp_Object Vprin1_to_string_buffer;

DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
       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.  */)
  (Lisp_Object object, Lisp_Object noescape)
{
  ptrdiff_t count = SPECPDL_INDEX ();

  specbind (Qinhibit_modification_hooks, Qt);

  /* 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;

  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;

  struct buffer *previous = current_buffer;
  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 ();
  set_buffer_internal (previous);

  Vdeactivate_mark = save_deactivate_mark;

  return unbind_to (count, object);
}

DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
       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.  */)
  (Lisp_Object object, Lisp_Object printcharfun)
{
  if (NILP (printcharfun))
    printcharfun = Vstandard_output;
  PRINTPREPARE;
  print (object, printcharfun, 0);
  PRINTFINISH;
  return object;
}

DEFUN ("print", Fprint, Sprint, 1, 2, 0,
       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.  */)
  (Lisp_Object object, Lisp_Object printcharfun)
{
  if (NILP (printcharfun))
    printcharfun = Vstandard_output;
  PRINTPREPARE;
  printchar ('\n', printcharfun);
  print (object, printcharfun, 1);
  printchar ('\n', printcharfun);
  PRINTFINISH;
  return object;
}

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
to make it write to the debugging output.  */)
  (Lisp_Object character)
{
  CHECK_NUMBER (character);
  printchar_to_stream (XINT (character), stderr);
  return character;
}

/* This function is never called.  Its purpose is to prevent
   print_output_debug_flag from being optimized away.  */

extern void debug_output_compilation_hack (bool) EXTERNALLY_VISIBLE;
void
debug_output_compilation_hack (bool x)
{
  print_output_debug_flag = x;
}

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.  */)
  (Lisp_Object file, Lisp_Object append)
{
  /* If equal to STDERR_FILENO, stderr has not been duplicated and is OK as-is.
     Otherwise, this is a close-on-exec duplicate of the original stderr. */
  static int stderr_dup = STDERR_FILENO;
  int fd = stderr_dup;

  if (! NILP (file))
    {
      file = Fexpand_file_name (file, Qnil);

      if (stderr_dup == STDERR_FILENO)
	{
	  int n = fcntl (STDERR_FILENO, F_DUPFD_CLOEXEC, STDERR_FILENO + 1);
	  if (n < 0)
	    report_file_error ("dup", file);
	  stderr_dup = n;
	}

      fd = emacs_open (SSDATA (ENCODE_FILE (file)),
		       (O_WRONLY | O_CREAT
			| (! NILP (append) ? O_APPEND : O_TRUNC)),
		       0666);
      if (fd < 0)
	report_file_error ("Cannot open debugging output stream", file);
    }

  fflush (stderr);
  if (dup2 (fd, STDERR_FILENO) < 0)
    report_file_error ("dup2", file);
  if (fd != stderr_dup)
    emacs_close (fd);
  return Qnil;
}


/* This is the interface for debugging printing.  */

void
debug_print (Lisp_Object arg)
{
  Fprin1 (arg, Qexternal_debugging_output);
  fprintf (stderr, "\r\n");
}