;;-*- Mode: Lisp; Package: CCL -*-
;;;
;;;   Copyright (C) 2006-2009 Clozure Associates
;;;   This file is part of Clozure CL.  
;;;
;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
;;;   License , known as the LLGPL and distributed with Clozure CL as the
;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
;;;   conflict, the preamble takes precedence.  
;;;
;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
;;;
;;;   The LLGPL is also available online at
;;;   http://opensource.franz.com/preamble.html


(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))

