Mercurial > hg > xemacs-beta

comparison src/dumper.c @ 404:2f8bb876ab1d r21-2-32

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