Merge pull request #40 from AbsInt/inline-asm

GCC-style extended inline asm.

The subset implemented is:

- zero or one output
- output constraints "=r" (to register) or "=m" (to memory)
- zero, one or several inputs
- input constraints "r" (in register), "m" (in memory), "i" and "n" (compile-time integer constant)
- clobbered registers (the 3rd argument)
- both anonymous (%3) and named (%[name]) operands
- modifiers %R and %Q to refer to the most significant / least significant part of a register pair holding a 64-bit integer. (Undocumented GCC ARM feature.)

All asm statements are treated as "volatile", possibly modifying memory and condition codes.

4 files changed, 42 insertions, 4 deletions

diff --git a/backend/CMparser.mly b/backend/CMparser.mly
index 69b70e72..f62e05d4 100644
--- a/backend/CMparser.mly
+++ b/backend/CMparser.mly
@@ -60,7 +60,7 @@ let mkef sg toks =
       if sg.sig_args = [] then raise Parsing.Parse_error;
       EF_annot_val(intern_string txt, List.hd sg.sig_args)
   | [EFT_tok "inline_asm"; EFT_string txt] ->
-      EF_inline_asm(intern_string txt)
+      EF_inline_asm(intern_string txt, sg, [])
   | _ ->
       raise Parsing.Parse_error
 
diff --git a/backend/CSE.v b/backend/CSE.v
index 2c0c5f33..e9006d4f 100644
--- a/backend/CSE.v
+++ b/backend/CSE.v
@@ -476,7 +476,7 @@ Definition transfer (f: function) (approx: PMap.t VA.t) (pc: node) (before: numb
           empty_numbering
       | Ibuiltin ef args res s =>
           match ef with
-          | EF_external _ _ | EF_malloc | EF_free | EF_inline_asm _ =>
+          | EF_external _ _ | EF_malloc | EF_free | EF_inline_asm _ _ _ =>
               empty_numbering
           | EF_builtin _ _ | EF_vstore _ | EF_vstore_global _ _ _ =>
               set_unknown (kill_all_loads before) res
diff --git a/backend/PrintAnnot.ml b/backend/PrintAnnot.ml
index 995f22dd..88f5d8d6 100644
--- a/backend/PrintAnnot.ml
+++ b/backend/PrintAnnot.ml
@@ -148,7 +148,29 @@ let print_annot_val print_preg oc txt args =
   print_annot_text print_preg "<internal error>" oc txt
     (List.map (fun r -> AA_base r) args)
 
-(* Print CompCert version and command-line as asm comment *)
+(** Inline assembly *)
+
+let re_asm_param = Str.regexp "%%\\|%[0-9]+"
+
+let print_inline_asm print_preg oc txt sg args res =
+  let operands =
+    if sg.sig_res = None then args else res @ args in
+  let print_fragment = function
+  | Str.Text s ->
+      output_string oc s
+  | Str.Delim "%%" ->
+      output_char oc '%'
+  | Str.Delim s ->
+      let n = int_of_string (String.sub s 1 (String.length s - 1)) in
+      try
+        print_preg oc (List.nth operands n)
+      with Failure _ ->
+        fprintf oc "<bad parameter %s>" s in
+  List.iter print_fragment (Str.full_split re_asm_param txt);
+  fprintf oc "\n"
+
+
+(** Print CompCert version and command-line as asm comment *)
 
 let print_version_and_options oc comment =
   fprintf oc "%s File generated by CompCert %s\n" comment Configuration.version;
diff --git a/backend/Regalloc.ml b/backend/Regalloc.ml
index 3a7f5d99..c286e946 100644
--- a/backend/Regalloc.ml
+++ b/backend/Regalloc.ml
@@ -510,6 +510,9 @@ let add_interfs_live g live v =
 let add_interfs_list g v vl =
   List.iter (IRC.add_interf g v) vl
 
+let add_interfs_list_mreg g vl mr =
+  List.iter (fun v -> IRC.add_interf g v (L (R mr))) vl
+
 let rec add_interfs_pairwise g = function
   | [] -> ()
   | v1 :: vl -> add_interfs_list g v1 vl; add_interfs_pairwise g vl
@@ -578,7 +581,20 @@ let add_interfs_instr g instr live =
       add_interfs_pairwise g res;
       add_interfs_destroyed g across (destroyed_by_builtin ef);
       begin match ef, args, res with
-      | EF_annot_val _, [arg], [res] -> IRC.add_pref g arg res (* like a move *)
+      | EF_annot_val _, [arg], [res] ->
+          (* like a move *)
+          IRC.add_pref g arg res
+      | EF_inline_asm(txt, sg, clob), _, _ ->
+          (* clobbered regs interfere with live set
+             and also with res and args for GCC compatibility *)
+          List.iter (fun c ->
+            match Machregsaux.register_by_name (extern_atom c) with
+            | None -> ()
+            | Some mr ->
+                add_interfs_destroyed g across [mr];
+                add_interfs_list_mreg g args mr;
+                if sg.sig_res <> None then add_interfs_list_mreg g res mr)
+            clob          
       | _ -> ()
       end
   | Xannot(ef, args) ->