source: src/ASM/Assembly.ma @ 3363

Last change on this file since 3363 was 3112, checked in by tranquil, 7 years ago

added invariant that costlabels are only assigned to NOPs (not proved
yet, assembly has a new cases daemon)

File size: 60.3 KB
Line 
1include "utilities/extralib.ma".
2
3include "ASM/Fetch.ma".
4include "ASM/Status.ma".
5
6include alias "arithmetics/nat.ma".
7include alias "ASM/Arithmetic.ma".
8
9(**************************************** START OF POLICY ABSTRACTION ********************)
10
11(* definition of & operations on jump length *)
12inductive jump_length: Type[0] ≝
13  | short_jump: jump_length
14  | absolute_jump: jump_length
15  | long_jump: jump_length.
16 
17(* Functions that define the conditions under which jumps are possible *)
18definition short_jump_cond: Word → Word → (*pseudo_instruction →*)
19  bool × (BitVector 8) ≝
20  λpc_plus_jmp_length.λaddr.(*λinstr.*)
21  let 〈result, flags〉 ≝ sub_16_with_carry addr pc_plus_jmp_length false in
22  let 〈upper, lower〉 ≝ vsplit ? 9 7 result in
23    if get_index' ? 2 0 flags then
24      〈eq_bv 9 upper [[true;true;true;true;true;true;true;true;true]], true:::lower〉
25    else
26      〈eq_bv 9 upper (zero …), false:::lower〉.
27 
28definition absolute_jump_cond: Word → Word → (*pseudo_instruction →*)
29  bool × (BitVector 11) ≝
30  λpc_plus_jmp_length.λaddr.(*λinstr.*)
31  let 〈fst_5_addr, rest_addr〉 ≝ vsplit bool 5 11 addr in
32  let 〈fst_5_pc, rest_pc〉 ≝ vsplit bool 5 11 pc_plus_jmp_length in
33  〈eq_bv 5 fst_5_addr fst_5_pc, rest_addr〉.
34
35definition assembly_preinstruction ≝
36  λA: Type[0].
37  λaddr_of: A → Byte. (* relative *)
38  λpre: preinstruction A.
39  match pre with
40  [ ADD addr1 addr2 ⇒
41     match addr2 return λx. bool_to_Prop (is_in ? [[registr;direct;indirect;data]] x) → ? with
42      [ REGISTER r ⇒ λ_.[ ([[false;false;true;false;true]]) @@ r ]
43      | DIRECT b1 ⇒ λ_.[ ([[false;false;true;false;false;true;false;true]]); b1 ]
44      | INDIRECT i1 ⇒ λ_. [ ([[false;false;true;false;false;true;true;i1]]) ]
45      | DATA b1 ⇒ λ_. [ ([[false;false;true;false;false;true;false;false]]) ; b1 ]
46      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
47  | ADDC addr1 addr2 ⇒
48     match addr2 return λx. bool_to_Prop (is_in ? [[registr;direct;indirect;data]] x) → ? with
49      [ REGISTER r ⇒ λ_.[ ([[false;false;true;true;true]]) @@ r ]
50      | DIRECT b1 ⇒ λ_.[ ([[false;false;true;true;false;true;false;true]]); b1 ]
51      | INDIRECT i1 ⇒ λ_. [ ([[false;false;true;true;false;true;true;i1]]) ]
52      | DATA b1 ⇒ λ_. [ ([[false;false;true;true;false;true;false;false]]) ; b1 ]
53      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
54  | ANL addrs ⇒
55     match addrs with
56      [ inl addrs ⇒ match addrs with
57         [ inl addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
58           match addr2 return λx. bool_to_Prop (is_in ? [[registr;direct;indirect;data]] x) → ? with
59            [ REGISTER r ⇒ λ_.[ ([[false;true;false;true;true]]) @@ r ]
60            | DIRECT b1 ⇒ λ_.[ ([[false;true;false;true;false;true;false;true]]); b1 ]
61            | INDIRECT i1 ⇒ λ_. [ ([[false;true;false;true;false;true;true;i1]]) ]
62            | DATA b1 ⇒ λ_. [ ([[false;true;false;true;false;true;false;false]]) ; b1 ]
63            | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
64         | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
65            let b1 ≝
66             match addr1 return λx. bool_to_Prop (is_in ? [[direct]] x) → ? with
67              [ DIRECT b1 ⇒ λ_.b1
68              | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1) in
69            match addr2 return λx. bool_to_Prop (is_in ? [[acc_a;data]] x) → ? with
70             [ ACC_A ⇒ λ_.[ ([[false;true;false;true;false;false;true;false]]) ; b1 ]
71             | DATA b2 ⇒ λ_. [ ([[false;true;false;true;false;false;true;true]]) ; b1 ; b2 ]
72             | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
73         ]
74      | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
75         match addr2 return λx. bool_to_Prop (is_in ? [[bit_addr;n_bit_addr]] x) → ? with
76          [ BIT_ADDR b1 ⇒ λ_.[ ([[true;false;false;false;false;false;true;false]]) ; b1 ]
77          | N_BIT_ADDR b1 ⇒ λ_. [ ([[true;false;true;true;false;false;false;false]]) ; b1 ]
78          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)]
79  | CLR addr ⇒
80     match addr return λx. bool_to_Prop (is_in ? [[acc_a;carry;bit_addr]] x) → ? with
81      [ ACC_A ⇒ λ_.
82         [ ([[true; true; true; false; false; true; false; false]]) ]
83      | CARRY ⇒ λ_.
84         [ ([[true; true; false; false; false; false; true; true]]) ]
85      | BIT_ADDR b1 ⇒ λ_.
86         [ ([[true; true; false; false; false; false; true; false]]) ; b1 ]
87      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
88  | CPL addr ⇒
89     match addr return λx. bool_to_Prop (is_in ? [[acc_a;carry;bit_addr]] x) → ? with
90      [ ACC_A ⇒ λ_.
91         [ ([[true; true; true; true; false; true; false; false]]) ]
92      | CARRY ⇒ λ_.
93         [ ([[true; false; true; true; false; false; true; true]]) ]
94      | BIT_ADDR b1 ⇒ λ_.
95         [ ([[true; false; true; true; false; false; true; false]]) ; b1 ]
96      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
97  | DA addr ⇒
98     [ ([[true; true; false; true; false; true; false; false]]) ]
99  | DEC addr ⇒
100     match addr return λx. bool_to_Prop (is_in ? [[acc_a;registr;direct;indirect]] x) → ? with
101      [ ACC_A ⇒ λ_.
102         [ ([[false; false; false; true; false; true; false; false]]) ]
103      | REGISTER r ⇒ λ_.
104         [ ([[false; false; false; true; true]]) @@ r ]
105      | DIRECT b1 ⇒ λ_.
106         [ ([[false; false; false; true; false; true; false; true]]); b1 ]
107      | INDIRECT i1 ⇒ λ_.
108         [ ([[false; false; false; true; false; true; true; i1]]) ]
109      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
110      | DJNZ addr1 addr2 ⇒
111         let b2 ≝ addr_of addr2 in
112         match addr1 return λx. bool_to_Prop (is_in ? [[registr;direct]] x) → ? with
113          [ REGISTER r ⇒ λ_.
114             [ ([[true; true; false; true; true]]) @@ r ; b2 ]
115          | DIRECT b1 ⇒ λ_.
116             [ ([[true; true; false; true; false; true; false; true]]); b1; b2 ]
117          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1)
118      | JC addr ⇒
119        let b1 ≝ addr_of addr in
120          [ ([[false; true; false; false; false; false; false; false]]); b1 ]
121      | JNC addr ⇒
122         let b1 ≝ addr_of addr in
123           [ ([[false; true; false; true; false; false; false; false]]); b1 ]
124      | JZ addr ⇒
125         let b1 ≝ addr_of addr in
126           [ ([[false; true; true; false; false; false; false; false]]); b1 ]
127      | JNZ addr ⇒
128         let b1 ≝ addr_of addr in
129           [ ([[false; true; true; true; false; false; false; false]]); b1 ]
130      | JB addr1 addr2 ⇒
131         let b2 ≝ addr_of addr2 in
132         match addr1 return λx. bool_to_Prop (is_in ? [[bit_addr]] x) → ? with
133          [ BIT_ADDR b1 ⇒ λ_.
134             [ ([[false; false; true; false; false; false; false; false]]); b1; b2 ]
135          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1)
136      | JNB addr1 addr2 ⇒
137         let b2 ≝ addr_of addr2 in
138         match addr1 return λx. bool_to_Prop (is_in ? [[bit_addr]] x) → ? with
139          [ BIT_ADDR b1 ⇒ λ_.
140             [ ([[false; false; true; true; false; false; false; false]]); b1; b2 ]
141          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1)
142      | JBC addr1 addr2 ⇒
143         let b2 ≝ addr_of addr2 in
144         match addr1 return λx. bool_to_Prop (is_in ? [[bit_addr]] x) → ? with
145          [ BIT_ADDR b1 ⇒ λ_.
146             [ ([[false; false; false; true; false; false; false; false]]); b1; b2 ]
147          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1)
148      | CJNE addrs addr3 ⇒
149         let b3 ≝ addr_of addr3 in
150         match addrs with
151          [ inl addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
152             match addr2 return λx. bool_to_Prop (is_in ? [[direct;data]] x) → ? with
153              [ DIRECT b1 ⇒ λ_.
154                 [ ([[true; false; true; true; false; true; false; true]]); b1; b3 ]
155              | DATA b1 ⇒ λ_.
156                 [ ([[true; false; true; true; false; true; false; false]]); b1; b3 ]
157              | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
158          | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
159             let b2 ≝
160              match addr2 return λx. bool_to_Prop (is_in ? [[data]] x) → ? with
161               [ DATA b2 ⇒ λ_. b2
162               | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2) in
163             match addr1 return λx. bool_to_Prop (is_in ? [[registr;indirect]] x) → list Byte with
164              [ REGISTER r ⇒ λ_.
165                 [ ([[true; false; true; true; true]]) @@ r; b2; b3 ]
166              | INDIRECT i1 ⇒ λ_.
167                 [ ([[true; false; true; true; false; true; true; i1]]); b2; b3 ]
168              | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1)
169         ]
170  | DIV addr1 addr2 ⇒
171     [ ([[true;false;false;false;false;true;false;false]]) ]
172  | INC addr ⇒
173     match addr return λx. bool_to_Prop (is_in ? [[acc_a;registr;direct;indirect;dptr]] x) → ? with
174      [ ACC_A ⇒ λ_.
175         [ ([[false;false;false;false;false;true;false;false]]) ]         
176      | REGISTER r ⇒ λ_.
177         [ ([[false;false;false;false;true]]) @@ r ]
178      | DIRECT b1 ⇒ λ_.
179         [ ([[false; false; false; false; false; true; false; true]]); b1 ]
180      | INDIRECT i1 ⇒ λ_.
181        [ ([[false; false; false; false; false; true; true; i1]]) ]
182      | DPTR ⇒ λ_.
183        [ ([[true;false;true;false;false;false;true;true]]) ]
184      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
185  | JMP adptr ⇒
186     [ ([[false;true;true;true;false;false;true;true]]) ]
187  | MOV addrs ⇒
188     match addrs with
189      [ inl addrs ⇒
190         match addrs with
191          [ inl addrs ⇒
192             match addrs with
193              [ inl addrs ⇒
194                 match addrs with
195                  [ inl addrs ⇒
196                     match addrs with
197                      [ inl addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
198                         match addr2 return λx. bool_to_Prop (is_in ? [[registr;direct;indirect;data]] x) → ? with
199                          [ REGISTER r ⇒ λ_.[ ([[true;true;true;false;true]]) @@ r ]
200                          | DIRECT b1 ⇒ λ_.[ ([[true;true;true;false;false;true;false;true]]); b1 ]
201                          | INDIRECT i1 ⇒ λ_. [ ([[true;true;true;false;false;true;true;i1]]) ]
202                          | DATA b1 ⇒ λ_. [ ([[false;true;true;true;false;true;false;false]]) ; b1 ]
203                          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
204                      | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
205                         match addr1 return λx. bool_to_Prop (is_in ? [[registr;indirect]] x) → ? with
206                          [ REGISTER r ⇒ λ_.
207                             match addr2 return λx. bool_to_Prop (is_in ? [[acc_a;direct;data]] x) → ? with
208                              [ ACC_A ⇒ λ_.[ ([[true;true;true;true;true]]) @@ r ]
209                              | DIRECT b1 ⇒ λ_.[ ([[true;false;true;false;true]]) @@ r; b1 ]
210                              | DATA b1 ⇒ λ_. [ ([[false;true;true;true;true]]) @@ r; b1 ]
211                              | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
212                          | INDIRECT i1 ⇒ λ_.
213                             match addr2 return λx. bool_to_Prop (is_in ? [[acc_a;direct;data]] x) → ? with
214                              [ ACC_A ⇒ λ_.[ ([[true;true;true;true;false;true;true;i1]]) ]
215                              | DIRECT b1 ⇒ λ_.[ ([[true;false;true;false;false;true;true;i1]]); b1 ]
216                              | DATA b1 ⇒ λ_. [ ([[false;true;true;true;false;true;true;i1]]) ; b1 ]
217                              | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
218                          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1)]
219                  | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
220                     let b1 ≝
221                      match addr1 return λx. bool_to_Prop (is_in ? [[direct]] x) → ? with
222                       [ DIRECT b1 ⇒ λ_. b1
223                       | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1) in
224                     match addr2 return λx. bool_to_Prop (is_in ? [[acc_a;registr;direct;indirect;data]] x) → ? with
225                      [ ACC_A ⇒ λ_.[ ([[true;true;true;true;false;true;false;true]]); b1]
226                      | REGISTER r ⇒ λ_.[ ([[true;false;false;false;true]]) @@ r; b1 ]
227                      | DIRECT b2 ⇒ λ_.[ ([[true;false;false;false;false;true;false;true]]); b1; b2 ]
228                      | INDIRECT i1 ⇒ λ_. [ ([[true;false;false;false;false;true;true;i1]]); b1 ]
229                      | DATA b2 ⇒ λ_. [ ([[false;true;true;true;false;true;false;true]]); b1; b2 ]
230                      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)]
231              | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
232                 match addr2 return λx. bool_to_Prop (is_in ? [[data16]] x) → ? with
233                  [ DATA16 w ⇒ λ_.
234                     let b1_b2 ≝ vsplit ? 8 8 w in
235                     let b1 ≝ \fst b1_b2 in
236                     let b2 ≝ \snd b1_b2 in
237                      [ ([[true;false;false;true;false;false;false;false]]); b1; b2]
238                  | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)]
239          | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
240             match addr2 return λx. bool_to_Prop (is_in ? [[bit_addr]] x) → ? with
241              [ BIT_ADDR b1 ⇒ λ_.
242                 [ ([[true;false;true;false;false;false;true;false]]); b1 ]
243              | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)]
244      | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
245         match addr1 return λx. bool_to_Prop (is_in ? [[bit_addr]] x) → ? with
246          [ BIT_ADDR b1 ⇒ λ_.
247             [ ([[true;false;false;true;false;false;true;false]]); b1 ]
248          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1)]
249  | MOVX addrs ⇒
250     match addrs with
251      [ inl addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
252         match addr2 return λx. bool_to_Prop (is_in ? [[ext_indirect;ext_indirect_dptr]] x) → ? with
253          [ EXT_INDIRECT i1 ⇒ λ_.
254             [ ([[true;true;true;false;false;false;true;i1]]) ]
255          | EXT_INDIRECT_DPTR ⇒ λ_.
256             [ ([[true;true;true;false;false;false;false;false]]) ]
257          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
258      | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
259         match addr1 return λx. bool_to_Prop (is_in ? [[ext_indirect;ext_indirect_dptr]] x) → ? with
260          [ EXT_INDIRECT i1 ⇒ λ_.
261             [ ([[true;true;true;true;false;false;true;i1]]) ]
262          | EXT_INDIRECT_DPTR ⇒ λ_.
263             [ ([[true;true;true;true;false;false;false;false]]) ]
264          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1)]
265  | MUL addr1 addr2 ⇒
266     [ ([[true;false;true;false;false;true;false;false]]) ]
267  | NOP ⇒
268     [ ([[false;false;false;false;false;false;false;false]]) ]
269  | ORL addrs ⇒
270     match addrs with
271      [ inl addrs ⇒
272         match addrs with
273          [ inl addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
274             match addr2 return λx. bool_to_Prop (is_in ? [[registr;data;direct;indirect]] x) → ? with
275             [ REGISTER r ⇒ λ_.[ ([[false;true;false;false;true]]) @@ r ]
276             | DIRECT b1 ⇒ λ_.[ ([[false;true;false;false;false;true;false;true]]); b1 ]
277             | INDIRECT i1 ⇒ λ_. [ ([[false;true;false;false;false;true;true;i1]]) ]
278             | DATA b1 ⇒ λ_. [ ([[false;true;false;false;false;true;false;false]]) ; b1 ]
279             | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
280          | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
281            let b1 ≝
282              match addr1 return λx. bool_to_Prop (is_in ? [[direct]] x) → ? with
283               [ DIRECT b1 ⇒ λ_. b1
284               | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1) in
285             match addr2 return λx. bool_to_Prop (is_in ? [[acc_a;data]] x) → ? with
286              [ ACC_A ⇒ λ_.
287                 [ ([[false;true;false;false;false;false;true;false]]); b1 ]
288              | DATA b2 ⇒ λ_.
289                 [ ([[false;true;false;false;false;false;true;true]]); b1; b2 ]
290              | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)]
291      | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in     
292         match addr2 return λx. bool_to_Prop (is_in ? [[bit_addr;n_bit_addr]] x) → ? with
293          [ BIT_ADDR b1 ⇒ λ_.
294             [ ([[false;true;true;true;false;false;true;false]]); b1 ]
295          | N_BIT_ADDR b1 ⇒ λ_.
296             [ ([[true;false;true;false;false;false;false;false]]); b1 ]
297          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)]
298  | POP addr ⇒
299     match addr return λx. bool_to_Prop (is_in ? [[direct]] x) → ? with
300      [ DIRECT b1 ⇒ λ_.
301         [ ([[true;true;false;true;false;false;false;false]]) ; b1 ]
302      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
303  | PUSH addr ⇒
304     match addr return λx. bool_to_Prop (is_in ? [[direct]] x) → ? with
305      [ DIRECT b1 ⇒ λ_.
306         [ ([[true;true;false;false;false;false;false;false]]) ; b1 ]
307      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
308  | RET ⇒
309     [ ([[false;false;true;false;false;false;true;false]]) ]
310  | RETI ⇒
311     [ ([[false;false;true;true;false;false;true;false]]) ]
312  | RL addr ⇒
313     [ ([[false;false;true;false;false;false;true;true]]) ]
314  | RLC addr ⇒
315     [ ([[false;false;true;true;false;false;true;true]]) ]
316  | RR addr ⇒
317     [ ([[false;false;false;false;false;false;true;true]]) ]
318  | RRC addr ⇒
319     [ ([[false;false;false;true;false;false;true;true]]) ]
320  | SETB addr ⇒     
321     match addr return λx. bool_to_Prop (is_in ? [[carry;bit_addr]] x) → ? with
322      [ CARRY ⇒ λ_.
323         [ ([[true;true;false;true;false;false;true;true]]) ]
324      | BIT_ADDR b1 ⇒ λ_.
325         [ ([[true;true;false;true;false;false;true;false]]); b1 ]
326      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
327  | SUBB addr1 addr2 ⇒
328     match addr2 return λx. bool_to_Prop (is_in ? [[registr;direct;indirect;data]] x) → ? with
329      [ REGISTER r ⇒ λ_.
330         [ ([[true;false;false;true;true]]) @@ r ]
331      | DIRECT b1 ⇒ λ_.
332         [ ([[true;false;false;true;false;true;false;true]]); b1]
333      | INDIRECT i1 ⇒ λ_.
334         [ ([[true;false;false;true;false;true;true;i1]]) ]
335      | DATA b1 ⇒ λ_.
336         [ ([[true;false;false;true;false;true;false;false]]); b1]
337      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
338  | SWAP addr ⇒
339     [ ([[true;true;false;false;false;true;false;false]]) ]
340  | XCH addr1 addr2 ⇒
341     match addr2 return λx. bool_to_Prop (is_in ? [[registr;direct;indirect]] x) → ? with
342      [ REGISTER r ⇒ λ_.
343         [ ([[true;true;false;false;true]]) @@ r ]
344      | DIRECT b1 ⇒ λ_.
345         [ ([[true;true;false;false;false;true;false;true]]); b1]
346      | INDIRECT i1 ⇒ λ_.
347         [ ([[true;true;false;false;false;true;true;i1]]) ]
348      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
349  | XCHD addr1 addr2 ⇒
350     match addr2 return λx. bool_to_Prop (is_in ? [[indirect]] x) → ? with
351      [ INDIRECT i1 ⇒ λ_.
352         [ ([[true;true;false;true;false;true;true;i1]]) ]
353      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
354  | XRL addrs ⇒
355     match addrs with
356      [ inl addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
357         match addr2 return λx. bool_to_Prop (is_in ? [[data;registr;direct;indirect]] x) → ? with
358          [ REGISTER r ⇒ λ_.
359             [ ([[false;true;true;false;true]]) @@ r ]
360          | DIRECT b1 ⇒ λ_.
361             [ ([[false;true;true;false;false;true;false;true]]); b1]
362          | INDIRECT i1 ⇒ λ_.
363             [ ([[false;true;true;false;false;true;true;i1]]) ]
364          | DATA b1 ⇒ λ_.
365             [ ([[false;true;true;false;false;true;false;false]]); b1]
366          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
367      | inr addrs ⇒ let 〈addr1,addr2〉 ≝ addrs in
368         let b1 ≝
369          match addr1 return λx. bool_to_Prop (is_in ? [[direct]] x) → ? with
370           [ DIRECT b1 ⇒ λ_. b1
371           | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr1) in
372         match addr2 return λx. bool_to_Prop (is_in ? [[acc_a;data]] x) → ? with
373          [ ACC_A ⇒ λ_.
374             [ ([[false;true;true;false;false;false;true;false]]); b1 ]         
375          | DATA b2 ⇒ λ_.
376             [ ([[false;true;true;false;false;false;true;true]]); b1; b2 ]
377          | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)]
378       ].
379
380definition assembly1 ≝
381 λi: instruction.
382 match i with
383  [ ACALL addr ⇒
384     match addr return λx. bool_to_Prop (is_in ? [[addr11]] x) → ? with
385      [ ADDR11 w ⇒ λ_.
386         let v1_v2 ≝ vsplit ? 3 8 w in
387         let v1 ≝ \fst v1_v2 in
388         let v2 ≝ \snd v1_v2 in
389          [ (v1 @@ [[true; false; false; false; true]]) ; v2 ]
390      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
391  | AJMP addr ⇒
392     match addr return λx. bool_to_Prop (is_in ? [[addr11]] x) → ? with
393      [ ADDR11 w ⇒ λ_.
394         let v1_v2 ≝ vsplit ? 3 8 w in
395         let v1 ≝ \fst v1_v2 in
396         let v2 ≝ \snd v1_v2 in
397          [ (v1 @@ [[false; false; false; false; true]]) ; v2 ]
398      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
399  | LCALL addr ⇒
400     match addr return λx. bool_to_Prop (is_in ? [[addr16]] x) → ? with
401      [ ADDR16 w ⇒ λ_.
402         let b1_b2 ≝ vsplit ? 8 8 w in
403         let b1 ≝ \fst b1_b2 in
404         let b2 ≝ \snd b1_b2 in
405          [ ([[false;false;false;true;false;false;true;false]]); b1; b2 ]         
406      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
407  | LJMP addr ⇒
408     match addr return λx. bool_to_Prop (is_in ? [[addr16]] x) → ? with
409      [ ADDR16 w ⇒ λ_.
410         let b1_b2 ≝ vsplit ? 8 8 w in
411         let b1 ≝ \fst b1_b2 in
412         let b2 ≝ \snd b1_b2 in
413          [ ([[false;false;false;false;false;false;true;false]]); b1; b2 ]         
414      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
415  | MOVC addr1 addr2 ⇒
416     match addr2 return λx. bool_to_Prop (is_in ? [[acc_dptr;acc_pc]] x) → ? with
417      [ ACC_DPTR ⇒ λ_.
418         [ ([[true;false;false;true;false;false;true;true]]) ]
419      | ACC_PC ⇒ λ_.
420         [ ([[true;false;false;false;false;false;true;true]]) ]
421      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr2)
422  | SJMP addr ⇒
423     match addr return λx. bool_to_Prop (is_in ? [[relative]] x) → ? with
424      [ RELATIVE b1 ⇒ λ_.
425         [ ([[true;false;false;false;false;false;false;false]]); b1 ]
426      | _ ⇒ λK.match K in False with [ ] ] (subaddressing_modein … addr)
427  | RealInstruction instr ⇒
428    assembly_preinstruction [[ relative ]]
429      (λx.
430        match x return λs. bool_to_Prop (is_in ? [[ relative ]] s) → ? with
431        [ RELATIVE r ⇒ λ_. r
432        | _ ⇒ λabsd. ⊥
433        ] (subaddressing_modein … x)) instr
434  ].
435  cases absd
436qed.
437
438(* XXX: pc_plus_sjmp_length used to be just sigma of ppc.  This is incorrect
439        as relative lengths are computed from the *end* of the SJMP, not from
440        the beginning.
441*)
442definition expand_relative_jump_internal:
443 ∀lookup_labels:Identifier → Word.∀sigma:Word → Word.∀policy:Word → bool.
444 Identifier → Word → ([[relative]] → preinstruction [[relative]]) →
445 list instruction
446 ≝
447  λlookup_labels.λsigma.λpolicy.λlbl.λppc,i.
448   let lookup_address ≝ sigma (lookup_labels lbl) in
449   let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
450   let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
451   if sj_possible ∧ ¬(policy ppc)
452   then
453     let address ≝ RELATIVE disp in
454       [ RealInstruction (i address) ]
455   else
456    [ RealInstruction (i (RELATIVE (bitvector_of_nat ? 2)));
457      SJMP (RELATIVE (bitvector_of_nat ? 3)); (* LJMP size? *)
458      LJMP (ADDR16 lookup_address)
459    ].
460  %
461qed.
462
463definition expand_relative_jump:
464  ∀lookup_labels.∀sigma.∀policy.
465  Word → (*jump_length →*)
466  preinstruction Identifier → list instruction ≝
467  λlookup_labels: Identifier → Word.
468  λsigma:Word → Word.
469  λpolicy:Word → bool.
470  λppc: Word.
471  (*λjmp_len: jump_length.*)
472  λi: preinstruction Identifier.
473  (*let rel_jmp ≝ RELATIVE (bitvector_of_nat ? 2) in*)
474  match i with
475  [ JC jmp ⇒ expand_relative_jump_internal lookup_labels sigma policy jmp ppc (JC ?)
476  | JNC jmp ⇒ expand_relative_jump_internal lookup_labels sigma policy jmp ppc (JNC ?)
477  | JB baddr jmp ⇒ expand_relative_jump_internal lookup_labels sigma policy jmp ppc (JB ? baddr)
478  | JZ jmp ⇒ expand_relative_jump_internal lookup_labels sigma policy jmp ppc (JZ ?)
479  | JNZ jmp ⇒ expand_relative_jump_internal lookup_labels sigma policy jmp ppc (JNZ ?)
480  | JBC baddr jmp ⇒ expand_relative_jump_internal lookup_labels sigma policy jmp ppc (JBC ? baddr)
481  | JNB baddr jmp ⇒ expand_relative_jump_internal lookup_labels sigma policy jmp ppc (JNB ? baddr)
482  | CJNE addr jmp ⇒ expand_relative_jump_internal lookup_labels sigma policy jmp ppc (CJNE ? addr)
483  | DJNZ addr jmp ⇒ expand_relative_jump_internal lookup_labels sigma policy jmp ppc (DJNZ ? addr)
484  | ADD arg1 arg2 ⇒ [ ADD ? arg1 arg2 ]
485  | ADDC arg1 arg2 ⇒ [ ADDC ? arg1 arg2 ]
486  | SUBB arg1 arg2 ⇒ [ SUBB ? arg1 arg2 ]
487  | INC arg ⇒ [ INC ? arg ]
488  | DEC arg ⇒ [ DEC ? arg ]
489  | MUL arg1 arg2 ⇒ [ MUL ? arg1 arg2 ]
490  | DIV arg1 arg2 ⇒ [ DIV ? arg1 arg2 ]
491  | DA arg ⇒ [ DA ? arg ]
492  | ANL arg ⇒ [ ANL ? arg ]
493  | ORL arg ⇒ [ ORL ? arg ]
494  | XRL arg ⇒ [ XRL ? arg ]
495  | CLR arg ⇒ [ CLR ? arg ]
496  | CPL arg ⇒ [ CPL ? arg ]
497  | RL arg ⇒ [ RL ? arg ]
498  | RR arg ⇒ [ RR ? arg ]
499  | RLC arg ⇒ [ RLC ? arg ]
500  | RRC arg ⇒ [ RRC ? arg ]
501  | SWAP arg ⇒ [ SWAP ? arg ]
502  | MOV arg ⇒ [ MOV ? arg ]
503  | MOVX arg ⇒ [ MOVX ? arg ]
504  | SETB arg ⇒ [ SETB ? arg ]
505  | PUSH arg ⇒ [ PUSH ? arg ]
506  | POP arg ⇒ [ POP ? arg ]
507  | XCH arg1 arg2 ⇒ [ XCH ? arg1 arg2 ]
508  | XCHD arg1 arg2 ⇒ [ XCHD ? arg1 arg2 ]
509  | RET ⇒ [ RET ? ]
510  | RETI ⇒ [ RETI ? ]
511  | NOP ⇒ [ NOP ? ]
512  | JMP arg ⇒ [ RealInstruction (JMP ? arg) ]
513  ].
514
515definition is_code : region → bool ≝ λr.match r with [ Code ⇒ true | _ ⇒ false ].
516
517definition expand_pseudo_instruction:
518    ∀lookup_labels.
519    ∀sigma: Word → Word.
520    ∀policy: Word → bool.
521      Word → ? → pseudo_instruction → list instruction ≝
522  λlookup_labels: Identifier → Word.
523  λsigma: Word → Word.
524  λpolicy: Word → bool.
525  λppc.
526  λlookup_datalabels:Identifier → region × Word.
527  λi.
528  match i with
529  [ Cost cost ⇒ [ NOP … ]
530  | Comment comment ⇒ [ ]
531  | Call call ⇒
532    let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
533    let lookup_address ≝ sigma (lookup_labels call) in
534    let 〈mj_possible, disp〉 ≝ absolute_jump_cond pc_plus_jmp_length lookup_address in
535    let do_a_long ≝ policy ppc in
536    if mj_possible ∧ ¬ do_a_long then
537      let address ≝ ADDR11 disp in
538        [ ACALL address ]
539    else
540      let address ≝ ADDR16 lookup_address in
541        [ LCALL address ]
542  | Mov d trgt off ⇒
543    let 〈r, addr〉 ≝ lookup_datalabels trgt in
544    let addr ≝ \fst (add_16_with_carry … addr off false) in
545    let addr ≝ if is_code r then sigma addr else addr in
546    match d with
547    [ inl _ ⇒
548      let address ≝ DATA16 addr in
549      [ RealInstruction (MOV ? (inl ? ? (inl ? ? (inr ? ? 〈DPTR, address〉))))]
550    | inr pr ⇒
551      let v ≝ DATA (match \snd pr with
552        [ LOW ⇒ \snd (vsplit … 8 8 addr)
553        | HIGH ⇒ \fst (vsplit … 8 8 addr)
554        ]) in
555     match \fst pr return λx. bool_to_Prop (is_in ? [[acc_a;direct;registr]] x) → ? with
556     [ ACC_A ⇒ λ_.
557        [ RealInstruction (MOV ? (inl ? ? (inl ? ? (inl ? ? (inl ? ? (inl ? ? 〈ACC_A, v〉))))))]     
558     | DIRECT b1 ⇒ λ_.
559        [ RealInstruction (MOV ? (inl ? ? (inl ? ? (inl ? ? (inr ? ? 〈DIRECT b1, v〉)))))]
560     | REGISTER r ⇒ λ_.
561        [ RealInstruction (MOV ? (inl ? ? (inl ? ? (inl ? ? (inl ? ? (inr ? ? 〈REGISTER r, v〉))))))]
562     | _ ⇒ Ⓧ ] (subaddressing_modein …)]
563  | Instruction instr ⇒ expand_relative_jump lookup_labels sigma policy ppc instr
564  | Jmp jmp ⇒
565    let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
566    let do_a_long ≝ policy ppc in
567    let lookup_address ≝ sigma (lookup_labels jmp) in
568    let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
569    if sj_possible ∧ ¬ do_a_long then
570      let address ≝ RELATIVE disp in
571        [ SJMP address ]
572    else
573      let 〈mj_possible, disp2〉 ≝ absolute_jump_cond pc_plus_jmp_length lookup_address in
574      if mj_possible ∧ ¬ do_a_long then
575        let address ≝ ADDR11 disp2 in
576          [ AJMP address ]
577      else   
578        let address ≝ ADDR16 lookup_address in
579        [ LJMP address ]
580  | Jnz acc tgt1 tgt2 ⇒
581     let lookup_address1 ≝ sigma (lookup_labels tgt1) in
582     let lookup_address2 ≝ sigma (lookup_labels tgt2) in
583      (*CSC: we inefficiently use always LJMPs; the policy could
584        choose two SJMPs instead *)
585      [ RealInstruction (JNZ … (RELATIVE (bitvector_of_nat ? 3)));
586        LJMP (ADDR16 lookup_address2);
587        LJMP (ADDR16 lookup_address1) ]
588  (*| MovSuccessor dst ws lbl ⇒
589     let addr ≝ lookup_labels lbl in
590     let 〈high, low〉 ≝ vsplit ? 8 8 addr in
591     let v ≝ DATA match ws with [ HIGH ⇒ high | LOW ⇒ low ] in
592     match dst return λx. bool_to_Prop (is_in ? [[acc_a;direct;registr]] x) → ? with
593     [ ACC_A ⇒ λ_.
594        [ RealInstruction (MOV ? (inl ? ? (inl ? ? (inl ? ? (inl ? ? (inl ? ? 〈ACC_A, v〉))))))]     
595     | DIRECT b1 ⇒ λ_.
596        [ RealInstruction (MOV ? (inl ? ? (inl ? ? (inl ? ? (inr ? ? 〈DIRECT b1, v〉)))))]
597     | REGISTER r ⇒ λ_.
598        [ RealInstruction (MOV ? (inl ? ? (inl ? ? (inl ? ? (inl ? ? (inr ? ? 〈REGISTER r, v〉))))))]     | _ ⇒ λK. match K in False with [ ] ] (subaddressing_modein … dst)*)
599  ].
600  try %
601qed.
602 
603definition assembly_1_pseudoinstruction ≝
604  λlookup_labels.
605  λsigma: Word → Word.
606  λpolicy: Word → bool.
607  λppc: Word.
608  λlookup_datalabels.
609  λi.
610  let pseudos ≝ expand_pseudo_instruction lookup_labels sigma policy ppc lookup_datalabels i in
611  let mapped ≝ map ? ? assembly1 pseudos in
612  let flattened ≝ flatten ? mapped in
613  let pc_len ≝ length ? flattened in
614   〈pc_len, flattened〉.
615
616definition instruction_size ≝
617  λlookup_labels.
618  λlookup_datalabels.
619  λsigma: Word → Word.
620  λpolicy: Word → bool.
621  λppc.
622  λi.
623    \fst (assembly_1_pseudoinstruction lookup_labels sigma policy ppc lookup_datalabels i).
624 
625(* Labels *)
626definition is_label ≝
627  λx:labelled_instruction.λl:Identifier.
628  let 〈lbl,instr〉 ≝ x in
629  match lbl with
630  [ Some l' ⇒ l' = l
631  | _       ⇒ False
632  ].
633
634lemma label_does_not_occur:
635  ∀i:ℕ.∀p:list labelled_instruction.∀l:Identifier.
636  is_label (nth i ? p 〈None ?, Comment EmptyString〉) l → does_not_occur ?? l p = false.
637 #i #p #l generalize in match i; elim p
638 [ #i >nth_nil #H cases H
639 | #h #t #IH #i cases i -i
640   [ cases h #hi #hp cases hi
641     [ normalize #H cases H
642     | #l' #Heq whd in ⊢ (??%?); change with (eq_identifier ? l' l) in match (instruction_matches_identifier ????);
643       whd in Heq; >Heq
644       >eq_identifier_refl / by refl/
645     ]
646   | #i #H whd in match (does_not_occur ????);
647     whd in match (instruction_matches_identifier ????);
648     cases h #hi #hp cases hi normalize nodelta
649     [ @(IH i) @H
650     | #l' @eq_identifier_elim
651       [ normalize / by /
652       | normalize #_ @(IH i) @H
653       ]
654     ]
655   ]
656 ]
657qed.
658
659definition sigma_policy_specification ≝
660  λprogram: pseudo_assembly_program.
661  λsigma: Word → Word.
662  λpolicy: Word → bool.
663  sigma (zero …) = zero … ∧
664  let instr_list ≝ code program in
665  let preamble ≝ preamble program in
666  ∀ppc: Word. ∀ppc_ok: nat_of_bitvector … ppc < |instr_list|.
667    let pc ≝ sigma ppc in
668    let labels ≝ \fst (create_label_cost_map instr_list) in
669    let lookup_labels ≝ λx. bitvector_of_nat 16 (lookup_def … labels x 0) in
670    let lookup_datalabels ≝ λx.
671      match lookup ASMTag … (construct_datalabels preamble) x with
672      [ Some addr ⇒ 〈XData, addr〉
673      | None ⇒ 〈Code, lookup_labels x〉
674      ] in
675    let instruction ≝ \fst (fetch_pseudo_instruction instr_list ppc ppc_ok) in
676    let next_pc ≝ sigma (add 16 ppc (bitvector_of_nat 16 1)) in
677     next_pc = add 16 pc (bitvector_of_nat … (instruction_size lookup_labels lookup_datalabels sigma policy ppc instruction))
678     ∧
679     (nat_of_bitvector … pc + instruction_size lookup_labels lookup_datalabels sigma policy ppc instruction < 2^16
680     ∨
681     (∀ppc'. ∀ppc_ok':nat_of_bitvector … ppc' < |instr_list|. nat_of_bitvector … ppc < nat_of_bitvector … ppc' →
682       let instruction' ≝ \fst (fetch_pseudo_instruction instr_list ppc' ppc_ok') in
683       instruction_size lookup_labels lookup_datalabels sigma policy ppc' instruction' = 0)
684     ∧
685     nat_of_bitvector … pc + instruction_size lookup_labels lookup_datalabels sigma policy ppc instruction = 2^16).
686
687
688lemma fst_assembly_1_pseudoinstruction_insensible_to_lookup_datalabels:
689 ∀lookup_labels,sigma,policy,ppc,pi.
690  ∀lookup_datalabels1,lookup_datalabels2.
691   \fst (assembly_1_pseudoinstruction lookup_labels sigma policy ppc lookup_datalabels1 pi) =
692   \fst (assembly_1_pseudoinstruction lookup_labels sigma policy ppc lookup_datalabels2 pi).
693#lookup_labels #sigma #policy #ppc #pi #lookup_datalabels1 #lookup_datalabels2
694cases pi // *
695[ #addr  @(subaddressing_mode_elim … addr)
696| * #addr @(subaddressing_mode_elim … addr) [2,3: #arg ] *
697] #Id #off whd in ⊢ (??(???%)(???%));
698whd in match (expand_pseudo_instruction ??????) in ⊢ (??%%);
699normalize nodelta
700@pair_elim * #a #_ @pair_elim * #b #_ %
701qed.
702
703lemma fst_snd_assembly_1_pseudoinstruction:
704 ∀lookup_labels,sigma,policy,ppc,pi,lookup_datalabels,len,assembled.
705   assembly_1_pseudoinstruction lookup_labels sigma policy ppc lookup_datalabels pi
706   = 〈len,assembled〉 →
707    len = |assembled|.
708#lookup #sigma #policy #ppc #pi #lookup_datalabels #len #assembled
709inversion (assembly_1_pseudoinstruction ??????) #len' #assembled'
710whd in ⊢ (??%? → ?); #EQ1 #EQ2 destruct %
711qed.
712
713(* XXX: easy but tedious *)
714lemma assembly1_lt_128:
715  ∀i: instruction.
716    |(assembly1 i)| < 128.
717  cases daemon
718(* XXX: commented out as takes ages to type check
719  #i cases i
720  try (#assm1 #assm2) try #assm1
721  [8:
722    cases assm1
723    try (#assm1 #assm2) try #assm1
724    whd in match assembly1; normalize nodelta
725    whd in match assembly_preinstruction; normalize nodelta
726    try @(subaddressing_mode_elim … assm2)
727    try @(subaddressing_mode_elim … assm1) try #w try #w' normalize nodelta
728    [32:
729      cases assm1 -assm1 #assm1 normalize nodelta
730      cases assm1 #addr1 #addr2 normalize nodelta
731      [1:
732        @(subaddressing_mode_elim … addr2)
733      |2:
734        @(subaddressing_mode_elim … addr1)
735      ]
736      #w
737    |35,36,37:
738      cases assm1 -assm1 #assm1 normalize nodelta
739      [1,3:
740        cases assm1 -assm1 #assm1 normalize nodelta
741      ]
742      cases assm1 #addr1 #addr2 normalize nodelta
743      @(subaddressing_mode_elim … addr2) try #w
744    |49:
745      cases assm1 -assm1 #assm1 normalize nodelta
746      [1:
747        cases assm1 -assm1 #assm1 normalize nodelta
748        [1:
749          cases assm1 -assm1 #assm1 normalize nodelta
750          [1:
751            cases assm1 -assm1 #assm1 normalize nodelta
752            [1:
753              cases assm1 -assm1 #assm1 normalize nodelta
754            ]
755          ]
756        ]
757      ]
758      cases assm1 #addr1 #addr2 normalize nodelta
759      [1,3,4,5:
760        @(subaddressing_mode_elim … addr2) try #w
761      |*:
762        @(subaddressing_mode_elim … addr1) try #w
763        normalize nodelta
764        [1,2:
765          @(subaddressing_mode_elim … addr2) try #w
766        ]
767      ]
768    |50:
769      cases assm1 -assm1 #assm1 normalize nodelta
770      cases assm1 #addr1 #addr2 normalize nodelta
771      [1:
772        @(subaddressing_mode_elim … addr2) try #w
773      |2:
774        @(subaddressing_mode_elim … addr1) try #w
775      ]
776    ]
777    normalize repeat @le_S_S @le_O_n
778  ]
779  whd in match assembly1; normalize nodelta
780  [6:
781    normalize repeat @le_S_S @le_O_n
782  |7:
783    @(subaddressing_mode_elim … assm2) normalize repeat @le_S_S @le_O_n
784  |*:
785    @(subaddressing_mode_elim … assm1) #w normalize nodelta repeat @le_S_S @le_O_n
786  ]
787  *)
788qed.
789
790lemma assembly1_pseudoinstruction_lt_2_to_16:
791  ∀lookup_labels,sigma,policy,ppc,lookup_datalabels,pi.
792  |\snd (assembly_1_pseudoinstruction
793    lookup_labels sigma policy ppc lookup_datalabels pi)|
794   < 2^16.
795 #lookup_labels #sigma #policy #ppc #lookup_datalabels *
796[ cut (128 < 2^16) [@leb_true_to_le %] #LT
797  * whd in match (assembly_1_pseudoinstruction ??????);
798  whd in match (expand_pseudo_instruction ??????);
799  whd in match assembly_1_pseudoinstruction; normalize nodelta
800  try (#arg1 #arg2 #arg3) try (#arg1 #arg2) try #arg1
801  whd in match (expand_pseudo_instruction ??????);
802  try
803   (change with (|flatten ? [assembly1 ?]| < ?)
804    >flatten_singleton
805    @(transitive_lt … (assembly1_lt_128 ?))
806    @LT)
807  @pair_elim #x #y #_ cases x cases (policy ppc) normalize nodelta
808  try
809   (change with (|flatten ? [assembly1 ?]| < ?)
810    >flatten_singleton
811    @(transitive_lt … (assembly1_lt_128 ?))
812    @LT)
813  change with (|flatten ? [assembly1 ?; assembly1 ?; assembly1 ?]| < ?)
814  >length_flatten_cons >length_flatten_cons >length_flatten_cons <plus_n_O
815  <associative_plus @(transitive_lt … (tech_transitive_lt_3 … (2^7) ???))
816  try @assembly1_lt_128 @leb_true_to_le %
817|2,3: #msg normalize in ⊢ (?%?); //
818| #label whd in match (assembly_1_pseudoinstruction ??????);
819  whd in match (expand_pseudo_instruction ??????);
820  @pair_elim #sj_poss #disp cases (?∧?) normalize nodelta #_
821  [2: @pair_elim #x #y #_ cases (?∧?)]
822  normalize in ⊢ (?%?); //
823|6: #label whd in match (assembly_1_pseudoinstruction ??????);
824  whd in match (expand_pseudo_instruction ??????);
825  @pair_elim #sj_poss #disp cases (?∧?) normalize nodelta #_
826  normalize in ⊢ (?%?); //
827|5: #acc #dst1 #dst2 normalize in ⊢ (?%?); //
828|7: *
829  [ #dst @(subaddressing_mode_elim … dst)
830  | * #dst @(subaddressing_mode_elim … dst) [2,3: #w] *
831  ] #lbl #off
832  whd in match (assembly_1_pseudoinstruction ??????);
833  whd in match (expand_pseudo_instruction ??????);
834  normalize nodelta @pair_elim #a #b #_
835  [|*: lapply (vsplit bool 8 8 ?) * #high #low ]
836  normalize in ⊢ (?%?); //
837]
838qed.
839
840definition assembly:
841    ∀p: pseudo_assembly_program.
842    ∀sigma: Word → Word.
843    ∀policy: Word → bool.
844      Σres:labelled_object_code.
845       sigma_policy_specification p sigma policy →
846       let preamble ≝ preamble p in
847       let instr_list ≝ code p in
848       |instr_list| ≤ 2^16 →
849       let assembled ≝ oc res in
850       |assembled| ≤ 2^16 ∧
851       (nat_of_bitvector … (sigma (bitvector_of_nat … (|instr_list|))) = |assembled| ∨
852        sigma (bitvector_of_nat … (|instr_list|)) = zero … ∧ |assembled| = 2^16) ∧
853       let 〈labels_to_ppc,ppc_to_costs〉 ≝ create_label_cost_map instr_list in
854       let datalabels ≝ construct_datalabels preamble in
855       let lookup_labels ≝ λx. bitvector_of_nat ? (lookup_def … labels_to_ppc x 0) in
856       let lookup_datalabels ≝ λx.
857         match lookup ASMTag … datalabels x with
858         [ Some addr ⇒ 〈XData, addr〉
859         | None ⇒ 〈Code, lookup_labels x〉
860         ] in
861       ∀ppc. ∀ppc_ok:nat_of_bitvector … ppc < |instr_list|.
862         let 〈pi,newppc〉 ≝ fetch_pseudo_instruction instr_list ppc ppc_ok in
863         let 〈len,assembledi〉 ≝
864          assembly_1_pseudoinstruction lookup_labels sigma policy ppc lookup_datalabels pi in
865         |assembledi| ≤ |assembled| ∧
866         ∀j:nat. ∀H: j < |assembledi|. ∃K.
867          nth_safe ? j assembledi H =
868           nth_safe ? (nat_of_bitvector … (add … (sigma ppc) (bitvector_of_nat ? j)))
869            assembled K
870
871  λp.
872  λsigma.
873  λpolicy.
874  deplet 〈labels_to_ppc,ppc_to_costs〉 as eq_create_label_cost_map ≝ create_label_cost_map (code p) in
875  let preamble ≝ preamble p in
876  let instr_list ≝ code p in
877  let datalabels ≝ construct_datalabels preamble in
878  let lookup_labels ≝ λx. bitvector_of_nat ? (lookup_def … labels_to_ppc x 0) in
879  let lookup_datalabels ≝ λx.
880    match lookup ASMTag … (construct_datalabels preamble) x with
881    [ Some addr ⇒ 〈XData, addr〉
882    | None ⇒ 〈Code, lookup_labels x〉
883    ] in
884  let 〈next_pc,revcode〉 ≝ pi1 … (
885     foldl_strong
886      (option Identifier × pseudo_instruction)
887      (λpre. Σppc_code:(Word × (list Byte)).
888       sigma_policy_specification p sigma policy →
889        |instr_list| ≤ 2^16 →
890        let 〈ppc,code〉 ≝ ppc_code in
891         ppc = bitvector_of_nat … (|pre|) ∧
892         |code| ≤ 2^16 ∧
893         (nat_of_bitvector … (sigma ppc) = |code| ∨
894          sigma ppc = zero … ∧ |code| = 2^16 ∧
895          (|pre| < 2^16 → ∀ppc'. ∀ppc_ok':nat_of_bitvector … ppc' < |instr_list|. nat_of_bitvector … ppc ≤ nat_of_bitvector … ppc' →
896            let instruction' ≝ \fst (fetch_pseudo_instruction instr_list ppc' ppc_ok') in
897            instruction_size lookup_labels lookup_datalabels sigma policy ppc' instruction' = 0)
898         ) ∧
899         ∀ppc'.∀ppc_ok'.
900          (nat_of_bitvector … ppc' < nat_of_bitvector … ppc ∨ |pre| = 2^16) →
901           let 〈pi,newppc〉 ≝ fetch_pseudo_instruction instr_list ppc' ppc_ok' in
902           let 〈len,assembledi〉 ≝
903            assembly_1_pseudoinstruction lookup_labels sigma policy ppc' lookup_datalabels pi in
904           |assembledi| ≤ |reverse … code| ∧
905           ∀j:nat. ∀H: j < |assembledi|. ∃K.
906            nth_safe ? j assembledi H =
907             nth_safe ? (nat_of_bitvector … (add … (sigma ppc') (bitvector_of_nat ? j))) (reverse … code) K)
908      instr_list
909      (λprefix,hd,tl,prf,ppc_code.
910        let 〈ppc, code〉 ≝ pi1 … ppc_code in
911        let 〈pc_delta, program〉 ≝ assembly_1_pseudoinstruction lookup_labels sigma policy ppc lookup_datalabels (\snd hd) in
912        let new_ppc ≝ add ? ppc (bitvector_of_nat ? 1) in
913         〈new_ppc, (reverse … program @ code)〉)
914      〈(zero ?), [ ]〉)
915    in
916     let code ≝ reverse … revcode in
917     mk_labelled_object_code
918     code (load_code_memory code) (refl …)
919     (fold … (λppc.λcost.λpc_to_costs. insert … (sigma ppc) cost pc_to_costs) ppc_to_costs (Stub ??))
920     (foldl ??
921      (λsymboltable,newident_oldident.
922        let ppc ≝ lookup_labels (\fst newident_oldident) in
923         insert … (sigma ppc) (\snd newident_oldident) symboltable) (Stub ??) (renamed_symbols p))
924     (sigma (lookup_labels (final_label p))) ??.
925  [ cases (foldl_strong ? (λx.Σy.?) ???) in p1; #ignore_revcode #Hfold #EQignore_revcode
926    >EQignore_revcode in Hfold; #Hfold #sigma_pol_ok #instr_list_ok
927    cases (Hfold sigma_pol_ok instr_list_ok) -Hfold * * #Hfold1 #Hfold4 #Hfold5 #Hfold3 whd
928    <eq_create_label_cost_map whd %
929    [2: #ppc #LTppc @Hfold3 >Hfold1 @(eqb_elim (|instr_list|) 2^16)
930      [ #limit %2 @limit
931      | #nlimit %1 >nat_of_bitvector_bitvector_of_nat_inverse try assumption
932        @not_eq_to_le_to_lt assumption ]
933    | >length_reverse % try assumption cases Hfold5 -Hfold5
934      [ #Hfold5 <Hfold5 % >Hfold1 %
935      | * #Hfold51 #Hfold52 %2 <Hfold1 assumption ]]
936  | cases daemon (* injectivity of cost labels *)
937  | cases daemon (* cost labels correspond to nops *)
938  | * #sigma_pol_ok1 #_ #instr_list_ok %
939    [ % % [%] // >sigma_pol_ok1 % ]
940    #ppc' #ppc_ok' #abs @⊥ cases abs
941     [#abs2 cases (not_le_Sn_O ?) [#H @(H abs2) | skip]
942     |#abs2 change with (0 = S ?) in abs2; destruct(abs2) ]
943  | #sigma_pol_ok cases sigma_pol_ok #sigma_pol_ok1 #sigma_pol_ok2 #instr_list_ok cases ppc_code in p1; -ppc_code #ppc_code #IH #EQppc_code >EQppc_code in IH; -EQppc_code
944    #IH cases (IH ? instr_list_ok) [2: % assumption ] -IH
945    * * #IH1 #IH2 #IH3 #IH4
946    cut (|prefix| < |instr_list|)
947    [ >prf >length_append normalize <plus_n_Sm @le_S_S // ] #LT_prefix_instr_list
948    cut (|prefix| < 2^16)
949    [ @(lt_to_le_to_lt … (|instr_list|)) assumption ] #prefix_ok
950    cut (nat_of_bitvector … ppc < |instr_list|)
951    [ >IH1 >nat_of_bitvector_bitvector_of_nat_inverse assumption ] #ppc_ok
952    cut (\snd hd = \fst (fetch_pseudo_instruction instr_list ppc ppc_ok))
953    [ >prf in ppc_ok; >IH1 >(add_zero … (bitvector_of_nat … (|prefix|)))
954      >fetch_pseudo_instruction_append
955      [ #ppc_ok whd in match fetch_pseudo_instruction; normalize nodelta
956        whd in match (nth_safe ????); [ cases hd // | normalize // ]
957      | <add_zero >nat_of_bitvector_bitvector_of_nat_inverse
958        [ <prf assumption | assumption ]
959      | skip
960      | <prf assumption
961      ]] #eq_fetch_pseudo_instruction
962    lapply (fst_snd_assembly_1_pseudoinstruction … p2) #EQpc_delta
963    cut (pc_delta < 2^16)
964    [ >EQpc_delta
965      @(eq_ind ?? (λp.λ_. |\snd p| < 2^16) ?? p2)
966      @assembly1_pseudoinstruction_lt_2_to_16 ] #pc_delta_ok
967    cut (pc_delta = instruction_size lookup_labels lookup_datalabels sigma policy ppc (\snd hd))
968    [ whd in match instruction_size; normalize nodelta
969      >fst_assembly_1_pseudoinstruction_insensible_to_lookup_datalabels [ >p2 | skip] % ]
970    #EQpc_delta2
971    cases (sigma_pol_ok2 … ppc_ok)
972    <eq_fetch_pseudo_instruction <eq_create_label_cost_map <EQpc_delta2
973    #sigma_pol3 #sigma_pol4
974    % [ % [% ] ]
975    [ >length_append normalize nodelta >IH1 @sym_eq @add_bitvector_of_nat
976    | >length_append >length_reverse <EQpc_delta
977      cases IH3 -IH3
978      [ #IH3 <IH3 >commutative_plus
979        cases sigma_pol4 [ #LT @(transitive_le … LT) // | * #_ #EQ >EQ % ]
980      | * * #IH3a #IH3b #IH3c >IH3b <EQpc_delta >EQpc_delta2 >eq_fetch_pseudo_instruction
981        >IH3c try % assumption ]
982    | >length_append >length_reverse
983      cases IH3 -IH3
984      [ #IH3 <IH3 <EQpc_delta cases sigma_pol4
985        [ #LT %1 >sigma_pol3 >nat_of_bitvector_add
986          [2: >nat_of_bitvector_bitvector_of_nat_inverse assumption]
987          >nat_of_bitvector_bitvector_of_nat_inverse try assumption //
988        | * #EQ1 #EQ2 %2 %
989          [ lapply (eq_f … (bitvector_of_nat 16) … EQ2) <add_bitvector_of_nat_plus
990            >bitvector_of_nat_inverse_nat_of_bitvector <sigma_pol3 #X >X % //
991          | #LLT_prefix
992            cut (S (nat_of_bitvector … ppc) < 2^16)
993            [ >length_append in LLT_prefix; <plus_n_Sm <plus_n_O #LLT_prefix
994              >IH1 >nat_of_bitvector_bitvector_of_nat_inverse assumption ]
995            -LLT_prefix #LLT_prefix
996            #ppc' #ppc_ok' #LEQ_newppc_ppc' whd >EQ1 try %
997            @(lt_to_le_to_lt … LEQ_newppc_ppc') normalize nodelta
998            >nat_of_bitvector_add >nat_of_bitvector_bitvector_of_nat_inverse // ]]
999      | * * #IH5 #IH6 #IH7 %2 % [% ]
1000        [ normalize nodelta >sigma_pol3 >IH5
1001          >add_commutative <add_zero >nat_of_bitvector_bitvector_of_nat_inverse try assumption
1002          >EQpc_delta2 >eq_fetch_pseudo_instruction >IH7 try % assumption
1003        | >IH6 <EQpc_delta >EQpc_delta2 >eq_fetch_pseudo_instruction >IH7 try %
1004          assumption
1005        | #LLT_prefix
1006          cut (S (nat_of_bitvector … ppc) < 2^16)
1007          [ >length_append in LLT_prefix; <plus_n_Sm <plus_n_O #LLT_prefix
1008            >IH1 >nat_of_bitvector_bitvector_of_nat_inverse assumption ]
1009          -LLT_prefix #LLT_prefix
1010          #ppc' #ppc_ok' #LEQ_newppc_ppc' whd @IH7 try assumption
1011          @(transitive_le … LEQ_newppc_ppc') normalize nodelta
1012          >nat_of_bitvector_add >nat_of_bitvector_bitvector_of_nat_inverse // ]]
1013  | #ppc' #LTppc' cases hd in prf p2 EQpc_delta2 eq_fetch_pseudo_instruction; #label #pi #prf #p2
1014    #EQpc_delta2 #eq_fetch_pseudo_instruction #OR_lt_eq @(eq_bv_elim … ppc' ppc)
1015    [ #EQppc' >EQppc' in LTppc'; -ppc' >prf
1016      >IH1 #LTppc lapply LTppc
1017      >(add_zero … (bitvector_of_nat 16 (|prefix|))) in ⊢ (% → match % with [_ ⇒ ?]);
1018      >fetch_pseudo_instruction_append
1019      [3: @le_S_S @le_O_n
1020      |2: lapply LTppc; >(add_zero … (bitvector_of_nat 16 (|prefix|))) in ⊢ (% → ?); #H @H
1021      |4: <prf @instr_list_ok ]
1022      #LTppc' @pair_elim #pi' #newppc' #EQpair destruct(EQpair) <IH1 >p2 %
1023      [ >length_reverse >length_append >length_reverse // ]
1024      #j #LTj >nat_of_bitvector_add
1025      >nat_of_bitvector_bitvector_of_nat_inverse
1026      [2,4: @(lt_to_le_to_lt … LTj) <EQpc_delta @(transitive_le … pc_delta_ok) %2 %
1027      |3: @(lt_to_le_to_lt … (nat_of_bitvector … (sigma ppc) + pc_delta))
1028          [ >EQpc_delta @monotonic_lt_plus_r assumption
1029          | cases sigma_pol4
1030            [ #H @(transitive_le … H) %2 %
1031            | * #_ #EQ >EQ % ]]]
1032      >reverse_append >reverse_reverse
1033      cases IH3 -IH3
1034      [ #IH3 >IH3 <(length_reverse … code) %
1035        [ >length_append @monotonic_lt_plus_r assumption
1036        | @nth_safe_prepend ]
1037      | * * #IH3a #IH3b #IH3c >IH3a @⊥
1038        cut (|program| = 0)
1039        [ <EQpc_delta >EQpc_delta2 >eq_fetch_pseudo_instruction @IH3c // ] #EQprogram
1040        @(absurd ?? (not_le_Sn_O j)) <EQprogram assumption ]
1041    | #NEQppc'
1042      lapply (IH4 … LTppc')
1043      @pair_elim #pi' #newppc' #eq_fetch_pseudoinstruction
1044      @pair_elim #len' #assembledi' #eq_assembly_1_pseudoinstruction #IH
1045      cases (IH ?) -IH
1046      [2: %1 cases OR_lt_eq
1047        [ normalize nodelta #LT lapply LT >nat_of_bitvector_add
1048          [2: >nat_of_bitvector_bitvector_of_nat_inverse [2: //]
1049            cases (le_to_or_lt_eq … (? : nat_of_bitvector … ppc < 2^16))
1050            [ #X <plus_n_Sm <plus_n_O @X
1051            | #abs @⊥
1052              <(bitvector_of_nat_inverse_nat_of_bitvector … ppc) in LT;
1053              >add_overflow [2: <plus_n_Sm <plus_n_O assumption ]
1054              #abs' @(absurd … abs') normalize in ⊢ (? (??%));
1055              @not_le_Sn_O
1056            | @(lt_to_le_to_lt … ppc_ok) assumption ]]
1057          >nat_of_bitvector_bitvector_of_nat_inverse [2: // ]
1058          <plus_n_Sm <plus_n_O #X lapply (le_S_S_to_le … X) -X #X
1059          cases (le_to_or_lt_eq … X) [//] #abs @⊥
1060          lapply (eq_f … (bitvector_of_nat 16) … abs)
1061          >bitvector_of_nat_inverse_nat_of_bitvector
1062          >bitvector_of_nat_inverse_nat_of_bitvector #EQ
1063          @(absurd … EQ NEQppc')
1064        | >length_append <plus_n_Sm <plus_n_O #EQ @le_S_S_to_le >IH1
1065          >nat_of_bitvector_bitvector_of_nat_inverse try assumption
1066          cases (le_to_or_lt_eq … (lt_nat_of_bitvector 16 ppc')) [#X >EQ @X]
1067          #abs @⊥ <EQ in abs; #X lapply (injective_S … X) #abs
1068          lapply (eq_f … (bitvector_of_nat 16) … abs)
1069          >bitvector_of_nat_inverse_nat_of_bitvector <IH1 #EQ
1070          @(absurd … EQ NEQppc') ]]
1071      #IH6 #IH
1072      change with (let 〈len,assembledi〉 ≝ assembly_1_pseudoinstruction ????? pi' in ? ∧ ∀j:ℕ. ∀H:j<|assembledi|.?)
1073      >eq_assembly_1_pseudoinstruction %
1074      [ >reverse_append >length_append
1075        >(fst_snd_assembly_1_pseudoinstruction … eq_assembly_1_pseudoinstruction)
1076        @(transitive_le … IH6) //
1077      | #j #LTj >reverse_append >reverse_reverse cases (IH … LTj) -IH #K #IH %
1078        [ >length_append @(lt_to_le_to_lt … K) //
1079        | >IH @shift_nth_prefix ]]]]]
1080qed.
1081
1082(*
1083definition assembly_unlabelled_program:
1084    assembly_program → option labelled_object_code ≝
1085  λp.
1086    Some …
1087     (mk_labelled_object_code
1088     (foldr … (λi,l. assembly1 i @ l) [ ] p) 〈Stub …, Stub …〉〉).
1089*)
1090
1091definition ticks_of_instruction ≝
1092  λi.
1093    let trivial_code_memory ≝ assembly1 i in
1094    let trivial_status ≝ load_code_memory trivial_code_memory in
1095      \snd (fetch trivial_status (zero ?)).
1096
1097definition ticks_of0:
1098    ∀p:pseudo_assembly_program.
1099      (Identifier → Word) → (Word → Word) → (Word → bool) → Word → pseudo_instruction → nat × nat ≝
1100  λprogram: pseudo_assembly_program.
1101  λlookup_labels: Identifier → Word.
1102  λsigma.
1103  λpolicy.
1104  λppc: Word.
1105  λfetched.
1106    match fetched with
1107    [ Instruction instr ⇒
1108      match instr with
1109      [ JC lbl ⇒
1110        let lookup_address ≝ sigma (lookup_labels lbl) in
1111        let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1112        let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1113          if sj_possible then
1114            〈2, 2〉
1115          else
1116            〈4, 4〉
1117      | JMP _ ⇒ 〈2, 2〉
1118      | JNC lbl ⇒
1119        let lookup_address ≝ sigma (lookup_labels lbl) in
1120        let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1121        let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1122          if sj_possible then
1123            〈2, 2〉
1124          else
1125            〈4, 4〉
1126      | JB bit lbl ⇒
1127        let lookup_address ≝ sigma (lookup_labels lbl) in
1128        let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1129        let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1130          if sj_possible then
1131            〈2, 2〉
1132          else
1133            〈4, 4〉
1134      | JNB bit lbl ⇒
1135        let lookup_address ≝ sigma (lookup_labels lbl) in
1136        let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1137        let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1138          if sj_possible then
1139            〈2, 2〉
1140          else
1141            〈4, 4〉
1142      | JBC bit lbl ⇒
1143        let lookup_address ≝ sigma (lookup_labels lbl) in
1144        let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1145        let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1146          if sj_possible then
1147            〈2, 2〉
1148          else
1149            〈4, 4〉
1150      | JZ lbl ⇒
1151        let lookup_address ≝ sigma (lookup_labels lbl) in
1152        let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1153        let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1154          if sj_possible then
1155            〈2, 2〉
1156          else
1157            〈4, 4〉
1158      | JNZ lbl ⇒
1159        let lookup_address ≝ sigma (lookup_labels lbl) in
1160        let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1161        let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1162          if sj_possible then
1163            〈2, 2〉
1164          else
1165            〈4, 4〉
1166      | CJNE arg lbl ⇒
1167        let lookup_address ≝ sigma (lookup_labels lbl) in
1168        let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1169        let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1170          if sj_possible then
1171            〈2, 2〉
1172          else
1173            〈4, 4〉
1174      | DJNZ arg lbl ⇒
1175        let lookup_address ≝ sigma (lookup_labels lbl) in
1176        let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1177        let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1178          if sj_possible then
1179            〈2, 2〉
1180          else
1181            〈4, 4〉
1182      | ADD arg1 arg2 ⇒
1183        let ticks ≝ ticks_of_instruction (ADD ? arg1 arg2) in
1184         〈ticks, ticks〉
1185      | ADDC arg1 arg2 ⇒
1186        let ticks ≝ ticks_of_instruction (ADDC ? arg1 arg2) in
1187         〈ticks, ticks〉
1188      | SUBB arg1 arg2 ⇒
1189        let ticks ≝ ticks_of_instruction (SUBB ? arg1 arg2) in
1190         〈ticks, ticks〉
1191      | INC arg ⇒
1192        let ticks ≝ ticks_of_instruction (INC ? arg) in
1193         〈ticks, ticks〉
1194      | DEC arg ⇒
1195        let ticks ≝ ticks_of_instruction (DEC ? arg) in
1196         〈ticks, ticks〉
1197      | MUL arg1 arg2 ⇒
1198        let ticks ≝ ticks_of_instruction (MUL ? arg1 arg2) in
1199         〈ticks, ticks〉
1200      | DIV arg1 arg2 ⇒
1201        let ticks ≝ ticks_of_instruction (DIV ? arg1 arg2) in
1202         〈ticks, ticks〉
1203      | DA arg ⇒
1204        let ticks ≝ ticks_of_instruction (DA ? arg) in
1205         〈ticks, ticks〉
1206      | ANL arg ⇒
1207        let ticks ≝ ticks_of_instruction (ANL ? arg) in
1208         〈ticks, ticks〉
1209      | ORL arg ⇒
1210        let ticks ≝ ticks_of_instruction (ORL ? arg) in
1211         〈ticks, ticks〉
1212      | XRL arg ⇒
1213        let ticks ≝ ticks_of_instruction (XRL ? arg) in
1214         〈ticks, ticks〉
1215      | CLR arg ⇒
1216        let ticks ≝ ticks_of_instruction (CLR ? arg) in
1217         〈ticks, ticks〉
1218      | CPL arg ⇒
1219        let ticks ≝ ticks_of_instruction (CPL ? arg) in
1220         〈ticks, ticks〉
1221      | RL arg ⇒
1222        let ticks ≝ ticks_of_instruction (RL ? arg) in
1223         〈ticks, ticks〉
1224      | RLC arg ⇒
1225        let ticks ≝ ticks_of_instruction (RLC ? arg) in
1226         〈ticks, ticks〉
1227      | RR arg ⇒
1228        let ticks ≝ ticks_of_instruction (RR ? arg) in
1229         〈ticks, ticks〉
1230      | RRC arg ⇒
1231        let ticks ≝ ticks_of_instruction (RRC ? arg) in
1232         〈ticks, ticks〉
1233      | SWAP arg ⇒
1234        let ticks ≝ ticks_of_instruction (SWAP ? arg) in
1235         〈ticks, ticks〉
1236      | MOV arg ⇒
1237        let ticks ≝ ticks_of_instruction (MOV ? arg) in
1238         〈ticks, ticks〉
1239      | MOVX arg ⇒
1240        let ticks ≝ ticks_of_instruction (MOVX ? arg) in
1241         〈ticks, ticks〉
1242      | SETB arg ⇒
1243        let ticks ≝ ticks_of_instruction (SETB ? arg) in
1244         〈ticks, ticks〉
1245      | PUSH arg ⇒
1246        let ticks ≝ ticks_of_instruction (PUSH ? arg) in
1247         〈ticks, ticks〉
1248      | POP arg ⇒
1249        let ticks ≝ ticks_of_instruction (POP ? arg) in
1250         〈ticks, ticks〉
1251      | XCH arg1 arg2 ⇒
1252        let ticks ≝ ticks_of_instruction (XCH ? arg1 arg2) in
1253         〈ticks, ticks〉
1254      | XCHD arg1 arg2 ⇒
1255        let ticks ≝ ticks_of_instruction (XCHD ? arg1 arg2) in
1256         〈ticks, ticks〉
1257      | RET ⇒
1258        let ticks ≝ ticks_of_instruction (RET ?) in
1259         〈ticks, ticks〉
1260      | RETI ⇒
1261        let ticks ≝ ticks_of_instruction (RETI ?) in
1262         〈ticks, ticks〉
1263      | NOP ⇒
1264        let ticks ≝ ticks_of_instruction (NOP ?) in
1265         〈ticks, ticks〉
1266      ]
1267    | Comment comment ⇒ 〈0, 0〉
1268    | Cost cost ⇒
1269       let ticks ≝ ticks_of_instruction (NOP ?) in
1270         〈ticks, ticks〉
1271    | Jnz _ _ _ ⇒ 〈4, 4〉
1272    | Jmp jmp ⇒
1273      let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1274      let do_a_long ≝ policy ppc in
1275      let lookup_address ≝ sigma (lookup_labels jmp) in
1276      let 〈sj_possible, disp〉 ≝ short_jump_cond pc_plus_jmp_length lookup_address in
1277        if sj_possible ∧ ¬ do_a_long then
1278          〈2, 2〉 (* XXX: SJMP *)
1279        else
1280        let 〈mj_possible, disp2〉 ≝ absolute_jump_cond pc_plus_jmp_length lookup_address in
1281          if mj_possible ∧ ¬ do_a_long then
1282            〈2, 2〉 (* XXX: AJMP *)
1283          else
1284            〈2, 2〉 (* XXX: LJMP *)
1285    | Call call ⇒
1286      (* XXX: collapse the branches as they are identical? *)
1287      let pc_plus_jmp_length ≝ sigma (add … ppc (bitvector_of_nat … 1)) in
1288      let lookup_address ≝ sigma (lookup_labels call) in
1289      let 〈mj_possible, disp〉 ≝ absolute_jump_cond pc_plus_jmp_length lookup_address in
1290      let do_a_long ≝ policy ppc in
1291      if mj_possible ∧ ¬ do_a_long then
1292        〈2, 2〉 (* ACALL *)
1293      else
1294        〈2, 2〉 (* LCALL *)
1295    | Mov dst lbl off ⇒
1296      match dst with
1297      [ inl _ ⇒ 〈2, 2〉
1298      | inr pr ⇒
1299        match \fst pr return λx.is_in … [[ acc_a; direct; registr]] x → ? with
1300        [ REGISTER r ⇒ λ_.〈1, 1〉
1301        | DIRECT d ⇒ λ_.〈2, 2〉
1302        | ACC_A ⇒ λ_.〈1, 1〉
1303        | _ ⇒ Ⓧ] (subaddressing_modein …)]
1304     ].
1305
1306definition ticks_of:
1307    ∀p:pseudo_assembly_program.∀addr_of: Identifier → Word.
1308    ∀sigma:Word → Word. ∀policy:Word → bool.
1309     ∀ppc:Word.
1310      nat_of_bitvector … ppc < |code p| → nat × nat ≝
1311  λprogram: pseudo_assembly_program.
1312  λaddr_of,sigma,policy,ppc,ppc_ok.
1313    let 〈fetched, new_ppc〉 ≝ fetch_pseudo_instruction (code program) ppc ppc_ok in
1314     ticks_of0 program addr_of sigma policy ppc fetched.
Note: See TracBrowser for help on using the repository browser.