1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Mark Shinwell and Leo White, Jane Street Europe */
6 /* */
7 /* Copyright 2013--2016, Jane Street Group, LLC */
8 /* */
9 /* All rights reserved. This file is distributed under the terms of */
10 /* the GNU Lesser General Public License version 2.1, with the */
11 /* special exception on linking described in the file LICENSE. */
12 /* */
13 /**************************************************************************/
14
15 #define CAML_INTERNALS
16
17 #include <stdio.h>
18 #include <stdlib.h>
19 #include <string.h>
20 #include <limits.h>
21 #include <math.h>
22
23 #include "caml/alloc.h"
24 #include "caml/config.h"
25 #include "caml/fail.h"
26 #include "caml/gc.h"
27 #include "caml/intext.h"
28 #include "caml/major_gc.h"
29 #include "caml/memory.h"
30 #include "caml/minor_gc.h"
31 #include "caml/misc.h"
32 #include "caml/mlvalues.h"
33 #include "caml/roots.h"
34 #include "caml/signals.h"
35 #include "caml/stack.h"
36 #include "caml/sys.h"
37 #include "caml/spacetime.h"
38
39 #include "caml/s.h"
40
41 #define SPACETIME_PROFINFO_WIDTH 26
42 #define Spacetime_profinfo_hd(hd) \
43 (Gen_profinfo_hd(SPACETIME_PROFINFO_WIDTH, hd))
44
45 #ifdef ARCH_SIXTYFOUR
46
47 /* CR-someday lwhite: The following two definitions are copied from spacetime.c
48 because they are needed here, but must be inlined in spacetime.c
49 for performance. Perhaps a macro or "static inline" would be
50 more appropriate. */
51
52 c_node* caml_spacetime_offline_c_node_of_stored_pointer_not_null
53 (value node_stored)
54 {
55 CAMLassert(Is_c_node(node_stored));
56 return (c_node*) Hp_val(node_stored);
57 }
58
59 c_node_type caml_spacetime_offline_classify_c_node(c_node* node)
60 {
61 return (node->pc & 2) ? CALL : ALLOCATION;
62 }
63
64 CAMLprim value caml_spacetime_compare_node(
65 value node1, value node2)
66 {
67 CAMLassert(!Is_in_value_area(node1));
68 CAMLassert(!Is_in_value_area(node2));
69
70 if (node1 == node2) {
71 return Val_long(0);
72 }
73 if (node1 < node2) {
74 return Val_long(-1);
75 }
76 return Val_long(1);
77 }
78
79 CAMLprim value caml_spacetime_unmarshal_trie (value v_channel)
80 {
81 return caml_input_value_to_outside_heap(v_channel);
82 }
83
84 CAMLprim value caml_spacetime_node_num_header_words(value unit)
85 {
86 return Val_long(Node_num_header_words);
87 }
88
89 CAMLprim value caml_spacetime_is_ocaml_node(value node)
90 {
91 CAMLassert(Is_ocaml_node(node) || Is_c_node(node));
92 return Val_bool(Is_ocaml_node(node));
93 }
94
95 CAMLprim value caml_spacetime_ocaml_function_identifier(value node)
96 {
97 CAMLassert(Is_ocaml_node(node));
98 return caml_copy_int64((uint64_t) Decode_node_pc(Node_pc(node)));
99 }
100
101 CAMLprim value caml_spacetime_ocaml_tail_chain(value node)
102 {
103 CAMLassert(Is_ocaml_node(node));
104 return Tail_link(node);
105 }
106
107 CAMLprim value caml_spacetime_classify_direct_call_point
108 (value node, value offset)
109 {
110 uintnat field;
111 value callee_node;
112
113 CAMLassert(Is_ocaml_node(node));
114
115 field = Long_val(offset);
116
117 callee_node = Direct_callee_node(node, field);
118 if (!Is_block(callee_node)) {
119 /* An unused call point (may be a tail call point). */
120 return Val_long(0);
121 } else if (Is_ocaml_node(callee_node)) {
122 return Val_long(1); /* direct call point to OCaml code */
123 } else {
124 return Val_long(2); /* direct call point to non-OCaml code */
125 }
126 }
127
128 CAMLprim value caml_spacetime_ocaml_allocation_point_annotation
129 (value node, value offset)
130 {
131 uintnat profinfo_shifted;
132 profinfo_shifted = (uintnat) Alloc_point_profinfo(node, Long_val(offset));
133 return Val_long(Spacetime_profinfo_hd(profinfo_shifted));
134 }
135
136 CAMLprim value caml_spacetime_ocaml_allocation_point_count
137 (value node, value offset)
138 {
139 value count = Alloc_point_count(node, Long_val(offset));
140 CAMLassert(!Is_block(count));
141 return count;
142 }
143
144 CAMLprim value caml_spacetime_ocaml_direct_call_point_callee_node
145 (value node, value offset)
146 {
147 return Direct_callee_node(node, Long_val(offset));
148 }
149
150 CAMLprim value caml_spacetime_ocaml_direct_call_point_call_count
151 (value node, value offset)
152 {
153 return Direct_call_count(node, Long_val(offset));
154 }
155
156 CAMLprim value caml_spacetime_ocaml_indirect_call_point_callees
157 (value node, value offset)
158 {
159 value callees = Indirect_pc_linked_list(node, Long_val(offset));
160 CAMLassert(Is_block(callees));
161 CAMLassert(Is_c_node(callees));
162 return callees;
163 }
164
165 CAMLprim value caml_spacetime_c_node_is_call(value node)
166 {
167 c_node* c_node;
168 CAMLassert(node != (value) NULL);
169 CAMLassert(Is_c_node(node));
170 c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
171 switch (caml_spacetime_offline_classify_c_node(c_node)) {
172 case CALL: return Val_true;
173 case ALLOCATION: return Val_false;
174 }
175 CAMLassert(0);
176 return Val_unit; /* silence compiler warning */
177 }
178
179 CAMLprim value caml_spacetime_c_node_next(value node)
180 {
181 c_node* c_node;
182
183 CAMLassert(node != (value) NULL);
184 CAMLassert(Is_c_node(node));
185 c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
186 CAMLassert(c_node->next == Val_unit || Is_c_node(c_node->next));
187 return c_node->next;
188 }
189
190 CAMLprim value caml_spacetime_c_node_call_site(value node)
191 {
192 c_node* c_node;
193 CAMLassert(node != (value) NULL);
194 CAMLassert(Is_c_node(node));
195 c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
196 return caml_copy_int64((uint64_t) Decode_c_node_pc(c_node->pc));
197 }
198
199 CAMLprim value caml_spacetime_c_node_callee_node(value node)
200 {
201 c_node* c_node;
202 CAMLassert(node != (value) NULL);
203 CAMLassert(Is_c_node(node));
204 c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
205 CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == CALL);
206 /* This might be an uninitialised tail call point: for example if an OCaml
207 callee was indirectly called but the callee wasn't instrumented (e.g. a
208 leaf function that doesn't allocate). */
209 if (Is_tail_caller_node_encoded(c_node->data.call.callee_node)) {
210 return Val_unit;
211 }
212 return c_node->data.call.callee_node;
213 }
214
215 CAMLprim value caml_spacetime_c_node_call_count(value node)
216 {
217 c_node* c_node;
218 CAMLassert(node != (value) NULL);
219 CAMLassert(Is_c_node(node));
220 c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
221 CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == CALL);
222 if (Is_tail_caller_node_encoded(c_node->data.call.callee_node)) {
223 return Val_long(0);
224 }
225 return c_node->data.call.call_count;
226 }
227
228 CAMLprim value caml_spacetime_c_node_profinfo(value node)
229 {
230 c_node* c_node;
231 CAMLassert(node != (value) NULL);
232 CAMLassert(Is_c_node(node));
233 c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
234 CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == ALLOCATION);
235 CAMLassert(!Is_block(c_node->data.allocation.profinfo));
236 return Val_long(Spacetime_profinfo_hd(c_node->data.allocation.profinfo));
237 }
238
239 CAMLprim value caml_spacetime_c_node_allocation_count(value node)
240 {
241 c_node* c_node;
242 CAMLassert(node != (value) NULL);
243 CAMLassert(Is_c_node(node));
244 c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node);
245 CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == ALLOCATION);
246 CAMLassert(!Is_block(c_node->data.allocation.count));
247 return c_node->data.allocation.count;
248 }
249
250 #endif
251