New support for inserting ais-annotations.

The ais annotations can be inserted via the new ais variants of
the builtin annotation. They mainly differe in that they have an
address format specifier '%addr' which will be replaced by the
adress in the binary.

The implementation simply prints a label for the builtin call
alongside a the text of the annotation as comment and inserts the
annotation together as acii string in a separate section
'ais_annotations' and replaces the usages of the address format
specifiers by the address of the label of the builtin call.

4 files changed, 29 insertions, 13 deletions

diff --git a/powerpc/AsmToJSON.ml b/powerpc/AsmToJSON.ml
index b542d7a7..a3e57e51 100644
--- a/powerpc/AsmToJSON.ml
+++ b/powerpc/AsmToJSON.ml
@@ -367,7 +367,7 @@ let pp_instructions pp ic =
       | EF_inline_asm _ ->
         instruction pp "Pinlineasm" [Id];
         Cerrors.warning ("",-10) Cerrors.Inline_asm_sdump "inline assembler is not supported in sdump"
-      | EF_annot (txt,targs) ->
+      | EF_annot (kind,txt,targs) ->
         let annot_string = PrintAsmaux.annot_text preg_annot "r1" (camlstring_of_coqstring txt) args in
         let len = String.length annot_string in
         let buf = Buffer.create len in
@@ -376,7 +376,11 @@ let pp_instructions pp ic =
             | _ -> () end;
             Buffer.add_char buf c) annot_string;
         let annot_string = Buffer.contents buf in
-        instruction pp "Pannot" [String annot_string]
+        let kind = match P.to_int kind with
+          | 1 -> "normal"
+          | 2 -> "ais"
+          | _ -> assert false in
+        instruction pp "Pannot" [String kind;String annot_string]
       | EF_annot_val _
       | EF_builtin _
       | EF_debug _
@@ -423,7 +427,8 @@ let pp_section pp sec =
   | Section_debug_line _
   | Section_debug_loc
   | Section_debug_ranges
-  | Section_debug_str -> () (* There should be no info in the debug sections *)
+  | Section_debug_str
+  | Section_ais_annotation -> () (* There should be no info in the debug sections *)
 
 let pp_int_opt pp = function
   | None -> fprintf pp "0"
diff --git a/powerpc/Asmexpand.ml b/powerpc/Asmexpand.ml
index deab7703..96b11056 100644
--- a/powerpc/Asmexpand.ml
+++ b/powerpc/Asmexpand.ml
@@ -58,8 +58,8 @@ let emit_addimm rd rs n =
 
 (* Handling of annotations *)
 
-let expand_annot_val txt targ args res =
-  emit (Pbuiltin(EF_annot(txt, [targ]), args, BR_none));
+let expand_annot_val kind txt targ args res =
+  emit (Pbuiltin(EF_annot(kind,txt, [targ]), args, BR_none));
   begin match args, res with
   | [BA(IR src)], BR(IR dst) ->
       if dst <> src then emit (Pmr(dst, src))
@@ -869,8 +869,8 @@ let expand_instruction instr =
           expand_builtin_vstore chunk args
       | EF_memcpy(sz, al) ->
           expand_builtin_memcpy (Z.to_int sz) (Z.to_int al) args
-      | EF_annot_val(txt, targ) ->
-          expand_annot_val txt targ args res
+      | EF_annot_val(kind,txt, targ) ->
+          expand_annot_val kind txt targ args res
        | EF_annot _ | EF_debug _ | EF_inline_asm _ ->
           emit instr
       | _ ->
diff --git a/powerpc/Machregs.v b/powerpc/Machregs.v
index 8442bb52..53d99e2f 100644
--- a/powerpc/Machregs.v
+++ b/powerpc/Machregs.v
@@ -279,7 +279,7 @@ Definition builtin_constraints (ef: external_function) :
   | EF_vload _ => OK_addressing :: nil
   | EF_vstore _ => OK_addressing :: OK_default :: nil
   | EF_memcpy _ _ => OK_addrstack :: OK_addrstack :: nil
-  | EF_annot txt targs => map (fun _ => OK_all) targs
+  | EF_annot kind txt targs => map (fun _ => OK_all) targs
   | EF_debug kind txt targs => map (fun _ => OK_all) targs
   | _ => nil
   end.
diff --git a/powerpc/TargetPrinter.ml b/powerpc/TargetPrinter.ml
index bff2a7fa..9c07b086 100644
--- a/powerpc/TargetPrinter.ml
+++ b/powerpc/TargetPrinter.ml
@@ -136,6 +136,7 @@ module Linux_System : SYSTEM =
       | Section_debug_line _ ->  ".section	.debug_line,\"\",@progbits"
       | Section_debug_ranges -> ".section	.debug_ranges,\"\",@progbits"
       | Section_debug_str -> ".section	.debug_str,\"MS\",@progbits,1"
+      | Section_ais_annotation -> sprintf ".section	\"__compcert_ais_annotations\",\"\",@note"
 
 
     let section oc sec =
@@ -234,6 +235,7 @@ module Diab_System : SYSTEM =
           sprintf ".section	.debug_line,,n\n"
       | Section_debug_ranges
       | Section_debug_str -> assert false (* Should not be used *)
+      | Section_ais_annotation -> sprintf ".section	\"__compcert_ais_annotations\",,n"
 
     let section oc sec =
       let name = name_of_section sec in
@@ -832,10 +834,17 @@ module Target (System : SYSTEM):TARGET =
             fprintf oc "	.balign	%d\n" !Clflags.option_falignbranchtargets;
           fprintf oc "%a:\n" label (transl_label lbl)
       | Pbuiltin(ef, args, res) ->
-          begin match ef with
-          | EF_annot(txt, targs) ->
-              fprintf oc "%s annotation: %s\n" comment
-              (annot_text preg_annot "r1" (camlstring_of_coqstring txt) args)
+        begin match ef with
+          | EF_annot(kind,txt, targs) ->
+            let annot =
+              begin match (P.to_int kind) with
+                | 1 -> annot_text preg_annot "sp" (camlstring_of_coqstring txt) args
+                | 2 -> let lbl = new_label () in
+                  fprintf oc "%a: " label lbl;
+                  ais_annot_text lbl preg_annot "r1" (camlstring_of_coqstring txt) args
+                | _ -> assert false
+              end in
+            fprintf oc "%s annotation: %S\n" comment annot
           | EF_debug(kind, txt, targs) ->
               print_debug_info comment print_file_line preg_annot "r1" oc
                                (P.to_int kind) (extern_atom txt) args
@@ -990,7 +999,9 @@ module Target (System : SYSTEM):TARGET =
 
     let section oc sec =
       section oc sec;
-      debug_section oc sec
+      match sec with
+      | Section_ais_annotation -> ()
+      | _ -> debug_section oc sec
   end
 
 let sel_target () =