diff options
author | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2010-05-26 11:59:09 +0000 |
---|---|---|
committer | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2010-05-26 11:59:09 +0000 |
commit | f0db487d8c8798b9899be03bf65bcb12524b9186 (patch) | |
tree | aa9c57edf987fed973dfebd0de067be7bcdb089c | |
parent | ee8556f646ac19726f012fff78fffdee39f5be63 (diff) |
Updated Caml parts to match new representation for global variables.
*/PrintAsm.ml: watch out for large stack frames in Pallocframe.
git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1349 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
-rw-r--r-- | arm/PrintAsm.ml | 21 | ||||
-rw-r--r-- | backend/CMparser.mly | 3 | ||||
-rw-r--r-- | cfrontend/C2Clight.ml | 16 | ||||
-rw-r--r-- | cfrontend/PrintCsyntax.ml | 23 | ||||
-rw-r--r-- | powerpc/PrintAsm.ml | 20 |
5 files changed, 57 insertions, 26 deletions
diff --git a/arm/PrintAsm.ml b/arm/PrintAsm.ml index 90b082b..3184d92 100644 --- a/arm/PrintAsm.ml +++ b/arm/PrintAsm.ml @@ -440,8 +440,17 @@ let print_instruction oc labels = function (* R12 = first int temporary is unused at this point, but this should be reflected in the proof *) fprintf oc " mov r12, sp\n"; - fprintf oc " sub sp, sp, #%ld\n" sz4; - fprintf oc " str r12, [sp, #%ld]\n" ofs; 3 + let ninstr = ref 0 in + List.iter + (fun mask -> + let b = Int32.logand sz4 mask in + if b <> 0l then begin + fprintf oc " sub sp, sp, #%ld\n" b; + incr ninstr + end) + [0xFF000000l; 0x00FF0000l; 0x0000FF00l; 0x000000FFl]; + fprintf oc " str r12, [sp, #%ld]\n" ofs; + 2 + !ninstr | Pfreeframe(lo, hi, ofs) -> fprintf oc " ldr sp, [sp, #%a]\n" coqint ofs; 1 | Plabel lbl -> @@ -583,11 +592,11 @@ let print_init_data oc name id = else List.iter (print_init oc) id -let print_var oc (Coq_pair(Coq_pair(name, init_data), _)) = - match init_data with +let print_var oc (Coq_pair(name, v)) = + match v.gvar_init with | [] -> () | _ -> - if C2Clight.atom_is_readonly name + if v.gvar_readonly then fprintf oc " .const\n" else fprintf oc " .data\n"; fprintf oc " .align 2\n"; @@ -595,7 +604,7 @@ let print_var oc (Coq_pair(Coq_pair(name, init_data), _)) = fprintf oc " .global %a\n" print_symb name; fprintf oc " .type %a, %%object\n" print_symb name; fprintf oc "%a:\n" print_symb name; - print_init_data oc name init_data + print_init_data oc name v.gvar_init let print_program oc p = extfuns := IdentSet.empty; diff --git a/backend/CMparser.mly b/backend/CMparser.mly index c83a46e..8420209 100644 --- a/backend/CMparser.mly +++ b/backend/CMparser.mly @@ -324,7 +324,8 @@ global_declarations: global_declaration: VAR STRINGLIT LBRACKET INTLIT RBRACKET - { Coq_pair(Coq_pair($2, [ Init_space (z_of_camlint $4) ]), ()) } + { Coq_pair($2, {gvar_info = (); gvar_init = [Init_space(z_of_camlint $4)]; + gvar_readonly = false; gvar_volatile = false}) } ; proc_list: diff --git a/cfrontend/C2Clight.ml b/cfrontend/C2Clight.ml index 5bdd727..2f61d53 100644 --- a/cfrontend/C2Clight.ml +++ b/cfrontend/C2Clight.ml @@ -69,7 +69,9 @@ let global_for_string s id = :: !init in add_char '\000'; for i = String.length s - 1 downto 0 do add_char s.[i] done; - Datatypes.Coq_pair(Datatypes.Coq_pair(id, !init), typeStringLiteral s) + Datatypes.Coq_pair(id, + {gvar_info = typeStringLiteral s; gvar_init = !init; + gvar_readonly = true; gvar_volatile = false}) let globals_for_strings globs = Hashtbl.fold @@ -654,6 +656,13 @@ let rec type_is_readonly env t = | C.TArray(t', _, _) -> type_is_readonly env t' | _ -> false +let rec type_is_volatile env t = + let a = Cutil.attributes_of_type env t in + if List.mem C.AConst a then true else + match Cutil.unroll env t with + | C.TArray(t', _, _) -> type_is_volatile env t' + | _ -> false + let convertGlobvar env (sto, id, ty, optinit as decl) = let id' = intern_string id.name in let ty' = convertTyp env ty in @@ -667,7 +676,10 @@ let convertGlobvar env (sto, id, ty, optinit as decl) = Sections.define_variable id' (match Cutil.sizeof env ty with Some sz -> sz | None -> max_int) (type_is_readonly env ty); - Datatypes.Coq_pair(Datatypes.Coq_pair(id', init'), ty') + Datatypes.Coq_pair(id', + {gvar_info = ty'; gvar_init = init'; + gvar_readonly = type_is_readonly env ty; + gvar_volatile = type_is_volatile env ty}) (** Convert a list of global declarations. Result is a pair [(funs, vars)] where [funs] are diff --git a/cfrontend/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml index d678831..3b5dbc5 100644 --- a/cfrontend/PrintCsyntax.ml +++ b/cfrontend/PrintCsyntax.ml @@ -376,24 +376,27 @@ let print_init p = function let re_string_literal = Str.regexp "__stringlit_[0-9]+" -let print_globvar p (Coq_pair(Coq_pair(id, init), ty)) = - match init with +let print_globvar p (Coq_pair(id, v)) = + let name1 = extern_atom id in + let name2 = if v.gvar_readonly then "const " ^ name1 else name1 in + let name3 = if v.gvar_volatile then "volatile " ^ name2 else name2 in + match v.gvar_init with | [] -> fprintf p "extern %s;@ @ " - (name_cdecl (extern_atom id) ty) + (name_cdecl name3 v.gvar_info) | [Init_space _] -> fprintf p "%s;@ @ " - (name_cdecl (extern_atom id) ty) + (name_cdecl name3 v.gvar_info) | _ -> fprintf p "@[<hov 2>%s = " - (name_cdecl (extern_atom id) ty); + (name_cdecl name3 v.gvar_info); if Str.string_match re_string_literal (extern_atom id) 0 - && List.for_all (function Init_int8 _ -> true | _ -> false) init + && List.for_all (function Init_int8 _ -> true | _ -> false) v.gvar_init then - fprintf p "\"%s\"" (string_of_init (chop_last_nul init)) + fprintf p "\"%s\"" (string_of_init (chop_last_nul v.gvar_init)) else begin fprintf p "{@ "; - List.iter (print_init p) init; + List.iter (print_init p) v.gvar_init; fprintf p "}" end; fprintf p ";@]@ @ " @@ -474,8 +477,8 @@ let collect_fundef (Coq_pair(id, fd)) = | External(_, args, res) -> collect_type_list args; collect_type res | Internal f -> collect_function f -let collect_globvar (Coq_pair(Coq_pair(id, init), ty)) = - collect_type ty +let collect_globvar (Coq_pair(id, v)) = + collect_type v.gvar_info let collect_program p = List.iter collect_globvar p.prog_vars; diff --git a/powerpc/PrintAsm.ml b/powerpc/PrintAsm.ml index 1fdb1a9..6ef0083 100644 --- a/powerpc/PrintAsm.ml +++ b/powerpc/PrintAsm.ml @@ -401,10 +401,16 @@ let print_instruction oc labels = function and hi = camlint_of_coqint hi and ofs = camlint_of_coqint ofs in let sz = Int32.sub hi lo in - (* Keep stack 16-aligned *) - let sz16 = Int32.logand (Int32.add sz 15l) 0xFFFF_FFF0l in assert (ofs = 0l); - fprintf oc " stwu %a, %ld(%a)\n" ireg GPR1 (Int32.neg sz16) ireg GPR1 + (* Keep stack 16-aligned *) + let adj = Int32.neg (Int32.logand (Int32.add sz 15l) 0xFFFF_FFF0l) in + if adj >= -0x8000l then + fprintf oc " stwu %a, %ld(%a)\n" ireg GPR1 adj ireg GPR1 + else begin + fprintf oc " addis %a, 0, %ld\n" ireg GPR12 (Int32.shift_right_logical adj 16); + fprintf oc " ori %a, %a, %ld\n" ireg GPR12 ireg GPR12 (Int32.logand adj 0xFFFFl); + fprintf oc " stwux %a, %a, %a\n" ireg GPR1 ireg GPR1 ireg GPR12 + end | Pand_(r1, r2, r3) -> fprintf oc " and. %a, %a, %a\n" ireg r1 ireg r2 ireg r3 | Pandc(r1, r2, r3) -> @@ -889,12 +895,12 @@ let print_init_data oc name id = else List.iter (print_init oc) id -let print_var oc (Coq_pair(Coq_pair(name, init_data), _)) = - match init_data with +let print_var oc (Coq_pair(name, v)) = + match v.gvar_init with | [] -> () | _ -> let init = - match init_data with [Init_space _] -> false | _ -> true in + match v.gvar_init with [Init_space _] -> false | _ -> true in let sec = Sections.section_for_variable name init and align = @@ -907,7 +913,7 @@ let print_var oc (Coq_pair(Coq_pair(name, init_data), _)) = if not (C2Clight.atom_is_static name) then fprintf oc " .globl %a\n" symbol name; fprintf oc "%a:\n" symbol name; - print_init_data oc name init_data; + print_init_data oc name v.gvar_init; if target <> MacOS then begin fprintf oc " .type %a, @object\n" symbol name; fprintf oc " .size %a, . - %a\n" symbol name symbol name |