From d1104c07f7d79ac721c29774651ae512aacbcf3f Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Thu, 1 Jan 2015 12:07:09 +0100 Subject: Translation of wide string literals. Closes PR#13. Also: give string literals type unsigned char [] or signed char [] depending on the machine configuration. (Instead of unsigned char [] before.) --- cfrontend/C2C.ml | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 57 insertions(+), 6 deletions(-) (limited to 'cfrontend/C2C.ml') diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 4d5d6c07..f3487acc 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -201,7 +201,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 @@ -221,7 +222,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 @@ -232,10 +234,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 *) @@ -555,7 +604,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)) -> Eval(Vint(convertInt i), ty) | C.ESizeof ty1 -> @@ -1130,6 +1180,7 @@ let convertProgram p = stringNum := 0; Hashtbl.clear decl_atom; Hashtbl.clear stringTable; + Hashtbl.clear wstringTable; Hashtbl.clear compositeCache; let p = Builtins.declarations() @ p in try -- cgit From ce8f29b4b2502ce8c4da08dfea8796c49e2bc386 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Fri, 2 Jan 2015 13:15:13 +0100 Subject: PR#15: vararg functions are not eligible for inlining. --- cfrontend/C2C.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'cfrontend/C2C.ml') diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index f3487acc..f9501439 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -954,7 +954,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; -- cgit From 05f1cccccad587234c526225aa04aff041490051 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 6 Jan 2015 15:16:13 +0100 Subject: PR#19: there is no reason to reject an empty "switch" statement. --- cfrontend/C2C.ml | 2 -- 1 file changed, 2 deletions(-) (limited to 'cfrontend/C2C.ml') diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index f9501439..118b6d2d 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -875,8 +875,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 -- cgit