Mercurial > hg > xemacs-beta

comparison src/dumper.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents
children 1ccc32a20af4
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
1 /* Portable data dumper for XEmacs.
2 Copyright (C) 1999-2000 Olivier Galibert
3
4 This file is part of XEmacs.
5
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
9 later version.
10
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
14 for more details.
15
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. */
20
21 /* Synched up with: Not in FSF. */
22
23 #include <config.h>
24 #include "lisp.h"
25
26 #include "dump-id.h"
27 #include "specifier.h"
28 #include "alloc.h"
29 #include "elhash.h"
30 #include "sysfile.h"
31 #include "console-stream.h"
32 #include "dumper.h"
33
34 #ifdef WIN32_NATIVE
35 #include "nt.h"
36 #else
37 #ifdef HAVE_MMAP
38 #include <sys/mman.h>
39 #endif
40 #endif
41
42 #ifndef SEPCHAR
43 #define SEPCHAR ':'
44 #endif
45
46 typedef struct
47 {
48 const struct lrecord_description *desc;
49 int count;
50 } pdump_reloc_table;
51
52 static char *pdump_rt_list = 0;
53
54 void
55 pdump_objects_unmark (void)
56 {
57 int i;
58 char *p = pdump_rt_list;
59 if (p)
60 for (;;)
61 {
62 pdump_reloc_table *rt = (pdump_reloc_table *)p;
63 p += sizeof (pdump_reloc_table);
64 if (rt->desc)
65 {
66 for (i=0; i<rt->count; i++)
67 {
68 struct lrecord_header *lh = * (struct lrecord_header **) p;
69 if (! C_READONLY_RECORD_HEADER_P (lh))
70 UNMARK_RECORD_HEADER (lh);
71 p += sizeof (EMACS_INT);
72 }
73 } else
74 break;
75 }
76 }
77
78
79 /* The structure of the file
80 *
81 * 0 - header
82 * 256 - dumped objects
83 * stab_offset - nb_staticpro*(Lisp_Object *) from staticvec
84 * - nb_staticpro*(relocated Lisp_Object) pointed to by staticpro
85 * - nb_structdmp*pair(void *, adr) for pointers to structures
86 * - lrecord_implementations_table[]
87 * - relocation table
88 * - wired variable address/value couples with the count preceding the list
89 */
90
91
92 #define DUMP_SIGNATURE "XEmacsDP"
93 #define DUMP_SIGNATURE_LEN (sizeof (DUMP_SIGNATURE) - 1)
94
95 typedef struct
96 {
97 char signature[DUMP_SIGNATURE_LEN];
98 unsigned int id;
99 EMACS_UINT stab_offset;
100 EMACS_UINT reloc_address;
101 int nb_staticpro;
102 int nb_structdmp;
103 int nb_opaquedmp;
104 } dump_header;
105
106 char *pdump_start, *pdump_end;
107 static size_t pdump_length;
108
109 #ifdef WIN32_NATIVE
110 // Handle for the dump file
111 HANDLE pdump_hFile = INVALID_HANDLE_VALUE;
112 // Handle for the file mapping object for the dump file
113 HANDLE pdump_hMap = INVALID_HANDLE_VALUE;
114 #endif
115
116 void (*pdump_free) (void);
117
118 static const unsigned char align_table[256] =
119 {
120 8, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
121 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
122 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
123 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
124 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
125 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
126 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
127 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
128 7, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
129 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
130 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
131 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
132 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
133 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
134 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
135 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0
136 };
137
138 typedef struct pdump_entry_list_elmt
139 {
140 struct pdump_entry_list_elmt *next;
141 const void *obj;
142 size_t size;
143 int count;
144 int is_lrecord;
145 EMACS_INT save_offset;
146 } pdump_entry_list_elmt;
147
148 typedef struct
149 {
150 pdump_entry_list_elmt *first;
151 int align;
152 int count;
153 } pdump_entry_list;
154
155 typedef struct pdump_struct_list_elmt
156 {
157 pdump_entry_list list;
158 const struct struct_description *sdesc;
159 } pdump_struct_list_elmt;
160
161 typedef struct
162 {
163 pdump_struct_list_elmt *list;
164 int count;
165 int size;
166 } pdump_struct_list;
167
168 static pdump_entry_list pdump_object_table[256];
169 static pdump_entry_list pdump_opaque_data_list;
170 static pdump_struct_list pdump_struct_table;
171 static pdump_entry_list_elmt *pdump_qnil;
172
173 static int pdump_alert_undump_object[256];
174
175 static unsigned long cur_offset;
176 static size_t max_size;
177 static int pdump_fd;
178 static void *pdump_buf;
179
180 #define PDUMP_HASHSIZE 200001
181
182 static pdump_entry_list_elmt **pdump_hash;
183
184 /* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
185 static int
186 pdump_make_hash (const void *obj)
187 {
188 return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE;
189 }
190
191 static pdump_entry_list_elmt *
192 pdump_get_entry (const void *obj)
193 {
194 int pos = pdump_make_hash (obj);
195 pdump_entry_list_elmt *e;
196
197 assert (obj != 0);
198
199 while ((e = pdump_hash[pos]) != 0)
200 {
201 if (e->obj == obj)
202 return e;
203
204 pos++;
205 if (pos == PDUMP_HASHSIZE)
206 pos = 0;
207 }
208 return 0;
209 }
210
211 static void
212 pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size, int count, int is_lrecord)
213 {
214 pdump_entry_list_elmt *e;
215 int align;
216 int pos = pdump_make_hash (obj);
217
218 while ((e = pdump_hash[pos]) != 0)
219 {
220 if (e->obj == obj)
221 return;
222
223 pos++;
224 if (pos == PDUMP_HASHSIZE)
225 pos = 0;
226 }
227
228 e = xnew (pdump_entry_list_elmt);
229
230 e->next = list->first;
231 e->obj = obj;
232 e->size = size;
233 e->count = count;
234 e->is_lrecord = is_lrecord;
235 list->first = e;
236
237 list->count += count;
238 pdump_hash[pos] = e;
239
240 align = align_table[size & 255];
241 if (align < 2 && is_lrecord)
242 align = 2;
243
244 if (align < list->align)
245 list->align = align;
246 }
247
248 static pdump_entry_list *
249 pdump_get_entry_list (const struct struct_description *sdesc)
250 {
251 int i;
252 for (i=0; i<pdump_struct_table.count; i++)
253 if (pdump_struct_table.list[i].sdesc == sdesc)
254 return &pdump_struct_table.list[i].list;
255
256 if (pdump_struct_table.size <= pdump_struct_table.count)
257 {
258 if (pdump_struct_table.size == -1)
259 pdump_struct_table.size = 10;
260 else
261 pdump_struct_table.size = pdump_struct_table.size * 2;
262 pdump_struct_table.list = (pdump_struct_list_elmt *)
263 xrealloc (pdump_struct_table.list,
264 pdump_struct_table.size * sizeof (pdump_struct_list_elmt));
265 }
266 pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
267 pdump_struct_table.list[pdump_struct_table.count].list.align = 8;
268 pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
269 pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
270
271 return &pdump_struct_table.list[pdump_struct_table.count++].list;
272 }
273
274 static struct
275 {
276 struct lrecord_header *obj;
277 int position;
278 int offset;
279 } backtrace[65536];
280
281 static int depth;
282
283 static void pdump_backtrace (void)
284 {
285 int i;
286 stderr_out ("pdump backtrace :\n");
287 for (i=0;i<depth;i++)
288 {
289 if (!backtrace[i].obj)
290 stderr_out (" - ind. (%d, %d)\n", backtrace[i].position, backtrace[i].offset);
291 else
292 {
293 stderr_out (" - %s (%d, %d)\n",
294 LHEADER_IMPLEMENTATION (backtrace[i].obj)->name,
295 backtrace[i].position,
296 backtrace[i].offset);
297 }
298 }
299 }
300
301 static void pdump_register_object (Lisp_Object obj);
302 static void pdump_register_struct (const void *data, const struct struct_description *sdesc, int count);
303
304 static EMACS_INT
305 pdump_get_indirect_count (EMACS_INT code, const struct lrecord_description *idesc, const void *idata)
306 {
307 EMACS_INT count;
308 const void *irdata;
309
310 int line = XD_INDIRECT_VAL (code);
311 int delta = XD_INDIRECT_DELTA (code);
312
313 irdata = ((char *)idata) + idesc[line].offset;
314 switch (idesc[line].type)
315 {
316 case XD_SIZE_T:
317 count = *(size_t *)irdata;
318 break;
319 case XD_INT:
320 count = *(int *)irdata;
321 break;
322 case XD_LONG:
323 count = *(long *)irdata;
324 break;
325 case XD_BYTECOUNT:
326 count = *(Bytecount *)irdata;
327 break;
328 default:
329 stderr_out ("Unsupported count type : %d (line = %d, code=%ld)\n", idesc[line].type, line, (long)code);
330 pdump_backtrace ();
331 abort ();
332 }
333 count += delta;
334 return count;
335 }
336
337 static void
338 pdump_register_sub (const void *data, const struct lrecord_description *desc, int me)
339 {
340 int pos;
341
342 restart:
343 for (pos = 0; desc[pos].type != XD_END; pos++)
344 {
345 const void *rdata = (const char *)data + desc[pos].offset;
346
347 backtrace[me].position = pos;
348 backtrace[me].offset = desc[pos].offset;
349
350 switch (desc[pos].type)
351 {
352 case XD_SPECIFIER_END:
353 pos = 0;
354 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
355 goto restart;
356 case XD_SIZE_T:
357 case XD_INT:
358 case XD_LONG:
359 case XD_BYTECOUNT:
360 case XD_LO_RESET_NIL:
361 case XD_INT_RESET:
362 case XD_LO_LINK:
363 break;
364 case XD_OPAQUE_DATA_PTR:
365 {
366 EMACS_INT count = desc[pos].data1;
367 if (XD_IS_INDIRECT (count))
368 count = pdump_get_indirect_count (count, desc, data);
369
370 pdump_add_entry (&pdump_opaque_data_list,
371 *(void **)rdata,
372 count,
373 1,
374 0);
375 break;
376 }
377 case XD_C_STRING:
378 {
379 const char *str = *(const char **)rdata;
380 if (str)
381 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
382 break;
383 }
384 case XD_DOC_STRING:
385 {
386 const char *str = *(const char **)rdata;
387 if ((EMACS_INT)str > 0)
388 pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
389 break;
390 }
391 case XD_LISP_OBJECT:
392 {
393 const Lisp_Object *pobj = (const Lisp_Object *)rdata;
394
395 assert (desc[pos].data1 == 0);
396
397 backtrace[me].offset = (const char *)pobj - (const char *)data;
398 pdump_register_object (*pobj);
399 break;
400 }
401 case XD_LISP_OBJECT_ARRAY:
402 {
403 int i;
404 EMACS_INT count = desc[pos].data1;
405 if (XD_IS_INDIRECT (count))
406 count = pdump_get_indirect_count (count, desc, data);
407
408 for (i = 0; i < count; i++)
409 {
410 const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i;
411 Lisp_Object dobj = *pobj;
412
413 backtrace[me].offset = (const char *)pobj - (const char *)data;
414 pdump_register_object (dobj);
415 }
416 break;
417 }
418 case XD_STRUCT_PTR:
419 {
420 EMACS_INT count = desc[pos].data1;
421 const struct struct_description *sdesc = desc[pos].data2;
422 const char *dobj = *(const char **)rdata;
423 if (dobj)
424 {
425 if (XD_IS_INDIRECT (count))
426 count = pdump_get_indirect_count (count, desc, data);
427
428 pdump_register_struct (dobj, sdesc, count);
429 }
430 break;
431 }
432 default:
433 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
434 pdump_backtrace ();
435 abort ();
436 };
437 }
438 }
439
440 static void
441 pdump_register_object (Lisp_Object obj)
442 {
443 struct lrecord_header *objh;
444
445 if (!POINTER_TYPE_P (XTYPE (obj)))
446 return;
447
448 objh = XRECORD_LHEADER (obj);
449 if (!objh)
450 return;
451
452 if (pdump_get_entry (objh))
453 return;
454
455 if (LHEADER_IMPLEMENTATION (objh)->description)
456 {
457 int me = depth++;
458 if (me>65536)
459 {
460 stderr_out ("Backtrace overflow, loop ?\n");
461 abort ();
462 }
463 backtrace[me].obj = objh;
464 backtrace[me].position = 0;
465 backtrace[me].offset = 0;
466
467 pdump_add_entry (pdump_object_table + objh->type,
468 objh,
469 LHEADER_IMPLEMENTATION (objh)->static_size ?
470 LHEADER_IMPLEMENTATION (objh)->static_size :
471 LHEADER_IMPLEMENTATION (objh)->size_in_bytes_method (objh),
472 1,
473 1);
474 pdump_register_sub (objh,
475 LHEADER_IMPLEMENTATION (objh)->description,
476 me);
477 --depth;
478 }
479 else
480 {
481 pdump_alert_undump_object[objh->type]++;
482 stderr_out ("Undumpable object type : %s\n", LHEADER_IMPLEMENTATION (objh)->name);
483 pdump_backtrace ();
484 }
485 }
486
487 static void
488 pdump_register_struct (const void *data, const struct struct_description *sdesc, int count)
489 {
490 if (data && !pdump_get_entry (data))
491 {
492 int me = depth++;
493 int i;
494 if (me>65536)
495 {
496 stderr_out ("Backtrace overflow, loop ?\n");
497 abort ();
498 }
499 backtrace[me].obj = 0;
500 backtrace[me].position = 0;
501 backtrace[me].offset = 0;
502
503 pdump_add_entry (pdump_get_entry_list (sdesc),
504 data,
505 sdesc->size,
506 count,
507 0);
508 for (i=0; i<count; i++)
509 {
510 pdump_register_sub (((char *)data) + sdesc->size*i,
511 sdesc->description,
512 me);
513 }
514 --depth;
515 }
516 }
517
518 static void
519 pdump_dump_data (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
520 {
521 size_t size = elmt->size;
522 int count = elmt->count;
523 if (desc)
524 {
525 int pos, i;
526 memcpy (pdump_buf, elmt->obj, size*count);
527
528 for (i=0; i<count; i++)
529 {
530 char *cur = ((char *)pdump_buf) + i*size;
531 restart:
532 for (pos = 0; desc[pos].type != XD_END; pos++)
533 {
534 void *rdata = cur + desc[pos].offset;
535 switch (desc[pos].type)
536 {
537 case XD_SPECIFIER_END:
538 desc = ((const Lisp_Specifier *)(elmt->obj))->methods->extra_description;
539 goto restart;
540 case XD_SIZE_T:
541 case XD_INT:
542 case XD_LONG:
543 case XD_BYTECOUNT:
544 break;
545 case XD_LO_RESET_NIL:
546 {
547 EMACS_INT num = desc[pos].data1;
548 int j;
549 if (XD_IS_INDIRECT (num))
550 num = pdump_get_indirect_count (num, desc, elmt->obj);
551 for (j=0; j<num; j++)
552 ((EMACS_INT *)rdata)[j] = pdump_qnil->save_offset;
553 break;
554 }
555 case XD_INT_RESET:
556 {
557 EMACS_INT val = desc[pos].data1;
558 if (XD_IS_INDIRECT (val))
559 val = pdump_get_indirect_count (val, desc, elmt->obj);
560 *(int *)rdata = val;
561 break;
562 }
563 case XD_OPAQUE_DATA_PTR:
564 case XD_C_STRING:
565 case XD_STRUCT_PTR:
566 {
567 void *ptr = *(void **)rdata;
568 if (ptr)
569 *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset;
570 break;
571 }
572 case XD_LO_LINK:
573 {
574 Lisp_Object obj = *(Lisp_Object *)rdata;
575 pdump_entry_list_elmt *elmt1;
576 for (;;)
577 {
578 elmt1 = pdump_get_entry (XRECORD_LHEADER (obj));
579 if (elmt1)
580 break;
581 obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
582 }
583 *(EMACS_INT *)rdata = elmt1->save_offset;
584 break;
585 }
586 case XD_LISP_OBJECT:
587 {
588 Lisp_Object *pobj = (Lisp_Object *) rdata;
589
590 assert (desc[pos].data1 == 0);
591
592 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
593 *(EMACS_INT *)pobj =
594 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
595 break;
596 }
597 case XD_LISP_OBJECT_ARRAY:
598 {
599 EMACS_INT num = desc[pos].data1;
600 int j;
601 if (XD_IS_INDIRECT (num))
602 num = pdump_get_indirect_count (num, desc, elmt->obj);
603
604 for (j=0; j<num; j++)
605 {
606 Lisp_Object *pobj = ((Lisp_Object *)rdata) + j;
607 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
608 *(EMACS_INT *)pobj =
609 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
610 }
611 break;
612 }
613 case XD_DOC_STRING:
614 {
615 EMACS_INT str = *(EMACS_INT *)rdata;
616 if (str > 0)
617 *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset;
618 break;
619 }
620 default:
621 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
622 abort ();
623 };
624 }
625 }
626 }
627 write (pdump_fd, desc ? pdump_buf : elmt->obj, size*count);
628 if (elmt->is_lrecord && ((size*count) & 3))
629 write (pdump_fd, "\0\0\0", 4-((size*count) & 3));
630 }
631
632 static void
633 pdump_reloc_one (void *data, EMACS_INT delta, const struct lrecord_description *desc)
634 {
635 int pos;
636
637 restart:
638 for (pos = 0; desc[pos].type != XD_END; pos++)
639 {
640 void *rdata = (char *)data + desc[pos].offset;
641 switch (desc[pos].type)
642 {
643 case XD_SPECIFIER_END:
644 pos = 0;
645 desc = ((const Lisp_Specifier *)data)->methods->extra_description;
646 goto restart;
647 case XD_SIZE_T:
648 case XD_INT:
649 case XD_LONG:
650 case XD_BYTECOUNT:
651 case XD_INT_RESET:
652 break;
653 case XD_OPAQUE_DATA_PTR:
654 case XD_C_STRING:
655 case XD_STRUCT_PTR:
656 case XD_LO_LINK:
657 {
658 EMACS_INT ptr = *(EMACS_INT *)rdata;
659 if (ptr)
660 *(EMACS_INT *)rdata = ptr+delta;
661 break;
662 }
663 case XD_LISP_OBJECT:
664 {
665 Lisp_Object *pobj = (Lisp_Object *) rdata;
666
667 assert (desc[pos].data1 == 0);
668
669 if (POINTER_TYPE_P (XTYPE (*pobj))
670 && ! EQ (*pobj, Qnull_pointer))
671 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
672
673 break;
674 }
675 case XD_LISP_OBJECT_ARRAY:
676 case XD_LO_RESET_NIL:
677 {
678 EMACS_INT num = desc[pos].data1;
679 int j;
680 if (XD_IS_INDIRECT (num))
681 num = pdump_get_indirect_count (num, desc, data);
682
683 for (j=0; j<num; j++)
684 {
685 Lisp_Object *pobj = (Lisp_Object *) rdata + j;
686
687 if (POINTER_TYPE_P (XTYPE (*pobj))
688 && ! EQ (*pobj, Qnull_pointer))
689 XSETOBJ (*pobj, (char *) XPNTR (*pobj) + delta);
690 }
691 break;
692 }
693 case XD_DOC_STRING:
694 {
695 EMACS_INT str = *(EMACS_INT *)rdata;
696 if (str > 0)
697 *(EMACS_INT *)rdata = str + delta;
698 break;
699 }
700 default:
701 stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
702 abort ();
703 };
704 }
705 }
706
707 static void
708 pdump_allocate_offset (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
709 {
710 size_t size = (elmt->is_lrecord ? (elmt->size + 3) & ~3 : elmt->size)*elmt->count;
711 elmt->save_offset = cur_offset;
712 if (size>max_size)
713 max_size = size;
714 cur_offset += size;
715 }
716
717 static void
718 pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *, const struct lrecord_description *))
719 {
720 int align, i;
721 const struct lrecord_description *idesc;
722 pdump_entry_list_elmt *elmt;
723 for (align=8; align>=0; align--)
724 {
725 for (i=0; i<lrecord_type_count; i++)
726 if (pdump_object_table[i].align == align)
727 {
728 elmt = pdump_object_table[i].first;
729 if (!elmt)
730 continue;
731 idesc = lrecord_implementations_table[i]->description;
732 while (elmt)
733 {
734 f (elmt, idesc);
735 elmt = elmt->next;
736 }
737 }
738
739 for (i=0; i<pdump_struct_table.count; i++)
740 if (pdump_struct_table.list[i].list.align == align)
741 {
742 elmt = pdump_struct_table.list[i].list.first;
743 idesc = pdump_struct_table.list[i].sdesc->description;
744 while (elmt)
745 {
746 f (elmt, idesc);
747 elmt = elmt->next;
748 }
749 }
750
751 elmt = pdump_opaque_data_list.first;
752 while (elmt)
753 {
754 if (align_table[elmt->size & 255] == align)
755 f (elmt, 0);
756 elmt = elmt->next;
757 }
758 }
759 }
760
761 static void
762 pdump_dump_staticvec (void)
763 {
764 EMACS_INT *reloc = xnew_array (EMACS_INT, staticidx);
765 int i;
766 write (pdump_fd, staticvec, staticidx*sizeof (Lisp_Object *));
767
768 for (i=0; i<staticidx; i++)
769 {
770 Lisp_Object obj = *staticvec[i];
771 if (POINTER_TYPE_P (XTYPE (obj)))
772 reloc[i] = pdump_get_entry (XRECORD_LHEADER (obj))->save_offset;
773 else
774 reloc[i] = *(EMACS_INT *)(staticvec[i]);
775 }
776 write (pdump_fd, reloc, staticidx*sizeof (Lisp_Object));
777 free (reloc);
778 }
779
780 static void
781 pdump_dump_structvec (void)
782 {
783 int i;
784 for (i=0; i<dumpstructidx; i++)
785 {
786 EMACS_INT adr;
787 write (pdump_fd, &(dumpstructvec[i].data), sizeof (void *));
788 adr = pdump_get_entry (*(void **)(dumpstructvec[i].data))->save_offset;
789 write (pdump_fd, &adr, sizeof (adr));
790 }
791 }
792
793 static void
794 pdump_dump_opaquevec (void)
795 {
796 int i;
797 for (i=0; i<dumpopaqueidx; i++)
798 {
799 write (pdump_fd, &(dumpopaquevec[i]), sizeof (dumpopaquevec[i]));
800 write (pdump_fd, dumpopaquevec[i].data, dumpopaquevec[i].size);
801 }
802 }
803
804 static void
805 pdump_dump_itable (void)
806 {
807 write (pdump_fd, lrecord_implementations_table, lrecord_type_count*sizeof (lrecord_implementations_table[0]));
808 }
809
810 static void
811 pdump_dump_rtables (void)
812 {
813 int i, j;
814 pdump_entry_list_elmt *elmt;
815 pdump_reloc_table rt;
816
817 for (i=0; i<lrecord_type_count; i++)
818 {
819 elmt = pdump_object_table[i].first;
820 if (!elmt)
821 continue;
822 rt.desc = lrecord_implementations_table[i]->description;
823 rt.count = pdump_object_table[i].count;
824 write (pdump_fd, &rt, sizeof (rt));
825 while (elmt)
826 {
827 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
828 write (pdump_fd, &rdata, sizeof (rdata));
829 elmt = elmt->next;
830 }
831 }
832
833 rt.desc = 0;
834 rt.count = 0;
835 write (pdump_fd, &rt, sizeof (rt));
836
837 for (i=0; i<pdump_struct_table.count; i++)
838 {
839 elmt = pdump_struct_table.list[i].list.first;
840 rt.desc = pdump_struct_table.list[i].sdesc->description;
841 rt.count = pdump_struct_table.list[i].list.count;
842 write (pdump_fd, &rt, sizeof (rt));
843 while (elmt)
844 {
845 EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
846 for (j=0; j<elmt->count; j++)
847 {
848 write (pdump_fd, &rdata, sizeof (rdata));
849 rdata += elmt->size;
850 }
851 elmt = elmt->next;
852 }
853 }
854 rt.desc = 0;
855 rt.count = 0;
856 write (pdump_fd, &rt, sizeof (rt));
857 }
858
859 static void
860 pdump_dump_wired (void)
861 {
862 EMACS_INT count = pdump_wireidx + pdump_wireidx_list;
863 int i;
864
865 write (pdump_fd, &count, sizeof (count));
866
867 for (i=0; i<pdump_wireidx; i++)
868 {
869 EMACS_INT obj = pdump_get_entry (XRECORD_LHEADER (*(pdump_wirevec[i])))->save_offset;
870 write (pdump_fd, &pdump_wirevec[i], sizeof (pdump_wirevec[i]));
871 write (pdump_fd, &obj, sizeof (obj));
872 }
873
874 for (i=0; i<pdump_wireidx_list; i++)
875 {
876 Lisp_Object obj = *(pdump_wirevec_list[i]);
877 pdump_entry_list_elmt *elmt;
878 EMACS_INT res;
879
880 for (;;)
881 {
882 const struct lrecord_description *desc;
883 int pos;
884 elmt = pdump_get_entry (XRECORD_LHEADER (obj));
885 if (elmt)
886 break;
887 desc = XRECORD_LHEADER_IMPLEMENTATION (obj)->description;
888 for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
889 assert (desc[pos].type != XD_END);
890
891 obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
892 }
893 res = elmt->save_offset;
894
895 write (pdump_fd, &pdump_wirevec_list[i], sizeof (pdump_wirevec_list[i]));
896 write (pdump_fd, &res, sizeof (res));
897 }
898 }
899
900 void
901 pdump (void)
902 {
903 int i;
904 Lisp_Object t_console, t_device, t_frame;
905 int none;
906 dump_header hd;
907
908 /* These appear in a DEFVAR_LISP, which does a staticpro() */
909 t_console = Vterminal_console;
910 t_frame = Vterminal_frame;
911 t_device = Vterminal_device;
912
913 Vterminal_console = Qnil;
914 Vterminal_frame = Qnil;
915 Vterminal_device = Qnil;
916
917 pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE);
918
919 for (i=0; i<lrecord_type_count; i++)
920 {
921 pdump_object_table[i].first = 0;
922 pdump_object_table[i].align = 8;
923 pdump_object_table[i].count = 0;
924 pdump_alert_undump_object[i] = 0;
925 }
926 pdump_struct_table.count = 0;
927 pdump_struct_table.size = -1;
928
929 pdump_opaque_data_list.first = 0;
930 pdump_opaque_data_list.align = 8;
931 pdump_opaque_data_list.count = 0;
932 depth = 0;
933
934 for (i=0; i<staticidx; i++)
935 pdump_register_object (*staticvec[i]);
936 for (i=0; i<pdump_wireidx; i++)
937 pdump_register_object (*pdump_wirevec[i]);
938
939 none = 1;
940 for (i=0; i<lrecord_type_count; i++)
941 if (pdump_alert_undump_object[i])
942 {
943 if (none)
944 printf ("Undumpable types list :\n");
945 none = 0;
946 printf (" - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]);
947 }
948 if (!none)
949 return;
950
951 for (i=0; i<dumpstructidx; i++)
952 pdump_register_struct (*(void **)(dumpstructvec[i].data), dumpstructvec[i].desc, 1);
953
954 memcpy (hd.signature, DUMP_SIGNATURE, DUMP_SIGNATURE_LEN);
955 hd.id = dump_id;
956 hd.reloc_address = 0;
957 hd.nb_staticpro = staticidx;
958 hd.nb_structdmp = dumpstructidx;
959 hd.nb_opaquedmp = dumpopaqueidx;
960
961 cur_offset = 256;
962 max_size = 0;
963
964 pdump_scan_by_alignment (pdump_allocate_offset);
965 pdump_qnil = pdump_get_entry (XRECORD_LHEADER (Qnil));
966
967 pdump_buf = xmalloc (max_size);
968 /* Avoid use of the `open' macro. We want the real function. */
969 #undef open
970 pdump_fd = open (EMACS_PROGNAME ".dmp",
971 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666);
972 hd.stab_offset = (cur_offset + 3) & ~3;
973
974 write (pdump_fd, &hd, sizeof (hd));
975 lseek (pdump_fd, 256, SEEK_SET);
976
977 pdump_scan_by_alignment (pdump_dump_data);
978
979 lseek (pdump_fd, hd.stab_offset, SEEK_SET);
980
981 pdump_dump_staticvec ();
982 pdump_dump_structvec ();
983 pdump_dump_opaquevec ();
984 pdump_dump_itable ();
985 pdump_dump_rtables ();
986 pdump_dump_wired ();
987
988 close (pdump_fd);
989 free (pdump_buf);
990
991 free (pdump_hash);
992
993 Vterminal_console = t_console;
994 Vterminal_frame = t_frame;
995 Vterminal_device = t_device;
996 }
997
998 static int pdump_load_check (void)
999 {
1000 return (!memcmp (((dump_header *)pdump_start)->signature, DUMP_SIGNATURE, DUMP_SIGNATURE_LEN)
1001 && ((dump_header *)pdump_start)->id == dump_id);
1002 }
1003
1004 static int pdump_load_finish (void)
1005 {
1006 int i;
1007 char *p;
1008 EMACS_INT delta;
1009 EMACS_INT count;
1010
1011 pdump_end = pdump_start + pdump_length;
1012
1013 #define PDUMP_READ(p, type) (p = (char*) (((type *) p) + 1), *((type *) p - 1))
1014
1015 staticidx = ((dump_header *)(pdump_start))->nb_staticpro;
1016 delta = ((EMACS_INT)pdump_start) - ((dump_header *)pdump_start)->reloc_address;
1017 p = pdump_start + ((dump_header *)pdump_start)->stab_offset;
1018
1019 /* Put back the staticvec in place */
1020 memcpy (staticvec, p, staticidx*sizeof (Lisp_Object *));
1021 p += staticidx*sizeof (Lisp_Object *);
1022 for (i=0; i<staticidx; i++)
1023 {
1024 Lisp_Object obj = PDUMP_READ (p, Lisp_Object);
1025 if (POINTER_TYPE_P (XTYPE (obj)))
1026 XSETOBJ (obj, (char *) XPNTR (obj) + delta);
1027 *staticvec[i] = obj;
1028 }
1029
1030 /* Put back the dumpstructs */
1031 for (i=0; i<((dump_header *)pdump_start)->nb_structdmp; i++)
1032 {
1033 void **adr = PDUMP_READ (p, void **);
1034 *adr = (void *) (PDUMP_READ (p, char *) + delta);
1035 }
1036
1037 /* Put back the opaques */
1038 for (i=0; i<((dump_header *)pdump_start)->nb_opaquedmp; i++)
1039 {
1040 struct pdump_dumpopaqueinfo di = PDUMP_READ (p, struct pdump_dumpopaqueinfo);
1041 memcpy (di.data, p, di.size);
1042 p += di.size;
1043 }
1044
1045 /* Put back the lrecord_implementations_table */
1046 /* The (void *) cast is there to make Ben happy. */
1047 memcpy ((void *) lrecord_implementations_table, p, lrecord_type_count*sizeof (lrecord_implementations_table[0]));
1048 p += lrecord_type_count*sizeof (lrecord_implementations_table[0]);
1049
1050 /* Reinitialize lrecord_markers from lrecord_implementations_table */
1051 for (i=0; i < lrecord_type_count; i++)
1052 if (lrecord_implementations_table[i])
1053 lrecord_markers[i] = lrecord_implementations_table[i]->marker;
1054
1055 /* Do the relocations */
1056 pdump_rt_list = p;
1057 count = 2;
1058 for (;;)
1059 {
1060 pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1061 if (rt.desc)
1062 {
1063 for (i=0; i < rt.count; i++)
1064 {
1065 char *adr = delta + *(char **)p;
1066 *(char **)p = adr;
1067 pdump_reloc_one (adr, delta, rt.desc);
1068 p += sizeof (char *);
1069 }
1070 } else
1071 if (!(--count))
1072 break;
1073 }
1074
1075 /* Put the pdump_wire variables in place */
1076 count = PDUMP_READ (p, EMACS_INT);
1077
1078 for (i=0; i<count; i++)
1079 {
1080 Lisp_Object *var = PDUMP_READ (p, Lisp_Object *);
1081 Lisp_Object obj = PDUMP_READ (p, Lisp_Object);
1082
1083 if (POINTER_TYPE_P (XTYPE (obj)))
1084 XSETOBJ (obj, (char *) XPNTR (obj) + delta);
1085
1086 *var = obj;
1087 }
1088
1089 /* Final cleanups */
1090 /* reorganize hash tables */
1091 p = pdump_rt_list;
1092 for (;;)
1093 {
1094 pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
1095 if (!rt.desc)
1096 break;
1097 if (rt.desc == hash_table_description)
1098 {
1099 for (i=0; i < rt.count; i++)
1100 pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object));
1101 break;
1102 } else
1103 p += sizeof (Lisp_Object) * rt.count;
1104 }
1105
1106 return 1;
1107 }
1108
1109 #ifdef WIN32_NATIVE
1110 /* Free the mapped file if we decide we don't want it after all */
1111 static void pdump_file_unmap(void)
1112 {
1113 UnmapViewOfFile (pdump_start);
1114 CloseHandle (pdump_hFile);
1115 CloseHandle (pdump_hMap);
1116 }
1117
1118 static int pdump_file_get(const char *path)
1119 {
1120
1121 pdump_hFile = CreateFile (path,
1122 GENERIC_READ + GENERIC_WRITE, /* Required for copy on write */
1123 0, /* Not shared */
1124 NULL, /* Not inheritable */
1125 OPEN_EXISTING,
1126 FILE_ATTRIBUTE_NORMAL,
1127 NULL); /* No template file */
1128 if (pdump_hFile == INVALID_HANDLE_VALUE)
1129 return 0;
1130
1131 pdump_length = GetFileSize (pdump_hFile, NULL);
1132 pdump_hMap = CreateFileMapping (pdump_hFile,
1133 NULL, /* No security attributes */
1134 PAGE_WRITECOPY, /* Copy on write */
1135 0, /* Max size, high half */
1136 0, /* Max size, low half */
1137 NULL); /* Unnamed */
1138 if (pdump_hMap == INVALID_HANDLE_VALUE)
1139 return 0;
1140
1141 pdump_start = MapViewOfFile (pdump_hMap,
1142 FILE_MAP_COPY, /* Copy on write */
1143 0, /* Start at zero */
1144 0,
1145 0); /* Map all of it */
1146 pdump_free = pdump_file_unmap;
1147 return 1;
1148 }
1149
1150 /* pdump_resource_free is called (via the pdump_free pointer) to release
1151 any resources allocated by pdump_resource_get. Since the Windows API
1152 specs specifically state that you don't need to (and shouldn't) free the
1153 resources allocated by FindResource, LoadResource, and LockResource this
1154 routine does nothing. */
1155 static void pdump_resource_free (void)
1156 {
1157 }
1158
1159 static int pdump_resource_get (void)
1160 {
1161 HRSRC hRes; /* Handle to dump resource */
1162 HRSRC hResLoad; /* Handle to loaded dump resource */
1163
1164 /* See Q126630 which describes how Windows NT and 95 trap writes to
1165 resource sections and duplicate the page to allow the write to proceed.
1166 It also describes how to make the resource section read/write (and hence
1167 private to each process). Doing this avoids the exceptions and related
1168 overhead, but causes the resource section to be private to each process
1169 that is running XEmacs. Since the resource section contains little
1170 other than the dumped data, which should be private to each process, we
1171 make the whole resource section read/write so we don't have to copy it. */
1172
1173 hRes = FindResource (NULL, MAKEINTRESOURCE(101), "DUMP");
1174 if (hRes == NULL)
1175 return 0;
1176
1177 /* Found it, use the data in the resource */
1178 hResLoad = LoadResource (NULL, hRes);
1179 if (hResLoad == NULL)
1180 return 0;
1181
1182 pdump_start = LockResource (hResLoad);
1183 if (pdump_start == NULL)
1184 return 0;
1185
1186 pdump_free = pdump_resource_free;
1187 pdump_length = SizeofResource (NULL, hRes);
1188 if (pdump_length <= sizeof(dump_header))
1189 {
1190 pdump_start = 0;
1191 return 0;
1192 }
1193
1194 return 1;
1195 }
1196
1197 #else /* !WIN32_NATIVE */
1198
1199 static void *pdump_mallocadr;
1200
1201 static void pdump_file_free(void)
1202 {
1203 xfree (pdump_mallocadr);
1204 }
1205
1206 #ifdef HAVE_MMAP
1207 static void pdump_file_unmap(void)
1208 {
1209 munmap (pdump_start, pdump_length);
1210 }
1211 #endif
1212
1213 static int pdump_file_get(const char *path)
1214 {
1215 int fd = open (path, O_RDONLY | OPEN_BINARY);
1216 if (fd<0)
1217 return 0;
1218
1219 pdump_length = lseek (fd, 0, SEEK_END);
1220 if (pdump_length < sizeof (dump_header))
1221 {
1222 close (fd);
1223 return 0;
1224 }
1225
1226 lseek (fd, 0, SEEK_SET);
1227
1228 #ifdef HAVE_MMAP
1229 pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1230 if (pdump_start != MAP_FAILED)
1231 {
1232 pdump_free = pdump_file_unmap;
1233 close (fd);
1234 return 1;
1235 }
1236 #endif
1237
1238 pdump_mallocadr = xmalloc(pdump_length+255);
1239 pdump_free = pdump_file_free;
1240 pdump_start = (char *)((255 + (unsigned long)pdump_mallocadr) & ~255);
1241 read (pdump_fd, pdump_start, pdump_length);
1242
1243 close (pdump_fd);
1244 return 1;
1245 }
1246 #endif /* !WIN32_NATIVE */
1247
1248
1249 static int pdump_file_try(char *exe_path)
1250 {
1251 char *w;
1252
1253 w = exe_path + strlen(exe_path);
1254 do
1255 {
1256 sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
1257 if (pdump_file_get (exe_path))
1258 {
1259 if (pdump_load_check ())
1260 return 1;
1261 pdump_free();
1262 }
1263
1264 sprintf (w, "-%08x.dmp", dump_id);
1265 if (pdump_file_get (exe_path))
1266 {
1267 if (pdump_load_check ())
1268 return 1;
1269 pdump_free();
1270 }
1271
1272 sprintf (w, ".dmp");
1273 if (pdump_file_get (exe_path))
1274 {
1275 if (pdump_load_check ())
1276 return 1;
1277 pdump_free();
1278 }
1279
1280 do
1281 w--;
1282 while (w>exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && (*w != '.'));
1283 }
1284 while (w>exe_path && !IS_DIRECTORY_SEP (*w));
1285 return 0;
1286 }
1287
1288 int pdump_load(const char *argv0)
1289 {
1290 char exe_path[PATH_MAX];
1291 #ifdef WIN32_NATIVE
1292 GetModuleFileName (NULL, exe_path, PATH_MAX);
1293 #else /* !WIN32_NATIVE */
1294 char *w;
1295 const char *dir, *p;
1296
1297 dir = argv0;
1298 if (dir[0] == '-')
1299 {
1300 /* XEmacs as a login shell, oh goody! */
1301 dir = getenv("SHELL");
1302 }
1303
1304 p = dir + strlen(dir);
1305 while (p != dir && !IS_ANY_SEP (p[-1])) p--;
1306
1307 if (p != dir)
1308 {
1309 /* invocation-name includes a directory component -- presumably it
1310 is relative to cwd, not $PATH */
1311 strcpy (exe_path, dir);
1312 }
1313 else
1314 {
1315 const char *path = getenv ("PATH");
1316 const char *name = p;
1317 for (;;)
1318 {
1319 p = path;
1320 while (*p && *p != SEPCHAR)
1321 p++;
1322 if (p == path)
1323 {
1324 exe_path[0] = '.';
1325 w = exe_path + 1;
1326 }
1327 else
1328 {
1329 memcpy (exe_path, path, p - path);
1330 w = exe_path + (p - path);
1331 }
1332 if (!IS_DIRECTORY_SEP (w[-1]))
1333 {
1334 *w++ = '/';
1335 }
1336 strcpy(w, name);
1337
1338 /* ### #$%$#^$^@%$^#%@$ ! */
1339 #ifdef access
1340 #undef access
1341 #endif
1342
1343 if (!access (exe_path, X_OK))
1344 break;
1345 if (!*p)
1346 {
1347 /* Oh well, let's have some kind of default */
1348 sprintf (exe_path, "./%s", name);
1349 break;
1350 }
1351 path = p+1;
1352 }
1353 }
1354 #endif /* WIN32_NATIVE */
1355
1356 if (pdump_file_try (exe_path))
1357 {
1358 pdump_load_finish ();
1359 return 1;
1360 }
1361
1362 #ifdef WIN32_NATIVE
1363 if (pdump_resource_get ())
1364 {
1365 if (pdump_load_check ())
1366 {
1367 pdump_load_finish ();
1368 return 1;
1369 }
1370 pdump_free ();
1371 }
1372 #endif
1373
1374 return 0;
1375 }