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

5 files changed, 57 insertions, 26 deletions

diff --git a/arm/PrintAsm.ml b/arm/PrintAsm.ml
index 90b082be..3184d92f 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 c83a46e5..84202096 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 5bdd7273..2f61d53c 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 d6788319..3b5dbc53 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 1fdb1a91..6ef0083e 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