summaryrefslogtreecommitdiffstats
path: root/byterun
diff options
context:
space:
mode:
Diffstat (limited to 'byterun')
-rw-r--r--byterun/alloc.c1
-rw-r--r--byterun/config.h7
-rw-r--r--byterun/gc_ctrl.c4
-rw-r--r--byterun/minor_gc.c101
-rw-r--r--byterun/minor_gc.h10
-rw-r--r--byterun/roots.c13
-rw-r--r--byterun/startup.c6
7 files changed, 93 insertions, 49 deletions
diff --git a/byterun/alloc.c b/byterun/alloc.c
index 41dafdc4f..97d57b977 100644
--- a/byterun/alloc.c
+++ b/byterun/alloc.c
@@ -35,6 +35,7 @@ CAMLexport value alloc (mlsize_t wosize, tag_t tag)
mlsize_t i;
Assert (tag < 256);
+ Assert (tag != Infix_tag);
if (wosize == 0){
result = Atom (tag);
}else if (wosize <= Max_young_wosize){
diff --git a/byterun/config.h b/byterun/config.h
index 812ab88cc..13276a197 100644
--- a/byterun/config.h
+++ b/byterun/config.h
@@ -124,11 +124,12 @@ typedef uint64 int64;
/* Default speed setting for the major GC. The heap will grow until
the dead objects and the free list represent this percentage of the
- heap size. The rest of the heap is live objects. */
+ total size of live objects. */
#define Percent_free_def 42
-/* Default setting for the compacter: off */
-#define Max_percent_free_def 1000000
+/* Default setting for the compacter: 300%
+ (i.e. trigger the compacter when 3/4 of the heap is free) */
+#define Max_percent_free_def 300
#endif /* _config_ */
diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c
index 1871d8cc2..6d945359e 100644
--- a/byterun/gc_ctrl.c
+++ b/byterun/gc_ctrl.c
@@ -207,7 +207,7 @@ static value heap_stats (int returnstats)
double majwords = stat_major_words + (double) allocated_words;
long mincoll = stat_major_collections;
long majcoll = stat_minor_collections;
- long heapsz = stat_heap_size;
+ long heap_words = Wsize_bsize (stat_heap_size);
long cpct = stat_compactions;
res = alloc_tuple (14);
@@ -216,7 +216,7 @@ static value heap_stats (int returnstats)
Store_field (res, 2, copy_double (majwords));
Store_field (res, 3, Val_long (mincoll));
Store_field (res, 4, Val_long (majcoll));
- Store_field (res, 5, Val_long (heapsz));
+ 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));
diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c
index 78bb8ac7f..915053c08 100644
--- a/byterun/minor_gc.c
+++ b/byterun/minor_gc.c
@@ -67,7 +67,9 @@ void set_minor_heap_size (asize_t size)
ref_table_end = ref_table + ref_table_size + ref_table_reserve;
}
-void oldify (value v, value *p)
+static value oldify_todo_list = NULL;
+
+void oldify_one (value v, value *p)
{
value result, field0;
header_t hd;
@@ -78,40 +80,38 @@ void oldify (value v, value *p)
if (Is_block (v) && Is_young (v)){
Assert (Hp_val (v) >= young_ptr);
hd = Hd_val (v);
- if (hd == 0){ /* Already forwarded ? */
- *p = Field (v, 0); /* Then the forward pointer is the first field. */
- }else if ((tag = Tag_hd (hd)), (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) = 0; /* Put the forward flag. */
- Field (v, 0) = result; /* And the forward pointer. */
- *p = result;
+ if (hd == 0){ /* If already forwarded */
+ *p = Field (v, 0); /* then forward pointer is first field. */
}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) = 0; /* 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;
+ tag = Tag_hd (hd);
+ 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) = 0; /* Set forward flag */
+ Field (v, 0) = result; /* and forward pointer. */
+ *p = result;
+ }else if (tag == Infix_tag){
+ mlsize_t offset = Infix_offset_hd (hd);
+ oldify_one (v - offset, p); /* This cannot recurse deeper than 1. */
+ *p += offset;
+ }else{
+ sz = Wosize_hd (hd);
+ result = alloc_shr (sz, tag);
+ *p = result;
+ field0 = Field (v, 0);
+ Hd_val (v) = 0; /* Set forward flag */
+ Field (v, 0) = result; /* and forward pointer. */
+ if (sz > 1){
+ Field (result, 0) = field0;
+ Field (result, 1) = oldify_todo_list; /* Add this block */
+ oldify_todo_list = v; /* to the "to do" list. */
+ }else{
+ Assert (sz == 1);
+ p = &Field (result, 0);
+ v = field0;
+ goto tail_call;
+ }
}
}
}else{
@@ -119,6 +119,36 @@ void oldify (value v, value *p)
}
}
+/* Finish the work that was put off by oldify_one.
+ Note that oldify_one itself is called by oldify_mopup, so we
+ have to be careful to remove the first entry from the list before
+ oldifying its fields. */
+void oldify_mopup (void)
+{
+ value v, new_v, f;
+ mlsize_t i;
+
+ while (oldify_todo_list != NULL){
+ v = oldify_todo_list; /* Get the head. */
+ Assert (Hd_val (v) == 0); /* It must be forwarded. */
+ new_v = Field (v, 0); /* Follow forward pointer. */
+ oldify_todo_list = Field (new_v, 1); /* Remove from list. */
+
+ f = Field (new_v, 0);
+ if (Is_block (f) && Is_young (f)){
+ oldify_one (f, &Field (new_v, 0));
+ }
+ for (i = 1; i < Wosize_val (new_v); i++){
+ f = Field (v, i);
+ if (Is_block (f) && Is_young (f)){
+ oldify_one (Field (v, i), &Field (new_v, i));
+ }else{
+ Field (new_v, i) = f;
+ }
+ }
+ }
+}
+
/* Make sure the minor heap is empty by performing a minor collection
if needed.
*/
@@ -130,7 +160,8 @@ void empty_minor_heap (void)
in_minor_collection = 1;
gc_message (0x02, "<", 0);
oldify_local_roots();
- for (r = ref_table; r < ref_table_ptr; r++) oldify (**r, *r);
+ for (r = ref_table; r < ref_table_ptr; r++) oldify_one (**r, *r);
+ oldify_mopup ();
if (young_ptr < young_limit) young_ptr = young_limit;
stat_minor_words += Wsize_bsize (young_end - young_ptr);
young_ptr = young_end;
diff --git a/byterun/minor_gc.h b/byterun/minor_gc.h
index 66252aeb2..d520d98c7 100644
--- a/byterun/minor_gc.h
+++ b/byterun/minor_gc.h
@@ -32,6 +32,14 @@ extern void empty_minor_heap (void);
CAMLextern void minor_collection (void);
CAMLextern void garbage_collection (void); /* for the native-code system */
extern void realloc_ref_table (void);
-extern void oldify (value, value *);
+extern void oldify_one (value, value *);
+extern void oldify_mopup (void);
+
+#define Oldify(p) do{ \
+ value __oldify__v__ = *p; \
+ if (Is_block (__oldify__v__) && Is_young (__oldify__v__)){ \
+ oldify_one (__oldify__v__, (p)); \
+ } \
+ }while(0)
#endif /* _minor_gc_ */
diff --git a/byterun/roots.c b/byterun/roots.c
index 391789c9e..6378ceffb 100644
--- a/byterun/roots.c
+++ b/byterun/roots.c
@@ -30,7 +30,8 @@ CAMLexport struct caml__roots_block *local_roots = NULL;
void (*scan_roots_hook) (scanning_action f) = NULL;
/* FIXME rename to [oldify_young_roots] and synchronise with asmrun/roots.c */
-/* Call [oldify] on (at least) all the roots that point to the minor heap. */
+/* Call [oldify_one] on (at least) all the roots that point to the minor
+ heap. */
void oldify_local_roots (void)
{
register value * sp;
@@ -40,25 +41,25 @@ void oldify_local_roots (void)
/* The stack */
for (sp = extern_sp; sp < stack_high; sp++) {
- oldify (*sp, sp);
+ oldify_one (*sp, sp);
}
/* Local C roots */ /* FIXME do the old-frame trick ? */
for (lr = local_roots; lr != NULL; lr = lr->next) {
for (i = 0; i < lr->ntables; i++){
for (j = 0; j < lr->nitems; j++){
sp = &(lr->tables[i][j]);
- oldify (*sp, sp);
+ oldify_one (*sp, sp);
}
}
}
/* Global C roots */
for (gr = caml_global_roots.forward[0]; gr != NULL; gr = gr->forward[0]) {
- oldify(*(gr->root), gr->root);
+ oldify_one(*(gr->root), gr->root);
}
/* Finalised values */
- final_do_young_roots (&oldify);
+ final_do_young_roots (&oldify_one);
/* Hook */
- if (scan_roots_hook != NULL) (*scan_roots_hook)(&oldify);
+ if (scan_roots_hook != NULL) (*scan_roots_hook)(&oldify_one);
}
/* Call [darken] on all roots */
diff --git a/byterun/startup.c b/byterun/startup.c
index db69dc5ae..a2dddd662 100644
--- a/byterun/startup.c
+++ b/byterun/startup.c
@@ -376,7 +376,8 @@ CAMLexport void caml_main(char **argv)
close_channel(chan); /* this also closes fd */
stat_free(trail.section);
/* Ensure that the globals are in the major heap. */
- oldify(global_data, &global_data);
+ oldify_one (global_data, &global_data);
+ oldify_mopup ();
/* Initialize system libraries */
init_exceptions();
sys_init(argv + pos);
@@ -429,7 +430,8 @@ CAMLexport void caml_startup_code(code_t code, asize_t code_size,
/* Load the globals */
global_data = input_val_from_string((value)data, 0);
/* Ensure that the globals are in the major heap. */
- oldify(global_data, &global_data);
+ oldify_one (global_data, &global_data);
+ oldify_mopup ();
/* Run the code */
init_exceptions();
sys_init(argv);
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-04-11 22:18:47 +0000