[6] | 1 | ;-*- Mode: Lisp; Package: CCL -*- |
---|
| 2 | ;;; |
---|
[13067] | 3 | ;;; Copyright (C) 2009 Clozure Associates |
---|
[6] | 4 | ;;; Copyright (C) 1994-2001 Digitool, Inc |
---|
[13066] | 5 | ;;; This file is part of Clozure CL. |
---|
[6] | 6 | ;;; |
---|
[13066] | 7 | ;;; Clozure CL is licensed under the terms of the Lisp Lesser GNU Public |
---|
| 8 | ;;; License , known as the LLGPL and distributed with Clozure CL as the |
---|
[6] | 9 | ;;; file "LICENSE". The LLGPL consists of a preamble and the LGPL, |
---|
[13066] | 10 | ;;; which is distributed with Clozure CL as the file "LGPL". Where these |
---|
[6] | 11 | ;;; conflict, the preamble takes precedence. |
---|
| 12 | ;;; |
---|
[13066] | 13 | ;;; Clozure CL is referenced in the preamble as the "LIBRARY." |
---|
[6] | 14 | ;;; |
---|
| 15 | ;;; The LLGPL is also available online at |
---|
| 16 | ;;; http://opensource.franz.com/preamble.html |
---|
| 17 | |
---|
| 18 | |
---|
| 19 | |
---|
[1935] | 20 | (in-package "CCL") |
---|
[6] | 21 | |
---|
| 22 | (defppclapfunction %fixnum-signum ((number arg_z)) |
---|
[1326] | 23 | (cmpri :cr0 number '0) |
---|
[6] | 24 | (li arg_z '0) |
---|
| 25 | (beqlr :cr0) |
---|
| 26 | (li arg_z '1) ; assume positive |
---|
| 27 | (bgtlr :cr0) |
---|
| 28 | (li arg_z '-1) |
---|
| 29 | (blr)) |
---|
| 30 | |
---|
| 31 | ; see %logcount (ppc-bignum.lisp) |
---|
| 32 | (defppclapfunction %ilogcount ((number arg_z)) |
---|
| 33 | (let ((arg imm0) |
---|
| 34 | (shift imm1) |
---|
| 35 | (temp imm2)) |
---|
| 36 | (unbox-fixnum arg number) |
---|
| 37 | (mr. shift arg) |
---|
| 38 | (li arg_z 0) |
---|
| 39 | (b @test) |
---|
| 40 | @next |
---|
| 41 | (la temp -1 shift) |
---|
| 42 | (and. shift shift temp) |
---|
| 43 | (la arg_z '1 arg_z) |
---|
| 44 | @test |
---|
| 45 | (bne @next) |
---|
| 46 | (blr))) |
---|
| 47 | |
---|
| 48 | (defppclapfunction %iash ((number arg_y) (count arg_z)) |
---|
[1326] | 49 | (unbox-fixnum imm1 count) |
---|
[6] | 50 | (unbox-fixnum imm0 number) |
---|
| 51 | (neg. imm2 imm1) |
---|
| 52 | (blt @left) |
---|
[1326] | 53 | (srar imm0 imm0 imm2) |
---|
[6] | 54 | (box-fixnum arg_z imm0) |
---|
| 55 | (blr) |
---|
| 56 | @left |
---|
[1326] | 57 | (slr arg_z number imm1) |
---|
[6] | 58 | (blr)) |
---|
| 59 | |
---|
| 60 | (defparameter *double-float-zero* 0.0d0) |
---|
| 61 | (defparameter *short-float-zero* 0.0s0) |
---|
| 62 | |
---|
| 63 | |
---|
[1326] | 64 | #+ppc32-target |
---|
[6] | 65 | (defppclapfunction %sfloat-hwords ((sfloat arg_z)) |
---|
[78] | 66 | (lwz imm0 ppc32::single-float.value sfloat) |
---|
[6] | 67 | (digit-h temp0 imm0) |
---|
| 68 | (digit-l temp1 imm0) |
---|
| 69 | (vpush temp0) |
---|
| 70 | (vpush temp1) |
---|
| 71 | (la temp0 8 vsp) |
---|
| 72 | (set-nargs 2) |
---|
| 73 | (ba .SPvalues)) |
---|
| 74 | |
---|
| 75 | |
---|
| 76 | ; (integer-length arg) = (- 32 (cntlz (if (>= arg 0) arg (lognot arg)))) |
---|
[1326] | 77 | #+ppc32-target |
---|
[6] | 78 | (defppclapfunction %fixnum-intlen ((number arg_z)) |
---|
| 79 | (unbox-fixnum imm0 arg_z) |
---|
| 80 | (cntlzw. imm1 imm0) ; testing result of cntlzw? - ah no zeros if neg |
---|
| 81 | (bne @nonneg) |
---|
| 82 | (not imm1 imm0) |
---|
| 83 | (cntlzw imm1 imm1) |
---|
| 84 | @nonneg |
---|
| 85 | (subfic imm1 imm1 32) |
---|
| 86 | (box-fixnum arg_z imm1) |
---|
| 87 | (blr)) |
---|
| 88 | |
---|
[1326] | 89 | #+ppc64-target |
---|
| 90 | (defppclapfunction %fixnum-intlen ((number arg_z)) |
---|
| 91 | (unbox-fixnum imm0 arg_z) |
---|
| 92 | (cntlzd. imm1 imm0) |
---|
| 93 | (bne @nonneg) |
---|
| 94 | (not imm1 imm0) |
---|
| 95 | (cntlzd imm1 imm1) |
---|
| 96 | @nonneg |
---|
| 97 | (subfic imm1 imm1 64) |
---|
| 98 | (box-fixnum arg_z imm1) |
---|
[6] | 99 | (blr)) |
---|
| 100 | |
---|
| 101 | |
---|
| 102 | |
---|
| 103 | |
---|
[1326] | 104 | ;;; Caller guarantees that result fits in a fixnum. |
---|
| 105 | #+ppc32-target |
---|
[6] | 106 | (defppclapfunction %truncate-double-float->fixnum ((arg arg_z)) |
---|
| 107 | (get-double-float fp0 arg) |
---|
| 108 | (fctiwz fp0 fp0) |
---|
| 109 | (stwu tsp -16 tsp) |
---|
| 110 | (stw tsp 4 tsp) |
---|
| 111 | (stfd fp0 8 tsp) |
---|
| 112 | (lwz imm0 (+ 8 4) tsp) |
---|
| 113 | (lwz tsp 0 tsp) |
---|
| 114 | (box-fixnum arg_z imm0) |
---|
| 115 | (blr)) |
---|
| 116 | |
---|
[1326] | 117 | #+ppc64-target |
---|
| 118 | (defppclapfunction %truncate-double-float->fixnum ((arg arg_z)) |
---|
| 119 | (get-double-float fp0 arg) |
---|
| 120 | (fctidz fp0 fp0) |
---|
[1596] | 121 | (stdu tsp -32 tsp) |
---|
| 122 | (std tsp 8 tsp) |
---|
| 123 | (stfd fp0 16 tsp) |
---|
| 124 | (ld imm0 16 tsp) |
---|
| 125 | (la tsp 32 tsp) |
---|
[1326] | 126 | (box-fixnum arg_z imm0) |
---|
| 127 | (blr)) |
---|
| 128 | |
---|
| 129 | #+ppc32-target |
---|
[6] | 130 | (defppclapfunction %truncate-short-float->fixnum ((arg arg_z)) |
---|
| 131 | (get-single-float fp0 arg) |
---|
| 132 | (fctiwz fp0 fp0) |
---|
| 133 | (stwu tsp -16 tsp) |
---|
| 134 | (stw tsp 4 tsp) |
---|
| 135 | (stfd fp0 8 tsp) |
---|
| 136 | (lwz imm0 (+ 8 4) tsp) |
---|
| 137 | (lwz tsp 0 tsp) |
---|
| 138 | (box-fixnum arg_z imm0) |
---|
| 139 | (blr)) |
---|
| 140 | |
---|
[1326] | 141 | #+ppc64-target |
---|
| 142 | (defppclapfunction %truncate-short-float->fixnum ((arg arg_z)) |
---|
| 143 | (get-single-float fp0 arg) |
---|
| 144 | (fctidz fp0 fp0) |
---|
[1596] | 145 | (stdu tsp -32 tsp) |
---|
| 146 | (std tsp 8 tsp) |
---|
| 147 | (stfd fp0 16 tsp) |
---|
| 148 | (ld imm0 16 tsp) |
---|
| 149 | (la tsp 32 tsp) |
---|
[1326] | 150 | (box-fixnum arg_z imm0) |
---|
| 151 | (blr)) |
---|
| 152 | |
---|
| 153 | ;;; DOES round to even |
---|
| 154 | #+ppc32-target |
---|
[6] | 155 | (defppclapfunction %round-nearest-double-float->fixnum ((arg arg_z)) |
---|
| 156 | (get-double-float fp0 arg) |
---|
| 157 | (fctiw fp0 fp0) |
---|
| 158 | (stwu tsp -16 tsp) |
---|
| 159 | (stw tsp 4 tsp) |
---|
| 160 | (stfd fp0 8 tsp) |
---|
| 161 | (lwz imm0 (+ 8 4) tsp) |
---|
| 162 | (lwz tsp 0 tsp) |
---|
| 163 | (box-fixnum arg_z imm0) |
---|
| 164 | (blr)) |
---|
| 165 | |
---|
[1326] | 166 | #+ppc64-target |
---|
| 167 | (defppclapfunction %round-nearest-double-float->fixnum ((arg arg_z)) |
---|
| 168 | (get-double-float fp0 arg) |
---|
| 169 | (fctid fp0 fp0) |
---|
[1596] | 170 | (stdu tsp -32 tsp) |
---|
| 171 | (std tsp 8 tsp) |
---|
| 172 | (stfd fp0 16 tsp) |
---|
| 173 | (ld imm0 16 tsp) |
---|
| 174 | (la tsp 32 tsp) |
---|
[1326] | 175 | (box-fixnum arg_z imm0) |
---|
| 176 | (blr)) |
---|
| 177 | |
---|
| 178 | #+ppc32-target |
---|
[6] | 179 | (defppclapfunction %round-nearest-short-float->fixnum ((arg arg_z)) |
---|
| 180 | (get-single-float fp0 arg) |
---|
| 181 | (fctiw fp0 fp0) |
---|
| 182 | (stwu tsp -16 tsp) |
---|
| 183 | (stw tsp 4 tsp) |
---|
| 184 | (stfd fp0 8 tsp) |
---|
| 185 | (lwz imm0 (+ 8 4) tsp) |
---|
| 186 | (lwz tsp 0 tsp) |
---|
| 187 | (box-fixnum arg_z imm0) |
---|
| 188 | (blr)) |
---|
| 189 | |
---|
[1326] | 190 | #+ppc64-target |
---|
| 191 | (defppclapfunction %round-nearest-short-float->fixnum ((arg arg_z)) |
---|
| 192 | (get-single-float fp0 arg) |
---|
| 193 | (fctid fp0 fp0) |
---|
[1596] | 194 | (stdu tsp -32 tsp) |
---|
| 195 | (std tsp 8 tsp) |
---|
[1874] | 196 | (stfd fp0 16 tsp) |
---|
[1596] | 197 | (ld imm0 16 tsp) |
---|
| 198 | (la tsp 32 tsp) |
---|
[1326] | 199 | (box-fixnum arg_z imm0) |
---|
| 200 | (blr)) |
---|
[6] | 201 | |
---|
| 202 | |
---|
| 203 | |
---|
[1326] | 204 | |
---|
[13530] | 205 | ;;; maybe this could be smarter but frankly scarlett I dont give a damn |
---|
| 206 | ;;; ticket:666 describes one reason to give a damn. |
---|
[1326] | 207 | #+ppc32-target |
---|
[6] | 208 | (defppclapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z)) |
---|
| 209 | (let ((unboxed-quotient imm0) |
---|
| 210 | (unboxed-dividend imm1) |
---|
| 211 | (unboxed-divisor imm2) |
---|
| 212 | (unboxed-product imm3) |
---|
| 213 | (product temp0) |
---|
| 214 | (boxed-quotient temp1) |
---|
| 215 | (remainder temp2)) |
---|
[13530] | 216 | (cmpwi divisor '-1) |
---|
[6] | 217 | (unbox-fixnum unboxed-dividend dividend) |
---|
| 218 | (unbox-fixnum unboxed-divisor divisor) |
---|
[13530] | 219 | (beq @neg) |
---|
[6] | 220 | (divwo. unboxed-quotient unboxed-dividend unboxed-divisor) ; set OV if divisor = 0 |
---|
| 221 | (box-fixnum boxed-quotient unboxed-quotient) |
---|
| 222 | (mullw unboxed-product unboxed-quotient unboxed-divisor) |
---|
[1326] | 223 | (bns+ @ok) |
---|
[6] | 224 | (mtxer rzero) |
---|
| 225 | (save-lisp-context) |
---|
| 226 | (set-nargs 3) |
---|
[4463] | 227 | (load-constant arg_x truncate) |
---|
[6] | 228 | (call-symbol divide-by-zero-error) |
---|
| 229 | @not-0 |
---|
| 230 | @ok |
---|
| 231 | (subf imm0 unboxed-product unboxed-dividend) |
---|
| 232 | (vpush boxed-quotient) |
---|
| 233 | (box-fixnum remainder imm0) |
---|
| 234 | (vpush remainder) |
---|
| 235 | (set-nargs 2) |
---|
| 236 | (la temp0 8 vsp) |
---|
[13530] | 237 | (ba .SPvalues) |
---|
| 238 | @neg |
---|
| 239 | (nego. dividend dividend) |
---|
| 240 | (lwz arg_z '*least-positive-bignum* nfn) |
---|
| 241 | (bns @ret) |
---|
| 242 | (mtxer rzero) |
---|
| 243 | (lwz dividend ppc32::symbol.vcell arg_z) |
---|
| 244 | @ret |
---|
| 245 | (mr temp0 vsp) |
---|
| 246 | (vpush dividend) |
---|
| 247 | (vpush rzero) |
---|
| 248 | (set-nargs 2) |
---|
[6] | 249 | (ba .SPvalues))) |
---|
| 250 | |
---|
[1326] | 251 | #+ppc64-target |
---|
| 252 | (defppclapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z)) |
---|
| 253 | (let ((unboxed-quotient imm0) |
---|
| 254 | (unboxed-dividend imm1) |
---|
| 255 | (unboxed-divisor imm2) |
---|
| 256 | (unboxed-product imm3) |
---|
| 257 | (product temp0) |
---|
| 258 | (boxed-quotient temp1) |
---|
| 259 | (remainder temp2)) |
---|
[13530] | 260 | (cmpdi divisor '-1) |
---|
[1326] | 261 | (unbox-fixnum unboxed-dividend dividend) |
---|
| 262 | (unbox-fixnum unboxed-divisor divisor) |
---|
[13530] | 263 | (beq @neg) |
---|
[1792] | 264 | (divdo. unboxed-quotient unboxed-dividend unboxed-divisor) ; set OV if divisor = 0 |
---|
[1326] | 265 | (box-fixnum boxed-quotient unboxed-quotient) |
---|
[1558] | 266 | (mulld unboxed-product unboxed-quotient unboxed-divisor) |
---|
[1326] | 267 | (bns+ @ok) |
---|
| 268 | (mtxer rzero) |
---|
| 269 | (save-lisp-context) |
---|
| 270 | (set-nargs 3) |
---|
[4463] | 271 | (load-constant arg_x truncate) |
---|
[1326] | 272 | (call-symbol divide-by-zero-error) |
---|
| 273 | @not-0 |
---|
| 274 | @ok |
---|
| 275 | (subf imm0 unboxed-product unboxed-dividend) |
---|
| 276 | (vpush boxed-quotient) |
---|
| 277 | (box-fixnum remainder imm0) |
---|
| 278 | (vpush remainder) |
---|
| 279 | (set-nargs 2) |
---|
| 280 | (la temp0 '2 vsp) |
---|
[13530] | 281 | (ba .SPvalues) |
---|
| 282 | @neg |
---|
| 283 | (nego. dividend dividend) |
---|
| 284 | (ld arg_z '*least-positive-bignum* nfn) |
---|
| 285 | (bns @ret) |
---|
| 286 | (mtxer rzero) |
---|
| 287 | (ld dividend ppc64::symbol.vcell arg_z) |
---|
| 288 | @ret |
---|
| 289 | (mr temp0 vsp) |
---|
| 290 | (vpush dividend) |
---|
| 291 | (vpush rzero) |
---|
| 292 | (set-nargs 2) |
---|
| 293 | (ba .SPvalues) |
---|
| 294 | )) |
---|
[6] | 295 | |
---|
[1326] | 296 | |
---|
[6] | 297 | (defppclapfunction called-for-mv-p () |
---|
| 298 | (ref-global imm0 ret1valaddr) |
---|
[1326] | 299 | (ldr imm1 target::lisp-frame.savelr sp) |
---|
[6] | 300 | (eq->boolean arg_z imm0 imm1 imm0) |
---|
| 301 | (blr)) |
---|
| 302 | |
---|
[1326] | 303 | ;;; n1 and n2 must be positive (esp non zero) |
---|
| 304 | #+ppc32-target |
---|
[6] | 305 | (defppclapfunction %fixnum-gcd ((n1 arg_y)(n2 arg_z)) |
---|
| 306 | (let ((temp imm0) |
---|
| 307 | (u imm1) |
---|
| 308 | (v imm2) |
---|
| 309 | (ut0 imm3) |
---|
| 310 | (vt0 imm4)) |
---|
| 311 | (unbox-fixnum u n1) |
---|
| 312 | (unbox-fixnum v n2) |
---|
| 313 | (neg temp u) |
---|
| 314 | (and temp temp u) |
---|
| 315 | (cntlzw ut0 temp) |
---|
| 316 | (subfic ut0 ut0 31) |
---|
| 317 | (neg temp v) |
---|
| 318 | (and temp temp v) |
---|
| 319 | (cntlzw vt0 temp) |
---|
| 320 | (subfic vt0 vt0 31) |
---|
| 321 | (cmpw cr2 ut0 vt0) |
---|
| 322 | (srw u u ut0) |
---|
| 323 | (srw v v vt0) |
---|
[78] | 324 | (addi ut0 ut0 ppc32::fixnum-shift) |
---|
| 325 | (addi vt0 vt0 ppc32::fixnum-shift) |
---|
[6] | 326 | @loop |
---|
| 327 | (cmpw cr0 u v) |
---|
| 328 | (slw arg_z u ut0) |
---|
| 329 | (bgt cr0 @u>v) |
---|
| 330 | (blt cr0 @u<v) |
---|
| 331 | (blelr cr2) |
---|
| 332 | (slw arg_z u vt0) |
---|
| 333 | (blr) |
---|
| 334 | @u>v |
---|
| 335 | (sub u u v) |
---|
| 336 | @shiftu |
---|
| 337 | (andi. temp u (ash 1 1)) |
---|
| 338 | (srwi u u 1) |
---|
| 339 | (beq cr0 @shiftu) |
---|
| 340 | (b @loop) |
---|
| 341 | @u<v |
---|
| 342 | (sub v v u) |
---|
| 343 | @shiftv |
---|
| 344 | (andi. temp v (ash 1 1)) |
---|
| 345 | (srwi v v 1) |
---|
| 346 | (beq cr0 @shiftv) |
---|
| 347 | (b @loop))) |
---|
[1326] | 348 | |
---|
| 349 | #+ppc64-target |
---|
| 350 | (defppclapfunction %fixnum-gcd ((n1 arg_y)(n2 arg_z)) |
---|
| 351 | (let ((temp imm0) |
---|
| 352 | (u imm1) |
---|
| 353 | (v imm2) |
---|
| 354 | (ut0 imm3) |
---|
| 355 | (vt0 imm4)) |
---|
| 356 | (unbox-fixnum u n1) |
---|
| 357 | (unbox-fixnum v n2) |
---|
| 358 | (neg temp u) |
---|
| 359 | (and temp temp u) |
---|
| 360 | (cntlzd ut0 temp) |
---|
| 361 | (subfic ut0 ut0 63) |
---|
| 362 | (neg temp v) |
---|
| 363 | (and temp temp v) |
---|
| 364 | (cntlzd vt0 temp) |
---|
| 365 | (subfic vt0 vt0 63) |
---|
| 366 | (cmpw cr2 ut0 vt0) |
---|
| 367 | (srd u u ut0) |
---|
| 368 | (srd v v vt0) |
---|
| 369 | (addi ut0 ut0 ppc64::fixnum-shift) |
---|
| 370 | (addi vt0 vt0 ppc64::fixnum-shift) |
---|
| 371 | @loop |
---|
| 372 | (cmpd cr0 u v) |
---|
| 373 | (sld arg_z u ut0) |
---|
| 374 | (bgt cr0 @u>v) |
---|
| 375 | (blt cr0 @u<v) |
---|
| 376 | (blelr cr2) |
---|
[1558] | 377 | (sld arg_z u vt0) |
---|
[1326] | 378 | (blr) |
---|
| 379 | @u>v |
---|
| 380 | (sub u u v) |
---|
| 381 | @shiftu |
---|
| 382 | (andi. temp u (ash 1 1)) |
---|
| 383 | (srdi u u 1) |
---|
| 384 | (beq cr0 @shiftu) |
---|
| 385 | (b @loop) |
---|
| 386 | @u<v |
---|
| 387 | (sub v v u) |
---|
| 388 | @shiftv |
---|
| 389 | (andi. temp v (ash 1 1)) |
---|
| 390 | (srdi v v 1) |
---|
| 391 | (beq cr0 @shiftv) |
---|
| 392 | (b @loop))) |
---|
[13327] | 393 | |
---|
| 394 | (defppclapfunction %mrg31k3p ((state arg_z)) |
---|
| 395 | (let ((seed temp0)) |
---|
| 396 | (svref seed 1 state) |
---|
| 397 | (u32-ref imm0 1 seed) |
---|
| 398 | (u32-ref imm3 2 seed) |
---|
| 399 | (rlwinm imm1 imm0 22 1 9) |
---|
| 400 | (srwi imm2 imm0 9) |
---|
| 401 | (add imm0 imm1 imm2) |
---|
[6] | 402 | |
---|
[13327] | 403 | ;; construct m1 (1- (expt 2 31)) |
---|
| 404 | (lis imm1 #x7fff) |
---|
| 405 | (ori imm1 imm1 #xffff) |
---|
[6] | 406 | |
---|
[13327] | 407 | (rlwinm imm4 imm3 7 1 24) |
---|
| 408 | (srwi imm5 imm3 24) |
---|
| 409 | (add imm0 imm0 imm4) |
---|
| 410 | (add imm0 imm0 imm5) |
---|
[6] | 411 | |
---|
[13327] | 412 | ;; reduce mod m1 |
---|
| 413 | (cmplw cr7 imm0 imm1) |
---|
| 414 | (blt cr7 @ok1) |
---|
| 415 | (sub imm0 imm0 imm1) |
---|
| 416 | @ok1 |
---|
[6] | 417 | |
---|
[13327] | 418 | (add imm0 imm0 imm3) |
---|
| 419 | |
---|
| 420 | ;; reduce mod m1 |
---|
| 421 | (cmplw cr7 imm0 imm1) |
---|
| 422 | (blt cr7 @ok2) |
---|
| 423 | (sub imm0 imm0 imm1) |
---|
| 424 | @ok2 |
---|
| 425 | |
---|
| 426 | ;; update state |
---|
| 427 | (u32-ref imm1 1 seed) |
---|
| 428 | (u32-set imm1 2 seed) |
---|
| 429 | (u32-ref imm1 0 seed) |
---|
| 430 | (u32-set imm1 1 seed) |
---|
| 431 | (u32-set imm0 0 seed) |
---|
| 432 | |
---|
| 433 | ;; construct m2 (- (expt 2 31) 21069)) |
---|
| 434 | (lis imm5 #x7fff) |
---|
| 435 | (ori imm5 imm5 44467) |
---|
| 436 | |
---|
| 437 | ;; second component |
---|
| 438 | (u32-ref imm0 3 seed) |
---|
| 439 | (rlwinm imm1 imm0 15 1 16) |
---|
| 440 | (srwi imm2 imm0 16) |
---|
| 441 | (mulli imm2 imm2 21069) |
---|
| 442 | (add imm0 imm1 imm2) |
---|
| 443 | |
---|
| 444 | ;; reduce mod m2 |
---|
| 445 | (cmplw cr7 imm0 imm5) |
---|
| 446 | (blt cr7 @ok3) |
---|
| 447 | (sub imm0 imm0 imm5) |
---|
| 448 | @ok3 |
---|
| 449 | |
---|
| 450 | (u32-ref imm1 5 seed) |
---|
| 451 | (rlwinm imm2 imm1 15 1 16) |
---|
| 452 | (srwi imm3 imm1 16) |
---|
| 453 | (mulli imm3 imm3 21069) |
---|
| 454 | (add imm2 imm2 imm3) |
---|
| 455 | |
---|
| 456 | ;; reduce mod m2 |
---|
| 457 | (cmplw cr7 imm2 imm5) |
---|
| 458 | (blt cr7 @ok4) |
---|
| 459 | (sub imm2 imm2 imm5) |
---|
| 460 | @ok4 |
---|
| 461 | |
---|
| 462 | (add imm2 imm1 imm2) |
---|
| 463 | (cmplw cr7 imm2 imm5) |
---|
| 464 | (blt cr7 @ok5) |
---|
| 465 | (sub imm2 imm2 imm5) |
---|
| 466 | @ok5 |
---|
| 467 | |
---|
| 468 | (add imm2 imm2 imm0) |
---|
| 469 | (cmplw cr7 imm2 imm5) |
---|
| 470 | (blt cr7 @ok6) |
---|
| 471 | (sub imm2 imm2 imm5) |
---|
| 472 | @ok6 |
---|
| 473 | |
---|
| 474 | ;; update state |
---|
| 475 | (u32-ref imm0 4 seed) |
---|
| 476 | (u32-set imm0 5 seed) |
---|
| 477 | (u32-ref imm0 3 seed) |
---|
| 478 | (u32-set imm0 4 seed) |
---|
| 479 | (u32-set imm2 3 seed) |
---|
| 480 | |
---|
| 481 | ;; construct m1 (1- (expt 2 31)) |
---|
| 482 | (lis imm5 #x7fff) |
---|
| 483 | (ori imm5 imm5 #xffff) |
---|
| 484 | |
---|
| 485 | ;; combination |
---|
| 486 | (u32-ref imm0 0 seed) |
---|
| 487 | (cmplw cr7 imm0 imm2) |
---|
| 488 | (sub imm0 imm0 imm2) |
---|
| 489 | (bgt cr7 @finish) |
---|
| 490 | (add imm0 imm0 imm5) |
---|
| 491 | @finish |
---|
| 492 | #+ppc32-target |
---|
| 493 | (clrlwi imm0 imm0 3) ;don't want negative fixnums |
---|
| 494 | (box-fixnum arg_z imm0) |
---|
| 495 | (blr))) |
---|
| 496 | |
---|
[6] | 497 | ; End of ppc-numbers.lisp |
---|