Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 1598:ac1be85b4a5f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-07-31 13:32:24 by crestani] 2003-07-29 Marcus Crestani <crestani@informatik.uni-tuebingen.de> Markus Kaltenbach <makalten@informatik.uni-tuebingen.de> * README.kkcc: Aligned to the changes. * alloc.c: Implemented the kkcc_gc_stack. (kkcc_gc_stack_init): (kkcc_gc_stack_free): (kkcc_gc_stack_realloc): (kkcc_gc_stack_full): (kkcc_gc_stack_empty): (kkcc_gc_stack_push): (kkcc_gc_stack_pop): (kkcc_gc_stack_push_lisp_object): (mark_object_maybe_checking_free): Push objects on kkcc stack instead of marking. (mark_struct_contents): Push objects on kkcc stack instead of marking. (kkcc_marking): KKCC mark algorithm using the kkcc_gc_stack. (mark_object): Removed KKCC ifdefs. (garbage_collect_1): Push objects on kkcc stack instead of marking. * data.c: Added XD_FLAG_NO_KKCC to ephemeron_description and to weak_list_description. * data.c (finish_marking_weak_lists): Push objects on kkcc stack instead of marking. (continue_marking_ephemerons): Push objects on kkcc stack instead of marking. (finish_marking_ephemerons): Push objects on kkcc stack instead of marking. * elhash.c (finish_marking_weak_hash_tables): Push objects on kkcc stack instead of marking. * eval.c: Added XD_FLAG_NO_KKCC to subr_description. * lisp.h: Added prototype for kkcc_gc_stack_push_lisp_object. * profile.c (mark_profiling_info_maphash): Push keys on kkcc stack instead of marking.
author crestani
date Thu, 31 Jul 2003 13:32:26 +0000
parents 03009473262a
children 750821e2c014
comparison
equal deleted inserted replaced
1597:4b6ee17c5f37 1598:ac1be85b4a5f
2948 sizeof (Lisp_Object), 2948 sizeof (Lisp_Object),
2949 lisp_object_description_1 2949 lisp_object_description_1
2950 }; 2950 };
2951 2951
2952 #if defined (USE_KKCC) || defined (PDUMP) 2952 #if defined (USE_KKCC) || defined (PDUMP)
2953
2954 /* the initial stack size in kkcc_gc_stack_entries */
2955 #define KKCC_INIT_GC_STACK_SIZE 16384
2956
2957 typedef struct
2958 {
2959 void *data;
2960 const struct memory_description *desc;
2961 } kkcc_gc_stack_entry;
2962
2963 static kkcc_gc_stack_entry *kkcc_gc_stack_ptr;
2964 static kkcc_gc_stack_entry *kkcc_gc_stack_top;
2965 static int kkcc_gc_stack_size;
2966 static int kkcc_gc_stack_count;
2967
2968 static void
2969 kkcc_gc_stack_init (void)
2970 {
2971 kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE;
2972 kkcc_gc_stack_ptr =
2973 malloc (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
2974 if (!kkcc_gc_stack_ptr)
2975 {
2976 stderr_out ("stack init failed for size %d\n", kkcc_gc_stack_size);
2977 exit(23);
2978 }
2979 kkcc_gc_stack_top = kkcc_gc_stack_ptr - 1;
2980 kkcc_gc_stack_count = 0;
2981 }
2982
2983 static void
2984 kkcc_gc_stack_free (void)
2985 {
2986 free (kkcc_gc_stack_ptr);
2987 kkcc_gc_stack_ptr = 0;
2988 kkcc_gc_stack_top = 0;
2989 kkcc_gc_stack_size = 0;
2990 }
2991
2992 static void
2993 kkcc_gc_stack_realloc (void)
2994 {
2995 kkcc_gc_stack_size *= 2;
2996 kkcc_gc_stack_ptr =
2997 realloc (kkcc_gc_stack_ptr,
2998 kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
2999 if (!kkcc_gc_stack_ptr)
3000 {
3001 stderr_out ("stack realloc failed for size %d\n", kkcc_gc_stack_size);
3002 exit(23);
3003 }
3004 kkcc_gc_stack_top = kkcc_gc_stack_ptr + kkcc_gc_stack_count - 1;
3005 }
3006
3007 static int
3008 kkcc_gc_stack_full (void)
3009 {
3010 if (kkcc_gc_stack_count > (kkcc_gc_stack_size - 1))
3011 return 1;
3012 return 0;
3013 }
3014
3015 static int
3016 kkcc_gc_stack_empty (void)
3017 {
3018 if (kkcc_gc_stack_count == 0)
3019 return 1;
3020 return 0;
3021 }
3022
3023 static void
3024 kkcc_gc_stack_push (void *data, const struct memory_description *desc)
3025 {
3026 if (kkcc_gc_stack_full ())
3027 kkcc_gc_stack_realloc();
3028
3029 kkcc_gc_stack_top++;
3030 kkcc_gc_stack_count++;
3031 kkcc_gc_stack_top->data = data;
3032 kkcc_gc_stack_top->desc = desc;
3033 }
3034
3035 static kkcc_gc_stack_entry *
3036 kkcc_gc_stack_pop (void) //void *data, const struct memory_description *desc)
3037 {
3038 if (kkcc_gc_stack_empty ())
3039 return 0;
3040
3041 kkcc_gc_stack_top--;
3042 kkcc_gc_stack_count--;
3043
3044 return kkcc_gc_stack_top + 1;
3045 }
3046
3047 void
3048 kkcc_gc_stack_push_lisp_object (Lisp_Object obj)
3049 {
3050 if (XTYPE (obj) == Lisp_Type_Record)
3051 {
3052 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
3053 const struct memory_description *desc;
3054 GC_CHECK_LHEADER_INVARIANTS (lheader);
3055 desc = LHEADER_IMPLEMENTATION (lheader)->description;
3056 if (! MARKED_RECORD_HEADER_P (lheader))
3057 {
3058 MARK_RECORD_HEADER (lheader);
3059 kkcc_gc_stack_push((void*) lheader, desc);
3060 }
3061 }
3062 }
2953 3063
2954 /* This function extracts the value of a count variable described somewhere 3064 /* This function extracts the value of a count variable described somewhere
2955 else in the description. It is converted corresponding to the type */ 3065 else in the description. It is converted corresponding to the type */
2956 EMACS_INT 3066 EMACS_INT
2957 lispdesc_indirect_count_1 (EMACS_INT code, 3067 lispdesc_indirect_count_1 (EMACS_INT code,
3191 #ifdef USE_KKCC 3301 #ifdef USE_KKCC
3192 /* The following functions implement the new mark algorithm. 3302 /* The following functions implement the new mark algorithm.
3193 They mark objects according to their descriptions. They 3303 They mark objects according to their descriptions. They
3194 are modeled on the corresponding pdumper procedures. */ 3304 are modeled on the corresponding pdumper procedures. */
3195 3305
3196 static void mark_struct_contents (const void *data,
3197 const struct sized_memory_description *sdesc,
3198 int count);
3199
3200 #ifdef ERROR_CHECK_GC 3306 #ifdef ERROR_CHECK_GC
3201 #define KKCC_DO_CHECK_FREE(obj, allow_free) \ 3307 #define KKCC_DO_CHECK_FREE(obj, allow_free) \
3202 do \ 3308 do \
3203 { \ 3309 { \
3204 if (!allow_free && XTYPE (obj) == Lisp_Type_Record) \ 3310 if (!allow_free && XTYPE (obj) == Lisp_Type_Record) \
3210 #else 3316 #else
3211 #define KKCC_DO_CHECK_FREE(obj, allow_free) 3317 #define KKCC_DO_CHECK_FREE(obj, allow_free)
3212 #endif 3318 #endif
3213 3319
3214 #ifdef ERROR_CHECK_GC 3320 #ifdef ERROR_CHECK_GC
3215 void 3321 static void
3216 mark_object_maybe_checking_free (Lisp_Object obj, int allow_free) 3322 mark_object_maybe_checking_free (Lisp_Object obj, int allow_free)
3217 { 3323 {
3218 KKCC_DO_CHECK_FREE (obj, allow_free); 3324 KKCC_DO_CHECK_FREE (obj, allow_free);
3325 #ifdef USE_KKCC
3326 kkcc_gc_stack_push_lisp_object (obj);
3327 #else /* NOT USE_KKCC */
3219 mark_object (obj); 3328 mark_object (obj);
3329 #endif /* NOT USE_KKCC */
3220 } 3330 }
3221 #else 3331 #else
3222 #define mark_object_maybe_checking_free(obj, allow_free) mark_object (obj) 3332 #define mark_object_maybe_checking_free(obj, allow_free) mark_object (obj)
3223 #endif /* ERROR_CHECK_GC */ 3333 #endif /* ERROR_CHECK_GC */
3224 3334
3225 /* This function is called to mark the elements of an object. It processes
3226 the description of the object and calls mark object with every described
3227 object. */
3228 static void
3229 mark_with_description (const void *data,
3230 const struct memory_description *desc)
3231 {
3232 int pos;
3233 static const Lisp_Object *last_occurred_object = (Lisp_Object *) 0;
3234 static int mark_last_occurred_object = 0;
3235 #ifdef ERROR_CHECK_GC
3236 static int last_occurred_flags;
3237 #endif
3238
3239 tail_recurse:
3240
3241 for (pos = 0; desc[pos].type != XD_END; pos++)
3242 {
3243 const struct memory_description *desc1 = &desc[pos];
3244 const void *rdata =
3245 (const char *) data + lispdesc_indirect_count (desc1->offset,
3246 desc, data);
3247 union_switcheroo:
3248
3249 /* If the flag says don't mark, then don't mark. */
3250 if ((desc1->flags) & XD_FLAG_NO_KKCC)
3251 continue;
3252
3253 switch (desc1->type)
3254 {
3255 case XD_BYTECOUNT:
3256 case XD_ELEMCOUNT:
3257 case XD_HASHCODE:
3258 case XD_INT:
3259 case XD_LONG:
3260 case XD_INT_RESET:
3261 case XD_LO_LINK:
3262 case XD_OPAQUE_PTR:
3263 case XD_OPAQUE_DATA_PTR:
3264 case XD_C_STRING:
3265 case XD_DOC_STRING:
3266 break;
3267 case XD_LISP_OBJECT:
3268 {
3269 const Lisp_Object *stored_obj = (const Lisp_Object *) rdata;
3270
3271 /* Because of the way that tagged objects work (pointers and
3272 Lisp_Objects have the same representation), XD_LISP_OBJECT
3273 can be used for untagged pointers. They might be NULL,
3274 though. */
3275 if (EQ (*stored_obj, Qnull_pointer))
3276 break;
3277
3278 if (desc[pos+1].type == XD_END)
3279 {
3280 mark_last_occurred_object = 1;
3281 last_occurred_object = stored_obj;
3282 #ifdef ERROR_CHECK_GC
3283 last_occurred_flags = desc1->flags;
3284 #endif
3285 break;
3286 }
3287 else
3288 mark_object_maybe_checking_free
3289 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
3290
3291 break;
3292 }
3293 case XD_LISP_OBJECT_ARRAY:
3294 {
3295 int i;
3296 EMACS_INT count =
3297 lispdesc_indirect_count (desc1->data1, desc, data);
3298
3299 for (i = 0; i < count; i++)
3300 {
3301 const Lisp_Object *stored_obj =
3302 (const Lisp_Object *) rdata + i;
3303
3304 if (EQ (*stored_obj, Qnull_pointer))
3305 break;
3306
3307 mark_object_maybe_checking_free
3308 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
3309 }
3310 break;
3311 }
3312 case XD_STRUCT_PTR:
3313 {
3314 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
3315 data);
3316 const struct sized_memory_description *sdesc =
3317 lispdesc_indirect_description (data, desc1->data2);
3318 const char *dobj = * (const char **) rdata;
3319 if (dobj)
3320 mark_struct_contents (dobj, sdesc, count);
3321 break;
3322 }
3323 case XD_STRUCT_ARRAY:
3324 {
3325 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
3326 data);
3327 const struct sized_memory_description *sdesc =
3328 lispdesc_indirect_description (data, desc1->data2);
3329
3330 mark_struct_contents (rdata, sdesc, count);
3331 break;
3332 }
3333 case XD_UNION:
3334 case XD_UNION_DYNAMIC_SIZE:
3335 desc1 = lispdesc_process_xd_union (desc1, desc, data);
3336 if (desc1)
3337 goto union_switcheroo;
3338 break;
3339
3340 default:
3341 stderr_out ("Unsupported description type : %d\n", desc1->type);
3342 abort ();
3343 }
3344 }
3345
3346 if (mark_last_occurred_object)
3347 {
3348 Lisp_Object obj = *last_occurred_object;
3349
3350 old_tail_recurse:
3351 /* NOTE: The second parameter isn't even evaluated
3352 non-ERROR_CHECK_GC, so it's OK for the variable not to exist.
3353 */
3354 KKCC_DO_CHECK_FREE
3355 (obj, (last_occurred_flags & XD_FLAG_FREE_LISP_OBJECT) != 0);
3356
3357 if (XTYPE (obj) == Lisp_Type_Record)
3358 {
3359 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
3360
3361 GC_CHECK_LHEADER_INVARIANTS (lheader);
3362
3363 /* All c_readonly objects have their mark bit set,
3364 so that we only need to check the mark bit here. */
3365 if (! MARKED_RECORD_HEADER_P (lheader))
3366 {
3367 MARK_RECORD_HEADER (lheader);
3368
3369 {
3370 desc = LHEADER_IMPLEMENTATION (lheader)->description;
3371 if (desc) /* && !CONSP(obj))*/ /* KKCC cons special case */
3372 {
3373 data = lheader;
3374 mark_last_occurred_object = 0;
3375 goto tail_recurse;
3376 }
3377 else
3378 {
3379 if (RECORD_MARKER (lheader))
3380 {
3381 obj = RECORD_MARKER (lheader) (obj);
3382 if (!NILP (obj)) goto old_tail_recurse;
3383 }
3384 }
3385 }
3386 }
3387 }
3388
3389 mark_last_occurred_object = 0;
3390 }
3391 }
3392 3335
3393 /* This function loops all elements of a struct pointer and calls 3336 /* This function loops all elements of a struct pointer and calls
3394 mark_with_description with each element. */ 3337 mark_with_description with each element. */
3395 static void 3338 static void
3396 mark_struct_contents (const void *data, 3339 mark_struct_contents (const void *data,
3401 Bytecount elsize; 3344 Bytecount elsize;
3402 elsize = lispdesc_structure_size (data, sdesc); 3345 elsize = lispdesc_structure_size (data, sdesc);
3403 3346
3404 for (i = 0; i < count; i++) 3347 for (i = 0; i < count; i++)
3405 { 3348 {
3406 mark_with_description (((char *) data) + elsize * i, 3349 kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description);
3407 sdesc->description);
3408 } 3350 }
3409 } 3351 }
3410 3352
3353
3354 /* This function implements the KKCC mark algorithm.
3355 Instead of calling mark_object, all the alive Lisp_Objects are pushed
3356 on the kkcc_gc_stack. This function processes all elements on the stack
3357 according to their descriptions. */
3358 static void
3359 kkcc_marking (void)
3360 {
3361 kkcc_gc_stack_entry *stack_entry = 0;
3362 void *data = 0;
3363 const struct memory_description *desc = 0;
3364 int pos;
3365
3366 while ((stack_entry = kkcc_gc_stack_pop ()) != 0)
3367 {
3368 data = stack_entry->data;
3369 desc = stack_entry->desc;
3370
3371 for (pos = 0; desc[pos].type != XD_END; pos++)
3372 {
3373 const struct memory_description *desc1 = &desc[pos];
3374 const void *rdata =
3375 (const char *) data + lispdesc_indirect_count (desc1->offset,
3376 desc, data);
3377 union_switcheroo:
3378
3379 /* If the flag says don't mark, then don't mark. */
3380 if ((desc1->flags) & XD_FLAG_NO_KKCC)
3381 continue;
3382
3383 switch (desc1->type)
3384 {
3385 case XD_BYTECOUNT:
3386 case XD_ELEMCOUNT:
3387 case XD_HASHCODE:
3388 case XD_INT:
3389 case XD_LONG:
3390 case XD_INT_RESET:
3391 case XD_LO_LINK:
3392 case XD_OPAQUE_PTR:
3393 case XD_OPAQUE_DATA_PTR:
3394 case XD_C_STRING:
3395 case XD_DOC_STRING:
3396 break;
3397 case XD_LISP_OBJECT:
3398 {
3399 const Lisp_Object *stored_obj = (const Lisp_Object *) rdata;
3400
3401 /* Because of the way that tagged objects work (pointers and
3402 Lisp_Objects have the same representation), XD_LISP_OBJECT
3403 can be used for untagged pointers. They might be NULL,
3404 though. */
3405 if (EQ (*stored_obj, Qnull_pointer))
3406 break;
3407 mark_object_maybe_checking_free
3408 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
3409
3410 break;
3411 }
3412 case XD_LISP_OBJECT_ARRAY:
3413 {
3414 int i;
3415 EMACS_INT count =
3416 lispdesc_indirect_count (desc1->data1, desc, data);
3417
3418 for (i = 0; i < count; i++)
3419 {
3420 const Lisp_Object *stored_obj =
3421 (const Lisp_Object *) rdata + i;
3422
3423 if (EQ (*stored_obj, Qnull_pointer))
3424 break;
3425
3426 mark_object_maybe_checking_free
3427 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
3428 }
3429 break;
3430 }
3431 case XD_STRUCT_PTR:
3432 {
3433 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
3434 data);
3435 const struct sized_memory_description *sdesc =
3436 lispdesc_indirect_description (data, desc1->data2);
3437 const char *dobj = * (const char **) rdata;
3438 if (dobj)
3439 mark_struct_contents (dobj, sdesc, count);
3440 break;
3441 }
3442 case XD_STRUCT_ARRAY:
3443 {
3444 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
3445 data);
3446 const struct sized_memory_description *sdesc =
3447 lispdesc_indirect_description (data, desc1->data2);
3448
3449 mark_struct_contents (rdata, sdesc, count);
3450 break;
3451 }
3452 case XD_UNION:
3453 case XD_UNION_DYNAMIC_SIZE:
3454 desc1 = lispdesc_process_xd_union (desc1, desc, data);
3455 if (desc1)
3456 goto union_switcheroo;
3457 break;
3458
3459 default:
3460 stderr_out ("Unsupported description type : %d\n", desc1->type);
3461 abort ();
3462 }
3463 }
3464 }
3465 }
3411 #endif /* USE_KKCC */ 3466 #endif /* USE_KKCC */
3412 3467
3413 /* Mark reference to a Lisp_Object. If the object referred to has not been 3468 /* Mark reference to a Lisp_Object. If the object referred to has not been
3414 seen yet, recursively mark all the references contained in it. */ 3469 seen yet, recursively mark all the references contained in it. */
3415 3470
3416 void 3471 void
3417 mark_object (Lisp_Object obj) 3472 mark_object (Lisp_Object obj)
3418 { 3473 {
3474 #ifdef USE_KKCC
3475 /* this code should never be reached when configured for KKCC */
3476 stderr_out ("KKCC: Invalid mark_object call.\n");
3477 stderr_out ("Replace mark_object with kkcc_gc_stack_push_lisp_object.\n");
3478 abort ();
3479 #endif /* USE_KKCC */
3480
3419 tail_recurse: 3481 tail_recurse:
3420 3482
3421 /* Checks we used to perform */ 3483 /* Checks we used to perform */
3422 /* if (EQ (obj, Qnull_pointer)) return; */ 3484 /* if (EQ (obj, Qnull_pointer)) return; */
3423 /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */ 3485 /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */
3427 { 3489 {
3428 struct lrecord_header *lheader = XRECORD_LHEADER (obj); 3490 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
3429 3491
3430 GC_CHECK_LHEADER_INVARIANTS (lheader); 3492 GC_CHECK_LHEADER_INVARIANTS (lheader);
3431 3493
3432 #ifndef USE_KKCC
3433 /* We handle this separately, above, so we can mark free objects */ 3494 /* We handle this separately, above, so we can mark free objects */
3434 GC_CHECK_NOT_FREE (lheader); 3495 GC_CHECK_NOT_FREE (lheader);
3435 #endif /* not USE_KKCC */
3436 3496
3437 /* All c_readonly objects have their mark bit set, 3497 /* All c_readonly objects have their mark bit set,
3438 so that we only need to check the mark bit here. */ 3498 so that we only need to check the mark bit here. */
3439 if (! MARKED_RECORD_HEADER_P (lheader)) 3499 if (! MARKED_RECORD_HEADER_P (lheader))
3440 { 3500 {
3441 MARK_RECORD_HEADER (lheader); 3501 MARK_RECORD_HEADER (lheader);
3442 3502
3443 { 3503 if (RECORD_MARKER (lheader))
3444 #ifdef USE_KKCC 3504 {
3445 const struct memory_description *desc; 3505 obj = RECORD_MARKER (lheader) (obj);
3446 desc = LHEADER_IMPLEMENTATION (lheader)->description; 3506 if (!NILP (obj)) goto tail_recurse;
3447 if (desc) /* && !CONSP(obj))*/ /* KKCC cons special case */ 3507 }
3448 mark_with_description (lheader, desc);
3449 else
3450 #endif /* USE_KKCC */
3451 {
3452 if (RECORD_MARKER (lheader))
3453 {
3454 obj = RECORD_MARKER (lheader) (obj);
3455 if (!NILP (obj)) goto tail_recurse;
3456 }
3457 }
3458 }
3459 } 3508 }
3460 } 3509 }
3461 } 3510 }
3462 3511
3463
3464 /* Find all structures not marked, and free them. */
3465 3512
3466 static int gc_count_num_short_string_in_use; 3513 static int gc_count_num_short_string_in_use;
3467 static Bytecount gc_count_string_total_size; 3514 static Bytecount gc_count_string_total_size;
3468 static Bytecount gc_count_short_string_total_size; 3515 static Bytecount gc_count_short_string_total_size;
3469 3516
4540 cleanup_specifiers (); 4587 cleanup_specifiers ();
4541 cleanup_buffer_undo_lists (); 4588 cleanup_buffer_undo_lists ();
4542 4589
4543 /* Mark all the special slots that serve as the roots of accessibility. */ 4590 /* Mark all the special slots that serve as the roots of accessibility. */
4544 4591
4592 #ifdef USE_KKCC
4593 /* initialize kkcc stack */
4594 kkcc_gc_stack_init();
4595 #endif /* USE_KKCC */
4596
4545 { /* staticpro() */ 4597 { /* staticpro() */
4546 Lisp_Object **p = Dynarr_begin (staticpros); 4598 Lisp_Object **p = Dynarr_begin (staticpros);
4547 Elemcount count; 4599 Elemcount count;
4548 for (count = Dynarr_length (staticpros); count; count--) 4600 for (count = Dynarr_length (staticpros); count; count--)
4601 #ifdef USE_KKCC
4602 kkcc_gc_stack_push_lisp_object (**p++);
4603 #else /* NOT USE_KKCC */
4549 mark_object (**p++); 4604 mark_object (**p++);
4605 #endif /* NOT USE_KKCC */
4550 } 4606 }
4551 4607
4552 { /* staticpro_nodump() */ 4608 { /* staticpro_nodump() */
4553 Lisp_Object **p = Dynarr_begin (staticpros_nodump); 4609 Lisp_Object **p = Dynarr_begin (staticpros_nodump);
4554 Elemcount count; 4610 Elemcount count;
4555 for (count = Dynarr_length (staticpros_nodump); count; count--) 4611 for (count = Dynarr_length (staticpros_nodump); count; count--)
4612 #ifdef USE_KKCC
4613 kkcc_gc_stack_push_lisp_object (**p++);
4614 #else /* NOT USE_KKCC */
4556 mark_object (**p++); 4615 mark_object (**p++);
4616 #endif /* NOT USE_KKCC */
4557 } 4617 }
4558 4618
4559 { /* GCPRO() */ 4619 { /* GCPRO() */
4560 struct gcpro *tail; 4620 struct gcpro *tail;
4561 int i; 4621 int i;
4562 for (tail = gcprolist; tail; tail = tail->next) 4622 for (tail = gcprolist; tail; tail = tail->next)
4563 for (i = 0; i < tail->nvars; i++) 4623 for (i = 0; i < tail->nvars; i++)
4624 #ifdef USE_KKCC
4625 kkcc_gc_stack_push_lisp_object (tail->var[i]);
4626 #else /* NOT USE_KKCC */
4564 mark_object (tail->var[i]); 4627 mark_object (tail->var[i]);
4628 #endif /* NOT USE_KKCC */
4565 } 4629 }
4566 4630
4567 { /* specbind() */ 4631 { /* specbind() */
4568 struct specbinding *bind; 4632 struct specbinding *bind;
4569 for (bind = specpdl; bind != specpdl_ptr; bind++) 4633 for (bind = specpdl; bind != specpdl_ptr; bind++)
4570 { 4634 {
4635 #ifdef USE_KKCC
4636 kkcc_gc_stack_push_lisp_object (bind->symbol);
4637 kkcc_gc_stack_push_lisp_object (bind->old_value);
4638 #else /* NOT USE_KKCC */
4571 mark_object (bind->symbol); 4639 mark_object (bind->symbol);
4572 mark_object (bind->old_value); 4640 mark_object (bind->old_value);
4641 #endif /* NOT USE_KKCC */
4573 } 4642 }
4574 } 4643 }
4575 4644
4576 { 4645 {
4577 struct catchtag *catch; 4646 struct catchtag *catch;
4578 for (catch = catchlist; catch; catch = catch->next) 4647 for (catch = catchlist; catch; catch = catch->next)
4579 { 4648 {
4649 #ifdef USE_KKCC
4650 kkcc_gc_stack_push_lisp_object (catch->tag);
4651 kkcc_gc_stack_push_lisp_object (catch->val);
4652 kkcc_gc_stack_push_lisp_object (catch->actual_tag);
4653 #else /* NOT USE_KKCC */
4580 mark_object (catch->tag); 4654 mark_object (catch->tag);
4581 mark_object (catch->val); 4655 mark_object (catch->val);
4582 mark_object (catch->actual_tag); 4656 mark_object (catch->actual_tag);
4657 #endif /* NOT USE_KKCC */
4583 } 4658 }
4584 } 4659 }
4585 4660
4586 { 4661 {
4587 struct backtrace *backlist; 4662 struct backtrace *backlist;
4588 for (backlist = backtrace_list; backlist; backlist = backlist->next) 4663 for (backlist = backtrace_list; backlist; backlist = backlist->next)
4589 { 4664 {
4590 int nargs = backlist->nargs; 4665 int nargs = backlist->nargs;
4591 int i; 4666 int i;
4592 4667
4668 #ifdef USE_KKCC
4669 kkcc_gc_stack_push_lisp_object (*backlist->function);
4670 if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */
4671 /* might be fake (internal profiling entry) */
4672 && backlist->args)
4673 kkcc_gc_stack_push_lisp_object (backlist->args[0]);
4674 else
4675 for (i = 0; i < nargs; i++)
4676 kkcc_gc_stack_push_lisp_object (backlist->args[i]);
4677 #else /* NOT USE_KKCC */
4593 mark_object (*backlist->function); 4678 mark_object (*backlist->function);
4594 if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */ 4679 if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */
4595 /* might be fake (internal profiling entry) */ 4680 /* might be fake (internal profiling entry) */
4596 && backlist->args) 4681 && backlist->args)
4597 mark_object (backlist->args[0]); 4682 mark_object (backlist->args[0]);
4598 else 4683 else
4599 for (i = 0; i < nargs; i++) 4684 for (i = 0; i < nargs; i++)
4600 mark_object (backlist->args[i]); 4685 mark_object (backlist->args[i]);
4686 #endif /* NOT USE_KKCC */
4601 } 4687 }
4602 } 4688 }
4603 4689
4604 mark_profiling_info (); 4690 mark_profiling_info ();
4605 4691
4607 are only marked when something else is marked (e.g. weak hash tables). 4693 are only marked when something else is marked (e.g. weak hash tables).
4608 There may be complex dependencies between such objects -- e.g. 4694 There may be complex dependencies between such objects -- e.g.
4609 a weak hash table might be unmarked, but after processing a later 4695 a weak hash table might be unmarked, but after processing a later
4610 weak hash table, the former one might get marked. So we have to 4696 weak hash table, the former one might get marked. So we have to
4611 iterate until nothing more gets marked. */ 4697 iterate until nothing more gets marked. */
4612 4698 #ifdef USE_KKCC
4699 kkcc_marking ();
4700 #endif /* USE_KKCC */
4613 init_marking_ephemerons (); 4701 init_marking_ephemerons ();
4614 while (finish_marking_weak_hash_tables () > 0 || 4702 while (finish_marking_weak_hash_tables () > 0 ||
4615 finish_marking_weak_lists () > 0 || 4703 finish_marking_weak_lists () > 0 ||
4616 continue_marking_ephemerons () > 0) 4704 continue_marking_ephemerons () > 0)
4617 ; 4705 ;
4706
4707 #ifdef USE_KKCC
4708 kkcc_marking ();
4709 kkcc_gc_stack_free ();
4710 #endif /* USE_KKCC */
4618 4711
4619 /* At this point, we know which objects need to be finalized: we 4712 /* At this point, we know which objects need to be finalized: we
4620 still need to resurrect them */ 4713 still need to resurrect them */
4621 4714
4622 while (finish_marking_ephemerons () > 0 || 4715 while (finish_marking_ephemerons () > 0 ||