From 60d14c472f42fb56b80aa1b9df28d5c3f447d6a3 Mon Sep 17 00:00:00 2001 From: Cyrus Harmon Date: Sat, 13 May 2006 16:16:49 +0000 Subject: [PATCH] 0.9.12.7: Mips assembly micro optimisations. NOTE: reapplying changes lost in the sf.net CVS outage --- src/assembly/mips/arith.lisp | 179 +++++++++++++++++++++--------------------- version.lisp-expr | 2 +- 2 files changed, 92 insertions(+), 89 deletions(-) diff --git a/src/assembly/mips/arith.lisp b/src/assembly/mips/arith.lisp index 94803c9..5ac9b97 100644 --- a/src/assembly/mips/arith.lisp +++ b/src/assembly/mips/arith.lisp @@ -25,39 +25,37 @@ (:temp temp1 non-descriptor-reg nl1-offset) (:temp temp2 non-descriptor-reg nl2-offset) (:temp pa-flag non-descriptor-reg nl4-offset) + (:temp lra descriptor-reg lra-offset) (:temp lip interior-reg lip-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) (inst or temp x y) (inst and temp fixnum-tag-mask) - (inst beq temp DO-ADD) + (inst bne temp DO-STATIC-FUN) + (inst addu temp x y) + ;; check for overflow + (inst xor temp1 temp x) + (inst xor temp2 temp y) + (inst and temp1 temp2) + (inst bltz temp1 DO-OVERFLOW) (inst sra temp1 x n-fixnum-tag-bits) + (inst move res temp) + (lisp-return lra lip :offset 2) - ;; DO-STATIC-FUN - (inst lw lip null-tn (static-fun-offset 'two-arg-+)) - (inst li nargs (fixnumize 2)) - (move ocfp cfp-tn) - (inst j lip) - (move cfp-tn csp-tn t) - - DO-ADD + DO-OVERFLOW + ;; We did overflow, so do the bignum version (inst sra temp2 y n-fixnum-tag-bits) (inst addu temp temp1 temp2) - ;; check for overflow - (inst sra temp1 temp (- n-word-bits n-lowtag-bits)) - (inst beq temp1 RETURN) - (inst nor temp1 temp1) - (inst beq temp1 RETURN) - (inst nop) (with-fixed-allocation (res pa-flag temp2 bignum-widetag (1+ bignum-digits-offset)) (storew temp res bignum-digits-offset other-pointer-lowtag)) - (inst b DONE) - (inst nop) - - RETURN - (inst sll res temp n-fixnum-tag-bits) + (lisp-return lra lip :offset 2) - DONE) + DO-STATIC-FUN + (inst lw lip null-tn (static-fun-offset 'two-arg-+)) + (inst li nargs (fixnumize 2)) + (move ocfp cfp-tn) + (inst j lip) + (move cfp-tn csp-tn t)) (define-assembly-routine (generic-- @@ -75,39 +73,37 @@ (:temp temp1 non-descriptor-reg nl1-offset) (:temp temp2 non-descriptor-reg nl2-offset) (:temp pa-flag non-descriptor-reg nl4-offset) + (:temp lra descriptor-reg lra-offset) (:temp lip interior-reg lip-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) (inst or temp x y) (inst and temp fixnum-tag-mask) - (inst beq temp DO-SUB) + (inst bne temp DO-STATIC-FUN) + (inst subu temp x y) + ;; check for overflow + (inst xor temp1 x y) + (inst xor temp2 x temp) + (inst and temp1 temp2) + (inst bltz temp1 DO-OVERFLOW) (inst sra temp1 x n-fixnum-tag-bits) + (inst move res temp) + (lisp-return lra lip :offset 2) - ;; DO-STATIC-FUN - (inst lw lip null-tn (static-fun-offset 'two-arg--)) - (inst li nargs (fixnumize 2)) - (move ocfp cfp-tn) - (inst j lip) - (move cfp-tn csp-tn t) - - DO-SUB + DO-OVERFLOW + ;; We did overflow, so do the bignum version (inst sra temp2 y n-fixnum-tag-bits) (inst subu temp temp1 temp2) - ;; check for overflow - (inst sra temp1 temp (- n-word-bits n-lowtag-bits)) - (inst beq temp1 RETURN) - (inst nor temp1 temp1) - (inst beq temp1 RETURN) - (inst nop) (with-fixed-allocation (res pa-flag temp2 bignum-widetag (1+ bignum-digits-offset)) (storew temp res bignum-digits-offset other-pointer-lowtag)) - (inst b DONE) - (inst nop) + (lisp-return lra lip :offset 2) - RETURN - (inst sll res temp n-fixnum-tag-bits) - - DONE) + DO-STATIC-FUN + (inst lw lip null-tn (static-fun-offset 'two-arg--)) + (inst li nargs (fixnumize 2)) + (move ocfp cfp-tn) + (inst j lip) + (move cfp-tn csp-tn t)) @@ -129,6 +125,7 @@ (:temp lo non-descriptor-reg nl1-offset) (:temp hi non-descriptor-reg nl2-offset) (:temp pa-flag non-descriptor-reg nl4-offset) + (:temp lra descriptor-reg lra-offset) (:temp lip interior-reg lip-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) @@ -145,10 +142,13 @@ ;; Check to see if the result will fit in a fixnum. (I.e. the high word ;; is just 32 copies of the sign bit of the low word). (inst sra temp res 31) - (inst beq temp hi DONE) + (inst bne temp hi DO-BIGNUM) + (inst srl lo res n-fixnum-tag-bits) + (lisp-return lra lip :offset 2) + + DO-BIGNUM ;; Shift the double word hi:res down two bits into hi:low to get rid of the ;; fixnum tag. - (inst srl lo res n-fixnum-tag-bits) (inst sll temp hi (- n-word-bits n-fixnum-tag-bits)) (inst or lo temp) (inst sra hi n-fixnum-tag-bits) @@ -165,8 +165,8 @@ (pseudo-atomic (pa-flag :extra (pad-data-block (+ 1 bignum-digits-offset))) (inst or res alloc-tn other-pointer-lowtag) (storew temp res 0 other-pointer-lowtag)) - (inst b DONE) (storew lo res bignum-digits-offset other-pointer-lowtag) + (lisp-return lra lip :offset 2) TWO-WORDS (pseudo-atomic (pa-flag :extra (pad-data-block (+ 2 bignum-digits-offset))) @@ -174,17 +174,16 @@ (storew temp res 0 other-pointer-lowtag)) (storew lo res bignum-digits-offset other-pointer-lowtag) - (inst b DONE) (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag) + (lisp-return lra lip :offset 2) DO-STATIC-FUN (inst lw lip null-tn (static-fun-offset 'two-arg-*)) (inst li nargs (fixnumize 2)) (move ocfp cfp-tn) (inst j lip) - (move cfp-tn csp-tn t) + (move cfp-tn csp-tn t)) - DONE) (macrolet ((frob (name note cost type sc signed-p) @@ -297,27 +296,28 @@ (:res res descriptor-reg a0-offset) (:temp temp non-descriptor-reg nl0-offset) + (:temp lra descriptor-reg lra-offset) (:temp lip interior-reg lip-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) (inst or temp x y) (inst and temp fixnum-tag-mask) - (inst beq temp DO-COMPARE) + (inst bne temp DO-STATIC-FUN) ,cmp - ;; DO-STATIC-FUN - (inst lw lip null-tn (static-fun-offset ',static-fn)) - (inst li nargs (fixnumize 2)) - (move ocfp cfp-tn) - (inst j lip) - (move cfp-tn csp-tn t) - - DO-COMPARE (inst ,(if not-p 'beq 'bne) temp DONE) (move res null-tn t) (load-symbol res t) - DONE))) + DONE + (lisp-return lra lip :offset 2) + + DO-STATIC-FUN + (inst lw lip null-tn (static-fun-offset ',static-fn)) + (inst li nargs (fixnumize 2)) + (move ocfp cfp-tn) + (inst j lip) + (move cfp-tn csp-tn t)))) (define-cond-assem-rtn generic-< < two-arg-< (inst slt temp x y) t) (define-cond-assem-rtn generic-<= <= two-arg-<= (inst slt temp x y) nil) @@ -337,30 +337,31 @@ (:res res descriptor-reg a0-offset) (:temp temp non-descriptor-reg nl0-offset) + (:temp lra descriptor-reg lra-offset) (:temp lip interior-reg lip-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) (inst beq x y RETURN-T) (inst or temp x y) (inst and temp fixnum-tag-mask) - (inst beq temp RETURN) + (inst bne temp DO-STATIC-FUN) (inst nop) - ;; DO-STATIC-FUN - (inst lw lip null-tn (static-fun-offset 'eql)) - (inst li nargs (fixnumize 2)) - (move ocfp cfp-tn) - (inst j lip) - (move cfp-tn csp-tn t) - - RETURN (inst bne x y DONE) (move res null-tn t) RETURN-T (load-symbol res t) - DONE) + DONE + (lisp-return lra lip :offset 2) + + DO-STATIC-FUN + (inst lw lip null-tn (static-fun-offset 'eql)) + (inst li nargs (fixnumize 2)) + (move ocfp cfp-tn) + (inst j lip) + (move cfp-tn csp-tn t)) (define-assembly-routine (generic-= @@ -375,27 +376,28 @@ (:res res descriptor-reg a0-offset) (:temp temp non-descriptor-reg nl0-offset) + (:temp lra descriptor-reg lra-offset) (:temp lip interior-reg lip-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) (inst or temp x y) (inst and temp fixnum-tag-mask) - (inst beq temp RETURN) + (inst bne temp DO-STATIC-FUN) (inst nop) - ;; DO-STATIC-FUN - (inst lw lip null-tn (static-fun-offset 'two-arg-=)) - (inst li nargs (fixnumize 2)) - (move ocfp cfp-tn) - (inst j lip) - (move cfp-tn csp-tn t) - - RETURN (inst bne x y DONE) (move res null-tn t) (load-symbol res t) - DONE) + DONE + (lisp-return lra lip :offset 2) + + DO-STATIC-FUN + (inst lw lip null-tn (static-fun-offset 'two-arg-=)) + (inst li nargs (fixnumize 2)) + (move ocfp cfp-tn) + (inst j lip) + (move cfp-tn csp-tn t)) (define-assembly-routine (generic-/= @@ -410,24 +412,25 @@ (:res res descriptor-reg a0-offset) (:temp temp non-descriptor-reg nl0-offset) + (:temp lra descriptor-reg lra-offset) (:temp lip interior-reg lip-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) (inst or temp x y) (inst and temp fixnum-tag-mask) - (inst beq temp RETURN) + (inst bne temp DO-STATIC-FUN) (inst nop) - ;; DO-STATIC-FUN - (inst lw lip null-tn (static-fun-offset 'two-arg-/=)) - (inst li nargs (fixnumize 2)) - (move ocfp cfp-tn) - (inst j lip) - (move cfp-tn csp-tn t) - - RETURN (inst beq x y DONE) (move res null-tn t) (load-symbol res t) - DONE) + DONE + (lisp-return lra lip :offset 2) + + DO-STATIC-FUN + (inst lw lip null-tn (static-fun-offset 'two-arg-/=)) + (inst li nargs (fixnumize 2)) + (move ocfp cfp-tn) + (inst j lip) + (move cfp-tn csp-tn t)) diff --git a/version.lisp-expr b/version.lisp-expr index ea5217f..d3c4853 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".) -"0.9.12.6" +"0.9.12.7" -- 1.7.10.4