comparison src/alloc.c @ 5146:88bd4f3ef8e4

make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-03-15 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (c_readonly): * alloc.c (deadbeef_memory): * alloc.c (make_compiled_function): * alloc.c (make_button_data): * alloc.c (make_motion_data): * alloc.c (make_process_data): * alloc.c (make_timeout_data): * alloc.c (make_magic_data): * alloc.c (make_magic_eval_data): * alloc.c (make_eval_data): * alloc.c (make_misc_user_data): * alloc.c (noseeum_make_marker): * alloc.c (ADDITIONAL_FREE_string): * alloc.c (common_init_alloc_early): * alloc.c (init_alloc_once_early): * bytecode.c (print_compiled_function): * bytecode.c (mark_compiled_function): * casetab.c: * casetab.c (print_case_table): * console.c: * console.c (print_console): * database.c (print_database): * database.c (finalize_database): * device-msw.c (sync_printer_with_devmode): * device-msw.c (print_devmode): * device-msw.c (finalize_devmode): * device.c: * device.c (print_device): * elhash.c: * elhash.c (print_hash_table): * eval.c (print_multiple_value): * eval.c (mark_multiple_value): * events.c (deinitialize_event): * events.c (print_event): * events.c (event_equal): * extents.c: * extents.c (soe_dump): * extents.c (soe_insert): * extents.c (soe_delete): * extents.c (soe_move): * extents.c (extent_fragment_update): * extents.c (print_extent_1): * extents.c (print_extent): * extents.c (vars_of_extents): * frame.c: * frame.c (print_frame): * free-hook.c: * free-hook.c (check_free): * glyphs.c: * glyphs.c (print_image_instance): * glyphs.c (print_glyph): * gui.c: * gui.c (copy_gui_item): * hash.c: * hash.c (NULL_ENTRY): * hash.c (KEYS_DIFFER_P): * keymap.c (print_keymap): * keymap.c (MARKED_SLOT): * lisp.h: * lrecord.h: * lrecord.h (LISP_OBJECT_UID): * lrecord.h (set_lheader_implementation): * lrecord.h (struct old_lcrecord_header): * lstream.c (print_lstream): * lstream.c (finalize_lstream): * marker.c (print_marker): * marker.c (marker_equal): * mc-alloc.c (visit_all_used_page_headers): * mule-charset.c: * mule-charset.c (print_charset): * objects.c (print_color_instance): * objects.c (print_font_instance): * objects.c (finalize_font_instance): * opaque.c (print_opaque): * opaque.c (print_opaque_ptr): * opaque.c (equal_opaque_ptr): * print.c (internal_object_printer): * print.c (enum printing_badness): * rangetab.c (print_range_table): * rangetab.c (range_table_equal): * specifier.c (print_specifier): * specifier.c (finalize_specifier): * symbols.c: * symbols.c (print_symbol_value_magic): * tooltalk.c: * tooltalk.c (print_tooltalk_message): * tooltalk.c (print_tooltalk_pattern): * window.c (print_window): * window.c (debug_print_window): (1) Make lrecord UID's have a separate UID space for each object. Otherwise, with 20-bit UID's, we rapidly wrap around, especially when common objects like conses and strings increment the UID value for every object created. (Originally I tried making two UID spaces, one for objects that always print readably and hence don't display the UID, and one for other objects. But certain objects like markers for which a UID is displayed are still generated rapidly enough that UID overflow is a serious issue.) This also has the advantage of making UID values smaller, hence easier to remember -- their main purpose is to make it easier to keep track of different objects of the same type when debugging code. Make sure we dump lrecord UID's so that we don't have problems with pdumped and non-dumped objects having the same UID. (2) Display UID's consistently whenever an object (a) doesn't consistently print readably (objects like cons and string, which always print readably, can't display a UID), and (b) doesn't otherwise have a unique property that makes objects of a particular type distinguishable. (E.g. buffers didn't and still don't print an ID, but the buffer name uniquely identifies the buffer.) Some types, such as event, extent, compiled-function, didn't always (or didn't ever) display an ID; others (such as marker, extent, lstream, opaque, opaque-ptr, any object using internal_object_printer()) used to display the actual machine pointer instead. (3) Rename NORMAL_LISP_OBJECT_UID to LISP_OBJECT_UID; make it work over all Lisp objects and take a Lisp object, not a struct pointer. (4) Some misc cleanups in alloc.c, elhash.c. (5) Change code in events.c that "deinitializes" an event so that it doesn't increment the event UID counter in the process. Also use deadbeef_memory() to overwrite memory instead of doing the same with custom code. In the process, make deadbeef_memory() in alloc.c always available, and delete extraneous copy in mc-alloc.c. Also capitalize all uses of 0xDEADBEEF. Similarly in elhash.c call deadbeef_memory(). (6) Resurrect "debug SOE" code in extents.c. Make it conditional on DEBUG_XEMACS and on a `debug-soe' variable, rather than on SOE_DEBUG. Make it output to stderr, not stdout. (7) Delete some custom print methods that were identical to external_object_printer().
author Ben Wing <ben@xemacs.org>
date Mon, 15 Mar 2010 16:35:38 -0500
parents f965e31a35f0
children 641d0cdd1d00 1fae11d56ad2
comparison
equal deleted inserted replaced
5145:0b0241ae382f 5146:88bd4f3ef8e4
99 int need_to_check_c_alloca; 99 int need_to_check_c_alloca;
100 int need_to_signal_post_gc; 100 int need_to_signal_post_gc;
101 int funcall_allocation_flag; 101 int funcall_allocation_flag;
102 Bytecount __temp_alloca_size__; 102 Bytecount __temp_alloca_size__;
103 Bytecount funcall_alloca_count; 103 Bytecount funcall_alloca_count;
104
105 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
106 Additional ones may be defined by a module (none yet). We leave some
107 room in `lrecord_implementations_table' for such new lisp object types. */
108 const struct lrecord_implementation *lrecord_implementations_table[(int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
109 int lrecord_type_count = lrecord_type_last_built_in_type;
110
111 /* This is just for use by the printer, to allow things to print uniquely.
112 We have a separate UID space for each object. (Important because the
113 UID is only 20 bits in old-GC, and 22 in NEW_GC.) */
114 int lrecord_uid_counter[countof (lrecord_implementations_table)];
115
116 /* Non-zero means we're in the process of doing the dump */
117 int purify_flag;
118
119 /* Non-zero means we're pdumping out or in */
120 #ifdef PDUMP
121 int in_pdump;
122 #endif
123
124 #ifdef ERROR_CHECK_TYPES
125
126 Error_Behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN, ERROR_ME_DEBUG_WARN;
127
128 #endif
129
130 /* Very cheesy ways of figuring out how much memory is being used for
131 data. #### Need better (system-dependent) ways. */
132 void *minimum_address_seen;
133 void *maximum_address_seen;
104 134
105 /* Determine now whether we need to garbage collect or not, to make 135 /* Determine now whether we need to garbage collect or not, to make
106 Ffuncall() faster */ 136 Ffuncall() faster */
107 #define INCREMENT_CONS_COUNTER_1(size) \ 137 #define INCREMENT_CONS_COUNTER_1(size) \
108 do \ 138 do \
169 if (consing_since_gc < 0) \ 199 if (consing_since_gc < 0) \
170 consing_since_gc = 0; \ 200 consing_since_gc = 0; \
171 recompute_need_to_garbage_collect (); \ 201 recompute_need_to_garbage_collect (); \
172 } while (0) 202 } while (0)
173 #endif /*not NEW_GC */ 203 #endif /*not NEW_GC */
174
175 /* This is just for use by the printer, to allow things to print uniquely */
176 int lrecord_uid_counter;
177
178 /* Non-zero means we're in the process of doing the dump */
179 int purify_flag;
180
181 /* Non-zero means we're pdumping out or in */
182 #ifdef PDUMP
183 int in_pdump;
184 #endif
185
186 #ifdef ERROR_CHECK_TYPES
187
188 Error_Behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN, ERROR_ME_DEBUG_WARN;
189
190 #endif
191
192 /* Very cheesy ways of figuring out how much memory is being used for
193 data. #### Need better (system-dependent) ways. */
194 void *minimum_address_seen;
195 void *maximum_address_seen;
196 204
197 #ifndef NEW_GC 205 #ifndef NEW_GC
198 int 206 int
199 c_readonly (Lisp_Object obj) 207 c_readonly (Lisp_Object obj)
200 { 208 {
434 FREE_OR_REALLOC_BEGIN (block); 442 FREE_OR_REALLOC_BEGIN (block);
435 free (block); 443 free (block);
436 MALLOC_END (); 444 MALLOC_END ();
437 } 445 }
438 446
439 #ifdef ERROR_CHECK_GC 447 void
440
441 #ifndef NEW_GC
442 static void
443 deadbeef_memory (void *ptr, Bytecount size) 448 deadbeef_memory (void *ptr, Bytecount size)
444 { 449 {
445 UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr; 450 UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr;
446 Bytecount beefs = size >> 2; 451 Bytecount beefs = size >> 2;
447 452
448 /* In practice, size will always be a multiple of four. */ 453 /* In practice, size will always be a multiple of four. */
449 while (beefs--) 454 while (beefs--)
450 (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */ 455 (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */
451 } 456 }
452 #endif /* not NEW_GC */
453
454 #else /* !ERROR_CHECK_GC */
455
456
457 #define deadbeef_memory(ptr, size)
458
459 #endif /* !ERROR_CHECK_GC */
460 457
461 #undef xstrdup 458 #undef xstrdup
462 char * 459 char *
463 xstrdup (const char *str) 460 xstrdup (const char *str)
464 { 461 {
1951 make_compiled_function (void) 1948 make_compiled_function (void)
1952 { 1949 {
1953 Lisp_Compiled_Function *f; 1950 Lisp_Compiled_Function *f;
1954 1951
1955 ALLOC_FROB_BLOCK_LISP_OBJECT (compiled_function, Lisp_Compiled_Function, 1952 ALLOC_FROB_BLOCK_LISP_OBJECT (compiled_function, Lisp_Compiled_Function,
1956 f, &lrecord_compiled_function); 1953 f, &lrecord_compiled_function);
1957 1954
1958 f->stack_depth = 0; 1955 f->stack_depth = 0;
1959 f->specpdl_depth = 0; 1956 f->specpdl_depth = 0;
1960 f->flags.documentationp = 0; 1957 f->flags.documentationp = 0;
1961 f->flags.interactivep = 0; 1958 f->flags.interactivep = 0;
2168 Lisp_Object 2165 Lisp_Object
2169 make_button_data (void) 2166 make_button_data (void)
2170 { 2167 {
2171 Lisp_Button_Data *d; 2168 Lisp_Button_Data *d;
2172 2169
2173 ALLOC_FROB_BLOCK_LISP_OBJECT (button_data, Lisp_Button_Data, d, &lrecord_button_data); 2170 ALLOC_FROB_BLOCK_LISP_OBJECT (button_data, Lisp_Button_Data, d,
2171 &lrecord_button_data);
2174 zero_nonsized_lisp_object (wrap_button_data (d)); 2172 zero_nonsized_lisp_object (wrap_button_data (d));
2175 return wrap_button_data (d); 2173 return wrap_button_data (d);
2176 } 2174 }
2177 2175
2178 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data); 2176 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data);
2181 Lisp_Object 2179 Lisp_Object
2182 make_motion_data (void) 2180 make_motion_data (void)
2183 { 2181 {
2184 Lisp_Motion_Data *d; 2182 Lisp_Motion_Data *d;
2185 2183
2186 ALLOC_FROB_BLOCK_LISP_OBJECT (motion_data, Lisp_Motion_Data, d, &lrecord_motion_data); 2184 ALLOC_FROB_BLOCK_LISP_OBJECT (motion_data, Lisp_Motion_Data, d,
2185 &lrecord_motion_data);
2187 zero_nonsized_lisp_object (wrap_motion_data (d)); 2186 zero_nonsized_lisp_object (wrap_motion_data (d));
2188 2187
2189 return wrap_motion_data (d); 2188 return wrap_motion_data (d);
2190 } 2189 }
2191 2190
2195 Lisp_Object 2194 Lisp_Object
2196 make_process_data (void) 2195 make_process_data (void)
2197 { 2196 {
2198 Lisp_Process_Data *d; 2197 Lisp_Process_Data *d;
2199 2198
2200 ALLOC_FROB_BLOCK_LISP_OBJECT (process_data, Lisp_Process_Data, d, &lrecord_process_data); 2199 ALLOC_FROB_BLOCK_LISP_OBJECT (process_data, Lisp_Process_Data, d,
2200 &lrecord_process_data);
2201 zero_nonsized_lisp_object (wrap_process_data (d)); 2201 zero_nonsized_lisp_object (wrap_process_data (d));
2202 d->process = Qnil; 2202 d->process = Qnil;
2203 2203
2204 return wrap_process_data (d); 2204 return wrap_process_data (d);
2205 } 2205 }
2210 Lisp_Object 2210 Lisp_Object
2211 make_timeout_data (void) 2211 make_timeout_data (void)
2212 { 2212 {
2213 Lisp_Timeout_Data *d; 2213 Lisp_Timeout_Data *d;
2214 2214
2215 ALLOC_FROB_BLOCK_LISP_OBJECT (timeout_data, Lisp_Timeout_Data, d, &lrecord_timeout_data); 2215 ALLOC_FROB_BLOCK_LISP_OBJECT (timeout_data, Lisp_Timeout_Data, d,
2216 &lrecord_timeout_data);
2216 zero_nonsized_lisp_object (wrap_timeout_data (d)); 2217 zero_nonsized_lisp_object (wrap_timeout_data (d));
2217 d->function = Qnil; 2218 d->function = Qnil;
2218 d->object = Qnil; 2219 d->object = Qnil;
2219 2220
2220 return wrap_timeout_data (d); 2221 return wrap_timeout_data (d);
2226 Lisp_Object 2227 Lisp_Object
2227 make_magic_data (void) 2228 make_magic_data (void)
2228 { 2229 {
2229 Lisp_Magic_Data *d; 2230 Lisp_Magic_Data *d;
2230 2231
2231 ALLOC_FROB_BLOCK_LISP_OBJECT (magic_data, Lisp_Magic_Data, d, &lrecord_magic_data); 2232 ALLOC_FROB_BLOCK_LISP_OBJECT (magic_data, Lisp_Magic_Data, d,
2233 &lrecord_magic_data);
2232 zero_nonsized_lisp_object (wrap_magic_data (d)); 2234 zero_nonsized_lisp_object (wrap_magic_data (d));
2233 2235
2234 return wrap_magic_data (d); 2236 return wrap_magic_data (d);
2235 } 2237 }
2236 2238
2240 Lisp_Object 2242 Lisp_Object
2241 make_magic_eval_data (void) 2243 make_magic_eval_data (void)
2242 { 2244 {
2243 Lisp_Magic_Eval_Data *d; 2245 Lisp_Magic_Eval_Data *d;
2244 2246
2245 ALLOC_FROB_BLOCK_LISP_OBJECT (magic_eval_data, Lisp_Magic_Eval_Data, d, &lrecord_magic_eval_data); 2247 ALLOC_FROB_BLOCK_LISP_OBJECT (magic_eval_data, Lisp_Magic_Eval_Data, d,
2248 &lrecord_magic_eval_data);
2246 zero_nonsized_lisp_object (wrap_magic_eval_data (d)); 2249 zero_nonsized_lisp_object (wrap_magic_eval_data (d));
2247 d->object = Qnil; 2250 d->object = Qnil;
2248 2251
2249 return wrap_magic_eval_data (d); 2252 return wrap_magic_eval_data (d);
2250 } 2253 }
2255 Lisp_Object 2258 Lisp_Object
2256 make_eval_data (void) 2259 make_eval_data (void)
2257 { 2260 {
2258 Lisp_Eval_Data *d; 2261 Lisp_Eval_Data *d;
2259 2262
2260 ALLOC_FROB_BLOCK_LISP_OBJECT (eval_data, Lisp_Eval_Data, d, &lrecord_eval_data); 2263 ALLOC_FROB_BLOCK_LISP_OBJECT (eval_data, Lisp_Eval_Data, d,
2264 &lrecord_eval_data);
2261 zero_nonsized_lisp_object (wrap_eval_data (d)); 2265 zero_nonsized_lisp_object (wrap_eval_data (d));
2262 d->function = Qnil; 2266 d->function = Qnil;
2263 d->object = Qnil; 2267 d->object = Qnil;
2264 2268
2265 return wrap_eval_data (d); 2269 return wrap_eval_data (d);
2271 Lisp_Object 2275 Lisp_Object
2272 make_misc_user_data (void) 2276 make_misc_user_data (void)
2273 { 2277 {
2274 Lisp_Misc_User_Data *d; 2278 Lisp_Misc_User_Data *d;
2275 2279
2276 ALLOC_FROB_BLOCK_LISP_OBJECT (misc_user_data, Lisp_Misc_User_Data, d, &lrecord_misc_user_data); 2280 ALLOC_FROB_BLOCK_LISP_OBJECT (misc_user_data, Lisp_Misc_User_Data, d,
2281 &lrecord_misc_user_data);
2277 zero_nonsized_lisp_object (wrap_misc_user_data (d)); 2282 zero_nonsized_lisp_object (wrap_misc_user_data (d));
2278 d->function = Qnil; 2283 d->function = Qnil;
2279 d->object = Qnil; 2284 d->object = Qnil;
2280 2285
2281 return wrap_misc_user_data (d); 2286 return wrap_misc_user_data (d);
2310 noseeum_make_marker (void) 2315 noseeum_make_marker (void)
2311 { 2316 {
2312 Lisp_Marker *p; 2317 Lisp_Marker *p;
2313 2318
2314 NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p, 2319 NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p,
2315 &lrecord_marker); 2320 &lrecord_marker);
2316 p->buffer = 0; 2321 p->buffer = 0;
2317 p->membpos = 0; 2322 p->membpos = 0;
2318 marker_next (p) = 0; 2323 marker_next (p) = 0;
2319 marker_prev (p) = 0; 2324 marker_prev (p) = 0;
2320 p->insertion_type = 0; 2325 p->insertion_type = 0;
3354 3359
3355 /************************************************************************/ 3360 /************************************************************************/
3356 /* Garbage Collection */ 3361 /* Garbage Collection */
3357 /************************************************************************/ 3362 /************************************************************************/
3358 3363
3359 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
3360 Additional ones may be defined by a module (none yet). We leave some
3361 room in `lrecord_implementations_table' for such new lisp object types. */
3362 const struct lrecord_implementation *lrecord_implementations_table[(int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
3363 int lrecord_type_count = lrecord_type_last_built_in_type;
3364 #ifndef USE_KKCC 3364 #ifndef USE_KKCC
3365 /* Object marker functions are in the lrecord_implementation structure. 3365 /* Object marker functions are in the lrecord_implementation structure.
3366 But copying them to a parallel array is much more cache-friendly. 3366 But copying them to a parallel array is much more cache-friendly.
3367 This hack speeds up (garbage-collect) by about 5%. */ 3367 This hack speeds up (garbage-collect) by about 5%. */
3368 Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object); 3368 Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object);
4389 debug_string_purity_print (wrap_string (p)); \ 4389 debug_string_purity_print (wrap_string (p)); \
4390 } while (0) 4390 } while (0)
4391 #define ADDITIONAL_FREE_string(ptr) do { \ 4391 #define ADDITIONAL_FREE_string(ptr) do { \
4392 Bytecount size = ptr->size_; \ 4392 Bytecount size = ptr->size_; \
4393 if (BIG_STRING_SIZE_P (size)) \ 4393 if (BIG_STRING_SIZE_P (size)) \
4394 xfree (ptr->data_); \ 4394 xfree (ptr->data_); \
4395 } while (0) 4395 } while (0)
4396 4396
4397 SWEEP_FIXED_TYPE_BLOCK_1 (string, Lisp_String, u.lheader); 4397 SWEEP_FIXED_TYPE_BLOCK_1 (string, Lisp_String, u.lheader);
4398 4398
4399 gc_count_num_short_string_in_use = num_small_used; 4399 gc_count_num_short_string_in_use = num_small_used;
5115 consing_since_gc = 0; 5115 consing_since_gc = 0;
5116 need_to_check_c_alloca = 0; 5116 need_to_check_c_alloca = 0;
5117 funcall_allocation_flag = 0; 5117 funcall_allocation_flag = 0;
5118 funcall_alloca_count = 0; 5118 funcall_alloca_count = 0;
5119 5119
5120 lrecord_uid_counter = 259;
5121 #ifndef NEW_GC 5120 #ifndef NEW_GC
5122 debug_string_purity = 0; 5121 debug_string_purity = 0;
5123 #endif /* not NEW_GC */ 5122 #endif /* not NEW_GC */
5124 5123
5125 #ifdef ERROR_CHECK_TYPES 5124 #ifdef ERROR_CHECK_TYPES
5182 { 5181 {
5183 int i; 5182 int i;
5184 for (i = 0; i < countof (lrecord_implementations_table); i++) 5183 for (i = 0; i < countof (lrecord_implementations_table); i++)
5185 lrecord_implementations_table[i] = 0; 5184 lrecord_implementations_table[i] = 0;
5186 } 5185 }
5186
5187 dump_add_opaque (lrecord_uid_counter, sizeof (lrecord_uid_counter));
5187 5188
5188 INIT_LISP_OBJECT (cons); 5189 INIT_LISP_OBJECT (cons);
5189 INIT_LISP_OBJECT (vector); 5190 INIT_LISP_OBJECT (vector);
5190 INIT_LISP_OBJECT (string); 5191 INIT_LISP_OBJECT (string);
5191 #ifdef NEW_GC 5192 #ifdef NEW_GC