X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fx86%2Farith.lisp;h=535e023758e8319fe2fd2fc7e83ea5248fc6b144;hb=6127c0b282bb6d7fa6d225ee91d0a601d9b82360;hp=1365fba2b7a2b58f6b30f95e134383033422540c;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/assembly/x86/arith.lisp b/src/assembly/x86/arith.lisp index 1365fba..535e023 100644 --- a/src/assembly/x86/arith.lisp +++ b/src/assembly/x86/arith.lisp @@ -28,15 +28,16 @@ (: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 mov ecx x) + (inst or ecx y) + (inst test ecx fixnum-tag-mask) ; both fixnums? + (inst jmp :nz DO-STATIC-FUN) ; no - do generic - (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 + ,@body + (inst clc) ; single-value return + (inst ret) DO-STATIC-FUN (inst pop eax) @@ -51,10 +52,7 @@ (make-ea :dword :disp (+ nil-value (static-fun-offset - ',(symbolicate "TWO-ARG-" fun))))) - - DO-BODY - ,@body))) + ',(symbolicate "TWO-ARG-" fun)))))))) (define-generic-arith-routine (+ 10) (move res x) @@ -86,18 +84,18 @@ (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) @@ -129,7 +127,7 @@ (: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) @@ -145,7 +143,7 @@ (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)) @@ -170,16 +168,25 @@ (: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? + + (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) - TAIL-CALL-TO-STATIC-FN + DO-STATIC-FUN (inst pop eax) (inst push ebp-tn) (inst lea ebp-tn (make-ea :dword @@ -193,27 +200,10 @@ ; should be named parallelly. (inst jmp (make-ea :dword :disp (+ nil-value - (static-fun-offset ',static-fn)))) + (static-fun-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)))) - - (define-cond-assem-rtn generic-< < two-arg-< :l) - (define-cond-assem-rtn generic-> > two-arg-> :g)) + (define-cond-assem-rtn generic-< < two-arg-< :ge) + (define-cond-assem-rtn generic-> > two-arg-> :le)) (define-assembly-routine (generic-eql (:cost 10) @@ -228,20 +218,28 @@ (: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 pop eax) - (inst add eax 2) - (inst jmp eax) + (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)) @@ -249,12 +247,7 @@ (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) - ;; FIXME: I don't understand how we return from here.. - ) + :disp (+ nil-value (static-fun-offset 'eql))))) (define-assembly-routine (generic-= (:cost 10) @@ -268,21 +261,25 @@ (: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 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) ; 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)) @@ -290,10 +287,7 @@ (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)) + :disp (+ nil-value (static-fun-offset 'two-arg-=))))) ;;; Support for the Mersenne Twister, MT19937, random number generator @@ -328,14 +322,8 @@ ;; 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 vector-data-offset) - n-word-bytes) - other-pointer-lowtag))) - (inst mov tmp (make-ea :dword :base state :index k :scale 4 - :disp (- (* (+ 1 3 vector-data-offset) - n-word-bytes) - other-pointer-lowtag))) + (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) @@ -343,27 +331,14 @@ (inst jmp :nc skip1) (inst xor y #x9908b0df) SKIP1 - (inst xor y (make-ea :dword :base state :index k :scale 4 - :disp (- (* (+ 397 3 vector-data-offset) - n-word-bytes) - other-pointer-lowtag))) - (inst mov (make-ea :dword :base state :index k :scale 4 - :disp (- (* (+ 3 vector-data-offset) - n-word-bytes) - other-pointer-lowtag)) - 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 vector-data-offset) - n-word-bytes) - other-pointer-lowtag))) - (inst mov tmp (make-ea :dword :base state :index k :scale 4 - :disp (- (* (+ 1 3 vector-data-offset) - n-word-bytes) - other-pointer-lowtag))) + (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) @@ -371,27 +346,14 @@ (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 vector-data-offset) - n-word-bytes) - other-pointer-lowtag))) - (inst mov (make-ea :dword :base state :index k :scale 4 - :disp (- (* (+ 3 vector-data-offset) - n-word-bytes) - other-pointer-lowtag)) - 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 vector-data-offset) - n-word-bytes) - other-pointer-lowtag))) - (inst mov tmp (make-ea :dword :base state - :disp (- (* (+ 0 3 vector-data-offset) - n-word-bytes) - other-pointer-lowtag))) + (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) @@ -399,15 +361,8 @@ (inst jmp :nc skip3) (inst xor y #x9908b0df) SKIP3 - (inst xor y (make-ea :dword :base state - :disp (- (* (+ (- 397 1) 3 vector-data-offset) - n-word-bytes) - other-pointer-lowtag))) - (inst mov (make-ea :dword :base state - :disp (- (* (+ (- 624 1) 3 vector-data-offset) - n-word-bytes) - other-pointer-lowtag)) - 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)