1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
/* */
/* Copyright 1996 Institut National de Recherche en Informatique et */
/* en Automatique. Distributed only by permission. */
/* */
/***********************************************************************/
/* $Id$ */
/* To walk the memory roots for garbage collection */
#include "major_gc.h"
#include "memory.h"
#include "minor_gc.h"
#include "misc.h"
#include "mlvalues.h"
#include "roots.h"
#include "stacks.h"
struct caml__roots_block *local_roots = NULL;
struct global_root {
value * root;
struct global_root * next;
};
static struct global_root * global_roots = NULL;
void (*scan_roots_hook) (scanning_action f) = NULL;
/* Register a global C root */
void register_global_root(value *r)
{
struct global_root * gr;
Assert (((long) r & 3) == 0); /* compact.c demands this (for now) */
gr = (struct global_root *) stat_alloc(sizeof(struct global_root));
gr->root = r;
gr->next = global_roots;
global_roots = gr;
}
/* Un-register a global C root */
void remove_global_root(value *r)
{
struct global_root ** gp, * gr;
for (gp = &global_roots; *gp != NULL; gp = &(*gp)->next) {
gr = *gp;
if (gr->root == r) {
*gp = gr->next;
stat_free(gr);
return;
}
}
}
/* Call [oldify] on all roots except [global_data] */
void oldify_local_roots (void)
{
register value * sp;
struct global_root * gr;
struct caml__roots_block *lr;
long i, j;
/* The stack */
for (sp = extern_sp; sp < stack_high; sp++) {
oldify (*sp, sp);
}
/* Local C roots */
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);
}
}
}
/* Global C roots */
for (gr = global_roots; gr != NULL; gr = gr->next) {
oldify(*(gr->root), gr->root);
}
/* Hook */
if (scan_roots_hook != NULL) (*scan_roots_hook)(oldify);
}
/* Call [darken] on all roots */
void darken_all_roots (void)
{
do_roots (darken);
}
void do_roots (scanning_action f)
{
struct global_root * gr;
/* Global variables */
f(global_data, &global_data);
/* The stack and the local C roots */
do_local_roots(f, extern_sp, stack_high, local_roots);
/* Global C roots */
for (gr = global_roots; gr != NULL; gr = gr->next) {
f (*(gr->root), gr->root);
}
/* Hook */
if (scan_roots_hook != NULL) (*scan_roots_hook)(f);
}
void do_local_roots (scanning_action f, value *stack_low, value *stack_high, struct caml__roots_block *local_roots)
{
register value * sp;
struct caml__roots_block *lr;
int i, j;
for (sp = stack_low; sp < stack_high; sp++) {
f (*sp, sp);
}
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]);
f (*sp, sp);
}
}
}
}
|
