l4/pkg/ocaml/contrib/debugger/trap_barrier.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
   6 (*          Objective Caml port by John Malecki and Xavier Leroy       *)
   7 (*                                                                     *)
   8 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   9 (*  en Automatique.  All rights reserved.  This file is distributed    *)
  10 (*  under the terms of the Q Public License version 1.0.               *)
  11 (*                                                                     *)
  12 (***********************************************************************)
  13
  14 (* $Id: trap_barrier.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
  15
  16 (************************** Trap barrier *******************************)
  17
  18 open Debugcom
  19 open Checkpoints
  20
  21 let current_trap_barrier = ref 0
  22
  23 let install_trap_barrier pos =
  24   current_trap_barrier := pos
  25
  26 let remove_trap_barrier () =
  27   current_trap_barrier := 0
  28
  29 (* Ensure the trap barrier state is up to date in current checkpoint. *)
  30 let update_trap_barrier () =
  31   if !current_checkpoint.c_trap_barrier <> !current_trap_barrier then
  32     Exec.protect
  33       (function () ->
  34          set_trap_barrier !current_trap_barrier;
  35          !current_checkpoint.c_trap_barrier <- !current_trap_barrier)
  36
  37 (* Execute `funct' with a trap barrier. *)
  38 (* --- Used by `finish'. *)
  39 let exec_with_trap_barrier trap_barrier funct =
  40   try
  41     install_trap_barrier trap_barrier;
  42     funct ();
  43     remove_trap_barrier ()
  44   with
  45     x ->
  46       remove_trap_barrier ();
  47       raise x