1;;;; the VM definition arithmetic VOPs for the Alpha 2 3;;;; This software is part of the SBCL system. See the README file for 4;;;; more information. 5;;;; 6;;;; This software is derived from the CMU CL system, which was 7;;;; written at Carnegie Mellon University and released into the 8;;;; public domain. The software is in the public domain and is 9;;;; provided with absolutely no warranty. See the COPYING and CREDITS 10;;;; files for more information. 11 12(in-package "SB!VM") 13 14;;;; unary operations 15 16(define-vop (fixnum-unop) 17 (:args (x :scs (any-reg))) 18 (:results (res :scs (any-reg))) 19 (:note "inline fixnum arithmetic") 20 (:arg-types tagged-num) 21 (:result-types tagged-num) 22 (:policy :fast-safe)) 23 24(define-vop (signed-unop) 25 (:args (x :scs (signed-reg))) 26 (:results (res :scs (signed-reg))) 27 (:note "inline (signed-byte 64) arithmetic") 28 (:arg-types signed-num) 29 (:result-types signed-num) 30 (:policy :fast-safe)) 31 32(define-vop (fast-negate/fixnum fixnum-unop) 33 (:translate %negate) 34 (:generator 1 35 (inst subq zero-tn x res))) 36 37(define-vop (fast-negate/signed signed-unop) 38 (:translate %negate) 39 (:generator 2 40 (inst subq zero-tn x res))) 41 42(define-vop (fast-lognot/fixnum fixnum-unop) 43 (:translate lognot) 44 (:generator 1 45 (inst eqv x fixnum-tag-mask res))) 46 47(define-vop (fast-lognot/signed signed-unop) 48 (:translate lognot) 49 (:generator 2 50 (inst not x res))) 51 52;;;; binary fixnum operations 53 54;;; Assume that any constant operand is the second arg... 55 56(define-vop (fast-fixnum-binop) 57 (:args (x :target r :scs (any-reg)) 58 (y :target r :scs (any-reg))) 59 (:arg-types tagged-num tagged-num) 60 (:results (r :scs (any-reg))) 61 (:result-types tagged-num) 62 (:note "inline fixnum arithmetic") 63 (:effects) 64 (:affected) 65 (:policy :fast-safe)) 66 67(define-vop (fast-unsigned-binop) 68 (:args (x :target r :scs (unsigned-reg)) 69 (y :target r :scs (unsigned-reg))) 70 (:arg-types unsigned-num unsigned-num) 71 (:results (r :scs (unsigned-reg))) 72 (:result-types unsigned-num) 73 (:note "inline (unsigned-byte 64) arithmetic") 74 (:effects) 75 (:affected) 76 (:policy :fast-safe)) 77 78(define-vop (fast-signed-binop) 79 (:args (x :target r :scs (signed-reg)) 80 (y :target r :scs (signed-reg))) 81 (:arg-types signed-num signed-num) 82 (:results (r :scs (signed-reg))) 83 (:result-types signed-num) 84 (:note "inline (signed-byte 64) arithmetic") 85 (:effects) 86 (:affected) 87 (:policy :fast-safe)) 88 89(define-vop (fast-fixnum-c-binop fast-fixnum-binop) 90 (:args (x :target r :scs (any-reg))) 91 (:info y) 92 (:arg-types tagged-num (:constant integer))) 93 94(define-vop (fast-signed-c-binop fast-signed-binop) 95 (:args (x :target r :scs (signed-reg))) 96 (:info y) 97 (:arg-types signed-num (:constant integer))) 98 99(define-vop (fast-unsigned-c-binop fast-unsigned-binop) 100 (:args (x :target r :scs (unsigned-reg))) 101 (:info y) 102 (:arg-types unsigned-num (:constant integer))) 103 104(defmacro define-binop (translate cost untagged-cost op 105 tagged-type untagged-type 106 &optional arg-swap restore-fixnum-mask) 107 `(progn 108 (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM") 109 fast-fixnum-binop) 110 ,@(when restore-fixnum-mask 111 `((:temporary (:sc non-descriptor-reg) temp))) 112 (:args (x ,@(unless restore-fixnum-mask `(:target r)) :scs (any-reg)) 113 (y ,@(unless restore-fixnum-mask `(:target r)) :scs (any-reg))) 114 (:translate ,translate) 115 (:generator ,(1+ cost) 116 ,(if arg-swap 117 `(inst ,op y x ,(if restore-fixnum-mask 'temp 'r)) 118 `(inst ,op x y ,(if restore-fixnum-mask 'temp 'r))) 119 ,@(when restore-fixnum-mask 120 `((inst bic temp #.(ash lowtag-mask -1) r))))) 121 (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED") 122 fast-signed-binop) 123 (:args (x :target r :scs (signed-reg)) 124 (y :target r :scs (signed-reg))) 125 (:translate ,translate) 126 (:generator ,(1+ untagged-cost) 127 ,(if arg-swap 128 `(inst ,op y x r) 129 `(inst ,op x y r)))) 130 (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED") 131 fast-unsigned-binop) 132 (:args (x :target r :scs (unsigned-reg)) 133 (y :target r :scs (unsigned-reg))) 134 (:translate ,translate) 135 (:generator ,(1+ untagged-cost) 136 ,(if arg-swap 137 `(inst ,op y x r) 138 `(inst ,op x y r)))) 139 ,@(when (and tagged-type (not arg-swap)) 140 `((define-vop (,(symbolicate "FAST-" translate "-C/FIXNUM=>FIXNUM") 141 fast-fixnum-c-binop) 142 (:args (x ,@(unless restore-fixnum-mask `(:target r)) 143 :scs (any-reg))) 144 (:arg-types tagged-num (:constant ,tagged-type)) 145 ,@(when restore-fixnum-mask 146 `((:temporary (:sc non-descriptor-reg) temp))) 147 (:translate ,translate) 148 (:generator ,cost 149 (inst ,op x (fixnumize y) ,(if restore-fixnum-mask 'temp 'r)) 150 ,@(when restore-fixnum-mask 151 `((inst bic temp #.(ash lowtag-mask -1) r))))))) 152 ,@(when (and untagged-type (not arg-swap)) 153 `((define-vop (,(symbolicate "FAST-" translate "-C/SIGNED=>SIGNED") 154 fast-signed-c-binop) 155 (:arg-types signed-num (:constant ,untagged-type)) 156 (:translate ,translate) 157 (:generator ,untagged-cost 158 (inst ,op x y r))) 159 (define-vop (,(symbolicate "FAST-" translate 160 "-C/UNSIGNED=>UNSIGNED") 161 fast-unsigned-c-binop) 162 (:arg-types unsigned-num (:constant ,untagged-type)) 163 (:translate ,translate) 164 (:generator ,untagged-cost 165 (inst ,op x y r))))))) 166 167(define-binop + 1 5 addq (unsigned-byte 6) (unsigned-byte 8)) 168(define-binop - 1 5 subq (unsigned-byte 6) (unsigned-byte 8)) 169(define-binop logand 1 3 and (unsigned-byte 6) (unsigned-byte 8)) 170(define-binop logandc1 1 3 bic (unsigned-byte 6) (unsigned-byte 8) t) 171(define-binop logandc2 1 3 bic (unsigned-byte 6) (unsigned-byte 8)) 172(define-binop logior 1 3 bis (unsigned-byte 6) (unsigned-byte 8)) 173(define-binop logorc1 1 3 ornot (unsigned-byte 6) (unsigned-byte 8) t t) 174(define-binop logorc2 1 3 ornot (unsigned-byte 6) (unsigned-byte 8) nil t) 175(define-binop logxor 1 3 xor (unsigned-byte 6) (unsigned-byte 8)) 176(define-binop logeqv 1 3 eqv (unsigned-byte 6) (unsigned-byte 8) nil t) 177 178;;; special cases for LOGAND where we can use a mask operation 179(define-vop (fast-logand-c-mask/unsigned=>unsigned fast-unsigned-c-binop) 180 (:translate logand) 181 (:arg-types unsigned-num 182 (:constant (or (integer #xffffffff #xffffffff) 183 (integer #xffffffff00000000 #xffffffff00000000)))) 184 (:generator 1 185 (ecase y 186 (#xffffffff (inst mskll x 4 r)) 187 (#xffffffff00000000 (inst mskll x 0 r))))) 188 189;;;; shifting 190 191(define-vop (fast-ash/unsigned=>unsigned) 192 (:note "inline ASH") 193 (:args (number :scs (unsigned-reg) :to :save) 194 (amount :scs (signed-reg))) 195 (:arg-types unsigned-num signed-num) 196 (:results (result :scs (unsigned-reg))) 197 (:result-types unsigned-num) 198 (:translate ash) 199 (:policy :fast-safe) 200 (:temporary (:sc non-descriptor-reg) ndesc) 201 (:temporary (:sc non-descriptor-reg) temp) 202 (:generator 3 203 (inst bge amount positive) 204 (inst subq zero-tn amount ndesc) 205 (inst cmplt ndesc 64 temp) 206 (inst srl number ndesc result) 207 ;; FIXME: this looks like a candidate for a conditional move -- 208 ;; CSR, 2003-09-10 209 (inst bne temp done) 210 (move zero-tn result) 211 (inst br zero-tn done) 212 213 POSITIVE 214 (inst sll number amount result) 215 216 DONE)) 217 218(define-vop (fast-ash/signed=>signed) 219 (:note "inline ASH") 220 (:args (number :scs (signed-reg) :to :save) 221 (amount :scs (signed-reg))) 222 (:arg-types signed-num signed-num) 223 (:results (result :scs (signed-reg))) 224 (:result-types signed-num) 225 (:translate ash) 226 (:policy :fast-safe) 227 (:temporary (:sc non-descriptor-reg) ndesc) 228 (:temporary (:sc non-descriptor-reg) temp) 229 (:generator 3 230 (inst bge amount positive) 231 (inst subq zero-tn amount ndesc) 232 (inst cmplt ndesc 63 temp) 233 (inst sra number ndesc result) 234 (inst bne temp done) 235 (inst sra number 63 result) 236 (inst br zero-tn done) 237 238 POSITIVE 239 (inst sll number amount result) 240 241 DONE)) 242 243(define-vop (fast-ash-c/signed=>signed) 244 (:policy :fast-safe) 245 (:translate ash) 246 (:note nil) 247 (:args (number :scs (signed-reg))) 248 (:info count) 249 (:arg-types signed-num (:constant integer)) 250 (:results (result :scs (signed-reg))) 251 (:result-types signed-num) 252 (:generator 1 253 (cond 254 ((< count 0) (inst sra number (min 63 (- count)) result)) 255 ((> count 0) (inst sll number (min 63 count) result)) 256 (t (bug "identity ASH not transformed away"))))) 257 258(define-vop (fast-ash-c/unsigned=>unsigned) 259 (:policy :fast-safe) 260 (:translate ash) 261 (:note nil) 262 (:args (number :scs (unsigned-reg))) 263 (:info count) 264 (:arg-types unsigned-num (:constant integer)) 265 (:results (result :scs (unsigned-reg))) 266 (:result-types unsigned-num) 267 (:generator 1 268 (cond 269 ((< count -63) (move zero-tn result)) 270 ((< count 0) (inst sra number (- count) result)) 271 ((> count 0) (inst sll number (min 63 count) result)) 272 (t (bug "identity ASH not transformed away"))))) 273 274(macrolet ((def (name sc-type type result-type cost) 275 `(define-vop (,name) 276 (:note "inline ASH") 277 (:translate ash) 278 (:args (number :scs (,sc-type)) 279 (amount :scs (signed-reg unsigned-reg immediate))) 280 (:arg-types ,type positive-fixnum) 281 (:results (result :scs (,result-type))) 282 (:result-types ,type) 283 (:policy :fast-safe) 284 (:generator ,cost 285 (sc-case amount 286 ((signed-reg unsigned-reg) 287 (inst sll number amount result)) 288 (immediate 289 (let ((amount (tn-value amount))) 290 (aver (> amount 0)) 291 (inst sll number amount result)))))))) 292 (def fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2) 293 (def fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3) 294 (def fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3)) 295 296(define-vop (signed-byte-64-len) 297 (:translate integer-length) 298 (:note "inline (signed-byte 64) integer-length") 299 (:policy :fast-safe) 300 (:args (arg :scs (signed-reg) :to (:argument 1))) 301 (:arg-types signed-num) 302 (:results (res :scs (any-reg))) 303 (:result-types positive-fixnum) 304 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift) 305 (:generator 30 306 (inst not arg shift) 307 (inst cmovge arg arg shift) 308 (inst subq zero-tn (fixnumize 1) res) 309 (inst sll shift 1 shift) 310 LOOP 311 (inst addq res (fixnumize 1) res) 312 (inst srl shift 1 shift) 313 (inst bne shift loop))) 314 315(define-vop (unsigned-byte-64-count) 316 (:translate logcount) 317 (:note "inline (unsigned-byte 64) logcount") 318 (:policy :fast-safe) 319 (:args (arg :scs (unsigned-reg))) 320 (:arg-types unsigned-num) 321 (:results (res :scs (unsigned-reg))) 322 (:result-types positive-fixnum) 323 (:guard (member :cix *backend-subfeatures*)) 324 (:generator 1 325 (inst ctpop zero-tn arg res))) 326 327(define-vop (unsigned-byte-64-count) 328 (:translate logcount) 329 (:note "inline (unsigned-byte 64) logcount") 330 (:policy :fast-safe) 331 (:args (arg :scs (unsigned-reg) :target num)) 332 (:arg-types unsigned-num) 333 (:results (res :scs (unsigned-reg))) 334 (:result-types positive-fixnum) 335 (:temporary (:scs (non-descriptor-reg) :from (:argument 0) :to (:result 0) 336 :target res) num) 337 (:temporary (:scs (non-descriptor-reg)) mask temp) 338 (:generator 60 339 ;; FIXME: now this looks expensive, what with these 64bit loads. 340 ;; Maybe a loop and count would be faster? -- CSR, 2003-09-10 341 (inst li #x5555555555555555 mask) 342 (inst srl arg 1 temp) 343 (inst and arg mask num) 344 (inst and temp mask temp) 345 (inst addq num temp num) 346 (inst li #x3333333333333333 mask) 347 (inst srl num 2 temp) 348 (inst and num mask num) 349 (inst and temp mask temp) 350 (inst addq num temp num) 351 (inst li #x0f0f0f0f0f0f0f0f mask) 352 (inst srl num 4 temp) 353 (inst and num mask num) 354 (inst and temp mask temp) 355 (inst addq num temp num) 356 (inst li #x00ff00ff00ff00ff mask) 357 (inst srl num 8 temp) 358 (inst and num mask num) 359 (inst and temp mask temp) 360 (inst addq num temp num) 361 (inst li #x0000ffff0000ffff mask) 362 (inst srl num 16 temp) 363 (inst and num mask num) 364 (inst and temp mask temp) 365 (inst addq num temp num) 366 (inst li #x00000000ffffffff mask) 367 (inst srl num 32 temp) 368 (inst and num mask num) 369 (inst and temp mask temp) 370 (inst addq num temp res))) 371 372;;;; multiplying 373 374(define-vop (fast-*/fixnum=>fixnum fast-fixnum-binop) 375 (:temporary (:scs (non-descriptor-reg)) temp) 376 (:translate *) 377 (:generator 4 378 (inst sra y n-fixnum-tag-bits temp) 379 (inst mulq x temp r))) 380 381(define-vop (fast-*/signed=>signed fast-signed-binop) 382 (:translate *) 383 (:generator 3 384 (inst mulq x y r))) 385 386(define-vop (fast-*/unsigned=>unsigned fast-unsigned-binop) 387 (:translate *) 388 (:generator 3 389 (inst mulq x y r))) 390 391;;;; Modular functions: 392(define-modular-fun lognot-mod64 (x) lognot :untagged nil 64) 393(define-vop (lognot-mod64/unsigned=>unsigned) 394 (:translate lognot-mod64) 395 (:args (x :scs (unsigned-reg))) 396 (:arg-types unsigned-num) 397 (:results (res :scs (unsigned-reg))) 398 (:result-types unsigned-num) 399 (:policy :fast-safe) 400 (:generator 1 401 (inst not x res))) 402 403(define-vop (fast-ash-left-mod64-c/unsigned=>unsigned 404 fast-ash-c/unsigned=>unsigned) 405 (:translate ash-left-mod64)) 406(define-vop (fast-ash-left-mod64/unsigned=>unsigned 407 fast-ash-left/unsigned=>unsigned)) 408(deftransform ash-left-mod64 ((integer count) 409 ((unsigned-byte 64) (unsigned-byte 6))) 410 (when (sb!c::constant-lvar-p count) 411 (sb!c::give-up-ir1-transform)) 412 '(%primitive fast-ash-left-mod64/unsigned=>unsigned integer count)) 413 414(macrolet 415 ((define-modular-backend (fun &optional constantp) 416 (let ((mfun-name (symbolicate fun '-mod64)) 417 (modvop (symbolicate 'fast- fun '-mod64/unsigned=>unsigned)) 418 (modcvop (symbolicate 'fast- fun '-mod64-c/unsigned=>unsigned)) 419 (vop (symbolicate 'fast- fun '/unsigned=>unsigned)) 420 (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned))) 421 `(progn 422 (define-modular-fun ,mfun-name (x y) ,fun :untagged nil 64) 423 (define-vop (,modvop ,vop) 424 (:translate ,mfun-name)) 425 ,@(when constantp 426 `((define-vop (,modcvop ,cvop) 427 (:translate ,mfun-name)))))))) 428 (define-modular-backend + t) 429 (define-modular-backend - t) 430 (define-modular-backend logeqv t) 431 (define-modular-backend logandc1) 432 (define-modular-backend logandc2 t) 433 (define-modular-backend logorc1) 434 (define-modular-backend logorc2 t)) 435 436(define-source-transform lognand (x y) 437 `(lognot (logand ,x ,y))) 438(define-source-transform lognor (x y) 439 `(lognot (logior ,x ,y))) 440 441;;;; binary conditional VOPs 442 443(define-vop (fast-conditional) 444 (:conditional) 445 (:info target not-p) 446 (:effects) 447 (:affected) 448 (:temporary (:scs (non-descriptor-reg)) temp) 449 (:policy :fast-safe)) 450 451(define-vop (fast-conditional/fixnum fast-conditional) 452 (:args (x :scs (any-reg)) 453 (y :scs (any-reg))) 454 (:arg-types tagged-num tagged-num) 455 (:note "inline fixnum comparison")) 456 457(define-vop (fast-conditional-c/fixnum fast-conditional/fixnum) 458 (:args (x :scs (any-reg))) 459 (:arg-types tagged-num (:constant (unsigned-byte-with-a-bite-out 6 4))) 460 (:info target not-p y)) 461 462(define-vop (fast-conditional/signed fast-conditional) 463 (:args (x :scs (signed-reg)) 464 (y :scs (signed-reg))) 465 (:arg-types signed-num signed-num) 466 (:note "inline (signed-byte 64) comparison")) 467 468(define-vop (fast-conditional-c/signed fast-conditional/signed) 469 (:args (x :scs (signed-reg))) 470 (:arg-types signed-num (:constant (unsigned-byte-with-a-bite-out 8 1))) 471 (:info target not-p y)) 472 473(define-vop (fast-conditional/unsigned fast-conditional) 474 (:args (x :scs (unsigned-reg)) 475 (y :scs (unsigned-reg))) 476 (:arg-types unsigned-num unsigned-num) 477 (:note "inline (unsigned-byte 64) comparison")) 478 479(define-vop (fast-conditional-c/unsigned fast-conditional/unsigned) 480 (:args (x :scs (unsigned-reg))) 481 (:arg-types unsigned-num (:constant (unsigned-byte-with-a-bite-out 8 1))) 482 (:info target not-p y)) 483 484 485(defmacro define-conditional-vop (translate &rest generator) 486 `(progn 487 ,@(mapcar (lambda (suffix cost signed) 488 (unless (and (member suffix '(/fixnum -c/fixnum)) 489 (eq translate 'eql)) 490 `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)" 491 translate suffix)) 492 ,(intern 493 (format nil "~:@(FAST-CONDITIONAL~A~)" 494 suffix))) 495 (:translate ,translate) 496 (:generator ,cost 497 (let* ((signed ,signed) 498 (-c/fixnum ,(eq suffix '-c/fixnum)) 499 (y (if -c/fixnum (fixnumize y) y))) 500 ,@generator))))) 501 '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned) 502 '(3 2 5 4 5 4) 503 '(t t t t nil nil)))) 504 505(define-conditional-vop < 506 (cond ((and signed (eql y 0)) 507 (if not-p 508 (inst bge x target) 509 (inst blt x target))) 510 (t 511 (if signed 512 (inst cmplt x y temp) 513 (inst cmpult x y temp)) 514 (if not-p 515 (inst beq temp target) 516 (inst bne temp target))))) 517 518(define-conditional-vop > 519 (cond ((and signed (eql y 0)) 520 (if not-p 521 (inst ble x target) 522 (inst bgt x target))) 523 ((integerp y) 524 (let ((y (+ y (if -c/fixnum (fixnumize 1) 1)))) 525 (if signed 526 (inst cmplt x y temp) 527 (inst cmpult x y temp)) 528 (if not-p 529 (inst bne temp target) 530 (inst beq temp target)))) 531 (t 532 (if signed 533 (inst cmplt y x temp) 534 (inst cmpult y x temp)) 535 (if not-p 536 (inst beq temp target) 537 (inst bne temp target))))) 538 539;;; EQL/FIXNUM is funny because the first arg can be of any type, not 540;;; just a known fixnum. 541 542(define-conditional-vop eql 543 (declare (ignore signed)) 544 (when (integerp y) 545 (inst li y temp) 546 (setf y temp)) 547 (inst cmpeq x y temp) 548 (if not-p 549 (inst beq temp target) 550 (inst bne temp target))) 551 552;;; These versions specify a fixnum restriction on their first arg. We 553;;; have also generic-eql/fixnum VOPs which are the same, but have no 554;;; restriction on the first arg and a higher cost. The reason for 555;;; doing this is to prevent fixnum specific operations from being 556;;; used on word integers, spuriously consing the argument. 557(define-vop (fast-eql/fixnum fast-conditional) 558 (:args (x :scs (any-reg)) 559 (y :scs (any-reg))) 560 (:arg-types tagged-num tagged-num) 561 (:note "inline fixnum comparison") 562 (:translate eql) 563 (:generator 3 564 (cond ((equal y zero-tn) 565 (if not-p 566 (inst bne x target) 567 (inst beq x target))) 568 (t 569 (inst cmpeq x y temp) 570 (if not-p 571 (inst beq temp target) 572 (inst bne temp target)))))) 573 574;;; 575(define-vop (generic-eql/fixnum fast-eql/fixnum) 576 (:args (x :scs (any-reg descriptor-reg)) 577 (y :scs (any-reg))) 578 (:arg-types * tagged-num) 579 (:variant-cost 7)) 580 581(define-vop (fast-eql-c/fixnum fast-conditional/fixnum) 582 (:args (x :scs (any-reg))) 583 (:arg-types tagged-num (:constant (signed-byte 6))) 584 (:temporary (:scs (non-descriptor-reg)) temp) 585 (:info target not-p y) 586 (:translate eql) 587 (:generator 2 588 (let ((y (cond ((eql y 0) zero-tn) 589 (t 590 (inst li (fixnumize y) temp) 591 temp)))) 592 (inst cmpeq x y temp) 593 (if not-p 594 (inst beq temp target) 595 (inst bne temp target))))) 596;;; 597(define-vop (generic-eql-c/fixnum fast-eql-c/fixnum) 598 (:args (x :scs (any-reg descriptor-reg))) 599 (:arg-types * (:constant (signed-byte 6))) 600 (:variant-cost 6)) 601 602 603;;;; 32-bit logical operations 604 605(define-vop (shift-towards-someplace) 606 (:policy :fast-safe) 607 (:args (num :scs (unsigned-reg)) 608 (amount :scs (signed-reg))) 609 (:arg-types unsigned-num tagged-num) 610 (:results (r :scs (unsigned-reg))) 611 (:result-types unsigned-num)) 612 613(define-vop (shift-towards-start shift-towards-someplace) 614 (:translate shift-towards-start) 615 (:note "SHIFT-TOWARDS-START") 616 (:temporary (:sc non-descriptor-reg) temp) 617 (:generator 1 618 (inst and amount #x1f temp) 619 (inst srl num temp r))) 620 621(define-vop (shift-towards-end shift-towards-someplace) 622 (:translate shift-towards-end) 623 (:note "SHIFT-TOWARDS-END") 624 (:temporary (:sc non-descriptor-reg) temp) 625 (:generator 1 626 (inst and amount #x1f temp) 627 (inst sll num temp r))) 628 629;;;; bignum stuff 630 631(define-vop (bignum-length get-header-data) 632 (:translate sb!bignum:%bignum-length) 633 (:policy :fast-safe)) 634 635(define-vop (bignum-set-length set-header-data) 636 (:translate sb!bignum:%bignum-set-length) 637 (:policy :fast-safe)) 638 639(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag 640 (unsigned-reg) unsigned-num sb!bignum:%bignum-ref) 641 642(define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag 643 (unsigned-reg) unsigned-num sb!bignum:%bignum-set #!+gengc nil) 644 645(define-vop (digit-0-or-plus) 646 (:translate sb!bignum:%digit-0-or-plusp) 647 (:policy :fast-safe) 648 (:args (digit :scs (unsigned-reg))) 649 (:arg-types unsigned-num) 650 (:temporary (:sc non-descriptor-reg) temp) 651 (:conditional) 652 (:info target not-p) 653 (:generator 2 654 (inst sll digit 32 temp) 655 (if not-p 656 (inst blt temp target) 657 (inst bge temp target)))) 658 659(define-vop (add-w/carry) 660 (:translate sb!bignum:%add-with-carry) 661 (:policy :fast-safe) 662 (:args (a :scs (unsigned-reg)) 663 (b :scs (unsigned-reg)) 664 (c :scs (unsigned-reg))) 665 (:arg-types unsigned-num unsigned-num positive-fixnum) 666 (:results (result :scs (unsigned-reg) :from :load) 667 (carry :scs (unsigned-reg) :from :eval)) 668 (:result-types unsigned-num positive-fixnum) 669 (:generator 5 670 (inst addq a b result) 671 (inst addq result c result) 672 (inst sra result 32 carry) 673 (inst mskll result 4 result))) 674 675(define-vop (sub-w/borrow) 676 (:translate sb!bignum:%subtract-with-borrow) 677 (:policy :fast-safe) 678 (:args (a :scs (unsigned-reg)) 679 (b :scs (unsigned-reg)) 680 (c :scs (unsigned-reg))) 681 (:arg-types unsigned-num unsigned-num positive-fixnum) 682 (:results (result :scs (unsigned-reg) :from :load) 683 (borrow :scs (unsigned-reg) :from :eval)) 684 (:result-types unsigned-num positive-fixnum) 685 (:generator 4 686 (inst xor c 1 result) 687 (inst subq a result result) 688 (inst subq result b result) 689 (inst srl result 63 borrow) 690 (inst xor borrow 1 borrow) 691 (inst mskll result 4 result))) 692 693(define-vop (bignum-mult-and-add-3-arg) 694 (:translate sb!bignum:%multiply-and-add) 695 (:policy :fast-safe) 696 (:args (x :scs (unsigned-reg)) 697 (y :scs (unsigned-reg)) 698 (carry-in :scs (unsigned-reg) :to :save)) 699 (:arg-types unsigned-num unsigned-num unsigned-num) 700 (:results (hi :scs (unsigned-reg)) 701 (lo :scs (unsigned-reg))) 702 (:result-types unsigned-num unsigned-num) 703 (:generator 6 704 (inst mulq x y lo) 705 (inst addq lo carry-in lo) 706 (inst srl lo 32 hi) 707 (inst mskll lo 4 lo))) 708 709 710(define-vop (bignum-mult-and-add-4-arg) 711 (:translate sb!bignum:%multiply-and-add) 712 (:policy :fast-safe) 713 (:args (x :scs (unsigned-reg)) 714 (y :scs (unsigned-reg)) 715 (prev :scs (unsigned-reg)) 716 (carry-in :scs (unsigned-reg) :to :save)) 717 (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num) 718 (:results (hi :scs (unsigned-reg)) 719 (lo :scs (unsigned-reg))) 720 (:result-types unsigned-num unsigned-num) 721 (:generator 9 722 (inst mulq x y lo) 723 (inst addq lo prev lo) 724 (inst addq lo carry-in lo) 725 (inst srl lo 32 hi) 726 (inst mskll lo 4 lo))) 727 728(define-vop (bignum-mult) 729 (:translate sb!bignum:%multiply) 730 (:policy :fast-safe) 731 (:args (x :scs (unsigned-reg)) 732 (y :scs (unsigned-reg))) 733 (:arg-types unsigned-num unsigned-num) 734 (:results (hi :scs (unsigned-reg)) 735 (lo :scs (unsigned-reg))) 736 (:result-types unsigned-num unsigned-num) 737 (:generator 3 738 (inst mulq x y lo) 739 (inst srl lo 32 hi) 740 (inst mskll lo 4 lo))) 741 742(define-vop (bignum-lognot) 743 (:translate sb!bignum:%lognot) 744 (:policy :fast-safe) 745 (:args (x :scs (unsigned-reg))) 746 (:arg-types unsigned-num) 747 (:results (r :scs (unsigned-reg))) 748 (:result-types unsigned-num) 749 (:generator 1 750 (inst not x r) 751 (inst mskll r 4 r))) 752 753(define-vop (fixnum-to-digit) 754 (:translate sb!bignum:%fixnum-to-digit) 755 (:policy :fast-safe) 756 (:args (fixnum :scs (any-reg))) 757 (:arg-types tagged-num) 758 (:results (digit :scs (unsigned-reg))) 759 (:result-types unsigned-num) 760 (:generator 1 761 (inst sra fixnum n-fixnum-tag-bits digit))) 762 763(define-vop (bignum-floor) 764 (:translate sb!bignum:%bigfloor) 765 (:policy :fast-safe) 766 (:args (num-high :scs (unsigned-reg)) 767 (num-low :scs (unsigned-reg)) 768 (denom-arg :scs (unsigned-reg) :target denom)) 769 (:arg-types unsigned-num unsigned-num unsigned-num) 770 (:temporary (:scs (unsigned-reg) :from (:argument 2)) denom) 771 (:temporary (:scs (unsigned-reg) :from (:eval 0)) temp) 772 (:results (quo :scs (unsigned-reg) :from (:eval 0)) 773 (rem :scs (unsigned-reg) :from (:argument 0))) 774 (:result-types unsigned-num unsigned-num) 775 (:generator 325 ; number of inst assuming targeting works. 776 (inst sll num-high 32 rem) 777 (inst bis rem num-low rem) 778 (inst sll denom-arg 32 denom) 779 (inst cmpule denom rem quo) 780 (inst beq quo shift1) 781 (inst subq rem denom rem) 782 SHIFT1 783 (dotimes (i 32) 784 (let ((shift2 (gen-label))) 785 (inst srl denom 1 denom) 786 (inst cmpule denom rem temp) 787 (inst sll quo 1 quo) 788 (inst beq temp shift2) 789 (inst subq rem denom rem) 790 (inst bis quo 1 quo) 791 (emit-label shift2))))) 792 793(define-vop (signify-digit) 794 (:translate sb!bignum:%fixnum-digit-with-correct-sign) 795 (:policy :fast-safe) 796 (:args (digit :scs (unsigned-reg) :target res)) 797 (:arg-types unsigned-num) 798 (:results (res :scs (any-reg signed-reg))) 799 (:result-types signed-num) 800 (:generator 2 801 (sc-case res 802 (any-reg 803 (inst sll digit 34 res) 804 (inst sra res 32 res)) 805 (signed-reg 806 (inst sll digit 32 res) 807 (inst sra res 32 res))))) 808 809 810(define-vop (digit-ashr) 811 (:translate sb!bignum:%ashr) 812 (:policy :fast-safe) 813 (:args (digit :scs (unsigned-reg)) 814 (count :scs (unsigned-reg))) 815 (:arg-types unsigned-num positive-fixnum) 816 (:results (result :scs (unsigned-reg) :from (:argument 0))) 817 (:result-types unsigned-num) 818 (:generator 1 819 (inst sll digit 32 result) 820 (inst sra result count result) 821 (inst srl result 32 result))) 822 823(define-vop (digit-lshr digit-ashr) 824 (:translate sb!bignum:%digit-logical-shift-right) 825 (:generator 1 826 (inst srl digit count result))) 827 828(define-vop (digit-ashl digit-ashr) 829 (:translate sb!bignum:%ashl) 830 (:generator 1 831 (inst sll digit count result))) 832 833;;;; static functions 834 835(define-static-fun two-arg-gcd (x y) :translate gcd) 836(define-static-fun two-arg-lcm (x y) :translate lcm) 837 838(define-static-fun two-arg-+ (x y) :translate +) 839(define-static-fun two-arg-- (x y) :translate -) 840(define-static-fun two-arg-* (x y) :translate *) 841(define-static-fun two-arg-/ (x y) :translate /) 842 843(define-static-fun two-arg-< (x y) :translate <) 844(define-static-fun two-arg-<= (x y) :translate <=) 845(define-static-fun two-arg-> (x y) :translate >) 846(define-static-fun two-arg->= (x y) :translate >=) 847(define-static-fun two-arg-= (x y) :translate =) 848(define-static-fun two-arg-/= (x y) :translate /=) 849 850(define-static-fun %negate (x) :translate %negate) 851 852(define-static-fun two-arg-and (x y) :translate logand) 853(define-static-fun two-arg-ior (x y) :translate logior) 854(define-static-fun two-arg-xor (x y) :translate logxor) 855(define-static-fun two-arg-eqv (x y) :translate logeqv) 856