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