Mercurial > hg > xemacs-beta
comparison src/dumper.c @ 771:943eaba38521
[xemacs-hg @ 2002-03-13 08:51:24 by ben]
The big ben-mule-21-5 check-in!
Various files were added and deleted. See CHANGES-ben-mule.
There are still some test suite failures. No crashes, though.
Many of the failures have to do with problems in the test suite itself
rather than in the actual code. I'll be addressing these in the next
day or so -- none of the test suite failures are at all critical.
Meanwhile I'll be trying to address the biggest issues -- i.e. build
or run failures, which will almost certainly happen on various platforms.
All comments should be sent to ben@xemacs.org -- use a Cc: if necessary
when sending to mailing lists. There will be pre- and post- tags,
something like
pre-ben-mule-21-5-merge-in, and
post-ben-mule-21-5-merge-in.
author | ben |
---|---|
date | Wed, 13 Mar 2002 08:54:06 +0000 |
parents | fdefd0186b75 |
children | e38acbeb1cae |
comparison
equal
deleted
inserted
replaced
770:336a418893b5 | 771:943eaba38521 |
---|---|
1 /* Portable data dumper for XEmacs. | 1 /* Portable data dumper for XEmacs. |
2 Copyright (C) 1999-2000 Olivier Galibert | 2 Copyright (C) 1999-2000 Olivier Galibert |
3 Copyright (C) 2001 Martin Buchholz | 3 Copyright (C) 2001 Martin Buchholz |
4 Copyright (C) 2001 Ben Wing. | |
4 | 5 |
5 This file is part of XEmacs. | 6 This file is part of XEmacs. |
6 | 7 |
7 XEmacs is free software; you can redistribute it and/or modify it | 8 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 under the terms of the GNU General Public License as published by the |
23 | 24 |
24 #include <config.h> | 25 #include <config.h> |
25 #include "lisp.h" | 26 #include "lisp.h" |
26 | 27 |
27 #include "specifier.h" | 28 #include "specifier.h" |
29 #include "file-coding.h" | |
28 #include "elhash.h" | 30 #include "elhash.h" |
29 #include "sysfile.h" | 31 #include "sysfile.h" |
30 #include "console-stream.h" | 32 #include "console-stream.h" |
31 #include "dumper.h" | 33 #include "dumper.h" |
32 | 34 |
33 #ifdef WIN32_NATIVE | 35 #ifdef WIN32_NATIVE |
34 #include "nt.h" | 36 #include "syswindows.h" |
35 #else | 37 #else |
36 #ifdef HAVE_MMAP | 38 #ifdef HAVE_MMAP |
37 #include <sys/mman.h> | 39 #include <sys/mman.h> |
38 #endif | 40 #endif |
39 #endif | |
40 | |
41 #ifndef SEPCHAR | |
42 #define SEPCHAR ':' | |
43 #endif | 41 #endif |
44 | 42 |
45 typedef struct | 43 typedef struct |
46 { | 44 { |
47 const void *varaddress; | 45 const void *varaddress; |
96 | 94 |
97 /* Mark the struct described by DESC and pointed to by the pointer at | 95 /* Mark the struct described by DESC and pointed to by the pointer at |
98 non-heap address VARADDRESS for dumping. | 96 non-heap address VARADDRESS for dumping. |
99 All the objects reachable from this pointer will also be dumped. */ | 97 All the objects reachable from this pointer will also be dumped. */ |
100 void | 98 void |
101 dump_add_root_struct_ptr (void *ptraddress, const struct struct_description *desc) | 99 dump_add_root_struct_ptr (void *ptraddress, |
100 const struct struct_description *desc) | |
102 { | 101 { |
103 pdump_root_struct_ptr info; | 102 pdump_root_struct_ptr info; |
104 info.ptraddress = (void **) ptraddress; | 103 info.ptraddress = (void **) ptraddress; |
105 info.desc = desc; | 104 info.desc = desc; |
106 if (pdump_root_struct_ptrs == NULL) | 105 if (pdump_root_struct_ptrs == NULL) |
138 } | 137 } |
139 | 138 |
140 #define PDUMP_ALIGN_OUTPUT(type) pdump_align_stream (pdump_out, ALIGNOF (type)) | 139 #define PDUMP_ALIGN_OUTPUT(type) pdump_align_stream (pdump_out, ALIGNOF (type)) |
141 | 140 |
142 #define PDUMP_WRITE(type, object) \ | 141 #define PDUMP_WRITE(type, object) \ |
143 fwrite (&object, sizeof (object), 1, pdump_out); | 142 retry_fwrite (&object, sizeof (object), 1, pdump_out); |
144 | 143 |
145 #define PDUMP_WRITE_ALIGNED(type, object) do { \ | 144 #define PDUMP_WRITE_ALIGNED(type, object) do { \ |
146 PDUMP_ALIGN_OUTPUT (type); \ | 145 PDUMP_ALIGN_OUTPUT (type); \ |
147 PDUMP_WRITE (type, object); \ | 146 PDUMP_WRITE (type, object); \ |
148 } while (0) | 147 } while (0) |
386 static void | 385 static void |
387 pdump_backtrace (void) | 386 pdump_backtrace (void) |
388 { | 387 { |
389 int i; | 388 int i; |
390 stderr_out ("pdump backtrace :\n"); | 389 stderr_out ("pdump backtrace :\n"); |
391 for (i=0;i<depth;i++) | 390 for (i = 0; i < depth; i++) |
392 { | 391 { |
393 if (!backtrace[i].obj) | 392 if (!backtrace[i].obj) |
394 stderr_out (" - ind. (%d, %d)\n", | 393 stderr_out (" - ind. (%d, %d)\n", |
395 backtrace[i].position, | 394 backtrace[i].position, |
396 backtrace[i].offset); | 395 backtrace[i].offset); |
403 } | 402 } |
404 } | 403 } |
405 } | 404 } |
406 | 405 |
407 static void pdump_register_object (Lisp_Object obj); | 406 static void pdump_register_object (Lisp_Object obj); |
407 static void pdump_register_struct_contents (const void *data, | |
408 const struct struct_description * | |
409 sdesc, | |
410 int count); | |
408 static void pdump_register_struct (const void *data, | 411 static void pdump_register_struct (const void *data, |
409 const struct struct_description *sdesc, | 412 const struct struct_description *sdesc, |
410 int count); | 413 int count); |
411 | 414 |
412 static EMACS_INT | 415 static EMACS_INT |
465 switch (desc[pos].type) | 468 switch (desc[pos].type) |
466 { | 469 { |
467 case XD_SPECIFIER_END: | 470 case XD_SPECIFIER_END: |
468 pos = 0; | 471 pos = 0; |
469 desc = ((const Lisp_Specifier *)data)->methods->extra_description; | 472 desc = ((const Lisp_Specifier *)data)->methods->extra_description; |
473 goto restart; | |
474 case XD_CODING_SYSTEM_END: | |
475 pos = 0; | |
476 desc = | |
477 ((const Lisp_Coding_System *)data)->methods->extra_description; | |
470 goto restart; | 478 goto restart; |
471 case XD_BYTECOUNT: | 479 case XD_BYTECOUNT: |
472 case XD_ELEMCOUNT: | 480 case XD_ELEMCOUNT: |
473 case XD_HASHCODE: | 481 case XD_HASHCODE: |
474 case XD_INT: | 482 case XD_INT: |
539 | 547 |
540 pdump_register_struct (dobj, sdesc, count); | 548 pdump_register_struct (dobj, sdesc, count); |
541 } | 549 } |
542 break; | 550 break; |
543 } | 551 } |
552 case XD_STRUCT_ARRAY: | |
553 { | |
554 EMACS_INT count = desc[pos].data1; | |
555 const struct struct_description *sdesc = desc[pos].data2; | |
556 | |
557 if (XD_IS_INDIRECT (count)) | |
558 count = pdump_get_indirect_count (count, desc, data); | |
559 | |
560 pdump_register_struct_contents (rdata, sdesc, count); | |
561 break; | |
562 } | |
563 case XD_UNION: | |
564 abort (); /* #### IMPLEMENT ME! NEEDED FOR UNICODE SUPPORT */ | |
565 | |
544 default: | 566 default: |
545 stderr_out ("Unsupported dump type : %d\n", desc[pos].type); | 567 stderr_out ("Unsupported dump type : %d\n", desc[pos].type); |
546 pdump_backtrace (); | 568 pdump_backtrace (); |
547 abort (); | 569 abort (); |
548 }; | 570 }; |
568 imp = LHEADER_IMPLEMENTATION (objh); | 590 imp = LHEADER_IMPLEMENTATION (objh); |
569 | 591 |
570 if (imp->description) | 592 if (imp->description) |
571 { | 593 { |
572 int me = depth++; | 594 int me = depth++; |
573 if (me>65536) | 595 if (me > 65536) |
574 { | 596 { |
575 stderr_out ("Backtrace overflow, loop ?\n"); | 597 stderr_out ("Backtrace overflow, loop ?\n"); |
576 abort (); | 598 abort (); |
577 } | 599 } |
578 backtrace[me].obj = objh; | 600 backtrace[me].obj = objh; |
594 stderr_out ("Undumpable object type : %s\n", imp->name); | 616 stderr_out ("Undumpable object type : %s\n", imp->name); |
595 pdump_backtrace (); | 617 pdump_backtrace (); |
596 } | 618 } |
597 } | 619 } |
598 | 620 |
621 /* Return the size of the memory block (NOT necessarily a structure!) | |
622 described by SDESC and pointed to by OBJ. If SDESC records an | |
623 explicit size (i.e. non-zero), it is simply returned; otherwise, | |
624 the size is calculated by the maximum offset and the size of the | |
625 object at that offset, rounded up to the maximum alignment. In | |
626 this case, we may need the object, for example when retrieving an | |
627 "indirect count" of an inlined array (the count is not constant, | |
628 but is specified by one of the elements of the memory block). (It | |
629 is generally not a problem if we return an overly large size -- we | |
630 will simply end up reserving more space than necessary; but if the | |
631 size is too small we could be in serious trouble, in particular | |
632 with nested inlined structures, where there may be alignment | |
633 padding in the middle of a block. #### In fact there is an (at | |
634 least theoretical) problem with an overly large size -- we may | |
635 trigger a protection fault when reading from invalid memory. We | |
636 need to handle this -- perhaps in a stupid but dependable way, | |
637 i.e. by trapping SIGSEGV and SIGBUS.) */ | |
638 | |
639 static Bytecount | |
640 pdump_structure_size (const void *obj, const struct struct_description *sdesc) | |
641 { | |
642 int max_offset = -1; | |
643 int max_offset_pos = -1; | |
644 int size_at_max = 0; | |
645 int pos; | |
646 const struct lrecord_description *desc; | |
647 void *rdata; | |
648 | |
649 if (sdesc->size) | |
650 return sdesc->size; | |
651 | |
652 desc = sdesc->description; | |
653 | |
654 for (pos = 0; desc[pos].type != XD_END; pos++) | |
655 { | |
656 if (desc[pos].offset == max_offset) | |
657 { | |
658 stderr_out ("Two relocatable elements at same offset?\n"); | |
659 abort (); | |
660 } | |
661 else if (desc[pos].offset > max_offset) | |
662 { | |
663 max_offset = desc[pos].offset; | |
664 max_offset_pos = pos; | |
665 } | |
666 } | |
667 | |
668 if (max_offset_pos < 0) | |
669 return 0; | |
670 | |
671 pos = max_offset_pos; | |
672 rdata = (char *) obj + desc[pos].offset; | |
673 | |
674 switch (desc[pos].type) | |
675 { | |
676 case XD_LISP_OBJECT_ARRAY: | |
677 { | |
678 EMACS_INT val = desc[pos].data1; | |
679 if (XD_IS_INDIRECT (val)) | |
680 val = pdump_get_indirect_count (val, desc, obj); | |
681 size_at_max = val * sizeof (Lisp_Object); | |
682 break; | |
683 } | |
684 case XD_LISP_OBJECT: | |
685 case XD_LO_LINK: | |
686 size_at_max = sizeof (Lisp_Object); | |
687 break; | |
688 case XD_OPAQUE_PTR: | |
689 size_at_max = sizeof (void *); | |
690 break; | |
691 case XD_STRUCT_PTR: | |
692 { | |
693 EMACS_INT val = desc[pos].data1; | |
694 if (XD_IS_INDIRECT (val)) | |
695 val = pdump_get_indirect_count (val, desc, obj); | |
696 size_at_max = val * sizeof (void *); | |
697 break; | |
698 } | |
699 break; | |
700 case XD_STRUCT_ARRAY: | |
701 { | |
702 EMACS_INT val = desc[pos].data1; | |
703 | |
704 if (XD_IS_INDIRECT (val)) | |
705 val = pdump_get_indirect_count (val, desc, obj); | |
706 | |
707 size_at_max = val * pdump_structure_size (rdata, desc[pos].data2); | |
708 break; | |
709 } | |
710 break; | |
711 case XD_OPAQUE_DATA_PTR: | |
712 size_at_max = sizeof (void *); | |
713 break; | |
714 case XD_UNION: | |
715 abort (); /* #### IMPLEMENT ME! NEEDED FOR UNICODE | |
716 SUPPORT */ | |
717 break; | |
718 case XD_C_STRING: | |
719 size_at_max = sizeof (void *); | |
720 break; | |
721 case XD_DOC_STRING: | |
722 size_at_max = sizeof (void *); | |
723 break; | |
724 case XD_INT_RESET: | |
725 size_at_max = sizeof (int); | |
726 break; | |
727 case XD_BYTECOUNT: | |
728 size_at_max = sizeof (Bytecount); | |
729 break; | |
730 case XD_ELEMCOUNT: | |
731 size_at_max = sizeof (Elemcount); | |
732 break; | |
733 case XD_HASHCODE: | |
734 size_at_max = sizeof (Hashcode); | |
735 break; | |
736 case XD_INT: | |
737 size_at_max = sizeof (int); | |
738 break; | |
739 case XD_LONG: | |
740 size_at_max = sizeof (long); | |
741 break; | |
742 case XD_SPECIFIER_END: | |
743 case XD_CODING_SYSTEM_END: | |
744 stderr_out | |
745 ("Should not be seeing XD_SPECIFIER_END or\n" | |
746 "XD_CODING_SYSTEM_END outside of struct Lisp_Specifier\n" | |
747 "and struct Lisp_Coding_System.\n"); | |
748 abort (); | |
749 default: | |
750 stderr_out ("Unsupported dump type : %d\n", desc[pos].type); | |
751 abort (); | |
752 } | |
753 | |
754 /* We have no way of knowing the required alignment for this structure, | |
755 so just max it maximally aligned. */ | |
756 return ALIGN_SIZE (max_offset + size_at_max, ALIGNOF (max_align_t)); | |
757 } | |
758 | |
759 /* Register the referenced objects in the array of COUNT objects of | |
760 located at DATA; each object is described by SDESC. "Object" here | |
761 simply means any block of memory; it need not actually be a C | |
762 "struct". It could be a single integer or Lisp_Object, for | |
763 example, as long as the description is accurate. | |
764 | |
765 This does not register the block of memory itself; it may, for | |
766 example, be an array of structures inlined in another memory block | |
767 and thus should not be registered. See pdump_register_struct(), | |
768 which does register the memory block. */ | |
769 | |
770 static void | |
771 pdump_register_struct_contents (const void *data, | |
772 const struct struct_description *sdesc, | |
773 int count) | |
774 | |
775 { | |
776 int me = depth++; | |
777 int i; | |
778 Bytecount elsize; | |
779 | |
780 if (me>65536) | |
781 { | |
782 stderr_out ("Backtrace overflow, loop ?\n"); | |
783 abort (); | |
784 } | |
785 backtrace[me].obj = 0; | |
786 backtrace[me].position = 0; | |
787 backtrace[me].offset = 0; | |
788 | |
789 elsize = pdump_structure_size (data, sdesc); | |
790 | |
791 for (i = 0; i < count; i++) | |
792 { | |
793 pdump_register_sub (((char *) data) + elsize * i, | |
794 sdesc->description, | |
795 me); | |
796 } | |
797 --depth; | |
798 } | |
799 | |
800 /* Register the array of COUNT objects of located at DATA; each object is | |
801 described by SDESC. "Object" here simply means any block of memory; | |
802 it need not actually be a C "struct". It could be a single integer | |
803 or Lisp_Object, for example, as long as the description is accurate. | |
804 | |
805 This is like pdump_register_struct_contents() but also registers | |
806 the memory block itself. */ | |
807 | |
599 static void | 808 static void |
600 pdump_register_struct (const void *data, | 809 pdump_register_struct (const void *data, |
601 const struct struct_description *sdesc, | 810 const struct struct_description *sdesc, |
602 int count) | 811 int count) |
603 { | 812 { |
604 if (data && !pdump_get_entry (data)) | 813 if (data && !pdump_get_entry (data)) |
605 { | 814 { |
606 int me = depth++; | 815 pdump_add_entry (pdump_get_entry_list (sdesc), data, |
607 int i; | 816 pdump_structure_size (data, sdesc), count); |
608 if (me>65536) | 817 |
818 pdump_register_struct_contents (data, sdesc, count); | |
819 } | |
820 } | |
821 | |
822 /* Store the already-calculated new pointer offsets for all pointers | |
823 in the COUNT contiguous blocks of memory, each described by DESC | |
824 and of size SIZE, whose original is located at ORIG_DATA and the | |
825 modifiable copy at DATA. | |
826 | |
827 This is done just before writing the modified block of memory to | |
828 the dump file. The new pointer offsets have been carefully | |
829 calculated so that the data being pointed gets written at that | |
830 offset in the dump file. That way, the dump file is a correct | |
831 memory image except perhaps for a constant that needs to be added | |
832 to all pointers. (#### In fact, we SHOULD be starting up a dumped | |
833 XEmacs, seeing where the dumped file gets loaded into memory, and | |
834 then rewriting the dumped file after relocating all the pointers | |
835 relative to this memory location. That way, if the file gets | |
836 loaded again at the same location, which will be common, we don't | |
837 have to do any relocating, which is both faster at startup and | |
838 allows the read-only part of the dumped data to be shared read-only | |
839 between different invocations of XEmacs.) | |
840 | |
841 #### Do we distinguish between read-only and writable dumped data? | |
842 Should we? It's tricky because the dumped data, once loaded again, | |
843 cannot really be free()d or garbage collected since it's all stored | |
844 in one contiguous block of data with no malloc() headers, and we | |
845 don't keep track of the pointers used internally in malloc() and | |
846 the Lisp allocator to track allocated blocks of memory. */ | |
847 | |
848 static void | |
849 pdump_store_new_pointer_offsets (int count, void *data, const void *orig_data, | |
850 const struct lrecord_description *desc, | |
851 int size) | |
852 { | |
853 int pos, i; | |
854 /* Process each block one by one */ | |
855 for (i = 0; i < count; i++) | |
856 { | |
857 /* CUR points to the beginning of each block in the new data. */ | |
858 char *cur = ((char *)data) + i*size; | |
859 restart: | |
860 /* Scan each line of the description for relocatable pointers */ | |
861 for (pos = 0; desc[pos].type != XD_END; pos++) | |
609 { | 862 { |
610 stderr_out ("Backtrace overflow, loop ?\n"); | 863 /* RDATA points to the beginning of each element in the new data. */ |
611 abort (); | 864 void *rdata = cur + desc[pos].offset; |
865 switch (desc[pos].type) | |
866 { | |
867 case XD_SPECIFIER_END: | |
868 desc = ((const Lisp_Specifier *)(orig_data))-> | |
869 methods->extra_description; | |
870 goto restart; | |
871 case XD_CODING_SYSTEM_END: | |
872 desc = ((const Lisp_Coding_System *)(orig_data))-> | |
873 methods->extra_description; | |
874 goto restart; | |
875 case XD_BYTECOUNT: | |
876 case XD_ELEMCOUNT: | |
877 case XD_HASHCODE: | |
878 case XD_INT: | |
879 case XD_LONG: | |
880 break; | |
881 case XD_INT_RESET: | |
882 { | |
883 EMACS_INT val = desc[pos].data1; | |
884 if (XD_IS_INDIRECT (val)) | |
885 val = pdump_get_indirect_count (val, desc, orig_data); | |
886 * (int *) rdata = val; | |
887 break; | |
888 } | |
889 case XD_OPAQUE_DATA_PTR: | |
890 case XD_C_STRING: | |
891 case XD_STRUCT_PTR: | |
892 { | |
893 void *ptr = * (void **) rdata; | |
894 if (ptr) | |
895 * (EMACS_INT *) rdata = pdump_get_entry (ptr)->save_offset; | |
896 break; | |
897 } | |
898 case XD_LO_LINK: | |
899 { | |
900 /* As described in lrecord.h, this is a weak link. | |
901 Thus, we need to link this object not (necessarily) | |
902 to the object directly pointed to, but to the next | |
903 referenced object in the chain. None of the | |
904 intermediate objects will be written out, so we | |
905 traverse down the chain of objects until we find a | |
906 referenced one. (The Qnil or Qunbound that ends the | |
907 chain will always be a referenced object.) */ | |
908 Lisp_Object obj = * (Lisp_Object *) rdata; | |
909 pdump_entry_list_elt *elt1; | |
910 for (;;) | |
911 { | |
912 elt1 = pdump_get_entry (XRECORD_LHEADER (obj)); | |
913 if (elt1) | |
914 break; | |
915 obj = * (Lisp_Object *) (desc[pos].offset + | |
916 (char *)(XRECORD_LHEADER (obj))); | |
917 } | |
918 * (EMACS_INT *) rdata = elt1->save_offset; | |
919 break; | |
920 } | |
921 case XD_LISP_OBJECT: | |
922 { | |
923 Lisp_Object *pobj = (Lisp_Object *) rdata; | |
924 | |
925 assert (desc[pos].data1 == 0); | |
926 | |
927 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj)) | |
928 * (EMACS_INT *) pobj = | |
929 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset; | |
930 break; | |
931 } | |
932 case XD_LISP_OBJECT_ARRAY: | |
933 { | |
934 EMACS_INT num = desc[pos].data1; | |
935 int j; | |
936 if (XD_IS_INDIRECT (num)) | |
937 num = pdump_get_indirect_count (num, desc, orig_data); | |
938 | |
939 for (j = 0; j < num; j++) | |
940 { | |
941 Lisp_Object *pobj = ((Lisp_Object *) rdata) + j; | |
942 if (POINTER_TYPE_P (XTYPE (*pobj)) && | |
943 XRECORD_LHEADER (*pobj)) | |
944 * (EMACS_INT *) pobj = | |
945 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset; | |
946 } | |
947 break; | |
948 } | |
949 case XD_DOC_STRING: | |
950 { | |
951 EMACS_INT str = *(EMACS_INT *)rdata; | |
952 if (str > 0) | |
953 * (EMACS_INT *) rdata = | |
954 pdump_get_entry ((void *)str)->save_offset; | |
955 break; | |
956 } | |
957 case XD_STRUCT_ARRAY: | |
958 { | |
959 EMACS_INT num = desc[pos].data1; | |
960 if (XD_IS_INDIRECT (num)) | |
961 num = pdump_get_indirect_count (num, desc, orig_data); | |
962 | |
963 pdump_store_new_pointer_offsets | |
964 (num, rdata, | |
965 ((char *) rdata - (char *) data) + (char *) orig_data, | |
966 desc[pos].data2->description, | |
967 pdump_structure_size | |
968 (((char *) rdata - (char *) data) + (char *) orig_data, | |
969 desc[pos].data2)); | |
970 break; | |
971 } | |
972 case XD_UNION: | |
973 abort (); /* #### IMPLEMENT ME! NEEDED FOR UNICODE | |
974 SUPPORT */ | |
975 | |
976 default: | |
977 stderr_out ("Unsupported dump type : %d\n", desc[pos].type); | |
978 abort (); | |
979 } | |
612 } | 980 } |
613 backtrace[me].obj = 0; | 981 } |
614 backtrace[me].position = 0; | 982 } |
615 backtrace[me].offset = 0; | 983 |
616 | 984 /* Write out to global file descriptor PDUMP_OUT the element (one or |
617 pdump_add_entry (pdump_get_entry_list (sdesc), | 985 more contiguous blocks of identical size/description) recorded in |
618 data, sdesc->size, count); | 986 ELT and described by DESC. The element is first copied to a buffer |
619 for (i=0; i<count; i++) | 987 and then all pointers (this includes Lisp_Objects other than |
620 { | 988 integer/character) are relocated to the (pre-computed) offset in |
621 pdump_register_sub (((char *)data) + sdesc->size*i, | 989 the dump file. */ |
622 sdesc->description, | |
623 me); | |
624 } | |
625 --depth; | |
626 } | |
627 } | |
628 | 990 |
629 static void | 991 static void |
630 pdump_dump_data (pdump_entry_list_elt *elt, | 992 pdump_dump_data (pdump_entry_list_elt *elt, |
631 const struct lrecord_description *desc) | 993 const struct lrecord_description *desc) |
632 { | 994 { |
633 Bytecount size = elt->size; | 995 Bytecount size = elt->size; |
634 int count = elt->count; | 996 int count = elt->count; |
635 if (desc) | 997 if (desc) |
636 { | 998 { |
637 int pos, i; | 999 /* Copy to temporary buffer */ |
638 memcpy (pdump_buf, elt->obj, size*count); | 1000 memcpy (pdump_buf, elt->obj, size*count); |
639 | 1001 |
640 for (i=0; i<count; i++) | 1002 /* Store new offsets into all pointers in block */ |
641 { | 1003 pdump_store_new_pointer_offsets (count, pdump_buf, elt->obj, desc, size); |
642 char *cur = ((char *)pdump_buf) + i*size; | 1004 } |
643 restart: | 1005 retry_fwrite (desc ? pdump_buf : elt->obj, size, count, pdump_out); |
644 for (pos = 0; desc[pos].type != XD_END; pos++) | 1006 } |
645 { | 1007 |
646 void *rdata = cur + desc[pos].offset; | 1008 /* Relocate a single memory block at DATA, described by DESC, from its |
647 switch (desc[pos].type) | 1009 assumed load location to its actual one by adding DELTA to all |
648 { | 1010 pointers in the block. Does not recursively relocate any other |
649 case XD_SPECIFIER_END: | 1011 memory blocks pointed to. (We already have a list of all memory |
650 desc = ((const Lisp_Specifier *)(elt->obj))->methods->extra_description; | 1012 blocks in the dump file.) */ |
651 goto restart; | |
652 case XD_BYTECOUNT: | |
653 case XD_ELEMCOUNT: | |
654 case XD_HASHCODE: | |
655 case XD_INT: | |
656 case XD_LONG: | |
657 break; | |
658 case XD_INT_RESET: | |
659 { | |
660 EMACS_INT val = desc[pos].data1; | |
661 if (XD_IS_INDIRECT (val)) | |
662 val = pdump_get_indirect_count (val, desc, elt->obj); | |
663 *(int *)rdata = val; | |
664 break; | |
665 } | |
666 case XD_OPAQUE_DATA_PTR: | |
667 case XD_C_STRING: | |
668 case XD_STRUCT_PTR: | |
669 { | |
670 void *ptr = *(void **)rdata; | |
671 if (ptr) | |
672 *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset; | |
673 break; | |
674 } | |
675 case XD_LO_LINK: | |
676 { | |
677 Lisp_Object obj = *(Lisp_Object *)rdata; | |
678 pdump_entry_list_elt *elt1; | |
679 for (;;) | |
680 { | |
681 elt1 = pdump_get_entry (XRECORD_LHEADER (obj)); | |
682 if (elt1) | |
683 break; | |
684 obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj))); | |
685 } | |
686 *(EMACS_INT *)rdata = elt1->save_offset; | |
687 break; | |
688 } | |
689 case XD_LISP_OBJECT: | |
690 { | |
691 Lisp_Object *pobj = (Lisp_Object *) rdata; | |
692 | |
693 assert (desc[pos].data1 == 0); | |
694 | |
695 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj)) | |
696 *(EMACS_INT *)pobj = | |
697 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset; | |
698 break; | |
699 } | |
700 case XD_LISP_OBJECT_ARRAY: | |
701 { | |
702 EMACS_INT num = desc[pos].data1; | |
703 int j; | |
704 if (XD_IS_INDIRECT (num)) | |
705 num = pdump_get_indirect_count (num, desc, elt->obj); | |
706 | |
707 for (j=0; j<num; j++) | |
708 { | |
709 Lisp_Object *pobj = ((Lisp_Object *)rdata) + j; | |
710 if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj)) | |
711 *(EMACS_INT *)pobj = | |
712 pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset; | |
713 } | |
714 break; | |
715 } | |
716 case XD_DOC_STRING: | |
717 { | |
718 EMACS_INT str = *(EMACS_INT *)rdata; | |
719 if (str > 0) | |
720 *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset; | |
721 break; | |
722 } | |
723 default: | |
724 stderr_out ("Unsupported dump type : %d\n", desc[pos].type); | |
725 abort (); | |
726 } | |
727 } | |
728 } | |
729 } | |
730 fwrite (desc ? pdump_buf : elt->obj, size, count, pdump_out); | |
731 } | |
732 | 1013 |
733 static void | 1014 static void |
734 pdump_reloc_one (void *data, EMACS_INT delta, | 1015 pdump_reloc_one (void *data, EMACS_INT delta, |
735 const struct lrecord_description *desc) | 1016 const struct lrecord_description *desc) |
736 { | 1017 { |
743 switch (desc[pos].type) | 1024 switch (desc[pos].type) |
744 { | 1025 { |
745 case XD_SPECIFIER_END: | 1026 case XD_SPECIFIER_END: |
746 pos = 0; | 1027 pos = 0; |
747 desc = ((const Lisp_Specifier *)data)->methods->extra_description; | 1028 desc = ((const Lisp_Specifier *)data)->methods->extra_description; |
1029 goto restart; | |
1030 case XD_CODING_SYSTEM_END: | |
1031 pos = 0; | |
1032 desc = | |
1033 ((const Lisp_Coding_System *)data)->methods->extra_description; | |
748 goto restart; | 1034 goto restart; |
749 case XD_BYTECOUNT: | 1035 case XD_BYTECOUNT: |
750 case XD_ELEMCOUNT: | 1036 case XD_ELEMCOUNT: |
751 case XD_HASHCODE: | 1037 case XD_HASHCODE: |
752 case XD_INT: | 1038 case XD_INT: |
797 EMACS_INT str = *(EMACS_INT *)rdata; | 1083 EMACS_INT str = *(EMACS_INT *)rdata; |
798 if (str > 0) | 1084 if (str > 0) |
799 *(EMACS_INT *)rdata = str + delta; | 1085 *(EMACS_INT *)rdata = str + delta; |
800 break; | 1086 break; |
801 } | 1087 } |
1088 case XD_STRUCT_ARRAY: | |
1089 { | |
1090 EMACS_INT num = desc[pos].data1; | |
1091 int j; | |
1092 const struct struct_description *sdesc = desc[pos].data2; | |
1093 Bytecount size = pdump_structure_size (rdata, sdesc); | |
1094 | |
1095 if (XD_IS_INDIRECT (num)) | |
1096 num = pdump_get_indirect_count (num, desc, data); | |
1097 /* Note: We are recursing over data in the block itself */ | |
1098 for (j = 0; j < num; j++) | |
1099 pdump_reloc_one ((char *) rdata + j * size, delta, | |
1100 sdesc->description); | |
1101 | |
1102 break; | |
1103 } | |
1104 | |
1105 case XD_UNION: | |
1106 abort (); /* #### IMPLEMENT ME! NEEDED FOR UNICODE SUPPORT */ | |
802 default: | 1107 default: |
803 stderr_out ("Unsupported dump type : %d\n", desc[pos].type); | 1108 stderr_out ("Unsupported dump type : %d\n", desc[pos].type); |
804 abort (); | 1109 abort (); |
805 }; | 1110 }; |
806 } | 1111 } |
857 { | 1162 { |
858 data[i].address = (char **) Dynarr_atp (pdump_root_struct_ptrs, i)->ptraddress; | 1163 data[i].address = (char **) Dynarr_atp (pdump_root_struct_ptrs, i)->ptraddress; |
859 data[i].value = (char *) pdump_get_entry (* data[i].address)->save_offset; | 1164 data[i].value = (char *) pdump_get_entry (* data[i].address)->save_offset; |
860 } | 1165 } |
861 PDUMP_ALIGN_OUTPUT (pdump_static_pointer); | 1166 PDUMP_ALIGN_OUTPUT (pdump_static_pointer); |
862 fwrite (data, sizeof (pdump_static_pointer), count, pdump_out); | 1167 retry_fwrite (data, sizeof (pdump_static_pointer), count, pdump_out); |
863 } | 1168 } |
864 | 1169 |
865 static void | 1170 static void |
866 pdump_dump_opaques (void) | 1171 pdump_dump_opaques (void) |
867 { | 1172 { |
868 int i; | 1173 int i; |
869 for (i = 0; i < Dynarr_length (pdump_opaques); i++) | 1174 for (i = 0; i < Dynarr_length (pdump_opaques); i++) |
870 { | 1175 { |
871 pdump_opaque *info = Dynarr_atp (pdump_opaques, i); | 1176 pdump_opaque *info = Dynarr_atp (pdump_opaques, i); |
872 PDUMP_WRITE_ALIGNED (pdump_opaque, *info); | 1177 PDUMP_WRITE_ALIGNED (pdump_opaque, *info); |
873 fwrite (info->varaddress, info->size, 1, pdump_out); | 1178 retry_fwrite (info->varaddress, info->size, 1, pdump_out); |
874 } | 1179 } |
875 } | 1180 } |
876 | 1181 |
877 static void | 1182 static void |
878 pdump_dump_rtables (void) | 1183 pdump_dump_rtables (void) |
1054 pdump_scan_by_alignment (pdump_allocate_offset); | 1359 pdump_scan_by_alignment (pdump_allocate_offset); |
1055 cur_offset = ALIGN_SIZE (cur_offset, ALIGNOF (max_align_t)); | 1360 cur_offset = ALIGN_SIZE (cur_offset, ALIGNOF (max_align_t)); |
1056 header.stab_offset = cur_offset; | 1361 header.stab_offset = cur_offset; |
1057 | 1362 |
1058 pdump_buf = xmalloc (max_size); | 1363 pdump_buf = xmalloc (max_size); |
1059 /* Avoid use of the `open' macro. We want the real function. */ | |
1060 #undef open | |
1061 pdump_fd = open (EMACS_PROGNAME ".dmp", | 1364 pdump_fd = open (EMACS_PROGNAME ".dmp", |
1062 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666); | 1365 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666); |
1366 if (pdump_fd < 0) | |
1367 report_file_error ("Unable to open dump file", | |
1368 build_string (EMACS_PROGNAME ".dmp")); | |
1063 pdump_out = fdopen (pdump_fd, "w"); | 1369 pdump_out = fdopen (pdump_fd, "w"); |
1064 | 1370 if (pdump_out < 0) |
1065 fwrite (&header, sizeof (header), 1, pdump_out); | 1371 report_file_error ("Unable to open dump file for writing", |
1372 build_string (EMACS_PROGNAME ".dmp")); | |
1373 | |
1374 retry_fwrite (&header, sizeof (header), 1, pdump_out); | |
1066 PDUMP_ALIGN_OUTPUT (max_align_t); | 1375 PDUMP_ALIGN_OUTPUT (max_align_t); |
1067 | 1376 |
1068 pdump_scan_by_alignment (pdump_dump_data); | 1377 pdump_scan_by_alignment (pdump_dump_data); |
1069 | 1378 |
1070 fseek (pdump_out, header.stab_offset, SEEK_SET); | 1379 fseek (pdump_out, header.stab_offset, SEEK_SET); |
1072 pdump_dump_root_struct_ptrs (); | 1381 pdump_dump_root_struct_ptrs (); |
1073 pdump_dump_opaques (); | 1382 pdump_dump_opaques (); |
1074 pdump_dump_rtables (); | 1383 pdump_dump_rtables (); |
1075 pdump_dump_root_objects (); | 1384 pdump_dump_root_objects (); |
1076 | 1385 |
1077 fclose (pdump_out); | 1386 retry_fclose (pdump_out); |
1078 close (pdump_fd); | 1387 retry_close (pdump_fd); |
1079 | 1388 |
1080 free (pdump_buf); | 1389 free (pdump_buf); |
1081 | 1390 |
1082 free (pdump_hash); | 1391 free (pdump_hash); |
1083 | 1392 |
1298 return 0; | 1607 return 0; |
1299 | 1608 |
1300 pdump_length = lseek (fd, 0, SEEK_END); | 1609 pdump_length = lseek (fd, 0, SEEK_END); |
1301 if (pdump_length < (Bytecount) sizeof (pdump_header)) | 1610 if (pdump_length < (Bytecount) sizeof (pdump_header)) |
1302 { | 1611 { |
1303 close (fd); | 1612 retry_close (fd); |
1304 return 0; | 1613 return 0; |
1305 } | 1614 } |
1306 | 1615 |
1307 lseek (fd, 0, SEEK_SET); | 1616 lseek (fd, 0, SEEK_SET); |
1308 | 1617 |
1314 # endif | 1623 # endif |
1315 pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0); | 1624 pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0); |
1316 if (pdump_start != (char *) MAP_FAILED) | 1625 if (pdump_start != (char *) MAP_FAILED) |
1317 { | 1626 { |
1318 pdump_free = pdump_file_unmap; | 1627 pdump_free = pdump_file_unmap; |
1319 close (fd); | 1628 retry_close (fd); |
1320 return 1; | 1629 return 1; |
1321 } | 1630 } |
1322 #endif /* HAVE_MMAP */ | 1631 #endif /* HAVE_MMAP */ |
1323 | 1632 |
1324 pdump_start = xnew_array (char, pdump_length); | 1633 pdump_start = xnew_array (char, pdump_length); |
1325 pdump_free = pdump_file_free; | 1634 pdump_free = pdump_file_free; |
1326 read (fd, pdump_start, pdump_length); | 1635 retry_read (fd, pdump_start, pdump_length); |
1327 | 1636 |
1328 close (fd); | 1637 retry_close (fd); |
1329 return 1; | 1638 return 1; |
1330 } | 1639 } |
1331 #endif /* !WIN32_NATIVE */ | 1640 #endif /* !WIN32_NATIVE */ |
1332 | 1641 |
1333 | 1642 |
1369 while (w>exe_path && !IS_DIRECTORY_SEP (*w)); | 1678 while (w>exe_path && !IS_DIRECTORY_SEP (*w)); |
1370 return 0; | 1679 return 0; |
1371 } | 1680 } |
1372 | 1681 |
1373 int | 1682 int |
1374 pdump_load (const char *argv0) | 1683 pdump_load (const Extbyte *argv0) |
1375 { | 1684 { |
1376 char exe_path[PATH_MAX]; | 1685 Extbyte exe_path[PATH_MAX]; |
1377 #ifdef WIN32_NATIVE | 1686 #ifdef WIN32_NATIVE |
1378 GetModuleFileName (NULL, exe_path, PATH_MAX); | 1687 GetModuleFileName (NULL, exe_path, PATH_MAX); |
1379 #else /* !WIN32_NATIVE */ | 1688 #else /* !WIN32_NATIVE */ |
1380 char *w; | 1689 Extbyte *w; |
1381 const char *dir, *p; | 1690 const Extbyte *dir, *p; |
1382 | 1691 |
1383 dir = argv0; | 1692 dir = argv0; |
1384 if (dir[0] == '-') | 1693 if (dir[0] == '-') |
1385 { | 1694 { |
1386 /* XEmacs as a login shell, oh goody! */ | 1695 /* XEmacs as a login shell, oh goody! */ |
1387 dir = getenv ("SHELL"); | 1696 dir = getenv ("SHELL"); /* not egetenv -- not yet initialized */ |
1388 } | 1697 } |
1389 | 1698 |
1390 p = dir + strlen (dir); | 1699 p = dir + strlen (dir); |
1391 while (p != dir && !IS_ANY_SEP (p[-1])) p--; | 1700 while (p != dir && !IS_ANY_SEP (p[-1])) p--; |
1392 | 1701 |
1396 is relative to cwd, not $PATH */ | 1705 is relative to cwd, not $PATH */ |
1397 strcpy (exe_path, dir); | 1706 strcpy (exe_path, dir); |
1398 } | 1707 } |
1399 else | 1708 else |
1400 { | 1709 { |
1401 const char *path = getenv ("PATH"); | 1710 const Extbyte *path = getenv ("PATH"); /* not egetenv -- not yet init. */ |
1402 const char *name = p; | 1711 const Extbyte *name = p; |
1403 for (;;) | 1712 for (;;) |
1404 { | 1713 { |
1405 p = path; | 1714 p = path; |
1406 while (*p && *p != SEPCHAR) | 1715 while (*p && *p != SEPCHAR) |
1407 p++; | 1716 p++; |
1419 { | 1728 { |
1420 *w++ = '/'; | 1729 *w++ = '/'; |
1421 } | 1730 } |
1422 strcpy (w, name); | 1731 strcpy (w, name); |
1423 | 1732 |
1424 /* ### #$%$#^$^@%$^#%@$ ! */ | |
1425 #ifdef access | |
1426 #undef access | |
1427 #endif | |
1428 | |
1429 if (!access (exe_path, X_OK)) | 1733 if (!access (exe_path, X_OK)) |
1430 break; | 1734 break; |
1431 if (!*p) | 1735 if (!*p) |
1432 { | 1736 { |
1433 /* Oh well, let's have some kind of default */ | 1737 /* Oh well, let's have some kind of default */ |