Browse Source

fixed hl/c generation with optional libs, hashes collisions and some thread primitives (close #10509)

Nicolas Cannasse 3 years ago
parent
commit
beb191a21b
1 changed files with 27 additions and 6 deletions
  1. 27 6
      src/generators/hl2c.ml

+ 27 - 6
src/generators/hl2c.ml

@@ -1096,6 +1096,9 @@ let valid_ident =
 	let e = Str.regexp "[^A-Za-z0-9_]+" in
 	(fun str -> Str.global_replace e "_" str)
 
+let native_name str =
+	if str.[0] = '?' then String.sub str 1 (String.length str - 1) else str
+
 let make_types_idents htypes =
 	let types_descs = ref PMap.empty in
 	let rec make_desc t =
@@ -1125,8 +1128,13 @@ let make_types_idents htypes =
 				Array.iteri (fun i (f,_,t) -> arr.(i) <- (f,make_desc t)) vp.vfields;
 				td
 	in
+	let hashes = Hashtbl.create 0 in
 	let make_sign d =
-		String.sub (Digest.to_hex (Digest.bytes (Marshal.to_bytes d [Marshal.Compat_32]))) 0 7
+		let dig = Digest.to_hex (Digest.bytes (Marshal.to_bytes d [Marshal.Compat_32])) in
+		let h = String.sub dig 0 7 in
+		let h = if Hashtbl.mem hashes h then dig else h in
+		Hashtbl.add hashes h ();
+		h
 	in
 	let rec desc_string d =
 		match d with
@@ -1182,8 +1190,11 @@ let make_function_table code =
 	Array.iter (fun (lib,name,t,idx) ->
 		let fname =
 			let lib = code.strings.(lib) in
-			let lib = if lib = "std" then "hl" else lib in
-			lib ^ "_" ^ code.strings.(name)
+			let lib = if lib.[0] = '?' then String.sub lib 1 (String.length lib - 1) else lib in
+ 			let lib = if lib = "std" then "hl" else lib in
+			let str = lib ^ "_" ^ code.strings.(name) in
+			(* create wrappers defines for invalid definitions *)
+			if str = "hl_tls_get" then str ^ "_w" else str
 		in
 		match t with
 		| HFun (args, t) ->
@@ -1443,6 +1454,7 @@ let write_c com file (code:code) gnames =
 	define ctx "// Abstract decls";
 	let rec get_abstracts = function
 		| [] -> []
+		| HAbstract (("hl_tls" | "hl_mutex" | "hl_thread"), _) :: l -> get_abstracts l (* ignore / defined in hl.h already *)
 		| HAbstract (name,_) :: l -> name :: get_abstracts l
 		| _ :: l -> get_abstracts l
 	in
@@ -1457,7 +1469,13 @@ let write_c com file (code:code) gnames =
 		Hashtbl.replace native_libs code.strings.(lib) ();
 		let ft = ctx.ftable.(idx) in
 		define_type ctx (HFun (ft.fe_args,ft.fe_ret));
-		sexpr "HL_API %s %s(%s)" (ctype ft.fe_ret) ft.fe_name (args_repr ft.fe_args);
+		match ft.fe_name with
+		| "hl_tls_get_w" ->
+			define ctx "#define hl_tls_get_w(tls) ((vdynamic*)hl_tls_get(tls))";
+		| "hl_tls_set" ->
+			() (* don't redefine *)
+		| _ ->
+			sexpr "HL_API %s %s(%s)" (ctype ft.fe_ret) ft.fe_name (args_repr ft.fe_args);
 	) sorted_natives;
 	line "#endif";
 	line "";
@@ -1721,7 +1739,10 @@ let write_c com file (code:code) gnames =
 	open_file ctx "hl/functions.c";
 	define ctx "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
-	sexpr "void *hl_functions_ptrs[] = {%s}" (String.concat "," (List.map (fun f -> define_function ctx f.fe_index) (Array.to_list ctx.ftable)));
+	sexpr "void *hl_functions_ptrs[] = {%s}" (String.concat ",\\\n\t" (List.map (fun f ->
+		let name = define_function ctx f.fe_index in
+		if name = "hl_tls_get_w" then "hl_tls_get" else name
+	) (Array.to_list ctx.ftable)));
 	let rec loop i =
 		if i = Array.length ctx.ftable then [] else
 		let ft = ctx.ftable.(i) in
@@ -1729,7 +1750,7 @@ let write_c com file (code:code) gnames =
 		define ctx (sprintf "extern hl_type %s;" n);
 		("&" ^ n) :: loop (i + 1)
 	in
-	sexpr "hl_type *hl_functions_types[] = {%s}" (String.concat "," (loop 0));
+	sexpr "hl_type *hl_functions_types[] = {%s}" (String.concat ",\\\n\t" (loop 0));
 	line "";
 	Array.iter (fun f ->
 		if f.fe_module = None then (match f.fe_decl with None -> () | Some f -> generate_function ctx f);