1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
/***********************************************************************/
/* */
/* Caml Special Light */
/* */
/* Damien Doligez, projet Para, INRIA Rocquencourt */
/* */
/* Copyright 1995 Institut National de Recherche en Informatique et */
/* Automatique. Distributed only by permission. */
/* */
/***********************************************************************/
/* $Id$ */
#include <string.h>
#include "config.h"
#include "fail.h"
#include "gc.h"
#include "gc_ctrl.h"
#include "major_gc.h"
#include "memory.h"
#include "minor_gc.h"
#include "misc.h"
#include "mlvalues.h"
#include "roots.h"
#include "signals.h"
asize_t minor_heap_size;
char *young_start = NULL, *young_end = NULL;
char *young_ptr = NULL, *young_limit = NULL;
static value **ref_table = NULL, **ref_table_end, **ref_table_threshold;
value **ref_table_ptr = NULL, **ref_table_limit;
static asize_t ref_table_size, ref_table_reserve;
int in_minor_collection = 0;
void set_minor_heap_size (size)
asize_t size;
{
char *new_heap;
value **new_table;
Assert (size >= Minor_heap_min);
Assert (size <= Minor_heap_max);
Assert (size % sizeof (value) == 0);
if (young_ptr != young_end) minor_collection ();
Assert (young_ptr == young_end);
new_heap = (char *) stat_alloc (size);
if (young_start != NULL){
stat_free ((char *) young_start);
}
young_start = new_heap;
young_end = new_heap + size;
young_limit = young_start;
young_ptr = young_end;
minor_heap_size = size;
ref_table_size = minor_heap_size / sizeof (value) / 8;
ref_table_reserve = 256;
new_table = (value **) stat_alloc ((ref_table_size + ref_table_reserve)
* sizeof (value *));
if (ref_table != NULL) stat_free ((char *) ref_table);
ref_table = new_table;
ref_table_ptr = ref_table;
ref_table_threshold = ref_table + ref_table_size;
ref_table_limit = ref_table_threshold;
ref_table_end = ref_table + ref_table_size + ref_table_reserve;
}
void oldify (v, p)
value *p;
value v;
{
value result, field0;
header_t hd;
mlsize_t sz, i;
int tag;
tail_call:
if (Is_block (v) && Is_young (v)){
Assert (Hp_val (v) >= young_ptr);
hd = Hd_val (v);
tag = Tag_hd (hd);
if (Is_blue_hd (hd)){ /* Already forwarded ? */
*p = Field (v, 0); /* Then the forward pointer is the first field. */
}else if (tag == Infix_tag) {
mlsize_t offset = Infix_offset_hd (hd);
oldify(v - offset, p);
*p += offset;
}else if (tag >= No_scan_tag){
sz = Wosize_hd (hd);
result = alloc_shr (sz, tag);
for (i = 0; i < sz; i++) Field(result, i) = Field(v, i);
Hd_val (v) = Bluehd_hd (hd); /* Put the forward flag. */
Field (v, 0) = result; /* And the forward pointer. */
*p = result;
}else{
/* We can do recursive calls before all the fields are filled, because
we will not be calling the major GC. */
sz = Wosize_hd (hd);
result = alloc_shr (sz, tag);
*p = result;
field0 = Field (v, 0);
Hd_val (v) = Bluehd_hd (hd); /* Put the forward flag. */
Field (v, 0) = result; /* And the forward pointer. */
if (sz == 1) {
p = &Field (result, 0);
v = field0;
goto tail_call;
} else {
oldify (field0, &Field (result, 0));
for (i = 1; i < sz - 1; i++){
oldify (Field(v, i), &Field (result, i));
}
p = &Field (result, i);
v = Field (v, i);
goto tail_call;
}
}
}else{
*p = v;
}
}
void minor_collection ()
{
value **r;
long prev_alloc_words = allocated_words;
in_minor_collection = 1;
gc_message ("<", 0);
oldify_local_roots();
for (r = ref_table; r < ref_table_ptr; r++) oldify (**r, *r);
stat_minor_words += Wsize_bsize (young_end - young_ptr);
young_ptr = young_end;
ref_table_ptr = ref_table;
ref_table_limit = ref_table_threshold;
gc_message (">", 0);
in_minor_collection = 0;
stat_promoted_words += allocated_words - prev_alloc_words;
++ stat_minor_collections;
major_collection_slice ();
force_major_slice = 0;
}
void realloc_ref_table ()
{ Assert (ref_table_ptr == ref_table_limit);
Assert (ref_table_limit <= ref_table_end);
Assert (ref_table_limit >= ref_table_threshold);
if (ref_table_limit == ref_table_threshold){
gc_message ("ref_table threshold crossed\n", 0);
ref_table_limit = ref_table_end;
urge_major_slice ();
}else{ /* This will almost never happen with the bytecode interpreter. */
asize_t sz;
asize_t cur_ptr = ref_table_ptr - ref_table;
Assert (force_major_slice);
ref_table_size *= 2;
sz = (ref_table_size + ref_table_reserve) * sizeof (value *);
gc_message ("Growing ref_table to %ldk\n", (long) sz / 1024);
ref_table = (value **) realloc ((char *) ref_table, sz);
if (ref_table == NULL) fatal_error ("Fatal error: ref_table overflow\n");
ref_table_end = ref_table + ref_table_size + ref_table_reserve;
ref_table_threshold = ref_table + ref_table_size;
ref_table_ptr = ref_table + cur_ptr;
ref_table_limit = ref_table_end;
}
}
|
