1
2open HolKernel Parse boolLib bossLib;
3val _ = new_theory "x64_multiword";
4
5infix \\ val op \\ = op THEN;
6open multiwordTheory;
7
8open progTheory;
9open decompilerLib x64_codegenLib prog_x64Lib x64_compilerLib;
10open wordsTheory wordsLib addressTheory arithmeticTheory listTheory pairSyntax;
11open addressTheory pairTheory set_sepTheory rich_listTheory integerTheory;
12open prog_x64_extraTheory x64_encodeLib
13
14val REV = Tactical.REVERSE;
15
16fun x64_decompile name asm =
17  decompile_strings x64_tools_64 name (assemble asm);
18
19fun x64_decompile_no_status name asm =
20  decompile_strings x64_tools_64_no_status name (assemble asm);
21
22(*
23
24  This file produces a single blob of x64 machine code that is able to
25  do any of the following arithmetic functions over arbitrary size
26  integer inputs.
27
28    + - * div mod compare print-to-dec
29
30  This blob of machine code takes to bignum integers as input. Each
31  bignum is represented as a pointer to the payload in memory (an
32  unsigned natural number) and a word containing the length of the
33  payload and the sign of the integer.
34
35    input 1: R13 hold pointer, R0 holds length with sign
36    input 2: R14 hold pointer, R1 holds length with sign
37
38  The name of the operation to perform is held in R2 and a pointer to
39  free space is given in R15. Output is produced where at the location
40  given in R15 and the length of this output is returned in R0 with
41  sign --- the exception is comparison which returns its full result
42  in R0.
43
44*)
45
46(*
47
48  All of the functions in this file operate over three arrays (bignum
49  payloads): two read-only that may alias and one which is the result
50  of the arithemtic operation. In order to make it easy to write
51  functions that operate over these we will provide an abstraction
52  which makes it clear that we are operating over such arrays. We
53  provide two indexes into each array.
54
55*)
56
57val array64_def = Define `
58  (array64 a [] = emp) /\
59  (array64 a (x::xs) = one (a:word64,x:word64) * array64 (a+8w) xs)`;
60
61val bignum_mem_def = Define `
62  bignum_mem p dm m xa xs ya ys za zs =
63    (xa && 7w = 0w) /\ (ya && 7w = 0w) /\ (za && 7w = 0w) /\
64    if xa = ya then
65      (xs = ys) /\ (array64 xa xs * array64 za zs * p) (fun2set (m,dm))
66    else
67      (array64 xa xs * array64 ya ys * array64 za zs * p) (fun2set (m,dm))`
68
69val zBIGNUMS_def = Define `
70  zBIGNUMS (xa,xs,ya,ys,za,zs,p) =
71    SEP_EXISTS dm m.
72      zMEMORY64 dm m * zR 13w xa * zR 14w ya * zR 15w za *
73      cond (bignum_mem p dm m xa xs ya ys za zs)`;
74
75(* read xs, ys, zs *)
76
77val LESS_LENGTH_IMP = prove(
78  ``!xs n. n < LENGTH xs ==>
79           ?ys1 ys2. (xs = ys1 ++ EL n xs :: ys2) /\ (LENGTH ys1 = n)``,
80  Induct \\ FULL_SIMP_TAC (srw_ss()) []
81  \\ Cases_on `n` \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_NIL]
82  \\ REPEAT STRIP_TAC \\ RES_TAC
83  \\ Q.LIST_EXISTS_TAC [`h::ys1`,`ys2`]
84  \\ FULL_SIMP_TAC std_ss [APPEND,LENGTH] \\ METIS_TAC []);
85
86val array64_APPEND = prove(
87  ``!xs a ys.
88      array64 a (xs ++ ys) = array64 a xs * array64 (a + n2w (8 * LENGTH xs)) ys``,
89  Induct \\ FULL_SIMP_TAC (srw_ss()) [array64_def,SEP_CLAUSES,STAR_ASSOC,
90      MULT_CLAUSES,word_arith_lemma1,AC ADD_COMM ADD_ASSOC]);
91
92val ALIGNED64_IMP = prove(
93  ``(x && 7w = 0w:word64) ==> (x + 8w * w && 7w = 0w) /\
94                              (8w * w + x && 7w = 0w)``,
95  blastLib.BBLAST_TAC);
96
97val FINISH_TAC =
98  FULL_SIMP_TAC std_ss [array64_APPEND,array64_def]
99  \\ Cases_on `xa = ya` \\ FULL_SIMP_TAC std_ss [GSYM word_mul_n2w,
100        AC WORD_ADD_COMM WORD_ADD_ASSOC,GSYM w2w_def,
101        AC WORD_MULT_COMM WORD_MULT_ASSOC,w2w_id]
102  \\ SEP_R_TAC
103
104val x0 = ("r0",``0w:word4``,``r0:word64``);
105val x1 = ("r1",``1w:word4``,``r1:word64``);
106val x2 = ("r2",``2w:word4``,``r2:word64``);
107val x3 = ("r3",``3w:word4``,``r3:word64``);
108val x7 = ("r7",``7w:word4``,``r7:word64``);
109val x8 = ("r8",``8w:word4``,``r8:word64``);
110val x9 = ("r9",``9w:word4``,``r9:word64``);
111val x10 = ("r10",``10w:word4``,``r10:word64``);
112val x11 = ("r11",``11w:word4``,``r11:word64``);
113val x12 = ("r12",``12w:word4``,``r12:word64``);
114
115fun READ_XS (at,wt,rt) (a,w,r) = let
116  val ((th,_,_),_) = x64_spec_memory64 (x64_encode ("mov "^at^",[8*"^a^"+r13]"))
117  val th = SPEC_FRAME_RULE th ``zR 14w ya * zR 15w za *
118                 cond (bignum_mem p df f xa xs ya ys za zs /\
119                       w2n (^r:word64) < LENGTH xs)``
120  val th = Q.INST [`r13`|->`xa`] th
121  val (th,goal) = SPEC_WEAKEN_RULE th
122    ``let ^rt = (EL (w2n ^r) xs) in zPC (rip + 0x5w) * zR ^wt ^rt * zR ^w ^r *
123      zBIGNUMS (xa,xs,ya,ys,za,zs,p)``
124  val lemma = prove(goal,
125    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
126      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM,LET_DEF] \\ REPEAT STRIP_TAC
127    \\ Q.LIST_EXISTS_TAC [`df`,`f`] \\ FULL_SIMP_TAC std_ss []
128    \\ `f (8w * ^r + xa) = EL (w2n (^r:word64)) xs` by ALL_TAC
129    \\ FULL_SIMP_TAC (std_ss++star_ss) []
130    \\ FULL_SIMP_TAC std_ss [bignum_mem_def]
131    \\ IMP_RES_TAC LESS_LENGTH_IMP
132    \\ Q.ABBREV_TAC `y = EL (w2n (^r:word64)) xs` \\ POP_ASSUM (K ALL_TAC)
133    \\ FINISH_TAC)
134  val th = MP th lemma
135  val th = th |> Q.GEN `df` |> Q.GEN `f` |> SIMP_RULE std_ss [SPEC_PRE_EXISTS]
136  val (th,goal) = SPEC_STRENGTHEN_RULE th
137    ``zPC rip * zR ^wt ^rt * zR ^w ^r *
138      zBIGNUMS (xa,xs,ya,ys,za,zs,p) * cond (w2n ^r < LENGTH xs)``
139  val lemma = prove(goal,
140    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
141      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM] \\ REPEAT STRIP_TAC
142    \\ Q.LIST_EXISTS_TAC [`m`,`dm`] \\ FULL_SIMP_TAC (std_ss++star_ss) []
143    \\ FULL_SIMP_TAC std_ss [bignum_mem_def]
144    \\ IMP_RES_TAC ALIGNED64_IMP \\ FULL_SIMP_TAC std_ss [GSYM word_mul_n2w]
145    \\ IMP_RES_TAC LESS_LENGTH_IMP
146    \\ Q.ABBREV_TAC `y = EL (w2n (^r:word64)) xs` \\ POP_ASSUM (K ALL_TAC)
147    \\ FINISH_TAC)
148  val th = MP th lemma
149  val th = th |> INST [``rip:word64``|->``p:word64``]
150  val _ = add_compiled [SIMP_RULE std_ss [LET_DEF] th]
151  in th end;
152
153val mov_r10_xs = READ_XS x0 x10;
154val mov_r10_xs = READ_XS x2 x10;
155val mov_r10_xs = READ_XS x2 x11;
156val mov_r11_xs = READ_XS x8 x11;
157val mov_r12_xs = READ_XS x8 x12;
158
159val r8_el_r10_xs = READ_XS x8 x10;
160
161val _ = add_decompiled("r8_el_r10_xs",r8_el_r10_xs,5,SOME 5);
162
163fun READ_YS (at,wt,rt) (a,w,r) = let
164  val ((th,_,_),_) = x64_spec_memory64 (x64_encode ("mov "^at^",[8*"^a^"+r14]"))
165  val th = SPEC_FRAME_RULE th ``zR 13w xa * zR 15w za *
166                 cond (bignum_mem p df f xa xs ya ys za zs /\
167                       w2n (^r:word64) < LENGTH ys)``
168  val th = Q.INST [`r14`|->`ya`] th
169  val (th,goal) = SPEC_WEAKEN_RULE th
170    ``let ^rt = (EL (w2n ^r) ys) in zPC (rip + 0x4w) * zR ^wt ^rt * zR ^w ^r *
171      zBIGNUMS (xa,xs,ya,ys,za,zs,p)``
172  val lemma = prove(goal,
173    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
174      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM,LET_DEF] \\ REPEAT STRIP_TAC
175    \\ Q.LIST_EXISTS_TAC [`df`,`f`] \\ FULL_SIMP_TAC std_ss []
176    \\ `f (8w * ^r + ya) = EL (w2n (^r:word64)) ys` by ALL_TAC
177    \\ FULL_SIMP_TAC (std_ss++star_ss) []
178    \\ FULL_SIMP_TAC std_ss [bignum_mem_def]
179    \\ IMP_RES_TAC LESS_LENGTH_IMP
180    \\ Q.ABBREV_TAC `y = EL (w2n (^r:word64)) ys` \\ POP_ASSUM (K ALL_TAC)
181    \\ Cases_on `xs = ys` \\ FULL_SIMP_TAC std_ss []
182    \\ FINISH_TAC)
183  val th = MP th lemma
184  val th = th |> Q.GEN `df` |> Q.GEN `f` |> SIMP_RULE std_ss [SPEC_PRE_EXISTS]
185  val (th,goal) = SPEC_STRENGTHEN_RULE th
186    ``zPC rip * zR ^wt ^rt * zR ^w ^r *
187      zBIGNUMS (xa,xs,ya,ys,za,zs,p) * cond (w2n ^r < LENGTH ys)``
188  val lemma = prove(goal,
189    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
190      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM] \\ REPEAT STRIP_TAC
191    \\ Q.LIST_EXISTS_TAC [`m`,`dm`] \\ FULL_SIMP_TAC (std_ss++star_ss) []
192    \\ FULL_SIMP_TAC std_ss [bignum_mem_def]
193    \\ IMP_RES_TAC ALIGNED64_IMP \\ FULL_SIMP_TAC std_ss [GSYM word_mul_n2w]
194    \\ IMP_RES_TAC LESS_LENGTH_IMP
195    \\ Q.ABBREV_TAC `y = EL (w2n (^r:word64)) ys` \\ POP_ASSUM (K ALL_TAC)
196    \\ Cases_on `xs = ys` \\ FULL_SIMP_TAC std_ss []
197    \\ FINISH_TAC)
198  val th = MP th lemma
199  val th = th |> INST [``rip:word64``|->``p:word64``]
200  val _ = add_compiled [SIMP_RULE std_ss [LET_DEF] th]
201  in th end;
202
203val mov_r10_ys = READ_YS x1 x10;
204val mov_r10_ys = READ_YS x2 x10;
205val mov_r11_ys = READ_YS x2 x11;
206val mov_r12_ys = READ_YS x2 x12;
207val mov_r11_ys = READ_YS x8 x11;
208val mov_r12_ys = READ_YS x8 x12;
209val mov_r11_ys = READ_YS x9 x11;
210val mov_r12_ys = READ_YS x9 x12;
211
212val r8_el_r10_ys = READ_YS x8 x10;
213val r9_el_r10_ys = READ_YS x9 x10;
214
215val _ = add_decompiled("r8_el_r10_ys",r8_el_r10_ys,4,SOME 4);
216val _ = add_decompiled("r9_el_r10_ys",r9_el_r10_ys,4,SOME 4);
217
218fun READ_ZS (at,wt,rt) (a,w,r) = let
219  val ((th,_,_),_) = x64_spec_memory64 (x64_encode ("mov "^at^",[8*"^a^"+r15]"))
220  val th = SPEC_FRAME_RULE th ``zR 13w xa * zR 14w ya *
221                 cond (bignum_mem p df f xa xs ya ys za zs /\
222                       w2n (^r:word64) < LENGTH zs)``
223  val th = Q.INST [`r15`|->`za`] th
224  val (th,goal) = SPEC_WEAKEN_RULE th
225    ``let ^rt = (EL (w2n ^r) zs) in zPC (rip + 0x4w) * zR ^wt ^rt * zR ^w ^r *
226      zBIGNUMS (xa,xs,ya,ys,za,zs,p)``
227  val lemma = prove(goal,
228    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
229      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM,LET_DEF] \\ REPEAT STRIP_TAC
230    \\ Q.LIST_EXISTS_TAC [`df`,`f`] \\ FULL_SIMP_TAC std_ss []
231    \\ `f (8w * ^r + za) = EL (w2n (^r:word64)) zs` by ALL_TAC
232    \\ FULL_SIMP_TAC (std_ss++star_ss) []
233    \\ FULL_SIMP_TAC std_ss [bignum_mem_def]
234    \\ IMP_RES_TAC LESS_LENGTH_IMP
235    \\ Q.ABBREV_TAC `y = EL (w2n (^r:word64)) zs` \\ POP_ASSUM (K ALL_TAC)
236    \\ FINISH_TAC)
237  val th = MP th lemma
238  val th = th |> Q.GEN `df` |> Q.GEN `f` |> SIMP_RULE std_ss [SPEC_PRE_EXISTS]
239  val (th,goal) = SPEC_STRENGTHEN_RULE th
240    ``zPC rip * zR ^wt ^rt * zR ^w ^r *
241      zBIGNUMS (xa,xs,ya,ys,za,zs,p) * cond (w2n ^r < LENGTH zs)``
242  val lemma = prove(goal,
243    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
244      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM] \\ REPEAT STRIP_TAC
245    \\ Q.LIST_EXISTS_TAC [`m`,`dm`] \\ FULL_SIMP_TAC (std_ss++star_ss) []
246    \\ FULL_SIMP_TAC std_ss [bignum_mem_def]
247    \\ IMP_RES_TAC ALIGNED64_IMP \\ FULL_SIMP_TAC std_ss [GSYM word_mul_n2w]
248    \\ IMP_RES_TAC LESS_LENGTH_IMP
249    \\ Q.ABBREV_TAC `y = EL (w2n (^r:word64)) zs` \\ POP_ASSUM (K ALL_TAC)
250    \\ FINISH_TAC)
251  val th = MP th lemma
252  val th = th |> INST [``rip:word64``|->``p:word64``]
253  val _ = add_compiled [SIMP_RULE std_ss [LET_DEF] th]
254  in th end;
255
256val mov_r10_zs = READ_ZS x0 x10;
257val mov_r10_zs = READ_ZS x1 x10;
258val mov_r10_zs = READ_ZS x2 x10;
259val mov_r10_zs = READ_ZS x3 x10;
260val mov_r10_zs = READ_ZS x3 x10;
261val mov_r11_zs = READ_ZS x3 x11;
262val mov_r12_zs = READ_ZS x3 x12;
263val mov_r10_zs = READ_ZS x8 x10;
264val mov_r11_zs = READ_ZS x8 x11;
265val mov_r12_zs = READ_ZS x8 x12;
266val mov_r10_zs = READ_ZS x9 x10;
267
268val r8_el_r10_zs = READ_ZS x8 x10;
269val r9_el_r10_zs = READ_ZS x9 x10;
270
271val _ = add_decompiled("r8_el_r10_zs",r8_el_r10_zs,4,SOME 4);
272val _ = add_decompiled("r9_el_r10_zs",r9_el_r10_zs,4,SOME 4);
273
274(* write zs *)
275
276fun WRITE_ZS (at,wt,rt) (a,w,r) = let
277  val ((th,_,_),_) = x64_spec_memory64 (x64_encode ("mov [8*"^a^"+r15],"^at))
278  val th = SPEC_FRAME_RULE th ``zR 13w xa * zR 14w ya *
279                 cond (bignum_mem p df f xa xs ya ys za zs /\
280                       w2n (^r:word64) < LENGTH zs)``
281  val th = Q.INST [`r15`|->`za`] th
282  val (th,goal) = SPEC_WEAKEN_RULE th
283    ``let zs = LUPDATE ^rt (w2n ^r) zs in
284        zPC (rip + 0x4w) * zR ^wt ^rt * zR ^w ^r *
285        zBIGNUMS (xa,xs,ya,ys,za,zs,p)``
286  val lemma = prove(goal,
287    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
288      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM,LET_DEF] \\ REPEAT STRIP_TAC
289    \\ Q.LIST_EXISTS_TAC [`df`,`(0x8w * ^r + za =+ ^rt) f`]
290    \\ FULL_SIMP_TAC (std_ss++star_ss) []
291    \\ FULL_SIMP_TAC std_ss [bignum_mem_def]
292    \\ IMP_RES_TAC LESS_LENGTH_IMP
293    \\ POP_ASSUM (ASSUME_TAC o GSYM)
294    \\ Q.ABBREV_TAC `y = EL (w2n ^r) zs` \\ POP_ASSUM (K ALL_TAC)
295    \\ FULL_SIMP_TAC std_ss [APPEND,GSYM APPEND_ASSOC,LUPDATE_LENGTH]
296    \\ FULL_SIMP_TAC std_ss [array64_APPEND,array64_def]
297    \\ `za + n2w (8 * LENGTH ys1) = 0x8w * ^r + za` by ALL_TAC THEN1
298      (Cases_on `^r` \\ FULL_SIMP_TAC (srw_ss()) [word_mul_n2w])
299    \\ FULL_SIMP_TAC std_ss []
300    \\ Cases_on `xa = ya` \\ FULL_SIMP_TAC std_ss [] \\ SEP_WRITE_TAC
301    \\ FULL_SIMP_TAC (std_ss++star_ss) [])
302  val th = MP th lemma
303  val th = th |> Q.GEN `df` |> Q.GEN `f` |> SIMP_RULE std_ss [SPEC_PRE_EXISTS]
304  val (th,goal) = SPEC_STRENGTHEN_RULE th
305    ``zPC rip * zR ^wt ^rt * zR ^w ^r *
306      zBIGNUMS (xa,xs,ya,ys,za,zs,p) * cond (w2n ^r < LENGTH zs)``
307  val lemma = prove(goal,
308    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
309      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM] \\ REPEAT STRIP_TAC
310    \\ Q.LIST_EXISTS_TAC [`m`,`dm`] \\ FULL_SIMP_TAC (std_ss++star_ss) []
311    \\ FULL_SIMP_TAC std_ss [bignum_mem_def]
312    \\ IMP_RES_TAC ALIGNED64_IMP \\ FULL_SIMP_TAC std_ss [GSYM word_mul_n2w]
313    \\ IMP_RES_TAC LESS_LENGTH_IMP
314    \\ Q.ABBREV_TAC `y = EL (w2n (^r:word64)) zs` \\ POP_ASSUM (K ALL_TAC)
315    \\ FINISH_TAC)
316  val th = MP th lemma
317  val th = th |> INST [``rip:word64``|->``p:word64``]
318  val _ = add_compiled [SIMP_RULE std_ss [LET_DEF] th]
319  in th end;
320
321val mov_zs_r10 = WRITE_ZS x0 x10;
322val mov_zs_r11 = WRITE_ZS x0 x11;
323val mov_zs_r12 = WRITE_ZS x0 x12;
324val mov_zs_r10 = WRITE_ZS x1 x10;
325val mov_zs_r11 = WRITE_ZS x1 x11;
326val mov_zs_r12 = WRITE_ZS x1 x12;
327val mov_zs_r10 = WRITE_ZS x2 x10;
328val mov_zs_r10 = WRITE_ZS x7 x10;
329val mov_zs_r10 = WRITE_ZS x8 x10;
330val mov_zs_r11 = WRITE_ZS x8 x11;
331val mov_zs_r12 = WRITE_ZS x8 x12;
332
333val _ = add_decompiled("lupdate_r10_zs_with_r8",mov_zs_r10,4,SOME 4);
334
335(* swap xs ys *)
336
337val SWAP_XS_YS = let
338  val ((th,_,_),_) = x64_spec_memory64 (x64_encode ("xchg r13,r14"))
339  val th = SPEC_FRAME_RULE th ``zR 15w za * zMEMORY64 df f *
340                 cond (bignum_mem p df f xa xs ya ys za zs)``
341  val th = Q.INST [`r13`|->`xa`,`r14`|->`ya`] th
342  val (th,goal) = SPEC_WEAKEN_RULE th
343    ``zPC (rip + 0x3w) * zBIGNUMS (ya,ys,xa,xs,za,zs,p)``
344  val lemma = prove(goal,
345    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
346      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM,LET_DEF] \\ REPEAT STRIP_TAC
347    \\ Q.LIST_EXISTS_TAC [`df`,`f`]
348    \\ FULL_SIMP_TAC (std_ss++star_ss) []
349    \\ FULL_SIMP_TAC std_ss [bignum_mem_def]
350    \\ SRW_TAC [] [] \\ FULL_SIMP_TAC (std_ss++star_ss) []);
351  val th = MP th lemma
352  val th = th |> Q.GEN `df` |> Q.GEN `f` |> SIMP_RULE std_ss [SPEC_PRE_EXISTS]
353  val (th,goal) = SPEC_STRENGTHEN_RULE th
354    ``zPC rip * zBIGNUMS (xa,xs,ya,ys,za,zs,p)``
355  val lemma = prove(goal,
356    FULL_SIMP_TAC (std_ss++sep_cond_ss) [zBIGNUMS_def,SEP_CLAUSES,
357      cond_STAR,SEP_IMP_def,SEP_EXISTS_THM] \\ REPEAT STRIP_TAC
358    \\ Q.LIST_EXISTS_TAC [`m`,`dm`] \\ FULL_SIMP_TAC (std_ss++star_ss) [])
359  val th = MP th lemma
360  val th = th |> INST [``rip:word64``|->``p:word64``]
361  val _ = add_compiled [SIMP_RULE std_ss [LET_DEF] th]
362  in th end;
363
364val _ = print_compiler_grammar ();
365
366(* compare *)
367
368val (res,x64_cmp_def,x64_cmp_pre_def) = x64_compile `
369  x64_cmp (r10:word64,xs:word64 list,ys:word64 list) =
370    if r10 = 0w then (r10,xs,ys) else
371      let r10 = r10 - 1w in
372      let r8 = EL (w2n r10) xs in
373      let r9 = EL (w2n r10) ys in
374        if r8 = r9 then
375          x64_cmp (r10,xs,ys)
376        else if r8 <+ r9 then let r10 = 1w in (r10,xs,ys)
377                         else let r10 = 2w in (r10,xs,ys)`
378
379val (res,x64_compare_def,x64_compare_pre_def) = x64_compile `
380  x64_compare (r10:word64,r11,xs:word64 list,ys:word64 list) =
381    if r10 <+ r11 then let r10 = 1w in (r10,xs,ys) else
382    if r11 <+ r10 then let r10 = 2w in (r10,xs,ys) else
383      let (r10,xs,ys) = x64_cmp (r10,xs,ys) in
384        (r10,xs,ys)`
385
386val x64_header_def = Define `
387  x64_header (s,xs:word64 list) = n2w (LENGTH xs * 2) + if s then 1w else 0w:word64`;
388
389val (x64_icompare_res,x64_icompare_def,x64_icompare_pre_def) = x64_compile `
390  x64_icompare (r10:word64,r11,xs:word64 list,ys:word64 list) =
391    if r10 && 1w = 0w then
392      if ~(r11 && 1w = 0w) then let r10 = 2w in (r10,xs,ys) else
393        let r10 = r10 >>> 1 in
394        let r11 = r11 >>> 1 in
395        let (r10,xs,ys) = x64_compare (r10,r11,xs,ys) in
396          (r10,xs,ys)
397    else
398      if r11 && 1w = 0w then let r10 = 1w in (r10,xs,ys) else
399        let r10 = r10 >>> 1 in
400        let r11 = r11 >>> 1 in
401        let (r10,xs,ys) = x64_compare (r10,r11,xs,ys) in
402          if r10 = 0w then (r10,xs,ys) else
403            let r10 = r10 ?? 3w in (r10,xs,ys)`
404
405val cmp2w_def = Define `
406  (cmp2w NONE = 0w:word64) /\
407  (cmp2w (SOME T) = 1w) /\
408  (cmp2w (SOME F) = 2w)`;
409
410val x64_cmp_thm = prove(
411  ``!xs ys xs1 ys1.
412      (LENGTH ys = LENGTH xs) /\ LENGTH xs < dimword(:64) ==>
413      x64_cmp_pre (n2w (LENGTH xs),xs++xs1,ys++ys1) /\
414      (x64_cmp (n2w (LENGTH xs),xs++xs1,ys++ys1) =
415       (cmp2w (mw_cmp xs ys),xs++xs1,ys++ys1))``,
416  HO_MATCH_MP_TAC SNOC_INDUCT \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL]
417  \\ STRIP_TAC THEN1
418   (REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [x64_cmp_def,Once x64_cmp_pre_def]
419    \\ FULL_SIMP_TAC std_ss [Once mw_cmp_def,cmp2w_def,APPEND])
420  \\ NTAC 7 STRIP_TAC
421  \\ `(ys = []) \/ ?y ys2. ys = SNOC y ys2` by METIS_TAC [SNOC_CASES]
422  \\ FULL_SIMP_TAC (srw_ss()) [] \\ FULL_SIMP_TAC std_ss [GSYM SNOC_APPEND,ADD1]
423  \\ `LENGTH xs < dimword (:64)` by (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
424  \\ RES_TAC \\ ONCE_REWRITE_TAC [x64_cmp_def,x64_cmp_pre_def]
425  \\ SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB]
426  \\ FULL_SIMP_TAC (srw_ss()) [n2w_11,word_add_n2w,LET_DEF]
427  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]
428  \\ STRIP_TAC THEN1 DECIDE_TAC
429  \\ FULL_SIMP_TAC (srw_ss()) [rich_listTheory.EL_LENGTH_APPEND]
430  \\ Q.PAT_X_ASSUM `LENGTH ys2 = LENGTH xs` (ASSUME_TAC o GSYM)
431  \\ FULL_SIMP_TAC (srw_ss()) [rich_listTheory.EL_LENGTH_APPEND]
432  \\ ONCE_REWRITE_TAC [EQ_SYM_EQ]
433  \\ SIMP_TAC std_ss [Once mw_cmp_def]
434  \\ FULL_SIMP_TAC (srw_ss()) []
435  \\ FULL_SIMP_TAC std_ss [GSYM SNOC_APPEND,FRONT_SNOC]
436  \\ SRW_TAC [] [cmp2w_def])
437  |> Q.SPECL [`xs`,`ys`,`[]`,`[]`]
438  |> SIMP_RULE std_ss [APPEND_NIL];
439
440val x64_compare_thm = prove(
441  ``LENGTH xs < dimword (:64) /\ LENGTH ys < dimword (:64) ==>
442    x64_compare_pre (n2w (LENGTH xs),n2w (LENGTH ys),xs,ys) /\
443    (x64_compare (n2w (LENGTH xs),n2w (LENGTH ys),xs,ys) =
444     (cmp2w (mw_compare xs ys),xs,ys))``,
445  SIMP_TAC (srw_ss()) [x64_compare_def,x64_compare_pre_def,
446    n2w_11,WORD_LO,LET_DEF,mw_compare_def] \\ SRW_TAC [] [cmp2w_def]
447  \\ `LENGTH xs = LENGTH ys` by DECIDE_TAC
448  \\ MP_TAC x64_cmp_thm \\ FULL_SIMP_TAC (srw_ss()) []);
449
450val x64_header_sign = prove(
451  ``(x64_header (s,xs) && 1w = 0w) = ~s``,
452  SIMP_TAC std_ss [x64_header_def,GSYM word_mul_n2w]
453  \\ Q.SPEC_TAC (`n2w (LENGTH xs)`,`w`) \\ Cases_on `s`
454  \\ FULL_SIMP_TAC std_ss [] \\ blastLib.BBLAST_TAC);
455
456val x64_length_lemma = prove(
457  ``(w * 2w + if s then 0x1w else 0x0w) >>> 1 = (w * 2w:word64) >>> 1``,
458  Cases_on `s` \\ FULL_SIMP_TAC std_ss [] \\ blastLib.BBLAST_TAC);
459
460val x64_length = prove(
461  ``LENGTH xs < dimword (:63) ==>
462    (x64_header (s,xs) >>> 1 = n2w (LENGTH xs))``,
463  FULL_SIMP_TAC std_ss [x64_header_def,GSYM word_mul_n2w,x64_length_lemma]
464  \\ SIMP_TAC std_ss [GSYM w2n_11,w2n_lsr,w2n_n2w,word_mul_n2w]
465  \\ FULL_SIMP_TAC (srw_ss()) [] \\ REPEAT STRIP_TAC
466  \\ `(LENGTH xs * 2) < 18446744073709551616` by DECIDE_TAC
467  \\ `LENGTH xs < 18446744073709551616` by DECIDE_TAC
468  \\ FULL_SIMP_TAC (srw_ss()) [MULT_DIV]);
469
470val dim63_IMP_dim64 = prove(
471  ``n < dimword (:63) ==> n < dimword (:64)``,
472  FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC);
473
474val x64_icompare_thm = prove(
475  ``LENGTH xs < dimword (:63) /\ LENGTH ys < dimword (:63) ==>
476    x64_icompare_pre (x64_header (s,xs),x64_header (t,ys),xs,ys) /\
477    (x64_icompare (x64_header (s,xs),x64_header (t,ys),xs,ys) =
478     (cmp2w (mwi_compare (s,xs) (t,ys)),xs,ys))``,
479  FULL_SIMP_TAC std_ss [x64_icompare_def,x64_icompare_pre_def,x64_header_sign,
480    x64_length,LET_DEF] \\ STRIP_TAC \\ IMP_RES_TAC dim63_IMP_dim64
481  \\ FULL_SIMP_TAC std_ss [x64_compare_thm,mwi_compare_def]
482  \\ Cases_on `s` \\ Cases_on `t` \\ FULL_SIMP_TAC std_ss [cmp2w_def]
483  \\ Cases_on `mw_compare xs ys` \\ FULL_SIMP_TAC std_ss [cmp2w_def,option_eq_def]
484  \\ Cases_on `x` \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,option_eq_def,n2w_11]);
485
486(* addition *)
487
488val (res,x64_add_loop_def) = x64_decompile_no_status "x64_add_loop" `
489      inc r1
490      inc r2
491      add r1,0
492      jmp L2
493  L1: insert r8_el_r10_xs
494      insert r9_el_r10_ys
495      adc r8,r9
496      insert lupdate_r10_zs_with_r8
497      lea r10,[r10+1]
498  L2: loop L1
499      mov r1,r2
500      mov r9,0
501      jmp L4
502  L3: insert r8_el_r10_xs
503      adc r8,r9
504      insert lupdate_r10_zs_with_r8
505      lea r10,[r10+1]
506  L4: loop L3
507      jnb L5
508      mov r8,1
509      insert lupdate_r10_zs_with_r8
510      lea r10,[r10+1]
511  L5:`
512
513val (x64_add_res,x64_add_def) = x64_decompile "x64_add" `
514  sub r2,r1
515  insert x64_add_loop`;
516
517val _ = add_compiled [x64_add_res]
518
519val SNOC_INTRO = prove(
520  ``xs1 ++ x::(xs ++ xs2) = SNOC x xs1 ++ (xs ++ xs2)``,
521  FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]);
522
523val LUPDATE_SNOC = prove(
524  ``(LENGTH zs1 = LENGTH xs1) ==>
525    (LUPDATE x (LENGTH xs1) (SNOC y zs1 ++ (t ++ zs2)) =
526     (SNOC x zs1 ++ (t ++ zs2)))``,
527  ONCE_REWRITE_TAC [EQ_SYM_EQ]
528  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,LUPDATE_LENGTH]);
529
530val bool2num_thm = prove(``!b. bool2num b = b2n b``,Cases \\ EVAL_TAC)
531
532val x64_add_loop1_thm = prove(
533  ``!xs ys zs xs1 ys1 zs1 xs2 ys2 zs2
534     z_af z_of c z_pf z_sf z_zf r8 r9.
535      (LENGTH ys1 = LENGTH xs1) /\ (LENGTH zs1 = LENGTH xs1) /\
536      (LENGTH ys = LENGTH xs) /\ (LENGTH zs = LENGTH xs) /\
537      LENGTH (xs1 ++ xs) + 1 < 18446744073709551616 ==>
538      ?r8' r9' z_af' z_of' z_pf' z_sf' z_zf'.
539        x64_add_loop1_pre (n2w (LENGTH xs + 1),r8,r9,n2w (LENGTH xs1),
540          xs1 ++ xs ++ xs2, ys1 ++ ys ++ ys2,z_af,SOME c,
541          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) /\
542        (x64_add_loop1 (n2w (LENGTH xs + 1),r8,r9,n2w (LENGTH xs1),
543          xs1 ++ xs ++ xs2, ys1 ++ ys ++ ys2,z_af,SOME c,
544          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) =
545          (0w,r8',r9',n2w (LENGTH (xs1++xs)),xs1 ++ xs ++ xs2,ys1 ++ ys ++ ys2,z_af',
546             SOME (SND (mw_add xs ys c)),z_of',z_pf',z_sf',z_zf',
547                        zs1 ++ FST (mw_add xs ys c) ++ zs2))``,
548  Induct THEN1
549   (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_add_def]
550    \\ ONCE_REWRITE_TAC [x64_add_loop_def]
551    \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_add_def,LET_DEF])
552  \\ Cases_on `ys` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1]
553  \\ ONCE_REWRITE_TAC [x64_add_loop_def]
554  \\ FULL_SIMP_TAC (srw_ss()) [LET_DEF]
555  \\ REPEAT STRIP_TAC
556  \\ `LENGTH xs < 18446744073709551616 /\
557      LENGTH xs + 1 < 18446744073709551616 /\
558      LENGTH xs + 1 + 1 < 18446744073709551616` by DECIDE_TAC
559  \\ `LENGTH xs1 < 18446744073709551616 /\
560      LENGTH xs1 + 1 < 18446744073709551616` by DECIDE_TAC
561  \\ FULL_SIMP_TAC std_ss []
562  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,
563        rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL]
564  \\ Q.PAT_X_ASSUM `LENGTH ys1 = LENGTH xs1` (ASSUME_TAC o GSYM)
565  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,
566        rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL]
567  \\ SIMP_TAC std_ss [GSYM word_sub_def,GSYM word_add_n2w,WORD_ADD_SUB]
568  \\ SIMP_TAC std_ss [word_add_n2w]
569  \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,APPEND]
570  \\ SIMP_TAC std_ss [SNOC_INTRO]
571  \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss []
572  \\ `LENGTH xs1 + 1 = LENGTH (SNOC h' xs1)` by
573    FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1] \\ ASM_SIMP_TAC std_ss []
574  \\ ASM_SIMP_TAC std_ss [LUPDATE_SNOC]
575  \\ SEP_I_TAC "x64_add_loop1" \\ POP_ASSUM MP_TAC
576  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
577  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
578  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
579  \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_add_def,
580       LET_DEF,single_add_def,bool2num_thm]
581  \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV)
582  \\ FULL_SIMP_TAC (srw_ss()) [b2w_def] \\ DECIDE_TAC)
583
584val x64_add_loop2_thm = prove(
585  ``!xs zs xs1 zs1 xs2 zs2
586     z_af z_of c z_pf z_sf z_zf r8.
587      (LENGTH zs1 = LENGTH xs1) /\ (LENGTH zs = LENGTH xs) /\
588      LENGTH (xs1 ++ xs) + 1 < 18446744073709551616 ==>
589      ?r8' r9' z_af' z_of' z_pf' z_sf' z_zf'.
590        x64_add_loop2_pre (n2w (LENGTH xs + 1),r8,0w,n2w (LENGTH xs1),
591          xs1 ++ xs ++ xs2,z_af,SOME c,
592          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) /\
593        (x64_add_loop2 (n2w (LENGTH xs + 1),r8,0w,n2w (LENGTH xs1),
594          xs1 ++ xs ++ xs2,z_af,SOME c,
595          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) =
596          (0w,r8',r9',n2w (LENGTH (xs1++xs)),xs1 ++ xs ++ xs2,z_af',
597             SOME (SND (mw_add xs (MAP (\x.0w) xs) c)),z_of',z_pf',z_sf',z_zf',
598                        zs1 ++ FST (mw_add xs (MAP (\x.0w) xs) c) ++ zs2))``,
599  Induct THEN1
600   (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_add_def]
601    \\ ONCE_REWRITE_TAC [x64_add_loop_def]
602    \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_add_def,LET_DEF])
603  \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1]
604  \\ ONCE_REWRITE_TAC [x64_add_loop_def]
605  \\ FULL_SIMP_TAC (srw_ss()) [LET_DEF]
606  \\ REPEAT STRIP_TAC
607  \\ `LENGTH xs < 18446744073709551616 /\
608      LENGTH xs + 1 < 18446744073709551616 /\
609      LENGTH xs + 1 + 1 < 18446744073709551616` by DECIDE_TAC
610  \\ `LENGTH xs1 < 18446744073709551616 /\
611      LENGTH xs1 + 1 < 18446744073709551616` by DECIDE_TAC
612  \\ FULL_SIMP_TAC std_ss []
613  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,
614        rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL]
615  \\ SIMP_TAC std_ss [GSYM word_sub_def,GSYM word_add_n2w,WORD_ADD_SUB]
616  \\ SIMP_TAC std_ss [word_add_n2w]
617  \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,APPEND]
618  \\ SIMP_TAC std_ss [SNOC_INTRO]
619  \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss []
620  \\ `LENGTH xs1 + 1 = LENGTH (SNOC h xs1)` by
621    FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1] \\ ASM_SIMP_TAC std_ss []
622  \\ ASM_SIMP_TAC std_ss [LUPDATE_SNOC]
623  \\ SEP_I_TAC "x64_add_loop2" \\ POP_ASSUM MP_TAC
624  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
625  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
626  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
627  \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_add_def,
628       LET_DEF,single_add_def,bool2num_thm]
629  \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV)
630  \\ FULL_SIMP_TAC (srw_ss()) [b2w_def]
631  \\ DECIDE_TAC)
632
633val x64_add_thm = prove(
634  ``!xs ys zs zs2.
635      LENGTH ys <= LENGTH xs /\ (LENGTH zs = LENGTH (mw_addv xs ys F)) /\
636      LENGTH xs + 1 < 18446744073709551616 ==>
637      ?r1' r2' r8' r9' r10'.
638        x64_add_pre (n2w (LENGTH ys),n2w (LENGTH xs),0w,0w,0w,xs,ys,zs++zs2) /\
639        (x64_add (n2w (LENGTH ys),n2w (LENGTH xs),0w,0w,0w,xs,ys,zs++zs2) =
640          (r1',r2',r8',r9',n2w (LENGTH (mw_addv xs ys F)),xs,ys,mw_addv xs ys F ++ zs2))``,
641  REPEAT STRIP_TAC \\ IMP_RES_TAC LESS_EQ_LENGTH
642  \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,x64_add_def,LET_DEF]
643  \\ ONCE_REWRITE_TAC [ADD_COMM]
644  \\ SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB]
645  \\ ONCE_REWRITE_TAC [x64_add_loop_def]
646  \\ SIMP_TAC (srw_ss()) [LET_DEF,w2n_n2w,word_add_n2w]
647  \\ `~((18446744073709551616 <= (LENGTH ys + 1) MOD 18446744073709551616))` by ALL_TAC
648  THEN1 (FULL_SIMP_TAC std_ss [DECIDE ``~(n <= m) = m < n:num``])
649  \\ FULL_SIMP_TAC std_ss []
650  \\ (x64_add_loop1_thm |> Q.SPECL [`xs1`,`ys`,`zs`,`[]`,`[]`,`[]`,`xs2`,`[]`,`zs2`]
651      |> GEN_ALL |> MP_TAC)
652  \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND,APPEND_NIL] \\ STRIP_TAC
653  \\ Q.PAT_X_ASSUM `LENGTH xs1 = LENGTH ys` (ASSUME_TAC o GSYM)
654  \\ FULL_SIMP_TAC std_ss [mw_addv_EQ_mw_add,LET_DEF]
655  \\ `?qs1 c1. mw_add xs1 ys F = (qs1,c1)` by METIS_TAC [PAIR]
656  \\ `?qs2 c2. mw_add xs2 (MAP (\x.0w) xs2) c1 = (qs2,c2)` by METIS_TAC [PAIR]
657  \\ FULL_SIMP_TAC std_ss []
658  \\ Q.ABBREV_TAC `qs3 = if c2 then [0x1w] else []:word64 list`
659  \\ `?zs1 zs3 zs4. (zs = zs1 ++ zs3 ++ zs4) /\
660        (LENGTH zs1 = LENGTH xs1) /\
661        (LENGTH zs3 = LENGTH xs2) /\
662        (LENGTH zs4 = LENGTH qs3)` by ALL_TAC THEN1
663   (IMP_RES_TAC LENGTH_mw_add
664    \\ `LENGTH xs1 <= LENGTH zs` by ALL_TAC THEN1
665          (FULL_SIMP_TAC std_ss [LENGTH_APPEND] \\ DECIDE_TAC)
666    \\ IMP_RES_TAC LESS_EQ_LENGTH \\ FULL_SIMP_TAC std_ss []
667    \\ Q.EXISTS_TAC `xs1'` \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND]
668    \\ `LENGTH xs2 <= LENGTH xs2'` by ALL_TAC THEN1
669          (FULL_SIMP_TAC std_ss [LENGTH_APPEND] \\ DECIDE_TAC)
670    \\ IMP_RES_TAC LESS_EQ_LENGTH \\ FULL_SIMP_TAC std_ss []
671    \\ Q.LIST_EXISTS_TAC [`xs1''`,`xs2''`]
672    \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC,LENGTH_APPEND]
673    \\ DECIDE_TAC)
674  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC]
675  \\ SEP_I_TAC "x64_add_loop1" \\ POP_ASSUM MP_TAC
676  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
677  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
678  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
679  \\ (x64_add_loop2_thm |> Q.SPECL [`xs`,`ys`,`xs1`,`zs1`,`[]`] |> GEN_ALL
680       |> SIMP_RULE std_ss [GSYM APPEND_ASSOC,APPEND_NIL] |> ASSUME_TAC)
681  \\ SEP_I_TAC "x64_add_loop2" \\ POP_ASSUM MP_TAC
682  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
683  THEN1 (IMP_RES_TAC LENGTH_mw_add \\ FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
684  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
685  \\ REV (Cases_on `c2`) \\ FULL_SIMP_TAC std_ss []
686  THEN1 (Q.UNABBREV_TAC `qs3`
687         \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL,APPEND_NIL,LENGTH_APPEND])
688  \\ `LENGTH xs1 + LENGTH xs2 < 18446744073709551616` by DECIDE_TAC
689  \\ FULL_SIMP_TAC (srw_ss()) []
690  \\ IMP_RES_TAC LENGTH_mw_add
691  \\ Q.UNABBREV_TAC `qs3` \\ FULL_SIMP_TAC std_ss [LENGTH]
692  \\ STRIP_TAC THEN1 DECIDE_TAC
693  \\ Cases_on `zs4` \\ FULL_SIMP_TAC std_ss [LENGTH]
694  \\ Cases_on `t` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1]
695  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,word_add_n2w,ADD_ASSOC]
696  \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC,GSYM LENGTH_APPEND,LUPDATE_LENGTH]);
697
698(* subtraction *)
699
700val (res,x64_sub_loop_def) = x64_decompile_no_status "x64_sub_loop" `
701      inc r1
702      inc r2
703      sub r8,0
704      jmp L2
705  L1: insert r8_el_r10_xs
706      insert r9_el_r10_ys
707      sbb r8,r9
708      insert lupdate_r10_zs_with_r8
709      lea r10,[r10+1]
710  L2: loop L1
711      mov r1,r2
712      mov r9,0
713      jmp L4
714  L3: insert r8_el_r10_xs
715      sbb r8,r9
716      insert lupdate_r10_zs_with_r8
717      lea r10,[r10+1]
718  L4: loop L3`
719
720val (x64_fix_res,x64_fix_def) = x64_decompile "x64_fix" `
721  L1: test r10,r10
722      je L2
723      dec r10
724      insert r8_el_r10_zs
725      test r8,r8
726      je L1
727      inc r10
728  L2: `
729
730val _ = add_compiled [x64_fix_res];
731
732val (x64_sub_res,x64_sub_def) = x64_decompile "x64_sub" `
733      sub r2,r1
734      insert x64_sub_loop
735      insert x64_fix`
736
737val _ = add_compiled [x64_sub_res]
738
739val x64_fix_thm = prove(
740  ``!zs zs1 r8.
741      LENGTH zs < dimword(:64) ==>
742      ?r8'.
743        x64_fix_pre (r8,n2w (LENGTH zs),zs++zs1) /\
744        (x64_fix (r8,n2w (LENGTH zs),zs++zs1) =
745         (r8',n2w (LENGTH (mw_fix zs)),
746          mw_fix zs ++ REPLICATE (LENGTH zs - LENGTH (mw_fix zs)) 0w ++ zs1))``,
747  HO_MATCH_MP_TAC SNOC_INDUCT \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL]
748  \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [x64_fix_def,mw_fix_def]
749  \\ FULL_SIMP_TAC (srw_ss()) [rich_listTheory.REPLICATE,LET_DEF]
750  \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,ADD1,GSYM word_sub_def,WORD_ADD_SUB]
751  \\ IMP_RES_TAC (DECIDE ``n + 1 < k ==> n < k:num``)
752  \\ FULL_SIMP_TAC (srw_ss()) [w2n_n2w]
753  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,
754       rich_listTheory.EL_LENGTH_APPEND,NULL,HD]
755  \\ REV (Cases_on `x = 0w`) \\ FULL_SIMP_TAC std_ss [] THEN1
756   (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,REPLICATE,APPEND,
757      GSYM APPEND_ASSOC,word_add_n2w] \\ DECIDE_TAC)
758  \\ SEP_I_TAC "x64_fix" \\ FULL_SIMP_TAC std_ss []
759  \\ STRIP_TAC THEN1 DECIDE_TAC \\ AP_TERM_TAC
760  \\ `LENGTH (mw_fix zs) <= LENGTH zs` by
761      FULL_SIMP_TAC std_ss [LENGTH_mw_fix]
762  \\ `LENGTH zs + 1 - LENGTH (mw_fix zs) =
763        SUC (LENGTH zs - LENGTH (mw_fix zs))` by DECIDE_TAC
764  \\ FULL_SIMP_TAC std_ss [REPLICATE_SNOC]
765  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND])
766
767val sub_borrow_lemma = prove(
768  ``!h:word64 h':word64 c.
769     (18446744073709551616 <= b2n ~c + (w2n h' + w2n (~h))) =
770      ~(w2n h' < b2n c + w2n h)``,
771  Cases \\ Cases \\ Cases
772  \\ `(18446744073709551615 - n) < 18446744073709551616` by DECIDE_TAC
773  \\ FULL_SIMP_TAC (srw_ss()) [b2n_def,word_1comp_n2w] \\ DECIDE_TAC);
774
775val x64_sub_loop1_thm = prove(
776  ``!xs ys zs xs1 ys1 zs1 xs2 ys2 zs2
777     z_af z_of c z_pf z_sf z_zf r8 r9.
778      (LENGTH ys1 = LENGTH xs1) /\ (LENGTH zs1 = LENGTH xs1) /\
779      (LENGTH ys = LENGTH xs) /\ (LENGTH zs = LENGTH xs) /\
780      LENGTH (xs1 ++ xs) + 1 < 18446744073709551616 ==>
781      ?r8' r9' z_af' z_of' z_pf' z_sf' z_zf'.
782        x64_sub_loop1_pre (n2w (LENGTH xs + 1),r8,r9,n2w (LENGTH xs1),
783          xs1 ++ xs ++ xs2, ys1 ++ ys ++ ys2,z_af,SOME c,
784          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) /\
785        (x64_sub_loop1 (n2w (LENGTH xs + 1),r8,r9,n2w (LENGTH xs1),
786          xs1 ++ xs ++ xs2, ys1 ++ ys ++ ys2,z_af,SOME c,
787          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) =
788          (0w,r8',r9',n2w (LENGTH (xs1++xs)),xs1 ++ xs ++ xs2,ys1 ++ ys ++ ys2,z_af',
789             SOME (~SND (mw_sub xs ys ~c)),z_of',z_pf',z_sf',z_zf',
790                        zs1 ++ FST (mw_sub xs ys ~c) ++ zs2))``,
791  Induct THEN1
792   (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def]
793    \\ ONCE_REWRITE_TAC [x64_sub_loop_def]
794    \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def,LET_DEF])
795  \\ Cases_on `ys` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1]
796  \\ ONCE_REWRITE_TAC [x64_sub_loop_def]
797  \\ FULL_SIMP_TAC (srw_ss()) [LET_DEF]
798  \\ REPEAT STRIP_TAC
799  \\ `LENGTH xs < 18446744073709551616 /\
800      LENGTH xs + 1 < 18446744073709551616 /\
801      LENGTH xs + 1 + 1 < 18446744073709551616` by DECIDE_TAC
802  \\ `LENGTH xs1 < 18446744073709551616 /\
803      LENGTH xs1 + 1 < 18446744073709551616` by DECIDE_TAC
804  \\ FULL_SIMP_TAC std_ss []
805  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,
806        rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL]
807  \\ Q.PAT_X_ASSUM `LENGTH ys1 = LENGTH xs1` (ASSUME_TAC o GSYM)
808  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,
809        rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL]
810  \\ SIMP_TAC std_ss [GSYM word_sub_def,GSYM word_add_n2w,WORD_ADD_SUB]
811  \\ SIMP_TAC std_ss [word_add_n2w]
812  \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,APPEND]
813  \\ SIMP_TAC std_ss [SNOC_INTRO]
814  \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss []
815  \\ `LENGTH xs1 + 1 = LENGTH (SNOC h' xs1)` by
816    FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1] \\ ASM_SIMP_TAC std_ss []
817  \\ ASM_SIMP_TAC std_ss [LUPDATE_SNOC]
818  \\ SEP_I_TAC "x64_sub_loop1" \\ POP_ASSUM MP_TAC
819  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
820  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
821  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
822  \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_sub_def,
823       LET_DEF,single_sub_def,bool2num_thm,single_add_def]
824  \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV)
825  \\ FULL_SIMP_TAC (srw_ss()) [b2w_def]
826  \\ `(18446744073709551616 <= b2n ~c + (w2n h' + w2n (~h))) =
827      ~(w2n h' < b2n c + w2n h)` by METIS_TAC [sub_borrow_lemma]
828  \\ FULL_SIMP_TAC std_ss [AC ADD_COMM ADD_ASSOC]
829  \\ REPEAT (STRIP_TAC THEN1 DECIDE_TAC)
830  \\ Cases_on `c` \\ FULL_SIMP_TAC std_ss [b2n_def]
831  \\ REPEAT (POP_ASSUM (K ALL_TAC))
832  \\ blastLib.BBLAST_TAC);
833
834val x64_sub_loop2_thm = prove(
835  ``!xs zs xs1 zs1 xs2 zs2
836     z_af z_of c z_pf z_sf z_zf r8.
837      (LENGTH zs1 = LENGTH xs1) /\ (LENGTH zs = LENGTH xs) /\
838      LENGTH (xs1 ++ xs) + 1 < 18446744073709551616 ==>
839      ?r8' r9' z_af' z_of' z_pf' z_sf' z_zf'.
840        x64_sub_loop2_pre (n2w (LENGTH xs + 1),r8,0w,n2w (LENGTH xs1),
841          xs1 ++ xs ++ xs2,z_af,SOME c,
842          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) /\
843        (x64_sub_loop2 (n2w (LENGTH xs + 1),r8,0w,n2w (LENGTH xs1),
844          xs1 ++ xs ++ xs2,z_af,SOME c,
845          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) =
846          (0w,r8',r9',n2w (LENGTH (xs1++xs)),xs1 ++ xs ++ xs2,z_af',
847             SOME (~SND (mw_sub xs [] ~c)),z_of',z_pf',z_sf',z_zf',
848                        zs1 ++ FST (mw_sub xs [] ~c) ++ zs2))``,
849  Induct THEN1
850   (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def]
851    \\ ONCE_REWRITE_TAC [x64_sub_loop_def]
852    \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def,LET_DEF])
853  \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1]
854  \\ ONCE_REWRITE_TAC [x64_sub_loop_def]
855  \\ FULL_SIMP_TAC (srw_ss()) [LET_DEF]
856  \\ REPEAT STRIP_TAC
857  \\ `LENGTH xs < 18446744073709551616 /\
858      LENGTH xs + 1 < 18446744073709551616 /\
859      LENGTH xs + 1 + 1 < 18446744073709551616` by DECIDE_TAC
860  \\ `LENGTH xs1 < 18446744073709551616 /\
861      LENGTH xs1 + 1 < 18446744073709551616` by DECIDE_TAC
862  \\ FULL_SIMP_TAC std_ss []
863  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,
864        rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,TL]
865  \\ SIMP_TAC std_ss [GSYM word_sub_def,GSYM word_add_n2w,WORD_ADD_SUB]
866  \\ SIMP_TAC std_ss [word_add_n2w]
867  \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,APPEND]
868  \\ SIMP_TAC std_ss [SNOC_INTRO]
869  \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss []
870  \\ `LENGTH xs1 + 1 = LENGTH (SNOC h xs1)` by
871    FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1] \\ ASM_SIMP_TAC std_ss []
872  \\ ASM_SIMP_TAC std_ss [LUPDATE_SNOC]
873  \\ SEP_I_TAC "x64_sub_loop2" \\ POP_ASSUM MP_TAC
874  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
875  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
876  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
877  \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_sub_def,
878       LET_DEF,single_add_def,bool2num_thm,single_sub_def]
879  \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV)
880  \\ FULL_SIMP_TAC (srw_ss()) [b2w_def]
881  \\ `(18446744073709551616 <= b2n ~c + (w2n h + w2n (~(0w:word64)))) =
882      ~(w2n h < b2n c + w2n (0w:word64))` by METIS_TAC [sub_borrow_lemma]
883  \\ FULL_SIMP_TAC (srw_ss()) [AC ADD_COMM ADD_ASSOC]
884  \\ REPEAT (STRIP_TAC THEN1 DECIDE_TAC)
885  \\ Cases_on `c` \\ FULL_SIMP_TAC std_ss [b2n_def]
886  \\ REPEAT (POP_ASSUM (K ALL_TAC))
887  \\ blastLib.BBLAST_TAC);
888
889val x64_sub_thm = prove(
890  ``!xs ys zs zs2.
891      LENGTH ys <= LENGTH xs /\ (LENGTH zs = LENGTH xs) /\
892      LENGTH xs + 1 < 18446744073709551616 ==>
893      ?r1' r2' r8' r9' r10'.
894        x64_sub_pre (n2w (LENGTH ys),n2w (LENGTH xs),0w,0w,0w,xs,ys,zs++zs2) /\
895        (x64_sub (n2w (LENGTH ys),n2w (LENGTH xs),0w,0w,0w,xs,ys,zs++zs2) =
896          (r1',r2',r8',r9',n2w (LENGTH (mw_subv xs ys)),xs,ys,
897           mw_subv xs ys ++ REPLICATE (LENGTH xs - LENGTH (mw_subv xs ys)) 0w ++ zs2))``,
898  REPEAT STRIP_TAC \\ IMP_RES_TAC LESS_EQ_LENGTH
899  \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,x64_sub_def,LET_DEF]
900  \\ ONCE_REWRITE_TAC [ADD_COMM]
901  \\ SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB]
902  \\ ONCE_REWRITE_TAC [x64_sub_loop_def]
903  \\ SIMP_TAC std_ss [LET_DEF,w2n_n2w,word_add_n2w,WORD_LO]
904  \\ FULL_SIMP_TAC (srw_ss()) []
905  \\ (x64_sub_loop1_thm |> Q.SPECL [`xs1`,`ys`,`zs`,`[]`,`[]`,`[]`,`xs2`,`[]`,`zs2`]
906      |> GEN_ALL |> MP_TAC)
907  \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND,APPEND_NIL] \\ STRIP_TAC
908  \\ Q.PAT_X_ASSUM `LENGTH xs1 = LENGTH ys` (ASSUME_TAC o GSYM)
909  \\ FULL_SIMP_TAC std_ss [mw_subv_def,LET_DEF]
910  \\ ASM_SIMP_TAC std_ss [mw_sub_APPEND]
911  \\ `?qs1 c1. mw_sub xs1 ys T = (qs1,c1)` by METIS_TAC [PAIR]
912  \\ `?qs2 c2. mw_sub xs2 [] c1 = (qs2,c2)` by METIS_TAC [PAIR]
913  \\ FULL_SIMP_TAC std_ss [LET_DEF]
914  \\ `?zs1 zs3. (zs = zs1 ++ zs3) /\
915        (LENGTH zs1 = LENGTH xs1) /\
916        (LENGTH zs3 = LENGTH xs2)` by ALL_TAC THEN1
917     (IMP_RES_TAC LENGTH_mw_sub \\ FULL_SIMP_TAC std_ss []
918      \\ `LENGTH qs1 <= LENGTH zs` by DECIDE_TAC
919      \\ IMP_RES_TAC LESS_EQ_LENGTH \\ FULL_SIMP_TAC std_ss []
920      \\ Q.LIST_EXISTS_TAC [`xs1'`,`xs2'`] \\ FULL_SIMP_TAC std_ss []
921      \\ `LENGTH (xs1' ++ xs2') = LENGTH (qs1 ++ qs2)` by ALL_TAC
922      \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND] \\ DECIDE_TAC)
923  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC]
924  \\ SEP_I_TAC "x64_sub_loop1" \\ POP_ASSUM MP_TAC
925  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
926  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
927  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
928  \\ (x64_sub_loop2_thm |> Q.SPECL [`xs`,`ys`,`xs1`,`zs1`,`[]`] |> GEN_ALL
929       |> SIMP_RULE std_ss [GSYM APPEND_ASSOC,APPEND_NIL] |> ASSUME_TAC)
930  \\ SEP_I_TAC "x64_sub_loop2" \\ POP_ASSUM MP_TAC
931  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
932  THEN1 (IMP_RES_TAC LENGTH_mw_sub \\ FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
933  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
934  \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC]
935  \\ IMP_RES_TAC LENGTH_mw_sub
936  \\ `LENGTH (xs1 ++ xs2) = LENGTH (qs1 ++ qs2)` by FULL_SIMP_TAC std_ss [LENGTH_APPEND]
937  \\ `LENGTH (qs1 ++ qs2) < dimword (:64)` by
938        (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
939  \\ FULL_SIMP_TAC std_ss []
940  \\ IMP_RES_TAC x64_fix_thm \\ SEP_I_TAC "x64_fix"
941  \\ FULL_SIMP_TAC std_ss []
942  \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,AC ADD_COMM ADD_ASSOC]);
943
944(* integer addition *)
945
946val (res,x64_iadd1_def,x64_iadd1_pre_def) = x64_compile `
947  x64_iadd1 (r1:word64,r2:word64,xs:word64 list,ys:word64 list,xa:word64,ya:word64) =
948    let r0 = 0w:word64 in
949      if r1 <+ r2 then
950        let (xa,xs,ya,ys) = (ya,ys,xa,xs) in
951        let r0 = 1w in
952          (r1,r2,r0,xs,ys,xa,ya)
953      else
954        let r8 = r1 in
955        let r1 = r2 in
956        let r2 = r8 in
957          (r1,r2,r0,xs,ys,xa,ya)`
958
959val (res,x64_iadd2_def,x64_iadd2_pre_def) = x64_compile `
960  x64_iadd2 (r1:word64,r2:word64,r10:word64,r12:word64,xs,ys,xa,ya) =
961    let r0 = 0w:word64 in
962      if r10 = 1w then
963        let (xa,xs,ya,ys) = (ya,ys,xa,xs) in
964        let r12 = r12 ?? 1w in
965        let r0 = 1w in
966          (r1,r2,r0,r12,xs,ys,xa,ya)
967      else
968        let r8 = r1 in
969        let r1 = r2 in
970        let r2 = r8 in
971          (r1,r2,r0,r12,xs:word64 list,ys:word64 list,xa:word64,ya:word64)`
972
973val (res,x64_iadd3_def,x64_iadd3_pre_def) = x64_compile `
974  x64_iadd3 (r0:word64,xs:word64 list,ys:word64 list,xa:word64,ya:word64) =
975      if r0 = 0w then (xs,ys,xa,ya) else
976        let (xa,xs,ya,ys) = (ya,ys,xa,xs) in
977          (xs,ys,xa,ya)`
978
979val (x64_iadd_res,x64_iadd_def,x64_iadd_pre_def) = x64_compile `
980  x64_iadd (r1:word64,r2:word64,xs:word64 list,ys:word64 list,zs:word64 list,xa,ya) =
981    let r10 = r1 && 1w in
982    let r11 = r2 && 1w in
983      if r10 = r11 then (* same sign *)
984        let r1 = r1 >>> 1 in
985        let r2 = r2 >>> 1 in
986        let (r1,r2,r0,xs,ys,xa,ya) = x64_iadd1 (r1,r2,xs,ys,xa,ya) in
987        let r8 = 0w in
988        let r9 = r8 in
989        let r10 = r8 in
990        let (r1,r2,r8,r9,r10,xs,ys,zs) = x64_add (r1,r2,r8,r9,r10,xs,ys,zs) in
991        let (xs,ys,xa,ya) = x64_iadd3 (r0,xs,ys,xa,ya) in
992        let r10 = r10 << 1 in
993        let r10 = r10 + r11 in
994          (r10,xs,ys,zs,xa,ya)
995      else (* signs differ *)
996        let r12 = r10 in
997        let r10 = r1 >>> 1 in
998        let r11 = r2 >>> 1 in
999        let (r10,xs,ys) = x64_compare (r10,r11,xs,ys) in
1000          if r10 = 0w then
1001            (r10,xs,ys,zs,xa,ya)
1002          else
1003            let (r1,r2,r0,r12,xs,ys,xa,ya) = x64_iadd2 (r1,r2,r10,r12,xs,ys,xa,ya) in
1004            let r8 = 0w in
1005            let r9 = r8 in
1006            let r10 = r8 in
1007            let r1 = r1 >>> 1 in
1008            let r2 = r2 >>> 1 in
1009            let (r1,r2,r8,r9,r10,xs,ys,zs) = x64_sub (r1,r2,r8,r9,r10,xs,ys,zs) in
1010            let (xs,ys,xa,ya) = x64_iadd3 (r0,xs,ys,xa,ya) in
1011            let r10 = r10 << 1 in
1012            let r10 = r10 + r12 in
1013              (r10,xs,ys,zs,xa,ya)`
1014
1015val x64_header_AND_1 = prove(
1016  ``x64_header (s,xs) && 0x1w = b2w s``,
1017  FULL_SIMP_TAC std_ss [x64_header_def,GSYM word_mul_n2w]
1018  \\ Cases_on `s` \\ FULL_SIMP_TAC std_ss [b2w_def,b2n_def]
1019  \\ blastLib.BBLAST_TAC);
1020
1021val x64_header_EQ = prove(
1022  ``(x64_header (s,xs) && 0x1w = x64_header (t,ys) && 0x1w) = (s = t)``,
1023  FULL_SIMP_TAC std_ss [x64_header_AND_1]
1024  \\ Cases_on `s` \\ Cases_on `t` \\ EVAL_TAC);
1025
1026val b2w_NOT = prove(
1027  ``!s. b2w s ?? 0x1w = b2w (~s):word64``,
1028  Cases \\ EVAL_TAC);
1029
1030val x64_iadd_thm = prove(
1031  ``LENGTH xs < dimword (:63) /\ LENGTH ys < dimword (:63) /\
1032    LENGTH xs + LENGTH ys <= LENGTH zs /\ mw_ok xs /\ mw_ok ys ==>
1033    ?zs1.
1034      x64_iadd_pre (x64_header (s,xs),x64_header (t,ys),xs,ys,zs,xa,ya) /\
1035      (x64_iadd (x64_header (s,xs),x64_header (t,ys),xs,ys,zs,xa,ya) =
1036        (x64_header (mwi_add (s,xs) (t,ys)),xs,ys,
1037         SND (mwi_add (s,xs) (t,ys))++zs1,xa,ya)) /\
1038      (LENGTH (SND (mwi_add (s,xs) (t,ys))++zs1) = LENGTH zs) ``,
1039  FULL_SIMP_TAC std_ss [x64_iadd_def,x64_iadd_pre_def,LET_DEF]
1040  \\ FULL_SIMP_TAC std_ss [x64_header_EQ,mwi_add_def,x64_length]
1041  \\ Cases_on `s <=> t` \\ FULL_SIMP_TAC std_ss []
1042  \\ REPEAT STRIP_TAC \\ IMP_RES_TAC dim63_IMP_dim64 THEN1
1043   (Cases_on `LENGTH ys <= LENGTH xs` \\ FULL_SIMP_TAC std_ss []
1044    \\ FULL_SIMP_TAC (srw_ss()) [x64_iadd1_def,WORD_LO,GSYM NOT_LESS,LET_DEF]
1045    THEN1
1046     (ASSUME_TAC x64_add_thm
1047      \\ `LENGTH (mw_addv xs ys F) <= LENGTH xs + LENGTH ys` by
1048            FULL_SIMP_TAC std_ss [LENGTH_mw_addv,NOT_LESS]
1049      \\ `LENGTH (mw_addv xs ys F) <= LENGTH zs` by DECIDE_TAC
1050      \\ IMP_RES_TAC LESS_EQ_LENGTH
1051      \\ FULL_SIMP_TAC std_ss []
1052      \\ SEP_I_TAC "x64_add" \\ POP_ASSUM MP_TAC
1053      \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
1054      THEN1 (FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC)
1055      \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND]
1056      \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,x64_iadd3_def,x64_iadd3_pre_def,LET_DEF]
1057      \\ FULL_SIMP_TAC std_ss [WORD_MUL_LSL,word_mul_n2w]
1058      \\ ONCE_REWRITE_TAC [WORD_AND_COMM]
1059      \\ FULL_SIMP_TAC std_ss [x64_header_AND_1]
1060      \\ FULL_SIMP_TAC std_ss [x64_header_def,AC MULT_COMM MULT_ASSOC]
1061      \\ Cases_on `t` \\ FULL_SIMP_TAC (srw_ss()) [b2w_def,b2n_def,
1062           AC ADD_COMM ADD_ASSOC,word_add_n2w])
1063    THEN1
1064     (ASSUME_TAC x64_add_thm
1065      \\ `LENGTH (mw_addv ys xs F) <= LENGTH ys + LENGTH xs` by
1066         (`LENGTH xs <= LENGTH ys` by DECIDE_TAC
1067          \\ FULL_SIMP_TAC std_ss [LENGTH_mw_addv])
1068      \\ `LENGTH (mw_addv ys xs F) <= LENGTH zs` by DECIDE_TAC
1069      \\ IMP_RES_TAC LESS_EQ_LENGTH
1070      \\ FULL_SIMP_TAC std_ss []
1071      \\ SEP_I_TAC "x64_add" \\ POP_ASSUM MP_TAC
1072      \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
1073      THEN1 (FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC)
1074      \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND]
1075      \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,x64_iadd3_def,x64_iadd3_pre_def,LET_DEF]
1076      \\ FULL_SIMP_TAC std_ss [WORD_MUL_LSL,word_mul_n2w]
1077      \\ ONCE_REWRITE_TAC [WORD_AND_COMM]
1078      \\ FULL_SIMP_TAC std_ss [x64_header_AND_1]
1079      \\ FULL_SIMP_TAC std_ss [x64_header_def,AC MULT_COMM MULT_ASSOC]
1080      \\ Cases_on `t` \\ FULL_SIMP_TAC (srw_ss()) [b2w_def,b2n_def,
1081           AC ADD_COMM ADD_ASSOC,word_add_n2w]))
1082  \\ FULL_SIMP_TAC std_ss [x64_compare_thm,mw_compare_thm]
1083  \\ Cases_on `mw2n ys = mw2n xs` \\ FULL_SIMP_TAC std_ss [cmp2w_def]
1084  THEN1 (FULL_SIMP_TAC (srw_ss()) [x64_header_def,APPEND,LENGTH])
1085  \\ Cases_on `mw2n xs < mw2n ys` \\ FULL_SIMP_TAC std_ss [GSYM NOT_LESS]
1086  \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,x64_iadd2_def,LET_DEF]
1087  THEN1
1088   (`LENGTH ys <= LENGTH zs` by DECIDE_TAC
1089    \\ IMP_RES_TAC LESS_EQ_LENGTH
1090    \\ FULL_SIMP_TAC std_ss []
1091    \\ ASSUME_TAC x64_sub_thm
1092    \\ FULL_SIMP_TAC (srw_ss()) [x64_length]
1093    \\ SEP_I_TAC "x64_sub" \\ POP_ASSUM MP_TAC
1094    \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
1095    \\ `mw2n xs <= mw2n ys` by DECIDE_TAC
1096    \\ IMP_RES_TAC mw2n_LESS
1097    THEN1 (FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC)
1098    \\ REPEAT STRIP_TAC
1099    \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,x64_iadd3_def,
1100         x64_iadd3_pre_def,LET_DEF,EVAL ``1w=0w:word64``]
1101    \\ SIMP_TAC (srw_ss()) [GSYM APPEND_ASSOC,LENGTH_REPLICATE]
1102    \\ STRIP_TAC THEN1
1103     (FULL_SIMP_TAC std_ss [WORD_MUL_LSL,word_mul_n2w]
1104      \\ ONCE_REWRITE_TAC [WORD_AND_COMM]
1105      \\ FULL_SIMP_TAC std_ss [x64_header_AND_1]
1106      \\ FULL_SIMP_TAC std_ss [x64_header_def,AC MULT_COMM MULT_ASSOC]
1107      \\ FULL_SIMP_TAC std_ss [b2w_NOT]
1108      \\ Cases_on `s` \\ FULL_SIMP_TAC (srw_ss()) [b2w_def,b2n_def,
1109           AC ADD_COMM ADD_ASSOC,word_add_n2w])
1110    \\ `LENGTH (mw_subv ys xs) <= LENGTH ys` by ASM_SIMP_TAC std_ss [LENGTH_mw_subv]
1111    \\ DECIDE_TAC)
1112  THEN1
1113   (`LENGTH xs <= LENGTH zs` by DECIDE_TAC
1114    \\ IMP_RES_TAC LESS_EQ_LENGTH
1115    \\ FULL_SIMP_TAC std_ss []
1116    \\ ASSUME_TAC x64_sub_thm
1117    \\ FULL_SIMP_TAC (srw_ss()) [x64_length]
1118    \\ SEP_I_TAC "x64_sub" \\ POP_ASSUM MP_TAC
1119    \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
1120    \\ `mw2n ys <= mw2n xs` by DECIDE_TAC
1121    \\ IMP_RES_TAC mw2n_LESS
1122    THEN1 (FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC)
1123    \\ REPEAT STRIP_TAC
1124    \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,x64_iadd3_def,x64_iadd3_pre_def,LET_DEF]
1125    \\ SIMP_TAC (srw_ss()) [GSYM APPEND_ASSOC,LENGTH_REPLICATE]
1126    \\ STRIP_TAC THEN1
1127     (FULL_SIMP_TAC std_ss [WORD_MUL_LSL,word_mul_n2w]
1128      \\ ONCE_REWRITE_TAC [WORD_AND_COMM]
1129      \\ FULL_SIMP_TAC std_ss [x64_header_AND_1]
1130      \\ FULL_SIMP_TAC std_ss [x64_header_def,AC MULT_COMM MULT_ASSOC]
1131      \\ FULL_SIMP_TAC std_ss [b2w_NOT]
1132      \\ Cases_on `s` \\ FULL_SIMP_TAC (srw_ss()) [b2w_def,b2n_def,
1133           AC ADD_COMM ADD_ASSOC,word_add_n2w])
1134    \\ `LENGTH (mw_subv xs ys) <= LENGTH xs` by ASM_SIMP_TAC std_ss [LENGTH_mw_subv]
1135    \\ DECIDE_TAC));
1136
1137
1138(* multiplication *)
1139
1140val (x64_single_mul_add_res,
1141     x64_single_mul_add_def) = x64_decompile "x64_single_mul_add" `
1142  mul r2
1143  add r0,r1
1144  adc r2,0
1145  add r0,r3
1146  adc r2,0`
1147
1148val _ = add_compiled [x64_single_mul_add_res]
1149
1150val x64_single_mul_add_thm = prove(
1151  ``x64_single_mul_add_pre (p,k,q,s) /\
1152    (x64_single_mul_add (p,k,q,s) =
1153      let (x1,x2) = single_mul_add p q k s in (x1,k,x2,s))``,
1154  FULL_SIMP_TAC (srw_ss()) [x64_single_mul_add_def,LET_DEF]
1155  \\ Cases_on `k` \\ Cases_on `s` \\ Cases_on `p` \\ Cases_on `q`
1156  \\ FULL_SIMP_TAC (srw_ss()) [single_mul_add_def,LET_DEF,single_mul_def,bool2num_thm,
1157       mw_add_def,single_add_def,b2n_def,b2w_def,word_add_n2w,word_mul_n2w]
1158  \\ FULL_SIMP_TAC std_ss [AC ADD_COMM ADD_ASSOC, AC MULT_COMM MULT_ASSOC]
1159  \\ `10 < 18446744073709551616:num` by DECIDE_TAC
1160  \\ Q.ABBREV_TAC `k = 18446744073709551616:num` \\ POP_ASSUM (K ALL_TAC)
1161  \\ FULL_SIMP_TAC std_ss [ADD_ASSOC]
1162  \\ `n'' * n''' DIV k + b2n (k <= n + (n'' * n''') MOD k) =
1163      (n + n'' * n''') DIV k` by ALL_TAC \\ FULL_SIMP_TAC std_ss []
1164  \\ Q.SPEC_TAC (`n'' * n'''`,`l`) \\ STRIP_TAC
1165  \\ `0 < k` by DECIDE_TAC
1166  \\ `(n + l) DIV k = l DIV k + (n + l MOD k) DIV k` by ALL_TAC THEN1
1167   (SIMP_TAC std_ss [Once ADD_COMM]
1168    \\ STRIP_ASSUME_TAC (SIMP_RULE bool_ss [PULL_FORALL] DIVISION
1169         |> Q.SPECL [`k`,`l`] |> UNDISCH_ALL |> ONCE_REWRITE_RULE [CONJ_COMM])
1170    \\ POP_ASSUM (fn th => SIMP_TAC std_ss [Once th])
1171    \\ FULL_SIMP_TAC std_ss [GSYM ADD_ASSOC,ADD_DIV_ADD_DIV]
1172    \\ FULL_SIMP_TAC std_ss [AC ADD_ASSOC ADD_COMM])
1173  \\ FULL_SIMP_TAC std_ss []
1174  \\ Cases_on `k <= n + l MOD k` \\ FULL_SIMP_TAC std_ss [b2n_def]
1175  \\ SIMP_TAC std_ss [Once EQ_SYM_EQ]
1176  \\ `l MOD k < k` by FULL_SIMP_TAC std_ss []
1177  \\ ASM_SIMP_TAC std_ss [DIV_EQ_X] \\ DECIDE_TAC);
1178
1179val (res,x64_mul_pass_def,x64_mul_pass_pre_def) = x64_compile `
1180  x64_mul_pass (r1:word64,r8:word64,r9:word64,r10:word64,r11:word64,ys:word64 list,zs:word64 list) =
1181    if r9 = r11 then
1182      let zs = LUPDATE r1 (w2n r10) zs in
1183      let r10 = r10 + 1w in
1184        (r1,r9,r10,ys,zs)
1185    else
1186      let r3 = EL (w2n r10) zs in
1187      let r2 = EL (w2n r11) ys in
1188      let r0 = r8 in
1189      let (r0,r1,r2,r3) = x64_single_mul_add (r0,r1,r2,r3) in
1190      let zs = LUPDATE r0 (w2n r10) zs in
1191      let r1 = r2 in
1192      let r10 = r10 + 1w in
1193      let r11 = r11 + 1w in
1194        x64_mul_pass (r1,r8,r9,r10,r11,ys,zs)`
1195
1196val (res,x64_mul_def,x64_mul_pre_def) = x64_compile `
1197  x64_mul (r7:word64,r9,r10:word64,r12:word64,xs:word64 list,ys,zs) =
1198    if r7 = 0w then let r10 = r10 + r9 in (r10,xs,ys,zs) else
1199      let r7 = r7 - 1w in
1200      let r8 = EL (w2n r12) xs in
1201      let r12 = r12 + 1w in
1202      let r11 = 0w in
1203      let r1 = r11 in
1204      let (r1,r9,r10,ys,zs) = x64_mul_pass (r1,r8,r9,r10,r11,ys,zs) in
1205      let r10 = r10 - r9 in
1206        x64_mul (r7,r9,r10,r12,xs,ys,zs)`
1207
1208val (res,x64_mul_zero_def,x64_mul_zero_pre_def) = x64_compile `
1209  x64_mul_zero (r0:word64,r10:word64,zs:word64 list) =
1210    if r10 = 0w then (r10,zs) else
1211      let r10 = r10 - 1w in
1212      let zs = LUPDATE r0 (w2n r10) zs in
1213        x64_mul_zero (r0,r10,zs)`;
1214
1215val (x64_imul_res,x64_imul_def,x64_imul_pre_def) = x64_compile `
1216  x64_imul (r1:word64,r2:word64,xs:word64 list,ys:word64 list,zs:word64 list) =
1217    let r10 = 0w in
1218      if r1 = 0w then (r10,xs,ys,zs) else
1219      if r2 = 0w then (r10,xs,ys,zs) else
1220        let r0 = 0w in
1221        let r10 = r2 >>> 1 in
1222        let (r10,zs) = x64_mul_zero (r0,r10,zs) in
1223        let r10 = r1 && 1w in
1224        let r11 = r2 && 1w in
1225          if r10 = r11 then
1226            let r7 = r1 >>> 1 in
1227            let r9 = r2 >>> 1 in
1228            let r10 = 0w in
1229            let r12 = r10 in
1230            let (r10,xs,ys,zs) = x64_mul (r7,r9,r10,r12,xs,ys,zs) in
1231            let r8 = 0w in
1232            let (r8,r10,zs) = x64_fix (r8,r10,zs) in
1233            let r10 = r10 << 1 in
1234              (r10,xs,ys,zs)
1235          else
1236            let r7 = r1 >>> 1 in
1237            let r9 = r2 >>> 1 in
1238            let r10 = 0w in
1239            let r12 = r10 in
1240            let (r10,xs,ys,zs) = x64_mul (r7,r9,r10,r12,xs,ys,zs) in
1241            let r8 = 0w in
1242            let (r8,r10,zs) = x64_fix (r8,r10,zs) in
1243            let r10 = r10 << 1 in
1244            let r10 = r10 + 1w in
1245              (r10,xs,ys,zs)`;
1246
1247val x64_mul_pass_thm = prove(
1248  ``!ys ys1 x zs k zs1 zs2 z2.
1249      LENGTH (ys1++ys) < dimword (:64) /\  (LENGTH zs = LENGTH ys) /\
1250      LENGTH (zs1++zs) < dimword (:64) ==>
1251      ?r1.
1252        x64_mul_pass_pre (k,x,n2w (LENGTH (ys1++ys)),n2w (LENGTH zs1),
1253                          n2w (LENGTH ys1),ys1++ys,zs1++zs++z2::zs2) /\
1254        (x64_mul_pass (k,x,n2w (LENGTH (ys1++ys)),n2w (LENGTH zs1),
1255                       n2w (LENGTH ys1),ys1++ys,zs1++zs++z2::zs2) =
1256           (r1,n2w (LENGTH (ys1++ys)),n2w (LENGTH (zs1++zs)+1),ys1++ys,
1257            zs1++(mw_mul_pass x ys zs k)++zs2))``,
1258  Induct \\ Cases_on `zs`
1259  \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND_NIL,mw_mul_pass_def,ADD1]
1260  \\ ONCE_REWRITE_TAC [x64_mul_pass_def,x64_mul_pass_pre_def]
1261  \\ FULL_SIMP_TAC std_ss [LET_DEF,n2w_11,w2n_n2w,LUPDATE_LENGTH]
1262  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,word_add_n2w,LENGTH_APPEND]
1263  \\ FULL_SIMP_TAC std_ss [LENGTH]
1264  \\ REPEAT STRIP_TAC
1265  \\ IMP_RES_TAC (DECIDE ``m+n<k ==> m < k /\ n<k:num``)
1266  \\ FULL_SIMP_TAC std_ss [ADD1,x64_single_mul_add_thm]
1267  \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,LUPDATE_LENGTH,NULL,HD]
1268  \\ Cases_on `single_mul_add x h' k h` \\ FULL_SIMP_TAC std_ss [LET_DEF,TL]
1269  \\ ONCE_REWRITE_TAC [SNOC_INTRO |> Q.INST [`xs2`|->`[]`] |> REWRITE_RULE [APPEND_NIL]]
1270  \\ `((LENGTH ys1 + (LENGTH ys + 1)) = (LENGTH (SNOC h' ys1) + LENGTH ys)) /\
1271      ((LENGTH ys1 + 1) = (LENGTH (SNOC h' ys1))) /\
1272      ((LENGTH zs1 + 1) = LENGTH (SNOC q zs1))` by ALL_TAC
1273  THEN1 (FULL_SIMP_TAC std_ss [LENGTH_SNOC] \\ DECIDE_TAC)
1274  \\ FULL_SIMP_TAC std_ss []
1275  \\ SEP_I_TAC "x64_mul_pass" \\ POP_ASSUM MP_TAC
1276  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
1277  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
1278  \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss []
1279  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,
1280       LENGTH_APPEND,LENGTH,AC ADD_COMM ADD_ASSOC] \\ DECIDE_TAC)
1281  |> Q.SPECL [`ys`,`[]`] |> SIMP_RULE std_ss [APPEND,LENGTH] |> GEN_ALL;
1282
1283val WORD_SUB_LEMMA = prove(
1284  ``v + -1w * w = v - w``,
1285  FULL_SIMP_TAC (srw_ss()) []);
1286
1287val x64_mul_thm = prove(
1288  ``!xs ys zs xs1 zs1 zs2.
1289      LENGTH (xs1 ++ xs) < dimword (:64) /\ LENGTH ys < dimword (:64) /\
1290      (LENGTH zs = LENGTH ys) /\ LENGTH (zs1++zs++zs2) < dimword (:64) /\
1291      LENGTH xs <= LENGTH zs2 /\ ys <> [] ==>
1292      ?zs3.
1293        x64_mul_pre (n2w (LENGTH xs),n2w (LENGTH ys),n2w (LENGTH zs1),n2w (LENGTH xs1),
1294                 xs1 ++ xs,ys,zs1 ++ zs ++ zs2) /\
1295       (x64_mul (n2w (LENGTH xs),n2w (LENGTH ys),n2w (LENGTH zs1),n2w (LENGTH xs1),
1296                 xs1 ++ xs,ys,zs1 ++ zs ++ zs2) =
1297          (n2w (LENGTH (zs1 ++ mw_mul xs ys zs)),xs1++xs,ys,zs1 ++ mw_mul xs ys zs ++ zs3)) /\
1298       (LENGTH (zs1 ++ zs ++ zs2) = LENGTH (zs1 ++ mw_mul xs ys zs ++ zs3))``,
1299  Induct \\ ONCE_REWRITE_TAC [x64_mul_def,x64_mul_pre_def]
1300  \\ FULL_SIMP_TAC std_ss [LENGTH,mw_mul_def,APPEND_NIL,LET_DEF]
1301  \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,word_add_n2w]
1302  THEN1 (METIS_TAC [])
1303  \\ NTAC 7 STRIP_TAC
1304  \\ IMP_RES_TAC (DECIDE ``m+n<k ==> m < k /\ n<k:num``)
1305  \\ IMP_RES_TAC (DECIDE ``SUC n < k ==> n < k``)
1306  \\ FULL_SIMP_TAC (srw_ss()) []
1307  \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,LUPDATE_LENGTH,NULL,HD]
1308  \\ FULL_SIMP_TAC std_ss [GSYM word_sub_def,ADD1,GSYM word_add_n2w,WORD_ADD_SUB]
1309  \\ Cases_on `zs2` \\ FULL_SIMP_TAC std_ss [LENGTH]
1310  \\ ASSUME_TAC x64_mul_pass_thm
1311  \\ SEP_I_TAC "x64_mul_pass" \\ POP_ASSUM MP_TAC
1312  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
1313  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
1314  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss []
1315  \\ `LENGTH (mw_mul_pass h ys zs 0x0w) = LENGTH ys + 1` by ALL_TAC
1316  THEN1 (FULL_SIMP_TAC std_ss [LENGTH_mw_mul_pass])
1317  \\ Cases_on `mw_mul_pass h ys zs 0x0w`
1318  \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1]
1319  \\ `n2w (LENGTH (zs1 ++ zs:word64 list) + 1) + -0x1w * n2w (LENGTH (ys:word64 list)) =
1320      n2w (LENGTH (SNOC h'' zs1)):word64` by ALL_TAC THEN1
1321   (FULL_SIMP_TAC std_ss [WORD_SUB_LEMMA,LENGTH,LENGTH_APPEND]
1322    \\ `LENGTH zs1 + LENGTH ys + 1 = (LENGTH zs1 + 1) + LENGTH ys` by DECIDE_TAC
1323    \\ ASM_SIMP_TAC std_ss []
1324    \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB]
1325    \\ FULL_SIMP_TAC std_ss [word_add_n2w,LENGTH_SNOC,ADD1])
1326  \\ `n2w (LENGTH xs1) + 0x1w = n2w (LENGTH (SNOC h xs1)):word64` by ALL_TAC
1327  THEN1 (FULL_SIMP_TAC std_ss [word_add_n2w,LENGTH_SNOC,ADD1])
1328  \\ FULL_SIMP_TAC std_ss []
1329  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND]
1330  \\ ONCE_REWRITE_TAC [SNOC_INTRO |> Q.INST [`xs2`|->`[]`] |> REWRITE_RULE [APPEND_NIL]]
1331  \\ SEP_I_TAC "x64_mul" \\ POP_ASSUM MP_TAC
1332  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
1333  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ REPEAT STRIP_TAC \\ DECIDE_TAC)
1334  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss []
1335  \\ SIMP_TAC std_ss [word_add_n2w,TL,LENGTH_SNOC,ADD1,HD,AC ADD_COMM ADD_ASSOC]
1336  \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH_mw_mul] \\ STRIP_TAC
1337  \\ Q.EXISTS_TAC `zs3` \\ DECIDE_TAC)
1338  |> Q.SPECL [`xs`,`ys`,`zs`,`[]`,`[]`,`zs2`]
1339  |> SIMP_RULE std_ss [LENGTH,APPEND] |> GEN_ALL;
1340
1341val x64_mul_zero_thm = prove(
1342  ``!zs zs1.
1343      LENGTH zs < dimword(:64) ==>
1344        x64_mul_zero_pre (0w,n2w (LENGTH zs),zs++zs1) /\
1345        (x64_mul_zero (0w,n2w (LENGTH zs),zs++zs1) = (0w,MAP (\x.0w) zs ++ zs1))``,
1346  HO_MATCH_MP_TAC SNOC_INDUCT \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL]
1347  \\ NTAC 3 STRIP_TAC
1348  \\ ONCE_REWRITE_TAC [x64_mul_zero_def,x64_mul_zero_pre_def]
1349  \\ FULL_SIMP_TAC (srw_ss()) [rich_listTheory.REPLICATE,LET_DEF]
1350  \\ NTAC 3 STRIP_TAC
1351  \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,ADD1,GSYM word_sub_def,WORD_ADD_SUB]
1352  \\ IMP_RES_TAC (DECIDE ``n+1<k ==> n<k:num``)
1353  \\ FULL_SIMP_TAC (srw_ss()) [w2n_n2w]
1354  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,
1355       APPEND,LUPDATE_LENGTH,MAP_APPEND,MAP] \\ DECIDE_TAC);
1356
1357val MAP_EQ_MAP_EQ = prove(
1358  ``!xs ys. (MAP (\x.0w) xs = MAP (\x.0w) ys) = (LENGTH xs = LENGTH ys)``,
1359  Induct \\ Cases_on `ys` \\ FULL_SIMP_TAC (srw_ss()) []);
1360
1361val x64_imul_thm = prove(
1362  ``((x64_header (s,xs) = 0w) = (xs = [])) /\
1363    ((x64_header (t,ys) = 0w) = (ys = [])) /\
1364    LENGTH xs < dimword (:63) /\ LENGTH ys < dimword (:63) /\
1365    LENGTH xs + LENGTH ys <= LENGTH zs /\ LENGTH zs < dimword (:63) ==>
1366    ?zs1.
1367      x64_imul_pre (x64_header (s,xs),x64_header (t,ys),xs,ys,zs) /\
1368      (x64_imul (x64_header (s,xs),x64_header (t,ys),xs,ys,zs) =
1369        (x64_header (mwi_mul (s,xs) (t,ys)),xs,ys,
1370         SND (mwi_mul (s,xs) (t,ys))++zs1)) /\
1371      (LENGTH (SND (mwi_mul (s,xs) (t,ys))++zs1) = LENGTH zs) ``,
1372  FULL_SIMP_TAC std_ss [x64_imul_def,x64_imul_pre_def,LET_DEF]
1373  \\ FULL_SIMP_TAC std_ss [x64_header_EQ,mwi_mul_def,x64_length]
1374  \\ Cases_on `xs = []` \\ FULL_SIMP_TAC std_ss [APPEND]
1375  THEN1 (REPEAT STRIP_TAC \\ EVAL_TAC)
1376  \\ Cases_on `ys = []` \\ FULL_SIMP_TAC std_ss [APPEND]
1377  THEN1 (REPEAT STRIP_TAC \\ EVAL_TAC)
1378  \\ REPEAT STRIP_TAC
1379  \\ `LENGTH ys <= LENGTH zs` by DECIDE_TAC
1380  \\ `?qs1 qs2. (zs = qs1 ++ qs2) /\ (LENGTH ys = LENGTH qs1)` by
1381       METIS_TAC [LESS_EQ_LENGTH]
1382  \\ `LENGTH qs1 < dimword (:64)` by (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
1383  \\ FULL_SIMP_TAC std_ss [x64_mul_zero_thm]
1384  \\ ASSUME_TAC x64_mul_thm
1385  \\ Q.PAT_X_ASSUM `LENGTH ys = LENGTH qs1` (ASSUME_TAC o GSYM)
1386  \\ `MAP (\x. 0x0w:word64) qs1 = MAP (\x. 0x0w) ys` by
1387       ASM_SIMP_TAC std_ss [MAP_EQ_MAP_EQ]
1388  \\ FULL_SIMP_TAC std_ss []
1389  \\ SEP_I_TAC "x64_mul" \\ POP_ASSUM MP_TAC
1390  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
1391  THEN1 (FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND] \\ DECIDE_TAC)
1392  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss []
1393  \\ `LENGTH qs1 < dimword (:64)` by (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
1394  \\ `LENGTH (mw_mul xs ys (MAP (\x. 0x0w) ys)) < dimword (:64)` by ALL_TAC
1395  THEN1 (FULL_SIMP_TAC (srw_ss()) [LENGTH_mw_mul,LENGTH_MAP] \\ DECIDE_TAC)
1396  \\ ASSUME_TAC x64_fix_thm \\ SEP_I_TAC "x64_fix" \\ POP_ASSUM MP_TAC
1397  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
1398  THEN1 (FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND] \\ DECIDE_TAC)
1399  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss []
1400  \\ Cases_on `s = t` \\ FULL_SIMP_TAC std_ss []
1401  \\ FULL_SIMP_TAC std_ss [x64_header_def,GSYM APPEND_ASSOC]
1402  \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_REPLICATE,WORD_MUL_LSL,word_mul_n2w]
1403  \\ FULL_SIMP_TAC std_ss [AC MULT_COMM MULT_ASSOC]
1404  \\ Q.ABBREV_TAC `ts = mw_mul xs ys (MAP (\x. 0x0w) ys)`
1405  \\ `LENGTH (mw_fix ts) <= LENGTH ts` by FULL_SIMP_TAC std_ss [LENGTH_mw_fix]
1406  \\ DECIDE_TAC);
1407
1408
1409(* simple div xs into zs and zs into zs *)
1410
1411val (x64_single_div_res,x64_single_div_def) = x64_decompile "x64_single_div" `
1412  div r9`
1413
1414val _ = add_compiled [x64_single_div_res]
1415
1416val MULT_LEMMA_LEMMA = prove(
1417  ``!m n. l < k /\ l + k * m < k + k * n ==> m <= n:num``,
1418  Induct \\ Cases_on `n` \\ FULL_SIMP_TAC std_ss [MULT_CLAUSES]
1419  THEN1 (REPEAT STRIP_TAC \\ CCONTR_TAC \\ FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC)
1420  \\ REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `!x.bbb` MATCH_MP_TAC
1421  \\ FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC);
1422
1423val MULT_LEMMA = prove(
1424  ``l < k ==> (l + k * m < k + k * n = m <= n:num)``,
1425  REPEAT STRIP_TAC \\ REV EQ_TAC \\ REPEAT STRIP_TAC THEN1
1426   (SUFF_TAC ``k * m <= k * n:num`` \\ REPEAT STRIP_TAC THEN1 DECIDE_TAC
1427    \\ MATCH_MP_TAC LESS_MONO_MULT2 \\ FULL_SIMP_TAC std_ss [])
1428  \\ CCONTR_TAC \\ FULL_SIMP_TAC std_ss [GSYM NOT_LESS]
1429  \\ IMP_RES_TAC MULT_LEMMA_LEMMA \\ DECIDE_TAC);
1430
1431val x64_single_div_thm = prove(
1432  ``(x64_single_div_pre (x2,x1,y) = x1 <+ y) /\
1433    (x64_single_div (x2,x1,y) = let (q,r) = single_div x1 x2 y in (q,r,y))``,
1434  FULL_SIMP_TAC (srw_ss()) [x64_single_div_def,single_div_def,LET_DEF]
1435  \\ Cases_on `y` \\ Cases_on `n` \\ FULL_SIMP_TAC (srw_ss()) [WORD_LO,DIV_LT_X]
1436  \\ FULL_SIMP_TAC std_ss [MULT_CLAUSES]
1437  \\ SIMP_TAC std_ss [Once ADD_COMM] \\ SIMP_TAC std_ss [Once MULT_COMM]
1438  \\ `w2n x2 < 18446744073709551616` by ALL_TAC THEN1
1439   (ASSUME_TAC (w2n_lt |> INST_TYPE [``:'a``|->``:64``] |> Q.SPEC `x2`)
1440    \\ FULL_SIMP_TAC (srw_ss()) [])
1441  \\ FULL_SIMP_TAC std_ss [MULT_LEMMA]
1442  \\ DECIDE_TAC);
1443
1444val (res,x64_simple_div_def,x64_simple_div_pre_def) = x64_compile `
1445  x64_simple_div (r2:word64,r9:word64,r10:word64,xs:word64 list,zs:word64 list) =
1446    if r10 = 0w then (r2,r9,r10,xs,zs) else
1447      let r10 = r10 - 1w in
1448      let r0 = EL (w2n r10) xs in
1449      let (r0,r2,r9) = x64_single_div (r0,r2,r9) in
1450      let zs = LUPDATE r0 (w2n r10) zs in
1451        x64_simple_div (r2,r9,r10,xs,zs)`
1452
1453val (res,x64_simple_div1_def,x64_simple_div1_pre_def) = x64_compile `
1454  x64_simple_div1 (r2:word64,r9:word64,r10:word64,zs:word64 list) =
1455    if r10 = 0w then (r2,r9,r10,zs) else
1456      let r10 = r10 - 1w in
1457      let r0 = EL (w2n r10) zs in
1458      let (r0,r2,r9) = x64_single_div (r0,r2,r9) in
1459      let zs = LUPDATE r0 (w2n r10) zs in
1460        x64_simple_div1 (r2,r9,r10,zs)`
1461
1462val x64_simple_div_thm = prove(
1463  ``!xs xs1 zs zs1 r2 r9 qs r.
1464      LENGTH xs < dimword(:64) /\ (LENGTH zs = LENGTH xs) /\
1465      (mw_simple_div r2 (REVERSE xs) r9 = (qs,r,T)) ==>
1466      x64_simple_div_pre (r2,r9,n2w (LENGTH xs),xs++xs1,zs++zs1) /\
1467      (x64_simple_div (r2,r9,n2w (LENGTH xs),xs++xs1,zs++zs1) =
1468         (r,r9,0w,xs++xs1,REVERSE qs++zs1))``,
1469  HO_MATCH_MP_TAC SNOC_INDUCT \\ STRIP_TAC THEN1
1470   (REPEAT STRIP_TAC \\ POP_ASSUM MP_TAC
1471    \\ FULL_SIMP_TAC std_ss [LENGTH,Once x64_simple_div_pre_def,
1472         Once x64_simple_div_def,REVERSE,mw_simple_div_def]
1473    \\ Q.SPEC_TAC (`qs`,`qs`)
1474    \\ Cases_on `zs` \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,ADD1])
1475  \\ NTAC 11 STRIP_TAC
1476  \\ FULL_SIMP_TAC std_ss [REVERSE_SNOC,mw_simple_div_def,LET_DEF]
1477  \\ `(zs = []) \/ ?z zs2. zs = SNOC z zs2` by METIS_TAC [SNOC_CASES]
1478  THEN1 (FULL_SIMP_TAC (srw_ss()) [LENGTH])
1479  \\ FULL_SIMP_TAC std_ss [LENGTH_SNOC]
1480  \\ SIMP_TAC std_ss [LENGTH,Once x64_simple_div_pre_def,
1481         Once x64_simple_div_def,REVERSE,mw_simple_div_def]
1482  \\ FULL_SIMP_TAC (srw_ss()) [n2w_11,LET_DEF]
1483  \\ FULL_SIMP_TAC std_ss [ADD1,GSYM word_add_n2w,GSYM word_sub_def,WORD_ADD_SUB]
1484  \\ IMP_RES_TAC (DECIDE ``n+1<k ==> n<k:num``)
1485  \\ FULL_SIMP_TAC (srw_ss()) []
1486  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,LUPDATE_LENGTH]
1487  \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,NULL,HD]
1488  \\ Q.PAT_X_ASSUM `LENGTH zs2 = LENGTH xs` (ASSUME_TAC o GSYM)
1489  \\ FULL_SIMP_TAC std_ss [LUPDATE_LENGTH,x64_single_div_thm]
1490  \\ `?q1 r1. single_div r2 x r9 = (q1,r1)` by METIS_TAC [PAIR]
1491  \\ `?qs2 r2 c2. mw_simple_div r1 (REVERSE xs) r9 = (qs2,r2,c2)` by METIS_TAC [PAIR]
1492  \\ FULL_SIMP_TAC std_ss [LET_DEF]
1493  \\ Q.PAT_X_ASSUM `q1::qs2 = qs` (ASSUME_TAC o GSYM)
1494  \\ FULL_SIMP_TAC std_ss [REVERSE,SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]
1495  \\ DECIDE_TAC);
1496
1497val x64_simple_div1_thm = prove(
1498  ``!zs zs1 r2 r9 qs r.
1499      LENGTH zs < dimword(:64) /\
1500      (mw_simple_div r2 (REVERSE zs) r9 = (qs,r,T)) ==>
1501      x64_simple_div1_pre (r2,r9,n2w (LENGTH zs),zs++zs1) /\
1502      (x64_simple_div1 (r2,r9,n2w (LENGTH zs),zs++zs1) =
1503         (r,r9,0w,REVERSE qs++zs1))``,
1504  HO_MATCH_MP_TAC SNOC_INDUCT \\ STRIP_TAC THEN1
1505   (REPEAT STRIP_TAC \\ POP_ASSUM MP_TAC
1506    \\ FULL_SIMP_TAC std_ss [LENGTH,Once x64_simple_div1_pre_def,
1507         Once x64_simple_div1_def,REVERSE,mw_simple_div_def]
1508    \\ Q.SPEC_TAC (`qs`,`qs`) \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,ADD1])
1509  \\ NTAC 9 STRIP_TAC
1510  \\ FULL_SIMP_TAC std_ss [REVERSE_SNOC,mw_simple_div_def,LET_DEF]
1511  \\ FULL_SIMP_TAC std_ss [LENGTH_SNOC]
1512  \\ SIMP_TAC std_ss [LENGTH,Once x64_simple_div1_pre_def,
1513         Once x64_simple_div1_def,REVERSE,mw_simple_div_def]
1514  \\ FULL_SIMP_TAC (srw_ss()) [n2w_11,LET_DEF]
1515  \\ FULL_SIMP_TAC std_ss [ADD1,GSYM word_add_n2w,GSYM word_sub_def,WORD_ADD_SUB]
1516  \\ IMP_RES_TAC (DECIDE ``n+1<k ==> n<k:num``)
1517  \\ FULL_SIMP_TAC (srw_ss()) []
1518  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,LUPDATE_LENGTH]
1519  \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,NULL,HD]
1520  \\ FULL_SIMP_TAC std_ss [LUPDATE_LENGTH,x64_single_div_thm]
1521  \\ `?q1 r1. single_div r2 x r9 = (q1,r1)` by METIS_TAC [PAIR]
1522  \\ `?qs2 r2 c2. mw_simple_div r1 (REVERSE zs) r9 = (qs2,r2,c2)` by METIS_TAC [PAIR]
1523  \\ FULL_SIMP_TAC std_ss [LET_DEF]
1524  \\ Q.PAT_X_ASSUM `q1::qs2 = qs` (ASSUME_TAC o GSYM)
1525  \\ FULL_SIMP_TAC std_ss [REVERSE,SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]
1526  \\ DECIDE_TAC);
1527
1528(* mw_div -- calc_d *)
1529
1530val (res,x64_calc_d_def,x64_calc_d_pre_def) = x64_compile `
1531  x64_calc_d (r1:word64,r2:word64) =
1532    let r0 = r1 + r1 in
1533    let r0 = r0 >>> 1 in
1534      if r0 <> r1 then r2 else
1535        let r1 = r1 + r1 in
1536        let r2 = r2 + r2 in
1537          x64_calc_d (r1,r2)`
1538
1539val x64_calc_d_thm = prove(
1540  ``!v1 d.
1541      (\(v1,d).
1542        (v1 <> 0w) ==>
1543        x64_calc_d_pre (v1,d) /\
1544        (x64_calc_d (v1,d) = calc_d (v1,d))) (v1,d)``,
1545  MATCH_MP_TAC (calc_d_ind |> INST_TYPE [alpha|->``:64``])
1546  \\ FULL_SIMP_TAC std_ss [] \\ NTAC 4 STRIP_TAC
1547  \\ ONCE_REWRITE_TAC [x64_calc_d_pre_def,x64_calc_d_def,calc_d_def]
1548  \\ FULL_SIMP_TAC std_ss [LET_DEF]
1549  \\ Tactical.REVERSE (Cases_on `v1 = (v1 + v1) >>> 1`)
1550  \\ `(v1 = (v1 + v1) >>> 1) <=> ~word_msb v1` by
1551        (NTAC 2 (POP_ASSUM MP_TAC) \\ blastLib.BBLAST_TAC)
1552  \\ FULL_SIMP_TAC std_ss [AND_IMP_INTRO]
1553  \\ FULL_SIMP_TAC std_ss [GSYM addressTheory.WORD_TIMES2,
1554       AC WORD_MULT_ASSOC WORD_MULT_COMM]
1555  \\ FIRST_X_ASSUM MATCH_MP_TAC
1556  \\ REPEAT (POP_ASSUM MP_TAC) \\ blastLib.BBLAST_TAC)
1557  |> SIMP_RULE std_ss [];
1558
1559(* mw_div -- mw_div_guess *)
1560
1561val (x64_single_mul_res,
1562     x64_single_mul_def) = x64_decompile "x64_single_mul" `
1563  mul r2
1564  add r0,r1
1565  adc r2,0`
1566
1567val _ = add_compiled [x64_single_mul_res]
1568
1569val single_mul_add_thm  = prove(
1570  ``single_mul_add p q k s =
1571      (let (r0,r1,r2,r3) = x64_single_mul_add (p,k,q,s) in
1572         (r0,r2))``,
1573  SIMP_TAC std_ss [x64_single_mul_add_thm]
1574  \\ Q.SPEC_TAC (`single_mul_add p q k s`,`w`)
1575  \\ FULL_SIMP_TAC std_ss [FORALL_PROD,LET_DEF]);
1576
1577val x64_single_mul_thm = prove(
1578  ``x64_single_mul_pre (p,k,q) /\
1579    (x64_single_mul (p,k,q) =
1580      let (x1,x2) = single_mul_add p q k 0w in (x1,k,x2))``,
1581  SIMP_TAC (srw_ss()) [single_mul_add_thm,x64_single_mul_def,LET_DEF,
1582    x64_single_mul_add_def] \\ SIMP_TAC std_ss [GSYM (EVAL ``dimword (:64)``)]
1583  \\ SIMP_TAC std_ss [GSYM NOT_LESS,w2n_lt,EVAL ``bool2num F``,WORD_ADD_0]);
1584
1585val (res,x64_mul_by_single2_def,x64_mul_by_single2_pre_def) = x64_compile `
1586  x64_mul_by_single2 (r6:word64,r7:word64,r8:word64) =
1587    let r0 = r6 in
1588    let r1 = 0w in
1589    let r2 = r7 in
1590    let (r0,r1,r2) = x64_single_mul (r0,r1,r2) in
1591    let r12 = r0 in
1592    let r0 = r6 in
1593    let r1 = r2 in
1594    let r2 = r8 in
1595    let (r0,r1,r2) = x64_single_mul (r0,r1,r2) in
1596    let r3 = r2 in
1597    let r2 = r0 in
1598    let r1 = r12 in
1599      (r1,r2,r3,r6,r7,r8)`
1600
1601val x64_mul_by_single2_thm = prove(
1602  ``!r6 r7 r8.
1603      ?r1 r2 r3.
1604        x64_mul_by_single2_pre (r6,r7,r8) /\
1605        (x64_mul_by_single2 (r6,r7,r8) = (r1,r2,r3,r6,r7,r8)) /\
1606        (mw_mul_by_single r6 [r7; r8] = [r1; r2; r3])``,
1607  SIMP_TAC std_ss [mw_mul_by_single_def,LENGTH,mw_mul_pass_def,x64_single_mul_thm,
1608    k2mw_def,HD,TL,x64_mul_by_single2_def,EVAL ``(k2mw 2 0):word64 list``,LET_DEF]
1609  \\ CONV_TAC (DEPTH_CONV (PairRules.PBETA_CONV))
1610  \\ SIMP_TAC std_ss [x64_mul_by_single2_pre_def,LET_DEF,x64_single_mul_add_def]
1611  \\ CONV_TAC (DEPTH_CONV (PairRules.PBETA_CONV))
1612  \\ SIMP_TAC std_ss [x64_mul_by_single2_pre_def,LET_DEF,x64_single_mul_add_def]
1613  \\ SIMP_TAC std_ss [x64_single_mul_thm] \\ EVAL_TAC);
1614
1615val (res,x64_cmp3_def,x64_cmp3_pre_def) = x64_compile `
1616  x64_cmp3 (r1:word64,r2,r3,r9:word64,r10:word64,r11:word64) =
1617    let r0 = 1w:word64 in
1618      if r3 <> r11 then
1619        if r11 <+ r3 then (r0,r1,r2,r3,r9,r10,r11) else
1620          let r0 = 0w in (r0,r1,r2,r3,r9,r10,r11) else
1621      if r2 <> r10 then
1622        if r10 <+ r2 then (r0,r1,r2,r3,r9,r10,r11) else
1623          let r0 = 0w in (r0,r1,r2,r3,r9,r10,r11) else
1624      if r1 <> r9 then
1625        if r9 <+ r1 then (r0,r1,r2,r3,r9,r10,r11) else
1626          let r0 = 0w in (r0,r1,r2,r3,r9,r10,r11) else
1627      let r0 = 0w in (r0,r1,r2,r3,r9,r10,r11)`
1628
1629val x64_cmp3_thm = prove(
1630  ``x64_cmp3_pre (r1,r2,r3,r9,r10,r11) /\
1631    (x64_cmp3 (r1,r2,r3,r9,r10,r11) =
1632      (if mw_cmp [r9;r10;r11] [r1;r2;r3] = SOME T then 1w else 0w,
1633       r1,r2,r3,r9,r10,r11))``,
1634  NTAC 5 (ONCE_REWRITE_TAC [mw_cmp_def])
1635  \\ SIMP_TAC (srw_ss()) [x64_cmp3_def,x64_cmp3_pre_def,LET_DEF]
1636  \\ Tactical.REVERSE (Cases_on `r3 = r11`)
1637  \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] []
1638  \\ Tactical.REVERSE (Cases_on `r2 = r10`)
1639  \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] []
1640  \\ Tactical.REVERSE (Cases_on `r1 = r9`)
1641  \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] []);
1642
1643val (res,x64_cmp_mul2_def,x64_cmp_mul2_pre_def) = x64_compile `
1644  x64_cmp_mul2 (r6,r7,r8,r9,r10,r11) =
1645    let (r1,r2,r3,r6,r7,r8) = x64_mul_by_single2 (r6,r7,r8) in
1646    let (r0,r1,r2,r3,r9,r10,r11) = x64_cmp3 (r1,r2,r3,r9,r10,r11) in
1647      (r0,r6,r7,r8,r9,r10,r11)`
1648
1649val x64_cmp_mul2_thm = prove(
1650  ``x64_cmp_mul2_pre (r6,r7,r8,r9,r10,r11) /\
1651    (x64_cmp_mul2 (r6,r7,r8,r9,r10,r11) =
1652      ((if mw_cmp [r9;r10;r11] (mw_mul_by_single r6 [r7; r8]) = SOME T
1653            then 1w else 0w),r6,r7,r8,r9,r10,r11))``,
1654  SIMP_TAC std_ss [x64_cmp_mul2_pre_def,x64_cmp_mul2_def]
1655  \\ STRIP_ASSUME_TAC (x64_mul_by_single2_thm |> SPEC_ALL)
1656  \\ FULL_SIMP_TAC std_ss [LET_DEF,x64_cmp3_thm]);
1657
1658val (res,x64_sub1_def,x64_sub1_pre_def) = x64_compile `
1659  x64_sub1 (r6:word64) =
1660    if r6 = 0w then r6 else let r6 = r6 - 1w in r6`
1661
1662val x64_sub1_thm = prove(
1663  ``!r6. x64_sub1_pre r6 /\ (x64_sub1 r6 = n2w (w2n r6 - 1))``,
1664  Cases \\ ASM_SIMP_TAC (srw_ss()) [x64_sub1_pre_def,x64_sub1_def]
1665  \\ Cases_on `n = 0` \\ FULL_SIMP_TAC std_ss [LET_DEF,GSYM word_sub_def]
1666  \\ `~(n < 1)` by DECIDE_TAC
1667  \\ ASM_SIMP_TAC std_ss [addressTheory.word_arith_lemma2]);
1668
1669val (res,x64_cmp2_def,x64_cmp2_pre_def) = x64_compile `
1670  x64_cmp2 (r0:word64,r2,r10:word64,r11:word64) =
1671    let r1 = 1w:word64 in
1672      if r2 <> r11 then
1673        if r11 <+ r2 then (r0,r1,r2,r10,r11) else
1674          let r1 = 0w in (r0,r1,r2,r10,r11) else
1675      if r0 <> r10 then
1676        if r10 <+ r0 then (r0,r1,r2,r10,r11) else
1677          let r1 = 0w in (r0,r1,r2,r10,r11) else
1678      let r1 = 0w in (r0,r1,r2,r10,r11)`
1679
1680val x64_cmp2_thm = prove(
1681  ``x64_cmp2_pre (r0,r2,r10,r11) /\
1682    (x64_cmp2 (r0,r2,r10,r11) =
1683      (r0,if mw_cmp [r10;r11] [r0;r2] = SOME T then 1w else 0w,
1684       r2,r10,r11))``,
1685  NTAC 5 (ONCE_REWRITE_TAC [mw_cmp_def])
1686  \\ SIMP_TAC (srw_ss()) [x64_cmp2_def,x64_cmp2_pre_def,LET_DEF]
1687  \\ Tactical.REVERSE (Cases_on `r2 = r11`)
1688  \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] []
1689  \\ Tactical.REVERSE (Cases_on `r0 = r10`)
1690  \\ FULL_SIMP_TAC std_ss [] THEN1 SRW_TAC [] []);
1691
1692val (res,x64_div_test_def,x64_div_test_pre_def) = x64_compile `
1693  x64_div_test (r6,r7,r8,r9,r10,r11) =
1694    let (r0,r6,r7,r8,r9,r10,r11) = x64_cmp_mul2 (r6,r7,r8,r9,r10,r11) in
1695      if r0 <> 0w then
1696        let r6 = x64_sub1 r6 in
1697        let r0 = r6 in
1698        let r1 = 0w in
1699        let r2 = r8 in
1700        let r3 = r1 in
1701        let (r0,r1,r2,r3) = x64_single_mul_add (r0,r1,r2,r3) in
1702        let r2 = r2 + 1w in
1703        let (r0,r1,r2,r10,r11) = x64_cmp2 (r0,r2,r10,r11) in
1704          if r1 <> 0w then
1705            x64_div_test (r6,r7,r8,r9,r10,r11)
1706          else (r6,r7,r8,r9,r10,r11)
1707      else
1708        (r6,r7,r8,r9,r10,r11)`
1709
1710val single_mul_thm = prove(
1711  ``single_mul_add x y 0w 0w = single_mul x y 0w``,
1712  SIMP_TAC (srw_ss()) [single_mul_add_def,single_mul_def,LET_DEF,
1713    mw_add_def,single_add_def,b2n_def,b2w_def,GSYM NOT_LESS,w2n_lt]);
1714
1715val mw_add_0_1 = prove(
1716  ``(FST (mw_add [r0;r2] [0w;1w] F) = [r0;r2+1w])``,
1717  SIMP_TAC (srw_ss()) [mw_add_def,HD,TL,single_add_def,b2w_def,
1718    LET_DEF,EVAL ``b2n F``,GSYM NOT_LESS,w2n_lt]);
1719
1720val x64_div_test_thm = prove(
1721  ``!q u1 u2 u3 v1 v2.
1722      x64_div_test_pre (q,v2,v1,u3,u2,u1) /\
1723      (x64_div_test (q,v2,v1,u3,u2,u1) =
1724         (mw_div_test q u1 u2 u3 v1 v2,v2,v1,u3,u2,u1))``,
1725  HO_MATCH_MP_TAC mw_div_test_ind \\ NTAC 7 STRIP_TAC
1726  \\ ONCE_REWRITE_TAC [x64_div_test_def,x64_div_test_pre_def,mw_div_test_def]
1727  \\ SIMP_TAC std_ss [x64_cmp_mul2_thm]
1728  \\ Cases_on `mw_cmp [u3; u2; u1] (mw_mul_by_single q [v2; v1]) = SOME T`
1729  \\ ASM_SIMP_TAC std_ss [LET_DEF,EVAL ``0w = 1w:word64``,x64_sub1_thm]
1730  \\ FULL_SIMP_TAC std_ss [x64_single_mul_add_thm,GSYM single_mul_thm]
1731  \\ Cases_on `single_mul_add (n2w (w2n q - 1)) v1 0x0w 0x0w`
1732  \\ FULL_SIMP_TAC std_ss [LET_DEF,x64_cmp2_thm]
1733  \\ Q.MATCH_ASSUM_RENAME_TAC
1734       `single_mul_add (n2w (w2n q - 1)) v1 0x0w 0x0w = (q1,q2)`
1735  \\ FULL_SIMP_TAC std_ss [mw_add_0_1]
1736  \\ Cases_on `mw_cmp [u2; u1] [q1; q2 + 0x1w] = SOME T`
1737  \\ FULL_SIMP_TAC std_ss [EVAL ``0w = 1w:word64``]);
1738
1739val (x64_div_r1_res,x64_div_r1_def) = x64_decompile "x64_div_r1" `
1740      cmp r2 r1
1741      jb L
1742      xor r0,r0
1743      not r0
1744      jmp EXIT
1745L:    div r1
1746EXIT: `;
1747
1748val _ = add_compiled [x64_div_r1_res]
1749
1750val x64_div_r1_thm = prove(
1751  ``x64_div_r1 (r0,r1,r2) =
1752      if r2 <+ r1 then
1753        (FST (single_div r2 r0 r1),r1,SND (single_div r2 r0 r1))
1754      else (~0w,r1,r2)``,
1755  SIMP_TAC (srw_ss()) [x64_div_r1_def,single_div_def,LET_DEF]);
1756
1757val (res,x64_div_guess_def,x64_div_guess_pre_def) = x64_compile `
1758  x64_div_guess (r7,r8,r9,r10,r11) =
1759    let r0 = r10 in
1760    let r1 = r8 in
1761    let r2 = r11 in
1762    let (r0,r1,r2) = x64_div_r1 (r0,r1,r2) in
1763    let r6 = r0 in
1764    let (r6,r7,r8,r9,r10,r11) = x64_div_test (r6,r7,r8,r9,r10,r11) in
1765      (r6,r7,r8,r9,r10,r11)`
1766
1767val x64_div_guess_thm = prove(
1768  ``!q u1 u2 u3 v1 v2.
1769      (x64_div_guess_pre (v2,v1,u3,u2,u1) <=>
1770         (u1 <+ v1 ==> v1 <> 0w))  /\
1771      (x64_div_guess (v2,v1,u3,u2,u1) =
1772         (mw_div_guess (u1::u2::u3::us) (v1::v2::vs),v2,v1,u3,u2,u1))``,
1773  SIMP_TAC (srw_ss()) [x64_div_guess_def,x64_div_guess_pre_def,
1774    x64_div_test_thm, mw_div_guess_def,HD,TL,x64_div_r1_thm,LET_DEF]
1775  \\ SIMP_TAC std_ss [x64_div_r1_def,LET_DEF,WORD_LO]
1776  \\ REPEAT STRIP_TAC
1777  \\ Cases_on `w2n u1 < w2n v1` \\ FULL_SIMP_TAC std_ss [EVAL ``-1w:word64``]
1778  \\ Cases_on `v1 = 0w` \\ FULL_SIMP_TAC std_ss []
1779  \\ Cases_on `v1` \\ FULL_SIMP_TAC (srw_ss()) []
1780  \\ `0 < n` by DECIDE_TAC
1781  \\ FULL_SIMP_TAC std_ss [DIV_LT_X]
1782  \\ Cases_on `u1` \\ FULL_SIMP_TAC (srw_ss()) []
1783  \\ Cases_on `u2` \\ FULL_SIMP_TAC (srw_ss()) []
1784  \\ DECIDE_TAC);
1785
1786(* mw_div -- mw_div_adjust *)
1787
1788(*
1789
1790 r1 -- k1
1791 r6 -- x1, i.e. d
1792 r7 -- x2
1793 r8 -- accumulated result
1794 r9 -- length of ys
1795 r10 -- points into zs
1796 r11 -- points into ys
1797 r12 -- k2
1798
1799*)
1800
1801val (res,x64_adj_cmp_def,x64_adj_cmp_pre_def) = x64_compile `
1802  x64_adj_cmp (r0:word64,r3:word64,r8:word64) =
1803    if r0 = r3 then (r0,r3,r8) else
1804      let r8 = 1w in
1805        if r3 <+ r0 then (r0,r3,r8)
1806        else let r8 = 0w in (r0,r3,r8)`
1807
1808val (res,x64_adjust_aux_def,x64_adjust_aux_pre_def) = x64_compile `
1809  x64_adjust_aux (r1,r6,r7,r8,r9,r10:word64,r11:word64,r12,ys:word64 list,zs) =
1810    if r9 = r11 then
1811      let r0 = r12 in
1812      let r3 = EL (w2n r10) zs in
1813      let r10 = r10 + 1w in
1814      let (r0,r3,r8) = x64_adj_cmp (r0,r3,r8) in
1815        (r6,r7,r8,r9,r10,r11,ys,zs)
1816    else
1817      let r0 = r6 in (* x1 *)
1818      let r2 = EL (w2n r11) ys in
1819      let (r0,r1,r2) = x64_single_mul (r0,r1,r2) in
1820      let r1 = r12 in
1821      let r12 = r2 in
1822      let r2 = r0 in
1823      let r0 = r7 in
1824      let (r0,r1,r2) = x64_single_mul (r0,r1,r2) in
1825      let r1 = r12 in
1826      let r12 = r2 in
1827      let r3 = EL (w2n r10) zs in
1828      let (r0,r3,r8) = x64_adj_cmp (r0,r3,r8) in
1829      let r11 = r11 + 1w in
1830      let r10 = r10 + 1w in
1831        x64_adjust_aux (r1,r6,r7,r8,r9,r10,r11,r12,ys,zs)`
1832
1833val (res,x64_div_adjust_def,x64_div_adjust_pre_def) = x64_compile `
1834  x64_div_adjust (r6,r7,r9,r10,ys,zs) =
1835    let r1 = 0w in
1836    let r8 = r1 in
1837    let r11 = r1 in
1838    let r12 = r1 in
1839    let (r6,r7,r8,r9,r10,r11,ys,zs) =
1840      x64_adjust_aux (r1,r6,r7,r8,r9,r10,r11,r12,ys,zs) in
1841      if (r7 = 0w) then (r6,r7,r9,r10,r11,ys,zs) else
1842      if (r8 = 0w) then (r6,r7,r9,r10,r11,ys,zs) else
1843        let r7 = r7 - 1w in (r6,r7,r9,r10,r11,ys,zs)`
1844
1845val x64_adj_cmp_thm = prove(
1846  ``x64_adj_cmp_pre (r1,h,anything) /\
1847    (x64_adj_cmp (r1,h,if res = SOME T then 0x1w else 0x0w) =
1848      (r1,h,if mw_cmp_alt [h] [r1] res = SOME T then 0x1w else 0x0w))``,
1849  SIMP_TAC std_ss [mw_cmp_alt_def,HD,TL,x64_adj_cmp_def,x64_adj_cmp_pre_def,LET_DEF]
1850  \\ Cases_on `r1 = h` \\ FULL_SIMP_TAC std_ss []
1851  \\ Cases_on `h <+ r1` \\ FULL_SIMP_TAC std_ss []);
1852
1853val EL_LENGTH = prove(
1854  ``(EL (LENGTH xs) (xs ++ y::ys) = y) /\
1855    (EL (LENGTH xs) (xs ++ y::ys ++ zs) = y)``,
1856  SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD,
1857    GSYM APPEND_ASSOC,APPEND]);
1858
1859val SNOC_INTRO = prove(
1860  ``(xs ++ y::ys = SNOC y xs ++ ys) /\
1861    (xs ++ y::ys ++ zs = SNOC y xs ++ ys ++ zs)``,
1862  FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]);
1863
1864val mw_cmp_alt_CONS = prove(
1865  ``mw_cmp_alt zs (mw_mul_by_single2 r6 r7 ys q2 q4) (mw_cmp_alt [z] [q3] res) =
1866    mw_cmp_alt (z::zs) (q3::mw_mul_by_single2 r6 r7 ys q2 q4) res``,
1867  SIMP_TAC std_ss [mw_cmp_alt_def,TL,HD]);
1868
1869val x64_adjust_aux_thm = prove(
1870  ``!ys zs ys1 zs1 zs2 res r1 r12.
1871      (LENGTH zs = LENGTH ys + 1) /\ LENGTH (ys1 ++ ys) < dimword (:64)
1872                                  /\ LENGTH (zs1 ++ zs) < dimword (:64) ==>
1873      x64_adjust_aux_pre (r1,r6,r7,if res = SOME T then 1w else 0w,
1874        n2w (LENGTH (ys1 ++ ys)), n2w (LENGTH zs1),n2w (LENGTH ys1),
1875        r12,ys1 ++ ys,zs1 ++ zs ++ zs2) /\
1876      (x64_adjust_aux (r1,r6,r7,if res = SOME T then 1w else 0w,
1877        n2w (LENGTH (ys1 ++ ys)), n2w (LENGTH zs1),n2w (LENGTH ys1),
1878        r12,ys1 ++ ys,zs1 ++ zs ++ zs2) =
1879        (r6,r7,if mw_cmp_alt zs (mw_mul_by_single2 r6 r7 ys r1 r12) res = SOME T
1880               then 1w else 0w,n2w (LENGTH (ys1 ++ ys)),n2w (LENGTH (zs1 ++ zs)),
1881               n2w (LENGTH (ys1 ++ ys)),ys1 ++ ys,zs1 ++ zs ++ zs2))``,
1882  Induct THEN1
1883   (SIMP_TAC std_ss [APPEND_NIL,mw_mul_by_single2_def,LENGTH]
1884    \\ Cases \\ SIMP_TAC std_ss [LENGTH]
1885    \\ Cases_on `t` \\ SIMP_TAC std_ss [LENGTH,ADD1]
1886    \\ ONCE_REWRITE_TAC [x64_adjust_aux_def,x64_adjust_aux_pre_def]
1887    \\ SIMP_TAC std_ss [LET_DEF,LENGTH_APPEND,LENGTH]
1888    \\ NTAC 6 STRIP_TAC
1889    \\ `LENGTH zs1 < dimword (:64)` by DECIDE_TAC
1890    \\ FULL_SIMP_TAC std_ss [APPEND,GSYM APPEND_ASSOC,w2n_n2w,
1891         rich_listTheory.EL_LENGTH_APPEND,NULL_DEF,HD]
1892    \\ REWRITE_TAC [x64_adj_cmp_thm] \\ SIMP_TAC std_ss [word_add_n2w]
1893    \\ DECIDE_TAC)
1894  \\ ONCE_REWRITE_TAC [x64_adjust_aux_def,x64_adjust_aux_pre_def]
1895  \\ Cases_on `zs` \\ SIMP_TAC std_ss [LENGTH,ADD1] \\ NTAC 8 STRIP_TAC
1896  \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH (zs1 ++ z::zs) < dimword (:64)`
1897  \\ POP_ASSUM MP_TAC
1898  \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH (ys1 ++ y::ys) < dimword (:64)`
1899  \\ STRIP_TAC
1900  \\ `n2w (LENGTH (ys1 ++ y::ys)) <> n2w (LENGTH ys1):word64` by ALL_TAC THEN1
1901   (FULL_SIMP_TAC std_ss [LENGTH_APPEND]
1902    \\ `LENGTH ys1 < dimword(:64)` by DECIDE_TAC
1903    \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH,ADD1])
1904  \\ FULL_SIMP_TAC std_ss [word_add_n2w,x64_adj_cmp_thm,x64_single_mul_add_thm,
1905        x64_single_mul_thm]
1906  \\ `LENGTH zs1 < dimword (:64) /\ LENGTH ys1 < dimword (:64)` by
1907       (FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC)
1908  \\ FULL_SIMP_TAC std_ss [w2n_n2w,EL_LENGTH,LET_DEF,mw_mul_by_single2_def]
1909  \\ `?q1 q2. single_mul_add r6 y r1 0x0w = (q1,q2)` by METIS_TAC [PAIR]
1910  \\ `?q3 q4. single_mul_add r7 q1 r12 0x0w = (q3,q4)` by METIS_TAC [PAIR]
1911  \\ FULL_SIMP_TAC std_ss [SNOC_INTRO]
1912  \\ `(LENGTH ys1 + 1 = LENGTH (SNOC y ys1)) /\
1913      (LENGTH zs1 + 1 = LENGTH (SNOC z zs1))` by
1914        FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1]
1915  \\ FULL_SIMP_TAC std_ss [mw_cmp_alt_CONS]
1916  \\ FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
1917  |> Q.SPECL [`ys`,`zs`,`[]`,`zs1`,`zs2`,`NONE`,`0w`,`0w`]
1918  |> SIMP_RULE std_ss [LENGTH,APPEND] |> GEN_ALL;
1919
1920val x64_div_adjust_thm = prove(
1921  ``(LENGTH zs = LENGTH ys + 1) /\ LENGTH ys < dimword (:64)
1922                                /\ LENGTH (zs1 ++ zs) < dimword (:64) ==>
1923    x64_div_adjust_pre (r6,r7,n2w (LENGTH ys),n2w (LENGTH zs1),
1924                        ys,zs1 ++ zs ++ zs2) /\
1925    (x64_div_adjust (r6,r7,n2w (LENGTH ys),n2w (LENGTH zs1),
1926                     ys,zs1 ++ zs ++ zs2) =
1927      (r6,mw_div_adjust r7 zs (FRONT (mw_mul_by_single r6 ys)),
1928       n2w (LENGTH ys),n2w (LENGTH (zs1 ++ zs)),n2w (LENGTH ys),
1929       ys,zs1 ++ zs ++ zs2))``,
1930  SIMP_TAC std_ss [x64_div_adjust_def,x64_div_adjust_pre_def,LET_DEF]
1931  \\ ASSUME_TAC x64_adjust_aux_thm \\ SEP_I_TAC "x64_adjust_aux"
1932  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mw_div_adjust_def]
1933  \\ SIMP_TAC std_ss [GSYM mw_mul_by_single2_thm]
1934  \\ `mw_cmp_alt zs (mw_mul_by_single2 r6 r7 ys 0x0w 0x0w) NONE =
1935      mw_cmp zs (mw_mul_by_single2 r6 r7 ys 0x0w 0x0w)` by ALL_TAC THEN1
1936   (MATCH_MP_TAC (GSYM mw_cmp_alt_thm)
1937    \\ SIMP_TAC std_ss [mw_mul_by_single2_thm,LENGTH_mw_mul_by_single]
1938    \\ FULL_SIMP_TAC std_ss [LENGTH_mw_mul_by_single,LENGTH_FRONT,
1939         GSYM LENGTH_NIL] \\ DECIDE_TAC)
1940  \\ FULL_SIMP_TAC std_ss [] \\ `0 < dimword (:64)` by DECIDE_TAC
1941  \\ Cases_on `r7` \\ FULL_SIMP_TAC std_ss [w2n_n2w,n2w_11]
1942  \\ Cases_on `mw_cmp zs (mw_mul_by_single2 r6 (n2w n) ys 0x0w 0x0w) = SOME T`
1943  \\ FULL_SIMP_TAC std_ss [EVAL ``0w=1w:word64``]
1944  \\ Cases_on `n = 0` \\ FULL_SIMP_TAC std_ss [word_arith_lemma2]
1945  \\ `~(n < 1)` by DECIDE_TAC \\ FULL_SIMP_TAC std_ss []);
1946
1947(* mw_div -- mw_sub *)
1948
1949val (x64_div_sub_res,x64_div_sub_def) = x64_decompile "x64_div_sub" `
1950      not r0
1951      add r8,1
1952      adc r3,r0
1953      mov r0,0
1954      mov r8,r0
1955      not r0
1956      cmovb r8,r0`;
1957
1958val _ = add_compiled [x64_div_sub_res]
1959
1960val bool2num_thm = prove(
1961  ``bool2num = b2n``,
1962  FULL_SIMP_TAC std_ss [FUN_EQ_THM] \\ Cases \\ EVAL_TAC);
1963
1964val x64_div_sub_thm = prove(
1965  ``x64_div_sub_pre (r0,r3,r8) /\
1966    (x64_div_sub (r0,r3,r8) =
1967       let (r3,c) = single_sub r3 r0 (dimword (:64) <= w2n r8 + 1) in
1968         (~0w,r3,if c then ~0w else 0w))``,
1969  SIMP_TAC std_ss [single_sub_def,x64_div_sub_def,LET_DEF]
1970  \\ FULL_SIMP_TAC std_ss [bool2num_thm]
1971  \\ SIMP_TAC std_ss [GSYM (EVAL ``dimword (:64)``)]
1972  \\ SIMP_TAC std_ss [GSYM (EVAL ``FST (single_add x y c)``)]
1973  \\ SIMP_TAC std_ss [GSYM (EVAL ``SND (single_add x y c)``)]
1974  \\ Cases_on `single_add r3 (~r0) (dimword (:64) <= w2n r8 + 1)`
1975  \\ FULL_SIMP_TAC std_ss [] \\ Cases_on `r` \\ EVAL_TAC);
1976
1977val (res,x64_div_sub_loop_def,x64_div_sub_loop_pre_def) = x64_compile `
1978  x64_div_sub_loop (r1,r6,r7,r8:word64,r9,r10:word64,r11:word64,r12,ys:word64 list,zs) =
1979    if r9 = r11 then
1980      let r0 = r12 in
1981      let r3 = EL (w2n r10) zs in
1982      let (r0,r3,r8) = x64_div_sub (r0,r3,r8) in
1983      let r1 = r3 in
1984      let zs = LUPDATE r1 (w2n r10) zs in
1985      let r10 = r10 + 1w in
1986        (r6,r7,r9,r10,r11,ys,zs)
1987    else
1988      let r0 = r6 in (* x1 *)
1989      let r2 = EL (w2n r11) ys in
1990      let (r0,r1,r2) = x64_single_mul (r0,r1,r2) in
1991      let r1 = r12 in
1992      let r12 = r2 in
1993      let r2 = r0 in
1994      let r0 = r7 in
1995      let (r0,r1,r2) = x64_single_mul (r0,r1,r2) in
1996      let r1 = r12 in
1997      let r12 = r2 in
1998      let r3 = EL (w2n r10) zs in
1999      let (r0,r3,r8) = x64_div_sub (r0,r3,r8) in
2000      let r0 = r1 in
2001      let r1 = r3 in
2002      let zs = LUPDATE r1 (w2n r10) zs in
2003      let r1 = r0 in
2004      let r11 = r11 + 1w in
2005      let r10 = r10 + 1w in
2006        x64_div_sub_loop (r1,r6,r7,r8,r9,r10,r11,r12,ys,zs)`
2007
2008val LUPDATE_THM = prove(
2009  ``(LUPDATE q (LENGTH xs) (SNOC x xs) = SNOC q xs) /\
2010    (LUPDATE q (LENGTH xs) (SNOC x xs ++ ys) = SNOC q xs ++ ys) /\
2011    (LUPDATE q (LENGTH xs) (SNOC x xs ++ ys ++ zs) = SNOC q xs ++ ys ++ zs)``,
2012  SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,LUPDATE_LENGTH]);
2013
2014val x64_div_sub_loop_thm = prove(
2015  ``!ys zs ys1 zs1 zs2 c r1 r12.
2016      (LENGTH zs = LENGTH ys + 1) /\ LENGTH (ys1 ++ ys) < dimword (:64)
2017                                  /\ LENGTH (zs1 ++ zs) < dimword (:64) ==>
2018      x64_div_sub_loop_pre (r1,r6,r7,(if c then ~0w else 0w),
2019        n2w (LENGTH (ys1 ++ ys)), n2w (LENGTH zs1),n2w (LENGTH ys1),
2020        r12,ys1 ++ ys,zs1 ++ zs ++ zs2) /\
2021      (x64_div_sub_loop (r1,r6,r7,(if c then ~0w else 0w),
2022        n2w (LENGTH (ys1 ++ ys)), n2w (LENGTH zs1),n2w (LENGTH ys1),
2023        r12,ys1 ++ ys,zs1 ++ zs ++ zs2) =
2024        (r6,r7,n2w (LENGTH (ys1 ++ ys)),n2w (LENGTH (zs1 ++ zs)),
2025               n2w (LENGTH (ys1 ++ ys)),ys1 ++ ys,
2026         zs1 ++ (FST (mw_sub zs (mw_mul_by_single2 r6 r7 ys r1 r12) c)) ++ zs2))``,
2027  Induct THEN1
2028   (SIMP_TAC std_ss [APPEND_NIL,mw_mul_by_single2_def,LENGTH]
2029    \\ Cases \\ SIMP_TAC std_ss [LENGTH]
2030    \\ Cases_on `t` \\ SIMP_TAC std_ss [LENGTH,ADD1]
2031    \\ ONCE_REWRITE_TAC [x64_div_sub_loop_def,x64_div_sub_loop_pre_def]
2032    \\ SIMP_TAC std_ss [LET_DEF,LENGTH_APPEND,LENGTH]
2033    \\ NTAC 6 STRIP_TAC
2034    \\ `LENGTH zs1 < dimword (:64)` by DECIDE_TAC
2035    \\ FULL_SIMP_TAC std_ss [word_add_n2w,w2n_n2w,EL_LENGTH]
2036    \\ FULL_SIMP_TAC std_ss [LUPDATE_THM,APPEND_NIL,SNOC_INTRO]
2037    \\ FULL_SIMP_TAC std_ss [SNOC_INTRO,x64_div_sub_thm]
2038    \\ `(dimword (:64) <= w2n (if c then (~0x0w) else 0x0w:word64) + 1) = c` by
2039          (Cases_on `c` \\ EVAL_TAC)
2040    \\ FULL_SIMP_TAC std_ss [mw_sub_def,HD,TL]
2041    \\ Cases_on `single_sub h r12 c`
2042    \\ FULL_SIMP_TAC std_ss [LET_DEF,SNOC_INTRO,APPEND_NIL] \\ DECIDE_TAC)
2043  \\ ONCE_REWRITE_TAC [x64_div_sub_loop_def,x64_div_sub_loop_pre_def]
2044  \\ Cases_on `zs` \\ SIMP_TAC std_ss [LENGTH,ADD1] \\ NTAC 8 STRIP_TAC
2045  \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH (zs1 ++ z::zs) < dimword (:64)`
2046  \\ POP_ASSUM MP_TAC
2047  \\ Q.MATCH_ASSUM_RENAME_TAC `LENGTH (ys1 ++ y::ys) < dimword (:64)`
2048  \\ STRIP_TAC
2049  \\ `n2w (LENGTH (ys1 ++ y::ys)) <> n2w (LENGTH ys1):word64` by
2050   (FULL_SIMP_TAC std_ss [LENGTH_APPEND]
2051    \\ `LENGTH ys1 < dimword(:64)` by DECIDE_TAC
2052    \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH,ADD1])
2053  \\ FULL_SIMP_TAC std_ss [word_add_n2w,x64_adj_cmp_thm,x64_single_mul_add_thm,
2054        x64_single_mul_thm]
2055  \\ `LENGTH zs1 < dimword (:64) /\ LENGTH ys1 < dimword (:64)` by
2056       (FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC)
2057  \\ FULL_SIMP_TAC std_ss [w2n_n2w,EL_LENGTH,LET_DEF,mw_mul_by_single2_def]
2058  \\ `?q1 q2. single_mul_add r6 y r1 0x0w = (q1,q2)` by METIS_TAC [PAIR]
2059  \\ `?q3 q4. single_mul_add r7 q1 r12 0x0w = (q3,q4)` by METIS_TAC [PAIR]
2060  \\ FULL_SIMP_TAC std_ss [SNOC_INTRO,x64_div_sub_thm]
2061  \\ `(dimword (:64) <= w2n (if c then (~0x0w) else 0x0w:word64) + 1) = c` by
2062        (Cases_on `c` \\ EVAL_TAC)
2063  \\ FULL_SIMP_TAC std_ss [mw_sub_def,HD,TL]
2064  \\ Cases_on `single_sub z q3 c`
2065  \\ FULL_SIMP_TAC std_ss [LET_DEF]
2066  \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV)
2067  \\ SIMP_TAC std_ss [SNOC_INTRO,LUPDATE_THM]
2068  \\ `(LENGTH ys1 + 1 = LENGTH (SNOC y ys1)) /\
2069      (LENGTH zs1 + 1 = LENGTH (SNOC q zs1)) /\
2070      (LENGTH (SNOC y ys1 ++ ys) = LENGTH (SNOC q ys1 ++ ys)) /\
2071      LENGTH (SNOC q ys1 ++ ys) < dimword (:64) /\
2072      LENGTH (SNOC q zs1 ++ zs) < dimword (:64)` by
2073        (FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1,LENGTH_APPEND] \\ DECIDE_TAC)
2074  \\ Q.PAT_X_ASSUM `!zs. bbb` (MP_TAC o Q.SPECL [`zs`,`SNOC y ys1`,
2075         `SNOC q zs1`,`zs2`,`r`,`q2`,`q4`])
2076  \\ FULL_SIMP_TAC std_ss []
2077  \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_SNOC]
2078  \\ REPEAT STRIP_TAC \\ DECIDE_TAC)
2079  |> Q.SPECL [`ys`,`zs`,`[]`,`zs1`,`zs2`,`T`,`0w`,`0w`]
2080  |> SIMP_RULE std_ss [LENGTH,APPEND] |> GEN_ALL;
2081
2082(* mw_div -- mw_div_aux *)
2083
2084val (res,x64_div_loop_def,x64_div_loop_pre_def) = x64_compile `
2085  x64_div_loop (r7,r9,r10,r11,ys,zs,ss) =
2086    if r10 = 0w then
2087      (r7,r9,r10,r11,ys,zs,ss)
2088    else
2089      let (r6,ss) = (HD ss,TL ss) in
2090      let (r3,ss) = (HD ss,TL ss) in
2091      let ss = r7::ss in
2092      let ss = r9::ss in
2093      let ss = r10::ss in
2094      let r10 = r10 + r9 in
2095      let r10 = r10 - 1w in
2096      let r0 = EL (w2n r10) zs in
2097      let r10 = r10 - 1w in
2098      let r1 = EL (w2n r10) zs in
2099      let r10 = r10 - 1w in
2100      let r2 = EL (w2n r10) zs in
2101      let r11 = r0 in
2102      let r10 = r1 in
2103      let r9 = r2 in
2104      let r7 = r3 in
2105      let r8 = r6 in
2106      let (r6,r7,r8,r9,r10,r11) = x64_div_guess (r7,r8,r9,r10,r11) in
2107      let r0 = r6 in
2108      let (r10,ss) = (HD ss,TL ss) in
2109      let (r9,ss) = (HD ss,TL ss) in
2110      let (r6,ss) = (HD ss,TL ss) in
2111      let r10 = r10 - 1w in
2112      let ss = r7::ss in
2113      let ss = r8::ss in
2114      let r7 = r0 in
2115      let (r6,r7,r9,r10,r11,ys,zs) = x64_div_adjust (r6,r7,r9,r10,ys,zs) in
2116      let r10 = r10 - r9 in
2117      let r10 = r10 - 1w in
2118      let r1 = 0w in
2119      let r8 = ~r1 in
2120      let r11 = r1 in
2121      let r12 = r1 in
2122      let (r6,r7,r9,r10,r11,ys,zs) =
2123            x64_div_sub_loop (r1,r6,r7,r8,r9,r10,r11,r12,ys,zs) in
2124      let r10 = r10 - 1w in
2125      let zs = LUPDATE r7 (w2n r10) zs in
2126      let r10 = r10 - r9 in
2127      let r7 = r6 in
2128        x64_div_loop (r7,r9,r10,r11,ys,zs,ss)`
2129
2130val x64_div_loop_thm = prove(
2131  ``!zs1 zs ys1 zs2 c r1 r12.
2132      (LENGTH zs = LENGTH ys) /\ LENGTH (zs1 ++ zs ++ zs2) < dimword (:64) /\
2133      1 < LENGTH ys /\ LAST (FRONT (mw_mul_by_single d ys)) <> 0x0w ==>
2134      let ys1 = (FRONT (mw_mul_by_single d ys)) in
2135        x64_div_loop_pre (d,n2w (LENGTH ys),n2w (LENGTH zs1),n2w (LENGTH ys),
2136          ys,zs1 ++ zs ++ zs2,(LAST ys1)::(LAST (BUTLAST ys1))::ss) /\
2137        (x64_div_loop (d,n2w (LENGTH ys),n2w (LENGTH zs1),n2w (LENGTH ys),
2138          ys,zs1 ++ zs ++ zs2,(LAST ys1)::(LAST (BUTLAST ys1))::ss) =
2139          (d,n2w (LENGTH ys),0w,n2w (LENGTH ys),ys,
2140           (let (qs,rs) = mw_div_aux zs1 zs ys1 in
2141              rs ++ REVERSE qs ++ zs2),(LAST ys1)::(LAST (BUTLAST ys1))::ss))``,
2142  Q.ABBREV_TAC `ys1 = FRONT (mw_mul_by_single d ys)`
2143  \\ SIMP_TAC std_ss [LET_DEF] \\ HO_MATCH_MP_TAC SNOC_INDUCT
2144  \\ STRIP_TAC THEN1 (SIMP_TAC std_ss
2145    [LENGTH,APPEND,Once mw_div_aux_def,APPEND_NIL,
2146     Once x64_div_loop_def,Once x64_div_loop_pre_def,REVERSE_DEF])
2147  \\ NTAC 2 STRIP_TAC
2148  \\ ONCE_REWRITE_TAC [mw_div_aux_def] \\ NTAC 4 STRIP_TAC
2149  \\ SIMP_TAC std_ss [LAST_SNOC,FRONT_SNOC,rich_listTheory.NOT_SNOC_NIL]
2150  \\ NTAC 4 (SIMP_TAC std_ss [Once LET_DEF])
2151  \\ Q.ABBREV_TAC `guess = mw_div_guess (REVERSE (x::zs)) (REVERSE ys1)`
2152  \\ Q.ABBREV_TAC `adj = mw_div_adjust guess (x::zs) ys1`
2153  \\ Q.ABBREV_TAC `sub = (FST (mw_sub (x::zs) (mw_mul_by_single adj ys1) T))`
2154  \\ `?qs1 rs1. mw_div_aux zs1 (FRONT sub) ys1 = (qs1,rs1)` by METIS_TAC [PAIR]
2155  \\ FULL_SIMP_TAC std_ss []
2156  \\ ONCE_REWRITE_TAC [x64_div_loop_def,x64_div_loop_pre_def]
2157  \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH_APPEND]
2158  \\ IMP_RES_TAC (DECIDE ``n + m + k < d ==> 0 < d /\ n < d:num``)
2159  \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH_APPEND]
2160  \\ SIMP_TAC std_ss [LENGTH_SNOC,ADD1,GSYM word_add_n2w,WORD_ADD_SUB,HD,TL]
2161  \\ SIMP_TAC std_ss [LET_DEF,TL,HD,GSYM WORD_SUB_PLUS,word_add_n2w]
2162  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC]
2163  \\ `(zs1 ++ ([x] ++ (zs ++ zs2))) = (zs1 ++ x::zs ++ zs2)` by ALL_TAC
2164  THEN1 FULL_SIMP_TAC std_ss [APPEND,GSYM APPEND_ASSOC]
2165  \\ FULL_SIMP_TAC std_ss []
2166  \\ `~(LENGTH zs1 + 1 + LENGTH ys < 3) /\
2167      ~(LENGTH zs1 + 1 + LENGTH ys < 2) /\
2168      ~(LENGTH zs1 + 1 + LENGTH ys < 1) /\
2169      ~(LENGTH (zs1 ++ x::zs) < 1) /\
2170      ~(LENGTH (zs1 ++ x::zs) < 1 + LENGTH ys) /\
2171      (LENGTH zs1 + 1 + LENGTH ys - 3) < dimword (:64) /\
2172      (LENGTH zs1 + 1 + LENGTH ys - 2) < dimword (:64) /\
2173      (LENGTH zs1 + 1 + LENGTH ys - 1) < dimword (:64) /\
2174      (LENGTH zs1 + 1 + LENGTH ys) < dimword (:64) /\
2175      (LENGTH (zs1 ++ x::zs) - 1) < dimword (:64) /\
2176      ~(LENGTH zs1 + 1 < 1) /\
2177      ~(LENGTH (zs1 ++ x::zs) < LENGTH ys + 1) /\
2178      (LENGTH (zs1 ++ x::zs) - (LENGTH ys + 1) = LENGTH zs1)` by
2179        (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC)
2180  \\ FULL_SIMP_TAC std_ss [w2n_n2w,word_arith_lemma2]
2181  \\ FULL_SIMP_TAC std_ss [w2n_n2w]
2182  \\ `(EL (LENGTH zs1 + 1 + LENGTH ys - 3) (zs1 ++ x::zs ++ zs2) =
2183       LAST (BUTLAST (BUTLAST (x::zs)))) /\
2184      (EL (LENGTH zs1 + 1 + LENGTH ys - 2) (zs1 ++ x::zs ++ zs2) =
2185       LAST (BUTLAST (x::zs))) /\
2186      (EL (LENGTH zs1 + 1 + LENGTH ys - 1) (zs1 ++ x::zs ++ zs2) =
2187       LAST (x::zs))` by ALL_TAC THEN1
2188   (`(LENGTH zs1 + 1 + LENGTH ys - 3 = LENGTH zs1 + (LENGTH (x::zs) - 3)) /\
2189     (LENGTH zs1 + 1 + LENGTH ys - 2 = LENGTH zs1 + (LENGTH (x::zs) - 2)) /\
2190     (LENGTH zs1 + 1 + LENGTH ys - 1 = LENGTH zs1 + (LENGTH (x::zs) - 1)) /\
2191     (LENGTH (x::zs) - 3 < LENGTH (x::zs))` by
2192        (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC)
2193    \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_APPEND2,DECIDE ``n <= n + m:num``,
2194         GSYM APPEND_ASSOC,rich_listTheory.EL_APPEND1]
2195    \\ `(x::zs = []) \/ ?t1 t2. x::zs = SNOC t1 t2` by METIS_TAC [SNOC_CASES]
2196    \\ FULL_SIMP_TAC (srw_ss()) [ADD1]
2197    \\ `LENGTH ys = LENGTH t2` by ALL_TAC THEN1
2198     (`LENGTH (x::zs) = LENGTH (t2 ++ [t1])` by METIS_TAC []
2199      \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,ADD1])
2200    \\ FULL_SIMP_TAC std_ss [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC]
2201    \\ `(t2 = []) \/ ?t3 t4. t2 = SNOC t3 t4` by METIS_TAC [SNOC_CASES]
2202    \\ FULL_SIMP_TAC (srw_ss()) [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC,
2203         LENGTH,ADD1,SNOC_APPEND] \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND]
2204    \\ SIMP_TAC std_ss [EL_LENGTH,DECIDE ``n+1+1-2 = n:num``]
2205    \\ `(t4 = []) \/ ?t5 t6. t4 = SNOC t5 t6` by METIS_TAC [SNOC_CASES]
2206    \\ FULL_SIMP_TAC (srw_ss()) [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC,
2207         LENGTH,ADD1,SNOC_APPEND] \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND]
2208    \\ SIMP_TAC std_ss [EL_LENGTH,DECIDE ``n+1+1+1-3 = n:num``])
2209  \\ FULL_SIMP_TAC std_ss []
2210  \\ ASSUME_TAC (x64_div_guess_thm |> GEN_ALL)
2211  \\ SEP_I_TAC "x64_div_guess" \\ FULL_SIMP_TAC std_ss []
2212  \\ POP_ASSUM (MP_TAC o Q.SPECL [`REVERSE (FRONT (FRONT ys1))`,
2213      `REVERSE (FRONT (FRONT (FRONT (x::zs))))`])
2214  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
2215  \\ `mw_div_guess
2216        (LAST (x::zs)::LAST (FRONT (x::zs))::
2217             LAST (FRONT (FRONT (x::zs)))::REVERSE (FRONT (FRONT (FRONT (x::zs)))))
2218        (LAST ys1::LAST (FRONT ys1)::REVERSE (FRONT (FRONT ys1))) = guess` by ALL_TAC
2219  THEN1
2220   (Q.UNABBREV_TAC `guess`
2221    \\ MATCH_MP_TAC (METIS_PROVE [] ``(x1 = x2) /\ (y1 = y2) ==> (f x1 y1 = f x2 y2)``)
2222    \\ Tactical.REVERSE STRIP_TAC THEN1
2223     (`LENGTH ys1 = LENGTH ys` by ALL_TAC THEN1
2224       (Q.UNABBREV_TAC `ys1`
2225        \\ FULL_SIMP_TAC std_ss [LENGTH_FRONT,LENGTH_mw_mul_by_single,GSYM LENGTH_NIL]
2226        \\ DECIDE_TAC)
2227      \\ `(ys1 = []) \/ ?t1 t2. ys1 = SNOC t1 t2` by METIS_TAC [SNOC_CASES]
2228      \\ FULL_SIMP_TAC (srw_ss()) [ADD1,GSYM LENGTH_NIL] THEN1 `F` by DECIDE_TAC
2229      \\ FULL_SIMP_TAC std_ss [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC]
2230      \\ `(t2 = []) \/ ?t3 t4. t2 = SNOC t3 t4` by METIS_TAC [SNOC_CASES]
2231      \\ FULL_SIMP_TAC (srw_ss()) [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC,
2232           LENGTH,ADD1,SNOC_APPEND] \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND]
2233      \\ DECIDE_TAC)
2234    \\ `(x::zs = []) \/ ?t1 t2. x::zs = SNOC t1 t2` by METIS_TAC [SNOC_CASES]
2235    THEN1 FULL_SIMP_TAC (srw_ss()) [ADD1] \\ ASM_SIMP_TAC std_ss []
2236    \\ `LENGTH ys = LENGTH t2` by ALL_TAC THEN1
2237     (`LENGTH (x::zs) = LENGTH (SNOC t1 t2)` by METIS_TAC []
2238      \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND,LENGTH,ADD1])
2239    \\ FULL_SIMP_TAC std_ss [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC]
2240    \\ `(t2 = []) \/ ?t3 t4. t2 = SNOC t3 t4` by METIS_TAC [SNOC_CASES]
2241    \\ FULL_SIMP_TAC std_ss [LAST_SNOC,FRONT_SNOC,REVERSE_SNOC,CONS_11]
2242    \\ FULL_SIMP_TAC (srw_ss()) [EL_LENGTH,RW [SNOC_APPEND] FRONT_SNOC,
2243         LENGTH,ADD1,SNOC_APPEND] \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND]
2244    \\ `(t4 = []) \/ ?t5 t6. t4 = SNOC t5 t6` by METIS_TAC [SNOC_CASES]
2245    \\ FULL_SIMP_TAC std_ss [LAST_SNOC,FRONT_SNOC,REVERSE_SNOC,CONS_11]
2246    \\ FULL_SIMP_TAC (srw_ss()) [])
2247  \\ FULL_SIMP_TAC std_ss [] \\ NTAC 6 (POP_ASSUM (K ALL_TAC))
2248  \\ ASSUME_TAC (GEN_ALL x64_div_adjust_thm)
2249  \\ SEP_I_TAC "x64_div_adjust" \\ POP_ASSUM MP_TAC
2250  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
2251  THEN1 (FULL_SIMP_TAC (srw_ss()) [LENGTH] \\ DECIDE_TAC)
2252  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [word_add_n2w,word_arith_lemma2]
2253  \\ ASSUME_TAC (GEN_ALL x64_div_sub_loop_thm)
2254  \\ SEP_I_TAC "x64_div_sub_loop" \\ POP_ASSUM MP_TAC
2255  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
2256  THEN1 (FULL_SIMP_TAC (srw_ss()) [LENGTH] \\ DECIDE_TAC)
2257  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss [word_add_n2w,word_arith_lemma2]
2258  \\ FULL_SIMP_TAC std_ss [w2n_n2w]
2259  \\ `LENGTH (zs1 ++ x::zs) - (1 + LENGTH ys) = LENGTH zs1` by
2260        (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC)
2261  \\ FULL_SIMP_TAC std_ss []
2262  \\ `LUPDATE adj (LENGTH (zs1 ++ x::zs) - 1) (zs1 ++
2263        FST (mw_sub (x::zs) (mw_mul_by_single2 d adj ys 0x0w 0x0w) T) ++
2264        zs2) = zs1 ++ SNOC adj (FRONT sub) ++ zs2` by ALL_TAC THEN1
2265   (FULL_SIMP_TAC std_ss [mw_mul_by_single2_thm]
2266    \\ `LENGTH sub = LENGTH (x::zs)` by ALL_TAC THEN1
2267     (Q.UNABBREV_TAC `sub`
2268      \\ Cases_on `mw_sub (x::zs) (mw_mul_by_single adj ys1) T`
2269      \\ IMP_RES_TAC LENGTH_mw_sub \\ FULL_SIMP_TAC std_ss [LENGTH])
2270    \\ `(sub = []) \/ ?t3 t4. sub = SNOC t3 t4` by METIS_TAC [SNOC_CASES]
2271    \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,FRONT_SNOC]
2272    \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]
2273    \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC]
2274    \\ `LENGTH (zs1 ++ x::zs) - 1 = LENGTH (zs1 ++ t4)` by
2275        (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC)
2276    \\ FULL_SIMP_TAC std_ss [LUPDATE_LENGTH])
2277  \\ FULL_SIMP_TAC std_ss []
2278  \\ SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND]
2279  \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC,APPEND]
2280  \\ SEP_I_TAC "x64_div_loop" \\ POP_ASSUM MP_TAC
2281  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1
2282   (`(LENGTH (FRONT sub) = LENGTH ys)` by ALL_TAC THEN1
2283      (Q.UNABBREV_TAC `sub`
2284       \\ Cases_on `mw_sub (x::zs) (mw_mul_by_single adj ys1) T`
2285       \\ FULL_SIMP_TAC std_ss []
2286       \\ IMP_RES_TAC LENGTH_mw_sub
2287       \\ Cases_on `q = []` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1]
2288       \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_FRONT,GSYM LENGTH_NIL,ADD1]
2289       \\ DECIDE_TAC)
2290    \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND] \\ DECIDE_TAC)
2291  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
2292  \\ FULL_SIMP_TAC std_ss [REVERSE_DEF,GSYM APPEND_ASSOC,APPEND]
2293  \\ FULL_SIMP_TAC (srw_ss()) [GSYM CONJ_ASSOC]
2294  \\ Cases_on `mw_sub (x::zs) (mw_mul_by_single2 d adj ys 0x0w 0x0w) T`
2295  \\ IMP_RES_TAC LENGTH_mw_sub
2296  \\ FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC);
2297
2298(* mw_div -- mul_by_single *)
2299
2300val (res,x64_mul_by_single_def,x64_mul_by_single_pre_def) = x64_compile `
2301  x64_mul_by_single (r1:word64,r8:word64,r9:word64,r10:word64,r11:word64,xs:word64 list,zs:word64 list) =
2302    if r9 = r11 then
2303      let zs = LUPDATE r1 (w2n r10) zs in
2304      let r10 = r10 + 1w in
2305        (r1,r8,r9,r10,xs,zs)
2306    else
2307      let r2 = EL (w2n r11) xs in
2308      let r0 = r8 in
2309      let r3 = 0w in
2310      let (r0,r1,r2,r3) = x64_single_mul_add (r0,r1,r2,r3) in
2311      let zs = LUPDATE r0 (w2n r10) zs in
2312      let r1 = r2 in
2313      let r10 = r10 + 1w in
2314      let r11 = r11 + 1w in
2315        x64_mul_by_single (r1,r8,r9,r10,r11,xs,zs)`
2316
2317val x64_mul_by_single_thm = prove(
2318  ``!xs xs1 x zs k zs1 zs2 z2.
2319      LENGTH (xs1++xs) < dimword (:64) /\  (LENGTH zs = LENGTH xs) /\
2320      LENGTH (zs1++zs) < dimword (:64) ==>
2321      ?r1.
2322        x64_mul_by_single_pre (k,x,n2w (LENGTH (xs1++xs)),n2w (LENGTH zs1),
2323                          n2w (LENGTH xs1),xs1++xs,zs1++zs++z2::zs2) /\
2324        (x64_mul_by_single (k,x,n2w (LENGTH (xs1++xs)),n2w (LENGTH zs1),
2325                       n2w (LENGTH xs1),xs1++xs,zs1++zs++z2::zs2) =
2326           (r1,x,n2w (LENGTH (xs1++xs)),n2w (LENGTH (zs1++zs)+1),xs1++xs,
2327            zs1++(mw_mul_pass x xs (MAP (K 0w) xs) k)++zs2))``,
2328  Induct \\ Cases_on `zs`
2329  \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND_NIL,mw_mul_pass_def,ADD1]
2330  \\ ONCE_REWRITE_TAC [x64_mul_by_single_def,x64_mul_by_single_pre_def]
2331  \\ FULL_SIMP_TAC std_ss [LET_DEF,n2w_11,w2n_n2w,LUPDATE_LENGTH]
2332  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,word_add_n2w,LENGTH_APPEND]
2333  \\ FULL_SIMP_TAC std_ss [LENGTH,MAP,HD,TL]
2334  \\ REPEAT STRIP_TAC
2335  \\ IMP_RES_TAC (DECIDE ``m+n<k ==> m < k /\ n<k:num``)
2336  \\ FULL_SIMP_TAC std_ss [ADD1,x64_single_mul_add_thm]
2337  \\ FULL_SIMP_TAC std_ss [rich_listTheory.EL_LENGTH_APPEND,LUPDATE_LENGTH,NULL,HD]
2338  \\ Cases_on `single_mul_add x h' k 0w` \\ FULL_SIMP_TAC std_ss [LET_DEF,TL]
2339  \\ ONCE_REWRITE_TAC [SNOC_INTRO |> Q.INST [`xs2`|->`[]`] |> REWRITE_RULE [APPEND_NIL]]
2340  \\ `((LENGTH xs1 + (LENGTH xs + 1)) = (LENGTH (SNOC h' xs1) + LENGTH xs)) /\
2341      ((LENGTH xs1 + 1) = (LENGTH (SNOC h' xs1))) /\
2342      ((LENGTH zs1 + 1) = LENGTH (SNOC q zs1))` by ALL_TAC
2343  THEN1 (FULL_SIMP_TAC std_ss [LENGTH_SNOC] \\ DECIDE_TAC)
2344  \\ FULL_SIMP_TAC std_ss []
2345  \\ SEP_I_TAC "x64_mul_by_single" \\ POP_ASSUM MP_TAC
2346  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
2347  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
2348  \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss []
2349  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,
2350       LENGTH_APPEND,LENGTH,AC ADD_COMM ADD_ASSOC] \\ DECIDE_TAC)
2351  |> Q.SPECL [`xs`,`[]`,`x`,`zs`,`0w`,`[]`]
2352  |> SIMP_RULE std_ss [APPEND,LENGTH,GSYM k2mw_LENGTH_0,GSYM mw_mul_by_single_def]
2353  |> GEN_ALL;
2354
2355(* mw_div -- mul_by_single, top two from ys *)
2356
2357val (res,x64_top_two_def,x64_top_two_pre_def) = x64_compile `
2358  x64_top_two (r0,r1:word64,r3,r8:word64,r9:word64,r11:word64,ys:word64 list) =
2359    if r9 = r11 then
2360      let r1 = r3 in
2361        (r0,r1,r8,r9,r11,ys)
2362    else
2363      let r3 = r0 in
2364      let r2 = EL (w2n r11) ys in
2365      let r0 = r8 in
2366      let (r0,r1,r2) = x64_single_mul (r0,r1,r2) in
2367      let r1 = r2 in
2368      let r11 = r11 + 1w in
2369        x64_top_two (r0,r1,r3,r8,r9,r11,ys)`
2370
2371val x64_top_two_thm = prove(
2372  ``!ys x k1 k2 k3 ys1.
2373      LENGTH (ys1 ++ ys) < dimword (:64) ==>
2374      x64_top_two_pre (k2,k1,k3,
2375                       x,n2w (LENGTH (ys1++ys)),n2w (LENGTH ys1),ys1++ys) /\
2376      (x64_top_two (k2,k1,k3,
2377                    x,n2w (LENGTH (ys1++ys)),n2w (LENGTH ys1),ys1++ys) =
2378               (FST (SND (mw_mul_pass_top x ys (k1,k2,k3))),
2379                SND (SND (mw_mul_pass_top x ys (k1,k2,k3))),x,
2380                n2w (LENGTH (ys1++ys)),n2w (LENGTH (ys1++ys)),ys1++ys))``,
2381  Induct \\ FULL_SIMP_TAC std_ss [APPEND,APPEND_NIL]
2382  \\ ONCE_REWRITE_TAC [x64_top_two_def,x64_top_two_pre_def]
2383  \\ FULL_SIMP_TAC std_ss [LET_DEF,n2w_11,mw_mul_pass_top_def]
2384  \\ NTAC 7 STRIP_TAC
2385  \\ `LENGTH ys1 < dimword (:64) /\
2386      LENGTH (ys1 ++ h::ys) <> LENGTH ys1` by
2387        (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC)
2388  \\ FULL_SIMP_TAC std_ss [w2n_n2w,EL_LENGTH]
2389  \\ FULL_SIMP_TAC std_ss [x64_single_mul_thm]
2390  \\ Cases_on `single_mul_add x h k1 0w`
2391  \\ FULL_SIMP_TAC std_ss [LET_DEF,SNOC_INTRO]
2392  \\ `(LENGTH ys1 + 1) = (LENGTH (SNOC h ys1))` by ALL_TAC THEN1
2393       FULL_SIMP_TAC (srw_ss()) [word_add_n2w,ADD1]
2394  \\ FULL_SIMP_TAC std_ss [word_add_n2w]
2395  \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_APPEND] \\ DECIDE_TAC)
2396  |> Q.SPECL [`ys`,`x`,`0w`,`0w`,`0w`,`[]`] |> DISCH ``1 < LENGTH (ys:word64 list)``
2397  |> SIMP_RULE std_ss [APPEND_NIL,APPEND,LENGTH,mw_mul_pass_top_thm]
2398  |> REWRITE_RULE [AND_IMP_INTRO]
2399
2400
2401(* mw_div -- copy result down *)
2402
2403val (res,x64_copy_down_def,x64_copy_down_pre_def) = x64_compile `
2404  x64_copy_down (r8:word64,r10:word64,r11:word64,zs:word64 list) =
2405    if r8 = 0w then zs else
2406      let r0 = EL (w2n r10) zs in
2407      let r8 = r8 - 1w in
2408      let r10 = r10 + 1w in
2409      let zs = LUPDATE r0 (w2n r11) zs in
2410      let r11 = r11 + 1w in
2411        x64_copy_down (r8,r10,r11,zs)`
2412
2413val x64_copy_down_thm = prove(
2414  ``!zs0 zs1 zs2 zs3.
2415      LENGTH (zs0 ++ zs1 ++ zs2) < dimword (:64) /\ zs1 <> [] ==>
2416      ?zs4.
2417        x64_copy_down_pre (n2w (LENGTH zs2),
2418          n2w (LENGTH (zs0 ++ zs1)),n2w (LENGTH zs0),zs0 ++ zs1 ++ zs2 ++ zs3) /\
2419        (x64_copy_down (n2w (LENGTH zs2),
2420          n2w (LENGTH (zs0 ++ zs1)),n2w (LENGTH zs0),zs0 ++ zs1 ++ zs2 ++ zs3) =
2421           zs0 ++ zs2 ++ zs4) /\ (LENGTH zs4 = LENGTH zs1 + LENGTH zs3)``,
2422  Induct_on `zs2`
2423  \\ ONCE_REWRITE_TAC [x64_copy_down_def,x64_copy_down_pre_def]
2424  \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND_NIL]
2425  \\ FULL_SIMP_TAC std_ss [APPEND_11,GSYM APPEND_ASSOC,LENGTH_APPEND]
2426  \\ REPEAT STRIP_TAC
2427  \\ `SUC (LENGTH zs2) < dimword (:64) /\ 0 < dimword (:64) /\
2428      (LENGTH zs0 + LENGTH zs1) < dimword (:64) /\ LENGTH zs0 < dimword (:64)`
2429       by (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH] \\ DECIDE_TAC)
2430  \\ FULL_SIMP_TAC std_ss [n2w_11,ADD1,w2n_n2w]
2431  \\ FULL_SIMP_TAC std_ss [GSYM LENGTH_APPEND,APPEND_ASSOC,EL_LENGTH]
2432  \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB,LET_DEF]
2433  \\ FULL_SIMP_TAC std_ss [word_add_n2w]
2434  \\ Cases_on `zs1` \\ FULL_SIMP_TAC std_ss []
2435  \\ Q.MATCH_ASSUM_RENAME_TAC `z::zs <> []`
2436  \\ FULL_SIMP_TAC std_ss []
2437  \\ `(LENGTH (zs0 ++ z::zs) + 1 = LENGTH (SNOC h zs0 ++ SNOC h zs)) /\
2438      (LENGTH zs0 + 1 = LENGTH (SNOC h zs0))`
2439       by (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,LENGTH_SNOC] \\ DECIDE_TAC)
2440  \\ FULL_SIMP_TAC std_ss [LUPDATE_LENGTH,GSYM APPEND_ASSOC,APPEND]
2441  \\ SIMP_TAC std_ss [SNOC_INTRO] \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC]
2442  \\ Q.PAT_X_ASSUM `!xx.bb` (MP_TAC o Q.SPECL [`SNOC h zs0`,`SNOC h zs`,`zs3`])
2443  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1
2444    (FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,LENGTH_SNOC,NOT_SNOC_NIL]
2445     \\ DECIDE_TAC) \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
2446  \\ Q.EXISTS_TAC `zs4` \\ FULL_SIMP_TAC std_ss []
2447  \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH,LENGTH_SNOC,NOT_SNOC_NIL]
2448  \\ DECIDE_TAC) |> Q.SPEC `[]` |> SIMP_RULE std_ss [APPEND,LENGTH];
2449
2450(* mw_div -- copy xs into zs *)
2451
2452val (res,x64_copy_over_def,x64_copy_over_pre_def) = x64_compile `
2453  x64_copy_over (r10:word64,xs:word64 list,zs:word64 list) =
2454    if r10 = 0w then (xs,zs) else
2455      let r10 = r10 - 1w in
2456      let r0 = EL (w2n r10) xs in
2457      let zs = LUPDATE r0 (w2n r10) zs in
2458        x64_copy_over (r10,xs,zs)`;
2459
2460val x64_copy_over_thm = prove(
2461  ``!xs0 zs0 xs zs.
2462      (LENGTH zs0 = LENGTH xs0) /\
2463      LENGTH (zs0++zs) < dimword (:64) ==>
2464      x64_copy_over_pre (n2w (LENGTH xs0),xs0 ++ xs,zs0 ++ zs) /\
2465      (x64_copy_over (n2w (LENGTH xs0),xs0 ++ xs,zs0 ++ zs) =
2466         (xs0 ++ xs,xs0 ++ zs))``,
2467  HO_MATCH_MP_TAC SNOC_INDUCT \\ STRIP_TAC THEN1
2468   (ONCE_REWRITE_TAC [x64_copy_over_def,x64_copy_over_pre_def]
2469    \\ SIMP_TAC std_ss [LENGTH,LENGTH_NIL,APPEND])
2470  \\ NTAC 7 STRIP_TAC
2471  \\ `(zs0 = []) \/ ?x l. zs0 = SNOC x l` by METIS_TAC [SNOC_CASES]
2472  \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,LENGTH_SNOC]
2473  \\ `LENGTH xs0 + 1 < dimword (:64) /\ LENGTH xs0 < dimword (:64)` by ALL_TAC
2474  THEN1 (FULL_SIMP_TAC std_ss [LENGTH_SNOC,LENGTH_APPEND] \\ DECIDE_TAC)
2475  \\ ONCE_REWRITE_TAC [x64_copy_over_def,x64_copy_over_pre_def]
2476  \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword]
2477  \\ FULL_SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB,LET_DEF]
2478  \\ FULL_SIMP_TAC std_ss [w2n_n2w,EL_LENGTH,SNOC_APPEND]
2479  \\ Q.PAT_X_ASSUM `LENGTH l = LENGTH xs0` (ASSUME_TAC o GSYM)
2480  \\ ASM_SIMP_TAC std_ss [LUPDATE_LENGTH,APPEND,GSYM APPEND_ASSOC]
2481  \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND]
2482  \\ `LENGTH l + LENGTH (x::zs) < dimword (:64)` by ALL_TAC
2483  THEN1 (FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND] \\ DECIDE_TAC)
2484  \\ RES_TAC \\ FULL_SIMP_TAC std_ss [])
2485
2486
2487(* mw_div -- top-level function *)
2488
2489val (res,x64_div_def,x64_div_pre_def) = x64_compile `
2490  x64_div (r0,r1,r3,xs,ys,zs,ss) =
2491    if r0 <+ r1 then (* LENGTH xs < LENGTH ys *)
2492      let r6 = r0 in
2493        if r3 = 0w then (* return div *)
2494          let r0 = 0w in
2495            (r0,r3,r6,xs,ys,zs,ss)
2496        else (* return mod *)
2497          let r11 = r0 in
2498          let r10 = r1 in
2499          let r0 = 0w in
2500          let (r10,zs) = x64_mul_zero (r0,r10,zs) in
2501          let r10 = r11 in
2502          let (xs,zs) = x64_copy_over (r10,xs,zs) in
2503          let r0 = r1 in
2504            (r0,r3,r6,xs,ys,zs,ss)
2505    else if r1 = 1w then (* LENGTH ys = 1 *)
2506      let ss = r3 :: ss in
2507      let r2 = 0w in
2508      let r10 = r2 in
2509      let r9 = EL (w2n r10) ys in
2510      let r10 = r0 in
2511      let r8 = r0 in
2512      let (r2,r9,r10,xs,zs) = x64_simple_div (r2,r9,r10,xs,zs) in
2513      let r6 = 0w in
2514      let r0 = r8 in
2515      let (r3,ss) = (HD ss,TL ss) in
2516        if r3 = 0w then
2517          if r2 = 0w then (r0,r3,r6,xs,ys,zs,ss) else
2518            let r6 = 1w in
2519              (r0,r3,r6,xs,ys,zs,ss)
2520        else
2521          let r0 = 1w in
2522          let r10 = 0w:word64 in
2523          let zs = LUPDATE r2 (w2n r10) zs in
2524            if r2 = 0w then (r0,r3,r6,xs,ys,zs,ss) else
2525              let r6 = 1w in
2526                (r0,r3,r6,xs,ys,zs,ss)
2527    else (* 1 < LENGTH ys <= LENGTH xs *)
2528      let ss = r3 :: ss in
2529      let ss = r0 :: ss in
2530      let r7 = r1 in
2531      let r9 = r0 in
2532      let r10 = r1 - 1w in
2533      let r1 = EL (w2n r10) ys in
2534      let r2 = 1w in
2535      let r2 = x64_calc_d (r1,r2) in
2536      let r1 = 0w in
2537      let r8 = r2 in
2538      let r10 = r1 in
2539      let r11 = r1 in
2540      let (r1,r8,r9,r10,xs,zs) = x64_mul_by_single (r1,r8,r9,r10,r11,xs,zs) in
2541      let r1 = 0w in
2542      let zs = LUPDATE r1 (w2n r10) zs in
2543      let r0 = 0w in
2544      let r1 = r0 in
2545      let r3 = r0 in
2546      let r11 = r0 in
2547      let r9 = r7 in
2548      let (r0,r1,r8,r9,r11,ys) = x64_top_two (r0,r1,r3,r8,r9,r11,ys) in
2549      let r7 = r8 in
2550      let r11 = r9 in
2551      let (r10,ss) = (HD ss,TL ss) in
2552      let r10 = r10 - r9 in
2553      let r10 = r10 + 2w in
2554      let ss = r10 :: ss in
2555      let ss = r1 :: ss in
2556      let ss = r0 :: ss in
2557      let (r7,r9,r10,r11,ys,zs,ss) = x64_div_loop (r7,r9,r10,r11,ys,zs,ss) in
2558      let (r0,ss) = (HD ss,TL ss) in
2559      let (r0,ss) = (HD ss,TL ss) in
2560      let (r8,ss) = (HD ss,TL ss) in
2561      let r11 = r9 in
2562      let r10 = r9 in
2563      let r9 = r7 in
2564      let r2 = 0w in
2565      let (r2,r9,r10,zs) = x64_simple_div1 (r2,r9,r10,zs) in
2566      let r9 = r11 in
2567      let r10 = r9 in
2568      let r7 = r8 in
2569      let (r8,r10,zs) = x64_fix (r8,r10,zs) in
2570      let r6 = r10 in
2571      let r10 = r9 in
2572      let (r3,ss) = (HD ss,TL ss) in
2573      let r8 = r7 in
2574        if r3 = 0w then
2575          let r11 = 0w in
2576          let zs = x64_copy_down (r8,r10,r11,zs) in
2577          let r0 = r7 in
2578            (r0,r3,r6,xs,ys,zs,ss)
2579        else
2580          let r0 = r9 in
2581            (r0,r3,r6,xs,ys,zs,ss)`
2582
2583val mw_fix_SNOC = store_thm("mw_fix_SNOC",
2584 ``mw_fix (SNOC 0w xs) = mw_fix xs``,
2585  SIMP_TAC std_ss [Once mw_fix_def,FRONT_SNOC,LAST_SNOC] \\ SRW_TAC [] []);
2586
2587val mw_fix_REPLICATE = prove(
2588  ``!n. mw_fix (xs ++ REPLICATE n 0w) = mw_fix xs``,
2589  Induct THEN1 SIMP_TAC std_ss [REPLICATE,APPEND_NIL]
2590  \\ ASM_SIMP_TAC std_ss [REPLICATE_SNOC,APPEND_SNOC,mw_fix_SNOC]);
2591
2592val MAP_K_0 = prove(
2593  ``!xs. MAP (\x. 0x0w) xs = REPLICATE (LENGTH xs) 0x0w``,
2594  Induct \\ SRW_TAC [] [REPLICATE]);
2595
2596val x64_div_thm = prove(
2597  ``ys <> [] /\ mw_ok xs /\ mw_ok ys /\ LENGTH xs + LENGTH ys <= LENGTH zs /\
2598    LENGTH zs < dimword (:64) /\ ((res,mod,T) = mw_div xs ys) ==>
2599    ?zs2.
2600      x64_div_pre (n2w (LENGTH xs),n2w (LENGTH ys),r3,xs,ys,zs,ss) /\
2601      (x64_div (n2w (LENGTH xs),n2w (LENGTH ys),r3,xs,ys,zs,ss) =
2602         (n2w (LENGTH (if r3 = 0w then res else mod)),r3,
2603          n2w (LENGTH (mw_fix mod)),xs,ys,
2604          (if r3 = 0w then res else mod) ++ zs2,ss)) /\
2605      (LENGTH zs = LENGTH ((if r3 = 0w then res else mod) ++ zs2)) /\
2606      ((r3 = 0w) ==> LENGTH zs2 <> 0) /\ LENGTH (mw_fix mod) < dimword (:64)``,
2607  SIMP_TAC std_ss [mw_div_def,LET_DEF] \\ STRIP_TAC
2608  \\ `LENGTH xs < dimword (:64) /\ LENGTH ys < dimword (:64)` by DECIDE_TAC
2609  \\ IMP_RES_TAC mw_ok_mw_fix_ID \\ FULL_SIMP_TAC std_ss []
2610  \\ NTAC 2 (POP_ASSUM (K ALL_TAC))
2611  \\ Cases_on `LENGTH xs < LENGTH ys` \\ FULL_SIMP_TAC std_ss [] THEN1
2612   (Cases_on `r3 = 0w` \\ FULL_SIMP_TAC std_ss [] THEN1
2613     (Q.EXISTS_TAC `zs`
2614      \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND,APPEND]
2615      \\ ASM_SIMP_TAC std_ss [x64_div_def,x64_div_pre_def,LET_DEF,WORD_LO,
2616           w2n_n2w, mw_ok_mw_fix_ID,n2w_11,ZERO_LT_dimword,LENGTH_NIL,
2617           mw_fix_REPLICATE] \\ FULL_SIMP_TAC std_ss [LENGTH,GSYM LENGTH_NIL]
2618      \\ DECIDE_TAC)
2619    \\ ASM_SIMP_TAC std_ss [x64_div_def,x64_div_pre_def,LET_DEF,WORD_LO,
2620           w2n_n2w, mw_ok_mw_fix_ID,n2w_11,ZERO_LT_dimword,LENGTH_NIL]
2621    \\ `?zs1 zs2. (zs = zs1 ++ zs2) /\ (LENGTH zs1 = LENGTH ys)` by ALL_TAC
2622    THEN1 (MATCH_MP_TAC LESS_EQ_LENGTH \\ DECIDE_TAC)
2623    \\ POP_ASSUM (ASSUME_TAC o GSYM)
2624    \\ FULL_SIMP_TAC std_ss []
2625    \\ ASSUME_TAC x64_mul_zero_thm \\ SEP_I_TAC "x64_mul_zero"
2626    \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss []
2627    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss []
2628    \\ `?zs3 zs4. (zs1 = zs3 ++ zs4) /\ (LENGTH zs3 = LENGTH xs)` by ALL_TAC
2629    THEN1 (MATCH_MP_TAC LESS_EQ_LENGTH \\ DECIDE_TAC)
2630    \\ FULL_SIMP_TAC std_ss [MAP_APPEND,GSYM APPEND_ASSOC]
2631    \\ ASSUME_TAC (x64_copy_over_thm |>
2632          Q.SPECL [`xs`,`MAP (\x.0w) (zs1:word64 list)`,`[]`,`zs2`]
2633          |> SIMP_RULE std_ss [LENGTH_MAP,APPEND_NIL,LENGTH_APPEND] |> GEN_ALL)
2634    \\ SEP_I_TAC "x64_copy_over" \\ POP_ASSUM MP_TAC
2635    \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
2636    THEN1 (FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND,LENGTH_MAP] \\ DECIDE_TAC)
2637    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss []
2638    \\ `LENGTH (zs3 ++ zs4) - LENGTH xs = LENGTH zs4` by ALL_TAC
2639    THEN1 FULL_SIMP_TAC std_ss [LENGTH_APPEND]
2640    \\ FULL_SIMP_TAC std_ss [mw_fix_REPLICATE,mw_ok_mw_fix_ID]
2641    \\ ASM_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REPLICATE,GSYM LENGTH_NIL]
2642    \\ ASM_SIMP_TAC std_ss [MAP_K_0,APPEND_11])
2643  \\ Cases_on `LENGTH ys = 1` \\ FULL_SIMP_TAC std_ss [] THEN1
2644   (`?qs r c. mw_simple_div 0x0w (REVERSE xs) (HD ys) = (qs,r,c)` by METIS_TAC [PAIR]
2645    \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE]
2646    \\ `0 < dimword (:64)` by DECIDE_TAC
2647    \\ ASM_SIMP_TAC std_ss [x64_div_def,x64_div_pre_def,LET_DEF,WORD_LO,w2n_n2w,EL]
2648    \\ `?zs1 zs2. (zs = zs1 ++ zs2) /\ (LENGTH zs1 = LENGTH xs)` by
2649         (MATCH_MP_TAC LESS_EQ_LENGTH \\ DECIDE_TAC)
2650    \\ FULL_SIMP_TAC std_ss []
2651    \\ ASSUME_TAC (x64_simple_div_thm |> Q.SPECL [`xs`,`[]`] |> GEN_ALL
2652        |> SIMP_RULE std_ss [APPEND_NIL])
2653    \\ SEP_I_TAC "x64_simple_div" \\ POP_ASSUM MP_TAC
2654    \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC
2655    \\ `(LENGTH xs) = (LENGTH qs)` by
2656        (IMP_RES_TAC LENGTH_mw_simple_div \\ FULL_SIMP_TAC (srw_ss()) [])
2657    \\ Cases_on `r3 = 0w` \\ FULL_SIMP_TAC std_ss [] THEN1
2658     (Q.EXISTS_TAC `zs2` \\ Cases_on `r = 0w`
2659      \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REVERSE]
2660      \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss [] \\ EVAL_TAC
2661      \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_NIL])
2662    \\ FULL_SIMP_TAC std_ss [HD,NOT_CONS_NIL,TL,LENGTH]
2663    \\ Cases_on `REVERSE qs`
2664    THEN1 FULL_SIMP_TAC std_ss [GSYM LENGTH_NIL,LENGTH_REVERSE]
2665    \\ FULL_SIMP_TAC std_ss [APPEND,LUPDATE_def,LENGTH]
2666    \\ Q.EXISTS_TAC `t ++ zs2`
2667    \\ `LENGTH (mw_fix [r]) = if r = 0w then 0 else 1` by ALL_TAC
2668    THEN1 (EVAL_TAC \\ SRW_TAC [] [] \\ EVAL_TAC)
2669    \\ `LENGTH (REVERSE qs) = LENGTH (h::t)` by FULL_SIMP_TAC std_ss []
2670    \\ `LENGTH (zs1 ++ zs2) = SUC (LENGTH (t ++ zs2))` by ALL_TAC
2671    THEN1 (FULL_SIMP_TAC std_ss [LENGTH,LENGTH_REVERSE,LENGTH_APPEND] \\ DECIDE_TAC)
2672    \\ `LENGTH (t ++ zs2) <> 0` by ALL_TAC
2673    THEN1 (FULL_SIMP_TAC std_ss [LENGTH,LENGTH_REVERSE,LENGTH_APPEND] \\ DECIDE_TAC)
2674    \\ FULL_SIMP_TAC std_ss []
2675    \\ Cases_on `r = 0w` \\ FULL_SIMP_TAC std_ss [HD,NOT_CONS_NIL,TL])
2676  \\ Q.ABBREV_TAC `d = calc_d (LAST ys,0x1w)`
2677  \\ Q.ABBREV_TAC `xs1 = mw_mul_by_single d xs ++ [0x0w]`
2678  \\ `?qs1 rs1. (mw_div_aux (BUTLASTN (LENGTH ys) xs1) (LASTN (LENGTH ys) xs1)
2679           (FRONT (mw_mul_by_single d ys))) = (qs1,rs1)` by METIS_TAC [PAIR]
2680  \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REVERSE]
2681  \\ `LENGTH ys <> 0` by FULL_SIMP_TAC std_ss [LENGTH_NIL]
2682  \\ `0 < dimword (:64) /\ LENGTH ys - 1 < dimword (:64)` by DECIDE_TAC
2683  \\ `1 < dimword (:64) /\ ~(LENGTH ys < 1) /\ 0 < LENGTH ys` by DECIDE_TAC
2684  \\ ASM_SIMP_TAC std_ss [x64_div_def,x64_div_pre_def,LET_DEF,WORD_LO,
2685       w2n_n2w,n2w_11,word_arith_lemma2]
2686  \\ `(LAST ys <> 0w) /\ (EL (LENGTH ys - 1) ys = LAST ys)` by ALL_TAC THEN1
2687   (FULL_SIMP_TAC std_ss [mw_ok_def]
2688    \\ `(ys = []) \/ ?y ys2. ys = SNOC y ys2` by METIS_TAC [SNOC_CASES]
2689    \\ FULL_SIMP_TAC std_ss [LENGTH_SNOC,LAST_SNOC]
2690    \\ FULL_SIMP_TAC std_ss [EL_LENGTH,SNOC_APPEND])
2691  \\ FULL_SIMP_TAC std_ss [x64_calc_d_thm]
2692  \\ `?zs1 zs2. (zs = zs1 ++ zs2) /\ (LENGTH zs1 = LENGTH xs)` by
2693       (MATCH_MP_TAC LESS_EQ_LENGTH \\ DECIDE_TAC)
2694  \\ FULL_SIMP_TAC std_ss []
2695  \\ Cases_on `zs2` \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND]
2696  THEN1 (`F` by DECIDE_TAC)
2697  \\ ASSUME_TAC x64_mul_by_single_thm
2698  \\ SEP_I_TAC "x64_mul_by_single"
2699  \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC
2700  \\ FULL_SIMP_TAC std_ss [] \\ NTAC 2 (POP_ASSUM (K ALL_TAC))
2701  \\ Cases_on `t` \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND]
2702  THEN1 (`F` by DECIDE_TAC)
2703  \\ Q.MATCH_ASSUM_RENAME_TAC `zs = zs1 ++ z1::z2::zs2`
2704  \\ FULL_SIMP_TAC std_ss [LENGTH_mw_mul_by_single]
2705  \\ `LENGTH xs + 1 < dimword (:64)` by DECIDE_TAC \\ FULL_SIMP_TAC std_ss [w2n_n2w]
2706  \\ `LUPDATE 0x0w (LENGTH xs + 1) (mw_mul_by_single d xs ++ z2::zs2) =
2707      xs1 ++ zs2` by ALL_TAC THEN1
2708   (`LENGTH xs + 1 = LENGTH (mw_mul_by_single d xs)` by
2709       FULL_SIMP_TAC std_ss [LENGTH_mw_mul_by_single]
2710    \\ ASM_SIMP_TAC std_ss [LUPDATE_LENGTH]
2711    \\ Q.UNABBREV_TAC `xs1`
2712    \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC, APPEND])
2713  \\ FULL_SIMP_TAC std_ss [] \\ POP_ASSUM (K ALL_TAC)
2714  \\ (x64_top_two_thm |> GEN_ALL |> ASSUME_TAC)
2715  \\ SEP_I_TAC "x64_top_two" \\ POP_ASSUM MP_TAC
2716  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 DECIDE_TAC
2717  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] \\ NTAC 2 (POP_ASSUM (K ALL_TAC))
2718  \\ FULL_SIMP_TAC std_ss [HD,TL]
2719  \\ `n2w (LENGTH xs) - n2w (LENGTH ys) + 0x2w:word64 =
2720      n2w (LENGTH xs1 - LENGTH ys)` by ALL_TAC THEN1
2721   (Q.UNABBREV_TAC `xs1`
2722    \\ FULL_SIMP_TAC std_ss [word_arith_lemma2,word_add_n2w,LENGTH_APPEND,
2723          LENGTH_mw_mul_by_single,LENGTH] \\ AP_TERM_TAC \\ DECIDE_TAC)
2724  \\  FULL_SIMP_TAC std_ss []
2725  \\ `LENGTH xs + 2 = LENGTH xs1` by ALL_TAC THEN1
2726   (Q.UNABBREV_TAC `xs1`
2727    \\ FULL_SIMP_TAC std_ss [LENGTH_mw_mul_by_single,LENGTH_APPEND,LENGTH]
2728    \\ DECIDE_TAC)
2729  \\ `LENGTH ys <= LENGTH xs1` by DECIDE_TAC
2730  \\ `?ts1 ts2. (xs1 = ts1 ++ ts2) /\ (LENGTH ts2 = LENGTH ys)` by
2731        (MATCH_MP_TAC LESS_EQ_LENGTH_ALT \\ FULL_SIMP_TAC std_ss [])
2732  \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND]
2733  \\ FULL_SIMP_TAC std_ss [BUTLASTN_LENGTH_APPEND,LASTN_LENGTH_APPEND]
2734  \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND]
2735  \\ ASSUME_TAC (x64_div_loop_thm |> SIMP_RULE std_ss [LET_DEF] |> GEN_ALL)
2736  \\ SEP_I_TAC "x64_div_loop" \\ POP_ASSUM MP_TAC
2737  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1
2738   (FULL_SIMP_TAC std_ss [LENGTH_APPEND]
2739    \\ STRIP_TAC THEN1 DECIDE_TAC \\ STRIP_TAC THEN1 DECIDE_TAC
2740    \\ Q.UNABBREV_TAC `d`
2741    \\ MATCH_MP_TAC LAST_FRONT_mw_mul_by_single_NOT_ZERO
2742    \\ ASM_SIMP_TAC std_ss [] \\ EVAL_TAC)
2743  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] \\ NTAC 2 (POP_ASSUM (K ALL_TAC))
2744  \\ FULL_SIMP_TAC std_ss [TL,HD,NOT_CONS_NIL]
2745  \\ `(LENGTH rs1 = LENGTH ys) /\ (LENGTH qs1 = LENGTH ts1)` by ALL_TAC THEN1
2746   (`LENGTH ys = LENGTH (FRONT (mw_mul_by_single d ys))` by ALL_TAC THEN1
2747     (FULL_SIMP_TAC std_ss [LENGTH_FRONT,GSYM LENGTH_NIL,
2748        LENGTH_mw_mul_by_single] \\ DECIDE_TAC)
2749    \\ FULL_SIMP_TAC std_ss [] \\ MATCH_MP_TAC LENGTH_mw_div_aux
2750    \\ Q.EXISTS_TAC `ts2` \\ FULL_SIMP_TAC std_ss [])
2751  \\ FULL_SIMP_TAC std_ss []
2752  \\ Q.PAT_X_ASSUM `LENGTH rs1 = LENGTH ys` (ASSUME_TAC o GSYM)
2753  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC]
2754  \\ ASSUME_TAC x64_simple_div1_thm
2755  \\ SEP_I_TAC "x64_simple_div1" \\ POP_ASSUM MP_TAC
2756  \\ `?x1 x2 x3. mw_simple_div 0x0w (REVERSE rs1) d = (x1,x2,x3)` by METIS_TAC [PAIR]
2757  \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC \\ NTAC 2 (POP_ASSUM (K ALL_TAC))
2758  \\ IMP_RES_TAC LENGTH_mw_simple_div
2759  \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE]
2760  \\ (x64_fix_thm |> Q.SPECL [`REVERSE x1`,`REVERSE qs1 ++ zs2`,
2761        `n2w (LENGTH (ts1:word64 list))`] |> MP_TAC)
2762  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
2763  THEN1 (FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ DECIDE_TAC)
2764  \\ FULL_SIMP_TAC std_ss [APPEND_ASSOC] \\ STRIP_TAC
2765  \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE]
2766  \\ Q.ABBREV_TAC `tt = mw_fix (REVERSE x1) ++
2767       REPLICATE (LENGTH x1 - LENGTH (mw_fix (REVERSE x1))) 0x0w`
2768  \\ `LENGTH tt = LENGTH rs1` by ALL_TAC THEN1
2769   (Q.UNABBREV_TAC `tt`
2770    \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REPLICATE]
2771    \\ `LENGTH (mw_fix (REVERSE x1)) <= LENGTH (REVERSE x1)` by
2772          FULL_SIMP_TAC std_ss [LENGTH_mw_fix]
2773    \\ `LENGTH (REVERSE x1) = LENGTH x1` by SRW_TAC [] []
2774    \\ DECIDE_TAC)
2775  \\ Tactical.REVERSE (Cases_on `r3 = 0w`) \\ FULL_SIMP_TAC std_ss [] THEN1
2776   (Q.UNABBREV_TAC `tt` \\ FULL_SIMP_TAC std_ss
2777       [mw_fix_thm |> Q.SPEC `REVERSE xs` |> RW [LENGTH_REVERSE]]
2778    \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11,LENGTH_APPEND,LENGTH_REVERSE]
2779    \\ ASSUME_TAC (Q.ISPEC `REVERSE (x1:word64 list)` LENGTH_mw_fix)
2780    \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ DECIDE_TAC)
2781  \\ MP_TAC (x64_copy_down_thm |> Q.SPECL [`tt`,`REVERSE qs1`,`zs2`])
2782  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1
2783   (FULL_SIMP_TAC (srw_ss()) []
2784    \\ SIMP_TAC std_ss [GSYM LENGTH_NIL] \\ DECIDE_TAC)
2785  \\ STRIP_TAC \\ NTAC 3 (POP_ASSUM MP_TAC)
2786  \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE,APPEND_11]
2787  \\ `LENGTH (mw_fix (REVERSE x1)) < dimword (:64)` by ALL_TAC THEN1
2788      (`LENGTH (mw_fix (REVERSE x1)) <= LENGTH (REVERSE x1)` by
2789          FULL_SIMP_TAC std_ss [LENGTH_mw_fix]
2790       \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ DECIDE_TAC)
2791  \\ FULL_SIMP_TAC std_ss [n2w_11,LENGTH_NIL]
2792  \\ NTAC 3 STRIP_TAC \\ DECIDE_TAC);
2793
2794(* mwi_div -- addv zs [] c *)
2795
2796val (res,x64_add1_def,x64_add1_pre_def) = x64_compile `
2797  x64_add1 (r2,r10,r11:word64,zs:word64 list) =
2798    if r10 = r11 then
2799      let r0 = 1w in
2800      let zs = LUPDATE r0 (w2n r10) zs in
2801      let r11 = r11 + 1w in
2802        (r11,zs)
2803    else
2804      let r0 = EL (w2n r10) zs in
2805        if r0 <> r2 then
2806          let r0 = r0 + 1w in
2807          let zs = LUPDATE r0 (w2n r10) zs in
2808            (r11,zs)
2809        else
2810          let r0 = 0w in
2811          let zs = LUPDATE r0 (w2n r10) zs in
2812          let r10 = r10 + 1w in
2813            x64_add1 (r2,r10,r11,zs)`
2814
2815val (res,x64_add1_call_def,x64_add1_call_pre_def) = x64_compile `
2816  x64_add1_call (r2:word64,r6:word64,r11,zs) =
2817    if r2 = 0w then (r11,zs) else
2818    if r6 = 0w then (r11,zs) else
2819      let r2 = 0w in
2820      let r10 = r2 in
2821      let r2 = ~r2 in
2822      let (r11,zs) = x64_add1 (r2,r10,r11,zs) in
2823        (r11,zs)`
2824
2825val x64_add1_thm = prove(
2826  ``!zs zs1.
2827      LENGTH (zs1 ++ zs) + 1 < dimword (:64) /\ zs2 <> [] ==>
2828      ?rest.
2829        x64_add1_pre (~0w,n2w (LENGTH zs1),n2w (LENGTH (zs1 ++ zs)),
2830                      zs1 ++ zs ++ zs2) /\
2831        (x64_add1 (~0w,n2w (LENGTH zs1),n2w (LENGTH (zs1 ++ zs)),
2832                   zs1 ++ zs ++ zs2) =
2833         (n2w (LENGTH (zs1 ++ mw_addv zs [] T)), zs1 ++ mw_addv zs [] T ++ rest)) /\
2834        LENGTH (zs1 ++ mw_addv zs [] T) < dimword (:64) /\
2835        (LENGTH (zs1 ++ mw_addv zs [] T ++ rest) = LENGTH (zs1 ++ zs ++ zs2))``,
2836  Cases_on `zs2` \\ SIMP_TAC std_ss []
2837  \\ Q.SPEC_TAC (`t`,`zs2`) \\ Q.SPEC_TAC (`h`,`t`) \\ STRIP_TAC \\ STRIP_TAC
2838  \\ Induct
2839  \\ SIMP_TAC std_ss [mw_addv_NIL,LENGTH_APPEND,APPEND,APPEND_NIL,LENGTH]
2840  \\ ONCE_REWRITE_TAC [x64_add1_def,x64_add1_pre_def] \\ REPEAT STRIP_TAC
2841  \\ `LENGTH zs1 < dimword (:64)` by DECIDE_TAC
2842  \\ FULL_SIMP_TAC std_ss [LET_DEF,w2n_n2w,LENGTH_APPEND,LENGTH,
2843         word_add_n2w,n2w_11,LUPDATE_LENGTH]
2844  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,APPEND_11,CONS_11]
2845  THEN1 DECIDE_TAC
2846  \\ `(LENGTH zs1 + SUC (LENGTH zs)) < dimword (:64) /\
2847      LENGTH zs1 <> LENGTH zs1 + SUC (LENGTH zs)` by DECIDE_TAC
2848  \\ FULL_SIMP_TAC std_ss [LET_DEF,w2n_n2w,LENGTH_APPEND,LENGTH,
2849       word_add_n2w,n2w_11,LUPDATE_LENGTH,EL_LENGTH]
2850  \\ Tactical.REVERSE (Cases_on `h = ~0x0w`) \\ FULL_SIMP_TAC std_ss [] THEN1
2851   (Q.EXISTS_TAC `t::zs2`
2852    \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND,LENGTH]
2853    \\ DECIDE_TAC) \\ FULL_SIMP_TAC std_ss [LENGTH]
2854  \\ Q.PAT_X_ASSUM `!zss.bbb` (MP_TAC o Q.SPEC `SNOC 0w zs1`)
2855  \\ FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1]
2856  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 DECIDE_TAC \\ STRIP_TAC
2857  \\ FULL_SIMP_TAC std_ss [SNOC_INTRO,AC ADD_COMM ADD_ASSOC]
2858  \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,GSYM APPEND_ASSOC,APPEND,
2859       APPEND_11,CONS_11] \\ DECIDE_TAC) |> Q.SPECL [`zs`,`[]`]
2860  |> SIMP_RULE std_ss [APPEND,LENGTH];
2861
2862(* mwi_div -- subtraction *)
2863
2864val (res,x64_div_sub_aux_def) = x64_decompile_no_status "x64_div_sub_aux" `
2865      xor r10,r10
2866      inc r1
2867      jmp L2
2868  L1: insert r8_el_r10_ys
2869      insert r9_el_r10_zs
2870      sbb r8,r9
2871      insert lupdate_r10_zs_with_r8
2872      lea r10,[r10+1]
2873  L2: loop L1`
2874
2875val (x64_div_sub_res,x64_div_sub_def) = x64_decompile "x64_div_sub" `
2876  insert x64_div_sub_aux`
2877
2878val _ = add_compiled [x64_div_sub_res]
2879
2880val (res,x64_div_sub_call_def,x64_div_sub_call_pre_def) = x64_compile `
2881  x64_div_sub_call (r1,r2:word64,r6:word64,ys,zs) =
2882    if r2 = 0w then (r6,ys,zs) else
2883    if r6 = 0w then (r6,ys,zs) else
2884      let r8 = r6 in
2885      let r9 = r6 in
2886      let r3 = r1 in
2887      let (r1,r8,r9,r10,ys,zs) = x64_div_sub (r1,r8,r9,ys,zs) in
2888      let r10 = r3 in
2889      let (r8,r10,zs) = x64_fix (r8,r10,zs) in
2890      let r6 = r10 in
2891        (r6,ys,zs)`
2892
2893val x64_div_sub_aux_thm = prove(
2894  ``!ys zs ys1 zs1 ys2 zs2
2895     z_af z_of c z_pf z_sf z_zf r8 r9.
2896      (LENGTH zs1 = LENGTH ys1) /\ (LENGTH zs = LENGTH ys) /\
2897      LENGTH (zs1 ++ zs) + 1 < dimword (:64) ==>
2898      ?r8' r9' z_af' z_of' z_pf' z_sf' z_zf'.
2899        x64_div_sub_aux1_pre (n2w (LENGTH zs + 1),r8,r9,n2w (LENGTH zs1),
2900          ys1 ++ ys ++ ys2,z_af,SOME c,
2901          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) /\
2902        (x64_div_sub_aux1 (n2w (LENGTH zs + 1),r8,r9,n2w (LENGTH zs1),
2903          ys1 ++ ys ++ ys2,z_af,SOME c,
2904          z_of,z_pf,z_sf,z_zf,zs1 ++ zs ++ zs2) =
2905          (0w,r8',r9',n2w (LENGTH (zs1++zs)),ys1 ++ ys ++ ys2,z_af',
2906             SOME (~SND (mw_sub ys zs ~c)),z_of',z_pf',z_sf',z_zf',
2907                        zs1 ++ FST (mw_sub ys zs ~c) ++ zs2))``,
2908  Induct THEN1
2909   (FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def]
2910    \\ ONCE_REWRITE_TAC [x64_div_sub_aux_def]
2911    \\ FULL_SIMP_TAC (srw_ss()) [LENGTH,LENGTH_NIL,mw_sub_def,LET_DEF])
2912  \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1]
2913  \\ ONCE_REWRITE_TAC [x64_div_sub_aux_def]
2914  \\ FULL_SIMP_TAC std_ss [LET_DEF,ADD1,n2w_w2n,w2n_n2w]
2915  \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH,LENGTH_APPEND]
2916  \\ `LENGTH ys1 < dimword (:64) /\
2917      LENGTH zs1 < dimword (:64) /\
2918      LENGTH ys + 1 + 1 < dimword (:64) /\
2919      1 < dimword (:64)` by DECIDE_TAC
2920  \\ FULL_SIMP_TAC std_ss [EL_LENGTH,LUPDATE_LENGTH,GSYM APPEND_ASSOC,APPEND]
2921  \\ Q.PAT_X_ASSUM `LENGTH zs1 = LENGTH ys1` (ASSUME_TAC o GSYM)
2922  \\ FULL_SIMP_TAC std_ss [EL_LENGTH,LUPDATE_LENGTH,n2w_11,GSYM APPEND_ASSOC,APPEND]
2923  \\ SIMP_TAC std_ss [GSYM word_add_n2w,WORD_ADD_SUB]
2924  \\ FULL_SIMP_TAC std_ss [word_add_n2w]
2925  \\ SIMP_TAC std_ss [SNOC_INTRO]
2926  \\ `LENGTH zs1 + 1 = LENGTH (SNOC h' ys1)` by
2927        FULL_SIMP_TAC std_ss [LENGTH_SNOC,ADD1]
2928  \\ FULL_SIMP_TAC std_ss []
2929  \\ SEP_I_TAC "x64_div_sub_aux1" \\ POP_ASSUM MP_TAC
2930  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
2931  THEN1 (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
2932  \\ STRIP_TAC \\ ASM_SIMP_TAC std_ss []
2933  \\ FULL_SIMP_TAC (srw_ss()) [LENGTH_SNOC,ADD1,AC ADD_COMM ADD_ASSOC,mw_sub_def,
2934       LET_DEF,single_sub_def,bool2num_thm,single_add_def]
2935  \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV)
2936  \\ FULL_SIMP_TAC (srw_ss()) [b2w_def]
2937  \\ `(18446744073709551616 <= b2n ~c + (w2n h' + w2n (~h))) =
2938      ~(w2n h' < b2n c + w2n h)` by METIS_TAC [sub_borrow_lemma]
2939  \\ FULL_SIMP_TAC std_ss [AC ADD_COMM ADD_ASSOC]
2940  \\ REPEAT (STRIP_TAC THEN1 DECIDE_TAC)
2941  \\ Cases_on `c` \\ FULL_SIMP_TAC std_ss [b2n_def]
2942  \\ REPEAT (POP_ASSUM (K ALL_TAC))
2943  \\ blastLib.BBLAST_TAC)
2944  |> Q.SPECL [`ys`,`zs`,`[]`,`[]`]
2945  |> SIMP_RULE std_ss [APPEND,LENGTH] |> GEN_ALL;
2946
2947val x64_div_sub_thm = prove(
2948  ``(LENGTH zs = LENGTH ys) /\ LENGTH zs + 1 < dimword (:64) ==>
2949    ?r8' r9'.
2950      x64_div_sub_pre (n2w (LENGTH ys),r8,r9,ys ++ ys2,zs ++ zs2) /\
2951      (x64_div_sub (n2w (LENGTH ys),r8,r9,ys ++ ys2,zs ++ zs2) =
2952        (0x0w,r8',r9',n2w (LENGTH ys),ys ++ ys2,
2953         FST (mw_sub ys zs T) ++ zs2))``,
2954  SIMP_TAC std_ss [x64_div_sub_def]
2955  \\ ONCE_REWRITE_TAC [x64_div_sub_aux_def]
2956  \\ SIMP_TAC std_ss [LET_DEF,WORD_SUB_RZERO,word_add_n2w]
2957  \\ REPEAT STRIP_TAC \\ ASSUME_TAC x64_div_sub_aux_thm
2958  \\ SEP_I_TAC "x64_div_sub_aux1" \\ POP_ASSUM MP_TAC
2959  \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss []);
2960
2961
2962(* mwi_div -- integer division *)
2963
2964val (res,x64_idiv_mod_header_def,x64_idiv_mod_header_pre_def) = x64_compile `
2965  x64_idiv_mod_header (r6:word64,r11:word64) =
2966    if r6 = 0w then r6 else
2967      let r6 = r6 << 1 in
2968        if r11 && 1w = 0w then r6 else
2969          let r6 = r6 + 1w in r6`;
2970
2971val x64_idiv_mod_header_thm = prove(
2972  ``LENGTH xs < dimword (:64) ==>
2973    (x64_idiv_mod_header (n2w (LENGTH xs),x64_header (t,ys)) =
2974     x64_header (xs <> [] /\ t,xs))``,
2975  SIMP_TAC std_ss [x64_idiv_mod_header_def,x64_header_sign,n2w_11,
2976    ZERO_LT_dimword,LENGTH_NIL,LET_DEF,x64_header_def,word_lsl_n2w]
2977  \\ Cases_on `xs = []` \\ ASM_SIMP_TAC (srw_ss()) []
2978  \\ Cases_on `t` \\ ASM_SIMP_TAC (srw_ss()) []);
2979
2980val (x64_idiv_res,x64_idiv_def,x64_idiv_pre_def) = x64_compile `
2981  x64_idiv (r3,r10,r11,xs,ys,zs,ss) =
2982    let r0 = r10 >>> 1 in
2983    let r1 = r11 >>> 1 in
2984    let r10 = r10 ?? r11 in
2985    let r10 = r10 && 1w in
2986    let ss = r10 :: ss in
2987    let ss = r11 :: ss in
2988    let (r0,r3,r6,xs,ys,zs,ss) = x64_div (r0,r1,r3,xs,ys,zs,ss) in
2989    let (r11,ss) = (HD ss, TL ss) in
2990      if r3 <> 0w then
2991        let (r2,ss) = (HD ss, TL ss) in
2992        let r1 = r11 >>> 1 in
2993        let (r6,ys,zs) = x64_div_sub_call (r1,r2,r6,ys,zs) in
2994        let r6 = x64_idiv_mod_header (r6,r11) in
2995        let r11 = r6 in
2996          (r11,xs,ys,zs,ss)
2997      else
2998        let r10 = r0 in
2999        let r8 = r10 in
3000        let (r8,r10,zs) = x64_fix (r8,r10,zs) in
3001        let r11 = r10 in
3002        let (r2,ss) = (HD ss, TL ss) in
3003        let r3 = r2 in
3004        let (r11,zs) = x64_add1_call (r2,r6,r11,zs) in
3005          if r11 = 0w then (r11,xs,ys,zs,ss) else
3006            let r11 = r11 << 1 in
3007            let r11 = r11 + r3 in
3008              (r11,xs,ys,zs,ss)`
3009
3010val x64_header_XOR = prove(
3011  ``!s t. ((x64_header (s,xs) ?? x64_header (t,ys)) && 0x1w:word64) =
3012          (b2w (s <> t)):word64``,
3013  SIMP_TAC std_ss [WORD_RIGHT_AND_OVER_XOR,x64_header_AND_1]
3014  \\ Cases \\ Cases \\ EVAL_TAC);
3015
3016val b2w_EQ_0w = prove(
3017  ``!b. (b2w b = 0w:word64) = ~b``,
3018  Cases \\ EVAL_TAC);
3019
3020val mwi_divmod_alt_def = Define `
3021  mwi_divmod_alt w s_xs t_ys =
3022    if w = 0w then mwi_div s_xs t_ys else mwi_mod s_xs t_ys`;
3023
3024val x64_idiv_thm = prove(
3025  ``LENGTH xs + LENGTH ys <= LENGTH zs /\ LENGTH zs < dimword (:63) /\
3026    mw_ok xs /\ mw_ok ys /\ ys <> [] ==>
3027    ?zs1.
3028      x64_idiv_pre (r3,x64_header (s,xs),x64_header (t,ys),xs,ys,zs,ss) /\
3029      (x64_idiv (r3,x64_header (s,xs),x64_header (t,ys),xs,ys,zs,ss) =
3030        (x64_header ((mwi_divmod_alt r3 (s,xs) (t,ys))),xs,ys,
3031         SND ((mwi_divmod_alt r3 (s,xs) (t,ys)))++zs1,ss)) /\
3032      (LENGTH (SND ((mwi_divmod_alt r3 (s,xs) (t,ys)))++zs1) = LENGTH zs) ``,
3033  FULL_SIMP_TAC std_ss [x64_idiv_def,x64_idiv_pre_def,LET_DEF]
3034  \\ FULL_SIMP_TAC std_ss [x64_header_EQ,mwi_mul_def,x64_length]
3035  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [x64_header_XOR]
3036  \\ `LENGTH xs < dimword (:63) /\ LENGTH ys < dimword (:63)` by DECIDE_TAC
3037  \\ `LENGTH zs < dimword (:64)` by (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
3038  \\ IMP_RES_TAC x64_length \\ FULL_SIMP_TAC std_ss []
3039  \\ `mw2n ys <> 0` by ALL_TAC THEN1
3040   (SIMP_TAC std_ss [GSYM mw_fix_NIL]
3041    \\ FULL_SIMP_TAC std_ss [mw_ok_mw_fix_ID])
3042  \\ `?res mod c. (mw_div xs ys = (res,mod,c))` by METIS_TAC [PAIR]
3043  \\ `c /\ (LENGTH mod = LENGTH ys)` by METIS_TAC [mw_div_thm,mw_ok_mw_fix_ID]
3044  \\ FULL_SIMP_TAC std_ss []
3045  \\ ASSUME_TAC (x64_div_thm |> GEN_ALL)
3046  \\ SEP_I_TAC "x64_div"
3047  \\ POP_ASSUM MP_TAC
3048  \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC
3049  \\ FULL_SIMP_TAC std_ss []
3050  \\ NTAC 3 (POP_ASSUM MP_TAC) \\ NTAC 2 (POP_ASSUM (K ALL_TAC))
3051  \\ REPEAT STRIP_TAC
3052  \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND]
3053  \\ Cases_on `r3 <> 0w` \\ FULL_SIMP_TAC std_ss [mwi_divmod_alt_def] THEN1
3054   (FULL_SIMP_TAC std_ss [x64_div_sub_call_def,x64_div_sub_call_pre_def]
3055    \\ FULL_SIMP_TAC std_ss [TL,mwi_mod_def,mwi_divmod_def,LET_DEF,HD,NOT_CONS_NIL,
3056         x64_header_XOR]
3057    \\ Cases_on `s = t` \\ FULL_SIMP_TAC std_ss [EVAL ``b2w F``] THEN1
3058     (FULL_SIMP_TAC std_ss [x64_idiv_mod_header_thm]
3059      \\ ASSUME_TAC (Q.ISPEC `mod:word64 list` (GSYM mw_fix_thm))
3060      \\ POP_ASSUM (fn th => SIMP_TAC std_ss [Once th])
3061      \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11]
3062      \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REPLICATE]
3063      \\ `LENGTH (mw_fix mod) <= LENGTH mod` by METIS_TAC [LENGTH_mw_fix]
3064      \\ DECIDE_TAC)
3065    \\ Cases_on `mw_fix mod = []`
3066    \\ FULL_SIMP_TAC std_ss [LENGTH,APPEND,LENGTH_APPEND]
3067    THEN1 (SIMP_TAC std_ss [x64_idiv_mod_header_def] \\ EVAL_TAC)
3068    \\ FULL_SIMP_TAC std_ss [EVAL ``b2w T = 0x0w:word64``,n2w_11,ZERO_LT_dimword]
3069    \\ FULL_SIMP_TAC std_ss [LENGTH_NIL]
3070    \\ (x64_div_sub_thm |> Q.INST [`ys2`|->`[]`]
3071        |> SIMP_RULE std_ss [APPEND_NIL] |> GEN_ALL |> ASSUME_TAC)
3072    \\ SEP_I_TAC "x64_div_sub" \\ POP_ASSUM MP_TAC
3073    \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC
3074    THEN1 (FULL_SIMP_TAC std_ss [GSYM LENGTH_NIL]
3075           \\ FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
3076    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss []
3077    \\ `LENGTH ys = LENGTH (FST (mw_sub ys mod T))` by ALL_TAC THEN1
3078     (Cases_on `mw_sub ys mod T` \\ IMP_RES_TAC LENGTH_mw_sub
3079      \\ FULL_SIMP_TAC std_ss [])
3080    \\ ASM_SIMP_TAC std_ss []
3081    \\ ASSUME_TAC x64_fix_thm
3082    \\ SEP_I_TAC "x64_fix"
3083    \\ `LENGTH (FST (mw_sub ys mod T)) < dimword (:64)` by DECIDE_TAC
3084    \\ FULL_SIMP_TAC std_ss []
3085    \\ FULL_SIMP_TAC std_ss [GSYM mw_subv_def]
3086    \\ `mw_subv ys (mw_fix mod) = mw_subv ys mod` by ALL_TAC
3087    THEN1 (SIMP_TAC std_ss [mw_subv_def,mw_sub_mw_fix])
3088    \\ FULL_SIMP_TAC std_ss []
3089    \\ `LENGTH (mw_subv ys mod) <= LENGTH ys` by ALL_TAC
3090    THEN1 (MATCH_MP_TAC LENGTH_mw_subv \\ FULL_SIMP_TAC std_ss [])
3091    \\ `LENGTH (mw_subv ys mod) < dimword (:64)` by DECIDE_TAC
3092    \\ ASM_SIMP_TAC std_ss [x64_idiv_mod_header_thm]
3093    \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11]
3094    \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND,LENGTH_REPLICATE]
3095    \\ SIMP_TAC std_ss [mw_subv_def]
3096    \\ `LENGTH (mw_fix (FST (mw_sub ys mod T))) <= LENGTH (FST (mw_sub ys mod T))`
3097          by FULL_SIMP_TAC std_ss [LENGTH_mw_fix] \\ DECIDE_TAC)
3098  \\ `LENGTH res < dimword (:64)` by DECIDE_TAC
3099  \\ FULL_SIMP_TAC std_ss [mwi_div_def]
3100  \\ MP_TAC (x64_fix_thm |> Q.SPECL
3101       [`res`,`zs2`,`n2w (LENGTH (res:word64 list))`])
3102  \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [HD,TL]
3103  \\ NTAC 2 (POP_ASSUM (K ALL_TAC))
3104  \\ FULL_SIMP_TAC std_ss [x64_add1_call_def,x64_add1_call_pre_def,
3105                           LET_DEF,mwi_divmod_def,b2w_EQ_0w]
3106  \\ `LENGTH (mw_fix res) <= LENGTH res` by
3107        FULL_SIMP_TAC std_ss [LENGTH_mw_fix]
3108  \\ `LENGTH (mw_fix res) < dimword (:64)` by DECIDE_TAC
3109  \\ Cases_on `s = t` \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword] THEN1
3110   (SIMP_TAC (srw_ss()) [word_lsl_n2w,b2w_def,b2n_def,x64_header_def]
3111    \\ Cases_on `LENGTH (mw_fix res) = 0` \\ FULL_SIMP_TAC std_ss []
3112    \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11,
3113         LENGTH_APPEND,LENGTH_REPLICATE] \\ DECIDE_TAC)
3114  \\ FULL_SIMP_TAC std_ss [LENGTH_NIL]
3115  \\ Cases_on `mw_fix mod = []`
3116  \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL] THEN1
3117   (Cases_on `mw_fix res = []` \\ FULL_SIMP_TAC std_ss []
3118    \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11,
3119         LENGTH_APPEND,LENGTH_REPLICATE]
3120    \\ SIMP_TAC (srw_ss()) [word_lsl_n2w,b2w_def,b2n_def,x64_header_def]
3121    \\ DECIDE_TAC)
3122  \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC]
3123  \\ Q.ABBREV_TAC `ts1 = REPLICATE (LENGTH res - LENGTH (mw_fix res)) 0x0w ++ zs2`
3124  \\ ASSUME_TAC (x64_add1_thm |> GEN_ALL)
3125  \\ SEP_I_TAC "x64_add1" \\ POP_ASSUM MP_TAC
3126  \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1
3127    (Q.UNABBREV_TAC `ts1`
3128     \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,GSYM LENGTH_NIL,
3129          LENGTH_REPLICATE,x64_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND]
3130     \\ DECIDE_TAC)
3131  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [NOT_CONS_NIL]
3132  \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL]
3133  \\ Cases_on `mw_addv (mw_fix res) [] T = []`
3134  \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL,
3135       x64_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND]
3136  THEN1 (Q.UNABBREV_TAC `ts1`
3137    \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL,LENGTH_REPLICATE,
3138         x64_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND]
3139    \\ DECIDE_TAC)
3140  \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL,LENGTH_REPLICATE,
3141         x64_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND,APPEND_11]
3142  \\ FULL_SIMP_TAC std_ss [b2w_def,b2n_def]
3143  \\ SIMP_TAC (srw_ss()) [word_lsl_n2w,word_add_n2w]
3144  \\ Q.UNABBREV_TAC `ts1`
3145  \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword,LENGTH_NIL,LENGTH_REPLICATE,
3146         x64_header_def,LENGTH,APPEND,word_add_n2w,LENGTH_APPEND]
3147  \\ DECIDE_TAC);
3148
3149
3150(* int to decimal conversion *)
3151
3152val (res,x64_to_dec_def,x64_to_dec_pre_def) = x64_compile `
3153  x64_to_dec (r9,r10,zs,ss) =
3154    let r2 = 0w in
3155    let r11 = r10 in
3156    let (r2,r9,r10,zs) = x64_simple_div1 (r2,r9,r10,zs) in
3157    let r2 = r2 + 0x30w in
3158    let ss = r2 :: ss in
3159    let r8 = r10 in
3160    let r10 = r11 in
3161    let (r8,r10,zs) = x64_fix (r8,r10,zs) in
3162      if r10 = 0w then (zs,ss) else
3163        x64_to_dec (r9,r10,zs,ss)`
3164
3165val (res,x64_int_to_dec_def,x64_int_to_dec_pre_def) = x64_compile `
3166  x64_int_to_dec (r10,xs,zs,ss) =
3167    let r1 = r10 in
3168    let r10 = r10 >>> 1 in
3169    let (xs,zs) = x64_copy_over (r10,xs,zs) in
3170    let r10 = r1 >>> 1 in
3171    let r9 = 10w in
3172    let (zs,ss) = x64_to_dec (r9,r10,zs,ss) in
3173      if r1 && 1w = 0w then (xs,zs,ss) else
3174        let r2 = 0x7Ew in
3175        let ss = r2 :: ss in
3176          (xs,zs,ss)`
3177
3178val x64_to_dec_thm = prove(
3179  ``!xs ys zs ss.
3180      LENGTH xs < dimword (:64) /\ (mw_to_dec xs = (ys,T)) ==>
3181      ?zs1.
3182        x64_to_dec_pre (10w,n2w (LENGTH xs),xs++zs,ss) /\
3183        (x64_to_dec (10w,n2w (LENGTH xs),xs++zs,ss) = (zs1,ys ++ ss)) /\
3184        (LENGTH zs1 = LENGTH xs + LENGTH zs)``,
3185  HO_MATCH_MP_TAC mw_to_dec_ind \\ REPEAT STRIP_TAC \\ POP_ASSUM MP_TAC
3186  \\ SIMP_TAC std_ss [Once mw_to_dec_def]
3187  \\ FULL_SIMP_TAC std_ss [EVAL ``dimword (:64) <= 10``]
3188  \\ `?qs r c1. mw_simple_div 0x0w (REVERSE xs) 0xAw = (qs,r,c1)` by METIS_TAC [PAIR]
3189  \\ `?res c2. mw_to_dec (mw_fix (REVERSE qs)) = (res,c2)` by METIS_TAC [PAIR]
3190  \\ FULL_SIMP_TAC std_ss [LET_DEF]
3191  \\ ONCE_REWRITE_TAC [x64_to_dec_def,x64_to_dec_pre_def]
3192  \\ SIMP_TAC std_ss [LET_DEF]
3193  \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ STRIP_TAC
3194  \\ `c1` by ALL_TAC \\ FULL_SIMP_TAC std_ss []
3195  THEN1 (Cases_on `LENGTH (mw_fix (REVERSE qs)) = 0` \\ FULL_SIMP_TAC std_ss [])
3196  \\ SIMP_TAC std_ss [Once EQ_SYM_EQ]
3197  \\ IMP_RES_TAC x64_simple_div1_thm
3198  \\ FULL_SIMP_TAC std_ss []
3199  \\ IMP_RES_TAC LENGTH_mw_simple_div
3200  \\ MP_TAC (x64_fix_thm |> Q.SPECL [`REVERSE qs`,`zs`,`0w`])
3201  \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ STRIP_TAC
3202  \\ `LENGTH (mw_fix (REVERSE qs)) <= LENGTH (REVERSE qs)` by
3203        METIS_TAC [LENGTH_mw_fix]
3204  \\ `LENGTH (mw_fix (REVERSE qs)) < dimword (:64)` by ALL_TAC
3205  THEN1 (FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ DECIDE_TAC)
3206  \\ FULL_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword]
3207  \\ FULL_SIMP_TAC std_ss [LENGTH_NIL]
3208  \\ Cases_on `mw_fix (REVERSE qs) = []` \\ FULL_SIMP_TAC std_ss [LENGTH]
3209  THEN1 (SIMP_TAC std_ss [LENGTH_REPLICATE,LENGTH_APPEND] \\ EVAL_TAC)
3210  \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC]
3211  \\ SEP_I_TAC "x64_to_dec"
3212  \\ FULL_SIMP_TAC std_ss []
3213  \\ SIMP_TAC std_ss [LENGTH_REPLICATE,LENGTH_APPEND,REVERSE_APPEND,REVERSE_DEF]
3214  \\ FULL_SIMP_TAC std_ss [APPEND]
3215  \\ FULL_SIMP_TAC std_ss [LENGTH_REVERSE] \\ DECIDE_TAC);
3216
3217val x64_int_to_dec_thm = prove(
3218  ``(mwi_to_dec (s,xs) = (res,T)) /\ LENGTH zs < dimword (:63) /\
3219    LENGTH xs <= LENGTH zs ==>
3220    ?zs1.
3221      (x64_int_to_dec_pre (x64_header(s,xs),xs,zs,ss)) /\
3222      (x64_int_to_dec (x64_header(s,xs),xs,zs,ss) = (xs,zs1,res ++ ss)) /\
3223      (LENGTH zs1 = LENGTH zs)``,
3224  SIMP_TAC std_ss [Once EQ_SYM_EQ]
3225  \\ SIMP_TAC std_ss [x64_int_to_dec_def,x64_int_to_dec_pre_def,LET_DEF] \\ STRIP_TAC
3226  \\ `LENGTH xs < dimword (:63)` by DECIDE_TAC
3227  \\ ASM_SIMP_TAC std_ss [x64_length]
3228  \\ IMP_RES_TAC LESS_EQ_LENGTH
3229  \\ FULL_SIMP_TAC std_ss []
3230  \\ ASSUME_TAC (x64_copy_over_thm |> Q.SPECL [`xs0`,`zs0`,`[]`] |> GEN_ALL)
3231  \\ FULL_SIMP_TAC std_ss [APPEND_NIL]
3232  \\ `LENGTH xs + LENGTH xs2 < dimword (:64)` by
3233        (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
3234  \\ SEP_I_TAC "x64_copy_over"
3235  \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [LENGTH_APPEND]
3236  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss []
3237  \\ FULL_SIMP_TAC std_ss [mwi_to_dec_def,LET_DEF]
3238  \\ Cases_on `mw_to_dec xs` \\ FULL_SIMP_TAC std_ss []
3239  \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC
3240  \\ `LENGTH xs < dimword (:64)` by DECIDE_TAC
3241  \\ IMP_RES_TAC x64_to_dec_thm
3242  \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPECL [`xs2`,`ss`])
3243  \\ FULL_SIMP_TAC std_ss [x64_header_sign]
3244  \\ Cases_on `s` \\ FULL_SIMP_TAC std_ss [APPEND]);
3245
3246
3247(* top-level entry point *)
3248
3249val int_op_rep_def = Define `
3250  (int_op_rep Add = 0w) /\
3251  (int_op_rep Sub = 1w) /\
3252  (int_op_rep Lt  = 2w) /\
3253  (int_op_rep Eq  = 3w) /\
3254  (int_op_rep Mul = 4w) /\
3255  (int_op_rep Div = 5w) /\
3256  (int_op_rep Mod = 6w) /\
3257  (int_op_rep Dec = 7w:'a word)`;
3258
3259val (res,x64_isub_flip_def,x64_isub_flip_pre_def) = x64_compile `
3260  x64_isub_flip (r1:word64,r3:word64) =
3261    if r3 = 0w then (r1,r3) else let r1 = r1 ?? 1w in (r1,r3)`
3262
3263val (res,x64_icmp_res_def,x64_icmp_res_pre_def) = x64_compile `
3264  x64_icmp_res (r10:word64,r3:word64) =
3265    if r3 = 2w then (* lt *)
3266      if r10 = 1w then let r10 = 1w in r10
3267                  else let r10 = 0w in r10
3268    else (* eq *)
3269      if r10 = 0w then let r10 = 1w in r10
3270                  else let r10 = 0w in r10:word64`
3271
3272val (res,x64_full_cmp_def,x64_full_cmp_pre_def) = x64_compile `
3273  x64_full_cmp (r3,r10,r11,xs,ys,zs) =
3274    let (r10,xs,ys) = x64_icompare (r10,r11,xs,ys) in
3275    let r10 = x64_icmp_res (r10,r3) in
3276      if r10 = 0w then (r10,xs,ys,zs) else
3277        let r0 = 1w:word64 in
3278        let r10 = 0w:word64 in
3279        let zs = LUPDATE r0 (w2n r10) zs in
3280        let r10 = 2w in
3281          (r10,xs,ys,zs)`
3282
3283val NumABS_LEMMA = prove(
3284  ``(Num (ABS (0:int)) = 0:num) /\ (Num (ABS (1:int)) = 1:num)``,
3285  intLib.COOPER_TAC);
3286
3287val x64_full_cmp_lt = prove(
3288  ``((x64_header (s,xs) = 0x0w) <=> (xs = [])) /\ mw_ok xs /\
3289    ((x64_header (t,ys) = 0x0w) <=> (ys = [])) /\ mw_ok ys /\
3290    LENGTH xs < dimword (:63) /\ LENGTH ys < dimword (:63) /\
3291    LENGTH xs + LENGTH ys < LENGTH zs /\ LENGTH zs < dimword (:63) ==>
3292    ?zs1.
3293      x64_full_cmp_pre (2w,x64_header (s,xs),x64_header (t,ys),xs,ys,zs) /\
3294      (x64_full_cmp (2w,x64_header (s,xs),x64_header (t,ys),xs,ys,zs) =
3295       (x64_header (mwi_op Lt (s,xs) (t,ys)),xs,ys,
3296        SND (mwi_op Lt (s,xs) (t,ys)) ++ zs1)) /\
3297      (LENGTH (SND (mwi_op Lt (s,xs) (t,ys)) ++ zs1) = LENGTH zs)``,
3298  SIMP_TAC std_ss [x64_full_cmp_def,x64_full_cmp_pre_def,LET_DEF] \\ STRIP_TAC
3299  \\ MP_TAC x64_icompare_thm \\ FULL_SIMP_TAC std_ss []
3300  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def] \\ SIMP_TAC std_ss [mwi_lt_def]
3301  \\ Cases_on `mwi_compare (s,xs) (t,ys)`
3302  \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,x64_icmp_res_def,n2w_11,LET_DEF]
3303  THEN1 (Q.EXISTS_TAC `zs` \\ SIMP_TAC std_ss []
3304    \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``] \\ EVAL_TAC)
3305  \\ REV (Cases_on `x`)
3306  \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,x64_icmp_res_def,n2w_11,LET_DEF]
3307  THEN1 (Q.EXISTS_TAC `zs` \\ SIMP_TAC std_ss []
3308    \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``] \\ EVAL_TAC)
3309  \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH]
3310  \\ Q.EXISTS_TAC `t'` \\ FULL_SIMP_TAC std_ss [LUPDATE_def]
3311  \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``]
3312  \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss [ADD1] \\ DECIDE_TAC);
3313
3314val x64_full_cmp_eq = prove(
3315  ``((x64_header (s,xs) = 0x0w) <=> (xs = [])) /\ mw_ok xs /\
3316    ((x64_header (t,ys) = 0x0w) <=> (ys = [])) /\ mw_ok ys /\
3317    LENGTH xs < dimword (:63) /\ LENGTH ys < dimword (:63) /\
3318    LENGTH xs + LENGTH ys < LENGTH zs /\ LENGTH zs < dimword (:63) ==>
3319    ?zs1.
3320      x64_full_cmp_pre (3w,x64_header (s,xs),x64_header (t,ys),xs,ys,zs) /\
3321      (x64_full_cmp (3w,x64_header (s,xs),x64_header (t,ys),xs,ys,zs) =
3322       (x64_header (mwi_op Eq (s,xs) (t,ys)),xs,ys,
3323        SND (mwi_op Eq (s,xs) (t,ys)) ++ zs1)) /\
3324      (LENGTH (SND (mwi_op Eq (s,xs) (t,ys)) ++ zs1) = LENGTH zs)``,
3325  SIMP_TAC std_ss [x64_full_cmp_def,x64_full_cmp_pre_def,LET_DEF] \\ STRIP_TAC
3326  \\ MP_TAC x64_icompare_thm \\ FULL_SIMP_TAC std_ss []
3327  \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def] \\ SIMP_TAC std_ss [mwi_eq_def]
3328  \\ REV (Cases_on `mwi_compare (s,xs) (t,ys)`) THEN1
3329   (Cases_on `x`
3330    \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,x64_icmp_res_def,n2w_11,LET_DEF]
3331    \\ Q.EXISTS_TAC `zs` \\ SIMP_TAC std_ss []
3332    \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``] \\ EVAL_TAC)
3333  \\ SIMP_TAC std_ss [cmp2w_def]
3334  \\ FULL_SIMP_TAC (srw_ss()) [cmp2w_def,x64_icmp_res_def,n2w_11,LET_DEF]
3335  \\ Cases_on `zs` \\ FULL_SIMP_TAC std_ss [LENGTH]
3336  \\ Q.EXISTS_TAC `t'` \\ FULL_SIMP_TAC std_ss [LUPDATE_def]
3337  \\ SIMP_TAC std_ss [i2mw_def,NumABS_LEMMA,EVAL ``n2mw 0``]
3338  \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss [ADD1] \\ DECIDE_TAC);
3339
3340val (x64_iop_res,x64_iop_def,x64_iop_pre_def) = x64_compile `
3341  x64_iop (r0,r1,r3,xs,ys,zs,xa,ya,ss) =
3342    if r3 <+ 2w then (* + or - *)
3343      let (r1,r3) = x64_isub_flip (r1,r3) in
3344      let r2 = r1 in
3345      let r1 = r0 in
3346      let (r10,xs,ys,zs,xa,ya) = x64_iadd (r1,r2,xs,ys,zs,xa,ya) in
3347        (r10,xs,ys,zs,xa,ya,ss)
3348    else if r3 <+ 4w then (* < or = *)
3349      let r10 = r0 in
3350      let r11 = r1 in
3351      let (r10,xs,ys,zs) = x64_full_cmp (r3,r10,r11,xs,ys,zs) in
3352        (r10,xs,ys,zs,xa,ya,ss)
3353    else if r3 = 4w then (* * *)
3354      let r2 = r1 in
3355      let r1 = r0 in
3356      let (r10,xs,ys,zs) = x64_imul (r1,r2,xs,ys,zs) in
3357        (r10,xs,ys,zs,xa,ya,ss)
3358    else if r3 <+ 7w then (* / or % *)
3359      let r3 = r3 - 5w in
3360      let r10 = r0 in
3361      let r11 = r1 in
3362      let (r11,xs,ys,zs,ss) = x64_idiv (r3,r10,r11,xs,ys,zs,ss) in
3363      let r10 = r11 in
3364        (r10,xs,ys,zs,xa,ya,ss)
3365    else (* print to dec *)
3366      let r10 = r0 in
3367      let (xs,zs,ss) = x64_int_to_dec (r10,xs,zs,ss) in
3368      let r10 = 0w in
3369        (r10,xs,ys,zs,xa,ya,ss)`
3370
3371val _ = save_thm("x64_iop_res",x64_iop_res);
3372
3373val x64_header_XOR_1 = prove(
3374  ``x64_header (s,xs) ?? 1w = x64_header (~s,xs)``,
3375  Cases_on `s` \\ SIMP_TAC std_ss [x64_header_def,GSYM word_mul_n2w]
3376  \\ blastLib.BBLAST_TAC);
3377
3378val x64_iop_thm = store_thm("x64_iop_thm",
3379  ``((x64_header (s,xs) = 0x0w) <=> (xs = [])) /\ mw_ok xs /\
3380    ((x64_header (t,ys) = 0x0w) <=> (ys = [])) /\ mw_ok ys /\
3381    LENGTH xs + LENGTH ys < LENGTH zs /\ LENGTH zs < dimword (:63) /\
3382    (((iop = Div) \/ (iop = Mod)) ==> ys <> []) ==>
3383    ?zs1.
3384      x64_iop_pre (x64_header (s,xs),x64_header (t,ys),int_op_rep iop,
3385                   xs,ys,zs,xa,ya,ss) /\
3386      (x64_iop (x64_header (s,xs),x64_header (t,ys),int_op_rep iop,
3387                xs,ys,zs,xa,ya,ss) =
3388       (x64_header (mwi_op iop (s,xs) (t,ys)),xs,ys,
3389        SND (mwi_op iop (s,xs) (t,ys)) ++ zs1,xa,ya,
3390        if iop = Dec then MAP (n2w o ORD) (int_to_str (mw2i (s,xs))) ++ ss
3391        else ss)) /\
3392      (LENGTH (SND (mwi_op iop (s,xs) (t,ys)) ++ zs1) = LENGTH zs)``,
3393  Cases_on `iop` \\ SIMP_TAC std_ss [int_op_rep_def] \\ REPEAT STRIP_TAC
3394  \\ `LENGTH xs < dimword (:63) /\ LENGTH ys < dimword (:63)` by DECIDE_TAC
3395  \\ `LENGTH xs + LENGTH ys <= LENGTH zs` by DECIDE_TAC
3396  \\ SIMP_TAC std_ss [x64_iop_def,x64_iop_pre_def,WORD_LO]
3397  \\ SIMP_TAC (srw_ss()) [w2n_n2w,LET_DEF,x64_isub_flip_def]
3398  THEN1 (MP_TAC x64_iadd_thm \\ FULL_SIMP_TAC std_ss []
3399    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def]
3400    \\ FULL_SIMP_TAC (srw_ss()) [])
3401  THEN1 (MP_TAC (x64_iadd_thm |> Q.INST [`t`|->`~t`])
3402    \\ FULL_SIMP_TAC std_ss [x64_header_XOR_1]
3403    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def,mwi_sub_def]
3404    \\ FULL_SIMP_TAC (srw_ss()) [])
3405  THEN1 (MP_TAC x64_imul_thm \\ FULL_SIMP_TAC std_ss []
3406    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def]
3407    \\ FULL_SIMP_TAC (srw_ss()) [])
3408  THEN1 (MP_TAC (x64_idiv_thm |> Q.INST [`r3`|->`0w`])
3409    \\ FULL_SIMP_TAC std_ss []
3410    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def]
3411    \\ FULL_SIMP_TAC (srw_ss()) [mwi_divmod_alt_def])
3412  THEN1 (MP_TAC (x64_idiv_thm |> Q.INST [`r3`|->`1w`])
3413    \\ FULL_SIMP_TAC std_ss []
3414    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def]
3415    \\ FULL_SIMP_TAC (srw_ss()) [mwi_divmod_alt_def])
3416  THEN1 (MP_TAC x64_full_cmp_lt \\ FULL_SIMP_TAC std_ss []
3417    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def]
3418    \\ FULL_SIMP_TAC (srw_ss()) [])
3419  THEN1 (MP_TAC x64_full_cmp_eq \\ FULL_SIMP_TAC std_ss []
3420    \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [mwi_op_def]
3421    \\ FULL_SIMP_TAC (srw_ss()) [])
3422  \\ FULL_SIMP_TAC std_ss [mwi_op_def]
3423  \\ MP_TAC (INST_TYPE [``:'a``|->``:64``] mwi_to_dec_thm)
3424  \\ FULL_SIMP_TAC (srw_ss()) [] \\ STRIP_TAC
3425  \\ `((xs = []) ==> ~s)` by ALL_TAC
3426  THEN1 (REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [EVAL ``x64_header (T,[])=0x0w``])
3427  \\ FULL_SIMP_TAC std_ss []
3428  \\ IMP_RES_TAC x64_int_to_dec_thm
3429  \\ POP_ASSUM (MP_TAC o Q.SPEC `zs`) \\ POP_ASSUM (K ALL_TAC)
3430  \\ `LENGTH xs <= LENGTH zs /\ LENGTH zs < dimword (:63)` by
3431        (FULL_SIMP_TAC (srw_ss()) [] \\ DECIDE_TAC)
3432  \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC
3433  \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPEC `ss`)
3434  \\ FULL_SIMP_TAC std_ss []
3435  \\ EVAL_TAC);
3436
3437val _ = export_theory();
3438