diff options
author | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2014-04-23 09:18:51 +0000 |
---|---|---|
committer | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2014-04-23 09:18:51 +0000 |
commit | 2f643e4419e8237c63d6823720da8100da9c8b11 (patch) | |
tree | 8a243fe800541597beffe8fec152f20d6bada549 /cfrontend/C2C.ml | |
parent | 214ab56c02860a9c472f701b601cbf6c9cf5fd69 (diff) |
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
Diffstat (limited to 'cfrontend/C2C.ml')
-rw-r--r-- | cfrontend/C2C.ml | 39 |
1 files changed, 17 insertions, 22 deletions
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 |