debugger/frames.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$ *)
  15
  16 (***************************** Frames **********************************)
  17
  18 open Instruct
  19 open Primitives
  20 open Debugcom
  21 open Checkpoints
  22 open Events
  23 open Symbols
  24
  25 (* Current frame number *)
  26 let current_frame = ref 0
  27
  28 (* Event at selected position *)
  29 let selected_event = ref (None : debug_event option)
  30
  31 (* Selected position in source. *)
  32 (* Raise `Not_found' if not on an event. *)
  33 let selected_point () =
  34   match !selected_event with
  35     None ->
  36       raise Not_found
  37   | Some ev ->
  38       (ev.ev_module, (Events.get_pos ev).Lexing.pos_cnum)
  39
  40 let selected_event_is_before () =
  41   match !selected_event with
  42     None ->
  43       raise Not_found
  44   | Some {ev_kind = Event_before} ->
  45       true
  46   | _ ->
  47       false
  48
  49 (* Move up `frame_count' frames, assuming current frame pointer
  50    corresponds to event `event'. Return event of final frame. *)
  51
  52 let rec move_up frame_count event =
  53   if frame_count <= 0 then event else begin
  54     let (sp, pc) = up_frame event.ev_stacksize in
  55     if sp < 0 then raise Not_found;
  56     move_up (frame_count - 1) (any_event_at_pc pc)
  57   end
  58
  59 (* Select a frame. *)
  60 (* Raise `Not_found' if no such frame. *)
  61 (* --- Assume the current events have already been updated. *)
  62 let select_frame frame_number =
  63   if frame_number < 0 then raise Not_found;
  64   let (initial_sp, _) = get_frame() in
  65   try
  66     match !current_event with
  67       None ->
  68         raise Not_found
  69     | Some curr_event ->
  70         match !selected_event with
  71           Some sel_event when frame_number >= !current_frame ->
  72             selected_event :=
  73               Some(move_up (frame_number - !current_frame) sel_event);
  74             current_frame := frame_number
  75         | _ ->
  76             set_initial_frame();
  77             selected_event := Some(move_up frame_number curr_event);
  78             current_frame := frame_number
  79   with Not_found ->
  80     set_frame initial_sp;
  81     raise Not_found
  82
  83 (* Select a frame. *)
  84 (* Same as `select_frame' but raise no exception if the frame is not found. *)
  85 (* --- Assume the currents events have already been updated. *)
  86 let try_select_frame frame_number =
  87   try
  88     select_frame frame_number
  89   with
  90     Not_found ->
  91       ()
  92
  93 (* Return to default frame (frame 0). *)
  94 let reset_frame () =
  95   set_initial_frame();
  96   selected_event := !current_event;
  97   current_frame := 0
  98
  99 (* Perform a stack backtrace.
 100    Call the given function with the events for each stack frame,
 101    or None if we've encountered a stack frame with no debugging info
 102    attached. Stop when the function returns false, or frame with no
 103    debugging info reached, or top of stack reached. *)
 104
 105 let do_backtrace action =
 106   match !current_event with
 107     None -> Misc.fatal_error "Frames.do_backtrace"
 108   | Some curr_ev ->
 109       let (initial_sp, _) = get_frame() in
 110       set_initial_frame();
 111       let event = ref curr_ev in
 112       begin try
 113         while action (Some !event) do
 114           let (sp, pc) = up_frame !event.ev_stacksize in
 115           if sp < 0 then raise Exit;
 116           event := any_event_at_pc pc
 117         done
 118       with Exit -> ()
 119          | Not_found -> ignore (action None)
 120       end;
 121       set_frame initial_sp
 122
 123 (* Return the number of frames in the stack *)
 124
 125 let stack_depth () =
 126   let num_frames = ref 0 in
 127   do_backtrace (function Some ev -> incr num_frames; true
 128                        | None -> num_frames := -1; false);
 129   !num_frames