From: Nikodemus Siivola Date: Wed, 3 Dec 2008 16:31:10 +0000 (+0000) Subject: 1.0.23.16: more generic assembly op optimizations on x86 and x86-64 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2cd35e262d4be338e419114137ebf75e36e950f9;p=sbcl.git 1.0.23.16: more generic assembly op optimizations on x86 and x86-64 * Cleanup: replace bunch of magic numbers with fixnum-tag-mask and n-fixnum-tag-bits. * More cases of "one test to check both argument types against fixnum". * Use CMOV where appropriate. (Thanks to Vitaly Mayatskikh) --- diff --git a/src/assembly/x86-64/arith.lisp b/src/assembly/x86-64/arith.lisp index 22fee87..3e83992 100644 --- a/src/assembly/x86-64/arith.lisp +++ b/src/assembly/x86-64/arith.lisp @@ -32,8 +32,8 @@ (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) @@ -46,7 +46,7 @@ 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 @@ -83,16 +83,13 @@ 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 @@ -127,7 +124,7 @@ (: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) @@ -143,7 +140,7 @@ (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)) @@ -168,16 +165,19 @@ (: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 @@ -191,16 +191,7 @@ ; 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)) @@ -216,32 +207,30 @@ (: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) @@ -254,31 +243,29 @@ (: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-=))))) diff --git a/src/assembly/x86/arith.lisp b/src/assembly/x86/arith.lisp index 0d3b721..535e023 100644 --- a/src/assembly/x86/arith.lisp +++ b/src/assembly/x86/arith.lisp @@ -32,8 +32,8 @@ (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 @@ -84,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) @@ -127,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) @@ -143,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)) @@ -168,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? - 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 @@ -191,17 +200,7 @@ ; 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)) @@ -219,18 +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 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)) @@ -238,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) - - DONE) + :disp (+ nil-value (static-fun-offset 'eql))))) (define-assembly-routine (generic-= (:cost 10) @@ -257,19 +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 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)) @@ -277,12 +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) - - DONE) + :disp (+ nil-value (static-fun-offset 'two-arg-=))))) ;;; Support for the Mersenne Twister, MT19937, random number generator diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c index 359e031..7843e0b 100644 --- a/src/runtime/alloc.c +++ b/src/runtime/alloc.c @@ -74,7 +74,7 @@ static lispobj * 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; diff --git a/version.lisp-expr b/version.lisp-expr index a87978a..4c46e9c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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"