+
+/* -----------------------------------------------------------------------------
+ * Utilities for handling root pointers.
+ * -------------------------------------------------------------------------- */
+
+
+#define INIT_RPT_SIZE 64
+
+STATIC_INLINE void
+initFreeList(rootEntry *table, nat n, rootEntry *free)
+{
+ rootEntry *p;
+
+ for (p = table + n - 1; p >= table; p--) {
+ p->addr = (P_)free;
+ free = p;
+ }
+ root_ptr_free = table;
+}
+
+static void
+initRootPtrTable(void)
+{
+ if (RPT_size > 0)
+ return;
+
+ RPT_size = INIT_RPT_SIZE;
+ root_ptr_table = stgMallocBytes(RPT_size * sizeof(rootEntry),
+ "initRootPtrTable");
+
+ initFreeList(root_ptr_table,INIT_RPT_SIZE,NULL);
+}
+
+
+static void
+enlargeRootPtrTable(void)
+{
+ nat old_RPT_size = RPT_size;
+
+ // 2nd and subsequent times
+ RPT_size *= 2;
+ root_ptr_table =
+ stgReallocBytes(root_ptr_table,
+ RPT_size * sizeof(rootEntry),
+ "enlargeRootPtrTable");
+
+ initFreeList(root_ptr_table + old_RPT_size, old_RPT_size, NULL);
+}
+
+static void
+addRootObject(void *addr)
+{
+ StgWord rt;
+ initRootPtrTable();
+ if (root_ptr_free == NULL) {
+ enlargeRootPtrTable();
+ }
+
+ rt = root_ptr_free - root_ptr_table;
+ root_ptr_free = (rootEntry*)(root_ptr_free->addr);
+ root_ptr_table[rt].addr = addr;
+}
+
+/* -----------------------------------------------------------------------------
+ * Treat root pointers as roots for the garbage collector.
+ * -------------------------------------------------------------------------- */
+
+void
+markRootPtrTable(evac_fn evac)
+{
+ rootEntry *p, *end_root_ptr_table;
+ StgPtr q;
+
+ end_root_ptr_table = &root_ptr_table[RPT_size];
+
+ for (p = root_ptr_table; p < end_root_ptr_table; p++) {
+ q = p->addr;
+
+ if (q && (q < (P_)root_ptr_table || q >= (P_)end_root_ptr_table)) {
+ evac((StgClosure **)p->addr);
+ }
+ }
+}
+
+/* -----------------------------------------------------------------------------
+ * End of utilities for handling root pointers.
+ * -------------------------------------------------------------------------- */
+
+