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;
249 #define PDUMP_HASHSIZE 200001
251 static pdump_entry_list_elmt **pdump_hash;
253 /* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
255 pdump_make_hash (const void *obj)
257 return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE;
260 static pdump_entry_list_elmt *
261 pdump_get_entry (const void *obj)
263 int pos = pdump_make_hash (obj);
264 pdump_entry_list_elmt *e;
268 while ((e = pdump_hash[pos]) != 0)
274 if (pos == PDUMP_HASHSIZE)
281 pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size, int count, int is_lrecord)
283 pdump_entry_list_elmt *e;
285 int pos = pdump_make_hash (obj);
287 while ((e = pdump_hash[pos]) != 0)
293 if (pos == PDUMP_HASHSIZE)
297 e = xnew (pdump_entry_list_elmt);
299 e->next = list->first;
303 e->is_lrecord = is_lrecord;
306 list->count += count;
309 align = pdump_align_table[size & 255];
310 if (align < 2 && is_lrecord)
313 if (align < list->align)
317 static pdump_entry_list *
318 pdump_get_entry_list (const struct struct_description *sdesc)
321 for (i=0; i<pdump_struct_table.count; i++)
322 if (pdump_struct_table.list[i].sdesc == sdesc)
323 return &pdump_struct_table.list[i].list;
325 if (pdump_struct_table.size <= pdump_struct_table.count)
327 if (pdump_struct_table.size == -1)
328 pdump_struct_table.size = 10;
330 pdump_struct_table.size = pdump_struct_table.size * 2;
331 pdump_struct_table.list = (pdump_struct_list_elmt *)
332 xrealloc (pdump_struct_table.list,
333 pdump_struct_table.size * sizeof (pdump_struct_list_elmt));
335 pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
336 pdump_struct_table.list[pdump_struct_table.count].list.align = 8;
337 pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
338 pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
340 return &pdump_struct_table.list[pdump_struct_table.count++].list;
345 struct lrecord_header *obj;
353 pdump_backtrace (void)
356 stderr_out ("pdump backtrace :\n");
357 for (i=0;i<depth;i++)
359 if (!backtrace[i].obj)
360 stderr_out (" - ind. (%d, %d)\n", backtrace[i].position, backtrace[i].offset);
363 stderr_out (" - %s (%d, %d)\n",
364 LHEADER_IMPLEMENTATION (backtrace[i].obj)->name,
365 backtrace[i].position,
366 backtrace[i].offset);
371 static void pdump_register_object (Lisp_Object obj);
372 static void pdump_register_struct (const void *data, const struct struct_description *sdesc, int count);
375 pdump_get_indirect_count (EMACS_INT code, const struct lrecord_description *idesc, const void *idata)
380 int line = XD_INDIRECT_VAL (code);
381 int delta = XD_INDIRECT_DELTA (code);
383 irdata = ((char *)idata) + idesc[line].offset;
384 switch (idesc[line].type)
387 count = *(size_t *)irdata;
390 count = *(int *)irdata;
393 count = *(long *)irdata;
396 count = *(Bytecount *)irdata;
399 stderr_out ("Unsupported count type : %d (line = %d, code=%ld)\n", idesc[line].type, line, (long)code);
408 pdump_register_sub (const void *data, const struct lrecord_description *desc, int me)
413 for (pos = 0; desc[pos].type != XD_END; pos++)
415 const void *rdata = (const char *)data + desc[pos].offset;
417 backtrace[me].position = pos;
418 backtrace[me].offset = desc[pos].offset;
420 switch (desc[pos].type)
422 case XD_SPECIFIER_END:
424 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
433 case XD_OPAQUE_DATA_PTR:
435 EMACS_INT count = desc[pos].data1;
436 if (XD_IS_INDIRECT (count))
437 count = pdump_get_indirect_count (count, desc, data);
439 pdump_add_entry (&pdump_opaque_data_list,
448 const char *str = *(const char **)rdata;
450 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
455 const char *str = *(const char **)rdata;
456 if ((EMACS_INT)str > 0)
457 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
462 const Lisp_Object *pobj = (const Lisp_Object *)rdata;
464 assert (desc[pos].data1 == 0);
466 backtrace[me].offset = (const char *)pobj - (const char *)data;
467 pdump_register_object (*pobj);
470 case XD_LISP_OBJECT_ARRAY:
473 EMACS_INT count = desc[pos].data1;
474 if (XD_IS_INDIRECT (count))
475 count = pdump_get_indirect_count (count, desc, data);
477 for (i = 0; i < count; i++)
479 const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i;
480 Lisp_Object dobj = *pobj;
482 backtrace[me].offset = (const char *)pobj - (const char *)data;
483 pdump_register_object (dobj);
489 EMACS_INT count = desc[pos].data1;
490 const struct struct_description *sdesc = desc[pos].data2;
491 const char *dobj = *(const char **)rdata;
494 if (XD_IS_INDIRECT (count))
495 count = pdump_get_indirect_count (count, desc, data);
497 pdump_register_struct (dobj, sdesc, count);
502 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
510 pdump_register_object (Lisp_Object obj)
512 struct lrecord_header *objh;
514 if (!POINTER_TYPE_P (XTYPE (obj)))
517 objh = XRECORD_LHEADER (obj);
521 if (pdump_get_entry (objh))
524 if (LHEADER_IMPLEMENTATION (objh)->description)
529 stderr_out ("Backtrace overflow, loop ?\n");
532 backtrace[me].obj = objh;
533 backtrace[me].position = 0;
534 backtrace[me].offset = 0;
536 pdump_add_entry (pdump_object_table + objh->type,
538 LHEADER_IMPLEMENTATION (objh)->static_size ?
539 LHEADER_IMPLEMENTATION (objh)->static_size :
540 LHEADER_IMPLEMENTATION (objh)->size_in_bytes_method (objh),
543 pdump_register_sub (objh,
544 LHEADER_IMPLEMENTATION (objh)->description,
550 pdump_alert_undump_object[objh->type]++;
551 stderr_out ("Undumpable object type : %s\n", LHEADER_IMPLEMENTATION (objh)->name);
557 pdump_register_struct (const void *data, const struct struct_description *sdesc, int count)
559 if (data && !pdump_get_entry (data))
565 stderr_out ("Backtrace overflow, loop ?\n");
568 backtrace[me].obj = 0;
569 backtrace[me].position = 0;
570 backtrace[me].offset = 0;
572 pdump_add_entry (pdump_get_entry_list (sdesc),
577 for (i=0; i<count; i++)
579 pdump_register_sub (((char *)data) + sdesc->size*i,
588 pdump_dump_data (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
590 size_t size = elmt->size;
591 int count = elmt->count;
595 memcpy (pdump_buf, elmt->obj, size*count);
597 for (i=0; i<count; i++)
599 char *cur = ((char *)pdump_buf) + i*size;
601 for (pos = 0; desc[pos].type != XD_END; pos++)
603 void *rdata = cur + desc[pos].offset;
604 switch (desc[pos].type)
606 case XD_SPECIFIER_END:
607 desc = ((const Lisp_Specifier *)(elmt->obj))->methods->extra_description;
616 EMACS_INT val = desc[pos].data1;
617 if (XD_IS_INDIRECT (val))
618 val = pdump_get_indirect_count (val, desc, elmt->obj);
622 case XD_OPAQUE_DATA_PTR:
626 void *ptr = *(void **)rdata;
628 *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset;
633 Lisp_Object obj = *(Lisp_Object *)rdata;
634 pdump_entry_list_elmt *elmt1;
637 elmt1 = pdump_get_entry (XRECORD_LHEADER (obj));
640 obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
642 *(EMACS_INT *)rdata = elmt1->save_offset;
647 Lisp_Object *pobj = (Lisp_Object *) rdata;
649 assert (desc[pos].data1 == 0);
651 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
653 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
656 case XD_LISP_OBJECT_ARRAY:
658 EMACS_INT num = desc[pos].data1;
660 if (XD_IS_INDIRECT (num))
661 num = pdump_get_indirect_count (num, desc, elmt->obj);
663 for (j=0; j<num; j++)
665 Lisp_Object *pobj = ((Lisp_Object *)rdata) + j;
666 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
668 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
674 EMACS_INT str = *(EMACS_INT *)rdata;
676 *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset;
680 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
686 write (pdump_fd, desc ? pdump_buf : elmt->obj, size*count);
687 if (elmt->is_lrecord && ((size*count) & 3))
688 write (pdump_fd, "\0\0\0", 4-((size*count) & 3));
692 pdump_reloc_one (void *data, EMACS_INT delta, const struct lrecord_description *desc)
697 for (pos = 0; desc[pos].type != XD_END; pos++)
699 void *rdata = (char *)data + desc[pos].offset;
700 switch (desc[pos].type)
702 case XD_SPECIFIER_END:
704 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
712 case XD_OPAQUE_DATA_PTR:
717 EMACS_INT ptr = *(EMACS_INT *)rdata;
719 *(EMACS_INT *)rdata = ptr+delta;
724 Lisp_Object *pobj = (Lisp_Object *) rdata;
726 assert (desc[pos].data1 == 0);
728 if (POINTER_TYPE_P (XTYPE (*pobj))
729 && ! EQ (*pobj, Qnull_pointer))
730 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
734 case XD_LISP_OBJECT_ARRAY:
736 EMACS_INT num = desc[pos].data1;
738 if (XD_IS_INDIRECT (num))
739 num = pdump_get_indirect_count (num, desc, data);
741 for (j=0; j<num; j++)
743 Lisp_Object *pobj = (Lisp_Object *) rdata + j;
745 if (POINTER_TYPE_P (XTYPE (*pobj))
746 && ! EQ (*pobj, Qnull_pointer))
747 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
753 EMACS_INT str = *(EMACS_INT *)rdata;
755 *(EMACS_INT *)rdata = str + delta;
759 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
766 pdump_allocate_offset (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
768 size_t size = (elmt->is_lrecord ? (elmt->size + 3) & ~3 : elmt->size)*elmt->count;
769 elmt->save_offset = cur_offset;
776 pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *, const struct lrecord_description *))
779 const struct lrecord_description *idesc;
780 pdump_entry_list_elmt *elmt;
781 for (align=8; align>=0; align--)
783 for (i=0; i<lrecord_type_count; i++)
784 if (pdump_object_table[i].align == align)
786 elmt = pdump_object_table[i].first;
789 idesc = lrecord_implementations_table[i]->description;
797 for (i=0; i<pdump_struct_table.count; i++)
798 if (pdump_struct_table.list[i].list.align == align)
800 elmt = pdump_struct_table.list[i].list.first;
801 idesc = pdump_struct_table.list[i].sdesc->description;
809 elmt = pdump_opaque_data_list.first;
812 if (pdump_align_table[elmt->size & 255] == align)
820 pdump_dump_from_root_struct_ptrs (void)
823 for (i = 0; i < Dynarr_length (pdump_root_struct_ptrs); i++)
826 pdump_root_struct_ptr *info = Dynarr_atp (pdump_root_struct_ptrs, i);
827 write (pdump_fd, &info->ptraddress, sizeof (info->ptraddress));
828 adr = pdump_get_entry (*(info->ptraddress))->save_offset;
829 write (pdump_fd, &adr, sizeof (adr));
834 pdump_dump_opaques (void)
837 for (i = 0; i < Dynarr_length (pdump_opaques); i++)
839 pdump_opaque *info = Dynarr_atp (pdump_opaques, i);
840 write (pdump_fd, info, sizeof (*info));
841 write (pdump_fd, info->varaddress, info->size);
846 pdump_dump_rtables (void)
849 pdump_entry_list_elmt *elmt;
850 pdump_reloc_table rt;
852 for (i=0; i<lrecord_type_count; i++)
854 elmt = pdump_object_table[i].first;
857 rt.desc = lrecord_implementations_table[i]->description;
858 rt.count = pdump_object_table[i].count;
859 write (pdump_fd, &rt, sizeof (rt));
862 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
863 write (pdump_fd, &rdata, sizeof (rdata));
870 write (pdump_fd, &rt, sizeof (rt));
872 for (i=0; i<pdump_struct_table.count; i++)
874 elmt = pdump_struct_table.list[i].list.first;
875 rt.desc = pdump_struct_table.list[i].sdesc->description;
876 rt.count = pdump_struct_table.list[i].list.count;
877 write (pdump_fd, &rt, sizeof (rt));
880 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
882 for (j=0; j<elmt->count; j++)
884 write (pdump_fd, &rdata, sizeof (rdata));
892 write (pdump_fd, &rt, sizeof (rt));
896 pdump_dump_from_root_objects (void)
898 size_t count = Dynarr_length (pdump_root_objects) + Dynarr_length (pdump_weak_object_chains);
901 write (pdump_fd, &count, sizeof (count));
903 for (i=0; i<Dynarr_length (pdump_root_objects); i++)
905 Lisp_Object obj = * Dynarr_at (pdump_root_objects, i);
906 if (POINTER_TYPE_P (XTYPE (obj)))
907 obj = wrap_object ((void *) pdump_get_entry (XRECORD_LHEADER (obj))->save_offset);
908 write (pdump_fd, Dynarr_atp (pdump_root_objects, i), sizeof (Dynarr_atp (pdump_root_objects, i)));
909 write (pdump_fd, &obj, sizeof (obj));
912 for (i=0; i<Dynarr_length (pdump_weak_object_chains); i++)
914 Lisp_Object obj = * Dynarr_at (pdump_weak_object_chains, i);
915 pdump_entry_list_elmt *elmt;
919 const struct lrecord_description *desc;
921 elmt = pdump_get_entry (XRECORD_LHEADER (obj));
924 desc = XRECORD_LHEADER_IMPLEMENTATION (obj)->description;
925 for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
926 assert (desc[pos].type != XD_END);
928 obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
930 obj = wrap_object ((void *) elmt->save_offset);
932 write (pdump_fd, Dynarr_atp (pdump_weak_object_chains, i), sizeof (Lisp_Object *));
933 write (pdump_fd, &obj, sizeof (obj));
941 Lisp_Object t_console, t_device, t_frame;
945 flush_all_buffer_local_cache ();
947 /* These appear in a DEFVAR_LISP, which does a staticpro() */
948 t_console = Vterminal_console; Vterminal_console = Qnil;
949 t_frame = Vterminal_frame; Vterminal_frame = Qnil;
950 t_device = Vterminal_device; Vterminal_device = Qnil;
952 dump_add_opaque (&lrecord_implementations_table,
953 lrecord_type_count * sizeof (lrecord_implementations_table[0]));
954 dump_add_opaque (&lrecord_markers,
955 lrecord_type_count * sizeof (lrecord_markers[0]));
957 pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE);
959 for (i=0; i<lrecord_type_count; i++)
961 pdump_object_table[i].first = 0;
962 pdump_object_table[i].align = 8;
963 pdump_object_table[i].count = 0;
964 pdump_alert_undump_object[i] = 0;
966 pdump_struct_table.count = 0;
967 pdump_struct_table.size = -1;
969 pdump_opaque_data_list.first = 0;
970 pdump_opaque_data_list.align = 8;
971 pdump_opaque_data_list.count = 0;
974 for (i=0; i<Dynarr_length (pdump_root_objects); i++)
975 pdump_register_object (* Dynarr_at (pdump_root_objects, i));
978 for (i=0; i<lrecord_type_count; i++)
979 if (pdump_alert_undump_object[i])
982 printf ("Undumpable types list :\n");
984 printf (" - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]);
989 for (i=0; i<Dynarr_length (pdump_root_struct_ptrs); i++)
991 pdump_root_struct_ptr info = Dynarr_at (pdump_root_struct_ptrs, i);
992 pdump_register_struct (*(info.ptraddress), info.desc, 1);
995 memcpy (hd.signature, PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN);
997 hd.reloc_address = 0;
998 hd.nb_root_struct_ptrs = Dynarr_length (pdump_root_struct_ptrs);
999 hd.nb_opaques = Dynarr_length (pdump_opaques);
1004 pdump_scan_by_alignment (pdump_allocate_offset);
1006 pdump_buf = xmalloc (max_size);
1007 /* Avoid use of the `open' macro. We want the real function. */
1009 pdump_fd = open (EMACS_PROGNAME ".dmp",
1010 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666);
1011 hd.stab_offset = (cur_offset + 3) & ~3;
1013 write (pdump_fd, &hd, sizeof (hd));
1014 lseek (pdump_fd, 256, SEEK_SET);
1016 pdump_scan_by_alignment (pdump_dump_data);
1018 lseek (pdump_fd, hd.stab_offset, SEEK_SET);
1020 pdump_dump_from_root_struct_ptrs ();
1021 pdump_dump_opaques ();
1022 pdump_dump_rtables ();
1023 pdump_dump_from_root_objects ();
1030 Vterminal_console = t_console;
1031 Vterminal_frame = t_frame;
1032 Vterminal_device = t_device;
1036 pdump_load_check (void)
1038 return (!memcmp (((pdump_header *)pdump_start)->signature,
1039 PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN)
1040 && ((pdump_header *)pdump_start)->id == dump_id);
1044 pdump_load_finish (void)
1051 pdump_end = pdump_start + pdump_length;
1053 #define PDUMP_READ(p, type) (p = (char*) (((type *) p) + 1), *((type *) p - 1))
1055 delta = ((EMACS_INT)pdump_start) - ((pdump_header *)pdump_start)->reloc_address;
1056 p = pdump_start + ((pdump_header *)pdump_start)->stab_offset;
1058 /* Put back the pdump_root_struct_ptrs */
1059 for (i=0; i<((pdump_header *)pdump_start)->nb_root_struct_ptrs; i++)
1061 void **adr = PDUMP_READ (p, void **);
1062 *adr = (void *) (PDUMP_READ (p, char *) + delta);
1065 /* Put back the pdump_opaques */
1066 for (i=0; i<((pdump_header *)pdump_start)->nb_opaques; i++)
1068 pdump_opaque info = PDUMP_READ (p, pdump_opaque);
1069 memcpy (info.varaddress, p, info.size);
1073 /* Do the relocations */
1078 pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1081 for (i=0; i < rt.count; i++)
1083 char *adr = delta + *(char **)p;
1085 pdump_reloc_one (adr, delta, rt.desc);
1086 p += sizeof (char *);
1093 /* Put the pdump_root_objects variables in place */
1094 for (i = PDUMP_READ (p, size_t); i; i--)
1096 Lisp_Object *var = PDUMP_READ (p, Lisp_Object *);
1097 Lisp_Object obj = PDUMP_READ (p, Lisp_Object);
1099 if (POINTER_TYPE_P (XTYPE (obj)))
1100 obj = wrap_object ((char *) XPNTR (obj) + delta);
1105 /* Final cleanups */
1106 /* reorganize hash tables */
1110 pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1113 if (rt.desc == hash_table_description)
1115 for (i=0; i < rt.count; i++)
1116 pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object));
1119 p += sizeof (Lisp_Object) * rt.count;
1126 /* Free the mapped file if we decide we don't want it after all */
1128 pdump_file_unmap (void)
1130 UnmapViewOfFile (pdump_start);
1131 CloseHandle (pdump_hFile);
1132 CloseHandle (pdump_hMap);
1136 pdump_file_get (const char *path)
1139 pdump_hFile = CreateFile (path,
1140 GENERIC_READ + GENERIC_WRITE, /* Required for copy on write */
1142 NULL, /* Not inheritable */
1144 FILE_ATTRIBUTE_NORMAL,
1145 NULL); /* No template file */
1146 if (pdump_hFile == INVALID_HANDLE_VALUE)
1149 pdump_length = GetFileSize (pdump_hFile, NULL);
1150 pdump_hMap = CreateFileMapping (pdump_hFile,
1151 NULL, /* No security attributes */
1152 PAGE_WRITECOPY, /* Copy on write */
1153 0, /* Max size, high half */
1154 0, /* Max size, low half */
1155 NULL); /* Unnamed */
1156 if (pdump_hMap == INVALID_HANDLE_VALUE)
1159 pdump_start = MapViewOfFile (pdump_hMap,
1160 FILE_MAP_COPY, /* Copy on write */
1161 0, /* Start at zero */
1163 0); /* Map all of it */
1164 pdump_free = pdump_file_unmap;
1168 /* pdump_resource_free is called (via the pdump_free pointer) to release
1169 any resources allocated by pdump_resource_get. Since the Windows API
1170 specs specifically state that you don't need to (and shouldn't) free the
1171 resources allocated by FindResource, LoadResource, and LockResource this
1172 routine does nothing. */
1174 pdump_resource_free (void)
1179 pdump_resource_get (void)
1181 HRSRC hRes; /* Handle to dump resource */
1182 HRSRC hResLoad; /* Handle to loaded dump resource */
1184 /* See Q126630 which describes how Windows NT and 95 trap writes to
1185 resource sections and duplicate the page to allow the write to proceed.
1186 It also describes how to make the resource section read/write (and hence
1187 private to each process). Doing this avoids the exceptions and related
1188 overhead, but causes the resource section to be private to each process
1189 that is running XEmacs. Since the resource section contains little
1190 other than the dumped data, which should be private to each process, we
1191 make the whole resource section read/write so we don't have to copy it. */
1193 hRes = FindResource (NULL, MAKEINTRESOURCE(101), "DUMP");
1197 /* Found it, use the data in the resource */
1198 hResLoad = LoadResource (NULL, hRes);
1199 if (hResLoad == NULL)
1202 pdump_start = LockResource (hResLoad);
1203 if (pdump_start == NULL)
1206 pdump_free = pdump_resource_free;
1207 pdump_length = SizeofResource (NULL, hRes);
1208 if (pdump_length <= sizeof (pdump_header))
1217 #else /* !WIN32_NATIVE */
1219 static void *pdump_mallocadr;
1222 pdump_file_free (void)
1224 xfree (pdump_mallocadr);
1229 pdump_file_unmap (void)
1231 munmap (pdump_start, pdump_length);
1236 pdump_file_get (const char *path)
1238 int fd = open (path, O_RDONLY | OPEN_BINARY);
1242 pdump_length = lseek (fd, 0, SEEK_END);
1243 if (pdump_length < sizeof (pdump_header))
1249 lseek (fd, 0, SEEK_SET);
1252 pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1253 if (pdump_start != (char *) MAP_FAILED)
1255 pdump_free = pdump_file_unmap;
1261 pdump_mallocadr = xmalloc (pdump_length+255);
1262 pdump_free = pdump_file_free;
1263 pdump_start = (char *)((255 + (unsigned long)pdump_mallocadr) & ~255);
1264 read (fd, pdump_start, pdump_length);
1269 #endif /* !WIN32_NATIVE */
1273 pdump_file_try (char *exe_path)
1277 w = exe_path + strlen (exe_path);
1280 sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
1281 if (pdump_file_get (exe_path))
1283 if (pdump_load_check ())
1288 sprintf (w, "-%08x.dmp", dump_id);
1289 if (pdump_file_get (exe_path))
1291 if (pdump_load_check ())
1296 sprintf (w, ".dmp");
1297 if (pdump_file_get (exe_path))
1299 if (pdump_load_check ())
1306 while (w>exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && (*w != '.'));
1308 while (w>exe_path && !IS_DIRECTORY_SEP (*w));
1313 pdump_load (const char *argv0)
1315 char exe_path[PATH_MAX];
1317 GetModuleFileName (NULL, exe_path, PATH_MAX);
1318 #else /* !WIN32_NATIVE */
1320 const char *dir, *p;
1325 /* XEmacs as a login shell, oh goody! */
1326 dir = getenv ("SHELL");
1329 p = dir + strlen (dir);
1330 while (p != dir && !IS_ANY_SEP (p[-1])) p--;
1334 /* invocation-name includes a directory component -- presumably it
1335 is relative to cwd, not $PATH */
1336 strcpy (exe_path, dir);
1340 const char *path = getenv ("PATH");
1341 const char *name = p;
1345 while (*p && *p != SEPCHAR)
1354 memcpy (exe_path, path, p - path);
1355 w = exe_path + (p - path);
1357 if (!IS_DIRECTORY_SEP (w[-1]))
1363 /* ### #$%$#^$^@%$^#%@$ ! */
1368 if (!access (exe_path, X_OK))
1372 /* Oh well, let's have some kind of default */
1373 sprintf (exe_path, "./%s", name);
1379 #endif /* WIN32_NATIVE */
1381 if (pdump_file_try (exe_path))
1383 pdump_load_finish ();
1388 if (pdump_resource_get ())
1390 if (pdump_load_check ())
1392 pdump_load_finish ();