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;
291 #define PDUMP_HASHSIZE 200001
293 static pdump_entry_list_elmt **pdump_hash;
295 /* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
297 pdump_make_hash (const void *obj)
299 return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE;
302 static pdump_entry_list_elmt *
303 pdump_get_entry (const void *obj)
305 int pos = pdump_make_hash (obj);
306 pdump_entry_list_elmt *e;
310 while ((e = pdump_hash[pos]) != 0)
316 if (pos == PDUMP_HASHSIZE)
323 pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size,
326 pdump_entry_list_elmt *e;
328 int pos = pdump_make_hash (obj);
330 while ((e = pdump_hash[pos]) != 0)
336 if (pos == PDUMP_HASHSIZE)
340 e = xnew (pdump_entry_list_elmt);
342 e->next = list->first;
348 list->count += count;
351 align = pdump_align_table[size & 255];
353 if (align < list->align)
357 static pdump_entry_list *
358 pdump_get_entry_list (const struct struct_description *sdesc)
361 for (i=0; i<pdump_struct_table.count; i++)
362 if (pdump_struct_table.list[i].sdesc == sdesc)
363 return &pdump_struct_table.list[i].list;
365 if (pdump_struct_table.size <= pdump_struct_table.count)
367 if (pdump_struct_table.size == -1)
368 pdump_struct_table.size = 10;
370 pdump_struct_table.size = pdump_struct_table.size * 2;
371 pdump_struct_table.list = (pdump_struct_list_elmt *)
372 xrealloc (pdump_struct_table.list,
373 pdump_struct_table.size * sizeof (pdump_struct_list_elmt));
375 pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
376 pdump_struct_table.list[pdump_struct_table.count].list.align = 8;
377 pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
378 pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
380 return &pdump_struct_table.list[pdump_struct_table.count++].list;
385 struct lrecord_header *obj;
393 pdump_backtrace (void)
396 stderr_out ("pdump backtrace :\n");
397 for (i=0;i<depth;i++)
399 if (!backtrace[i].obj)
400 stderr_out (" - ind. (%d, %d)\n",
401 backtrace[i].position,
402 backtrace[i].offset);
405 stderr_out (" - %s (%d, %d)\n",
406 LHEADER_IMPLEMENTATION (backtrace[i].obj)->name,
407 backtrace[i].position,
408 backtrace[i].offset);
413 static void pdump_register_object (Lisp_Object obj);
414 static void pdump_register_struct (const void *data,
415 const struct struct_description *sdesc,
419 pdump_get_indirect_count (EMACS_INT code,
420 const struct lrecord_description *idesc,
426 int line = XD_INDIRECT_VAL (code);
427 int delta = XD_INDIRECT_DELTA (code);
429 irdata = ((char *)idata) + idesc[line].offset;
430 switch (idesc[line].type)
433 count = *(size_t *)irdata;
436 count = *(int *)irdata;
439 count = *(long *)irdata;
442 count = *(Bytecount *)irdata;
445 stderr_out ("Unsupported count type : %d (line = %d, code=%ld)\n",
446 idesc[line].type, line, (long)code);
455 pdump_register_sub (const void *data, const struct lrecord_description *desc, int me)
460 for (pos = 0; desc[pos].type != XD_END; pos++)
462 const void *rdata = (const char *)data + desc[pos].offset;
464 backtrace[me].position = pos;
465 backtrace[me].offset = desc[pos].offset;
467 switch (desc[pos].type)
469 case XD_SPECIFIER_END:
471 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
480 case XD_OPAQUE_DATA_PTR:
482 EMACS_INT count = desc[pos].data1;
483 if (XD_IS_INDIRECT (count))
484 count = pdump_get_indirect_count (count, desc, data);
486 pdump_add_entry (&pdump_opaque_data_list,
487 *(void **)rdata, count, 1);
492 const char *str = *(const char **)rdata;
494 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1);
499 const char *str = *(const char **)rdata;
500 if ((EMACS_INT)str > 0)
501 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1);
506 const Lisp_Object *pobj = (const Lisp_Object *)rdata;
508 assert (desc[pos].data1 == 0);
510 backtrace[me].offset = (const char *)pobj - (const char *)data;
511 pdump_register_object (*pobj);
514 case XD_LISP_OBJECT_ARRAY:
517 EMACS_INT count = desc[pos].data1;
518 if (XD_IS_INDIRECT (count))
519 count = pdump_get_indirect_count (count, desc, data);
521 for (i = 0; i < count; i++)
523 const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i;
524 Lisp_Object dobj = *pobj;
526 backtrace[me].offset = (const char *)pobj - (const char *)data;
527 pdump_register_object (dobj);
533 EMACS_INT count = desc[pos].data1;
534 const struct struct_description *sdesc = desc[pos].data2;
535 const char *dobj = *(const char **)rdata;
538 if (XD_IS_INDIRECT (count))
539 count = pdump_get_indirect_count (count, desc, data);
541 pdump_register_struct (dobj, sdesc, count);
546 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
554 pdump_register_object (Lisp_Object obj)
556 struct lrecord_header *objh;
557 const struct lrecord_implementation *imp;
559 if (!POINTER_TYPE_P (XTYPE (obj)))
562 objh = XRECORD_LHEADER (obj);
566 if (pdump_get_entry (objh))
569 imp = LHEADER_IMPLEMENTATION (objh);
571 if (imp->description)
576 stderr_out ("Backtrace overflow, loop ?\n");
579 backtrace[me].obj = objh;
580 backtrace[me].position = 0;
581 backtrace[me].offset = 0;
583 pdump_add_entry (pdump_object_table + objh->type,
587 imp->size_in_bytes_method (objh),
589 pdump_register_sub (objh, imp->description, me);
594 pdump_alert_undump_object[objh->type]++;
595 stderr_out ("Undumpable object type : %s\n", imp->name);
601 pdump_register_struct (const void *data,
602 const struct struct_description *sdesc,
605 if (data && !pdump_get_entry (data))
611 stderr_out ("Backtrace overflow, loop ?\n");
614 backtrace[me].obj = 0;
615 backtrace[me].position = 0;
616 backtrace[me].offset = 0;
618 pdump_add_entry (pdump_get_entry_list (sdesc),
619 data, sdesc->size, count);
620 for (i=0; i<count; i++)
622 pdump_register_sub (((char *)data) + sdesc->size*i,
631 pdump_dump_data (pdump_entry_list_elmt *elmt,
632 const struct lrecord_description *desc)
634 size_t size = elmt->size;
635 int count = elmt->count;
639 memcpy (pdump_buf, elmt->obj, size*count);
641 for (i=0; i<count; i++)
643 char *cur = ((char *)pdump_buf) + i*size;
645 for (pos = 0; desc[pos].type != XD_END; pos++)
647 void *rdata = cur + desc[pos].offset;
648 switch (desc[pos].type)
650 case XD_SPECIFIER_END:
651 desc = ((const Lisp_Specifier *)(elmt->obj))->methods->extra_description;
660 EMACS_INT val = desc[pos].data1;
661 if (XD_IS_INDIRECT (val))
662 val = pdump_get_indirect_count (val, desc, elmt->obj);
666 case XD_OPAQUE_DATA_PTR:
670 void *ptr = *(void **)rdata;
672 *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset;
677 Lisp_Object obj = *(Lisp_Object *)rdata;
678 pdump_entry_list_elmt *elmt1;
681 elmt1 = pdump_get_entry (XRECORD_LHEADER (obj));
684 obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
686 *(EMACS_INT *)rdata = elmt1->save_offset;
691 Lisp_Object *pobj = (Lisp_Object *) rdata;
693 assert (desc[pos].data1 == 0);
695 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
697 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
700 case XD_LISP_OBJECT_ARRAY:
702 EMACS_INT num = desc[pos].data1;
704 if (XD_IS_INDIRECT (num))
705 num = pdump_get_indirect_count (num, desc, elmt->obj);
707 for (j=0; j<num; j++)
709 Lisp_Object *pobj = ((Lisp_Object *)rdata) + j;
710 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
712 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
718 EMACS_INT str = *(EMACS_INT *)rdata;
720 *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset;
724 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
730 fwrite (desc ? pdump_buf : elmt->obj, size, count, pdump_out);
734 pdump_reloc_one (void *data, EMACS_INT delta,
735 const struct lrecord_description *desc)
740 for (pos = 0; desc[pos].type != XD_END; pos++)
742 void *rdata = (char *)data + desc[pos].offset;
743 switch (desc[pos].type)
745 case XD_SPECIFIER_END:
747 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
755 case XD_OPAQUE_DATA_PTR:
760 EMACS_INT ptr = *(EMACS_INT *)rdata;
762 *(EMACS_INT *)rdata = ptr+delta;
767 Lisp_Object *pobj = (Lisp_Object *) rdata;
769 assert (desc[pos].data1 == 0);
771 if (POINTER_TYPE_P (XTYPE (*pobj))
772 && ! EQ (*pobj, Qnull_pointer))
773 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
777 case XD_LISP_OBJECT_ARRAY:
779 EMACS_INT num = desc[pos].data1;
781 if (XD_IS_INDIRECT (num))
782 num = pdump_get_indirect_count (num, desc, data);
784 for (j=0; j<num; j++)
786 Lisp_Object *pobj = (Lisp_Object *) rdata + j;
788 if (POINTER_TYPE_P (XTYPE (*pobj))
789 && ! EQ (*pobj, Qnull_pointer))
790 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
796 EMACS_INT str = *(EMACS_INT *)rdata;
798 *(EMACS_INT *)rdata = str + delta;
802 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
809 pdump_allocate_offset (pdump_entry_list_elmt *elmt,
810 const struct lrecord_description *desc)
812 size_t size = elmt->count * elmt->size;
813 elmt->save_offset = cur_offset;
820 pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *,
821 const struct lrecord_description *))
824 const struct lrecord_description *idesc;
825 pdump_entry_list_elmt *elmt;
826 for (align=8; align>=0; align--)
828 for (i=0; i<lrecord_type_count; i++)
829 if (pdump_object_table[i].align == align)
831 elmt = pdump_object_table[i].first;
834 idesc = lrecord_implementations_table[i]->description;
842 for (i=0; i<pdump_struct_table.count; i++)
843 if (pdump_struct_table.list[i].list.align == align)
845 elmt = pdump_struct_table.list[i].list.first;
846 idesc = pdump_struct_table.list[i].sdesc->description;
854 elmt = pdump_opaque_data_list.first;
857 if (pdump_align_table[elmt->size & 255] == align)
865 pdump_dump_root_struct_ptrs (void)
868 size_t count = Dynarr_length (pdump_root_struct_ptrs);
869 pdump_static_pointer *data = alloca_array (pdump_static_pointer, count);
870 for (i = 0; i < count; i++)
872 data[i].address = (char **) Dynarr_atp (pdump_root_struct_ptrs, i)->ptraddress;
873 data[i].value = (char *) pdump_get_entry (* data[i].address)->save_offset;
875 PDUMP_ALIGN_OUTPUT (pdump_static_pointer);
876 fwrite (data, sizeof (pdump_static_pointer), count, pdump_out);
880 pdump_dump_opaques (void)
883 for (i = 0; i < Dynarr_length (pdump_opaques); i++)
885 pdump_opaque *info = Dynarr_atp (pdump_opaques, i);
886 PDUMP_WRITE_ALIGNED (pdump_opaque, *info);
887 fwrite (info->varaddress, info->size, 1, pdump_out);
892 pdump_dump_rtables (void)
895 pdump_entry_list_elmt *elmt;
896 pdump_reloc_table rt;
898 for (i=0; i<lrecord_type_count; i++)
900 elmt = pdump_object_table[i].first;
903 rt.desc = lrecord_implementations_table[i]->description;
904 rt.count = pdump_object_table[i].count;
905 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt);
908 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
909 PDUMP_WRITE_ALIGNED (EMACS_INT, rdata);
916 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt);
918 for (i=0; i<pdump_struct_table.count; i++)
920 elmt = pdump_struct_table.list[i].list.first;
921 rt.desc = pdump_struct_table.list[i].sdesc->description;
922 rt.count = pdump_struct_table.list[i].list.count;
923 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt);
926 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
928 for (j=0; j<elmt->count; j++)
930 PDUMP_WRITE_ALIGNED (EMACS_INT, rdata);
938 PDUMP_WRITE_ALIGNED (pdump_reloc_table, rt);
942 pdump_dump_root_objects (void)
944 size_t count = (Dynarr_length (pdump_root_objects) +
945 Dynarr_length (pdump_weak_object_chains));
948 PDUMP_WRITE_ALIGNED (size_t, count);
949 PDUMP_ALIGN_OUTPUT (pdump_static_Lisp_Object);
951 for (i=0; i<Dynarr_length (pdump_root_objects); i++)
953 pdump_static_Lisp_Object obj;
954 obj.address = Dynarr_at (pdump_root_objects, i);
955 obj.value = * obj.address;
957 if (POINTER_TYPE_P (XTYPE (obj.value)))
958 obj.value = wrap_object ((void *) pdump_get_entry (XRECORD_LHEADER (obj.value))->save_offset);
960 PDUMP_WRITE (pdump_static_Lisp_Object, obj);
963 for (i=0; i<Dynarr_length (pdump_weak_object_chains); i++)
965 pdump_entry_list_elmt *elmt;
966 pdump_static_Lisp_Object obj;
968 obj.address = Dynarr_at (pdump_weak_object_chains, i);
969 obj.value = * obj.address;
973 const struct lrecord_description *desc;
975 elmt = pdump_get_entry (XRECORD_LHEADER (obj.value));
978 desc = XRECORD_LHEADER_IMPLEMENTATION (obj.value)->description;
979 for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
980 assert (desc[pos].type != XD_END);
982 obj.value = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj.value)));
984 obj.value = wrap_object ((void *) elmt->save_offset);
986 PDUMP_WRITE (pdump_static_Lisp_Object, obj);
994 Lisp_Object t_console, t_device, t_frame;
998 flush_all_buffer_local_cache ();
1000 /* These appear in a DEFVAR_LISP, which does a staticpro() */
1001 t_console = Vterminal_console; Vterminal_console = Qnil;
1002 t_frame = Vterminal_frame; Vterminal_frame = Qnil;
1003 t_device = Vterminal_device; Vterminal_device = Qnil;
1005 dump_add_opaque (&lrecord_implementations_table,
1006 lrecord_type_count * sizeof (lrecord_implementations_table[0]));
1007 dump_add_opaque (&lrecord_markers,
1008 lrecord_type_count * sizeof (lrecord_markers[0]));
1010 pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE);
1012 for (i=0; i<lrecord_type_count; i++)
1014 pdump_object_table[i].first = 0;
1015 pdump_object_table[i].align = 8;
1016 pdump_object_table[i].count = 0;
1017 pdump_alert_undump_object[i] = 0;
1019 pdump_struct_table.count = 0;
1020 pdump_struct_table.size = -1;
1022 pdump_opaque_data_list.first = 0;
1023 pdump_opaque_data_list.align = 8;
1024 pdump_opaque_data_list.count = 0;
1027 for (i=0; i<Dynarr_length (pdump_root_objects); i++)
1028 pdump_register_object (* Dynarr_at (pdump_root_objects, i));
1031 for (i=0; i<lrecord_type_count; i++)
1032 if (pdump_alert_undump_object[i])
1035 printf ("Undumpable types list :\n");
1037 printf (" - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]);
1042 for (i=0; i<Dynarr_length (pdump_root_struct_ptrs); i++)
1044 pdump_root_struct_ptr info = Dynarr_at (pdump_root_struct_ptrs, i);
1045 pdump_register_struct (*(info.ptraddress), info.desc, 1);
1048 memcpy (header.signature, PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN);
1049 header.id = dump_id;
1050 header.reloc_address = 0;
1051 header.nb_root_struct_ptrs = Dynarr_length (pdump_root_struct_ptrs);
1052 header.nb_opaques = Dynarr_length (pdump_opaques);
1054 cur_offset = ALIGN_SIZE (sizeof (header), ALIGNOF (max_align_t));
1057 pdump_scan_by_alignment (pdump_allocate_offset);
1058 cur_offset = ALIGN_SIZE (cur_offset, ALIGNOF (max_align_t));
1059 header.stab_offset = cur_offset;
1061 pdump_buf = xmalloc (max_size);
1062 /* Avoid use of the `open' macro. We want the real function. */
1064 pdump_fd = open (EMACS_PROGNAME ".dmp",
1065 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666);
1066 pdump_out = fdopen (pdump_fd, "w");
1068 fwrite (&header, sizeof (header), 1, pdump_out);
1069 PDUMP_ALIGN_OUTPUT (max_align_t);
1071 pdump_scan_by_alignment (pdump_dump_data);
1073 fseek (pdump_out, header.stab_offset, SEEK_SET);
1075 pdump_dump_root_struct_ptrs ();
1076 pdump_dump_opaques ();
1077 pdump_dump_rtables ();
1078 pdump_dump_root_objects ();
1087 Vterminal_console = t_console;
1088 Vterminal_frame = t_frame;
1089 Vterminal_device = t_device;
1093 pdump_load_check (void)
1095 return (!memcmp (((pdump_header *)pdump_start)->signature,
1096 PDUMP_SIGNATURE, PDUMP_SIGNATURE_LEN)
1097 && ((pdump_header *)pdump_start)->id == dump_id);
1100 /*----------------------------------------------------------------------*/
1101 /* Reading the dump file */
1102 /*----------------------------------------------------------------------*/
1104 pdump_load_finish (void)
1110 pdump_header *header = (pdump_header *)pdump_start;
1112 pdump_end = pdump_start + pdump_length;
1114 delta = ((EMACS_INT)pdump_start) - header->reloc_address;
1115 p = pdump_start + header->stab_offset;
1117 /* Put back the pdump_root_struct_ptrs */
1118 p = (char *) ALIGN_PTR (p, ALIGNOF (pdump_static_pointer));
1119 for (i=0; i<header->nb_root_struct_ptrs; i++)
1121 pdump_static_pointer ptr = PDUMP_READ (p, pdump_static_pointer);
1122 (* ptr.address) = ptr.value + delta;
1125 /* Put back the pdump_opaques */
1126 for (i=0; i<header->nb_opaques; i++)
1128 pdump_opaque info = PDUMP_READ_ALIGNED (p, pdump_opaque);
1129 memcpy (info.varaddress, p, info.size);
1133 /* Do the relocations */
1138 pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table);
1139 p = (char *) ALIGN_PTR (p, ALIGNOF (char *));
1142 char **reloc = (char **)p;
1143 for (i=0; i < rt.count; i++)
1146 pdump_reloc_one (reloc[i], delta, rt.desc);
1148 p += rt.count * sizeof (char *);
1154 /* Put the pdump_root_objects variables in place */
1155 i = PDUMP_READ_ALIGNED (p, size_t);
1156 p = (char *) ALIGN_PTR (p, ALIGNOF (pdump_static_Lisp_Object));
1159 pdump_static_Lisp_Object obj = PDUMP_READ (p, pdump_static_Lisp_Object);
1161 if (POINTER_TYPE_P (XTYPE (obj.value)))
1162 obj.value = wrap_object ((char *) XPNTR (obj.value) + delta);
1164 (* obj.address) = obj.value;
1167 /* Final cleanups */
1168 /* reorganize hash tables */
1172 pdump_reloc_table rt = PDUMP_READ_ALIGNED (p, pdump_reloc_table);
1173 p = (char *) ALIGN_PTR (p, ALIGNOF (Lisp_Object));
1176 if (rt.desc == hash_table_description)
1178 for (i=0; i < rt.count; i++)
1179 pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object));
1182 p += sizeof (Lisp_Object) * rt.count;
1189 /* Free the mapped file if we decide we don't want it after all */
1191 pdump_file_unmap (void)
1193 UnmapViewOfFile (pdump_start);
1194 CloseHandle (pdump_hFile);
1195 CloseHandle (pdump_hMap);
1199 pdump_file_get (const char *path)
1202 pdump_hFile = CreateFile (path,
1203 GENERIC_READ + GENERIC_WRITE, /* Required for copy on write */
1205 NULL, /* Not inheritable */
1207 FILE_ATTRIBUTE_NORMAL,
1208 NULL); /* No template file */
1209 if (pdump_hFile == INVALID_HANDLE_VALUE)
1212 pdump_length = GetFileSize (pdump_hFile, NULL);
1213 pdump_hMap = CreateFileMapping (pdump_hFile,
1214 NULL, /* No security attributes */
1215 PAGE_WRITECOPY, /* Copy on write */
1216 0, /* Max size, high half */
1217 0, /* Max size, low half */
1218 NULL); /* Unnamed */
1219 if (pdump_hMap == INVALID_HANDLE_VALUE)
1222 pdump_start = MapViewOfFile (pdump_hMap,
1223 FILE_MAP_COPY, /* Copy on write */
1224 0, /* Start at zero */
1226 0); /* Map all of it */
1227 pdump_free = pdump_file_unmap;
1231 /* pdump_resource_free is called (via the pdump_free pointer) to release
1232 any resources allocated by pdump_resource_get. Since the Windows API
1233 specs specifically state that you don't need to (and shouldn't) free the
1234 resources allocated by FindResource, LoadResource, and LockResource this
1235 routine does nothing. */
1237 pdump_resource_free (void)
1242 pdump_resource_get (void)
1244 HRSRC hRes; /* Handle to dump resource */
1245 HRSRC hResLoad; /* Handle to loaded dump resource */
1247 /* See Q126630 which describes how Windows NT and 95 trap writes to
1248 resource sections and duplicate the page to allow the write to proceed.
1249 It also describes how to make the resource section read/write (and hence
1250 private to each process). Doing this avoids the exceptions and related
1251 overhead, but causes the resource section to be private to each process
1252 that is running XEmacs. Since the resource section contains little
1253 other than the dumped data, which should be private to each process, we
1254 make the whole resource section read/write so we don't have to copy it. */
1256 hRes = FindResource (NULL, MAKEINTRESOURCE(101), "DUMP");
1260 /* Found it, use the data in the resource */
1261 hResLoad = LoadResource (NULL, hRes);
1262 if (hResLoad == NULL)
1265 pdump_start = LockResource (hResLoad);
1266 if (pdump_start == NULL)
1269 pdump_free = pdump_resource_free;
1270 pdump_length = SizeofResource (NULL, hRes);
1271 if (pdump_length <= sizeof (pdump_header))
1280 #else /* !WIN32_NATIVE */
1282 static void *pdump_mallocadr;
1285 pdump_file_free (void)
1287 xfree (pdump_mallocadr);
1292 pdump_file_unmap (void)
1294 munmap (pdump_start, pdump_length);
1299 pdump_file_get (const char *path)
1301 int fd = open (path, O_RDONLY | OPEN_BINARY);
1305 pdump_length = lseek (fd, 0, SEEK_END);
1306 if (pdump_length < sizeof (pdump_header))
1312 lseek (fd, 0, SEEK_SET);
1315 /* Unix 98 requires that sys/mman.h define MAP_FAILED,
1316 but many earlier implementations don't. */
1318 # define MAP_FAILED ((void *) -1L)
1320 pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1321 if (pdump_start != (char *) MAP_FAILED)
1323 pdump_free = pdump_file_unmap;
1327 #endif /* HAVE_MMAP */
1329 pdump_mallocadr = xmalloc (pdump_length+255);
1330 pdump_free = pdump_file_free;
1331 pdump_start = (char *)((255 + (unsigned long)pdump_mallocadr) & ~255);
1332 read (fd, pdump_start, pdump_length);
1337 #endif /* !WIN32_NATIVE */
1341 pdump_file_try (char *exe_path)
1345 w = exe_path + strlen (exe_path);
1348 sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
1349 if (pdump_file_get (exe_path))
1351 if (pdump_load_check ())
1356 sprintf (w, "-%08x.dmp", dump_id);
1357 if (pdump_file_get (exe_path))
1359 if (pdump_load_check ())
1364 sprintf (w, ".dmp");
1365 if (pdump_file_get (exe_path))
1367 if (pdump_load_check ())
1374 while (w>exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && (*w != '.'));
1376 while (w>exe_path && !IS_DIRECTORY_SEP (*w));
1381 pdump_load (const char *argv0)
1383 char exe_path[PATH_MAX];
1385 GetModuleFileName (NULL, exe_path, PATH_MAX);
1386 #else /* !WIN32_NATIVE */
1388 const char *dir, *p;
1393 /* XEmacs as a login shell, oh goody! */
1394 dir = getenv ("SHELL");
1397 p = dir + strlen (dir);
1398 while (p != dir && !IS_ANY_SEP (p[-1])) p--;
1402 /* invocation-name includes a directory component -- presumably it
1403 is relative to cwd, not $PATH */
1404 strcpy (exe_path, dir);
1408 const char *path = getenv ("PATH");
1409 const char *name = p;
1413 while (*p && *p != SEPCHAR)
1422 memcpy (exe_path, path, p - path);
1423 w = exe_path + (p - path);
1425 if (!IS_DIRECTORY_SEP (w[-1]))
1431 /* ### #$%$#^$^@%$^#%@$ ! */
1436 if (!access (exe_path, X_OK))
1440 /* Oh well, let's have some kind of default */
1441 sprintf (exe_path, "./%s", name);
1447 #endif /* WIN32_NATIVE */
1449 if (pdump_file_try (exe_path))
1451 pdump_load_finish ();
1456 if (pdump_resource_get ())
1458 if (pdump_load_check ())
1460 pdump_load_finish ();