Index: asmcomp/selectgen.ml
===================================================================
--- asmcomp/selectgen.ml	(révision 12149)
+++ asmcomp/selectgen.ml	(copie de travail)
@@ -818,6 +818,7 @@
   self#emit_tail env f.Cmm.fun_body;
   { fun_name = f.Cmm.fun_name;
     fun_args = loc_arg;
+    fun_dbg  = f.Cmm.fun_dbg;
     fun_body = self#extract;
     fun_fast = f.Cmm.fun_fast }
 
Index: asmcomp/schedgen.ml
===================================================================
--- asmcomp/schedgen.ml	(révision 12149)
+++ asmcomp/schedgen.ml	(copie de travail)
@@ -348,6 +348,7 @@
     let new_body = schedule f.fun_body in
     clear_code_dag();
     { fun_name = f.fun_name;
+      fun_dbg  = f.fun_dbg;
       fun_body = new_body;
       fun_fast = f.fun_fast }
   end else
Index: asmcomp/mach.mli
===================================================================
--- asmcomp/mach.mli	(révision 12149)
+++ asmcomp/mach.mli	(copie de travail)
@@ -78,6 +78,7 @@
 type fundecl =
   { fun_name: string;
     fun_args: Reg.t array;
+    fun_dbg : Debuginfo.t;
     fun_body: instruction;
     fun_fast: bool }
 
Index: asmcomp/clambda.ml
===================================================================
--- asmcomp/clambda.ml	(révision 12153)
+++ asmcomp/clambda.ml	(copie de travail)
@@ -25,7 +25,7 @@
   | Uconst of structured_constant * string option
   | Udirect_apply of function_label * ulambda list * Debuginfo.t
   | Ugeneric_apply of ulambda * ulambda list * Debuginfo.t
-  | Uclosure of (function_label * int * Ident.t list * ulambda) list
+  | Uclosure of (function_label * int * Ident.t list * Debuginfo.t * ulambda) list
               * ulambda list
   | Uoffset of ulambda * int
   | Ulet of Ident.t * ulambda * ulambda
@@ -52,6 +52,7 @@
 
 type function_description =
   { fun_label: function_label;          (* Label of direct entry point *)
+    fun_dbg: Debuginfo.t;               (* Debug info : source code position *)
     fun_arity: int;                     (* Number of arguments *)
     mutable fun_closed: bool;           (* True if environment not used *)
     mutable fun_inline: (Ident.t list * ulambda) option }
Index: asmcomp/spill.ml
===================================================================
--- asmcomp/spill.ml	(révision 12149)
+++ asmcomp/spill.ml	(copie de travail)
@@ -398,5 +398,6 @@
   use_date := Reg.Map.empty;
   { fun_name = f.fun_name;
     fun_args = f.fun_args;
+    fun_dbg  = f.fun_dbg;
     fun_body = new_body;
     fun_fast = f.fun_fast }
Index: asmcomp/cmm.mli
===================================================================
--- asmcomp/cmm.mli	(révision 12149)
+++ asmcomp/cmm.mli	(copie de travail)
@@ -93,6 +93,7 @@
 type fundecl =
   { fun_name: string;
     fun_args: (Ident.t * machtype) list;
+    fun_dbg: Debuginfo.t;
     fun_body: expression;
     fun_fast: bool }
 
Index: asmcomp/debuginfo.ml
===================================================================
--- asmcomp/debuginfo.ml	(révision 12153)
+++ asmcomp/debuginfo.ml	(copie de travail)
@@ -38,7 +38,6 @@
            d.dinfo_file d.dinfo_line d.dinfo_char_start d.dinfo_char_end
 
 let from_location kind loc =
-  if loc.loc_ghost then none else
   { dinfo_kind = kind;
     dinfo_file = loc.loc_start.pos_fname;
     dinfo_line = loc.loc_start.pos_lnum;
Index: asmcomp/mach.ml
===================================================================
--- asmcomp/mach.ml	(révision 12149)
+++ asmcomp/mach.ml	(copie de travail)
@@ -78,6 +78,7 @@
 type fundecl =
   { fun_name: string;
     fun_args: Reg.t array;
+    fun_dbg : Debuginfo.t;
     fun_body: instruction;
     fun_fast: bool }
 
Index: asmcomp/cmm.ml
===================================================================
--- asmcomp/cmm.ml	(révision 12149)
+++ asmcomp/cmm.ml	(copie de travail)
@@ -107,6 +107,7 @@
 type fundecl =
   { fun_name: string;
     fun_args: (Ident.t * machtype) list;
+    fun_dbg: Debuginfo.t;
     fun_body: expression;
     fun_fast: bool }
 
Index: asmcomp/amd64/emit.mlp
===================================================================
--- asmcomp/amd64/emit.mlp	(révision 12149)
+++ asmcomp/amd64/emit.mlp	(copie de travail)
@@ -54,6 +54,10 @@
       else !stack_offset + (num_stack_slots.(0) + n) * 8
   | Outgoing n -> n
 
+(* Debugging *)
+open Debuginfo
+let file_counter = ref 0
+
 (* Symbols *)
 
 let emit_symbol s =
@@ -333,6 +337,17 @@
 let float_constants = ref ([] : (int * string) list)
 
 let emit_instr fallthrough i =
+    if !Clflags.debug then begin
+      let dbg = i.dbg in
+      let file_name = dbg.dinfo_file
+      and file_num = !file_counter
+      and file_line = dbg.dinfo_line
+      in
+      if file_name<>""
+      && file_num != 0 (* means the entry function *)
+      then
+        `\t.loc {emit_int file_num} {emit_int file_line}\n`;
+    end;
     match i.desc with
       Lend -> ()
     | Lop(Imove | Ispill | Ireload) ->
@@ -685,6 +700,18 @@
   else
     `	.globl	{emit_symbol fundecl.fun_name}\n`;
   `{emit_symbol fundecl.fun_name}:\n`;
+  if !Clflags.debug then begin
+    let dbg = fundecl.fun_dbg in
+    let file_name = dbg.dinfo_file
+    and file_line = dbg.dinfo_line
+    in
+    if file_name<>"" then begin
+      incr file_counter;
+      let file_num = !file_counter in
+      `\t.file {emit_int file_num} \"{emit_string file_name}\"\n`;
+      `\t.loc {emit_int file_num} {emit_int file_line}\n`;
+    end;
+  end;
   if !Clflags.gprofile then emit_profile();
   if frame_required() then begin
     let n = frame_size() - 8 in
Index: asmcomp/linearize.ml
===================================================================
--- asmcomp/linearize.ml	(révision 12149)
+++ asmcomp/linearize.ml	(copie de travail)
@@ -53,6 +53,7 @@
 
 type fundecl =
   { fun_name: string;
+    fun_dbg : Debuginfo.t;
     fun_body: instruction;
     fun_fast: bool }
 
@@ -263,5 +264,6 @@
 
 let fundecl f =
   { fun_name = f.Mach.fun_name;
+    fun_dbg  = f.Mach.fun_dbg;
     fun_body = linear f.Mach.fun_body end_instr;
     fun_fast = f.Mach.fun_fast }
Index: asmcomp/printcmm.ml
===================================================================
--- asmcomp/printcmm.ml	(révision 12149)
+++ asmcomp/printcmm.ml	(copie de travail)
@@ -176,8 +176,13 @@
        if !first then first := false else fprintf ppf "@ ";
        fprintf ppf "%a: %a" Ident.print id machtype ty)
      cases in
-  fprintf ppf "@[<1>(function %s@;<1 4>@[<1>(%a)@]@ @[%a@])@]@."
-         f.fun_name print_cases f.fun_args sequence f.fun_body
+  let dbg =
+    if f.fun_dbg = Debuginfo.none
+    then "no dbg"
+    else Debuginfo.to_string f.fun_dbg
+  in
+  fprintf ppf "@[<1>(function %s %s@;<1 4>@[<1>(%a)@]@ @[%a@])@]@."
+         f.fun_name dbg print_cases f.fun_args sequence f.fun_body
 
 let data_item ppf = function
   | Cdefine_symbol s -> fprintf ppf "\"%s\":" s
Index: asmcomp/clambda.mli
===================================================================
--- asmcomp/clambda.mli	(révision 12149)
+++ asmcomp/clambda.mli	(copie de travail)
@@ -25,7 +25,7 @@
   | Uconst of structured_constant * string option
   | Udirect_apply of function_label * ulambda list * Debuginfo.t
   | Ugeneric_apply of ulambda * ulambda list * Debuginfo.t
-  | Uclosure of (function_label * int * Ident.t list * ulambda) list
+  | Uclosure of (function_label * int * Ident.t list * Debuginfo.t * ulambda) list
               * ulambda list
   | Uoffset of ulambda * int
   | Ulet of Ident.t * ulambda * ulambda
@@ -52,6 +52,7 @@
 
 type function_description =
   { fun_label: function_label;          (* Label of direct entry point *)
+    fun_dbg: Debuginfo.t;               (* Debug info : file, line ,... *)
     fun_arity: int;                     (* Number of arguments *)
     mutable fun_closed: bool;           (* True if environment not used *)
     mutable fun_inline: (Ident.t list * ulambda) option }
Index: asmcomp/reloadgen.ml
===================================================================
--- asmcomp/reloadgen.ml	(révision 12149)
+++ asmcomp/reloadgen.ml	(copie de travail)
@@ -134,6 +134,7 @@
   redo_regalloc <- false;
   let new_body = self#reload f.fun_body in
   ({fun_name = f.fun_name; fun_args = f.fun_args;
+    fun_dbg = f.fun_dbg;
     fun_body = new_body; fun_fast = f.fun_fast},
    redo_regalloc)
 
Index: asmcomp/cmmgen.ml
===================================================================
--- asmcomp/cmmgen.ml	(révision 12149)
+++ asmcomp/cmmgen.ml	(copie de travail)
@@ -382,7 +382,7 @@
 let fundecls_size fundecls =
   let sz = ref (-1) in
   List.iter
-    (fun (label, arity, params, body) ->
+    (fun (label, arity, params, dbg, body) ->
       sz := !sz + 1 + (if arity = 1 then 2 else 3))
     fundecls;
   !sz
@@ -461,7 +461,7 @@
 (* Translate constant closures *)
 
 let constant_closures =
-  ref ([] : (string * (string * int * Ident.t list * ulambda) list) list)
+  ref ([] : (string * (string * int * Ident.t list * Debuginfo.t * ulambda) list) list)
 
 (* Boxed integers *)
 
@@ -808,7 +808,7 @@
 
 (* Translate an expression *)
 
-let functions = (Queue.create() : (string * Ident.t list * ulambda) Queue.t)
+let functions = (Queue.create() : (string * Ident.t list * Debuginfo.t * ulambda) Queue.t)
 
 let rec transl = function
     Uvar id ->
@@ -821,8 +821,8 @@
       let lbl = Compilenv.new_const_symbol() in
       constant_closures := (lbl, fundecls) :: !constant_closures;
       List.iter
-        (fun (label, arity, params, body) ->
-          Queue.add (label, params, body) functions)
+        (fun (label, arity, params, dbg, body) ->
+          Queue.add (label, params, dbg, body) functions)
         fundecls;
       Cconst_symbol lbl
   | Uclosure(fundecls, clos_vars) ->
@@ -831,8 +831,8 @@
       let rec transl_fundecls pos = function
           [] ->
             List.map transl clos_vars
-        | (label, arity, params, body) :: rem ->
-            Queue.add (label, params, body) functions;
+        | (label, arity, params, dbg, body) :: rem ->
+            Queue.add (label, params, dbg, body) functions;
             let header =
               if pos = 0
               then alloc_closure_header block_size
@@ -1556,9 +1556,10 @@
 
 (* Translate a function definition *)
 
-let transl_function lbl params body =
+let transl_function lbl params dbg body =
   Cfunction {fun_name = lbl;
              fun_args = List.map (fun id -> (id, typ_addr)) params;
+             fun_dbg  = dbg;
              fun_body = transl body;
              fun_fast = !Clflags.optimize_for_speed}
 
@@ -1572,12 +1573,12 @@
 
 let rec transl_all_functions already_translated cont =
   try
-    let (lbl, params, body) = Queue.take functions in
+    let (lbl, params, dbg, body) = Queue.take functions in
     if StringSet.mem lbl already_translated then
       transl_all_functions already_translated cont
     else begin
       transl_all_functions (StringSet.add lbl already_translated)
-                           (transl_function lbl params body :: cont)
+                           (transl_function lbl params dbg body :: cont)
     end
   with Queue.Empty ->
     cont
@@ -1709,10 +1710,10 @@
 let emit_constant_closure symb fundecls cont =
   match fundecls with
     [] -> assert false
-  | (label, arity, params, body) :: remainder ->
+  | (label, arity, params, dbg, body) :: remainder ->
       let rec emit_others pos = function
         [] -> cont
-      | (label, arity, params, body) :: rem ->
+      | (label, arity, params, dbg, body) :: rem ->
           if arity = 1 then
             Cint(infix_header pos) ::
             Csymbol_address label ::
@@ -1764,6 +1765,7 @@
   let init_code = transl ulam in
   let c1 = [Cfunction {fun_name = Compilenv.make_symbol (Some "entry");
                        fun_args = [];
+                       fun_dbg  = Debuginfo.none;
                        fun_body = init_code; fun_fast = false}] in
   let c2 = transl_all_functions StringSet.empty c1 in
   let c3 = emit_all_constants c2 in
@@ -1892,6 +1894,7 @@
   Cfunction
    {fun_name = "caml_send" ^ string_of_int arity;
     fun_args = fun_args;
+    fun_dbg  = Debuginfo.none;
     fun_body = body;
     fun_fast = true}
 
@@ -1901,6 +1904,7 @@
   Cfunction
    {fun_name = "caml_apply" ^ string_of_int arity;
     fun_args = List.map (fun id -> (id, typ_addr)) all_args;
+    fun_dbg  = Debuginfo.none;
     fun_body = body;
     fun_fast = true}
 
@@ -1918,6 +1922,7 @@
   Cfunction
    {fun_name = "caml_tuplify" ^ string_of_int arity;
     fun_args = [arg, typ_addr; clos, typ_addr];
+    fun_dbg  = Debuginfo.none;
     fun_body =
       Cop(Capply(typ_addr, Debuginfo.none),
           get_field (Cvar clos) 2 :: access_components 0 @ [Cvar clos]);
@@ -1971,6 +1976,7 @@
    {fun_name = "caml_curry" ^ string_of_int arity ^
                "_" ^ string_of_int (arity-1);
     fun_args = [last_arg, typ_addr; last_clos, typ_addr];
+    fun_dbg  = Debuginfo.none;
     fun_body = curry_fun [] last_clos (arity-1);
     fun_fast = true}
 
@@ -1984,6 +1990,7 @@
     Cfunction
      {fun_name = name2;
       fun_args = [arg, typ_addr; clos, typ_addr];
+      fun_dbg  = Debuginfo.none;
       fun_body =
 	 if arity - num > 2 then
 	   Cop(Calloc,
@@ -2021,6 +2028,7 @@
 	    Cfunction
 	      {fun_name = name1 ^ "_" ^ string_of_int (num+1) ^ "_app";
 	       fun_args = direct_args @ [clos, typ_addr];
+           fun_dbg  = Debuginfo.none;
 	       fun_body = iter (num+1)
 		  (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
 	       fun_fast = true}
@@ -2078,6 +2086,7 @@
       namelist (Cconst_int 1) in
   Cfunction {fun_name = "caml_program";
              fun_args = [];
+             fun_dbg  = Debuginfo.none;
              fun_body = body;
              fun_fast = false}
 
Index: asmcomp/closure.ml
===================================================================
--- asmcomp/closure.ml	(révision 12153)
+++ asmcomp/closure.ml	(copie de travail)
@@ -719,8 +719,13 @@
           (id, Lfunction(kind, params, body)) ->
             let label = Compilenv.make_symbol (Some (Ident.unique_name id)) in
             let arity = List.length params in
+            let dbg = match body with
+              Levent(_,ev) -> Debuginfo.from_call ev
+            | _ -> Debuginfo.none
+            in
             let fundesc =
               {fun_label = label;
+               fun_dbg = dbg;
                fun_arity = (if kind = Tupled then -arity else arity);
                fun_closed = initially_closed;
                fun_inline = None } in
@@ -759,7 +764,7 @@
     let (ubody, approx) = close fenv_rec cenv_body body in
     if !useless_env && occurs_var env_param ubody then useless_env := false;
     let fun_params = if !useless_env then params else params @ [env_param] in
-    ((fundesc.fun_label, fundesc.fun_arity, fun_params, ubody),
+    ((fundesc.fun_label, fundesc.fun_arity, fun_params, fundesc.fun_dbg, ubody),
      (id, env_pos, Value_closure(fundesc, approx))) in
   (* Translate all function definitions. *)
   let clos_info_list =
@@ -789,7 +794,7 @@
 
 and close_one_function fenv cenv id funct =
   match close_functions fenv cenv [id, funct] with
-      ((Uclosure([_, _, params, body], _) as clos),
+      ((Uclosure([_, _, params, dbg, body], _) as clos),
        [_, _, (Value_closure(fundesc, _) as approx)]) ->
         (* See if the function can be inlined *)
         if lambda_smaller body (!Clflags.inline_threshold + List.length params)
Index: asmcomp/printmach.ml
===================================================================
--- asmcomp/printmach.ml	(révision 12149)
+++ asmcomp/printmach.ml	(copie de travail)
@@ -190,8 +190,13 @@
   end
 
 let fundecl ppf f =
-  fprintf ppf "@[<v 2>%s(%a)@,%a@]"
-    f.fun_name regs f.fun_args instr f.fun_body
+  let dbg =
+    if f.fun_dbg = Debuginfo.none
+    then "no dbg"
+    else Debuginfo.to_string f.fun_dbg
+  in
+  fprintf ppf "@[<v 2>%s %s (%a)@,%a@]"
+    f.fun_name dbg regs f.fun_args instr f.fun_body
 
 let phase msg ppf f =
   fprintf ppf "*** %s@.%a@." msg fundecl f
Index: asmcomp/printlinear.ml
===================================================================
--- asmcomp/printlinear.ml	(révision 12149)
+++ asmcomp/printlinear.ml	(copie de travail)
@@ -74,4 +74,9 @@
   | _ -> fprintf ppf "%a@,%a" instr i all_instr i.next
 
 let fundecl ppf f =
-  fprintf ppf "@[<v 2>%s:@,%a@]" f.fun_name all_instr f.fun_body
+  let dbg =
+    if f.fun_dbg = Debuginfo.none
+    then "no dbg"
+    else Debuginfo.to_string f.fun_dbg
+  in
+  fprintf ppf "@[<v 2>%s:%s@,%a@]" f.fun_name dbg all_instr f.fun_body
Index: asmcomp/linearize.mli
===================================================================
--- asmcomp/linearize.mli	(révision 12149)
+++ asmcomp/linearize.mli	(copie de travail)
@@ -48,6 +48,7 @@
 
 type fundecl =
   { fun_name: string;
+    fun_dbg : Debuginfo.t;
     fun_body: instruction;
     fun_fast: bool }
 
Index: asmcomp/split.ml
===================================================================
--- asmcomp/split.ml	(révision 12149)
+++ asmcomp/split.ml	(copie de travail)
@@ -206,5 +206,6 @@
   equiv_classes := Reg.Map.empty;
   { fun_name = f.fun_name;
     fun_args = new_args;
+    fun_dbg  = f.fun_dbg;
     fun_body = new_body;
     fun_fast = f.fun_fast }
Index: bytecomp/translcore.ml
===================================================================
--- bytecomp/translcore.ml	(révision 12149)
+++ bytecomp/translcore.ml	(copie de travail)
@@ -817,7 +817,12 @@
           end
       (* other cases compile to a lazy block holding a function *)
       | _ ->
-          let fn = Lfunction (Curried, [Ident.create "param"], transl_exp e) in
+          let ((kind, params), body) =
+            event_function e
+              (function repr ->
+                ((Curried, [Ident.create "param"]), transl_exp e))
+          in
+          let fn = Lfunction(kind, params, body) in
           Lprim(Pmakeblock(Config.lazy_tag, Immutable), [fn])
       end
   | Texp_object (cs, cty, meths) ->