Suite du portage (nombreuses modifs)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1281 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

16 files changed, 219 insertions, 219 deletions

diff --git a/debugger/.depend b/debugger/.depend
index 23cd30b395..00e7d467ca 100644
--- a/debugger/.depend
+++ b/debugger/.depend
@@ -9,7 +9,7 @@ events.cmi: ../bytecomp/instruct.cmi
 frames.cmi: ../bytecomp/instruct.cmi primitives.cmi 
 input_handling.cmi: primitives.cmi 
 loadprinter.cmi: ../parsing/longident.cmi 
-parser.cmi: parser_aux.cmi 
+parser.cmi: ../parsing/longident.cmi parser_aux.cmi 
 parser_aux.cmi: ../parsing/longident.cmi primitives.cmi 
 pattern_matching.cmi: debugcom.cmi parser_aux.cmi ../typing/typedtree.cmi 
 primitives.cmi: ../otherlibs/unix/unix.cmi 
@@ -86,22 +86,20 @@ loadprinter.cmo: ../utils/config.cmi ../typing/ctype.cmi debugger_config.cmi \
     ../typing/env.cmi ../typing/ident.cmi ../parsing/longident.cmi \
     ../utils/misc.cmi ../typing/path.cmi ../typing/predef.cmi \
     ../typing/printtyp.cmi printval.cmi ../bytecomp/symtable.cmi \
-    loadprinter.cmi 
+    ../typing/types.cmi loadprinter.cmi 
 loadprinter.cmx: ../utils/config.cmx ../typing/ctype.cmx debugger_config.cmx \
     ../typing/env.cmx ../typing/ident.cmx ../parsing/longident.cmx \
     ../utils/misc.cmx ../typing/path.cmx ../typing/predef.cmx \
     ../typing/printtyp.cmx printval.cmx ../bytecomp/symtable.cmx \
-    loadprinter.cmi 
+    ../typing/types.cmx loadprinter.cmi 
 main.cmo: checkpoints.cmi command_line_interpreter.cmi ../utils/config.cmi \
     debugger_config.cmi exec.cmi frames.cmi input_handling.cmi \
-    loadprinter.cmi ../utils/misc.cmi parameters.cmi primitives.cmi \
-    program_management.cmi show_information.cmi time_travel.cmi \
-    ../otherlibs/unix/unix.cmi 
+    ../utils/misc.cmi parameters.cmi primitives.cmi program_management.cmi \
+    show_information.cmi time_travel.cmi ../otherlibs/unix/unix.cmi 
 main.cmx: checkpoints.cmx command_line_interpreter.cmx ../utils/config.cmx \
     debugger_config.cmx exec.cmx frames.cmx input_handling.cmx \
-    loadprinter.cmx ../utils/misc.cmx parameters.cmx primitives.cmx \
-    program_management.cmx show_information.cmx time_travel.cmx \
-    ../otherlibs/unix/unix.cmx 
+    ../utils/misc.cmx parameters.cmx primitives.cmx program_management.cmx \
+    show_information.cmx time_travel.cmx ../otherlibs/unix/unix.cmx 
 parameters.cmo: ../utils/config.cmi envaux.cmi ../utils/misc.cmi \
     primitives.cmi parameters.cmi 
 parameters.cmx: ../utils/config.cmx envaux.cmx ../utils/misc.cmx \
diff --git a/debugger/breakpoints.ml b/debugger/breakpoints.ml
index af7f4d0c41..2a3184d2f3 100644
--- a/debugger/breakpoints.ml
+++ b/debugger/breakpoints.ml
@@ -156,12 +156,12 @@ let new_breakpoint event =
   print_string " at ";
   print_int event.ev_pos;
   print_string " : file ";
-  print_string event.ev_file;
-  print_string ".ml, line ";
-  (let (start, line) = line_of_pos (get_buffer event.ev_file) event.ev_char in
-     print_int line;
-     print_string " column ";
-     print_int (event.ev_char - start + 1));
+  print_string event.ev_module;
+  print_string ", line ";
+  let (start, line) = line_of_pos (get_buffer event.ev_module) event.ev_char in
+  print_int line;
+  print_string " column ";
+  print_int (event.ev_char - start + 1);
   print_newline ()
 
 (* Remove a breakpoint from lists. *)
diff --git a/debugger/command_line_interpreter.ml b/debugger/command_line_interpreter.ml
index b1d2f2cad4..42614463e5 100644
--- a/debugger/command_line_interpreter.ml
+++ b/debugger/command_line_interpreter.ml
@@ -114,12 +114,26 @@ let find_info action alternative lexbuf =
 let add_breakpoint_at_pc pc =
   try
     new_breakpoint (event_at_pc pc)
-  with
-    Not_found ->
+  with Not_found ->
+    prerr_string "Can't add breakpoint at pc ";
+    prerr_int pc;
+    prerr_endline " : no event there.";
+    raise Toplevel
+
+let add_breakpoint_after_pc pc =
+  let rec try_add n =
+    if n < 4 then begin
+      try
+        new_breakpoint (event_at_pc(pc + n * 4))
+      with Not_found ->
+        try_add (n+1)
+    end else begin
       prerr_string "Can't add breakpoint at pc ";
       prerr_int pc;
       prerr_endline " : no event there.";
       raise Toplevel
+    end
+  in try_add 0
 
 let convert_module mdle =
   match mdle with
@@ -211,8 +225,10 @@ let instr_dir lexbuf =
       end
     else
       List.iter (function x -> add_path (expand_path x)) (List.rev new_directory);
+    open_box 2;
     print_string "Directories :";
     List.iter (function x -> print_space(); print_string x) !Config.load_path;
+    close_box();
     print_newline ()
 
 let instr_kill lexbuf =
@@ -425,8 +441,17 @@ let instr_print lexbuf = print_command !max_printer_depth lexbuf
 
 let instr_display lexbuf = print_command 1 lexbuf
 
+(* Loading of command files *)
+
+let extract_filename arg =
+  (* Allow enclosing filename in quotes *)
+  let l = String.length arg in
+  let pos1 = if l > 0 && arg.[0] = '"' then 1 else 0 in
+  let pos2 = if l > 0 && arg.[l-1] = '"' then l-1 else l in
+  String.sub arg pos1 (pos2 - pos1)
+
 let instr_source lexbuf =
-  let file = argument_eol argument lexbuf
+  let file = extract_filename(argument_eol argument lexbuf)
   and old_state = !interactif
   and old_channel = !user_channel in
     let io_chan =
@@ -450,16 +475,6 @@ let instr_source lexbuf =
           user_channel := old_channel;
           raise x
 
-let instr_open lexbuf = ()
-(***
-  let mdles = argument_list_eol argument lexbuf in
-    List.iter open_module mdles ***)
-
-let instr_close lexbuf = ()
-(***
-  let mdles = argument_list_eol argument lexbuf in
-    List.iter close_module mdles ***)
-
 let instr_set =
   find_variable
     (function {var_action = (funct, _)} -> funct)
@@ -496,30 +511,30 @@ let instr_break lexbuf =
              raise Toplevel)
     | BA_pc pc ->                               (* break PC *)
         add_breakpoint_at_pc pc
-    | BA_function lid ->                       (* break FUNCTION *)
-        let e = match !current_event with
+    | BA_function expr ->                       (* break FUNCTION *)
+        let ev = match !current_event with
             None -> raise Toplevel
           | Some x -> x in
-        let env = Envaux.env_from_summary e.ev_typenv in
-        (try
-          let (path, valdesc) = Env.lookup_value lid env in
-          let typ = (Ctype.instance valdesc.Types.val_type)
-          and valu = Eval.path e path in
-            match (Ctype.repr typ).desc with
-              Tarrow (_, _) ->
-                prerr_endline "Not Yet Implemented"
-            | _ ->
-                prerr_endline "Not a function.";
-                raise Toplevel
-        with Not_found ->
-          print_string "Unbound identifier"; print_newline())
+        let env = Envaux.env_from_summary ev.ev_typenv in
+        begin try
+          let (v, ty) = Eval.expression ev env expr in
+          match (Ctype.repr ty).desc with
+            Tarrow (_, _) ->
+              add_breakpoint_after_pc (Debugcom.get_closure_code v)
+          | _ ->
+              prerr_endline "Not a function.";
+              raise Toplevel
+        with Eval.Error msg ->
+          Eval.report_error msg;
+          raise Toplevel
+        end
     | BA_pos1 (mdle, line, column) ->         (* break @ [MODULE] LINE [COL] *)
         let module_name = convert_module mdle in
           new_breakpoint
             (try
                match column with
                  None ->
-                   event_after_pos
+                   event_at_pos
                      module_name
                      (fst (pos_of_line (get_buffer module_name) line))
                | Some col ->
@@ -610,7 +625,7 @@ let do_up rep =
   let stack_pointer = rep.rep_stack_pointer in
   let pc = rep.rep_program_pointer in
   let ev = ref (event_at_pc pc) in
-      print_string !ev.ev_file; print_string " char "; print_int !ev.ev_char;
+      print_string !ev.ev_module; print_string " char "; print_int !ev.ev_char;
       print_newline();
       let (stackpos, pc) = Debugcom.up_frame !ev.ev_stacksize in
       if stackpos = -1 then raise Exit;
@@ -813,8 +828,8 @@ let info_breakpoints lexbuf =
   else
     (print_endline "Num    Address  Where";
      List.iter
-       (function (num, {ev_pos = pc; ev_file = file; ev_char = char}) ->
-          Printf.printf "%3d %10d  in %s.ml, character %d\n" num pc file char)
+       (function (num, {ev_pos = pc; ev_module = md; ev_char = char}) ->
+          Printf.printf "%3d %10d  in %s, character %d\n" num pc md char)
        (List.rev !breakpoints))
 
 let info_events lexbuf =
@@ -827,11 +842,11 @@ let info_events lexbuf =
         match !current_event with
           None ->
             prerr_endline "Not in a module."; raise Toplevel
-        | Some {ev_file = f} -> f
+        | Some {ev_module = m} -> m
   in
     print_endline ("Module : " ^ mdle);
     print_endline "   Address  Character   Kind";
-    List.iter
+    Array.iter
       (function {ev_pos = pc; ev_char = char; ev_kind = kind} ->
          Printf.printf
            "%10d %10d  %s\n"
@@ -845,7 +860,7 @@ let info_events lexbuf =
 (** User-defined printers **)
 
 let instr_load_printer lexbuf =
-  let filename = argument_eol argument lexbuf in
+  let filename = extract_filename(argument_eol argument lexbuf) in
   try
     Loadprinter.loadfile filename
   with Loadprinter.Error e ->
@@ -922,7 +937,7 @@ Argument N means do this N times (or till program stops for another reason)." };
        instr_action = instr_print; instr_repeat = true; instr_help =
 "print value of expressions (deep printing)." };
      { instr_name = "display"; instr_prio = true;
-       instr_action = instr_print; instr_repeat = true; instr_help =
+       instr_action = instr_display; instr_repeat = true; instr_help =
 "print value of expressions (shallow printing)." };
      { instr_name = "source"; instr_prio = false;
        instr_action = instr_source; instr_repeat = true; instr_help =
diff --git a/debugger/eval.ml b/debugger/eval.ml
index 1f3f07a445..7f9f0a64f7 100644
--- a/debugger/eval.ml
+++ b/debugger/eval.ml
@@ -46,7 +46,7 @@ let rec path event = function
         with Not_found ->
         try
           let pos = Ident.find_same id event.ev_compenv.ce_heap in
-          Debugcom.get_environment pos
+          Debugcom.get_environment (pos + 1)
         with Not_found ->
           raise(Error(Unbound_identifier id))
       end
@@ -146,7 +146,7 @@ let report_error error =
   open_hovbox 0;
   begin match error with
     Unbound_identifier id ->
-      print_string "Unbound identifier "; Ident.print id
+      print_string "Unbound identifier "; print_string (Ident.name id)
   | Not_initialized_yet path ->
       print_string "The module path "; Printtyp.path path;
       print_string " is not yet initialized."; print_space();
diff --git a/debugger/events.ml b/debugger/events.ml
index 60178ee69e..ab0055b9e4 100644
--- a/debugger/events.ml
+++ b/debugger/events.ml
@@ -47,7 +47,7 @@ let current_point () =
   match !current_event with
     None ->
       raise Not_found
-  | Some {ev_char = point; ev_file = mdle} ->
+  | Some {ev_char = point; ev_module = mdle} ->
       (mdle, point)
 
 let current_event_is_before () =
@@ -58,56 +58,3 @@ let current_event_is_before () =
       true
   | _ ->
       false
-
-(*** Finding events. ***)
-
-(* List the events in `module'. *)
-let events_in_module mdle =
-  let filename = String.uncapitalize mdle ^ ".ml" in
-  filter
-    (function {ev_file = f} -> f = filename)
-    !Symbols.events
-
-(* First event after the given position. *)
-(* Raise `Not_found' if no such event. *)
-let event_after_pos mdle position =
-  match
-    List.fold_right
-      (function
-      	 ({ev_char = pos1} as ev) ->
-	   if pos1 < position then
-	     function x -> x
-	   else
-	     function
-	       None ->
-	         Some ev
-             | (Some {ev_char = pos2} as old) ->
-	         if pos1 < pos2 then
-		   Some ev
-		 else
-		   old)
-      (events_in_module mdle)
-      None
-  with
-    None ->
-      raise Not_found
-  | Some x ->
-      x
-
-(* Nearest event from given position. *)
-(* Raise `Not_found' if no such event. *)
-let event_near_pos mdle position =
-  match events_in_module mdle with
-    [] ->
-      raise Not_found
-  | [event] ->
-      event
-  | a::l ->
-      List.fold_right
-      	(fun ({ev_char = pos1} as ev) ({ev_char = pos2} as old) ->
-	   if abs (position - pos1) < abs (position - pos2) then
-	     ev
-	   else
-	     old)
-	l
-	a
diff --git a/debugger/events.mli b/debugger/events.mli
index 43fa8600b1..d71f81286a 100644
--- a/debugger/events.mli
+++ b/debugger/events.mli
@@ -28,16 +28,3 @@ val current_point : unit -> string * int
 
 val current_event_is_before : unit -> bool
 
-(** Finding events. **)
-
-(* List the events in `module'. *)
-(* ### module -> event_list *)
-val events_in_module : string -> debug_event list
-
-(* First event after the given position. *)
-(* --- Raise `Not_found' if no such event. *)
-val event_after_pos : string -> int -> debug_event
-
-(* Nearest event from given position. *)
-(* --- Raise `Not_found' if no such event. *)
-val event_near_pos : string -> int -> debug_event
diff --git a/debugger/frames.ml b/debugger/frames.ml
index b85426b5ae..2d43a5e84d 100644
--- a/debugger/frames.ml
+++ b/debugger/frames.ml
@@ -33,7 +33,7 @@ let selected_point () =
   match !selected_event with
     None ->
       raise Not_found
-  | Some {ev_char = point; ev_file = mdle} ->
+  | Some {ev_char = point; ev_module = mdle} ->
       (mdle, point)
 
 let selected_event_is_before () =
diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml
index c85951c28c..ef01b26634 100644
--- a/debugger/loadprinter.ml
+++ b/debugger/loadprinter.ml
@@ -45,9 +45,10 @@ let use_debugger_symtable fn arg =
       Symtable.restore_state st
   end;
   try
-    fn arg;
+    let result = fn arg in
     debugger_symtable := Some(Symtable.current_state());
-    Symtable.restore_state old_symtable
+    Symtable.restore_state old_symtable;
+    result
   with exn ->
     Symtable.restore_state old_symtable;
     raise exn
diff --git a/debugger/parser.mly b/debugger/parser.mly
index fe1b56eac4..f79d28cb22 100644
--- a/debugger/parser.mly
+++ b/debugger/parser.mly
@@ -195,7 +195,7 @@ expression_list_eol :
 break_argument_eol :
     end_of_line                                 { BA_none }
   | integer_eol                                 { BA_pc $1 }
-  | longident_eol                               { BA_function $1 }
+  | expression end_of_line                      { BA_function $1 }
   | AT opt_identifier INTEGER opt_integer_eol   { BA_pos1 ($2, $3, $4) }
   | AT opt_identifier SHARP integer_eol         { BA_pos2 ($2, $4) }
 ;
diff --git a/debugger/parser_aux.mli b/debugger/parser_aux.mli
index 1e65004cc0..1088a19066 100644
--- a/debugger/parser_aux.mli
+++ b/debugger/parser_aux.mli
@@ -16,14 +16,6 @@
 
 open Primitives
 
-type break_arg =
-    BA_none                             (* break *)
-  | BA_pc of int                        (* break PC *)
-  | BA_function of Longident.t          (* break FUNCTION *)
-  | BA_pos1 of string option * int * int option
-                                        (* break @ [MODULE] LINE [POS] *)
-  | BA_pos2 of string option * int      (* break @ [MODULE] # OFFSET *)
-
 type expression =
     E_ident of Longident.t              (* x or Mod.x *)
   | E_name of int                       (* $xxx *)
@@ -31,3 +23,11 @@ type expression =
   | E_field of expression * string      (* x.lbl !x *)
   | E_result
 
+type break_arg =
+    BA_none                             (* break *)
+  | BA_pc of int                        (* break PC *)
+  | BA_function of expression           (* break FUNCTION *)
+  | BA_pos1 of string option * int * int option
+                                        (* break @ [MODULE] LINE [POS] *)
+  | BA_pos2 of string option * int      (* break @ [MODULE] # OFFSET *)
+
diff --git a/debugger/printval.ml b/debugger/printval.ml
index 900e207ef0..0f3dcc7e26 100644
--- a/debugger/printval.ml
+++ b/debugger/printval.ml
@@ -124,6 +124,13 @@ exception Ellipsis
 let cautious f arg =
   try f arg with Ellipsis -> print_string "..."
 
+let check_depth depth obj ty =
+  if depth <= 0 then begin
+    let n = name_value obj ty in
+    print_char '$'; print_int n;
+    false
+  end else true
+
 let print_value max_depth obj ty env =
 
   let printer_steps = ref !max_printer_steps in
@@ -131,49 +138,54 @@ let print_value max_depth obj ty env =
   let rec print_val prio depth obj ty =
     decr printer_steps;
     if !printer_steps < 0 then raise Ellipsis;
-    if depth < 0 then begin
-      let n = name_value obj ty in
-      print_char '$'; print_int n
-    end else begin
-      try
-        find_printer env ty obj; ()
-      with Not_found ->
-        match (Ctype.repr ty).desc with
-          Tvar ->
-            print_string "<poly>"
-        | Tarrow(ty1, ty2) ->
-            print_string "<fun>"
-        | Ttuple(ty_list) ->
+    try
+      find_printer env ty obj; ()
+    with Not_found ->
+      match (Ctype.repr ty).desc with
+        Tvar ->
+          print_string "<poly>"
+      | Tarrow(ty1, ty2) ->
+          print_string "<fun>"
+      | Ttuple(ty_list) ->
+          if check_depth depth obj ty then begin
             if prio > 0
             then begin open_hovbox 1; print_string "(" end
             else open_hovbox 0;
             print_val_list 1 depth obj ty_list;
             if prio > 0 then print_string ")";
             close_box()
-        | Tconstr(path, [], _) when Path.same path Predef.path_exn ->
+          end
+      | Tconstr(path, [], _) when Path.same path Predef.path_exn ->
+          if check_depth depth obj ty then begin
             if prio > 1
             then begin open_hovbox 2; print_string "(" end
             else open_hovbox 1;
             print_exception obj;
             if prio > 1 then print_string ")";
             close_box()
-        | Tconstr(path, [ty_arg], _) when Path.same path Predef.path_list ->
+          end
+      | Tconstr(path, [ty_arg], _) when Path.same path Predef.path_list ->
+          if Debugcom.remote_value_is_int obj then
+            print_string "[]"
+          else if check_depth depth obj ty then begin
             let rec print_conses cons =
-              if not (Debugcom.remote_value_is_int cons) then begin
-                print_val 0 (depth - 1) (Debugcom.get_field cons 0) ty_arg;
-                let next_obj = Debugcom.get_field cons 1 in
-                if not (Debugcom.remote_value_is_int next_obj) then begin
-                  print_string ";"; print_space();
-                  print_conses next_obj
-                end
+              print_val 0 (depth - 1) (Debugcom.get_field cons 0) ty_arg;
+              let next_obj = Debugcom.get_field cons 1 in
+              if not (Debugcom.remote_value_is_int next_obj) then begin
+                print_string ";"; print_space();
+                print_conses next_obj
               end in
             open_hovbox 1;
             print_string "[";
             cautious print_conses obj;
             print_string "]";
             close_box()
-        | Tconstr(path, [ty_arg], _) when Path.same path Predef.path_array ->
-            let (tag, fields) = Debugcom.get_obj obj in
+          end
+      | Tconstr(path, [ty_arg], _) when Path.same path Predef.path_array ->
+          let (tag, fields) = Debugcom.get_obj obj in
+          if Array.length fields = 0 then
+            print_string "[||]"
+          else if check_depth depth obj ty then begin
             let rec print_items i =
               if i < Array.length fields then begin
                 if i > 0 then begin print_string ";"; print_space() end;
@@ -185,31 +197,33 @@ let print_value max_depth obj ty env =
             cautious print_items 0;
             print_string "|]";
             close_box()
-        | Tconstr(path, ty_list, _) ->
-            begin try
-              let decl = Env.find_type path env in
-              match decl with
-                {type_kind = Type_abstract; type_manifest = None} ->
-                  print_string "<abstr>"
-              | {type_kind = Type_abstract; type_manifest = Some body} ->
-                  print_val prio depth obj
-                            (Ctype.substitute decl.type_params ty_list body)
-              | {type_kind = Type_variant constr_list} ->
-                  let tag =
-                    if Debugcom.remote_value_is_int obj then
-                      Cstr_constant(Debugcom.int_value obj)
-                    else
-                      let (tag, sz) = Debugcom.get_header obj in
-                      Cstr_block tag in
-                  let (constr_name, constr_args) =
-                    find_constr tag 0 0 constr_list in
-                  let ty_args =
-                    List.map (Ctype.substitute decl.type_params ty_list)
-                        constr_args in
-                  begin match ty_args with
-                    [] ->
-                      print_string constr_name
-                  | [ty1] ->
+          end
+      | Tconstr(path, ty_list, _) ->
+          begin try
+            let decl = Env.find_type path env in
+            match decl with
+              {type_kind = Type_abstract; type_manifest = None} ->
+                print_string "<abstr>"
+            | {type_kind = Type_abstract; type_manifest = Some body} ->
+                print_val prio depth obj
+                          (Ctype.substitute decl.type_params ty_list body)
+            | {type_kind = Type_variant constr_list} ->
+                let tag =
+                  if Debugcom.remote_value_is_int obj then
+                    Cstr_constant(Debugcom.int_value obj)
+                  else
+                    let (tag, sz) = Debugcom.get_header obj in
+                    Cstr_block tag in
+                let (constr_name, constr_args) =
+                  find_constr tag 0 0 constr_list in
+                let ty_args =
+                  List.map (Ctype.substitute decl.type_params ty_list)
+                      constr_args in
+                begin match ty_args with
+                  [] ->
+                    print_string constr_name
+                | [ty1] ->
+                    if check_depth depth obj ty then begin
                       if prio > 1
                       then begin open_hovbox 2; print_string "(" end
                       else open_hovbox 1;
@@ -220,7 +234,9 @@ let print_value max_depth obj ty env =
                         ty1;
                       if prio > 1 then print_string ")";
                       close_box()
-                  | tyl ->
+                    end
+                | tyl ->
+                    if check_depth depth obj ty then begin
                       if prio > 1
                       then begin open_hovbox 2; print_string "(" end
                       else open_hovbox 1;
@@ -233,8 +249,10 @@ let print_value max_depth obj ty env =
                       close_box();
                       if prio > 1 then print_string ")";
                       close_box()
-                  end
-              | {type_kind = Type_record lbl_list} ->
+                    end
+                end
+            | {type_kind = Type_record lbl_list} ->
+                if check_depth depth obj ty then begin
                   let rec print_fields pos = function
                     [] -> ()
                   | (lbl_name, _, lbl_arg) :: remainder ->
@@ -256,17 +274,17 @@ let print_value max_depth obj ty env =
                   cautious (print_fields 0) lbl_list;
                   print_string "}";
                   close_box()
-            with
-              Not_found ->                (* raised by Env.find_type *)
-                print_string "<abstr>"
-            | Constr_not_found ->         (* raised by find_constr *)
-                print_string "<unknown constructor>"
-            end
-        | Tobject (_, _) ->
-            print_string "<obj>"
-        | Tfield(_, _, _) | Tnil | Tlink _ ->
-            fatal_error "Printval.print_value"
-      end
+                end
+          with
+            Not_found ->                (* raised by Env.find_type *)
+              print_string "<abstr>"
+          | Constr_not_found ->         (* raised by find_constr *)
+              print_string "<unknown constructor>"
+          end
+      | Tobject (_, _) ->
+          print_string "<obj>"
+      | Tfield(_, _, _) | Tnil | Tlink _ ->
+          fatal_error "Printval.print_value"
 
   and print_val_list prio depth obj ty_list =
     let rec print_list i = function
diff --git a/debugger/show_information.ml b/debugger/show_information.ml
index c13be2e999..b7292acef1 100644
--- a/debugger/show_information.ml
+++ b/debugger/show_information.ml
@@ -78,7 +78,7 @@ let show_one_frame framenum event =
   print_string "  Pc : ";
   print_int event.ev_pos;
   print_string "  ";
-  print_string event.ev_file;
+  print_string event.ev_module;
   print_string " char ";
   print_int event.ev_char;
   print_newline ()
@@ -103,5 +103,5 @@ let show_current_frame selected =
           List.iter (function x -> print_int x; print_string " ") breakpoints;
           print_newline ()
       end;
-      show_point sel_ev.ev_file sel_ev.ev_char
+      show_point sel_ev.ev_module sel_ev.ev_char
                  (selected_event_is_before ()) selected
diff --git a/debugger/show_source.ml b/debugger/show_source.ml
index 86e26ac47d..f9ea323c97 100644
--- a/debugger/show_source.ml
+++ b/debugger/show_source.ml
@@ -61,7 +61,7 @@ let show_point mdle point before selected =
       Out_of_range ->
         prerr_endline "Position out of range."
     | Not_found ->
-        prerr_endline ("Cannot find " ^ mdle ^ ".")
+        prerr_endline ("No source file for " ^ mdle ^ ".")
     end
 
 (* Display part of the source. *)
@@ -77,4 +77,4 @@ let show_listing mdle start stop point before =
       Out_of_range ->
         prerr_endline "Position out of range."
     | Not_found ->
-        prerr_endline ("Cannot find " ^ mdle ^ ".")
+        prerr_endline ("No source file for " ^ mdle ^ ".")
diff --git a/debugger/source.ml b/debugger/source.ml
index 87494c560d..acd9b9623e 100644
--- a/debugger/source.ml
+++ b/debugger/source.ml
@@ -20,7 +20,7 @@ open Primitives
 (*** Conversion function. ***)
 
 let source_of_module mdle =
-  find_in_path !Config.load_path mdle
+  find_in_path !Config.load_path (String.uncapitalize mdle ^ ".ml")
 
 (*** Buffer cache ***)
 
diff --git a/debugger/symbols.ml b/debugger/symbols.ml
index 8af8b8a383..d411783f7f 100644
--- a/debugger/symbols.ml
+++ b/debugger/symbols.ml
@@ -26,7 +26,7 @@ let events =
   ref ([] : debug_event list)
 let events_by_pc =
   (Hashtbl.create 257 : (int, debug_event) Hashtbl.t)
-let events_by_file =
+let events_by_module =
   (Hashtbl.create 17 : (string, debug_event array) Hashtbl.t)
 
 let read_symbols' bytecode_file =
@@ -69,10 +69,11 @@ let read_symbols bytecode_file =
     (function
         [] -> ()
       | ev :: _ as evl ->
-      	  let file = ev.ev_file
-          and sorted_evl = Sort.list (fun ev1 ev2 -> ev1.ev_char <= ev2.ev_char) evl in
-	  modules := file :: !modules;
-          Hashtbl.add events_by_file file (Array.of_list sorted_evl))
+      	  let md = ev.ev_module
+          and sorted_evl =
+            Sort.list (fun ev1 ev2 -> ev1.ev_char <= ev2.ev_char) evl in
+	  modules := md :: !modules;
+          Hashtbl.add events_by_module md (Array.of_list sorted_evl))
     all_events
 
 let event_at_pc pc =
@@ -82,7 +83,6 @@ let event_at_pc pc =
     Hashtbl.find events_by_pc pc
   with Not_found ->
     prerr_string "No event at pc="; prerr_int pc; prerr_endline ".";
-    (*exit 2*)
     raise Toplevel
 *)
 
@@ -90,21 +90,44 @@ let event_at_pc pc =
 let events_at_pc =
   Hashtbl.find_all events_by_pc
 
-let event_at_pos file char =
-  let ev = Hashtbl.find events_by_file file in
-  (* Binary search of event at or just after char *)
+(* List all events in module *)
+let events_in_module mdle =
+  try
+    Hashtbl.find events_by_module mdle
+  with Not_found ->
+    [||]
+
+(* Binary search of event at or just after char *)
+let find_event ev char =
   let rec bsearch lo hi =
     if lo >= hi then
-      if hi + 1 < Array.length ev then ev.(hi+1) else ev.(hi)
+      if hi + 1 < Array.length ev then hi+1 else hi
     else begin
       let pivot = (lo + hi) / 2 in
       let e = ev.(pivot) in
-      if char = e.ev_char then e else
+      if char = e.ev_char then pivot else
       if char < e.ev_char then bsearch lo (pivot - 1)
                           else bsearch (pivot + 1) hi
-    end in
-  bsearch 0 (Array.length ev - 1)
+    end
+  in bsearch 0 (Array.length ev - 1)
+
+(* Return first event after the given position. *)
+(* Raise [Not_found] if module is unknown. *)
+let event_at_pos md char =
+  let ev = Hashtbl.find events_by_module md in
+  ev.(find_event ev char)
+
+(* Return event closest to given position *)
+(* Raise [Not_found] if module is unknown. *)
+let event_near_pos md char =
+  let ev = Hashtbl.find events_by_module md in
+  let pos = find_event ev char in
+  (* Desired event is either ev.(pos) or ev.(pos - 1), whichever is closest *)
+  if pos > 0 && char - ev.(pos - 1).ev_char <= char - ev.(pos).ev_char
+  then ev.(pos - 1)
+  else ev.(pos)
 
+(* Flip "event" bit on all instructions *)
 let set_all_events () =
   Hashtbl.iter
     (fun pc ev -> Debugcom.set_event ev.ev_pos)
diff --git a/debugger/symbols.mli b/debugger/symbols.mli
index d212a139ea..6f88f0733b 100644
--- a/debugger/symbols.mli
+++ b/debugger/symbols.mli
@@ -15,12 +15,23 @@
 (* Modules used by the program. *)
 val modules : string list ref
 
-(* Events used by the program *)
-val events : Instruct.debug_event list ref
-val events_by_pc : (int, Instruct.debug_event) Hashtbl.t
-val events_by_file : (string, Instruct.debug_event array) Hashtbl.t
-
+(* Read debugging info from executable file *)
 val read_symbols : string -> unit
+
+(* Flip "event" bit on all instructions *)
+val set_all_events : unit -> unit
+
+(* Return event at given PC, or raise Not_found *)
 val event_at_pc : int -> Instruct.debug_event
+
+(* List the events in `module'. *)
+val events_in_module : string -> Instruct.debug_event array
+
+(* First event after the given position. *)
+(* --- Raise `Not_found' if no such event. *)
 val event_at_pos : string -> int -> Instruct.debug_event
-val set_all_events : unit -> unit
+
+(* Closest event from given position. *)
+(* --- Raise `Not_found' if no such event. *)
+val event_near_pos : string -> int -> Instruct.debug_event
+