Dynlink support for ocamldebug

This commit adds dynlink support for ocamldebug. As a side effect, it also:
  - factorizes the various functions searching for a code fragment into one,
    called [caml_find_code_fragment];
  - removes the [caml_register_code_fragment], which does not seem to
    be used anywhere, and which clearly should not be used by external code.

27 files changed, 420 insertions, 260 deletions

diff --git a/debugger/.depend b/debugger/.depend
index 114bd380e3..5fdc17ea7e 100644
--- a/debugger/.depend
+++ b/debugger/.depend
@@ -2,8 +2,11 @@ breakpoints.cmo : \
     symbols.cmi \
     pos.cmi \
     parameters.cmi \
+    ../utils/misc.cmi \
     ../bytecomp/instruct.cmi \
     exec.cmi \
+    events.cmi \
+    debugger_config.cmi \
     debugcom.cmi \
     checkpoints.cmi \
     breakpoints.cmi
@@ -11,13 +14,17 @@ breakpoints.cmx : \
     symbols.cmx \
     pos.cmx \
     parameters.cmx \
+    ../utils/misc.cmx \
     ../bytecomp/instruct.cmx \
     exec.cmx \
+    events.cmx \
+    debugger_config.cmx \
     debugcom.cmx \
     checkpoints.cmx \
     breakpoints.cmi
 breakpoints.cmi : \
-    ../bytecomp/instruct.cmi
+    events.cmi \
+    debugcom.cmi
 checkpoints.cmo : \
     primitives.cmi \
     int64ops.cmi \
@@ -112,16 +119,19 @@ debugcom.cmo : \
     primitives.cmi \
     ../utils/misc.cmi \
     int64ops.cmi \
+    ../bytecomp/instruct.cmi \
     input_handling.cmi \
     debugcom.cmi
 debugcom.cmx : \
     primitives.cmx \
     ../utils/misc.cmx \
     int64ops.cmx \
+    ../bytecomp/instruct.cmx \
     input_handling.cmx \
     debugcom.cmi
 debugcom.cmi : \
-    primitives.cmi
+    primitives.cmi \
+    ../bytecomp/instruct.cmi
 debugger_config.cmo : \
     int64ops.cmi \
     debugger_config.cmi
@@ -143,6 +153,7 @@ eval.cmo : \
     ../bytecomp/instruct.cmi \
     ../typing/ident.cmi \
     frames.cmi \
+    events.cmi \
     ../typing/env.cmi \
     debugcom.cmi \
     ../typing/ctype.cmi \
@@ -162,6 +173,7 @@ eval.cmx : \
     ../bytecomp/instruct.cmx \
     ../typing/ident.cmx \
     frames.cmx \
+    events.cmx \
     ../typing/env.cmx \
     debugcom.cmx \
     ../typing/ctype.cmx \
@@ -172,8 +184,8 @@ eval.cmi : \
     ../typing/path.cmi \
     parser_aux.cmi \
     ../parsing/longident.cmi \
-    ../bytecomp/instruct.cmi \
     ../typing/ident.cmi \
+    events.cmi \
     ../typing/env.cmi \
     debugcom.cmi
 events.cmo : \
@@ -206,7 +218,7 @@ frames.cmx : \
     debugcom.cmx \
     frames.cmi
 frames.cmi : \
-    ../bytecomp/instruct.cmi
+    events.cmi
 history.cmo : \
     primitives.cmi \
     int64ops.cmi \
@@ -340,18 +352,21 @@ parser.cmo : \
     ../parsing/longident.cmi \
     int64ops.cmi \
     input_handling.cmi \
+    debugcom.cmi \
     parser.cmi
 parser.cmx : \
     parser_aux.cmi \
     ../parsing/longident.cmx \
     int64ops.cmx \
     input_handling.cmx \
+    debugcom.cmx \
     parser.cmi
 parser.cmi : \
     parser_aux.cmi \
     ../parsing/longident.cmi
 parser_aux.cmi : \
-    ../parsing/longident.cmi
+    ../parsing/longident.cmi \
+    debugcom.cmi
 pattern_matching.cmo : \
     ../typing/typedtree.cmi \
     parser_aux.cmi \
@@ -375,13 +390,15 @@ pattern_matching.cmi : \
 pos.cmo : \
     ../parsing/location.cmi \
     ../bytecomp/instruct.cmi \
+    events.cmi \
     pos.cmi
 pos.cmx : \
     ../parsing/location.cmx \
     ../bytecomp/instruct.cmx \
+    events.cmx \
     pos.cmi
 pos.cmi : \
-    ../bytecomp/instruct.cmi
+    events.cmi
 primitives.cmo : \
     $(UNIXDIR)/unix.cmi \
     primitives.cmi
@@ -511,7 +528,7 @@ show_information.cmx : \
     breakpoints.cmx \
     show_information.cmi
 show_information.cmi : \
-    ../bytecomp/instruct.cmi
+    events.cmi
 show_source.cmo : \
     source.cmi \
     primitives.cmi \
@@ -568,7 +585,9 @@ symbols.cmx : \
     ../bytecomp/bytesections.cmx \
     symbols.cmi
 symbols.cmi : \
-    ../bytecomp/instruct.cmi
+    ../bytecomp/instruct.cmi \
+    events.cmi \
+    debugcom.cmi
 time_travel.cmo : \
     trap_barrier.cmi \
     symbols.cmi \
diff --git a/debugger/breakpoints.ml b/debugger/breakpoints.ml
index 4751bde6bb..dfbf410091 100644
--- a/debugger/breakpoints.ml
+++ b/debugger/breakpoints.ml
@@ -19,6 +19,7 @@
 open Checkpoints
 open Debugcom
 open Instruct
+open Events
 open Printf
 
 (*** Debugging. ***)
@@ -30,10 +31,11 @@ let debug_breakpoints = ref false
 let breakpoint_number = ref 0
 
 (* Breakpoint number -> event. *)
-let breakpoints = ref ([] : (int * debug_event) list)
+type breakpoint_id = int
+let breakpoints = ref ([] : (breakpoint_id * code_event) list)
 
 (* Program counter -> breakpoint count. *)
-let positions = ref ([] : (int * int ref) list)
+let positions = ref ([] : (pc * int ref) list)
 
 (* Versions of the breakpoint list. *)
 let current_version = ref 0
@@ -58,17 +60,17 @@ let breakpoints_count () =
 
 (* List of breakpoints at `pc'. *)
 let rec breakpoints_at_pc pc =
-  begin try
-    let ev = Symbols.event_at_pc pc in
-    match ev.ev_repr with
-      Event_child {contents = pc'} -> breakpoints_at_pc pc'
-    | _                            -> []
-  with Not_found ->
-   []
+  begin match Symbols.event_at_pc pc with
+  | {ev_frag = frag; ev_ev = {ev_repr = Event_child {contents = pos}}} ->
+     breakpoints_at_pc {frag; pos}
+  | _ -> []
+  | exception Not_found -> []
   end
     @
-  List.map fst (List.filter (function (_, {ev_pos = pos}) -> pos = pc)
-                            !breakpoints)
+  List.map fst (List.filter
+                  (function (_, {ev_frag = frag; ev_ev = {ev_pos = pos}}) ->
+                            {frag; pos} = pc)
+                  !breakpoints)
 
 (* Is there a breakpoint at `pc' ? *)
 let breakpoint_at_pc pc =
@@ -76,32 +78,28 @@ let breakpoint_at_pc pc =
 
 (*** Set and remove breakpoints ***)
 
+let print_pc out {frag;pos} = fprintf out "%d:%d" frag pos
+
 (* Remove all breakpoints. *)
-let remove_breakpoints pos =
+let remove_breakpoints pcs =
   if !debug_breakpoints then
-    (print_string "Removing breakpoints..."; print_newline ());
+    printf "Removing breakpoints...\n%!";
   List.iter
-    (function (pos, _) ->
-       if !debug_breakpoints then begin
-         print_int pos;
-         print_newline()
-       end;
-       reset_instr pos;
-       Symbols.set_event_at_pc pos)
-    pos
+    (function (pc, _) ->
+       if !debug_breakpoints then printf "%a\n%!" print_pc pc;
+       reset_instr pc;
+       Symbols.set_event_at_pc pc)
+    pcs
 
 (* Set all breakpoints. *)
-let set_breakpoints pos =
+let set_breakpoints pcs =
   if !debug_breakpoints then
-    (print_string "Setting breakpoints..."; print_newline ());
+    printf "Setting breakpoints...\n%!";
   List.iter
-    (function (pos, _) ->
-       if !debug_breakpoints then begin
-         print_int pos;
-         print_newline()
-       end;
-       set_breakpoint pos)
-    pos
+    (function (pc, _) ->
+       if !debug_breakpoints then printf "%a\n%!" print_pc pc;
+       set_breakpoint pc)
+    pcs
 
 (* Ensure the current version is installed in current checkpoint. *)
 let update_breakpoints () =
@@ -119,25 +117,13 @@ let update_breakpoints () =
          set_breakpoints !positions;
          copy_breakpoints ())
 
-let change_version version pos =
-  Exec.protect
-    (function () ->
-       current_version := version;
-       positions := pos)
-
 (* Execute given function with no breakpoint in current checkpoint. *)
 (* --- `goto' runs faster this way (does not stop on each breakpoint). *)
 let execute_without_breakpoints f =
-  let version = !current_version
-  and pos = !positions
-  in
-    change_version 0 [];
-    try
-      f ();
-      change_version version pos
-    with
-      _ ->
-        change_version version pos
+  Misc.protect_refs [Misc.R (Debugger_config.break_on_load, false);
+                     Misc.R (current_version, 0);
+                     Misc.R (positions, [])]
+                    f
 
 (* Add a position in the position list. *)
 (* Change version if necessary. *)
@@ -160,37 +146,33 @@ let remove_position pos =
     end
 
 (* Insert a new breakpoint in lists. *)
-let rec new_breakpoint =
-  function
-    {ev_repr = Event_child pc} ->
-      new_breakpoint (Symbols.any_event_at_pc !pc)
-  | event ->
-      Exec.protect
-        (function () ->
-           incr breakpoint_number;
-           insert_position event.ev_pos;
-           breakpoints := (!breakpoint_number, event) :: !breakpoints);
-      if !Parameters.breakpoint then begin
-        printf "Breakpoint %d at %d: %s" !breakpoint_number event.ev_pos
-               (Pos.get_desc event);
-        print_newline ()
-      end
+let rec new_breakpoint event =
+  match event with
+    {ev_frag=frag; ev_ev={ev_repr=Event_child pos}} ->
+      new_breakpoint (Symbols.any_event_at_pc {frag; pos=(!pos)})
+  | {ev_frag=frag; ev_ev={ev_pos=pos}} ->
+    let pc = {frag; pos} in
+    Exec.protect
+      (function () ->
+         incr breakpoint_number;
+         insert_position pc;
+         breakpoints := (!breakpoint_number, event) :: !breakpoints);
+    if !Parameters.breakpoint then
+      printf "Breakpoint %d at %a: %s\n%!" !breakpoint_number print_pc pc
+             (Pos.get_desc event)
 
 (* Remove a breakpoint from lists. *)
 let remove_breakpoint number =
   try
     let ev = List.assoc number !breakpoints in
-    let pos = ev.ev_pos in
-      Exec.protect
-        (function () ->
-           breakpoints := List.remove_assoc number !breakpoints;
-           remove_position pos;
-           if !Parameters.breakpoint then begin
-             printf "Removed breakpoint %d at %d: %s" number ev.ev_pos
-                    (Pos.get_desc ev);
-             print_newline ()
-           end
-        )
+    let pc = {frag = ev.ev_frag; pos=ev.ev_ev.ev_pos} in
+    Exec.protect
+      (function () ->
+         breakpoints := List.remove_assoc number !breakpoints;
+         remove_position pc;
+         if !Parameters.breakpoint then
+           printf "Removed breakpoint %d at %a: %s\n%!" number print_pc pc
+                  (Pos.get_desc ev))
   with
     Not_found ->
       prerr_endline ("No breakpoint number " ^ (Int.to_string number) ^ ".");
@@ -202,7 +184,7 @@ let remove_all_breakpoints () =
 (*** Temporary breakpoints. ***)
 
 (* Temporary breakpoint position. *)
-let temporary_breakpoint_position = ref (None : int option)
+let temporary_breakpoint_position = ref (None : pc option)
 
 (* Execute `funct' with a breakpoint added at `pc'. *)
 (* --- Used by `finish'. *)
diff --git a/debugger/breakpoints.mli b/debugger/breakpoints.mli
index be1baf12f9..623c0ef3fb 100644
--- a/debugger/breakpoints.mli
+++ b/debugger/breakpoints.mli
@@ -16,8 +16,6 @@
 
 (******************************* Breakpoints ***************************)
 
-open Instruct
-
 (*** Debugging. ***)
 val debug_breakpoints : bool ref
 
@@ -25,14 +23,15 @@ val debug_breakpoints : bool ref
 
 val breakpoints_count : unit -> int
 
-(* Breakpoint number -> debug_event_kind. *)
-val breakpoints : (int * debug_event) list ref
+(* Breakpoint number -> code_event. *)
+type breakpoint_id = int
+val breakpoints : (breakpoint_id * Events.code_event) list ref
 
 (* Is there a breakpoint at `pc' ? *)
-val breakpoint_at_pc : int -> bool
+val breakpoint_at_pc : Debugcom.pc -> bool
 
 (* List of breakpoints at `pc'. *)
-val breakpoints_at_pc : int -> int list
+val breakpoints_at_pc : Debugcom.pc -> int list
 
 (*** Set and remove breakpoints ***)
 
@@ -44,7 +43,7 @@ val update_breakpoints : unit -> unit
 val execute_without_breakpoints : (unit -> unit) -> unit
 
 (* Insert a new breakpoint in lists. *)
-val new_breakpoint : debug_event -> unit
+val new_breakpoint : Events.code_event -> unit
 
 (* Remove a breakpoint from lists. *)
 val remove_breakpoint : int -> unit
@@ -54,8 +53,8 @@ val remove_all_breakpoints : unit -> unit
 (*** Temporary breakpoints. ***)
 
 (* Temporary breakpoint position. *)
-val temporary_breakpoint_position : int option ref
+val temporary_breakpoint_position : Debugcom.pc option ref
 
 (* Execute `funct' with a breakpoint added at `pc'. *)
 (* --- Used by `finish'. *)
-val exec_with_temporary_breakpoint : int -> (unit -> unit) -> unit
+val exec_with_temporary_breakpoint : Debugcom.pc -> (unit -> unit) -> unit
diff --git a/debugger/checkpoints.ml b/debugger/checkpoints.ml
index 7ab8de728f..b78961408b 100644
--- a/debugger/checkpoints.ml
+++ b/debugger/checkpoints.ml
@@ -43,8 +43,9 @@ type checkpoint = {
   mutable c_state : checkpoint_state;
   mutable c_parent : checkpoint;
   mutable c_breakpoint_version : int;
-  mutable c_breakpoints : (int * int ref) list;
-  mutable c_trap_barrier : int
+  mutable c_breakpoints : (pc * int ref) list;
+  mutable c_trap_barrier : int;
+  mutable c_code_fragments : int list
   }
 
 (*** Pseudo-checkpoint `root'. ***)
@@ -59,7 +60,8 @@ let rec root = {
   c_parent = root;
   c_breakpoint_version = 0;
   c_breakpoints = [];
-  c_trap_barrier = 0
+  c_trap_barrier = 0;
+  c_code_fragments = [0]
   }
 
 (*** Current state ***)
@@ -75,12 +77,14 @@ let current_time () =
 let current_report () =
   !current_checkpoint.c_report
 
-let current_pc () =
-  match current_report () with
-    None | Some {rep_type = Exited | Uncaught_exc} -> None
-  | Some {rep_program_pointer = pc } -> Some pc
-
 let current_pc_sp () =
+  (* This pattern matching mimics the test used in debugger.c for
+     deciding whether or not PC/SP should be sent with the report.
+     See debugger.c, the [if] statement above the [command_loop]
+     label. *)
   match current_report () with
-    None | Some {rep_type = Exited | Uncaught_exc} -> None
-  | Some {rep_program_pointer = pc; rep_stack_pointer = sp } -> Some (pc, sp)
+  | Some {rep_type = Event | Breakpoint;
+          rep_program_pointer = pc; rep_stack_pointer = sp } -> Some (pc, sp)
+  | _ -> None
+
+let current_pc () = Option.map fst (current_pc_sp ())
diff --git a/debugger/checkpoints.mli b/debugger/checkpoints.mli
index f3ca13808b..d02240ee6a 100644
--- a/debugger/checkpoints.mli
+++ b/debugger/checkpoints.mli
@@ -42,8 +42,9 @@ type checkpoint =
    mutable c_state : checkpoint_state;
    mutable c_parent : checkpoint;
    mutable c_breakpoint_version : int;
-   mutable c_breakpoints : (int * int ref) list;
-   mutable c_trap_barrier : int}
+   mutable c_breakpoints : (pc * int ref) list;
+   mutable c_trap_barrier : int;
+   mutable c_code_fragments : int list}
 
 (*** Pseudo-checkpoint `root'. ***)
 (* --- Parents of all checkpoints which have no parent. *)
@@ -55,5 +56,5 @@ val current_checkpoint : checkpoint ref
 
 val current_time : unit -> int64
 val current_report : unit -> report option
-val current_pc : unit -> int option
-val current_pc_sp : unit -> (int * int) option
+val current_pc : unit -> pc option
+val current_pc_sp : unit -> (pc * int) option
diff --git a/debugger/command_line.ml b/debugger/command_line.ml
index 0cd25ccb25..b9bc9d2f84 100644
--- a/debugger/command_line.ml
+++ b/debugger/command_line.ml
@@ -126,14 +126,15 @@ let add_breakpoint_at_pc pc =
     new_breakpoint (any_event_at_pc pc)
   with
   | Not_found ->
-    eprintf "Can\'t add breakpoint at pc %i: no event there.@." pc;
+    eprintf "Can\'t add breakpoint at pc %i:%i: no event there.@."
+            pc.frag pc.pos;
     raise Toplevel
 
 let add_breakpoint_after_pc pc =
   let rec try_add n =
     if n < 3 then begin
       try
-        new_breakpoint (any_event_at_pc (pc + n * 4))
+        new_breakpoint (any_event_at_pc {pc with pos = pc.pos + n * 4})
       with
       | Not_found ->
         try_add (n+1)
@@ -156,11 +157,8 @@ let convert_module mdle =
                               then Filename.chop_suffix m ".ml"
                               else m)
   | None ->
-      try
-        (get_current_event ()).ev_module
-      with
-      | Not_found ->
-          error "Not in a module."
+      try (get_current_event ()).ev_ev.ev_module
+      with Not_found -> error "Not in a module."
 
 (** Toplevel. **)
 let current_line = ref ""
@@ -303,7 +301,7 @@ let instr_run ppf lexbuf =
   ensure_loaded ();
   reset_named_values ();
   run ();
-  show_current_event ppf;;
+  show_current_event ppf
 
 let instr_reverse ppf lexbuf =
   eol lexbuf;
@@ -502,7 +500,7 @@ let env_of_event =
   function
     None    -> Env.empty
   | Some ev ->
-      Envaux.env_from_summary ev.Instruct.ev_typenv ev.Instruct.ev_typsubst
+      Envaux.env_from_summary ev.ev_ev.ev_typenv ev.ev_ev.ev_typsubst
 
 let print_command depth ppf lexbuf =
   let exprs = expression_list_eol Lexer.lexeme lexbuf in
@@ -613,8 +611,8 @@ let instr_break ppf lexbuf =
              new_breakpoint ev
          | None ->
              error "Can\'t add breakpoint at this point.")
-    | BA_pc pc ->                               (* break PC *)
-        add_breakpoint_at_pc pc
+    | BA_pc {frag; pos} ->                      (* break PC *)
+        add_breakpoint_at_pc {frag; pos}
     | BA_function expr ->                       (* break FUNCTION *)
         let env =
           try
@@ -644,7 +642,7 @@ let instr_break ppf lexbuf =
             let ev =  event_at_pos module_name 0 in
             let ev_pos =
               {Lexing.dummy_pos with
-               pos_fname = (Events.get_pos ev).pos_fname} in
+               pos_fname = (Events.get_pos ev.ev_ev).pos_fname} in
              let buffer =
                try get_buffer ev_pos module_name with
                | Not_found ->
@@ -703,7 +701,7 @@ let instr_backtrace ppf lexbuf =
     | Some x -> x in
   ensure_loaded ();
   match current_report() with
-  | None | Some {rep_type = Exited | Uncaught_exc} -> ()
+  | None | Some {rep_type = Exited | Uncaught_exc | Code_loaded _} -> ()
   | Some _ ->
       let frame_counter = ref 0 in
       let print_frame first_frame last_frame = function
@@ -936,8 +934,8 @@ let info_checkpoints ppf lexbuf =
           !checkpoints))
 
 let info_one_breakpoint ppf (num, ev) =
-  fprintf ppf "%3d %10d  %s@." num ev.ev_pos (Pos.get_desc ev);
-;;
+  fprintf ppf "%3d %d:%10d  %s@." num ev.ev_frag ev.ev_ev.ev_pos
+          (Pos.get_desc ev)
 
 let info_breakpoints ppf lexbuf =
   eol lexbuf;
@@ -946,7 +944,7 @@ let info_breakpoints ppf lexbuf =
     fprintf ppf "Num    Address  Where@.";
     List.iter (info_one_breakpoint ppf) (List.rev !breakpoints);
   end
-;;
+
 
 let info_events _ppf lexbuf =
   ensure_loaded ();
@@ -955,6 +953,7 @@ let info_events _ppf lexbuf =
   in
     print_endline ("Module: " ^ mdle);
     print_endline "   Address  Characters        Kind      Repr.";
+    let frag, events = events_in_module mdle in
     List.iter
       (function ev ->
         let start_char, end_char =
@@ -966,7 +965,8 @@ let info_events _ppf lexbuf =
             ev.ev_loc.Location.loc_start.Lexing.pos_cnum,
             ev.ev_loc.Location.loc_end.Lexing.pos_cnum in
         Printf.printf
-           "%10d %6d-%-6d  %10s %10s\n"
+           "%d:%10d %6d-%-6d  %10s %10s\n"
+           frag
            ev.ev_pos
            start_char
            end_char
@@ -983,7 +983,7 @@ let info_events _ppf lexbuf =
               Event_none        -> ""
             | Event_parent _    -> "(repr)"
             | Event_child repr  -> Int.to_string !repr))
-      (events_in_module mdle)
+      events
 
 (** User-defined printers **)
 
@@ -1093,10 +1093,14 @@ Argument N means do this N times (or till program stops for another reason)." };
      (* Breakpoints *)
      { instr_name = "break"; instr_prio = false;
        instr_action = instr_break; instr_repeat = false; instr_help =
-"Set breakpoint at specified line or function.\
-\nSyntax: break function-name\
+"Set breakpoint.\
+\nSyntax: break\
+\n        break function-name\
 \n        break @ [module] linenum\
-\n        break @ [module] # characternum" };
+\n        break @ [module] linenum columnnum\
+\n        break @ [module] # characternum\
+\n        break frag:pc\
+\n        break pc" };
      { instr_name = "delete"; instr_prio = false;
        instr_action = instr_delete; instr_repeat = false; instr_help =
 "delete some breakpoints.\n\
@@ -1214,7 +1218,11 @@ It can be either:\n\
 "process to follow after forking.\n\
 It can be either :\n\
   child: the newly created process.\n\
-  parent: the process that called fork.\n" }];
+  parent: the process that called fork.\n" };
+     { var_name = "break_on_load";
+       var_action = boolean_variable false break_on_load;
+       var_help =
+"whether to stop after loading new code (e.g. with Dynlink)." }];
 
   info_list :=
     (* info name, function, help *)
diff --git a/debugger/debugcom.ml b/debugger/debugcom.ml
index e828ec4e2b..f9f8164f84 100644
--- a/debugger/debugcom.ml
+++ b/debugger/debugcom.ml
@@ -45,16 +45,23 @@ let set_current_connection io_chan =
 
 (* Modify the program code *)
 
-let set_event pos =
+type pc =
+  { frag : int;
+    pos : int; }
+
+let set_event {frag; pos} =
   output_char !conn.io_out 'e';
+  output_binary_int !conn.io_out frag;
   output_binary_int !conn.io_out pos
 
-let set_breakpoint pos =
+let set_breakpoint {frag; pos} =
   output_char !conn.io_out 'B';
+  output_binary_int !conn.io_out frag;
   output_binary_int !conn.io_out pos
 
-let reset_instr pos =
+let reset_instr {frag; pos} =
   output_char !conn.io_out 'i';
+  output_binary_int !conn.io_out frag;
   output_binary_int !conn.io_out pos
 
 (* Basic commands for flow control *)
@@ -65,12 +72,15 @@ type execution_summary =
   | Exited
   | Trap_barrier
   | Uncaught_exc
+  | Debug_info of Instruct.debug_event list array
+  | Code_loaded of int
+  | Code_unloaded of int
 
 type report = {
   rep_type : execution_summary;
-  rep_event_count : int;
+  rep_event_count : int64;
   rep_stack_pointer : int;
-  rep_program_pointer : int
+  rep_program_pointer : pc
 }
 
 type checkpoint_report =
@@ -95,24 +105,33 @@ let do_go_smallint n =
          | 'x' -> Exited
          | 's' -> Trap_barrier
          | 'u' -> Uncaught_exc
-         |  _  -> Misc.fatal_error "Debugcom.do_go" in
+         | 'D' -> Debug_info (input_value !conn.io_in :
+                                Instruct.debug_event list array)
+         | 'L' -> Code_loaded (input_binary_int !conn.io_in)
+         | 'U' -> Code_unloaded (input_binary_int !conn.io_in)
+         |  c  -> Misc.fatal_error (Printf.sprintf "Debugcom.do_go %c" c)
+       in
        let event_counter = input_binary_int !conn.io_in in
        let stack_pos = input_binary_int !conn.io_in in
-       let pc = input_binary_int !conn.io_in in
+       let frag = input_binary_int !conn.io_in in
+       let pos = input_binary_int !conn.io_in in
        { rep_type = summary;
-         rep_event_count = event_counter;
+         rep_event_count = Int64.of_int event_counter;
          rep_stack_pointer = stack_pos;
-         rep_program_pointer = pc })
+         rep_program_pointer = {frag; pos} })
 
 let rec do_go n =
   assert (n >= _0);
-  if n > max_small_int then(
-    ignore (do_go_smallint max_int);
-    do_go (n -- max_small_int)
-  )else(
+  if n > max_small_int then
+    begin match do_go_smallint max_int with
+    | { rep_type = Event } ->
+      do_go (n -- max_small_int)
+    | report ->
+      { report with
+        rep_event_count = report.rep_event_count ++ (n -- max_small_int) }
+    end
+  else
     do_go_smallint (Int64.to_int n)
-  )
-;;
 
 (* Perform a checkpoint *)
 
@@ -148,8 +167,9 @@ let initial_frame () =
   output_char !conn.io_out '0';
   flush !conn.io_out;
   let stack_pos = input_binary_int !conn.io_in in
-  let pc = input_binary_int !conn.io_in in
-  (stack_pos, pc)
+  let frag = input_binary_int !conn.io_in in
+  let pos = input_binary_int !conn.io_in in
+  (stack_pos, {frag; pos})
 
 let set_initial_frame () =
   ignore(initial_frame ())
@@ -163,8 +183,14 @@ let up_frame stacksize =
   output_binary_int !conn.io_out stacksize;
   flush !conn.io_out;
   let stack_pos = input_binary_int !conn.io_in in
-  let pc = if stack_pos = -1 then 0 else input_binary_int !conn.io_in in
-  (stack_pos, pc)
+  let frag, pos =
+    if stack_pos = -1
+    then 0, 0
+    else let frag = input_binary_int !conn.io_in in
+         let pos = input_binary_int !conn.io_in in
+         frag, pos
+  in
+  (stack_pos, { frag; pos })
 
 (* Get and set the current frame position *)
 
@@ -172,8 +198,9 @@ let get_frame () =
   output_char !conn.io_out 'f';
   flush !conn.io_out;
   let stack_pos = input_binary_int !conn.io_in in
-  let pc = input_binary_int !conn.io_in in
-  (stack_pos, pc)
+  let frag = input_binary_int !conn.io_in in
+  let pos = input_binary_int !conn.io_in in
+  (stack_pos, {frag; pos})
 
 let set_frame stack_pos =
   output_char !conn.io_out 'S';
@@ -308,7 +335,9 @@ module Remote_value =
         output_char !conn.io_out 'C';
         output_remote_value !conn.io_out v;
         flush !conn.io_out;
-        input_binary_int !conn.io_in
+        let frag = input_binary_int !conn.io_in in
+        let pos = input_binary_int !conn.io_in in
+        {frag;pos}
 
     let same rv1 rv2 =
       match (rv1, rv2) with
diff --git a/debugger/debugcom.mli b/debugger/debugcom.mli
index 4091362613..0b6eb30fcd 100644
--- a/debugger/debugcom.mli
+++ b/debugger/debugcom.mli
@@ -16,18 +16,25 @@
 
 (* Low-level communication with the debuggee *)
 
+type pc =
+  { frag : int;
+    pos : int; }
+
 type execution_summary =
     Event
   | Breakpoint
   | Exited
   | Trap_barrier
   | Uncaught_exc
+  | Debug_info of Instruct.debug_event list array
+  | Code_loaded of int
+  | Code_unloaded of int
 
 type report =
   { rep_type : execution_summary;
-    rep_event_count : int;
+    rep_event_count : int64;
     rep_stack_pointer : int;
-    rep_program_pointer : int }
+    rep_program_pointer : pc }
 
 type checkpoint_report =
     Checkpoint_done of int
@@ -41,13 +48,13 @@ type follow_fork_mode =
 val set_current_connection : Primitives.io_channel -> unit
 
 (* Put an event at given pc *)
-val set_event : int -> unit
+val set_event : pc -> unit
 
 (* Put a breakpoint at given pc *)
-val set_breakpoint : int -> unit
+val set_breakpoint : pc -> unit
 
 (* Remove breakpoint or event at given pc *)
-val reset_instr : int -> unit
+val reset_instr : pc -> unit
 
 (* Create a new checkpoint (the current process forks). *)
 val do_checkpoint : unit -> checkpoint_report
@@ -63,12 +70,12 @@ val wait_child : Primitives.io_channel -> unit
 
 (* Move to initial frame (that of current function). *)
 (* Return stack position and current pc *)
-val initial_frame : unit -> int * int
+val initial_frame : unit -> int * pc
 val set_initial_frame : unit -> unit
 
 (* Get the current frame position *)
 (* Return stack position and current pc *)
-val get_frame : unit -> int * int
+val get_frame : unit -> int * pc
 
 (* Set the current frame *)
 val set_frame : int -> unit
@@ -76,7 +83,7 @@ val set_frame : int -> unit
 (* Move up one frame *)
 (* Return stack position and current pc.
    If there's no frame above, return (-1, 0). *)
-val up_frame : int -> int * int
+val up_frame : int -> int * pc
 
 (* Set the trap barrier to given stack position. *)
 val set_trap_barrier : int -> unit
@@ -109,7 +116,7 @@ module Remote_value :
     val from_environment : int -> t
     val global : int -> t
     val accu : unit -> t
-    val closure_code : t -> int
+    val closure_code : t -> pc
 
     (* Returns a hexadecimal representation of the remote address,
        or [""] if the value is local. *)
diff --git a/debugger/debugger_config.ml b/debugger/debugger_config.ml
index 3996d221e9..9677bb0c51 100644
--- a/debugger/debugger_config.ml
+++ b/debugger/debugger_config.ml
@@ -82,6 +82,9 @@ let make_checkpoints = ref
     "Win32" -> false
   | _ -> true)
 
+(* Whether to break when new code is loaded. *)
+let break_on_load = ref true
+
 (*** Environment variables for debuggee. ***)
 
 let environment = ref []
diff --git a/debugger/debugger_config.mli b/debugger/debugger_config.mli
index 42fa774404..9db86e9330 100644
--- a/debugger/debugger_config.mli
+++ b/debugger/debugger_config.mli
@@ -34,6 +34,7 @@ val checkpoint_big_step : int64 ref
 val checkpoint_small_step : int64 ref
 val checkpoint_max_count : int ref
 val make_checkpoints : bool ref
+val break_on_load : bool ref
 
 (*** Environment variables for debuggee. ***)
 
diff --git a/debugger/eval.ml b/debugger/eval.ml
index e3bacfa611..d3dbf2a306 100644
--- a/debugger/eval.ml
+++ b/debugger/eval.ml
@@ -19,6 +19,7 @@ open Path
 open Instruct
 open Types
 open Parser_aux
+open Events
 
 type error =
     Unbound_identifier of Ident.t
@@ -47,7 +48,7 @@ let rec address path event = function
         with Symtable.Error _ -> raise(Error(Unbound_identifier id))
       else
         begin match event with
-          Some ev ->
+          Some {ev_ev = ev} ->
             begin try
               let pos = Ident.find_same id ev.ev_compenv.ce_stack in
               Debugcom.Remote_value.local (ev.ev_stacksize - pos)
@@ -94,7 +95,7 @@ let rec expression event env = function
       end
   | E_result ->
       begin match event with
-        Some {ev_kind = Event_after ty; ev_typsubst = subst}
+        Some {ev_ev = {ev_kind = Event_after ty; ev_typsubst = subst}}
         when !Frames.current_frame = 0 ->
           (Debugcom.Remote_value.accu(), Subst.type_expr subst ty)
       | _ ->
diff --git a/debugger/eval.mli b/debugger/eval.mli
index 51d27136c0..6aa8cb1ff4 100644
--- a/debugger/eval.mli
+++ b/debugger/eval.mli
@@ -19,7 +19,7 @@ open Parser_aux
 open Format
 
 val expression :
-    Instruct.debug_event option -> Env.t -> expression ->
+    Events.code_event option -> Env.t -> expression ->
     Debugcom.Remote_value.t * type_expr
 
 type error =
diff --git a/debugger/events.ml b/debugger/events.ml
index a50eae0d60..3bad8b2f7e 100644
--- a/debugger/events.ml
+++ b/debugger/events.ml
@@ -18,6 +18,10 @@
 
 open Instruct
 
+type code_event =
+  { ev_frag : int;
+    ev_ev : Instruct.debug_event }
+
 let get_pos ev =
   match ev.ev_kind with
   | Event_before -> ev.ev_loc.Location.loc_start
@@ -30,7 +34,7 @@ let get_pos ev =
 
 (* Event at current position *)
 let current_event =
-  ref (None : debug_event option)
+  ref (None : code_event option)
 
 (* Current position in source. *)
 (* Raise `Not_found' if not on an event (beginning or end of program). *)
@@ -43,7 +47,7 @@ let current_event_is_before () =
   match !current_event with
     None ->
       raise Not_found
-  | Some {ev_kind = Event_before} ->
+  | Some {ev_ev = {ev_kind = Event_before}} ->
       true
   | _ ->
       false
diff --git a/debugger/events.mli b/debugger/events.mli
index f50f156e44..b095e50aac 100644
--- a/debugger/events.mli
+++ b/debugger/events.mli
@@ -16,15 +16,20 @@
 
 open Instruct
 
+(* A debug event associated with a code fragment. *)
+type code_event =
+  { ev_frag : int;
+    ev_ev : Instruct.debug_event }
+
 val get_pos : debug_event -> Lexing.position;;
 
 (** Current events. **)
 
 (* The event at current position. *)
-val current_event : debug_event option ref
+val current_event : code_event option ref
 
 (* Current position in source. *)
 (* Raise `Not_found' if not on an event (beginning or end of program). *)
-val get_current_event : unit -> debug_event
+val get_current_event : unit -> code_event
 
 val current_event_is_before : unit -> bool
diff --git a/debugger/frames.ml b/debugger/frames.ml
index 96b7ce1531..e1edf2317d 100644
--- a/debugger/frames.ml
+++ b/debugger/frames.ml
@@ -25,7 +25,7 @@ open Symbols
 let current_frame = ref 0
 
 (* Event at selected position *)
-let selected_event = ref (None : debug_event option)
+let selected_event = ref (None : code_event option)
 
 (* Selected position in source. *)
 (* Raise `Not_found' if not on an event. *)
@@ -33,7 +33,7 @@ let selected_point () =
   match !selected_event with
     None ->
       raise Not_found
-  | Some ev ->
+  | Some {ev_ev=ev} ->
       (ev.ev_module,
        (Events.get_pos ev).Lexing.pos_lnum,
        (Events.get_pos ev).Lexing.pos_cnum - (Events.get_pos ev).Lexing.pos_bol)
@@ -42,7 +42,7 @@ let selected_event_is_before () =
   match !selected_event with
     None ->
       raise Not_found
-  | Some {ev_kind = Event_before} ->
+  | Some {ev_ev={ev_kind = Event_before}} ->
       true
   | _ ->
       false
@@ -52,7 +52,7 @@ let selected_event_is_before () =
 
 let rec move_up frame_count event =
   if frame_count <= 0 then event else begin
-    let (sp, pc) = up_frame event.ev_stacksize in
+    let (sp, pc) = up_frame event.ev_ev.ev_stacksize in
     if sp < 0 then raise Not_found;
     move_up (frame_count - 1) (any_event_at_pc pc)
   end
@@ -106,13 +106,13 @@ let reset_frame () =
 let do_backtrace action =
   match !current_event with
     None -> Misc.fatal_error "Frames.do_backtrace"
-  | Some curr_ev ->
+  | Some ev ->
       let (initial_sp, _) = get_frame() in
       set_initial_frame();
-      let event = ref curr_ev in
+      let event = ref ev in
       begin try
         while action (Some !event) do
-          let (sp, pc) = up_frame !event.ev_stacksize in
+          let (sp, pc) = up_frame !event.ev_ev.ev_stacksize in
           if sp < 0 then raise Exit;
           event := any_event_at_pc pc
         done
diff --git a/debugger/frames.mli b/debugger/frames.mli
index 514aa2e361..08fd326cc8 100644
--- a/debugger/frames.mli
+++ b/debugger/frames.mli
@@ -16,13 +16,13 @@
 
 (****************************** Frames *********************************)
 
-open Instruct
+open Events
 
 (* Current frame number *)
 val current_frame : int ref
 
-(* Event at selected position. *)
-val selected_event : debug_event option ref
+(* Fragment and event at selected position. *)
+val selected_event : code_event option ref
 
 (* Selected position in source (module, line, column). *)
 (* Raise `Not_found' if not on an event. *)
@@ -48,7 +48,7 @@ val reset_frame : unit -> unit
    or None if we've encountered a stack frame with no debugging info
    attached. Stop when the function returns false, or frame with no
    debugging info reached, or top of stack reached. *)
-val do_backtrace : (debug_event option -> bool) -> unit
+val do_backtrace : (code_event option -> bool) -> unit
 
 (* Return the number of frames in the stack, or (-1) if it can't be
    determined because some frames have no debugging info. *)
diff --git a/debugger/lexer.mll b/debugger/lexer.mll
index 8570b152a8..f6744f7925 100644
--- a/debugger/lexer.mll
+++ b/debugger/lexer.mll
@@ -83,6 +83,8 @@ and lexeme =    (* Read a lexeme *)
       { AT }
   | "$"
       { DOLLAR }
+  | ":"
+      { COLON }
   | "!"
       { BANG }
   | "("
diff --git a/debugger/parser.mly b/debugger/parser.mly
index 36864b042f..b8789d94de 100644
--- a/debugger/parser.mly
+++ b/debugger/parser.mly
@@ -20,6 +20,7 @@ open Int64ops
 open Input_handling
 open Longident
 open Parser_aux
+open Debugcom
 
 %}
 
@@ -31,6 +32,7 @@ open Parser_aux
 %token          STAR                    /* *  */
 %token          MINUS                   /* -  */
 %token          DOT                     /* . */
+%token          COLON                   /* : */
 %token          HASH                    /* #  */
 %token          AT                      /* @  */
 %token          DOLLAR                  /* $ */
@@ -235,7 +237,9 @@ expression_list_eol :
 
 break_argument_eol :
     end_of_line                                 { BA_none }
-  | integer_eol                                 { BA_pc $1 }
+  | integer_eol                                 { BA_pc {frag = 0; pos = $1} }
+  | INTEGER COLON integer_eol                   { BA_pc {frag = to_int $1;
+                                                         pos = $3} }
   | expression end_of_line                      { BA_function $1 }
   | AT opt_longident INTEGER opt_integer_eol    { BA_pos1 ($2, (to_int $3), $4)}
   | AT opt_longident HASH integer_eol           { BA_pos2 ($2, $4) }
diff --git a/debugger/parser_aux.mli b/debugger/parser_aux.mli
index 67c8446278..36c383e0c2 100644
--- a/debugger/parser_aux.mli
+++ b/debugger/parser_aux.mli
@@ -23,7 +23,7 @@ type expression =
 
 type break_arg =
     BA_none                             (* break *)
-  | BA_pc of int                        (* break PC *)
+  | BA_pc of Debugcom.pc                (* break FRAG PC *)
   | BA_function of expression           (* break FUNCTION *)
   | BA_pos1 of Longident.t option * int * int option
                                         (* break @ [MODULE] LINE [POS] *)
diff --git a/debugger/pos.ml b/debugger/pos.ml
index cc164e68da..2b5b0e2e27 100644
--- a/debugger/pos.ml
+++ b/debugger/pos.ml
@@ -13,14 +13,14 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Instruct;;
-open Lexing;;
-open Location;;
+open Instruct
+open Lexing
+open Location
+open Events
 
 let get_desc ev =
-  let loc = ev.ev_loc in
+  let loc = ev.ev_ev.ev_loc in
   Printf.sprintf "file %s, line %d, characters %d-%d"
                  loc.loc_start.pos_fname loc.loc_start.pos_lnum
                  (loc.loc_start.pos_cnum - loc.loc_start.pos_bol + 1)
                  (loc.loc_end.pos_cnum - loc.loc_start.pos_bol + 1)
-;;
diff --git a/debugger/pos.mli b/debugger/pos.mli
index f5c376502c..31bc341f55 100644
--- a/debugger/pos.mli
+++ b/debugger/pos.mli
@@ -13,4 +13,4 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val get_desc : Instruct.debug_event -> string;;
+val get_desc : Events.code_event -> string;;
diff --git a/debugger/program_management.ml b/debugger/program_management.ml
index a232be2b2c..318e3f2c2e 100644
--- a/debugger/program_management.ml
+++ b/debugger/program_management.ml
@@ -126,7 +126,8 @@ let initialize_loading () =
     prerr_endline "Program not found.";
     raise Toplevel;
   end;
-  Symbols.read_symbols !program_name;
+  Symbols.clear_symbols ();
+  Symbols.read_symbols 0 !program_name;
   Load_path.init (Load_path.get_paths () @ !Symbols.program_source_dirs);
   Envaux.reset_cache ();
   if !debug_loading then
@@ -134,7 +135,7 @@ let initialize_loading () =
   open_connection !socket_name
     (function () ->
       go_to _0;
-      Symbols.set_all_events();
+      Symbols.set_all_events 0;
       exit_main_loop ())
 
 (* Ensure the program is already loaded. *)
diff --git a/debugger/show_information.ml b/debugger/show_information.ml
index 29fe1fb69c..27cdf5f6c1 100644
--- a/debugger/show_information.ml
+++ b/debugger/show_information.ml
@@ -32,7 +32,7 @@ let show_current_event ppf =
     fprintf ppf "Time: %Li" (current_time ());
     (match current_pc () with
      | Some pc ->
-         fprintf ppf " - pc: %i" pc
+         fprintf ppf " - pc: %i:%i" pc.frag pc.pos
      | _ -> ());
   end;
   update_current_event ();
@@ -43,7 +43,7 @@ let show_current_event ppf =
       fprintf ppf "Beginning of program.@.";
       show_no_point ()
   | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} ->
-        let ev = get_current_event () in
+        let ev = (get_current_event ()).ev_ev in
         if !Parameters.time then fprintf ppf " - module %s@." ev.ev_module;
         (match breakpoints_at_pc pc with
          | [] ->
@@ -68,28 +68,34 @@ let show_current_event ppf =
          @[Uncaught exception:@ %a@]@."
       Printval.print_exception (Debugcom.Remote_value.accu ());
       show_no_point ()
-  | Some {rep_type = Trap_barrier} ->
-                                        (* Trap_barrier not visible outside *)
-                                        (* of module `time_travel'. *)
+  | Some {rep_type = Code_loaded frag} ->
+      let mds = String.concat ", " (Symbols.modules_in_code_fragment frag) in
+      fprintf ppf "@.Module(s) %s loaded.@." mds;
+      show_no_point ()
+  | Some {rep_type = Trap_barrier}
+  | Some {rep_type = Debug_info _}
+  | Some {rep_type = Code_unloaded _} ->
+      (* Not visible outside *)
+      (* of module `time_travel'. *)
       if !Parameters.time then fprintf ppf "@.";
       Misc.fatal_error "Show_information.show_current_event"
 
 (* Display short information about one frame. *)
 
-let show_one_frame framenum ppf event =
-  let pos = Events.get_pos event in
+let show_one_frame framenum ppf ev =
+  let pos = Events.get_pos ev.ev_ev in
   let cnum =
     try
-      let buffer = get_buffer pos event.ev_module in
+      let buffer = get_buffer pos ev.ev_ev.ev_module in
       snd (start_and_cnum buffer pos)
     with _ -> pos.Lexing.pos_cnum in
   if !machine_readable then
-    fprintf ppf "#%i  Pc: %i  %s char %i@."
-           framenum event.ev_pos event.ev_module
+    fprintf ppf "#%i  Pc: %i:%i  %s char %i@."
+           framenum ev.ev_frag ev.ev_ev.ev_pos ev.ev_ev.ev_module
            cnum
   else
     fprintf ppf "#%i %s %s:%i:%i@."
-           framenum event.ev_module
+           framenum ev.ev_ev.ev_module
            pos.Lexing.pos_fname pos.Lexing.pos_lnum
            (pos.Lexing.pos_cnum - pos.Lexing.pos_bol + 1)
 
@@ -101,7 +107,8 @@ let show_current_frame ppf selected =
       fprintf ppf "@.No frame selected.@."
   | Some sel_ev ->
       show_one_frame !current_frame ppf sel_ev;
-      begin match breakpoints_at_pc sel_ev.ev_pos with
+      begin match breakpoints_at_pc
+                    {frag=sel_ev.ev_frag; pos = sel_ev.ev_ev.ev_pos} with
       | [] -> ()
       | [breakpoint] ->
           fprintf ppf "Breakpoint: %i@." breakpoint
@@ -111,4 +118,4 @@ let show_current_frame ppf selected =
             List.iter (function x -> fprintf ppf "%i " x) l)
           (List.sort compare breakpoints);
       end;
-      show_point sel_ev selected
+      show_point sel_ev.ev_ev selected
diff --git a/debugger/show_information.mli b/debugger/show_information.mli
index 2d6b6b0183..bc5df9d9e6 100644
--- a/debugger/show_information.mli
+++ b/debugger/show_information.mli
@@ -14,14 +14,14 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Format;;
+open Format
 
 (* Display information about the current event. *)
-val show_current_event : formatter -> unit;;
+val show_current_event : formatter -> unit
 
 (* Display information about the current frame. *)
 (* --- `select frame' must have succeeded before calling this function. *)
-val show_current_frame : formatter -> bool -> unit;;
+val show_current_frame : formatter -> bool -> unit
 
 (* Display short information about one frame. *)
-val show_one_frame : int -> formatter -> Instruct.debug_event -> unit
+val show_one_frame : int -> formatter -> Events.code_event -> unit
diff --git a/debugger/symbols.ml b/debugger/symbols.ml
index d22f1a1715..6cb49c1ea2 100644
--- a/debugger/symbols.ml
+++ b/debugger/symbols.ml
@@ -19,6 +19,8 @@
 open Instruct
 open Debugger_config (* Toplevel *)
 open Program_loading
+open Debugcom
+open Events
 module String = Misc.Stdlib.String
 
 let modules =
@@ -30,11 +32,11 @@ let program_source_dirs =
 let events =
   ref ([] : debug_event list)
 let events_by_pc =
-  (Hashtbl.create 257 : (int, debug_event) Hashtbl.t)
+  (Hashtbl.create 257 : (pc, debug_event) Hashtbl.t)
 let events_by_module =
-  (Hashtbl.create 17 : (string, debug_event array) Hashtbl.t)
+  (Hashtbl.create 17 : (string, int * debug_event array) Hashtbl.t)
 let all_events_by_module =
-  (Hashtbl.create 17 : (string, debug_event list) Hashtbl.t)
+  (Hashtbl.create 17 : (string, int * debug_event list) Hashtbl.t)
 
 let partition_modules evl =
   let rec partition_modules' ev evl =
@@ -93,20 +95,19 @@ let read_symbols' bytecode_file =
   close_in_noerr ic;
   !eventlists, !dirs
 
-let read_symbols bytecode_file =
-  let all_events, all_dirs = read_symbols' bytecode_file in
-
+let clear_symbols () =
   modules := []; events := [];
-  program_source_dirs := String.Set.elements all_dirs;
+  program_source_dirs := [];
   Hashtbl.clear events_by_pc; Hashtbl.clear events_by_module;
-  Hashtbl.clear all_events_by_module;
+  Hashtbl.clear all_events_by_module
 
+let add_symbols frag all_events =
   List.iter
     (fun evl ->
       List.iter
         (fun ev ->
           events := ev :: !events;
-          Hashtbl.add events_by_pc ev.ev_pos ev)
+          Hashtbl.add events_by_pc {frag; pos = ev.ev_pos} ev)
         evl)
     all_events;
 
@@ -120,7 +121,7 @@ let read_symbols bytecode_file =
           in
           let sorted_evl = List.sort cmp evl in
           modules := md :: !modules;
-          Hashtbl.add all_events_by_module md sorted_evl;
+          Hashtbl.add all_events_by_module md (frag, sorted_evl);
           let real_evl =
             List.filter
               (function
@@ -128,20 +129,52 @@ let read_symbols bytecode_file =
                | _                        -> true)
               sorted_evl
           in
-          Hashtbl.add events_by_module md (Array.of_list real_evl))
+          Hashtbl.add events_by_module md (frag, Array.of_list real_evl))
     all_events
 
+let read_symbols frag bytecode_file =
+  let all_events, all_dirs = read_symbols' bytecode_file in
+  program_source_dirs := !program_source_dirs @ (String.Set.elements all_dirs);
+  add_symbols frag all_events
+
+let erase_symbols frag =
+  let pcs = Hashtbl.fold (fun pc _ pcs ->
+      if pc.frag = frag then pc :: pcs else pcs)
+    events_by_pc []
+  in
+  List.iter (Hashtbl.remove events_by_pc) pcs;
+
+  let mds = Hashtbl.fold (fun md (frag', _) mds ->
+      if frag' = frag then md :: mds else mds)
+    events_by_module []
+  in
+  List.iter (Hashtbl.remove events_by_module) mds;
+  List.iter (Hashtbl.remove all_events_by_module) mds;
+  modules := List.filter (fun md -> not (List.mem md mds)) !modules
+
+let code_fragments () =
+  let frags =
+    Hashtbl.fold
+      (fun _ (frag, _) l -> frag :: l)
+      all_events_by_module []
+  in
+  List.sort_uniq compare frags
+
+let modules_in_code_fragment frag' =
+  Hashtbl.fold (fun md (frag, _) l ->
+      if frag' = frag then md :: l else l)
+    all_events_by_module []
+
 let any_event_at_pc pc =
-  Hashtbl.find events_by_pc pc
+  { ev_frag = pc.frag; ev_ev = Hashtbl.find events_by_pc pc }
 
 let event_at_pc pc =
-  let ev = any_event_at_pc pc in
-  match ev.ev_kind with
-    Event_pseudo -> raise Not_found
-  | _            -> ev
+  match any_event_at_pc pc with
+    { ev_ev = { ev_kind = Event_pseudo } } -> raise Not_found
+  | ev -> ev
 
 let set_event_at_pc pc =
- try ignore(event_at_pc pc); Debugcom.set_event pc
+ try ignore(event_at_pc pc); set_event pc
  with Not_found -> ()
 
 (* List all events in module *)
@@ -149,7 +182,7 @@ let events_in_module mdle =
   try
     Hashtbl.find all_events_by_module mdle
   with Not_found ->
-    []
+    0, []
 
 (* Binary search of event at or just after char *)
 let find_event ev char =
@@ -174,40 +207,40 @@ let find_event ev char =
 (* Return first event after the given position. *)
 (* Raise [Not_found] if module is unknown or no event is found. *)
 let event_at_pos md char =
-  let ev = Hashtbl.find events_by_module md in
-  ev.(find_event ev char)
+  let ev_frag, ev = Hashtbl.find events_by_module md in
+  { ev_frag; ev_ev = ev.(find_event ev char) }
 
 (* Return event closest to given position *)
 (* Raise [Not_found] if module is unknown or no event is found. *)
 let event_near_pos md char =
-  let ev = Hashtbl.find events_by_module md in
+  let ev_frag, ev = Hashtbl.find events_by_module md in
   try
     let pos = find_event ev char in
     (* Desired event is either ev.(pos) or ev.(pos - 1),
        whichever is closest *)
     if pos > 0 && char - (Events.get_pos ev.(pos - 1)).Lexing.pos_cnum
                   <= (Events.get_pos ev.(pos)).Lexing.pos_cnum - char
-    then ev.(pos - 1)
-    else ev.(pos)
+    then { ev_frag; ev_ev = ev.(pos - 1) }
+    else { ev_frag; ev_ev = ev.(pos) }
   with Not_found ->
     let pos = Array.length ev - 1 in
     if pos < 0 then raise Not_found;
-    ev.(pos)
+    { ev_frag; ev_ev = ev.(pos) }
 
 (* Flip "event" bit on all instructions *)
-let set_all_events () =
+let set_all_events frag =
   Hashtbl.iter
-    (fun _pc ev ->
+    (fun pc ev ->
        match ev.ev_kind with
          Event_pseudo -> ()
-       | _            -> Debugcom.set_event ev.ev_pos)
+       | _ when pc.frag = frag -> set_event pc
+       | _ -> ())
     events_by_pc
 
-
 (* Previous `pc'. *)
 (* Save time if `update_current_event' is called *)
 (* several times at the same point. *)
-let old_pc = ref (None : int option)
+let old_pc = ref (None : pc option)
 
 (* Recompute the current event *)
 let update_current_event () =
diff --git a/debugger/symbols.mli b/debugger/symbols.mli
index b1fc9d6f91..30728f5585 100644
--- a/debugger/symbols.mli
+++ b/debugger/symbols.mli
@@ -14,6 +14,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Events
+
 (* Modules used by the program. *)
 val modules : string list ref
 
@@ -21,31 +23,49 @@ val modules : string list ref
  * compiled *)
 val program_source_dirs : string list ref
 
-(* Read debugging info from executable file *)
-val read_symbols : string -> unit
+(* Clear loaded symbols *)
+val clear_symbols : unit -> unit
+
+(* Read debugging info from executable or dynlinkable file
+   and associate with given code fragment *)
+val read_symbols : int -> string -> unit
+
+(* Add debugging info from memory and associate with given
+   code fragment *)
+val add_symbols : int -> Instruct.debug_event list list -> unit
+
+(* Erase debugging info associated with given code fragment *)
+val erase_symbols : int -> unit
 
-(* Flip "event" bit on all instructions *)
-val set_all_events : unit -> unit
+(* Return the list of all code fragments that have debug info associated *)
+val code_fragments : unit -> int list
+
+(* Flip "event" bit on all instructions in given fragment *)
+val set_all_events : int -> unit
 
 (* Return event at given PC, or raise Not_found *)
 (* Can also return pseudo-event at beginning of functions *)
-val any_event_at_pc : int -> Instruct.debug_event
+val any_event_at_pc : Debugcom.pc -> code_event
 
 (* Return event at given PC, or raise Not_found *)
-val event_at_pc : int -> Instruct.debug_event
+val event_at_pc : Debugcom.pc -> code_event
+
 (* Set event at given PC *)
-val set_event_at_pc : int -> unit
+val set_event_at_pc : Debugcom.pc -> unit
 
 (* List the events in `module'. *)
-val events_in_module : string -> Instruct.debug_event list
+val events_in_module : string -> int * Instruct.debug_event list
+
+(* List the modules in given code fragment. *)
+val modules_in_code_fragment : int -> string list
 
 (* First event after the given position. *)
 (* --- Raise `Not_found' if no such event. *)
-val event_at_pos : string -> int -> Instruct.debug_event
+val event_at_pos : string -> int -> code_event
 
 (* Closest event from given position. *)
 (* --- Raise `Not_found' if no such event. *)
-val event_near_pos : string -> int -> Instruct.debug_event
+val event_near_pos : string -> int -> code_event
 
 (* Recompute the current event *)
 val update_current_event : unit -> unit
diff --git a/debugger/time_travel.ml b/debugger/time_travel.ml
index c239a20c1f..4d3252fb19 100644
--- a/debugger/time_travel.ml
+++ b/debugger/time_travel.ml
@@ -99,6 +99,11 @@ let set_current_checkpoint checkpoint =
   if not checkpoint.c_valid then
     wait_for_connection checkpoint;
   current_checkpoint := checkpoint;
+  let dead_frags = List.filter (fun frag ->
+      not (List.mem frag checkpoint.c_code_fragments))
+    (Symbols.code_fragments ())
+  in
+  List.iter Symbols.erase_symbols dead_frags;
   set_current_connection checkpoint.c_fd
 
 (* Kill `checkpoint'. *)
@@ -231,7 +236,8 @@ let duplicate_current_checkpoint () =
        c_parent = checkpoint;
        c_breakpoint_version = checkpoint.c_breakpoint_version;
        c_breakpoints = checkpoint.c_breakpoints;
-       c_trap_barrier = checkpoint.c_trap_barrier}
+       c_trap_barrier = checkpoint.c_trap_barrier;
+       c_code_fragments = checkpoint.c_code_fragments}
     in
       checkpoints := list_replace checkpoint new_checkpoint !checkpoints;
       set_current_checkpoint checkpoint;
@@ -260,6 +266,29 @@ let interrupted = ref false
 (* Information about last breakpoint encountered *)
 let last_breakpoint = ref None
 
+(* Last debug info loaded *)
+let last_debug_info = ref None
+
+let rec do_go_dynlink steps =
+  match do_go steps with
+  | { rep_type = Code_loaded frag; rep_event_count = steps } as report ->
+    begin match !last_debug_info with
+    | Some di ->
+      Symbols.add_symbols frag di;
+      Symbols.set_all_events frag;
+      last_debug_info := None
+    | None -> assert false
+    end;
+    if !break_on_load then report
+    else do_go_dynlink steps
+  | { rep_type = Code_unloaded frag; rep_event_count = steps } ->
+    Symbols.erase_symbols frag;
+    do_go_dynlink steps
+  | { rep_type = Debug_info di; rep_event_count = steps } ->
+    last_debug_info := Some (Array.to_list di);
+    do_go_dynlink steps
+  | report -> report
+
 (* Ensure we stop on an event. *)
 let rec stop_on_event report =
   match report with
@@ -282,7 +311,7 @@ and find_event () =
     print_string "Searching next event...";
     print_newline ()
   end;
-  let report = do_go _1 in
+  let report = do_go_dynlink _1 in
   !current_checkpoint.c_report <- Some report;
   stop_on_event report
 
@@ -302,9 +331,10 @@ let internal_step duration =
            update_breakpoints ();
            update_trap_barrier ();
            !current_checkpoint.c_state <- C_running duration;
-           let report = do_go duration in
+           let report = do_go_dynlink duration in
              !current_checkpoint.c_report <- Some report;
              !current_checkpoint.c_state <- C_stopped;
+             !current_checkpoint.c_code_fragments <- Symbols.code_fragments ();
              if report.rep_type = Event then begin
                !current_checkpoint.c_time <-
                  !current_checkpoint.c_time ++ duration;
@@ -314,7 +344,7 @@ let internal_step duration =
              else begin
                !current_checkpoint.c_time <-
                   !current_checkpoint.c_time ++ duration
-                  -- (Int64.of_int report.rep_event_count) ++ _1;
+                  -- report.rep_event_count ++ _1;
                interrupted := true;
                last_breakpoint := None;
                stop_on_event report
@@ -350,7 +380,8 @@ let new_checkpoint pid fd =
      c_parent = root;
      c_breakpoint_version = 0;
      c_breakpoints = [];
-     c_trap_barrier = 0}
+     c_trap_barrier = 0;
+     c_code_fragments = [0]}
   in
     insert_checkpoint new_checkpoint
 
@@ -469,7 +500,6 @@ let find_last_breakpoint max_time =
          (Some (pc, _)) as state when breakpoint_at_pc pc -> state
        | _                                                -> None)
 
-
 (* Run from `time_max' back to `time'. *)
 (* --- Assume 0 <= time < time_max *)
 let rec back_to time time_max =
@@ -522,9 +552,9 @@ let finish () =
     None ->
       prerr_endline "`finish' not meaningful in outermost frame.";
       raise Toplevel
-  | Some curr_event ->
+  | Some {ev_ev={ev_stacksize}} ->
       set_initial_frame();
-      let (frame, pc) = up_frame curr_event.ev_stacksize in
+      let (frame, pc) = up_frame ev_stacksize in
       if frame < 0 then begin
         prerr_endline "`finish' not meaningful in outermost frame.";
         raise Toplevel
@@ -558,18 +588,18 @@ let next_1 () =
   match !current_event with
     None ->                             (* Beginning of the program. *)
       step _1
-  | Some event1 ->
+  | Some {ev_ev={ev_stacksize=ev_stacksize1}} ->
       let (frame1, _pc1) = initial_frame() in
       step _1;
       if not !interrupted then begin
         Symbols.update_current_event ();
         match !current_event with
           None -> ()
-        | Some event2 ->
+        | Some {ev_ev={ev_stacksize=ev_stacksize2}} ->
             let (frame2, _pc2) = initial_frame() in
             (* Call `finish' if we've entered a function. *)
             if frame1 >= 0 && frame2 >= 0 &&
-               frame2 - event2.ev_stacksize > frame1 - event1.ev_stacksize
+               frame2 - ev_stacksize2 > frame1 - ev_stacksize1
             then finish()
       end
 
@@ -589,9 +619,9 @@ let start () =
     None ->
       prerr_endline "`start not meaningful in outermost frame.";
       raise Toplevel
-  | Some curr_event ->
+  | Some {ev_ev={ev_stacksize}} ->
       let (frame, _) = initial_frame() in
-      let (frame', pc) = up_frame curr_event.ev_stacksize in
+      let (frame', pc) = up_frame ev_stacksize in
       if frame' < 0 then begin
         prerr_endline "`start not meaningful in outermost frame.";
         raise Toplevel
@@ -602,11 +632,11 @@ let start () =
             prerr_endline "Calling function has no debugging information.";
             raise Toplevel
         with
-          {ev_info = Event_return nargs} -> nargs
+          {ev_ev = {ev_info = Event_return nargs}} -> nargs
         | _ ->  Misc.fatal_error "Time_travel.start"
       in
       let offset = if nargs < 4 then 1 else 2 in
-      let pc = pc - 4 * offset in
+      let pc = { pc with pos = pc.pos - 4 * offset } in
       while
         exec_with_temporary_breakpoint pc back_run;
         match !last_breakpoint with
@@ -614,7 +644,7 @@ let start () =
             step _minus1;
             (not !interrupted)
               &&
-            (frame' - nargs > frame - curr_event.ev_stacksize)
+            (frame' - nargs > frame - ev_stacksize)
         | _ ->
             false
       do
@@ -626,18 +656,18 @@ let previous_1 () =
   match !current_event with
     None ->                             (* End of the program. *)
       step _minus1
-  | Some event1 ->
+  | Some {ev_ev={ev_stacksize=ev_stacksize1}} ->
       let (frame1, _pc1) = initial_frame() in
       step _minus1;
       if not !interrupted then begin
         Symbols.update_current_event ();
         match !current_event with
           None -> ()
-        | Some event2 ->
+        | Some {ev_ev={ev_stacksize=ev_stacksize2}} ->
             let (frame2, _pc2) = initial_frame() in
             (* Call `start' if we've entered a function. *)
             if frame1 >= 0 && frame2 >= 0 &&
-               frame2 - event2.ev_stacksize > frame1 - event1.ev_stacksize
+               frame2 - ev_stacksize2 > frame1 - ev_stacksize1
             then start()
       end