1 /* Portable data dumper for XEmacs.
2 Copyright (C) 1999-2000 Olivier Galibert
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: Not in FSF. */
27 #include "specifier.h"
30 #include "console-stream.h"
53 Dynarr_declare (pdump_opaque);
54 } pdump_opaque_dynarr;
59 const struct struct_description *desc;
60 } pdump_root_struct_ptr;
64 Dynarr_declare (pdump_root_struct_ptr);
65 } pdump_root_struct_ptr_dynarr;
67 static pdump_opaque_dynarr *pdump_opaques;
68 static pdump_root_struct_ptr_dynarr *pdump_root_struct_ptrs;
69 static Lisp_Object_ptr_dynarr *pdump_root_objects;
70 static Lisp_Object_ptr_dynarr *pdump_weak_object_chains;
72 /* Mark SIZE bytes at non-heap address VARADDRESS for dumping as is,
73 without any bit-twiddling. */
75 dump_add_opaque (void *varaddress, size_t size)
78 info.varaddress = varaddress;
80 if (pdump_opaques == NULL)
81 pdump_opaques = Dynarr_new (pdump_opaque);
82 Dynarr_add (pdump_opaques, info);
85 /* Mark the struct described by DESC and pointed to by the pointer at
86 non-heap address VARADDRESS for dumping.
87 All the objects reachable from this pointer will also be dumped. */
89 dump_add_root_struct_ptr (void *ptraddress, const struct struct_description *desc)
91 pdump_root_struct_ptr info;
92 info.ptraddress = (void **) ptraddress;
94 if (pdump_root_struct_ptrs == NULL)
95 pdump_root_struct_ptrs = Dynarr_new (pdump_root_struct_ptr);
96 Dynarr_add (pdump_root_struct_ptrs, info);
99 /* Mark the Lisp_Object at non-heap address VARADDRESS for dumping.
100 All the objects reachable from this var will also be dumped. */
102 dump_add_root_object (Lisp_Object *varaddress)
104 if (pdump_root_objects == NULL)
105 pdump_root_objects = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
106 Dynarr_add (pdump_root_objects, varaddress);
109 /* Mark the list pointed to by the Lisp_Object at VARADDRESS for dumping. */
111 dump_add_weak_object_chain (Lisp_Object *varaddress)
113 if (pdump_weak_object_chains == NULL)
114 pdump_weak_object_chains = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
115 Dynarr_add (pdump_weak_object_chains, varaddress);
121 const struct lrecord_description *desc;
125 static char *pdump_rt_list = 0;
128 pdump_objects_unmark (void)
131 char *p = pdump_rt_list;
135 pdump_reloc_table *rt = (pdump_reloc_table *)p;
136 p += sizeof (pdump_reloc_table);
139 for (i=0; i<rt->count; i++)
141 struct lrecord_header *lh = * (struct lrecord_header **) p;
142 if (! C_READONLY_RECORD_HEADER_P (lh))
143 UNMARK_RECORD_HEADER (lh);
144 p += sizeof (EMACS_INT);
152 /* The structure of the file
155 * 256 - dumped objects
156 * stab_offset - nb_root_struct_ptrs*pair(void *, adr) for pointers to structures
157 * - nb_opaques*pair(void *, size) for raw bits to restore
159 * - wired variable address/value couples with the count preceding the list
163 #define PDUMP_SIGNATURE "XEmacsDP"
164 #define PDUMP_SIGNATURE_LEN (sizeof (PDUMP_SIGNATURE) - 1)
168 char signature[PDUMP_SIGNATURE_LEN];
170 EMACS_UINT stab_offset;
171 EMACS_UINT reloc_address;
172 int nb_root_struct_ptrs;
176 char *pdump_start, *pdump_end;
177 static size_t pdump_length;
180 /* Handle for the dump file */
181 HANDLE pdump_hFile = INVALID_HANDLE_VALUE;
182 /* Handle for the file mapping object for the dump file */
183 HANDLE pdump_hMap = INVALID_HANDLE_VALUE;
186 void (*pdump_free) (void);
188 static const unsigned char pdump_align_table[256] =
190 8, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
191 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
192 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
193 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
194 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
195 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
196 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
197 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
198 7, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
199 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
200 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
201 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
202 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
203 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
204 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
205 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0
208 typedef struct pdump_entry_list_elmt
210 struct pdump_entry_list_elmt *next;
215 EMACS_INT save_offset;
216 } pdump_entry_list_elmt;
220 pdump_entry_list_elmt *first;
225 typedef struct pdump_struct_list_elmt
227 pdump_entry_list list;
228 const struct struct_description *sdesc;
229 } pdump_struct_list_elmt;
233 pdump_struct_list_elmt *list;
238 static pdump_entry_list pdump_object_table[256];
239 static pdump_entry_list pdump_opaque_data_list;
240 static pdump_struct_list pdump_struct_table;
242 static int pdump_alert_undump_object[256];
244 static unsigned long cur_offset;
245 static size_t max_size;
247 static void *pdump_buf;
250 #define PDUMP_HASHSIZE 20000001
252 #define PDUMP_HASHSIZE 200001
255 static pdump_entry_list_elmt **pdump_hash;
257 /* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
259 pdump_make_hash (const void *obj)
261 return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE;
264 static pdump_entry_list_elmt *
265 pdump_get_entry (const void *obj)
267 int pos = pdump_make_hash (obj);
268 pdump_entry_list_elmt *e;
272 while ((e = pdump_hash[pos]) != 0)
278 if (pos == PDUMP_HASHSIZE)
285 pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size, int count, int is_lrecord)
287 pdump_entry_list_elmt *e;
289 int pos = pdump_make_hash (obj);
291 while ((e = pdump_hash[pos]) != 0)
297 if (pos == PDUMP_HASHSIZE)
301 e = xnew (pdump_entry_list_elmt);
303 e->next = list->first;
307 e->is_lrecord = is_lrecord;
310 list->count += count;
313 align = pdump_align_table[size & 255];
314 if (align < 2 && is_lrecord)
317 if (align < list->align)
321 static pdump_entry_list *
322 pdump_get_entry_list (const struct struct_description *sdesc)
325 for (i=0; i<pdump_struct_table.count; i++)
326 if (pdump_struct_table.list[i].sdesc == sdesc)
327 return &pdump_struct_table.list[i].list;
329 if (pdump_struct_table.size <= pdump_struct_table.count)
331 if (pdump_struct_table.size == -1)
332 pdump_struct_table.size = 10;
334 pdump_struct_table.size = pdump_struct_table.size * 2;
335 pdump_struct_table.list = (pdump_struct_list_elmt *)
336 xrealloc (pdump_struct_table.list,
337 pdump_struct_table.size * sizeof (pdump_struct_list_elmt));
339 pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
340 pdump_struct_table.list[pdump_struct_table.count].list.align = 8;
341 pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
342 pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
344 return &pdump_struct_table.list[pdump_struct_table.count++].list;
349 struct lrecord_header *obj;
357 pdump_backtrace (void)
360 stderr_out ("pdump backtrace :\n");
361 for (i=0;i<depth;i++)
363 if (!backtrace[i].obj)
364 stderr_out (" - ind. (%d, %d)\n", backtrace[i].position, backtrace[i].offset);
367 stderr_out (" - %s (%d, %d)\n",
368 LHEADER_IMPLEMENTATION (backtrace[i].obj)->name,
369 backtrace[i].position,
370 backtrace[i].offset);
375 static void pdump_register_object (Lisp_Object obj);
376 static void pdump_register_struct (const void *data, const struct struct_description *sdesc, int count);
379 pdump_get_indirect_count (EMACS_INT code, const struct lrecord_description *idesc, const void *idata)
384 int line = XD_INDIRECT_VAL (code);
385 int delta = XD_INDIRECT_DELTA (code);
387 irdata = ((char *)idata) + idesc[line].offset;
388 switch (idesc[line].type)
391 count = *(size_t *)irdata;
394 count = *(int *)irdata;
397 count = *(long *)irdata;
400 count = *(Bytecount *)irdata;
403 stderr_out ("Unsupported count type : %d (line = %d, code=%ld)\n", idesc[line].type, line, (long)code);
412 pdump_register_sub (const void *data, const struct lrecord_description *desc, int me)
417 for (pos = 0; desc[pos].type != XD_END; pos++)
419 const void *rdata = (const char *)data + desc[pos].offset;
421 backtrace[me].position = pos;
422 backtrace[me].offset = desc[pos].offset;
424 switch (desc[pos].type)
426 case XD_SPECIFIER_END:
428 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
437 case XD_OPAQUE_DATA_PTR:
439 EMACS_INT count = desc[pos].data1;
440 if (XD_IS_INDIRECT (count))
441 count = pdump_get_indirect_count (count, desc, data);
443 pdump_add_entry (&pdump_opaque_data_list,
452 const char *str = *(const char **)rdata;
454 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
459 const char *str = *(const char **)rdata;
460 if ((EMACS_INT)str > 0)
461 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
466 const Lisp_Object *pobj = (const Lisp_Object *)rdata;
468 assert (desc[pos].data1 == 0);
470 backtrace[me].offset = (const char *)pobj - (const char *)data;
471 pdump_register_object (*pobj);
474 case XD_LISP_OBJECT_ARRAY:
477 EMACS_INT count = desc[pos].data1;
478 if (XD_IS_INDIRECT (count))
479 count = pdump_get_indirect_count (count, desc, data);
481 for (i = 0; i < count; i++)
483 const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i;
484 Lisp_Object dobj = *pobj;
486 backtrace[me].offset = (const char *)pobj - (const char *)data;
487 pdump_register_object (dobj);
493 EMACS_INT count = desc[pos].data1;
494 const struct struct_description *sdesc = desc[pos].data2;
495 const char *dobj = *(const char **)rdata;
498 if (XD_IS_INDIRECT (count))
499 count = pdump_get_indirect_count (count, desc, data);
501 pdump_register_struct (dobj, sdesc, count);
506 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
514 pdump_register_object (Lisp_Object obj)
516 struct lrecord_header *objh;
518 if (!POINTER_TYPE_P (XTYPE (obj)))
521 objh = XRECORD_LHEADER (obj);
525 if (pdump_get_entry (objh))
528 if (LHEADER_IMPLEMENTATION (objh)->description)
533 stderr_out ("Backtrace overflow, loop ?\n");
536 backtrace[me].obj = objh;
537 backtrace[me].position = 0;
538 backtrace[me].offset = 0;
540 pdump_add_entry (pdump_object_table + objh->type,
542 LHEADER_IMPLEMENTATION (objh)->static_size ?
543 LHEADER_IMPLEMENTATION (objh)->static_size :
544 LHEADER_IMPLEMENTATION (objh)->size_in_bytes_method (objh),
547 pdump_register_sub (objh,
548 LHEADER_IMPLEMENTATION (objh)->description,
554 pdump_alert_undump_object[objh->type]++;
555 stderr_out ("Undumpable object type : %s\n", LHEADER_IMPLEMENTATION (objh)->name);
561 pdump_register_struct (const void *data, const struct struct_description *sdesc, int count)
563 if (data && !pdump_get_entry (data))
569 stderr_out ("Backtrace overflow, loop ?\n");
572 backtrace[me].obj = 0;
573 backtrace[me].position = 0;
574 backtrace[me].offset = 0;
576 pdump_add_entry (pdump_get_entry_list (sdesc),
581 for (i=0; i<count; i++)
583 pdump_register_sub (((char *)data) + sdesc->size*i,
592 pdump_dump_data (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
594 size_t size = elmt->size;
595 int count = elmt->count;
599 memcpy (pdump_buf, elmt->obj, size*count);
601 for (i=0; i<count; i++)
603 char *cur = ((char *)pdump_buf) + i*size;
605 for (pos = 0; desc[pos].type != XD_END; pos++)
607 void *rdata = cur + desc[pos].offset;
608 switch (desc[pos].type)
610 case XD_SPECIFIER_END:
611 desc = ((const Lisp_Specifier *)(elmt->obj))->methods->extra_description;
620 EMACS_INT val = desc[pos].data1;
621 if (XD_IS_INDIRECT (val))
622 val = pdump_get_indirect_count (val, desc, elmt->obj);
626 case XD_OPAQUE_DATA_PTR:
630 void *ptr = *(void **)rdata;
632 *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset;
637 Lisp_Object obj = *(Lisp_Object *)rdata;
638 pdump_entry_list_elmt *elmt1;
641 elmt1 = pdump_get_entry (XRECORD_LHEADER (obj));
644 obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
646 *(EMACS_INT *)rdata = elmt1->save_offset;
651 Lisp_Object *pobj = (Lisp_Object *) rdata;
653 assert (desc[pos].data1 == 0);
655 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
657 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
660 case XD_LISP_OBJECT_ARRAY:
662 EMACS_INT num = desc[pos].data1;
664 if (XD_IS_INDIRECT (num))
665 num = pdump_get_indirect_count (num, desc, elmt->obj);
667 for (j=0; j<num; j++)
669 Lisp_Object *pobj = ((Lisp_Object *)rdata) + j;
670 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
672 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
678 EMACS_INT str = *(EMACS_INT *)rdata;
680 *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset;
684 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
690 write (pdump_fd, desc ? pdump_buf : elmt->obj, size*count);
691 if (elmt->is_lrecord && ((size*count) & 3))
692 write (pdump_fd, "\0\0\0", 4-((size*count) & 3));
696 pdump_reloc_one (void *data, EMACS_INT delta, const struct lrecord_description *desc)
701 for (pos = 0; desc[pos].type != XD_END; pos++)
703 void *rdata = (char *)data + desc[pos].offset;
704 switch (desc[pos].type)
706 case XD_SPECIFIER_END:
708 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
716 case XD_OPAQUE_DATA_PTR:
721 EMACS_INT ptr = *(EMACS_INT *)rdata;
723 *(EMACS_INT *)rdata = ptr+delta;
728 Lisp_Object *pobj = (Lisp_Object *) rdata;
730 assert (desc[pos].data1 == 0);
732 if (POINTER_TYPE_P (XTYPE (*pobj))
733 && ! EQ (*pobj, Qnull_pointer))
734 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
738 case XD_LISP_OBJECT_ARRAY:
740 EMACS_INT num = desc[pos].data1;
742 if (XD_IS_INDIRECT (num))
743 num = pdump_get_indirect_count (num, desc, data);
745 for (j=0; j<num; j++)
747 Lisp_Object *pobj = (Lisp_Object *) rdata + j;
749 if (POINTER_TYPE_P (XTYPE (*pobj))
750 && ! EQ (*pobj, Qnull_pointer))
751 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
757 EMACS_INT str = *(EMACS_INT *)rdata;
759 *(EMACS_INT *)rdata = str + delta;
763 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
770 pdump_allocate_offset (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
772 size_t size = (elmt->is_lrecord ? (elmt->size + 3) & ~3 : elmt->size)*elmt->count;
773 elmt->save_offset = cur_offset;
780 pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *, const struct lrecord_description *))
783 const struct lrecord_description *idesc;
784 pdump_entry_list_elmt *elmt;
785 for (align=8; align>=0; align--)
787 for (i=0; i<lrecord_type_count; i++)
788 if (pdump_object_table[i].align == align)
790 elmt = pdump_object_table[i].first;
793 idesc = lrecord_implementations_table[i]->description;
801 for (i=0; i<pdump_struct_table.count; i++)
802 if (pdump_struct_table.list[i].list.align == align)
804 elmt = pdump_struct_table.list[i].list.first;
805 idesc = pdump_struct_table.list[i].sdesc->description;
813 elmt = pdump_opaque_data_list.first;
816 if (pdump_align_table[elmt->size & 255] == align)
824 pdump_dump_from_root_struct_ptrs (void)
827 for (i = 0; i < Dynarr_length (pdump_root_struct_ptrs); i++)
830 pdump_root_struct_ptr *info = Dynarr_atp (pdump_root_struct_ptrs, i);
831 write (pdump_fd, &info->ptraddress, sizeof (info->ptraddress));
832 adr = pdump_get_entry (*(info->ptraddress))->save_offset;
833 write (pdump_fd, &adr, sizeof (adr));
838 pdump_dump_opaques (void)
841 for (i = 0; i < Dynarr_length (pdump_opaques); i++)
843 pdump_opaque *info = Dynarr_atp (pdump_opaques, i);
844 write (pdump_fd, info, sizeof (*info));
845 write (pdump_fd, info->varaddress, info->size);
850 pdump_dump_rtables (void)
853 pdump_entry_list_elmt *elmt;
854 pdump_reloc_table rt;
856 for (i=0; i<lrecord_type_count; i++)
858 elmt = pdump_object_table[i].first;
861 rt.desc = lrecord_implementations_table[i]->description;
862 rt.count = pdump_object_table[i].count;
863 write (pdump_fd, &rt, sizeof (rt));
866 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
867 write (pdump_fd, &rdata, sizeof (rdata));
874 write (pdump_fd, &rt, sizeof (rt));
876 for (i=0; i<pdump_struct_table.count; i++)
878 elmt = pdump_struct_table.list[i].list.first;
879 rt.desc = pdump_struct_table.list[i].sdesc->description;
880 rt.count = pdump_struct_table.list[i].list.count;
881 write (pdump_fd, &rt, sizeof (rt));
884 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
886 for (j=0; j<elmt->count; j++)
888 write (pdump_fd, &rdata, sizeof (rdata));
896 write (pdump_fd, &rt, sizeof (rt));
900 pdump_dump_from_root_objects (void)
902 size_t count = Dynarr_length (pdump_root_objects) + Dynarr_length (pdump_weak_object_chains);
905 write (pdump_fd, &count, sizeof (count));
907 for (i=0; i<Dynarr_length (pdump_root_objects); i++)
909 Lisp_Object obj = * Dynarr_at (pdump_root_objects, i);
910 if (POINTER_TYPE_P (XTYPE (obj)))
911 obj = wrap_object ((void *) pdump_get_entry (XRECORD_LHEADER (obj))->save_offset);
912 write (pdump_fd, Dynarr_atp (pdump_root_objects, i), sizeof (Dynarr_atp (pdump_root_objects, i)));
913 write (pdump_fd, &obj, sizeof (obj));
916 for (i=0; i<Dynarr_length (pdump_weak_object_chains); i++)
918 Lisp_Object obj = * Dynarr_at (pdump_weak_object_chains, i);
919 pdump_entry_list_elmt *elmt;
923 const struct lrecord_description *desc;
925 elmt = pdump_get_entry (XRECORD_LHEADER (obj));
928 desc = XRECORD_LHEADER_IMPLEMENTATION (obj)->description;
929 for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
930 assert (desc[pos].type != XD_END);
932 obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
934 obj = wrap_object ((void *) elmt->save_offset);
936 write (pdump_fd, Dynarr_atp (pdump_weak_object_chains, i), sizeof (Lisp_Object *));
937 write (pdump_fd, &obj, sizeof (obj));
945 Lisp_Object t_console, t_device, t_frame;
949 flush_all_buffer_local_cache ();
951 /* These appear in a DEFVAR_LISP, which does a staticpro() */
952 t_console = Vterminal_console; Vterminal_console = Qnil;
953 t_frame = Vterminal_frame; Vterminal_frame = Qnil;
954 t_device = Vterminal_device; Vterminal_device = Qnil;
956 dump_add_opaque (&lrecord_implementations_table,
957 lrecord_type_count * sizeof (lrecord_implementations_table[0]));
958 dump_add_opaque (&lrecord_markers,
959 lrecord_type_count * sizeof (lrecord_markers[0]));
961 pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE);
963 for (i=0; i<lrecord_type_count; i++)
965 pdump_object_table[i].first = 0;
966 pdump_object_table[i].align = 8;
967 pdump_object_table[i].count = 0;
968 pdump_alert_undump_object[i] = 0;
970 pdump_struct_table.count = 0;
971 pdump_struct_table.size = -1;
973 pdump_opaque_data_list.first = 0;
974 pdump_opaque_data_list.align = 8;
975 pdump_opaque_data_list.count = 0;
978 for (i=0; i<Dynarr_length (pdump_root_objects); i++)
979 pdump_register_object (* Dynarr_at (pdump_root_objects, i));
982 for (i=0; i<lrecord_type_count; i++)
983 if (pdump_alert_undump_object[i])
986 printf ("Undumpable types list :\n");
988 printf (" - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]);
993 for (i=0; i<Dynarr_length (pdump_root_struct_ptrs); i++)
995 pdump_root_struct_ptr info = Dynarr_at (pdump_root_struct_ptrs, i);
996 pdump_register_struct (*(info.ptraddress), info.desc, 1);
999 memcpy (hd.signature, PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN);
1001 hd.reloc_address = 0;
1002 hd.nb_root_struct_ptrs = Dynarr_length (pdump_root_struct_ptrs);
1003 hd.nb_opaques = Dynarr_length (pdump_opaques);
1008 pdump_scan_by_alignment (pdump_allocate_offset);
1010 pdump_buf = xmalloc (max_size);
1011 /* Avoid use of the `open' macro. We want the real function. */
1013 pdump_fd = open (EMACS_PROGNAME ".dmp",
1014 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666);
1015 hd.stab_offset = (cur_offset + 3) & ~3;
1017 write (pdump_fd, &hd, sizeof (hd));
1018 lseek (pdump_fd, 256, SEEK_SET);
1020 pdump_scan_by_alignment (pdump_dump_data);
1022 lseek (pdump_fd, hd.stab_offset, SEEK_SET);
1024 pdump_dump_from_root_struct_ptrs ();
1025 pdump_dump_opaques ();
1026 pdump_dump_rtables ();
1027 pdump_dump_from_root_objects ();
1034 Vterminal_console = t_console;
1035 Vterminal_frame = t_frame;
1036 Vterminal_device = t_device;
1040 pdump_load_check (void)
1042 return (!memcmp (((pdump_header *)pdump_start)->signature,
1043 PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN)
1044 && ((pdump_header *)pdump_start)->id == dump_id);
1048 pdump_load_finish (void)
1055 pdump_end = pdump_start + pdump_length;
1057 #define PDUMP_READ(p, type) (p = (char*) (((type *) p) + 1), *((type *) p - 1))
1059 delta = ((EMACS_INT)pdump_start) - ((pdump_header *)pdump_start)->reloc_address;
1060 p = pdump_start + ((pdump_header *)pdump_start)->stab_offset;
1062 /* Put back the pdump_root_struct_ptrs */
1063 for (i=0; i<((pdump_header *)pdump_start)->nb_root_struct_ptrs; i++)
1065 void **adr = PDUMP_READ (p, void **);
1066 *adr = (void *) (PDUMP_READ (p, char *) + delta);
1069 /* Put back the pdump_opaques */
1070 for (i=0; i<((pdump_header *)pdump_start)->nb_opaques; i++)
1072 pdump_opaque info = PDUMP_READ (p, pdump_opaque);
1073 memcpy (info.varaddress, p, info.size);
1077 /* Do the relocations */
1082 pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1085 for (i=0; i < rt.count; i++)
1087 char *adr = delta + *(char **)p;
1089 pdump_reloc_one (adr, delta, rt.desc);
1090 p += sizeof (char *);
1097 /* Put the pdump_root_objects variables in place */
1098 for (i = PDUMP_READ (p, size_t); i; i--)
1100 Lisp_Object *var = PDUMP_READ (p, Lisp_Object *);
1101 Lisp_Object obj = PDUMP_READ (p, Lisp_Object);
1103 if (POINTER_TYPE_P (XTYPE (obj)))
1104 obj = wrap_object ((char *) XPNTR (obj) + delta);
1109 /* Final cleanups */
1110 /* reorganize hash tables */
1114 pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1117 if (rt.desc == hash_table_description)
1119 for (i=0; i < rt.count; i++)
1120 pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object));
1123 p += sizeof (Lisp_Object) * rt.count;
1130 /* Free the mapped file if we decide we don't want it after all */
1132 pdump_file_unmap (void)
1134 UnmapViewOfFile (pdump_start);
1135 CloseHandle (pdump_hFile);
1136 CloseHandle (pdump_hMap);
1140 pdump_file_get (const char *path)
1143 pdump_hFile = CreateFile (path,
1144 GENERIC_READ + GENERIC_WRITE, /* Required for copy on write */
1146 NULL, /* Not inheritable */
1148 FILE_ATTRIBUTE_NORMAL,
1149 NULL); /* No template file */
1150 if (pdump_hFile == INVALID_HANDLE_VALUE)
1153 pdump_length = GetFileSize (pdump_hFile, NULL);
1154 pdump_hMap = CreateFileMapping (pdump_hFile,
1155 NULL, /* No security attributes */
1156 PAGE_WRITECOPY, /* Copy on write */
1157 0, /* Max size, high half */
1158 0, /* Max size, low half */
1159 NULL); /* Unnamed */
1160 if (pdump_hMap == INVALID_HANDLE_VALUE)
1163 pdump_start = MapViewOfFile (pdump_hMap,
1164 FILE_MAP_COPY, /* Copy on write */
1165 0, /* Start at zero */
1167 0); /* Map all of it */
1168 pdump_free = pdump_file_unmap;
1172 /* pdump_resource_free is called (via the pdump_free pointer) to release
1173 any resources allocated by pdump_resource_get. Since the Windows API
1174 specs specifically state that you don't need to (and shouldn't) free the
1175 resources allocated by FindResource, LoadResource, and LockResource this
1176 routine does nothing. */
1178 pdump_resource_free (void)
1183 pdump_resource_get (void)
1185 HRSRC hRes; /* Handle to dump resource */
1186 HRSRC hResLoad; /* Handle to loaded dump resource */
1188 /* See Q126630 which describes how Windows NT and 95 trap writes to
1189 resource sections and duplicate the page to allow the write to proceed.
1190 It also describes how to make the resource section read/write (and hence
1191 private to each process). Doing this avoids the exceptions and related
1192 overhead, but causes the resource section to be private to each process
1193 that is running XEmacs. Since the resource section contains little
1194 other than the dumped data, which should be private to each process, we
1195 make the whole resource section read/write so we don't have to copy it. */
1197 hRes = FindResource (NULL, MAKEINTRESOURCE(101), "DUMP");
1201 /* Found it, use the data in the resource */
1202 hResLoad = LoadResource (NULL, hRes);
1203 if (hResLoad == NULL)
1206 pdump_start = LockResource (hResLoad);
1207 if (pdump_start == NULL)
1210 pdump_free = pdump_resource_free;
1211 pdump_length = SizeofResource (NULL, hRes);
1212 if (pdump_length <= sizeof (pdump_header))
1221 #else /* !WIN32_NATIVE */
1223 static void *pdump_mallocadr;
1226 pdump_file_free (void)
1228 xfree (pdump_mallocadr);
1233 pdump_file_unmap (void)
1235 munmap (pdump_start, pdump_length);
1240 pdump_file_get (const char *path)
1242 int fd = open (path, O_RDONLY | OPEN_BINARY);
1246 pdump_length = lseek (fd, 0, SEEK_END);
1247 if (pdump_length < sizeof (pdump_header))
1253 lseek (fd, 0, SEEK_SET);
1256 /* Unix 98 requires that sys/mman.h define MAP_FAILED,
1257 but many earlier implementations don't. */
1259 # define MAP_FAILED ((void *) -1L)
1261 pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1262 if (pdump_start != (char *) MAP_FAILED)
1264 pdump_free = pdump_file_unmap;
1268 #endif /* HAVE_MMAP */
1270 pdump_mallocadr = xmalloc (pdump_length+255);
1271 pdump_free = pdump_file_free;
1272 pdump_start = (char *)((255 + (unsigned long)pdump_mallocadr) & ~255);
1273 read (fd, pdump_start, pdump_length);
1278 #endif /* !WIN32_NATIVE */
1282 pdump_file_try (char *exe_path)
1286 w = exe_path + strlen (exe_path);
1289 sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
1290 if (pdump_file_get (exe_path))
1292 if (pdump_load_check ())
1297 sprintf (w, "-%08x.dmp", dump_id);
1298 if (pdump_file_get (exe_path))
1300 if (pdump_load_check ())
1305 sprintf (w, ".dmp");
1306 if (pdump_file_get (exe_path))
1308 if (pdump_load_check ())
1315 while (w>exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && (*w != '.'));
1317 while (w>exe_path && !IS_DIRECTORY_SEP (*w));
1322 pdump_load (const char *argv0)
1324 char exe_path[PATH_MAX];
1326 GetModuleFileName (NULL, exe_path, PATH_MAX);
1327 #else /* !WIN32_NATIVE */
1329 const char *dir, *p;
1334 /* XEmacs as a login shell, oh goody! */
1335 dir = getenv ("SHELL");
1338 p = dir + strlen (dir);
1339 while (p != dir && !IS_ANY_SEP (p[-1])) p--;
1343 /* invocation-name includes a directory component -- presumably it
1344 is relative to cwd, not $PATH */
1345 strcpy (exe_path, dir);
1349 const char *path = getenv ("PATH");
1350 const char *name = p;
1354 while (*p && *p != SEPCHAR)
1363 memcpy (exe_path, path, p - path);
1364 w = exe_path + (p - path);
1366 if (!IS_DIRECTORY_SEP (w[-1]))
1372 /* ### #$%$#^$^@%$^#%@$ ! */
1377 if (!access (exe_path, X_OK))
1381 /* Oh well, let's have some kind of default */
1382 sprintf (exe_path, "./%s", name);
1388 #endif /* WIN32_NATIVE */
1390 if (pdump_file_try (exe_path))
1392 pdump_load_finish ();
1397 if (pdump_resource_get ())
1399 if (pdump_load_check ())
1401 pdump_load_finish ();