diff options
Diffstat (limited to 'backend')
| -rw-r--r-- | backend/Constprop.v | 6 | ||||
| -rw-r--r-- | backend/Constpropproof.v | 6 | ||||
| -rw-r--r-- | backend/PrintAsm.ml | 39 | ||||
| -rw-r--r-- | backend/PrintAsmaux.ml | 11 |
4 files changed, 31 insertions, 31 deletions
diff --git a/backend/Constprop.v b/backend/Constprop.v index cd844d30..8f4cb76d 100644 --- a/backend/Constprop.v +++ b/backend/Constprop.v @@ -144,9 +144,9 @@ Fixpoint debug_strength_reduction (ae: AE.t) (al: list (builtin_arg reg)) := | a :: al => let a' := builtin_arg_reduction ae a in let al' := a :: debug_strength_reduction ae al in - match a' with - | BA_int _ | BA_long _ | BA_float _ | BA_single _ => a' :: al' - | _ => al' + match a, a' with + | BA _, (BA_int _ | BA_long _ | BA_float _ | BA_single _) => a' :: al' + | _, _ => al' end end. diff --git a/backend/Constpropproof.v b/backend/Constpropproof.v index d9005f5e..eafefed5 100644 --- a/backend/Constpropproof.v +++ b/backend/Constpropproof.v @@ -243,7 +243,11 @@ Proof. induction 2; simpl. - exists (@nil val); constructor. - destruct IHlist_forall2 as (vl' & A). - destruct (builtin_arg_reduction ae a1); repeat (eauto; econstructor). + assert (eval_builtin_args ge (fun r => rs#r) sp m + (a1 :: debug_strength_reduction ae al) (b1 :: vl')) + by (constructor; eauto). + destruct a1; try (econstructor; eassumption). + destruct (builtin_arg_reduction ae (BA x)); repeat (eauto; econstructor). Qed. Lemma builtin_strength_reduction_correct: diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml index f3c80f3e..a152e3c2 100644 --- a/backend/PrintAsm.ml +++ b/backend/PrintAsm.ml @@ -24,14 +24,11 @@ open TargetPrinter module Printer(Target:TARGET) = struct - let addr_mapping: (string, (int * int)) Hashtbl.t = Hashtbl.create 7 - let get_fun_addr name = - let name = extern_atom name in - let start_addr = new_label () - and end_addr = new_label () in - Hashtbl.add addr_mapping name (start_addr,end_addr); - start_addr,end_addr + let s = Target.new_label () + and e = Target.new_label () in + Debug.add_fun_addr name (e,s); + s,e let print_debug_label oc l = if !Clflags.option_g && Configuration.advanced_debug then @@ -39,7 +36,6 @@ module Printer(Target:TARGET) = else () - let print_location oc loc = if loc <> Cutil.no_loc then Target.print_file_line oc (fst loc) (snd loc) @@ -67,7 +63,9 @@ module Printer(Target:TARGET) = print_debug_label oc e; Target.print_fun_info oc name; Target.emit_constants oc lit; - Target.print_jumptable oc jmptbl + Target.print_jumptable oc jmptbl; + if !Clflags.option_g then + Hashtbl.iter (fun p i -> Debug.add_label name p i) current_function_labels let print_init_data oc name id = if Str.string_match PrintCsyntax.re_string_literal (extern_atom name) 0 @@ -102,8 +100,7 @@ module Printer(Target:TARGET) = let sz = match v.gvar_init with [Init_space sz] -> sz | _ -> assert false in Target.print_comm_symb oc sz name align - - + let print_globdef oc (name,gdef) = match gdef with | Gfun (Internal code) -> print_function oc name code @@ -113,18 +110,13 @@ module Printer(Target:TARGET) = module DwarfTarget: DwarfTypes.DWARF_TARGET = struct let label = Target.label - let name_of_section = Target.name_of_section + let section = Target.section let print_file_loc = Target.print_file_loc - let get_start_addr = Target.get_start_addr - let get_end_addr = Target.get_end_addr - let get_stmt_list_addr = Target.get_stmt_list_addr let name_of_section = Target.name_of_section - let get_fun_addr s = try Some (Hashtbl.find addr_mapping s) with Not_found -> None + let symbol = Target.symbol end - module DebugPrinter = DwarfPrinter (DwarfTarget) (Target.DwarfAbbrevs) - - + module DebugPrinter = DwarfPrinter (DwarfTarget) end let print_program oc p db = @@ -138,7 +130,14 @@ let print_program oc p db = close_filenames (); if !Clflags.option_g && Configuration.advanced_debug then begin - match db with + let atom_to_s s = + let s = C2C.atom_sections s in + match s with + | [] -> Target.name_of_section Section_text + | (Section_user (n,_,_))::_ -> n + | a::_ -> + Target.name_of_section a in + match Debug.generate_debug_info atom_to_s (Target.name_of_section Section_text) with | None -> () | Some db -> Printer.DebugPrinter.print_debug oc db diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml index 67e53aea..1c3b47b5 100644 --- a/backend/PrintAsmaux.ml +++ b/backend/PrintAsmaux.ml @@ -48,10 +48,10 @@ module type TARGET = val get_start_addr: unit -> int val get_end_addr: unit -> int val get_stmt_list_addr: unit -> int + val get_debug_start_addr: unit -> int val new_label: unit -> int val label: out_channel -> int -> unit val print_file_loc: out_channel -> file_loc -> unit - module DwarfAbbrevs: DWARF_ABBREVS end (* On-the-fly label renaming *) @@ -140,12 +140,6 @@ let coqint oc n = fprintf oc "%ld" (camlint_of_coqint n) (* Printing annotations in asm syntax *) -(** All files used in the debug entries *) -module StringSet = Set.Make(String) -let all_files : StringSet.t ref = ref StringSet.empty -let add_file file = - all_files := StringSet.add file !all_files - let filename_info : (string, int * Printlines.filebuf option) Hashtbl.t = Hashtbl.create 7 @@ -283,6 +277,9 @@ let print_debug_info comment print_line print_preg sp_name oc kind txt args = | 5 -> (* local variable preallocated in stack *) fprintf oc "%s debug: %s resides at%a\n" comment txt print_debug_args args + | 6 -> (* scope annotations *) + fprintf oc "%s debug: current scopes%a\n" + comment print_debug_args args; | _ -> () |