source: release/1.11/source/level-0/X86/X8664/x8664-bignum.lisp

;;-*- Mode: Lisp; Package: CCL -*-

;;;

;;; Copyright 2006-2009 Clozure Associates

;;;

;;; Licensed under the Apache License, Version 2.0 (the "License");

;;; you may not use this file except in compliance with the License.

;;; You may obtain a copy of the License at

;;;

;;;     http://www.apache.org/licenses/LICENSE-2.0

;;;

;;; Unless required by applicable law or agreed to in writing, software

;;; distributed under the License is distributed on an "AS IS" BASIS,

;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.

;;; See the License for the specific language governing permissions and

;;; limitations under the License.





(in-package "CCL")



;;; The caller has allocated a two-digit bignum (quite likely on the stack).

;;; If we can fit in a single digit (if the high word is just a sign

;;; extension of the low word), truncate the bignum in place (the

;;; trailing words should already be zeroed.

(defx86lapfunction %fixnum-to-bignum-set ((bignum arg_y) (fixnum arg_z))

  (movq (% fixnum) (% arg_x))

  (shl ($ (- 32 x8664::fixnumshift)) (% arg_x))

  (sar ($ (- 32 x8664::fixnumshift)) (% arg_x))

  (unbox-fixnum fixnum imm0)

  (cmp (% arg_x) (% fixnum))

  (je @chop)

  (movq (% imm0)  (@ x8664::misc-data-offset (% bignum)))

  (single-value-return)

  @chop

  (movq ($ x8664::one-digit-bignum-header) (@ x8664::misc-header-offset (% bignum)))

  (movl (% imm0.l) (@ x8664::misc-data-offset (% bignum)))

  (single-value-return))

  





(defx86lapfunction %multiply-and-add-loop64

    ((xs 16) (ys 8) #|(ra 0)|# (r arg_x) (i arg_y) (ylen arg_z))

  (let ((y temp2)

        (j temp0)

        (c imm2))

    (movq (@ xs (% rsp)) (% temp0))

    (movq (@ x8664::misc-data-offset (% temp0) (% i)) (% mm0)) ;x[i]

    (movq (@ ys (% rsp)) (% y))

    (xorl (%l j) (%l j))

    (xorl (%l c) (%l c))

    @loop

    ;; It's a pity to have to reload this every time, but there's no

    ;; imm3.  (Give him 16 registers, and he still complains...)

    (movd (% mm0) (% rax))

    (mulq (@ x8664::misc-data-offset (% y) (% j))) ;128-bit x * y[j] in rdx:rax

    (addq (@ x8664::misc-data-offset (% r) (% i)) (% rax)) ;add in r[i]

    (adcq ($ 0) (% rdx))

    ;; add in carry digit

    (addq (% c) (% rax))

    (movl ($ 0) (%l c))

    (adcq (% rdx) (% c))                                   ;new carry digit

    (movq (% rax) (@ x8664::misc-data-offset (% r) (% i))) ;update r[i]

    (addq ($ '1) (% i))

    (addq ($ '1) (% j))

    (subq ($ '1) (% ylen))

    (ja @loop)

    (movq (% c) (@ x8664::misc-data-offset (% r) (% i)))

    (single-value-return 4)))



;;; Multiply the (32-bit) digits X and Y, producing a 64-bit result.

;;; Add the 32-bit "prev" digit and the 32-bit carry-in digit to that 64-bit

;;; result; return the halves as (VALUES high low).

(defx86lapfunction %multiply-and-add4 ((x 8) #|(ra 0)|# (y arg_x) (prev arg_y) (carry-in arg_z))

  (let ((unboxed-x imm0)

        (unboxed-y imm1)

        (unboxed-prev imm0)

        (unboxed-carry-in imm0)

        (unboxed-low imm0)

        (high arg_y)

        (low arg_z))

    (pop (% ra0))

    (popq (% temp0))

    (discard-reserved-frame)

    (push (% ra0))

    (unbox-fixnum temp0 unboxed-x)

    (unbox-fixnum y unboxed-y)

    (mull (%l unboxed-y))

    (shlq ($ 32) (% unboxed-y))

    (orq (% unboxed-x) (% unboxed-y))   ; I got yer 64-bit product right here

    (unbox-fixnum prev unboxed-prev)

    (addq (% unboxed-prev) (% unboxed-y))

    (unbox-fixnum carry-in unboxed-carry-in)

    (addq (% unboxed-carry-in) (% unboxed-y))

    (movl (%l unboxed-y) (%l unboxed-low))

    (box-fixnum unboxed-low low)

    (shr ($ 32) (% unboxed-y))

    (box-fixnum unboxed-y high)

    (movq (% rsp) (% temp0))

    (pushq (% high))

    (pushq (% low))

    (set-nargs 2)

    (jmp-subprim .SPvalues)))



(defx86lapfunction %multiply-and-add3 ((x arg_x) (y arg_y) (carry-in arg_z))

  (let ((unboxed-x imm0)

        (unboxed-y imm1)

        (unboxed-carry-in imm0)

        (unboxed-low imm0)

        (high arg_y)

        (low arg_z))

    (unbox-fixnum arg_x unboxed-x)

    (unbox-fixnum y unboxed-y)

    (mull (%l unboxed-y))

    (shlq ($ 32) (% unboxed-y))

    (orq (% unboxed-x) (% unboxed-y))

    (unbox-fixnum carry-in unboxed-carry-in)

    (addq (% unboxed-carry-in) (% unboxed-y))

    (movl (%l unboxed-y) (%l unboxed-low))

    (box-fixnum unboxed-low low)

    (shr ($ 32) (% unboxed-y))

    (box-fixnum unboxed-y high)

    (movq (% rsp) (% temp0))

    (pushq (% high))

    (pushq (% low))

    (set-nargs 2)

    (jmp-subprim .SPvalues)))





(defx86lapfunction %multiply-and-add-fixnum-loop ((len64 8) #||(ra 0)||# (x arg_x) (y arg_y) (result arg_z))

  (let ((carry imm2)

        (i temp0)

        (rlen temp1))

    (movq (@ len64 (% rsp)) (% rlen))

    (xorl (%l carry) (%l carry))

    (xorl (%l i) (%l i))

    (jmp @test)

    @loop

    (unbox-fixnum y rax)

    (mulq (@ x8664::misc-data-offset (% x) (% i)))

    (addq (% carry) (% rax))

    (adcq ($ 0) (% rdx))

    (movq (% rdx) (% carry))

    (movq (% rax) (@ x8664::misc-data-offset (% result) (% i)))

    (addq ($ 8) (% i))

    @test

    (cmpq (% rlen) (% i))

    (jl @loop)

    (movq (% carry) (@ x8664::misc-data-offset (% result) (% i)))

    (single-value-return 3)))

    

    



    





;;; Set the ith 64-bit digit of BIGNUM to R

(defx86lapfunction %set-digit ((bignum arg_x) (i arg_y) (r arg_z))



  (movq (@ x8664::misc-data-offset (% r)) (% imm0))

  (movq (% imm0) (@ x8664::misc-data-offset (% bignum) (% i)))

  (single-value-return))



;;; Return the (possibly truncated) 32-bit quotient and remainder

;;; resulting from dividing hi:low by divisor.

(defx86lapfunction %floor ((num-high arg_x) (num-low arg_y) (divisor arg_z))

  (let ((unboxed-high imm1)

        (unboxed-low imm0)

        (unboxed-quo imm0)

        (unboxed-rem imm1)

        (unboxed-divisor imm2))

    (unbox-fixnum divisor unboxed-divisor)

    (unbox-fixnum num-high unboxed-high)

    (unbox-fixnum num-low unboxed-low)

    (divl (%l unboxed-divisor))

    (box-fixnum unboxed-quo arg_y)

    (box-fixnum unboxed-rem arg_z)

    (movq (% rsp) (% temp0))

    (pushq (% arg_y))

    (pushq (% arg_z))

    (set-nargs 2)

    (jmp-subprim .SPvalues)))



;;; Multiply two (UNSIGNED-BYTE 32) arguments, return the high and

;;; low halves of the 64-bit result

(defx86lapfunction %multiply ((x arg_y) (y arg_z))

  (let ((unboxed-x imm0)

        (unboxed-y imm1)

        (unboxed-high imm1)

        (unboxed-low imm0))

    (unbox-fixnum x unboxed-x)

    (unbox-fixnum y unboxed-y)

    (mull (%l unboxed-y))

    (box-fixnum unboxed-high arg_y)

    (box-fixnum unboxed-low arg_z)

    (movq (% rsp) (% temp0))

    (pushq (% arg_y))

    (pushq (% arg_z))

    (set-nargs 2)

    (jmp-subprim .SPvalues)))



;;; Any words in the "tail" of the bignum should have been

;;; zeroed by the caller.

(defx86lapfunction %set-bignum-length ((newlen arg_y) (bignum arg_z))

  (movq (% newlen) (% imm0))

  (shl ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% imm0))

  (movb ($ x8664::subtag-bignum) (%b imm0))

  (movq (% imm0) (@ x8664::misc-header-offset (% bignum)))

  (single-value-return))



;;; Count the sign bits in the most significant digit of bignum;

;;; return fixnum count.

(defx86lapfunction %bignum-sign-bits ((bignum arg_z))

  (vector-size bignum imm0 imm0)

  (movl (@ (- x8664::misc-data-offset 4) (% bignum) (% imm0) 4) (%l imm0))

  (movl (% imm0.l) (% imm1.l))

  (notl (% imm0.l))

  (testl (% imm1.l) (% imm1.l))

  (js @wasneg)

  (notl (% imm0.l))  

  @wasneg

  (bsrl (% imm0.l) (% imm0.l))

  (sete (% imm1.b))

  (xorl ($ 31) (% imm0))

  (addb (% imm1.b) (% imm0.b))

  (box-fixnum imm0 arg_z)

  (single-value-return))



(defx86lapfunction %signed-bignum-ref ((bignum arg_y) (index arg_z))

  (uuo-error-debug-trap)

  (unbox-fixnum index imm0)

  (movslq (@ x8664::misc-data-offset (% bignum) (% imm0) 4) (% imm0))

  (box-fixnum imm0 arg_z)

  (single-value-return))





;;; If the bignum is a one-digit bignum, return the value of the

;;; single digit as a fixnum.  Otherwise, if it's a two-digit-bignum

;;; and the two words of the bignum can be represented in a fixnum,

;;; return that fixnum; else return nil.

(defx86lapfunction %maybe-fixnum-from-one-or-two-digit-bignum ((bignum arg_z))

  (getvheader bignum imm1)

  (cmpq ($ x8664::one-digit-bignum-header) (% imm1))

  (je @one)

  (cmpq ($ x8664::two-digit-bignum-header) (% imm1))

  (jne @no)

  (movq (@ x8664::misc-data-offset (% bignum)) (% imm0))

  (box-fixnum imm0 arg_z)

  (unbox-fixnum arg_z imm1)

  (cmpq (% imm0) (% imm1))

  (je @done)

  @no

  (movq ($ nil) (% arg_z))

  (single-value-return)

  @one

  (movslq (@ x8664::misc-data-offset (% bignum)) (% imm0))

  (box-fixnum imm0 arg_z)

  @done

  (single-value-return))



;;; Again, we're out of imm regs: a variable shift count has to go in %cl.

;;; Make sure that the rest of %rcx is 0, to keep the GC happy.

;;; %rcx == temp2

(defx86lapfunction %digit-logical-shift-right ((digit arg_y) (count arg_z))

  (unbox-fixnum digit imm0)

  (unbox-fixnum count imm2)

  (shrq (% imm2.b) (% imm0))

  (box-fixnum imm0 arg_z)

  (single-value-return))







(defx86lapfunction %ashr ((digit arg_y) (count arg_z))

  (unbox-fixnum digit imm0)

  (unbox-fixnum count imm2)

  (movslq (%l imm0) (% imm0))

  (sarq (% imm2.b) (% imm0))

  (box-fixnum imm0 arg_z)

  (single-value-return))



(defx86lapfunction %ashl ((digit arg_y) (count arg_z))

  (unbox-fixnum digit imm0)

  (unbox-fixnum count imm2)

  (shlq (% imm2.b) (% imm0))

  (movl (%l imm0) (%l imm0))            ;zero-extend

  (box-fixnum imm0 arg_z)

  (single-value-return))



(defx86lapfunction macptr->fixnum ((ptr arg_z))

  (macptr-ptr arg_z ptr)

  (single-value-return))



(defx86lapfunction fix-digit-logand ((fix arg_x) (big arg_y) (dest arg_z)) ; index 0

  (let ((w1 imm0)

        (w2 imm1))

    (movq (@ x8664::misc-data-offset (% big)) (% w2))

    (unbox-fixnum  fix w1)

    (andq (% w2) (% w1))

    (cmp-reg-to-nil dest)

    (jne @store)

    (box-fixnum w1 arg_z)

    (single-value-return)

    @store

    (movq (% w1) (@ x8664::misc-data-offset (% dest)))

    (single-value-return)))



(defx86lapfunction fix-digit-logandc2 ((fix arg_x) (big arg_y) (dest arg_z))

  (let ((w1 imm0)

        (w2 imm1))

    (movq (@ x8664::misc-data-offset (% big)) (% w2))

    (unbox-fixnum  fix w1)

    (notq (% w2))

    (andq (% w2) (% w1))

    (cmp-reg-to-nil dest)

    (jne @store)

    (box-fixnum w1 arg_z)

    (single-value-return)

    @store

    (movq (% w1) (@ x8664::misc-data-offset (% dest)))

    (single-value-return)))





(defx86lapfunction fix-digit-logandc1 ((fix arg_x) (big arg_y) (dest arg_z))

  (let ((w1 imm0)

        (w2 imm1))

    (movq (@ x8664::misc-data-offset (% big)) (% w2))

    (unbox-fixnum  fix w1)

    (notq (% w1))

    (andq (% w2) (% w1))

    (cmp-reg-to-nil dest)

    (jne @store)

    (box-fixnum w1 arg_z)

    (single-value-return)

    @store

    (movq (% w1) (@ x8664::misc-data-offset (% dest)))

    (single-value-return)))



;;; Do LOGIOR on the N 32-bit words in A and B, storing the result in

;;; C.  (It's legal and desirable to do this more than 32 bits at a time.)



(defx86lapfunction %bignum-logior ((n 8) #|ra 0|# (a arg_x) (b arg_y) (c arg_z))

  (movq (@ n (% rsp)) (% imm0))

  (shrq (% imm0))

  (testl ($ 4) (%l imm0))

  (je @check128)

  (subq ($ 4) (% imm0))

  (movl (@ x8664::misc-data-offset (% a) (% imm0)) (%l imm1))

  (orl (@ x8664::misc-data-offset (% b) (% imm0)) (%l imm1))

  (movl (%l imm1) (@ x8664::misc-data-offset (% c) (% imm0)))

  (jmp @check128)

  @loop64

  (movq (@ x8664::misc-data-offset (% a) (% imm0)) (% imm1))

  (orq (@ x8664::misc-data-offset (% b) (% imm0)) (% imm1))

  (movq (% imm1) (@ x8664::misc-data-offset (% c) (% imm0)))

  @test64

  (subq ($  8) (% imm0))

  (jge @loop64)

  (single-value-return 3)

  ;; See if we can do some of this using the SSE2 hardware.

  ;; That's only possible if we have 6 or more words.

  @check128

  (rcmpq (% imm0) ($ (* 6 4)))

  (jl @test64)

  ;; We'll have to do the first 2 words in a 64-bit operation.

  ;; If the total number of words is a multiple of 4, we have

  ;; to do the last 2 words without using SSE2, as well.

  (testl ($ 8) (%l imm0))

  (jne @test128)

  (movq (@ (- x8664::misc-data-offset 8) (% a) (% imm0)) (% imm1))

  (orq (@ (- x8664::misc-data-offset 8) (% b) (% imm0)) (% imm1))

  (movq (% imm1) (@ (- x8664::misc-data-offset 8) (% c) (% imm0)))

  (subq ($ (+ 16 8)) (% imm0))

  @loop128

  (movaps (@ x8664::misc-data-offset (% a) (% imm0)) (% xmm0))

  (por (@ x8664::misc-data-offset (% b) (% imm0)) (% xmm0))

  (movaps (% xmm0) (@ x8664::misc-data-offset (% c) (% imm0)))

  @test128

  (subq ($ 16) (% imm0))

  (jg @loop128)

  (movq (@ x8664::misc-data-offset (% a)) (% imm1))

  (orq (@ x8664::misc-data-offset (% b)) (% imm1))

  (movq (% imm1) (@ x8664::misc-data-offset (% c)))

  (single-value-return 3))







;;; Do LOGAND on the N 32-bit words in A and B, storing the result in

;;; C.  (It's legal and desirable to do this more than 32 bits at a time.)



(defx86lapfunction %bignum-logand ((n 8) #|ra 0|# (a arg_x) (b arg_y) (c arg_z))

  (movq (@ n (% rsp)) (% imm0))

  (shrq (% imm0))

  (testl ($ 4) (%l imm0))

  (je @check128)

  (subq ($ 4) (% imm0))

  (movl (@ x8664::misc-data-offset (% a) (% imm0)) (%l imm1))

  (andl (@ x8664::misc-data-offset (% b) (% imm0)) (%l imm1))

  (movl (%l imm1) (@ x8664::misc-data-offset (% c) (% imm0)))

  (jmp @check128)

  @loop64

  (movq (@ x8664::misc-data-offset (% a) (% imm0)) (% imm1))

  (andq (@ x8664::misc-data-offset (% b) (% imm0)) (% imm1))

  (movq (% imm1) (@ x8664::misc-data-offset (% c) (% imm0)))

  @test64

  (subq ($  8) (% imm0))

  (jge @loop64)

  (single-value-return 3)

  ;; See if we can do some of this using the SSE2 hardware.

  ;; That's only possible if we have 6 or more words.

  @check128

  (rcmpq (% imm0) ($ (* 6 4)))

  (jl @test64)

  ;; We'll have to do the first 2 words in a 64-bit operation.

  ;; If the total number of words is a multiple of 4, we have

  ;; to do the last 2 words without using SSE2, as well.

  (testl ($ 8) (%l imm0))

  (jne @test128)

  (movq (@ (- x8664::misc-data-offset 8) (% a) (% imm0)) (% imm1))

  (andq (@ (- x8664::misc-data-offset 8) (% b) (% imm0)) (% imm1))

  (movq (% imm1) (@ (- x8664::misc-data-offset 8) (% c) (% imm0)))

  (subq ($ (+ 16 8)) (% imm0))

  @loop128

  (movaps (@ x8664::misc-data-offset (% a) (% imm0)) (% xmm0))

  (pand (@ x8664::misc-data-offset (% b) (% imm0)) (% xmm0))

  (movaps (% xmm0) (@ x8664::misc-data-offset (% c) (% imm0)))

  @test128

  (subq ($ 16) (% imm0))

  (jg @loop128)

  (movq (@ x8664::misc-data-offset (% a)) (% imm1))

  (and (@ x8664::misc-data-offset (% b)) (% imm1))

  (movq (% imm1) (@ x8664::misc-data-offset (% c)))

  (single-value-return 3))