1 /* Portable data dumper for XEmacs.
2 Copyright (C) 1999-2000 Olivier Galibert
3 Copyright (C) 2001 Martin Buchholz
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
28 #include "specifier.h"
31 #include "console-stream.h"
54 Dynarr_declare (pdump_opaque);
55 } pdump_opaque_dynarr;
60 const struct struct_description *desc;
61 } pdump_root_struct_ptr;
65 Dynarr_declare (pdump_root_struct_ptr);
66 } pdump_root_struct_ptr_dynarr;
72 } pdump_static_Lisp_Object;
76 char **address; /* char * for ease of doing relocation */
78 } pdump_static_pointer;
80 static pdump_opaque_dynarr *pdump_opaques;
81 static pdump_root_struct_ptr_dynarr *pdump_root_struct_ptrs;
82 static Lisp_Object_ptr_dynarr *pdump_root_objects;
83 static Lisp_Object_ptr_dynarr *pdump_weak_object_chains;
85 /* Mark SIZE bytes at non-heap address VARADDRESS for dumping as is,
86 without any bit-twiddling. */
88 dump_add_opaque (void *varaddress, size_t size)
91 info.varaddress = varaddress;
93 if (pdump_opaques == NULL)
94 pdump_opaques = Dynarr_new (pdump_opaque);
95 Dynarr_add (pdump_opaques, info);
98 /* Mark the struct described by DESC and pointed to by the pointer at
99 non-heap address VARADDRESS for dumping.
100 All the objects reachable from this pointer will also be dumped. */
102 dump_add_root_struct_ptr (void *ptraddress, const struct struct_description *desc)
104 pdump_root_struct_ptr info;
105 info.ptraddress = (void **) ptraddress;
107 if (pdump_root_struct_ptrs == NULL)
108 pdump_root_struct_ptrs = Dynarr_new (pdump_root_struct_ptr);
109 Dynarr_add (pdump_root_struct_ptrs, info);
112 /* Mark the Lisp_Object at non-heap address VARADDRESS for dumping.
113 All the objects reachable from this var will also be dumped. */
115 dump_add_root_object (Lisp_Object *varaddress)
117 if (pdump_root_objects == NULL)
118 pdump_root_objects = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
119 Dynarr_add (pdump_root_objects, varaddress);
122 /* Mark the list pointed to by the Lisp_Object at VARADDRESS for dumping. */
124 dump_add_weak_object_chain (Lisp_Object *varaddress)
126 if (pdump_weak_object_chains == NULL)
127 pdump_weak_object_chains = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
128 Dynarr_add (pdump_weak_object_chains, varaddress);
133 pdump_align_stream (FILE *stream, size_t alignment)
135 long offset = ftell (stream);
136 long adjustment = ALIGN_SIZE (offset, alignment) - offset;
138 fseek (stream, adjustment, SEEK_CUR);
141 #define PDUMP_ALIGN_OUTPUT(type) pdump_align_stream (pdump_out, ALIGNOF (type))
143 #define PDUMP_WRITE(type, object) \
144 fwrite (&object, sizeof (object), 1, pdump_out);
146 #define PDUMP_WRITE_ALIGNED(type, object) do { \
147 PDUMP_ALIGN_OUTPUT (type); \
148 PDUMP_WRITE (type, object); \
151 #define PDUMP_READ(ptr, type) \
152 (((type *) (ptr = (char*) (((type *) ptr) + 1)))[-1])
154 #define PDUMP_READ_ALIGNED(ptr, type) \
155 ((ptr = (char *) ALIGN_PTR (ptr, ALIGNOF (type))), PDUMP_READ (ptr, type))
161 const struct lrecord_description *desc;
165 static char *pdump_rt_list = 0;
168 pdump_objects_unmark (void)
171 char *p = pdump_rt_list;
175 pdump_reloc_table *rt = (pdump_reloc_table *)p;
176 p += sizeof (pdump_reloc_table);
179 for (i=0; i<rt->count; i++)
181 struct lrecord_header *lh = * (struct lrecord_header **) p;
182 if (! C_READONLY_RECORD_HEADER_P (lh))
183 UNMARK_RECORD_HEADER (lh);
184 p += sizeof (EMACS_INT);
192 /* The structure of the file
195 stab_offset - nb_root_struct_ptrs*pair(void *, adr)
196 for pointers to structures
197 - nb_opaques*pair(void *, size) for raw bits to restore
199 - root lisp object address/value couples with the count
204 #define PDUMP_SIGNATURE "XEmacsDP"
205 #define PDUMP_SIGNATURE_LEN (sizeof (PDUMP_SIGNATURE) - 1)
209 char signature[PDUMP_SIGNATURE_LEN];
211 EMACS_UINT stab_offset;
212 EMACS_UINT reloc_address;
213 int nb_root_struct_ptrs;
219 static size_t pdump_length;
222 /* Handle for the dump file */
223 static HANDLE pdump_hFile = INVALID_HANDLE_VALUE;
224 /* Handle for the file mapping object for the dump file */
225 static HANDLE pdump_hMap = INVALID_HANDLE_VALUE;
228 static void (*pdump_free) (void);
230 static const unsigned char pdump_align_table[256] =
232 8, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
233 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
234 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
235 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
236 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
237 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
238 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
239 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
240 7, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
241 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
242 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
243 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
244 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
245 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
246 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
247 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0
250 typedef struct pdump_entry_list_elmt
252 struct pdump_entry_list_elmt *next;
256 EMACS_INT save_offset;
257 } pdump_entry_list_elmt;
261 pdump_entry_list_elmt *first;
266 typedef struct pdump_struct_list_elmt
268 pdump_entry_list list;
269 const struct struct_description *sdesc;
270 } pdump_struct_list_elmt;
274 pdump_struct_list_elmt *list;
279 static pdump_entry_list pdump_object_table[256];
280 static pdump_entry_list pdump_opaque_data_list;
281 static pdump_struct_list pdump_struct_table;
283 static int pdump_alert_undump_object[256];
285 static unsigned long cur_offset;
286 static size_t max_size;
288 static void *pdump_buf;
289 static FILE *pdump_out;
292 #define PDUMP_HASHSIZE 20000001
294 #define PDUMP_HASHSIZE 200001
297 static pdump_entry_list_elmt **pdump_hash;
299 /* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
301 pdump_make_hash (const void *obj)
303 return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE;
306 static pdump_entry_list_elmt *
307 pdump_get_entry (const void *obj)
309 int pos = pdump_make_hash (obj);
310 pdump_entry_list_elmt *e;
314 while ((e = pdump_hash[pos]) != 0)
320 if (pos == PDUMP_HASHSIZE)
327 pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size,
330 pdump_entry_list_elmt *e;
332 int pos = pdump_make_hash (obj);
334 while ((e = pdump_hash[pos]) != 0)
340 if (pos == PDUMP_HASHSIZE)
344 e = xnew (pdump_entry_list_elmt);
346 e->next = list->first;
352 list->count += count;
355 align = pdump_align_table[size & 255];
357 if (align < list->align)
361 static pdump_entry_list *
362 pdump_get_entry_list (const struct struct_description *sdesc)
365 for (i=0; i<pdump_struct_table.count; i++)
366 if (pdump_struct_table.list[i].sdesc == sdesc)
367 return &pdump_struct_table.list[i].list;
369 if (pdump_struct_table.size <= pdump_struct_table.count)
371 if (pdump_struct_table.size == -1)
372 pdump_struct_table.size = 10;
374 pdump_struct_table.size = pdump_struct_table.size * 2;
375 pdump_struct_table.list = (pdump_struct_list_elmt *)
376 xrealloc (pdump_struct_table.list,
377 pdump_struct_table.size * sizeof (pdump_struct_list_elmt));
379 pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
380 pdump_struct_table.list[pdump_struct_table.count].list.align = 8;
381 pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
382 pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
384 return &pdump_struct_table.list[pdump_struct_table.count++].list;
389 struct lrecord_header *obj;
397 pdump_backtrace (void)
400 stderr_out ("pdump backtrace :\n");
401 for (i=0;i<depth;i++)
403 if (!backtrace[i].obj)
404 stderr_out (" - ind. (%d, %d)\n",
405 backtrace[i].position,
406 backtrace[i].offset);
409 stderr_out (" - %s (%d, %d)\n",
410 LHEADER_IMPLEMENTATION (backtrace[i].obj)->name,
411 backtrace[i].position,
412 backtrace[i].offset);
417 static void pdump_register_object (Lisp_Object obj);
418 static void pdump_register_struct (const void *data,
419 const struct struct_description *sdesc,
423 pdump_get_indirect_count (EMACS_INT code,
424 const struct lrecord_description *idesc,
430 int line = XD_INDIRECT_VAL (code);
431 int delta = XD_INDIRECT_DELTA (code);
433 irdata = ((char *)idata) + idesc[line].offset;
434 switch (idesc[line].type)
437 count = *(size_t *)irdata;
440 count = *(int *)irdata;
443 count = *(long *)irdata;
446 count = *(Bytecount *)irdata;
449 stderr_out ("Unsupported count type : %d (line = %d, code=%ld)\n",
450 idesc[line].type, line, (long)code);
459 pdump_register_sub (const void *data, const struct lrecord_description *desc, int me)
464 for (pos = 0; desc[pos].type != XD_END; pos++)
466 const void *rdata = (const char *)data + desc[pos].offset;
468 backtrace[me].position = pos;
469 backtrace[me].offset = desc[pos].offset;
471 switch (desc[pos].type)
473 case XD_SPECIFIER_END:
475 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
484 case XD_OPAQUE_DATA_PTR:
486 EMACS_INT count = desc[pos].data1;
487 if (XD_IS_INDIRECT (count))
488 count = pdump_get_indirect_count (count, desc, data);
490 pdump_add_entry (&pdump_opaque_data_list,
491 *(void **)rdata, count, 1);
496 const char *str = *(const char **)rdata;
498 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1);
503 const char *str = *(const char **)rdata;
504 if ((EMACS_INT)str > 0)
505 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1);
510 const Lisp_Object *pobj = (const Lisp_Object *)rdata;
512 assert (desc[pos].data1 == 0);
514 backtrace[me].offset = (const char *)pobj - (const char *)data;
515 pdump_register_object (*pobj);
518 case XD_LISP_OBJECT_ARRAY:
521 EMACS_INT count = desc[pos].data1;
522 if (XD_IS_INDIRECT (count))
523 count = pdump_get_indirect_count (count, desc, data);
525 for (i = 0; i < count; i++)
527 const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i;
528 Lisp_Object dobj = *pobj;
530 backtrace[me].offset = (const char *)pobj - (const char *)data;
531 pdump_register_object (dobj);
537 EMACS_INT count = desc[pos].data1;
538 const struct struct_description *sdesc = desc[pos].data2;
539 const char *dobj = *(const char **)rdata;
542 if (XD_IS_INDIRECT (count))
543 count = pdump_get_indirect_count (count, desc, data);
545 pdump_register_struct (dobj, sdesc, count);
550 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
558 pdump_register_object (Lisp_Object obj)
560 struct lrecord_header *objh;
561 const struct lrecord_implementation *imp;
563 if (!POINTER_TYPE_P (XTYPE (obj)))
566 objh = XRECORD_LHEADER (obj);
570 if (pdump_get_entry (objh))
573 imp = LHEADER_IMPLEMENTATION (objh);
575 if (imp->description)
580 stderr_out ("Backtrace overflow, loop ?\n");
583 backtrace[me].obj = objh;
584 backtrace[me].position = 0;
585 backtrace[me].offset = 0;
587 pdump_add_entry (pdump_object_table + objh->type,
591 imp->size_in_bytes_method (objh),
593 pdump_register_sub (objh, imp->description, me);
598 pdump_alert_undump_object[objh->type]++;
599 stderr_out ("Undumpable object type : %s\n", imp->name);
605 pdump_register_struct (const void *data,
606 const struct struct_description *sdesc,
609 if (data && !pdump_get_entry (data))
615 stderr_out ("Backtrace overflow, loop ?\n");
618 backtrace[me].obj = 0;
619 backtrace[me].position = 0;
620 backtrace[me].offset = 0;
622 pdump_add_entry (pdump_get_entry_list (sdesc),
623 data, sdesc->size, count);
624 for (i=0; i<count; i++)
626 pdump_register_sub (((char *)data) + sdesc->size*i,
635 pdump_dump_data (pdump_entry_list_elmt *elmt,
636 const struct lrecord_description *desc)
638 size_t size = elmt->size;
639 int count = elmt->count;
643 memcpy (pdump_buf, elmt->obj, size*count);
645 for (i=0; i<count; i++)
647 char *cur = ((char *)pdump_buf) + i*size;
649 for (pos = 0; desc[pos].type != XD_END; pos++)
651 void *rdata = cur + desc[pos].offset;
652 switch (desc[pos].type)
654 case XD_SPECIFIER_END:
655 desc = ((const Lisp_Specifier *)(elmt->obj))->methods->extra_description;
664 EMACS_INT val = desc[pos].data1;
665 if (XD_IS_INDIRECT (val))
666 val = pdump_get_indirect_count (val, desc, elmt->obj);
670 case XD_OPAQUE_DATA_PTR:
674 void *ptr = *(void **)rdata;
676 *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset;
681 Lisp_Object obj = *(Lisp_Object *)rdata;
682 pdump_entry_list_elmt *elmt1;
685 elmt1 = pdump_get_entry (XRECORD_LHEADER (obj));
688 obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
690 *(EMACS_INT *)rdata = elmt1->save_offset;
695 Lisp_Object *pobj = (Lisp_Object *) rdata;
697 assert (desc[pos].data1 == 0);
699 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
701 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
704 case XD_LISP_OBJECT_ARRAY:
706 EMACS_INT num = desc[pos].data1;
708 if (XD_IS_INDIRECT (num))
709 num = pdump_get_indirect_count (num, desc, elmt->obj);
711 for (j=0; j<num; j++)
713 Lisp_Object *pobj = ((Lisp_Object *)rdata) + j;
714 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
716 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
722 EMACS_INT str = *(EMACS_INT *)rdata;
724 *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset;
728 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
734 fwrite (desc ? pdump_buf : elmt->obj, size, count, pdump_out);
738 pdump_reloc_one (void *data, EMACS_INT delta,
739 const struct lrecord_description *desc)
744 for (pos = 0; desc[pos].type != XD_END; pos++)
746 void *rdata = (char *)data + desc[pos].offset;
747 switch (desc[pos].type)
749 case XD_SPECIFIER_END:
751 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
759 case XD_OPAQUE_DATA_PTR:
764 EMACS_INT ptr = *(EMACS_INT *)rdata;
766 *(EMACS_INT *)rdata = ptr+delta;
771 Lisp_Object *pobj = (Lisp_Object *) rdata;
773 assert (desc[pos].data1 == 0);
775 if (POINTER_TYPE_P (XTYPE (*pobj))
776 && ! EQ (*pobj, Qnull_pointer))
777 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
781 case XD_LISP_OBJECT_ARRAY:
783 EMACS_INT num = desc[pos].data1;
785 if (XD_IS_INDIRECT (num))
786 num = pdump_get_indirect_count (num, desc, data);
788 for (j=0; j<num; j++)
790 Lisp_Object *pobj = (Lisp_Object *) rdata + j;
792 if (POINTER_TYPE_P (XTYPE (*pobj))
793 && ! EQ (*pobj, Qnull_pointer))
794 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
800 EMACS_INT str = *(EMACS_INT *)rdata;
802 *(EMACS_INT *)rdata = str + delta;
806 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
813 pdump_allocate_offset (pdump_entry_list_elmt *elmt,
814 const struct lrecord_description *desc)
816 size_t size = elmt->count * elmt->size;
817 elmt->save_offset = cur_offset;
824 pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *,
825 const struct lrecord_description *))
828 const struct lrecord_description *idesc;
829 pdump_entry_list_elmt *elmt;
830 for (align=8; align>=0; align--)
832 for (i=0; i<lrecord_type_count; i++)
833 if (pdump_object_table[i].align == align)
835 elmt = pdump_object_table[i].first;
838 idesc = lrecord_implementations_table[i]->description;
846 for (i=0; i<pdump_struct_table.count; i++)
847 if (pdump_struct_table.list[i].list.align == align)
849 elmt = pdump_struct_table.list[i].list.first;
850 idesc = pdump_struct_table.list[i].sdesc->description;
858 elmt = pdump_opaque_data_list.first;
861 if (pdump_align_table[elmt->size & 255] == align)
869 pdump_dump_root_struct_ptrs (void)
872 size_t count = Dynarr_length (pdump_root_struct_ptrs);
873 pdump_static_pointer *data = alloca_array (pdump_static_pointer, count);
874 for (i = 0; i < count; i++)
876 data[i].address = (char **) Dynarr_atp (pdump_root_struct_ptrs, i)->ptraddress;
877 data[i].value = (char *) pdump_get_entry (* data[i].address)->save_offset;
879 PDUMP_ALIGN_OUTPUT (pdump_static_pointer);
880 fwrite (data, sizeof (pdump_static_pointer), count, pdump_out);
884 pdump_dump_opaques (void)
887 for (i = 0; i < Dynarr_length (pdump_opaques); i++)
889 pdump_opaque *info = Dynarr_atp (pdump_opaques, i);
890 PDUMP_WRITE_ALIGNED (pdump_opaque, *info);
891 fwrite (info->varaddress, info->size, 1, pdump_out);
896 pdump_dump_rtables (void)
899 pdump_entry_list_elmt *elmt;
900 pdump_reloc_table rt;
902 for (i=0; i<lrecord_type_count; i++)
904 elmt = pdump_object_table[i].first;
907 rt.desc = lrecord_implementations_table[i]->description;
908 rt.count = pdump_object_table[i].count;
909 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt);
912 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
913 PDUMP_WRITE_ALIGNED (EMACS_INT, rdata);
920 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt);
922 for (i=0; i<pdump_struct_table.count; i++)
924 elmt = pdump_struct_table.list[i].list.first;
925 rt.desc = pdump_struct_table.list[i].sdesc->description;
926 rt.count = pdump_struct_table.list[i].list.count;
927 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt);
930 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
932 for (j=0; j<elmt->count; j++)
934 PDUMP_WRITE_ALIGNED (EMACS_INT, rdata);
942 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt);
946 pdump_dump_root_objects (void)
948 size_t count = (Dynarr_length (pdump_root_objects) +
949 Dynarr_length (pdump_weak_object_chains));
952 PDUMP_WRITE_ALIGNED (size_t, count);
953 PDUMP_ALIGN_OUTPUT (pdump_static_Lisp_Object);
955 for (i=0; i<Dynarr_length (pdump_root_objects); i++)
957 pdump_static_Lisp_Object obj;
958 obj.address = Dynarr_at (pdump_root_objects, i);
959 obj.value = * obj.address;
961 if (POINTER_TYPE_P (XTYPE (obj.value)))
962 obj.value = wrap_object ((void *) pdump_get_entry (XRECORD_LHEADER (obj.value))->save_offset);
964 PDUMP_WRITE (pdump_static_Lisp_Object, obj);
967 for (i=0; i<Dynarr_length (pdump_weak_object_chains); i++)
969 pdump_entry_list_elmt *elmt;
970 pdump_static_Lisp_Object obj;
972 obj.address = Dynarr_at (pdump_weak_object_chains, i);
973 obj.value = * obj.address;
977 const struct lrecord_description *desc;
979 elmt = pdump_get_entry (XRECORD_LHEADER (obj.value));
982 desc = XRECORD_LHEADER_IMPLEMENTATION (obj.value)->description;
983 for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
984 assert (desc[pos].type != XD_END);
986 obj.value = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj.value)));
988 obj.value = wrap_object ((void *) elmt->save_offset);
990 PDUMP_WRITE (pdump_static_Lisp_Object, obj);
998 Lisp_Object t_console, t_device, t_frame;
1000 pdump_header header;
1002 flush_all_buffer_local_cache ();
1004 /* These appear in a DEFVAR_LISP, which does a staticpro() */
1005 t_console = Vterminal_console; Vterminal_console = Qnil;
1006 t_frame = Vterminal_frame; Vterminal_frame = Qnil;
1007 t_device = Vterminal_device; Vterminal_device = Qnil;
1009 dump_add_opaque (&lrecord_implementations_table,
1010 lrecord_type_count * sizeof (lrecord_implementations_table[0]));
1011 dump_add_opaque (&lrecord_markers,
1012 lrecord_type_count * sizeof (lrecord_markers[0]));
1014 pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE);
1016 for (i=0; i<lrecord_type_count; i++)
1018 pdump_object_table[i].first = 0;
1019 pdump_object_table[i].align = 8;
1020 pdump_object_table[i].count = 0;
1021 pdump_alert_undump_object[i] = 0;
1023 pdump_struct_table.count = 0;
1024 pdump_struct_table.size = -1;
1026 pdump_opaque_data_list.first = 0;
1027 pdump_opaque_data_list.align = 8;
1028 pdump_opaque_data_list.count = 0;
1031 for (i=0; i<Dynarr_length (pdump_root_objects); i++)
1032 pdump_register_object (* Dynarr_at (pdump_root_objects, i));
1035 for (i=0; i<lrecord_type_count; i++)
1036 if (pdump_alert_undump_object[i])
1039 printf ("Undumpable types list :\n");
1041 printf (" - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]);
1046 for (i=0; i<Dynarr_length (pdump_root_struct_ptrs); i++)
1048 pdump_root_struct_ptr info = Dynarr_at (pdump_root_struct_ptrs, i);
1049 pdump_register_struct (*(info.ptraddress), info.desc, 1);
1052 memcpy (header.signature, PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN);
1053 header.id = dump_id;
1054 header.reloc_address = 0;
1055 header.nb_root_struct_ptrs = Dynarr_length (pdump_root_struct_ptrs);
1056 header.nb_opaques = Dynarr_length (pdump_opaques);
1058 cur_offset = ALIGN_SIZE (sizeof (header), ALIGNOF (max_align_t));
1061 pdump_scan_by_alignment (pdump_allocate_offset);
1062 cur_offset = ALIGN_SIZE (cur_offset, ALIGNOF (max_align_t));
1063 header.stab_offset = cur_offset;
1065 pdump_buf = xmalloc (max_size);
1066 /* Avoid use of the `open' macro. We want the real function. */
1068 pdump_fd = open (EMACS_PROGNAME ".dmp",
1069 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666);
1070 pdump_out = fdopen (pdump_fd, "w");
1072 fwrite (&header, sizeof (header), 1, pdump_out);
1073 PDUMP_ALIGN_OUTPUT (max_align_t);
1075 pdump_scan_by_alignment (pdump_dump_data);
1077 fseek (pdump_out, header.stab_offset, SEEK_SET);
1079 pdump_dump_root_struct_ptrs ();
1080 pdump_dump_opaques ();
1081 pdump_dump_rtables ();
1082 pdump_dump_root_objects ();
1091 Vterminal_console = t_console;
1092 Vterminal_frame = t_frame;
1093 Vterminal_device = t_device;
1097 pdump_load_check (void)
1099 return (!memcmp (((pdump_header *)pdump_start)->signature,
1100 PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN)
1101 && ((pdump_header *)pdump_start)->id == dump_id);
1104 /*----------------------------------------------------------------------*/
1105 /* Reading the dump file */
1106 /*----------------------------------------------------------------------*/
1108 pdump_load_finish (void)
1114 pdump_header *header = (pdump_header *)pdump_start;
1116 pdump_end = pdump_start + pdump_length;
1118 delta = ((EMACS_INT)pdump_start) - header->reloc_address;
1119 p = pdump_start + header->stab_offset;
1121 /* Put back the pdump_root_struct_ptrs */
1122 p = (char *) ALIGN_PTR (p, ALIGNOF (pdump_static_pointer));
1123 for (i=0; i<header->nb_root_struct_ptrs; i++)
1125 pdump_static_pointer ptr = PDUMP_READ (p, pdump_static_pointer);
1126 (* ptr.address) = ptr.value + delta;
1129 /* Put back the pdump_opaques */
1130 for (i=0; i<header->nb_opaques; i++)
1132 pdump_opaque info = PDUMP_READ_ALIGNED (p, pdump_opaque);
1133 memcpy (info.varaddress, p, info.size);
1137 /* Do the relocations */
1142 pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table);
1143 p = (char *) ALIGN_PTR (p, ALIGNOF (char *));
1146 char **reloc = (char **)p;
1147 for (i=0; i < rt.count; i++)
1150 pdump_reloc_one (reloc[i], delta, rt.desc);
1152 p += rt.count * sizeof (char *);
1158 /* Put the pdump_root_objects variables in place */
1159 i = PDUMP_READ_ALIGNED (p, size_t);
1160 p = (char *) ALIGN_PTR (p, ALIGNOF (pdump_static_Lisp_Object));
1163 pdump_static_Lisp_Object obj = PDUMP_READ (p, pdump_static_Lisp_Object);
1165 if (POINTER_TYPE_P (XTYPE (obj.value)))
1166 obj.value = wrap_object ((char *) XPNTR (obj.value) + delta);
1168 (* obj.address) = obj.value;
1171 /* Final cleanups */
1172 /* reorganize hash tables */
1176 pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table);
1177 p = (char *) ALIGN_PTR (p, ALIGNOF (Lisp_Object));
1180 if (rt.desc == hash_table_description)
1182 for (i=0; i < rt.count; i++)
1183 pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object));
1186 p += sizeof (Lisp_Object) * rt.count;
1193 /* Free the mapped file if we decide we don't want it after all */
1195 pdump_file_unmap (void)
1197 UnmapViewOfFile (pdump_start);
1198 CloseHandle (pdump_hFile);
1199 CloseHandle (pdump_hMap);
1203 pdump_file_get (const char *path)
1206 pdump_hFile = CreateFile (path,
1207 GENERIC_READ + GENERIC_WRITE, /* Required for copy on write */
1209 NULL, /* Not inheritable */
1211 FILE_ATTRIBUTE_NORMAL,
1212 NULL); /* No template file */
1213 if (pdump_hFile == INVALID_HANDLE_VALUE)
1216 pdump_length = GetFileSize (pdump_hFile, NULL);
1217 pdump_hMap = CreateFileMapping (pdump_hFile,
1218 NULL, /* No security attributes */
1219 PAGE_WRITECOPY, /* Copy on write */
1220 0, /* Max size, high half */
1221 0, /* Max size, low half */
1222 NULL); /* Unnamed */
1223 if (pdump_hMap == INVALID_HANDLE_VALUE)
1226 pdump_start = MapViewOfFile (pdump_hMap,
1227 FILE_MAP_COPY, /* Copy on write */
1228 0, /* Start at zero */
1230 0); /* Map all of it */
1231 pdump_free = pdump_file_unmap;
1235 /* pdump_resource_free is called (via the pdump_free pointer) to release
1236 any resources allocated by pdump_resource_get. Since the Windows API
1237 specs specifically state that you don't need to (and shouldn't) free the
1238 resources allocated by FindResource, LoadResource, and LockResource this
1239 routine does nothing. */
1241 pdump_resource_free (void)
1246 pdump_resource_get (void)
1248 HRSRC hRes; /* Handle to dump resource */
1249 HRSRC hResLoad; /* Handle to loaded dump resource */
1251 /* See Q126630 which describes how Windows NT and 95 trap writes to
1252 resource sections and duplicate the page to allow the write to proceed.
1253 It also describes how to make the resource section read/write (and hence
1254 private to each process). Doing this avoids the exceptions and related
1255 overhead, but causes the resource section to be private to each process
1256 that is running XEmacs. Since the resource section contains little
1257 other than the dumped data, which should be private to each process, we
1258 make the whole resource section read/write so we don't have to copy it. */
1260 hRes = FindResource (NULL, MAKEINTRESOURCE(101), "DUMP");
1264 /* Found it, use the data in the resource */
1265 hResLoad = LoadResource (NULL, hRes);
1266 if (hResLoad == NULL)
1269 pdump_start = LockResource (hResLoad);
1270 if (pdump_start == NULL)
1273 pdump_free = pdump_resource_free;
1274 pdump_length = SizeofResource (NULL, hRes);
1275 if (pdump_length <= sizeof (pdump_header))
1284 #else /* !WIN32_NATIVE */
1286 static void *pdump_mallocadr;
1289 pdump_file_free (void)
1291 xfree (pdump_mallocadr);
1296 pdump_file_unmap (void)
1298 munmap (pdump_start, pdump_length);
1303 pdump_file_get (const char *path)
1305 int fd = open (path, O_RDONLY | OPEN_BINARY);
1309 pdump_length = lseek (fd, 0, SEEK_END);
1310 if (pdump_length < sizeof (pdump_header))
1316 lseek (fd, 0, SEEK_SET);
1319 /* Unix 98 requires that sys/mman.h define MAP_FAILED,
1320 but many earlier implementations don't. */
1322 # define MAP_FAILED ((void *) -1L)
1324 pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1325 if (pdump_start != (char *) MAP_FAILED)
1327 pdump_free = pdump_file_unmap;
1331 #endif /* HAVE_MMAP */
1333 pdump_mallocadr = xmalloc (pdump_length+255);
1334 pdump_free = pdump_file_free;
1335 pdump_start = (char *)((255 + (unsigned long)pdump_mallocadr) & ~255);
1336 read (fd, pdump_start, pdump_length);
1341 #endif /* !WIN32_NATIVE */
1345 pdump_file_try (char *exe_path)
1349 w = exe_path + strlen (exe_path);
1352 sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
1353 if (pdump_file_get (exe_path))
1355 if (pdump_load_check ())
1360 sprintf (w, "-%08x.dmp", dump_id);
1361 if (pdump_file_get (exe_path))
1363 if (pdump_load_check ())
1368 sprintf (w, ".dmp");
1369 if (pdump_file_get (exe_path))
1371 if (pdump_load_check ())
1378 while (w>exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && (*w != '.'));
1380 while (w>exe_path && !IS_DIRECTORY_SEP (*w));
1385 pdump_load (const char *argv0)
1387 char exe_path[PATH_MAX];
1389 GetModuleFileName (NULL, exe_path, PATH_MAX);
1390 #else /* !WIN32_NATIVE */
1392 const char *dir, *p;
1397 /* XEmacs as a login shell, oh goody! */
1398 dir = getenv ("SHELL");
1401 p = dir + strlen (dir);
1402 while (p != dir && !IS_ANY_SEP (p[-1])) p--;
1406 /* invocation-name includes a directory component -- presumably it
1407 is relative to cwd, not $PATH */
1408 strcpy (exe_path, dir);
1412 const char *path = getenv ("PATH");
1413 const char *name = p;
1417 while (*p && *p != SEPCHAR)
1426 memcpy (exe_path, path, p - path);
1427 w = exe_path + (p - path);
1429 if (!IS_DIRECTORY_SEP (w[-1]))
1435 /* ### #$%$#^$^@%$^#%@$ ! */
1440 if (!access (exe_path, X_OK))
1444 /* Oh well, let's have some kind of default */
1445 sprintf (exe_path, "./%s", name);
1451 #endif /* WIN32_NATIVE */
1453 if (pdump_file_try (exe_path))
1455 pdump_load_finish ();
1460 if (pdump_resource_get ())
1462 if (pdump_load_check ())
1464 pdump_load_finish ();