1 files changed, 56 insertions, 0 deletions
diff --git a/ocaml-binary-annot/testsuite/tests/gc-roots/globrootsprim.c b/ocaml-binary-annot/testsuite/tests/gc-roots/globrootsprim.c
new file mode 100644
index 0000000000..f58fff1cc3
--- /dev/null
+++ b/ocaml-binary-annot/testsuite/tests/gc-roots/globrootsprim.c
@@ -0,0 +1,56 @@
+/* For testing global root registration */
+
+#include "mlvalues.h"
+#include "memory.h"
+#include "alloc.h"
+
+struct block { value v; };
+
+#define Block_val(v) ((struct block *) (v))
+
+value gb_get(value vblock)
+{
+  return Block_val(vblock)->v;
+}
+
+value gb_classic_register(value v)
+{
+  struct block * b = stat_alloc(sizeof(struct block));
+  b->v = v;
+  caml_register_global_root(&(b->v));
+  return (value) b;
+}
+
+value gb_classic_set(value vblock, value newval)
+{
+  Block_val(vblock)->v = newval;
+  return Val_unit;
+}
+
+value gb_classic_remove(value vblock)
+{
+  caml_remove_global_root(&(Block_val(vblock)->v));
+  return Val_unit;
+}
+
+value gb_generational_register(value v)
+{
+  struct block * b = stat_alloc(sizeof(struct block));
+  b->v = v;
+  caml_register_generational_global_root(&(b->v));
+  return (value) b;
+}
+
+value gb_generational_set(value vblock, value newval)
+{
+  caml_modify_generational_global_root(&(Block_val(vblock)->v), newval);
+  return Val_unit;
+}
+
+value gb_generational_remove(value vblock)
+{
+  caml_remove_generational_global_root(&(Block_val(vblock)->v));
+  return Val_unit;
+}
+
+