diff src/print.c @ 207:e45d5e7c476e r20-4b2

Import from CVS: tag r20-4b2
author cvs
date Mon, 13 Aug 2007 10:03:52 +0200
parents b405438285a2
children 78478c60bfcd
line wrap: on
line diff
--- a/src/print.c	Mon Aug 13 10:02:48 2007 +0200
+++ b/src/print.c	Mon Aug 13 10:03:52 2007 +0200
@@ -854,6 +854,137 @@
   write_c_string (end, printcharfun);
 }
 
+void
+print_cons (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  /* This function can GC */
+  struct gcpro gcpro1, gcpro2;
+
+  /* If print_readably is on, print (quote -foo-) as '-foo-
+     (Yeah, this should really be what print-pretty does, but we
+     don't have the rest of a pretty printer, and this actually
+     has non-negligible impact on size/speed of .elc files.)
+  */
+  if (print_readably &&
+      EQ (XCAR (obj), Qquote) &&
+      CONSP (XCDR (obj)) &&
+      NILP (XCDR (XCDR (obj))))
+    {
+      obj = XCAR (XCDR (obj));
+      GCPRO2 (obj, printcharfun);
+      write_char_internal ("'", printcharfun);
+      UNGCPRO;
+      print_internal (obj, printcharfun, escapeflag);
+      return;
+    }
+
+  GCPRO2 (obj, printcharfun);
+  write_char_internal ("(", printcharfun);
+  {
+    int i = 0;
+    int max = 0;
+
+    if (INTP (Vprint_length))
+      max = XINT (Vprint_length);
+    while (CONSP (obj))
+      {
+	if (i++)
+	  write_char_internal (" ", printcharfun);
+	if (max && i > max)
+	  {
+	    write_c_string ("...", printcharfun);
+	    break;
+	  }
+	print_internal (Fcar (obj), printcharfun,
+			escapeflag);
+	obj = Fcdr (obj);
+      }
+  }
+  if (!NILP (obj) && !CONSP (obj))
+    {
+      write_c_string (" . ", printcharfun);
+      print_internal (obj, printcharfun, escapeflag);
+    }
+  UNGCPRO;
+  write_char_internal (")", printcharfun);
+  return;
+}
+
+void
+print_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  print_vector_internal ("[", "]", obj, printcharfun, escapeflag);
+}
+
+void
+print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  Bytecount size = XSTRING_LENGTH (obj);
+  struct gcpro gcpro1, gcpro2;
+  int max = size;
+  GCPRO2 (obj, printcharfun);
+
+  if (INTP (Vprint_string_length) &&
+      XINT (Vprint_string_length) < max)
+    max = XINT (Vprint_string_length);
+  if (max < 0)
+    max = 0;
+
+  /* !!#### This handles MAX incorrectly for Mule. */
+  if (!escapeflag)
+    {
+      /* This deals with GC-relocation */
+      output_string (printcharfun, 0, obj, 0, max);
+      if (max < size)
+	write_c_string (" ...", printcharfun);
+    }
+  else
+    {
+      Bytecount i;
+      struct Lisp_String *s = XSTRING (obj);
+      Bytecount last = 0;
+
+      write_char_internal ("\"", printcharfun);
+      for (i = 0; i < max; i++)
+	{
+	  Bufbyte ch = string_byte (s, i);
+	  if (ch == '\"' || ch == '\\'
+	      || (ch == '\n' && print_escape_newlines))
+	    {
+	      if (i > last)
+		{
+		  output_string (printcharfun, 0, obj, last,
+				 i - last);
+		}
+	      if (ch == '\n')
+		{
+		  write_c_string ("\\n", printcharfun);
+		}
+	      else
+		{
+		  write_char_internal ("\\", printcharfun);
+		  /* This is correct for Mule because the
+		     character is either \ or " */
+		  write_char_internal ((char *) (string_data (s) + i),
+				       printcharfun);
+		}
+	      last = i + 1;
+	    }
+	}
+      if (max > last)
+	{
+	  output_string (printcharfun, 0, obj, last,
+			 max - last);
+	}
+      if (max < size)
+	write_c_string (" ...", printcharfun);
+      write_char_internal ("\"", printcharfun);
+    }
+  UNGCPRO;
+  return;
+}
+
+
 static void
 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
 			int escapeflag)
@@ -928,7 +1059,12 @@
 
   switch (XTYPE (obj))
     {
+#ifdef USE_MINIMAL_TAGBITS
+    case Lisp_Type_Int_Even:
+    case Lisp_Type_Int_Odd:
+#else
     case Lisp_Type_Int:
+#endif
       {
 	sprintf (buf, "%ld", (long) XINT (obj));
 	write_c_string (buf, printcharfun);
@@ -977,73 +1113,15 @@
 	break;
       }
 
+#ifndef LRECORD_STRING
     case Lisp_Type_String:
       {
-	Bytecount size = XSTRING_LENGTH (obj);
-	struct gcpro gcpro1, gcpro2;
-	int max = size;
-	GCPRO2 (obj, printcharfun);
-
-	if (INTP (Vprint_string_length) &&
-	    XINT (Vprint_string_length) < max)
-	  max = XINT (Vprint_string_length);
-	if (max < 0)
-	  max = 0;
-
-	/* !!#### This handles MAX incorrectly for Mule. */
-	if (!escapeflag)
-	  {
-	    /* This deals with GC-relocation */
-	    output_string (printcharfun, 0, obj, 0, max);
-	    if (max < size)
-	      write_c_string (" ...", printcharfun);
-	  }
-	else
-	  {
-	    Bytecount i;
-	    struct Lisp_String *s = XSTRING (obj);
-	    Bytecount last = 0;
-
-	    write_char_internal ("\"", printcharfun);
-	    for (i = 0; i < max; i++)
-	      {
-		Bufbyte ch = string_byte (s, i);
-		if (ch == '\"' || ch == '\\'
-		    || (ch == '\n' && print_escape_newlines))
-		  {
-		    if (i > last)
-		      {
-			output_string (printcharfun, 0, obj, last,
-				       i - last);
-		      }
-		    if (ch == '\n')
-		      {
-			write_c_string ("\\n", printcharfun);
-		      }
-		    else
-		      {
-			write_char_internal ("\\", printcharfun);
-			/* This is correct for Mule because the
-			   character is either \ or " */
-			write_char_internal ((char *) (string_data (s) + i),
-					     printcharfun);
-		      }
-		    last = i + 1;
-		  }
-	      }
-	    if (max > last)
-	      {
-		output_string (printcharfun, 0, obj, last,
-			       max - last);
-	      }
-	    if (max < size)
-	      write_c_string (" ...", printcharfun);
-	    write_char_internal ("\"", printcharfun);
-	  }
-	UNGCPRO;
+	print_string(obj, printcharfun, escapeflag);
 	break;
       }
+#endif /* ! LRECORD_STRING */
 
+#ifndef LRECORD_CONS
     case Lisp_Type_Cons:
       {
 	struct gcpro gcpro1, gcpro2;
@@ -1052,68 +1130,29 @@
 	if (INTP (Vprint_level)
 	    && print_depth > XINT (Vprint_level))
 	  {
+	    GCPRO2 (obj, printcharfun);
 	    write_c_string ("...", printcharfun);
-	    break;
-	  }
-
-	/* If print_readably is on, print (quote -foo-) as '-foo-
-	   (Yeah, this should really be what print-pretty does, but we
-	   don't have the rest of a pretty printer, and this actually
-	   has non-negligible impact on size/speed of .elc files.)
-	 */
-	if (print_readably &&
-	    EQ (XCAR (obj), Qquote) &&
-	    CONSP (XCDR (obj)) &&
-	    NILP (XCDR (XCDR (obj))))
-	  {
-	    obj = XCAR (XCDR (obj));
-	    GCPRO2 (obj, printcharfun);
-	    write_char_internal ("'", printcharfun);
 	    UNGCPRO;
-	    print_internal (obj, printcharfun, escapeflag);
 	    break;
 	  }
 
-	GCPRO2 (obj, printcharfun);
-	write_char_internal ("(", printcharfun);
-	{
-	  int i = 0;
-	  int max = 0;
-
-	  if (INTP (Vprint_length))
-	    max = XINT (Vprint_length);
-	  while (CONSP (obj))
-	    {
-	      if (i++)
-		write_char_internal (" ", printcharfun);
-	      if (max && i > max)
-		{
-		  write_c_string ("...", printcharfun);
-		  break;
-		}
-	      print_internal (Fcar (obj), printcharfun,
-			      escapeflag);
-	      obj = Fcdr (obj);
-	    }
-	}
-	if (!NILP (obj) && !CONSP (obj))
-	  {
-	    write_c_string (" . ", printcharfun);
-	    print_internal (obj, printcharfun, escapeflag);
-	  }
-	UNGCPRO;
-	write_char_internal (")", printcharfun);
+	print_cons (obj, printcharfun, escapeflag);
 	break;
       }
+#endif /* ! LRECORD_CONS */
 
 #ifndef LRECORD_VECTOR
     case Lisp_Type_Vector:
       {
+	struct gcpro gcpro1, gcpro2;
+
 	/* If deeper than spec'd depth, print placeholder.  */
 	if (INTP (Vprint_level)
 	    && print_depth > XINT (Vprint_level))
 	  {
+	    GCPRO2 (obj, printcharfun);
 	    write_c_string ("...", printcharfun);
+	    UNGCPRO;
 	    break;
 	  }
 
@@ -1136,6 +1175,21 @@
 	struct lrecord_header *lheader = XRECORD_LHEADER (obj);
 	struct gcpro gcpro1, gcpro2;
 
+#if defined(LRECORD_CONS) || defined(LRECORD_VECTOR)
+	if (CONSP (obj) || VECTORP(obj))
+	  {
+	    /* If deeper than spec'd depth, print placeholder.  */
+	    if (INTP (Vprint_level)
+		&& print_depth > XINT (Vprint_level))
+	      {
+		GCPRO2 (obj, printcharfun);
+		write_c_string ("...", printcharfun);
+		UNGCPRO;
+		break;
+	      }
+	  }
+#endif
+
 	GCPRO2 (obj, printcharfun);
 	if (lheader->implementation->printer)
 	  ((lheader->implementation->printer)
@@ -1346,7 +1400,6 @@
   }
   UNGCPRO;
 }
-
 
 int alternate_do_pointer;
 char alternate_do_string[5000];