Merge from emacs-23
[bpt/emacs.git] / src / print.c
index 682212d..10878d0 100644 (file)
@@ -42,7 +42,6 @@ Lisp_Object Vstandard_output, Qstandard_output;
 Lisp_Object Qtemp_buffer_setup_hook;
 
 /* These are used to print like we read.  */
-extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
 
 Lisp_Object Vfloat_output_format, Qfloat_output_format;
 
@@ -97,11 +96,11 @@ Lisp_Object being_printed[PRINT_CIRCLE];
 char *print_buffer;
 
 /* Size allocated in print_buffer.  */
-int print_buffer_size;
+EMACS_INT print_buffer_size;
 /* Chars stored in print_buffer.  */
-int print_buffer_pos;
+EMACS_INT print_buffer_pos;
 /* Bytes stored in print_buffer.  */
-int print_buffer_pos_byte;
+EMACS_INT print_buffer_pos_byte;
 
 /* Maximum length of list to print in full; noninteger means
    effectively infinity */
@@ -146,32 +145,21 @@ Lisp_Object Vprint_circle;
 
 Lisp_Object Vprint_continuous_numbering;
 
-/* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
-   where OBJn are objects going to be printed, and STATn are their status,
-   which may be different meanings during process.  See the comments of
-   the functions print and print_preprocess for details.
-   print_number_index keeps the last position the next object should be added,
-   twice of which is the actual vector position in Vprint_number_table.  */
+/* 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.  */
 int print_number_index;
 Lisp_Object Vprint_number_table;
 
-/* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
-   PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
-   See the comment of the variable Vprint_number_table.  */
-#define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
-#define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
-
-/* Nonzero means print newline to stdout before next minibuffer message.
-   Defined in xdisp.c */
-
-extern int noninteractive_need_newline;
-
-extern int minibuffer_auto_raise;
-
-void print_interval ();
+void print_interval (INTERVAL interval, Lisp_Object printcharfun);
 
 /* GDB resets this to zero on W32 to disable OutputDebugString calls.  */
-int print_output_debug_flag = 1;
+int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
 
 \f
 /* Low level output routines for characters and strings */
@@ -185,8 +173,8 @@ int print_output_debug_flag = 1;
 
 #define PRINTDECLARE                                                   \
    struct buffer *old = current_buffer;                                        \
-   int old_point = -1, start_point = -1;                               \
-   int old_point_byte = -1, start_point_byte = -1;                     \
+   EMACS_INT old_point = -1, start_point = -1;                         \
+   EMACS_INT old_point_byte = -1, start_point_byte = -1;               \
    int specpdl_count = SPECPDL_INDEX ();                               \
    int free_print_buffer = 0;                                          \
    int multibyte = !NILP (current_buffer->enable_multibyte_characters);        \
@@ -287,10 +275,9 @@ int print_output_debug_flag = 1;
    when there is a recursive call to print.  */
 
 static Lisp_Object
-print_unwind (saved_text)
-     Lisp_Object saved_text;
+print_unwind (Lisp_Object saved_text)
 {
-  bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
+  memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
   return Qnil;
 }
 
@@ -301,9 +288,7 @@ print_unwind (saved_text)
    argument.  */
 
 static void
-printchar (ch, fun)
-     unsigned int ch;
-     Lisp_Object fun;
+printchar (unsigned int ch, Lisp_Object fun)
 {
   if (!NILP (fun) && !EQ (fun, Qt))
     call1 (fun, make_number (ch));
@@ -319,7 +304,7 @@ printchar (ch, fun)
          if (print_buffer_pos_byte + len >= print_buffer_size)
            print_buffer = (char *) xrealloc (print_buffer,
                                              print_buffer_size *= 2);
-         bcopy (str, print_buffer + print_buffer_pos_byte, len);
+         memcpy (print_buffer + print_buffer_pos_byte, str, len);
          print_buffer_pos += 1;
          print_buffer_pos_byte += len;
        }
@@ -353,11 +338,8 @@ printchar (ch, fun)
    to data in a Lisp string.  Otherwise that is not safe.  */
 
 static void
-strout (ptr, size, size_byte, printcharfun, multibyte)
-     char *ptr;
-     int size, size_byte;
-     Lisp_Object printcharfun;
-     int multibyte;
+strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte,
+       Lisp_Object printcharfun, int multibyte)
 {
   if (size < 0)
     size_byte = size = strlen (ptr);
@@ -370,7 +352,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
          print_buffer = (char *) xrealloc (print_buffer,
                                            print_buffer_size);
        }
-      bcopy (ptr, print_buffer + print_buffer_pos_byte, size_byte);
+      memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
       print_buffer_pos += size;
       print_buffer_pos_byte += size_byte;
     }
@@ -409,7 +391,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
   else
     {
       /* PRINTCHARFUN is a Lisp function.  */
-      int i = 0;
+      EMACS_INT i = 0;
 
       if (size == size_byte)
        {
@@ -440,13 +422,11 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
    because printing one char can relocate.  */
 
 static void
-print_string (string, printcharfun)
-     Lisp_Object string;
-     Lisp_Object printcharfun;
+print_string (Lisp_Object string, Lisp_Object printcharfun)
 {
   if (EQ (printcharfun, Qt) || NILP (printcharfun))
     {
-      int chars;
+      EMACS_INT chars;
 
       if (print_escape_nonascii)
        string = string_escape_byte8 (string);
@@ -462,14 +442,14 @@ print_string (string, printcharfun)
             convert STRING to a multibyte string containing the same
             character codes.  */
          Lisp_Object newstr;
-         int bytes;
+         EMACS_INT bytes;
 
          chars = SBYTES (string);
          bytes = parse_str_to_multibyte (SDATA (string), chars);
          if (chars < bytes)
            {
              newstr = make_uninit_multibyte_string (chars, bytes);
-             bcopy (SDATA (string), SDATA (newstr), chars);
+             memcpy (SDATA (newstr), SDATA (string), chars);
              str_to_multibyte (SDATA (newstr), bytes, chars);
              string = newstr;
            }
@@ -480,7 +460,7 @@ print_string (string, printcharfun)
       if (EQ (printcharfun, Qt))
        {
          /* Output to echo area.  */
-         int nbytes = SBYTES (string);
+         EMACS_INT nbytes = SBYTES (string);
          char *buffer;
 
          /* Copy the string contents so that relocation of STRING by
@@ -488,7 +468,7 @@ print_string (string, printcharfun)
          USE_SAFE_ALLOCA;
 
          SAFE_ALLOCA (buffer, char *, nbytes);
-         bcopy (SDATA (string), buffer, nbytes);
+         memcpy (buffer, SDATA (string), nbytes);
 
          strout (buffer, chars, SBYTES (string),
                  printcharfun, STRING_MULTIBYTE (string));
@@ -505,9 +485,9 @@ print_string (string, printcharfun)
     {
       /* Otherwise, string may be relocated by printing one char.
         So re-fetch the string address for each character.  */
-      int i;
-      int size = SCHARS (string);
-      int size_byte = SBYTES (string);
+      EMACS_INT i;
+      EMACS_INT size = SCHARS (string);
+      EMACS_INT size_byte = SBYTES (string);
       struct gcpro gcpro1;
       GCPRO1 (string);
       if (size == size_byte)
@@ -530,8 +510,7 @@ print_string (string, printcharfun)
 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).  */)
-     (character, printcharfun)
-     Lisp_Object character, printcharfun;
+  (Lisp_Object character, Lisp_Object printcharfun)
 {
   PRINTDECLARE;
 
@@ -549,9 +528,7 @@ PRINTCHARFUN defaults to the value of `standard-output' (which see).  */)
    Do not use this on the contents of a Lisp string.  */
 
 void
-write_string (data, size)
-     char *data;
-     int size;
+write_string (const char *data, int size)
 {
   PRINTDECLARE;
   Lisp_Object printcharfun;
@@ -563,15 +540,12 @@ write_string (data, size)
   PRINTFINISH;
 }
 
-/* Used from outside of print.c to print a block of SIZE
-   single-byte chars at DATA on a specified stream PRINTCHARFUN.
+/* Used to print a block of SIZE single-byte chars at DATA on a
+   specified stream PRINTCHARFUN.
    Do not use this on the contents of a Lisp string.  */
 
-void
-write_string_1 (data, size, printcharfun)
-     char *data;
-     int size;
-     Lisp_Object printcharfun;
+static void
+write_string_1 (const char *data, int size, Lisp_Object printcharfun)
 {
   PRINTDECLARE;
 
@@ -582,8 +556,7 @@ write_string_1 (data, size, printcharfun)
 
 
 void
-temp_output_buffer_setup (bufname)
-    const char *bufname;
+temp_output_buffer_setup (const char *bufname)
 {
   int count = SPECPDL_INDEX ();
   register struct buffer *old = current_buffer;
@@ -616,10 +589,7 @@ temp_output_buffer_setup (bufname)
 }
 
 Lisp_Object
-internal_with_output_to_temp_buffer (bufname, function, args)
-     const char *bufname;
-     Lisp_Object (*function) P_ ((Lisp_Object));
-     Lisp_Object args;
+internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function) (Lisp_Object), Lisp_Object args)
 {
   int count = SPECPDL_INDEX ();
   Lisp_Object buf, val;
@@ -670,8 +640,7 @@ temporarily selected.  But it doesn't run `temp-buffer-show-hook'
 if it uses `temp-buffer-show-function'.
 
 usage: (with-output-to-temp-buffer BUFNAME BODY...)  */)
-     (args)
-     Lisp_Object args;
+  (Lisp_Object args)
 {
   struct gcpro gcpro1;
   Lisp_Object name;
@@ -695,16 +664,15 @@ usage: (with-output-to-temp-buffer BUFNAME BODY...)  */)
 }
 
 \f
-static void print ();
-static void print_preprocess ();
-static void print_preprocess_string ();
-static void print_object ();
+static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
+static void print_preprocess (Lisp_Object obj);
+static void print_preprocess_string (INTERVAL interval, Lisp_Object arg);
+static void print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
 
 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
        doc: /* Output a newline to stream PRINTCHARFUN.
 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.  */)
-  (printcharfun)
-     Lisp_Object printcharfun;
+  (Lisp_Object printcharfun)
 {
   PRINTDECLARE;
 
@@ -739,8 +707,7 @@ of these:
 
 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
 is used instead.  */)
-     (object, printcharfun)
-     Lisp_Object object, printcharfun;
+  (Lisp_Object object, Lisp_Object printcharfun)
 {
   PRINTDECLARE;
 
@@ -766,8 +733,7 @@ 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.  */)
-     (object, noescape)
-     Lisp_Object object, noescape;
+  (Lisp_Object object, Lisp_Object noescape)
 {
   Lisp_Object printcharfun;
   /* struct gcpro gcpro1, gcpro2; */
@@ -835,8 +801,7 @@ of these:
 
 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
 is used instead.  */)
-     (object, printcharfun)
-     Lisp_Object object, printcharfun;
+  (Lisp_Object object, Lisp_Object printcharfun)
 {
   PRINTDECLARE;
 
@@ -871,8 +836,7 @@ of these:
 
 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
 is used instead.  */)
-     (object, printcharfun)
-     Lisp_Object object, printcharfun;
+  (Lisp_Object object, Lisp_Object printcharfun)
 {
   PRINTDECLARE;
   struct gcpro gcpro1;
@@ -897,11 +861,10 @@ DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugg
        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.  */)
-     (character)
-     Lisp_Object character;
+  (Lisp_Object character)
 {
   CHECK_NUMBER (character);
-  putc (XINT (character), stderr);
+  putc ((int) XINT (character), stderr);
 
 #ifdef WINDOWSNT
   /* Send the output to a debugger (nothing happens if there isn't one).  */
@@ -919,8 +882,7 @@ to make it write to the debugging output.  */)
    print_output_debug_flag from being optimized away.  */
 
 void
-debug_output_compilation_hack (x)
-     int x;
+debug_output_compilation_hack (int x)
 {
   print_output_debug_flag = x;
 }
@@ -941,8 +903,7 @@ DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugg
 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.  */)
-     (file, append)
-     Lisp_Object file, append;
+  (Lisp_Object file, Lisp_Object append)
 {
   if (initial_stderr_stream != NULL)
     {
@@ -974,16 +935,14 @@ append to existing target file.  */)
 /* This is the interface for debugging printing.  */
 
 void
-debug_print (arg)
-     Lisp_Object arg;
+debug_print (Lisp_Object arg)
 {
   Fprin1 (arg, Qexternal_debugging_output);
   fprintf (stderr, "\r\n");
 }
 
 void
-safe_debug_print (arg)
-     Lisp_Object arg;
+safe_debug_print (Lisp_Object arg)
 {
   int valid = valid_lisp_object_p (arg);
 
@@ -1002,8 +961,7 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
        doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
 See Info anchor `(elisp)Definition of signal' for some details on how this
 error message is constructed.  */)
-     (obj)
-     Lisp_Object obj;
+  (Lisp_Object obj)
 {
   struct buffer *old = current_buffer;
   Lisp_Object value;
@@ -1037,10 +995,8 @@ error message is constructed.  */)
    CALLER is the Lisp function inside which the error was signaled.  */
 
 void
-print_error_message (data, stream, context, caller)
-     Lisp_Object data, stream;
-     char *context;
-     Lisp_Object caller;
+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;
@@ -1055,7 +1011,7 @@ print_error_message (data, stream, context, caller)
     {
       Lisp_Object cname = SYMBOL_NAME (caller);
       char *name = alloca (SBYTES (cname));
-      bcopy (SDATA (cname), name, SBYTES (cname));
+      memcpy (name, SDATA (cname), SBYTES (cname));
       message_dolog (name, SBYTES (cname), 0, 0);
       message_dolog (": ", 2, 0, 0);
     }
@@ -1125,9 +1081,7 @@ print_error_message (data, stream, context, caller)
  */
 
 void
-float_to_string (buf, data)
-     unsigned char *buf;
-     double data;
+float_to_string (unsigned char *buf, double data)
 {
   unsigned char *cp;
   int width;
@@ -1250,10 +1204,7 @@ float_to_string (buf, data)
 
 \f
 static void
-print (obj, printcharfun, escapeflag)
-     Lisp_Object obj;
-     register Lisp_Object printcharfun;
-     int escapeflag;
+print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
 {
   new_backquote_output = 0;
 
@@ -1271,33 +1222,24 @@ print (obj, printcharfun, escapeflag)
   /* Construct Vprint_number_table for print-gensym and print-circle.  */
   if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
     {
-      int i, start, index;
-      start = index = print_number_index;
       /* Construct Vprint_number_table.
         This increments print_number_index for the objects added.  */
       print_depth = 0;
       print_preprocess (obj);
 
-      /* Remove unnecessary objects, which appear only once in OBJ;
-        that is, whose status is Qnil.  Compactify the necessary objects.  */
-      for (i = start; i < print_number_index; i++)
-       if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
-         {
-           PRINT_NUMBER_OBJECT (Vprint_number_table, index)
-             = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
-           index++;
-         }
-
-      /* Clear out objects outside the active part of the table.  */
-      for (i = index; i < print_number_index; i++)
-       PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
-
-      /* Reset the status field for the next print step.  Now this
-        field means whether the object has already been printed.  */
-      for (i = start; i < print_number_index; i++)
-       PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
+      if (HASH_TABLE_P (Vprint_number_table))
+       { /* Remove unnecessary objects, which appear only once in OBJ;
+            that is, whose status is Qt.
+            Maybe a better way to do that is to copy elements to
+            a new hash table.  */
+         struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
+         int i;
 
-      print_number_index = index;
+         for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
+           if (!NILP (HASH_HASH (h, i))
+               && EQ (HASH_VALUE (h, i), Qt))
+             Fremhash (HASH_KEY (h, i), Vprint_number_table);
+       }
     }
 
   print_depth = 0;
@@ -1312,8 +1254,7 @@ print (obj, printcharfun, escapeflag)
    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 .  */
 static void
-print_preprocess (obj)
-     Lisp_Object obj;
+print_preprocess (Lisp_Object obj)
 {
   int i;
   EMACS_INT size;
@@ -1346,48 +1287,40 @@ print_preprocess (obj)
          && SYMBOLP (obj)
          && !SYMBOL_INTERNED_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);
+       }
+
       /* In case print-circle is nil and print-gensym is t,
         add OBJ to Vprint_number_table only when OBJ is a symbol.  */
       if (! NILP (Vprint_circle) || SYMBOLP (obj))
        {
-         for (i = 0; i < print_number_index; i++)
-           if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
-             {
-               /* OBJ appears more than once.  Let's remember that.  */
-               PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
-                print_depth--;
-               return;
-             }
-
-         /* OBJ is not yet recorded.  Let's add to the table.  */
-         if (print_number_index == 0)
-           {
-             /* Initialize the table.  */
-             Vprint_number_table = Fmake_vector (make_number (40), Qnil);
-           }
-         else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
-           {
-             /* Reallocate the table.  */
-             int i = print_number_index * 4;
-             Lisp_Object old_table = Vprint_number_table;
-             Vprint_number_table = Fmake_vector (make_number (i), Qnil);
-             for (i = 0; i < print_number_index; i++)
+         Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+         if (!NILP (num)
+             /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
+                always print the gensym with a number.  This is a special for
+                the lisp function byte-compile-output-docform.  */
+             || (!NILP (Vprint_continuous_numbering)
+                 && SYMBOLP (obj)
+                 && !SYMBOL_INTERNED_P (obj)))
+           { /* OBJ appears more than once.    Let's remember that.  */
+             if (!INTEGERP (num))
                {
-                 PRINT_NUMBER_OBJECT (Vprint_number_table, i)
-                   = PRINT_NUMBER_OBJECT (old_table, i);
-                 PRINT_NUMBER_STATUS (Vprint_number_table, i)
-                   = PRINT_NUMBER_STATUS (old_table, i);
+                 print_number_index++;
+                 /* Negative number indicates it hasn't been printed yet.  */
+                 Fputhash (obj, make_number (- print_number_index),
+                           Vprint_number_table);
                }
+             print_depth--;
+             return;
            }
-         PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
-         /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
-            always print the gensym with a number.  This is a special for
-            the lisp function byte-compile-output-docform.  */
-         if (!NILP (Vprint_continuous_numbering)
-             && SYMBOLP (obj)
-             && !SYMBOL_INTERNED_P (obj))
-           PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
-         print_number_index++;
+         else
+           /* OBJ is not yet recorded.  Let's add to the table.  */
+           Fputhash (obj, Qt, Vprint_number_table);
        }
 
       switch (XTYPE (obj))
@@ -1418,8 +1351,8 @@ print_preprocess (obj)
            print_preprocess (XVECTOR (obj)->contents[i]);
          if (HASH_TABLE_P (obj))
            { /* For hash tables, the key_and_value slot is past
-               `size' because it needs to be marked specially in case
-               the table is weak.  */
+                `size' because it needs to be marked specially in case
+                the table is weak.  */
              struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
              print_preprocess (h->key_and_value);
            }
@@ -1433,9 +1366,7 @@ print_preprocess (obj)
 }
 
 static void
-print_preprocess_string (interval, arg)
-     INTERVAL interval;
-     Lisp_Object arg;
+print_preprocess_string (INTERVAL interval, Lisp_Object arg)
 {
   print_preprocess (interval->plist);
 }
@@ -1443,9 +1374,8 @@ print_preprocess_string (interval, arg)
 /* A flag to control printing of `charset' text property.
    The default value is Qdefault. */
 Lisp_Object Vprint_charset_text_property;
-extern Lisp_Object Qdefault;
 
-static void print_check_string_charset_prop ();
+static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object string);
 
 #define PRINT_STRING_NON_CHARSET_FOUND 1
 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
@@ -1454,9 +1384,7 @@ static void print_check_string_charset_prop ();
 static int print_check_string_result;
 
 static void
-print_check_string_charset_prop (interval, string)
-     INTERVAL interval;
-     Lisp_Object string;
+print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
 {
   Lisp_Object val;
 
@@ -1481,8 +1409,8 @@ print_check_string_charset_prop (interval, string)
       || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
     {
       int i, c;
-      int charpos = interval->position;
-      int bytepos = string_char_to_byte (string, charpos);
+      EMACS_INT charpos = interval->position;
+      EMACS_INT bytepos = string_char_to_byte (string, charpos);
       Lisp_Object charset;
 
       charset = XCAR (XCDR (val));
@@ -1503,8 +1431,7 @@ print_check_string_charset_prop (interval, string)
 static Lisp_Object print_prune_charset_plist;
 
 static Lisp_Object
-print_prune_string_charset (string)
-     Lisp_Object string;
+print_prune_string_charset (Lisp_Object string)
 {
   print_check_string_result = 0;
   traverse_intervals (STRING_INTERVALS (string), 0,
@@ -1528,10 +1455,7 @@ print_prune_string_charset (string)
 }
 
 static void
-print_object (obj, printcharfun, escapeflag)
-     Lisp_Object obj;
-     register Lisp_Object printcharfun;
-     int escapeflag;
+print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
 {
   char buf[40];
 
@@ -1565,28 +1489,26 @@ print_object (obj, printcharfun, escapeflag)
       else
        {
          /* With the print-circle feature.  */
-         int i;
-         for (i = 0; i < print_number_index; i++)
-           if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
-             {
-               if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
-                 {
-                   /* Add a prefix #n= if OBJ has not yet been printed;
-                      that is, its status field is nil.  */
-                   sprintf (buf, "#%d=", i + 1);
-                   strout (buf, -1, -1, printcharfun, 0);
-                   /* OBJ is going to be printed.  Set the status to t.  */
-                   PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
-                   break;
-                 }
-               else
-                 {
-                   /* Just print #n# if OBJ has already been printed.  */
-                   sprintf (buf, "#%d#", i + 1);
-                   strout (buf, -1, -1, printcharfun, 0);
-                   return;
-                 }
-             }
+         Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+         if (INTEGERP (num))
+           {
+             int n = XINT (num);
+             if (n < 0)
+               { /* Add a prefix #n= if OBJ has not yet been printed;
+                    that is, its status field is nil.  */
+                 sprintf (buf, "#%d=", -n);
+                 strout (buf, -1, -1, printcharfun, 0);
+                 /* OBJ is going to be printed.  Remember that fact.  */
+                 Fputhash (obj, make_number (- n), Vprint_number_table);
+               }
+             else
+               {
+                 /* Just print #n# if OBJ has already been printed.  */
+                 sprintf (buf, "#%d#", n);
+                 strout (buf, -1, -1, printcharfun, 0);
+                 return;
+               }
+           }
        }
     }
 
@@ -1618,10 +1540,10 @@ print_object (obj, printcharfun, escapeflag)
        print_string (obj, printcharfun);
       else
        {
-         register int i, i_byte;
+         register EMACS_INT i, i_byte;
          struct gcpro gcpro1;
          unsigned char *str;
-         int size_byte;
+         EMACS_INT size_byte;
          /* 1 means we must ensure that the next character we output
             cannot be taken as part of a hex character escape.  */
          int need_nonhex = 0;
@@ -1739,7 +1661,8 @@ print_object (obj, printcharfun, escapeflag)
        register unsigned char *p = SDATA (SYMBOL_NAME (obj));
        register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
        register int c;
-       int i, i_byte, size_byte;
+       int i, i_byte;
+       EMACS_INT size_byte;
        Lisp_Object name;
 
        name = SYMBOL_NAME (obj);
@@ -1858,7 +1781,8 @@ print_object (obj, printcharfun, escapeflag)
            }
 
          {
-           int print_length, i;
+           EMACS_INT print_length;
+           int i;
            Lisp_Object halftail = obj;
 
            /* Negative values of print-length are invalid in CL.
@@ -1887,23 +1811,13 @@ print_object (obj, printcharfun, escapeflag)
                    /* With the print-circle feature.  */
                    if (i != 0)
                      {
-                       int i;
-                       for (i = 0; i < print_number_index; i++)
-                         if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
-                                 obj))
-                           {
-                             if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
-                               {
-                                 strout (" . ", 3, 3, printcharfun, 0);
-                                 print_object (obj, printcharfun, escapeflag);
-                               }
-                             else
-                               {
-                                 sprintf (buf, " . #%d#", i + 1);
-                                 strout (buf, -1, -1, printcharfun, 0);
-                               }
-                             goto end_of_list;
-                           }
+                       Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+                       if (INTEGERP (num))
+                         {
+                           strout (" . ", 3, 3, printcharfun, 0);
+                           print_object (obj, printcharfun, escapeflag);
+                           goto end_of_list;
+                         }
                      }
                  }
 
@@ -1953,7 +1867,7 @@ print_object (obj, printcharfun, escapeflag)
          register int i;
          register unsigned char c;
          struct gcpro gcpro1;
-         int size_in_chars
+         EMACS_INT size_in_chars
            = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
               / BOOL_VECTOR_BITS_PER_CHAR);
 
@@ -2039,7 +1953,8 @@ print_object (obj, printcharfun, escapeflag)
       else if (HASH_TABLE_P (obj))
        {
          struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
-         int i, real_size, size;
+         int i;
+         EMACS_INT real_size, size;
 #if 0
          strout ("#<hash-table", -1, -1, printcharfun, 0);
          if (SYMBOLP (h->test))
@@ -2205,7 +2120,7 @@ print_object (obj, printcharfun, escapeflag)
          {
            register int i;
            register Lisp_Object tem;
-           int real_size = size;
+           EMACS_INT real_size = size;
 
            /* Don't print more elements than the specified maximum.  */
            if (NATNUMP (Vprint_length)
@@ -2237,7 +2152,7 @@ print_object (obj, printcharfun, escapeflag)
            strout ("in no buffer", -1, -1, printcharfun, 0);
          else
            {
-             sprintf (buf, "at %d", marker_position (obj));
+             sprintf (buf, "at %ld", (long)marker_position (obj));
              strout (buf, -1, -1, printcharfun, 0);
              strout (" in ", -1, -1, printcharfun, 0);
              print_string (XMARKER (obj)->buffer->name, printcharfun);
@@ -2251,9 +2166,9 @@ print_object (obj, printcharfun, escapeflag)
            strout ("in no buffer", -1, -1, printcharfun, 0);
          else
            {
-             sprintf (buf, "from %d to %d in ",
-                      marker_position (OVERLAY_START (obj)),
-                      marker_position (OVERLAY_END   (obj)));
+             sprintf (buf, "from %ld to %ld in ",
+                      (long)marker_position (OVERLAY_START (obj)),
+                      (long)marker_position (OVERLAY_END   (obj)));
              strout (buf, -1, -1, printcharfun, 0);
              print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
                            printcharfun);
@@ -2267,70 +2182,6 @@ print_object (obj, printcharfun, escapeflag)
          strout ("#<misc free cell>", -1, -1, printcharfun, 0);
          break;
 
-       case Lisp_Misc_Intfwd:
-         sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
-         strout (buf, -1, -1, printcharfun, 0);
-         break;
-
-       case Lisp_Misc_Boolfwd:
-         sprintf (buf, "#<boolfwd to %s>",
-                  (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
-         strout (buf, -1, -1, printcharfun, 0);
-         break;
-
-       case Lisp_Misc_Objfwd:
-         strout ("#<objfwd to ", -1, -1, printcharfun, 0);
-         print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
-         PRINTCHAR ('>');
-         break;
-
-       case Lisp_Misc_Buffer_Objfwd:
-         strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
-         print_object (PER_BUFFER_VALUE (current_buffer,
-                                         XBUFFER_OBJFWD (obj)->offset),
-                       printcharfun, escapeflag);
-         PRINTCHAR ('>');
-         break;
-
-       case Lisp_Misc_Kboard_Objfwd:
-         strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
-         print_object (*(Lisp_Object *) ((char *) current_kboard
-                                         + XKBOARD_OBJFWD (obj)->offset),
-                       printcharfun, escapeflag);
-         PRINTCHAR ('>');
-         break;
-
-       case Lisp_Misc_Buffer_Local_Value:
-         strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
-         if (XBUFFER_LOCAL_VALUE (obj)->local_if_set)
-           strout ("[local-if-set] ", -1, -1, printcharfun, 0);
-         strout ("[realvalue] ", -1, -1, printcharfun, 0);
-         print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
-                       printcharfun, escapeflag);
-         if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
-           strout ("[local in buffer] ", -1, -1, printcharfun, 0);
-         else
-           strout ("[buffer] ", -1, -1, printcharfun, 0);
-         print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
-                       printcharfun, escapeflag);
-         if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
-           {
-             if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
-               strout ("[local in frame] ", -1, -1, printcharfun, 0);
-             else
-               strout ("[frame] ", -1, -1, printcharfun, 0);
-             print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
-                           printcharfun, escapeflag);
-           }
-         strout ("[alist-elt] ", -1, -1, printcharfun, 0);
-         print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
-                       printcharfun, escapeflag);
-         strout ("[default-value] ", -1, -1, printcharfun, 0);
-         print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
-                       printcharfun, escapeflag);
-         PRINTCHAR ('>');
-         break;
-
        case Lisp_Misc_Save_Value:
          strout ("#<save_value ", -1, -1, printcharfun, 0);
          sprintf(buf, "ptr=0x%08lx int=%d",
@@ -2371,9 +2222,7 @@ print_object (obj, printcharfun, escapeflag)
    This is part of printing a string that has text properties.  */
 
 void
-print_interval (interval, printcharfun)
-     INTERVAL interval;
-     Lisp_Object printcharfun;
+print_interval (INTERVAL interval, Lisp_Object printcharfun)
 {
   if (NILP (interval->plist))
     return;
@@ -2388,7 +2237,7 @@ print_interval (interval, printcharfun)
 
 \f
 void
-syms_of_print ()
+syms_of_print (void)
 {
   Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook");
   staticpro (&Qtemp_buffer_setup_hook);