Browse Source

[hl] pre-calculate jump offsets

also align instruction labels
Simon Krajewski 2 years ago
parent
commit
ac5b365f52
3 changed files with 22 additions and 19 deletions
  1. 1 1
      src/generators/hl2c.ml
  2. 20 17
      src/generators/hlcode.ml
  3. 1 1
      src/generators/hlopt.ml

+ 1 - 1
src/generators/hl2c.ml

@@ -731,7 +731,7 @@ let generate_function ctx f =
 			label
 		in
 		let todo() =
-			sexpr "hl_fatal(\"%s\")" (ostr (fun id -> "f" ^ string_of_int id) op)
+			sexpr "hl_fatal(\"%s\")" (ostr (fun id -> "f" ^ string_of_int id) i op)
 		in
 		let rec compare_op op a b d =
 			let phys_compare() =

+ 20 - 17
src/generators/hlcode.ml

@@ -470,7 +470,8 @@ let rec tstr ?(stack=[]) ?(detailed=false) t =
 	| HNull t -> "null(" ^ tstr t ^ ")"
 	| HPacked t -> "packed(" ^ tstr t ^ ")"
 
-let ostr fstr o =
+let ostr fstr i o =
+	let jump_target d = Printf.sprintf "@%X" (i + d + 1) in
 	match o with
 	| OMov (a,b) -> Printf.sprintf "mov %d,%d" a b
 	| OInt (r,i) -> Printf.sprintf "int %d,@%d" r i
@@ -511,21 +512,21 @@ let ostr fstr o =
 	| OGetGlobal (r,g) -> Printf.sprintf "global %d, %d" r g
 	| OSetGlobal (g,r) -> Printf.sprintf "setglobal %d, %d" g r
 	| ORet r -> Printf.sprintf "ret %d" r
-	| OJTrue (r,d) -> Printf.sprintf "jtrue %d,%d" r d
-	| OJFalse (r,d) -> Printf.sprintf "jfalse %d,%d" r d
-	| OJNull (r,d) -> Printf.sprintf "jnull %d,%d" r d
-	| OJNotNull (r,d) -> Printf.sprintf "jnotnull %d,%d" r d
-	| OJSLt (a,b,i) -> Printf.sprintf "jslt %d,%d,%d" a b i
-	| OJSGte (a,b,i) -> Printf.sprintf "jsgte %d,%d,%d" a b i
-	| OJSGt (r,a,b) -> Printf.sprintf "jsgt %d,%d,%d" r a b
-	| OJSLte (r,a,b) -> Printf.sprintf "jslte %d,%d,%d" r a b
-	| OJULt (a,b,i) -> Printf.sprintf "jult %d,%d,%d" a b i
-	| OJUGte (a,b,i) -> Printf.sprintf "jugte %d,%d,%d" a b i
-	| OJNotLt (a,b,i) -> Printf.sprintf "jnotlt %d,%d,%d" a b i
-	| OJNotGte (a,b,i) -> Printf.sprintf "jnotgte %d,%d,%d" a b i
-	| OJEq (a,b,i) -> Printf.sprintf "jeq %d,%d,%d" a b i
-	| OJNotEq (a,b,i) -> Printf.sprintf "jnoteq %d,%d,%d" a b i
-	| OJAlways d -> Printf.sprintf "jalways %d" d
+	| OJTrue (r,d) -> Printf.sprintf "jtrue %d,%s" r (jump_target d)
+	| OJFalse (r,d) -> Printf.sprintf "jfalse %d,%s" r (jump_target d)
+	| OJNull (r,d) -> Printf.sprintf "jnull %d,%s" r (jump_target d)
+	| OJNotNull (r,d) -> Printf.sprintf "jnotnull %d,%s" r (jump_target d)
+	| OJSLt (a,b,i) -> Printf.sprintf "jslt %d,%d,%s" a b (jump_target i)
+	| OJSGte (a,b,i) -> Printf.sprintf "jsgte %d,%d,%s" a b (jump_target i)
+	| OJSGt (r,a,b) -> Printf.sprintf "jsgt %d,%d,%s" r a (jump_target b)
+	| OJSLte (r,a,b) -> Printf.sprintf "jslte %d,%d,%s" r a (jump_target b)
+	| OJULt (a,b,i) -> Printf.sprintf "jult %d,%d,%s" a b (jump_target i)
+	| OJUGte (a,b,i) -> Printf.sprintf "jugte %d,%d,%s" a b (jump_target i)
+	| OJNotLt (a,b,i) -> Printf.sprintf "jnotlt %d,%d,%s" a b (jump_target i)
+	| OJNotGte (a,b,i) -> Printf.sprintf "jnotgte %d,%d,%s" a b (jump_target i)
+	| OJEq (a,b,i) -> Printf.sprintf "jeq %d,%d,%s" a b (jump_target i)
+	| OJNotEq (a,b,i) -> Printf.sprintf "jnoteq %d,%d,%s" a b (jump_target i)
+	| OJAlways d -> Printf.sprintf "jalways %s" (jump_target d)
 	| OToDyn (r,a) -> Printf.sprintf "todyn %d,%d" r a
 	| OToSFloat (r,a) -> Printf.sprintf "tosfloat %d,%d" r a
 	| OToUFloat (r,a) -> Printf.sprintf "toufloat %d,%d" r a
@@ -635,13 +636,15 @@ let dump pr code =
 		Array.iteri (fun i r ->
 			pr ("		r" ^ string_of_int i ^ " " ^ tstr r);
 		) f.regs;
+		let max_istr = String.length (Printf.sprintf "@%X" (Array.length f.code)) in
 		Array.iteri (fun i o ->
 			let fid, line = f.debug.(i) in
 			if fid <> !cur_fid then begin
 				cur_fid := fid;
 				pr (Printf.sprintf "	; %s" (debug_infos (fid,line)));
 			end;
-			pr (Printf.sprintf "		.%-5d @%X %s" line i (ostr fstr o))
+			let istr = Printf.sprintf "@%X" i in
+			pr (Printf.sprintf "		.%-5d %*s %s" line max_istr istr (ostr fstr i o))
 		) f.code;
 	) code.functions;
 	let protos = Hashtbl.fold (fun _ p acc -> p :: acc) all_protos [] in

+ 1 - 1
src/generators/hlopt.ml

@@ -614,7 +614,7 @@ let remap_fun ctx f dump get_str old_code =
 			let live = "LIVE=" ^ String.concat "," (List.map string_of_int (live_loop 0 [])) in
 			let var_set = (try let v = Hashtbl.find old_assigns i in "set " ^ get_str v with Not_found -> "") in
 			let nvar_set = (try let v = Hashtbl.find new_assigns i in "set " ^ String.concat "," (List.map get_str !v) with Not_found -> "") in
-			write (Printf.sprintf "\t@%-3X %-20s %-20s %-20s %-20s %s" i (ostr string_of_int old) (if opcode_eq old op then "" else ostr string_of_int op) var_set nvar_set live);
+			write (Printf.sprintf "\t@%-3X %-20s %-20s %-20s %-20s %s" i (ostr string_of_int i old) (if opcode_eq old op then "" else ostr string_of_int i op) var_set nvar_set live);
 			loop (i + 1) block
 		in
 		write (Printf.sprintf "%s@%d" (fundecl_name f) f.findex);