From 09ee4a28f7c87b0f1e9ade86ac4c6bfa860af12d Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Tue, 14 Nov 2017 14:21:24 +0100 Subject: New json printing interface. The common json export functionallity is moved into an own File. Bug 22472 --- powerpc/AsmToJSON.ml | 161 ++++++--------------------------------------------- 1 file changed, 18 insertions(+), 143 deletions(-) (limited to 'powerpc/AsmToJSON.ml') diff --git a/powerpc/AsmToJSON.ml b/powerpc/AsmToJSON.ml index a3e57e51..696f7ca5 100644 --- a/powerpc/AsmToJSON.ml +++ b/powerpc/AsmToJSON.ml @@ -15,11 +15,10 @@ open Asm open AST open BinNums -open C2C open Camlcoq open Json open Format -open Sections +open JsonAST let pp_reg pp t n = let s = sprintf "%s%s" t n in @@ -36,20 +35,6 @@ let preg_annot = function | FR r -> sprintf "f%s" (TargetPrinter.float_reg_name r) | _ -> assert false -let pp_atom pp a = pp_jstring pp (extern_atom a) - -let pp_atom_constant pp a = pp_jsingle_object pp "Atom" pp_atom a - -let pp_int pp i = fprintf pp "%ld" (camlint_of_coqint i) -let pp_int64 pp i = fprintf pp "%Ld" (camlint64_of_coqint i) -let pp_float32 pp f = fprintf pp "%ld" (camlint_of_coqint (Floats.Float32.to_bits f)) -let pp_float64 pp f = fprintf pp "%Ld" (camlint64_of_coqint (Floats.Float.to_bits f)) -let pp_z pp z = fprintf pp "%s" (Z.to_string z) - -let pp_int_constant pp i = pp_jsingle_object pp "Integer" pp_int i -let pp_float64_constant pp f = pp_jsingle_object pp "Float" pp_float64 f -let pp_float32_constant pp f = pp_jsingle_object pp "Float" pp_float32 f - let pp_constant pp c = let pp_symbol pp (i,c) = pp_jobject_start pp; @@ -88,23 +73,12 @@ type instruction_arg = | Atom of positive | String of string -let id = ref 0 - -let next_id () = - let tmp = !id in - incr id; - tmp - -let reset_id () = - id := 0 - let pp_arg pp = function | Ireg ir -> pp_ireg pp ir | Freg fr -> pp_freg pp fr | Constant c -> pp_constant pp c | Long i -> pp_jsingle_object pp "Integer" pp_int64 i - | Id -> let i = next_id () in - pp_jsingle_object pp "Integer" (fun pp i -> fprintf pp "%d" i) i + | Id -> pp_id_const pp () | Crbit cr -> pp_crbit pp cr | ALabel lbl -> pp_label pp lbl | Float32 f -> pp_float32_constant pp f @@ -164,7 +138,7 @@ let pp_instructions pp ic = | Paddis64 (ir1,ir2,n) -> instruction pp "Paddis" [Ireg ir1; Ireg ir2; Constant (Cint n)] | Paddze (ir1,ir2) | Paddze64 (ir1,ir2) -> instruction pp "Paddze" [Ireg ir1; Ireg ir2] - | Pallocframe _ -> assert false (* Should not ppcur *) + | Pallocframe _ -> assert false (* Should not occur *) | Pand_ (ir1,ir2,ir3) | Pand_64 (ir1,ir2,ir3) -> instruction pp "Pand_" [Ireg ir1; Ireg ir2; Ireg ir3] | Pandc (ir1,ir2,ir3) -> instruction pp "Pandc" [Ireg ir1; Ireg ir2; Ireg ir3] @@ -211,33 +185,33 @@ let pp_instructions pp ic = | Pextsb (ir1,ir2) -> instruction pp "Pextsb" [Ireg ir1; Ireg ir2] | Pextsh (ir1,ir2) -> instruction pp "Pextsh" [Ireg ir1; Ireg ir2] | Pextsw (ir1,ir2) -> instruction pp "Pextsw" [Ireg ir1; Ireg ir2] - | Pextzw (ir1,ir2) -> assert false (* Should not ppcur *) - | Pfreeframe (c,i) -> assert false (* Should not ppcur *) + | Pextzw (ir1,ir2) -> assert false (* Should not occur *) + | Pfreeframe (c,i) -> assert false (* Should not occur *) | Pfabs (fr1,fr2) | Pfabss (fr1,fr2) -> instruction pp "Pfabs" [Freg fr1; Freg fr2] | Pfadd (fr1,fr2,fr3) -> instruction pp "Pfadd" [Freg fr1; Freg fr2; Freg fr3] | Pfadds (fr1,fr2,fr3) -> instruction pp "Pfadds" [Freg fr1; Freg fr2; Freg fr3] | Pfcmpu (fr1,fr2) -> instruction pp "Pfcmpu" [Freg fr1; Freg fr2] | Pfcfi (ir,fr) - | Pfcfl (ir,fr) -> assert false (* Should not ppcur *) + | Pfcfl (ir,fr) -> assert false (* Should not occur *) | Pfcfid (fr1,fr2) -> instruction pp "Pfcfid" [Freg fr1; Freg fr2] - | Pfcfiu _ (* Should not ppcur *) - | Pfcti _ (* Should not ppcur *) - | Pfctiu _ (* Should not ppcur *) - | Pfctid _ -> assert false (* Should not ppcur *) + | Pfcfiu _ (* Should not occur *) + | Pfcti _ (* Should not occur *) + | Pfctiu _ (* Should not occur *) + | Pfctid _ -> assert false (* Should not occur *) | Pfctidz (fr1,fr2) -> instruction pp "Pfctidz" [Freg fr1; Freg fr2] | Pfctiw (fr1,fr2) -> instruction pp "Pfctiw" [Freg fr1; Freg fr2] | Pfctiwz (fr1,fr2) -> instruction pp "Pfctiwz" [Freg fr1; Freg fr2] | Pfdiv (fr1,fr2,fr3) -> instruction pp "Pfdiv" [Freg fr1; Freg fr2; Freg fr3] | Pfdivs (fr1,fr2,fr3) -> instruction pp "Pfdivs" [Freg fr1; Freg fr2; Freg fr3] - | Pfmake (fr,ir1,ir2) -> assert false (* Should not ppcur *) + | Pfmake (fr,ir1,ir2) -> assert false (* Should not occur *) | Pfmr (fr1,fr2) -> instruction pp "Pfmr" [Freg fr1; Freg fr2] | Pfmul (fr1,fr2,fr3) -> instruction pp "Pfmul" [Freg fr1; Freg fr2; Freg fr3] | Pfmuls(fr1,fr2,fr3) -> instruction pp "Pfmuls" [Freg fr1; Freg fr2; Freg fr3] | Pfneg (fr1,fr2) | Pfnegs (fr1,fr2) -> instruction pp "Pfneg" [Freg fr1; Freg fr2] | Pfrsp (fr1,fr2) -> instruction pp "Pfrsp" [Freg fr1; Freg fr2] - | Pfxdp (fr1,fr2) -> assert false (* Should not ppcur *) + | Pfxdp (fr1,fr2) -> assert false (* Should not occur *) | Pfsub (fr1,fr2,fr3) -> instruction pp "Pfsub" [Freg fr1; Freg fr2; Freg fr3] | Pfsubs (fr1,fr2,fr3) -> instruction pp "Pfsubs" [Freg fr1; Freg fr2; Freg fr3] | Pfmadd (fr1,fr2,fr3,fr4) -> instruction pp "Pfmadd" [Freg fr1; Freg fr2; Freg fr3; Freg fr4] @@ -271,9 +245,9 @@ let pp_instructions pp ic = | Plhz (ir1,c,ir2) -> instruction pp "Plhz" [Ireg ir1; Constant c; Ireg ir2] | Plhzx (ir1,ir2,ir3) -> instruction pp "Plhzx" [Ireg ir1; Ireg ir2; Ireg ir3] | Pldi (ir,c) -> instruction pp "Pldi" [Ireg ir; Long c] (* FIXME Cint is too small, we need Clong *) - | Plmake _ (* Should not ppcur *) - | Pllo _ (* Should not ppcur *) - | Plhi _ -> assert false (* Should not ppcur *) + | Plmake _ (* Should not occur *) + | Pllo _ (* Should not occur *) + | Plhi _ -> assert false (* Should not occur *) | Plfi (fr,fc) -> instruction pp "Plfi" [Freg fr; Float64 fc] | Plfis (fr,fc) -> instruction pp "Plfis" [Freg fr; Float32 fc] | Plwz (ir1,c,ir2) @@ -285,7 +259,7 @@ let pp_instructions pp ic = | Plwbrx (ir1,ir2,ir3) -> instruction pp "Plwbrx" [Ireg ir1; Ireg ir2; Ireg ir3] | Pmbar c -> instruction pp "Pmbar" [Constant (Cint c)] | Pmfcr ir -> instruction pp "Pmfcr" [Ireg ir] - | Pmfcrbit (ir,crb) -> assert false (* Should not ppcur *) + | Pmfcrbit (ir,crb) -> assert false (* Should not occur *) | Pmflr ir -> instruction pp "Pmflr" [Ireg ir] | Pmr (ir1,ir2) -> instruction pp "Pmr" [Ireg ir1; Ireg ir2] | Pmtctr ir -> instruction pp "Pmtctr" [Ireg ir] @@ -396,108 +370,9 @@ let pp_instructions pp ic = | Pcfi_rel_offset _ -> assert false in (* Only debug relevant *) pp_jarray instruction pp ic -let pp_storage pp static = - pp_jstring pp (if static then "Static" else "Extern") - -let pp_section pp sec = - let pp_simple name = - pp_jsingle_object pp "Section Name" pp_jstring name - and pp_complex name init = - pp_jobject_start pp; - pp_jmember ~first:true pp "Section Name" pp_jstring name; - pp_jmember pp "Init" pp_jbool init; - pp_jobject_end pp in - match sec with - | Section_text -> pp_simple "Text" - | Section_data init -> pp_complex "Data" init - | Section_small_data init -> pp_complex "Small Data" init - | Section_const init -> pp_complex "Const" init - | Section_small_const init -> pp_complex "Small Const" init - | Section_string -> pp_simple "String" - | Section_literal -> pp_simple "Literal" - | Section_jumptable -> pp_simple "Jumptable" - | Section_user (s,w,e) -> - pp_jobject_start pp; - pp_jmember ~first:true pp "Section Name" pp_jstring s; - pp_jmember pp "Writable" pp_jbool w; - pp_jmember pp "Executable" pp_jbool e; - pp_jobject_end pp - | Section_debug_info _ - | Section_debug_abbrev - | Section_debug_line _ - | Section_debug_loc - | Section_debug_ranges - | 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" - | Some i -> fprintf pp "%d" i - - -let pp_fundef pp (name,f) = - let alignment = atom_alignof name - and inline = atom_is_inline name - and static = atom_is_static name - and c_section,l_section,j_section = match (atom_sections name) with [a;b;c] -> a,b,c | _ -> assert false in - pp_jobject_start pp; - pp_jmember ~first:true pp "Fun Name" pp_atom name; - pp_jmember pp "Fun Storage Class" pp_storage static; - pp_jmember pp "Fun Alignment" pp_int_opt alignment; - pp_jmember pp "Fun Section Code" pp_section c_section; - pp_jmember pp "Fun Section Literals" pp_section l_section; - pp_jmember pp "Fun Section Jumptable" pp_section j_section; - pp_jmember pp "Fun Inline" pp_jbool inline; - pp_jmember pp "Fun Code" pp_instructions f.fn_code; - pp_jobject_end pp - -let pp_init_data pp = function - | Init_int8 ic -> pp_jsingle_object pp "Init_int8" pp_int ic - | Init_int16 ic -> pp_jsingle_object pp "Init_int16" pp_int ic - | Init_int32 ic -> pp_jsingle_object pp "Init_int32" pp_int ic - | Init_int64 lc -> pp_jsingle_object pp "Init_int64" pp_int64 lc - | Init_float32 f -> pp_jsingle_object pp "Init_float32" pp_float32 f - | Init_float64 f -> pp_jsingle_object pp "Init_float64" pp_float64 f - | Init_space z -> pp_jsingle_object pp "Init_space" pp_z z - | Init_addrof (p,i) -> - let pp_addr_of pp (p,i) = - pp_jobject_start pp; - pp_jmember ~first:true pp "Addr" pp_atom p; - pp_jmember pp "Offset" pp_int i; - pp_jobject_end pp in - pp_jsingle_object pp "Init_addrof" pp_addr_of (p,i) - -let pp_vardef pp (name,v) = - let alignment = atom_alignof name - and static = atom_is_static name - and section = match (atom_sections name) with [s] -> s | _ -> assert false in(* Should only have one section *) - pp_jobject_start pp; - pp_jmember ~first:true pp "Var Name" pp_atom name; - pp_jmember pp "Var Readonly" pp_jbool v.gvar_readonly; - pp_jmember pp "Var Volatile" pp_jbool v.gvar_volatile; - pp_jmember pp "Var Storage Class" pp_storage static; - pp_jmember pp "Var Alignment" pp_int_opt alignment; - pp_jmember pp "Var Section" pp_section section; - pp_jmember pp "Var Init" (pp_jarray pp_init_data) v.gvar_init; - pp_jobject_end pp - let pp_program pp prog = reset_id (); - let prog_vars,prog_funs = List.fold_left (fun (vars,funs) (ident,def) -> - match def with - | Gfun (Internal f) -> - if not (atom_is_iso_inline_definition ident) then - vars,(ident,f)::funs - else - vars,funs - | Gvar v -> (ident,v)::vars,funs - | _ -> vars,funs) ([],[]) prog.prog_defs in - pp_jobject_start pp; - pp_jmember ~first:true pp "Global Variables" (pp_jarray pp_vardef) prog_vars; - pp_jmember pp "Functions" (pp_jarray pp_fundef) prog_funs; - pp_jobject_end pp + pp_program pp pp_instructions prog let pp_mnemonics pp = - let mnemonic_names = List.sort (String.compare) mnemonic_names in - let new_line pp () = pp_print_string pp "\n" in - pp_print_list ~pp_sep:new_line pp_print_string pp mnemonic_names + pp_mnemonics pp mnemonic_names -- cgit