Browse Source

basic opcode encoding ok

Nicolas Cannasse 10 years ago
parent
commit
be5a2a02d5
1 changed files with 44 additions and 26 deletions
  1. 44 26
      genhl.ml

+ 44 - 26
genhl.ml

@@ -95,7 +95,6 @@ type opcode =
 	| OCall0 of reg * global
 	| OCall1 of reg * global * reg
 	| OCall2 of reg * global * reg * reg
-	| OCall3 of reg * global * reg * reg * reg
 	| OCallN of reg * reg * reg list
 	| OGetGlobal of reg * global
 	| OSetGlobal of reg * global
@@ -523,8 +522,6 @@ let interp code =
 				call f [a] r
 			| OCall2 (r, f, a, b) ->
 				call f [a;b] r
-			| OCall3 (r, f, a, b, c) ->
-				call f [a;b;c] r
 			| OCallN (r,f,rl) ->
 				(match rtype f with
 				| TFun (targs,tret) when List.length targs = List.length rl -> List.iter2 reg rl targs; reg r tret
@@ -606,7 +603,6 @@ let interp code =
 			| OCall0 (r,f) -> set r (call (match global f with VFun f -> f | _ -> assert false) [])
 			| OCall1 (r,f,r1) -> set r (call (match global f with VFun f -> f | _ -> assert false) [get r1])
 			| OCall2 (r,f,r1,r2) -> set r (call (match global f with VFun f -> f | _ -> assert false) [get r1;get r2])
-			| OCall3 (r,f,r1,r2,r3) -> set r (call (match global f with VFun f -> f | _ -> assert false) [get r1;get r2;get r3])
 			| OCallN (r,f,rl) ->
 				(match get f with
 				| VFun f -> set r (call f (List.map get rl))
@@ -688,27 +684,49 @@ let write_code ch code =
 		write_index (lookup types t (fun() -> assert false))
 	in
 
-	let reg = write_index in
-
 	let write_op op =
+
 		let o = Obj.repr op in
 		let oid = Obj.tag o in
-		let field n = (Obj.magic (Obj.field o n) : int) in
-		match Obj.size o with
-		| 1 ->
-			let a = field 0 in
-			assert false
-		| 2 ->
-			let a = field 0 in
-			let b = field 1 in
-			assert false
-		| 3 ->
-			let a = field 0 in
-			let b = field 1 in
-			let c = field 2 in
-			assert false
-		| n ->
-			assert false
+
+		match op with
+		| OCall2 (r,g,a,b) ->
+			byte oid;
+			write_index r;
+			write_index g;
+			write_index a;
+			write_index b;
+		| OCallN (r,f,rl) ->
+			byte oid;
+			write_index r;
+			write_index f;
+			let n = List.length rl in
+			if n > 0xFF then assert false;
+			byte n;
+			List.iter write_index rl
+		| _ ->
+			let field n = (Obj.magic (Obj.field o n) : int) in
+			match Obj.size o with
+			| 1 ->
+				let a = field 0 in
+				byte oid;
+				write_index a;
+			| 2 ->
+				let a = field 0 in
+				let b = field 1 in
+				byte oid;
+				write_index a;
+				write_index b;
+			| 3 ->
+				let a = field 0 in
+				let b = field 1 in
+				let c = field 2 in
+				byte oid;
+				write_index a;
+				write_index b;
+				write_index c;
+			| _ ->
+				assert false
 	in
 
 	IO.nwrite ch "HLB";
@@ -743,23 +761,24 @@ let write_code ch code =
 		IO.close_out tmp_ch
 	in
 	let types_data = calc_types() in
-	write_index (Array.length code.strings);
 	write_index (Array.length code.ints);
 	write_index (Array.length code.floats);
+	write_index (Array.length code.strings);
 	write_index (DynArray.length types.arr);
 	write_index (Array.length code.globals);
 	write_index (Array.length code.natives);
 	write_index (Array.length code.functions);
 	write_index code.entrypoint;
 
+	Array.iter (IO.write_real_i32 ch) code.ints;
+	Array.iter (IO.write_double ch) code.floats;
+
 	let str_length = ref 0 in
 	Array.iter (fun str -> str_length := !str_length + String.length str + 1) code.strings;
 	IO.write_i32 ch !str_length;
 	Array.iter (IO.write_string ch) code.strings;
 	Array.iter (fun str -> write_index (String.length str)) code.strings;
 
-	Array.iter (IO.write_real_i32 ch) code.ints;
-	Array.iter (IO.write_double ch) code.floats;
 	IO.nwrite ch types_data;
 	Array.iter write_type code.globals;
 	Array.iter (fun (name_index,global_index) ->
@@ -790,7 +809,6 @@ let ostr o =
 	| OCall0 (r,g) -> Printf.sprintf "call %d, %d()" r g
 	| OCall1 (r,g,a) -> Printf.sprintf "call %d, %d(%d)" r g a
 	| OCall2 (r,g,a,b) -> Printf.sprintf "call %d, %d(%d,%d)" r g a b
-	| OCall3 (r,g,a,b,c) -> Printf.sprintf "call %d, %d(%d,%d,%d)" r g a b c
 	| OCallN (r,g,rl) -> Printf.sprintf "call %d, %d(%s)" r g (String.concat "," (List.map string_of_int rl))
 	| OGetGlobal (r,g) -> Printf.sprintf "global %d, %d" r g
 	| OSetGlobal (g,r) -> Printf.sprintf "setglobal %d, %d" g r