X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fhppa%2Farith.lisp;h=0a378e44fa08ead86331a6f5fc4abe7673f3b5d8;hb=37b1ed8e9b6faa84832b8251998b5d0eb1f6b307;hp=4929582726533cbbc1c9f8d4c21ca60c36c20bde;hpb=8a19c6876412b8ad1cf729297c2a373d63a0d0ec;p=sbcl.git diff --git a/src/assembly/hppa/arith.lisp b/src/assembly/hppa/arith.lisp index 4929582..0a378e4 100644 --- a/src/assembly/hppa/arith.lisp +++ b/src/assembly/hppa/arith.lisp @@ -49,8 +49,6 @@ (inst xor res sign res) (inst add res sign res)) - -#+sb-assembling (define-assembly-routine (truncate) ((:arg dividend signed-reg nl0-offset) @@ -58,7 +56,6 @@ (:res quo signed-reg nl2-offset) (:res rem signed-reg nl3-offset)) - ;; Move abs(divident) into quo. (inst move dividend quo :>=) (inst sub zero-tn quo quo) @@ -87,68 +84,102 @@ (inst move dividend zero-tn :>=) (inst sub zero-tn rem rem)) - ;;;; Generic arithmetic. (define-assembly-routine (generic-+ - (:cost 10) - (:return-style :full-call) - (:translate +) - (:policy :safe) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res (descriptor-reg any-reg) a0-offset) - - (:temp lip interior-reg lip-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst extru x 31 2 zero-tn :=) - (inst b do-static-fun :nullify t) - (inst extru y 31 2 zero-tn :=) - (inst b do-static-fun :nullify t) - (inst addo x y res) + (:cost 10) + (:return-style :full-call) + (:translate +) + (:policy :safe) + (:save-p t)) + ((:arg x (descriptor-reg any-reg) a0-offset) + (:arg y (descriptor-reg any-reg) a1-offset) + (:res res (descriptor-reg any-reg) a0-offset) + (:temp temp non-descriptor-reg nl0-offset) + (:temp temp1 non-descriptor-reg nl1-offset) + (:temp temp2 non-descriptor-reg nl2-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)) + ;; If either arg is not fixnum, use two-arg-+ to summarize + (inst or x y temp) + (inst extru temp 31 3 zero-tn :=) + (inst b DO-STATIC-FUN :nullify t) + ;; check for overflow + (inst add x y temp) + (inst xor temp x temp1) + (inst xor temp y temp2) + (inst and temp1 temp2 temp1) + (inst bc :< nil temp1 zero-tn DO-OVERFLOW) + (inst move temp res) + (lisp-return lra :offset 1) + + DO-OVERFLOW + ;; We did overflow, so do the bignum version + (inst sra x n-fixnum-tag-bits temp1) + (inst sra y n-fixnum-tag-bits temp2) + (inst add temp1 temp2 temp) + (with-fixed-allocation (res nil temp2 bignum-widetag + (1+ bignum-digits-offset) nil) + (storew temp res bignum-digits-offset other-pointer-lowtag)) (lisp-return lra :offset 1) DO-STATIC-FUN (inst ldw (static-fun-offset 'two-arg-+) null-tn lip) (inst li (fixnumize 2) nargs) - (inst move cfp-tn ocfp) + (move cfp-tn ocfp) (inst bv lip) - (inst move csp-tn cfp-tn)) + (move csp-tn cfp-tn t)) (define-assembly-routine (generic-- - (:cost 10) - (:return-style :full-call) - (:translate -) - (:policy :safe) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res (descriptor-reg any-reg) a0-offset) - - (:temp lip interior-reg lip-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst extru x 31 2 zero-tn :=) - (inst b do-static-fun :nullify t) - (inst extru y 31 2 zero-tn :=) - (inst b do-static-fun :nullify t) - (inst subo x y res) + (:cost 10) + (:return-style :full-call) + (:translate -) + (:policy :safe) + (:save-p t)) + ((:arg x (descriptor-reg any-reg) a0-offset) + (:arg y (descriptor-reg any-reg) a1-offset) + + (:res res (descriptor-reg any-reg) a0-offset) + + (:temp temp non-descriptor-reg nl0-offset) + (:temp temp1 non-descriptor-reg nl1-offset) + (:temp temp2 non-descriptor-reg nl2-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)) + ;; If either arg is not fixnum, use two-arg-+ to summarize + (inst or x y temp) + (inst extru temp 31 3 zero-tn :=) + (inst b DO-STATIC-FUN :nullify t) + (inst sub x y temp) + ;; check for overflow + (inst xor x y temp1) + (inst xor x temp temp2) + (inst and temp2 temp1 temp1) + (inst bc :< nil temp1 zero-tn DO-OVERFLOW) + (inst move temp res) + (lisp-return lra :offset 1) + + DO-OVERFLOW + ;; We did overflow, so do the bignum version + (inst sra x n-fixnum-tag-bits temp1) + (inst sra y n-fixnum-tag-bits temp2) + (inst sub temp1 temp2 temp) + (with-fixed-allocation (res nil temp2 bignum-widetag + (1+ bignum-digits-offset) nil) + (storew temp res bignum-digits-offset other-pointer-lowtag)) (lisp-return lra :offset 1) DO-STATIC-FUN (inst ldw (static-fun-offset 'two-arg--) null-tn lip) (inst li (fixnumize 2) nargs) - (inst move cfp-tn ocfp) + (move cfp-tn ocfp) (inst bv lip) - (inst move csp-tn cfp-tn)) - + (move csp-tn cfp-tn t)) ;;;; Comparison routines. @@ -156,36 +187,36 @@ (macrolet ((define-cond-assem-rtn (name translate static-fn cond) `(define-assembly-routine (,name - (:cost 10) - (:return-style :full-call) - (:policy :safe) - (:translate ,translate) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) - - (:res res descriptor-reg a0-offset) - - (:temp lip interior-reg lip-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst extru x 31 2 zero-tn :=) - (inst b do-static-fn :nullify t) - (inst extru y 31 2 zero-tn :=) - (inst b do-static-fn :nullify t) - - (inst comclr x y zero-tn ,cond) - (inst move null-tn res :tr) - (load-symbol res t) - (lisp-return lra :offset 1) - - DO-STATIC-FN - (inst ldw (static-fun-offset ',static-fn) null-tn lip) - (inst li (fixnumize 2) nargs) - (inst move cfp-tn ocfp) - (inst bv lip) - (inst move csp-tn cfp-tn)))) + (:cost 10) + (:return-style :full-call) + (:policy :safe) + (:translate ,translate) + (:save-p t)) + ((:arg x (descriptor-reg any-reg) a0-offset) + (:arg y (descriptor-reg any-reg) a1-offset) + + (:res res descriptor-reg a0-offset) + + (:temp lip interior-reg lip-offset) + (:temp lra descriptor-reg lra-offset) + (:temp nargs any-reg nargs-offset) + (:temp ocfp any-reg ocfp-offset)) + (inst extru x 31 2 zero-tn :=) + (inst b do-static-fn :nullify t) + (inst extru y 31 2 zero-tn :=) + (inst b do-static-fn :nullify t) + + (inst comclr x y zero-tn ,cond) + (inst move null-tn res :tr) + (load-symbol res t) + (lisp-return lra :offset 1) + + DO-STATIC-FN + (inst ldw (static-fun-offset ',static-fn) null-tn lip) + (inst li (fixnumize 2) nargs) + (inst move cfp-tn ocfp) + (inst bv lip) + (inst move csp-tn cfp-tn)))) (define-cond-assem-rtn generic-< < two-arg-< :<) (define-cond-assem-rtn generic-> > two-arg-> :>)) @@ -200,9 +231,9 @@ (:save-p t)) ((:arg x (descriptor-reg any-reg) a0-offset) (:arg y (descriptor-reg any-reg) a1-offset) - + (:res res descriptor-reg a0-offset) - + (:temp lip interior-reg lip-offset) (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) @@ -237,9 +268,9 @@ (:save-p t)) ((:arg x (descriptor-reg any-reg) a0-offset) (:arg y (descriptor-reg any-reg) a1-offset) - + (:res res descriptor-reg a0-offset) - + (:temp lip interior-reg lip-offset) (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset)