Ticket #1173: fast-working-symbol-gc.patch
File fast-working-symbol-gc.patch, 17.5 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..e7bdfb8 100644
a b static inline int isinf_ld (long double x) 511 511 #define C_SWIG_POINTER_TAG (C_SWIG_POINTER_TYPE | (C_wordstobytes(C_SIZEOF_SWIG_POINTER - 1))) 512 512 #define C_SYMBOL_TAG (C_SYMBOL_TYPE | (C_SIZEOF_SYMBOL - 1)) 513 513 #define C_FLONUM_TAG (C_FLONUM_TYPE | sizeof(double)) 514 #define C_STRONG_BUCKET_TAG (C_BUCKET_TYPE | (C_SIZEOF_BUCKET - 1)) 515 #define C_WEAK_BUCKET_TAG (C_BUCKET_TYPE | C_SPECIALBLOCK_BIT | (C_SIZEOF_BUCKET - 1)) 514 516 515 517 /* Locative subtypes */ 516 518 #define C_SLOT_LOCATIVE 0 … … C_fctexport C_word C_fcall C_i_o_fixnum_and(C_word x, C_word y) C_regparm; 1951 1953 C_fctexport C_word C_fcall C_i_o_fixnum_ior(C_word x, C_word y) C_regparm; 1952 1954 C_fctexport C_word C_fcall C_i_o_fixnum_xor(C_word x, C_word y) C_regparm; 1953 1955 C_fctexport C_word C_fcall C_a_i_flonum_round_proper(C_word **a, int c, C_word n) C_regparm; 1956 C_fctexport C_word C_fcall C_i_persist_symbol(C_word sym) C_regparm; 1954 1957 C_fctexport C_word C_fcall C_i_getprop(C_word sym, C_word prop, C_word def) C_regparm; 1955 1958 C_fctexport C_word C_fcall C_putprop(C_word **a, C_word sym, C_word prop, C_word val) C_regparm; 1956 1959 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 2655 { 2653 2656 C_word *p = *ptr, *p0 = p; 2654 2657 2655 *(p++) = C_ BUCKET_TYPE | (C_SIZEOF_BUCKET - 1);2658 *(p++) = C_enable_gcweak ? C_WEAK_BUCKET_TAG : C_STRONG_BUCKET_TAG; 2656 2659 *(p++) = head; 2657 2660 *(p++) = tail; 2658 2661 *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..4ccd3dc 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) 2969 2972 2970 2973 if(n > 0 && (h & C_BYTEBLOCK_BIT) == 0) { 2971 2974 if(h & C_SPECIALBLOCK_BIT) { 2972 --n; 2973 ++p; 2975 /* Minor GC needs to be fast; always mark weakly held buckets */ 2976 if (gc_mode != GC_MINOR || h != C_WEAK_BUCKET_TAG) { 2977 --n; 2978 ++p; 2979 } 2974 2980 } 2975 2981 2976 2982 while(n--) mark(p++); … … C_regparm void C_fcall C_reclaim(void *trampoline, C_word c) 3092 3098 3093 3099 i_like_spaghetti: 3094 3100 ++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 3101 } 3135 3102 3103 update_symbol_tables(gc_mode); 3104 3136 3105 if(gc_mode == GC_MAJOR) { 3137 3106 tgc = C_cpu_milliseconds() - tgc; 3138 3107 gc_ms += tgc; … … C_regparm void C_fcall C_reclaim(void *trampoline, C_word c) 3169 3138 (C_uword)tospace_start, (C_uword)tospace_top, 3170 3139 (C_uword)tospace_limit); 3171 3140 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 3141 C_dbg("GC", C_text("%d locatives (from %d)\n"), locative_table_count, locative_table_size); 3176 3142 } 3177 3143 … … C_regparm void C_fcall mark_system_globals(void) 3200 3166 3201 3167 C_regparm void C_fcall really_mark(C_word *x) 3202 3168 { 3203 C_word val , item;3169 C_word val; 3204 3170 C_uword n, bytes; 3205 3171 C_header h; 3206 3172 C_SCHEME_BLOCK *p, *p2; 3207 WEAK_TABLE_ENTRY *wep;3208 3173 3209 3174 val = *x; 3210 3175 … … C_regparm void C_fcall really_mark(C_word *x) 3227 3192 return; 3228 3193 } 3229 3194 3230 if((C_uword)val >= (C_uword)fromspace_start && (C_uword)val < (C_uword)C_fromspace_top) return; 3195 if((C_uword)val >= (C_uword)fromspace_start && (C_uword)val < (C_uword)C_fromspace_top) 3196 return; 3231 3197 3232 3198 p2 = (C_SCHEME_BLOCK *)C_align((C_uword)C_fromspace_top); 3233 3199 … … C_regparm void C_fcall really_mark(C_word *x) 3257 3223 C_memcpy(p2->data, p->data, bytes); 3258 3224 } 3259 3225 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 3226 if(is_fptr(h)) { 3268 3227 val = fptr_to_ptr(h); 3269 3228 … … C_regparm void C_fcall really_mark(C_word *x) 3299 3258 } 3300 3259 #endif 3301 3260 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 3261 n = C_header_size(p); 3313 3262 bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word); 3314 3263 … … static void remark(C_word *x) { \ 3348 3297 C_cblockend 3349 3298 #endif 3350 3299 3351 3352 3300 /* Do a major GC into a freshly allocated heap: */ 3353 3301 3354 3302 C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize) 3355 3303 { 3356 3304 int i, j; 3357 3305 C_uword count, n, bytes; 3358 C_word *p, **msp, item, last;3306 C_word *p, **msp, bucket, last; 3359 3307 C_header h; 3360 3308 C_byte *tmp, *start; 3361 3309 LF_LIST *lfn; 3362 3310 C_SCHEME_BLOCK *bp; 3363 WEAK_TABLE_ENTRY *wep;3364 3311 C_GC_ROOT *gcrp; 3365 3312 C_SYMBOL_TABLE *stp; 3366 3313 FINALIZER_NODE *flist; … … C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize) 3445 3392 /* Mark symbol table: */ 3446 3393 for(stp = symbol_table_list; stp != NULL; stp = stp->next) 3447 3394 for(i = 0; i < stp->size; ++i) 3448 remark(&stp->table[i]); 3395 remark(&stp->table[i]); /* Ensure buckets survive */ 3449 3396 3450 3397 /* Mark collectibles: */ 3451 3398 for(msp = collectibles; msp < collectibles_top; ++msp) … … C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize) 3473 3420 remark(&flist->finalizer); 3474 3421 } 3475 3422 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 3423 /* Mark trace-buffer: */ 3485 3424 for(tinfo = trace_buffer; tinfo < trace_buffer_limit; ++tinfo) { 3486 3425 remark(&tinfo->cooked1); … … C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize) 3515 3454 heap_scan_top = (C_byte *)bp + C_align(bytes) + sizeof(C_word); 3516 3455 } 3517 3456 3457 update_symbol_tables(GC_REALLOC); 3458 3518 3459 heap_free (heapspace1, heapspace1_size); 3519 3460 heap_free (heapspace2, heapspace2_size); 3520 3461 … … C_regparm void C_fcall really_remark(C_word *x) 3560 3501 C_uword n, bytes; 3561 3502 C_header h; 3562 3503 C_SCHEME_BLOCK *p, *p2; 3563 WEAK_TABLE_ENTRY *wep;3564 3504 3565 3505 val = *x; 3566 3506 … … C_regparm void C_fcall update_locative_table(int mode) 3734 3674 if(mode != GC_REALLOC) locative_table_count = hi; 3735 3675 } 3736 3676 3737 3738 C_regparm WEAK_TABLE_ENTRY *C_fcall lookup_weak_table_entry(C_word item, C_word container) 3677 C_regparm void C_fcall update_symbol_tables(int mode) 3739 3678 { 3740 C_uword 3741 key = (C_uword)item >> 2, 3742 disp = 0, 3743 n; 3744 WEAK_TABLE_ENTRY *wep; 3679 int weakn = 0, i; 3680 C_word bucket, last, sym, h; 3681 C_SYMBOL_TABLE *stp; 3745 3682 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 ]; 3683 if(C_enable_gcweak && mode != GC_MINOR) { 3684 /* Fixup symbol table */ 3685 for(stp = symbol_table_list; stp != NULL; stp = stp->next) { 3686 for(i = 0; i < stp->size; ++i) { 3687 last = 0; 3749 3688 3750 if(wep->item == 0) { 3751 if(container != 0) { 3752 /* Add fresh entry: */ 3753 wep->item = item; 3754 wep->container = container; 3755 return wep; 3756 } 3689 for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1)) { 3757 3690 3758 return NULL; 3691 sym = C_block_item(bucket, 0); 3692 h = C_block_header(sym); 3693 3694 /* Resolve any forwarding pointers */ 3695 while(is_fptr(h)) { 3696 sym = fptr_to_ptr(h); 3697 h = C_block_header(sym); 3698 } 3699 3700 assert((h & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE); 3701 3702 /* If the symbol is unreferenced, drop it: */ 3703 if(!C_truep(C_permanentp(sym)) && (mode == GC_REALLOC ? 3704 !C_in_new_heapp(sym) : 3705 !C_in_fromspacep(sym))) { 3706 3707 if(last) C_set_block_item(last, 1, C_block_item(bucket,1)); 3708 else stp->table[ i ] = C_block_item(bucket,1); 3709 3710 assert(C_block_item(sym, 0) == C_SCHEME_UNBOUND || 3711 C_block_item(sym, 0) == sym); /* kw */ 3712 assert(C_block_item(sym, 2) == C_SCHEME_END_OF_LIST); 3713 ++weakn; 3714 } else { 3715 C_set_block_item(bucket,0,sym); /* Might have moved */ 3716 last = bucket; 3717 } 3718 } 3719 } 3759 3720 } 3760 else if(wep->item == item) return wep; 3761 else disp += WEAK_HASH_DISPLACEMENT; 3721 if(gc_report_flag && weakn) 3722 C_dbg("GC", C_text("%d recoverable weakly held items found\n"), weakn); 3723 } else { 3724 #ifdef DEBUGBUILD 3725 /* Sanity check: all symbols should've been marked */ 3726 for(stp = symbol_table_list; stp != NULL; stp = stp->next) 3727 for(i = 0; i < stp->size; ++i) 3728 for(bucket = stp->table[ i ]; bucket != C_SCHEME_END_OF_LIST; bucket = C_block_item(bucket,1)) { 3729 sym = C_block_item(bucket, 0); 3730 assert(!is_fptr(C_block_header(sym)) && 3731 (C_truep(C_permanentp(sym)) || 3732 (mode == GC_REALLOC ? 3733 C_in_new_heapp(sym) : 3734 C_in_fromspacep(sym)))); 3735 } 3736 #endif 3762 3737 } 3763 3764 return NULL;3765 3738 } 3766 3739 3767 3740 … … C_putprop(C_word **ptr, C_word sym, C_word prop, C_word val) 9404 9377 { 9405 9378 C_word pl = C_block_item(sym, 2); 9406 9379 9380 /* Newly added plist? Ensure the symbol stays! */ 9381 if (C_enable_gcweak && pl == C_SCHEME_END_OF_LIST) persist(sym, NULL); 9382 9407 9383 while(pl != C_SCHEME_END_OF_LIST) { 9408 9384 if(C_block_item(pl, 0) == prop) { 9409 9385 C_mutate2(&C_u_i_car(C_u_i_cdr(pl)), val);