1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6 /* */
7 /* Copyright 2000 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #define CAML_INTERNALS
17
18 /* Stack backtrace for uncaught exceptions */
19
20 #include <stdio.h>
21 #include <stdlib.h>
22 #include <string.h>
23
24 #include "caml/alloc.h"
25 #include "caml/memory.h"
26 #include "caml/backtrace.h"
27 #include "caml/backtrace_prim.h"
28 #include "caml/fail.h"
29 #include "caml/debugger.h"
30
31 void caml_init_backtrace(void)
32 {
33 caml_register_global_root(&Caml_state->backtrace_last_exn);
34 }
35
36 /* Start or stop the backtrace machinery */
37 CAMLprim value caml_record_backtrace(value vflag)
38 {
39 int flag = Int_val(vflag);
40
41 if (flag != Caml_state->backtrace_active) {
42 Caml_state->backtrace_active = flag;
43 Caml_state->backtrace_pos = 0;
44 Caml_state->backtrace_last_exn = Val_unit;
45 /* Note: We do lazy initialization of Caml_state->backtrace_buffer when
46 needed in order to simplify the interface with the thread
47 library (thread creation doesn't need to allocate
48 Caml_state->backtrace_buffer). So we don't have to allocate it here.
49 */
50 }
51 return Val_unit;
52 }
53
54 /* Return the status of the backtrace machinery */
55 CAMLprim value caml_backtrace_status(value vunit)
56 {
57 return Val_bool(Caml_state->backtrace_active);
58 }
59
60 /* Print location information -- same behavior as in Printexc
61
62 note that the test for compiler-inserted raises is slightly redundant:
63 (!li->loc_valid && li->loc_is_raise)
64 caml_debuginfo_location guarantees that when li->loc_valid is
65 0, then li->loc_is_raise is always 1, so the latter test is
66 useless. We kept it to keep code identical to the runtime/
67 implementation. */
68 static void print_location(struct caml_loc_info * li, int index)
69 {
70 char * info;
71 char * inlined;
72
73 /* Ignore compiler-inserted raise */
74 if (!li->loc_valid && li->loc_is_raise) return;
75
76 if (li->loc_is_raise) {
77 /* Initial raise if index == 0, re-raise otherwise */
78 if (index == 0)
79 info = "Raised at";
80 else
81 info = "Re-raised at";
82 } else {
83 if (index == 0)
84 info = "Raised by primitive operation at";
85 else
86 info = "Called from";
87 }
88 if (li->loc_is_inlined) {
89 inlined = " (inlined)";
90 } else {
91 inlined = "";
92 }
93 if (! li->loc_valid) {
94 fprintf(stderr, "%s unknown location%s\n", info, inlined);
95 } else {
96 fprintf (stderr, "%s file \"%s\"%s, line %d, characters %d-%d\n",
97 info, li->loc_filename, inlined, li->loc_lnum,
98 li->loc_startchr, li->loc_endchr);
99 }
100 }
101
102 /* Print a backtrace */
103 CAMLexport void caml_print_exception_backtrace(void)
104 {
105 int i;
106 struct caml_loc_info li;
107 debuginfo dbg;
108
109 if (!caml_debug_info_available()) {
110 fprintf(stderr, "(Cannot print stack backtrace: "
111 "no debug information available)\n");
112 return;
113 }
114
115 for (i = 0; i < Caml_state->backtrace_pos; i++) {
116 for (dbg = caml_debuginfo_extract(Caml_state->backtrace_buffer[i]);
117 dbg != NULL;
118 dbg = caml_debuginfo_next(dbg))
119 {
120 caml_debuginfo_location(dbg, &li);
121 print_location(&li, i);
122 }
123 }
124 }
125
126 /* Get a copy of the latest backtrace */
127 CAMLprim value caml_get_exception_raw_backtrace(value unit)
128 {
129 CAMLparam0();
130 CAMLlocal1(res);
131
132 if (!Caml_state->backtrace_active ||
133 Caml_state->backtrace_buffer == NULL ||
134 Caml_state->backtrace_pos == 0) {
135 res = caml_alloc(0, 0);
136 }
137 else {
138 intnat i, len = Caml_state->backtrace_pos;
139
140 res = caml_alloc(len, 0);
141 for (i = 0; i < len; i++)
142 Field(res, i) = Val_backtrace_slot(Caml_state->backtrace_buffer[i]);
143 }
144
145 CAMLreturn(res);
146 }
147
148 /* Copy back a backtrace and exception to the global state.
149 This function should be used only with Printexc.raw_backtrace */
150 /* noalloc (caml value): so no CAMLparam* CAMLreturn* */
151 CAMLprim value caml_restore_raw_backtrace(value exn, value backtrace)
152 {
153 intnat i;
154 mlsize_t bt_size;
155
156 Caml_state->backtrace_last_exn = exn;
157
158 bt_size = Wosize_val(backtrace);
159 if(bt_size > BACKTRACE_BUFFER_SIZE){
160 bt_size = BACKTRACE_BUFFER_SIZE;
161 }
162
163 /* We don't allocate if the backtrace is empty (no -g or backtrace
164 not activated) */
165 if(bt_size == 0){
166 Caml_state->backtrace_pos = 0;
167 return Val_unit;
168 }
169
170 /* Allocate if needed and copy the backtrace buffer */
171 if (Caml_state->backtrace_buffer == NULL &&
172 caml_alloc_backtrace_buffer() == -1) {
173 return Val_unit;
174 }
175
176 Caml_state->backtrace_pos = bt_size;
177 for(i=0; i < Caml_state->backtrace_pos; i++){
178 Caml_state->backtrace_buffer[i] = Backtrace_slot_val(Field(backtrace, i));
179 }
180
181 return Val_unit;
182 }
183
184 #define Val_debuginfo(bslot) (Val_long((uintnat)(bslot)>>1))
185 #define Debuginfo_val(vslot) ((debuginfo)(Long_val(vslot) << 1))
186
187 /* Convert the raw backtrace to a data structure usable from OCaml */
188 static value caml_convert_debuginfo(debuginfo dbg)
189 {
190 CAMLparam0();
191 CAMLlocal2(p, fname);
192 struct caml_loc_info li;
193
194 caml_debuginfo_location(dbg, &li);
195
196 if (li.loc_valid) {
197 fname = caml_copy_string(li.loc_filename);
198 p = caml_alloc_small(6, 0);
199 Field(p, 0) = Val_bool(li.loc_is_raise);
200 Field(p, 1) = fname;
201 Field(p, 2) = Val_int(li.loc_lnum);
202 Field(p, 3) = Val_int(li.loc_startchr);
203 Field(p, 4) = Val_int(li.loc_endchr);
204 Field(p, 5) = Val_bool(li.loc_is_inlined);
205 } else {
206 p = caml_alloc_small(1, 1);
207 Field(p, 0) = Val_bool(li.loc_is_raise);
208 }
209
210 CAMLreturn(p);
211 }
212
213 CAMLprim value caml_convert_raw_backtrace_slot(value slot)
214 {
215 if (!caml_debug_info_available())
216 caml_failwith("No debug information available");
217
218 return (caml_convert_debuginfo(Debuginfo_val(slot)));
219 }
220
221 /* Convert the raw backtrace to a data structure usable from OCaml */
222 CAMLprim value caml_convert_raw_backtrace(value bt)
223 {
224 CAMLparam1(bt);
225 CAMLlocal1(array);
226 intnat i, index;
227
228 if (!caml_debug_info_available())
229 caml_failwith("No debug information available");
230
231 for (i = 0, index = 0; i < Wosize_val(bt); ++i)
232 {
233 debuginfo dbg;
234 for (dbg = caml_debuginfo_extract(Backtrace_slot_val(Field(bt, i)));
235 dbg != NULL;
236 dbg = caml_debuginfo_next(dbg))
237 index++;
238 }
239
240 array = caml_alloc(index, 0);
241
242 for (i = 0, index = 0; i < Wosize_val(bt); ++i)
243 {
244 debuginfo dbg;
245 for (dbg = caml_debuginfo_extract(Backtrace_slot_val(Field(bt, i)));
246 dbg != NULL;
247 dbg = caml_debuginfo_next(dbg))
248 {
249 Store_field(array, index, caml_convert_debuginfo(dbg));
250 index++;
251 }
252 }
253
254 CAMLreturn(array);
255 }
256
257 CAMLprim value caml_raw_backtrace_length(value bt)
258 {
259 return Val_int(Wosize_val(bt));
260 }
261
262 CAMLprim value caml_raw_backtrace_slot(value bt, value index)
263 {
264 uintnat i;
265 debuginfo dbg;
266
267 i = Long_val(index);
268 if (i >= Wosize_val(bt))
269 caml_invalid_argument("Printexc.get_raw_backtrace_slot: "
270 "index out of bounds");
271 dbg = caml_debuginfo_extract(Backtrace_slot_val(Field(bt, i)));
272 return Val_debuginfo(dbg);
273 }
274
275 CAMLprim value caml_raw_backtrace_next_slot(value slot)
276 {
277 debuginfo dbg;
278
279 CAMLparam1(slot);
280 CAMLlocal1(v);
281
282 dbg = Debuginfo_val(slot);
283 dbg = caml_debuginfo_next(dbg);
284
285 if (dbg == NULL)
286 v = Val_int(0); /* None */
287 else
288 {
289 v = caml_alloc(1, 0);
290 Field(v, 0) = Val_debuginfo(dbg);
291 }
292
293 CAMLreturn(v);
294 }
295
296 /* the function below is deprecated: we previously returned directly
297 the OCaml-usable representation, instead of the raw backtrace as an
298 abstract type, but this has a large performance overhead if you
299 store a lot of backtraces and print only some of them.
300
301 It is not used by the Printexc library anymore, or anywhere else in
302 the compiler, but we have kept it in case some user still depends
303 on it as an external. */
304 CAMLprim value caml_get_exception_backtrace(value unit)
305 {
306 CAMLparam0();
307 CAMLlocal3(arr, res, backtrace);
308 intnat i;
309
310 if (!caml_debug_info_available()) {
311 res = Val_int(0); /* None */
312 } else {
313 backtrace = caml_get_exception_raw_backtrace(Val_unit);
314
315 arr = caml_alloc(Wosize_val(backtrace), 0);
316 for (i = 0; i < Wosize_val(backtrace); i++) {
317 backtrace_slot slot = Backtrace_slot_val(Field(backtrace, i));
318 debuginfo dbg = caml_debuginfo_extract(slot);
319 Store_field(arr, i, caml_convert_debuginfo(dbg));
320 }
321
322 res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
323 }
324
325 CAMLreturn(res);
326 }
327
328 CAMLprim value caml_get_current_callstack(value max_frames_value) {
329 CAMLparam1(max_frames_value);
330 CAMLlocal1(res);
331
332 res = caml_alloc(caml_current_callstack_size(Long_val(max_frames_value)), 0);
333 caml_current_callstack_write(res);
334
335 CAMLreturn(res);
336 }
337