X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fx86%2Farith.lisp;h=46aa23c4c1fa53729ecde27d83fe8bc214012b5b;hb=f78e2d271f540d68d35b4f41696ce746ff129ee3;hp=392f67cfdba221a45760e958b21988ae2397f298;hpb=f43f136f9b3ff6cae501e850fa67b2183317e212;p=sbcl.git diff --git a/src/assembly/x86/arith.lisp b/src/assembly/x86/arith.lisp index 392f67c..46aa23c 100644 --- a/src/assembly/x86/arith.lisp +++ b/src/assembly/x86/arith.lisp @@ -14,54 +14,54 @@ ;;;; 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 n-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-fun-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 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 n-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-fun-offset + ',(symbolicate "TWO-ARG-" fun))))) + + DO-BODY + ,@body))) (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) @@ -71,17 +71,12 @@ 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) @@ -90,19 +85,19 @@ 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 2) ; 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 2) ; high bits from edx + (inst sar x 2) ; 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) @@ -124,16 +119,16 @@ ;;;; 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)) + (: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) (inst jmp :z FIXNUM) @@ -142,15 +137,15 @@ (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes)) (inst sub esp-tn (fixnumize 2)) (inst push eax) - (inst mov ecx (fixnumize 1)) ; arg count + (inst mov ecx (fixnumize 1)) ; arg count (inst jmp (make-ea :dword - :disp (+ nil-value (static-fun-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 2) ; sign bit is data - remove type bits (move ecx res) (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset)) @@ -161,78 +156,71 @@ ;;;; 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 n-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-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-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 n-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-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))) + + (define-cond-assem-rtn generic-< < two-arg-< :ge) + (define-cond-assem-rtn generic-> > two-arg-> :le)) (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)) + (: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)) (inst cmp x y) (inst jmp :e RETURN-T) (inst test x 3) @@ -242,9 +230,7 @@ RETURN-NIL (inst mov res nil-value) - (inst pop eax) - (inst add eax 2) - (inst jmp eax) + (inst jmp DONE) DO-STATIC-FN (inst pop eax) @@ -254,38 +240,36 @@ (inst push eax) (inst mov ecx (fixnumize 2)) (inst jmp (make-ea :dword - :disp (+ nil-value (static-fun-offset 'eql)))) + :disp (+ nil-value (static-fun-offset 'eql)))) RETURN-T (load-symbol res t) - ;; FIXME: I don't understand how we return from here.. - ) + + DONE) (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? + (: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 test y 3) ; descriptor? (inst jmp :nz DO-STATIC-FN) (inst cmp x y) - (inst jmp :e RETURN-T) ; ok + (inst jmp :e RETURN-T) ; ok (inst mov res nil-value) - (inst pop eax) - (inst add eax 2) - (inst jmp eax) + (inst jmp DONE) DO-STATIC-FN (inst pop eax) @@ -295,10 +279,12 @@ (inst push eax) (inst mov ecx (fixnumize 2)) (inst jmp (make-ea :dword - :disp (+ nil-value (static-fun-offset 'two-arg-=)))) + :disp (+ nil-value (static-fun-offset 'two-arg-=)))) RETURN-T - (load-symbol res t)) + (load-symbol res t) + + DONE) ;;; Support for the Mersenne Twister, MT19937, random number generator @@ -334,13 +320,13 @@ (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))) + :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))) + :disp (- (* (+ 1 3 vector-data-offset) + n-word-bytes) + other-pointer-lowtag))) (inst and y #x80000000) (inst and tmp #x7fffffff) (inst or y tmp) @@ -349,26 +335,26 @@ (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))) + :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) + :disp (- (* (+ 3 vector-data-offset) + n-word-bytes) + other-pointer-lowtag)) + 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))) + :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))) + :disp (- (* (+ 1 3 vector-data-offset) + n-word-bytes) + other-pointer-lowtag))) (inst and y #x80000000) (inst and tmp #x7fffffff) (inst or y tmp) @@ -377,26 +363,26 @@ (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))) + :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) + :disp (- (* (+ 3 vector-data-offset) + n-word-bytes) + other-pointer-lowtag)) + 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))) + :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))) + :disp (- (* (+ 0 3 vector-data-offset) + n-word-bytes) + other-pointer-lowtag))) (inst and y #x80000000) (inst and tmp #x7fffffff) (inst or y tmp) @@ -405,14 +391,14 @@ (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))) + :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) + :disp (- (* (+ (- 624 1) 3 vector-data-offset) + n-word-bytes) + other-pointer-lowtag)) + y) ;; Restore the temporary registers and return. (inst pop tmp)