diff options
| -rw-r--r-- | Changelog | 4 | ||||
| -rw-r--r-- | cfrontend/C2C.ml | 28 | ||||
| -rw-r--r-- | driver/Clflags.ml | 1 | ||||
| -rw-r--r-- | driver/Driver.ml | 8 |
4 files changed, 31 insertions, 10 deletions
@@ -14,7 +14,9 @@ the last case. - Revised parsing of command-line options, more GCC-like. - Simpler and more robust handling of calls to variadic functions. - +- More tolerance for functions declared without a prototype + (option -funprototyped, on by default). + Release 2.1, 2013-10-28 ======================= diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 16c85ed..ff12823 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -268,7 +268,7 @@ let convertTyp env t = if Cutil.is_composite_type env tres then unsupported "return type is a struct or union (consider adding option -fstruct-return)"; Tfunction(begin match targs with - | None -> (*warning "un-prototyped function type";*) Tnil + | None -> Tnil | Some tl -> convertParams seen tl end, convertTyp seen tres, @@ -341,6 +341,12 @@ let cacheCompositeDef env su id attr flds = | C.Union -> C.TUnion(id, attr) in Hashtbl.add compositeCache id (convertTyp env ty) +let rec projFunType env ty = + match Cutil.unroll env ty with + | TFun(res, args, vararg, attr) -> Some(res, args, vararg) + | TPtr(ty', attr) -> projFunType env ty' + | _ -> None + let string_of_type ty = let b = Buffer.create 20 in let fb = Format.formatter_of_buffer b in @@ -561,6 +567,15 @@ let rec convertExpr env e = | C.ECall(fn, args) -> if not (supported_return_type env e.etyp) then unsupported ("function returning a result of type " ^ string_of_type e.etyp ^ " (consider adding option -fstruct-return)"); + begin match projFunType env fn.etyp with + | None -> + error "wrong type for function part of a call" + | Some(tres, targs, va) -> + if targs = None && not !Clflags.option_funprototyped then + unsupported "call to unprototyped function (consider adding option -funprototyped)"; + if va && not !Clflags.option_fvararg_calls then + unsupported "call to variable-argument function (consider adding option -fvararg-calls)" + end; Ecall(convertExpr env fn, convertExprList env args, ty) and convertLvalue env e = @@ -719,6 +734,8 @@ and convertSwitch ploc env = function let convertFundef loc env fd = if Cutil.is_composite_type env fd.fd_ret then unsupported "function returning a struct or union (consider adding option -fstruct-return)"; + if fd.fd_vararg && not !Clflags.option_fvararg_calls then + unsupported "variable-argument function (consider adding option -fvararg-calls)"; let ret = convertTyp env fd.fd_ret in let params = @@ -852,14 +869,13 @@ let rec convertGlobdecls env res gl = updateLoc g.gloc; match g.gdesc with | C.Gdecl((sto, id, ty, optinit) as d) -> - (* Prototyped functions become external declarations. + (* Functions become external declarations. Other types become variable declarations. *) begin match Cutil.unroll env ty with - | TFun(_, Some _, _, _) -> + | TFun(tres, targs, va, a) -> + if targs = None then + warning ("'" ^ id.name ^ "' is declared without a function prototype"); convertGlobdecls env (convertFundecl env d :: res) gl' - | TFun(_, None, _, _) -> - unsupported ("'" ^ id.name ^ "' is declared without a function prototype"); - convertGlobdecls env res gl' | _ -> convertGlobdecls env (convertGlobvar g.gloc env d :: res) gl' end diff --git a/driver/Clflags.ml b/driver/Clflags.ml index 4f41bf6..4d6e3f6 100644 --- a/driver/Clflags.ml +++ b/driver/Clflags.ml @@ -19,6 +19,7 @@ let option_flongdouble = ref false let option_fstruct_return = ref false let option_fbitfields = ref false let option_fvararg_calls = ref true +let option_funprototyped = ref true let option_fpacked_structs = ref false let option_ffpu = ref true let option_ffloatconstprop = ref 2 diff --git a/driver/Driver.ml b/driver/Driver.ml index 44037b2..d5b99d4 100644 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -399,7 +399,8 @@ Language support options (use -fno-<opt> to turn off -f<opt>) : -fbitfields Emulate bit fields in structs [off] -flongdouble Treat 'long double' as 'double' [off] -fstruct-return Emulate returning structs and unions by value [off] - -fvararg-calls Emulate calls to variable-argument functions [on] + -fvararg-calls Support calls to variable-argument functions [on] + -funprototyped Support calls to old-style functions without prototypes [on] -fpacked-structs Emulate packed structs [off] -finline-asm Support inline 'asm' statements [off] -fall Activate all language support options above @@ -448,8 +449,8 @@ Interpreter mode: let language_support_options = [ option_fbitfields; option_flongdouble; - option_fstruct_return; option_fvararg_calls; option_fpacked_structs; - option_finline_asm + option_fstruct_return; option_fvararg_calls; option_funprototyped; + option_fpacked_structs; option_finline_asm ] let num_source_files = ref 0 @@ -526,6 +527,7 @@ let cmdline_actions = @ f_opt "struct-return" option_fstruct_return @ f_opt "bitfields" option_fbitfields @ f_opt "vararg-calls" option_fvararg_calls + @ f_opt "unprototyped" option_funprototyped @ f_opt "packed-structs" option_fpacked_structs @ f_opt "inline-asm" option_finline_asm @ f_opt "fpu" option_ffpu |