Mercurial > hg > xemacs-beta
annotate src/free-hook.c @ 5050:6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
-------------------- ChangeLog entries follow: --------------------
ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* configure.ac (XE_COMPLEX_ARG):
Correct doc of --quick-build: It also doesn't check for Lisp shadows.
src/ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* EmacsFrame.c:
* EmacsFrame.c (EmacsFrameRecomputeCellSize):
* alloca.c (i00afunc):
* buffer.c:
* buffer.c (MARKED_SLOT):
* buffer.c (complex_vars_of_buffer):
* cm.c:
* cm.c (cmcheckmagic):
* console.c:
* console.c (MARKED_SLOT):
* device-x.c:
* device-x.c (x_get_visual_depth):
* emacs.c (sort_args):
* eval.c (throw_or_bomb_out):
* event-stream.c:
* event-stream.c (Fadd_timeout):
* event-stream.c (Fadd_async_timeout):
* event-stream.c (Frecent_keys):
* events.c:
* events.c (Fdeallocate_event):
* events.c (event_pixel_translation):
* extents.c:
* extents.c (process_extents_for_insertion_mapper):
* fns.c (Fbase64_encode_region):
* fns.c (Fbase64_encode_string):
* fns.c (Fbase64_decode_region):
* fns.c (Fbase64_decode_string):
* font-lock.c:
* font-lock.c (find_context):
* frame-x.c:
* frame-x.c (x_wm_mark_shell_size_user_specified):
* frame-x.c (x_wm_mark_shell_position_user_specified):
* frame-x.c (x_wm_set_shell_iconic_p):
* frame-x.c (x_wm_set_cell_size):
* frame-x.c (x_wm_set_variable_size):
* frame-x.c (x_wm_store_class_hints):
* frame-x.c (x_wm_maybe_store_wm_command):
* frame-x.c (x_initialize_frame_size):
* frame.c (delete_frame_internal):
* frame.c (change_frame_size_1):
* free-hook.c (check_free):
* free-hook.c (note_block_input):
* free-hook.c (log_gcpro):
* gccache-gtk.c (gc_cache_lookup):
* gccache-x.c:
* gccache-x.c (gc_cache_lookup):
* glyphs-gtk.c:
* glyphs-gtk.c (init_image_instance_from_gdk_pixmap):
* glyphs-x.c:
* glyphs-x.c (extract_xpm_color_names):
* insdel.c:
* insdel.c (move_gap):
* keymap.c:
* keymap.c (keymap_lookup_directly):
* keymap.c (keymap_delete_inverse_internal):
* keymap.c (accessible_keymaps_mapper_1):
* keymap.c (where_is_recursive_mapper):
* lisp.h:
* lstream.c (make_lisp_buffer_stream_1):
* macros.c:
* macros.c (pop_kbd_macro_event):
* mc-alloc.c (remove_page_from_used_list):
* menubar-x.c:
* menubar-x.c (set_frame_menubar):
* ralloc.c:
* ralloc.c (obtain):
* ralloc.c (relinquish):
* ralloc.c (relocate_blocs):
* ralloc.c (resize_bloc):
* ralloc.c (r_alloc_free):
* ralloc.c (r_re_alloc):
* ralloc.c (r_alloc_thaw):
* ralloc.c (init_ralloc):
* ralloc.c (Free_Addr_Block):
* scrollbar-x.c:
* scrollbar-x.c (x_update_scrollbar_instance_status):
* sunplay.c (init_device):
* unexnt.c:
* unexnt.c (read_in_bss):
* unexnt.c (map_in_heap):
* window.c:
* window.c (real_window):
* window.c (window_display_lines):
* window.c (window_display_buffer):
* window.c (set_window_display_buffer):
* window.c (unshow_buffer):
* window.c (Fget_lru_window):
if (...) ABORT(); ---> assert();
More specifically:
if (x == y) ABORT (); --> assert (x != y);
if (x != y) ABORT (); --> assert (x == y);
if (x > y) ABORT (); --> assert (x <= y);
etc.
if (!x) ABORT (); --> assert (x);
if (x) ABORT (); --> assert (!x);
DeMorgan's Law's applied and manually simplified:
if (x && !y) ABORT (); --> assert (!x || y);
if (!x || y >= z) ABORT (); --> assert (x && y < z);
Checked to make sure that assert() of an expression with side
effects ensures that the side effects get executed even when
asserts are disabled, and add a comment about this being a
requirement of any "disabled assert" expression.
* depend:
* make-src-depend:
* make-src-depend (PrintDeps):
Fix broken code in make-src-depend so it does what it was always
supposed to do, which was separate out config.h and lisp.h and
all the files they include into separate variables in the
depend part of Makefile so that quick-build can turn off the
lisp.h/config.h/text.h/etc. dependencies of the source files, to
speed up recompilation.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sat, 20 Feb 2010 05:05:54 -0600 |
| parents | 1227374e7199 |
| children | 88bd4f3ef8e4 |
| rev | line source |
|---|---|
| 428 | 1 /* This file is part of XEmacs. |
| 2 | |
| 3 XEmacs is free software; you can redistribute it and/or modify it | |
| 4 under the terms of the GNU General Public License as published by the | |
| 5 Free Software Foundation; either version 2, or (at your option) any | |
| 6 later version. | |
| 7 | |
| 8 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 9 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 10 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 11 for more details. | |
| 12 | |
| 13 You should have received a copy of the GNU General Public License | |
| 14 along with XEmacs; see the file COPYING. If not, write to | |
| 15 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 16 Boston, MA 02111-1307, USA. */ | |
| 17 | |
| 18 /* Synched up with: Not in FSF. */ | |
| 19 | |
| 20 /* Debugging hooks for malloc. */ | |
| 21 | |
| 22 /* These hooks work with gmalloc to catch allocation errors. | |
| 23 In particular, the following is trapped: | |
| 24 | |
| 25 * Freeing the same pointer twice. | |
| 26 * Trying to free a pointer not returned by malloc. | |
| 27 * Trying to realloc a pointer not returned by malloc. | |
| 28 | |
| 1204 | 29 In addition, every word of every block freed is set to 0xdeadbeef |
| 30 (-559038737). This causes many uses of freed storage to be trapped or | |
| 31 recognized. | |
| 428 | 32 |
| 33 When you use this, the storage used by the last FREE_QUEUE_LIMIT | |
| 34 calls to free() is not recycled. When you call free for the Nth | |
| 35 time, the (N - FREE_QUEUE_LIMIT)'th block is actually recycled. | |
| 36 | |
| 37 For these last FREE_QUEUE_LIMIT calls to free() a backtrace is | |
| 38 saved showing where it was called from. The function | |
| 39 find_backtrace() is provided here to be called from GDB with a | |
| 40 pointer (such as would be passed to free()) as argument, e.g. | |
| 41 (gdb) p/a *find_backtrace (0x234000). If SAVE_ARGS is defined, | |
| 42 the first three arguments to each function are saved as well as the | |
| 43 return addresses. | |
| 44 | |
| 45 If UNMAPPED_FREE is defined, instead of setting every word of freed | |
| 46 storage to 0xdeadbeef, every call to malloc goes on its own page(s). | |
| 47 When free() is called, the block is read and write protected. This | |
| 48 is very useful when debugging, since it usually generates a bus error | |
| 49 when the deadbeef hack might only cause some garbage to be printed. | |
| 50 However, this is too slow for everyday use, since it takes an enormous | |
| 51 number of pages. | |
| 52 | |
| 53 | |
| 54 Some other features that would be useful are: | |
| 55 | |
| 56 * Checking for storage leaks. | |
| 57 This could be done by a GC-like facility that would scan the data | |
| 58 segment looking for pointers to allocated storage and tell you | |
| 59 about those that are no longer referenced. This could be invoked | |
| 60 at any time. Another possibility is to report on what allocated | |
| 61 storage is still in use when the process is exited. Typically | |
| 62 there will be a large amount, so this might not be very useful. | |
| 63 */ | |
| 64 | |
| 65 #ifdef emacs | |
| 66 #include <config.h> | |
| 67 #include "lisp.h" | |
| 68 #else | |
| 69 void *malloc (size_t); | |
| 70 #endif | |
| 71 | |
| 72 #if !defined(HAVE_LIBMCHECK) | |
| 73 #include <stdio.h> | |
| 74 | |
| 75 #include "hash.h" | |
| 76 | |
| 77 #ifdef UNMAPPED_FREE | |
| 78 #include <sys/mman.h> | |
| 79 #include <sys/param.h> | |
| 80 #define ROUND_UP_TO_PAGE(i) (((i) + PAGEOFFSET) & PAGEMASK) | |
| 81 #endif | |
| 82 | |
| 83 #include <sys/types.h> | |
| 84 | |
| 85 /* System function prototypes don't belong in C source files */ | |
| 86 /* extern void free (void *); */ | |
| 87 | |
| 88 static struct hash_table *pointer_table; | |
| 89 | |
| 90 extern void (*__free_hook) (void *); | |
| 91 extern void *(*__malloc_hook) (size_t); | |
| 92 | |
| 93 static void *check_malloc (size_t); | |
| 94 | |
| 95 typedef void (*fun_ptr) (void); | |
| 96 | |
| 97 /* free_queue is not too useful without backtrace logging */ | |
| 98 #define FREE_QUEUE_LIMIT 1 | |
| 99 #define TRACE_LIMIT 20 | |
| 100 | |
| 101 typedef struct { | |
| 102 fun_ptr return_pc; | |
| 103 #ifdef SAVE_ARGS | |
| 104 void *arg[3]; | |
| 105 #endif | |
| 106 } fun_entry; | |
| 107 | |
| 108 typedef struct { | |
| 109 void *address; | |
| 110 unsigned long length; | |
| 111 } free_queue_entry; | |
| 112 | |
| 113 static free_queue_entry free_queue[FREE_QUEUE_LIMIT]; | |
| 114 | |
| 115 static int current_free; | |
| 116 | |
| 117 static int strict_free_check; | |
| 118 | |
| 119 static void | |
| 120 check_free (void *ptr) | |
| 121 { | |
| 122 __free_hook = 0; | |
| 123 __malloc_hook = 0; | |
| 124 if (!pointer_table) | |
| 125 pointer_table = make_hash_table (max (100, FREE_QUEUE_LIMIT * 2)); | |
| 126 if (ptr != 0) | |
| 127 { | |
| 128 long size; | |
| 129 #ifdef UNMAPPED_FREE | |
| 130 unsigned long rounded_up_size; | |
| 131 #endif | |
| 132 | |
| 133 EMACS_INT present = (EMACS_INT) gethash (ptr, pointer_table, | |
| 2519 | 134 (const void **) |
| 135 (void *) &size); | |
| 428 | 136 |
| 137 if (!present) | |
| 138 { | |
| 139 /* This can only happen if you try to free something that didn't | |
| 140 come from malloc */ | |
| 141 #if !defined(__linux__) | |
| 142 /* I originally wrote: "There's really no need to drop core." | |
| 143 I have seen the error of my ways. -slb */ | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
144 assert (!strict_free_check); |
| 428 | 145 #endif |
| 146 printf("Freeing unmalloc'ed memory at %p\n", ptr); | |
| 147 __free_hook = check_free; | |
| 148 __malloc_hook = check_malloc; | |
| 149 goto end; | |
| 150 } | |
| 151 | |
| 152 if (size < 0) | |
| 153 { | |
| 154 /* This happens when you free twice */ | |
| 155 #if !defined(__linux__) | |
| 156 /* See above comment. */ | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
157 assert (!strict_free_check); |
| 428 | 158 #endif |
| 159 printf("Freeing %p twice\n", ptr); | |
| 160 __free_hook = check_free; | |
| 161 __malloc_hook = check_malloc; | |
| 162 goto end; | |
| 163 } | |
| 164 | |
| 165 puthash (ptr, (void *)-size, pointer_table); | |
| 166 #ifdef UNMAPPED_FREE | |
| 167 /* Round up size to an even number of pages. */ | |
| 168 rounded_up_size = ROUND_UP_TO_PAGE (size); | |
| 169 /* Protect the pages freed from all access */ | |
| 170 if (strict_free_check) | |
| 171 mprotect (ptr, rounded_up_size, PROT_NONE); | |
| 172 #else | |
| 173 /* Set every word in the block to 0xdeadbeef */ | |
| 174 if (strict_free_check) | |
| 175 { | |
| 176 unsigned long long_length = (size + (sizeof (long) - 1)) | |
| 177 / sizeof (long); | |
| 178 unsigned long i; | |
| 179 | |
| 3988 | 180 /* Not using the DEADBEEF_CONSTANT #define, since we don't know |
| 181 * that allocation sizes will be multiples of eight. */ | |
| 428 | 182 for (i = 0; i < long_length; i++) |
| 183 ((unsigned long *) ptr)[i] = 0xdeadbeef; | |
| 184 } | |
| 185 #endif | |
| 186 free_queue[current_free].address = ptr; | |
| 187 free_queue[current_free].length = size; | |
| 188 | |
| 189 current_free++; | |
| 190 if (current_free >= FREE_QUEUE_LIMIT) | |
| 191 current_free = 0; | |
| 192 /* Really free this if there's something there */ | |
| 193 { | |
| 194 void *old = free_queue[current_free].address; | |
| 195 | |
| 196 if (old) | |
| 197 { | |
| 198 #ifdef UNMAPPED_FREE | |
| 199 unsigned long old_len = free_queue[current_free].length; | |
| 200 | |
| 201 mprotect (old, old_len, PROT_READ | PROT_WRITE | PROT_EXEC); | |
| 202 #endif | |
| 203 free (old); | |
| 204 remhash (old, pointer_table); | |
| 205 } | |
| 206 } | |
| 207 } | |
| 208 __free_hook = check_free; | |
| 209 __malloc_hook = check_malloc; | |
| 210 | |
| 211 end: | |
| 212 return; | |
| 213 } | |
| 214 | |
| 215 static void * | |
| 216 check_malloc (size_t size) | |
| 217 { | |
| 218 size_t rounded_up_size; | |
| 219 void *result; | |
| 220 | |
| 221 __free_hook = 0; | |
| 222 __malloc_hook = 0; | |
| 223 if (size == 0) | |
| 224 { | |
| 225 result = 0; | |
| 226 goto end; | |
| 227 } | |
| 228 #ifdef UNMAPPED_FREE | |
| 229 /* Round up to an even number of pages. */ | |
| 230 rounded_up_size = ROUND_UP_TO_PAGE (size); | |
| 231 #else | |
| 232 rounded_up_size = size; | |
| 233 #endif | |
| 234 result = malloc (rounded_up_size); | |
| 235 if (!pointer_table) | |
| 236 pointer_table = make_hash_table (FREE_QUEUE_LIMIT * 2); | |
| 237 puthash (result, (void *)size, pointer_table); | |
| 238 __free_hook = check_free; | |
| 239 __malloc_hook = check_malloc; | |
| 240 end: | |
| 241 return result; | |
| 242 } | |
| 243 | |
| 244 extern void *(*__realloc_hook) (void *, size_t); | |
| 245 | |
| 246 #ifdef MIN | |
| 247 #undef MIN | |
| 248 #endif | |
| 249 #define MIN(A, B) ((A) < (B) ? (A) : (B)) | |
| 250 | |
| 251 /* Don't optimize realloc */ | |
| 252 | |
| 253 static void * | |
| 254 check_realloc (void * ptr, size_t size) | |
| 255 { | |
| 256 EMACS_INT present; | |
| 257 size_t old_size; | |
| 258 void *result = malloc (size); | |
| 259 | |
| 260 if (!ptr) return result; | |
| 442 | 261 present = (EMACS_INT) gethash (ptr, pointer_table, (const void **) &old_size); |
| 428 | 262 if (!present) |
| 263 { | |
| 264 /* This can only happen by reallocing a pointer that didn't | |
| 265 come from malloc. */ | |
| 266 #if !defined(__linux__) | |
| 267 /* see comment in check_free(). */ | |
| 2500 | 268 ABORT (); |
| 428 | 269 #endif |
| 270 printf("Realloc'ing unmalloc'ed pointer at %p\n", ptr); | |
| 271 } | |
| 272 | |
| 273 if (result == 0) | |
| 274 goto end; | |
| 275 memcpy (result, ptr, MIN (size, old_size)); | |
| 276 free (ptr); | |
| 277 end: | |
| 278 return result; | |
| 279 } | |
| 280 | |
| 281 void enable_strict_free_check (void); | |
| 282 void | |
| 283 enable_strict_free_check (void) | |
| 284 { | |
| 285 strict_free_check = 1; | |
| 286 } | |
| 287 | |
| 288 void disable_strict_free_check (void); | |
| 289 void | |
| 290 disable_strict_free_check (void) | |
| 291 { | |
| 292 strict_free_check = 0; | |
| 293 } | |
| 294 | |
| 295 /* Note: All BLOCK_INPUT stuff removed from this file because it's | |
| 296 completely gone in XEmacs */ | |
| 297 | |
| 298 static void * | |
| 299 block_input_malloc (size_t size); | |
| 300 | |
| 301 static void | |
| 302 block_input_free (void* ptr) | |
| 303 { | |
| 304 __free_hook = 0; | |
| 305 __malloc_hook = 0; | |
| 306 free (ptr); | |
| 307 __free_hook = block_input_free; | |
| 308 __malloc_hook = block_input_malloc; | |
| 309 } | |
| 310 | |
| 311 static void * | |
| 312 block_input_malloc (size_t size) | |
| 313 { | |
| 314 void* result; | |
| 315 __free_hook = 0; | |
| 316 __malloc_hook = 0; | |
| 317 result = malloc (size); | |
| 318 __free_hook = block_input_free; | |
| 319 __malloc_hook = block_input_malloc; | |
| 320 return result; | |
| 321 } | |
| 322 | |
| 323 | |
| 324 static void * | |
| 325 block_input_realloc (void* ptr, size_t size) | |
| 326 { | |
| 327 void* result; | |
| 328 __free_hook = 0; | |
| 329 __malloc_hook = 0; | |
| 330 __realloc_hook = 0; | |
| 331 result = realloc (ptr, size); | |
| 332 __free_hook = block_input_free; | |
| 333 __malloc_hook = block_input_malloc; | |
| 334 __realloc_hook = block_input_realloc; | |
| 335 return result; | |
| 336 } | |
| 337 | |
| 338 #ifdef emacs | |
| 339 | |
| 340 void disable_free_hook (void); | |
| 341 void | |
| 342 disable_free_hook (void) | |
| 343 { | |
| 344 __free_hook = block_input_free; | |
| 345 __malloc_hook = block_input_malloc; | |
| 346 __realloc_hook = block_input_realloc; | |
| 347 } | |
| 348 | |
| 349 void | |
| 350 init_free_hook (void) | |
| 351 { | |
| 352 __free_hook = check_free; | |
| 353 __malloc_hook = check_malloc; | |
| 354 __realloc_hook = check_realloc; | |
| 355 current_free = 0; | |
| 356 strict_free_check = 1; | |
| 357 } | |
| 358 | |
| 359 void really_free_one_entry (void *, int, int *); | |
| 360 | |
| 361 DEFUN ("really-free", Freally_free, 0, 1, "P", /* | |
| 362 Actually free the storage held by the free() debug hook. | |
| 363 A no-op if the free hook is disabled. | |
| 364 */ | |
| 2286 | 365 (UNUSED (arg))) |
| 428 | 366 { |
| 367 int count[2]; | |
| 368 Lisp_Object lisp_count[2]; | |
| 369 | |
| 370 if ((__free_hook != 0) && pointer_table) | |
| 371 { | |
| 372 count[0] = 0; | |
| 373 count[1] = 0; | |
| 374 __free_hook = 0; | |
| 375 maphash ((maphash_function)really_free_one_entry, | |
| 376 pointer_table, (void *)&count); | |
| 377 memset (free_queue, 0, sizeof (free_queue_entry) * FREE_QUEUE_LIMIT); | |
| 378 current_free = 0; | |
| 379 __free_hook = check_free; | |
| 793 | 380 lisp_count[0] = make_int (count[0]); |
| 381 lisp_count[1] = make_int (count[1]); | |
| 428 | 382 return Fcons (lisp_count[0], lisp_count[1]); |
| 383 } | |
| 384 else | |
| 385 return Fcons (make_int (0), make_int (0)); | |
| 386 } | |
| 387 | |
| 388 void | |
| 389 really_free_one_entry (void *key, int contents, int *countp) | |
| 390 { | |
| 391 if (contents < 0) | |
| 392 { | |
| 393 free (key); | |
| 394 #ifdef UNMAPPED_FREE | |
| 395 mprotect (key, -contents, PROT_READ | PROT_WRITE | PROT_EXEC); | |
| 396 #endif | |
| 397 remhash (key, pointer_table); | |
| 398 countp[0]++; | |
| 399 countp[1] += -contents; | |
| 400 } | |
| 401 } | |
| 402 | |
| 403 void | |
| 404 syms_of_free_hook (void) | |
| 405 { | |
| 406 DEFSUBR (Freally_free); | |
| 407 } | |
| 408 | |
| 409 #else | |
| 410 void (*__free_hook)(void *) = check_free; | |
| 411 void *(*__malloc_hook)(size_t) = check_malloc; | |
| 412 void *(*__realloc_hook)(void *, size_t) = check_realloc; | |
| 413 #endif | |
| 414 | |
| 415 #endif /* !defined(HAVE_LIBMCHECK) */ | |
| 416 | |
| 417 #if defined(DEBUG_INPUT_BLOCKING) || defined (DEBUG_GCPRO) | |
| 418 | |
| 419 /* Note: There is no more input blocking in XEmacs */ | |
| 420 typedef enum { | |
| 421 block_type, unblock_type, totally_type, | |
| 422 gcpro1_type, gcpro2_type, gcpro3_type, gcpro4_type, gcpro5_type, | |
| 423 ungcpro_type | |
| 424 } blocktype; | |
| 425 | |
| 426 struct block_input_history_struct | |
| 427 { | |
| 428 char *file; | |
| 429 int line; | |
| 430 blocktype type; | |
| 431 int value; | |
| 432 }; | |
| 433 | |
| 434 typedef struct block_input_history_struct block_input_history; | |
| 435 | |
| 436 #endif /* DEBUG_INPUT_BLOCKING || DEBUG_GCPRO */ | |
| 437 | |
| 438 #ifdef DEBUG_INPUT_BLOCKING | |
| 439 | |
| 440 int blhistptr; | |
| 441 | |
| 442 #define BLHISTLIMIT 1000 | |
| 443 | |
| 444 block_input_history blhist[BLHISTLIMIT]; | |
| 445 | |
| 446 note_block_input (char *file, int line) | |
| 447 { | |
| 448 note_block (file, line, block_type); | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
449 assert (interrupt_input_blocked <= 2); |
| 428 | 450 } |
| 451 | |
| 452 note_unblock_input (char* file, int line) | |
| 453 { | |
| 454 note_block (file, line, unblock_type); | |
| 455 } | |
| 456 | |
| 457 note_totally_unblocked (char* file, int line) | |
| 458 { | |
| 459 note_block (file, line, totally_type); | |
| 460 } | |
| 461 | |
| 462 note_block (char *file, int line, blocktype type) | |
| 463 { | |
| 464 blhist[blhistptr].file = file; | |
| 465 blhist[blhistptr].line = line; | |
| 466 blhist[blhistptr].type = type; | |
| 467 blhist[blhistptr].value = interrupt_input_blocked; | |
| 468 | |
| 469 blhistptr++; | |
| 470 if (blhistptr >= BLHISTLIMIT) | |
| 471 blhistptr = 0; | |
| 472 } | |
| 473 | |
| 474 #endif /* DEBUG_INPUT_BLOCKING */ | |
| 475 | |
| 476 | |
| 477 #ifdef DEBUG_GCPRO | |
| 478 | |
| 479 int gcprohistptr; | |
| 480 #define GCPROHISTLIMIT 1000 | |
| 481 block_input_history gcprohist[GCPROHISTLIMIT]; | |
| 482 | |
| 483 static void | |
| 484 log_gcpro (char *file, int line, struct gcpro *value, blocktype type) | |
| 485 { | |
| 486 if (type == ungcpro_type) | |
| 487 { | |
| 488 if (value == gcprolist) goto OK; | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
489 assert (gcprolist); |
| 428 | 490 if (value == gcprolist->next) goto OK; |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
491 assert (gcprolist->next); |
| 428 | 492 if (value == gcprolist->next->next) goto OK; |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
493 assert (gcprolist->next->next); |
| 428 | 494 if (value == gcprolist->next->next->next) goto OK; |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
495 assert (gcprolist->next->next->next); |
| 446 | 496 if (value == gcprolist->next->next->next->next) goto OK; |
| 2500 | 497 ABORT (); |
| 428 | 498 OK:; |
| 499 } | |
| 500 gcprohist[gcprohistptr].file = file; | |
| 501 gcprohist[gcprohistptr].line = line; | |
| 502 gcprohist[gcprohistptr].type = type; | |
| 503 gcprohist[gcprohistptr].value = (int) value; | |
| 504 gcprohistptr++; | |
| 505 if (gcprohistptr >= GCPROHISTLIMIT) | |
| 506 gcprohistptr = 0; | |
| 507 } | |
| 508 | |
| 509 void | |
| 510 debug_gcpro1 (char *file, int line, struct gcpro *gcpro1, Lisp_Object *var) | |
| 511 { | |
| 512 gcpro1->next = gcprolist; gcpro1->var = var; gcpro1->nvars = 1; | |
| 513 gcprolist = gcpro1; | |
| 514 log_gcpro (file, line, gcpro1, gcpro1_type); | |
| 515 } | |
| 516 | |
| 517 void | |
| 518 debug_gcpro2 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, | |
| 519 Lisp_Object *var1, Lisp_Object *var2) | |
| 520 { | |
| 521 gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; | |
| 522 gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; | |
| 523 gcprolist = gcpro2; | |
| 524 log_gcpro (file, line, gcpro2, gcpro2_type); | |
| 525 } | |
| 526 | |
| 527 void | |
| 528 debug_gcpro3 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, | |
| 529 struct gcpro *gcpro3, Lisp_Object *var1, Lisp_Object *var2, | |
| 530 Lisp_Object *var3) | |
| 531 { | |
| 532 gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; | |
| 533 gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; | |
| 534 gcpro3->next = gcpro2; gcpro3->var = var3; gcpro3->nvars = 1; | |
| 535 gcprolist = gcpro3; | |
| 536 log_gcpro (file, line, gcpro3, gcpro3_type); | |
| 537 } | |
| 538 | |
| 539 void | |
| 540 debug_gcpro4 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, | |
| 541 struct gcpro *gcpro3, struct gcpro *gcpro4, Lisp_Object *var1, | |
| 542 Lisp_Object *var2, Lisp_Object *var3, Lisp_Object *var4) | |
| 543 { | |
| 544 log_gcpro (file, line, gcpro4, gcpro4_type); | |
| 545 gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; | |
| 546 gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; | |
| 547 gcpro3->next = gcpro2; gcpro3->var = var3; gcpro3->nvars = 1; | |
| 548 gcpro4->next = gcpro3; gcpro4->var = var4; gcpro4->nvars = 1; | |
| 549 gcprolist = gcpro4; | |
| 550 } | |
| 551 | |
| 552 void | |
| 553 debug_gcpro5 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, | |
| 554 struct gcpro *gcpro3, struct gcpro *gcpro4, struct gcpro *gcpro5, | |
| 555 Lisp_Object *var1, Lisp_Object *var2, Lisp_Object *var3, | |
| 556 Lisp_Object *var4, Lisp_Object *var5) | |
| 557 { | |
| 558 log_gcpro (file, line, gcpro5, gcpro5_type); | |
| 559 gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; | |
| 560 gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; | |
| 561 gcpro3->next = gcpro2; gcpro3->var = var3; gcpro3->nvars = 1; | |
| 562 gcpro4->next = gcpro3; gcpro4->var = var4; gcpro4->nvars = 1; | |
| 563 gcpro5->next = gcpro4; gcpro5->var = var5; gcpro5->nvars = 1; | |
| 564 gcprolist = gcpro5; | |
| 565 } | |
| 566 | |
| 567 void | |
| 568 debug_ungcpro (char *file, int line, struct gcpro *gcpro1) | |
| 569 { | |
| 570 log_gcpro (file, line, gcpro1, ungcpro_type); | |
| 571 gcprolist = gcpro1->next; | |
| 572 } | |
| 573 | |
| 574 | |
| 575 /* To be called from the debugger */ | |
| 576 void show_gcprohist (void); | |
| 577 void | |
| 578 show_gcprohist (void) | |
| 579 { | |
| 580 int i, j; | |
| 581 for (i = 0, j = gcprohistptr; | |
| 582 i < GCPROHISTLIMIT; | |
| 583 i++, j++) | |
| 584 { | |
| 585 if (j >= GCPROHISTLIMIT) | |
| 586 j = 0; | |
| 587 printf ("%3d %s %d %s 0x%x\n", | |
| 588 j, gcprohist[j].file, gcprohist[j].line, | |
| 589 (gcprohist[j].type == gcpro1_type ? "GCPRO1" : | |
| 590 gcprohist[j].type == gcpro2_type ? "GCPRO2" : | |
| 591 gcprohist[j].type == gcpro3_type ? "GCPRO3" : | |
| 592 gcprohist[j].type == gcpro4_type ? "GCPRO4" : | |
| 446 | 593 gcprohist[j].type == gcpro5_type ? "GCPRO5" : |
| 428 | 594 gcprohist[j].type == ungcpro_type ? "UNGCPRO" : "???"), |
| 595 gcprohist[j].value); | |
| 596 } | |
| 597 fflush (stdout); | |
| 598 } | |
| 599 | |
| 600 #endif /* DEBUG_GCPRO */ |