diff options
Diffstat (limited to 'cfrontend/C2C.ml')
| -rw-r--r-- | cfrontend/C2C.ml | 126 |
1 files changed, 114 insertions, 12 deletions
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index ef621a7c..0ccf569b 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -147,8 +147,8 @@ let builtins_generic = { (TVoid [], [TPtr(TVoid [], []); TPtr(TVoid [AConst], []); - TInt(Cutil.size_t_ikind, []); - TInt(Cutil.size_t_ikind, [])], + TInt(IUInt, []); + TInt(IUInt, [])], false); (* Annotations *) "__builtin_annot", @@ -198,7 +198,60 @@ let builtins_generic = { "__compcert_va_float64", (TFloat(FDouble, []), [TPtr(TVoid [], [])], - false) + false); + (* Helper functions for int64 arithmetic *) + "__i64_dtos", + (TInt(ILongLong, []), + [TFloat(FDouble, [])], + false); + "__i64_dtou", + (TInt(IULongLong, []), + [TFloat(FDouble, [])], + false); + "__i64_stod", + (TFloat(FDouble, []), + [TInt(ILongLong, [])], + false); + "__i64_utod", + (TFloat(FDouble, []), + [TInt(IULongLong, [])], + false); + "__i64_stof", + (TFloat(FFloat, []), + [TInt(ILongLong, [])], + false); + "__i64_utof", + (TFloat(FFloat, []), + [TInt(IULongLong, [])], + false); + "__i64_sdiv", + (TInt(ILongLong, []), + [TInt(ILongLong, []); TInt(ILongLong, [])], + false); + "__i64_udiv", + (TInt(IULongLong, []), + [TInt(IULongLong, []); TInt(IULongLong, [])], + false); + "__i64_smod", + (TInt(ILongLong, []), + [TInt(ILongLong, []); TInt(ILongLong, [])], + false); + "__i64_umod", + (TInt(IULongLong, []), + [TInt(IULongLong, []); TInt(IULongLong, [])], + false); + "__i64_shl", + (TInt(ILongLong, []), + [TInt(ILongLong, []); TInt(IInt, [])], + false); + "__i64_shr", + (TInt(IULongLong, []), + [TInt(IULongLong, []); TInt(IInt, [])], + false); + "__i64_sar", + (TInt(ILongLong, []), + [TInt(ILongLong, []); TInt(IInt, [])], + false) ] } @@ -211,7 +264,8 @@ let builtins = (** ** Functions used to handle string literals *) let stringNum = ref 0 (* number of next global for string literals *) -let stringTable = Hashtbl.create 47 +let stringTable : (string, AST.ident) Hashtbl.t = Hashtbl.create 47 +let wstringTable : (int64 list, AST.ident) Hashtbl.t = Hashtbl.create 47 let name_for_string_literal env s = try @@ -231,7 +285,8 @@ let name_for_string_literal env s = id let typeStringLiteral s = - Tarray(Tint(I8, Unsigned, noattr), Z.of_uint (String.length s + 1), noattr) + let sg = if Machine.((!config).char_signed) then Signed else Unsigned in + Tarray(Tint(I8, sg, noattr), Z.of_uint (String.length s + 1), noattr) let global_for_string s id = let init = ref [] in @@ -242,10 +297,57 @@ let global_for_string s id = (id, Gvar {gvar_info = typeStringLiteral s; gvar_init = !init; gvar_readonly = true; gvar_volatile = false}) +let name_for_wide_string_literal env s = + try + Hashtbl.find wstringTable s + with Not_found -> + incr stringNum; + let name = Printf.sprintf "__stringlit_%d" !stringNum in + let id = intern_string name in + Hashtbl.add decl_atom id + { a_storage = C.Storage_static; + a_alignment = Some Machine.((!config).sizeof_wchar); + a_sections = [Sections.for_stringlit()]; + a_access = Sections.Access_default; + a_inline = false; + a_loc = Cutil.no_loc }; + Hashtbl.add wstringTable s id; + id + +let typeWideStringLiteral s = + let sz = + match Machine.((!config).sizeof_wchar) with + | 2 -> I16 + | 4 -> I32 + | _ -> assert false in + let sg = + if Machine.((!config).wchar_signed) then Signed else Unsigned in + Tarray(Tint(sz, sg, noattr), Z.of_uint (List.length s + 1), noattr) + +let global_for_wide_string s id = + let init = ref [] in + let init_of_char = + match Machine.((!config).sizeof_wchar) with + | 2 -> (fun z -> AST.Init_int16 z) + | 4 -> (fun z -> AST.Init_int32 z) + | _ -> assert false in + let add_char c = + init := init_of_char(Z.of_uint64 c) :: !init in + List.iter add_char s; + add_char 0L; + (id, Gvar {gvar_info = typeWideStringLiteral s; gvar_init = List.rev !init; + gvar_readonly = true; gvar_volatile = false}) + let globals_for_strings globs = - Hashtbl.fold - (fun s id l -> global_for_string s id :: l) - stringTable globs + let globs1 = + Hashtbl.fold + (fun s id l -> global_for_wide_string s id :: l) + wstringTable globs in + let globs2 = + Hashtbl.fold + (fun s id l -> global_for_string s id :: l) + stringTable globs1 in + globs2 (** ** Handling of inlined memcpy functions *) @@ -509,7 +611,8 @@ let rec convertExpr env e = let ty = typeStringLiteral s in Evalof(Evar(name_for_string_literal env s, ty), ty) | C.EConst(C.CWStr s) -> - unsupported "wide string literal"; ezero + let ty = typeWideStringLiteral s in + Evalof(Evar(name_for_wide_string_literal env s, ty), ty) | C.EConst(C.CEnum(id, i)) -> Ctyping.econst_int (convertInt i) Signed | C.ESizeof ty1 -> @@ -789,8 +892,6 @@ let rec convertStmt ploc env s = Scontinue | C.Sswitch(e, s1) -> let (init, cases) = groupSwitch (flattenSwitch s1) in - if cases = [] then - unsupported "ill-formed 'switch' statement"; if init.sdesc <> C.Sskip then warning "ignored code at beginning of 'switch'"; let te = convertExpr env e in @@ -869,7 +970,7 @@ let convertFundef loc env fd = a_alignment = None; a_sections = Sections.for_function env id' fd.fd_ret; a_access = Sections.Access_default; - a_inline = fd.fd_inline; + a_inline = fd.fd_inline && not fd.fd_vararg; (* PR#15 *) a_loc = loc }; (id', Gfun(Internal {fn_return = ret; fn_callconv = convertCallconv fd.fd_vararg fd.fd_attrib; @@ -1089,6 +1190,7 @@ let convertProgram p = stringNum := 0; Hashtbl.clear decl_atom; Hashtbl.clear stringTable; + Hashtbl.clear wstringTable; let p = cleanupGlobals (Builtins.declarations() @ p) in try let env = translEnv Env.empty p in |