src/gc/gc_ms.c

   1 /*
   2 Copyright (C) 2001-2010, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/gc/gc_ms.c - Implementation of the basic mark & sweep collector
   8
   9 =head1 DESCRIPTION
  10
  11 This code implements the default mark and sweep garbage collector.
  12
  13 =cut
  14
  15 */
  16
  17 #include "parrot/parrot.h"
  18 #include "gc_private.h"
  19
  20 #define DEBUG_FREE_LIST 0
  21
  22 PARROT_DOES_NOT_RETURN
  23 static void failed_allocation(unsigned int line, unsigned long size) /* HEADERIZER SKIP */
  24 {
  25     fprintf(stderr, "Failed allocation of %lu bytes\n", size);
  26     do_panic(NULL, "Out of mem", __FILE__, line);
  27 }
  28
  29 #define PANIC_OUT_OF_MEM(size) failed_allocation(__LINE__, (size))
  30
  31 /* HEADERIZER HFILE: src/gc/gc_private.h */
  32
  33 /* HEADERIZER BEGIN: static */
  34 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  35
  36 PARROT_WARN_UNUSED_RESULT
  37 static INTVAL contained_in_attr_pool(
  38     ARGIN(const PMC_Attribute_Pool *pool),
  39     ARGIN(const void *ptr))
  40         __attribute__nonnull__(1)
  41         __attribute__nonnull__(2);
  42
  43 static int gc_ms_active_sized_buffers(ARGIN(const Memory_Pools *mem_pools))
  44         __attribute__nonnull__(1);
  45
  46 static void gc_ms_add_free_object(SHIM_INTERP,
  47     ARGMOD(Memory_Pools *mem_pools),
  48     ARGMOD(Fixed_Size_Pool *pool),
  49     ARGIN(void *to_add))
  50         __attribute__nonnull__(2)
  51         __attribute__nonnull__(3)
  52         __attribute__nonnull__(4)
  53         FUNC_MODIFIES(*mem_pools)
  54         FUNC_MODIFIES(*pool);
  55
  56 static void gc_ms_alloc_objects(PARROT_INTERP,
  57     ARGIN(Memory_Pools *mem_pools),
  58     ARGMOD(Fixed_Size_Pool *pool))
  59         __attribute__nonnull__(1)
  60         __attribute__nonnull__(2)
  61         __attribute__nonnull__(3)
  62         FUNC_MODIFIES(*pool);
  63
  64 static void gc_ms_allocate_buffer_storage(PARROT_INTERP,
  65     ARGOUT(Buffer *buffer),
  66     size_t size)
  67         __attribute__nonnull__(1)
  68         __attribute__nonnull__(2)
  69         FUNC_MODIFIES(*buffer);
  70
  71 PARROT_CANNOT_RETURN_NULL
  72 PARROT_WARN_UNUSED_RESULT
  73 static Buffer * gc_ms_allocate_bufferlike_header(PARROT_INTERP, size_t size)
  74         __attribute__nonnull__(1);
  75
  76 PARROT_MALLOC
  77 PARROT_CANNOT_RETURN_NULL
  78 static void * gc_ms_allocate_memory_chunk(SHIM_INTERP, size_t size);
  79
  80 PARROT_MALLOC
  81 PARROT_CANNOT_RETURN_NULL
  82 static void * gc_ms_allocate_memory_chunk_zeroed(SHIM_INTERP, size_t size);
  83
  84 PARROT_CANNOT_RETURN_NULL
  85 static void * gc_ms_allocate_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
  86         __attribute__nonnull__(1)
  87         __attribute__nonnull__(2)
  88         FUNC_MODIFIES(*pmc);
  89
  90 PARROT_CAN_RETURN_NULL
  91 static PMC* gc_ms_allocate_pmc_header(PARROT_INTERP, UINTVAL flags)
  92         __attribute__nonnull__(1);
  93
  94 PARROT_CAN_RETURN_NULL
  95 static STRING* gc_ms_allocate_string_header(PARROT_INTERP, UINTVAL flags)
  96         __attribute__nonnull__(1);
  97
  98 static void gc_ms_block_GC_mark(PARROT_INTERP)
  99         __attribute__nonnull__(1);
 100
 101 static void gc_ms_block_GC_sweep(PARROT_INTERP)
 102         __attribute__nonnull__(1);
 103
 104 static void gc_ms_destroy_child_interp(
 105     ARGMOD(Interp *dest_interp),
 106     ARGIN(Interp *source_interp))
 107         __attribute__nonnull__(1)
 108         __attribute__nonnull__(2)
 109         FUNC_MODIFIES(*dest_interp);
 110
 111 static void gc_ms_finalize(PARROT_INTERP)
 112         __attribute__nonnull__(1);
 113
 114 static void gc_ms_finalize_memory_pools(PARROT_INTERP,
 115     ARGIN(Memory_Pools * const mem_pools))
 116         __attribute__nonnull__(1)
 117         __attribute__nonnull__(2);
 118
 119 static void gc_ms_free_attributes_from_pool(
 120     ARGMOD(PMC_Attribute_Pool *pool),
 121     ARGMOD(void *data))
 122         __attribute__nonnull__(1)
 123         __attribute__nonnull__(2)
 124         FUNC_MODIFIES(*pool)
 125         FUNC_MODIFIES(*data);
 126
 127 static void gc_ms_free_bufferlike_header(PARROT_INTERP,
 128     ARGMOD(Buffer *obj),
 129     size_t size)
 130         __attribute__nonnull__(1)
 131         __attribute__nonnull__(2)
 132         FUNC_MODIFIES(*obj);
 133
 134 static void gc_ms_free_memory_chunk(SHIM_INTERP, ARGFREE(void *data));
 135 static void gc_ms_free_pmc_header(PARROT_INTERP, ARGMOD(PMC *pmc))
 136         __attribute__nonnull__(1)
 137         __attribute__nonnull__(2)
 138         FUNC_MODIFIES(*pmc);
 139
 140 static void gc_ms_free_string_header(PARROT_INTERP, ARGMOD(STRING *s))
 141         __attribute__nonnull__(1)
 142         __attribute__nonnull__(2)
 143         FUNC_MODIFIES(*s);
 144
 145 PARROT_CANNOT_RETURN_NULL
 146 PARROT_WARN_UNUSED_RESULT
 147 static void * gc_ms_get_free_object(PARROT_INTERP,
 148     ARGMOD(Memory_Pools *mem_pools),
 149     ARGMOD(Fixed_Size_Pool *pool))
 150         __attribute__nonnull__(1)
 151         __attribute__nonnull__(2)
 152         __attribute__nonnull__(3)
 153         FUNC_MODIFIES(*mem_pools)
 154         FUNC_MODIFIES(*pool);
 155
 156 static size_t gc_ms_get_gc_info(PARROT_INTERP, Interpinfo_enum which)
 157         __attribute__nonnull__(1);
 158
 159 static unsigned int gc_ms_is_blocked_GC_mark(PARROT_INTERP)
 160         __attribute__nonnull__(1);
 161
 162 static unsigned int gc_ms_is_blocked_GC_sweep(PARROT_INTERP)
 163         __attribute__nonnull__(1);
 164
 165 static void gc_ms_mark_and_sweep(PARROT_INTERP, UINTVAL flags)
 166         __attribute__nonnull__(1);
 167
 168 static void gc_ms_mark_special(PARROT_INTERP, ARGIN(PMC *pmc))
 169         __attribute__nonnull__(1)
 170         __attribute__nonnull__(2);
 171
 172 static void gc_ms_more_traceable_objects(PARROT_INTERP,
 173     ARGIN(Memory_Pools *mem_pools),
 174     ARGMOD(Fixed_Size_Pool *pool))
 175         __attribute__nonnull__(1)
 176         __attribute__nonnull__(2)
 177         __attribute__nonnull__(3)
 178         FUNC_MODIFIES(*pool);
 179
 180 static void gc_ms_pool_init(SHIM_INTERP, ARGMOD(Fixed_Size_Pool *pool))
 181         __attribute__nonnull__(2)
 182         FUNC_MODIFIES(*pool);
 183
 184 static void gc_ms_reallocate_buffer_storage(PARROT_INTERP,
 185     ARGMOD(Buffer *buffer),
 186     size_t newsize)
 187         __attribute__nonnull__(1)
 188         __attribute__nonnull__(2)
 189         FUNC_MODIFIES(*buffer);
 190
 191 PARROT_MALLOC
 192 PARROT_CANNOT_RETURN_NULL
 193 static void * gc_ms_reallocate_memory_chunk(SHIM_INTERP,
 194     ARGFREE(void *from),
 195     size_t size);
 196
 197 PARROT_MALLOC
 198 PARROT_CANNOT_RETURN_NULL
 199 static void * gc_ms_reallocate_memory_chunk_zeroed(SHIM_INTERP,
 200     ARGFREE(void *data),
 201     size_t newsize,
 202     size_t oldsize);
 203
 204 static void gc_ms_reallocate_string_storage(PARROT_INTERP,
 205     ARGMOD(STRING *str),
 206     size_t newsize)
 207         __attribute__nonnull__(1)
 208         __attribute__nonnull__(2)
 209         FUNC_MODIFIES(*str);
 210
 211 static int gc_ms_sweep_cb(PARROT_INTERP,
 212     ARGIN(Memory_Pools *mem_pools),
 213     ARGMOD(Fixed_Size_Pool *pool),
 214     SHIM(int flag),
 215     ARGMOD(void *arg))
 216         __attribute__nonnull__(1)
 217         __attribute__nonnull__(2)
 218         __attribute__nonnull__(3)
 219         __attribute__nonnull__(5)
 220         FUNC_MODIFIES(*pool)
 221         FUNC_MODIFIES(*arg);
 222
 223 static int gc_ms_total_sized_buffers(ARGIN(const Memory_Pools *mem_pools))
 224         __attribute__nonnull__(1);
 225
 226 static int gc_ms_trace_active_PMCs(PARROT_INTERP,
 227     Parrot_gc_trace_type trace)
 228         __attribute__nonnull__(1);
 229
 230 static void gc_ms_unblock_GC_mark(PARROT_INTERP)
 231         __attribute__nonnull__(1);
 232
 233 static void gc_ms_unblock_GC_sweep(PARROT_INTERP)
 234         __attribute__nonnull__(1);
 235
 236 static void Parrot_gc_allocate_new_attributes_arena(
 237     ARGMOD(PMC_Attribute_Pool *pool))
 238         __attribute__nonnull__(1)
 239         FUNC_MODIFIES(*pool);
 240
 241 PARROT_CANNOT_RETURN_NULL
 242 PARROT_MALLOC
 243 static PMC_Attribute_Pool * Parrot_gc_create_attrib_pool(size_t attrib_idx);
 244
 245 PARROT_CANNOT_RETURN_NULL
 246 static PMC_Attribute_Pool * Parrot_gc_get_attribute_pool(SHIM_INTERP,
 247     ARGMOD(Memory_Pools *mem_pools),
 248     size_t attrib_size)
 249         __attribute__nonnull__(2)
 250         FUNC_MODIFIES(*mem_pools);
 251
 252 PARROT_CANNOT_RETURN_NULL
 253 static void * Parrot_gc_get_attributes_from_pool(PARROT_INTERP,
 254     ARGMOD(PMC_Attribute_Pool * pool))
 255         __attribute__nonnull__(1)
 256         __attribute__nonnull__(2)
 257         FUNC_MODIFIES(* pool);
 258
 259 static void Parrot_gc_initialize_fixed_size_pools(SHIM_INTERP,
 260     ARGMOD(Memory_Pools *mem_pools),
 261     size_t init_num_pools)
 262         __attribute__nonnull__(2)
 263         FUNC_MODIFIES(*mem_pools);
 264
 265 #define ASSERT_ARGS_contained_in_attr_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 266        PARROT_ASSERT_ARG(pool) \
 267     , PARROT_ASSERT_ARG(ptr))
 268 #define ASSERT_ARGS_gc_ms_active_sized_buffers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 269        PARROT_ASSERT_ARG(mem_pools))
 270 #define ASSERT_ARGS_gc_ms_add_free_object __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 271        PARROT_ASSERT_ARG(mem_pools) \
 272     , PARROT_ASSERT_ARG(pool) \
 273     , PARROT_ASSERT_ARG(to_add))
 274 #define ASSERT_ARGS_gc_ms_alloc_objects __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 275        PARROT_ASSERT_ARG(interp) \
 276     , PARROT_ASSERT_ARG(mem_pools) \
 277     , PARROT_ASSERT_ARG(pool))
 278 #define ASSERT_ARGS_gc_ms_allocate_buffer_storage __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 279        PARROT_ASSERT_ARG(interp) \
 280     , PARROT_ASSERT_ARG(buffer))
 281 #define ASSERT_ARGS_gc_ms_allocate_bufferlike_header \
 282      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 283        PARROT_ASSERT_ARG(interp))
 284 #define ASSERT_ARGS_gc_ms_allocate_memory_chunk __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 285 #define ASSERT_ARGS_gc_ms_allocate_memory_chunk_zeroed \
 286      __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 287 #define ASSERT_ARGS_gc_ms_allocate_pmc_attributes __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 288        PARROT_ASSERT_ARG(interp) \
 289     , PARROT_ASSERT_ARG(pmc))
 290 #define ASSERT_ARGS_gc_ms_allocate_pmc_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 291        PARROT_ASSERT_ARG(interp))
 292 #define ASSERT_ARGS_gc_ms_allocate_string_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 293        PARROT_ASSERT_ARG(interp))
 294 #define ASSERT_ARGS_gc_ms_block_GC_mark __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 295        PARROT_ASSERT_ARG(interp))
 296 #define ASSERT_ARGS_gc_ms_block_GC_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 297        PARROT_ASSERT_ARG(interp))
 298 #define ASSERT_ARGS_gc_ms_destroy_child_interp __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 299        PARROT_ASSERT_ARG(dest_interp) \
 300     , PARROT_ASSERT_ARG(source_interp))
 301 #define ASSERT_ARGS_gc_ms_finalize __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 302        PARROT_ASSERT_ARG(interp))
 303 #define ASSERT_ARGS_gc_ms_finalize_memory_pools __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 304        PARROT_ASSERT_ARG(interp) \
 305     , PARROT_ASSERT_ARG(mem_pools))
 306 #define ASSERT_ARGS_gc_ms_free_attributes_from_pool \
 307      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 308        PARROT_ASSERT_ARG(pool) \
 309     , PARROT_ASSERT_ARG(data))
 310 #define ASSERT_ARGS_gc_ms_free_bufferlike_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 311        PARROT_ASSERT_ARG(interp) \
 312     , PARROT_ASSERT_ARG(obj))
 313 #define ASSERT_ARGS_gc_ms_free_memory_chunk __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 314 #define ASSERT_ARGS_gc_ms_free_pmc_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 315        PARROT_ASSERT_ARG(interp) \
 316     , PARROT_ASSERT_ARG(pmc))
 317 #define ASSERT_ARGS_gc_ms_free_string_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 318        PARROT_ASSERT_ARG(interp) \
 319     , PARROT_ASSERT_ARG(s))
 320 #define ASSERT_ARGS_gc_ms_get_free_object __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 321        PARROT_ASSERT_ARG(interp) \
 322     , PARROT_ASSERT_ARG(mem_pools) \
 323     , PARROT_ASSERT_ARG(pool))
 324 #define ASSERT_ARGS_gc_ms_get_gc_info __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 325        PARROT_ASSERT_ARG(interp))
 326 #define ASSERT_ARGS_gc_ms_is_blocked_GC_mark __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 327        PARROT_ASSERT_ARG(interp))
 328 #define ASSERT_ARGS_gc_ms_is_blocked_GC_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 329        PARROT_ASSERT_ARG(interp))
 330 #define ASSERT_ARGS_gc_ms_mark_and_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 331        PARROT_ASSERT_ARG(interp))
 332 #define ASSERT_ARGS_gc_ms_mark_special __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 333        PARROT_ASSERT_ARG(interp) \
 334     , PARROT_ASSERT_ARG(pmc))
 335 #define ASSERT_ARGS_gc_ms_more_traceable_objects __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 336        PARROT_ASSERT_ARG(interp) \
 337     , PARROT_ASSERT_ARG(mem_pools) \
 338     , PARROT_ASSERT_ARG(pool))
 339 #define ASSERT_ARGS_gc_ms_pool_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 340        PARROT_ASSERT_ARG(pool))
 341 #define ASSERT_ARGS_gc_ms_reallocate_buffer_storage \
 342      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 343        PARROT_ASSERT_ARG(interp) \
 344     , PARROT_ASSERT_ARG(buffer))
 345 #define ASSERT_ARGS_gc_ms_reallocate_memory_chunk __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 346 #define ASSERT_ARGS_gc_ms_reallocate_memory_chunk_zeroed \
 347      __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 348 #define ASSERT_ARGS_gc_ms_reallocate_string_storage \
 349      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 350        PARROT_ASSERT_ARG(interp) \
 351     , PARROT_ASSERT_ARG(str))
 352 #define ASSERT_ARGS_gc_ms_sweep_cb __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 353        PARROT_ASSERT_ARG(interp) \
 354     , PARROT_ASSERT_ARG(mem_pools) \
 355     , PARROT_ASSERT_ARG(pool) \
 356     , PARROT_ASSERT_ARG(arg))
 357 #define ASSERT_ARGS_gc_ms_total_sized_buffers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 358        PARROT_ASSERT_ARG(mem_pools))
 359 #define ASSERT_ARGS_gc_ms_trace_active_PMCs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 360        PARROT_ASSERT_ARG(interp))
 361 #define ASSERT_ARGS_gc_ms_unblock_GC_mark __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 362        PARROT_ASSERT_ARG(interp))
 363 #define ASSERT_ARGS_gc_ms_unblock_GC_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 364        PARROT_ASSERT_ARG(interp))
 365 #define ASSERT_ARGS_Parrot_gc_allocate_new_attributes_arena \
 366      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 367        PARROT_ASSERT_ARG(pool))
 368 #define ASSERT_ARGS_Parrot_gc_create_attrib_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 369 #define ASSERT_ARGS_Parrot_gc_get_attribute_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 370        PARROT_ASSERT_ARG(mem_pools))
 371 #define ASSERT_ARGS_Parrot_gc_get_attributes_from_pool \
 372      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 373        PARROT_ASSERT_ARG(interp) \
 374     , PARROT_ASSERT_ARG(pool))
 375 #define ASSERT_ARGS_Parrot_gc_initialize_fixed_size_pools \
 376      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 377        PARROT_ASSERT_ARG(mem_pools))
 378 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 379 /* HEADERIZER END: static */
 380
 381 /*
 382
 383 =head2 Primary MS Functions
 384
 385 =over 4
 386
 387 =item C<void Parrot_gc_ms_init(PARROT_INTERP)>
 388
 389 Initialize the state structures of the gc system. Called immediately before
 390 creation of memory pools. This function must set the function pointers
 391 for C<add_free_object_fn>, C<get_free_object_fn>, C<alloc_object_fn>, and
 392 C<more_object_fn>.
 393
 394 =cut
 395
 396 */
 397
 398 void
 399 Parrot_gc_ms_init(PARROT_INTERP)
 400 {
 401     ASSERT_ARGS(Parrot_gc_ms_init)
 402
 403     interp->mem_pools = mem_internal_allocate_zeroed_typed(Memory_Pools);
 404     interp->mem_pools->num_sized          = 0;
 405     interp->mem_pools->num_attribs        = 0;
 406     interp->mem_pools->attrib_pools       = NULL;
 407     interp->mem_pools->sized_header_pools = NULL;
 408
 409     interp->gc_sys->finalize_gc_system      = gc_ms_finalize;
 410     interp->gc_sys->destroy_child_interp    = gc_ms_destroy_child_interp;
 411     interp->gc_sys->init_pool               = gc_ms_pool_init;
 412
 413     interp->gc_sys->do_gc_mark              = gc_ms_mark_and_sweep;
 414     interp->gc_sys->compact_string_pool     = gc_ms_compact_memory_pool;
 415
 416     interp->gc_sys->mark_special                = gc_ms_mark_special;
 417     interp->gc_sys->pmc_needs_early_collection  = gc_ms_pmc_needs_early_collection;
 418
 419     interp->gc_sys->allocate_pmc_header     = gc_ms_allocate_pmc_header;
 420     interp->gc_sys->free_pmc_header         = gc_ms_free_pmc_header;
 421
 422     interp->gc_sys->allocate_string_header  = gc_ms_allocate_string_header;
 423     interp->gc_sys->free_string_header      = gc_ms_free_string_header;
 424
 425     interp->gc_sys->allocate_bufferlike_header  = gc_ms_allocate_bufferlike_header;
 426     interp->gc_sys->free_bufferlike_header      = gc_ms_free_bufferlike_header;
 427
 428     interp->gc_sys->allocate_pmc_attributes = gc_ms_allocate_pmc_attributes;
 429     interp->gc_sys->free_pmc_attributes     = gc_ms_free_pmc_attributes;
 430
 431     interp->gc_sys->allocate_string_storage = gc_ms_allocate_string_storage;
 432     interp->gc_sys->reallocate_string_storage = gc_ms_reallocate_string_storage;
 433
 434     interp->gc_sys->allocate_buffer_storage = gc_ms_allocate_buffer_storage;
 435     interp->gc_sys->reallocate_buffer_storage = gc_ms_reallocate_buffer_storage;
 436
 437     interp->gc_sys->allocate_fixed_size_storage = gc_ms_allocate_fixed_size_storage;
 438     interp->gc_sys->free_fixed_size_storage     = gc_ms_free_fixed_size_storage;
 439
 440     /* We don't distinguish between chunk and chunk_with_pointers */
 441     interp->gc_sys->allocate_memory_chunk   = gc_ms_allocate_memory_chunk;
 442     interp->gc_sys->reallocate_memory_chunk = gc_ms_reallocate_memory_chunk;
 443     interp->gc_sys->allocate_memory_chunk_with_interior_pointers
 444                 = gc_ms_allocate_memory_chunk_zeroed;
 445     interp->gc_sys->reallocate_memory_chunk_with_interior_pointers
 446                 = gc_ms_reallocate_memory_chunk_zeroed;
 447     interp->gc_sys->free_memory_chunk       = gc_ms_free_memory_chunk;
 448
 449     interp->gc_sys->block_mark      = gc_ms_block_GC_mark;
 450     interp->gc_sys->unblock_mark    = gc_ms_unblock_GC_mark;
 451     interp->gc_sys->is_blocked_mark = gc_ms_is_blocked_GC_mark;
 452
 453     interp->gc_sys->block_sweep      = gc_ms_block_GC_sweep;
 454     interp->gc_sys->unblock_sweep    = gc_ms_unblock_GC_sweep;
 455     interp->gc_sys->is_blocked_sweep = gc_ms_is_blocked_GC_sweep;
 456
 457     interp->gc_sys->get_gc_info      = gc_ms_get_gc_info;
 458
 459     initialize_var_size_pools(interp, interp->mem_pools);
 460     initialize_fixed_size_pools(interp, interp->mem_pools);
 461     Parrot_gc_initialize_fixed_size_pools(interp, interp->mem_pools,
 462                                           GC_NUM_INITIAL_FIXED_SIZE_POOLS);
 463 }
 464
 465 /*
 466
 467 =item C<static void gc_ms_finalize(PARROT_INTERP)>
 468
 469 Finalyze MS GC subsystem. Destroy everything.
 470
 471 =cut
 472
 473 */
 474 static void
 475 gc_ms_finalize(PARROT_INTERP)
 476 {
 477     ASSERT_ARGS(gc_ms_finalize)
 478
 479     /* buffer headers, PMCs */
 480     Parrot_gc_destroy_header_pools(interp, interp->mem_pools);
 481
 482     /* memory pools in resources */
 483     Parrot_gc_destroy_memory_pools(interp, interp->mem_pools);
 484
 485     /* mem subsystem is dead now */
 486     mem_internal_free(interp->mem_pools);
 487     interp->mem_pools = NULL;
 488 }
 489
 490 /*
 491
 492 =item C<static void gc_ms_destroy_child_interp(Interp *dest_interp, Interp
 493 *source_interp)>
 494
 495 Merges the header pools of C<source_interp> into those of C<dest_interp>.
 496 (Used to deal with shared objects left after interpreter destruction.)
 497
 498 =cut
 499
 500 */
 501
 502 static void
 503 gc_ms_destroy_child_interp(ARGMOD(Interp *dest_interp),
 504     ARGIN(Interp *source_interp))
 505 {
 506     ASSERT_ARGS(gc_ms_destroy_child_interp)
 507
 508     Memory_Pools * const dest_arena   = dest_interp->mem_pools;
 509     Memory_Pools * const source_arena = source_interp->mem_pools;
 510     Parrot_gc_merge_memory_pools(dest_interp, dest_arena, source_arena);
 511 }
 512 /*
 513
 514 =item C<static void gc_ms_mark_and_sweep(PARROT_INTERP, UINTVAL flags)>
 515
 516 Runs the stop-the-world mark & sweep (MS) collector.
 517
 518 =cut
 519
 520 */
 521
 522 static void
 523 gc_ms_mark_and_sweep(PARROT_INTERP, UINTVAL flags)
 524 {
 525     ASSERT_ARGS(gc_ms_mark_and_sweep)
 526     Memory_Pools * const mem_pools = interp->mem_pools;
 527     int total_free = 0;
 528
 529     if (mem_pools->gc_mark_block_level)
 530         return;
 531
 532     if (interp->pdb && interp->pdb->debugger) {
 533         /* The debugger could have performed a mark. Make sure everything is
 534            marked dead here, so that when we sweep it all gets collected */
 535         Parrot_gc_clear_live_bits(interp, mem_pools->pmc_pool);
 536     }
 537
 538     if (flags & GC_finish_FLAG) {
 539         gc_ms_finalize_memory_pools(interp, mem_pools);
 540         return;
 541     }
 542
 543     ++mem_pools->gc_mark_block_level;
 544     mem_pools->lazy_gc = flags & GC_lazy_FLAG;
 545
 546     /* tell the threading system that we're doing GC mark */
 547     pt_gc_start_mark(interp);
 548     Parrot_gc_run_init(interp, interp->mem_pools);
 549
 550     /* Now go trace the PMCs. returning true means we did a complete trace.
 551        false means it was a lazy trace. */
 552     if (gc_ms_trace_active_PMCs(interp, (flags & GC_trace_stack_FLAG)
 553         ? GC_TRACE_FULL : GC_TRACE_ROOT_ONLY)) {
 554
 555         mem_pools->gc_trace_ptr = NULL;
 556         mem_pools->gc_mark_ptr  = NULL;
 557
 558         /* We've done the mark, now do the sweep. Pass the sweep callback
 559            function to the PMC pool and all the sized pools. */
 560        header_pools_iterate_callback(interp, interp->mem_pools,
 561             POOL_BUFFER | POOL_PMC, (void *)&total_free, gc_ms_sweep_cb);
 562
 563     }
 564     else {
 565         ++mem_pools->gc_lazy_mark_runs;
 566
 567         Parrot_gc_clear_live_bits(interp, mem_pools->pmc_pool);
 568     }
 569
 570     /* compact STRING pools to collect free headers and allocated buffers */
 571     Parrot_gc_compact_memory_pool(interp);
 572
 573     pt_gc_stop_mark(interp);
 574
 575     /* Note it */
 576     ++mem_pools->gc_mark_runs;
 577     --mem_pools->gc_mark_block_level;
 578     mem_pools->header_allocs_since_last_collect = 0;
 579     mem_pools->mem_used_last_collect = mem_pools->memory_used;
 580
 581     return;
 582 }
 583
 584 /*
 585
 586 =item C<void gc_ms_compact_memory_pool(PARROT_INTERP)>
 587
 588 Scan the string pools and compact them. This does not perform a GC mark or
 589 sweep run, and does not check whether string buffers are still alive.
 590 Redirects to C<compact_pool>.
 591
 592 =cut
 593
 594 */
 595
 596 void
 597 gc_ms_compact_memory_pool(PARROT_INTERP)
 598 {
 599     ASSERT_ARGS(gc_ms_compact_memory_pool)
 600     compact_pool(interp, interp->mem_pools, interp->mem_pools->memory_pool);
 601 }
 602
 603 /*
 604
 605 =item C<static void gc_ms_mark_special(PARROT_INTERP, PMC *pmc)>
 606
 607 Mark PMC special.
 608
 609 =cut
 610 */
 611 static void
 612 gc_ms_mark_special(PARROT_INTERP, ARGIN(PMC *pmc))
 613 {
 614     ASSERT_ARGS(gc_ms_mark_special)
 615     mark_special(interp, interp->mem_pools, pmc);
 616 }
 617
 618 /*
 619
 620 =item C<void gc_ms_pmc_needs_early_collection(PARROT_INTERP, PMC *pmc)>
 621
 622 Mark a PMC as needing timely destruction
 623
 624 =cut
 625
 626 */
 627
 628 void
 629 gc_ms_pmc_needs_early_collection(PARROT_INTERP, ARGMOD(PMC *pmc))
 630 {
 631     ASSERT_ARGS(gc_ms_pmc_needs_early_collection)
 632     PObj_needs_early_gc_SET(pmc);
 633     ++interp->mem_pools->num_early_gc_PMCs;
 634 }
 635
 636 /*
 637
 638 =item C<static void gc_ms_finalize_memory_pools(PARROT_INTERP, Memory_Pools *
 639 const mem_pools)>
 640
 641 Perform the finalization run, freeing all PMCs in Memory_Pools.
 642
 643 =cut
 644
 645 */
 646
 647 static void
 648 gc_ms_finalize_memory_pools(PARROT_INTERP, ARGIN(Memory_Pools * const mem_pools))
 649 {
 650     ASSERT_ARGS(gc_ms_finalize_memory_pools)
 651     Parrot_gc_clear_live_bits(interp, mem_pools->pmc_pool);
 652     Parrot_gc_clear_live_bits(interp, mem_pools->constant_pmc_pool);
 653
 654     /* keep the scheduler and its kids alive for Task-like PMCs to destroy
 655      * themselves; run a sweep to collect them */
 656     if (interp->scheduler) {
 657         Parrot_gc_mark_PMC_alive(interp, interp->scheduler);
 658         VTABLE_mark(interp, interp->scheduler);
 659         Parrot_gc_sweep_pool(interp, mem_pools, mem_pools->pmc_pool);
 660     }
 661
 662     /* now sweep everything that's left */
 663     Parrot_gc_sweep_pool(interp, mem_pools, mem_pools->pmc_pool);
 664     Parrot_gc_sweep_pool(interp, mem_pools, mem_pools->constant_pmc_pool);
 665 }
 666
 667 /*
 668
 669 =item C<static PMC* gc_ms_allocate_pmc_header(PARROT_INTERP, UINTVAL flags)>
 670
 671 Allocate new PMC header from pool.
 672
 673 =cut
 674
 675 */
 676 PARROT_CAN_RETURN_NULL
 677 static PMC*
 678 gc_ms_allocate_pmc_header(PARROT_INTERP, UINTVAL flags)
 679 {
 680     ASSERT_ARGS(gc_ms_allocate_pmc_header)
 681
 682     Fixed_Size_Pool * const pool = flags & PObj_constant_FLAG
 683             ? interp->mem_pools->constant_pmc_pool
 684             : interp->mem_pools->pmc_pool;
 685
 686     return (PMC *)pool->get_free_object(interp, interp->mem_pools, pool);
 687 }
 688
 689 /*
 690
 691 =item C<static void gc_ms_free_pmc_header(PARROT_INTERP, PMC *pmc)>
 692
 693 Return PMC header into pool.
 694
 695 =cut
 696
 697 */
 698 static void
 699 gc_ms_free_pmc_header(PARROT_INTERP, ARGMOD(PMC *pmc))
 700 {
 701     ASSERT_ARGS(gc_ms_free_pmc_header)
 702     Fixed_Size_Pool * const pool = (PObj_constant_TEST(pmc)) ?
 703         interp->mem_pools->constant_pmc_pool : interp->mem_pools->pmc_pool;
 704
 705     Parrot_pmc_destroy(interp, pmc);
 706
 707     PObj_flags_SETTO((PObj *)pmc, PObj_on_free_list_FLAG);
 708     pool->add_free_object(interp, interp->mem_pools, pool, (PObj *)pmc);
 709     ++pool->num_free_objects;
 710 }
 711
 712 /*
 713
 714 =item C<static STRING* gc_ms_allocate_string_header(PARROT_INTERP, UINTVAL
 715 flags)>
 716
 717 Allocate new STRING header from pool.
 718
 719 =cut
 720
 721 */
 722 PARROT_CAN_RETURN_NULL
 723 static STRING*
 724 gc_ms_allocate_string_header(PARROT_INTERP, UINTVAL flags)
 725 {
 726     ASSERT_ARGS(gc_ms_allocate_string_header)
 727
 728     Fixed_Size_Pool * const pool = flags & PObj_constant_FLAG
 729             ? interp->mem_pools->constant_string_header_pool
 730             : interp->mem_pools->string_header_pool;
 731
 732     STRING *s = (STRING *)pool->get_free_object(interp, interp->mem_pools, pool);
 733     memset(s, 0, sizeof (STRING));
 734     return s;
 735 }
 736
 737
 738 /*
 739
 740 =item C<static void gc_ms_free_string_header(PARROT_INTERP, STRING *s)>
 741
 742 Return STRING header into pool.
 743
 744 =cut
 745
 746 */
 747 static void
 748 gc_ms_free_string_header(PARROT_INTERP, ARGMOD(STRING *s))
 749 {
 750     ASSERT_ARGS(gc_ms_free_string_header)
 751     if (!PObj_constant_TEST(s)) {
 752         Fixed_Size_Pool * const pool = interp->mem_pools->string_header_pool;
 753         PObj_flags_SETTO((PObj *)s, PObj_on_free_list_FLAG);
 754         pool->add_free_object(interp, interp->mem_pools, pool, s);
 755         ++pool->num_free_objects;
 756     }
 757 }
 758
 759 /*
 760
 761 =item C<static Buffer * gc_ms_allocate_bufferlike_header(PARROT_INTERP, size_t
 762 size)>
 763
 764 Returns a new buffer-like header from the appropriate sized pool.
 765 A "bufferlike object" is an object that is considered to be isomorphic to the
 766 PObj, so it will participate in normal GC. At the moment these are only used
 767 to create ListChunk objects in src/list.c.
 768
 769 =cut
 770
 771 */
 772
 773 PARROT_CANNOT_RETURN_NULL
 774 PARROT_WARN_UNUSED_RESULT
 775 static Buffer *
 776 gc_ms_allocate_bufferlike_header(PARROT_INTERP, size_t size)
 777 {
 778     ASSERT_ARGS(gc_ms_allocate_bufferlike_header)
 779
 780     Fixed_Size_Pool * const pool = get_bufferlike_pool(interp, interp->mem_pools, size);
 781
 782     return (Buffer *)pool->get_free_object(interp, interp->mem_pools, pool);
 783 }
 784
 785 /*
 786
 787 =item C<static void gc_ms_free_bufferlike_header(PARROT_INTERP, Buffer *obj,
 788 size_t size)>
 789
 790 Free a bufferlike header that is not being used, so that Parrot can recycle
 791 it and use it again.
 792
 793 =cut
 794
 795 */
 796
 797 static void
 798 gc_ms_free_bufferlike_header(PARROT_INTERP, ARGMOD(Buffer *obj),
 799     size_t size)
 800 {
 801     ASSERT_ARGS(gc_ms_free_bufferlike_header)
 802     Fixed_Size_Pool * const pool = get_bufferlike_pool(interp, interp->mem_pools, size);
 803     pool->add_free_object(interp, interp->mem_pools, pool, obj);
 804 }
 805
 806 /*
 807
 808 =over 4
 809
 810 =item C<static void * Parrot_gc_get_attributes_from_pool(PARROT_INTERP,
 811 PMC_Attribute_Pool * pool)>
 812
 813 Get a new fixed-size storage space from the given pool. The pool contains
 814 information on the size of the item to allocate already.
 815
 816 =item C<static void Parrot_gc_allocate_new_attributes_arena(PMC_Attribute_Pool
 817 *pool)>
 818
 819 Allocate a new arena of fixed-sized data structures for the given pool.
 820
 821 =item C<static void Parrot_gc_initialize_fixed_size_pools(PARROT_INTERP,
 822 Memory_Pools *mem_pools, size_t init_num_pools)>
 823
 824 Initialize the pools (zeroize)
 825
 826 =item C<static PMC_Attribute_Pool * Parrot_gc_get_attribute_pool(PARROT_INTERP,
 827 Memory_Pools *mem_pools, size_t attrib_size)>
 828
 829 Find a fixed-sized data structure pool given the size of the object to
 830 allocate. If the pool does not exist, create it.
 831
 832 =item C<static PMC_Attribute_Pool * Parrot_gc_create_attrib_pool(size_t
 833 attrib_idx)>
 834
 835 Create a new pool for fixed-sized data items with the given C<attrib_size>.
 836
 837 =back
 838
 839 =cut
 840
 841 */
 842
 843 PARROT_CANNOT_RETURN_NULL
 844 static void *
 845 Parrot_gc_get_attributes_from_pool(PARROT_INTERP, ARGMOD(PMC_Attribute_Pool * pool))
 846 {
 847     ASSERT_ARGS(Parrot_gc_get_attributes_from_pool)
 848     PMC_Attribute_Free_List *item;
 849
 850     if (pool->free_list) {
 851         item            = pool->free_list;
 852         pool->free_list = item->next;
 853     }
 854     else if (pool->newfree) {
 855         item          = pool->newfree;
 856         pool->newfree = (PMC_Attribute_Free_List *)
 857                         ((char *)(pool->newfree) + pool->attr_size);
 858         if (pool->newfree >= pool->newlast)
 859             pool->newfree = NULL;
 860     }
 861     else {
 862         Parrot_gc_allocate_new_attributes_arena(pool);
 863         return Parrot_gc_get_attributes_from_pool(interp, pool);
 864     }
 865
 866     --pool->num_free_objects;
 867     return (void *)item;
 868 }
 869
 870
 871 static void
 872 Parrot_gc_allocate_new_attributes_arena(ARGMOD(PMC_Attribute_Pool *pool))
 873 {
 874     ASSERT_ARGS(Parrot_gc_allocate_new_attributes_arena)
 875     PMC_Attribute_Free_List *next;
 876
 877     const size_t num_items  = pool->objects_per_alloc;
 878     const size_t item_size  = pool->attr_size;
 879     const size_t item_space = item_size * num_items;
 880     const size_t total_size = sizeof (PMC_Attribute_Arena) + item_space;
 881
 882     PMC_Attribute_Arena * const new_arena = (PMC_Attribute_Arena *)mem_internal_allocate(
 883         total_size);
 884
 885     new_arena->prev = NULL;
 886     new_arena->next = pool->top_arena;
 887     pool->top_arena = new_arena;
 888     next            = (PMC_Attribute_Free_List *)(new_arena + 1);
 889
 890     pool->newfree   = next;
 891     pool->newlast   = (PMC_Attribute_Free_List *)((char *)next + item_space);
 892
 893     pool->num_free_objects += num_items;
 894     pool->total_objects    += num_items;
 895 }
 896
 897 static void
 898 Parrot_gc_initialize_fixed_size_pools(SHIM_INTERP,
 899         ARGMOD(Memory_Pools *mem_pools),
 900         size_t init_num_pools)
 901 {
 902     ASSERT_ARGS(Parrot_gc_initialize_fixed_size_pools)
 903     PMC_Attribute_Pool **pools;
 904     const size_t total_size = (init_num_pools + 1) * sizeof (void *);
 905
 906     pools = (PMC_Attribute_Pool **)mem_internal_allocate(total_size);
 907     memset(pools, 0, total_size);
 908
 909     mem_pools->attrib_pools = pools;
 910     mem_pools->num_attribs = init_num_pools;
 911 }
 912
 913
 914 PARROT_CANNOT_RETURN_NULL
 915 static PMC_Attribute_Pool *
 916 Parrot_gc_get_attribute_pool(SHIM_INTERP,
 917         ARGMOD(Memory_Pools *mem_pools),
 918         size_t attrib_size)
 919 {
 920     ASSERT_ARGS(Parrot_gc_get_attribute_pool)
 921
 922     PMC_Attribute_Pool **pools = mem_pools->attrib_pools;
 923     const size_t         idx   = (attrib_size < sizeof (void *))
 924                                ? 0
 925                                : attrib_size - sizeof (void *);
 926
 927     if (mem_pools->num_attribs <= idx) {
 928         const size_t total_length = idx + GC_ATTRIB_POOLS_HEADROOM;
 929         const size_t total_size   = total_length * sizeof (void *);
 930         const size_t current_size = mem_pools->num_attribs;
 931         const size_t diff         = total_length - current_size;
 932
 933         pools = (PMC_Attribute_Pool **)mem_internal_realloc(pools, total_size);
 934         memset(pools + current_size, 0, diff * sizeof (void *));
 935         mem_pools->attrib_pools = pools;
 936         mem_pools->num_attribs = total_length;
 937     }
 938
 939     if (!pools[idx]) {
 940         PMC_Attribute_Pool * const pool = Parrot_gc_create_attrib_pool(idx);
 941         /* Create the first arena now, so we don't have to check for it later */
 942         Parrot_gc_allocate_new_attributes_arena(pool);
 943         pools[idx] = pool;
 944     }
 945
 946     return pools[idx];
 947 }
 948
 949 PARROT_CANNOT_RETURN_NULL
 950 PARROT_MALLOC
 951 static PMC_Attribute_Pool *
 952 Parrot_gc_create_attrib_pool(size_t attrib_idx)
 953 {
 954     ASSERT_ARGS(Parrot_gc_create_attrib_pool)
 955     const size_t attrib_size = attrib_idx + sizeof (void *);
 956     const size_t num_objs_raw =
 957         (GC_FIXED_SIZE_POOL_SIZE - sizeof (PMC_Attribute_Arena)) / attrib_size;
 958     const size_t num_objs = (num_objs_raw == 0)?(1):(num_objs_raw);
 959     PMC_Attribute_Pool * const newpool = mem_internal_allocate_typed(PMC_Attribute_Pool);
 960
 961     newpool->attr_size         = attrib_size;
 962     newpool->total_objects     = 0;
 963     newpool->objects_per_alloc = num_objs;
 964     newpool->num_free_objects  = 0;
 965     newpool->free_list         = NULL;
 966     newpool->top_arena         = NULL;
 967
 968     return newpool;
 969 }
 970
 971
 972 /*
 973
 974 =item C<static void * gc_ms_allocate_pmc_attributes(PARROT_INTERP, PMC *pmc)>
 975
 976 Allocates a new attribute structure for a PMC if it has the auto_attrs flag
 977 set.
 978
 979 =cut
 980
 981 */
 982
 983 PARROT_CANNOT_RETURN_NULL
 984 static void *
 985 gc_ms_allocate_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
 986 {
 987     ASSERT_ARGS(gc_ms_allocate_pmc_attributes)
 988     const size_t attr_size = pmc->vtable->attr_size;
 989     PMC_Attribute_Pool * const pool = Parrot_gc_get_attribute_pool(interp,
 990             interp->mem_pools, attr_size);
 991     void * const attrs = Parrot_gc_get_attributes_from_pool(interp, pool);
 992     memset(attrs, 0, attr_size);
 993     PMC_data(pmc) = attrs;
 994     return attrs;
 995 }
 996
 997 /*
 998
 999 =item C<static INTVAL contained_in_attr_pool(const PMC_Attribute_Pool *pool,
1000 const void *ptr)>
1001
1002 Returns whether the given C<*ptr> points to a location in C<pool>.
1003
1004 =cut
1005
1006 */
1007
1008 PARROT_WARN_UNUSED_RESULT
1009 static INTVAL
1010 contained_in_attr_pool(ARGIN(const PMC_Attribute_Pool *pool), ARGIN(const void *ptr))
1011 {
1012     ASSERT_ARGS(contained_in_attr_pool)
1013     const PMC_Attribute_Arena *arena;
1014     const ptrdiff_t item_space = pool->objects_per_alloc * pool->attr_size;
1015
1016     for (arena = pool->top_arena; arena; arena = arena->next) {
1017         const ptrdiff_t ptr_diff = (const char *)ptr - (const char *)(arena + 1);
1018
1019         if (ptr_diff >= 0
1020         &&  ptr_diff < item_space
1021         &&  ptr_diff % pool->attr_size == 0)
1022             return 1;
1023     }
1024
1025     return 0;
1026 }
1027
1028 /*
1029
1030 =item C<void gc_ms_free_pmc_attributes(PARROT_INTERP, PMC *pmc)>
1031
1032 Deallocates an attibutes structure from a PMC if it has the auto_attrs
1033 flag set.
1034
1035 */
1036
1037 void
1038 gc_ms_free_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
1039 {
1040     ASSERT_ARGS(gc_ms_free_pmc_attributes)
1041     void * const data = PMC_data(pmc);
1042
1043     if (data) {
1044         const size_t attr_size = pmc->vtable->attr_size;
1045         const size_t item_size = attr_size < sizeof (void *) ? sizeof (void *) : attr_size;
1046         PMC_Attribute_Pool ** const pools = interp->mem_pools->attrib_pools;
1047         const size_t idx = item_size - sizeof (void *);
1048         gc_ms_free_attributes_from_pool(pools[idx], data);
1049     }
1050 }
1051
1052 /*
1053
1054 =item C<static void gc_ms_free_attributes_from_pool(PMC_Attribute_Pool *pool,
1055 void *data)>
1056
1057 Frees a fixed-size data item back to the pool for later reallocation.  Private
1058 to this file.
1059
1060 */
1061
1062 static void
1063 gc_ms_free_attributes_from_pool(ARGMOD(PMC_Attribute_Pool *pool), ARGMOD(void *data))
1064 {
1065     ASSERT_ARGS(gc_ms_free_attributes_from_pool)
1066     PMC_Attribute_Free_List * const item = (PMC_Attribute_Free_List *)data;
1067
1068 #if DEBUG_FREE_LIST
1069     PARROT_ASSERT(contained_in_attr_pool(pool, data));
1070 #endif
1071
1072     item->next      = pool->free_list;
1073     pool->free_list = item;
1074
1075     ++pool->num_free_objects;
1076 }
1077
1078 /*
1079
1080 =item C<static void gc_ms_allocate_buffer_storage(PARROT_INTERP, Buffer *buffer,
1081 size_t size)>
1082
1083 Allocates a chunk of memory of at least size C<size> for the given Buffer.
1084 buffer is guaranteed to be properly aligned for things like C<FLOATVALS>,
1085 so the size may be rounded up or down to guarantee that this alignment holds.
1086
1087 =cut
1088
1089 */
1090
1091 static void
1092 gc_ms_allocate_buffer_storage(PARROT_INTERP,
1093     ARGOUT(Buffer *buffer), size_t size)
1094 {
1095     ASSERT_ARGS(gc_ms_allocate_buffer_storage)
1096     const size_t new_size   = ALIGNED_STRING_SIZE(size);
1097
1098     Buffer_bufstart(buffer) = (void *)aligned_mem(buffer,
1099         (char *)mem_allocate(interp,
1100         interp->mem_pools, new_size, interp->mem_pools->memory_pool));
1101
1102     /* Save pool used to allocate into buffer header */
1103     *Buffer_poolptr(buffer) = interp->mem_pools->memory_pool->top_block;
1104
1105     Buffer_buflen(buffer)   = new_size - sizeof (void *);
1106 }
1107
1108 /*
1109
1110 =item C<static void gc_ms_reallocate_buffer_storage(PARROT_INTERP, Buffer
1111 *buffer, size_t newsize)>
1112
1113 Reallocate the Buffer's buffer memory to the given size. The
1114 allocated buffer will not shrink. If the buffer was allocated with
1115 L<Parrot_allocate_aligned> the new buffer will also be aligned. As with
1116 all reallocation, the new buffer might have moved and the additional
1117 memory is not cleared.
1118
1119 =cut
1120
1121 */
1122
1123 static void
1124 gc_ms_reallocate_buffer_storage(PARROT_INTERP, ARGMOD(Buffer *buffer),
1125     size_t newsize)
1126 {
1127     ASSERT_ARGS(gc_ms_reallocate_buffer_storage)
1128     size_t copysize;
1129     char  *mem;
1130     Variable_Size_Pool * const pool = interp->mem_pools->memory_pool;
1131     size_t new_size, needed, old_size;
1132
1133     /* we don't shrink buffers */
1134     if (newsize <= Buffer_buflen(buffer))
1135         return;
1136
1137     /*
1138      * same as below but barely used and tested - only 3 list related
1139      * tests do use true reallocation
1140      *
1141      * list.c, which does _reallocate, has 2 reallocations
1142      * normally, which play ping pong with buffers.
1143      * The normal case is therefore always to allocate a new block
1144      */
1145     new_size = ALIGNED_STRING_SIZE(newsize);
1146     old_size = ALIGNED_STRING_SIZE(Buffer_buflen(buffer));
1147     needed   = new_size - old_size;
1148
1149     if ((pool->top_block->free >= needed)
1150     &&  (pool->top_block->top  == (char *)Buffer_bufstart(buffer) + old_size)) {
1151         pool->top_block->free -= needed;
1152         pool->top_block->top  += needed;
1153         interp->mem_pools->memory_used += needed;
1154         Buffer_buflen(buffer)  = newsize;
1155         return;
1156     }
1157
1158     copysize = Buffer_buflen(buffer);
1159
1160     mem = (char *)mem_allocate(interp, interp->mem_pools, new_size, pool);
1161     mem = aligned_mem(buffer, mem);
1162
1163     /* We shouldn't ever have a 0 from size, but we do. If we can track down
1164      * those bugs, this can be removed which would make things cheaper */
1165     if (copysize)
1166         memcpy(mem, Buffer_bufstart(buffer), copysize);
1167
1168     Buffer_bufstart(buffer) = mem;
1169
1170     new_size -= sizeof (void *);
1171
1172     Buffer_buflen(buffer) = new_size;
1173
1174     /* Save pool used to allocate into buffer header */
1175     *Buffer_poolptr(buffer) = interp->mem_pools->memory_pool->top_block;
1176 }
1177
1178 /*
1179
1180 =item C<void gc_ms_allocate_string_storage(PARROT_INTERP, STRING *str, size_t
1181 size)>
1182
1183 Allocate the STRING's buffer memory to the given size. The allocated
1184 buffer maybe slightly bigger than the given C<size>. This function
1185 sets also C<< str->strstart >> to the new buffer location, C<< str->bufused >>
1186 is B<not> changed.
1187
1188 =cut
1189
1190 */
1191
1192 void
1193 gc_ms_allocate_string_storage(PARROT_INTERP, ARGOUT(STRING *str),
1194     size_t size)
1195 {
1196     ASSERT_ARGS(gc_ms_allocate_string_storage)
1197     size_t       new_size;
1198     Variable_Size_Pool *pool;
1199     char        *mem;
1200
1201     Buffer_buflen(str)   = 0;
1202     Buffer_bufstart(str) = NULL;
1203
1204     if (size == 0)
1205         return;
1206
1207     pool     = PObj_constant_TEST(str)
1208                 ? interp->mem_pools->constant_string_pool
1209                 : interp->mem_pools->memory_pool;
1210
1211     new_size = ALIGNED_STRING_SIZE(size);
1212     mem      = (char *)mem_allocate(interp, interp->mem_pools, new_size, pool);
1213     mem     += sizeof (void *);
1214
1215     Buffer_bufstart(str) = str->strstart = mem;
1216     Buffer_buflen(str)   = new_size - sizeof (void *);
1217
1218     /* Save pool used to allocate into buffer header */
1219     *Buffer_poolptr(str) = pool->top_block;
1220 }
1221
1222 /*
1223
1224 =item C<static void gc_ms_reallocate_string_storage(PARROT_INTERP, STRING *str,
1225 size_t newsize)>
1226
1227 Reallocate the STRING's buffer memory to the given size. The allocated
1228 buffer will not shrink. This function sets also C<str-E<gt>strstart> to the
1229 new buffer location, C<str-E<gt>bufused> is B<not> changed.
1230
1231 =cut
1232
1233 */
1234
1235 static void
1236 gc_ms_reallocate_string_storage(PARROT_INTERP, ARGMOD(STRING *str),
1237     size_t newsize)
1238 {
1239     ASSERT_ARGS(gc_ms_reallocate_string_storage)
1240     size_t copysize;
1241     char *mem, *oldmem;
1242     size_t new_size, needed, old_size;
1243
1244     Variable_Size_Pool * const pool =
1245         PObj_constant_TEST(str)
1246             ? interp->mem_pools->constant_string_pool
1247             : interp->mem_pools->memory_pool;
1248
1249     /* if the requested size is smaller then buflen, we are done */
1250     if (newsize <= Buffer_buflen(str))
1251         return;
1252
1253     /*
1254      * first check, if we can reallocate:
1255      * - if the passed strings buffer is the last string in the pool and
1256      * - if there is enough size, we can just move the pool's top pointer
1257      */
1258     new_size = ALIGNED_STRING_SIZE(newsize);
1259     old_size = ALIGNED_STRING_SIZE(Buffer_buflen(str));
1260     needed   = new_size - old_size;
1261
1262     if (pool->top_block->free >= needed
1263     &&  pool->top_block->top  == (char *)Buffer_bufstart(str) + old_size) {
1264         pool->top_block->free -= needed;
1265         pool->top_block->top  += needed;
1266         interp->mem_pools->memory_used += needed;
1267         Buffer_buflen(str) = new_size - sizeof (void *);
1268         return;
1269     }
1270
1271     PARROT_ASSERT(str->bufused <= newsize);
1272
1273     /* only copy used memory, not total string buffer */
1274     copysize = str->bufused;
1275
1276     mem = (char *)mem_allocate(interp, interp->mem_pools, new_size, pool);
1277     mem += sizeof (void *);
1278
1279     /* Update Memory_Block usage */
1280     /* We must not reallocate non-movable buffers! */
1281     PARROT_ASSERT(PObj_is_movable_TESTALL(str));
1282
1283     /* We must not reallocate shared buffers! */
1284     PARROT_ASSERT(!(*Buffer_bufflagsptr(str) & Buffer_shared_FLAG));
1285
1286     /* Decrease usage */
1287     PARROT_ASSERT(Buffer_pool(str));
1288     Buffer_pool(str)->freed += old_size;
1289
1290     /* copy mem from strstart, *not* bufstart */
1291     oldmem             = str->strstart;
1292     Buffer_bufstart(str) = (void *)mem;
1293     str->strstart      = mem;
1294     Buffer_buflen(str)   = new_size - sizeof (void *);
1295
1296     /* We shouldn't ever have a 0 from size, but we do. If we can track down
1297      * those bugs, this can be removed which would make things cheaper */
1298     if (copysize)
1299         memcpy(mem, oldmem, copysize);
1300
1301     /* Save pool used to allocate into buffer header */
1302     *Buffer_poolptr(str) = pool->top_block;
1303 }
1304
1305 /*
1306
1307 =item C<void * gc_ms_allocate_fixed_size_storage(PARROT_INTERP, size_t size)>
1308
1309 Allocates a fixed-size chunk of memory for use. This memory is not manually
1310 managed and needs to be freed with C<gc_ms_free_fixed_size_storage>
1311
1312 */
1313
1314 PARROT_CANNOT_RETURN_NULL
1315 void *
1316 gc_ms_allocate_fixed_size_storage(PARROT_INTERP, size_t size)
1317 {
1318     ASSERT_ARGS(gc_ms_allocate_fixed_size_storage)
1319     PMC_Attribute_Pool *pool = NULL;
1320     const size_t idx = (size < sizeof (void *)) ? 0 : (size - sizeof (void *));
1321
1322     /* get the pool directly, if possible, for great speed */
1323     if (interp->mem_pools->num_attribs > idx)
1324         pool = interp->mem_pools->attrib_pools[idx];
1325
1326     /* otherwise create it */
1327     if (!pool)
1328         pool = Parrot_gc_get_attribute_pool(interp, interp->mem_pools, size);
1329
1330     return Parrot_gc_get_attributes_from_pool(interp, pool);
1331 }
1332
1333 /*
1334
1335 =item C<void gc_ms_free_fixed_size_storage(PARROT_INTERP, size_t size, void
1336 *data)>
1337
1338 Manually deallocates fixed size storage allocated with
1339 C<gc_ms_allocate_fixed_size_storage>
1340
1341 */
1342
1343 void
1344 gc_ms_free_fixed_size_storage(PARROT_INTERP, size_t size, ARGMOD(void *data))
1345 {
1346     ASSERT_ARGS(gc_ms_free_fixed_size_storage)
1347
1348     const size_t idx   = size - sizeof (void *);
1349     PMC_Attribute_Pool ** const pools = interp->mem_pools->attrib_pools;
1350     gc_ms_free_attributes_from_pool(pools[idx], data);
1351 }
1352
1353 /*
1354
1355 =item C<static void * gc_ms_allocate_memory_chunk(PARROT_INTERP, size_t size)>
1356
1357 =item C<static void * gc_ms_reallocate_memory_chunk(PARROT_INTERP, void *from,
1358 size_t size)>
1359
1360 =item C<static void * gc_ms_allocate_memory_chunk_zeroed(PARROT_INTERP, size_t
1361 size)>
1362
1363 =item C<static void * gc_ms_reallocate_memory_chunk_zeroed(PARROT_INTERP, void
1364 *data, size_t newsize, size_t oldsize)>
1365
1366 =item C<static void gc_ms_free_memory_chunk(PARROT_INTERP, void *data)>
1367
1368 TODO Write docu.
1369
1370 */
1371
1372 PARROT_MALLOC
1373 PARROT_CANNOT_RETURN_NULL
1374 static void *
1375 gc_ms_allocate_memory_chunk(SHIM_INTERP, size_t size)
1376 {
1377     ASSERT_ARGS(gc_ms_allocate_memory_chunk)
1378     void * const ptr = malloc(size);
1379 #ifdef DETAIL_MEMORY_DEBUG
1380     fprintf(stderr, "Allocated %i at %p\n", size, ptr);
1381 #endif
1382     if (!ptr)
1383         PANIC_OUT_OF_MEM(size);
1384     return ptr;
1385 }
1386
1387 PARROT_MALLOC
1388 PARROT_CANNOT_RETURN_NULL
1389 static void *
1390 gc_ms_reallocate_memory_chunk(SHIM_INTERP, ARGFREE(void *from), size_t size)
1391 {
1392     ASSERT_ARGS(gc_ms_reallocate_memory_chunk)
1393     void *ptr;
1394 #ifdef DETAIL_MEMORY_DEBUG
1395     fprintf(stderr, "Freed %p (realloc -- %i bytes)\n", from, size);
1396 #endif
1397     if (from)
1398         ptr = realloc(from, size);
1399     else
1400         ptr = calloc(1, size);
1401 #ifdef DETAIL_MEMORY_DEBUG
1402     fprintf(stderr, "Allocated %i at %p\n", size, ptr);
1403 #endif
1404     if (!ptr)
1405         PANIC_OUT_OF_MEM(size);
1406     return ptr;
1407 }
1408
1409 PARROT_MALLOC
1410 PARROT_CANNOT_RETURN_NULL
1411 static void *
1412 gc_ms_allocate_memory_chunk_zeroed(SHIM_INTERP, size_t size)
1413 {
1414     ASSERT_ARGS(gc_ms_allocate_memory_chunk_zeroed)
1415     void * const ptr = calloc(1, (size_t)size);
1416 #ifdef DETAIL_MEMORY_DEBUG
1417     fprintf(stderr, "Allocated %i at %p\n", size, ptr);
1418 #endif
1419     if (!ptr)
1420         PANIC_OUT_OF_MEM(size);
1421     return ptr;
1422 }
1423
1424 PARROT_MALLOC
1425 PARROT_CANNOT_RETURN_NULL
1426 static void *
1427 gc_ms_reallocate_memory_chunk_zeroed(SHIM_INTERP, ARGFREE(void *data),
1428         size_t newsize, size_t oldsize)
1429 {
1430     ASSERT_ARGS(gc_ms_reallocate_memory_chunk_zeroed)
1431     void * const ptr = realloc(data, newsize);
1432     if (newsize > oldsize)
1433         memset((char*)ptr + oldsize, 0, newsize - oldsize);
1434     return ptr;
1435 }
1436
1437 static void
1438 gc_ms_free_memory_chunk(SHIM_INTERP, ARGFREE(void *data))
1439 {
1440     ASSERT_ARGS(gc_ms_free_memory_chunk)
1441 #ifdef DETAIL_MEMORY_DEBUG
1442     fprintf(stderr, "Freed %p\n", data);
1443 #endif
1444     if (data)
1445         free(data);
1446 }
1447
1448
1449 /*
1450
1451 =item C<static int gc_ms_trace_active_PMCs(PARROT_INTERP, Parrot_gc_trace_type
1452 trace)>
1453
1454 Performs a full trace run and marks all the PMCs as active if they
1455 are. Returns whether the run completed, that is, whether it's safe
1456 to proceed with GC.
1457
1458 =cut
1459
1460 */
1461
1462 static int
1463 gc_ms_trace_active_PMCs(PARROT_INTERP, Parrot_gc_trace_type trace)
1464 {
1465     ASSERT_ARGS(gc_ms_trace_active_PMCs)
1466
1467     if (!Parrot_gc_trace_root(interp, interp->mem_pools, trace))
1468         return 0;
1469
1470     pt_gc_mark_root_finished(interp);
1471     interp->mem_pools->gc_trace_ptr  = NULL;
1472     return 1;
1473
1474 }
1475
1476 /*
1477
1478 =item C<static int gc_ms_sweep_cb(PARROT_INTERP, Memory_Pools *mem_pools,
1479 Fixed_Size_Pool *pool, int flag, void *arg)>
1480
1481 Sweeps the given pool for the MS collector. This function also ends
1482 the profiling timer, if profiling is enabled. Returns the total number
1483 of objects freed.
1484
1485 =cut
1486
1487 */
1488
1489 static int
1490 gc_ms_sweep_cb(PARROT_INTERP,
1491         ARGIN(Memory_Pools *mem_pools),
1492         ARGMOD(Fixed_Size_Pool *pool),
1493         SHIM(int flag), ARGMOD(void *arg))
1494 {
1495     ASSERT_ARGS(gc_ms_sweep_cb)
1496     int * const total_free = (int *) arg;
1497
1498     Parrot_gc_sweep_pool(interp, mem_pools, pool);
1499
1500     *total_free += pool->num_free_objects;
1501
1502     return 0;
1503 }
1504
1505 /*
1506
1507 =back
1508
1509 =head2 MS Pool Functions
1510
1511 =over 4
1512
1513 =item C<static void gc_ms_pool_init(PARROT_INTERP, Fixed_Size_Pool *pool)>
1514
1515 Initialize a memory pool for the MS garbage collector system. Sets the
1516 function pointers necessary to perform basic operations on a pool, such
1517 as object allocation.
1518
1519 =cut
1520
1521 */
1522
1523 static void
1524 gc_ms_pool_init(SHIM_INTERP, ARGMOD(Fixed_Size_Pool *pool))
1525 {
1526     ASSERT_ARGS(gc_ms_pool_init)
1527     pool->add_free_object = gc_ms_add_free_object;
1528     pool->get_free_object = gc_ms_get_free_object;
1529     pool->alloc_objects   = gc_ms_alloc_objects;
1530     pool->more_objects    = gc_ms_more_traceable_objects;
1531 }
1532
1533 /*
1534
1535 =item C<static void gc_ms_more_traceable_objects(PARROT_INTERP, Memory_Pools
1536 *mem_pools, Fixed_Size_Pool *pool)>
1537
1538 We're out of traceable objects. First we try a GC run to free some up. If
1539 that doesn't work, allocate a new arena.
1540
1541 =cut
1542
1543 */
1544
1545 static void
1546 gc_ms_more_traceable_objects(PARROT_INTERP,
1547         ARGIN(Memory_Pools *mem_pools),
1548         ARGMOD(Fixed_Size_Pool *pool))
1549 {
1550     ASSERT_ARGS(gc_ms_more_traceable_objects)
1551     size_t new_mem = mem_pools->memory_used
1552                    - mem_pools->mem_used_last_collect;
1553
1554     if (pool->skip == GC_ONE_SKIP)
1555         pool->skip = GC_NO_SKIP;
1556     else if (pool->skip == GC_NEVER_SKIP
1557          || (pool->skip == GC_NO_SKIP
1558          && (new_mem > (mem_pools->mem_used_last_collect >> 2)
1559          &&  new_mem >= GC_SIZE_THRESHOLD)))
1560             Parrot_gc_mark_and_sweep(interp, GC_trace_stack_FLAG);
1561
1562     /* requires that num_free_objects be updated in Parrot_gc_mark_and_sweep.
1563        If gc is disabled, then we must check the free list directly. */
1564     if ((!pool->free_list || pool->num_free_objects < pool->replenish_level)
1565         && !pool->newfree)
1566         (*pool->alloc_objects) (interp, interp->mem_pools, pool);
1567 }
1568
1569 /*
1570
1571 =item C<static void gc_ms_add_free_object(PARROT_INTERP, Memory_Pools
1572 *mem_pools, Fixed_Size_Pool *pool, void *to_add)>
1573
1574 Add an unused object back to the pool's free list for later reuse. Set
1575 the PObj flags to indicate that the item is free.
1576
1577 =cut
1578
1579 */
1580
1581 static void
1582 gc_ms_add_free_object(SHIM_INTERP,
1583         ARGMOD(Memory_Pools *mem_pools),
1584         ARGMOD(Fixed_Size_Pool *pool),
1585         ARGIN(void *to_add))
1586 {
1587     ASSERT_ARGS(gc_ms_add_free_object)
1588     GC_MS_PObj_Wrapper *object = (GC_MS_PObj_Wrapper *)to_add;
1589
1590 #if DEBUG_FREE_LIST
1591     PARROT_ASSERT(contained_in_pool(pool, to_add));
1592 #endif
1593
1594     PObj_flags_SETTO(object, PObj_on_free_list_FLAG);
1595
1596     object->next_ptr = pool->free_list;
1597     pool->free_list  = object;
1598     mem_pools->memory_used -= pool->object_size;
1599 }
1600
1601 /*
1602
1603 =item C<static void * gc_ms_get_free_object(PARROT_INTERP, Memory_Pools
1604 *mem_pools, Fixed_Size_Pool *pool)>
1605
1606 Free object allocator for the MS garbage collector system. If there are no
1607 free objects, call C<gc_ms_add_free_object> to either free them up with a
1608 GC run, or allocate new objects. If there are objects available on the
1609 free list, pop it off and return it.
1610
1611 =cut
1612
1613 */
1614
1615 PARROT_CANNOT_RETURN_NULL
1616 PARROT_WARN_UNUSED_RESULT
1617 static void *
1618 gc_ms_get_free_object(PARROT_INTERP,
1619         ARGMOD(Memory_Pools *mem_pools),
1620         ARGMOD(Fixed_Size_Pool *pool))
1621 {
1622     ASSERT_ARGS(gc_ms_get_free_object)
1623     PObj *ptr;
1624     PObj *free_list = (PObj *)pool->free_list;
1625
1626   HAVE_FREE:
1627     if (free_list) {
1628         ptr             = free_list;
1629         pool->free_list = ((GC_MS_PObj_Wrapper *)ptr)->next_ptr;
1630     }
1631     else if (pool->newfree) {
1632         Fixed_Size_Arena * const arena = pool->last_Arena;
1633         ptr           = (PObj *)pool->newfree;
1634         pool->newfree = (void *)((char *)pool->newfree + pool->object_size);
1635         ++arena->used;
1636
1637         if (pool->newfree >= pool->newlast)
1638             pool->newfree = NULL;
1639
1640         PARROT_ASSERT(ptr < (PObj *)pool->newlast);
1641     }
1642     else {
1643         (*pool->more_objects)(interp, mem_pools, pool);
1644         free_list = (PObj *)pool->free_list;
1645         goto HAVE_FREE;
1646     }
1647
1648     --pool->num_free_objects;
1649     mem_pools->memory_used += pool->object_size;
1650
1651     return ptr;
1652 }
1653
1654
1655 /*
1656
1657 =item C<static void gc_ms_alloc_objects(PARROT_INTERP, Memory_Pools *mem_pools,
1658 Fixed_Size_Pool *pool)>
1659
1660 New arena allocator function for the MS garbage collector system. Allocates
1661 and initializes a new memory arena in the given pool. Adds all the new
1662 objects to the pool's free list for later allocation.
1663
1664 =cut
1665
1666 */
1667
1668 static void
1669 gc_ms_alloc_objects(PARROT_INTERP,
1670         ARGIN(Memory_Pools *mem_pools),
1671         ARGMOD(Fixed_Size_Pool *pool))
1672 {
1673     ASSERT_ARGS(gc_ms_alloc_objects)
1674     /* Setup memory for the new objects */
1675
1676     Fixed_Size_Arena * const new_arena =
1677         mem_internal_allocate_typed(Fixed_Size_Arena);
1678
1679     const size_t size = pool->object_size * pool->objects_per_alloc;
1680     size_t alloc_size;
1681
1682     /* could be mem_internal_allocate too, but calloc is fast */
1683     new_arena->start_objects = mem_internal_allocate_zeroed(size);
1684
1685     Parrot_append_arena_in_pool(interp, mem_pools, pool, new_arena, size);
1686
1687     PARROT_ASSERT(pool->last_Arena);
1688
1689     Parrot_add_to_free_list(interp, pool, new_arena);
1690
1691     /* Allocate more next time */
1692     pool->objects_per_alloc *= GC_DEBUG_UNITS_PER_ALLOC_GROWTH_FACTOR;
1693     pool->replenish_level =
1694             (size_t)(pool->total_objects *
1695             GC_DEBUG_REPLENISH_LEVEL_FACTOR);
1696
1697     /* check alloc size against maximum */
1698     alloc_size = pool->object_size * pool->objects_per_alloc;
1699
1700     if (alloc_size > POOL_MAX_BYTES)
1701         pool->objects_per_alloc = POOL_MAX_BYTES / pool->object_size;
1702 }
1703
1704
1705 /*
1706
1707 =item C<static void gc_ms_block_GC_mark(PARROT_INTERP)>
1708
1709 Blocks the GC from performing its mark phase.
1710
1711 =item C<static void gc_ms_unblock_GC_mark(PARROT_INTERP)>
1712
1713 Unblocks the GC mark.
1714
1715 =item C<static void gc_ms_block_GC_sweep(PARROT_INTERP)>
1716
1717 Blocks the GC from performing its sweep phase.
1718
1719 =item C<static void gc_ms_unblock_GC_sweep(PARROT_INTERP)>
1720
1721 Unblocks GC sweep.
1722
1723 =item C<static unsigned int gc_ms_is_blocked_GC_mark(PARROT_INTERP)>
1724
1725 Determines if the GC mark is currently blocked.
1726
1727 =item C<static unsigned int gc_ms_is_blocked_GC_sweep(PARROT_INTERP)>
1728
1729 Determines if the GC sweep is currently blocked.
1730
1731 =cut
1732
1733 */
1734
1735 static void
1736 gc_ms_block_GC_mark(PARROT_INTERP)
1737 {
1738     ASSERT_ARGS(gc_ms_block_GC_mark)
1739     ++interp->mem_pools->gc_mark_block_level;
1740     Parrot_shared_gc_block(interp);
1741 }
1742
1743 static void
1744 gc_ms_unblock_GC_mark(PARROT_INTERP)
1745 {
1746     ASSERT_ARGS(gc_ms_unblock_GC_mark)
1747     if (interp->mem_pools->gc_mark_block_level) {
1748         --interp->mem_pools->gc_mark_block_level;
1749         Parrot_shared_gc_unblock(interp);
1750     }
1751 }
1752
1753 static void
1754 gc_ms_block_GC_sweep(PARROT_INTERP)
1755 {
1756     ASSERT_ARGS(gc_ms_block_GC_sweep)
1757     ++interp->mem_pools->gc_sweep_block_level;
1758 }
1759
1760 static void
1761 gc_ms_unblock_GC_sweep(PARROT_INTERP)
1762 {
1763     ASSERT_ARGS(gc_ms_unblock_GC_sweep)
1764     if (interp->mem_pools->gc_sweep_block_level)
1765         --interp->mem_pools->gc_sweep_block_level;
1766 }
1767
1768 static unsigned int
1769 gc_ms_is_blocked_GC_mark(PARROT_INTERP)
1770 {
1771     ASSERT_ARGS(gc_ms_is_blocked_GC_mark)
1772     return interp->mem_pools->gc_mark_block_level;
1773 }
1774
1775 static unsigned int
1776 gc_ms_is_blocked_GC_sweep(PARROT_INTERP)
1777 {
1778     ASSERT_ARGS(gc_ms_is_blocked_GC_sweep)
1779     return interp->mem_pools->gc_sweep_block_level;
1780 }
1781
1782 /*
1783
1784 =item C<static size_t gc_ms_get_gc_info(PARROT_INTERP, Interpinfo_enum which)>
1785
1786 Get information about MS GC.
1787
1788 =cut
1789
1790 */
1791
1792 static size_t
1793 gc_ms_get_gc_info(PARROT_INTERP, Interpinfo_enum which)
1794 {
1795     ASSERT_ARGS(gc_ms_get_gc_info)
1796
1797     Memory_Pools * const mem_pools = interp->mem_pools;
1798     switch (which) {
1799         case TOTAL_MEM_ALLOC:
1800             return mem_pools->memory_allocated;
1801         case GC_MARK_RUNS:
1802             return mem_pools->gc_mark_runs;
1803         case GC_COLLECT_RUNS:
1804             return mem_pools->gc_collect_runs;
1805         case ACTIVE_PMCS:
1806             return mem_pools->pmc_pool->total_objects -
1807                    mem_pools->pmc_pool->num_free_objects;
1808         case ACTIVE_BUFFERS:
1809             return gc_ms_active_sized_buffers(mem_pools);
1810         case TOTAL_PMCS:
1811             return mem_pools->pmc_pool->total_objects;
1812         case TOTAL_BUFFERS:
1813             return gc_ms_total_sized_buffers(mem_pools);
1814         case HEADER_ALLOCS_SINCE_COLLECT:
1815             return mem_pools->header_allocs_since_last_collect;
1816         case MEM_ALLOCS_SINCE_COLLECT:
1817             return mem_pools->mem_allocs_since_last_collect;
1818         case TOTAL_COPIED:
1819             return mem_pools->memory_collected;
1820         case IMPATIENT_PMCS:
1821             return mem_pools->num_early_gc_PMCs;
1822         case GC_LAZY_MARK_RUNS:
1823             return mem_pools->gc_lazy_mark_runs;
1824         case EXTENDED_PMCS:
1825         default:
1826             break;
1827     }
1828     return 0;
1829 }
1830
1831 /*
1832
1833 =item C<static int gc_ms_active_sized_buffers(const Memory_Pools *mem_pools)>
1834
1835 Returns the number of actively used sized buffers.
1836
1837 =cut
1838
1839 */
1840
1841 static int
1842 gc_ms_active_sized_buffers(ARGIN(const Memory_Pools *mem_pools))
1843 {
1844     ASSERT_ARGS(gc_ms_active_sized_buffers)
1845     int j, ret = 0;
1846     for (j = 0; j < (INTVAL)mem_pools->num_sized; ++j) {
1847         Fixed_Size_Pool * const header_pool =
1848             mem_pools->sized_header_pools[j];
1849         if (header_pool)
1850             ret += header_pool->total_objects -
1851                 header_pool->num_free_objects;
1852     }
1853     return ret;
1854 }
1855
1856 /*
1857
1858 =item C<static int gc_ms_total_sized_buffers(const Memory_Pools *mem_pools)>
1859
1860 Returns the total number of sized buffers that we are managing.
1861
1862 =cut
1863
1864 */
1865
1866 static int
1867 gc_ms_total_sized_buffers(ARGIN(const Memory_Pools *mem_pools))
1868 {
1869     ASSERT_ARGS(gc_ms_total_sized_buffers)
1870     int j, ret = 0;
1871     for (j = 0; j < (INTVAL)mem_pools->num_sized; ++j) {
1872         Fixed_Size_Pool * const header_pool =
1873             mem_pools->sized_header_pools[j];
1874         if (header_pool)
1875             ret += header_pool->total_objects;
1876     }
1877     return ret;
1878 }
1879
1880 /*
1881
1882 =back
1883
1884 =cut
1885
1886 */
1887
1888 /*
1889  * Local variables:
1890  *   c-file-style: "parrot"
1891  * End:
1892  * vim: expandtab shiftwidth=4:
1893  */