Changeset 7963
 Timestamp:
 Dec 28, 2007, 5:41:58 AM (12 years ago)
 Location:
 branches/ia32/level0/X86/X8632
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

branches/ia32/level0/X86/X8632/x8632bignum.lisp
r7916 r7963 6 6 ;;; The easiest thing to do is to store the 32 raw bits in two fixnums 7 7 ;;; and return multiple values. 8 ;;; 8 9 ;;; XXX  figure out how we're going to handle multiplevalues... 9 10 (defx8632lapfunction %bignumref ((bignum arg_y) (i arg_z)) … … 93 94 (defx8632lapfunction %addwithcarry ((r 20) (k 16) (c 12) (a 8) (i 4) #(ra 0)# (b arg_y) (j arg_z)) 94 95 (markasimm temp0) 95 (unboxfixnum b imm0) ;assume that j is going to be nil 96 (cmpl ($ x8632::nilvalue) (% j)) ;is j in fact nil? 97 (jne @gotb) 98 (movl (@ x8632::miscdataoffset (% b) (% j)) (% imm0)) 99 @gotb 96 (unboxfixnum b imm0) 97 (cmpl ($ x8632::nilvalue) (% j)) 98 ;; if j not nil, get b[j] 99 (cmovnel (@ x8632::miscdataoffset (% b) (% j)) (% imm0)) 100 100 (movl (@ a (% esp)) (% arg_y)) 101 (unboxfixnum arg_y temp0) ;assume that i is going be nil101 (unboxfixnum arg_y temp0) 102 102 (movl (@ i (% esp)) (% arg_z)) 103 (cmpl ($ x8632::nilvalue) (% arg_z)) ;is i in fact nil? 104 (jne @gota) 105 (movl (@ x8632::miscdataoffset (% arg_y) (% arg_z)) (% temp0)) 106 @gota 107 ;; unboxed a or a[i] now in temp0 108 ;; unboxed b or b[j] now in imm0 103 (cmpl ($ x8632::nilvalue) (% arg_z)) 104 ;; if i not nil, get a[i] 105 (cmovnel (@ x8632::miscdataoffset (% arg_y) (% arg_z)) (% temp0)) 109 106 (movl ($ '1) (% arg_z)) ;for outgoing carry 110 (movl (@ c (% esp)) (% arg_y))111 (testl (% arg_y) (% arg_y)) ;clears carry flag112 (jz @add)113 107 (xorl (% arg_y) (% arg_y)) 114 (stc)115 @add116 ;; arg_y = 0, arg_z = fixnum 1108 ;; I can't think of a better way to set CF at the moment. 109 ;; NEG would be ideal, but we don't have a free imm reg. 110 (btl ($ x8632::fixnumshift) (@ c (% esp))) ;CF = lsb of carry fixnum 117 111 (adc (% temp0) (% imm0)) 112 (markasnode temp0) 118 113 (movl (@ r (% esp)) (% temp0)) 119 114 (movl (@ k (% esp)) (% temp1)) 120 115 (movl (% imm0) (@ x8632::miscdataoffset (% temp0) (% temp1))) 121 (cmovnc (% arg_y) (% arg_z)) ;zero outgoing carry if no carry 122 (markasnode temp0) 116 (cmovnc (% arg_y) (% arg_z)) ;zero outgoing carry if CF = 0 123 117 (singlevaluereturn 7)) 118 119 ;;; Add the digits A[I] and B[J], and the incoming carry C (a fixnum). 120 ;;; Store the result in R[K], and return the outgoing carry. If I is 121 ;;; NIL, A is a fixnum. If J is NIL, B is a fixnum. 122 #+sse2 123 (defx8632lapfunction %addwithcarry ((r 20) (k 16) (c 12) (a 8) (i 4) #(ra 0)# (b arg_y) (j arg_z)) 124 (let ((aa mm2) 125 (bb mm3) 126 (cc mm4)) 127 (unboxfixnum b imm0) ;assume j will be nil 128 (cmpl ($ x8632::nilvalue) (% j)) 129 ;; if j not nil, get b[j] 130 (cmovnel (@ x8632::miscdataoffset (% b) (% j)) (% imm0)) 131 (movd (% imm0) (% bb)) 132 (movl (@ a (% esp)) (% arg_y)) 133 (movl (@ i (% esp)) (% arg_z)) 134 (movl (@ c (% esp)) (% temp0)) 135 (unboxfixnum arg_y imm0) ;assume i will be nil 136 (cmpl ($ x8632::nilvalue) (% arg_z)) 137 ;; if i not nil, get a[i] 138 (cmovnel (@ x8632::miscdataoffset (% arg_y) (% arg_z)) (% imm0)) 139 (movd (% imm0) (% aa)) 140 (unboxfixnum temp0 imm0) 141 (movd (% imm0) (% cc)) 142 (paddq (% xx) (% yy)) 143 (paddq (% cc) (% yy)) 144 (movl (@ r (% esp)) (% temp0)) 145 (movl (@ k (% esp)) (% temp1)) 146 (movd (% yy) (@ x8632::miscdataoffset (% temp0) (% temp1))) 147 (psrlq ($ 32) (% yy)) ;carry bit 148 (movd (% yy) (% imm0)) 149 (boxfixnum imm0 arg_z) 150 (singlevaluereturn 7))) 124 151 125 152 ;;; Store the result of A[I]  B[J]  borrow into R[K], returning the borrow. 126 153 ;;; If I is NIL, A is a fixnum; likewise for J and B. 154 ;;; 155 ;;; (a  b)  (1  borrow), or equivalently, (a  b) + borrow  1 156 ;;; 157 ;;; Note: borrow is 1 for no borrow and 0 for a borrow. 127 158 (defx8632lapfunction %subtractwithborrow ((r 20) (k 16) (borrow 12) (a 8) (i 4) #(ra 0)# (b arg_y) (j arg_z)) 128 159 (markasimm temp0) 129 (unboxfixnum b imm0) ;assume that j is going to be nil 130 (cmpl ($ x8632::nilvalue) (% j)) ;is j in fact nil? 131 (jne @gotb) 132 (movl (@ x8632::miscdataoffset (% b) (% j)) (% imm0)) 133 @gotb 160 (unboxfixnum b imm0) 161 (cmpl ($ x8632::nilvalue) (% j)) 162 (cmovnel (@ x8632::miscdataoffset (% b) (% j)) (% imm0)) 134 163 (movl (@ a (% esp)) (% arg_y)) 135 (unboxfixnum arg_y temp0) ;assume that i is going be nil164 (unboxfixnum arg_y temp0) 136 165 (movl (@ i (% esp)) (% arg_z)) 137 (cmpl ($ x8632::nilvalue) (% arg_z)) ;is i in fact nil? 138 (jne @gota) 139 (movl (@ x8632::miscdataoffset (% arg_y) (% arg_z)) (% temp0)) 140 @gota 141 ;; unboxed a or a[i] now in temp0 142 ;; unboxed b or b[j] now in imm0 143 (movl ($ '1) (% arg_z)) ;for outgoing carry 144 (movl (@ borrow (% esp)) (% arg_y)) 145 (testl (% arg_y) (% arg_y)) ;clears carry flag 146 (jz @sub) 147 (xorl (% arg_y) (% arg_y)) 148 (stc) 149 @sub 150 ;; arg_y = 0, arg_z = fixnum 1 166 (cmpl ($ x8632::nilvalue) (% arg_z)) 167 (cmovnel (@ x8632::miscdataoffset (% arg_y) (% arg_z)) (% temp0)) 168 ;; unboxed a or a[i] in temp0, unboxed b or b[j] in imm0 169 (cmpl ($ '1) (@ borrow (% esp))) ;CF = 1 if borrow is 0 else CF = 0 151 170 (sbb (% imm0) (% temp0)) 171 (movl ($ 1) (% imm0)) 172 (sbb ($ 0) (% imm0)) 173 (boxfixnum imm0 arg_z) 174 (movl (% temp0) (% imm0)) 175 (markasnode temp0) 152 176 (movl (@ r (% esp)) (% temp0)) 153 177 (movl (@ k (% esp)) (% temp1)) 154 178 (movl (% imm0) (@ x8632::miscdataoffset (% temp0) (% temp1))) 155 (cmovnc (% arg_y) (% arg_z)) ;zero outgoing carry if no carry156 (markasnode temp0)157 179 (singlevaluereturn 7)) 180 181 #+sse2 182 (defx8632lapfunction %subtractwithborrow ((r 20) (k 16) (borrow 12) (a 8) (i 4) #(ra 0)# (b arg_y) (j arg_z)) 183 (let ((aa mm2) 184 (bb mm3) 185 (ww mm4)) 186 (unboxfixnum b imm0) 187 (cmpl ($ x8632::nilvalue) (% j)) 188 ;; if j not nil, get b[j] 189 (cmovnel (@ x8632::miscdataoffset (% b) (% j)) (% imm0)) 190 (movd (% imm0) (% bb)) 191 (movl (@ a (% esp)) (% arg_y)) 192 (movl (@ i (% esp)) (% arg_z)) 193 (movl (@ borrow (% esp)) (% temp0)) 194 (unboxfixnum arg_y imm0) 195 (cmpl ($ x8632::nilvalue) (% arg_z)) 196 ;; if i not nil, get a[i] 197 (cmovnel (@ x8632::miscdataoffset (% arg_y) (% arg_z)) (% imm0)) 198 (movd (% imm0) (% aa)) 199 (unboxfixnum temp0 imm0) 200 (subl ($ 1) (% imm0)) 201 (movd (% imm0) (% ww)) 202 (psubq (% bb) (% aa)) 203 (paddq (% ww) (% aa)) 204 (movl (@ r (% esp)) (% temp0)) 205 (movl (@ k (% esp)) (% temp1)) 206 (movd (% aa) (@ x8632::miscdataoffset (% temp0) (% temp1))) 207 (psrlq ($ 32) (% aa)) ;carry digit 208 (movd (% aa) (% imm0)) 209 (xorl (% arg_z) (% arg_z)) 210 (test ($ 1) (% imm0)) 211 (cmovzl ($ '1) (% arg_z)) 212 (singlevaluereturn 7))) 213 214 (defx8632lapfunction %subtractone ((high arg_y) (low arg_z)) 215 (markasimm temp0) 216 (unboxfixnum low imm0) 217 (movl (% high) (% temp0)) 218 (shll ($ ( 16 x8632::fixnumshift)) (% temp0)) 219 (orl (% imm0) (% temp0)) 220 (subl ($ 1) (% temp0)) 221 (movzwl (% temp0.w) (% imm0)) 222 (boxfixnum imm0 low) 223 (sarl ($ 16) (% temp0)) 224 (boxfixnum temp0 high) 225 (markasnode temp0) 226 (push (% high)) 227 (push (% low)) 228 (movl (% esp) (% temp0)) 229 (jmpsubprim .SPvalues)) 230 231 ;;; %SUBTRACTWITHBORROW  Internal. 232 ;;; 233 ;;; This should be in assembler, and should not cons intermediate results. It 234 ;;; returns a 32bit digit and a borrow resulting from subtracting b from a, and 235 ;;; subtracting a possible incoming borrow. 236 ;;; 237 ;;; We really do: a  b  1 + borrow, where borrow is either 0 or 1. 238 ;;; 239 240 (defx8632lapfunction %subtractwithborrow1 ((ah 12) (al 8) (bh 4) #(ra 0)# (bl arg_y) (borrow arg_z)) 241 (markasimm temp0) 242 (markasimm temp1) 243 (unboxfixnum bl temp0) 244 (movl (@ bh (% esp)) (% imm0)) 245 (unboxfixnum imm0 imm0) 246 (shll ($ 16) (% imm0)) 247 (orl (% imm0) (% temp0)) 248 (movl (@ al (% esp)) (% temp1)) 249 (unboxfixnum temp1 temp1) 250 (movl (@ ah (% esp)) (% imm0)) 251 (unboxfixnum imm0 imm0) 252 (shll ($ 16) (% imm0)) 253 (orl (% imm0) (% temp1)) 254 (cmpl ($ '1) (@ borrow (% esp))) ;CF = 1 if borrow is 0 else CF = 0 255 (sbbl (% temp0) (% temp1)) 256 (movl ($ 1) (% imm0)) 257 (subb ($ 0) (% imm0)) 258 (boxfixnum imm0 arg_z) 259 (movzwl (% temp1.w) (% imm0)) 260 (boxfixnum imm0 imm0) 261 (push (% imm0)) ;high 262 (sarl ($ 16) (% temp1)) 263 (boxfixnum temp1 imm0) 264 (markasnode temp0) 265 (markasnode temp1) 266 (push (% imm0)) ;low 267 (push (% arg_z)) ;borrow 268 (setnargs 3) 269 (popl (@ 16 (% esp))) ;relocate return addr 270 (addl ($ '4) (% esp)) ;discard args, part of saved frame 271 (movl (% esp) (% temp0)) 272 (jmpsubprim .SPvalues)) 273 158 274 159 275 ;;; To normalize a bignum is to drop "trailing" digits which are … … 183 299 (je @adjustlength) 184 300 (movl (% next) (% sign)) 185 ;; (bignumref bignum ( len 2)) , i.e., nexttolast digit301 ;; (bignumref bignum ( len 2)) 186 302 (movl (@ ( x8632::miscdataoffset 8) (% bignum) (% len)) (% next)) 187 303 @test 188 304 (movl (% next) (% imm0)) 189 305 (sarl ($ 31) (% imm0)) ;propagate sign bit 190 (xorl (% sign) (% imm0)) 191 (testl (% imm0) (% imm0)) ;whole digit only sign? 306 (xorl (% sign) (% imm0)) ;whole digit only sign? 192 307 (jz @loop) 193 308 ;; New length now in len. … … 196 311 (cmpl (% len) (% imm0)) 197 312 ;; If the new length is the same as the original length, we know 198 ;; that the bignum is at least two digits long, and will never fit 199 ;; in a fixnum. Therefore, there's no need to do either of the 200 ;; tests at @maybereturnfixnum. 313 ;; that the bignum is at least two digits long (because if it was 314 ;; shorter, we would have branched directly to 315 ;; @maybereturnfixnum), and thus won't fit in a fixnum. 316 ;; Therefore, there's no need to do either of the tests at 317 ;; @maybereturnfixnum. 201 318 (je @done) 202 319 (movl (% len) (% imm0)) … … 206 323 @maybereturnfixnum 207 324 ;; could use SETcc here to avoid one branch 208 (pop (% returnfixnump))209 325 (cmpl ($ x8632::nilvalue) (@ 0 (% esp))) ;returnfixnump 210 326 (je @done) … … 222 338 (markasnode temp1) 223 339 (singlevaluereturn))) 340 341 ;;; Multiply X[I] by the unboxed value of the (nonnegative) fixnum Y; 342 ;;; add the incoming carry from CARRY[0] to the 64bit product. Store 343 ;;; the low word of the 64bit sum in R[0] and the high word in 344 ;;; CARRY[0]. 345 (defx8632lapfunction %multiplyandadd ((r 12) (carry 8) (x 4) #(ra 0)# (i arg_y) (y arg_z)) 346 (let ((xx mm2) 347 (yy mm3) 348 (cc mm4)) 349 (movl (@ x (% esp)) (% imm0)) 350 (movd (@ x8632::miscdataoffset (% imm0) (% i)) (% xx)) 351 (unboxfixnum y imm0) 352 (movd (% imm0) (% yy)) 353 (pmuludq (% xx) (% yy)) ;64 bit product 354 (movl (@ carry (% esp)) (% arg_y)) 355 (movd (@ x8632::miscdataoffset (% arg_y)) (% cc)) 356 (paddq (% cc) (% yy)) ;add in 32 bit carry digit 357 (movl (@ r (% esp)) (% arg_z)) 358 (movd (% yy) (@ x8632::miscdataoffset (% arg_z))) 359 (psrlq ($ 32) (% yy)) 360 (movd (% yy) (@ x8632::miscdataoffset (% arg_y))) 361 (singlevaluereturn 5))) 362 363 ;; multiply x[i] by y and add to result starting at digit i 364 (defx8632lapfunction %multiplyandaddharderloop2 365 ((x 12) (y 8) (r 4) #(ra 0)# (i arg_y) (ylen arg_z)) 366 (let ((cc mm2) 367 (xx mm3) 368 (yy mm4) 369 (j imm0)) 370 (movl (@ x (% esp)) (% temp0)) 371 (movd (@ x8632::miscdataoffset (% temp0) (% i)) (% xx)) ;x[i] 372 (movl (@ y (% esp)) (% temp0)) 373 (movl (@ r (% esp)) (% temp1)) 374 (pxor (% cc) (% cc)) 375 (xorl (% j) (% j)) 376 @loop 377 (movd (@ x8632::miscdataoffset (% temp0) (% j)) (% yy)) ;y[j] 378 (pmuludq (% xx) (% yy)) 379 (paddq (% cc) (% yy)) 380 (movd (% yy) (@ x8632::miscdataoffset (% temp1) (% i))) ;store r[i] 381 (movq (% yy) (% cc)) 382 (psrlq ($ 32) (% cc)) ;carry high digit 383 (addl ($ '1) (% i)) 384 (addl ($ '1) (% j)) 385 (subl ($ '1) (% ylen)) 386 (jg @loop) 387 (movd (% cc) (@ x8632::miscdataoffset (% temp1) (% i))) 388 (singlevaluereturn 5))) 389 390 ;; this is silly 391 (defx8632lapfunction %addthecarry ((high 4) #(ra 0)# (low arg_y) (c arg_z)) 392 (markasimm temp0) 393 (unboxfixnum low imm0) 394 (movl (@ high (% esp)) (% temp0)) 395 (shll ($ ( 16 x8632::fixnumshift)) (% temp0)) 396 (orl (% imm0) (% temp0)) 397 (unboxfixnum c imm0) 398 (addl (% imm0) (% temp0)) 399 (movzwl (% temp0.w) (% imm0)) 400 (boxfixnum imm0 temp1) 401 (sarl ($ 16) (% temp0)) 402 (boxfixnum temp0 temp0) 403 (push (% temp0)) ;high 404 (push (% temp1)) ;low 405 (setnargs 2) 406 (markasnode temp0) 407 (movl (% esp) (% temp0)) 408 (jmpsubprim .SPvalues)) 409 410 (defx8632lapfunction %bignumcounttrailingzerobits ((bignum arg_z)) 411 (let ((i arg_y) 412 (len temp0) 413 (zeros temp1)) 414 (vectorlength bignum temp0) 415 (xorl (% i) (% i)) 416 (movl ($ '32) (% zeros)) 417 @loop 418 (movl (@ x8632::miscdataoffset (% bignum) (% i)) (% imm0)) 419 (addl ($ '1) (% i)) 420 (addl ($ '32) (% zeros)) 421 (testl (% imm0) (% imm0)) 422 (jz @loop) 423 ;; now count zero bits in digit 424 (bsrl (% imm0) (% imm0)) 425 (boxfixnum imm0 imm0) 426 (addl (% imm0) (% zeros)) 427 (movl (% zeros) (% arg_z)) 428 (singlevaluereturn))) 429 430 ;;; dest[i] = (logand x[i] y[i]) 431 (defx8632lapfunction %bignumlogand ((idx 8) (x 4) #(ra 0)# (y arg_y) (dest arg_z)) 432 (let ((i temp0) 433 (xx temp1) 434 (yy arg_y)) 435 (movl (@ idx (% esp)) (% i)) 436 (movl (@ x (% esp)) (% xx)) 437 (movl (@ x8632::miscdataoffset (% xx) (% i)) (% imm0)) 438 (andl (@ x8632::miscdataoffset (% yy) (% i)) (% imm0)) 439 (movl (% imm0) (@ x8632::miscdataoffset (% dest) (% i))) 440 (singlevaluereturn 4))) 441 442 ;;; dest[i] = (logandc1 x[i] y[i]) 443 (defx8632lapfunction %bignumlogandc1 ((idx 8) (x 4) #(ra 0)# (y arg_y) (dest arg_z)) 444 (let ((i temp0) 445 (xx temp1) 446 (yy arg_y)) 447 (movl (@ idx (% esp)) (% i)) 448 (movl (@ x (% esp)) (% xx)) 449 (movl (@ x8632::miscdataoffset (% xx) (% i)) (% imm0)) 450 (not (% imm0)) 451 (andl (@ x8632::miscdataoffset (% yy) (% i)) (% imm0)) 452 (movl (% imm0) (@ x8632::miscdataoffset (% dest) (% i))) 453 (singlevaluereturn 4))) 454 455 ;;; dest[i] = (logandc2 x[i] y[i]) 456 (defx8632lapfunction %bignumlogandc2 ((idx 8) (x 4) #(ra 0)# (y arg_y) (dest arg_z)) 457 (let ((i temp0) 458 (xx temp1) 459 (yy arg_y)) 460 (movl (@ idx (% esp)) (% i)) 461 (movl (@ x (% esp)) (% xx)) 462 (movl (@ x8632::miscdataoffset (% yy) (% i)) (% imm0)) 463 (not (% imm0)) 464 (andl (@ x8632::miscdataoffset (% xx) (% i)) (% imm0)) 465 (movl (% imm0) (@ x8632::miscdataoffset (% dest) (% i))) 466 (singlevaluereturn 4))) 467 468 ;;; dest[i] = (logior x[i] y[i]) 469 (defx8632lapfunction %bignumlogior ((idx 8) (x 4) #(ra 0)# (y arg_y) (dest arg_z)) 470 (let ((i temp0) 471 (xx temp1) 472 (yy arg_y)) 473 (movl (@ idx (% esp)) (% i)) 474 (movl (@ x (% esp)) (% xx)) 475 (movl (@ x8632::miscdataoffset (% xx) (% i)) (% imm0)) 476 (orl (@ x8632::miscdataoffset (% yy) (% i)) (% imm0)) 477 (movl (% imm0) (@ x8632::miscdataoffset (% dest) (% i))) 478 (singlevaluereturn 4))) 479 480 ;;; dest[i] = (lognot x[i]) 481 (defx8632lapfunction %bignumlogior ((idx 4) #(ra 0)# (x arg_y) (dest arg_z)) 482 (let ((i temp0)) 483 (movl (@ idx (% esp)) (% i)) 484 (movl (@ x8632::miscdataoffset (% x) (% i)) (% imm0)) 485 (not (% imm0)) 486 (movl (% imm0) (@ x8632::miscdataoffset (% dest) (% i))) 487 (singlevaluereturn 3))) 488 489 ;;; dest[i] = (logxor x[i] y[i]) 490 (defx8632lapfunction %bignumlogxor ((idx 8) (x 4) #(ra 0)# (y arg_y) (dest arg_z)) 491 (let ((i temp0) 492 (xx temp1) 493 (yy arg_y)) 494 (movl (@ idx (% esp)) (% i)) 495 (movl (@ x (% esp)) (% xx)) 496 (movl (@ x8632::miscdataoffset (% xx) (% i)) (% imm0)) 497 (xorl (@ x8632::miscdataoffset (% yy) (% i)) (% imm0)) 498 (movl (% imm0) (@ x8632::miscdataoffset (% dest) (% i))) 499 (singlevaluereturn 4))) 500 501 (defx8632lapfunction %comparedigits ((a 4) #(ra 0)# (b arg_y) (i arg_z)) 502 (movl (@ a (% esp)) (% temp0)) 503 (movl (@ x8632::miscdataoffset (% temp0) (% i)) (% imm0)) 504 (xorl (% temp0) (% temp0)) 505 (movl ($ '1) (% temp1)) 506 (movl ($ '1) (% arg_y)) 507 (cmpl (@ x8632::miscdataoffset (% b) (% i)) (% imm0)) 508 (cmovzl (% temp0) (% arg_z)) 509 (cmovgl (% temp1) (% arg_z)) 510 (cmovll (% arg_y) (% arg_z)) 511 (singlevaluereturn 3)) 512 513 ;; returns number of bits in digithi,digitlo that are sign bits 514 ;; 32  digitssignbits is integerlength 515 (defx8632lapfunction %digitssignbits ((hi arg_y) (lo arg_z)) 516 (markasimm temp0) 517 (shll ($ ( 16 x8632::fixnumshift)) (% hi)) 518 (unboxfixnum lo imm0) 519 (orl (% hi) (% imm0)) 520 (movl (% imm0) (% temp0)) 521 (not (% imm0)) 522 (testl (% temp0) (% temp0)) 523 (js @wasneg) 524 (not (% imm0)) 525 @wasneg 526 (bsrl (% imm0) (% imm0)) 527 (sete (% temp0.b)) 528 (xorl ($ 31) (% imm0)) 529 (addb (% temp0.b) (% imm0.b)) 530 (boxfixnum imm0 arg_z) 531 (markasnode temp0) 532 (singlevaluereturn)) 533 534 ; if dest not nil store unboxed result in dest(0), else return a fixnum 535 (defx8632lapfunction fixdigitlogandc2 ((fix 4) #(ra 0)# (big arg_y) (dest arg_z)) ; index 0 536 (markasimm temp0) 537 (movl (@ fix (% esp)) (% temp0)) 538 (unboxfixnum temp0 temp0) 539 (movl (@ x8632::miscdataoffset (% big)) (% imm0)) 540 (not (% imm0)) 541 (andl (% temp0) (% imm0)) 542 (markasnode temp0) 543 (cmpl ($ x8632::nilvalue) (% dest)) 544 (jne @store) 545 (boxfixnum imm0 arg_z) 546 (singlevaluereturn 3) 547 @store 548 (movl (% imm0) (@ x8632::miscdataoffset (% dest))) 549 (singlevaluereturn 3)) 550 551 (defx8632lapfunction digitlognotmove ((index 4) #(ra 0)# (source arg_y) (dest arg_z)) 552 (movl (@ index (% esp)) (% temp0)) 553 (movl (@ x8632::miscdataoffset (% source) (% temp0)) (% imm0)) 554 (not (% imm0)) 555 (movl (% imm0) (@ x8632::miscdataoffset (% dest) (% temp0))) 556 (singlevaluereturn 3)) 557 558 ;; Add b to a starting at a[i] 559 ;; might want not to use SSE2 for this. use lea to update loop counter 560 ;; variables so that the flags don't get set. 561 (defx8632lapfunction bignumaddloop+ ((i 8) (a 4) #(ra 0)# (b arg_y) (blen arg_z)) 562 (let ((aa mm2) 563 (bb mm3) 564 (cc mm4)) 565 (movl (@ a (% esp)) (% temp0)) 566 (movl (@ i (% esp)) (% temp1)) 567 (xorl (% imm0) (% imm0)) 568 (pxor (% cc) (% cc)) 569 @loop 570 (movd (@ x8632::miscdataoffset (% temp0) (% temp1)) (% aa)) 571 (movd (@ x8632::miscdataoffset (% b) (% imm0)) (% bb)) 572 (paddq (% bb) (% aa)) 573 (paddq (% cc) (% aa)) 574 (movd (% aa) (@ x8632::miscdataoffset (% temp0) (% temp1))) 575 (psrlq ($ 32) (% aa)) 576 (movq (% aa) (% cc)) 577 (addl ($ '1) (% temp1)) 578 (addl ($ '1) (% imm0)) 579 (subl ($ '1) (% blen)) 580 (jg @loop) 581 ;; add in final carry 582 (movd (% cc) (% imm0)) 583 (addl (% imm0) (@ x8632::miscdataoffset (% temp0) (% temp1))) 584 (singlevaluereturn 4))) 585 586 (defx8632lapfunction bignumlogtestloop ((count 4) #(ra 0)# (s1 arg_y) (s2 arg_z)) 587 (let ((i temp1) 588 (c temp0)) 589 (movl (@ count (% esp)) (% c)) 590 (xorl (% i) (% i)) 591 @loop 592 (movl (@ x8632::miscdataoffset (% s1) (% i)) (% imm0)) 593 (test (@ x8632::miscdataoffset (% s2) (% i)) (% imm0)) 594 (jnz @true) 595 (addl ($ '1) (% i)) 596 (cmpl (% i) (% c)) 597 (jg @loop) 598 (movl ($ x8632::nilvalue) (% arg_z)) 599 (singlevaluereturn 3) 600 @true 601 (movl ($ x8632::tvalue) (% arg_z)) 602 (singlevaluereturn 3))) 603 604 ;;; called from bignumashiftleftunaligned 605 (defx8632lapfunction bignumshiftleftloop ((nbits 12) (result 8) (bignum 4) #(ra 0)# (reslen1 arg_y) (j arg_z)) 606 (let ((r temp0) 607 (b temp1) 608 (bb mm2) 609 (bits mm3) 610 (tt mm4) 611 (remainingbits mm5)) 612 (movl (% j) (% imm0)) 613 (subl ($ '1) (% imm0)) 614 (pushl (% imm0)) ;digits 615 (movl (@ nbits (% esp)) (% imm0)) 616 (unboxfixnum imm0 imm0) 617 (movd (% imm0) (% bits)) ;shift count 618 (negl (% imm0)) 619 (addl ($ 32) (% imm0)) 620 (movd (% imm0) (% remainingbits)) 621 (movl (@ result (% esp)) (% r)) 622 (movl (@ bignum (% esp)) (% b)) 623 (xorl (% imm0) (% imm0)) 624 @loop 625 ;; bignum[i] 626 (movd (@ x8632::miscdataoffset (% b) (% imm0)) (% bb)) 627 (psrlq (% remainingbits) (% bb)) 628 ;; bignum[i+1] 629 (movd (@ (+ x8632::miscdataoffset 4) (% b) (% imm0)) (% tt)) 630 (psllq (% bits) (% tt)) 631 (por (% tt) (% bb)) 632 (movd (% bb) (@ x8632::miscdataoffset (% r) (% j))) 633 (addl ($ '1) (% imm0)) 634 (addl ($ '1) (% j)) 635 (cmpl (% j) (% reslen1)) 636 (jne @loop) 637 (movd (@ x8632::miscdataoffset (% bignum)) (% bb)) ;bignum[0] 638 (psllq (% bits) (% bb)) 639 (popl (% arg_y)) ;digits 640 (movd (% bb) (@ x8632::miscdataoffset (% r) (% arg_y))) 641 (movd (@ x8632::miscdataoffset (% bignum) (% imm0)) (% bb)) ;bignum[i] 642 (psrlq (% remainingbits) (% bb)) 643 (movd (% bb) (@ x8632::miscdataoffset (% r) (% j))) 644 (singlevaluereturn 5))) 645 646 (defx8632lapfunction %logcountcomplement ((bignum arg_y) (i arg_z)) 647 (markasimm temp0) 648 (let ((rshift imm0) 649 (temp temp0)) 650 (movl (@ x8632::miscdataoffset (% bignum) (% i)) (% rshift)) 651 (notl (% rshift)) 652 (xorl (% arg_z) (% arg_z)) 653 (testl (% rshift) (% rshift)) 654 (jmp @test) 655 @next 656 (lea (@ 1 (% rshift)) (% temp)) 657 (and (% temp) (% rshift)) ;sets flags 658 (lea (@ '1 (% arg_z)) (% arg_z)) ;doesn't set flags 659 @test 660 (jne @next) 661 (markasnode temp0) 662 (singlevaluereturn))) 663 664 (defx8632lapfunction %logcount ((bignum arg_y) (i arg_z)) 665 (markasimm temp0) 666 (let ((rshift imm0) 667 (temp temp0)) 668 (movl (@ x8632::miscdataoffset (% bignum) (% i)) (% rshift)) 669 (xorl (% arg_z) (% arg_z)) 670 (testl (% rshift) (% rshift)) 671 (jmp @test) 672 @next 673 (lea (@ 1 (% rshift)) (% temp)) 674 (and (% temp) (% rshift)) ;sets flags 675 (lea (@ '1 (% arg_z)) (% arg_z)) ;doesn't set flags 676 @test 677 (jne @next) 678 (markasnode temp0) 679 (singlevaluereturn))) 680 681 682 ;;; floor: given x and y, producing q and r, q * y + r = x. 683 684 ;;; Divide bignum x by single digit y (passed as two halves). 685 ;;; The quotient in stored in q, and the remainder is returned 686 ;;; in two halves. 687 (defx8632lapfunction %floorloopquo ((x 8) (q 4) #(ra 0)# (yhi arg_y) (ylo arg_z)) 688 ) 689 690 691 
branches/ia32/level0/X86/X8632/x8632def.lisp
r7430 r7963 17 17 (inpackage "CCL") 18 18 19 (defx86 lapfunction %functionvectortofunction ((arg arg_z))20 (singlevaluereturn)) 21 22 (defx86 lapfunction %functiontofunctionvector ((arg arg_z))23 (singlevaluereturn)) 24 25 (defx86 lapfunction %functioncodewords ((fun arg_z))19 (defx8632lapfunction %functionvectortofunction ((arg arg_z)) 20 (singlevaluereturn)) 21 22 (defx8632lapfunction %functiontofunctionvector ((arg arg_z)) 23 (singlevaluereturn)) 24 25 (defx8632lapfunction %functioncodewords ((fun arg_z)) 26 26 (trapunlesstypecode= fun x8632::subtagfunction) 27 27 (movzwl (@ x8632::miscdataoffset (% fun)) (% imm0)) … … 29 29 (singlevaluereturn)) 30 30 31 (defx86 lapfunction %nthimmediate ((fun arg_y) (n arg_z))31 (defx8632lapfunction %nthimmediate ((fun arg_y) (n arg_z)) 32 32 (trapunlesstypecode= fun x8632::subtagfunction) 33 33 (movzwl (@ x8632::miscdataoffset (% fun)) (% imm0)) … … 36 36 (singlevaluereturn)) 37 37 38 (defx86lapfunction %setnthimmediate ((fun 4) #(ra 0)# (n arg_y) (new arg_z)) 39 (movl (@ fun (% esp)) (% temp0)) 38 (defx8632lapfunction %setnthimmediate ((fun 4) #(ra 0)# (n arg_y) (new arg_z)) 39 (popl (@ 8 (% esp))) 40 (popl (% temp0)) 41 (addl ($ 4) (% esp)) 40 42 (trapunlesstypecode= temp0 x8632::subtagfunction) 41 (mov l (@ x8632::miscdataoffset (% temp0)) (% imm0))43 (movzwl (@ x8632::miscdataoffset (% temp0)) (% imm0)) 42 44 (lea (@ (% n) (% imm0) 4) (% arg_y)) 43 45 ;; expects gvector in temp0 44 46 (jmpsubprim .SPgvset)) 45 47 46 (defx86 lapfunction %functioncodebyte ((fun arg_y) (pc arg_z))48 (defx8632lapfunction %functioncodebyte ((fun arg_y) (pc arg_z)) 47 49 (unboxfixnum pc imm0) 48 50 (movzbl (@ (% fun) (% imm0)) (% imm0)) … … 50 52 (singlevaluereturn)) 51 53 52 ;;;  53 54 55 ;;; Returns 3 values: mask of registers used in the function, stack location 56 ;;; from which they'd be restored, relative PC at which they're saved. If 57 ;;; the mask is 0, the values NIL NIL NIL are returned. If either the stack 58 ;;; location or relative PC is #xff, both of those values will be returned 59 ;;; as NIL. 60 (defx86lapfunction %functionregisterusage ((f arg_z)) 61 (checknargs 1) 62 (trapunlessfulltag= f x8664::fulltagfunction) 63 (movzbl (@ 1 (% f)) (% imm0.l)) 64 (shll ($ 8) (% imm0.l)) 65 (boxfixnum imm0 arg_x) 66 (movq (% rsp) (% temp0)) 67 (setnargs 3) 68 (je @noregs) 69 (movzbl (@ 2 (% f)) (% imm0.l)) 70 (movzbl (@ 3 (% f)) (% imm1.l)) 71 (cmpb ($ #xff) (% imm0.b)) 72 (je @unencodable) 73 (cmpb ($ #xff) (% imm1.b)) 74 (je @unencodable) 54 ;;; Use the offsets in the selfreference table to replace the :self 55 ;;; in (movl ($ :self) (% fn)) with the function's actual address. 56 (defx8632lapfunction %makecodeexecutable ((f arg_z)) 57 (movzwl (@ x8632::miscdataoffset (% f)) (% imm0)) 75 58 (boxfixnum imm0 arg_y) 76 (boxfixnum imm1 arg_z) 77 (push (% arg_x)) 78 (push (% arg_y)) 79 (push (% arg_z)) 80 (jmpsubprim .SPvalues) 81 @unencodable 82 (push (% arg_x)) 83 (pushq ($ nil)) 84 (pushq ($ nil)) 85 (jmpsubprim .SPvalues) 86 @noregs 87 (pushq ($ nil)) 88 (pushq ($ nil)) 89 (pushq ($ nil)) 90 (jmpsubprim .SPvalues)) 91 92 93 94 (defx86lapfunction %makecodeexecutable ((codev arg_z)) 95 (singlevaluereturn)) 96 97 98 99 (defx86lapfunction %getkernelglobalfromoffset ((offset arg_z)) 59 (jmp @test) 60 @loop 61 (movl (% f) (@ (% f) (% imm0))) 62 (subl ($ '1) (% arg_y)) 63 @test 64 (movl (@ 4 (% f) (% arg_y)) (% imm0)) 65 (testl (% imm0) (% imm0)) 66 (jnz @loop) 67 (singlevaluereturn)) 68 69 (defx8632lapfunction %getkernelglobalfromoffset ((offset arg_z)) 100 70 (checknargs 1) 101 71 (unboxfixnum offset imm0) 102 (movq (@ target::nilvalue (% imm0)) (% arg_z)) 103 (singlevaluereturn)) 104 105 (defx86lapfunction %setkernelglobalfromoffset ((offset arg_y) (newvalue arg_z)) 72 (movl (@ x8632::nilvalue (% imm0)) (% arg_z)) 73 (singlevaluereturn)) 74 75 (defx8632lapfunction %setkernelglobalfromoffset ((offset arg_y) 76 (newvalue arg_z)) 106 77 (checknargs 2) 107 78 (unboxfixnum offset imm0) 108 (movq (% arg_z) (@ target::nilvalue (% imm0))) 109 (singlevaluereturn)) 110 111 112 (defx86lapfunction %getkernelglobalptrfromoffset ((offset arg_y) 113 (ptr arg_z)) 79 (movl (% arg_z) (@ x8632::nilvalue (% imm0))) 80 (singlevaluereturn)) 81 82 (defx8632lapfunction %getkernelglobalptrfromoffset ((offset arg_y) 83 (ptr arg_z)) 114 84 (checknargs 2) 115 85 (unboxfixnum offset imm0) 116 (movq (@ target::nilvalue (% imm0)) (% imm0)) 117 (movq (% imm0) (@ x8664::macptr.address (% ptr))) 118 (singlevaluereturn)) 119 120 121 122 123 (defx86lapfunction %fixnumref ((fixnum arg_y) # &optional # (offset arg_z)) 86 (movl (@ x8632::nilvalue (% imm0)) (% imm0)) 87 (movl (% imm0) (@ x8632::macptr.address (% ptr))) 88 (singlevaluereturn)) 89 90 (defx8632lapfunction %fixnumref ((fixnum arg_y) # &optional # (offset arg_z)) 124 91 (:arglist (fixnum &optional offset)) 125 92 (checknargs 1 2) 126 (cmpw ($ x86 64::fixnumone) (% nargs))93 (cmpw ($ x8632::fixnumone) (% nargs)) 127 94 (jne @2args) 128 (mov q(% offset) (% fixnum))95 (movl (% offset) (% fixnum)) 129 96 (xorl (%l offset) (%l offset)) 130 97 @2args 131 98 (unboxfixnum offset imm0) 132 (mov q(@ (% fixnum) (% imm0)) (% arg_z))133 (singlevaluereturn)) 134 135 (defx86 lapfunction %fixnumrefnatural ((fixnum arg_y) # &optional # (offset arg_z))99 (movl (@ (% fixnum) (% imm0)) (% arg_z)) 100 (singlevaluereturn)) 101 102 (defx8632lapfunction %fixnumrefnatural ((fixnum arg_y) # &optional # (offset arg_z)) 136 103 (:arglist (fixnum &optional offset)) 137 104 (checknargs 1 2) 138 (cmpw ($ x86 64::fixnumone) (% nargs))105 (cmpw ($ x8632::fixnumone) (% nargs)) 139 106 (jne @2args) 140 (mov q(% offset) (% fixnum))107 (movl (% offset) (% fixnum)) 141 108 (xorl (%l offset) (%l offset)) 142 109 @2args 143 110 (unboxfixnum offset imm0) 144 (mov q(@ (% fixnum) (% imm0)) (% imm0))145 (jmpsubprim .SPmakeu 64))146 147 (defx86 lapfunction %fixnumset ((fixnum arg_x)(offset arg_y) # &optional # (newvalue arg_z))111 (movl (@ (% fixnum) (% imm0)) (% imm0)) 112 (jmpsubprim .SPmakeu32)) 113 114 (defx8632lapfunction %fixnumset ((fixnum 4) #(ra 0)# (offset arg_y) # &optional # (newvalue arg_z)) 148 115 (:arglist (fixnum offset &optional newval)) 149 116 (checknargs 2 3) 117 (movl (@ fixnum (% esp)) (% temp0)) 150 118 (cmpw ($ '2) (% nargs)) 151 119 (jne @3args) 152 (mov q (% offset) (% fixnum))120 (movl (% offset) (% temp0)) 153 121 (xorl (%l offset) (%l offset)) 154 122 @3args 155 123 (unboxfixnum offset imm0) 156 (mov q (% newvalue) (@ (% fixnum) (% imm0)))157 (mov q(% newvalue) (% arg_z))158 (singlevaluereturn ))159 160 161 (defx86 lapfunction %fixnumsetnatural ((fixnum arg_x)(offset arg_y) # &optional # (newvalue arg_z))124 (movl (% newvalue) (@ (% temp0) (% imm0))) 125 (movl (% newvalue) (% arg_z)) 126 (singlevaluereturn 3)) 127 128 129 (defx8632lapfunction %fixnumsetnatural ((fixnum 4) #(ra 0)# (offset arg_y) # &optional # (newvalue arg_z)) 162 130 (:arglist (fixnum offset &optional newval)) 163 131 (checknargs 2 3) 132 (movl (@ fixnum (% esp)) (% temp0)) 164 133 (savesimpleframe) 165 134 (cmpw ($ '2) (% nargs)) 166 135 (jne @3args) 167 (mov q (% offset) (% fixnum))136 (movl (% offset) (% temp0)) 168 137 (xorl (%l offset) (%l offset)) 169 138 @3args 170 (callsubprim .SPgetu64) 171 (unboxfixnum offset imm1) 172 (movq (% imm0) (@ (% fixnum) (% imm1))) 139 (callsubprim .SPgetu32) ;puts u32 in imm0 140 (markasimm temp1) 141 (unboxfixnum offset temp1) 142 (movl (% imm0) (@ (% temp0) (% temp1))) 143 (markasnode temp1) 173 144 (restoresimpleframe) 174 145 (singlevaluereturn)) 175 146 176 147 177 (defx86 lapfunction %currentframeptr ()148 (defx8632lapfunction %currentframeptr () 178 149 (checknargs 0) 179 (mov q (% rbp) (% arg_z))180 (singlevaluereturn)) 181 182 183 (defx86 lapfunction %currenttsp ()150 (movl (% ebp) (% arg_z)) 151 (singlevaluereturn)) 152 153 154 (defx8632lapfunction %currenttsp () 184 155 (checknargs 0) 185 (mov q (@ (% :rcontext) x8664::tcr.savetsp) (% arg_z))186 (singlevaluereturn)) 187 188 189 (defx86 lapfunction %%framebacklink ((p arg_z))156 (movl (@ (% :rcontext) x8632::tcr.savetsp) (% arg_z)) 157 (singlevaluereturn)) 158 159 160 (defx8632lapfunction %%framebacklink ((p arg_z)) 190 161 (checknargs 1) 191 (movq (@ (% arg_z)) (% arg_z)) 192 (singlevaluereturn)) 193 194 ;;; Look for "lea nnnn(%rip),%fn" AT the tra; if that's present, use 195 ;;; the dispacement nnnn to find the function. The end of the 196 ;;; encoded displacement is 197 ;;; x8664::recoverfnfromripdispoffset (= 7) bytes from the tra. 198 (defx86lapfunction %returnaddressfunction ((r arg_z)) 162 (movl (@ (% arg_z)) (% arg_z)) 163 (singlevaluereturn)) 164 165 ;;; Look for "movl $imm32,%fn at the tra; if present, then $imm32 is 166 ;;; the address of the function. 167 ;;; 168 ;;; That is: #b10111111 <imm32> 169 ;;; ^^^^ 170 ;;; operand size  register number (%fn/%edi) 171 172 (defx8632lapfunction %returnaddressfunction ((r arg_z)) 199 173 (extractlisptag r imm0) 200 (cmpb ($ x86 64::tagtra) (% imm0.b))174 (cmpb ($ x8632::fulltagtra) (% imm0.b)) 201 175 (jne @fail) 202 (cmp w ($ x8664::recoverfnfromripword0) (@ (% r)))176 (cmpb ($ x8632::recoverfnopcodebyte) (@ (% r))) 203 177 (jne @fail) 204 (cmpb ($ x8664::recoverfnfromripbyte2) (@ 2 (% r))) 205 (movslq (@ x8664::recoverfnfromripdispoffset (% r)) (% imm0)) 206 (jne @fail) 207 (lea (@ x8664::recoverfnfromriplength (% imm0) (% r)) (% arg_z)) 178 (movl (@ x8632::recoverfnaddressoffset (% r)) (% arg_z)) 208 179 (singlevaluereturn) 209 180 @fail 210 (movl ($ x8664::nilvalue) (% arg_z.l)) 211 (singlevaluereturn)) 212 213 (defx86lapfunction %returnaddressoffset ((r arg_z)) 181 (movl ($ x8632::nilvalue) (% arg_z)) 182 (singlevaluereturn)) 183 184 ;;; xxx this may need twiddling to refer to the right place 185 (defx8632lapfunction %returnaddressoffset ((r arg_z)) 214 186 (extractlisptag r imm0) 215 (cmpb ($ x86 64::tagtra) (% imm0.b))187 (cmpb ($ x8632::fulltagtra) (% imm0.b)) 216 188 (jne @fail) 217 (cmp w ($ x8664::recoverfnfromripword0) (@ (% r)))189 (cmpb ($ x8632::recoverfnopcodebyte) (@ (% r))) 218 190 (jne @fail) 219 (cmpb ($ x8664::recoverfnfromripbyte2) (@ 2 (% r))) 220 (movslq (@ x8664::recoverfnfromripdispoffset (% r)) (% imm0)) 221 (jne @fail) 222 (negq (% imm0)) 223 (leaq (@ ( (ash x8664::recoverfnfromriplength x8664::fixnumshift)) (% imm0) 8) (% arg_z)) 224 (singlevaluereturn) 191 (movl (@ x8632::recoverfnaddressoffset (% r)) (% imm0)) 192 (subl (% arg_z) (% imm0)) ;offset = tra  fn 193 (boxfixnum imm0 arg_z) 225 194 @fail 226 (movl ($ x86 64::nilvalue) (% arg_z.l))195 (movl ($ x8632::nilvalue) (% arg_z)) 227 196 (singlevaluereturn)) 228 197 … … 230 199 ;;; frame pointer is the caller of the function that "uses" that frame. 231 200 (defun %cfplfun (p) 232 (let* ((ra (%fixnumref p x86 64::lispframe.returnaddress)))201 (let* ((ra (%fixnumref p x8632::lispframe.returnaddress))) 233 202 (if (eq ra (%getkernelglobal ret1valaddr)) 234 (setq ra (%fixnumref p x86 64::lispframe.xtra)))203 (setq ra (%fixnumref p x8632::lispframe.xtra))) 235 204 (values (%returnaddressfunction ra) (%returnaddressoffset ra)))) 236 205 237 238 239 (defx86lapfunction %uvectordatafixnum ((uv arg_z)) 206 (defx8632lapfunction %uvectordatafixnum ((uv arg_z)) 240 207 (checknargs 1) 241 (trapunlessfulltag= arg_z x86 64::fulltagmisc)242 (add q ($ x8664::miscdataoffset) (% arg_z))243 (singlevaluereturn)) 244 245 (defx86 lapfunction %catchtop ((tcr arg_z))208 (trapunlessfulltag= arg_z x8632::fulltagmisc) 209 (addl ($ x8632::miscdataoffset) (% arg_z)) 210 (singlevaluereturn)) 211 212 (defx8632lapfunction %catchtop ((tcr arg_z)) 246 213 (checknargs 1) 247 (movl ($ x86 64::nilvalue) (%larg_y))248 (mov q (@ (% :rcontext) x8664::tcr.catchtop) (% arg_z))214 (movl ($ x8632::nilvalue) (% arg_y)) 215 (movl (@ (% :rcontext) x8632::tcr.catchtop) (% arg_z)) 249 216 (testb (%b arg_z) (%b arg_z)) 250 (cmove q(% arg_y) (% arg_z))251 (singlevaluereturn)) 252 253 (defx86 lapfunction %catchtsp ((catch arg_z))217 (cmovel (% arg_y) (% arg_z)) 218 (singlevaluereturn)) 219 220 (defx8632lapfunction %catchtsp ((catch arg_z)) 254 221 (checknargs 1) 255 (lea (@ ( (+ target::fulltagmisc256 (ash 1 (1+ target::wordshift)))) (% arg_z))222 (lea (@ ( (+ x8632::fulltagmisc 223 (ash 1 (1+ x8632::wordshift)))) (% arg_z)) 257 224 (% arg_z)) 258 225 (singlevaluereturn)) 259 260 261 226 262 227 ;;; Same as %addressof, but doesn't cons any bignums 263 228 ;;; It also left shift fixnums just like everything else. 264 (defx86 lapfunction %fixnumaddressof ((x arg_z))229 (defx8632lapfunction %fixnumaddressof ((x arg_z)) 265 230 (checknargs 1) 266 231 (boxfixnum x arg_z) 267 232 (singlevaluereturn)) 268 233 269 (defx86lapfunction %savestandardbindinglist ((bindings arg_z)) 270 (movq (@ (% :rcontext) x8664::tcr.vsarea) (% imm0)) 271 (movq (@ x8664::area.high (% imm0)) (% imm1)) 272 (subq ($ x8664::nodesize) (% imm1)) 273 (movq (% bindings) (@ (% imm1))) 274 (singlevaluereturn)) 275 276 (defx86lapfunction %savedbindingsaddress () 277 (movq (@ (% :rcontext) x8664::tcr.vsarea) (% imm0)) 278 (movq (@ x8664::area.high (% imm0)) (% imm1)) 279 (lea (@ ( x8664::nodesize) (% imm1)) (% arg_z)) 280 (singlevaluereturn)) 281 282 (defx86lapfunction %getobject ((macptr arg_y) (offset arg_z)) 234 (defx8632lapfunction %savestandardbindinglist ((bindings arg_z)) 235 (markasimm temp0) 236 (movl (@ (% :rcontext) x8632::tcr.vsarea) (% imm0)) 237 (movl (@ x8632::area.high (% imm0)) (% temp0)) 238 (subl ($ x8632::nodesize) (% temp0)) 239 (movl (% bindings) (@ (% temp0))) 240 (markasnode temp0) 241 (singlevaluereturn)) 242 243 (defx8632lapfunction %savedbindingsaddress () 244 (markasimm temp0) 245 (movl (@ (% :rcontext) x8632::tcr.vsarea) (% imm0)) 246 (movl (@ x8632::area.high (% imm0)) (% temp0)) 247 (leal (@ ( x8632::nodesize) (% temp0)) (% arg_z)) 248 (markasnode temp0) 249 (singlevaluereturn)) 250 251 (defx8632lapfunction %getobject ((macptr arg_y) (offset arg_z)) 283 252 (checknargs 2) 284 (trapunlesstypecode= macptr x8664::subtagmacptr) 253 (trapunlesstypecode= macptr x8632::subtagmacptr) 254 (trapunlesslisptag= offset x8632::tagfixnum) 285 255 (macptrptr macptr imm0) 286 ( trapunlesslisptag= offset target::tagfixnum imm1)287 (unboxfixnum offset imm1)288 (mov q (@ (% imm0) (% imm1)) (% arg_z))289 ( singlevaluereturn))290 291 292 (defx86 lapfunction %setobject ((macptr arg_x)(offset arg_y) (value arg_z))256 (markasimm temp0) 257 (unboxfixnum offset temp0) 258 (movl (@ (% imm0) (% temp0)) (% arg_z)) 259 (markasnode temp0) 260 (singlevaluereturn)) 261 262 (defx8632lapfunction %setobject ((macptr 4) #(ra 0)# (offset arg_y) (value arg_z)) 293 263 (checknargs 3) 294 (trapunlesstypecode= macptr target::subtagmacptr) 295 (macptrptr macptr imm0) 296 (trapunlesslisptag= offset target::tagfixnum imm1) 297 (unboxfixnum offset imm1) 298 (movq (% arg_z) (@ (% imm0) (% imm1))) 299 (singlevaluereturn)) 300 301 (defx86lapfunction %applylexprwithmethodcontext ((magic arg_x) 302 (function arg_y) 303 (args arg_z)) 264 (movl (@ macptr (% esp)) (% temp1)) 265 (trapunlesstypecode= temp1 x8632::subtagmacptr) 266 (trapunlesslisptag= offset x8632::tagfixnum) 267 (macptrptr temp1 imm0) 268 (markasimm temp0) 269 (unboxfixnum offset temp0) 270 (movl (% arg_z) (@ (% imm0) (% temp0))) 271 (markasnode temp0) 272 (singlevaluereturn)) 273 274 (defx8632lapfunction %applylexprwithmethodcontext ((magic 4) 275 #(ra 0)# 276 (function arg_y) 277 (args arg_z)) 304 278 ;; Somebody's called (or tailcalled) us. 305 ;; Put magic arg in x8664::nextmethodcontext (= x8664::temp0). 306 ;; Put function in x8664::xfn until we're ready to jump to it. 307 ;; Set nargs to 0, then spread "args" on stack (clobbers arg_x, arg_y, arg_z, 308 ;; but preserves x866::xfn/x8664::nextmethodcontext. 309 ;; Jump to the function in x8664::xfn. 310 (popq (% ra0)) 311 (movq (% magic) (% nextmethodcontext)) 312 (movq (% function) (% xfn)) 313 (setnargs 0) 314 (movq (@ (% args)) (% imm0)) ;lexprcount 315 (movw (% imm0.w) (% nargs)) 316 (leaq (@ x8664::nodesize (% arg_z) (% imm0)) (% imm1)) 317 (subw ($ '3) (% imm0.w)) 279 ;; * Put magic arg in x8632::nextmethodcontext (= x8632::temp0). 280 ;; * Put function in x8632::xfn ( = x8632::temp1) until we're ready to 281 ;; jump to it. 282 ;; * Set nargs to 0, then spread "args" on stack (clobbers arg_y, 283 ;; arg_z, but preserves x8632::xfn/x8632::nextmethodcontext. Note 284 ;; that nargs and imm0 are the same register on x8632. 285 ;; * Jump to the function in x8632::xfn. 286 ;; These steps are done in a mixed up order on x8632 because of 287 ;; the small number of registers. 288 (popl (@ (% :rcontext) x8632::tcr.save0)) ;save return address 289 (popl (@ (% :rcontext) x8632::tcr.save1)) ; and magic arg in the spill area 290 (movl (% function) (% xfn)) ;aka temp1 291 (movl (@ (% args)) (% imm0)) ;lexprcount 292 (movd (% imm0) (% mm0)) ;save nargs 293 (markasimm temp0) 294 (leal (@ x8632::nodesize (% arg_z) (% imm0)) (% temp0)) 295 (subl ($ '2) (% imm0)) 318 296 (jbe @regonly) 319 ;; Some args will be pushed; reserve a frame 320 (push q ($ x8664::reservedframemarker))321 (push q ($ x8664::reservedframemarker))297 ;; Some args will be pushed; reserve a frame. 298 (pushl ($ x8632::reservedframemarker)) 299 (pushl ($ x8632::reservedframemarker)) 322 300 @pushloop 323 (push q (@ ( x8664::nodesize) (% imm1)))324 (sub q ($ x8664::nodesize) (% imm1))325 (sub q ($ x8664::nodesize) (% imm0))301 (pushl (@ ( x8632::nodesize) (% temp0))) 302 (subl ($ x8632::nodesize) (% temp0)) 303 (subl ($ x8632::nodesize) (% imm0)) 326 304 (jne @pushloop) 327 @three328 (movq (@ (* x8664::nodesize 3) (% arg_z)) (% arg_x))329 305 @two 330 (mov q (@ (* x8664::nodesize 2) (% arg_z)) (% arg_y))306 (movl (@ (* x8632::nodesize 2) (% arg_z)) (% arg_y)) 331 307 @one 332 (mov q (@ (* x8664::nodesize 1) (% arg_z)) (% arg_z))308 (movl (@ (* x8632::nodesize 1) (% arg_z)) (% arg_z)) 333 309 (jmp @go) 334 310 @regonly 335 (testw (% nargs) (% nargs)) 336 (je @go) 337 (rcmpw (% nargs) ($ '2)) 338 (je @two) 339 (jb @one) 340 (jmp @three) 311 (movd (% mm0) (% imm0)) ;note that imm0 is nargs 312 (rcmp (% nargs) ($ '1)) 313 (je @one) 314 (jb @go) 315 (jmp @two) 341 316 @go 342 (push (% ra0)) 317 (markasnode temp0) 318 (movl (@ (% :rcontext) x8632::tcr.save1) (% nextmethodcontext)) ;aka temp0 319 (pushl (@ (% :rcontext) x8632::tcr.save0)) ;return address 320 (movapd (% fpzero) (@ (% :rcontext) x8632::tcr.save0)) ;clear out spill area 321 ;; magic arg in nextmethodcontext: check 322 ;; function in xfn: check 323 ;; nargs/imm0 set: check 343 324 (jmp (% xfn))) 344 325 345 (defx86lapfunction %applywithmethodcontext ((magic arg_x) 346 (function arg_y) 347 (args arg_z)) 348 ;; Somebody's called (or tailcalled) us. 349 ;; Put magic arg in x8664::nextmethodcontext (= x8664::temp0). 350 ;; Put function in x8664::xfn (= x8664::temp1). 351 ;; Set nargs to 0, then spread "args" on stack (clobbers arg_x, arg_y, arg_z, 352 ;; but preserves x8664::xfn/x8664::nextmethodcontext. 353 ;; Jump to the function in x8664::xfn. 354 (pop (% ra0)) 355 (movq (% magic) (% x8664::nextmethodcontext)) 356 (movq (% function) (% x8664::xfn)) 357 (movq (% args) (% arg_y)) ; in case of error 358 (setnargs 0) 359 (xorl (% imm0.l) (% imm0.l)) 360 (push (% imm0)) ; reserve frame (might discard 361 (push (% imm0)) ; it if nothing is passed on stack.) 326 (defx8632lapfunction %applywithmethodcontext ((magic 4) 327 #(ra 0)# 328 (function arg_y) 329 (args arg_z)) 330 ;; Similar to above. 331 (popl (@ (% :rcontext) x8632::tcr.save0)) ;save return address 332 (popl (@ (% :rcontext) x8632::tcr.save1)) ; and magic arg in the spill area 333 (movl (% args) (@ (% :rcontext) x8632::tcr.save2)) ;in case of error 334 (xorl (% imm0) (% imm0)) 335 (push (% imm0)) ;reserve frame (might discard it 336 (push (% imm0)) ;if nothing is passed on stack) 362 337 (cmpregtonil arg_z) 363 338 (je @done) 339 (markasimm temp0) 364 340 @loop 365 (extractfulltag arg_z imm1)366 (cmpb ($ x86 64::fulltagcons) (%b imm1))367 (jne @bad) 368 (%car arg_z arg_x)341 (extractfulltag arg_z temp0) 342 (cmpb ($ x8632::fulltagcons) (% temp0.b)) ;nil is a cons on x8632, but we 343 (jne @bad) ; checked for it already. 344 (%car arg_z temp1) 369 345 (%cdr arg_z arg_z) 370 ( lea (@ x8664::nodesize (% imm0)) (% imm0))346 (add ($ '1) (% imm0)) ;shorter than lea (imm0 is eax) 371 347 (cmpregtonil arg_z) 372 (push (% arg_x))348 (push (% temp1)) 373 349 (jne @loop) 350 (markasnode temp0) 374 351 @done 375 (addw (% imm0.w) (% nargs)) 352 ;; arg_y about to get clobbered; put function into xfn. 353 (movl (% function) (% xfn)) ;aka temp1 354 ;; imm0 (aka nargs) contains number of args just pushed 355 (test (% imm0) (% imm0)) 376 356 (jne @pop) 377 357 @discardandgo … … 379 359 (jmp @go) 380 360 @pop 381 (cmp w($ '1) (% nargs))361 (cmpl ($ '1) (% nargs)) 382 362 (pop (% arg_z)) 383 363 (je @discardandgo) 384 (cmp w($ '2) (% nargs))364 (cmpl ($ '2) (% nargs)) 385 365 (pop (% arg_y)) 386 366 (je @discardandgo) 387 (cmpw ($ '3) (% nargs))388 (pop (% arg_x))389 (je @discardandgo)390 367 @go 391 (push (% ra0)) 392 (jmp (% xfn)) 368 (pushl (@ (% :rcontext) x8632::tcr.save0)) ;return address 369 (movl (@ (% :rcontext) x8632::tcr.save1) (% nextmethodcontext)) ;aka temp0 370 (movapd (% fpzero) (@ (% :rcontext) x8632::tcr.save0)) ;clear out spill area 371 (jmp (% xfn)) ;aka temp1 393 372 @bad 394 (addq (% imm0) (% rsp)) 395 (movq (% arg_y) (% arg_z)) 396 (movq ($ (ash $XNOSPREAD x8664::fixnumshift)) (% arg_y)) 373 (markasnode temp0) 374 (addl (% imm0) (% esp)) 375 (movl (@ (% :rcontext) x8632::tcr.save1) (% arg_z)) ;saved args 376 (movapd (% fpzero) (@ (% :rcontext) x8632::tcr.save0)) ;clear out spill area 377 (movl ($ '#.$XNOSPREAD) (% arg_y)) 397 378 (setnargs 2) 398 379 (jmpsubprim .SPksignalerr)) 399 400 380 401 381 ;;; The idea here is to call METHOD in the same stack frame in … … 404 384 ;;; must have been tailcalled, and the frame built on lexpr 405 385 ;;; entry must be in %rbp. 406 (defx86 lapfunction %applylexprtailwise ((method arg_y) (args arg_z))407 (add q ($ x8664::nodesize) (% rsp)) ; discard extra return address408 (mov q (% method) (% xfn))409 (mov q (% args) (% rsp))410 (pop (%q nargs))411 (mov q (@ x8664::lispframe.returnaddress (% rbp)) (% ra0))412 (mov q (@ 0 (% rbp)) (% rbp))413 (rcmpw (% nargs) ($ ' 3))386 (defx8632lapfunction %applylexprtailwise ((method arg_y) (args arg_z)) 387 (addl ($ x8632::nodesize) (% esp)) ; discard extra return address 388 (movl (% method) (% xfn)) ;temp1 389 (movl (% args) (% esp)) 390 (popl (% imm0)) ;nargs 391 (movl (@ x8632::lispframe.returnaddress (% ebp)) (% temp0)) 392 (movl (@ 0 (% ebp)) (% ebp)) 393 (rcmpw (% nargs) ($ '2)) 414 394 (jbe @popregs) 415 ;; More than 3args; some must have been pushed by caller,395 ;; More than 2 args; some must have been pushed by caller, 416 396 ;; so retain the reserved frame. 417 397 (pop (% arg_z)) 418 398 (pop (% arg_y)) 419 (pop (% arg_x))420 399 (jmp @popped) 421 400 @popregs 422 (je @pop3)423 401 (rcmpw (% nargs) ($ '1)) 424 402 (jb @discard) 425 403 (ja @pop2) 426 404 (pop (% arg_z)) 427 (jmp @discard)428 @pop3429 (pop (% arg_z))430 (pop (% arg_y))431 (pop (% arg_x))432 405 (jmp @discard) 433 406 @pop2 … … 437 410 (discardreservedframe) 438 411 @popped 439 (push (% ra0))412 (push (% temp0)) ;return address 440 413 (jmp (% xfn))) 441 414 442 443 415 (defun closurefunction (fun) 416 (while (and (functionp fun) (not (compiledfunctionp fun))) 417 (setq fun (%nthimmediate fun 0)) 418 (when (vectorp fun) 419 (setq fun (svref fun 0)))) 420 fun) 444 421 445 422 ;;; For use by (setf (apply ...) ...) … … 450 427 (:arglist (function arg1 arg2 &rest otherargs)) 451 428 (checknargs 3 nil) 452 (cmpw ($ '3) (% nargs)) 453 (pop (% ra0)) 454 (ja @noframe) 455 (pushq ($ x8664::reservedframemarker)) 456 (pushq ($ x8664::reservedframemarker)) 457 @noframe 458 (push (% arg_x)) 459 (movq (% arg_z) (% temp0)) ; last 460 (movq (% arg_y) (% arg_z)) ; butlast 429 (popl (@ (% :rcontext) x8632::tcr.save0)) ;save return address 430 ;; only two arg regs on x8632, so the caller will always push a frame 431 (movl (% arg_z) (% temp0)) ; last 432 (movl (% arg_y) (% arg_z)) ; butlast 461 433 (subw ($ '2) (% nargs)) ; remove count for butlast & last 434 (movd (% imm0) (% mm0)) ;save nargs (aka imm0) for later 462 435 ;; Do .SPspreadargz inline here 463 436 (xorl (%l imm0) (%l imm0)) 464 (mov q (% arg_z) (% arg_y)); save in case of error437 (movl (% arg_z) (@ (% :rcontext) x8632::tcr.save1)) ; save in case of error 465 438 (cmpregtonil arg_z) 466 439 (je @done) 440 (markasimm temp1) 467 441 @loop 468 (extractfulltag arg_z imm1)469 (cmpb ($ x8664::fulltagcons) (%b imm1))442 (extractfulltag arg_z temp1) 443 (cmpb ($ x8664::fulltagcons) (%b temp1)) 470 444 (jne @bad) 471 (%car arg_z arg_ x)445 (%car arg_z arg_y) 472 446 (%cdr arg_z arg_z) 473 447 (addl ($ '1) (%l imm0)) 474 448 (cmpregtonil arg_z) 475 (push (% arg_ x))449 (push (% arg_y)) 476 450 (jne @loop) 451 (markasnode temp1) 477 452 @done 478 453 ;; nargs was at least 1 when we started spreading, and can't have gotten 479 454 ;; any smaller. 480 (addw (%w imm0) (% nargs)) 481 (movq (% temp0) (% arg_z)) 455 (movd (% mm0) (% arg_y)) ;nargs from before loop 456 (addl (% arg_y) (% imm0)) ;did I mention nargs is imm0? 457 (movl (% temp0) (% arg_z)) 482 458 (pop (% arg_y)) 483 (pop (% arg_x))484 459 (addw ($ '1) (% nargs)) 485 (cmpw ($ '3) (% nargs))486 (jne @nodiscard)487 (discardreservedframe)488 @nodiscard489 460 (loadconstant funcall temp0) 490 (push (% ra0)) 461 (pushl (@ (% :rcontext) x8632::tcr.save0)) ;return address 462 (movapd (% fpzero) (@ (% :rcontext) x8632::tcr.save0)) ;clear out spill area 491 463 (jmpsubprim .SPfuncall) 492 464 @bad ; error spreading list. 493 (add (% imm0) (% rsp)) ; discard whatever's been pushed 494 (movq (% arg_y) (% arg_z)) 495 (movl ($ '#.$XNOSPREAD) (%l arg_y)) 465 (markasnode temp1) 466 (add (% imm0) (% esp)) ; discard whatever's been pushed 467 (movl (@ (% :rcontext) x8632::tcr.save1) (% arg_z)) 468 (movl ($ '#.$XNOSPREAD) (% arg_y)) 496 469 (setnargs 2) 497 470 (jmpsubprim .SPksignalerr) )) … … 505 478 ;;; (c) reestablish the same foreign stack frame and store the result regs 506 479 ;;; (%rax/%xmm0) there 480 #+notyet 507 481 (defx86lapfunction %doffcall ((nfp 0) (frame arg_x) (fpregs arg_y) (entry arg_z)) 508 482 (popq (% ra0)) … … 531 505 (singlevaluereturn)) 532 506 533 507 #+notyet 534 508 (defun %ffcall (entry &rest specsandvals) 535 509 (declare (dynamicextent specsandvals))
Note: See TracChangeset
for help on using the changeset viewer.