summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--VERSION2
-rwxr-xr-xboot/ocamlcbin1016796 -> 4481391 bytes
-rwxr-xr-xboot/ocamllexbin161848 -> 162155 bytes
-rw-r--r--byterun/.cvsignore1
-rw-r--r--byterun/memory.c6
-rw-r--r--byterun/memory.h8
-rw-r--r--byterun/minor_gc.c101
-rw-r--r--byterun/minor_gc.h15
-rw-r--r--byterun/weak.c14
9 files changed, 101 insertions, 46 deletions
diff --git a/VERSION b/VERSION
index 3910dff0f..b1540c5f9 100644
--- a/VERSION
+++ b/VERSION
@@ -1,4 +1,4 @@
-3.11+dev0 (2007-04-18)
+3.11+dev1 (2007-05-03)
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli
diff --git a/boot/ocamlc b/boot/ocamlc
index dc126242a..cd40f1c39 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
Binary files differ
diff --git a/boot/ocamllex b/boot/ocamllex
index 508ff4186..90fc434a2 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
Binary files differ
diff --git a/byterun/.cvsignore b/byterun/.cvsignore
index 90636dc15..9020f408e 100644
--- a/byterun/.cvsignore
+++ b/byterun/.cvsignore
@@ -14,3 +14,4 @@ ocamlrun.dbg
interp.a.lst
*.[sd]obj
*.lib
+.gdb_history
diff --git a/byterun/memory.c b/byterun/memory.c
index 03d728693..660263e2e 100644
--- a/byterun/memory.c
+++ b/byterun/memory.c
@@ -358,10 +358,10 @@ void caml_initialize (value *fp, value val)
{
*fp = val;
if (Is_block (val) && Is_young (val) && Is_in_heap (fp)){
- *caml_ref_table_ptr++ = fp;
- if (caml_ref_table_ptr >= caml_ref_table_limit){
- caml_realloc_ref_table ();
+ if (caml_ref_table.ptr >= caml_ref_table.limit){
+ caml_realloc_ref_table (&caml_ref_table);
}
+ *caml_ref_table.ptr++ = fp;
}
}
diff --git a/byterun/memory.h b/byterun/memory.h
index d3962bfa5..d369b14b9 100644
--- a/byterun/memory.h
+++ b/byterun/memory.h
@@ -94,11 +94,11 @@ color_t caml_allocation_color (void *hp);
if (caml_gc_phase == Phase_mark) caml_darken (_old_, NULL); \
if (Is_block (val) && Is_young (val) \
&& ! (Is_block (_old_) && Is_young (_old_))){ \
- *caml_ref_table_ptr++ = (fp); \
- if (caml_ref_table_ptr >= caml_ref_table_limit){ \
- CAMLassert (caml_ref_table_ptr == caml_ref_table_limit); \
- caml_realloc_ref_table (); \
+ if (caml_ref_table.ptr >= caml_ref_table.limit){ \
+ CAMLassert (caml_ref_table.ptr == caml_ref_table.limit); \
+ caml_realloc_ref_table (&caml_ref_table); \
} \
+ *caml_ref_table.ptr++ = (fp); \
} \
} \
}while(0)
diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c
index f4958939b..396aff504 100644
--- a/byterun/minor_gc.c
+++ b/byterun/minor_gc.c
@@ -26,19 +26,51 @@
#include "mlvalues.h"
#include "roots.h"
#include "signals.h"
+#include "weak.h"
asize_t caml_minor_heap_size;
CAMLexport char *caml_young_start = NULL, *caml_young_end = NULL;
CAMLexport char *caml_young_ptr = NULL, *caml_young_limit = NULL;
-static value **ref_table = NULL, **ref_table_end, **ref_table_threshold;
-CAMLexport value **caml_ref_table_ptr = NULL, **caml_ref_table_limit;
-static asize_t ref_table_size, ref_table_reserve;
+
+CAMLexport struct caml_ref_table
+ caml_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0},
+ caml_weak_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0};
+
int caml_in_minor_collection = 0;
+void caml_alloc_table (struct caml_ref_table *tbl, asize_t sz, asize_t rsv)
+{
+ value **new_table;
+
+ tbl->size = sz;
+ tbl->reserve = rsv;
+ new_table = (value **) caml_stat_alloc ((tbl->size + tbl->reserve)
+ * sizeof (value *));
+ if (tbl->base != NULL) caml_stat_free (tbl->base);
+ tbl->base = new_table;
+ tbl->ptr = tbl->base;
+ tbl->threshold = tbl->base + tbl->size;
+ tbl->limit = tbl->threshold;
+ tbl->end = tbl->base + tbl->size + tbl->reserve;
+}
+
+static void reset_table (struct caml_ref_table *tbl)
+{
+ tbl->size = 0;
+ tbl->reserve = 0;
+ if (tbl->base != NULL) caml_stat_free (tbl->base);
+ tbl->base = tbl->ptr = tbl->threshold = tbl->limit = tbl->end = NULL;
+}
+
+static void clear_table (struct caml_ref_table *tbl)
+{
+ tbl->ptr = tbl->base;
+ tbl->limit = tbl->threshold;
+}
+
void caml_set_minor_heap_size (asize_t size)
{
char *new_heap;
- value **new_table;
Assert (size >= Minor_heap_min);
Assert (size <= Minor_heap_max);
@@ -55,16 +87,8 @@ void caml_set_minor_heap_size (asize_t size)
caml_young_ptr = caml_young_end;
caml_minor_heap_size = size;
- ref_table_size = caml_minor_heap_size / sizeof (value) / 8;
- ref_table_reserve = 256;
- new_table = (value **) caml_stat_alloc ((ref_table_size + ref_table_reserve)
- * sizeof (value *));
- if (ref_table != NULL) caml_stat_free (ref_table);
- ref_table = new_table;
- caml_ref_table_ptr = ref_table;
- ref_table_threshold = ref_table + ref_table_size;
- caml_ref_table_limit = ref_table_threshold;
- ref_table_end = ref_table + ref_table_size + ref_table_reserve;
+ reset_table (&caml_ref_table);
+ reset_table (&caml_weak_ref_table);
}
static value oldify_todo_list = 0;
@@ -187,16 +211,25 @@ void caml_empty_minor_heap (void)
caml_in_minor_collection = 1;
caml_gc_message (0x02, "<", 0);
caml_oldify_local_roots();
- for (r = ref_table; r < caml_ref_table_ptr; r++){
+ for (r = caml_ref_table.base; r < caml_ref_table.ptr; r++){
caml_oldify_one (**r, *r);
}
caml_oldify_mopup ();
+ for (r = caml_weak_ref_table.base; r < caml_weak_ref_table.ptr; r++){
+ if (Is_block (**r) && Is_young (**r)){
+ if (Hd_val (**r) == 0){
+ **r = Field (**r, 0);
+ }else{
+ **r = caml_weak_none;
+ }
+ }
+ }
if (caml_young_ptr < caml_young_start) caml_young_ptr = caml_young_start;
caml_stat_minor_words += Wsize_bsize (caml_young_end - caml_young_ptr);
caml_young_ptr = caml_young_end;
caml_young_limit = caml_young_start;
- caml_ref_table_ptr = ref_table;
- caml_ref_table_limit = ref_table_threshold;
+ clear_table (&caml_ref_table);
+ clear_table (&caml_weak_ref_table);
caml_gc_message (0x02, ">", 0);
caml_in_minor_collection = 0;
}
@@ -238,32 +271,34 @@ CAMLexport value caml_check_urgent_gc (value extra_root)
CAMLreturn (extra_root);
}
-void caml_realloc_ref_table (void)
-{ Assert (caml_ref_table_ptr == caml_ref_table_limit);
- Assert (caml_ref_table_limit <= ref_table_end);
- Assert (caml_ref_table_limit >= ref_table_threshold);
+void caml_realloc_ref_table (struct caml_ref_table *tbl)
+{ Assert (tbl->ptr == tbl->limit);
+ Assert (tbl->limit <= tbl->end);
+ Assert (tbl->limit >= tbl->threshold);
- if (caml_ref_table_limit == ref_table_threshold){
+ if (tbl->base == NULL){
+ caml_alloc_table (tbl, caml_minor_heap_size / sizeof (value) / 8, 256);
+ }else if (tbl->limit == tbl->threshold){
caml_gc_message (0x08, "ref_table threshold crossed\n", 0);
- caml_ref_table_limit = ref_table_end;
+ tbl->limit = tbl->end;
caml_urge_major_slice ();
}else{ /* This will almost never happen with the bytecode interpreter. */
asize_t sz;
- asize_t cur_ptr = caml_ref_table_ptr - ref_table;
+ asize_t cur_ptr = tbl->ptr - tbl->base;
Assert (caml_force_major_slice);
- ref_table_size *= 2;
- sz = (ref_table_size + ref_table_reserve) * sizeof (value *);
- caml_gc_message (0x08, "Growing ref_table to %"
+ tbl->size *= 2;
+ sz = (tbl->size + tbl->reserve) * sizeof (value *);
+ caml_gc_message (0x08, "Growing ref_table to %"
ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n",
(intnat) sz/1024);
- ref_table = (value **) realloc ((char *) ref_table, sz);
- if (ref_table == NULL){
+ tbl->base = (value **) realloc ((char *) tbl->base, sz);
+ if (tbl->base == NULL){
caml_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;
- caml_ref_table_ptr = ref_table + cur_ptr;
- caml_ref_table_limit = ref_table_end;
+ tbl->end = tbl->base + tbl->size + tbl->reserve;
+ tbl->threshold = tbl->base + tbl->size;
+ tbl->ptr = tbl->base + cur_ptr;
+ tbl->limit = tbl->end;
}
}
diff --git a/byterun/minor_gc.h b/byterun/minor_gc.h
index a569d3a90..8e834129b 100644
--- a/byterun/minor_gc.h
+++ b/byterun/minor_gc.h
@@ -21,10 +21,20 @@
CAMLextern char *caml_young_start, *caml_young_ptr;
CAMLextern char *caml_young_end, *caml_young_limit;
-CAMLextern value **caml_ref_table_ptr, **caml_ref_table_limit;
extern asize_t caml_minor_heap_size;
extern int caml_in_minor_collection;
+struct caml_ref_table {
+ value **base;
+ value **end;
+ value **threshold;
+ value **ptr;
+ value **limit;
+ asize_t size;
+ asize_t reserve;
+};
+CAMLextern struct caml_ref_table caml_ref_table, caml_weak_ref_table;
+
#define Is_young(val) \
(Assert (Is_block (val)), \
(addr)(val) < (addr)caml_young_end && (addr)(val) > (addr)caml_young_start)
@@ -33,7 +43,8 @@ extern void caml_set_minor_heap_size (asize_t);
extern void caml_empty_minor_heap (void);
CAMLextern void caml_minor_collection (void);
CAMLextern void garbage_collection (void); /* def in asmrun/signals.c */
-extern void caml_realloc_ref_table (void);
+extern void caml_realloc_ref_table (struct caml_ref_table *);
+extern void caml_alloc_table (struct caml_ref_table *, asize_t, asize_t);
extern void caml_oldify_one (value, value *);
extern void caml_oldify_mopup (void);
diff --git a/byterun/weak.c b/byterun/weak.c
index 0cea2a6dc..01a35ec89 100644
--- a/byterun/weak.c
+++ b/byterun/weak.c
@@ -52,12 +52,20 @@ CAMLprim value caml_weak_set (value ar, value n, value el)
if (offset < 1 || offset >= Wosize_val (ar)){
caml_invalid_argument ("Weak.set");
}
- Field (ar, offset) = caml_weak_none;
if (el != None_val){
value v; Assert (Wosize_val (el) == 1);
v = Field (el, 0);
- if (Is_block (v) && (Is_young (v) || Is_in_heap (v))){
- Modify (&Field (ar, offset), v);
+ if (Is_block (v) && Is_young (v)){
+ /* modified version of Modify */
+ value old = Field (ar, offset);
+ Field (ar, offset) = v;
+ if (!(Is_block (old) && Is_young (old))){
+ if (caml_weak_ref_table.ptr >= caml_weak_ref_table.limit){
+ CAMLassert (caml_weak_ref_table.ptr == caml_weak_ref_table.limit);
+ caml_realloc_ref_table (&caml_weak_ref_table);
+ }
+ *caml_weak_ref_table.ptr++ = &Field (ar, offset);
+ }
}else{
Field (ar, offset) = v;
}
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-20 15:27:36 +0000