From 71f95bbbe0bbe796e7049832e767972e6c1f5f9f Mon Sep 17 00:00:00 2001
From: Vincent Laporte <Vincent.Laporte@inria.fr>
Date: Tue, 16 Jan 2024 15:05:55 +0100
Subject: [PATCH] Compiler: emit DWARF2 line number information

---
 CHANGELOG.md               |  3 +++
 compiler/src/debugInfo.ml  | 27 +++++++++++++++++++++++++++
 compiler/src/debugInfo.mli |  2 ++
 compiler/src/pp_arm_m4.ml  |  6 ++++--
 compiler/src/ppasm.ml      |  7 ++++++-
 5 files changed, 42 insertions(+), 3 deletions(-)
 create mode 100644 compiler/src/debugInfo.ml
 create mode 100644 compiler/src/debugInfo.mli

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 4dd2a2eb4..02da8c0af 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -43,6 +43,9 @@
   against Spectre).
   ([PR #631](https://github.com/jasmin-lang/jasmin/pull/631)).
 
+- Interleave references to source-code positions within the assembly listings.
+  ([PR #684](https://github.com/jasmin-lang/jasmin/pull/684)).
+
 ## Bug fixes
 
 - Type-checking rejects invalid variants of primitive operators
diff --git a/compiler/src/debugInfo.ml b/compiler/src/debugInfo.ml
new file mode 100644
index 000000000..077a47308
--- /dev/null
+++ b/compiler/src/debugInfo.ml
@@ -0,0 +1,27 @@
+open Utils
+open Location
+open Format
+
+(* TODO: remove global mutable state *)
+
+(** Give a unique number to the given file name.
+    Second return value is true the first time this file name is seed. *)
+let internFile =
+  let count = ref 0 in
+  let internedFiles = Hashtbl.create 17 in
+  fun s ->
+    match Hashtbl.find internedFiles s with
+    | v -> (v, false)
+    | exception Not_found ->
+        incr count;
+        let v = !count in
+        Hashtbl.add internedFiles s v;
+        (v, true)
+
+let source_positions ii =
+  if Location.isdummy ii then []
+  else
+    let n, isFresh = internFile ii.loc_fname in
+    let line, col = ii.loc_start in
+    let loc = [ asprintf ".loc %d %d %d\n" n line col ] in
+    if isFresh then asprintf ".file %d %S\n" n ii.loc_fname :: loc else loc
diff --git a/compiler/src/debugInfo.mli b/compiler/src/debugInfo.mli
new file mode 100644
index 000000000..29020c641
--- /dev/null
+++ b/compiler/src/debugInfo.mli
@@ -0,0 +1,2 @@
+val source_positions : Location.t -> string list
+(** List of .file and .loc directives to decorate assembly listings. *)
diff --git a/compiler/src/pp_arm_m4.ml b/compiler/src/pp_arm_m4.ml
index 8aae3f99c..a14f16e4d 100644
--- a/compiler/src/pp_arm_m4.ml
+++ b/compiler/src/pp_arm_m4.ml
@@ -296,8 +296,10 @@ let pp_instr fn _ i =
 
 let pp_body fn fmt =
   let open List in
-  concat_map @@ fun { asmi_i = i ; _ } ->
-  pp_instr fn fmt i
+  concat_map @@ fun { asmi_i = i ; asmi_ii = (ii, _) } ->
+  append
+    (map (fun i -> LInstr (i, [])) (DebugInfo.source_positions ii.base_loc))
+    (pp_instr fn fmt i)
 
 (* -------------------------------------------------------------------- *)
 (* TODO_ARM: This is architecture-independent. *)
diff --git a/compiler/src/ppasm.ml b/compiler/src/ppasm.ml
index f45e21aa9..9142a4325 100644
--- a/compiler/src/ppasm.ml
+++ b/compiler/src/ppasm.ml
@@ -446,9 +446,14 @@ module Printer (BP:BPrinter) = struct
       let args = pp_asm_args pp.pp_aop_args in
       `Instr(name, args)
 
+  (* -------------------------------------------------------------------- *)
+  let pp_ii ({ Location.base_loc = ii; _}, _) =
+    List.map (fun i -> `Instr(i, [])) (DebugInfo.source_positions ii)
+
   (* -------------------------------------------------------------------- *)
   let pp_instr name (fmt : Format.formatter) (i : (_, _, _, _, _, _) Arch_decl.asm_i) =
-    let Arch_decl.({ asmi_i = i ; _ }) = i in
+    let Arch_decl.({ asmi_i = i ; asmi_ii = ii }) = i in
+    List.iter (pp_gen fmt) (pp_ii ii);
     pp_gen fmt (pp_instr name i)
 
   (* -------------------------------------------------------------------- *)