perf(native): eliminate adjacent stack transfers with verified moves

4 files changed, +58 −7

@@ -52,6 +52,14 @@ fun arithmetic :: "operator \<Rightarrow> nat list" where
52	52	\| "arithmetic Shr = [72,145,72,211,232]"
53	53	\| "arithmetic Less = [72,145,72,57,200,15,146,192,72,15,182,192]"
54	54
	55	+fun regno :: "register \<Rightarrow> nat" where
	56	+ "regno Rax = 0" \| "regno Rcx = 1" \| "regno Rdx = 2"
	57	+\| "regno Rbx = 3" \| "regno R8 = 8" \| "regno R9 = 9"
	58	+
	59	+definition movecode :: "register \<Rightarrow> register \<Rightarrow> nat list" where
	60	+ "movecode dst src = [72 + (if regno src \<ge> 8 then 4 else 0) + (if regno dst \<ge> 8 then 1 else 0),
	61	+ 137, 192 + 8 * (regno src mod 8) + regno dst mod 8]"
	62	+
55	63	fun encode :: "opcode \<Rightarrow> nat list" where
56	64	"encode (Immediate v) = [72,184] @ octets 8 (unat v)"
57	65	\| "encode (Push r) = pushcode r"

@@ -59,6 +67,7 @@ fun encode :: "opcode \<Rightarrow> nat list" where
59	67	\| "encode (Peek i) = [72,139,132,36] @ octets 4 (8 * i)"
60	68	\| "encode (Arithmetic op) = arithmetic op"
61	69	\| "encode Conditional = [72,133,219,72,15,69,193]"
	70	+\| "encode (Move dst src) = movecode dst src"
62	71
63	72	fun encodable :: "opcode \<Rightarrow> bool" where
64	73	"encodable (Peek i) = (i < 2 ^ 28)"

@@ -66,7 +75,8 @@ fun encodable :: "opcode \<Rightarrow> bool" where
66	75
67	76	definition fixed :: "opcode list" where
68	77	"fixed = map Push [Rax,Rcx,Rbx,Rdx,R8,R9] @ map Pop [Rax,Rcx,Rbx,Rdx,R8,R9] @
69		- map Arithmetic [Add,Sub,Mul,And,Or,Xor,Shl,Shr,Less] @ [Conditional]"
	78	+ map Arithmetic [Add,Sub,Mul,And,Or,Xor,Shl,Shr,Less] @ [Conditional] @
	79	+ concat (map (\<lambda>dst. map (Move dst) [Rax,Rcx,Rbx,Rdx,R8,R9]) [Rax,Rcx,Rbx,Rdx,R8,R9])"
70	80
71	81	definition decode :: "nat list \<Rightarrow> (opcode \<times> nat list) option" where
72	82	"decode bs = (if take 2 bs = [72,184] then

@@ -111,6 +121,10 @@ next
111	121	next
112	122	case Conditional
113	123	then show ?thesis by (simp add: decode_def fixed_def)
	124	+next
	125	+ case (Move dst src)
	126	+ then show ?thesis by (cases dst; cases src) (simp_all add: decode_def fixed_def movecode_def)
	127	+
114	128	qed
115	129
116	130	theorem encode_bytes: "set (encode op) \<subseteq> {..<256}"

@@ -132,6 +146,10 @@ next
132	146	next
133	147	case Conditional
134	148	then show ?thesis by simp
	149	+next
	150	+ case (Move dst src)
	151	+ then show ?thesis by (cases dst; cases src) (simp_all add: movecode_def)
	152	+
135	153	qed
136	154
137	155	theorem encode_injective:

@@ -150,7 +168,7 @@ theorem recover_encode:
150	168	by (induction ops) (simp_all add: decode_encode)
151	169
152	170	definition executable :: "expression \<Rightarrow> nat list" where
153		- "executable e = concat (map encode (native (compile (optimise e) []))) @ [88,195]"
	171	+ "executable e = concat (map encode (program e)) @ [195]"
154	172
155	173	theorem executable_bytes: "set (executable e) \<subseteq> {..<256}"
156	174	unfolding executable_def using encode_bytes by auto

@@ -144,6 +144,11 @@ lemma prepare_encodable:
144	144	"prepare s = Some e \<Longrightarrow> list_all encodable (native (compile (optimise e) []))"
145	145	by (auto simp: prepare_def prepare_with_def Let_def split: if_splits bind_splits prod.splits)
146	146
	147	+lemma prepare_program:
	148	+ "prepare s = Some e \<Longrightarrow> list_all encodable (program e)"
	149	+ unfolding program_def using prepare_encodable
	150	+ by (auto intro: transfers_property)
	151	+
147	152	theorem prepared_correct:
148	153	"prepare source = Some e \<Longrightarrow>
149	154	execute values (compile (optimise e) []) [] = Some [evaluate e [] values]"

@@ -157,9 +162,9 @@ theorem prepared_native:
157	162
158	163	theorem prepared_bytes:
159	164	"prepare source = Some e \<Longrightarrow>
160		- recover (length (native (compile (optimise e) []))) (executable e) =
161		- Some (native (compile (optimise e) []), [88,195])"
162		- unfolding executable_def using recover_encode prepare_encodable by blast
	165	+ recover (length (program e)) (executable e) =
	166	+ Some (program e, [195])"
	167	+ unfolding executable_def using recover_encode prepare_program by blast
163	168
164	169	theorem prepared_stacks:
165	170	"prepare source = Some e \<Longrightarrow>

@@ -5,7 +5,7 @@ begin
5	5	datatype register = Rax \| Rcx \| Rbx \| Rdx \| R8 \| R9
6	6
7	7	datatype opcode = Immediate pixel \| Push register \| Pop register \| Peek nat
8		- \| Arithmetic operator \| Conditional
	8	+ \| Arithmetic operator \| Conditional \| Move register register
9	9
10	10	record machine =
11	11	registers :: "register \<Rightarrow> pixel"

@@ -38,6 +38,7 @@ fun transition :: "opcode \<Rightarrow> machine \<Rightarrow> machine option" wh
38	38	Rax := operate op (registers s Rcx) (registers s Rax))\<rparr>)"
39	39	\| "transition Conditional s = Some (s\<lparr>registers :=
40	40	(registers s)(Rax := if registers s Rbx = 0 then registers s Rax else registers s Rcx)\<rparr>)"
	41	+\| "transition (Move dst src) s = Some (s\<lparr>registers := (registers s)(dst := registers s src)\<rparr>)"
41	42
42	43	fun run :: "opcode list \<Rightarrow> machine \<Rightarrow> machine option" where
43	44	"run [] s = Some s"

@@ -142,6 +143,7 @@ qed
142	143	fun writes :: "opcode \<Rightarrow> register set" where
143	144	"writes (Immediate v) = {Rax}"
144	145	\| "writes (Pop r) = {r}"
	146	+\| "writes (Move dst src) = {dst}"
145	147	\| "writes (Peek i) = {Rax}"
146	148	\| "writes (Arithmetic op) = {Rax,Rcx}"
147	149	\| "writes Conditional = {Rax}"

@@ -160,4 +162,30 @@ lemma lower_scratch:
160	162	"list_all (\<lambda>i. writes i \<subseteq> {Rax,Rcx,Rbx}) (lower op)"
161	163	by (cases op) auto
162	164
	165	+fun transfers :: "opcode list \<Rightarrow> opcode list" where
	166	+ "transfers (Push src # Pop dst # code) =
	167	+ (if src = dst then transfers code else Move dst src # transfers code)"
	168	+\| "transfers (op # code) = op # transfers code"
	169	+\| "transfers [] = []"
	170	+
	171	+theorem transfers_correct: "run (transfers code) s = run code s"
	172	+ by (induction code arbitrary: s rule: transfers.induct)
	173	+ (auto simp: fun_upd_idem split: if_splits option.splits bind_splits)
	174	+
	175	+lemma transfers_length: "length (transfers code) \<le> length code"
	176	+ by (induction code rule: transfers.induct) auto
	177	+
	178	+lemma transfers_property:
	179	+ "list_all P code \<Longrightarrow> (\<And>a b. P (Push a) \<Longrightarrow> P (Pop b) \<Longrightarrow> P (Move b a)) \<Longrightarrow>
	180	+ list_all P (transfers code)"
	181	+ by (induction code rule: transfers.induct) auto
	182	+
	183	+definition program :: "expression \<Rightarrow> opcode list" where
	184	+ "program e = transfers (native (compile (optimise e) []) @ [Pop Rax])"
	185	+
	186	+theorem program_return:
	187	+ "scoped 0 e \<Longrightarrow> \<exists>q. run (program e) s = Some q \<and>
	188	+ registers q Rax = evaluate e [] (inputs s) \<and> stack q = stack s \<and> inputs q = inputs s"
	189	+ unfolding program_def using native_return transfers_correct by metis
	190	+
163	191	end

~james/remy