X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fx86%2Farith.lisp;h=ea10b508a400d165ace349455ced6d15b27bb185;hb=37b1ed8e9b6faa84832b8251998b5d0eb1f6b307;hp=0d3b72124143d47c7f7e5f671df59ab377e3fa2a;hpb=1c09520cfbe88c76e5ac8b8b6c3c0d67f67a0d44;p=sbcl.git diff --git a/src/assembly/x86/arith.lisp b/src/assembly/x86/arith.lisp index 0d3b721..ea10b50 100644 --- a/src/assembly/x86/arith.lisp +++ b/src/assembly/x86/arith.lisp @@ -21,9 +21,7 @@ (: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) + (:arg y (descriptor-reg any-reg) edi-offset) (:res res (descriptor-reg any-reg) edx-offset) @@ -32,21 +30,20 @@ (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 (inst ret) DO-STATIC-FUN - (inst pop eax) + ;; Same as: (inst enter (fixnumize 1)) (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 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 @@ -84,18 +81,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) @@ -127,14 +124,14 @@ (: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) (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) + (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-fun-offset '%negate)))) @@ -143,7 +140,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)) @@ -154,135 +151,197 @@ ;;;; comparison (macrolet ((define-cond-assem-rtn (name translate static-fn test) + #+sb-assembling `(define-assembly-routine (,name - (:cost 10) - (:return-style :full-call) - (:policy :safe) - (:translate ,translate) - (:save-p t)) + (:return-style :none)) ((: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))) + (inst mov ecx x) + (inst or ecx y) + (inst test ecx fixnum-tag-mask) + (inst jmp :nz DO-STATIC-FUN) ; are both fixnums? - (define-cond-assem-rtn generic-< < two-arg-< :ge) - (define-cond-assem-rtn generic-> > two-arg-> :le)) + (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)) + (:return-style :none)) ((: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 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) - (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) - - DO-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)) - (inst push eax) - (inst mov ecx (fixnumize 2)) - (inst jmp (make-ea :dword - :disp (+ nil-value (static-fun-offset 'eql)))) + RET + (inst ret) - RETURN-T - (load-symbol res t) + DO-STATIC-FUN + ;; Might as well fast path that... + (inst cmp x y) + (inst jmp :e RET) - DONE) + (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 '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)) + (:return-style :none)) ((:arg x (descriptor-reg any-reg) edx-offset) (:arg y (descriptor-reg any-reg) edi-offset) - (:res res descriptor-reg edx-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) - (: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) + ;; Both fixnums (inst cmp x y) - (inst jmp :e RETURN-T) ; ok + (inst ret) - (inst mov res nil-value) - (inst jmp DONE) - - DO-STATIC-FN - (inst pop eax) + DO-STATIC-FUN (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) + (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-fun-offset 'two-arg-=)))) - - RETURN-T - (load-symbol res t) + (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)) - DONE) +#-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)))) ;;; Support for the Mersenne Twister, MT19937, random number generator