Mercurial > hg > xemacs-beta
comparison src/alloc.c @ 934:c925bacdda60
[xemacs-hg @ 2002-07-29 09:21:12 by michaels]
2002-07-17 Marcus Crestani <crestani@informatik.uni-tuebingen.de>
Markus Kaltenbach <makalten@informatik.uni-tuebingen.de>
Mike Sperber <mike@xemacs.org>
configure flag to turn these changes on: --use-kkcc
First we added a dumpable flag to lrecord_implementation. It shows,
if the object is dumpable and should be processed by the dumper.
* lrecord.h (struct lrecord_implementation): added dumpable flag
(MAKE_LRECORD_IMPLEMENTATION): fitted the different makro definitions
to the new lrecord_implementation and their calls.
Then we changed mark_object, that it no longer needs a mark method for
those types that have pdump descritions.
* alloc.c:
(mark_object): If the object has a description, the new mark algorithm
is called, and the object is marked according to its description.
Otherwise it uses the mark method like before.
These procedures mark objects according to their descriptions. They
are modeled on the corresponding pdumper procedures.
(mark_with_description):
(get_indirect_count):
(structure_size):
(mark_struct_contents):
These procedures still call mark_object, this is needed while there are
Lisp_Objects without descriptions left.
We added pdump descriptions for many Lisp_Objects:
* extents.c: extent_auxiliary_description
* database.c: database_description
* gui.c: gui_item_description
* scrollbar.c: scrollbar_instance_description
* toolbar.c: toolbar_button_description
* event-stream.c: command_builder_description
* mule-charset.c: charset_description
* device-msw.c: devmode_description
* dialog-msw.c: mswindows_dialog_id_description
* eldap.c: ldap_description
* postgresql.c: pgconn_description
pgresult_description
* tooltalk.c: tooltalk_message_description
tooltalk_pattern_description
* ui-gtk.c: emacs_ffi_description
emacs_gtk_object_description
* events.c:
* events.h:
* event-stream.c:
* event-Xt.c:
* event-gtk.c:
* event-tty.c:
To write a pdump description for Lisp_Event, we converted every struct
in the union event to a Lisp_Object. So we created nine new
Lisp_Objects: Lisp_Key_Data, Lisp_Button_Data, Lisp_Motion_Data,
Lisp_Process_Data, Lisp_Timeout_Data, Lisp_Eval_Data,
Lisp_Misc_User_Data, Lisp_Magic_Data, Lisp_Magic_Eval_Data.
We also wrote makro selectors and mutators for the fields of the new
designed Lisp_Event and added everywhere these new abstractions.
We implemented XD_UNION support in (mark_with_description), so
we can describe exspecially console/device specific data with XD_UNION.
To describe with XD_UNION, we added a field to these objects, which
holds the variant type of the object. This field is initialized in
the appendant constructor. The variant is an integer, it has also to
be described in an description, if XD_UNION is used.
XD_UNION is used in following descriptions:
* console.c: console_description
(get_console_variant): returns the variant
(create_console): added variant initialization
* console.h (console_variant): the different console types
* console-impl.h (struct console): added enum console_variant contype
* device.c: device_description
(Fmake_device): added variant initialization
* device-impl.h (struct device): added enum console_variant devtype
* objects.c: image_instance_description
font_instance_description
(Fmake_color_instance): added variant initialization
(Fmake_font_instance): added variant initialization
* objects-impl.h (struct Lisp_Color_Instance): added color_instance_type
* objects-impl.h (struct Lisp_Font_Instance): added font_instance_type
* process.c: process_description
(make_process_internal): added variant initialization
* process.h (process_variant): the different process types
author | michaels |
---|---|
date | Mon, 29 Jul 2002 09:21:25 +0000 |
parents | ccc3177ef10b |
children | 345b7d75cab4 |
comparison
equal
deleted
inserted
replaced
933:f6bc42928b34 | 934:c925bacdda60 |
---|---|
58 #include "specifier.h" | 58 #include "specifier.h" |
59 #include "sysfile.h" | 59 #include "sysfile.h" |
60 #include "sysdep.h" | 60 #include "sysdep.h" |
61 #include "window.h" | 61 #include "window.h" |
62 #include "console-stream.h" | 62 #include "console-stream.h" |
63 | |
64 #ifdef USE_KKCC | |
65 #include "file-coding.h" | |
66 #endif /* USE_KKCC */ | |
63 | 67 |
64 #ifdef DOUG_LEA_MALLOC | 68 #ifdef DOUG_LEA_MALLOC |
65 #include <malloc.h> | 69 #include <malloc.h> |
66 #endif | 70 #endif |
67 | 71 |
935 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) }, | 939 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) }, |
936 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) }, | 940 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) }, |
937 { XD_END } | 941 { XD_END } |
938 }; | 942 }; |
939 | 943 |
944 #ifdef USE_KKCC | |
945 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, | |
946 1, /*dumpable-flag*/ | |
947 mark_cons, print_cons, 0, | |
948 cons_equal, | |
949 /* | |
950 * No `hash' method needed. | |
951 * internal_hash knows how to | |
952 * handle conses. | |
953 */ | |
954 0, | |
955 cons_description, | |
956 Lisp_Cons); | |
957 #else /* not USE_KKCC */ | |
940 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, | 958 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, |
941 mark_cons, print_cons, 0, | 959 mark_cons, print_cons, 0, |
942 cons_equal, | 960 cons_equal, |
943 /* | 961 /* |
944 * No `hash' method needed. | 962 * No `hash' method needed. |
946 * handle conses. | 964 * handle conses. |
947 */ | 965 */ |
948 0, | 966 0, |
949 cons_description, | 967 cons_description, |
950 Lisp_Cons); | 968 Lisp_Cons); |
969 #endif /* not USE_KKCC */ | |
951 | 970 |
952 DEFUN ("cons", Fcons, 2, 2, 0, /* | 971 DEFUN ("cons", Fcons, 2, 2, 0, /* |
953 Create a new cons, give it CAR and CDR as components, and return it. | 972 Create a new cons, give it CAR and CDR as components, and return it. |
954 */ | 973 */ |
955 (car, cdr)) | 974 (car, cdr)) |
1153 { XD_LONG, offsetof (Lisp_Vector, size) }, | 1172 { XD_LONG, offsetof (Lisp_Vector, size) }, |
1154 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Vector, contents), XD_INDIRECT(0, 0) }, | 1173 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Vector, contents), XD_INDIRECT(0, 0) }, |
1155 { XD_END } | 1174 { XD_END } |
1156 }; | 1175 }; |
1157 | 1176 |
1177 #ifdef USE_KKCC | |
1178 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector, | |
1179 1, /*dumpable-flag*/ | |
1180 mark_vector, print_vector, 0, | |
1181 vector_equal, | |
1182 vector_hash, | |
1183 vector_description, | |
1184 size_vector, Lisp_Vector); | |
1185 #else /* not USE_KKCC */ | |
1158 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector, | 1186 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector, |
1159 mark_vector, print_vector, 0, | 1187 mark_vector, print_vector, 0, |
1160 vector_equal, | 1188 vector_equal, |
1161 vector_hash, | 1189 vector_hash, |
1162 vector_description, | 1190 vector_description, |
1163 size_vector, Lisp_Vector); | 1191 size_vector, Lisp_Vector); |
1164 | 1192 #endif /* not USE_KKCC */ |
1165 /* #### should allocate `small' vectors from a frob-block */ | 1193 /* #### should allocate `small' vectors from a frob-block */ |
1166 static Lisp_Vector * | 1194 static Lisp_Vector * |
1167 make_vector_internal (Elemcount sizei) | 1195 make_vector_internal (Elemcount sizei) |
1168 { | 1196 { |
1169 /* no vector_next */ | 1197 /* no vector_next */ |
1659 set_lheader_implementation (&e->lheader, &lrecord_event); | 1687 set_lheader_implementation (&e->lheader, &lrecord_event); |
1660 | 1688 |
1661 return wrap_event (e); | 1689 return wrap_event (e); |
1662 } | 1690 } |
1663 | 1691 |
1692 #ifdef USE_KKCC | |
1693 DECLARE_FIXED_TYPE_ALLOC (key_data, Lisp_Key_Data); | |
1694 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_key_data 1000 | |
1695 | |
1696 Lisp_Object | |
1697 allocate_key_data (void) | |
1698 { | |
1699 Lisp_Key_Data *d; | |
1700 | |
1701 ALLOCATE_FIXED_TYPE (key_data, Lisp_Key_Data, d); | |
1702 set_lheader_implementation (&d->lheader, &lrecord_key_data); | |
1703 | |
1704 return wrap_key_data(d); | |
1705 } | |
1706 | |
1707 DECLARE_FIXED_TYPE_ALLOC (button_data, Lisp_Button_Data); | |
1708 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_button_data 1000 | |
1709 | |
1710 Lisp_Object | |
1711 allocate_button_data (void) | |
1712 { | |
1713 Lisp_Button_Data *d; | |
1714 | |
1715 ALLOCATE_FIXED_TYPE (button_data, Lisp_Button_Data, d); | |
1716 set_lheader_implementation (&d->lheader, &lrecord_button_data); | |
1717 | |
1718 return wrap_button_data(d); | |
1719 } | |
1720 | |
1721 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data); | |
1722 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000 | |
1723 | |
1724 Lisp_Object | |
1725 allocate_motion_data (void) | |
1726 { | |
1727 Lisp_Motion_Data *d; | |
1728 | |
1729 ALLOCATE_FIXED_TYPE (motion_data, Lisp_Motion_Data, d); | |
1730 set_lheader_implementation (&d->lheader, &lrecord_motion_data); | |
1731 | |
1732 return wrap_motion_data(d); | |
1733 } | |
1734 | |
1735 DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data); | |
1736 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_process_data 1000 | |
1737 | |
1738 Lisp_Object | |
1739 allocate_process_data (void) | |
1740 { | |
1741 Lisp_Process_Data *d; | |
1742 | |
1743 ALLOCATE_FIXED_TYPE (process_data, Lisp_Process_Data, d); | |
1744 set_lheader_implementation (&d->lheader, &lrecord_process_data); | |
1745 | |
1746 return wrap_process_data(d); | |
1747 } | |
1748 | |
1749 DECLARE_FIXED_TYPE_ALLOC (timeout_data, Lisp_Timeout_Data); | |
1750 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_timeout_data 1000 | |
1751 | |
1752 Lisp_Object | |
1753 allocate_timeout_data (void) | |
1754 { | |
1755 Lisp_Timeout_Data *d; | |
1756 | |
1757 ALLOCATE_FIXED_TYPE (timeout_data, Lisp_Timeout_Data, d); | |
1758 set_lheader_implementation (&d->lheader, &lrecord_timeout_data); | |
1759 | |
1760 return wrap_timeout_data(d); | |
1761 } | |
1762 | |
1763 DECLARE_FIXED_TYPE_ALLOC (magic_data, Lisp_Magic_Data); | |
1764 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_data 1000 | |
1765 | |
1766 Lisp_Object | |
1767 allocate_magic_data (void) | |
1768 { | |
1769 Lisp_Magic_Data *d; | |
1770 | |
1771 ALLOCATE_FIXED_TYPE (magic_data, Lisp_Magic_Data, d); | |
1772 set_lheader_implementation (&d->lheader, &lrecord_magic_data); | |
1773 | |
1774 return wrap_magic_data(d); | |
1775 } | |
1776 | |
1777 DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data); | |
1778 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_eval_data 1000 | |
1779 | |
1780 Lisp_Object | |
1781 allocate_magic_eval_data (void) | |
1782 { | |
1783 Lisp_Magic_Eval_Data *d; | |
1784 | |
1785 ALLOCATE_FIXED_TYPE (magic_eval_data, Lisp_Magic_Eval_Data, d); | |
1786 set_lheader_implementation (&d->lheader, &lrecord_magic_eval_data); | |
1787 | |
1788 return wrap_magic_eval_data(d); | |
1789 } | |
1790 | |
1791 DECLARE_FIXED_TYPE_ALLOC (eval_data, Lisp_Eval_Data); | |
1792 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_eval_data 1000 | |
1793 | |
1794 Lisp_Object | |
1795 allocate_eval_data (void) | |
1796 { | |
1797 Lisp_Eval_Data *d; | |
1798 | |
1799 ALLOCATE_FIXED_TYPE (eval_data, Lisp_Eval_Data, d); | |
1800 set_lheader_implementation (&d->lheader, &lrecord_eval_data); | |
1801 | |
1802 return wrap_eval_data(d); | |
1803 } | |
1804 | |
1805 DECLARE_FIXED_TYPE_ALLOC (misc_user_data, Lisp_Misc_User_Data); | |
1806 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_misc_user_data 1000 | |
1807 | |
1808 Lisp_Object | |
1809 allocate_misc_user_data (void) | |
1810 { | |
1811 Lisp_Misc_User_Data *d; | |
1812 | |
1813 ALLOCATE_FIXED_TYPE (misc_user_data, Lisp_Misc_User_Data, d); | |
1814 set_lheader_implementation (&d->lheader, &lrecord_misc_user_data); | |
1815 | |
1816 return wrap_misc_user_data(d); | |
1817 } | |
1818 #endif /* USE_KKCC */ | |
1664 | 1819 |
1665 /************************************************************************/ | 1820 /************************************************************************/ |
1666 /* Marker allocation */ | 1821 /* Marker allocation */ |
1667 /************************************************************************/ | 1822 /************************************************************************/ |
1668 | 1823 |
1797 /* No `finalize', or `hash' methods. | 1952 /* No `finalize', or `hash' methods. |
1798 internal_hash() already knows how to hash strings and finalization | 1953 internal_hash() already knows how to hash strings and finalization |
1799 is done with the ADDITIONAL_FREE_string macro, which is the | 1954 is done with the ADDITIONAL_FREE_string macro, which is the |
1800 standard way to do finalization when using | 1955 standard way to do finalization when using |
1801 SWEEP_FIXED_TYPE_BLOCK(). */ | 1956 SWEEP_FIXED_TYPE_BLOCK(). */ |
1957 #ifdef USE_KKCC | |
1958 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, | |
1959 1, /*dumpable-flag*/ | |
1960 mark_string, print_string, | |
1961 0, string_equal, 0, | |
1962 string_description, | |
1963 string_getprop, | |
1964 string_putprop, | |
1965 string_remprop, | |
1966 string_plist, | |
1967 Lisp_String); | |
1968 #else /* not USE_KKCC */ | |
1802 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, | 1969 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, |
1803 mark_string, print_string, | 1970 mark_string, print_string, |
1804 0, string_equal, 0, | 1971 0, string_equal, 0, |
1805 string_description, | 1972 string_description, |
1806 string_getprop, | 1973 string_getprop, |
1807 string_putprop, | 1974 string_putprop, |
1808 string_remprop, | 1975 string_remprop, |
1809 string_plist, | 1976 string_plist, |
1810 Lisp_String); | 1977 Lisp_String); |
1811 | 1978 #endif /* not USE_KKCC */ |
1812 /* String blocks contain this many useful bytes. */ | 1979 /* String blocks contain this many useful bytes. */ |
1813 #define STRING_CHARS_BLOCK_SIZE \ | 1980 #define STRING_CHARS_BLOCK_SIZE \ |
1814 ((Bytecount) (8192 - MALLOC_OVERHEAD - \ | 1981 ((Bytecount) (8192 - MALLOC_OVERHEAD - \ |
1815 ((2 * sizeof (struct string_chars_block *)) \ | 1982 ((2 * sizeof (struct string_chars_block *)) \ |
1816 + sizeof (EMACS_INT)))) | 1983 + sizeof (EMACS_INT)))) |
2378 } | 2545 } |
2379 | 2546 |
2380 return Qnil; | 2547 return Qnil; |
2381 } | 2548 } |
2382 | 2549 |
2550 #ifdef USE_KKCC | |
2551 DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, | |
2552 0, /*dumpable-flag*/ | |
2553 mark_lcrecord_list, internal_object_printer, | |
2554 0, 0, 0, 0, struct lcrecord_list); | |
2555 #else /* not USE_KKCC */ | |
2383 DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, | 2556 DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, |
2384 mark_lcrecord_list, internal_object_printer, | 2557 mark_lcrecord_list, internal_object_printer, |
2385 0, 0, 0, 0, struct lcrecord_list); | 2558 0, 0, 0, 0, struct lcrecord_list); |
2559 #endif /* not USE_KKCC */ | |
2560 | |
2386 Lisp_Object | 2561 Lisp_Object |
2387 make_lcrecord_list (Elemcount size, | 2562 make_lcrecord_list (Elemcount size, |
2388 const struct lrecord_implementation *implementation) | 2563 const struct lrecord_implementation *implementation) |
2389 { | 2564 { |
2390 struct lcrecord_list *p = | 2565 struct lcrecord_list *p = |
2661 } while (0) | 2836 } while (0) |
2662 #else | 2837 #else |
2663 #define GC_CHECK_LHEADER_INVARIANTS(lheader) | 2838 #define GC_CHECK_LHEADER_INVARIANTS(lheader) |
2664 #endif | 2839 #endif |
2665 | 2840 |
2666 | 2841 |
2842 | |
2843 #ifdef USE_KKCC | |
2844 /* The following functions implement the new mark algorithm. | |
2845 They mark objects according to their descriptions. They | |
2846 are modeled on the corresponding pdumper procedures. */ | |
2847 | |
2848 static void mark_struct_contents (const void *data, | |
2849 const struct struct_description * | |
2850 sdesc, | |
2851 int count); | |
2852 | |
2853 /* This function extracts the value of a count variable described somewhere | |
2854 else in the description. It is converted corresponding to the type */ | |
2855 static EMACS_INT | |
2856 get_indirect_count (EMACS_INT code, | |
2857 const struct lrecord_description *idesc, | |
2858 const void *idata) | |
2859 { | |
2860 EMACS_INT count; | |
2861 const void *irdata; | |
2862 | |
2863 int line = XD_INDIRECT_VAL (code); | |
2864 int delta = XD_INDIRECT_DELTA (code); | |
2865 | |
2866 irdata = ((char *)idata) + idesc[line].offset; | |
2867 switch (idesc[line].type) | |
2868 { | |
2869 case XD_BYTECOUNT: | |
2870 count = *(Bytecount *)irdata; | |
2871 break; | |
2872 case XD_ELEMCOUNT: | |
2873 count = *(Elemcount *)irdata; | |
2874 break; | |
2875 case XD_HASHCODE: | |
2876 count = *(Hashcode *)irdata; | |
2877 break; | |
2878 case XD_INT: | |
2879 count = *(int *)irdata; | |
2880 break; | |
2881 case XD_LONG: | |
2882 count = *(long *)irdata; | |
2883 break; | |
2884 default: | |
2885 stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n", | |
2886 idesc[line].type, line, (long)code); | |
2887 count = 0; /* warning suppression */ | |
2888 abort (); | |
2889 } | |
2890 count += delta; | |
2891 return count; | |
2892 } | |
2893 | |
2894 /* This function is called to mark the elements of an object. It processes | |
2895 the description of the object and calls mark object with every described | |
2896 object. */ | |
2897 static void | |
2898 mark_with_description (const void *lheader, const struct lrecord_description *desc) | |
2899 { | |
2900 int pos; | |
2901 | |
2902 static const Lisp_Object *last_occured_object = (Lisp_Object *) 0; | |
2903 static int mark_last_occured_object = 0; | |
2904 | |
2905 reprocess_desc: | |
2906 for (pos=0; desc[pos].type != XD_END; pos++) | |
2907 { | |
2908 const void *rdata = (const char *)lheader + desc[pos].offset; | |
2909 switch (desc[pos].type) { | |
2910 case XD_LISP_OBJECT: | |
2911 { | |
2912 const Lisp_Object *stored_obj = (const Lisp_Object *)rdata; | |
2913 if (!(*stored_obj)){ | |
2914 break; | |
2915 } | |
2916 | |
2917 if (desc[pos+1].type == XD_END) | |
2918 { | |
2919 mark_last_occured_object = 1; | |
2920 last_occured_object = stored_obj; | |
2921 break; | |
2922 } | |
2923 else | |
2924 { | |
2925 mark_object (*stored_obj); | |
2926 } | |
2927 | |
2928 | |
2929 break; | |
2930 } | |
2931 case XD_LISP_OBJECT_ARRAY: | |
2932 { | |
2933 int i; | |
2934 EMACS_INT count = desc[pos].data1; | |
2935 if (XD_IS_INDIRECT (count)) | |
2936 count = get_indirect_count (count, desc, lheader); | |
2937 | |
2938 for (i = 0; i < count; i++) | |
2939 { | |
2940 const Lisp_Object *stored_obj = ((const Lisp_Object *)rdata) + i; | |
2941 if (!(*stored_obj)) | |
2942 { | |
2943 break; | |
2944 } | |
2945 | |
2946 mark_object (*stored_obj); | |
2947 } | |
2948 break; | |
2949 } | |
2950 case XD_SPECIFIER_END: | |
2951 desc = ((const Lisp_Specifier *)lheader)->methods->extra_description; | |
2952 goto reprocess_desc; | |
2953 break; | |
2954 case XD_CODING_SYSTEM_END: | |
2955 desc = ((const Lisp_Coding_System *)lheader)->methods->extra_description; | |
2956 goto reprocess_desc; | |
2957 break; | |
2958 case XD_BYTECOUNT: | |
2959 break; | |
2960 case XD_ELEMCOUNT: | |
2961 break; | |
2962 case XD_HASHCODE: | |
2963 break; | |
2964 case XD_INT: | |
2965 break; | |
2966 case XD_LONG: | |
2967 break; | |
2968 case XD_INT_RESET: | |
2969 break; | |
2970 case XD_LO_LINK: | |
2971 break; | |
2972 case XD_OPAQUE_PTR: | |
2973 break; | |
2974 case XD_OPAQUE_DATA_PTR: | |
2975 break; | |
2976 case XD_C_STRING: | |
2977 break; | |
2978 case XD_DOC_STRING: | |
2979 break; | |
2980 case XD_STRUCT_PTR: | |
2981 { | |
2982 EMACS_INT count = desc[pos].data1; | |
2983 const struct struct_description *sdesc = desc[pos].data2; | |
2984 const char *dobj = *(const char **)rdata; | |
2985 if (dobj) | |
2986 { | |
2987 if (XD_IS_INDIRECT (count)) | |
2988 count = get_indirect_count (count, desc, lheader); | |
2989 mark_struct_contents (dobj, sdesc, count); | |
2990 } | |
2991 break; | |
2992 } | |
2993 case XD_STRUCT_ARRAY: | |
2994 { | |
2995 EMACS_INT count = desc[pos].data1; | |
2996 const struct struct_description *sdesc = desc[pos].data2; | |
2997 | |
2998 if (XD_IS_INDIRECT (count)) | |
2999 count = get_indirect_count (count, desc, lheader); | |
3000 | |
3001 mark_struct_contents (rdata, sdesc, count); | |
3002 break; | |
3003 } | |
3004 case XD_UNION: | |
3005 { | |
3006 int count = 0; | |
3007 int variant = desc[pos].data1; | |
3008 const struct struct_description *sdesc = desc[pos].data2; | |
3009 const char *dobj = *(const char **)rdata; | |
3010 if (XD_IS_INDIRECT (variant)) | |
3011 variant = get_indirect_count (variant, desc, lheader); | |
3012 | |
3013 for (count=0; sdesc[count].size != XD_END; count++) | |
3014 { | |
3015 if (sdesc[count].size == variant) | |
3016 { | |
3017 mark_with_description(dobj, sdesc[count].description); | |
3018 break; | |
3019 } | |
3020 } | |
3021 break; | |
3022 } | |
3023 | |
3024 default: | |
3025 stderr_out ("Unsupported description type : %d\n", desc[pos].type); | |
3026 abort (); | |
3027 } | |
3028 } | |
3029 | |
3030 if (mark_last_occured_object) | |
3031 { | |
3032 mark_object(*last_occured_object); | |
3033 mark_last_occured_object = 0; | |
3034 } | |
3035 } | |
3036 | |
3037 | |
3038 /* This function calculates the size of a described struct. */ | |
3039 static Bytecount | |
3040 structure_size (const void *obj, const struct struct_description *sdesc) | |
3041 { | |
3042 int max_offset = -1; | |
3043 int max_offset_pos = -1; | |
3044 int size_at_max = 0; | |
3045 int pos; | |
3046 const struct lrecord_description *desc; | |
3047 void *rdata; | |
3048 | |
3049 if (sdesc->size) | |
3050 return sdesc->size; | |
3051 | |
3052 desc = sdesc->description; | |
3053 | |
3054 for (pos = 0; desc[pos].type != XD_END; pos++) | |
3055 { | |
3056 if (desc[pos].offset == max_offset) | |
3057 { | |
3058 stderr_out ("Two relocatable elements at same offset?\n"); | |
3059 abort (); | |
3060 } | |
3061 else if (desc[pos].offset > max_offset) | |
3062 { | |
3063 max_offset = desc[pos].offset; | |
3064 max_offset_pos = pos; | |
3065 } | |
3066 } | |
3067 | |
3068 if (max_offset_pos < 0) | |
3069 return 0; | |
3070 | |
3071 pos = max_offset_pos; | |
3072 rdata = (char *) obj + desc[pos].offset; | |
3073 | |
3074 switch (desc[pos].type) | |
3075 { | |
3076 case XD_LISP_OBJECT_ARRAY: | |
3077 { | |
3078 EMACS_INT val = desc[pos].data1; | |
3079 if (XD_IS_INDIRECT (val)) | |
3080 val = get_indirect_count (val, desc, obj); | |
3081 size_at_max = val * sizeof (Lisp_Object); | |
3082 break; | |
3083 } | |
3084 case XD_LISP_OBJECT: | |
3085 case XD_LO_LINK: | |
3086 size_at_max = sizeof (Lisp_Object); | |
3087 break; | |
3088 case XD_OPAQUE_PTR: | |
3089 size_at_max = sizeof (void *); | |
3090 break; | |
3091 case XD_STRUCT_PTR: | |
3092 { | |
3093 EMACS_INT val = desc[pos].data1; | |
3094 if (XD_IS_INDIRECT (val)) | |
3095 val = get_indirect_count (val, desc, obj); | |
3096 size_at_max = val * sizeof (void *); | |
3097 break; | |
3098 } | |
3099 break; | |
3100 case XD_STRUCT_ARRAY: | |
3101 { | |
3102 EMACS_INT val = desc[pos].data1; | |
3103 | |
3104 if (XD_IS_INDIRECT (val)) | |
3105 val = get_indirect_count (val, desc, obj); | |
3106 | |
3107 size_at_max = val * structure_size (rdata, desc[pos].data2); | |
3108 break; | |
3109 } | |
3110 break; | |
3111 case XD_OPAQUE_DATA_PTR: | |
3112 size_at_max = sizeof (void *); | |
3113 break; | |
3114 case XD_UNION: | |
3115 abort (); | |
3116 break; | |
3117 case XD_C_STRING: | |
3118 size_at_max = sizeof (void *); | |
3119 break; | |
3120 case XD_DOC_STRING: | |
3121 size_at_max = sizeof (void *); | |
3122 break; | |
3123 case XD_INT_RESET: | |
3124 size_at_max = sizeof (int); | |
3125 break; | |
3126 case XD_BYTECOUNT: | |
3127 size_at_max = sizeof (Bytecount); | |
3128 break; | |
3129 case XD_ELEMCOUNT: | |
3130 size_at_max = sizeof (Elemcount); | |
3131 break; | |
3132 case XD_HASHCODE: | |
3133 size_at_max = sizeof (Hashcode); | |
3134 break; | |
3135 case XD_INT: | |
3136 size_at_max = sizeof (int); | |
3137 break; | |
3138 case XD_LONG: | |
3139 size_at_max = sizeof (long); | |
3140 break; | |
3141 case XD_SPECIFIER_END: | |
3142 case XD_CODING_SYSTEM_END: | |
3143 stderr_out | |
3144 ("Should not be seeing XD_SPECIFIER_END or\n" | |
3145 "XD_CODING_SYSTEM_END outside of struct Lisp_Specifier\n" | |
3146 "and struct Lisp_Coding_System.\n"); | |
3147 abort (); | |
3148 default: | |
3149 stderr_out ("Unsupported dump type : %d\n", desc[pos].type); | |
3150 abort (); | |
3151 } | |
3152 | |
3153 return ALIGN_SIZE (max_offset + size_at_max, ALIGNOF (max_align_t)); | |
3154 } | |
3155 | |
3156 | |
3157 /* This function loops all elements of a struct pointer and calls | |
3158 mark_with_description with each element. */ | |
3159 static void | |
3160 mark_struct_contents (const void *data, | |
3161 const struct struct_description *sdesc, | |
3162 int count) | |
3163 { | |
3164 int i; | |
3165 Bytecount elsize; | |
3166 elsize = structure_size (data, sdesc); | |
3167 | |
3168 for (i = 0; i < count; i++) | |
3169 { | |
3170 mark_with_description (((char *) data) + elsize * i, | |
3171 sdesc->description); | |
3172 } | |
3173 } | |
3174 | |
3175 #endif /* USE_KKCC */ | |
3176 | |
2667 /* Mark reference to a Lisp_Object. If the object referred to has not been | 3177 /* Mark reference to a Lisp_Object. If the object referred to has not been |
2668 seen yet, recursively mark all the references contained in it. */ | 3178 seen yet, recursively mark all the references contained in it. */ |
2669 | 3179 |
2670 void | 3180 void |
2671 mark_object (Lisp_Object obj) | 3181 mark_object (Lisp_Object obj) |
2678 /* if (PURIFIED (XPNTR (obj))) return; */ | 3188 /* if (PURIFIED (XPNTR (obj))) return; */ |
2679 | 3189 |
2680 if (XTYPE (obj) == Lisp_Type_Record) | 3190 if (XTYPE (obj) == Lisp_Type_Record) |
2681 { | 3191 { |
2682 struct lrecord_header *lheader = XRECORD_LHEADER (obj); | 3192 struct lrecord_header *lheader = XRECORD_LHEADER (obj); |
3193 #ifdef USE_KKCC | |
3194 const struct lrecord_implementation *imp; | |
3195 const struct lrecord_description *desc; | |
3196 #endif /* USE_KKCC */ | |
2683 | 3197 |
2684 GC_CHECK_LHEADER_INVARIANTS (lheader); | 3198 GC_CHECK_LHEADER_INVARIANTS (lheader); |
2685 | 3199 |
2686 gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || | 3200 gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || |
2687 ! ((struct lcrecord_header *) lheader)->free); | 3201 ! ((struct lcrecord_header *) lheader)->free); |
2690 so that we only need to check the mark bit here. */ | 3204 so that we only need to check the mark bit here. */ |
2691 if (! MARKED_RECORD_HEADER_P (lheader)) | 3205 if (! MARKED_RECORD_HEADER_P (lheader)) |
2692 { | 3206 { |
2693 MARK_RECORD_HEADER (lheader); | 3207 MARK_RECORD_HEADER (lheader); |
2694 | 3208 |
2695 if (RECORD_MARKER (lheader)) | 3209 #ifdef USE_KKCC |
3210 imp = LHEADER_IMPLEMENTATION (lheader); | |
3211 desc = imp->description; | |
3212 | |
3213 if (desc) /* && !CONSP(obj))*/ /* KKCC cons special case */ | |
2696 { | 3214 { |
2697 obj = RECORD_MARKER (lheader) (obj); | 3215 mark_with_description (lheader, desc); |
2698 if (!NILP (obj)) goto tail_recurse; | |
2699 } | 3216 } |
3217 | |
3218 else | |
3219 { | |
3220 | |
3221 #endif /* USE_KKCC */ | |
3222 | |
3223 | |
3224 if (RECORD_MARKER (lheader)) | |
3225 { | |
3226 obj = RECORD_MARKER (lheader) (obj); | |
3227 if (!NILP (obj)) goto tail_recurse; | |
3228 } | |
3229 | |
3230 #ifdef USE_KKCC | |
3231 } | |
3232 #endif /* USE_KKCC */ | |
2700 } | 3233 } |
2701 } | 3234 } |
2702 } | 3235 } |
2703 | 3236 |
2704 /* mark all of the conses in a list and mark the final cdr; but | 3237 /* mark all of the conses in a list and mark the final cdr; but |
3131 #define ADDITIONAL_FREE_event(ptr) | 3664 #define ADDITIONAL_FREE_event(ptr) |
3132 | 3665 |
3133 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event); | 3666 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event); |
3134 } | 3667 } |
3135 | 3668 |
3669 #ifdef USE_KKCC | |
3670 | |
3671 static void | |
3672 sweep_key_data (void) | |
3673 { | |
3674 #define UNMARK_key_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | |
3675 #define ADDITIONAL_FREE_key_data(ptr) | |
3676 | |
3677 SWEEP_FIXED_TYPE_BLOCK (key_data, Lisp_Key_Data); | |
3678 } | |
3679 | |
3680 static void | |
3681 sweep_button_data (void) | |
3682 { | |
3683 #define UNMARK_button_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | |
3684 #define ADDITIONAL_FREE_button_data(ptr) | |
3685 | |
3686 SWEEP_FIXED_TYPE_BLOCK (button_data, Lisp_Button_Data); | |
3687 } | |
3688 | |
3689 static void | |
3690 sweep_motion_data (void) | |
3691 { | |
3692 #define UNMARK_motion_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | |
3693 #define ADDITIONAL_FREE_motion_data(ptr) | |
3694 | |
3695 SWEEP_FIXED_TYPE_BLOCK (motion_data, Lisp_Motion_Data); | |
3696 } | |
3697 | |
3698 static void | |
3699 sweep_process_data (void) | |
3700 { | |
3701 #define UNMARK_process_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | |
3702 #define ADDITIONAL_FREE_process_data(ptr) | |
3703 | |
3704 SWEEP_FIXED_TYPE_BLOCK (process_data, Lisp_Process_Data); | |
3705 } | |
3706 | |
3707 static void | |
3708 sweep_timeout_data (void) | |
3709 { | |
3710 #define UNMARK_timeout_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | |
3711 #define ADDITIONAL_FREE_timeout_data(ptr) | |
3712 | |
3713 SWEEP_FIXED_TYPE_BLOCK (timeout_data, Lisp_Timeout_Data); | |
3714 } | |
3715 | |
3716 static void | |
3717 sweep_magic_data (void) | |
3718 { | |
3719 #define UNMARK_magic_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | |
3720 #define ADDITIONAL_FREE_magic_data(ptr) | |
3721 | |
3722 SWEEP_FIXED_TYPE_BLOCK (magic_data, Lisp_Magic_Data); | |
3723 } | |
3724 | |
3725 static void | |
3726 sweep_magic_eval_data (void) | |
3727 { | |
3728 #define UNMARK_magic_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | |
3729 #define ADDITIONAL_FREE_magic_eval_data(ptr) | |
3730 | |
3731 SWEEP_FIXED_TYPE_BLOCK (magic_eval_data, Lisp_Magic_Eval_Data); | |
3732 } | |
3733 | |
3734 static void | |
3735 sweep_eval_data (void) | |
3736 { | |
3737 #define UNMARK_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | |
3738 #define ADDITIONAL_FREE_eval_data(ptr) | |
3739 | |
3740 SWEEP_FIXED_TYPE_BLOCK (eval_data, Lisp_Eval_Data); | |
3741 } | |
3742 | |
3743 static void | |
3744 sweep_misc_user_data (void) | |
3745 { | |
3746 #define UNMARK_misc_user_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | |
3747 #define ADDITIONAL_FREE_misc_user_data(ptr) | |
3748 | |
3749 SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data); | |
3750 } | |
3751 | |
3752 #endif /* USE_KKCC */ | |
3753 | |
3136 static void | 3754 static void |
3137 sweep_markers (void) | 3755 sweep_markers (void) |
3138 { | 3756 { |
3139 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3757 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
3140 #define ADDITIONAL_FREE_marker(ptr) \ | 3758 #define ADDITIONAL_FREE_marker(ptr) \ |
3441 Dechain each one first from the buffer into which it points. */ | 4059 Dechain each one first from the buffer into which it points. */ |
3442 sweep_markers (); | 4060 sweep_markers (); |
3443 | 4061 |
3444 sweep_events (); | 4062 sweep_events (); |
3445 | 4063 |
4064 #ifdef USE_KKCC | |
4065 sweep_key_data (); | |
4066 sweep_button_data (); | |
4067 sweep_motion_data (); | |
4068 sweep_process_data (); | |
4069 sweep_timeout_data (); | |
4070 sweep_magic_data (); | |
4071 sweep_magic_eval_data (); | |
4072 sweep_eval_data (); | |
4073 sweep_misc_user_data (); | |
4074 #endif /* USE_KKCC */ | |
4075 | |
3446 #ifdef PDUMP | 4076 #ifdef PDUMP |
3447 pdump_objects_unmark (); | 4077 pdump_objects_unmark (); |
3448 #endif | 4078 #endif |
3449 } | 4079 } |
3450 | 4080 |
3878 ()) | 4508 ()) |
3879 { | 4509 { |
3880 Lisp_Object pl = Qnil; | 4510 Lisp_Object pl = Qnil; |
3881 int i; | 4511 int i; |
3882 int gc_count_vector_total_size = 0; | 4512 int gc_count_vector_total_size = 0; |
3883 | |
3884 garbage_collect_1 (); | 4513 garbage_collect_1 (); |
3885 | 4514 |
3886 for (i = 0; i < lrecord_type_count; i++) | 4515 for (i = 0; i < lrecord_type_count; i++) |
3887 { | 4516 { |
3888 if (lcrecord_stats[i].bytes_in_use != 0 | 4517 if (lcrecord_stats[i].bytes_in_use != 0 |
4227 init_float_alloc (); | 4856 init_float_alloc (); |
4228 #endif /* LISP_FLOAT_TYPE */ | 4857 #endif /* LISP_FLOAT_TYPE */ |
4229 init_marker_alloc (); | 4858 init_marker_alloc (); |
4230 init_extent_alloc (); | 4859 init_extent_alloc (); |
4231 init_event_alloc (); | 4860 init_event_alloc (); |
4861 #ifdef USE_KKCC | |
4862 init_key_data_alloc (); | |
4863 init_button_data_alloc (); | |
4864 init_motion_data_alloc (); | |
4865 init_process_data_alloc (); | |
4866 init_timeout_data_alloc (); | |
4867 init_magic_data_alloc (); | |
4868 init_magic_eval_data_alloc (); | |
4869 init_eval_data_alloc (); | |
4870 init_misc_user_data_alloc (); | |
4871 #endif /* USE_KKCC */ | |
4232 | 4872 |
4233 ignore_malloc_warnings = 0; | 4873 ignore_malloc_warnings = 0; |
4234 | 4874 |
4235 if (staticpros_nodump) | 4875 if (staticpros_nodump) |
4236 Dynarr_free (staticpros_nodump); | 4876 Dynarr_free (staticpros_nodump); |