diff src/print.c @ 276:6330739388db r21-0b36

Import from CVS: tag r21-0b36
author cvs
date Mon, 13 Aug 2007 10:30:37 +0200
parents c5d627a313b1
children 90d73dddcdc4
line wrap: on
line diff
--- a/src/print.c	Mon Aug 13 10:29:43 2007 +0200
+++ b/src/print.c	Mon Aug 13 10:30:37 2007 +0200
@@ -177,22 +177,28 @@
 
   if (LSTREAMP (function))
     {
-      /* Lstream_write() could easily cause GC inside of it, if the
-	 stream is a print-stream. (It will call output_string()
-	 recursively.) This is probably the fastest way to fix this
-	 problem. (alloca() is very fast on machines that have it
-	 built-in, and you avoid some nasty problems with recursion
-	 that could result from using a static buffer somewhere.)
-
-	 The other possibility is to inhibit GC, but that of course
-	 would require an unwind-protect, which is usually a lot
-	 slower than the small amount of memcpy()ing that happens
-	 here. */
       if (STRINGP (reloc))
 	{
-	  Bufbyte *copied = (Bufbyte *) alloca (len);
-	  memcpy (copied, newnonreloc + offset, len);
-	  Lstream_write (XLSTREAM (function), copied, len);
+	  /* Protect against Lstream_write() causing a GC and
+	     relocating the string.  For small strings, we do it by
+	     alloc'ing the string and using a copy; for large strings,
+	     we inhibit GC.  Now that print_streams are dead, this
+	     case should happen very rarely anyway.  */
+	  if (len < 65536)
+	    {
+	      Bufbyte *copied = alloca_array (Bufbyte, len);
+	      memcpy (copied, newnonreloc + offset, len);
+	      Lstream_write (XLSTREAM (function), copied, len);
+	    }
+	  else
+	    {
+	      int speccount = specpdl_depth ();
+	      record_unwind_protect (restore_gc_inhibit,
+				     make_int (gc_currently_forbidden));
+	      gc_currently_forbidden = 1;
+	      Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
+	      unbind_to (speccount, Qnil);
+	    }
 	}
       else
 	Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
@@ -247,70 +253,6 @@
   UNGCPRO;
 }
 
-struct print_stream
-{
-  FILE *file;
-  Lisp_Object fun;
-};
-
-#define get_print_stream(stream) \
-  ((struct print_stream *) Lstream_data (stream))
-
-DEFINE_LSTREAM_IMPLEMENTATION ("print", lstream_print,
-			       sizeof (struct print_stream));
-
-static Lisp_Object
-make_print_output_stream (FILE *file, Lisp_Object fun)
-{
-  Lstream *str = Lstream_new (lstream_print, "w");
-  struct print_stream *ps = get_print_stream (str);
-  Lisp_Object val;
-
-  Lstream_set_character_mode (str);
-  ps->file = file;
-  ps->fun = fun;
-  XSETLSTREAM (val, str);
-  return val;
-}
-
-/* #### This isn't being used anywhere at the moment.  Is it supposed
-   to be? */
-#if 0
-static void
-reset_print_stream (Lstream *str, FILE *file, Lisp_Object fun)
-{
-  struct print_stream *ps = get_print_stream (str);
-
-  Lstream_reopen (str);
-  ps->file = file;
-  ps->fun = fun;
-}
-#endif
-
-static Lisp_Object
-print_marker (Lisp_Object obj, void (*markobj) (Lisp_Object))
-{
-  return get_print_stream (XLSTREAM (obj))->fun;
-}
-
-static int
-print_writer (Lstream *stream, CONST unsigned char *data, size_t size)
-{
-  struct print_stream *ps = get_print_stream (stream);
-
-  if (ps->file)
-    {
-      write_string_to_stdio_stream (ps->file, 0, data, 0, size,
-				    FORMAT_TERMINAL);
-      /* Make sure it really gets written now. */
-      if (print_unbuffered)
-	fflush (ps->file);
-    }
-  else
-    output_string (ps->fun, data, Qnil, 0, size);
-  return size;
-}
-
 static Lisp_Object
 canonicalize_printcharfun (Lisp_Object printcharfun)
 {
@@ -326,33 +268,21 @@
   return printcharfun;
 }
 
+/* Now that print_streams are dead, I wonder if the following two
+   functions are needed as separate entities.  */
 
 static Lisp_Object
 print_prepare (Lisp_Object printcharfun)
 {
-  FILE *stdio_stream = 0;
-
   /* Emacs won't print whilst GCing, but an external debugger might */
   if (gc_in_progress)
     return Qnil;
 
   printcharfun = canonicalize_printcharfun (printcharfun);
-  if (NILP (printcharfun))
-    {
-      stdio_stream = stdout;
-    }
-#if 0 /* Don't bother */
-  else if (SUBRP (indirect_function (printcharfun, 0))
-           && (XSUBR (indirect_function (printcharfun, 0))
-               == Sexternal_debugging_output))
-    {
-      stdio_stream = stderr;
-    }
-#endif
   if (!CONSP (Vprint_gensym))
     Vprint_gensym_alist = Qnil;
 
-  return make_print_output_stream (stdio_stream, printcharfun);
+  return printcharfun;
 }
 
 static void
@@ -364,8 +294,6 @@
 
   if (!CONSP (Vprint_gensym))
     Vprint_gensym_alist = Qnil;
-
-  Lstream_delete (XLSTREAM (stream));
 }
 
 #if 1 /* Prefer space over "speed" */
@@ -548,12 +476,11 @@
        (object, noescape))
 {
   /* This function can GC */
-  Lisp_Object result = Qnil;
   Lstream *stream;
   struct gcpro gcpro1;
 
   /* We avoid creating a new stream for every invocation of
-     prin1_to_string, for better memory usage.  */
+     prin1_to_string, for better memory usage.  #### Is it necessary?  */
 
   if (NILP (Vprin1_to_string_stream))
     Vprin1_to_string_stream = make_resizing_buffer_output_stream ();
@@ -563,12 +490,15 @@
   /* In case a caller forgot to protect. */
   GCPRO1 (object);
   print_depth = 0;
+  if (!CONSP (Vprint_gensym))
+    Vprint_gensym_alist = Qnil;
   print_internal (object, Vprin1_to_string_stream, NILP (noescape));
+  if (!CONSP (Vprint_gensym))
+    Vprint_gensym_alist = Qnil;
   Lstream_flush (stream);
   UNGCPRO;
-  result = make_string (resizing_buffer_stream_ptr (stream),
-			Lstream_byte_count (stream));
-  return result;
+  return make_string (resizing_buffer_stream_ptr (stream),
+		      Lstream_byte_count (stream));
 }
 
 DEFUN ("princ", Fprinc, 1, 2, 0, /*
@@ -624,9 +554,6 @@
   (data))
 {
   /* This function can GC */
-
-  /* This should maybe use Vprin1_to_string_stream...  However, it's
-     called sufficiently rarely, so I don't think it should matter.  */
   Lisp_Object stream = make_resizing_buffer_output_stream ();
   struct gcpro gcpro1;
   GCPRO1 (stream);
@@ -1003,6 +930,39 @@
   return;
 }
 
+/* Print NUMBER to BUFFER.  The digits are first written in reverse
+   order (the least significant digit first), and are then reversed.
+   This is equivalent to sprintf(buffer, "%ld", number), only much
+   faster.  */
+void
+long_to_string (char *buffer, long number)
+{
+  char *p;
+  int i, l;
+
+  if (number < 0)
+    {
+      *buffer++ = '-';
+      number = -number;
+    }
+  p = buffer;
+  /* Print the digits to the string.  */
+  do
+    {
+      *p++ = number % 10 + '0';
+      number /= 10;
+    }
+  while (number);
+  /* And reverse them.  */
+  l = p - buffer - 1;
+  for (i = l/2; i >= 0; i--)
+    {
+      char c = buffer[i];
+      buffer[i] = buffer[l - i];
+      buffer[l - i] = c;
+    }
+  buffer[l + 1] = '\0';
+}
 
 static void
 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
@@ -1087,7 +1047,7 @@
     case Lisp_Type_Int:
 #endif
       {
-	sprintf (buf, "%ld", (long) XINT (obj));
+	long_to_string (buf, XINT (obj));
 	write_c_string (buf, printcharfun);
 	break;
       }
@@ -1718,13 +1678,6 @@
 }
 
 void
-lstream_type_create_print (void)
-{
-  LSTREAM_HAS_METHOD (print, writer);
-  LSTREAM_HAS_METHOD (print, marker);
-}
-
-void
 vars_of_print (void)
 {
   alternate_do_pointer = 0;