PR#3767 features 1 and 2: display full location of events instead of one position

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

24 files changed, 195 insertions, 143 deletions

diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index 01156f438..65e51dcbc 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -146,7 +146,7 @@ let rec size_of_lambda = function
 let copy_event ev kind info repr =
   { ev_pos = 0;                   (* patched in emitcode *)
     ev_module = ev.ev_module;
-    ev_char = ev.ev_char;
+    ev_loc = ev.ev_loc;
     ev_kind = kind;
     ev_info = info;
     ev_typenv = ev.ev_typenv;
@@ -686,7 +686,7 @@ let rec comp_expr env exp sz cont =
       let event kind info =
         { ev_pos = 0;                   (* patched in emitcode *)
           ev_module = !compunit_name;
-          ev_char = lev.lev_pos;
+          ev_loc = lev.lev_loc;
           ev_kind = kind;
           ev_info = info;
           ev_typenv = lev.lev_env;
diff --git a/bytecomp/instruct.ml b/bytecomp/instruct.ml
index fd13db5d7..9fd2cb940 100644
--- a/bytecomp/instruct.ml
+++ b/bytecomp/instruct.ml
@@ -22,7 +22,7 @@ type compilation_env =
 type debug_event =
   { mutable ev_pos: int;                (* Position in bytecode *)
     ev_module: string;                  (* Name of defining module *)
-    ev_char: Lexing.position;           (* Position in source file *)
+    ev_loc: Location.t;                 (* Location in source file *)
     ev_kind: debug_event_kind;          (* Before/after event *)
     ev_info: debug_event_info;          (* Extra information *)
     ev_typenv: Env.summary;             (* Typing environment *)
diff --git a/bytecomp/instruct.mli b/bytecomp/instruct.mli
index fdedd8fd4..b7dbd7e3b 100644
--- a/bytecomp/instruct.mli
+++ b/bytecomp/instruct.mli
@@ -23,7 +23,7 @@ type compilation_env =
     ce_heap: int Ident.tbl;  (* Structure of the heap-allocated env *)
     ce_rec: int Ident.tbl }  (* Functions bound by the same let rec *)
 
-(* The ce_stack component gives locations of variables residing 
+(* The ce_stack component gives locations of variables residing
    in the stack. The locations are offsets w.r.t. the origin of the
    stack frame.
    The ce_heap component gives the positions of variables residing in the
@@ -39,7 +39,7 @@ type compilation_env =
 type debug_event =
   { mutable ev_pos: int;                (* Position in bytecode *)
     ev_module: string;                  (* Name of defining module *)
-    ev_char: Lexing.position;           (* Position in source file *)
+    ev_loc: Location.t;                 (* Location in source file *)
     ev_kind: debug_event_kind;          (* Before/after event *)
     ev_info: debug_event_info;          (* Extra information *)
     ev_typenv: Env.summary;             (* Typing environment *)
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index 7dbb60356..8b47cd4f2 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -96,7 +96,7 @@ and bigarray_kind =
   | Pbigarray_float32 | Pbigarray_float64
   | Pbigarray_sint8 | Pbigarray_uint8
   | Pbigarray_sint16 | Pbigarray_uint16
-  | Pbigarray_int32 | Pbigarray_int64 
+  | Pbigarray_int32 | Pbigarray_int64
   | Pbigarray_caml_int | Pbigarray_native_int
   | Pbigarray_complex32 | Pbigarray_complex64
 
@@ -149,7 +149,7 @@ and lambda_switch =
     sw_failaction : lambda option}
 
 and lambda_event =
-  { lev_pos: Lexing.position;
+  { lev_loc: Location.t;
     lev_kind: lambda_event_kind;
     lev_repr: int ref option;
     lev_env: Env.summary }
@@ -201,7 +201,7 @@ let rec same l1 l2 =
   | Lsend(k1, a1, b1, cl1), Lsend(k2, a2, b2, cl2) ->
       k1 = k2 && same a1 a2 && same b1 b2 && samelist same cl1 cl2
   | Levent(a1, ev1), Levent(a2, ev2) ->
-      same a1 a2 && ev1.lev_pos = ev2.lev_pos
+      same a1 a2 && ev1.lev_loc = ev2.lev_loc
   | Lifused(id1, a1), Lifused(id2, a2) ->
       Ident.same id1 id2 && same a1 a2
   | _, _ ->
@@ -270,7 +270,7 @@ let rec iter f = function
       f e1; f e2
   | Lwhile(e1, e2) ->
       f e1; f e2
-  | Lfor(v, e1, e2, dir, e3) -> 
+  | Lfor(v, e1, e2, dir, e3) ->
       f e1; f e2; f e3
   | Lassign(id, e) ->
       f e
@@ -300,10 +300,10 @@ let free_ids get l =
     | Lletrec(decl, body) ->
         List.iter (fun (id, exp) -> fv := IdentSet.remove id !fv) decl
     | Lstaticcatch(e1, (_,vars), e2) ->
-        List.iter (fun id -> fv := IdentSet.remove id !fv) vars        
+        List.iter (fun id -> fv := IdentSet.remove id !fv) vars
     | Ltrywith(e1, exn, e2) ->
         fv := IdentSet.remove exn !fv
-    | Lfor(v, e1, e2, dir, e3) -> 
+    | Lfor(v, e1, e2, dir, e3) ->
         fv := IdentSet.remove v !fv
     | Lassign(id, e) ->
         fv := IdentSet.add id !fv
@@ -386,14 +386,14 @@ let subst_lambda s lam =
                          match sw.sw_failaction with
                          | None -> None
                          | Some l -> Some (subst l)})
-                   
+
   | Lstaticraise (i,args) ->  Lstaticraise (i, List.map subst args)
   | Lstaticcatch(e1, io, e2) -> Lstaticcatch(subst e1, io, subst e2)
   | Ltrywith(e1, exn, e2) -> Ltrywith(subst e1, exn, subst e2)
   | Lifthenelse(e1, e2, e3) -> Lifthenelse(subst e1, subst e2, subst e3)
   | Lsequence(e1, e2) -> Lsequence(subst e1, subst e2)
   | Lwhile(e1, e2) -> Lwhile(subst e1, subst e2)
-  | Lfor(v, e1, e2, dir, e3) -> Lfor(v, subst e1, subst e2, dir, subst e3) 
+  | Lfor(v, e1, e2, dir, e3) -> Lfor(v, subst e1, subst e2, dir, subst e3)
   | Lassign(id, e) -> Lassign(id, subst e)
   | Lsend (k, met, obj, args) ->
       Lsend (k, subst met, subst obj, List.map subst args)
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index 87285effa..fb02042f3 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -157,7 +157,7 @@ and lambda_switch =
     sw_blocks: (int * lambda) list;     (* Tag block cases *)
     sw_failaction : lambda option}      (* Action to take if failure *)
 and lambda_event =
-  { lev_pos: Lexing.position;
+  { lev_loc: Location.t;
     lev_kind: lambda_event_kind;
     lev_repr: int ref option;
     lev_env: Env.summary }
@@ -200,6 +200,6 @@ val next_raise_count : unit -> int
 val staticfail : lambda (* Anticipated static failure *)
 
 (* Check anticipated failure, substitute its final value *)
-val is_guarded: lambda -> bool 
-val patch_guarded : lambda -> lambda -> lambda 
+val is_guarded: lambda -> bool
+val patch_guarded : lambda -> lambda -> lambda
 
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index d24be42f1..2afa4d2b6 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -2060,7 +2060,7 @@ let rec event_branch repr lam =
       lam
   | (Levent(lam', ev), Some r) ->
       incr r;
-      Levent(lam', {lev_pos = ev.lev_pos;
+      Levent(lam', {lev_loc = ev.lev_loc;
                     lev_kind = ev.lev_kind;
                     lev_repr = repr;
                     lev_env = ev.lev_env})
diff --git a/bytecomp/printinstr.ml b/bytecomp/printinstr.ml
index a7c859d84..2f0508b29 100644
--- a/bytecomp/printinstr.ml
+++ b/bytecomp/printinstr.ml
@@ -99,8 +99,10 @@ let instruction ppf = function
   | Kgetpubmet n -> fprintf ppf "\tgetpubmet %i" n
   | Kgetdynmet -> fprintf ppf "\tgetdynmet"
   | Kstop -> fprintf ppf "\tstop"
-  | Kevent ev -> fprintf ppf "\tevent \"%s\" %i" ev.ev_char.Lexing.pos_fname
-                                                 ev.ev_char.Lexing.pos_cnum
+  | Kevent ev -> fprintf ppf "\tevent \"%s\" %i-%i"
+                         ev.ev_loc.Location.loc_start.Lexing.pos_fname
+                         ev.ev_loc.Location.loc_start.Lexing.pos_cnum
+                         ev.ev_loc.Location.loc_end.Lexing.pos_cnum
 
 let rec instruction_list ppf = function
     [] -> ()
@@ -108,6 +110,6 @@ let rec instruction_list ppf = function
       fprintf ppf "L%i:%a" lbl instruction_list il
   | instr :: il ->
       fprintf ppf "%a@ %a" instruction instr instruction_list il
- 
+
 let instrlist ppf il =
   fprintf ppf "@[<v 0>%a@]" instruction_list il
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index bd72daa89..27c0ff3d5 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -282,12 +282,15 @@ let rec lam ppf = function
         if k = Self then "self" else if k = Cached then "cache" else "" in
       fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind lam obj lam met args largs
   | Levent(expr, ev) ->
-      let kind = 
+      let kind =
        match ev.lev_kind with
        | Lev_before -> "before"
        | Lev_after _  -> "after"
        | Lev_function -> "funct-body" in
-      fprintf ppf "@[<2>(%s %i@ %a)@]" kind ev.lev_pos.Lexing.pos_cnum lam expr
+      fprintf ppf "@[<2>(%s %i-%i@ %a)@]" kind
+              ev.lev_loc.Location.loc_start.Lexing.pos_cnum
+              ev.lev_loc.Location.loc_end.Lexing.pos_cnum
+              lam expr
   | Lifused(id, expr) ->
       fprintf ppf "@[<2>(ifused@ %a@ %a)@]" Ident.print id lam expr
 
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 87a066882..040721159 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -461,7 +461,7 @@ let event_before exp lam = match lam with
 | Lstaticraise (_,_) -> lam
 | _ ->
   if !Clflags.debug
-  then Levent(lam, {lev_pos = exp.exp_loc.Location.loc_start;
+  then Levent(lam, {lev_loc = exp.exp_loc;
                     lev_kind = Lev_before;
                     lev_repr = None;
                     lev_env = Env.summary exp.exp_env})
@@ -469,7 +469,7 @@ let event_before exp lam = match lam with
 
 let event_after exp lam =
   if !Clflags.debug
-  then Levent(lam, {lev_pos = exp.exp_loc.Location.loc_end;
+  then Levent(lam, {lev_loc = exp.exp_loc;
                     lev_kind = Lev_after exp.exp_type;
                     lev_repr = None;
                     lev_env = Env.summary exp.exp_env})
@@ -480,7 +480,7 @@ let event_function exp lam =
     let repr = Some (ref 0) in
     let (info, body) = lam repr in
     (info,
-     Levent(body, {lev_pos = exp.exp_loc.Location.loc_start;
+     Levent(body, {lev_loc = exp.exp_loc;
                    lev_kind = Lev_function;
                    lev_repr = repr;
                    lev_env = Env.summary exp.exp_env}))
diff --git a/debugger/.depend b/debugger/.depend
index 54cbb5e72..07a35e546 100644
--- a/debugger/.depend
+++ b/debugger/.depend
@@ -19,6 +19,7 @@ printval.cmi: ../typing/types.cmi ../typing/path.cmi parser_aux.cmi \
     ../typing/env.cmi debugcom.cmi 
 program_loading.cmi: primitives.cmi 
 show_information.cmi: ../bytecomp/instruct.cmi 
+show_source.cmi: ../bytecomp/instruct.cmi 
 symbols.cmi: ../bytecomp/instruct.cmi 
 time_travel.cmi: primitives.cmi 
 unix_tools.cmi: ../otherlibs/unix/unix.cmi 
@@ -34,20 +35,20 @@ command_line.cmo: unix_tools.cmi ../otherlibs/unix/unix.cmi \
     ../typing/types.cmi time_travel.cmi symbols.cmi source.cmi \
     show_source.cmi show_information.cmi program_management.cmi \
     program_loading.cmi printval.cmi primitives.cmi pos.cmi parser_aux.cmi \
-    parser.cmi parameters.cmi ../utils/misc.cmi loadprinter.cmi lexer.cmi \
-    int64ops.cmi ../bytecomp/instruct.cmi input_handling.cmi history.cmi \
-    frames.cmi events.cmi eval.cmi envaux.cmi debugger_config.cmi \
-    debugcom.cmi ../typing/ctype.cmi ../utils/config.cmi checkpoints.cmi \
-    breakpoints.cmi command_line.cmi 
+    parser.cmi parameters.cmi ../utils/misc.cmi ../parsing/location.cmi \
+    loadprinter.cmi lexer.cmi int64ops.cmi ../bytecomp/instruct.cmi \
+    input_handling.cmi history.cmi frames.cmi events.cmi eval.cmi envaux.cmi \
+    debugger_config.cmi debugcom.cmi ../typing/ctype.cmi ../utils/config.cmi \
+    checkpoints.cmi breakpoints.cmi command_line.cmi 
 command_line.cmx: unix_tools.cmx ../otherlibs/unix/unix.cmx \
     ../typing/types.cmx time_travel.cmx symbols.cmx source.cmx \
     show_source.cmx show_information.cmx program_management.cmx \
     program_loading.cmx printval.cmx primitives.cmx pos.cmx parser_aux.cmi \
-    parser.cmx parameters.cmx ../utils/misc.cmx loadprinter.cmx lexer.cmx \
-    int64ops.cmx ../bytecomp/instruct.cmx input_handling.cmx history.cmx \
-    frames.cmx events.cmx eval.cmx envaux.cmx debugger_config.cmx \
-    debugcom.cmx ../typing/ctype.cmx ../utils/config.cmx checkpoints.cmx \
-    breakpoints.cmx command_line.cmi 
+    parser.cmx parameters.cmx ../utils/misc.cmx ../parsing/location.cmx \
+    loadprinter.cmx lexer.cmx int64ops.cmx ../bytecomp/instruct.cmx \
+    input_handling.cmx history.cmx frames.cmx events.cmx eval.cmx envaux.cmx \
+    debugger_config.cmx debugcom.cmx ../typing/ctype.cmx ../utils/config.cmx \
+    checkpoints.cmx breakpoints.cmx command_line.cmi 
 debugcom.cmo: primitives.cmi ../utils/misc.cmi int64ops.cmi \
     input_handling.cmi debugcom.cmi 
 debugcom.cmx: primitives.cmx ../utils/misc.cmx int64ops.cmx \
@@ -72,9 +73,9 @@ eval.cmx: ../typing/types.cmx ../bytecomp/symtable.cmx printval.cmx \
     ../bytecomp/instruct.cmx ../typing/ident.cmx frames.cmx ../typing/env.cmx \
     debugger_config.cmx debugcom.cmx ../typing/ctype.cmx ../typing/btype.cmx \
     eval.cmi 
-events.cmo: symbols.cmi primitives.cmi ../bytecomp/instruct.cmi \
+events.cmo: primitives.cmi ../parsing/location.cmi ../bytecomp/instruct.cmi \
     checkpoints.cmi events.cmi 
-events.cmx: symbols.cmx primitives.cmx ../bytecomp/instruct.cmx \
+events.cmx: primitives.cmx ../parsing/location.cmx ../bytecomp/instruct.cmx \
     checkpoints.cmx events.cmi 
 exec.cmo: exec.cmi 
 exec.cmx: exec.cmi 
@@ -130,8 +131,10 @@ pattern_matching.cmo: ../typing/typedtree.cmi parser_aux.cmi \
 pattern_matching.cmx: ../typing/typedtree.cmx parser_aux.cmi \
     ../utils/misc.cmx debugger_config.cmx debugcom.cmx ../typing/ctype.cmx \
     pattern_matching.cmi 
-pos.cmo: source.cmi primitives.cmi ../bytecomp/instruct.cmi pos.cmi 
-pos.cmx: source.cmx primitives.cmx ../bytecomp/instruct.cmx pos.cmi 
+pos.cmo: source.cmi primitives.cmi ../parsing/location.cmi \
+    ../bytecomp/instruct.cmi pos.cmi 
+pos.cmx: source.cmx primitives.cmx ../parsing/location.cmx \
+    ../bytecomp/instruct.cmx pos.cmi 
 primitives.cmo: ../otherlibs/unix/unix.cmi primitives.cmi 
 primitives.cmx: ../otherlibs/unix/unix.cmx primitives.cmi 
 printval.cmo: ../typing/types.cmi ../bytecomp/symtable.cmi \
@@ -159,21 +162,27 @@ program_management.cmx: unix_tools.cmx ../otherlibs/unix/unix.cmx \
     input_handling.cmx history.cmx debugger_config.cmx debugcom.cmx \
     breakpoints.cmx program_management.cmi 
 show_information.cmo: symbols.cmi show_source.cmi printval.cmi primitives.cmi \
-    ../utils/misc.cmi ../bytecomp/instruct.cmi frames.cmi events.cmi \
-    debugcom.cmi checkpoints.cmi breakpoints.cmi show_information.cmi 
+    ../utils/misc.cmi ../parsing/location.cmi ../bytecomp/instruct.cmi \
+    frames.cmi events.cmi debugcom.cmi checkpoints.cmi breakpoints.cmi \
+    show_information.cmi 
 show_information.cmx: symbols.cmx show_source.cmx printval.cmx primitives.cmx \
-    ../utils/misc.cmx ../bytecomp/instruct.cmx frames.cmx events.cmx \
-    debugcom.cmx checkpoints.cmx breakpoints.cmx show_information.cmi 
+    ../utils/misc.cmx ../parsing/location.cmx ../bytecomp/instruct.cmx \
+    frames.cmx events.cmx debugcom.cmx checkpoints.cmx breakpoints.cmx \
+    show_information.cmi 
 show_source.cmo: source.cmi primitives.cmi parameters.cmi ../utils/misc.cmi \
+    ../parsing/location.cmi ../bytecomp/instruct.cmi events.cmi \
     debugger_config.cmi show_source.cmi 
 show_source.cmx: source.cmx primitives.cmx parameters.cmx ../utils/misc.cmx \
+    ../parsing/location.cmx ../bytecomp/instruct.cmx events.cmx \
     debugger_config.cmx show_source.cmi 
 source.cmo: primitives.cmi ../utils/misc.cmi ../utils/config.cmi source.cmi 
 source.cmx: primitives.cmx ../utils/misc.cmx ../utils/config.cmx source.cmi 
 symbols.cmo: ../bytecomp/symtable.cmi primitives.cmi ../bytecomp/instruct.cmi \
-    debugger_config.cmi debugcom.cmi ../bytecomp/bytesections.cmi symbols.cmi 
+    events.cmi debugger_config.cmi debugcom.cmi checkpoints.cmi \
+    ../bytecomp/bytesections.cmi symbols.cmi 
 symbols.cmx: ../bytecomp/symtable.cmx primitives.cmx ../bytecomp/instruct.cmx \
-    debugger_config.cmx debugcom.cmx ../bytecomp/bytesections.cmx symbols.cmi 
+    events.cmx debugger_config.cmx debugcom.cmx checkpoints.cmx \
+    ../bytecomp/bytesections.cmx symbols.cmi 
 time_travel.cmo: trap_barrier.cmi symbols.cmi program_loading.cmi \
     primitives.cmi ../utils/misc.cmi int64ops.cmi ../bytecomp/instruct.cmi \
     input_handling.cmi exec.cmi events.cmi debugger_config.cmi debugcom.cmi \
diff --git a/debugger/Makefile b/debugger/Makefile
index 9e0601d1a..beabfa283 100644
--- a/debugger/Makefile
+++ b/debugger/Makefile
@@ -57,8 +57,8 @@ OBJS=\
 	source.cmo \
 	pos.cmo \
 	checkpoints.cmo \
-	symbols.cmo \
 	events.cmo \
+	symbols.cmo \
 	breakpoints.cmo \
 	trap_barrier.cmo \
 	history.cmo \
diff --git a/debugger/command_line.ml b/debugger/command_line.ml
index 534aa482f..ef1b025a2 100644
--- a/debugger/command_line.ml
+++ b/debugger/command_line.ml
@@ -144,7 +144,7 @@ let convert_module mdle =
                         else m)
   | None ->
       try
-        let (x, _) = current_point () in x
+        (get_current_event ()).ev_module
       with
       | Not_found ->
           error "Not in a module."
@@ -830,13 +830,14 @@ let info_events ppf lexbuf =
   ensure_loaded ();
   let mdle = convert_module (opt_identifier_eol Lexer.lexeme lexbuf) in
     print_endline ("Module : " ^ mdle);
-    print_endline "   Address  Character      Kind      Repr.";
+    print_endline "   Address  Characters        Kind      Repr.";
     List.iter
       (function ev ->
          Printf.printf
-           "%10d %10d  %10s %10s\n"
+           "%10d %6d-%-6d  %10s %10s\n"
            ev.ev_pos
-           ev.ev_char.Lexing.pos_cnum
+           ev.ev_loc.Location.loc_start.Lexing.pos_cnum
+           ev.ev_loc.Location.loc_end.Lexing.pos_cnum
            ((match ev.ev_kind with
                Event_before   -> "before"
              | Event_after _  -> "after"
diff --git a/debugger/events.ml b/debugger/events.ml
index 5fb501ed3..d9229712a 100644
--- a/debugger/events.ml
+++ b/debugger/events.ml
@@ -19,10 +19,13 @@ open Instruct
 open Primitives
 open Checkpoints
 
-(* Previous `pc'. *)
-(* Save time if `update_current_event' is called *)
-(* several times at the same point. *)
-let old_pc = ref (None : int option)
+let get_pos ev =
+  match ev.ev_kind with
+  | Event_before -> ev.ev_loc.Location.loc_start
+  | Event_after _ -> ev.ev_loc.Location.loc_end
+  | _ -> ev.ev_loc.Location.loc_start
+;;
+
 
 (*** Current events. ***)
 
@@ -30,30 +33,12 @@ let old_pc = ref (None : int option)
 let current_event =
   ref (None : debug_event option)
 
-(* Recompute the current event *)
-let update_current_event () =
-  match current_pc () with
-    None ->
-      current_event := None;
-      old_pc := None
-  | (Some pc) as opt_pc when opt_pc <> !old_pc ->
-      current_event := begin try
-                         Some (Symbols.event_at_pc pc)
-                       with Not_found ->
-                         None
-                       end;
-      old_pc := opt_pc
-  | _ ->
-      ()
-
 (* Current position in source. *)
 (* Raise `Not_found' if not on an event (beginning or end of program). *)
-let current_point () =
+let get_current_event () =
   match !current_event with
-    None ->
-      raise Not_found
-  | Some {ev_char = point; ev_module = mdle} ->
-      (mdle, point.Lexing.pos_cnum)
+  | None -> raise Not_found
+  | Some ev -> ev
 
 let current_event_is_before () =
   match !current_event with
diff --git a/debugger/events.mli b/debugger/events.mli
index 8c4739957..df928de00 100644
--- a/debugger/events.mli
+++ b/debugger/events.mli
@@ -15,17 +15,16 @@
 
 open Instruct
 
+val get_pos : debug_event -> Lexing.position;;
+
 (** Current events. **)
 
 (* The event at current position. *)
 val current_event : debug_event option ref
 
-(* Recompute the current event *)
-val update_current_event : unit -> unit
-
 (* Current position in source. *)
 (* Raise `Not_found' if not on an event (beginning or end of program). *)
-val current_point : unit -> string * int
+val get_current_event : unit -> debug_event
 
 val current_event_is_before : unit -> bool
 
diff --git a/debugger/frames.ml b/debugger/frames.ml
index cb76e013a..a2e42087e 100644
--- a/debugger/frames.ml
+++ b/debugger/frames.ml
@@ -34,8 +34,8 @@ let selected_point () =
   match !selected_event with
     None ->
       raise Not_found
-  | Some {ev_char = point; ev_module = mdle} ->
-      (mdle, point.Lexing.pos_cnum)
+  | Some ev ->
+      (ev.ev_module, (Events.get_pos ev).Lexing.pos_cnum)
 
 let selected_event_is_before () =
   match !selected_event with
diff --git a/debugger/pos.ml b/debugger/pos.ml
index 235de121d..1da24c4bd 100644
--- a/debugger/pos.ml
+++ b/debugger/pos.ml
@@ -14,24 +14,29 @@
 
 open Instruct;;
 open Lexing;;
+open Location;;
 open Primitives;;
 open Source;;
 
 let get_desc ev =
-  if ev.ev_char.pos_fname <> ""
-  then Printf.sprintf "file %s, line %d, character %d"
-                      ev.ev_char.pos_fname ev.ev_char.pos_lnum
-                      (ev.ev_char.pos_cnum - ev.ev_char.pos_bol + 1)
+  let loc = ev.ev_loc in
+  if loc.loc_start.pos_fname <> ""
+  then 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)
   else begin
     let filename = source_of_module ev.ev_module in
     try
       let (start, line) = line_of_pos (get_buffer ev.ev_module)
-                                      ev.ev_char.pos_cnum
+                                      loc.loc_start.pos_cnum
       in
-      Printf.sprintf "file %s, line %d, character %d"
-                     filename line (ev.ev_char.pos_cnum - start + 1)
+      Printf.sprintf "file %s, line %d, characters %d-%d"
+                     filename line (loc.loc_start.pos_cnum - start + 1)
+                     (loc.loc_end.pos_cnum - start + 1)
     with Not_found | Out_of_range ->
-      Printf.sprintf "file %s, character %d"
-                     filename (ev.ev_char.pos_cnum + 1)
+      Printf.sprintf "file %s, characters %d-%d"
+                     filename (loc.loc_start.pos_cnum + 1)
+                     (loc.loc_end.pos_cnum + 1)
   end
 ;;
diff --git a/debugger/show_information.ml b/debugger/show_information.ml
index 7492ddc2e..de6817cd2 100644
--- a/debugger/show_information.ml
+++ b/debugger/show_information.ml
@@ -37,9 +37,9 @@ let show_current_event ppf =
   | None ->
       fprintf ppf "@.Beginning of program.@.";
       show_no_point ()
-  | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} -> 
-     let (mdle, point) = current_point () in
-        fprintf ppf " - module %s@." mdle;
+  | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} ->
+        let ev = get_current_event () in
+        fprintf ppf " - module %s@." ev.ev_module;
         (match breakpoints_at_pc pc with
          | [] ->
              ()
@@ -51,7 +51,7 @@ let show_current_event ppf =
                List.iter
                 (function x -> fprintf ppf "%i " x) l)
              (List.sort compare breakpoints));
-        show_point mdle point (current_event_is_before ()) true
+        show_point ev true
   | Some {rep_type = Exited} ->
       fprintf ppf "@.Program exit.@.";
       show_no_point ()
@@ -70,7 +70,8 @@ let show_current_event ppf =
 
 let show_one_frame framenum ppf event =
   fprintf ppf "#%i  Pc : %i  %s char %i@."
-         framenum event.ev_pos event.ev_module event.ev_char.Lexing.pos_cnum
+         framenum event.ev_pos event.ev_module
+         (Events.get_pos event).Lexing.pos_cnum
 
 (* Display information about the current frame. *)
 (* --- `select frame' must have succeded before calling this function. *)
@@ -90,5 +91,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.ev_module sel_ev.ev_char.Lexing.pos_cnum
-                 (selected_event_is_before ()) selected
+      show_point sel_ev selected
diff --git a/debugger/show_source.ml b/debugger/show_source.ml
index dd798cd5c..8ec34f8ab 100644
--- a/debugger/show_source.ml
+++ b/debugger/show_source.ml
@@ -14,11 +14,12 @@
 (* $Id$ *)
 
 open Debugger_config
-open Parameters
+open Instruct
 open Misc
+open Parameters
 open Primitives
-open Source
 open Printf
+open Source
 
 (* Print a line; return the beginning of the next line *)
 let print_line buffer line_number start point before =
@@ -40,12 +41,16 @@ let show_no_point () =
   if !emacs then printf "\026\026H\n"
 
 (* Print the line containing the point *)
-let show_point mdle point before selected =
+let show_point ev selected =
+  let mdle = ev.ev_module in
+  let before = (ev.ev_kind = Event_before) in
   if !emacs && selected then
     begin try
       let source = source_of_module mdle in
-        printf "\026\026M%s:%i" source point;
-        printf "%s\n" (if before then ":before" else ":after")
+      printf "\026\026M%s:%i:%i" source
+             ev.ev_loc.Location.loc_start.Lexing.pos_cnum
+             ev.ev_loc.Location.loc_end.Lexing.pos_cnum;
+      printf "%s\n" (if before then ":before" else ":after")
     with
       Not_found    -> (* get_buffer *)
         prerr_endline ("No source file for " ^ mdle ^ ".");
@@ -54,6 +59,7 @@ let show_point mdle point before selected =
   else
     begin try
       let buffer = get_buffer mdle in
+      let point = (Events.get_pos ev).Lexing.pos_cnum in
       let (start, line_number) = line_of_pos buffer point in
       ignore(print_line buffer line_number start point before)
     with
diff --git a/debugger/show_source.mli b/debugger/show_source.mli
index 29f2f8c67..17d5ef834 100644
--- a/debugger/show_source.mli
+++ b/debugger/show_source.mli
@@ -14,7 +14,7 @@
 (* $Id$ *)
 
 (* Print the line containing the point *)
-val show_point : string -> int -> bool -> bool -> unit;;
+val show_point : Instruct.debug_event -> bool -> unit;;
 
 (* Tell Emacs we are nowhere in the source. *)
 val show_no_point : unit -> unit;;
diff --git a/debugger/symbols.ml b/debugger/symbols.ml
index 031bec640..8ed7545c6 100644
--- a/debugger/symbols.ml
+++ b/debugger/symbols.ml
@@ -85,8 +85,8 @@ let read_symbols bytecode_file =
         [] -> ()
       | ev :: _ as evl ->
           let md = ev.ev_module in
-          let cmp ev1 ev2 = compare ev1.ev_char.Lexing.pos_cnum
-                                    ev2.ev_char.Lexing.pos_cnum
+          let cmp ev1 ev2 = compare (Events.get_pos ev1).Lexing.pos_cnum
+                                    (Events.get_pos ev2).Lexing.pos_cnum
           in
           let sorted_evl = List.sort cmp evl in
           modules := md :: !modules;
@@ -125,13 +125,15 @@ let events_in_module mdle =
 let find_event ev char =
   let rec bsearch lo hi =
     if lo >= hi then begin
-      if ev.(hi).ev_char.Lexing.pos_cnum < char then raise Not_found;
-      hi
+      if (Events.get_pos ev.(hi)).Lexing.pos_cnum < char
+      then raise Not_found
+      else hi
     end else begin
       let pivot = (lo + hi) / 2 in
       let e = ev.(pivot) in
-      if char <= e.ev_char.Lexing.pos_cnum then bsearch lo pivot
-                                           else bsearch (pivot + 1) hi
+      if char <= (Events.get_pos e).Lexing.pos_cnum
+      then bsearch lo pivot
+      else bsearch (pivot + 1) hi
     end
   in
   bsearch 0 (Array.length ev - 1)
@@ -150,8 +152,8 @@ let event_near_pos md char =
     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.Lexing.pos_cnum
-                  <= ev.(pos).ev_char.Lexing.pos_cnum - char
+    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)
   with Not_found ->
@@ -167,3 +169,26 @@ let set_all_events () =
          Event_pseudo -> ()
        | _            -> Debugcom.set_event ev.ev_pos)
     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)
+
+(* Recompute the current event *)
+let update_current_event () =
+  match Checkpoints.current_pc () with
+    None ->
+      Events.current_event := None;
+      old_pc := None
+  | (Some pc) as opt_pc when opt_pc <> !old_pc ->
+      Events.current_event :=
+        begin try
+          Some (event_at_pc pc)
+        with Not_found ->
+          None
+        end;
+      old_pc := opt_pc
+  | _ ->
+      ()
diff --git a/debugger/symbols.mli b/debugger/symbols.mli
index 0cb1e2e57..57ac8007b 100644
--- a/debugger/symbols.mli
+++ b/debugger/symbols.mli
@@ -42,3 +42,5 @@ val event_at_pos : string -> int -> Instruct.debug_event
 (* --- Raise `Not_found' if no such event. *)
 val event_near_pos : string -> int -> Instruct.debug_event
 
+(* Recompute the current event *)
+val update_current_event : unit -> unit
diff --git a/debugger/time_travel.ml b/debugger/time_travel.ml
index e4a03af6f..8977e9ca0 100644
--- a/debugger/time_travel.ml
+++ b/debugger/time_travel.ml
@@ -263,7 +263,7 @@ let rec stop_on_event report =
     {rep_type = Breakpoint; rep_program_pointer = pc;
      rep_stack_pointer = sp} ->
       last_breakpoint := Some (pc, sp);
-      update_current_event ();
+      Symbols.update_current_event ();
       begin match !current_event with
         None   -> find_event ()
       | Some _ -> ()
@@ -508,7 +508,7 @@ let step duration =
 
 (* Finish current function. *)
 let finish () =
-  update_current_event ();
+  Symbols.update_current_event ();
   match !current_event with
     None ->
       prerr_endline "`finish' not meaningful in outermost frame.";
@@ -545,7 +545,7 @@ let finish () =
                 done))
 
 let next_1 () =
-  update_current_event ();
+  Symbols.update_current_event ();
   match !current_event with
     None ->                             (* Beginning of the program. *)
       step _1
@@ -553,7 +553,7 @@ let next_1 () =
       let (frame1, pc1) = initial_frame() in
       step _1;
       if not !interrupted then begin
-        update_current_event ();
+        Symbols.update_current_event ();
         match !current_event with
           None -> ()
         | Some event2 ->
@@ -575,7 +575,7 @@ let rec next =
 
 (* Run backward until just before current function. *)
 let start () =
-  update_current_event ();
+  Symbols.update_current_event ();
   match !current_event with
     None ->
       prerr_endline "`start not meaningful in outermost frame.";
@@ -613,7 +613,7 @@ let start () =
       done
 
 let previous_1 () =
-  update_current_event ();
+  Symbols.update_current_event ();
   match !current_event with
     None ->                             (* End of the program. *)
       step _minus1
@@ -621,7 +621,7 @@ let previous_1 () =
       let (frame1, pc1) = initial_frame() in
       step _minus1;
       if not !interrupted then begin
-        update_current_event ();
+        Symbols.update_current_event ();
         match !current_event with
           None -> ()
         | Some event2 ->
diff --git a/emacs/camldebug.el b/emacs/camldebug.el
index 32846bbef..b91198395 100644
--- a/emacs/camldebug.el
+++ b/emacs/camldebug.el
@@ -248,10 +248,15 @@ representation is simply concatenated with the COMMAND."
   ;accumulate onto previous output
   (setq camldebug-filter-accumulator
         (concat camldebug-filter-accumulator string))
-  (if (not (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+"
-                          camldebug-goto-position
-                          "[ \t]*\\(before\\|after\\)\n")
-                  camldebug-filter-accumulator)) nil
+  (if (not (or (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+"
+                                     camldebug-goto-position
+                                     "-[0-9]+[ \t]*\\(before\\).*\n")
+                             camldebug-filter-accumulator)
+               (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+-"
+                                     camldebug-goto-position
+                                     "[ \t]*\\(after\\).*\n")
+                             camldebug-filter-accumulator)))
+           nil
     (setq camldebug-goto-output
           (match-string 2 camldebug-filter-accumulator))
     (setq camldebug-filter-accumulator
@@ -516,17 +521,24 @@ the camldebug commands `cd DIR' and `directory'."
     ;; Process all the complete markers in this chunk.
     (while (setq begin
                  (string-match
-                  "\032\032\\(H\\|M\\(.+\\):\\(.+\\):\\(before\\|after\\)\\)\n"
+                  "\032\032\\(H\\|M\\(.+\\):\\(.+\\):\\(.+\\):\\(before\\|after\\)\\)\n"
                   camldebug-filter-accumulator))
       (setq camldebug-last-frame
             (if (char-equal ?H (aref camldebug-filter-accumulator
                                      (1+ (1+ begin)))) nil
-              (list (match-string 2 camldebug-filter-accumulator)
-                    (string-to-int
-                     (match-string 3 camldebug-filter-accumulator))
-                    (string= "before"
-                             (match-string 4
-                                           camldebug-filter-accumulator))))
+              (let ((isbefore
+                     (string= "before"
+                              (match-string 5 camldebug-filter-accumulator)))
+                    (startpos (string-to-int
+                               (match-string 3 camldebug-filter-accumulator)))
+                    (endpos (string-to-int
+                             (match-string 4 camldebug-filter-accumulator))))
+                (list (match-string 2 camldebug-filter-accumulator)
+                      (if isbefore startpos endpos)
+                      isbefore
+                      startpos
+                      endpos
+                      )))
             output (concat output
                            (substring camldebug-filter-accumulator
                                       0 begin))
@@ -627,33 +639,36 @@ the camldebug commands `cd DIR' and `directory'."
 
 (defun camldebug-display-frame ()
   "Find, obey and delete the last filename-and-line marker from CDB.
-The marker looks like \\032\\032FILENAME:CHARACTER\\n.
+The marker looks like \\032\\032Mfilename:startchar:endchar:beforeflag\\n.
 Obeying it means displaying in another window the specified file and line."
   (interactive)
   (camldebug-set-buffer)
   (if (not camldebug-last-frame)
       (camldebug-remove-current-event)
-    (camldebug-display-line (car camldebug-last-frame)
-                            (car (cdr camldebug-last-frame))
-                            (car (cdr (cdr camldebug-last-frame)))))
+    (camldebug-display-line (nth 0 camldebug-last-frame)
+                            (nth 3 camldebug-last-frame)
+                            (nth 4 camldebug-last-frame)
+                            (nth 2 camldebug-last-frame)))
   (setq camldebug-last-frame-displayed-p t))
 
 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
 ;; and that its character CHARACTER is visible.
 ;; Put the mark on this character in that buffer.
 
-(defun camldebug-display-line (true-file character kind)
+(defun camldebug-display-line (true-file schar echar kind)
   (let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen
          (pop-up-windows t)
          (buffer (find-file-noselect true-file))
          (window (display-buffer buffer t))
-         (pos))
+         (spos) (epos) (pos))
     (save-excursion
       (set-buffer buffer)
       (save-restriction
         (widen)
-        (setq pos (+ (point-min) character))
-        (camldebug-set-current-event pos (current-buffer) kind))
+        (setq spos (+ (point-min) schar))
+        (setq epos (+ (point-min) echar))
+        (setq pos (if kind spos epos))
+        (camldebug-set-current-event spos epos (current-buffer) kind))
       (cond ((or (< pos (point-min)) (> pos (point-max)))
              (widen)
              (goto-char pos))))
@@ -668,15 +683,15 @@ Obeying it means displaying in another window the specified file and line."
         (delete-overlay camldebug-overlay-under))
     (setq overlay-arrow-position nil)))
 
-(defun camldebug-set-current-event (pos buffer before)
+(defun camldebug-set-current-event (spos epos buffer before)
   (if window-system
       (if before
           (progn
-            (move-overlay camldebug-overlay-event pos (1+ pos) buffer)
+            (move-overlay camldebug-overlay-event spos (1+ spos) buffer)
             (move-overlay camldebug-overlay-under
-                          (+ pos 1) (+ pos 3) buffer))
-        (move-overlay camldebug-overlay-event (1- pos) pos buffer)
-        (move-overlay camldebug-overlay-under (- pos 3) (- pos 1) buffer))
+                          (+ spos 1) epos buffer))
+        (move-overlay camldebug-overlay-event (1- epos) epos buffer)
+        (move-overlay camldebug-overlay-under spos (- epos 1) buffer))
     (save-excursion
       (set-buffer buffer)
       (goto-char pos)
diff --git a/stdlib/sys.ml b/stdlib/sys.ml
index 2247e7381..360a19c57 100644
--- a/stdlib/sys.ml
+++ b/stdlib/sys.ml
@@ -78,4 +78,4 @@ let catch_break on =
 
 (* OCaml version string, must be in the format described in sys.mli. *)
 
-let ocaml_version = "3.09+dev29 (2005-08-24)";;
+let ocaml_version = "3.09+dev30 (2005-08-25)";;