30 files changed, 220 insertions, 107 deletions

diff --git a/Changes b/Changes
index 44f5bdfd63..bf1a5e5d72 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,7 @@
+- Match_failure and Assert_failure now report (file, line, column),
+  instead of (file, starting char, ending char).
+
+
 Objective Caml 3.06:
 --------------------
 
diff --git a/boot/ocamlc b/boot/ocamlc
index 07b88e7389..1456628304 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamllex b/boot/ocamllex
index 459274448e..924b962db9 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index 1651fe7f83..c42ccf9a55 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -666,7 +666,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.Lexing.pos_cnum;  (* FIXME *)
+          ev_char = lev.lev_pos;
           ev_kind = kind;
           ev_info = info;
           ev_typenv = lev.lev_env;
diff --git a/bytecomp/instruct.ml b/bytecomp/instruct.ml
index 4952995460..81224dde6f 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: int;                       (* Position in source file *)
+    ev_char: Lexing.position;           (* Position 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 6fb979f4d9..f609d5d94b 100644
--- a/bytecomp/instruct.mli
+++ b/bytecomp/instruct.mli
@@ -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: int;                       (* Location in source file *)
+    ev_char: Lexing.position;           (* Position 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/printinstr.ml b/bytecomp/printinstr.ml
index d175cf1856..8b2ba1e8ca 100644
--- a/bytecomp/printinstr.ml
+++ b/bytecomp/printinstr.ml
@@ -97,7 +97,8 @@ let instruction ppf = function
   | Kisout -> fprintf ppf "\tisout"
   | Kgetmethod -> fprintf ppf "\tgetmethod"
   | Kstop -> fprintf ppf "\tstop"
-  | Kevent ev -> fprintf ppf "\tevent %i" ev.ev_char
+  | Kevent ev -> fprintf ppf "\tevent \"%s\" %i" ev.ev_char.Lexing.pos_fname
+                                                 ev.ev_char.Lexing.pos_cnum
 
 let rec instruction_list ppf = function
     [] -> ()
diff --git a/debugger/breakpoints.ml b/debugger/breakpoints.ml
index 3acb848b45..ce65b47391 100644
--- a/debugger/breakpoints.ml
+++ b/debugger/breakpoints.ml
@@ -177,15 +177,15 @@ let rec new_breakpoint =
       print_string event.ev_module;
       begin try
         let (start, line) =
-          line_of_pos (get_buffer event.ev_module) event.ev_char
+          line_of_pos (get_buffer event.ev_module) event.ev_char.Lexing.pos_cnum
         in
         print_string ", line ";
         print_int line;
         print_string " column ";
-        print_int (event.ev_char - start + 1)
+        print_int (event.ev_char.Lexing.pos_cnum - start + 1)
       with Not_found | Out_of_range ->
         print_string ", character ";
-        print_int event.ev_char
+        print_int event.ev_char.Lexing.pos_cnum
       end;
       print_newline ()
 
diff --git a/debugger/command_line.ml b/debugger/command_line.ml
index 1f33e9375f..75691ec9f5 100644
--- a/debugger/command_line.ml
+++ b/debugger/command_line.ml
@@ -746,7 +746,7 @@ let path_variable kill name =
   (function lexbuf ->
        let argument = argument_eol argument lexbuf in
          if (not kill) || ask_kill_program () then
-           name := (expand_path argument)),
+           name := make_absolute (expand_path argument)),
   function ppf -> fprintf ppf "%s@." !name
 
 let loading_mode_variable ppf =
@@ -811,7 +811,8 @@ let info_breakpoints ppf lexbuf =
     (fprintf ppf "Num    Address  Where@.";
      List.iter
        (function (num, {ev_pos = pc; ev_module = md; ev_char = char}) ->
-          fprintf ppf "%3d %10d  in %s, character %d\n" num pc md char)
+          fprintf ppf "%3d %10d  in %s, character %d\n" num pc md
+                  char.Lexing.pos_cnum)
        (List.rev !breakpoints))
 
 let info_events ppf lexbuf =
@@ -824,7 +825,7 @@ let info_events ppf lexbuf =
          Printf.printf
            "%10d %10d  %10s %10s\n"
            ev.ev_pos
-           ev.ev_char
+           ev.ev_char.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 2605b3c968..5fb501ed34 100644
--- a/debugger/events.ml
+++ b/debugger/events.ml
@@ -53,7 +53,7 @@ let current_point () =
     None ->
       raise Not_found
   | Some {ev_char = point; ev_module = mdle} ->
-      (mdle, point)
+      (mdle, point.Lexing.pos_cnum)
 
 let current_event_is_before () =
   match !current_event with
diff --git a/debugger/frames.ml b/debugger/frames.ml
index ede7db8b40..cb76e013a6 100644
--- a/debugger/frames.ml
+++ b/debugger/frames.ml
@@ -35,7 +35,7 @@ let selected_point () =
     None ->
       raise Not_found
   | Some {ev_char = point; ev_module = mdle} ->
-      (mdle, point)
+      (mdle, point.Lexing.pos_cnum)
 
 let selected_event_is_before () =
   match !selected_event with
diff --git a/debugger/main.ml b/debugger/main.ml
index c8458f7aba..0bb2dda19c 100644
--- a/debugger/main.ml
+++ b/debugger/main.ml
@@ -33,9 +33,9 @@ let rec loop ppf =
   if !loaded && (not (yes_or_no "The program is running. Quit anyway")) then
     loop ppf
 
-let rec protect ppf cont =
+let rec protect ppf loop =
   try
-    cont ppf
+    loop ppf
   with
   | End_of_file ->
       protect ppf (function ppf ->
@@ -79,7 +79,7 @@ let toplevel_loop () = protect Format.std_formatter loop
 exception Found_program_name
 
 let anonymous s =
-  program_name := s; raise Found_program_name
+  program_name := Unix_tools.make_absolute s; raise Found_program_name
 let add_include d =
   default_load_path :=
     Misc.expand_directory Config.standard_library d :: !default_load_path
@@ -116,7 +116,7 @@ let main () =
       exit 2
     with Found_program_name ->
       for j = !Arg.current + 1 to Array.length Sys.argv - 1 do
-        arguments := Printf.sprintf "%s '%s'" !arguments Sys.argv.(j)
+        arguments := !arguments ^ " " ^ (Filename.quote Sys.argv.(j))
       done
     end;
     current_prompt := debugger_prompt;
diff --git a/debugger/program_management.ml b/debugger/program_management.ml
index f83549e877..ec5877fc26 100644
--- a/debugger/program_management.ml
+++ b/debugger/program_management.ml
@@ -119,9 +119,6 @@ let ask_kill_program () =
 let initialize_loading () =
   if !debug_loading then
     prerr_endline "Loading debugging informations...";
-  if Filename.is_relative !program_name then begin
-    program_name := Filename.concat (getcwd ()) !program_name;
-  end;
   begin try access !program_name [F_OK]
   with Unix_error _ ->
     prerr_endline "Program not found.";
diff --git a/debugger/show_information.ml b/debugger/show_information.ml
index eff932f47a..7492ddc2e1 100644
--- a/debugger/show_information.ml
+++ b/debugger/show_information.ml
@@ -70,7 +70,7 @@ 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
+         framenum event.ev_pos event.ev_module event.ev_char.Lexing.pos_cnum
 
 (* Display information about the current frame. *)
 (* --- `select frame' must have succeded before calling this function. *)
@@ -90,5 +90,5 @@ 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
+      show_point sel_ev.ev_module sel_ev.ev_char.Lexing.pos_cnum
                  (selected_event_is_before ()) selected
diff --git a/debugger/symbols.ml b/debugger/symbols.ml
index 8af85f6b29..031bec6402 100644
--- a/debugger/symbols.ml
+++ b/debugger/symbols.ml
@@ -43,14 +43,14 @@ let read_symbols' bytecode_file =
     ignore(Bytesections.seek_section ic "SYMB");
   with Bytesections.Bad_magic_number | Not_found ->
     prerr_string bytecode_file; prerr_endline " is not a bytecode file.";
-    exit 2
+    raise Toplevel
   end;
   Symtable.restore_state (input_value ic);
   begin try
     ignore (Bytesections.seek_section ic "DBUG")
   with Not_found ->
     prerr_string bytecode_file; prerr_endline " has no debugging info.";
-    exit 2
+    raise Toplevel
   end;
   let num_eventlists = input_binary_int ic in
   let eventlists = ref [] in
@@ -85,8 +85,10 @@ let read_symbols bytecode_file =
         [] -> ()
       | ev :: _ as evl ->
           let md = ev.ev_module in
-          let sorted_evl =
-            List.sort (fun ev1 ev2 -> compare ev1.ev_char ev2.ev_char) evl in
+          let cmp ev1 ev2 = compare ev1.ev_char.Lexing.pos_cnum
+                                    ev2.ev_char.Lexing.pos_cnum
+          in
+          let sorted_evl = List.sort cmp evl in
           modules := md :: !modules;
           Hashtbl.add all_events_by_module md sorted_evl;
           let real_evl =
@@ -123,13 +125,13 @@ 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 < char then raise Not_found;
+      if ev.(hi).ev_char.Lexing.pos_cnum < char then raise Not_found;
       hi
     end else begin
       let pivot = (lo + hi) / 2 in
       let e = ev.(pivot) in
-      if char <= e.ev_char then bsearch lo pivot
-                           else bsearch (pivot + 1) hi
+      if char <= e.ev_char.Lexing.pos_cnum then bsearch lo pivot
+                                           else bsearch (pivot + 1) hi
     end
   in
   bsearch 0 (Array.length ev - 1)
@@ -148,7 +150,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 <= ev.(pos).ev_char - char
+    if pos > 0 && char - ev.(pos - 1).ev_char.Lexing.pos_cnum
+                  <= ev.(pos).ev_char.Lexing.pos_cnum - char
     then ev.(pos - 1)
     else ev.(pos)
   with Not_found ->
diff --git a/debugger/unix_tools.ml b/debugger/unix_tools.ml
index 95a603fbbf..5061bb1ddf 100644
--- a/debugger/unix_tools.ml
+++ b/debugger/unix_tools.ml
@@ -38,7 +38,7 @@ let convert_address address =
   with Not_found ->
       (PF_UNIX, ADDR_UNIX address)
 
-(*** Report an unix error. ***)
+(*** Report a unix error. ***)
 let report_error = function
   | Unix_error (err, fun_name, arg) ->
      prerr_string "Unix error : '";
@@ -50,7 +50,7 @@ let report_error = function
         prerr_string "'");
      prerr_string " : ";
      prerr_endline (error_message err)
-  | _ -> fatal_error "report_error: not an Unix error"
+  | _ -> fatal_error "report_error: not a Unix error"
 
 (* Find program `name' in `PATH'. *)
 (* Return the full path if found. *)
@@ -59,7 +59,7 @@ let search_in_path name =
   let check name =
     try access name [X_OK]; name with Unix_error _ -> raise Not_found
   in
-    if String.contains name '/' then
+    if not (Filename.is_implicit name) then
       check name
     else
       let path = Sys.getenv "PATH" in
@@ -133,3 +133,9 @@ let rec expand_path ch =
             Not_found ->
               expand_path (ch ^ "/")
         else ch
+
+let make_absolute name =
+  if Filename.is_relative name
+  then Filename.concat (getcwd ()) name
+  else name
+;;
diff --git a/debugger/unix_tools.mli b/debugger/unix_tools.mli
index 8281ad28ca..b5e4ee6ca4 100644
--- a/debugger/unix_tools.mli
+++ b/debugger/unix_tools.mli
@@ -30,3 +30,5 @@ val search_in_path : string -> string
 
 (* Path expansion. *)
 val expand_path : string -> string
+
+val make_absolute : string -> string
diff --git a/lex/.depend b/lex/.depend
index fa0c4a7f64..44499eed04 100644
--- a/lex/.depend
+++ b/lex/.depend
@@ -1,3 +1,4 @@
+common.cmi: lexgen.cmi syntax.cmi 
 compact.cmi: lexgen.cmi 
 lexer.cmi: parser.cmi 
 lexgen.cmi: syntax.cmi 
@@ -5,8 +6,8 @@ output.cmi: compact.cmi lexgen.cmi syntax.cmi
 outputbis.cmi: lexgen.cmi syntax.cmi 
 parser.cmi: syntax.cmi 
 syntax.cmi: cset.cmi 
-common.cmo: lexgen.cmi syntax.cmi 
-common.cmx: lexgen.cmx syntax.cmx 
+common.cmo: lexgen.cmi syntax.cmi common.cmi 
+common.cmx: lexgen.cmx syntax.cmx common.cmi 
 compact.cmo: lexgen.cmi table.cmi compact.cmi 
 compact.cmx: lexgen.cmx table.cmx compact.cmi 
 cset.cmo: cset.cmi 
@@ -19,9 +20,9 @@ main.cmo: compact.cmi lexer.cmi lexgen.cmi output.cmi outputbis.cmi \
     parser.cmi syntax.cmi 
 main.cmx: compact.cmx lexer.cmx lexgen.cmx output.cmx outputbis.cmx \
     parser.cmx syntax.cmx 
-output.cmo: common.cmo compact.cmi lexgen.cmi syntax.cmi output.cmi 
+output.cmo: common.cmi compact.cmi lexgen.cmi syntax.cmi output.cmi 
 output.cmx: common.cmx compact.cmx lexgen.cmx syntax.cmx output.cmi 
-outputbis.cmo: common.cmo lexgen.cmi syntax.cmi outputbis.cmi 
+outputbis.cmo: common.cmi lexgen.cmi syntax.cmi outputbis.cmi 
 outputbis.cmx: common.cmx lexgen.cmx syntax.cmx outputbis.cmi 
 parser.cmo: cset.cmi syntax.cmi parser.cmi 
 parser.cmx: cset.cmx syntax.cmx parser.cmi 
diff --git a/lex/common.ml b/lex/common.ml
index 35baf0e4b5..a8fc339e45 100644
--- a/lex/common.ml
+++ b/lex/common.ml
@@ -18,6 +18,35 @@ open Lexgen
 
 (* To copy the ML code fragments *)
 
+type line_tracker = {
+  file : string;
+  oc : out_channel;
+  ic : in_channel;
+  mutable cur_line : int;
+};;
+
+let open_tracker file oc = {
+  file = file;
+  oc = oc;
+  ic = open_in_bin file;
+  cur_line = 1;
+};;
+
+let close_tracker tr = close_in_noerr tr.ic;;
+
+let update_tracker tr =
+  fprintf tr.oc "\n";
+  flush tr.oc;
+  let cr_seen = ref false in
+  try while true do
+    match input_char tr.ic with
+    | '\010' when not !cr_seen -> tr.cur_line <- tr.cur_line + 1;
+    | '\013' -> cr_seen := true; tr.cur_line <- tr.cur_line + 1;
+    | _ -> cr_seen := false;
+  done with End_of_file ->
+  fprintf tr.oc "# %d \"%s\"\n" (tr.cur_line+1) tr.file;
+;;
+
 let copy_buffer = String.create 1024
 
 let copy_chars_unix ic oc start stop =
@@ -39,12 +68,13 @@ let copy_chars =
     "Win32" | "Cygwin" -> copy_chars_win32
   | _       -> copy_chars_unix
 
-let copy_chunk sourcefile ic oc loc =
+let copy_chunk sourcefile ic oc trl loc =
   if loc.start_pos < loc.end_pos then begin
     fprintf oc "# %d \"%s\"\n" loc.start_line sourcefile;
     for i = 1 to loc.start_col do output_char oc ' ' done;
     seek_in ic loc.start_pos;
-    copy_chars ic oc loc.start_pos loc.end_pos
+    copy_chars ic oc loc.start_pos loc.end_pos;
+    update_tracker trl;
   end
 
 (* Various memory actions *)
diff --git a/lex/common.mli b/lex/common.mli
new file mode 100644
index 0000000000..4e59ac9d8f
--- /dev/null
+++ b/lex/common.mli
@@ -0,0 +1,22 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*         Damien Doligez, projet Moscova, INRIA Rocquencourt          *)
+(*                                                                     *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+type line_tracker;;
+val open_tracker : string -> out_channel -> line_tracker
+val close_tracker : line_tracker -> unit
+val copy_chunk :
+  string ->
+  in_channel -> out_channel -> line_tracker -> Syntax.location -> unit
+val output_mem_access : out_channel -> int -> unit
+val output_memory_actions :
+  string -> out_channel -> Lexgen.memory_action list -> unit
+val output_env : out_channel -> (string * Lexgen.ident_info) list -> unit
diff --git a/lex/main.ml b/lex/main.ml
index 901ab5e234..fa5d63fba2 100644
--- a/lex/main.ml
+++ b/lex/main.ml
@@ -19,12 +19,16 @@ open Lexgen
 
 let ml_automata = ref false
 let source_name = ref ""
+let output_name = ref "";;
 
-let usage = "ocamlex [-option]* sourcefile"
+let usage = "usage: ocamlex [options] sourcefile"
 
 let _ =
   Arg.parse
-    ["-ml", Arg.Set ml_automata, " outputed automaton is a caml program" ;
+    ["-ml", Arg.Set ml_automata,
+           " Output code that does not use the Lexing module";
+     "-o", Arg.String (fun x -> source_name := x),
+           " <file>  Set output file name to <file>";
     ] 
     (fun name -> source_name := name)
     usage
@@ -33,12 +37,16 @@ let _ =
 let main () =
   let source_name = !source_name in
   let dest_name =
-    if Filename.check_suffix source_name ".mll" then
+    if !output_name <> "" then
+      !output_name
+    else if Filename.check_suffix source_name ".mll" then
       Filename.chop_suffix source_name ".mll" ^ ".ml"
     else
-      source_name ^ ".ml" in
+      source_name ^ ".ml"
+  in
   let ic = open_in_bin source_name in
   let oc = open_out dest_name in
+  let tr = Common.open_tracker dest_name oc in
   let lexbuf = Lexing.from_channel ic in
   try
     let def = Parser.lexer_definition Lexer.main lexbuf in
@@ -51,18 +59,20 @@ let main () =
 *)
     if !ml_automata then begin
       Outputbis.output_lexdef
-        source_name ic oc
+        source_name ic oc tr
         def.header entries transitions def.trailer
     end else begin
        let tables = Compact.compact_tables transitions in
-       Output.output_lexdef source_name ic oc
+       Output.output_lexdef source_name ic oc tr
          def.header tables entries def.trailer
-    end ;
-   close_in ic;
-    close_out oc
+    end;
+    close_in ic;
+    close_out oc;
+    Common.close_tracker tr;
   with exn ->
     close_in ic;
     close_out oc;
+    Common.close_tracker tr;
     Sys.remove dest_name;
     begin match exn with
       Parsing.Parse_error ->
diff --git a/lex/output.ml b/lex/output.ml
index 5b89f82604..eb510e4344 100644
--- a/lex/output.ml
+++ b/lex/output.ml
@@ -71,7 +71,7 @@ let output_tables oc tbl =
 
 (* Output the entries *)
 
-let output_entry sourcefile ic oc e =
+let output_entry sourcefile ic oc oci e =
   let init_num, init_moves = e.auto_initial_state in
   fprintf oc "%s lexbuf =
   %a%a  __ocaml_lex_%s_rec lexbuf %d\n"
@@ -89,7 +89,7 @@ let output_entry sourcefile ic oc e =
       fprintf oc "  | ";
       fprintf oc "%d -> (\n" num;
       output_env oc env ;
-      copy_chunk sourcefile ic oc loc;
+      copy_chunk sourcefile ic oc oci loc;
       fprintf oc ")\n")
     e.auto_actions;
   fprintf oc "  | n -> lexbuf.Lexing.refill_buff lexbuf; \
@@ -100,7 +100,7 @@ let output_entry sourcefile ic oc e =
 
 exception Table_overflow
 
-let output_lexdef sourcefile ic oc header tables entry_points trailer =
+let output_lexdef sourcefile ic oc oci header tables entry_points trailer =
   Printf.printf "%d states, %d transitions, table size %d bytes\n"
     (Array.length tables.tbl_base)
     (Array.length tables.tbl_trans)
@@ -118,15 +118,15 @@ let output_lexdef sourcefile ic oc header tables entry_points trailer =
     Printf.printf "%d additional bytes used for bindings\n" size_groups ;
   flush stdout;
   if Array.length tables.tbl_trans > 0x8000 then raise Table_overflow;
-  copy_chunk sourcefile ic oc header;
+  copy_chunk sourcefile ic oc oci header;
   output_tables oc tables;
   begin match entry_points with
     [] -> ()
   | entry1 :: entries ->
-      output_string oc "let rec "; output_entry sourcefile ic oc entry1;
+      output_string oc "let rec "; output_entry sourcefile ic oc oci entry1;
       List.iter
-        (fun e -> output_string oc "and "; output_entry sourcefile ic oc e)
+        (fun e -> output_string oc "and "; output_entry sourcefile ic oc oci e)
         entries;
       output_string oc ";;\n\n";
   end;
-  copy_chunk sourcefile ic oc trailer
+  copy_chunk sourcefile ic oc oci trailer
diff --git a/lex/output.mli b/lex/output.mli
index 6f01317c6b..ff2e04c4ea 100644
--- a/lex/output.mli
+++ b/lex/output.mli
@@ -15,7 +15,7 @@
 (* Output the DFA tables and its entry points *)
 
 val output_lexdef:
-      string -> in_channel -> out_channel ->
+      string -> in_channel -> out_channel -> Common.line_tracker ->
       Syntax.location ->
       Compact.lex_tables ->
       (unit, Syntax.location) Lexgen.automata_entry list ->
diff --git a/lex/outputbis.ml b/lex/outputbis.ml
index e0c0ced51c..a660608d56 100644
--- a/lex/outputbis.ml
+++ b/lex/outputbis.ml
@@ -153,7 +153,7 @@ let output_automata oc auto =
 
 (* Output the entries *)
 
-let output_entry sourcefile ic oc e =
+let output_entry sourcefile ic oc tr e =
   let init_num, init_moves = e.auto_initial_state in
   fprintf oc "%s lexbuf =
   __init_lexbuf lexbuf %d; %a  match __state%d lexbuf with\n"
@@ -163,7 +163,7 @@ let output_entry sourcefile ic oc e =
       fprintf oc "  | ";
       fprintf oc "%d -> (\n" num;
       output_env oc env ;
-      copy_chunk sourcefile ic oc loc;
+      copy_chunk sourcefile ic oc tr loc;
       fprintf oc ")\n")
     e.auto_actions;
   fprintf oc "  | _ -> raise (Failure \"lexing: empty token\") \n\n\n"
@@ -171,17 +171,17 @@ let output_entry sourcefile ic oc e =
 
 (* Main output function *)
 
-let output_lexdef sourcefile ic oc header entry_points transitions trailer =
+let output_lexdef sourcefile ic oc tr header entry_points transitions trailer =
 
-  copy_chunk sourcefile ic oc header;
+  copy_chunk sourcefile ic oc tr header;
   output_automata oc transitions ;
   begin match entry_points with
     [] -> ()
   | entry1 :: entries ->
-      output_string oc "let rec "; output_entry sourcefile ic oc entry1;
+      output_string oc "let rec "; output_entry sourcefile ic oc tr entry1;
       List.iter
-        (fun e -> output_string oc "and "; output_entry sourcefile ic oc e)
+        (fun e -> output_string oc "and "; output_entry sourcefile ic oc tr e)
         entries;
       output_string oc ";;\n\n";
   end;
-  copy_chunk sourcefile ic oc trailer
+  copy_chunk sourcefile ic oc tr trailer
diff --git a/lex/outputbis.mli b/lex/outputbis.mli
index 36a7f90c90..6afc0e9536 100644
--- a/lex/outputbis.mli
+++ b/lex/outputbis.mli
@@ -15,6 +15,7 @@ val output_lexdef :
   string ->
   in_channel ->
   out_channel ->
+  Common.line_tracker ->
   Syntax.location ->
   ('a, Syntax.location) Lexgen.automata_entry list ->
   Lexgen.automata array -> Syntax.location -> unit
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index 5991f4d3b1..9e3b974626 100644
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -385,7 +385,9 @@ let op_shapes = [
 ];;
 
 let print_event ev =
-  printf "%s, char %d:\n" ev.ev_module ev.ev_char
+  printf "%s, line %d, char %d:\n" ev.ev_char.Lexing.pos_fname
+         ev.ev_char.Lexing.pos_lnum
+         (ev.ev_char.Lexing.pos_cnum - ev.ev_char.Lexing.pos_bol)
 
 let print_instr ic =
   let pos = currpos ic in
diff --git a/yacc/defs.h b/yacc/defs.h
index 0a9d0eea9a..3f585d2cb7 100644
--- a/yacc/defs.h
+++ b/yacc/defs.h
@@ -107,9 +107,9 @@
 
 /*  character macros  */
 
-#define IS_IDENT(c)        (isalnum(c) || (c) == '_' || (c) == '.' || (c) == '$')
-#define        IS_OCTAL(c)        ((c) >= '0' && (c) <= '7')
-#define        NUMERIC_VALUE(c)        ((c) - '0')
+#define IS_IDENT(c)       (isalnum(c) || (c) == '_' || (c) == '.' || (c) == '$')
+#define IS_OCTAL(c)       ((c) >= '0' && (c) <= '7')
+#define NUMERIC_VALUE(c)  ((c) - '0')
 
 
 /*  symbol macros  */
@@ -124,21 +124,21 @@
 
 #define INTERACT() ROTATECURSOR_MAGIC ()
 
-#define CALLOC(k,n)         (INTERACT (), calloc((unsigned)(k),(unsigned)(n)))
+#define CALLOC(k,n)  (INTERACT (), calloc((unsigned)(k),(unsigned)(n)))
 #define FREE(x)      (INTERACT (), free((char*)(x)))
 #define MALLOC(n)    (INTERACT (), malloc((unsigned)(n)))
-#define        NEW(t)       (INTERACT (), (t*)allocate(sizeof(t)))
-#define        NEW2(n,t)    (INTERACT (), (t*)allocate((unsigned)((n)*sizeof(t))))
+#define NEW(t)       (INTERACT (), (t*)allocate(sizeof(t)))
+#define NEW2(n,t)    (INTERACT (), (t*)allocate((unsigned)((n)*sizeof(t))))
 #define REALLOC(p,n) (INTERACT (), realloc((char*)(p),(unsigned)(n)))
 
 #else
 
-#define CALLOC(k,n)        (calloc((unsigned)(k),(unsigned)(n)))
-#define        FREE(x)                (free((char*)(x)))
+#define CALLOC(k,n)      (calloc((unsigned)(k),(unsigned)(n)))
+#define FREE(x)          (free((char*)(x)))
 #define MALLOC(n)        (malloc((unsigned)(n)))
-#define        NEW(t)                ((t*)allocate(sizeof(t)))
-#define        NEW2(n,t)        ((t*)allocate((unsigned)((n)*sizeof(t))))
-#define REALLOC(p,n)        (realloc((char*)(p),(unsigned)(n)))
+#define NEW(t)           ((t*)allocate(sizeof(t)))
+#define NEW2(n,t)        ((t*)allocate((unsigned)((n)*sizeof(t))))
+#define REALLOC(p,n)     (realloc((char*)(p),(unsigned)(n)))
 
 #endif /* macintosh */
 
diff --git a/yacc/output.c b/yacc/output.c
index 09f2027d44..0774666e57 100644
--- a/yacc/output.c
+++ b/yacc/output.c
@@ -73,16 +73,21 @@ void output(void)
   output_actions();
   output_debug();
   free_parser();
-  if (sflag)
+  if (sflag){
+    if (!rflag) ++outline;
     fprintf(output_file,
       "let yyact = Array.new %d (fun _ -> (failwith \"parser\" : Obj.t))\n",
       ntotalrules);
-  else
+  }else{
+    if (!rflag) outline += 2;
     fprintf(output_file,
       "let yyact = [|\n  (fun _ -> failwith \"parser\")\n");
+  }
   output_semantic_actions();
-  if (!sflag)
+  if (!sflag){
+    if (!rflag) ++outline;
     fprintf(output_file, "|]\n");
+  }
   write_section(define_tables);
   output_entries();
   output_trailing_text();
@@ -482,20 +487,20 @@ void pack_table(void)
 }
 
 
-/*  The function matching_vector determines if the vector specified by        */
-/*  the input parameter matches a previously considered        vector.  The        */
-/*  test at the start of the function checks if the vector represents        */
-/*  a row of shifts over terminal symbols or a row of reductions, or a        */
-/*  column of shifts over a nonterminal symbol.  Berkeley Yacc does not        */
-/*  check if a column of shifts over a nonterminal symbols matches a        */
-/*  previously considered vector.  Because of the nature of LR parsing        */
-/*  tables, no two columns can match.  Therefore, the only possible        */
-/*  match would be between a row and a column.  Such matches are        */
-/*  unlikely.  Therefore, to save time, no attempt is made to see if a        */
+/*  The function matching_vector determines if the vector specified by    */
+/*  the input parameter matches a previously considered vector.  The      */
+/*  test at the start of the function checks if the vector represents     */
+/*  a row of shifts over terminal symbols or a row of reductions, or a    */
+/*  column of shifts over a nonterminal symbol.  Berkeley Yacc does not   */
+/*  check if a column of shifts over a nonterminal symbols matches a      */
+/*  previously considered vector.  Because of the nature of LR parsing    */
+/*  tables, no two columns can match.  Therefore, the only possible       */
+/*  match would be between a row and a column.  Such matches are          */
+/*  unlikely.  Therefore, to save time, no attempt is made to see if a    */
 /*  column matches a previously considered vector.                        */
 /*                                                                        */
-/*  Matching_vector is poorly designed.  The test could easily be made        */
-/*  faster.  Also, it depends on the vectors being in a specific        */
+/*  Matching_vector is poorly designed.  The test could easily be made    */
+/*  faster.  Also, it depends on the vectors being in a specific          */
 /*  order.                                                                */
 
 int
@@ -751,19 +756,25 @@ void output_transl(void)
 {
   int i;
 
+  ++outline;
   fprintf(code_file, "let yytransl_const = [|\n");
   for (i = 0; i < ntokens; i++) {
     if (symbol_true_token[i] && symbol_tag[i] == NULL) {
+      ++outline;
       fprintf(code_file, "  %3d (* %s *);\n", symbol_value[i], symbol_name[i]);
     }
   }
+  outline += 2;
   fprintf(code_file, "    0|]\n\n");
+  ++outline;
   fprintf(code_file, "let yytransl_block = [|\n");
   for (i = 0; i < ntokens; i++) {
     if (symbol_true_token[i] && symbol_tag[i] != NULL) {
+      ++outline;
       fprintf(code_file, "  %3d (* %s *);\n", symbol_value[i], symbol_name[i]);
     }
   }
+  outline += 2;
   fprintf(code_file, "    0|]\n\n");
 }
 
@@ -798,19 +809,25 @@ void output_debug(void)
 {
   int i;
 
+  ++outline;
   fprintf(code_file, "let yynames_const = \"\\\n");
   for (i = 0; i < ntokens; i++) {
     if (symbol_true_token[i] && symbol_tag[i] == NULL) {
+      ++outline;
       fprintf(code_file, "  %s\\000\\\n", symbol_name[i]);
     }
   }
+  outline += 2;
   fprintf(code_file, "  \"\n\n");
+  ++outline;
   fprintf(code_file, "let yynames_block = \"\\\n");
   for (i = 0; i < ntokens; i++) {
     if (symbol_true_token[i] && symbol_tag[i] != NULL) {
+      ++outline;
       fprintf(code_file, "  %s\\000\\\n", symbol_name[i]);
     }
   }
+  outline += 2;
   fprintf(code_file, "  \"\n\n");
 }
 
@@ -824,6 +841,10 @@ void output_trailing_text(void)
 
     in = input_file;
     out = code_file;
+
+    ++outline;
+    fprintf (out, ";;\n");
+
     c = *cptr;
     if (c == '\n')
     {
@@ -853,6 +874,7 @@ void output_trailing_text(void)
         last = '\n';
     }
 
+
     while ((c = getc(in)) != EOF)
     {
         if (c == '\n')
@@ -874,27 +896,34 @@ void output_trailing_text(void)
 void copy_file(FILE **file, char *file_name)
 {
   register int c, last;
-  register FILE *out;
+  register FILE *out = code_file;
+  int state = 0;
 
   fclose(*file);
     *file = fopen(file_name, "r");
     if (*file == NULL)
         open_error(file_name);
 
-    if ((c = getc(*file)) == EOF)
-        return;
+    last = '\n';
 
-    out = code_file;
-    last = c;
-    if (c == '\n')
-        ++outline;
-    putc(c, out);
     while ((c = getc(*file)) != EOF)
     {
-        if (c == '\n')
-            ++outline;
-        putc(c, out);
-        last = c;
+      switch (c){
+      case '\n': state = 1; break;
+      case '#': state = (state == 1) ? 2 : 0; break;
+      case ' ': state = (state == 2) ? 3 : 0; break;
+      case '0':
+        if (state == 3){
+          fprintf (out, "%d \"%s", outline+2, code_file_name);
+          c = '"';
+        }
+        state = 0;
+        break;
+      default: state = 0; break;
+      }
+      if (c == '\n') ++outline;
+      putc(c, out);
+      last = c;
     }
 
     if (last != '\n')
diff --git a/yacc/reader.c b/yacc/reader.c
index 11cdfaba90..2b6dca6ebc 100644
--- a/yacc/reader.c
+++ b/yacc/reader.c
@@ -48,7 +48,7 @@ bucket **plhs;
 int name_pool_size;
 char *name_pool;
 
-char line_format[] = "(* Line %d, file %s *)\n";
+char line_format[] = "# %d \"%s\"\n";
 
 
 
@@ -327,7 +327,7 @@ void copy_text(void)
         if (line == 0)
             unterminated_text(t_lineno, t_line, t_cptr);
     }
-    fprintf(f, "# %d \"%s\"\n", lineno, input_file_name);
+    fprintf(f, line_format, lineno, input_file_name);
 
 loop:
     c = *cptr++;
@@ -981,12 +981,13 @@ void output_token_type(void)
   int n;
 
   fprintf(interface_file, "type token =\n");
+  if (!rflag) ++outline;
   fprintf(output_file, "type token =\n");
   n = 0;
   for (bp = first_symbol; bp; bp = bp->next) {
     if (bp->class == TERM && bp->true_token) {
-      fprintf(interface_file, "  %c %s", n == 0 ? ' ' : '|', bp->name);
-      fprintf(output_file, "  %c %s", n == 0 ? ' ' : '|', bp->name);
+      fprintf(interface_file, "  | %s", bp->name);
+      fprintf(output_file, "  | %s", bp->name);
       if (bp->tag) {
         /* Print the type expression in parentheses to make sure
            that the constructor is unary */
@@ -994,11 +995,13 @@ void output_token_type(void)
         fprintf(output_file, " of (%s)", bp->tag);
       }
       fprintf(interface_file, "\n");
+      if (!rflag) ++outline;
       fprintf(output_file, "\n");
       n++;
     }
   }
   fprintf(interface_file, "\n");
+  if (!rflag) ++outline;
   fprintf(output_file, "\n");
 }
 
@@ -1231,7 +1234,7 @@ void copy_action(void)
         fprintf(f, "(peek_val parser_env %d : '%s) in\n", n - i, item->name);
     }
     fprintf(f, "    Obj.repr((\n");
-    fprintf(f, "# %d \"%s\"\n", lineno, input_file_name);
+    fprintf(f, line_format, lineno, input_file_name);
     for (i = cptr - line; i >= 0; i--) fputc(' ', f);
 
     depth = 1;
@@ -1265,6 +1268,7 @@ loop:
         goto loop;
     }
     if (c == '}' && depth == 1) {
+      fprintf(f, "\n# 0\n              ");
       cptr++;
       tagres = plhs[nrules]->tag;
       if (tagres)
diff --git a/yacc/skeleton.c b/yacc/skeleton.c
index 95b2d636c4..967e170994 100644
--- a/yacc/skeleton.c
+++ b/yacc/skeleton.c
@@ -18,7 +18,7 @@
 
 char *header[] =
 {
-  "open Parsing",
+  "open Parsing;;",
   0
 };