use dynwind_begin and dynwind_end

[bpt/emacs.git] / src / print.c

diff --git a/src/print.c b/src/print.c
index 586c061..6ed0f51 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -100,7 +100,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
    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 ();                         \
+   dynwind_begin ();                                                    \
    bool free_print_buffer = 0;                                         \
    bool multibyte                                                      \
      = !NILP (BVAR (current_buffer, enable_multibyte_characters));     \
@@ -153,7 +153,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
        else                                                            \
         {                                                              \
           int new_size = 1000;                                         \
-          print_buffer = xmalloc (new_size);                           \
+          print_buffer = xmalloc_atomic (new_size);                    \
           print_buffer_size = new_size;                                \
           free_print_buffer = 1;                                       \
         }                                                              \
@@ -185,7 +185,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
        xfree (print_buffer);                                           \
        print_buffer = 0;                                               \
      }                                                                 \
-   unbind_to (specpdl_count, Qnil);                                    \
+   dynwind_end ();                                                      \
    if (MARKERP (original))                                             \
      set_marker_both (original, Qnil, PT, PT_BYTE);                    \
    if (old_point >= 0)                                                 \
@@ -478,10 +478,10 @@ write_string_1 (const char *data, int size, Lisp_Object printcharfun)
 void
 temp_output_buffer_setup (const char *bufname)
 {
-  ptrdiff_t count = SPECPDL_INDEX ();
   register struct buffer *old = current_buffer;
   register Lisp_Object buf;
 
+  dynwind_begin ();
   record_unwind_current_buffer ();
 
   Fset_buffer (Fget_buffer_create (build_string (bufname)));
@@ -503,7 +503,7 @@ temp_output_buffer_setup (const char *bufname)
 
   Frun_hooks (1, &Qtemp_buffer_setup_hook);
 
-  unbind_to (count, Qnil);
+  dynwind_end ();
 
   specbind (Qstandard_output, buf);
 }
@@ -583,9 +583,9 @@ A printed representation of an object is text which describes that object.  */)
   bool prev_abort_on_gc;
   /* struct gcpro gcpro1, gcpro2; */
   Lisp_Object save_deactivate_mark;
-  ptrdiff_t count = SPECPDL_INDEX ();
   struct buffer *previous;
 
+  dynwind_begin ();
   specbind (Qinhibit_modification_hooks, Qt);
 
   {
@@ -596,8 +596,6 @@ A printed representation of an object is text which describes that object.  */)
        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;
@@ -621,8 +619,8 @@ A printed representation of an object is text which describes that object.  */)
   Vdeactivate_mark = save_deactivate_mark;
   /* UNGCPRO; */
 
-  abort_on_gc = prev_abort_on_gc;
-  return unbind_to (count, object);
+  dynwind_end ();
+  return object;
 }
 
 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
@@ -709,17 +707,36 @@ 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);
-  putc (XINT (character) & 0xFF, stderr);
+  unsigned int ch;
 
-#ifdef WINDOWSNT
-  /* Send the output to a debugger (nothing happens if there isn't one).  */
-  if (print_output_debug_flag)
+  CHECK_NUMBER (character);
+  ch = XINT (character);
+  if (ASCII_CHAR_P (ch))
     {
-      char buf[2] = {(char) XINT (character), '\0'};
-      OutputDebugString (buf);
+      putc (ch, 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
     }
+  else
+    {
+      unsigned char mbstr[MAX_MULTIBYTE_LENGTH];
+      ptrdiff_t len = CHAR_STRING (ch, mbstr);
+      Lisp_Object encoded_ch =
+       ENCODE_SYSTEM (make_multibyte_string ((char *) mbstr, 1, len));
+
+      fwrite (SSDATA (encoded_ch), SBYTES (encoded_ch), 1, stderr);
+#ifdef WINDOWSNT
+      if (print_output_debug_flag)
+       OutputDebugString (SSDATA (encoded_ch));
 #endif
+    }
 
   return character;
 }
@@ -1389,9 +1406,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
        print_string (obj, printcharfun);
       else
        {
-         register ptrdiff_t i_byte;
+         register ptrdiff_t i, i_byte;
          struct gcpro gcpro1;
-         unsigned char *str;
          ptrdiff_t size_byte;
          /* 1 means we must ensure that the next character we output
             cannot be taken as part of a hex character escape.  */
@@ -1410,23 +1426,15 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
            }
 
          PRINTCHAR ('\"');
-         str = SDATA (obj);
          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;
              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;
 
@@ -1462,7 +1470,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                  strout (outbuf, len, len, printcharfun);
                }
              else if (! multibyte
-                      && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
+                      && SINGLE_BYTE_CHAR_P (c) && ! ASCII_CHAR_P (c)
                       && print_escape_nonascii)
                {
                  /* When printing in a multibyte buffer
@@ -2189,6 +2197,8 @@ init_print_once (void)
 void
 syms_of_print (void)
 {
+#include "print.x"
+
   DEFSYM (Qtemp_buffer_setup_hook, "temp-buffer-setup-hook");
 
   DEFVAR_LISP ("standard-output", Vstandard_output,
@@ -2310,17 +2320,6 @@ priorities.  */);
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
   staticpro (&Vprin1_to_string_buffer);
 
-  defsubr (&Sprin1);
-  defsubr (&Sprin1_to_string);
-  defsubr (&Serror_message_string);
-  defsubr (&Sprinc);
-  defsubr (&Sprint);
-  defsubr (&Sterpri);
-  defsubr (&Swrite_char);
-#ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
-  defsubr (&Sredirect_debugging_output);
-#endif
-
   DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
   DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
   DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");