Mercurial > hg > xemacs-beta

comparison src/dumper.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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 */