Browse Source

[hl] added @:packed struct field (new type HPacked)

Nicolas Cannasse 3 năm trước cách đây
mục cha
commit
2a78c20086
4 tập tin đã thay đổi với 32 bổ sung8 xóa
  1. 10 1
      src/generators/genhl.ml
  2. 14 4
      src/generators/hl2c.ml
  3. 6 2
      src/generators/hlcode.ml
  4. 2 1
      src/generators/hlinterp.ml

+ 10 - 1
src/generators/genhl.ml

@@ -644,7 +644,13 @@ and class_type ?(tref=None) ctx c pl statics =
 			| Method MethDynamic when has_class_field_flag f CfOverride ->
 				Some (try fst (get_index f.cf_name p) with Not_found -> die "" __LOC__)
 			| _ ->
-				let fid = add_field f.cf_name (fun() -> to_type ctx f.cf_type) in
+				let fid = add_field f.cf_name (fun() ->
+					let t = to_type ctx f.cf_type in
+					if has_meta (Meta.Custom ":packed") f.cf_meta then begin
+						(match t with HStruct _ -> () | _ -> abort "Packed field should be struct" f.cf_pos);
+						HPacked t
+					end else t
+				) in
 				Some fid
 			) in
 			match f.cf_kind, fid with
@@ -3878,6 +3884,9 @@ let write_code ch code debug =
 		| HNull t ->
 			byte 19;
 			write_type t
+		| HPacked t ->
+			byte 22;
+			write_type t
 	) all_types;
 
 	let write_debug_infos debug =

+ 14 - 4
src/generators/hl2c.ml

@@ -125,7 +125,7 @@ let tname str =
 	if Hashtbl.mem keywords ("_" ^ n) then "__" ^ n else n
 
 let is_gc_ptr = function
-	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HType | HRef _ | HMethod _ -> false
+	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HType | HRef _ | HMethod _ | HPacked _ -> false
 	| HBytes | HDyn | HFun _ | HObj _ | HArray | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ | HStruct _ -> true
 
 let is_ptr = function
@@ -154,6 +154,9 @@ let rec ctype_no_ptr = function
 	| HEnum _ -> "venum",1
 	| HNull _ -> "vdynamic",1
 	| HMethod _ -> "void",1
+	| HPacked t ->
+		let name,v = ctype_no_ptr t in
+		"struct _" ^ name, v
 
 let ctype t =
 	let t, nptr = ctype_no_ptr t in
@@ -200,6 +203,7 @@ let type_id t =
 	| HNull _ -> "HNULL"
 	| HMethod _ -> "HMETHOD"
 	| HStruct _  -> "HSTRUCT"
+	| HPacked _ -> "HPACKED"
 
 let var_type n t =
 	ctype t ^ " " ^ ident n
@@ -224,7 +228,7 @@ let hash ctx sid =
 		h
 
 let type_name ctx t =
-	try PMap.find t ctx.htypes with Not_found -> Globals.die "" __LOC__
+	try PMap.find t ctx.htypes with Not_found -> Globals.die (tstr t) __LOC__
 
 let define ctx s =
 	if not (Hashtbl.mem ctx.hdefines s) then begin
@@ -246,6 +250,8 @@ let rec define_type ctx t =
 	| HVirtual vp when not (PMap.exists t ctx.defined_types) ->
 		ctx.defined_types <- PMap.add t () ctx.defined_types;
 		Array.iter (fun (_,_,t) -> define_type ctx t) vp.vfields
+	| HPacked t ->
+		define_type ctx t
 	| HEnum _ | HObj _ | HStruct _ | HVirtual _ ->
 		()
 
@@ -735,7 +741,7 @@ let generate_function ctx f =
 				one way for comparisons
 			*)
 			match rtype a, rtype b with
-			| (HUI8 | HUI16 | HI32 | HF32 | HF64 | HBool), (HUI8 | HUI16 | HI32 | HF32 | HF64 | HBool) ->
+			| (HUI8 | HUI16 | HI32 | HF32 | HF64 | HBool | HI64), (HUI8 | HUI16 | HI32 | HF32 | HF64 | HBool | HI64) ->
 				phys_compare()
 			| HType, HType ->
 				sexpr "if( hl_same_type(%s,%s) %s 0 ) {} else goto %s" (reg a) (reg b) (s_comp op) (label d)
@@ -1111,6 +1117,10 @@ let make_types_idents htypes =
 			DFun (List.map make_desc tl, make_desc t, false)
 		| HObj p | HStruct p ->
 			DNamed p.pname
+		| HPacked t ->
+			(match make_desc t with
+			| DNamed n -> DNamed ("packed_" ^ n)
+			| _ -> Globals.die "" __LOC__)
 		| HAbstract (n,_) ->
 			DNamed n
 		| HEnum e when e.ename = "" ->
@@ -1607,7 +1617,7 @@ let write_c com file (code:code) gnames =
 				string_of_int (Array.length o.pproto);
 				string_of_int (List.length o.pbindings);
 				sprintf "(const uchar*)%s" (string ctx o.pid);
-				(match o.psuper with None -> "NULL" | Some c -> type_value ctx (HObj c));
+				(match o.psuper with None -> "NULL" | Some c -> type_value ctx (match t with HObj _ -> HObj c | _ -> HStruct c));
 				fields;
 				proto;
 				bindings

+ 6 - 2
src/generators/hlcode.ml

@@ -48,6 +48,7 @@ type ttype =
 	| HNull of ttype
 	| HMethod of ttype list * ttype
 	| HStruct of class_proto
+	| HPacked of ttype
 
 and class_proto = {
 	pname : string;
@@ -256,10 +257,10 @@ let list_mapi f l =
 let is_nullable t =
 	match t with
 	| HBytes | HDyn | HFun _ | HObj _ | HArray | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ | HRef _ | HType | HMethod _ | HStruct _ -> true
-	| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HVoid -> false
+	| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HVoid | HPacked _ -> false
 
 let is_struct = function
-	| HStruct _ -> true
+	| HStruct _ | HPacked _ -> true
 	| _ -> false
 
 let is_int = function
@@ -332,6 +333,8 @@ let rec safe_cast t1 t2 =
 			p.pname = p2.pname || (match p.psuper with None -> false | Some p -> loop p)
 		in
 		loop p1
+	| HPacked t1, HStruct _ ->
+		safe_cast t1 t2
 	| HFun (args1,t1), HFun (args2,t2) when List.length args1 = List.length args2 ->
 		List.for_all2 (fun t1 t2 -> safe_cast t2 t1 || (t1 = HDyn && is_dynamic t2)) args1 args2 && safe_cast t1 t2
 	| _ ->
@@ -465,6 +468,7 @@ let rec tstr ?(stack=[]) ?(detailed=false) t =
 	| HEnum e ->
 		"enum(" ^ e.ename ^ ")"
 	| HNull t -> "null(" ^ tstr t ^ ")"
+	| HPacked t -> "packed(" ^ tstr t ^ ")"
 
 let ostr fstr o =
 	match o with

+ 2 - 1
src/generators/hlinterp.ml

@@ -1083,7 +1083,8 @@ let interp ctx f args =
 					| HEnum _ -> 18
 					| HNull _ -> 19
 					| HMethod _ -> 20
-					| HStruct _ -> 21)))
+					| HStruct _ -> 21
+					| HPacked _ -> 22)))
 				| _ -> Globals.die "" __LOC__);
 		| ORef (r,v) ->
 			set r (VRef (RStack (v + spos),rtype v))