From 2f643e4419e8237c63d6823720da8100da9c8b11 Mon Sep 17 00:00:00 2001
From: xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>
Date: Wed, 23 Apr 2014 09:18:51 +0000
Subject: Clean-up pass on C types: - Ctypes: add useful functions on
 attributes; remove attrs in typeconv     (because attributes are meaningless
 on r-values) - C2C: fixed missing or redundant Evalof - Cop: ignore
 attributes in ptr + int and ptr - int (meaningless on r-values);     add
 sanity check between typeconv/classify_binarith and the C99 standard. -
 cparser: fixed several cases where incorrect type annotations were put     on
 expressions.

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2457 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
---
 cfrontend/C2C.ml | 39 +++++++++++++++++----------------------
 1 file changed, 17 insertions(+), 22 deletions(-)

(limited to 'cfrontend/C2C.ml')

diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml
index f767372..8799bc0 100644
--- a/cfrontend/C2C.ml
+++ b/cfrontend/C2C.ml
@@ -200,9 +200,10 @@ a constant)"; Integers.Int.one in
 (** ** Translation of [va_arg] for variadic functions. *)
 
 let va_list_ptr e =
-  if CBuiltins.va_list_scalar
-  then Eaddrof(e, Tpointer(typeof e, noattr))
-  else e
+  if not CBuiltins.va_list_scalar then e else
+    match e with
+    | Evalof(e', _) -> Eaddrof(e', Tpointer(typeof e, noattr))
+    | _             -> error "bad use of a va_list object"; e
 
 let make_builtin_va_arg env ty e =
   let (helper, ty_ret) =
@@ -215,15 +216,14 @@ let make_builtin_va_arg env ty e =
         ("__compcert_va_float64", Tfloat(F64, noattr))
     | _ ->
         unsupported "va_arg at this type";
-        ("", Tvoid)
-  in
-    Ecast 
-      (Ecall(Evar (intern_string helper, 
-                   Tfunction(Tcons(Tpointer(Tvoid, noattr), Tnil), ty_ret, 
-                             cc_default)),
-             Econs(va_list_ptr e, Enil),
-             ty_ret),
-       ty)
+        ("", Tvoid) in
+  let ty_fun =
+    Tfunction(Tcons(Tpointer(Tvoid, noattr), Tnil), ty_ret, cc_default) in
+  Ecast 
+    (Ecall(Evalof(Evar(intern_string helper, ty_fun), ty_fun),
+           Econs(va_list_ptr e, Enil),
+           ty_ret),
+     ty)
 
 (** ** Translation functions *)
 
@@ -338,7 +338,7 @@ let convertTyp env t =
     | C.TStruct(id, a) ->
         let a' = convertAttr a in
         begin try
-          mergeTypAttr (Hashtbl.find compositeCache id) a'
+          merge_attributes (Hashtbl.find compositeCache id) a'
         with Not_found ->
           let flds =
             try
@@ -350,7 +350,7 @@ let convertTyp env t =
     | C.TUnion(id, a) ->
         let a' = convertAttr a in
         begin try
-          mergeTypAttr (Hashtbl.find compositeCache id) a'
+          merge_attributes (Hashtbl.find compositeCache id) a'
         with Not_found ->
           let flds =
             try
@@ -379,12 +379,6 @@ let convertTyp env t =
 
   in convertTyp [] t
 
-(*
-let rec convertTypList env = function
-  | [] -> Tnil
-  | t1 :: tl -> Tcons(convertTyp env t1, convertTypList env tl)
-*)
-
 let rec convertTypArgs env tl el =
   match tl, el with
   | _, [] -> Tnil
@@ -1062,10 +1056,11 @@ let convertProgram p =
   try
     let gl1 = convertGlobdecls (translEnv Env.empty p) [] (cleanupGlobals p) in
     let gl2 = globals_for_strings gl1 in
+    let p' = { AST.prog_defs = gl2;
+                AST.prog_main = intern_string "main" } in
     if !numErrors > 0
     then None
-    else Some { AST.prog_defs = gl2;
-                AST.prog_main = intern_string "main" }
+    else Some p'
   with Env.Error msg ->
     error (Env.error_message msg); None
 
-- 
cgit v1.2.3