1995-08-09 08:06:35 -07:00
|
|
|
/***********************************************************************/
|
|
|
|
/* */
|
1996-04-30 07:53:58 -07:00
|
|
|
/* Objective Caml */
|
1995-08-09 08:06:35 -07:00
|
|
|
/* */
|
|
|
|
/* Damien Doligez, projet Para, INRIA Rocquencourt */
|
|
|
|
/* */
|
1996-04-30 07:53:58 -07:00
|
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
1999-11-17 10:59:06 -08:00
|
|
|
/* en Automatique. All rights reserved. This file is distributed */
|
2001-12-07 05:41:02 -08:00
|
|
|
/* under the terms of the GNU Library General Public License, with */
|
|
|
|
/* the special exception on linking described in file ../LICENSE. */
|
1995-08-09 08:06:35 -07:00
|
|
|
/* */
|
|
|
|
/***********************************************************************/
|
|
|
|
|
|
|
|
/* $Id$ */
|
|
|
|
|
1998-10-07 12:01:42 -07:00
|
|
|
#include <limits.h>
|
|
|
|
|
1997-05-13 07:45:38 -07:00
|
|
|
#include "compact.h"
|
2000-02-10 06:04:59 -08:00
|
|
|
#include "custom.h"
|
1995-05-04 03:15:53 -07:00
|
|
|
#include "config.h"
|
|
|
|
#include "fail.h"
|
2000-01-07 08:51:58 -08:00
|
|
|
#include "finalise.h"
|
1995-05-04 03:15:53 -07:00
|
|
|
#include "freelist.h"
|
|
|
|
#include "gc.h"
|
|
|
|
#include "gc_ctrl.h"
|
|
|
|
#include "major_gc.h"
|
|
|
|
#include "misc.h"
|
|
|
|
#include "mlvalues.h"
|
|
|
|
#include "roots.h"
|
1997-02-24 11:24:39 -08:00
|
|
|
#include "weak.h"
|
1995-05-04 03:15:53 -07:00
|
|
|
|
1997-05-21 08:28:15 -07:00
|
|
|
unsigned long percent_free;
|
1995-05-04 03:15:53 -07:00
|
|
|
long major_heap_increment;
|
|
|
|
char *heap_start, *heap_end;
|
1995-07-24 05:46:59 -07:00
|
|
|
page_table_entry *page_table;
|
1998-08-07 11:43:39 -07:00
|
|
|
asize_t page_low, page_high;
|
1995-05-04 03:15:53 -07:00
|
|
|
char *gc_sweep_hp;
|
2002-02-05 09:11:33 -08:00
|
|
|
int gc_phase; /* always Phase_mark, Phase_sweep, or Phase_idle */
|
1995-05-04 03:15:53 -07:00
|
|
|
static value *gray_vals;
|
|
|
|
value *gray_vals_cur, *gray_vals_end;
|
|
|
|
static asize_t gray_vals_size;
|
|
|
|
static int heap_is_pure; /* The heap is pure if the only gray objects
|
|
|
|
below [markhp] are also in [gray_vals]. */
|
|
|
|
unsigned long allocated_words;
|
1998-08-07 11:43:39 -07:00
|
|
|
double extra_heap_memory;
|
2002-05-28 09:57:31 -07:00
|
|
|
unsigned long fl_size_at_phase_change = 0;
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
extern char *fl_merge; /* Defined in freelist.c. */
|
|
|
|
|
|
|
|
static char *markhp, *chunk, *limit;
|
|
|
|
|
2002-02-05 09:11:33 -08:00
|
|
|
static int gc_subphase; /* Subphase_main, Subphase_weak, Subphase_final */
|
|
|
|
#define Subphase_main 10
|
|
|
|
#define Subphase_weak 11
|
|
|
|
#define Subphase_final 12
|
|
|
|
static value *weak_prev;
|
1997-02-24 11:24:39 -08:00
|
|
|
|
1997-09-02 05:55:01 -07:00
|
|
|
static void realloc_gray_vals (void)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
|
|
|
value *new;
|
|
|
|
|
|
|
|
Assert (gray_vals_cur == gray_vals_end);
|
|
|
|
if (gray_vals_size < stat_heap_size / 128){
|
1998-08-07 11:43:39 -07:00
|
|
|
gc_message (0x08, "Growing gray_vals to %luk bytes\n",
|
1997-05-19 08:42:21 -07:00
|
|
|
(long) gray_vals_size * sizeof (value) / 512);
|
1995-05-04 03:15:53 -07:00
|
|
|
new = (value *) realloc ((char *) gray_vals,
|
|
|
|
2 * gray_vals_size * sizeof (value));
|
|
|
|
if (new == NULL){
|
1998-08-07 11:43:39 -07:00
|
|
|
gc_message (0x08, "No room for growing gray_vals\n", 0);
|
1995-05-04 03:15:53 -07:00
|
|
|
gray_vals_cur = gray_vals;
|
|
|
|
heap_is_pure = 0;
|
|
|
|
}else{
|
|
|
|
gray_vals = new;
|
|
|
|
gray_vals_cur = gray_vals + gray_vals_size;
|
|
|
|
gray_vals_size *= 2;
|
|
|
|
gray_vals_end = gray_vals + gray_vals_size;
|
|
|
|
}
|
|
|
|
}else{
|
|
|
|
gray_vals_cur = gray_vals + gray_vals_size / 2;
|
|
|
|
heap_is_pure = 0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
1998-08-07 11:43:39 -07:00
|
|
|
void darken (value v, value *p /* not used */)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
1995-07-10 02:48:27 -07:00
|
|
|
if (Is_block (v) && Is_in_heap (v)) {
|
|
|
|
if (Tag_val(v) == Infix_tag) v -= Infix_offset_val(v);
|
|
|
|
if (Is_white_val (v)){
|
|
|
|
Hd_val (v) = Grayhd_hd (Hd_val (v));
|
|
|
|
*gray_vals_cur++ = v;
|
|
|
|
if (gray_vals_cur >= gray_vals_end) realloc_gray_vals ();
|
|
|
|
}
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
1997-09-02 05:55:01 -07:00
|
|
|
static void start_cycle (void)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
1997-05-13 07:45:38 -07:00
|
|
|
Assert (gc_phase == Phase_idle);
|
1995-05-04 03:15:53 -07:00
|
|
|
Assert (gray_vals_cur == gray_vals);
|
1998-08-07 11:43:39 -07:00
|
|
|
gc_message (0x01, "Starting new major GC cycle\n", 0);
|
1995-07-10 02:48:27 -07:00
|
|
|
darken_all_roots();
|
1995-05-04 03:15:53 -07:00
|
|
|
gc_phase = Phase_mark;
|
2002-02-05 09:11:33 -08:00
|
|
|
gc_subphase = Subphase_main;
|
1995-05-04 03:15:53 -07:00
|
|
|
markhp = NULL;
|
1999-11-08 09:05:45 -08:00
|
|
|
#ifdef DEBUG
|
|
|
|
heap_check ();
|
|
|
|
#endif
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
1998-08-07 11:43:39 -07:00
|
|
|
static void mark_slice (long work)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
1997-05-13 07:45:38 -07:00
|
|
|
value *gray_vals_ptr; /* Local copy of gray_vals_cur */
|
1995-05-04 03:15:53 -07:00
|
|
|
value v, child;
|
1995-07-17 09:11:08 -07:00
|
|
|
header_t hd;
|
|
|
|
mlsize_t size, i;
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2002-02-05 09:11:33 -08:00
|
|
|
gc_message (0x40, "Marking %ld words\n", work);
|
1995-07-24 05:46:59 -07:00
|
|
|
gray_vals_ptr = gray_vals_cur;
|
1995-05-04 03:15:53 -07:00
|
|
|
while (work > 0){
|
1995-07-24 05:46:59 -07:00
|
|
|
if (gray_vals_ptr > gray_vals){
|
|
|
|
v = *--gray_vals_ptr;
|
1995-07-17 09:11:08 -07:00
|
|
|
hd = Hd_val(v);
|
|
|
|
Assert (Is_gray_hd (hd));
|
|
|
|
Hd_val (v) = Blackhd_hd (hd);
|
2002-09-18 06:59:27 -07:00
|
|
|
size = Wosize_hd (hd);
|
1995-07-17 09:11:08 -07:00
|
|
|
if (Tag_hd (hd) < No_scan_tag){
|
1997-05-19 08:42:21 -07:00
|
|
|
for (i = 0; i < size; i++){
|
|
|
|
child = Field (v, i);
|
1995-07-17 09:11:08 -07:00
|
|
|
if (Is_block (child) && Is_in_heap (child)) {
|
2002-09-18 06:59:27 -07:00
|
|
|
hd = Hd_val (child);
|
2002-01-20 09:39:10 -08:00
|
|
|
if (Tag_hd (hd) == Forward_tag){
|
2002-09-18 06:59:27 -07:00
|
|
|
value f = Forward_val (child);
|
|
|
|
if (Is_block (f) && (Is_young (f) || Is_in_heap (f))
|
|
|
|
&& (Tag_val (f) == Forward_tag || Tag_val (f) == Lazy_tag)){
|
|
|
|
/* Do not short-circuit the pointer. */
|
|
|
|
}else{
|
|
|
|
Field (v, i) = f;
|
|
|
|
}
|
2002-01-20 09:39:10 -08:00
|
|
|
}
|
2002-07-30 06:02:31 -07:00
|
|
|
else if (Tag_hd(hd) == Infix_tag) {
|
1995-07-17 09:11:08 -07:00
|
|
|
child -= Infix_offset_val(child);
|
|
|
|
hd = Hd_val(child);
|
|
|
|
}
|
|
|
|
if (Is_white_hd (hd)){
|
|
|
|
Hd_val (child) = Grayhd_hd (hd);
|
1995-07-24 05:46:59 -07:00
|
|
|
*gray_vals_ptr++ = child;
|
|
|
|
if (gray_vals_ptr >= gray_vals_end) {
|
|
|
|
gray_vals_cur = gray_vals_ptr;
|
|
|
|
realloc_gray_vals ();
|
|
|
|
gray_vals_ptr = gray_vals_cur;
|
|
|
|
}
|
1995-07-17 09:11:08 -07:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
1995-07-17 09:11:08 -07:00
|
|
|
work -= Whsize_wosize(size);
|
1995-05-04 03:15:53 -07:00
|
|
|
}else if (markhp != NULL){
|
|
|
|
if (markhp == limit){
|
1997-05-19 08:42:21 -07:00
|
|
|
chunk = Chunk_next (chunk);
|
|
|
|
if (chunk == NULL){
|
|
|
|
markhp = NULL;
|
|
|
|
}else{
|
|
|
|
markhp = chunk;
|
|
|
|
limit = chunk + Chunk_size (chunk);
|
|
|
|
}
|
1995-05-04 03:15:53 -07:00
|
|
|
}else{
|
1997-05-19 08:42:21 -07:00
|
|
|
if (Is_gray_val (Val_hp (markhp))){
|
|
|
|
Assert (gray_vals_ptr == gray_vals);
|
|
|
|
*gray_vals_ptr++ = Val_hp (markhp);
|
|
|
|
}
|
|
|
|
markhp += Bhsize_hp (markhp);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
}else if (!heap_is_pure){
|
|
|
|
heap_is_pure = 1;
|
|
|
|
chunk = heap_start;
|
|
|
|
markhp = chunk;
|
1997-05-13 07:45:38 -07:00
|
|
|
limit = chunk + Chunk_size (chunk);
|
2002-02-05 09:11:33 -08:00
|
|
|
}else if (gc_subphase == Subphase_main){
|
|
|
|
/* The main marking phase is over. Start removing weak pointers to
|
|
|
|
dead values. */
|
|
|
|
gc_subphase = Subphase_weak;
|
|
|
|
weak_prev = &weak_list_head;
|
|
|
|
}else if (gc_subphase == Subphase_weak){
|
|
|
|
value cur, curfield;
|
|
|
|
mlsize_t sz, i;
|
|
|
|
header_t hd;
|
2000-01-07 08:51:58 -08:00
|
|
|
|
2002-02-05 09:11:33 -08:00
|
|
|
cur = *weak_prev;
|
2002-02-19 06:37:44 -08:00
|
|
|
if (cur != (value) NULL){
|
2002-02-05 09:11:33 -08:00
|
|
|
hd = Hd_val (cur);
|
|
|
|
if (Color_hd (hd) == Caml_white){
|
|
|
|
/* The whole array is dead, remove it from the list. */
|
|
|
|
*weak_prev = Field (cur, 0);
|
|
|
|
}else{
|
|
|
|
sz = Wosize_hd (hd);
|
|
|
|
for (i = 1; i < sz; i++){
|
|
|
|
curfield = Field (cur, i);
|
2002-07-30 07:00:36 -07:00
|
|
|
weak_again:
|
2002-07-30 06:02:31 -07:00
|
|
|
if (curfield != 0 && Is_block (curfield) && Is_in_heap (curfield)){
|
2002-02-05 09:11:33 -08:00
|
|
|
if (Tag_val (curfield) == Forward_tag){
|
2002-09-18 06:59:27 -07:00
|
|
|
value f = Forward_val (curfield);
|
|
|
|
if (Is_block (f) && (Is_young (f) || Is_in_heap (f))){
|
|
|
|
if (Tag_val (f) == Forward_tag || Tag_val (f) == Lazy_tag){
|
|
|
|
/* Do not short-circuit the pointer. */
|
|
|
|
}else{
|
|
|
|
Field (cur, i) = curfield = f;
|
|
|
|
goto weak_again;
|
|
|
|
}
|
2002-09-17 06:45:33 -07:00
|
|
|
}
|
2002-07-30 06:02:31 -07:00
|
|
|
}
|
2002-07-30 07:00:36 -07:00
|
|
|
if (Is_white_val (curfield)){
|
2002-07-30 06:02:31 -07:00
|
|
|
Field (cur, i) = 0;
|
2002-02-05 09:11:33 -08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
weak_prev = &Field (cur, 0);
|
|
|
|
}
|
|
|
|
work -= Whsize_hd (hd);
|
|
|
|
}else{
|
|
|
|
/* Subphase_weak is done. Handle finalised values. */
|
|
|
|
gray_vals_cur = gray_vals_ptr;
|
|
|
|
final_update ();
|
|
|
|
gray_vals_ptr = gray_vals_cur;
|
|
|
|
gc_subphase = Subphase_final;
|
|
|
|
}
|
|
|
|
}else{
|
|
|
|
Assert (gc_subphase == Subphase_final);
|
1997-02-24 11:24:39 -08:00
|
|
|
/* Initialise the sweep phase. */
|
1995-07-24 05:46:59 -07:00
|
|
|
gray_vals_cur = gray_vals_ptr;
|
1995-05-04 03:15:53 -07:00
|
|
|
gc_sweep_hp = heap_start;
|
|
|
|
fl_init_merge ();
|
|
|
|
gc_phase = Phase_sweep;
|
|
|
|
chunk = heap_start;
|
|
|
|
gc_sweep_hp = chunk;
|
1997-05-13 07:45:38 -07:00
|
|
|
limit = chunk + Chunk_size (chunk);
|
1995-05-04 03:15:53 -07:00
|
|
|
work = 0;
|
2002-05-28 09:57:31 -07:00
|
|
|
fl_size_at_phase_change = fl_cur_size;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
}
|
1995-07-24 05:46:59 -07:00
|
|
|
gray_vals_cur = gray_vals_ptr;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2002-02-05 09:11:33 -08:00
|
|
|
static void sweep_slice (long work)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
|
|
|
char *hp;
|
|
|
|
header_t hd;
|
|
|
|
|
2002-02-05 09:11:33 -08:00
|
|
|
gc_message (0x40, "Sweeping %ld words\n", work);
|
1995-05-04 03:15:53 -07:00
|
|
|
while (work > 0){
|
|
|
|
if (gc_sweep_hp < limit){
|
|
|
|
hp = gc_sweep_hp;
|
|
|
|
hd = Hd_hp (hp);
|
|
|
|
work -= Whsize_hd (hd);
|
|
|
|
gc_sweep_hp += Bhsize_hd (hd);
|
|
|
|
switch (Color_hd (hd)){
|
2000-01-02 08:10:00 -08:00
|
|
|
case Caml_white:
|
2000-02-10 06:04:59 -08:00
|
|
|
if (Tag_hd (hd) == Custom_tag){
|
2000-02-11 04:03:31 -08:00
|
|
|
void (*final_fun)(value) = Custom_ops_val(Val_hp(hp))->finalize;
|
2000-02-10 06:04:59 -08:00
|
|
|
if (final_fun != NULL) final_fun(Val_hp(hp));
|
1997-05-19 08:42:21 -07:00
|
|
|
}
|
|
|
|
gc_sweep_hp = fl_merge_block (Bp_hp (hp));
|
|
|
|
break;
|
2000-01-02 08:10:00 -08:00
|
|
|
case Caml_blue:
|
1997-05-19 08:42:21 -07:00
|
|
|
/* Only the blocks of the free-list are blue. See [freelist.c]. */
|
|
|
|
fl_merge = Bp_hp (hp);
|
|
|
|
break;
|
2000-01-02 08:10:00 -08:00
|
|
|
default: /* gray or black */
|
|
|
|
Assert (Color_hd (hd) == Caml_black);
|
1997-05-19 08:42:21 -07:00
|
|
|
Hd_hp (hp) = Whitehd_hd (hd);
|
|
|
|
break;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
Assert (gc_sweep_hp <= limit);
|
|
|
|
}else{
|
1997-05-13 07:45:38 -07:00
|
|
|
chunk = Chunk_next (chunk);
|
1995-05-04 03:15:53 -07:00
|
|
|
if (chunk == NULL){
|
1997-05-19 08:42:21 -07:00
|
|
|
/* Sweeping is done. */
|
1995-05-04 03:15:53 -07:00
|
|
|
++ stat_major_collections;
|
1997-05-13 07:45:38 -07:00
|
|
|
work = 0;
|
|
|
|
gc_phase = Phase_idle;
|
1995-05-04 03:15:53 -07:00
|
|
|
}else{
|
1997-05-19 08:42:21 -07:00
|
|
|
gc_sweep_hp = chunk;
|
|
|
|
limit = chunk + Chunk_size (chunk);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2002-02-05 09:11:33 -08:00
|
|
|
/* The main entry point for the GC. Called after each minor GC.
|
|
|
|
[howmuch] is the amount of work to do, 0 to let the GC compute it.
|
|
|
|
Return the computed amount of work to do.
|
|
|
|
*/
|
|
|
|
long major_collection_slice (long howmuch)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
1998-08-07 11:43:39 -07:00
|
|
|
double p;
|
2002-02-05 09:11:33 -08:00
|
|
|
long computed_work;
|
2000-01-07 08:51:58 -08:00
|
|
|
/*
|
1997-05-21 08:28:15 -07:00
|
|
|
Free memory at the start of the GC cycle (garbage + free list) (assumed):
|
|
|
|
FM = stat_heap_size * percent_free / (100 + percent_free)
|
2002-06-05 05:11:15 -07:00
|
|
|
|
|
|
|
Assuming steady state and enforcing a constant allocation rate, then
|
|
|
|
FM is divided in 2/3 for garbage and 1/3 for free list.
|
|
|
|
G = 2 * FM / 3
|
|
|
|
G is also the amount of memory that will be used during this slice
|
|
|
|
(still assuming steady state).
|
|
|
|
|
|
|
|
Proportion of G consumed since the previous slice:
|
|
|
|
PH = allocated_words / G
|
|
|
|
= allocated_words * 3 * (100 + percent_free)
|
|
|
|
/ (2 * stat_heap_size * percent_free)
|
1995-05-04 03:15:53 -07:00
|
|
|
Proportion of extra-heap memory consumed since the previous slice:
|
1998-08-07 11:43:39 -07:00
|
|
|
PE = extra_heap_memory
|
1995-05-04 03:15:53 -07:00
|
|
|
Proportion of total work to do in this slice:
|
1998-08-07 11:43:39 -07:00
|
|
|
P = max (PH, PE)
|
1995-05-04 03:15:53 -07:00
|
|
|
Amount of marking work for the GC cycle:
|
1997-05-21 08:28:15 -07:00
|
|
|
MW = stat_heap_size * 100 / (100 + percent_free)
|
1995-05-04 03:15:53 -07:00
|
|
|
Amount of sweeping work for the GC cycle:
|
|
|
|
SW = stat_heap_size
|
|
|
|
Amount of marking work for this slice:
|
1998-08-07 11:43:39 -07:00
|
|
|
MS = P * MW
|
|
|
|
MS = P * stat_heap_size * 100 / (100 + percent_free)
|
1995-05-04 03:15:53 -07:00
|
|
|
Amount of sweeping work for this slice:
|
1998-08-07 11:43:39 -07:00
|
|
|
SS = P * SW
|
|
|
|
SS = P * stat_heap_size
|
1997-05-03 11:33:16 -07:00
|
|
|
This slice will either mark 2*MS words or sweep 2*SS words.
|
1995-05-04 03:15:53 -07:00
|
|
|
*/
|
|
|
|
|
1997-05-13 07:45:38 -07:00
|
|
|
if (gc_phase == Phase_idle) start_cycle ();
|
|
|
|
|
2002-06-05 05:11:15 -07:00
|
|
|
p = (double) allocated_words * 3.0 * (100 + percent_free)
|
|
|
|
/ Wsize_bsize (stat_heap_size) / percent_free / 2.0;
|
1998-08-07 11:43:39 -07:00
|
|
|
if (p < extra_heap_memory) p = extra_heap_memory;
|
|
|
|
|
|
|
|
gc_message (0x40, "allocated_words = %lu\n", allocated_words);
|
|
|
|
gc_message (0x40, "extra_heap_memory = %luu\n",
|
|
|
|
(unsigned long) (extra_heap_memory * 1000000));
|
|
|
|
gc_message (0x40, "amount of work to do = %luu\n",
|
|
|
|
(unsigned long) (p * 1000000));
|
|
|
|
|
2002-02-05 09:11:33 -08:00
|
|
|
if (gc_phase == Phase_mark){
|
2002-05-28 09:57:31 -07:00
|
|
|
computed_work = 2 * (long) (p * Wsize_bsize (stat_heap_size) * 100
|
|
|
|
/ (100+percent_free));
|
2002-02-05 09:11:33 -08:00
|
|
|
}else{
|
2002-05-28 09:57:31 -07:00
|
|
|
computed_work = 2 * (long) (p * Wsize_bsize (stat_heap_size));
|
2002-02-05 09:11:33 -08:00
|
|
|
}
|
|
|
|
gc_message (0x40, "ordered work = %ld words\n", howmuch);
|
|
|
|
gc_message (0x40, "computed work = %ld words\n", computed_work);
|
|
|
|
if (howmuch == 0) howmuch = computed_work;
|
|
|
|
if (gc_phase == Phase_mark){
|
|
|
|
mark_slice (howmuch);
|
1998-08-07 11:43:39 -07:00
|
|
|
gc_message (0x02, "!", 0);
|
1995-05-04 03:15:53 -07:00
|
|
|
}else{
|
|
|
|
Assert (gc_phase == Phase_sweep);
|
2002-02-05 09:11:33 -08:00
|
|
|
sweep_slice (howmuch);
|
1998-08-07 11:43:39 -07:00
|
|
|
gc_message (0x02, "$", 0);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
1997-05-13 07:45:38 -07:00
|
|
|
|
|
|
|
if (gc_phase == Phase_idle) compact_heap_maybe ();
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
stat_major_words += allocated_words;
|
|
|
|
allocated_words = 0;
|
1998-08-07 11:43:39 -07:00
|
|
|
extra_heap_memory = 0.0;
|
2002-02-05 09:11:33 -08:00
|
|
|
return computed_work;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2000-01-07 08:51:58 -08:00
|
|
|
/* The minor heap must be empty when this function is called;
|
|
|
|
the minor heap is empty when this function returns.
|
|
|
|
*/
|
1997-05-13 07:45:38 -07:00
|
|
|
/* This does not call compact_heap_maybe because the estimations of
|
|
|
|
free and live memory are only valid for a cycle done incrementally.
|
|
|
|
Besides, this function is called by compact_heap_maybe.
|
|
|
|
*/
|
1997-09-02 05:55:01 -07:00
|
|
|
void finish_major_cycle (void)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
1997-05-13 07:45:38 -07:00
|
|
|
if (gc_phase == Phase_idle) start_cycle ();
|
2002-02-05 09:11:33 -08:00
|
|
|
while (gc_phase == Phase_mark) mark_slice (LONG_MAX);
|
1995-05-04 03:15:53 -07:00
|
|
|
Assert (gc_phase == Phase_sweep);
|
2002-02-05 09:11:33 -08:00
|
|
|
while (gc_phase == Phase_sweep) sweep_slice (LONG_MAX);
|
1997-05-13 07:45:38 -07:00
|
|
|
Assert (gc_phase == Phase_idle);
|
1995-05-04 03:15:53 -07:00
|
|
|
stat_major_words += allocated_words;
|
|
|
|
allocated_words = 0;
|
|
|
|
}
|
|
|
|
|
2002-05-16 08:06:31 -07:00
|
|
|
/* Clip the request to [Heap_chunk_min..Heap_chunk_max] and round it
|
|
|
|
to a multiple of the page size.
|
|
|
|
*/
|
|
|
|
static asize_t clip_heap_chunk_size (asize_t request)
|
|
|
|
{ Assert (Heap_chunk_max >= Heap_chunk_min);
|
2002-11-15 08:15:19 -08:00
|
|
|
if (request < Bsize_wsize (Heap_chunk_min)){
|
|
|
|
request = Bsize_wsize (Heap_chunk_min);
|
2002-05-16 08:06:31 -07:00
|
|
|
}
|
2002-11-15 08:15:19 -08:00
|
|
|
if (request > Bsize_wsize (Heap_chunk_max)){
|
|
|
|
request = Bsize_wsize (Heap_chunk_max);
|
2002-05-16 08:06:31 -07:00
|
|
|
}
|
|
|
|
return ((request + Page_size - 1) >> Page_log) << Page_log;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Make sure the request is >= major_heap_increment, then call
|
|
|
|
clip_heap_chunk_size, then make sure the result is >= request.
|
|
|
|
*/
|
1997-09-02 05:55:01 -07:00
|
|
|
asize_t round_heap_chunk_size (asize_t request)
|
2002-05-16 08:06:31 -07:00
|
|
|
{
|
|
|
|
asize_t result = request;
|
|
|
|
|
|
|
|
if (result < major_heap_increment){
|
|
|
|
result = major_heap_increment;
|
|
|
|
}
|
|
|
|
result = clip_heap_chunk_size (result);
|
|
|
|
|
|
|
|
if (result < request){
|
1995-05-04 03:15:53 -07:00
|
|
|
raise_out_of_memory ();
|
2002-05-16 08:06:31 -07:00
|
|
|
return 0; /* not reached */
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
2002-05-16 08:06:31 -07:00
|
|
|
return result;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
1997-09-02 05:55:01 -07:00
|
|
|
void init_major_heap (asize_t heap_size)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
|
|
|
asize_t i;
|
1997-05-13 07:45:38 -07:00
|
|
|
void *block;
|
1998-08-07 11:43:39 -07:00
|
|
|
asize_t page_table_size;
|
|
|
|
page_table_entry *page_table_block;
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2002-05-16 08:06:31 -07:00
|
|
|
stat_heap_size = clip_heap_chunk_size (heap_size);
|
2002-02-01 04:23:58 -08:00
|
|
|
stat_top_heap_size = stat_heap_size;
|
1995-05-04 03:15:53 -07:00
|
|
|
Assert (stat_heap_size % Page_size == 0);
|
2002-06-03 07:21:50 -07:00
|
|
|
heap_start = (char *) alloc_for_heap (stat_heap_size);
|
1995-05-04 03:15:53 -07:00
|
|
|
if (heap_start == NULL)
|
|
|
|
fatal_error ("Fatal error: not enough memory for the initial heap.\n");
|
1997-05-13 07:45:38 -07:00
|
|
|
Chunk_next (heap_start) = NULL;
|
1995-05-04 03:15:53 -07:00
|
|
|
heap_end = heap_start + stat_heap_size;
|
|
|
|
Assert ((unsigned long) heap_end % Page_size == 0);
|
1998-08-07 11:43:39 -07:00
|
|
|
|
2002-05-28 09:57:31 -07:00
|
|
|
stat_heap_chunks = 1;
|
|
|
|
|
1998-08-07 11:43:39 -07:00
|
|
|
page_low = Page (heap_start);
|
|
|
|
page_high = Page (heap_end);
|
|
|
|
|
|
|
|
page_table_size = page_high - page_low;
|
2000-01-07 08:51:58 -08:00
|
|
|
page_table_block =
|
1998-08-07 11:43:39 -07:00
|
|
|
(page_table_entry *) malloc (page_table_size * sizeof (page_table_entry));
|
|
|
|
if (page_table_block == NULL){
|
1995-05-04 03:15:53 -07:00
|
|
|
fatal_error ("Fatal error: not enough memory for the initial heap.\n");
|
|
|
|
}
|
1998-08-07 11:43:39 -07:00
|
|
|
page_table = page_table_block - page_low;
|
1995-05-04 03:15:53 -07:00
|
|
|
for (i = Page (heap_start); i < Page (heap_end); i++){
|
|
|
|
page_table [i] = In_heap;
|
|
|
|
}
|
1998-08-07 11:43:39 -07:00
|
|
|
|
2001-10-09 07:35:20 -07:00
|
|
|
Hd_hp (heap_start) = Make_header (Wosize_bhsize(stat_heap_size),0,Caml_blue);
|
1995-05-04 03:15:53 -07:00
|
|
|
fl_init_merge ();
|
|
|
|
fl_merge_block (Bp_hp (heap_start));
|
1997-05-13 07:45:38 -07:00
|
|
|
gc_phase = Phase_idle;
|
1995-05-04 03:15:53 -07:00
|
|
|
gray_vals_size = 2048;
|
|
|
|
gray_vals = (value *) malloc (gray_vals_size * sizeof (value));
|
1995-08-08 06:37:34 -07:00
|
|
|
if (gray_vals == NULL)
|
|
|
|
fatal_error ("Fatal error: not enough memory for the initial heap.\n");
|
1995-05-04 03:15:53 -07:00
|
|
|
gray_vals_cur = gray_vals;
|
|
|
|
gray_vals_end = gray_vals + gray_vals_size;
|
|
|
|
heap_is_pure = 1;
|
|
|
|
allocated_words = 0;
|
1998-08-07 11:43:39 -07:00
|
|
|
extra_heap_memory = 0.0;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|