-
Notifications
You must be signed in to change notification settings - Fork 77
/
Copy pathcustom.c
168 lines (152 loc) · 6.44 KB
/
custom.c
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
/**************************************************************************/
/* */
/* 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/custom.h"
#include "caml/fail.h"
#include "caml/gc_ctrl.h"
#include "caml/memory.h"
#include "caml/mlvalues.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;
static value alloc_custom_gen (struct custom_operations * ops,
uintnat bsz,
mlsize_t mem,
mlsize_t max_major,
mlsize_t mem_minor,
mlsize_t max_minor)
{
mlsize_t wosize;
CAMLparam0();
CAMLlocal1(result);
/* [mem] is the total amount of out-of-heap memory, [mem_minor] is how much
of it should be counted against [max_minor]. */
CAMLassert (mem_minor <= mem);
wosize = 1 + (bsz + sizeof(value) - 1) / sizeof(value);
if (wosize <= Max_young_wosize) {
result = caml_alloc_small(wosize, Custom_tag);
Custom_ops_val(result) = ops;
if (ops->finalize != NULL || mem != 0) {
if (mem > mem_minor) {
caml_adjust_gc_speed (mem - mem_minor, max_major);
}
/* The remaining [mem_minor] will be counted if the block survives a
minor GC */
add_to_custom_table (Caml_state->custom_table, result,
mem_minor, max_major);
/* Keep track of extra resources held by custom block in
minor heap. */
if (mem_minor != 0) {
if (max_minor == 0) max_minor = 1;
Caml_state->extra_heap_resources_minor +=
(double) mem_minor / (double) max_minor;
if (Caml_state->extra_heap_resources_minor > 1.0)
caml_minor_collection ();
}
}
} else {
result = caml_alloc_shr(wosize, Custom_tag);
Custom_ops_val(result) = ops;
caml_adjust_gc_speed(mem, max_major);
caml_check_urgent_gc(Val_unit);
}
CAMLreturn(result);
}
CAMLexport value caml_alloc_custom(struct custom_operations * ops,
uintnat bsz,
mlsize_t mem,
mlsize_t max)
{
return alloc_custom_gen (ops, bsz, mem, max, mem, max);
}
CAMLexport value caml_alloc_custom_mem(struct custom_operations * ops,
uintnat bsz,
mlsize_t mem)
{
mlsize_t mem_minor =
mem < caml_custom_minor_max_bsz ? mem : caml_custom_minor_max_bsz;
mlsize_t max_major =
/* 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). */
Bsize_wsize (Caml_state->stat_heap_wsz) / 150 * caml_custom_major_ratio;
mlsize_t max_minor =
Bsize_wsize (Caml_state->minor_heap_wsz) / 100 * caml_custom_minor_ratio;
value v = alloc_custom_gen (ops, bsz, mem, max_major, mem_minor, max_minor);
caml_memprof_track_custom(v, mem);
return v;
}
struct custom_operations_list {
struct custom_operations * ops;
struct custom_operations_list * next;
};
static struct custom_operations_list * custom_ops_table = NULL;
CAMLexport void caml_register_custom_operations(struct custom_operations * ops)
{
struct custom_operations_list * l =
caml_stat_alloc(sizeof(struct custom_operations_list));
CAMLassert(ops->identifier != NULL);
CAMLassert(ops->deserialize != NULL);
l->ops = ops;
l->next = custom_ops_table;
custom_ops_table = l;
}
struct custom_operations * caml_find_custom_operations(char * ident)
{
struct custom_operations_list * l;
for (l = custom_ops_table; l != NULL; l = l->next)
if (strcmp(l->ops->identifier, ident) == 0) return l->ops;
return NULL;
}
static struct custom_operations_list * custom_ops_final_table = NULL;
struct custom_operations * caml_final_custom_operations(final_fun fn)
{
struct custom_operations_list * l;
struct custom_operations * ops;
for (l = custom_ops_final_table; l != NULL; l = l->next)
if (l->ops->finalize == fn) return 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;
l = caml_stat_alloc(sizeof(struct custom_operations_list));
l->ops = ops;
l->next = custom_ops_final_table;
custom_ops_final_table = l;
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);
caml_register_custom_operations(&caml_float32_ops);
}