Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Nettoyages dans l'espoir d'aller un poil plus vite. 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@111 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 1995-07-17 16:11:08 +00:00
parent 7005c1670d
commit 3e935fb501
2 changed files with 42 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
byterun/major_gc.c
View File

@ -87,21 +87,34 @@ static void mark_slice (work)
long work;
{
value v, child;
mlsize_t i;
header_t hd;
mlsize_t size, i;
while (work > 0){
if (gray_vals_cur > gray_vals){
v = *--gray_vals_cur;
Assert (Is_gray_val (v));
Hd_val (v) = Blackhd_hd (Hd_val (v));
if (Tag_val (v) < No_scan_tag){
for (i = Wosize_val (v); i > 0;){
--i;
hd = Hd_val(v);
Assert (Is_gray_hd (hd));
Hd_val (v) = Blackhd_hd (hd);
size = Wosize_hd(hd);
if (Tag_hd (hd) < No_scan_tag){
for (i = 0; i < size; i++){
child = Field (v, i);
darken (child);
}
if (Is_block (child) && Is_in_heap (child)) {
hd = Hd_val(child);
if (Tag_hd(hd) == Infix_tag) {
child -= Infix_offset_val(child);
hd = Hd_val(child);
}
if (Is_white_hd (hd)){
Hd_val (child) = Grayhd_hd (hd);
*gray_vals_cur++ = child;
if (gray_vals_cur >= gray_vals_end) realloc_gray_vals ();
}
}
}
}
work -= Whsize_val (v);
work -= Whsize_wosize(size);
}else if (markhp != NULL){
if (markhp == limit){
chunk = (((heap_chunk_head *) chunk) [-1]).next;

36
byterun/minor_gc.c
View File

@ -52,39 +52,43 @@ void oldify (p, v)
value *p;
value v;
{
value result;
mlsize_t i;
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);
if (Is_blue_val (v)){ /* Already forwarded ? */
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_val(v) == Infix_tag) {
mlsize_t offset = Infix_offset_val(v);
}else if (tag == Infix_tag) {
mlsize_t offset = Infix_offset_hd (hd);
oldify(p, v - offset);
*p += offset;
}else if (Tag_val (v) >= No_scan_tag){
result = alloc_shr (Wosize_val (v), Tag_val (v));
bcopy (Bp_val (v), Bp_val (result), Bosize_val (v));
Hd_val (v) = Bluehd_hd (Hd_val (v)); /* Put the forward flag. */
}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. */
value field0 = Field (v, 0);
mlsize_t sz = Wosize_val (v);
result = alloc_shr (sz, Tag_val (v));
sz = Wosize_hd (hd);
result = alloc_shr (sz, tag);
*p = result;
Hd_val (v) = Bluehd_hd (Hd_val (v)); /* Put the forward flag. */
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){
if (sz == 1) {
p = &Field (result, 0);
v = field0;
goto tail_call;
}else{
} else {
oldify (&Field (result, 0), field0);
for (i = 1; i < sz - 1; i++){
oldify (&Field (result, i), Field (v, i));