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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
/**************************************************************************/
/* */
/* OCaml */
/* */
/* Manuel Serrano and Xavier Leroy, INRIA Rocquencourt */
/* */
/* Copyright 2000 Institut National de Recherche en Informatique et */
/* en Automatique. */
/* */
/* All rights reserved. This file is distributed under the terms of */
/* the GNU Lesser General Public License version 2.1, with the */
/* special exception on linking described in the file LICENSE. */
/* */
/**************************************************************************/
#define CAML_INTERNALS
#include <string.h>
#include "caml/alloc.h"
#include "caml/camlatomic.h"
#include "caml/custom.h"
#include "caml/fail.h"
#include "caml/gc_ctrl.h"
#include "caml/memory.h"
#include "caml/mlvalues.h"
#include "caml/shared_heap.h"
#include "caml/signals.h"
#include "caml/memprof.h"
uintnat caml_custom_major_ratio = Custom_major_ratio_def;
uintnat caml_custom_minor_ratio = Custom_minor_ratio_def;
uintnat caml_custom_minor_max_bsz = Custom_minor_max_bsz_def;
mlsize_t caml_custom_get_max_major (void)
{
/* The major ratio is a percentage relative to the major heap size.
A complete GC cycle will be done every time 2/3 of that much
memory is allocated for blocks in the major heap. Assuming
constant allocation and deallocation rates, this means there are
at most [M/100 * major-heap-size] bytes of floating garbage at
any time. The reason for a factor of 2/3 (or 1.5) is, roughly
speaking, because the major GC takes 1.5 cycles (previous cycle +
marking phase) before it starts to deallocate dead blocks
allocated during the previous cycle. [heap_size / 150] is really
[heap_size * (2/3) / 100] (but faster). */
return caml_heap_size(Caml_state->shared_heap) / 150
* caml_custom_major_ratio;
}
/* [mem] is an amount of out-of-heap resources, in the same units as
[max_major] and [max_minor]. When the cumulated amount of such
resources reaches [max_minor] (for resources held by the minor
heap) we do a minor collection; when it reaches [max_major] (for
resources held by the major heap), we guarantee that a major cycle
is done.
If [max_major] is 0, then [mem] is a number of bytes and the actual
limit is [caml_custom_get_max_major ()] computed at the
time when the custom block is promoted to the major heap.
*/
static value alloc_custom_gen (const struct custom_operations * ops,
uintnat bsz,
mlsize_t mem,
mlsize_t max_major,
mlsize_t max_minor)
{
mlsize_t wosize;
CAMLparam0();
CAMLlocal1(result);
wosize = 1 + (bsz + sizeof(value) - 1) / sizeof(value);
if (wosize <= Max_young_wosize && mem <= caml_custom_minor_max_bsz) {
result = caml_alloc_small(wosize, Custom_tag);
Custom_ops_val(result) = ops;
if (ops->finalize != NULL || mem != 0) {
/* Record the extra resources in case the block gets promoted. */
add_to_custom_table (&Caml_state->minor_tables->custom, result,
mem, max_major);
/* Keep track of extra resources held by custom block in
minor heap. */
if (mem != 0) {
caml_adjust_minor_gc_speed (mem, max_minor);
}
}
} else {
result = caml_alloc_shr(wosize, Custom_tag);
Custom_ops_val(result) = ops;
caml_adjust_gc_speed(mem, max_major);
result = caml_check_urgent_gc(result);
}
CAMLreturn(result);
}
Caml_inline mlsize_t get_max_minor (void)
{
return
Bsize_wsize (Caml_state->minor_heap_wsz) / 100 * caml_custom_minor_ratio;
}
CAMLexport value caml_alloc_custom(const struct custom_operations * ops,
uintnat bsz,
mlsize_t mem,
mlsize_t max)
{
mlsize_t max_major = max;
mlsize_t max_minor = max == 0 ? get_max_minor() : max;
return alloc_custom_gen (ops, bsz, mem, max_major, max_minor);
}
CAMLexport value caml_alloc_custom_mem(const struct custom_operations * ops,
uintnat bsz,
mlsize_t mem)
{
value v = alloc_custom_gen (ops, bsz, mem, 0, get_max_minor());
size_t mem_words = (mem + sizeof(value) - 1) / sizeof(value);
caml_memprof_sample_block(v, mem_words, mem_words, CAML_MEMPROF_SRC_CUSTOM);
return v;
}
struct custom_operations_list {
const struct custom_operations * ops;
struct custom_operations_list * next;
};
typedef _Atomic(struct custom_operations_list *) custom_operations_table;
/* Thread-safety: the tables are append-only lists, hence we only need
a CAS loop update them. */
static void push_custom_ops(custom_operations_table * table,
const struct custom_operations * ops)
{
struct custom_operations_list * l =
caml_stat_alloc(sizeof(struct custom_operations_list));
l->ops = ops;
struct custom_operations_list * prev = atomic_load(table);
do {
l->next = prev;
} while (!atomic_compare_exchange_weak(table, &prev, l));
}
static custom_operations_table custom_ops_table = NULL;
CAMLexport void
caml_register_custom_operations(const struct custom_operations * ops)
{
CAMLassert(ops->identifier != NULL);
CAMLassert(ops->deserialize != NULL);
push_custom_ops(&custom_ops_table, ops);
}
struct custom_operations * caml_find_custom_operations(const char * ident)
{
for (struct custom_operations_list *l = atomic_load(&custom_ops_table);
l != NULL;
l = l->next)
if (strcmp(l->ops->identifier, ident) == 0)
return (struct custom_operations*)l->ops;
return NULL;
}
static custom_operations_table custom_ops_final_table = NULL;
struct custom_operations * caml_final_custom_operations(final_fun fn)
{
struct custom_operations * ops;
for (struct custom_operations_list *l = atomic_load(&custom_ops_final_table);
l != NULL;
l = l->next)
if (l->ops->finalize == fn) return (struct custom_operations*)l->ops;
ops = caml_stat_alloc(sizeof(struct custom_operations));
ops->identifier = "_final";
ops->finalize = fn;
ops->compare = custom_compare_default;
ops->hash = custom_hash_default;
ops->serialize = custom_serialize_default;
ops->deserialize = custom_deserialize_default;
ops->compare_ext = custom_compare_ext_default;
ops->fixed_length = custom_fixed_length_default;
push_custom_ops(&custom_ops_final_table, ops);
return ops;
}
void caml_init_custom_operations(void)
{
caml_register_custom_operations(&caml_int32_ops);
caml_register_custom_operations(&caml_nativeint_ops);
caml_register_custom_operations(&caml_int64_ops);
caml_register_custom_operations(&caml_ba_ops);
}
|
