From 6a010b47b216c5a6b6e85abcfbba5339bab15dd6 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Thu, 19 Oct 2017 13:08:13 +0200 Subject: 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. --- arm/Asmexpand.ml | 8 ++++---- arm/Machregs.v | 2 +- arm/TargetPrinter.ml | 14 +++++++++++--- 3 files changed, 16 insertions(+), 8 deletions(-) (limited to 'arm') diff --git a/arm/Asmexpand.ml b/arm/Asmexpand.ml index 04b4152d..b65007df 100644 --- a/arm/Asmexpand.ml +++ b/arm/Asmexpand.ml @@ -81,8 +81,8 @@ let expand_int64_arith conflict rl fn = (* 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)); match args, res with | [BA(IR src)], BR(IR dst) -> if dst <> src then emit (Pmov (dst,SOreg src)) @@ -453,8 +453,8 @@ let expand_instruction instr = expand_builtin_vload chunk args res | EF_vstore chunk -> expand_builtin_vstore chunk 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_memcpy(sz, al) -> expand_builtin_memcpy (Int32.to_int (camlint_of_coqint sz)) (Int32.to_int (camlint_of_coqint al)) args diff --git a/arm/Machregs.v b/arm/Machregs.v index ba3bda7c..ae0ff6bf 100644 --- a/arm/Machregs.v +++ b/arm/Machregs.v @@ -200,7 +200,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/arm/TargetPrinter.ml b/arm/TargetPrinter.ml index fa612047..67bc5d8b 100644 --- a/arm/TargetPrinter.ml +++ b/arm/TargetPrinter.ml @@ -159,6 +159,7 @@ struct | 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 = fprintf oc " %s\n" (name_of_section sec) @@ -722,9 +723,16 @@ struct end | Pbuiltin(ef, args, res) -> begin match ef with - | EF_annot(txt, targs) -> - fprintf oc "%s annotation: %s\n" comment - (annot_text preg_annot "sp" (camlstring_of_coqstring txt) args); + | 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: " elf_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; 0 | EF_debug(kind, txt, targs) -> print_debug_info comment print_file_line preg_annot "sp" oc -- cgit