added hl bytes section (separated from utf8 strings)

src/generators/genhl.ml

@@ -86,6 +86,7 @@ type context = {
 	com : Common.context;
 	cglobals : (string, ttype) lookup;
 	cstrings : (string, string) lookup;
+	cbytes : (bytes, bytes) lookup;
 	cfloats : (float, float) lookup;
 	cints : (int32, int32) lookup;
 	cnatives : (string, (string index * string index * ttype * functable index)) lookup;
@@ -266,6 +267,9 @@ let alloc_i32 ctx i =
 let alloc_string ctx s =
 	lookup ctx.cstrings s (fun() -> s)
 
+let alloc_bytes ctx s =
+	lookup ctx.cbytes s (fun() -> s)
+
 let array_class ctx t =
 	match t with
 	| HI32 ->
@@ -1966,7 +1970,9 @@ and eval_expr ctx e =
 				op ctx (ONew ro);
 				op ctx (OString (rb,alloc_string ctx k));
 				op ctx (OSetField (ro,0,rb));
-				op ctx (OBytes (rb,alloc_string ctx (v ^ "\x00"))); (* add a \x00 to prevent clashing with existing string *)
+				(* fix for Resource.getString *)
+				let str = try ignore(String.index v '\x00'); v with Not_found -> v ^ "\x00" in
+				op ctx (OBytes (rb,alloc_bytes ctx (Bytes.of_string str)));
 				op ctx (OSetField (ro,1,rb));
 				if has_len then op ctx (OSetField (ro,2,reg_int ctx (String.length v)));
 				op ctx (OSetArray (arr,ridx,ro));
@@ -2000,7 +2006,7 @@ and eval_expr ctx e =
 			let rt = HAbstract ("macro_pos",alloc_string ctx "macro_pos") in
 			let r = alloc_tmp ctx rt in
 			let rfile = alloc_tmp ctx HBytes in
-			op ctx (OBytes (rfile, alloc_string ctx file));
+			op ctx (OBytes (rfile, alloc_bytes ctx (Bytes.of_string file)));
 			hold ctx rfile;
 			let min = eval_expr ctx min in hold ctx min;
 			let max = eval_expr ctx max in
@@ -3652,6 +3658,7 @@ let write_code ch code debug =
 	write_index (Array.length code.ints);
 	write_index (Array.length code.floats);
 	write_index (Array.length code.strings);
+	write_index (Array.length code.bytes);
 	write_index (Array.length all_types);
 	write_index (Array.length code.globals);
 	write_index (Array.length code.natives);
@@ -3671,6 +3678,19 @@ let write_code ch code debug =
 	in
 	write_strings code.strings;
 
+	let write_bytes bytes =
+		let bytes_length = ref 0 in
+		Array.iter (fun b -> bytes_length := !bytes_length + Bytes.length b) bytes;
+		IO.write_i32 ch !bytes_length;
+		Array.iter (IO.nwrite ch) bytes;
+		let bytes_pos = ref 0 in
+		Array.iter (fun b ->
+			write_index (!bytes_pos);
+			bytes_pos := !bytes_pos + Bytes.length b
+		) bytes;
+	in
+	write_bytes code.bytes;
+
 	if debug then begin
 		write_index (Array.length code.debugfiles);
 		write_strings code.debugfiles;
@@ -3845,6 +3865,7 @@ let create_context com is_macro dump =
 		m = method_context 0 HVoid null_capture false;
 		cints = new_lookup();
 		cstrings = new_lookup();
+		cbytes = new_lookup();
 		cfloats = new_lookup();
 		cglobals = new_lookup();
 		cnatives = new_lookup();
@@ -3924,9 +3945,10 @@ let add_types ctx types =
 let build_code ctx types main =
 	let ep = generate_static_init ctx types main in
 	{
-		version = 4;
+		version = 5;
 		entrypoint = ep;
 		strings = DynArray.to_array ctx.cstrings.arr;
+		bytes = DynArray.to_array ctx.cbytes.arr;
 		ints = DynArray.to_array ctx.cints.arr;
 		floats = DynArray.to_array ctx.cfloats.arr;
 		globals = DynArray.to_array ctx.cglobals.arr;

src/generators/hl2c.ml

@@ -1015,14 +1015,11 @@ let write_c com file (code:code) =
 	line "#endif";
 
 	let used_closures = Hashtbl.create 0 in
-	let bytes_strings = Hashtbl.create 0 in
 	Array.iter (fun f ->
 		Array.iteri (fun i op ->
 			match op with
 			| OStaticClosure (_,fid) ->
 				Hashtbl.replace used_closures fid ()
-			| OBytes (_,sid) ->
-				Hashtbl.replace bytes_strings sid ()
 			| _ ->
 				()
 		) f.code
@@ -1145,11 +1142,10 @@ let write_c com file (code:code) =
 	) code.globals;
 
 	Array.iteri (fun i str ->
-		if Hashtbl.mem bytes_strings i then
-			sexpr "extern vbyte bytes$%d[]" i
-		else if String.length str >= string_data_limit then
+		if String.length str >= string_data_limit then
 			sexpr "extern vbyte string$%d[]" i
 	) code.strings;
+	Array.iteri (fun i _ -> sexpr "extern vbyte bytes$%d[]" i) code.bytes;
 
 	Hashtbl.iter (fun fid _ -> sexpr "extern vclosure cl$%d" fid) used_closures;
 	line "";
@@ -1196,38 +1192,40 @@ let write_c com file (code:code) =
 	unblock ctx;
 	line "}";
 
+	let output_bytes f str =
+		for i = 0 to String.length str - 1 do
+			if (i+1) mod 0x80 = 0 then f "\\\n\t";
+			if i > 0 then f ",";
+			f (string_of_int (int_of_char str.[i]));
+		done
+	in
 	Array.iteri (fun i str ->
-		let output_bytes f str =
-			for i = 0 to String.length str - 1 do
-				if (i+1) mod 0x80 = 0 then f "\\\n\t";
-				if i > 0 then f ",";
-				f (string_of_int (int_of_char str.[i]));
-			done
-		in
-		if Hashtbl.mem bytes_strings i then begin
-			if String.length str > 1000 then begin
-				let bytes_file = "hl/bytes_" ^ (Digest.to_hex (Digest.string str)) ^ ".h" in
-				let abs_file = ctx.dir ^ "/" ^ bytes_file in
-				if not (Sys.file_exists abs_file) then begin
-					let ch = open_out_bin abs_file in
-					output_bytes (output_string ch) str;
-					close_out ch;
-				end;
-				sline "vbyte bytes$%d[] = {" i;
-				output ctx (Printf.sprintf "#%s  include \"%s\"\n" ctx.tabs bytes_file);
-				sexpr "}";
-			end else begin
-				output ctx (Printf.sprintf "vbyte bytes$%d[] = {" i);
-				output_bytes (output ctx) str;
-				sexpr "}";
-			end
-		end else if String.length str >= string_data_limit then
+		if String.length str >= string_data_limit then begin
 			let s = Common.utf8_to_utf16 str true in
 			sline "// %s..." (String.escaped (String.sub str 0 (string_data_limit-4)));
 			output ctx (Printf.sprintf "vbyte string$%d[] = {" i);
 			output_bytes (output ctx) s;
-			sexpr "}"
+			sexpr "}";
+		end
 	) code.strings;
+	Array.iteri (fun i bytes ->
+		if Bytes.length bytes > 1000 then begin
+			let bytes_file = "hl/bytes_" ^ (Digest.to_hex (Digest.bytes bytes)) ^ ".h" in
+			let abs_file = ctx.dir ^ "/" ^ bytes_file in
+			if not (Sys.file_exists abs_file) then begin
+				let ch = open_out_bin abs_file in
+				output_bytes (output_string ch) (Bytes.to_string bytes);
+				close_out ch;
+			end;
+			sline "vbyte bytes$%d[] = {" i;
+			output ctx (Printf.sprintf "#%s  include \"%s\"\n" ctx.tabs bytes_file);
+			sexpr "}";
+		end else begin
+			output ctx (Printf.sprintf "vbyte bytes$%d[] = {" i);
+			output_bytes (output ctx) (Bytes.to_string bytes);
+			sexpr "}";
+		end
+	) code.bytes;
 
 	Hashtbl.iter (fun fid _ ->
 		let ft = ctx.ftable.(fid) in

src/generators/hlcode.ml

@@ -215,6 +215,7 @@ type code = {
 	strings : string array;
 	ints : int32 array;
 	floats : float array;
+	bytes : bytes array;
 	(* types : ttype array // only in bytecode, rebuilt on save() *)
 	globals : ttype array;
 	natives : (string index * string index * ttype * functable index) array;
@@ -581,6 +582,10 @@ let dump pr code =
 	Array.iteri (fun i s ->
 		pr ("	@" ^ string_of_int i ^ " : " ^ String.escaped s);
 	) code.strings;
+	pr (string_of_int (Array.length code.bytes) ^ " bytes");
+	Array.iteri (fun i s ->
+		pr ("	@" ^ string_of_int i ^ " : " ^ string_of_int (Bytes.length s));
+	) code.bytes;
 	pr (string_of_int (Array.length code.ints) ^ " ints");
 	Array.iteri (fun i v ->
 		pr ("	@" ^ string_of_int i ^ " : " ^ Int32.to_string v);

src/generators/hlinterp.ml

@@ -841,7 +841,7 @@ let interp ctx f args =
 		| OInt (r,i) -> set r (VInt ctx.code.ints.(i))
 		| OFloat (r,i) -> set r (VFloat (Array.unsafe_get ctx.code.floats i))
 		| OString (r,s) -> set r (VBytes (cached_string ctx s))
-		| OBytes (r,s) -> set r (VBytes (ctx.code.strings.(s) ^ "\x00"))
+		| OBytes (r,s) -> set r (VBytes (Bytes.to_string ctx.code.bytes.(s)))
 		| OBool (r,b) -> set r (VBool b)
 		| ONull r -> set r VNull
 		| OAdd (r,a,b) -> set r (numop Int32.add ( +. ) a b)
@@ -2105,6 +2105,7 @@ let create checked =
 			globals = [||];
 			natives = [||];
 			strings = [||];
+			bytes = [||];
 			ints = [||];
 			debugfiles = [||];
 			floats = [||];
@@ -2275,9 +2276,12 @@ let check code macros =
 				if i < 0 || i >= Array.length code.floats then error "float outside range";
 			| OBool (r,_) ->
 				reg r HBool
-			| OString (r,i) | OBytes (r,i) ->
+			| OString (r,i) ->
 				reg r HBytes;
 				if i < 0 || i >= Array.length code.strings then error "string outside range";
+			| OBytes (r,i) ->
+				reg r HBytes;
+				if i < 0 || i >= Array.length code.bytes then error "bytes outside range";
 			| ONull r ->
 				let t = rtype r in
 				if not (is_nullable t) then error (tstr t ^ " is not nullable")
@@ -2545,6 +2549,7 @@ type svalue =
 	| SInt of int32
 	| SFloat of float
 	| SString of string
+	| SBytes of int
 	| SBool of bool
 	| SNull
 	| SType of ttype
@@ -2600,6 +2605,7 @@ let rec svalue_string v =
 	| SInt i -> Int32.to_string i
 	| SFloat f -> string_of_float f
 	| SString s -> "\"" ^ s ^ "\""
+	| SBytes i -> "bytes$" ^ string_of_int i
 	| SBool b -> if b then "true" else "false"
 	| SNull -> "null"
 	| SRef _ -> "ref"
@@ -2625,7 +2631,7 @@ let rec svalue_string v =
 	| SDelayed (str,_) -> str
 
 let svalue_iter f = function
-	| SUndef | SArg _ | SInt _ | SFloat _ | SString _ | SBool _ | SNull | SType _ | SResult _
+	| SUndef | SArg _ | SInt _ | SFloat _ | SBytes _ | SString _ | SBool _ | SNull | SType _ | SResult _
 	| SFun (_,None) | SGlobal _ | SRef _ | SRefResult _ | SUnreach | SExc | SDelayed _ ->
 		()
 	| SOp (_,a,b) | SMem (a,b,_) -> f a; f b
@@ -2806,7 +2812,8 @@ let make_spec (code:code) (f:fundecl) =
 			| OInt (d,i) -> args.(d) <- SInt code.ints.(i)
 			| OFloat (d,f) -> args.(d) <- SFloat code.floats.(f)
 			| OBool (d,b) -> args.(d) <- SBool b
-			| OBytes (d,s) | OString (d,s) -> args.(d) <- SString code.strings.(s)
+			| OString (d,s) -> args.(d) <- SString code.strings.(s)
+			| OBytes (d,s) -> args.(d) <- SBytes s
 			| ONull d -> args.(d) <- SNull
 			| OAdd (d,a,b) -> args.(d) <- SOp ("+",args.(a),args.(b))
 			| OSub (d,a,b) -> args.(d) <- SOp ("-",args.(a),args.(b))