;;;; addition, subtraction, and multiplication
(macrolet ((define-generic-arith-routine ((fun cost) &body body)
- `(define-assembly-routine (,(symbolicate "GENERIC-" fun)
- (:cost ,cost)
- (:return-style :full-call)
- (:translate ,fun)
- (:policy :safe)
- (:save-p t))
- ((:arg x (descriptor-reg any-reg) edx-offset)
- (:arg y (descriptor-reg any-reg)
- ;; this seems wrong esi-offset -- FIXME: What's it mean?
- edi-offset)
-
- (:res res (descriptor-reg any-reg) edx-offset)
-
- (:temp eax unsigned-reg eax-offset)
- (:temp ebx unsigned-reg ebx-offset)
- (:temp ecx unsigned-reg ecx-offset))
-
- (declare (ignorable ebx))
-
- (inst test x 3) ; fixnum?
- (inst jmp :nz DO-STATIC-FUN) ; no - do generic
- (inst test y 3) ; fixnum?
- (inst jmp :z DO-BODY) ; yes - doit here
-
- DO-STATIC-FUN
- (inst pop eax)
- (inst push ebp-tn)
- (inst lea
- ebp-tn
- (make-ea :dword :base esp-tn :disp word-bytes))
- (inst sub esp-tn (fixnumize 2))
- (inst push eax) ; callers return addr
- (inst mov ecx (fixnumize 2)) ; arg count
- (inst jmp
- (make-ea :dword
- :disp (+ nil-value
- (static-function-offset
- ',(symbolicate "TWO-ARG-" fun)))))
-
- DO-BODY
- ,@body)))
+ `(define-assembly-routine (,(symbolicate "GENERIC-" fun)
+ (:cost ,cost)
+ (:return-style :full-call)
+ (:translate ,fun)
+ (:policy :safe)
+ (:save-p t))
+ ((:arg x (descriptor-reg any-reg) edx-offset)
+ (:arg y (descriptor-reg any-reg)
+ ;; this seems wrong esi-offset -- FIXME: What's it mean?
+ edi-offset)
+
+ (:res res (descriptor-reg any-reg) edx-offset)
+
+ (:temp eax unsigned-reg eax-offset)
+ (:temp ecx unsigned-reg ecx-offset))
+
+ (inst mov ecx x)
+ (inst or ecx y)
+ (inst test ecx fixnum-tag-mask) ; both fixnums?
+ (inst jmp :nz DO-STATIC-FUN) ; no - do generic
+
+ ,@body
+ (inst clc) ; single-value return
+ (inst ret)
+
+ DO-STATIC-FUN
+ ;; Same as: (inst enter (fixnumize 1))
+ (inst push ebp-tn)
+ (inst mov ebp-tn esp-tn)
+ (inst sub esp-tn (fixnumize 1))
+ (inst push (make-ea :dword :base ebp-tn
+ :disp (frame-byte-offset return-pc-save-offset)))
+ (inst mov ecx (fixnumize 2)) ; arg count
+ (inst jmp
+ (make-ea :dword
+ :disp (+ nil-value
+ (static-fun-offset
+ ',(symbolicate "TWO-ARG-" fun))))))))
(define-generic-arith-routine (+ 10)
(move res x)
(inst add res y)
(inst jmp :no OKAY)
- (inst rcr res 1) ; carry has correct sign
- (inst sar res 1) ; remove type bits
+ (inst rcr res 1) ; carry has correct sign
+ (inst sar res 1) ; remove type bits
(move ecx res)
- (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset))
- (storew ecx res bignum-digits-offset other-pointer-type))
+ (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
+ (storew ecx res bignum-digits-offset other-pointer-lowtag))
OKAY)
(define-generic-arith-routine (- 10)
- ;; FIXME: This is screwed up.
- ;;; I can't figure out the flags on subtract. Overflow never gets
- ;;; set and carry always does. (- 0 most-negative-fixnum) can't be
- ;;; easily detected so just let the upper level stuff do it.
- (inst jmp DO-STATIC-FUN)
-
(move res x)
(inst sub res y)
(inst jmp :no OKAY)
+ (inst cmc) ; carry has correct sign now
(inst rcr res 1)
- (inst sar res 1) ; remove type bits
+ (inst sar res 1) ; remove type bits
(move ecx res)
- (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset))
- (storew ecx res bignum-digits-offset other-pointer-type))
+ (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
+ (storew ecx res bignum-digits-offset other-pointer-lowtag))
OKAY)
(define-generic-arith-routine (* 30)
- (move eax x) ; must use eax for 64-bit result
- (inst sar eax 2) ; remove *4 fixnum bias
- (inst imul y) ; result in edx:eax
- (inst jmp :no okay) ; still fixnum
+ (move eax x) ; must use eax for 64-bit result
+ (inst sar eax n-fixnum-tag-bits) ; remove *4 fixnum bias
+ (inst imul y) ; result in edx:eax
+ (inst jmp :no OKAY) ; still fixnum
;; zzz jrd changed edx to ebx in here, as edx isn't listed as a temp, above
;; pfw says that loses big -- edx is target for arg x and result res
;; note that 'edx' is not defined -- using x
- (inst shrd eax x 2) ; high bits from edx
- (inst sar x 2) ; now shift edx too
+ (inst shrd eax x n-fixnum-tag-bits) ; high bits from edx
+ (inst sar x n-fixnum-tag-bits) ; now shift edx too
- (move ecx x) ; save high bits from cdq
- (inst cdq) ; edx:eax <- sign-extend of eax
+ (move ecx x) ; save high bits from cdq
+ (inst cdq) ; edx:eax <- sign-extend of eax
(inst cmp x ecx)
(inst jmp :e SINGLE-WORD-BIGNUM)
- (with-fixed-allocation (res bignum-type (+ bignum-digits-offset 2))
- (storew eax res bignum-digits-offset other-pointer-type)
- (storew ecx res (1+ bignum-digits-offset) other-pointer-type))
+ (with-fixed-allocation (res bignum-widetag (+ bignum-digits-offset 2))
+ (storew eax res bignum-digits-offset other-pointer-lowtag)
+ (storew ecx res (1+ bignum-digits-offset) other-pointer-lowtag))
(inst jmp DONE)
SINGLE-WORD-BIGNUM
- (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset))
- (storew eax res bignum-digits-offset other-pointer-type))
+ (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
+ (storew eax res bignum-digits-offset other-pointer-lowtag))
(inst jmp DONE)
OKAY
;;;; negation
(define-assembly-routine (generic-negate
- (:cost 10)
- (:return-style :full-call)
- (:policy :safe)
- (:translate %negate)
- (:save-p t))
- ((:arg x (descriptor-reg any-reg) edx-offset)
- (:res res (descriptor-reg any-reg) edx-offset)
-
- (:temp eax unsigned-reg eax-offset)
- (:temp ecx unsigned-reg ecx-offset))
- (inst test x 3)
+ (:cost 10)
+ (:return-style :full-call)
+ (:policy :safe)
+ (:translate %negate)
+ (:save-p t))
+ ((:arg x (descriptor-reg any-reg) edx-offset)
+ (:res res (descriptor-reg any-reg) edx-offset)
+
+ (:temp eax unsigned-reg eax-offset)
+ (:temp ecx unsigned-reg ecx-offset))
+ (inst test x fixnum-tag-mask)
(inst jmp :z FIXNUM)
- (inst pop eax)
(inst push ebp-tn)
- (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
- (inst sub esp-tn (fixnumize 2))
- (inst push eax)
- (inst mov ecx (fixnumize 1)) ; arg count
+ (inst mov ebp-tn esp-tn)
+ (inst sub esp-tn (fixnumize 1))
+ (inst push (make-ea :dword :base ebp-tn
+ :disp (frame-byte-offset return-pc-save-offset)))
+ (inst mov ecx (fixnumize 1)) ; arg count
(inst jmp (make-ea :dword
- :disp (+ nil-value (static-function-offset '%negate))))
+ :disp (+ nil-value (static-fun-offset '%negate))))
FIXNUM
(move res x)
- (inst neg res) ; (- most-negative-fixnum) is BIGNUM
+ (inst neg res) ; (- most-negative-fixnum) is BIGNUM
(inst jmp :no OKAY)
- (inst shr res 2) ; sign bit is data - remove type bits
+ (inst shr res n-fixnum-tag-bits) ; sign bit is data - remove type bits
(move ecx res)
- (with-fixed-allocation (res bignum-type (1+ bignum-digits-offset))
- (storew ecx res bignum-digits-offset other-pointer-type))
+ (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
+ (storew ecx res bignum-digits-offset other-pointer-lowtag))
OKAY)
\f
;;;; comparison
(macrolet ((define-cond-assem-rtn (name translate static-fn test)
- `(define-assembly-routine (,name
- (:cost 10)
- (:return-style :full-call)
- (:policy :safe)
- (:translate ,translate)
- (:save-p t))
- ((:arg x (descriptor-reg any-reg) edx-offset)
- (:arg y (descriptor-reg any-reg) edi-offset)
-
- (:res res descriptor-reg edx-offset)
-
- (:temp eax unsigned-reg eax-offset)
- (:temp ecx unsigned-reg ecx-offset))
-
- ;; KLUDGE: The "3" here is a mask for the bits which will be
- ;; zero in a fixnum. It should have a symbolic name. (Actually,
- ;; it might already have a symbolic name which the coder
- ;; couldn't be bothered to use..) -- WHN 19990917
- (inst test x 3)
- (inst jmp :nz TAIL-CALL-TO-STATIC-FN)
- (inst test y 3)
- (inst jmp :z INLINE-FIXNUM-COMPARE)
-
- TAIL-CALL-TO-STATIC-FN
- (inst pop eax)
- (inst push ebp-tn)
- (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
- (inst sub esp-tn (fixnumize 2)) ; FIXME: Push 2 words on stack,
- ; weirdly?
- (inst push eax)
- (inst mov ecx (fixnumize 2)) ; FIXME: FIXNUMIZE and
- ; SINGLE-FLOAT-BITS are parallel,
- ; should be named parallelly.
- (inst jmp (make-ea :dword
- :disp (+ nil-value
- (static-function-offset
- ',static-fn))))
-
- INLINE-FIXNUM-COMPARE
- (inst cmp x y)
- (inst jmp ,test RETURN-TRUE)
- (inst mov res nil-value)
- ;; FIXME: A note explaining this return convention, or a
- ;; symbolic name for it, would be nice. (It looks as though we
- ;; should be hand-crafting the same return sequence as would be
- ;; produced by GENERATE-RETURN-SEQUENCE, but in that case it's
- ;; not clear why we don't just jump to the end of this function
- ;; to share the return sequence there.
- (inst pop eax)
- (inst add eax 2)
- (inst jmp eax)
-
- RETURN-TRUE
- (load-symbol res t))))
+ #+sb-assembling
+ `(define-assembly-routine (,name
+ (:return-style :none))
+ ((:arg x (descriptor-reg any-reg) edx-offset)
+ (:arg y (descriptor-reg any-reg) edi-offset)
+
+ (:temp ecx unsigned-reg ecx-offset))
+
+ (inst mov ecx x)
+ (inst or ecx y)
+ (inst test ecx fixnum-tag-mask)
+ (inst jmp :nz DO-STATIC-FUN) ; are both fixnums?
+
+ (inst cmp x y)
+ (inst ret)
+
+ DO-STATIC-FUN
+ (inst push ebp-tn)
+ (inst mov ebp-tn esp-tn)
+ (inst sub esp-tn (fixnumize 3))
+ (inst mov (make-ea :dword :base esp-tn
+ :disp (frame-byte-offset
+ (+ sp->fp-offset
+ -3
+ ocfp-save-offset)))
+ ebp-tn)
+ (inst lea ebp-tn (make-ea :dword :base esp-tn
+ :disp (frame-byte-offset
+ (+ sp->fp-offset
+ -3
+ ocfp-save-offset))))
+ (inst mov ecx (fixnumize 2))
+ (inst call (make-ea :dword
+ :disp (+ nil-value
+ (static-fun-offset ',static-fn))))
+ ;; HACK: We depend on NIL having the lowest address of all
+ ;; static symbols (including T)
+ ,@(ecase test
+ (:l `((inst mov y (1+ nil-value))
+ (inst cmp y x)))
+ (:g `((inst cmp x (1+ nil-value)))))
+ (inst pop ebp-tn)
+ (inst ret))
+ #-sb-assembling
+ `(define-vop (,name)
+ (:translate ,translate)
+ (:policy :safe)
+ (:save-p t)
+ (:args (x :scs (descriptor-reg any-reg) :target edx)
+ (y :scs (descriptor-reg any-reg) :target edi))
+
+ (:temporary (:sc unsigned-reg :offset edx-offset
+ :from (:argument 0))
+ edx)
+ (:temporary (:sc unsigned-reg :offset edi-offset
+ :from (:argument 1))
+ edi)
+ (:conditional ,test)
+ (:generator 10
+ (move edx x)
+ (move edi y)
+ (inst call (make-fixup ',name :assembly-routine))))))
(define-cond-assem-rtn generic-< < two-arg-< :l)
(define-cond-assem-rtn generic-> > two-arg-> :g))
+#+sb-assembling
(define-assembly-routine (generic-eql
- (:cost 10)
- (:return-style :full-call)
- (:policy :safe)
- (:translate eql)
- (:save-p t))
- ((:arg x (descriptor-reg any-reg) edx-offset)
- (:arg y (descriptor-reg any-reg) edi-offset)
-
- (:res res descriptor-reg edx-offset)
-
- (:temp eax unsigned-reg eax-offset)
- (:temp ecx unsigned-reg ecx-offset))
+ (:return-style :none))
+ ((:arg x (descriptor-reg any-reg) edx-offset)
+ (:arg y (descriptor-reg any-reg) edi-offset)
+
+ (:temp ecx unsigned-reg ecx-offset))
+ (inst mov ecx x)
+ (inst and ecx y)
+ (inst and ecx lowtag-mask)
+ (inst cmp ecx other-pointer-lowtag)
+ (inst jmp :e DO-STATIC-FUN)
+
+ ;; At least one fixnum
+ (inst cmp x y)
+ RET
+ (inst ret)
+
+ DO-STATIC-FUN
+ ;; Might as well fast path that...
(inst cmp x y)
- (inst jmp :e RETURN-T)
- (inst test x 3)
- (inst jmp :z RETURN-NIL)
- (inst test y 3)
- (inst jmp :nz DO-STATIC-FN)
-
- RETURN-NIL
- (inst mov res nil-value)
- (inst pop eax)
- (inst add eax 2)
- (inst jmp eax)
-
- DO-STATIC-FN
- (inst pop eax)
+ (inst jmp :e RET)
+
(inst push ebp-tn)
- (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
- (inst sub esp-tn (fixnumize 2))
- (inst push eax)
+ (inst mov ebp-tn esp-tn)
+ (inst sub esp-tn (fixnumize 3))
+ (inst mov (make-ea :dword :base esp-tn
+ :disp (frame-byte-offset
+ (+ sp->fp-offset
+ -3
+ ocfp-save-offset)))
+ ebp-tn)
+ (inst lea ebp-tn (make-ea :dword :base esp-tn
+ :disp (frame-byte-offset
+ (+ sp->fp-offset
+ -3
+ ocfp-save-offset))))
(inst mov ecx (fixnumize 2))
- (inst jmp (make-ea :dword
- :disp (+ nil-value (static-function-offset 'eql))))
-
- RETURN-T
- (load-symbol res t)
- ;; FIXME: I don't understand how we return from here..
- )
+ (inst call (make-ea :dword
+ :disp (+ nil-value (static-fun-offset 'eql))))
+ (load-symbol y t)
+ (inst cmp x y)
+ (inst pop ebp-tn)
+ (inst ret))
+#-sb-assembling
+(define-vop (generic-eql)
+ (:translate eql)
+ (:policy :safe)
+ (:save-p t)
+ (:args (x :scs (descriptor-reg any-reg) :target edx)
+ (y :scs (descriptor-reg any-reg) :target edi))
+
+ (:temporary (:sc unsigned-reg :offset edx-offset
+ :from (:argument 0))
+ edx)
+ (:temporary (:sc unsigned-reg :offset edi-offset
+ :from (:argument 1))
+ edi)
+
+ (:conditional :e)
+ (:generator 10
+ (move edx x)
+ (move edi y)
+ (inst call (make-fixup 'generic-eql :assembly-routine))))
+
+#+sb-assembling
(define-assembly-routine (generic-=
- (:cost 10)
- (:return-style :full-call)
- (:policy :safe)
- (:translate =)
- (:save-p t))
- ((:arg x (descriptor-reg any-reg) edx-offset)
- (:arg y (descriptor-reg any-reg) edi-offset)
-
- (:res res descriptor-reg edx-offset)
-
- (:temp eax unsigned-reg eax-offset)
- (:temp ecx unsigned-reg ecx-offset)
- )
- (inst test x 3) ; descriptor?
- (inst jmp :nz DO-STATIC-FN) ; yes, do it here
- (inst test y 3) ; descriptor?
- (inst jmp :nz DO-STATIC-FN)
- (inst cmp x y)
- (inst jmp :e RETURN-T) ; ok
+ (:return-style :none))
+ ((:arg x (descriptor-reg any-reg) edx-offset)
+ (:arg y (descriptor-reg any-reg) edi-offset)
- (inst mov res nil-value)
- (inst pop eax)
- (inst add eax 2)
- (inst jmp eax)
+ (:temp ecx unsigned-reg ecx-offset))
+ (inst mov ecx x)
+ (inst or ecx y)
+ (inst test ecx fixnum-tag-mask)
+ (inst jmp :nz DO-STATIC-FUN)
+
+ ;; Both fixnums
+ (inst cmp x y)
+ (inst ret)
- DO-STATIC-FN
- (inst pop eax)
+ DO-STATIC-FUN
(inst push ebp-tn)
- (inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
- (inst sub esp-tn (fixnumize 2))
- (inst push eax)
+ (inst mov ebp-tn esp-tn)
+ (inst sub esp-tn (fixnumize 3))
+ (inst mov (make-ea :dword :base esp-tn
+ :disp (frame-byte-offset
+ (+ sp->fp-offset
+ -3
+ ocfp-save-offset)))
+ ebp-tn)
+ (inst lea ebp-tn (make-ea :dword :base esp-tn
+ :disp (frame-byte-offset
+ (+ sp->fp-offset
+ -3
+ ocfp-save-offset))))
(inst mov ecx (fixnumize 2))
- (inst jmp (make-ea :dword
- :disp (+ nil-value (static-function-offset 'two-arg-=))))
+ (inst call (make-ea :dword
+ :disp (+ nil-value (static-fun-offset 'two-arg-=))))
+ (load-symbol y t)
+ (inst cmp x y)
+ (inst pop ebp-tn)
+ (inst ret))
- RETURN-T
- (load-symbol res t))
+#-sb-assembling
+(define-vop (generic-=)
+ (:translate =)
+ (:policy :safe)
+ (:save-p t)
+ (:args (x :scs (descriptor-reg any-reg) :target edx)
+ (y :scs (descriptor-reg any-reg) :target edi))
+
+ (:temporary (:sc unsigned-reg :offset edx-offset
+ :from (:argument 0))
+ edx)
+ (:temporary (:sc unsigned-reg :offset edi-offset
+ :from (:argument 1))
+ edi)
+
+ (:conditional :e)
+ (:generator 10
+ (move edx x)
+ (move edi y)
+ (inst call (make-fixup 'generic-= :assembly-routine))))
\f
;;; Support for the Mersenne Twister, MT19937, random number generator
;; Generate a new set of results.
(inst xor k k)
LOOP1
- (inst mov y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
- (inst mov tmp (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 1 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ (inst mov y (make-ea-for-vector-data state :index k :offset 3))
+ (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
(inst and y #x80000000)
(inst and tmp #x7fffffff)
(inst or y tmp)
(inst jmp :nc skip1)
(inst xor y #x9908b0df)
SKIP1
- (inst xor y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 397 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
- (inst mov (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type))
- y)
+ (inst xor y (make-ea-for-vector-data state :index k :offset (+ 397 3)))
+ (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
(inst inc k)
(inst cmp k (- 624 397))
(inst jmp :b loop1)
LOOP2
- (inst mov y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
- (inst mov tmp (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 1 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ (inst mov y (make-ea-for-vector-data state :index k :offset 3))
+ (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
(inst and y #x80000000)
(inst and tmp #x7fffffff)
(inst or y tmp)
(inst jmp :nc skip2)
(inst xor y #x9908b0df)
SKIP2
- (inst xor y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ (- 397 624) 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
- (inst mov (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type))
- y)
+ (inst xor y (make-ea-for-vector-data state :index k :offset (+ (- 397 624) 3)))
+ (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
(inst inc k)
(inst cmp k (- 624 1))
(inst jmp :b loop2)
- (inst mov y (make-ea :dword :base state
- :disp (- (* (+ (- 624 1) 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
- (inst mov tmp (make-ea :dword :base state
- :disp (- (* (+ 0 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ (inst mov y (make-ea-for-vector-data state :offset (+ (- 624 1) 3)))
+ (inst mov tmp (make-ea-for-vector-data state :offset (+ 0 3)))
(inst and y #x80000000)
(inst and tmp #x7fffffff)
(inst or y tmp)
(inst jmp :nc skip3)
(inst xor y #x9908b0df)
SKIP3
- (inst xor y (make-ea :dword :base state
- :disp (- (* (+ (- 397 1) 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
- (inst mov (make-ea :dword :base state
- :disp (- (* (+ (- 624 1) 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type))
- y)
+ (inst xor y (make-ea-for-vector-data state :offset (+ (- 397 1) 3)))
+ (inst mov (make-ea-for-vector-data state :offset (+ (- 624 1) 3)) y)
;; Restore the temporary registers and return.
(inst pop tmp)
projects / sbcl.git / blobdiff