js_of_ocaml debug info

debug_info.diff

diff -rN -u old-js_of_ocaml/compiler/driver.ml new-js_of_ocaml/compiler/driver.ml
--- old-js_of_ocaml/compiler/driver.ml	2012-09-05 19:02:07.000000000 +0900
+++ new-js_of_ocaml/compiler/driver.ml	2012-09-05 19:02:07.000000000 +0900
@@ -20,7 +20,7 @@
 
 let debug = Util.debug "main"
 
-let f ?standalone p =
+let f ?standalone (p, d) =
 if debug () then Code.print_program (fun _ _ -> "") p;
 
 if debug () then Format.eprintf "Tail-call optimization...@.";
@@ -61,7 +61,7 @@
   let (p, live_vars) = Deadcode.f p in
 
 if debug () then Code.print_program (fun _ _ -> "") p;
-  fun formatter -> Generate.f formatter ?standalone p live_vars
+  fun formatter -> Generate.f formatter ?standalone (p, d) live_vars
 
 let from_string prims s =
   let p = Parse.from_string prims s in
diff -rN -u old-js_of_ocaml/compiler/driver.mli new-js_of_ocaml/compiler/driver.mli
--- old-js_of_ocaml/compiler/driver.mli	2012-09-05 19:02:07.000000000 +0900
+++ new-js_of_ocaml/compiler/driver.mli	2012-09-05 19:02:07.000000000 +0900
@@ -18,7 +18,7 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val f : ?standalone:bool -> Code.program -> Pretty_print.t -> unit
+val f : ?standalone:bool -> Code.program * Parse.debug_loc -> Pretty_print.t -> unit
 
 val from_string : string array -> string -> Pretty_print.t -> unit
 
diff -rN -u old-js_of_ocaml/compiler/generate.ml new-js_of_ocaml/compiler/generate.ml
--- old-js_of_ocaml/compiler/generate.ml	2012-09-05 19:02:07.000000000 +0900
+++ new-js_of_ocaml/compiler/generate.ml	2012-09-05 19:02:07.000000000 +0900
@@ -71,16 +71,20 @@
     { var_stream : Var.stream;
       mutable blocks : block AddrMap.t;
       live : int array;
+      debug_loc : Parse.debug_loc;
       mutated_vars : VarSet.t AddrMap.t }
 
   let fresh_var ctx =
     let (x, stream) = Var.next ctx.var_stream in
     (x, {ctx with var_stream = stream})
 
-  let initial b l v =
-    { var_stream = Var.make_stream (); blocks = b; live = l; mutated_vars = v }
+  let initial b l v dl =
+    { var_stream = Var.make_stream (); blocks = b; live = l; mutated_vars = v;
+    debug_loc = dl }
 
   let used_once ctx x = ctx.live.(Var.idx x) <= 1
+
+  let debug_loc ctx = ctx.debug_loc
 end
 
 let add_names = Hashtbl.create 101
@@ -1050,7 +1054,18 @@
 *)
   let block = AddrMap.find pc st.blocks in
   let (seq, queue) = translate_instr st.ctx queue block.body in
+  let debuginfo = match Ctx.debug_loc st.ctx pc with
+    | Some (f, l, s, e) ->
+      [
+        J.Expression_statement (J.EStr (Format.sprintf "<<%d: %s %d %d %d>>"
+                                          pc f l s e,
+                                        `Bytes))
+      (* J.Expression_statement(J.ECall (J.EVar "trace", *)
+      (*            [J.EStr (Format.sprintf "<<%d:>>" pc, `Bytes)])) *)
+      ]
+    | None -> [] in
   let body =
+    debuginfo @
     seq @
     match block.branch with
       Code.Pushtrap ((pc1, args1), x, (pc2, args2), pc3) ->
@@ -1485,10 +1500,10 @@
     List.iter (fun nm -> Format.eprintf "  %s@." nm) l
   end
 
-let f ch ?(standalone=true) ((pc, blocks, _) as p) live_vars =
+let f ch ?(standalone=true) ((pc, blocks, _) as p, debug_loc) live_vars =
   let mutated_vars = Freevars.f p in
   let t' = Util.Timer.make () in
-  let ctx = Ctx.initial blocks live_vars mutated_vars in
+  let ctx = Ctx.initial blocks live_vars mutated_vars debug_loc in
   let p = compile_program standalone ctx pc in
   if !compact then Pretty_print.set_compact ch true;
   if standalone then begin
diff -rN -u old-js_of_ocaml/compiler/generate.mli new-js_of_ocaml/compiler/generate.mli
--- old-js_of_ocaml/compiler/generate.mli	2012-09-05 19:02:07.000000000 +0900
+++ new-js_of_ocaml/compiler/generate.mli	2012-09-05 19:02:07.000000000 +0900
@@ -21,4 +21,4 @@
 val set_pretty : unit -> unit
 
 val f : Pretty_print.t -> ?standalone:bool ->
-        Code.program -> int array -> unit
+        Code.program * Parse.debug_loc -> int array -> unit
diff -rN -u old-js_of_ocaml/compiler/parse.ml new-js_of_ocaml/compiler/parse.ml
--- old-js_of_ocaml/compiler/parse.ml	2012-09-05 19:02:07.000000000 +0900
+++ new-js_of_ocaml/compiler/parse.ml	2012-09-05 19:02:07.000000000 +0900
@@ -29,6 +29,8 @@
 
 let blocks = ref AddrSet.empty
 
+type debug_loc = int -> (string * int * int * int) option
+
 let add_jump info pc = blocks := AddrSet.add pc !blocks
 
 let rec scan info code pc len =
@@ -161,10 +163,21 @@
       ce_heap: int Ident.tbl;  (* Structure of the heap-allocated env *)
       ce_rec: int Ident.tbl }  (* Functions bound by the same let rec *)
 
+  type pos =
+    { pos_fname: string;
+      pos_lnum: int;
+      pos_bol: int;
+      pos_cnum: int }
+
+  type loc_info =
+    { li_start: pos;
+      li_end: pos;
+      li_ghost: unit }
+
   type debug_event =
     { mutable ev_pos: int;                (* Position in bytecode *)
       ev_module: string;                  (* Name of defining module *)
-      ev_loc: unit;                       (* Location in source file *)
+      ev_loc: loc_info;                       (* Location in source file *)
       ev_kind: unit;                      (* Before/after event *)
       ev_info: unit;                      (* Extra information *)
       ev_typenv: unit;                    (* Typing environment *)
@@ -196,6 +209,16 @@
     with Not_found ->
       []
 
+  let find_loc pc =
+    try
+      let ev = Hashtbl.find events_by_pc pc in
+      let loc = ev.ev_loc in
+      let pos = loc.li_start in
+      Some (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol,
+            loc.li_end.pos_cnum - loc.li_end.pos_bol)
+    with Not_found ->
+      None
+
   let rec propagate l1 l2 =
     match l1, l2 with
       v1 :: r1, v2 :: r2 -> Var.propagate_name v1 v2; propagate r1 r2
@@ -1649,7 +1672,10 @@
   in
   let free_pc = free_pc + 1 in
   let blocks = match_exn_traps (pc, blocks, free_pc) in
-  (pc, blocks, free_pc)
+  let debug pc =
+    Debug.find_loc pc
+  in
+  ((pc, blocks, free_pc), debug)
 
 (****)
 
diff -rN -u old-js_of_ocaml/compiler/parse.mli new-js_of_ocaml/compiler/parse.mli
--- old-js_of_ocaml/compiler/parse.mli	2012-09-05 19:02:07.000000000 +0900
+++ new-js_of_ocaml/compiler/parse.mli	2012-09-05 19:02:07.000000000 +0900
@@ -18,9 +18,11 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val from_channel : paths:string list -> in_channel -> Code.program
+type debug_loc = int -> (string * int * int * int) option
 
-val from_string : string array -> string -> Code.program
+val from_channel : paths:string list -> in_channel -> Code.program * debug_loc
+
+val from_string : string array -> string -> Code.program * debug_loc
 
 val set_pretty : unit -> unit