diff src/alloc.c @ 424:11054d720c21 r21-2-20

Import from CVS: tag r21-2-20
author cvs
date Mon, 13 Aug 2007 11:26:11 +0200
parents 41dbb7a9d5f2
children
line wrap: on
line diff
--- a/src/alloc.c	Mon Aug 13 11:25:03 2007 +0200
+++ b/src/alloc.c	Mon Aug 13 11:26:11 2007 +0200
@@ -36,7 +36,7 @@
 	Added lcrecord lists for 19.14.
    slb: Lots of work on the purification and dump time code.
         Synched Doug Lea malloc support from Emacs 20.2.
-   og:  Killed the purespace.
+   og:  Killed the purespace.  Portable dumper.
 */
 
 #include <config.h>
@@ -57,11 +57,27 @@
 #include "specifier.h"
 #include "sysfile.h"
 #include "window.h"
+#include "console-stream.h"
 
 #ifdef DOUG_LEA_MALLOC
 #include <malloc.h>
 #endif
 
+#ifdef HAVE_MMAP
+#include <unistd.h>
+#include <sys/mman.h>
+#endif
+
+#ifdef PDUMP
+typedef struct
+{
+  const struct lrecord_description *desc;
+  int count;
+} pdump_reloc_table;
+
+static char *pdump_rt_list = 0;
+#endif
+
 EXFUN (Fgarbage_collect, 0);
 
 /* Return the true size of a struct with a variable-length array field.  */
@@ -183,13 +199,13 @@
 int
 c_readonly (Lisp_Object obj)
 {
-  return POINTER_TYPE_P (XGCTYPE (obj)) && C_READONLY (obj);
+  return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj);
 }
 
 int
 lisp_readonly (Lisp_Object obj)
 {
-  return POINTER_TYPE_P (XGCTYPE (obj)) && LISP_READONLY (obj);
+  return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj);
 }
 
 
@@ -359,8 +375,7 @@
 
   void *val = xmalloc (len);
   if (val == 0) return 0;
-  memcpy (val, str, len);
-  return (char *) val;
+  return (char *) memcpy (val, str, len);
 }
 
 #ifdef NEED_STRDUP
@@ -375,8 +390,7 @@
 static void *
 allocate_lisp_storage (size_t size)
 {
-  void *p = xmalloc (size);
-  return p;
+  return xmalloc (size);
 }
 
 
@@ -465,42 +479,17 @@
     }
 }
 
-
-/* This must not be called -- it just serves as for EQ test
- *  If lheader->implementation->finalizer is this_marks_a_marked_record,
- *  then lrecord has been marked by the GC sweeper
- * header->implementation is put back to its correct value by
- *  sweep_records */
-void
-this_marks_a_marked_record (void *dummy0, int dummy1)
-{
-  abort ();
-}
-
 /* Semi-kludge -- lrecord_symbol_value_forward objects get stuck
    in CONST space and you get SEGV's if you attempt to mark them.
    This sits in lheader->implementation->marker. */
 
 Lisp_Object
-this_one_is_unmarkable (Lisp_Object obj, void (*markobj) (Lisp_Object))
+this_one_is_unmarkable (Lisp_Object obj)
 {
   abort ();
   return Qnil;
 }
 
-/* XGCTYPE for records */
-int
-gc_record_type_p (Lisp_Object frob, CONST struct lrecord_implementation *type)
-{
-  CONST struct lrecord_implementation *imp;
-
-  if (XGCTYPE (frob) != Lisp_Type_Record)
-    return 0;
-
-  imp = XRECORD_LHEADER_IMPLEMENTATION (frob);
-  return imp == type;
-}
-
 
 /************************************************************************/
 /*			  Debugger support				*/
@@ -943,12 +932,12 @@
 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000
 
 static Lisp_Object
-mark_cons (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_cons (Lisp_Object obj)
 {
-  if (GC_NILP (XCDR (obj)))
+  if (NILP (XCDR (obj)))
     return XCAR (obj);
 
-  markobj (XCAR (obj));
+  mark_object (XCAR (obj));
   return XCDR (obj);
 }
 
@@ -1096,9 +1085,9 @@
 
   {
     Lisp_Object val = Qnil;
-    int size = XINT (length);
-
-    while (size-- > 0)
+    size_t size = XINT (length);
+
+    while (size--)
       val = Fcons (init, val);
     return val;
   }
@@ -1135,14 +1124,14 @@
 /************************************************************************/
 
 static Lisp_Object
-mark_vector (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_vector (Lisp_Object obj)
 {
   Lisp_Vector *ptr = XVECTOR (obj);
   int len = vector_length (ptr);
   int i;
 
   for (i = 0; i < len - 1; i++)
-    markobj (ptr->contents[i]);
+    mark_object (ptr->contents[i]);
   return (len > 0) ? ptr->contents[len - 1] : Qnil;
 }
 
@@ -1172,7 +1161,8 @@
 
 static const struct lrecord_description vector_description[] = {
   { XD_LONG,        offsetof(struct Lisp_Vector, size) },
-  { XD_LISP_OBJECT, offsetof(struct Lisp_Vector, contents), XD_INDIRECT(0) }
+  { XD_LISP_OBJECT, offsetof(struct Lisp_Vector, contents), XD_INDIRECT(0, 0) },
+  { XD_END }
 };
 
 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector,
@@ -1545,7 +1535,7 @@
   f->constants = constants;
 
   CHECK_NATNUM (stack_depth);
-  f->stack_depth  = XINT (stack_depth);
+  f->stack_depth = XINT (stack_depth);
 
 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
   if (!NILP (Vcurrent_compiled_function_annotation))
@@ -1557,7 +1547,7 @@
       struct gcpro gcpro1;
       GCPRO1 (fun);		/* don't let fun get reaped */
       Vload_file_name_internal_the_purecopy =
-	Fpurecopy (Ffile_name_nondirectory (Vload_file_name_internal));
+	Ffile_name_nondirectory (Vload_file_name_internal);
       f->annotated = Vload_file_name_internal_the_purecopy;
       UNGCPRO;
     }
@@ -1736,11 +1726,11 @@
 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 1000
 
 static Lisp_Object
-mark_string (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_string (Lisp_Object obj)
 {
   struct Lisp_String *ptr = XSTRING (obj);
 
-  if (GC_CONSP (ptr->plist) && GC_EXTENT_INFOP (XCAR (ptr->plist)))
+  if (CONSP (ptr->plist) && EXTENT_INFOP (XCAR (ptr->plist)))
     flush_cached_extent_info (XCAR (ptr->plist));
   return ptr->plist;
 }
@@ -1754,8 +1744,9 @@
 }
 
 static const struct lrecord_description string_description[] = {
-  { XD_STRING_DATA, offsetof(Lisp_String, data) },
-  { XD_LISP_OBJECT, offsetof(Lisp_String, plist), 1 },
+  { XD_BYTECOUNT,       offsetof(Lisp_String, size) },
+  { XD_OPAQUE_DATA_PTR, offsetof(Lisp_String, data), XD_INDIRECT(0, 1) },
+  { XD_LISP_OBJECT,     offsetof(Lisp_String, plist), 1 },
   { XD_END }
 };
 
@@ -1791,8 +1782,8 @@
   unsigned char string_chars[STRING_CHARS_BLOCK_SIZE];
 };
 
-struct string_chars_block *first_string_chars_block;
-struct string_chars_block *current_string_chars_block;
+static struct string_chars_block *first_string_chars_block;
+static struct string_chars_block *current_string_chars_block;
 
 /* If SIZE is the length of a string, this returns how many bytes
  *  the string occupies in string_chars_block->string_chars
@@ -2079,7 +2070,7 @@
       memset (XSTRING_DATA (val), XCHAR (init), XSTRING_LENGTH (val));
     else
       {
-	int i;
+	size_t i;
 	Bufbyte *ptr = XSTRING_DATA (val);
 
 	for (i = XINT (length); i; i--)
@@ -2202,7 +2193,7 @@
    It works like this:
 
    1) Create an lcrecord-list object using make_lcrecord_list().
-      This is often done at initialization.  Remember to staticpro
+      This is often done at initialization.  Remember to staticpro_nodump
       this object!  The arguments to make_lcrecord_list() are the
       same as would be passed to alloc_lcrecord().
    2) Instead of calling alloc_lcrecord(), call allocate_managed_lcrecord()
@@ -2223,7 +2214,7 @@
    */
 
 static Lisp_Object
-mark_lcrecord_list (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_lcrecord_list (Lisp_Object obj)
 {
   struct lcrecord_list *list = XLCRECORD_LIST (obj);
   Lisp_Object chain = list->free;
@@ -2376,6 +2367,7 @@
 
 /* 415 used Mly 29-Jun-93 */
 /* 1327 used slb 28-Feb-98 */
+/* 1328 used og  03-Oct-99 (moving slowly, heh?) */
 #ifdef HAVE_SHLIB
 #define NSTATICS 4000
 #else
@@ -2399,24 +2391,89 @@
   staticvec[staticidx++] = varaddress;
 }
 
+/* Not "static" because of linker lossage on some systems */
+Lisp_Object *staticvec_nodump[200]
+     /* Force it into data space! */
+     = {0};
+static int staticidx_nodump;
+
+/* Put an entry in staticvec_nodump, pointing at the variable whose address is given
+ */
+void
+staticpro_nodump (Lisp_Object *varaddress)
+{
+  if (staticidx_nodump >= countof (staticvec_nodump))
+    /* #### This is now a dubious abort() since this routine may be called */
+    /* by Lisp attempting to load a DLL. */
+    abort ();
+  staticvec_nodump[staticidx_nodump++] = varaddress;
+}
+
+/* Not "static" because of linker lossage on some systems */
+struct {
+  void *data;
+  const struct struct_description *desc;
+} dumpstructvec[200];
+
+static int dumpstructidx;
+
+/* Put an entry in dumpstructvec, pointing at the variable whose address is given
+ */
+void
+dumpstruct (void *varaddress, const struct struct_description *desc)
+{
+  if (dumpstructidx >= countof (dumpstructvec))
+    abort ();
+  dumpstructvec[dumpstructidx].data = varaddress;
+  dumpstructvec[dumpstructidx].desc = desc;
+  dumpstructidx++;
+}
+
+Lisp_Object *pdump_wirevec[50];
+static int pdump_wireidx;
+
+/* Put an entry in pdump_wirevec, pointing at the variable whose address is given
+ */
+void
+pdump_wire (Lisp_Object *varaddress)
+{
+  if (pdump_wireidx >= countof (pdump_wirevec))
+    abort ();
+  pdump_wirevec[pdump_wireidx++] = varaddress;
+}
+
+
+Lisp_Object *pdump_wirevec_list[50];
+static int pdump_wireidx_list;
+
+/* Put an entry in pdump_wirevec_list, pointing at the variable whose address is given
+ */
+void
+pdump_wire_list (Lisp_Object *varaddress)
+{
+  if (pdump_wireidx_list >= countof (pdump_wirevec_list))
+    abort ();
+  pdump_wirevec_list[pdump_wireidx_list++] = varaddress;
+}
+
 
 /* Mark reference to a Lisp_Object.  If the object referred to has not been
    seen yet, recursively mark all the references contained in it. */
 
-static void
+void
 mark_object (Lisp_Object obj)
 {
  tail_recurse:
 
 #ifdef ERROR_CHECK_GC
-  assert (! (GC_EQ (obj, Qnull_pointer)));
+  assert (! (EQ (obj, Qnull_pointer)));
 #endif
   /* Checks we used to perform */
   /* if (EQ (obj, Qnull_pointer)) return; */
   /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */
   /* if (PURIFIED (XPNTR (obj))) return; */
 
-  if (XGCTYPE (obj) == Lisp_Type_Record)
+  if (XTYPE (obj) == Lisp_Type_Record)
     {
       struct lrecord_header *lheader = XRECORD_LHEADER (obj);
 #if defined (ERROR_CHECK_GC)
@@ -2437,8 +2494,8 @@
 #endif
 	  if (implementation->marker)
 	    {
-	      obj = implementation->marker (obj, mark_object);
-	      if (!GC_NILP (obj)) goto tail_recurse;
+	      obj = implementation->marker (obj);
+	      if (!NILP (obj)) goto tail_recurse;
 	    }
 	}
     }
@@ -2911,7 +2968,7 @@
   /* Perhaps this will catch freeing an already-freed marker. */
   Lisp_Object temmy;
   XSETMARKER (temmy, ptr);
-  assert (GC_MARKERP (temmy));
+  assert (MARKERP (temmy));
 #endif /* ERROR_CHECK_GC */
 
 #ifndef ALLOC_NO_POOLS
@@ -3124,18 +3181,18 @@
 
 
 /* I hate duplicating all this crap! */
-static int
+int
 marked_p (Lisp_Object obj)
 {
 #ifdef ERROR_CHECK_GC
-  assert (! (GC_EQ (obj, Qnull_pointer)));
+  assert (! (EQ (obj, Qnull_pointer)));
 #endif
   /* Checks we used to perform. */
   /* if (EQ (obj, Qnull_pointer)) return 1; */
   /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */
   /* if (PURIFIED (XPNTR (obj))) return 1; */
 
-  if (XGCTYPE (obj) == Lisp_Type_Record)
+  if (XTYPE (obj) == Lisp_Type_Record)
     {
       struct lrecord_header *lheader = XRECORD_LHEADER (obj);
 #if defined (ERROR_CHECK_GC)
@@ -3205,6 +3262,27 @@
 
   sweep_events ();
 
+#ifdef PDUMP
+  /* Unmark all dumped objects */
+  {
+    int i;
+    char *p = pdump_rt_list;
+    if(p)
+      for(;;)
+	{
+	  pdump_reloc_table *rt = (pdump_reloc_table *)p;
+	  p += sizeof (pdump_reloc_table);
+	  if (rt->desc) {
+	    for (i=0; i<rt->count; i++)
+	      {
+		UNMARK_RECORD_HEADER ((struct lrecord_header *)(*(EMACS_INT *)p));
+		p += sizeof (EMACS_INT);
+	      }
+	  } else
+	    break;
+	}
+  }
+#endif
 }
 
 /* Clearing for disksave. */
@@ -3406,6 +3484,8 @@
     int i;
     for (i = 0; i < staticidx; i++)
       mark_object (*(staticvec[i]));
+    for (i = 0; i < staticidx_nodump; i++)
+      mark_object (*(staticvec_nodump[i]));    
   }
 
   { /* GCPRO() */
@@ -3450,8 +3530,8 @@
       }
   }
 
-  mark_redisplay (mark_object);
-  mark_profiling_info (mark_object);
+  mark_redisplay ();
+  mark_profiling_info ();
 
   /* OK, now do the after-mark stuff.  This is for things that
      are only marked when something else is marked (e.g. weak hash tables).
@@ -3460,18 +3540,18 @@
      weak hash table, the former one might get marked.  So we have to
      iterate until nothing more gets marked. */
 
-  while (finish_marking_weak_hash_tables (marked_p, mark_object) > 0 ||
-	 finish_marking_weak_lists       (marked_p, mark_object) > 0)
+  while (finish_marking_weak_hash_tables () > 0 ||
+	 finish_marking_weak_lists       () > 0)
     ;
 
   /* And prune (this needs to be called after everything else has been
      marked and before we do any sweeping). */
   /* #### this is somewhat ad-hoc and should probably be an object
      method */
-  prune_weak_hash_tables (marked_p);
-  prune_weak_lists (marked_p);
-  prune_specifiers (marked_p);
-  prune_syntax_tables (marked_p);
+  prune_weak_hash_tables ();
+  prune_weak_lists ();
+  prune_specifiers ();
+  prune_syntax_tables ();
 
   gc_sweep ();
 
@@ -3565,7 +3645,7 @@
 
   garbage_collect_1 ();
 
-  for (i = 0; i < last_lrecord_type_index_assigned; i++)
+  for (i = 0; i <= last_lrecord_type_index_assigned; i++)
     {
       if (lcrecord_stats[i].bytes_in_use != 0
           || lcrecord_stats[i].bytes_freed != 0
@@ -3839,32 +3919,8 @@
 
 /* Initialization */
 void
-init_alloc_once_early (void)
+reinit_alloc_once_early (void)
 {
-  int iii;
-
-  last_lrecord_type_index_assigned = -1;
-  for (iii = 0; iii < countof (lrecord_implementations_table); iii++)
-    {
-      lrecord_implementations_table[iii] = 0;
-    }
-
-  /*
-   * All the staticly
-   * defined subr lrecords were initialized with lheader->type == 0.
-   * See subr_lheader_initializer in lisp.h.  Force type index 0 to be
-   * assigned to lrecord_subr so that those predefined indexes match
-   * reality.
-   */
-  lrecord_type_index (&lrecord_subr);
-  assert (*(lrecord_subr.lrecord_type_index) == 0);
-  /*
-   * The same is true for symbol_value_forward objects, except the
-   * type is 1.
-   */
-  lrecord_type_index (&lrecord_symbol_value_forward);
-  assert (*(lrecord_symbol_value_forward.lrecord_type_index) == 1);
-
   gc_generation_number[0] = 0;
   /* purify_flag 1 is correct even if CANNOT_DUMP.
    * loadup.el will set to nil at end. */
@@ -3894,7 +3950,11 @@
   init_event_alloc ();
 
   ignore_malloc_warnings = 0;
-  staticidx = 0;
+
+  staticidx_nodump = 0;
+  dumpstructidx = 0;
+  pdump_wireidx = 0;
+
   consing_since_gc = 0;
 #if 1
   gc_cons_threshold = 500000; /* XEmacs change */
@@ -3923,6 +3983,38 @@
 #endif /* ERROR_CHECK_TYPECHECK */
 }
 
+void
+init_alloc_once_early (void)
+{
+  int iii;
+
+  reinit_alloc_once_early ();
+
+  last_lrecord_type_index_assigned = -1;
+  for (iii = 0; iii < countof (lrecord_implementations_table); iii++)
+    {
+      lrecord_implementations_table[iii] = 0;
+    }
+
+  /*
+   * All the staticly
+   * defined subr lrecords were initialized with lheader->type == 0.
+   * See subr_lheader_initializer in lisp.h.  Force type index 0 to be
+   * assigned to lrecord_subr so that those predefined indexes match
+   * reality.
+   */
+  lrecord_type_index (&lrecord_subr);
+  assert (*(lrecord_subr.lrecord_type_index) == 0);
+  /*
+   * The same is true for symbol_value_forward objects, except the
+   * type is 1.
+   */
+  lrecord_type_index (&lrecord_symbol_value_forward);
+  assert (*(lrecord_symbol_value_forward.lrecord_type_index) == 1);
+
+  staticidx = 0;
+}
+
 int pure_bytes_used = 0;
 
 void
@@ -4030,8 +4122,7 @@
 image instance) in the domain of the selected frame, the mouse pointer
 will change instead of this message being printed.
 */ );
-  Vgc_message = make_string_nocopy ((CONST Bufbyte *) gc_default_message,
-				    countof (gc_default_message) - 1);
+  Vgc_message = build_string (gc_default_message);
 
   DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /*
 Pointer glyph used to indicate that a garbage collection is in progress.
@@ -4048,3 +4139,982 @@
 {
   Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer);
 }
+
+
+#ifdef PDUMP
+
+/* The structure of the file
+ *
+ * 0			- header
+ * 256			- dumped objects
+ * stab_offset		- nb_staticpro*(Lisp_Object *) from staticvec
+ *			- nb_staticpro*(relocated Lisp_Object) pointed to by staticpro
+ *			- nb_structdmp*pair(void *, adr) for pointers to structures
+ *			- lrecord_implementations_table[]
+ *			- relocation table
+ *                      - wired variable address/value couples with the count preceding the list
+ */	
+typedef struct
+{
+  char signature[8];
+  EMACS_UINT stab_offset;
+  EMACS_UINT reloc_address;
+  int nb_staticpro;
+  int nb_structdmp;
+  int last_type;
+} dump_header;
+
+char *pdump_start, *pdump_end;
+
+static const unsigned char align_table[256] =
+{
+  8, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  7, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+  4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0
+};
+
+typedef struct pdump_entry_list_elmt
+{
+  struct pdump_entry_list_elmt *next;
+  const void *obj;
+  size_t size;
+  int count;
+  int is_lrecord;
+  EMACS_INT save_offset;
+} pdump_entry_list_elmt;
+
+typedef struct
+{
+  pdump_entry_list_elmt *first;
+  int align;
+  int count;
+} pdump_entry_list;
+
+typedef struct pdump_struct_list_elmt
+{
+  pdump_entry_list list;
+  const struct struct_description *sdesc;
+} pdump_struct_list_elmt;
+
+typedef struct
+{
+  pdump_struct_list_elmt *list;
+  int count;
+  int size;
+} pdump_struct_list;
+
+static pdump_entry_list pdump_object_table[256];
+static pdump_entry_list pdump_opaque_data_list;
+static pdump_struct_list pdump_struct_table;
+static pdump_entry_list_elmt *pdump_qnil;
+
+static int pdump_alert_undump_object[256];
+
+static unsigned long cur_offset;
+static size_t max_size;
+static int pdump_fd;
+static void *pdump_buf;
+
+#define PDUMP_HASHSIZE 200001
+
+static pdump_entry_list_elmt **pdump_hash;
+
+/* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
+static int
+pdump_make_hash (const void *obj)
+{
+  return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE;
+}
+
+static pdump_entry_list_elmt *
+pdump_get_entry (const void *obj)
+{
+  int pos = pdump_make_hash(obj);
+  pdump_entry_list_elmt *e;
+  while ((e = pdump_hash[pos]) != 0)
+    {
+      if (e->obj == obj)
+	return e;
+
+      pos++;
+      if (pos == PDUMP_HASHSIZE)
+	pos = 0;
+    }
+  return 0;
+}
+
+static void
+pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size, int count, int is_lrecord)
+{
+  pdump_entry_list_elmt *e;
+  int align;
+  int pos = pdump_make_hash (obj);
+
+  while ((e = pdump_hash[pos]) != 0)
+    {
+      if (e->obj == obj)
+	return;
+      
+      pos++;
+      if (pos == PDUMP_HASHSIZE)
+	pos = 0;
+    }
+
+  e = malloc (sizeof (pdump_entry_list_elmt));
+
+  e->next = list->first;
+  e->obj = obj;
+  e->size = size;
+  e->count = count;
+  e->is_lrecord = is_lrecord;
+  list->first = e;
+
+  list->count += count;
+  pdump_hash[pos] = e;
+
+  align = align_table[size & 255];
+  if (align<2 && is_lrecord)
+    align = 2;
+
+  if(align < list->align)
+    list->align = align;
+}
+
+static pdump_entry_list *
+pdump_get_entry_list(const struct struct_description *sdesc)
+{
+  int i;
+  for(i=0; i<pdump_struct_table.count; i++)
+    if (pdump_struct_table.list[i].sdesc == sdesc)
+      return &pdump_struct_table.list[i].list;
+
+  if (pdump_struct_table.size <= pdump_struct_table.count)
+    {
+      if (pdump_struct_table.size == -1)
+	pdump_struct_table.size = 10;
+      else
+	pdump_struct_table.size = pdump_struct_table.size * 2;
+      pdump_struct_table.list = xrealloc (pdump_struct_table.list,
+					  pdump_struct_table.size*sizeof (pdump_struct_list_elmt));
+    }
+  pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
+  pdump_struct_table.list[pdump_struct_table.count].list.align = 8;
+  pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
+  pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
+  
+  return &pdump_struct_table.list[pdump_struct_table.count++].list;
+}
+
+static struct {
+  Lisp_Object obj;
+  int position;
+  int offset;
+} backtrace[65536];
+
+static int depth;
+
+static void pdump_backtrace (void)
+{
+  int i;
+  fprintf (stderr, "pdump backtrace :\n");
+  for (i=0;i<depth;i++)
+    {
+      if (!backtrace[i].obj)
+	fprintf (stderr, "  - ind. (%d, %d)\n", backtrace[i].position, backtrace[i].offset);
+      else
+	{
+	  fprintf (stderr, "  - %s (%d, %d)\n",
+		   XRECORD_LHEADER_IMPLEMENTATION (backtrace[i].obj)->name,
+		   backtrace[i].position,
+		   backtrace[i].offset);
+	}
+    }
+}
+
+static void pdump_register_object (Lisp_Object obj);
+static void pdump_register_struct (const void *data, const struct struct_description *sdesc, int count);
+
+static EMACS_INT
+pdump_get_indirect_count (EMACS_INT code, const struct lrecord_description *idesc, const void *idata)
+{
+  EMACS_INT count;
+  const void *irdata;
+
+  int line = XD_INDIRECT_VAL (code);
+  int delta = XD_INDIRECT_DELTA (code);
+
+  irdata = ((char *)idata) + idesc[line].offset;
+  switch (idesc[line].type) {
+  case XD_SIZE_T:
+    count = *(size_t *)irdata;
+    break;
+  case XD_INT:
+    count = *(int *)irdata;
+    break;
+  case XD_LONG:
+    count = *(long *)irdata;
+    break;
+  case XD_BYTECOUNT:
+    count = *(Bytecount *)irdata;
+    break;
+  default:
+    fprintf (stderr, "Unsupported count type : %d (line = %d, code=%ld)\n", idesc[line].type, line, (long)code);
+    pdump_backtrace ();
+    abort ();
+  }
+  count += delta;
+  return count;
+}
+
+static void
+pdump_register_sub (const void *data, const struct lrecord_description *desc, int me)
+{
+  int pos;
+  const void *rdata;
+
+ restart:
+  for (pos = 0; desc[pos].type != XD_END; pos++)
+    {
+      backtrace[me].position = pos;
+      backtrace[me].offset = desc[pos].offset;
+
+      rdata = ((const char *)data) + desc[pos].offset;
+      switch(desc[pos].type)
+	{
+	case XD_SPECIFIER_END:
+	  pos = 0;
+	  desc = ((const struct Lisp_Specifier *)data)->methods->extra_description;
+	  goto restart;
+	case XD_SIZE_T:
+	case XD_INT:
+	case XD_LONG:
+	case XD_BYTECOUNT:
+	case XD_LO_RESET_NIL:
+	case XD_INT_RESET:
+	case XD_LO_LINK:
+	  break;
+	case XD_OPAQUE_DATA_PTR:
+	  {
+	    EMACS_INT count = desc[pos].data1;
+	    if (XD_IS_INDIRECT(count))
+	      count = pdump_get_indirect_count (count, desc, data);
+
+	    pdump_add_entry (&pdump_opaque_data_list,
+			     *(void **)rdata,
+			     count,
+			     1,
+			     0);
+	    break;
+	  }
+	case XD_C_STRING:
+	  {
+	    const char *str = *(const char **)rdata;
+	    if (str)
+	      pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
+	    break;
+	  }
+	case XD_DOC_STRING:
+	  {
+	    const char *str = *(const char **)rdata;
+	    if ((EMACS_INT)str > 0)
+	      pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
+	    break;
+	  }
+	case XD_LISP_OBJECT:
+	  {
+	    EMACS_INT count = desc[pos].data1;
+	    int i;
+	    if (XD_IS_INDIRECT (count))
+	      count = pdump_get_indirect_count (count, desc, data);
+	    
+	    for(i=0;i<count;i++) {
+	      const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i;
+	      Lisp_Object dobj = *pobj;
+	      
+	      backtrace[me].offset = (const char *)pobj - (const char *)data;
+	      pdump_register_object (dobj);
+	    }
+	    break;
+	  }
+	case XD_STRUCT_PTR:
+	  {
+	    EMACS_INT count = desc[pos].data1;
+	    const struct struct_description *sdesc = desc[pos].data2;
+	    const char *dobj = *(const char **)rdata;
+	    if (dobj) {
+	      if (XD_IS_INDIRECT (count))
+		count = pdump_get_indirect_count (count, desc, data);
+	      
+	      pdump_register_struct (dobj, sdesc, count);
+	    }
+	    break;
+	  }
+	default:
+	  fprintf (stderr, "Unsupported dump type : %d\n", desc[pos].type);
+	  pdump_backtrace ();
+	  abort ();
+	};
+    }
+}
+
+static void
+pdump_register_object (Lisp_Object obj)
+{
+  if (!obj ||
+      !POINTER_TYPE_P (XTYPE (obj)) ||
+      pdump_get_entry (XRECORD_LHEADER (obj)))
+    return;
+  
+  if (XRECORD_LHEADER_IMPLEMENTATION (obj)->description)
+    {
+      int me = depth++;
+      if (me>65536)
+	{
+	  fprintf (stderr, "Backtrace overflow, loop ?\n");
+	  abort ();
+	}
+      backtrace[me].obj = obj;
+      backtrace[me].position = 0;
+      backtrace[me].offset = 0;
+
+      pdump_add_entry (pdump_object_table + XRECORD_LHEADER (obj)->type,
+		       XRECORD_LHEADER (obj),
+		       XRECORD_LHEADER_IMPLEMENTATION (obj)->static_size ?
+		       XRECORD_LHEADER_IMPLEMENTATION (obj)->static_size :
+		       XRECORD_LHEADER_IMPLEMENTATION (obj)->size_in_bytes_method (XRECORD_LHEADER (obj)),
+		       1,
+		       1);
+      pdump_register_sub (XRECORD_LHEADER (obj),
+			  XRECORD_LHEADER_IMPLEMENTATION (obj)->description,
+			  me);
+      --depth;
+    }
+  else
+    {
+      pdump_alert_undump_object[XRECORD_LHEADER (obj)->type]++;
+      fprintf (stderr, "Undumpable object type : %s\n", XRECORD_LHEADER_IMPLEMENTATION (obj)->name);
+      pdump_backtrace ();
+    }
+}
+
+static void
+pdump_register_struct (const void *data, const struct struct_description *sdesc, int count)
+{
+  if (data && !pdump_get_entry (data))
+    {
+      int me = depth++;
+      int i;
+      if (me>65536)
+	{
+	  fprintf (stderr, "Backtrace overflow, loop ?\n");
+	  abort ();
+	}
+      backtrace[me].obj = 0;
+      backtrace[me].position = 0;
+      backtrace[me].offset = 0;
+      
+      pdump_add_entry (pdump_get_entry_list (sdesc),
+		       data,
+		       sdesc->size,
+		       count,
+		       0);
+      for (i=0; i<count; i++)
+	{
+	  pdump_register_sub (((char *)data) + sdesc->size*i,
+			      sdesc->description,
+			      me);
+	}
+      --depth;
+    }
+}
+
+static void
+pdump_dump_data (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
+{
+  size_t size = elmt->size;
+  int count = elmt->count;
+  if (desc)
+    {
+      int pos, i;
+      void *rdata;
+      memcpy (pdump_buf, elmt->obj, size*count);
+      
+      for (i=0; i<count; i++)
+	{
+	  char *cur = ((char *)pdump_buf) + i*size;
+	restart:
+	  for (pos = 0; desc[pos].type != XD_END; pos++)
+	    {
+	      rdata = cur + desc[pos].offset;
+	      switch (desc[pos].type)
+		{
+		case XD_SPECIFIER_END:
+		  pos = 0;
+		  desc = ((const struct Lisp_Specifier *)(elmt->obj))->methods->extra_description;
+		  goto restart;
+		case XD_SIZE_T:
+		case XD_INT:
+		case XD_LONG:
+		case XD_BYTECOUNT:
+		  break;
+		case XD_LO_RESET_NIL:
+		  {
+		    EMACS_INT count = desc[pos].data1;
+		    int i;
+		    if (XD_IS_INDIRECT (count))
+		      count = pdump_get_indirect_count (count, desc, elmt->obj);
+		    for (i=0; i<count; i++)
+		      ((EMACS_INT *)rdata)[i] = pdump_qnil->save_offset;
+		    break;
+		  }
+		case XD_INT_RESET:
+		  {
+		    EMACS_INT val = desc[pos].data1;
+		    if (XD_IS_INDIRECT (val))
+		      val = pdump_get_indirect_count (val, desc, elmt->obj);
+		    *(int *)rdata = val;
+		    break;
+		  }
+		case XD_OPAQUE_DATA_PTR:
+		case XD_C_STRING:
+		case XD_STRUCT_PTR:
+		  {
+		    void *ptr = *(void **)rdata;
+		    if (ptr)
+		      *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset;
+		    break;
+		  }
+		case XD_LO_LINK:
+		  {
+		    Lisp_Object obj = *(Lisp_Object *)rdata;
+		    pdump_entry_list_elmt *elmt1;
+		    for(;;)
+		      {
+			elmt1 = pdump_get_entry (XRECORD_LHEADER(obj));
+			if (elmt1)
+			  break;
+			obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
+		      }
+		    *(EMACS_INT *)rdata = elmt1->save_offset;
+		    break;
+		  }
+		case XD_LISP_OBJECT:
+		  {
+		    EMACS_INT count = desc[pos].data1;
+		    int i;
+		    if (XD_IS_INDIRECT (count))
+		      count = pdump_get_indirect_count (count, desc, elmt->obj);
+		    
+		    for(i=0; i<count; i++)
+		      {
+			Lisp_Object *pobj = ((Lisp_Object *)rdata) + i;
+			Lisp_Object dobj = *pobj;
+			if (dobj && POINTER_TYPE_P (XTYPE (dobj)))
+			  *pobj = pdump_get_entry (XRECORD_LHEADER (dobj))->save_offset;
+		      }
+		    break;
+		  }
+		case XD_DOC_STRING:
+		  {
+		    EMACS_INT str = *(EMACS_INT *)rdata;
+		    if (str > 0)
+		      *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset;
+		    break;
+		  }
+		default:
+		  fprintf (stderr, "Unsupported dump type : %d\n", desc[pos].type);
+		  abort ();
+		};
+	    }
+	}
+    }
+  write (pdump_fd, desc ? pdump_buf : elmt->obj, size*count);
+  if (elmt->is_lrecord && ((size*count) & 3))
+    write (pdump_fd, "\0\0\0", 4-((size*count) & 3));
+}
+
+static void
+pdump_reloc_one (void *data, EMACS_INT delta, const struct lrecord_description *desc)
+{
+  int pos;
+  void *rdata;
+
+  restart:
+  for (pos = 0; desc[pos].type != XD_END; pos++)
+    {
+      rdata = ((char *)data) + desc[pos].offset;
+      switch (desc[pos].type) {
+      case XD_SPECIFIER_END:
+	pos = 0;
+	desc = ((const struct Lisp_Specifier *)data)->methods->extra_description;
+	goto restart;
+      case XD_SIZE_T:
+      case XD_INT:
+      case XD_LONG:
+      case XD_BYTECOUNT:
+      case XD_INT_RESET:
+	break;
+      case XD_OPAQUE_DATA_PTR:
+      case XD_C_STRING:
+      case XD_STRUCT_PTR:
+      case XD_LO_LINK:
+	{
+	  EMACS_INT ptr = *(EMACS_INT *)rdata;
+	  if (ptr)
+	    *(EMACS_INT *)rdata = ptr+delta;
+	  break;
+	}
+      case XD_LISP_OBJECT:
+      case XD_LO_RESET_NIL:
+	{
+	  EMACS_INT count = desc[pos].data1;
+	  int i;
+	  if (XD_IS_INDIRECT (count))
+	    count = pdump_get_indirect_count (count, desc, data);
+	  
+	  for (i=0; i<count; i++)
+	    {
+	      Lisp_Object *pobj = ((Lisp_Object *)rdata) + i;
+	      Lisp_Object dobj = *pobj;
+	      if (dobj && POINTER_TYPE_P (XTYPE (dobj)))
+		*pobj = dobj + delta;
+	    }
+	  break;
+	}
+      case XD_DOC_STRING:
+	{
+	  EMACS_INT str = *(EMACS_INT *)rdata;
+	  if (str > 0)
+	    *(EMACS_INT *)rdata = str + delta;
+	  break;
+	}
+      default:
+	fprintf (stderr, "Unsupported dump type : %d\n", desc[pos].type);
+	abort ();
+      };
+    }
+}
+
+static void
+pdump_allocate_offset (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
+{
+  size_t size = (elmt->is_lrecord ? (elmt->size + 3) & ~3 : elmt->size)*elmt->count;
+  elmt->save_offset = cur_offset;
+  if (size>max_size)
+    max_size = size;
+  cur_offset += size;
+}
+
+static void
+pdump_scan_by_alignement (void (*f)(pdump_entry_list_elmt *, const struct lrecord_description *))
+{
+  int align, i;
+  const struct lrecord_description *idesc;
+  pdump_entry_list_elmt *elmt;
+  for (align=8; align>=0; align--)
+    {
+      for (i=0; i<=last_lrecord_type_index_assigned; i++)
+	if (pdump_object_table[i].align == align)
+	  {
+	    elmt = pdump_object_table[i].first;
+	    if (!elmt)
+	      continue;
+	    idesc = lrecord_implementations_table[i]->description;
+	    while (elmt)
+	      {
+		f (elmt, idesc);
+		elmt = elmt->next;
+	      }
+	  }
+      
+      for (i=0; i<pdump_struct_table.count; i++)
+	if (pdump_struct_table.list[i].list.align == align) {
+	  elmt = pdump_struct_table.list[i].list.first;
+	  idesc = pdump_struct_table.list[i].sdesc->description;
+	  while (elmt)
+	    {
+	      f (elmt, idesc);
+	      elmt = elmt->next;
+	    }
+	}
+      
+      elmt = pdump_opaque_data_list.first;
+      while (elmt)
+	{
+	  if (align_table[elmt->size & 255] == align)
+	    f (elmt, 0);
+	  elmt = elmt->next;
+	}
+    }
+}
+
+static void
+pdump_dump_staticvec (void)
+{
+  Lisp_Object *reloc = malloc (staticidx*sizeof (Lisp_Object));
+  int i;
+  write (pdump_fd, staticvec, staticidx*sizeof (Lisp_Object *));
+
+  for(i=0; i<staticidx; i++)
+    {
+      Lisp_Object obj = *staticvec[i];
+      if (obj && POINTER_TYPE_P (XTYPE (obj)))
+	reloc[i] = pdump_get_entry (XRECORD_LHEADER (obj))->save_offset;
+      else
+	reloc[i] = obj;
+    }
+  write (pdump_fd, reloc, staticidx*sizeof (Lisp_Object));
+  free (reloc);
+}
+
+static void
+pdump_dump_structvec (void)
+{
+  int i;
+  for (i=0; i<dumpstructidx; i++)
+    {
+      EMACS_INT adr;
+      write (pdump_fd, &(dumpstructvec[i].data), sizeof (void *));
+      adr = pdump_get_entry (*(void **)(dumpstructvec[i].data))->save_offset;
+      write (pdump_fd, &adr, sizeof (adr));
+  }
+}
+
+static void
+pdump_dump_itable (void)
+{
+  write (pdump_fd, lrecord_implementations_table, sizeof (lrecord_implementations_table));  
+}
+
+static void
+pdump_dump_rtables (void)
+{
+  int i, j;
+  pdump_entry_list_elmt *elmt;
+  pdump_reloc_table rt;
+
+  for (i=0; i<=last_lrecord_type_index_assigned; i++)
+    {
+      elmt = pdump_object_table[i].first;
+      if(!elmt)
+	continue;
+      rt.desc = lrecord_implementations_table[i]->description;
+      rt.count = pdump_object_table[i].count;
+      write (pdump_fd, &rt, sizeof (rt));
+      while (elmt)
+	{
+	  EMACS_INT rdata = pdump_get_entry (XRECORD_LHEADER (elmt->obj))->save_offset;
+	  write (pdump_fd, &rdata, sizeof (rdata));
+	  elmt = elmt->next;
+	}
+  }
+
+  rt.desc = 0;
+  rt.count = 0;
+  write (pdump_fd, &rt, sizeof (rt));
+
+  for (i=0; i<pdump_struct_table.count; i++)
+    {
+      elmt = pdump_struct_table.list[i].list.first;
+      rt.desc = pdump_struct_table.list[i].sdesc->description;
+      rt.count = pdump_struct_table.list[i].list.count;
+      write (pdump_fd, &rt, sizeof (rt));
+      while (elmt)
+	{
+	  EMACS_INT rdata = pdump_get_entry (XRECORD_LHEADER (elmt->obj))->save_offset;
+	  for (j=0; j<elmt->count; j++) {
+	    write (pdump_fd, &rdata, sizeof (rdata));
+	    rdata += elmt->size;
+	  }
+	  elmt = elmt->next;
+	}
+    }
+  rt.desc = 0;
+  rt.count = 0;
+  write (pdump_fd, &rt, sizeof (rt));
+}
+
+static void
+pdump_dump_wired (void)
+{
+  EMACS_INT count = pdump_wireidx + pdump_wireidx_list;
+  int i;
+
+  write (pdump_fd, &count, sizeof (count));
+
+  for (i=0; i<pdump_wireidx; i++)
+    {
+      Lisp_Object obj = pdump_get_entry (XRECORD_LHEADER (*(pdump_wirevec[i])))->save_offset;
+      write (pdump_fd, &pdump_wirevec[i], sizeof (pdump_wirevec[i]));
+      write (pdump_fd, &obj, sizeof (obj));
+    }
+  
+  for (i=0; i<pdump_wireidx_list; i++)
+    {
+      Lisp_Object obj = *(pdump_wirevec_list[i]);
+      pdump_entry_list_elmt *elmt;
+      EMACS_INT res;
+
+      for(;;)
+	{
+	  const struct lrecord_description *desc;
+	  int pos;
+	  elmt = pdump_get_entry (XRECORD_LHEADER (obj));
+	  if (elmt)
+	    break;
+	  desc = XRECORD_LHEADER_IMPLEMENTATION (obj)->description;
+	  for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
+	    if (desc[pos].type == XD_END)
+	      abort ();
+
+	  obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
+	}
+      res = elmt->save_offset;
+
+      write (pdump_fd, &pdump_wirevec_list[i], sizeof (pdump_wirevec_list[i]));
+      write (pdump_fd, &res, sizeof (res));
+    }
+}
+
+void
+pdump (void)
+{
+  int i;
+  Lisp_Object t_console, t_device, t_frame;
+  int none;
+  dump_header hd;
+
+  /* These appear in a DEFVAR_LISP, which does a staticpro() */
+  t_console = Vterminal_console;
+  t_frame   = Vterminal_frame;
+  t_device  = Vterminal_device;
+
+  Vterminal_console = Qnil;
+  Vterminal_frame   = Qnil;
+  Vterminal_device  = Qnil;
+
+  pdump_hash = malloc (PDUMP_HASHSIZE*sizeof (pdump_entry_list_elmt *));
+  memset (pdump_hash, 0, PDUMP_HASHSIZE*sizeof (pdump_entry_list_elmt *));
+
+  for (i=0; i<=last_lrecord_type_index_assigned; i++)
+    {
+      pdump_object_table[i].first = 0;
+      pdump_object_table[i].align = 8;
+      pdump_object_table[i].count = 0;
+      pdump_alert_undump_object[i] = 0;
+    }
+  pdump_struct_table.count = 0;
+  pdump_struct_table.size = -1;
+  
+  pdump_opaque_data_list.first = 0;
+  pdump_opaque_data_list.align = 8;
+  pdump_opaque_data_list.count = 0;
+  depth = 0;
+
+  for (i=0; i<staticidx; i++)
+    pdump_register_object (*staticvec[i]);
+  for (i=0; i<pdump_wireidx; i++)
+    pdump_register_object (*pdump_wirevec[i]);
+
+  none = 1;
+  for(i=0;i<=last_lrecord_type_index_assigned;i++)
+    if (pdump_alert_undump_object[i])
+      {
+	if (none)
+	  printf ("Undumpable types list :\n");
+	none = 0;
+	printf ("  - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]);
+      }
+  if (!none)
+    return;
+
+  for (i=0; i<dumpstructidx; i++)
+    pdump_register_struct (*(void **)(dumpstructvec[i].data), dumpstructvec[i].desc, 1); 
+
+  memcpy (hd.signature, "XEmacsDP", 8);
+  hd.reloc_address = 0;
+  hd.nb_staticpro = staticidx;
+  hd.nb_structdmp = dumpstructidx;
+  hd.last_type    = last_lrecord_type_index_assigned;
+  
+  cur_offset = 256;
+  max_size = 0;
+  
+  pdump_scan_by_alignement (pdump_allocate_offset);
+  pdump_qnil = pdump_get_entry (XRECORD_LHEADER (Qnil));
+
+  pdump_buf = malloc (max_size);
+  pdump_fd = open ("xemacs.dmp", O_WRONLY|O_CREAT|O_TRUNC, 0666);
+  hd.stab_offset = (cur_offset + 3) & ~3;
+
+  write (pdump_fd, &hd, sizeof (hd));
+  lseek (pdump_fd, 256, SEEK_SET);
+
+  pdump_scan_by_alignement (pdump_dump_data);
+
+  lseek (pdump_fd, hd.stab_offset, SEEK_SET);
+
+  pdump_dump_staticvec ();
+  pdump_dump_structvec ();
+  pdump_dump_itable ();
+  pdump_dump_rtables ();
+  pdump_dump_wired ();
+
+  close (pdump_fd);
+  free (pdump_buf);
+
+  free (pdump_hash);
+
+  Vterminal_console = t_console;
+  Vterminal_frame   = t_frame;
+  Vterminal_device  = t_device;
+}
+
+int
+pdump_load (void)
+{
+  size_t length;
+  int i;
+  char *p;
+  EMACS_INT delta;
+  EMACS_INT count;
+
+  pdump_start = pdump_end = 0;
+
+  pdump_fd = open ("xemacs.dmp", O_RDONLY);
+  if (pdump_fd<0)
+    return 0;
+
+  length = lseek (pdump_fd, 0, SEEK_END);
+  lseek (pdump_fd, 0, SEEK_SET);
+
+#ifdef HAVE_MMAP
+  pdump_start = mmap (0, length, PROT_READ|PROT_WRITE, MAP_PRIVATE, pdump_fd, 0);
+  if (pdump_start == MAP_FAILED)
+    pdump_start = 0;
+#endif
+  
+  if (!pdump_start)
+    {
+      pdump_start = (void *)((((unsigned long)(malloc(length+255))) + 255) & ~255);
+      read(pdump_fd, pdump_start, length);
+    }
+
+  close (pdump_fd);
+
+  pdump_end = pdump_start + length;
+
+  staticidx = ((dump_header *)(pdump_start))->nb_staticpro;
+  last_lrecord_type_index_assigned = ((dump_header *)(pdump_start))->last_type;
+  delta = ((EMACS_INT)pdump_start) - ((dump_header *)pdump_start)->reloc_address;
+  p = pdump_start + ((dump_header *)pdump_start)->stab_offset;
+
+  /* Put back the staticvec in place */
+  memcpy (staticvec, p, staticidx*sizeof (Lisp_Object *));
+  p += staticidx*sizeof (Lisp_Object *);
+  for (i=0; i<staticidx; i++)
+    {
+      Lisp_Object obj = *(Lisp_Object *)p;
+      p += sizeof (Lisp_Object);
+      if (obj && POINTER_TYPE_P (XTYPE (obj)))
+	obj += delta;
+      *staticvec[i] = obj;
+    }
+
+  /* Put back the dumpstructs */
+  for (i=0; i<((dump_header *)pdump_start)->nb_structdmp; i++)
+    {
+      void **adr = *(void **)p;
+      p += sizeof (void *);
+      *adr = (void *)((*(EMACS_INT *)p) + delta);
+      p += sizeof (EMACS_INT);
+    }
+
+  /* Put back the lrecord_implementations_table */
+  memcpy (lrecord_implementations_table, p, sizeof (lrecord_implementations_table));
+  p += sizeof (lrecord_implementations_table);
+
+  /* Give back their numbers to the lrecord implementations */
+  for (i=0; i<sizeof(lrecord_implementations_table)/sizeof(lrecord_implementations_table[0]); i++)
+    if (lrecord_implementations_table[i])
+      {
+	*(lrecord_implementations_table[i]->lrecord_type_index) = i;
+	last_lrecord_type_index_assigned = i;
+      }
+
+  /* Do the relocations */
+  pdump_rt_list = p;
+  count = 2;
+  for(;;)
+    {
+      pdump_reloc_table *rt = (pdump_reloc_table *)p;
+      p += sizeof (pdump_reloc_table);
+      if (rt->desc) {
+	for (i=0; i<rt->count; i++)
+	  {
+	    EMACS_INT adr = delta + *(EMACS_INT *)p;
+	    *(EMACS_INT *)p = adr;
+	    pdump_reloc_one ((void *)adr, delta, rt->desc);
+	    p += sizeof (EMACS_INT);
+	  }
+      } else
+	if(!(--count))
+	  break;
+    }
+
+  /* Put the pdump_wire variables in place */
+  count = *(EMACS_INT *)p;
+  p += sizeof(EMACS_INT);
+
+  for (i=0; i<count; i++)
+    {
+      Lisp_Object *var, obj;
+      var = *(Lisp_Object **)p;
+      p += sizeof (Lisp_Object *);
+
+      obj = *(Lisp_Object *)p;
+      p += sizeof (Lisp_Object);
+
+      if (obj && POINTER_TYPE_P (XTYPE (obj)))
+	obj += delta;
+      *var = obj;
+    }
+
+  /* Final cleanups */
+  /*   reorganize hash tables */
+  p = pdump_rt_list;
+  for(;;)
+    {
+      pdump_reloc_table *rt = (pdump_reloc_table *)p;
+      p += sizeof (pdump_reloc_table);
+      if (!rt->desc)
+	break;
+      if (rt->desc == hash_table_description)
+	{
+	  for (i=0; i<rt->count; i++)
+	    {
+	      struct Lisp_Hash_Table *ht = XHASH_TABLE (*(EMACS_INT *)p);
+	      reorganize_hash_table (ht);
+	      p += sizeof (EMACS_INT);
+	    }
+	  break;
+	} else
+	  p += sizeof (EMACS_INT)*rt->count;
+    }
+  return 1;
+}
+
+#endif