From 6a8503115a9952dc793d15d0ea9033b68b30aae6 Mon Sep 17 00:00:00 2001 From: xleroy Date: Sun, 7 Mar 2010 16:59:26 +0000 Subject: Revised treatment of builtins git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1283 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e --- cparser/Builtins.ml | 260 ++++++---------------------------------------------- 1 file changed, 30 insertions(+), 230 deletions(-) (limited to 'cparser/Builtins.ml') diff --git a/cparser/Builtins.ml b/cparser/Builtins.ml index eb10314..020452f 100644 --- a/cparser/Builtins.ml +++ b/cparser/Builtins.ml @@ -18,233 +18,33 @@ open C open Cutil -(* Code adapted from CIL *) - -let voidType = TVoid [] -let charType = TInt(IChar, []) -let intType = TInt(IInt, []) -let uintType = TInt(IUInt, []) -let longType = TInt(ILong, []) -let ulongType = TInt(IULong, []) -let ulongLongType = TInt(IULongLong, []) -let floatType = TFloat(FFloat, []) -let doubleType = TFloat(FDouble, []) -let longDoubleType = TFloat (FLongDouble, []) -let voidPtrType = TPtr(TVoid [], []) -let voidConstPtrType = TPtr(TVoid [AConst], []) -let charPtrType = TPtr(TInt(IChar, []), []) -let charConstPtrType = TPtr(TInt(IChar, [AConst]), []) -let intPtrType = TPtr(TInt(IInt, []), []) -let sizeType = TInt(size_t_ikind, []) - -let gcc_builtin_types = [ - "__builtin_va_list", voidPtrType -] - -let gcc_builtin_values = [ - "__builtin___fprintf_chk", (intType, [ voidPtrType; intType; charConstPtrType ], true) (* first argument is really FILE*, not void*, but we don't want to build in the definition for FILE *); - "__builtin___memcpy_chk", (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType; sizeType ], false); - "__builtin___memmove_chk", (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType; sizeType ], false); - "__builtin___mempcpy_chk", (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType; sizeType ], false); - "__builtin___memset_chk", (voidPtrType, [ voidPtrType; intType; sizeType; sizeType ], false); - "__builtin___printf_chk", (intType, [ intType; charConstPtrType ], true); - "__builtin___snprintf_chk", (intType, [ charPtrType; sizeType; intType; sizeType; charConstPtrType ], true); - "__builtin___sprintf_chk", (intType, [ charPtrType; intType; sizeType; charConstPtrType ], true); - "__builtin___stpcpy_chk", (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false); - "__builtin___strcat_chk", (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false); - "__builtin___strcpy_chk", (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false); - "__builtin___strncat_chk", (charPtrType, [ charPtrType; charConstPtrType; sizeType; sizeType ], false); - "__builtin___strncpy_chk", (charPtrType, [ charPtrType; charConstPtrType; sizeType; sizeType ], false); - "__builtin___vfprintf_chk", (intType, [ voidPtrType; intType; charConstPtrType; voidPtrType ], false) (* first argument is really FILE*, not void*, but we don't want to build in the definition for FILE *); - "__builtin___vprintf_chk", (intType, [ intType; charConstPtrType; voidPtrType ], false); - "__builtin___vsnprintf_chk", (intType, [ charPtrType; sizeType; intType; sizeType; charConstPtrType; voidPtrType ], false); - "__builtin___vsprintf_chk", (intType, [ charPtrType; intType; sizeType; charConstPtrType; voidPtrType ], false); - - "__builtin_acos", (doubleType, [ doubleType ], false); - "__builtin_acosf", (floatType, [ floatType ], false); - "__builtin_acosl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_alloca", (voidPtrType, [ uintType ], false); - - "__builtin_asin", (doubleType, [ doubleType ], false); - "__builtin_asinf", (floatType, [ floatType ], false); - "__builtin_asinl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_atan", (doubleType, [ doubleType ], false); - "__builtin_atanf", (floatType, [ floatType ], false); - "__builtin_atanl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_atan2", (doubleType, [ doubleType; doubleType ], false); - "__builtin_atan2f", (floatType, [ floatType; floatType ], false); - "__builtin_atan2l", (longDoubleType, [ longDoubleType; - longDoubleType ], false); - - "__builtin_ceil", (doubleType, [ doubleType ], false); - "__builtin_ceilf", (floatType, [ floatType ], false); - "__builtin_ceill", (longDoubleType, [ longDoubleType ], false); - - "__builtin_cos", (doubleType, [ doubleType ], false); - "__builtin_cosf", (floatType, [ floatType ], false); - "__builtin_cosl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_cosh", (doubleType, [ doubleType ], false); - "__builtin_coshf", (floatType, [ floatType ], false); - "__builtin_coshl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_clz", (intType, [ uintType ], false); - "__builtin_clzl", (intType, [ ulongType ], false); - "__builtin_clzll", (intType, [ ulongLongType ], false); - "__builtin_constant_p", (intType, [ intType ], false); - "__builtin_ctz", (intType, [ uintType ], false); - "__builtin_ctzl", (intType, [ ulongType ], false); - "__builtin_ctzll", (intType, [ ulongLongType ], false); - - "__builtin_exp", (doubleType, [ doubleType ], false); - "__builtin_expf", (floatType, [ floatType ], false); - "__builtin_expl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_expect", (longType, [ longType; longType ], false); - - "__builtin_fabs", (doubleType, [ doubleType ], false); - "__builtin_fabsf", (floatType, [ floatType ], false); - "__builtin_fabsl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_ffs", (intType, [ uintType ], false); - "__builtin_ffsl", (intType, [ ulongType ], false); - "__builtin_ffsll", (intType, [ ulongLongType ], false); - "__builtin_frame_address", (voidPtrType, [ uintType ], false); - - "__builtin_floor", (doubleType, [ doubleType ], false); - "__builtin_floorf", (floatType, [ floatType ], false); - "__builtin_floorl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_huge_val", (doubleType, [], false); - "__builtin_huge_valf", (floatType, [], false); - "__builtin_huge_vall", (longDoubleType, [], false); - "__builtin_inf", (doubleType, [], false); - "__builtin_inff", (floatType, [], false); - "__builtin_infl", (longDoubleType, [], false); - "__builtin_memcpy", (voidPtrType, [ voidPtrType; voidConstPtrType; uintType ], false); - "__builtin_mempcpy", (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType ], false); - - "__builtin_fmod", (doubleType, [ doubleType ], false); - "__builtin_fmodf", (floatType, [ floatType ], false); - "__builtin_fmodl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_frexp", (doubleType, [ doubleType; intPtrType ], false); - "__builtin_frexpf", (floatType, [ floatType; intPtrType ], false); - "__builtin_frexpl", (longDoubleType, [ longDoubleType; - intPtrType ], false); - - "__builtin_ldexp", (doubleType, [ doubleType; intType ], false); - "__builtin_ldexpf", (floatType, [ floatType; intType ], false); - "__builtin_ldexpl", (longDoubleType, [ longDoubleType; - intType ], false); - - "__builtin_log", (doubleType, [ doubleType ], false); - "__builtin_logf", (floatType, [ floatType ], false); - "__builtin_logl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_log10", (doubleType, [ doubleType ], false); - "__builtin_log10f", (floatType, [ floatType ], false); - "__builtin_log10l", (longDoubleType, [ longDoubleType ], false); - - "__builtin_modff", (floatType, [ floatType; - TPtr(floatType,[]) ], false); - "__builtin_modfl", (longDoubleType, [ longDoubleType; - TPtr(longDoubleType, []) ], - false); - - "__builtin_nan", (doubleType, [ charConstPtrType ], false); - "__builtin_nanf", (floatType, [ charConstPtrType ], false); - "__builtin_nanl", (longDoubleType, [ charConstPtrType ], false); - "__builtin_nans", (doubleType, [ charConstPtrType ], false); - "__builtin_nansf", (floatType, [ charConstPtrType ], false); - "__builtin_nansl", (longDoubleType, [ charConstPtrType ], false); - "__builtin_next_arg", (voidPtrType, [], false); - "__builtin_object_size", (sizeType, [ voidPtrType; intType ], false); - - "__builtin_parity", (intType, [ uintType ], false); - "__builtin_parityl", (intType, [ ulongType ], false); - "__builtin_parityll", (intType, [ ulongLongType ], false); - - "__builtin_popcount", (intType, [ uintType ], false); - "__builtin_popcountl", (intType, [ ulongType ], false); - "__builtin_popcountll", (intType, [ ulongLongType ], false); - - "__builtin_powi", (doubleType, [ doubleType; intType ], false); - "__builtin_powif", (floatType, [ floatType; intType ], false); - "__builtin_powil", (longDoubleType, [ longDoubleType; intType ], false); - "__builtin_prefetch", (voidType, [ voidConstPtrType ], true); - "__builtin_return", (voidType, [ voidConstPtrType ], false); - "__builtin_return_address", (voidPtrType, [ uintType ], false); - - "__builtin_sin", (doubleType, [ doubleType ], false); - "__builtin_sinf", (floatType, [ floatType ], false); - "__builtin_sinl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_sinh", (doubleType, [ doubleType ], false); - "__builtin_sinhf", (floatType, [ floatType ], false); - "__builtin_sinhl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_sqrt", (doubleType, [ doubleType ], false); - "__builtin_sqrtf", (floatType, [ floatType ], false); - "__builtin_sqrtl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_stpcpy", (charPtrType, [ charPtrType; charConstPtrType ], false); - "__builtin_strchr", (charPtrType, [ charPtrType; charType ], false); - "__builtin_strcmp", (intType, [ charConstPtrType; charConstPtrType ], false); - "__builtin_strcpy", (charPtrType, [ charPtrType; charConstPtrType ], false); - "__builtin_strcspn", (uintType, [ charConstPtrType; charConstPtrType ], false); - "__builtin_strncat", (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false); - "__builtin_strncmp", (intType, [ charConstPtrType; charConstPtrType; sizeType ], false); - "__builtin_strncpy", (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false); - "__builtin_strspn", (intType, [ charConstPtrType; charConstPtrType ], false); - "__builtin_strpbrk", (charPtrType, [ charConstPtrType; charConstPtrType ], false); - (* When we parse builtin_types_compatible_p, we change its interface *) - "__builtin_types_compatible_p", - (intType, [ uintType; (* Sizeof the type *) - uintType (* Sizeof the type *) ], - false); - "__builtin_tan", (doubleType, [ doubleType ], false); - "__builtin_tanf", (floatType, [ floatType ], false); - "__builtin_tanl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_tanh", (doubleType, [ doubleType ], false); - "__builtin_tanhf", (floatType, [ floatType ], false); - "__builtin_tanhl", (longDoubleType, [ longDoubleType ], false); - - "__builtin_va_end", (voidType, [ voidPtrType ], false); - "__builtin_varargs_start", - (voidType, [ voidPtrType ], false); - (* When we elaborate builtin_stdarg_start/builtin_va_start, - second argument is passed by address *) - "__builtin_va_start", (voidType, [ voidPtrType; voidPtrType ], false); - "__builtin_stdarg_start", (voidType, [ voidPtrType ], false); - (* When we parse builtin_va_arg, type argument becomes sizeof type *) - "__builtin_va_arg", (voidType, [ voidPtrType; sizeType ], false); - "__builtin_va_copy", (voidType, [ voidPtrType; - voidPtrType ], - false) -] - -let (builtin_env, builtin_idents) = - let env = ref Env.empty - and ids = ref [] in - List.iter - (fun (s, ty) -> - let (id, env') = Env.enter_typedef !env s ty in - env := env'; - ids := id :: !ids) - gcc_builtin_types; - List.iter - (fun (s, (res, args, va)) -> - let ty = - TFun(res, - Some (List.map (fun ty -> (Env.fresh_ident "", ty)) args), - va, []) in - let (id, env') = Env.enter_ident !env s Storage_extern ty in - env := env'; - ids := id :: !ids) - gcc_builtin_values; - (!env, List.rev !ids) +let env = ref Env.empty +let idents = ref [] + +let environment () = !env +let identifiers () = !idents + +let add_typedef (s, ty) = + let (id, env') = Env.enter_typedef !env s ty in + env := env'; + idents := id :: !idents + +let add_function (s, (res, args, va)) = + let ty = + TFun(res, + Some (List.map (fun ty -> (Env.fresh_ident "", ty)) args), + va, []) in + let (id, env') = Env.enter_ident !env s Storage_extern ty in + env := env'; + idents := id :: !idents + +type t = { + typedefs: (string * C.typ) list; + functions: (string * (C.typ * C.typ list * bool)) list +} + +let set blt = + env := Env.empty; + idents := []; + List.iter add_typedef blt.typedefs; + List.iter add_function blt.functions -- cgit v1.2.3