(inst mov rcx x)
(inst or rcx y)
- (inst test rcx 7) ; both fixnums?
- (inst jmp :nz DO-STATIC-FUN) ; no - do generic
+ (inst test rcx fixnum-tag-mask) ; both fixnums?
+ (inst jmp :nz DO-STATIC-FUN) ; no - do generic
,@body
(inst clc)
rbp-tn
(make-ea :qword :base rsp-tn :disp n-word-bytes))
(inst sub rsp-tn (fixnumize 2))
- (inst push rax) ; callers return addr
+ (inst push rax) ; callers return addr
(inst mov rcx (fixnumize 2)) ; arg count
(inst jmp
(make-ea :qword
OKAY)
(define-generic-arith-routine (* 30)
- (move rax x) ; must use eax for 64-bit result
- (inst sar rax 3) ; remove *4 fixnum bias
- (inst imul y) ; result in edx:eax
- (inst jmp :no OKAY) ; still fixnum
+ (move rax x) ; must use eax for 64-bit result
+ (inst sar rax n-fixnum-tag-bits) ; remove *8 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 rax x 3) ; high bits from edx
- (inst sar x 3) ; now shift edx too
+ (inst shrd rax x n-fixnum-tag-bits) ; high bits from edx
+ (inst sar x n-fixnum-tag-bits) ; now shift edx too
(move rcx x) ; save high bits from cqo
(inst cqo) ; edx:eax <- sign-extend of eax
(:temp rax unsigned-reg rax-offset)
(:temp rcx unsigned-reg rcx-offset))
- (inst test x 7)
+ (inst test x fixnum-tag-mask)
(inst jmp :z FIXNUM)
(inst pop rax)
(move res x)
(inst neg res) ; (- most-negative-fixnum) is BIGNUM
(inst jmp :no OKAY)
- (inst shr res 3) ; sign bit is data - remove type bits
+ (inst shr res n-fixnum-tag-bits) ; sign bit is data - remove type bits
(move rcx res)
(with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
(:temp eax unsigned-reg rax-offset)
(:temp ecx unsigned-reg rcx-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 7)
- (inst jmp :nz TAIL-CALL-TO-STATIC-FN)
- (inst test y 7)
- (inst jmp :z INLINE-FIXNUM-COMPARE)
+ (inst mov ecx x)
+ (inst or ecx y)
+ (inst test ecx fixnum-tag-mask)
+ (inst jmp :nz DO-STATIC-FUN)
- TAIL-CALL-TO-STATIC-FN
+ (inst cmp x y)
+ (load-symbol res t)
+ (inst mov eax nil-value)
+ (inst cmov ,test res eax)
+ (inst clc) ; single-value return
+ (inst ret)
+
+ DO-STATIC-FUN
(inst pop eax)
(inst push rbp-tn)
(inst lea rbp-tn (make-ea :qword
; should be named parallelly.
(inst jmp (make-ea :qword
:disp (+ nil-value
- (static-fun-offset ',static-fn))))
-
- INLINE-FIXNUM-COMPARE
- (inst cmp x y)
- (inst mov res nil-value)
- (inst jmp ,test RETURN-FALSE)
- RETURN-TRUE
- (load-symbol res t)
- RETURN-FALSE
- DONE)))
+ (static-fun-offset ',static-fn)))))))
(define-cond-assem-rtn generic-< < two-arg-< :ge)
(define-cond-assem-rtn generic-> > two-arg-> :le))
(:res res descriptor-reg rdx-offset)
- (:temp eax unsigned-reg rax-offset)
- (:temp ecx unsigned-reg rcx-offset))
+ (:temp rax unsigned-reg rax-offset)
+ (:temp rcx unsigned-reg rcx-offset))
+ (inst mov rcx x)
+ (inst and rcx y)
+ (inst test rcx fixnum-tag-mask)
+ (inst jmp :nz DO-STATIC-FUN)
+
+ ;; At least one fixnum
(inst cmp x y)
- (inst jmp :e RETURN-T)
- (inst test x 7)
- (inst jmp :z RETURN-NIL)
- (inst test y 7)
- (inst jmp :nz DO-STATIC-FN)
-
- RETURN-NIL
- (inst mov res nil-value)
- (inst jmp DONE)
-
- DO-STATIC-FN
- (inst pop eax)
+ (load-symbol res t)
+ (inst mov rax nil-value)
+ (inst cmov :ne res rax)
+ (inst clc)
+ (inst ret)
+
+ DO-STATIC-FUN
+ (inst pop rax)
(inst push rbp-tn)
(inst lea rbp-tn (make-ea :qword :base rsp-tn :disp n-word-bytes))
(inst sub rsp-tn (fixnumize 2))
- (inst push eax)
- (inst mov ecx (fixnumize 2))
+ (inst push rax)
+ (inst mov rcx (fixnumize 2))
(inst jmp (make-ea :qword
- :disp (+ nil-value (static-fun-offset 'eql))))
-
- RETURN-T
- (load-symbol res t)
- DONE)
+ :disp (+ nil-value (static-fun-offset 'eql)))))
(define-assembly-routine (generic-=
(:cost 10)
(:res res descriptor-reg rdx-offset)
- (:temp eax unsigned-reg rax-offset)
- (:temp ecx unsigned-reg rcx-offset)
- )
- (inst test x 7) ; descriptor?
- (inst jmp :nz DO-STATIC-FN) ; yes, do it here
- (inst test y 7) ; descriptor?
- (inst jmp :nz DO-STATIC-FN)
- (inst cmp x y)
- (inst jmp :e RETURN-T) ; ok
+ (:temp rax unsigned-reg rax-offset)
+ (:temp rcx unsigned-reg rcx-offset))
+ (inst mov rcx x)
+ (inst or rcx y)
+ (inst test rcx fixnum-tag-mask)
+ (inst jmp :nz DO-STATIC-FUN)
- (inst mov res nil-value)
- (inst jmp DONE)
+ ;; Both fixnums
+ (inst cmp x y)
+ (load-symbol res t)
+ (inst mov rax nil-value)
+ (inst cmov :ne res rax)
+ (inst clc)
+ (inst ret)
- DO-STATIC-FN
- (inst pop eax)
+ DO-STATIC-FUN
+ (inst pop rax)
(inst push rbp-tn)
(inst lea rbp-tn (make-ea :qword :base rsp-tn :disp n-word-bytes))
(inst sub rsp-tn (fixnumize 2))
- (inst push eax)
- (inst mov ecx (fixnumize 2))
+ (inst push rax)
+ (inst mov rcx (fixnumize 2))
(inst jmp (make-ea :qword
- :disp (+ nil-value (static-fun-offset 'two-arg-=))))
-
- RETURN-T
- (load-symbol res t)
- DONE)
+ :disp (+ nil-value (static-fun-offset 'two-arg-=)))))
(inst mov ecx x)
(inst or ecx y)
- (inst test ecx 3) ; both fixnums?
- (inst jmp :nz DO-STATIC-FUN) ; no - do generic
+ (inst test ecx fixnum-tag-mask) ; both fixnums?
+ (inst jmp :nz DO-STATIC-FUN) ; no - do generic
,@body
(inst clc) ; single-value return
(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
+ (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)
(:temp eax unsigned-reg eax-offset)
(:temp ecx unsigned-reg ecx-offset))
- (inst test x 3)
+ (inst test x fixnum-tag-mask)
(inst jmp :z FIXNUM)
(inst pop eax)
(move res x)
(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-widetag (1+ bignum-digits-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)
+ (inst mov ecx x)
+ (inst or ecx y)
+ (inst test ecx fixnum-tag-mask)
+ (inst jmp :nz DO-STATIC-FUN) ; are both fixnums?
- TAIL-CALL-TO-STATIC-FN
+ (inst cmp x y)
+ (cond ((member :cmov *backend-subfeatures*)
+ (load-symbol res t)
+ (inst mov eax nil-value)
+ (inst cmov ,test res eax))
+ (t
+ (inst mov res nil-value)
+ (inst jmp ,test RETURN)
+ (load-symbol res t)))
+ RETURN
+ (inst clc) ; single-value return
+ (inst ret)
+
+ DO-STATIC-FUN
(inst pop eax)
(inst push ebp-tn)
(inst lea ebp-tn (make-ea :dword
; should be named parallelly.
(inst jmp (make-ea :dword
:disp (+ nil-value
- (static-fun-offset ',static-fn))))
-
- INLINE-FIXNUM-COMPARE
- (inst cmp x y)
- (inst mov res nil-value)
- (inst jmp ,test RETURN-FALSE)
-
- (load-symbol res t)
-
- RETURN-FALSE
- DONE)))
+ (static-fun-offset ',static-fn)))))))
(define-cond-assem-rtn generic-< < two-arg-< :ge)
(define-cond-assem-rtn generic-> > two-arg-> :le))
(:temp eax unsigned-reg eax-offset)
(:temp ecx unsigned-reg ecx-offset))
- (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 jmp DONE)
+ (inst mov ecx x)
+ (inst and ecx y)
+ (inst test ecx fixnum-tag-mask)
+ (inst jmp :nz DO-STATIC-FUN)
- DO-STATIC-FN
+ ;; At least one fixnum
+ (inst cmp x y)
+ (load-symbol res t)
+ (cond ((member :cmov *backend-subfeatures*)
+ (inst mov eax nil-value)
+ (inst cmov :ne res eax))
+ (t
+ (inst jmp :e RETURN)
+ (inst mov res nil-value)))
+ RETURN
+ (inst clc)
+ (inst ret)
+
+ ;; FIXME: We could handle all non-numbers here easily enough: go to
+ ;; TWO-ARG-EQL only if lowtags and widetags match, lowtag is
+ ;; other-pointer-lowtag and widetag is < code-header-widetag.
+ DO-STATIC-FUN
(inst pop eax)
(inst push ebp-tn)
(inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
(inst push eax)
(inst mov ecx (fixnumize 2))
(inst jmp (make-ea :dword
- :disp (+ nil-value (static-fun-offset 'eql))))
-
- RETURN-T
- (load-symbol res t)
-
- DONE)
+ :disp (+ nil-value (static-fun-offset 'eql)))))
(define-assembly-routine (generic-=
(:cost 10)
(: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
-
- (inst mov res nil-value)
- (inst jmp DONE)
+ (: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)
- DO-STATIC-FN
+ (inst cmp x y)
+ (load-symbol res t)
+ (cond ((member :cmov *backend-subfeatures*)
+ (inst mov eax nil-value)
+ (inst cmov :ne res eax))
+ (t
+ (inst jmp :e RETURN)
+ (inst mov res nil-value)))
+ RETURN
+ (inst clc)
+ (inst ret)
+
+ DO-STATIC-FUN
(inst pop eax)
(inst push ebp-tn)
(inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
(inst push eax)
(inst mov ecx (fixnumize 2))
(inst jmp (make-ea :dword
- :disp (+ nil-value (static-fun-offset 'two-arg-=))))
-
- RETURN-T
- (load-symbol res t)
-
- DONE)
+ :disp (+ nil-value (static-fun-offset 'two-arg-=)))))
\f
;;; Support for the Mersenne Twister, MT19937, random number generator
pa_alloc(int bytes, int page_type_flag)
{
lispobj *result;
-
+
/* FIXME: this is not pseudo atomic at all, but is called only from
* interrupt safe places like interrupt handlers. MG - 2005-08-09 */
result = dynamic_space_free_pointer;
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.23.15"
+"1.0.23.16"
projects / sbcl.git / commitdiff