summaryrefslogtreecommitdiff
path: root/debugger/main.ml
blob: 299c28ad9f937580c268c304368928db354a02ef (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
(*          Objective Caml port by John Malecki and Xavier Leroy       *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the Q Public License version 1.0.               *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

open Primitives
open Misc
open Input_handling
open Command_line
open Debugger_config
open Checkpoints
open Time_travel
open Parameters
open Program_management
open Frames
open Show_information


let line_buffer = Lexing.from_function read_user_input

let rec loop () =
  line_loop line_buffer;
  if !loaded & (not (yes_or_no "The program is running. Quit anyway")) then
    loop ()

let rec protect cont =
  try
    cont ()
  with
    End_of_file ->
      protect (function () ->
        forget_process
          !current_checkpoint.c_fd
          !current_checkpoint.c_pid;
        flush stdout;
        stop_user_input ();
        loop ())
  | Toplevel ->
      protect (function () ->
        flush stdout;
        stop_user_input ();
        loop ())
  | Sys.Break ->
      protect (function () ->
        print_endline "Interrupted.";
        Exec.protect (function () ->
          flush stdout;
          stop_user_input ();
          if !loaded then begin
            try_select_frame 0;
            show_current_event ()
          end);
        loop ())
  | Current_checkpoint_lost ->
      protect (function () ->
        print_endline "Trying to recover...";
        flush stdout;
        stop_user_input ();
        recover ();
        try_select_frame 0;
        show_current_event ();
        loop ())
  | x ->
      kill_program ();
      raise x

let toplevel_loop () = protect loop

(* Parsing of command-line arguments *)

exception Found_program_name

let anonymous s =
  program_name := s; raise Found_program_name
let add_include d =
  default_load_path := d :: !default_load_path
let set_socket s =
  socket_name := s
let set_checkpoints n =
  checkpoint_max_count := n
let set_directory dir =
  Sys.chdir dir
let set_emacs () =
  emacs := true

let speclist =
  ["-I", Arg.String add_include,
      "<dir>  Add <dir> to the list of include directories";
   "-s", Arg.String set_socket,
      "<filename>  Set the name of the communication socket";
   "-c", Arg.Int set_checkpoints,
      "<count>  Set max number of checkpoints kept";
   "-cd", Arg.String set_directory,
      "<dir>  Change working directory";
   "-emacs", Arg.Unit set_emacs,
      "For running the debugger under emacs"]

let main () =
  try
    socket_name := "/tmp/camldebug" ^ (string_of_int (Unix.getpid ()));
    begin try
      Arg.parse speclist anonymous "";
      Arg.usage speclist
        "No program name specified\n\
         Usage: ocamldebug [options] <program> [arguments]\n\
         Options are:";
      exit 2
    with Found_program_name ->
      for j = !Arg.current + 1 to Array.length Sys.argv - 1 do
        arguments := Printf.sprintf "%s '%s'" !arguments Sys.argv.(j)
      done
    end;
    current_prompt := debugger_prompt;
    print_string "\tObjective Caml Debugger version ";
    print_string Config.version;
    print_newline(); print_newline();
    Config.load_path := !default_load_path;
    toplevel_loop ();                   (* Toplevel. *)
    kill_program ();
    exit 0
  with Toplevel ->
    exit 2

let _ =
  Printexc.catch (Unix.handle_unix_error main) ()