diff options
Diffstat (limited to 'backend')
-rw-r--r-- | backend/CSE.v | 2 | ||||
-rw-r--r-- | backend/Deadcode.v | 2 | ||||
-rw-r--r-- | backend/Deadcodeproof.v | 4 | ||||
-rw-r--r-- | backend/PrintAsm.ml | 18 | ||||
-rw-r--r-- | backend/PrintAsmaux.ml | 10 | ||||
-rw-r--r-- | backend/RTLtyping.v | 6 | ||||
-rw-r--r-- | backend/ValueAnalysis.v | 4 |
7 files changed, 37 insertions, 9 deletions
diff --git a/backend/CSE.v b/backend/CSE.v index bc3fdba5..6d3f6f33 100644 --- a/backend/CSE.v +++ b/backend/CSE.v @@ -486,7 +486,7 @@ Definition transfer (f: function) (approx: PMap.t VA.t) (pc: node) (before: numb | _ => empty_numbering end - | EF_vload _ | EF_annot _ _ | EF_annot_val _ _ | EF_debug _ _ _ => + | EF_vload _ | EF_annot _ _ _ | EF_annot_val _ _ _ | EF_debug _ _ _ => set_res_unknown before res end | Icond cond args ifso ifnot => diff --git a/backend/Deadcode.v b/backend/Deadcode.v index 9cbe5054..2286876e 100644 --- a/backend/Deadcode.v +++ b/backend/Deadcode.v @@ -102,7 +102,7 @@ Function transfer_builtin (app: VA.t) (ef: external_function) nmem_add (nmem_remove nm (aaddr_arg app dst) sz) (aaddr_arg app src) sz) args else (ne, nm) - | (EF_annot _ _ | EF_annot_val _ _), _ => + | (EF_annot _ _ _ | EF_annot_val _ _ _), _ => transfer_builtin_args (kill_builtin_res res ne, nm) args | EF_debug _ _ _, _ => (kill_builtin_res res ne, nm) diff --git a/backend/Deadcodeproof.v b/backend/Deadcodeproof.v index ca6ad649..12c05cc3 100644 --- a/backend/Deadcodeproof.v +++ b/backend/Deadcodeproof.v @@ -994,7 +994,7 @@ Ltac UseTransfer := erewrite Mem.loadbytes_length in H0 by eauto. rewrite nat_of_Z_eq in H0 by omega. auto. + (* annot *) - destruct (transfer_builtin_args (kill_builtin_res res ne, nm) _x1) as (ne1, nm1) eqn:TR. + destruct (transfer_builtin_args (kill_builtin_res res ne, nm) _x2) as (ne1, nm1) eqn:TR. InvSoundState. exploit transfer_builtin_args_sound; eauto. intros (tvl & A & B & C & D). inv H1. @@ -1006,7 +1006,7 @@ Ltac UseTransfer := eapply match_succ_states; eauto. simpl; auto. apply eagree_set_res; auto. + (* annot val *) - destruct (transfer_builtin_args (kill_builtin_res res ne, nm) _x1) as (ne1, nm1) eqn:TR. + destruct (transfer_builtin_args (kill_builtin_res res ne, nm) _x2) as (ne1, nm1) eqn:TR. InvSoundState. exploit transfer_builtin_args_sound; eauto. intros (tvl & A & B & C & D). inv H1. inv B. inv H6. diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml index 0e9eadcb..465b8791 100644 --- a/backend/PrintAsm.ml +++ b/backend/PrintAsm.ml @@ -108,6 +108,23 @@ module Printer(Target:TARGET) = | Gfun (External ef) -> () | Gvar v -> print_var oc name v + let print_ais_annot oc = + let annots = List.rev !ais_annot_list in + if annots <> [] then begin + Target.section oc Section_ais_annotation; + let annot_part oc lbl = function + | Str.Delim _ -> + fprintf oc " .byte 7,%d\n" (if Archi.ptr64 then 8 else 4) ; + fprintf oc " %s %a\n" Target.address Target.label lbl + | Str.Text a -> fprintf oc " .ascii %S\n" a in + let annot oc (lbl,str) = + List.iter (annot_part oc lbl) str; + fprintf oc " .ascii \"\\n\"\n" + in + List.iter (annot oc) annots + end; + ais_annot_list := [] + module DwarfTarget: DwarfTypes.DWARF_TARGET = struct let label = Target.label @@ -128,6 +145,7 @@ let print_program oc p = Target.print_prologue oc; List.iter (Printer.print_globdef oc) p.prog_defs; Target.print_epilogue oc; + Printer.print_ais_annot oc; if !Clflags.option_g then begin let atom_to_s s = diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml index df3445ea..07ab4bed 100644 --- a/backend/PrintAsmaux.ml +++ b/backend/PrintAsmaux.ml @@ -197,6 +197,16 @@ let annot_text preg_string sp_reg_name txt args = sprintf "<bad parameter %s>" s in String.concat "" (List.map fragment (Str.full_split re_annot_param txt)) +let ais_annot_list: (int * Str.split_result list) list ref = ref [] + +let re_annot_addr = Str.regexp "%addr" + +let ais_annot_text lbl preg_string sp_reg_name txt args = + let annot = annot_text preg_string sp_reg_name txt args in + let annots = Str.full_split re_annot_addr annot in + ais_annot_list := (lbl,annots)::!ais_annot_list; + annot + (* Printing of [EF_debug] info. To be completed. *) let re_file_line = Str.regexp "#line:\\(.*\\):\\([1-9][0-9]*\\)$" diff --git a/backend/RTLtyping.v b/backend/RTLtyping.v index fef74706..8336d1bf 100644 --- a/backend/RTLtyping.v +++ b/backend/RTLtyping.v @@ -132,7 +132,7 @@ Inductive wt_instr : instruction -> Prop := | wt_Ibuiltin: forall ef args res s, match ef with - | EF_annot _ _ | EF_debug _ _ _ => True + | EF_annot _ _ _ | EF_debug _ _ _ => True | _ => map type_of_builtin_arg args = (ef_sig ef).(sig_args) end -> type_of_builtin_res res = proj_sig_res (ef_sig ef) -> @@ -308,7 +308,7 @@ Definition type_instr (e: S.typenv) (i: instruction) : res S.typenv := do x <- check_successor s; do e1 <- match ef with - | EF_annot _ _ | EF_debug _ _ _ => OK e + | EF_annot _ _ _ | EF_debug _ _ _ => OK e | _ => type_builtin_args e args sig.(sig_args) end; type_builtin_res e1 res (proj_sig_res sig) @@ -702,7 +702,7 @@ Proof. exploit type_builtin_res_complete; eauto. instantiate (1 := res). intros [e2 [C D]]. exploit type_builtin_res_complete. eexact H. instantiate (1 := res). intros [e3 [E F]]. rewrite check_successor_complete by auto. simpl. - exists (match ef with EF_annot _ _ | EF_debug _ _ _ => e3 | _ => e2 end); split. + exists (match ef with EF_annot _ _ _ | EF_debug _ _ _ => e3 | _ => e2 end); split. rewrite H1 in C, E. destruct ef; try (rewrite <- H0; rewrite A); simpl; auto. destruct ef; auto. diff --git a/backend/ValueAnalysis.v b/backend/ValueAnalysis.v index 8aa4878a..674bc065 100644 --- a/backend/ValueAnalysis.v +++ b/backend/ValueAnalysis.v @@ -99,9 +99,9 @@ Definition transfer_builtin let p := loadbytes am rm (aptr_of_aval asrc) in let am' := storebytes am (aptr_of_aval adst) sz p in VA.State (set_builtin_res res ntop ae) am' - | (EF_annot _ _ | EF_debug _ _ _), _ => + | (EF_annot _ _ _ | EF_debug _ _ _), _ => VA.State (set_builtin_res res ntop ae) am - | EF_annot_val _ _, v :: nil => + | EF_annot_val _ _ _, v :: nil => let av := abuiltin_arg ae am rm v in VA.State (set_builtin_res res av ae) am | _, _ => |