CAMLprim value caml_gc_quick_stat(value v) { CAMLparam0 (); CAMLlocal1 (res); /* get a copy of these before allocating anything... */ #ifdef _KERNEL uintnat minwords = caml_stat_minor_words + Wsize_bsize (caml_young_end - caml_young_ptr); uintnat prowords = caml_stat_promoted_words; uintnat majwords = caml_stat_major_words + caml_allocated_words; #else double minwords = caml_stat_minor_words + (double) Wsize_bsize (caml_young_end - caml_young_ptr); double prowords = caml_stat_promoted_words; double majwords = caml_stat_major_words + (double) caml_allocated_words; #endif intnat mincoll = caml_stat_minor_collections; intnat majcoll = caml_stat_major_collections; intnat heap_words = caml_stat_heap_size / sizeof (value); intnat top_heap_words = caml_stat_top_heap_size / sizeof (value); intnat cpct = caml_stat_compactions; intnat heap_chunks = caml_stat_heap_chunks; res = caml_alloc_tuple (16); #ifdef _KERNEL Store_field (res, 0, Val_long (minwords)); Store_field (res, 1, Val_long (prowords)); Store_field (res, 2, Val_long (majwords)); #else Store_field (res, 0, caml_copy_double (minwords)); Store_field (res, 1, caml_copy_double (prowords)); Store_field (res, 2, caml_copy_double (majwords)); #endif Store_field (res, 3, Val_long (mincoll)); Store_field (res, 4, Val_long (majcoll)); Store_field (res, 5, Val_long (heap_words)); Store_field (res, 6, Val_long (heap_chunks)); Store_field (res, 7, Val_long (0)); Store_field (res, 8, Val_long (0)); Store_field (res, 9, Val_long (0)); Store_field (res, 10, Val_long (0)); Store_field (res, 11, Val_long (0)); Store_field (res, 12, Val_long (0)); Store_field (res, 13, Val_long (cpct)); Store_field (res, 14, Val_long (top_heap_words)); Store_field (res, 15, Val_long (caml_stack_usage())); CAMLreturn (res); }
/* Check the heap structure (if compiled in debug mode) and gather statistics; return the stats if [returnstats] is true, otherwise return [Val_unit]. */ static value heap_stats (int returnstats) { CAMLparam0 (); intnat live_words = 0, live_blocks = 0, free_words = 0, free_blocks = 0, largest_free = 0, fragments = 0, heap_chunks = 0; char *chunk = caml_heap_start, *chunk_end; header_t *cur_hp; #ifdef DEBUG header_t *prev_hp; #endif header_t cur_hd; #ifdef DEBUG caml_gc_message (-1, "### OCaml runtime: heap check ###\n", 0); #endif while (chunk != NULL){ ++ heap_chunks; chunk_end = chunk + Chunk_size (chunk); #ifdef DEBUG prev_hp = NULL; #endif cur_hp = (header_t *) chunk; while (cur_hp < (header_t *) chunk_end){ cur_hd = Hd_hp (cur_hp); Assert (Next (cur_hp) <= (header_t *) chunk_end); switch (Color_hd (cur_hd)){ case Caml_white: if (Wosize_hd (cur_hd) == 0){ ++ fragments; Assert (prev_hp == NULL || Color_hp (prev_hp) != Caml_blue || cur_hp == (header_t *) caml_gc_sweep_hp); }else{ if (caml_gc_phase == Phase_sweep && cur_hp >= (header_t *) caml_gc_sweep_hp){ ++ free_blocks; free_words += Whsize_hd (cur_hd); if (Whsize_hd (cur_hd) > largest_free){ largest_free = Whsize_hd (cur_hd); } }else{ ++ live_blocks; live_words += Whsize_hd (cur_hd); #ifdef DEBUG check_block (cur_hp); #endif } } break; case Caml_gray: case Caml_black: Assert (Wosize_hd (cur_hd) > 0); ++ live_blocks; live_words += Whsize_hd (cur_hd); #ifdef DEBUG check_block (cur_hp); #endif break; case Caml_blue: Assert (Wosize_hd (cur_hd) > 0); ++ free_blocks; free_words += Whsize_hd (cur_hd); if (Whsize_hd (cur_hd) > largest_free){ largest_free = Whsize_hd (cur_hd); } /* not true any more with big heap chunks Assert (prev_hp == NULL || (Color_hp (prev_hp) != Caml_blue && Wosize_hp (prev_hp) > 0) || cur_hp == caml_gc_sweep_hp); Assert (Next (cur_hp) == chunk_end || (Color_hp (Next (cur_hp)) != Caml_blue && Wosize_hp (Next (cur_hp)) > 0) || (Whsize_hd (cur_hd) + Wosize_hp (Next (cur_hp)) > Max_wosize) || Next (cur_hp) == caml_gc_sweep_hp); */ break; } #ifdef DEBUG prev_hp = cur_hp; #endif cur_hp = Next (cur_hp); } Assert (cur_hp == (header_t *) chunk_end); chunk = Chunk_next (chunk); } Assert (heap_chunks == caml_stat_heap_chunks); Assert (live_words + free_words + fragments == caml_stat_heap_wsz); if (returnstats){ CAMLlocal1 (res); /* get a copy of these before allocating anything... */ double minwords = caml_stat_minor_words + (double) (caml_young_alloc_end - caml_young_ptr); double prowords = caml_stat_promoted_words; double majwords = caml_stat_major_words + (double) caml_allocated_words; intnat mincoll = caml_stat_minor_collections; intnat majcoll = caml_stat_major_collections; intnat heap_words = caml_stat_heap_wsz; intnat cpct = caml_stat_compactions; intnat top_heap_words = caml_stat_top_heap_wsz; res = caml_alloc_tuple (16); Store_field (res, 0, caml_copy_double (minwords)); Store_field (res, 1, caml_copy_double (prowords)); Store_field (res, 2, caml_copy_double (majwords)); Store_field (res, 3, Val_long (mincoll)); Store_field (res, 4, Val_long (majcoll)); Store_field (res, 5, Val_long (heap_words)); Store_field (res, 6, Val_long (heap_chunks)); Store_field (res, 7, Val_long (live_words)); Store_field (res, 8, Val_long (live_blocks)); Store_field (res, 9, Val_long (free_words)); Store_field (res, 10, Val_long (free_blocks)); Store_field (res, 11, Val_long (largest_free)); Store_field (res, 12, Val_long (fragments)); Store_field (res, 13, Val_long (cpct)); Store_field (res, 14, Val_long (top_heap_words)); Store_field (res, 15, Val_long (caml_stack_usage())); CAMLreturn (res); }else{ CAMLreturn (Val_unit); } }