Ticket #1173: okay-working-symbol-gc.patch
File okay-working-symbol-gc.patch, 16.8 KB (added by , 8 years ago) |
---|
-
NEWS
diff --git a/NEWS b/NEWS index d64c818..0481245 100644
a b 23 23 which is faster because it is inlined (#1260, thanks to Kooda). 24 24 - The default error handler now truncates very long condition 25 25 messages (thanks to Lemonboy). 26 - Weak symbol GC (-:w) no longer drops random symbols (#1173). 26 27 27 28 - Syntax expander 28 29 - DSSSL lambda lists have improved hygiene, so they don't need -
chicken.h
diff --git a/chicken.h b/chicken.h index d451835..e988e54 100644
a b C_fctexport C_word C_fcall C_i_o_fixnum_and(C_word x, C_word y) C_regparm; 1951 1951 C_fctexport C_word C_fcall C_i_o_fixnum_ior(C_word x, C_word y) C_regparm; 1952 1952 C_fctexport C_word C_fcall C_i_o_fixnum_xor(C_word x, C_word y) C_regparm; 1953 1953 C_fctexport C_word C_fcall C_a_i_flonum_round_proper(C_word **a, int c, C_word n) C_regparm; 1954 C_fctexport C_word C_fcall C_i_persist_symbol(C_word sym) C_regparm; 1954 1955 C_fctexport C_word C_fcall C_i_getprop(C_word sym, C_word prop, C_word def) C_regparm; 1955 1956 C_fctexport C_word C_fcall C_putprop(C_word **a, C_word sym, C_word prop, C_word val) C_regparm; 1956 1957 C_fctexport C_word C_fcall C_i_get_keyword(C_word key, C_word args, C_word def) C_regparm; … … C_inline C_word C_fcall C_a_bucket(C_word **ptr, C_word head, C_word tail) 2652 2653 { 2653 2654 C_word *p = *ptr, *p0 = p; 2654 2655 2655 *(p++) = C_BUCKET_TYPE | (C_SIZEOF_BUCKET - 1); 2656 if (C_enable_gcweak) 2657 *(p++) = C_BUCKET_TYPE | C_SPECIALBLOCK_BIT | (C_SIZEOF_BUCKET - 1); 2658 else 2659 *(p++) = C_BUCKET_TYPE | (C_SIZEOF_BUCKET - 1); 2656 2660 *(p++) = head; 2657 2661 *(p++) = tail; 2658 2662 *ptr = p; -
eval.scm
diff --git a/eval.scm b/eval.scm index 6242f62..cc304c3 100644
a b 381 381 (lambda (v) 382 382 (##sys#error 'eval "environment is not mutable" evalenv var)) ;XXX var? 383 383 (lambda (v) 384 (##sys#persist-symbol var) 384 385 (##sys#setslot var 0 (##core#app val v))) ) ) ] 385 386 [(zero? i) (lambda (v) (##sys#setslot (##sys#slot v 0) j (##core#app val v)))] 386 387 [else -
library.scm
diff --git a/library.scm b/library.scm index e95542f..71bfbf1 100644
a b EOF 204 204 (define ##sys#gc (##core#primitive "C_gc")) 205 205 (define (##sys#setslot x i y) (##core#inline "C_i_setslot" x i y)) 206 206 (define (##sys#setislot x i y) (##core#inline "C_i_set_i_slot" x i y)) 207 (define (##sys#persist-symbol s) (##core#inline "C_i_persist_symbol" s)) 207 208 (define ##sys#allocate-vector (##core#primitive "C_allocate_vector")) 208 209 (define (argc+argv) (##sys#values main_argc main_argv)) 209 210 (define ##sys#make-structure (##core#primitive "C_make_structure")) … … EOF 4971 4972 4972 4973 (define get (getter-with-setter ##sys#get put! "(get sym prop . default)")) 4973 4974 4975 ;; TODO: "Unpersist" symbol if this drops the last property 4974 4976 (define (remprop! sym prop) 4975 4977 (##sys#check-symbol sym 'remprop!) 4976 4978 (let loop ((plist (##sys#slot sym 2)) (ptl #f)) -
runtime.c
diff --git a/runtime.c b/runtime.c index cdaaa0e..f7983ba 100644
a b static C_TLS int timezone; 156 156 157 157 #define MAX_HASH_PREFIX 64 158 158 159 #define WEAK_TABLE_SIZE 997160 #define WEAK_HASH_ITERATIONS 4161 #define WEAK_HASH_DISPLACEMENT 7162 #define WEAK_COUNTER_MASK 3163 #define WEAK_COUNTER_MAX 2164 165 159 #define TEMPORARY_STACK_SIZE 4096 166 160 #define STRING_BUFFER_SIZE 4096 167 161 #define DEFAULT_MUTATION_STACK_SIZE 1024 … … typedef struct lf_list_struct 285 279 char *module_name; 286 280 } LF_LIST; 287 281 288 typedef struct weak_table_entry_struct289 {290 C_word item, /* item weakly held (symbol) */291 container; /* object holding reference to symbol, lowest 3 bits are */292 } WEAK_TABLE_ENTRY; /* also used as a counter, saturated at 2 or more */293 294 282 typedef struct finalizer_node_struct 295 283 { 296 284 struct finalizer_node_struct … … static C_TLS int 438 426 gc_count_1, 439 427 gc_count_1_total, 440 428 gc_count_2, 441 weak_table_randomization,442 429 stack_size_changed, 443 430 dlopen_flags, 444 431 heap_size_changed, … … static C_TLS int 474 461 allocated_finalizer_count, 475 462 pending_finalizer_count, 476 463 callback_returned_flag; 477 static C_TLS WEAK_TABLE_ENTRY *weak_item_table;478 464 static C_TLS C_GC_ROOT *gc_root_list = NULL; 479 465 static C_TLS FINALIZER_NODE 480 466 *finalizer_list, … … static void panic(C_char *msg) C_noret; 501 487 static void usual_panic(C_char *msg) C_noret; 502 488 static void horror(C_char *msg) C_noret; 503 489 static void C_fcall really_mark(C_word *x) C_regparm; 504 static WEAK_TABLE_ENTRY *C_fcall lookup_weak_table_entry(C_word item, C_word container) C_regparm;505 490 static C_cpsproc(values_continuation) C_noret; 506 491 static C_word add_symbol(C_word **ptr, C_word key, C_word string, C_SYMBOL_TABLE *stable); 507 492 static C_regparm int C_fcall C_in_new_heapp(C_word x); 508 493 static C_word C_fcall hash_string(int len, C_char *str, C_word m, C_word r, int ci) C_regparm; 509 494 static C_word C_fcall lookup(C_word key, int len, C_char *str, C_SYMBOL_TABLE *stable) C_regparm; 495 static void C_fcall persist(C_word sym, C_SYMBOL_TABLE *stable) C_regparm; 510 496 static double compute_symbol_table_load(double *avg_bucket_len, int *total); 511 497 static C_word C_fcall convert_string_to_number(C_char *str, int radix, C_word *fix, double *flo) C_regparm; 512 498 static C_word C_fcall maybe_inexact_to_exact(C_word n) C_regparm; … … static void C_fcall remark_system_globals(void) C_regparm; 515 501 static void C_fcall really_remark(C_word *x) C_regparm; 516 502 static C_word C_fcall intern0(C_char *name) C_regparm; 517 503 static void C_fcall update_locative_table(int mode) C_regparm; 504 static void C_fcall update_symbol_tables(int mode) C_regparm; 518 505 static LF_LIST *find_module_handle(C_char *name); 519 506 static void set_profile_timer(C_uword freq); 520 507 static void take_profile_sample(); … … int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel) 687 674 C_gc_mutation_hook = NULL; 688 675 C_gc_trace_hook = NULL; 689 676 690 /* Allocate weak item table: */691 if(C_enable_gcweak) {692 weak_item_table = (WEAK_TABLE_ENTRY *)C_calloc(WEAK_TABLE_SIZE, sizeof(WEAK_TABLE_ENTRY));693 694 if(weak_item_table == NULL)695 return 0;696 }697 698 677 /* Initialize finalizer lists: */ 699 678 finalizer_list = NULL; 700 679 finalizer_free_list = NULL; … … C_regparm C_word C_fcall lookup(C_word key, int len, C_char *str, C_SYMBOL_TABLE 2257 2236 return C_SCHEME_FALSE; 2258 2237 } 2259 2238 2239 C_regparm C_word C_fcall C_i_persist_symbol(C_word sym) 2240 { 2241 C_i_check_symbol(sym); 2242 persist(sym, NULL); 2243 return C_SCHEME_UNDEFINED; 2244 } 2245 2246 /* Mark a symbol as "persistent", to prevent it from being GC'ed */ 2247 C_regparm void C_fcall persist(C_word sym, C_SYMBOL_TABLE *stable) 2248 { 2249 C_word bucket, str = C_block_item(sym, 1); 2250 int key, len = C_header_size(str); 2251 2252 if (stable == NULL) stable = symbol_table; 2253 2254 key = hash_string(len, C_c_string(str), stable->size, stable->rand, 0); 2255 2256 for(bucket = stable->table[ key ]; bucket != C_SCHEME_END_OF_LIST; 2257 bucket = C_block_item(bucket,1)) { 2258 if (C_block_item(bucket,0) == sym) { 2259 /* Change weak to strong ref to ensure overall survival */ 2260 C_block_header(bucket) = C_block_header(bucket) & ~C_SPECIALBLOCK_BIT; 2261 /* Ensure survival on next minor GC */ 2262 if (C_in_stackp(sym)) C_mutate_slot(&C_block_item(bucket, 0), sym); 2263 return; 2264 } 2265 } 2266 } 2267 2260 2268 2261 2269 double compute_symbol_table_load(double *avg_bucket_len, int *total_n) 2262 2270 { … … static void mark(C_word *x) { \ 2834 2842 C_cblockend 2835 2843 #endif 2836 2844 2837 2838 2845 C_regparm void C_fcall C_reclaim(void *trampoline, C_word c) 2839 2846 { 2840 int i, j, n, fcount , weakn = 0;2847 int i, j, n, fcount; 2841 2848 C_uword count, bytes; 2842 C_word *p, **msp, bucket, last , item, container;2849 C_word *p, **msp, bucket, last; 2843 2850 C_header h; 2844 2851 C_byte *tmp, *start; 2845 2852 LF_LIST *lfn; 2846 2853 C_SCHEME_BLOCK *bp; 2847 2854 C_GC_ROOT *gcrp; 2848 WEAK_TABLE_ENTRY *wep;2849 2855 double tgc = 0; 2850 2856 C_SYMBOL_TABLE *stp; 2851 2857 volatile int finalizers_checked; … … C_regparm void C_fcall C_reclaim(void *trampoline, C_word c) 2874 2880 gc_mode = GC_MINOR; 2875 2881 start = C_fromspace_top; 2876 2882 2877 if(C_enable_gcweak)2878 weak_table_randomization = rand();2879 2880 2883 /* Entry point for second-level GC (on explicit request or because of full fromspace): */ 2881 2884 #ifdef HAVE_SIGSETJMP 2882 2885 if(C_sigsetjmp(gc_restart, 0) || start >= C_fromspace_limit) { … … C_regparm void C_fcall C_reclaim(void *trampoline, C_word c) 3092 3095 3093 3096 i_like_spaghetti: 3094 3097 ++gc_count_2; 3095 3096 if(C_enable_gcweak) {3097 /* Check entries in weak item table and recover items ref'd only3098 once, which are unbound symbols and have empty property-lists: */3099 weakn = 0;3100 wep = weak_item_table;3101 3102 for(i = 0; i < WEAK_TABLE_SIZE; ++i, ++wep)3103 if(wep->item != 0) {3104 if((wep->container & WEAK_COUNTER_MAX) == 0 && /* counter saturated? (more than 1) */3105 is_fptr((item = C_block_header(wep->item)))) { /* and forwarded/collected */3106 item = fptr_to_ptr(item); /* recover obj from forwarding ptr */3107 container = wep->container & ~WEAK_COUNTER_MASK;3108 3109 if(C_header_bits(item) == C_SYMBOL_TYPE &&3110 C_block_item(item, 0) == C_SCHEME_UNBOUND &&3111 C_block_item(item, 2) == C_SCHEME_END_OF_LIST) {3112 ++weakn;3113 C_set_block_item(container, 0, C_SCHEME_UNDEFINED); /* clear reference to item */3114 }3115 }3116 3117 wep->item = wep->container = 0;3118 }3119 3120 /* Remove empty buckets in symbol table: */3121 for(stp = symbol_table_list; stp != NULL; stp = stp->next) {3122 for(i = 0; i < stp->size; ++i) {3123 last = 0;3124 3125 for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1))3126 if(C_block_item(bucket,0) == C_SCHEME_UNDEFINED) {3127 if(last) C_set_block_item(last, 1, C_block_item(bucket,1));3128 else stp->table[ i ] = C_block_item(bucket,1);3129 }3130 else last = bucket;3131 }3132 }3133 }3134 3098 } 3135 3099 3100 update_symbol_tables(gc_mode); 3101 3136 3102 if(gc_mode == GC_MAJOR) { 3137 3103 tgc = C_cpu_milliseconds() - tgc; 3138 3104 gc_ms += tgc; … … C_regparm void C_fcall C_reclaim(void *trampoline, C_word c) 3169 3135 (C_uword)tospace_start, (C_uword)tospace_top, 3170 3136 (C_uword)tospace_limit); 3171 3137 3172 if(gc_mode == GC_MAJOR && C_enable_gcweak && weakn)3173 C_dbg("GC", C_text("%d recoverable weakly held items found\n"), weakn);3174 3175 3138 C_dbg("GC", C_text("%d locatives (from %d)\n"), locative_table_count, locative_table_size); 3176 3139 } 3177 3140 … … C_regparm void C_fcall mark_system_globals(void) 3200 3163 3201 3164 C_regparm void C_fcall really_mark(C_word *x) 3202 3165 { 3203 C_word val , item;3166 C_word val; 3204 3167 C_uword n, bytes; 3205 3168 C_header h; 3206 3169 C_SCHEME_BLOCK *p, *p2; 3207 WEAK_TABLE_ENTRY *wep;3208 3170 3209 3171 val = *x; 3210 3172 … … C_regparm void C_fcall really_mark(C_word *x) 3227 3189 return; 3228 3190 } 3229 3191 3230 if((C_uword)val >= (C_uword)fromspace_start && (C_uword)val < (C_uword)C_fromspace_top) return; 3192 if((C_uword)val >= (C_uword)fromspace_start && (C_uword)val < (C_uword)C_fromspace_top) 3193 return; 3231 3194 3232 3195 p2 = (C_SCHEME_BLOCK *)C_align((C_uword)C_fromspace_top); 3233 3196 … … C_regparm void C_fcall really_mark(C_word *x) 3257 3220 C_memcpy(p2->data, p->data, bytes); 3258 3221 } 3259 3222 else { /* (major GC) */ 3260 /* Increase counter (saturated at 2) if weakly held item (someone pointed to this object): */3261 if(C_enable_gcweak &&3262 (h & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE &&3263 (wep = lookup_weak_table_entry(val, 0)) != NULL) {3264 if((wep->container & WEAK_COUNTER_MAX) == 0) ++wep->container;3265 }3266 3267 3223 if(is_fptr(h)) { 3268 3224 val = fptr_to_ptr(h); 3269 3225 … … C_regparm void C_fcall really_mark(C_word *x) 3299 3255 } 3300 3256 #endif 3301 3257 3302 if(C_enable_gcweak && (h & C_HEADER_TYPE_BITS) == C_BUCKET_TYPE) {3303 item = C_block_item(val,0);3304 3305 /* Lookup item in weak item table or add entry: */3306 if((wep = lookup_weak_table_entry(item, (C_word)p2)) != NULL) {3307 /* If item is already forwarded, then set count to 2: */3308 if(is_fptr(C_block_header(item))) wep->container |= 2;3309 }3310 }3311 3312 3258 n = C_header_size(p); 3313 3259 bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word); 3314 3260 … … static void remark(C_word *x) { \ 3348 3294 C_cblockend 3349 3295 #endif 3350 3296 3351 3352 3297 /* Do a major GC into a freshly allocated heap: */ 3353 3298 3354 3299 C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize) 3355 3300 { 3356 3301 int i, j; 3357 3302 C_uword count, n, bytes; 3358 C_word *p, **msp, item, last;3303 C_word *p, **msp, bucket, last; 3359 3304 C_header h; 3360 3305 C_byte *tmp, *start; 3361 3306 LF_LIST *lfn; 3362 3307 C_SCHEME_BLOCK *bp; 3363 WEAK_TABLE_ENTRY *wep;3364 3308 C_GC_ROOT *gcrp; 3365 3309 C_SYMBOL_TABLE *stp; 3366 3310 FINALIZER_NODE *flist; … … C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize) 3445 3389 /* Mark symbol table: */ 3446 3390 for(stp = symbol_table_list; stp != NULL; stp = stp->next) 3447 3391 for(i = 0; i < stp->size; ++i) 3448 remark(&stp->table[i]); 3392 remark(&stp->table[i]); /* Ensure buckets survive */ 3449 3393 3450 3394 /* Mark collectibles: */ 3451 3395 for(msp = collectibles; msp < collectibles_top; ++msp) … … C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize) 3473 3417 remark(&flist->finalizer); 3474 3418 } 3475 3419 3476 /* Clear weakly held items: */3477 if(C_enable_gcweak) {3478 wep = weak_item_table;3479 3480 for(i = 0; i < WEAK_TABLE_SIZE; ++i, ++wep)3481 wep->item = wep->container = 0;3482 }3483 3484 3420 /* Mark trace-buffer: */ 3485 3421 for(tinfo = trace_buffer; tinfo < trace_buffer_limit; ++tinfo) { 3486 3422 remark(&tinfo->cooked1); … … C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize) 3515 3451 heap_scan_top = (C_byte *)bp + C_align(bytes) + sizeof(C_word); 3516 3452 } 3517 3453 3454 update_symbol_tables(GC_REALLOC); 3455 3518 3456 heap_free (heapspace1, heapspace1_size); 3519 3457 heap_free (heapspace2, heapspace2_size); 3520 3458 … … C_regparm void C_fcall really_remark(C_word *x) 3560 3498 C_uword n, bytes; 3561 3499 C_header h; 3562 3500 C_SCHEME_BLOCK *p, *p2; 3563 WEAK_TABLE_ENTRY *wep;3564 3501 3565 3502 val = *x; 3566 3503 … … C_regparm void C_fcall update_locative_table(int mode) 3734 3671 if(mode != GC_REALLOC) locative_table_count = hi; 3735 3672 } 3736 3673 3737 3738 C_regparm WEAK_TABLE_ENTRY *C_fcall lookup_weak_table_entry(C_word item, C_word container) 3674 C_regparm void C_fcall update_symbol_tables(int mode) 3739 3675 { 3740 C_uword 3741 key = (C_uword)item >> 2, 3742 disp = 0, 3743 n; 3744 WEAK_TABLE_ENTRY *wep; 3745 3746 for(n = 0; n < WEAK_HASH_ITERATIONS; ++n) { 3747 key = (key + disp + weak_table_randomization) % WEAK_TABLE_SIZE; 3748 wep = &weak_item_table[ key ]; 3676 int weakn = 0, i; 3677 C_word bucket, last, sym, h; 3678 C_SYMBOL_TABLE *stp; 3749 3679 3750 if(wep->item == 0) { 3751 if(container != 0) { 3752 /* Add fresh entry: */ 3753 wep->item = item; 3754 wep->container = container; 3755 return wep; 3680 if(C_enable_gcweak) { 3681 /* Fixup symbol table */ 3682 for(stp = symbol_table_list; stp != NULL; stp = stp->next) { 3683 for(i = 0; i < stp->size; ++i) { 3684 last = 0; 3685 3686 for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1)) { 3687 3688 sym = C_block_item(bucket, 0); 3689 h = C_block_header(sym); 3690 3691 /* Resolve any forwarding pointers */ 3692 while(is_fptr(h)) { 3693 sym = fptr_to_ptr(h); 3694 h = C_block_header(sym); 3695 } 3696 3697 assert((h & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE); 3698 3699 /* If the symbol is unreferenced, drop it: */ 3700 if(!C_truep(C_permanentp(sym)) && (mode == GC_REALLOC ? 3701 !C_in_new_heapp(sym) : 3702 !C_in_fromspacep(sym))) { 3703 3704 if(last) C_set_block_item(last, 1, C_block_item(bucket,1)); 3705 else stp->table[ i ] = C_block_item(bucket,1); 3706 3707 assert(C_block_item(sym, 0) == C_SCHEME_UNBOUND || 3708 C_block_item(sym, 0) == sym); /* kw */ 3709 assert(C_block_item(sym, 2) == C_SCHEME_END_OF_LIST); 3710 ++weakn; 3711 } else { 3712 C_set_block_item(bucket,0,sym); /* Might have moved */ 3713 last = bucket; 3714 } 3715 } 3756 3716 } 3757 3758 return NULL;3759 3717 } 3760 else if(wep->item == item) return wep; 3761 else disp += WEAK_HASH_DISPLACEMENT; 3718 if(gc_report_flag && weakn) 3719 C_dbg("GC", C_text("%d recoverable weakly held items found\n"), weakn); 3720 } else { 3721 #ifdef DEBUGBUILD 3722 /* Sanity check: all symbols should've been marked */ 3723 for(stp = symbol_table_list; stp != NULL; stp = stp->next) 3724 for(i = 0; i < stp->size; ++i) 3725 for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1)) { 3726 sym = C_block_item(bucket, 0); 3727 assert(!is_fptr(C_block_header(sym)) && 3728 (C_truep(C_permanentp(sym)) || 3729 (mode == GC_REALLOC ? 3730 C_in_new_heapp(sym) : 3731 C_in_fromspacep(sym)))); 3732 } 3733 #endif 3762 3734 } 3763 3764 return NULL;3765 3735 } 3766 3736 3767 3737 … … C_putprop(C_word **ptr, C_word sym, C_word prop, C_word val) 9404 9374 { 9405 9375 C_word pl = C_block_item(sym, 2); 9406 9376 9377 /* Newly added plist? Ensure the symbol stays! */ 9378 if (C_enable_gcweak && pl == C_SCHEME_END_OF_LIST) persist(sym, NULL); 9379 9407 9380 while(pl != C_SCHEME_END_OF_LIST) { 9408 9381 if(C_block_item(pl, 0) == prop) { 9409 9382 C_mutate2(&C_u_i_car(C_u_i_cdr(pl)), val);