unique ids for static closures and labels

src/generators/hl2c.ml

@@ -61,6 +61,11 @@ type context = {
 	htypes : (ttype, string) PMap.t;
 	gnames : string array;
 	bytes_names : string array;
+	mutable defines : string list;
+	hdefines : (string, unit) Hashtbl.t;
+	mutable file_prefix : string;
+	mutable uid : int;
+	mutable fun_index : int;
 }
 
 let sprintf = Printf.sprintf
@@ -189,6 +194,11 @@ let block ctx =
 let unblock ctx =
 	ctx.tabs <- String.sub ctx.tabs 0 (String.length ctx.tabs - 1)
 
+let unique_id ctx =
+	let id = ctx.uid in
+	ctx.uid <- ctx.uid + 1;
+	ctx.file_prefix ^ string_of_int id
+
 let hash ctx sid =
 	try
 		Hashtbl.find ctx.hash_cache sid
@@ -247,6 +257,10 @@ let obj_field fid name =
 
 let close_file ctx =
 	let str = Buffer.contents ctx.out in
+	let defines = List.rev ctx.defines in
+	let str = (match defines with [] -> str | l -> String.concat "\n" l ^ "\n\n" ^ str) in
+	ctx.defines <- [];
+	Hashtbl.clear ctx.hdefines;
 	Buffer.reset ctx.out;
 	let fpath = ctx.dir ^ "/" ^ ctx.curfile in
 	if String.sub ctx.curfile (String.length ctx.curfile - 2) 2 = ".c" then ctx.cfiles <- ctx.curfile :: ctx.cfiles;
@@ -261,19 +275,27 @@ let close_file ctx =
 
 let bom = "\xEF\xBB\xBF"
 
+let define ctx s =
+	if not (Hashtbl.mem ctx.hdefines s) then begin
+		ctx.defines <- s :: ctx.defines;
+		Hashtbl.add ctx.hdefines s ();
+	end
+
+let short_digest str =
+	String.sub (Digest.to_hex (Digest.string str)) 0 7
+
 let open_file ctx file =
 	if ctx.curfile <> "" then close_file ctx;
 	let version_major = ctx.version / 1000 in
 	let version_minor = (ctx.version mod 1000) / 100 in
 	let version_revision = (ctx.version mod 100) in
-	if file <> "hlc.json" then line ctx (sprintf "%s// Generated by HLC %d.%d.%d (HL v%d)" bom version_major version_minor version_revision ctx.hlcode.version);
-	ctx.curfile <- file
+	if file <> "hlc.json" then define ctx (sprintf "%s// Generated by HLC %d.%d.%d (HL v%d)" bom version_major version_minor version_revision ctx.hlcode.version);
+	ctx.curfile <- file;
+	ctx.fun_index <- 0;
+	ctx.file_prefix <- (short_digest file) ^ "_"
 
 let string_data_limit = 64
 
-let short_digest str =
-	String.sub (Digest.to_hex (Digest.string str)) 0 7
-
 let string ctx sid =
 	let s = ctx.hlcode.strings.(sid) in
 	if String.length s < string_data_limit then
@@ -440,6 +462,7 @@ let generate_reflection ctx =
 let generate_function ctx f =
 	let line = line ctx and expr = expr ctx in
 	let sline fmt = Printf.ksprintf line fmt and sexpr fmt = Printf.ksprintf expr fmt in
+	let define fmt = Printf.ksprintf (define ctx) fmt in
 	let block() = block ctx and unblock() = unblock ctx in
 	let type_value = type_value ctx in
 	let code = ctx.hlcode in
@@ -447,7 +470,8 @@ let generate_function ctx f =
 	let rid = ref (-1) in
 	let reg id = "r" ^ string_of_int id in
 
-	let label id = "label$" ^ string_of_int f.findex ^ "$" ^ string_of_int id in
+	let label p = sprintf "label$%s%d_%d" ctx.file_prefix ctx.fun_index p in
+	ctx.fun_index <- ctx.fun_index + 1;
 
 	let rtype r = f.regs.(r) in
 
@@ -788,7 +812,10 @@ let generate_function ctx f =
 			| _ ->
 				assert false)
 		| OStaticClosure (r,fid) ->
-			sexpr "%s = &cl$%d" (reg r) fid
+			let ft = ctx.ftable.(fid) in
+			let uid = unique_id ctx in
+			define "static vclosure cl$%s = { %s, %s, 0 };" uid (type_value (HFun (ft.fe_args,ft.fe_ret))) ft.fe_name;
+			sexpr "%s = &cl$%s" (reg r) uid
 		| OInstanceClosure (r,fid,ptr) ->
 			let ft = ctx.ftable.(fid) in
 			sexpr "%s = hl_alloc_closure_ptr(%s,%s,%s)" (reg r) (type_value (HFun (ft.fe_args,ft.fe_ret))) (funname fid) (reg ptr)
@@ -1106,6 +1133,11 @@ let write_c com file (code:code) gnames =
 		htypes = types_ids;
 		gnames = gnames;
 		bytes_names = bnames;
+		defines = [];
+		hdefines = Hashtbl.create 0;
+		file_prefix = "";
+		uid = 0;
+		fun_index = 0;
 	} in
 
 	let line = line ctx and expr = expr ctx in
@@ -1125,17 +1157,6 @@ let write_c com file (code:code) gnames =
 	line "";
 	line "#endif";
 
-	let used_closures = Hashtbl.create 0 in
-	Array.iter (fun f ->
-		Array.iteri (fun i op ->
-			match op with
-			| OStaticClosure (_,fid) ->
-				Hashtbl.replace used_closures fid ()
-			| _ ->
-				()
-		) f.code
-	) code.functions;
-
 	open_file ctx "hl/typedefs.h";
 	line "// Types definitions";
 	Array.iter (fun t ->
@@ -1253,7 +1274,6 @@ let write_c com file (code:code) gnames =
 	) code.strings;
 	Array.iter (fun n -> sexpr "extern vbyte %s[]" n) bnames;
 
-	Hashtbl.iter (fun fid _ -> sexpr "extern vclosure cl$%d" fid) used_closures;
 	line "";
 	sexpr "void hl_init_roots()";
 
@@ -1333,11 +1353,6 @@ let write_c com file (code:code) gnames =
 		end
 	) code.bytes;
 
-	Hashtbl.iter (fun fid _ ->
-		let ft = ctx.ftable.(fid) in
-		sexpr "vclosure cl$%d = { %s, %s, 0 }" fid (type_value ctx (HFun (ft.fe_args,ft.fe_ret))) ft.fe_name
-	) used_closures;
-
 	open_file ctx "hl/types.c";
 	line "#include <hl/code.h>";
 	line "// Types values";
@@ -1505,8 +1520,7 @@ let write_c com file (code:code) gnames =
 						let path = List.map (fun n -> if String.length n > 128 then Digest.to_hex (Digest.string n) else n) path in
 						let path = (match path with [name] -> ["_std";name] | _ -> path) in
 						open_file ctx (String.concat "/" path ^ ".c");
-						line "#include <hl/code.h>";
-						line "";
+						define ctx "#include <hl/code.h>";
 					end;
 					Hashtbl.replace gen_functions f.findex ();
 					generate_function ctx f
@@ -1527,8 +1541,7 @@ let write_c com file (code:code) gnames =
 	) all_types;
 
 	open_file ctx "hl/functions.c";
-	line "#include <hl/code.h>";
-	line "";
+	define ctx "#include <hl/code.h>";
 	sexpr "void *hl_functions_ptrs[] = {%s}" (String.concat "," (List.map (fun f -> f.fe_name) (Array.to_list ctx.ftable)));
 	let rec loop i =
 		if i = Array.length ctx.ftable then [] else