aboutsummaryrefslogtreecommitdiff
path: root/lib/backtrace.ml
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2014-12-03 20:34:09 +0100
committerPierre-Marie Pédrot2014-12-16 13:15:12 +0100
commitbff51607cfdda137d7bc55d802895d7f794d5768 (patch)
tree1a159136a88ddc6561b814fb4ecbacdf9de0dd70 /lib/backtrace.ml
parent37ed28dfe253615729763b5d81a533094fb5425e (diff)
Getting rid of Exninfo hacks.
Instead of modifying exceptions to wear additional information, we instead use a dedicated type now. All exception-using functions were modified to support this new type, in particular Future's fix_exn-s and the tactic monad. To solve the problem of enriching exceptions at raise time and recover this data in the try-with handler, we use a global datastructure recording the given piece of data imperatively that we retrieve in the try-with handler. We ensure that such instrumented try-with destroy the data so that there may not be confusion with another exception. To further harden the correction of this structure, we also check for pointer equality with the last raised exception. The global data structure is not thread-safe for now, which is incorrect as the STM uses threads and enriched exceptions. Yet, we splitted the patch in two parts, so that we do not introduce dependencies to the Thread library immediatly. This will allow to revert only the second patch if ever we switch to OCaml-coded lightweight threads.
Diffstat (limited to 'lib/backtrace.ml')
-rw-r--r--lib/backtrace.ml13
1 files changed, 9 insertions, 4 deletions
diff --git a/lib/backtrace.ml b/lib/backtrace.ml
index 19b07d8767..b3b8bdea2e 100644
--- a/lib/backtrace.ml
+++ b/lib/backtrace.ml
@@ -84,18 +84,23 @@ let get_backtrace e =
let add_backtrace e =
if !is_recording then
+ (** This must be the first function call, otherwise the stack may be
+ destroyed *)
let current = get_exception_backtrace () in
+ let info = Exninfo.info e in
begin match current with
- | None -> e
+ | None -> (e, info)
| Some fragment ->
- let bt = match get_backtrace e with
+ let bt = match get_backtrace info with
| None -> []
| Some bt -> bt
in
let bt = fragment :: bt in
- Exninfo.add e backtrace bt
+ (e, Exninfo.add info backtrace bt)
end
- else e
+ else
+ let info = Exninfo.info e in
+ (e, info)
let app_backtrace ~src ~dst =
if !is_recording then