ocaml-boxroot-sys 0.4.0

Boxroot for OCaml: fast movable GC roots (C API)
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

/* SPDX-License-Identifier: MIT */
#ifndef BOXROOT_PLATFORM_H
#define BOXROOT_PLATFORM_H

#define CAML_NAME_SPACE

#ifndef __cplusplus
#include <stdbool.h>
#include <stdint.h>
#else
#include <cstdint>
#endif

#include <caml/config.h>
#include <caml/version.h>

#ifdef __cplusplus
extern "C" {
#endif

typedef intnat value;

#if SIZEOF_PTR == 8 // defined through caml/config.h
typedef uint32_t halfptr_t;
#else
static_assert(SIZEOF_PTR == 4, "Pointers expected 32 or 64 bits.")
typedef uint16_t halfptr_t;
#endif

#if defined(__GNUC__)
#define BXR_LIKELY(a) __builtin_expect(!!(a),1)
#define BXR_UNLIKELY(a) __builtin_expect(!!(a),0)
#else
#define BXR_LIKELY(a) (a)
#define BXR_UNLIKELY(a) (a)
#endif

#if OCAML_VERSION >= 50000
  // Note: contra to convention, caml/domain_state.h is made to be
  // included from inside extern "C" {}
#include <caml/domain_state.h>
#define OCAML_MULTICORE true
#else
#define Caml_state_opt Caml_state
#define OCAML_MULTICORE false
#endif

#ifdef __cplusplus
} // extern "C"
#endif

#ifdef CAML_INTERNALS

#include <assert.h>
#include <pthread.h>
#include <stdatomic.h>
#include <stddef.h>
#include <caml/mlvalues.h>
#include <caml/minor_gc.h>
#include <caml/roots.h>

#if OCAML_MULTICORE
#define Domain_id (Caml_state->id)
#else
#define Domain_id 0
#endif // OCAML_MULTICORE

#define Cache_line_size 64
//#define Cache_line_size 128 /* Apple M1 */

#define load_relaxed(a) (atomic_load_explicit((a), memory_order_relaxed))
#define load_acquire(a) (atomic_load_explicit((a), memory_order_acquire))
#define store_relaxed(a, n) (atomic_store_explicit((a), (n), memory_order_relaxed))
#define incr(a) (atomic_fetch_add_explicit((a), 1, memory_order_relaxed))
#define decr(a) (atomic_fetch_add_explicit((a), -1, memory_order_relaxed))
#define incr_release(a) (atomic_fetch_add_explicit((a), 1, memory_order_release))
#define decr_release(a) (atomic_fetch_add_explicit((a), -1, memory_order_release))

typedef pthread_mutex_t mutex_t;
#define BXR_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER;

bool bxr_initialize_mutex(mutex_t *mutex);
void bxr_mutex_lock(mutex_t *mutex);
void bxr_mutex_unlock(mutex_t *mutex);

/* Check integrity of pool structure after each scan, and compute
   additional statistics? (slow)
   This can be enabled by passing BOXROOT_DEBUG=1 as argument. */
#ifndef BOXROOT_DEBUG
#define BOXROOT_DEBUG false
#endif

/* Compute some statistics, should have marginal impact on performance
   unless DEBUG == 1. This can be enabled by passing BOXROOT_STATS=1
   as argument. */
#ifndef BOXROOT_STATS
#define BOXROOT_STATS BOXROOT_DEBUG
#endif

#if BOXROOT_STATS
#define STATS_INCR(x) (incr(&stats.x))
#define STATS_DECR(x) (decr(&stats.x))
#else
#define STATS_INCR(x) ((void)(0))
#define STATS_DECR(x) ((void)(0))
#endif

#if BOXROOT_DEBUG
#define DEBUGassert(x) assert(x)
#elif defined(__GNUC__)
#define DEBUGassert(x) do { if (!(x)) { __builtin_unreachable(); } } while (0)
#else
#define DEBUGassert(x) ((void)(x))
#endif

typedef struct pool pool;

pool* bxr_alloc_uninitialised_pool(size_t size);
void bxr_free_pool(pool *p);

#if defined(__GNUC__)
#define Noinline __attribute__((noinline))
#elif defined(_MSC_VER)
#define Noinline __declspec(noinline)
#else
#define Noinline
#endif

#endif // CAML_INTERNALS

#endif // BOXROOT_PLATFORM_H