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
|
/**************************************************************************/
/* */
/* OCaml */
/* */
/* Pierre Chambart, OCamlPro */
/* Mark Shinwell, Jane Street Europe */
/* */
/* Copyright 2013--2016 OCamlPro SAS */
/* Copyright 2014--2016 Jane Street Group LLC */
/* */
/* 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. */
/* */
/**************************************************************************/
/* Runtime checks to try to catch errors in code generation.
See flambda_to_clambda.ml for more information. */
#include <stdio.h>
#include "caml/mlvalues.h"
value caml_check_value_is_closure(value v, value v_descr)
{
const char* descr = String_val(v_descr);
value orig_v = v;
if (v == (value) 0) {
fprintf(stderr, "NULL is not a closure: %s\n",
descr);
abort();
}
if (!Is_block(v)) {
fprintf(stderr,
"Expecting a closure, got a non-boxed value %p: %s\n",
(void*) v, descr);
abort();
}
if (!(Tag_val(v) == Closure_tag || Tag_val(v) == Infix_tag)) {
fprintf(stderr,
"Expecting a closure, got a boxed value with tag %i: %s\n",
Tag_val(v), descr);
abort();
}
if (Tag_val(v) == Infix_tag) {
v -= Infix_offset_val(v);
CAMLassert(Tag_val(v) == Closure_tag);
}
CAMLassert(Wosize_val(v) >= 2);
return orig_v;
}
value caml_check_field_access(value v, value pos, value v_descr)
{
const char* descr = String_val(v_descr);
value orig_v = v;
if (v == (value) 0) {
fprintf(stderr,
"Access to field %" ARCH_INT64_PRINTF_FORMAT
"u of NULL: %s\n", (ARCH_UINT64_TYPE) Long_val(pos), descr);
abort();
}
if (!Is_block(v)) {
fprintf(stderr,
"Access to field %" ARCH_INT64_PRINTF_FORMAT
"u of non-boxed value %p is illegal: %s\n",
(ARCH_UINT64_TYPE) Long_val(pos), (void*) v, descr);
abort();
}
if (Tag_val(v) == Infix_tag) {
uintnat offset = Infix_offset_val(v);
v -= offset;
pos += offset / sizeof(value);
}
CAMLassert(Long_val(pos) >= 0);
if (Long_val(pos) >= Wosize_val(v)) {
fprintf(stderr,
"Access to field %" ARCH_INT64_PRINTF_FORMAT
"u of value %p of size %" ARCH_INT64_PRINTF_FORMAT "u is illegal: %s\n",
(ARCH_UINT64_TYPE) Long_val(pos), (void*) v,
(ARCH_UINT64_TYPE) Wosize_val(v),
descr);
abort();
}
return orig_v;
}
|
