vm/data_gc.c

   1 #include "master.h"
   2
   3 /* Scan all the objects in the card */
   4 void copy_card(F_CARD *ptr, CELL gen, CELL here)
   5 {
   6         CELL card_scan = (CELL)CARD_TO_ADDR(ptr) + CARD_OFFSET(ptr);
   7         CELL card_end = (CELL)CARD_TO_ADDR(ptr + 1);
   8
   9         if(here < card_end)
  10                 card_end = here;
  11
  12         copy_reachable_objects(card_scan,&card_end);
  13
  14         cards_scanned++;
  15 }
  16
  17 void copy_card_deck(F_DECK *deck, CELL gen, F_CARD mask, F_CARD unmask)
  18 {
  19         F_CARD *first_card = DECK_TO_CARD(deck);
  20         F_CARD *last_card = DECK_TO_CARD(deck + 1);
  21
  22         CELL here = data_heap->generations[gen].here;
  23
  24         u32 *quad_ptr;
  25         u32 quad_mask = mask | (mask << 8) | (mask << 16) | (mask << 24);
  26
  27         for(quad_ptr = (u32 *)first_card; quad_ptr < (u32 *)last_card; quad_ptr++)
  28         {
  29                 if(*quad_ptr & quad_mask)
  30                 {
  31                         F_CARD *ptr = (F_CARD *)quad_ptr;
  32
  33                         int card;
  34                         for(card = 0; card < 4; card++)
  35                         {
  36                                 if(ptr[card] & mask)
  37                                 {
  38                                         copy_card(&ptr[card],gen,here);
  39                                         ptr[card] &= ~unmask;
  40                                 }
  41                         }
  42                 }
  43         }
  44
  45         decks_scanned++;
  46 }
  47
  48 /* Copy all newspace objects referenced from marked cards to the destination */
  49 void copy_gen_cards(CELL gen)
  50 {
  51         F_DECK *first_deck = ADDR_TO_DECK(data_heap->generations[gen].start);
  52         F_DECK *last_deck = ADDR_TO_DECK(data_heap->generations[gen].end);
  53
  54         F_CARD mask, unmask;
  55
  56         /* if we are collecting the nursery, we care about old->nursery pointers
  57         but not old->aging pointers */
  58         if(collecting_gen == NURSERY)
  59         {
  60                 mask = CARD_POINTS_TO_NURSERY;
  61
  62                 /* after the collection, no old->nursery pointers remain
  63                 anywhere, but old->aging pointers might remain in tenured
  64                 space */
  65                 if(gen == TENURED)
  66                         unmask = CARD_POINTS_TO_NURSERY;
  67                 /* after the collection, all cards in aging space can be
  68                 cleared */
  69                 else if(HAVE_AGING_P && gen == AGING)
  70                         unmask = CARD_MARK_MASK;
  71                 else
  72                 {
  73                         critical_error("bug in copy_gen_cards",gen);
  74                         return;
  75                 }
  76         }
  77         /* if we are collecting aging space into tenured space, we care about
  78         all old->nursery and old->aging pointers. no old->aging pointers can
  79         remain */
  80         else if(HAVE_AGING_P && collecting_gen == AGING)
  81         {
  82                 if(collecting_aging_again)
  83                 {
  84                         mask = CARD_POINTS_TO_AGING;
  85                         unmask = CARD_MARK_MASK;
  86                 }
  87                 /* after we collect aging space into the aging semispace, no
  88                 old->nursery pointers remain but tenured space might still have
  89                 pointers to aging space. */
  90                 else
  91                 {
  92                         mask = CARD_POINTS_TO_AGING;
  93                         unmask = CARD_POINTS_TO_NURSERY;
  94                 }
  95         }
  96         else
  97         {
  98                 critical_error("bug in copy_gen_cards",gen);
  99                 return;
 100         }
 101
 102         F_DECK *ptr;
 103
 104         for(ptr = first_deck; ptr < last_deck; ptr++)
 105         {
 106                 if(*ptr & mask)
 107                 {
 108                         copy_card_deck(ptr,gen,mask,unmask);
 109                         *ptr &= ~unmask;
 110                 }
 111         }
 112 }
 113
 114 /* Scan cards in all generations older than the one being collected, copying
 115 old->new references */
 116 void copy_cards(void)
 117 {
 118         int i;
 119         for(i = collecting_gen + 1; i < data_heap->gen_count; i++)
 120                 copy_gen_cards(i);
 121 }
 122
 123 /* Copy all tagged pointers in a range of memory */
 124 void copy_stack_elements(F_SEGMENT *region, CELL top)
 125 {
 126         CELL ptr = region->start;
 127
 128         for(; ptr <= top; ptr += CELLS)
 129                 copy_handle((CELL*)ptr);
 130 }
 131
 132 void copy_registered_locals(void)
 133 {
 134         CELL ptr = gc_locals_region->start;
 135
 136         for(; ptr <= gc_locals; ptr += CELLS)
 137                 copy_handle(*(CELL **)ptr);
 138 }
 139
 140 /* Copy roots over at the start of GC, namely various constants, stacks,
 141 the user environment and extra roots registered with REGISTER_ROOT */
 142 void copy_roots(void)
 143 {
 144         copy_handle(&T);
 145         copy_handle(&bignum_zero);
 146         copy_handle(&bignum_pos_one);
 147         copy_handle(&bignum_neg_one);
 148
 149         copy_registered_locals();
 150         copy_stack_elements(extra_roots_region,extra_roots);
 151
 152         save_stacks();
 153         F_CONTEXT *stacks = stack_chain;
 154
 155         while(stacks)
 156         {
 157                 copy_stack_elements(stacks->datastack_region,stacks->datastack);
 158                 copy_stack_elements(stacks->retainstack_region,stacks->retainstack);
 159
 160                 copy_handle(&stacks->catchstack_save);
 161                 copy_handle(&stacks->current_callback_save);
 162
 163                 mark_active_blocks(stacks);
 164
 165                 stacks = stacks->next;
 166         }
 167
 168         int i;
 169         for(i = 0; i < USER_ENV; i++)
 170                 copy_handle(&userenv[i]);
 171 }
 172
 173 /* Given a pointer to oldspace, copy it to newspace */
 174 INLINE void *copy_untagged_object(void *pointer, CELL size)
 175 {
 176         if(newspace->here + size >= newspace->end)
 177                 longjmp(gc_jmp,1);
 178         allot_barrier(newspace->here);
 179         void *newpointer = allot_zone(newspace,size);
 180
 181         F_GC_STATS *s = &gc_stats[collecting_gen];
 182         s->object_count++;
 183         s->bytes_copied += size;
 184
 185         memcpy(newpointer,pointer,size);
 186         return newpointer;
 187 }
 188
 189 INLINE void forward_object(CELL pointer, CELL newpointer)
 190 {
 191         if(pointer != newpointer)
 192                 put(UNTAG(pointer),RETAG(newpointer,GC_COLLECTED));
 193 }
 194
 195 INLINE CELL copy_object_impl(CELL pointer)
 196 {
 197         CELL newpointer = (CELL)copy_untagged_object(
 198                 (void*)UNTAG(pointer),
 199                 object_size(pointer));
 200         forward_object(pointer,newpointer);
 201         return newpointer;
 202 }
 203
 204 /* Follow a chain of forwarding pointers */
 205 CELL resolve_forwarding(CELL untagged, CELL tag)
 206 {
 207         CELL header = get(untagged);
 208         /* another forwarding pointer */
 209         if(TAG(header) == GC_COLLECTED)
 210                 return resolve_forwarding(UNTAG(header),tag);
 211         /* we've found the destination */
 212         else
 213         {
 214                 CELL pointer = RETAG(untagged,tag);
 215                 if(should_copy(untagged))
 216                         pointer = RETAG(copy_object_impl(pointer),tag);
 217                 return pointer;
 218         }
 219 }
 220
 221 /* Given a pointer to a tagged pointer to oldspace, copy it to newspace.
 222 If the object has already been copied, return the forwarding
 223 pointer address without copying anything; otherwise, install
 224 a new forwarding pointer. */
 225 INLINE CELL copy_object(CELL pointer)
 226 {
 227         CELL tag = TAG(pointer);
 228         CELL header = get(UNTAG(pointer));
 229
 230         if(TAG(header) == GC_COLLECTED)
 231                 return resolve_forwarding(UNTAG(header),tag);
 232         else
 233                 return RETAG(copy_object_impl(pointer),tag);
 234 }
 235
 236 void copy_handle(CELL *handle)
 237 {
 238         CELL pointer = *handle;
 239
 240         if(!immediate_p(pointer) && should_copy(pointer))
 241                 *handle = copy_object(pointer);
 242 }
 243
 244 CELL copy_next_from_nursery(CELL scan)
 245 {
 246         CELL *obj = (CELL *)scan;
 247         CELL *end = (CELL *)(scan + binary_payload_start(scan));
 248
 249         if(obj != end)
 250         {
 251                 obj++;
 252
 253                 CELL nursery_start = nursery.start;
 254                 CELL nursery_end = nursery.end;
 255
 256                 for(; obj < end; obj++)
 257                 {
 258                         CELL pointer = *obj;
 259
 260                         if(!immediate_p(pointer)
 261                                 && (pointer >= nursery_start && pointer < nursery_end))
 262                                 *obj = copy_object(pointer);
 263                 }
 264         }
 265
 266         return scan + untagged_object_size(scan);
 267 }
 268
 269 CELL copy_next_from_aging(CELL scan)
 270 {
 271         CELL *obj = (CELL *)scan;
 272         CELL *end = (CELL *)(scan + binary_payload_start(scan));
 273
 274         if(obj != end)
 275         {
 276                 obj++;
 277
 278                 CELL tenured_start = data_heap->generations[TENURED].start;
 279                 CELL tenured_end = data_heap->generations[TENURED].end;
 280
 281                 CELL newspace_start = newspace->start;
 282                 CELL newspace_end = newspace->end;
 283
 284                 for(; obj < end; obj++)
 285                 {
 286                         CELL pointer = *obj;
 287
 288                         if(!immediate_p(pointer)
 289                                 && !(pointer >= newspace_start && pointer < newspace_end)
 290                                 && !(pointer >= tenured_start && pointer < tenured_end))
 291                                 *obj = copy_object(pointer);
 292                 }
 293         }
 294
 295         return scan + untagged_object_size(scan);
 296 }
 297
 298 CELL copy_next_from_tenured(CELL scan)
 299 {
 300         CELL *obj = (CELL *)scan;
 301         CELL *end = (CELL *)(scan + binary_payload_start(scan));
 302
 303         if(obj != end)
 304         {
 305                 obj++;
 306
 307                 CELL newspace_start = newspace->start;
 308                 CELL newspace_end = newspace->end;
 309
 310                 for(; obj < end; obj++)
 311                 {
 312                         CELL pointer = *obj;
 313
 314                         if(!immediate_p(pointer) && !(pointer >= newspace_start && pointer < newspace_end))
 315                                 *obj = copy_object(pointer);
 316                 }
 317         }
 318
 319         mark_object_code_block(scan);
 320
 321         return scan + untagged_object_size(scan);
 322 }
 323
 324 void copy_reachable_objects(CELL scan, CELL *end)
 325 {
 326         if(HAVE_NURSERY_P && collecting_gen == NURSERY)
 327         {
 328                 while(scan < *end)
 329                         scan = copy_next_from_nursery(scan);
 330         }
 331         else if(HAVE_AGING_P && collecting_gen == AGING)
 332         {
 333                 while(scan < *end)
 334                         scan = copy_next_from_aging(scan);
 335         }
 336         else if(collecting_gen == TENURED)
 337         {
 338                 while(scan < *end)
 339                         scan = copy_next_from_tenured(scan);
 340         }
 341 }
 342
 343 /* Prepare to start copying reachable objects into an unused zone */
 344 void begin_gc(CELL requested_bytes)
 345 {
 346         if(growing_data_heap)
 347         {
 348                 if(collecting_gen != TENURED)
 349                         critical_error("Invalid parameters to begin_gc",0);
 350
 351                 old_data_heap = data_heap;
 352                 set_data_heap(grow_data_heap(old_data_heap,requested_bytes));
 353                 newspace = &data_heap->generations[TENURED];
 354         }
 355         else if(collecting_accumulation_gen_p())
 356         {
 357                 /* when collecting one of these generations, rotate it
 358                 with the semispace */
 359                 F_ZONE z = data_heap->generations[collecting_gen];
 360                 data_heap->generations[collecting_gen] = data_heap->semispaces[collecting_gen];
 361                 data_heap->semispaces[collecting_gen] = z;
 362                 reset_generation(collecting_gen);
 363                 newspace = &data_heap->generations[collecting_gen];
 364                 clear_cards(collecting_gen,collecting_gen);
 365                 clear_decks(collecting_gen,collecting_gen);
 366                 clear_allot_markers(collecting_gen,collecting_gen);
 367         }
 368         else
 369         {
 370                 /* when collecting a younger generation, we copy
 371                 reachable objects to the next oldest generation,
 372                 so we set the newspace so the next generation. */
 373                 newspace = &data_heap->generations[collecting_gen + 1];
 374         }
 375 }
 376
 377 void end_gc(CELL gc_elapsed)
 378 {
 379         F_GC_STATS *s = &gc_stats[collecting_gen];
 380
 381         s->collections++;
 382         s->gc_time += gc_elapsed;
 383         if(s->max_gc_time < gc_elapsed)
 384                 s->max_gc_time = gc_elapsed;
 385
 386         if(growing_data_heap)
 387         {
 388                 dealloc_data_heap(old_data_heap);
 389                 old_data_heap = NULL;
 390                 growing_data_heap = false;
 391         }
 392
 393         if(collecting_accumulation_gen_p())
 394         {
 395                 /* all younger generations except are now empty.
 396                 if collecting_gen == NURSERY here, we only have 1 generation;
 397                 old-school Cheney collector */
 398                 if(collecting_gen != NURSERY)
 399                         reset_generations(NURSERY,collecting_gen - 1);
 400         }
 401         else if(HAVE_NURSERY_P && collecting_gen == NURSERY)
 402         {
 403                 nursery.here = nursery.start;
 404         }
 405         else
 406         {
 407                 /* all generations up to and including the one
 408                 collected are now empty */
 409                 reset_generations(NURSERY,collecting_gen);
 410         }
 411
 412         if(collecting_gen == TENURED)
 413         {
 414                 /* now that all reachable code blocks have been marked,
 415                 deallocate the rest */
 416                 free_unmarked(&code_heap);
 417         }
 418
 419         collecting_aging_again = false;
 420 }
 421
 422 /* Collect gen and all younger generations.
 423 If growing_data_heap_ is true, we must grow the data heap to such a size that
 424 an allocation of requested_bytes won't fail */
 425 void garbage_collection(CELL gen,
 426         bool growing_data_heap_,
 427         CELL requested_bytes)
 428 {
 429         if(gc_off)
 430         {
 431                 critical_error("GC disabled",gen);
 432                 return;
 433         }
 434
 435         s64 start = current_micros();
 436
 437         performing_gc = true;
 438         growing_data_heap = growing_data_heap_;
 439         collecting_gen = gen;
 440
 441         /* we come back here if a generation is full */
 442         if(setjmp(gc_jmp))
 443         {
 444                 /* We have no older generations we can try collecting, so we
 445                 resort to growing the data heap */
 446                 if(collecting_gen == TENURED)
 447                 {
 448                         growing_data_heap = true;
 449
 450                         /* see the comment in unmark_marked() */
 451                         unmark_marked(&code_heap);
 452                 }
 453                 /* we try collecting AGING space twice before going on to
 454                 collect TENURED */
 455                 else if(HAVE_AGING_P
 456                         && collecting_gen == AGING
 457                         && !collecting_aging_again)
 458                 {
 459                         collecting_aging_again = true;
 460                 }
 461                 /* Collect the next oldest generation */
 462                 else
 463                 {
 464                         collecting_gen++;
 465                 }
 466         }
 467
 468         begin_gc(requested_bytes);
 469
 470         /* initialize chase pointer */
 471         CELL scan = newspace->here;
 472
 473         /* collect objects referenced from stacks and environment */
 474         copy_roots();
 475         /* collect objects referenced from older generations */
 476         copy_cards();
 477         /* do some tracing */
 478         copy_reachable_objects(scan,&newspace->here);
 479
 480         /* don't scan code heap unless it has pointers to this
 481         generation or younger */
 482         if(collecting_gen >= last_code_heap_scan)
 483         {
 484                 code_heap_scans++;
 485
 486                 if(collecting_gen == TENURED)
 487                         update_code_heap_roots();
 488                 else
 489                         copy_code_heap_roots();
 490
 491                 if(collecting_accumulation_gen_p())
 492                         last_code_heap_scan = collecting_gen;
 493                 else
 494                         last_code_heap_scan = collecting_gen + 1;
 495         }
 496
 497         CELL gc_elapsed = (current_micros() - start);
 498
 499         end_gc(gc_elapsed);
 500
 501         performing_gc = false;
 502 }
 503
 504 void gc(void)
 505 {
 506         garbage_collection(TENURED,false,0);
 507 }
 508
 509 void minor_gc(void)
 510 {
 511         garbage_collection(NURSERY,false,0);
 512 }
 513
 514 void primitive_gc(void)
 515 {
 516         gc();
 517 }
 518
 519 void primitive_gc_stats(void)
 520 {
 521         GROWABLE_ARRAY(stats);
 522
 523         CELL i;
 524         u64 total_gc_time = 0;
 525
 526         for(i = 0; i < MAX_GEN_COUNT; i++)
 527         {
 528                 F_GC_STATS *s = &gc_stats[i];
 529                 GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections));
 530                 GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->gc_time)));
 531                 GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->max_gc_time)));
 532                 GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
 533                 GROWABLE_ARRAY_ADD(stats,allot_cell(s->object_count));
 534                 GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->bytes_copied)));
 535
 536                 total_gc_time += s->gc_time;
 537         }
 538
 539         GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(total_gc_time)));
 540         GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(cards_scanned)));
 541         GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(decks_scanned)));
 542         GROWABLE_ARRAY_ADD(stats,allot_cell(code_heap_scans));
 543
 544         GROWABLE_ARRAY_TRIM(stats);
 545         dpush(stats);
 546 }
 547
 548 void clear_gc_stats(void)
 549 {
 550         int i;
 551         for(i = 0; i < MAX_GEN_COUNT; i++)
 552                 memset(&gc_stats[i],0,sizeof(F_GC_STATS));
 553
 554         cards_scanned = 0;
 555         decks_scanned = 0;
 556         code_heap_scans = 0;
 557 }
 558
 559 void primitive_clear_gc_stats(void)
 560 {
 561         clear_gc_stats();
 562 }
 563
 564 void primitive_become(void)
 565 {
 566         F_ARRAY *new_objects = untag_array(dpop());
 567         F_ARRAY *old_objects = untag_array(dpop());
 568
 569         CELL capacity = array_capacity(new_objects);
 570         if(capacity != array_capacity(old_objects))
 571                 critical_error("bad parameters to become",0);
 572
 573         CELL i;
 574
 575         for(i = 0; i < capacity; i++)
 576         {
 577                 CELL old_obj = array_nth(old_objects,i);
 578                 CELL new_obj = array_nth(new_objects,i);
 579
 580                 forward_object(old_obj,new_obj);
 581         }
 582
 583         gc();
 584
 585         compile_all_words();
 586 }