debugger/main.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 open Primitives
  17 open Misc
  18 open Input_handling
  19 open Question
  20 open Command_line
  21 open Debugger_config
  22 open Checkpoints
  23 open Time_travel
  24 open Parameters
  25 open Program_management
  26 open Frames
  27 open Show_information
  28 open Format
  29
  30 let line_buffer = Lexing.from_function read_user_input
  31
  32 let rec loop ppf =
  33   line_loop ppf line_buffer;
  34   if !loaded && (not (yes_or_no "The program is running. Quit anyway")) then
  35     loop ppf
  36
  37 let current_duration = ref (-1L)
  38
  39 let rec protect ppf restart loop =
  40   try
  41     loop ppf
  42   with
  43   | End_of_file ->
  44       protect ppf restart (function ppf ->
  45         forget_process
  46           !current_checkpoint.c_fd
  47           !current_checkpoint.c_pid;
  48         pp_print_flush ppf ();
  49         stop_user_input ();
  50         loop ppf)
  51   | Toplevel ->
  52       protect ppf restart (function ppf ->
  53         pp_print_flush ppf ();
  54         stop_user_input ();
  55         loop ppf)
  56   | Sys.Break ->
  57       protect ppf restart (function ppf ->
  58         fprintf ppf "Interrupted.@.";
  59         Exec.protect (function () ->
  60           stop_user_input ();
  61           if !loaded then begin
  62             try_select_frame 0;
  63             show_current_event ppf;
  64           end);
  65         loop ppf)
  66   | Current_checkpoint_lost ->
  67       protect ppf restart (function ppf ->
  68         fprintf ppf "Trying to recover...@.";
  69         stop_user_input ();
  70         recover ();
  71         try_select_frame 0;
  72         show_current_event ppf;
  73         loop ppf)
  74   | Current_checkpoint_lost_start_at (time, init_duration) ->
  75       protect ppf restart (function ppf ->
  76         let b =
  77           if !current_duration = -1L then begin
  78             let msg = sprintf "Restart from time %Ld and try to get closer of the problem" time in
  79             stop_user_input ();
  80             if yes_or_no msg then
  81               (current_duration := init_duration; true)
  82             else
  83               false
  84             end
  85           else
  86             true in
  87         if b then
  88           begin
  89             go_to time;
  90             current_duration := Int64.div !current_duration 10L;
  91             if !current_duration > 0L then
  92               while true do
  93                 step !current_duration
  94               done
  95             else begin
  96               current_duration := -1L;
  97               stop_user_input ();
  98               show_current_event ppf;
  99               restart ppf;
 100             end
 101           end
 102         else
 103           begin
 104             recover ();
 105             show_current_event ppf;
 106             restart ppf
 107           end)
 108   | x ->
 109       kill_program ();
 110       raise x
 111
 112 let toplevel_loop () = protect Format.std_formatter loop loop
 113
 114 (* Parsing of command-line arguments *)
 115
 116 exception Found_program_name
 117
 118 let anonymous s =
 119   program_name := Unix_tools.make_absolute s; raise Found_program_name
 120 let add_include d =
 121   default_load_path :=
 122     Misc.expand_directory Config.standard_library d :: !default_load_path
 123 let set_socket s =
 124   socket_name := s
 125 let set_checkpoints n =
 126   checkpoint_max_count := n
 127 let set_directory dir =
 128   Sys.chdir dir
 129 let print_version () =
 130   printf "The Objective Caml debugger, version %s@." Sys.ocaml_version;
 131   exit 0;
 132 ;;
 133
 134 let speclist = [
 135    "-c", Arg.Int set_checkpoints,
 136       "<count>  Set max number of checkpoints kept";
 137    "-cd", Arg.String set_directory,
 138       "<dir>  Change working directory";
 139    "-emacs", Arg.Set emacs,
 140       "For running the debugger under emacs";
 141    "-I", Arg.String add_include,
 142       "<dir>  Add <dir> to the list of include directories";
 143    "-s", Arg.String set_socket,
 144       "<filename>  Set the name of the communication socket";
 145    "-version", Arg.Unit print_version,
 146       " Print version and exit";
 147    ]
 148
 149 let main () =
 150   try
 151     socket_name := Filename.concat Filename.temp_dir_name
 152                           ("camldebug" ^ (string_of_int (Unix.getpid ())));
 153     begin try
 154       Arg.parse speclist anonymous "";
 155       Arg.usage speclist
 156         "No program name specified\n\
 157          Usage: ocamldebug [options] <program> [arguments]\n\
 158          Options are:";
 159       exit 2
 160     with Found_program_name ->
 161       for j = !Arg.current + 1 to Array.length Sys.argv - 1 do
 162         arguments := !arguments ^ " " ^ (Filename.quote Sys.argv.(j))
 163       done
 164     end;
 165     current_prompt := debugger_prompt;
 166     printf "\tObjective Caml Debugger version %s@.@." Config.version;
 167     Config.load_path := !default_load_path;
 168     Clflags.recursive_types := true;    (* Allow recursive types. *)
 169     toplevel_loop ();                   (* Toplevel. *)
 170     kill_program ();
 171     exit 0
 172   with
 173     Toplevel ->
 174       exit 2
 175   | Env.Error e ->
 176       eprintf "Debugger [version %s] environment error:@ @[@;" Config.version;
 177       Env.report_error err_formatter e;
 178       eprintf "@]@.";
 179       exit 2
 180
 181 let _ =
 182   Printexc.catch (Unix.handle_unix_error main) ()