1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
6 /* */
7 /* Copyright 1996 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #define CAML_INTERNALS
17
18 /* To walk the memory roots for garbage collection */
19
20 #include "caml/finalise.h"
21 #include "caml/globroots.h"
22 #include "caml/major_gc.h"
23 #include "caml/memory.h"
24 #include "caml/minor_gc.h"
25 #include "caml/misc.h"
26 #include "caml/mlvalues.h"
27 #include "caml/roots.h"
28 #include "caml/stacks.h"
29
30 CAMLexport struct caml__roots_block *caml_local_roots = NULL;
31
32 CAMLexport void (*caml_scan_roots_hook) (scanning_action f) = NULL;
33
34 /* FIXME should rename to [caml_oldify_minor_roots] and synchronise with
35 asmrun/roots.c */
36 /* Call [caml_oldify_one] on (at least) all the roots that point to the minor
37 heap. */
caml_oldify_local_roots(void)38 void caml_oldify_local_roots (void)
39 {
40 register value * sp;
41 struct caml__roots_block *lr;
42 intnat i, j;
43
44 /* The stack */
45 for (sp = caml_extern_sp; sp < caml_stack_high; sp++) {
46 caml_oldify_one (*sp, sp);
47 }
48 /* Local C roots */ /* FIXME do the old-frame trick ? */
49 for (lr = caml_local_roots; lr != NULL; lr = lr->next) {
50 for (i = 0; i < lr->ntables; i++){
51 for (j = 0; j < lr->nitems; j++){
52 sp = &(lr->tables[i][j]);
53 caml_oldify_one (*sp, sp);
54 }
55 }
56 }
57 /* Global C roots */
58 caml_scan_global_young_roots(&caml_oldify_one);
59 /* Finalised values */
60 caml_final_oldify_young_roots ();
61 /* Hook */
62 if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one);
63 }
64
65 /* Call [caml_darken] on all roots */
66
caml_darken_all_roots_start(void)67 void caml_darken_all_roots_start (void)
68 {
69 caml_do_roots (caml_darken, 1);
70 }
71
72 uintnat caml_incremental_roots_count = 1;
73
caml_darken_all_roots_slice(intnat work)74 intnat caml_darken_all_roots_slice (intnat work)
75 {
76 return work;
77 }
78
79 /* Note, in byte-code there is only one global root, so [do_globals] is
80 ignored and [caml_darken_all_roots_slice] does nothing. */
caml_do_roots(scanning_action f,int do_globals)81 void caml_do_roots (scanning_action f, int do_globals)
82 {
83 CAML_INSTR_SETUP (tmr, "major_roots");
84 /* Global variables */
85 f(caml_global_data, &caml_global_data);
86 CAML_INSTR_TIME (tmr, "major_roots/global");
87 /* The stack and the local C roots */
88 caml_do_local_roots(f, caml_extern_sp, caml_stack_high, caml_local_roots);
89 CAML_INSTR_TIME (tmr, "major_roots/local");
90 /* Global C roots */
91 caml_scan_global_roots(f);
92 CAML_INSTR_TIME (tmr, "major_roots/C");
93 /* Finalised values */
94 caml_final_do_roots (f);
95 CAML_INSTR_TIME (tmr, "major_roots/finalised");
96 /* Hook */
97 if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
98 CAML_INSTR_TIME (tmr, "major_roots/hook");
99 }
100
caml_do_local_roots(scanning_action f,value * stack_low,value * stack_high,struct caml__roots_block * local_roots)101 CAMLexport void caml_do_local_roots (scanning_action f, value *stack_low,
102 value *stack_high,
103 struct caml__roots_block *local_roots)
104 {
105 register value * sp;
106 struct caml__roots_block *lr;
107 int i, j;
108
109 for (sp = stack_low; sp < stack_high; sp++) {
110 f (*sp, sp);
111 }
112 for (lr = local_roots; lr != NULL; lr = lr->next) {
113 for (i = 0; i < lr->ntables; i++){
114 for (j = 0; j < lr->nitems; j++){
115 sp = &(lr->tables[i][j]);
116 f (*sp, sp);
117 }
118 }
119 }
120 }
121