1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Pierre Chambart, OCamlPro */
6 /* Mark Shinwell, Jane Street Europe */
7 /* */
8 /* Copyright 2013--2016 OCamlPro SAS */
9 /* Copyright 2014--2016 Jane Street Group LLC */
10 /* */
11 /* All rights reserved. This file is distributed under the terms of */
12 /* the GNU Lesser General Public License version 2.1, with the */
13 /* special exception on linking described in the file LICENSE. */
14 /* */
15 /**************************************************************************/
16
17 /* Runtime checks to try to catch errors in code generation.
18 See flambda_to_clambda.ml for more information. */
19
20 #include <assert.h>
21 #include <stdio.h>
22
23 #include <caml/mlvalues.h>
24
caml_check_value_is_closure(value v,value v_descr)25 value caml_check_value_is_closure(value v, value v_descr)
26 {
27 const char* descr = String_val(v_descr);
28 value orig_v = v;
29
30 if (v == (value) 0) {
31 fprintf(stderr, "NULL is not a closure: %s\n",
32 descr);
33 abort();
34 }
35 if (!Is_block(v)) {
36 fprintf(stderr,
37 "Expecting a closure, got a non-boxed value %p: %s\n",
38 (void*) v, descr);
39 abort();
40 }
41 if (!(Tag_val(v) == Closure_tag || Tag_val(v) == Infix_tag)) {
42 fprintf(stderr,
43 "Expecting a closure, got a boxed value with tag %i: %s\n",
44 Tag_val(v), descr);
45 abort();
46 }
47 if (Tag_val(v) == Infix_tag) {
48 v -= Infix_offset_val(v);
49 assert(Tag_val(v) == Closure_tag);
50 }
51 assert(Wosize_val(v) >= 2);
52
53 return orig_v;
54 }
55
caml_check_field_access(value v,value pos,value v_descr)56 value caml_check_field_access(value v, value pos, value v_descr)
57 {
58 const char* descr = String_val(v_descr);
59 value orig_v = v;
60 if (v == (value) 0) {
61 fprintf(stderr,
62 "Access to field %" ARCH_INT64_PRINTF_FORMAT
63 "u of NULL: %s\n", (ARCH_UINT64_TYPE) Long_val(pos), descr);
64 abort();
65 }
66 if (!Is_block(v)) {
67 fprintf(stderr,
68 "Access to field %" ARCH_INT64_PRINTF_FORMAT
69 "u of non-boxed value %p is illegal: %s\n",
70 (ARCH_UINT64_TYPE) Long_val(pos), (void*) v, descr);
71 abort();
72 }
73 if (Tag_val(v) == Infix_tag) {
74 uintnat offset = Infix_offset_val(v);
75 v -= offset;
76 pos += offset / sizeof(value);
77 }
78 assert(Long_val(pos) >= 0);
79 if (Long_val(pos) >= Wosize_val(v)) {
80 fprintf(stderr,
81 "Access to field %" ARCH_INT64_PRINTF_FORMAT
82 "u of value %p of size %" ARCH_INT64_PRINTF_FORMAT "u is illegal: %s\n",
83 (ARCH_UINT64_TYPE) Long_val(pos), (void*) v,
84 (ARCH_UINT64_TYPE) Wosize_val(v),
85 descr);
86 abort();
87 }
88 return orig_v;
89 }
90