more hlc support

genhl.ml

@@ -4433,7 +4433,7 @@ let interp code =
 					VBytes str
 				| _ -> assert false);
 			| "math_isnan" -> (function [VFloat f] -> VBool (classify_float f = FP_nan) | _ -> assert false)
-			| "math_finite" -> (function [VFloat f] -> VBool (match classify_float f with FP_infinite | FP_nan -> false | _ -> true) | _ -> assert false)
+			| "math_isfinite" -> (function [VFloat f] -> VBool (match classify_float f with FP_infinite | FP_nan -> false | _ -> true) | _ -> assert false)
 			| "math_round" -> (function [VFloat f] -> VInt (Int32.of_float (floor (f +. 0.5))) | _ -> assert false)
 			| "math_floor" -> (function [VFloat f] -> VInt (Int32.of_float (floor f)) | _ -> assert false)
 			| "math_ceil" -> (function [VFloat f] -> VInt (Int32.of_float (ceil f)) | _ -> assert false)
@@ -5580,10 +5580,15 @@ let write_c version ch (code:code) =
 		| HVirtual _ -> "vvirtual*"
 		| HDynObj -> "vdynobj*"
 		| HAbstract (name,_) -> name ^ "*"
-		| HEnum e -> tname e.ename
+		| HEnum _ -> "venum*"
 		| HNull _ -> "vdynamic*"
 	in
 
+	let is_gc_ptr = function
+		| HVoid | HI8 | HI16 | HI32 | HF32 | HF64 | HBool | HType | HRef _ -> false
+		| HBytes | HDyn | HFun _ | HObj _ | HArray | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ -> true
+	in
+
 	let type_id t =
 		match t with
 		| HVoid -> "HVOID"
@@ -5616,10 +5621,15 @@ let write_c version ch (code:code) =
 	let version_revision = (version mod 100) in
 	let ver_str = Printf.sprintf "%d.%d.%d" version_major version_minor version_revision in
 	line ("// Generated by HLC " ^ ver_str ^ " (HL v" ^ string_of_int code.version ^")");
-	line "#include <hl.h>";
+	line "#include <hlc.h>";
 	let types = gather_types code in
 	let tfuns = Array.create (Array.length code.functions + Array.length code.natives) ([],HVoid) in
 
+	let enum_type t index =
+		let eindex = lookup types t (fun() -> assert false) in
+		"enum$" ^ string_of_int eindex ^ "_" ^ string_of_int index
+	in
+
 	line "";
 	line "// Types definitions";
 	DynArray.iter (fun t ->
@@ -5627,9 +5637,6 @@ let write_c version ch (code:code) =
 		| HObj o ->
 			let name = tname o.pname in
 			expr ("typedef struct _" ^ name ^ " *" ^ name);
-		| HEnum e ->
-			let name = tname e.ename in
-			expr ("typedef struct _" ^ name ^ " *" ^ name);
 		| HAbstract (name,_) ->
 			expr ("typedef struct _" ^ name ^ " "  ^ name);
 		| _ ->
@@ -5654,6 +5661,17 @@ let write_c version ch (code:code) =
 			) o.pfields;
 			unblock();
 			expr "}";
+		| HEnum e ->
+			Array.iteri (fun i (_,_,pl) ->
+				line ("typedef struct {");
+				block();
+				expr "struct _venum";
+				Array.iteri (fun i t ->
+					expr (var_type ("p" ^ string_of_int i) t)
+				) pl;
+				unblock();
+				sexpr "} %s" (enum_type t i);
+			) e.efields
 		| _ ->
 			()
 	) types.arr;
@@ -5665,8 +5683,6 @@ let write_c version ch (code:code) =
 		match t with
 		| HObj o ->
 			line (Printf.sprintf "#define %s__val &type$%d" (tname o.pname) i)
-		| HEnum e ->
-			line (Printf.sprintf "#define %s__val &type$%d" (tname e.ename) i)
 		| _ ->
 			()
 	) types.arr;
@@ -5755,8 +5771,23 @@ let write_c version ch (code:code) =
 				proto
 			] in
 			sexpr "static hl_type_obj obj$%d = {%s}" i (String.concat "," ofields);
-		| HEnum _ ->
-			()
+		| HEnum e ->
+			let constr_name = sprintf "econstructs$%d" i in
+			let constr_value cid (_,nid,tl) =
+				let tval = if Array.length tl = 0 then "NULL" else
+					let name = sprintf "econstruct$%d_%d" i cid in
+					sexpr "static hl_type *%s[] = {%s}" name (String.concat "," (List.map type_value (Array.to_list tl)));
+					name
+				in
+				sprintf "{(const uchar*)string$%d, %d, %s}" nid (Array.length tl) tval
+			in
+			sexpr "static hl_enum_construct %s[] = {%s}" constr_name (String.concat "," (Array.to_list (Array.mapi constr_value e.efields)));
+			let efields = [
+				if e.eid = 0 then "NULL" else sprintf "(const uchar*)string$%d" e.eid;
+				string_of_int (Array.length e.efields);
+				constr_name
+			] in
+			sexpr "static hl_type_enum enum$%d = {%s}" i (String.concat "," efields);
 		| _ ->
 			()
 	) types.arr;
@@ -5787,7 +5818,7 @@ let write_c version ch (code:code) =
 			sexpr "obj$%d.m = &ctx" i;
 			sexpr "type$%d.obj = &obj$%d" i i;
 		| HEnum _ ->
-			line "// TODO : enum"
+			sexpr "type$%d.tenum = &enum$%d" i i;
 		| _ ->
 			()
 	) types.arr;
@@ -5885,7 +5916,7 @@ let write_c version ch (code:code) =
 			in
 			match op with
 			| OMov (r,v) ->
-				sexpr "%s = %s" (reg r) (rcast v (rtype r))
+				if rtype r <> HVoid then sexpr "%s = %s" (reg r) (rcast v (rtype r))
 			| OInt (r,idx) ->
 				sexpr "%s = %ld" (reg r) code.ints.(idx)
 			| OFloat (r,idx) ->
@@ -5916,8 +5947,12 @@ let write_c version ch (code:code) =
 				(match rtype r with
 				| HI8 | HI16 | HI32 ->
 					sexpr "%s = %s == 0 ? 0 : %s %% %s" (reg r) (reg b) (reg a) (reg b)
+				| HF32 ->
+					sexpr "%s = fmodf(%s,%s)" (reg r) (reg a) (reg b)
+				| HF64 ->
+					sexpr "%s = fmod(%s,%s)" (reg r) (reg a) (reg b)
 				| _ ->
-					sexpr "%s = %s %% %s" (reg r) (reg a) (reg b))
+					assert false)
 			| OUMod (r,a,b) ->
 				sexpr "%s = %s == 0 ? 0 : ((unsigned)%s) %% ((unsigned)%s)" (reg r) (reg b) (reg a) (reg b)
 			| OShl (r,a,b) ->
@@ -5995,10 +6030,18 @@ let write_c version ch (code:code) =
 				sexpr "goto %s" (label d)
 			| OLabel _ ->
 				if not (flabels.(i)) then line (label (-1) ^ ":")
-
-			(*
-	| OToDyn of reg * reg *)
-
+			| OToDyn (r,v) ->
+				sexpr "%s = (vdynamic*)hl_gc_alloc%s(sizeof(vdynamic))" (reg r) (if is_gc_ptr (rtype v) then "" else "_noptr");
+				sexpr "%s->t = %s" (reg r) (type_value (rtype v));
+				(match rtype v with
+				| HI8 | HI16 | HI32 | HBool ->
+					sexpr "%s->v.i = %s" (reg r) (reg v)
+				| HF32 ->
+					sexpr "%s->v.f = %s" (reg r) (reg v)
+				| HF64 ->
+					sexpr "%s->v.d = %s" (reg r) (reg v)
+				| _ ->
+					sexpr "%s->v.ptr = %s" (reg r) (reg v))
 			| OToSFloat (r,v) ->
 				sexpr "%s = %s" (reg r) (reg v)
 			| OToUFloat (r,v) ->
@@ -6034,7 +6077,8 @@ let write_c version ch (code:code) =
 				sexpr "%s = *(float*)(%s + %s)" (reg r) (reg b) (reg idx)
 			| OGetF64 (r,b,idx) ->
 				sexpr "%s = *(double*)(%s + %s)" (reg r) (reg b) (reg idx)
-(*	| OGetArray of reg * reg * reg *)
+			| OGetArray (r, arr, idx) ->
+				sexpr "%s = ((%s*)(%s + 1))[%s]" (reg r) (ctype (rtype r)) (reg arr) (reg idx)
 			| OSetI8 (b,idx,r) ->
 				sexpr "*(unsigned char*)(%s + %s) = %s" (reg b) (reg idx) (reg r)
 			| OSetI32 (b,idx,r) ->
@@ -6043,12 +6087,15 @@ let write_c version ch (code:code) =
 				sexpr "*(float*)(%s + %s) = %s" (reg b) (reg idx) (reg r)
 			| OSetF64 (b,idx,r) ->
 				sexpr "*(double*)(%s + %s) = %s" (reg b) (reg idx) (reg r)
+			| OSetArray (arr,idx,v) ->
+				sexpr "((%s*)(%s + 1))[%s] = %s" (ctype (rtype v)) (reg arr) (reg idx) (reg v)
 (*
-	| OSetArray of reg * reg * reg
 	| OSafeCast of reg * reg
 	| OUnsafeCast of reg * reg
-	| OArraySize of reg * reg
-	| OError of string index
+*)
+			| OArraySize (r,a) ->
+				sexpr "%s = %s->size" (reg r) (reg a)
+(*	| OError of string index
 	*)
 			| OType (r,t) ->
 				sexpr "%s = %s" (reg r) (type_value t)
@@ -6061,12 +6108,31 @@ let write_c version ch (code:code) =
 				sexpr "%s = *%s" (reg r) (reg v)
 			| OSetref (r,v) ->
 				sexpr "*%s = %s" (reg r) (reg v)
-	(* | OToVirtual of reg * reg
+			| OToVirtual (r,v) ->
+				sexpr "%s = hl_to_virtual(%s,(vdynamic*)%s)" (reg r) (type_value (rtype r)) (reg v)
+	(*
 	| OUnVirtual of reg * reg
 	| ODynGet of reg * reg * string index
-	| ODynSet of reg * string index * reg
-	| OMakeEnum of reg * field index * reg list
-	| OEnumAlloc of reg * field index
+	*)
+			| ODynSet (o,str,v) ->
+				let h = hash code.strings.(str) in
+				let prefix = (match rtype v with
+				| HBool | HI8 | HI16 | HI32 -> "set32"
+				| HF32 -> "setf32"
+				| HF64 -> "setf64"
+				| _ -> "setptr"
+				) in
+				sexpr "hl_dyn_%s((vdynamic*)%s,%ld,%s,%s)" prefix (reg o) h (type_value (rtype v)) (reg v)
+			| OMakeEnum (r,eid,rl) ->
+				let et = enum_type (rtype r) eid in
+				let has_ptr = List.exists (fun r -> is_gc_ptr (rtype r)) rl in
+				sexpr "%s = (venum*)hl_gc_alloc%s(sizeof(%s))" (reg r) (if has_ptr then "" else "_noptr") et;
+				sexpr "%s->index = %d" (reg r) eid;
+				iteri (fun i v ->
+					sexpr "((%s*)%s)->p%d = %s" et (reg r) i (reg v)
+				) rl;
+
+	(*| OEnumAlloc of reg * field index
 	| OEnumIndex of reg * reg
 	| OEnumField of reg * reg * field index * int
 	| OSetEnumField of reg * int * reg

std/hl/_std/Math.hx

@@ -7,7 +7,7 @@ class Math {
 	@:hlNative("std","math_floor") public static function floor( v : Float ) : Int 			return 0;
 	@:hlNative("std","math_round") public static function round( v : Float ) : Int 			return 0;
 	@:hlNative("std","math_ceil") public static function ceil( v : Float ) : Int 			return 0;
-	@:hlNative("std","math_finite") public static function isFinite( f : Float ) : Bool 	return true;
+	@:hlNative("std","math_isfinite") public static function isFinite( f : Float ) : Bool 	return true;
 	@:hlNative("std","math_isnan") public static function isNaN( f : Float ) : Bool 		return false;
 
 	@:hlNative("std","math_ffloor") public static function ffloor( v : Float ) : Float 		return 0.;