Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/assembly/sparc arith.lisp,1.3,1.4 array.lisp,1.3,1.4 assem-rtns.lisp,1.1,1.2 support.lisp,1.2,1.3
|
From: William H. N. <wn...@us...> - 2005-07-14 16:31:24
|
Update of /cvsroot/sbcl/sbcl/src/assembly/sparc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9215/src/assembly/sparc Modified Files: arith.lisp array.lisp assem-rtns.lisp support.lisp Log Message: 0.9.2.43: another slice of whitespace canonicalization (Anyone who ends up here with "cvs annotate" probably wants to look at the "tabby" tagged version.) Index: arith.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/assembly/sparc/arith.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- arith.lisp 3 Jun 2005 10:17:27 -0000 1.3 +++ arith.lisp 14 Jul 2005 16:30:12 -0000 1.4 @@ -14,21 +14,21 @@ ;;;; Addition and subtraction. (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) + (: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) + (:res res (descriptor-reg any-reg) a0-offset) - (:temp temp non-descriptor-reg nl0-offset) - (:temp temp2 non-descriptor-reg nl1-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) + (:temp temp non-descriptor-reg nl0-offset) + (:temp temp2 non-descriptor-reg nl1-offset) + (:temp lra descriptor-reg lra-offset) + (:temp nargs any-reg nargs-offset) + (:temp ocfp any-reg ocfp-offset)) (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) (inst andcc zero-tn y fixnum-tag-mask) @@ -50,7 +50,7 @@ (inst li nargs (fixnumize 2)) (inst move ocfp cfp-tn) (inst j code-tn - (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) + (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) (inst move cfp-tn csp-tn) DONE @@ -58,21 +58,21 @@ (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) + (: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) + (:res res (descriptor-reg any-reg) a0-offset) - (:temp temp non-descriptor-reg nl0-offset) - (:temp temp2 non-descriptor-reg nl1-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) + (:temp temp non-descriptor-reg nl0-offset) + (:temp temp2 non-descriptor-reg nl1-offset) + (:temp lra descriptor-reg lra-offset) + (:temp nargs any-reg nargs-offset) + (:temp ocfp any-reg ocfp-offset)) (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) (inst andcc zero-tn y fixnum-tag-mask) @@ -94,7 +94,7 @@ (inst li nargs (fixnumize 2)) (inst move ocfp cfp-tn) (inst j code-tn - (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) + (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) (inst move cfp-tn csp-tn) DONE @@ -106,22 +106,22 @@ (define-assembly-routine (generic-* - (:cost 50) - (: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) + (:cost 50) + (: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) + (:res res (descriptor-reg any-reg) a0-offset) - (:temp temp non-descriptor-reg nl0-offset) - (:temp lo non-descriptor-reg nl1-offset) - (:temp hi non-descriptor-reg nl2-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) + (:temp temp non-descriptor-reg nl0-offset) + (:temp lo non-descriptor-reg nl1-offset) + (:temp hi non-descriptor-reg nl2-offset) + (:temp lra descriptor-reg lra-offset) + (:temp nargs any-reg nargs-offset) + (:temp ocfp any-reg ocfp-offset)) ;; If either arg is not a fixnum, call the static function. (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) @@ -143,7 +143,7 @@ (inst move lo hi) (inst srax hi 32)) ((or (member :sparc-v8 *backend-subfeatures*) - (member :sparc-v9 *backend-subfeatures*)) + (member :sparc-v9 *backend-subfeatures*)) (inst smul lo temp y) (inst rdy hi)) (t @@ -153,7 +153,7 @@ (inst nop) (inst nop) (dotimes (i 32) - (inst mulscc hi y)) + (inst mulscc hi y)) (inst mulscc hi zero-tn) (inst cmp x) (inst b :ge MULTIPLIER-POSITIVE) @@ -174,21 +174,21 @@ ;; Allocate a BIGNUM for the result. #+nil (pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset))) - (let ((one-word (gen-label))) - (inst or res alloc-tn other-pointer-lowtag) - ;; We start out assuming that we need one word. Is that correct? - (inst sra temp lo 31) - (inst xorcc temp hi) - (inst b :eq one-word) - (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag)) - ;; Nope, we need two, so allocate the addition space. - (inst add alloc-tn (- (pad-data-block (+ 2 bignum-digits-offset)) - (pad-data-block (1+ bignum-digits-offset)))) - (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag)) - (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag) - (emit-label one-word) - (storew temp res 0 other-pointer-lowtag) - (storew lo res bignum-digits-offset other-pointer-lowtag))) + (let ((one-word (gen-label))) + (inst or res alloc-tn other-pointer-lowtag) + ;; We start out assuming that we need one word. Is that correct? + (inst sra temp lo 31) + (inst xorcc temp hi) + (inst b :eq one-word) + (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag)) + ;; Nope, we need two, so allocate the addition space. + (inst add alloc-tn (- (pad-data-block (+ 2 bignum-digits-offset)) + (pad-data-block (1+ bignum-digits-offset)))) + (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag)) + (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag) + (emit-label one-word) + (storew temp res 0 other-pointer-lowtag) + (storew lo res bignum-digits-offset other-pointer-lowtag))) ;; Always allocate 2 words for the bignum result, even if we only ;; need one. The copying GC will take care of the extra word if it ;; isn't needed. @@ -210,13 +210,13 @@ (storew lo res bignum-digits-offset other-pointer-lowtag))) ;; Out of here (lisp-return lra :offset 2) - + DO-STATIC-FUN (inst ld code-tn null-tn (static-fun-offset 'two-arg-*)) (inst li nargs (fixnumize 2)) (inst move ocfp cfp-tn) (inst j code-tn - (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) + (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) (inst move cfp-tn csp-tn) LOW-FITS-IN-FIXNUM @@ -225,36 +225,36 @@ (macrolet ((frob (name note cost type sc) `(define-assembly-routine (,name - (:note ,note) - (:cost ,cost) - (:translate *) - (:policy :fast-safe) - (:arg-types ,type ,type) - (:result-types ,type)) - ((:arg x ,sc nl0-offset) - (:arg y ,sc nl1-offset) - (:res res ,sc nl0-offset) - (:temp temp ,sc nl2-offset)) - ,@(when (eq type 'tagged-num) - `((inst sra x 2))) - (cond - ((member :sparc-64 *backend-subfeatures*) - ;; Sign extend, then multiply - (inst sra x 0) - (inst sra y 0) - (inst mulx res x y)) - ((or (member :sparc-v8 *backend-subfeatures*) - (member :sparc-v9 *backend-subfeatures*)) - (inst smul res x y)) - (t - (inst wry x) - (inst andcc temp zero-tn) - (inst nop) - (inst nop) - (dotimes (i 32) - (inst mulscc temp y)) - (inst mulscc temp zero-tn) - (inst rdy res)))))) + (:note ,note) + (:cost ,cost) + (:translate *) + (:policy :fast-safe) + (:arg-types ,type ,type) + (:result-types ,type)) + ((:arg x ,sc nl0-offset) + (:arg y ,sc nl1-offset) + (:res res ,sc nl0-offset) + (:temp temp ,sc nl2-offset)) + ,@(when (eq type 'tagged-num) + `((inst sra x 2))) + (cond + ((member :sparc-64 *backend-subfeatures*) + ;; Sign extend, then multiply + (inst sra x 0) + (inst sra y 0) + (inst mulx res x y)) + ((or (member :sparc-v8 *backend-subfeatures*) + (member :sparc-v9 *backend-subfeatures*)) + (inst smul res x y)) + (t + (inst wry x) + (inst andcc temp zero-tn) + (inst nop) + (inst nop) + (dotimes (i 32) + (inst mulscc temp y)) + (inst mulscc temp zero-tn) + (inst rdy res)))))) (frob unsigned-* "unsigned *" 40 unsigned-num unsigned-reg) (frob signed-* "unsigned *" 41 signed-num signed-reg) (frob fixnum-* "fixnum *" 30 tagged-num any-reg)) @@ -268,42 +268,42 @@ (inst li quo 0) (labels ((do-loop (depth) - (cond - ((zerop depth) - (inst unimp 0)) - (t - (let ((label-1 (gen-label)) - (label-2 (gen-label))) - (inst cmp divisor rem) - (inst b :geu label-1) - (inst nop) - (inst sll divisor 1) - (do-loop (1- depth)) - (inst srl divisor 1) - (inst cmp divisor rem) - (emit-label label-1) - (inst b :gtu label-2) - (inst sll quo 1) - (inst add quo (if tagged (fixnumize 1) 1)) - (inst sub rem divisor) - (emit-label label-2)))))) + (cond + ((zerop depth) + (inst unimp 0)) + (t + (let ((label-1 (gen-label)) + (label-2 (gen-label))) + (inst cmp divisor rem) + (inst b :geu label-1) + (inst nop) + (inst sll divisor 1) + (do-loop (1- depth)) + (inst srl divisor 1) + (inst cmp divisor rem) + (emit-label label-1) + (inst b :gtu label-2) + (inst sll quo 1) + (inst add quo (if tagged (fixnumize 1) 1)) + (inst sub rem divisor) + (emit-label label-2)))))) (do-loop (if tagged 30 32)))) (define-assembly-routine (positive-fixnum-truncate - (:note "unsigned fixnum truncate") - (:cost 45) - (:translate truncate) - (:policy :fast-safe) - (:arg-types positive-fixnum positive-fixnum) - (:result-types positive-fixnum positive-fixnum)) - ((:arg dividend any-reg nl0-offset) - (:arg divisor any-reg nl1-offset) + (:note "unsigned fixnum truncate") + (:cost 45) + (:translate truncate) + (:policy :fast-safe) + (:arg-types positive-fixnum positive-fixnum) + (:result-types positive-fixnum positive-fixnum)) + ((:arg dividend any-reg nl0-offset) + (:arg divisor any-reg nl1-offset) - (:res quo any-reg nl2-offset) - (:res rem any-reg nl0-offset)) + (:res quo any-reg nl2-offset) + (:res rem any-reg nl0-offset)) (let ((error (generate-error-code nil division-by-zero-error - dividend divisor))) + dividend divisor))) (inst cmp divisor) (inst b :eq error)) @@ -312,23 +312,23 @@ (define-assembly-routine (fixnum-truncate - (:note "fixnum truncate") - (:cost 50) - (:policy :fast-safe) - (:translate truncate) - (:arg-types tagged-num tagged-num) - (:result-types tagged-num tagged-num)) - ((:arg dividend any-reg nl0-offset) - (:arg divisor any-reg nl1-offset) + (:note "fixnum truncate") + (:cost 50) + (:policy :fast-safe) + (:translate truncate) + (:arg-types tagged-num tagged-num) + (:result-types tagged-num tagged-num)) + ((:arg dividend any-reg nl0-offset) + (:arg divisor any-reg nl1-offset) - (:res quo any-reg nl2-offset) - (:res rem any-reg nl0-offset) + (:res quo any-reg nl2-offset) + (:res rem any-reg nl0-offset) + + (:temp quo-sign any-reg nl5-offset) + (:temp rem-sign any-reg nargs-offset)) - (:temp quo-sign any-reg nl5-offset) - (:temp rem-sign any-reg nargs-offset)) - (let ((error (generate-error-code nil division-by-zero-error - dividend divisor))) + dividend divisor))) (inst cmp divisor) (inst b :eq error)) @@ -361,24 +361,24 @@ (define-assembly-routine (signed-truncate - (:note "(signed-byte 32) truncate") - (:cost 60) - (:policy :fast-safe) - (:translate truncate) - (:arg-types signed-num signed-num) - (:result-types signed-num signed-num)) + (:note "(signed-byte 32) truncate") + (:cost 60) + (:policy :fast-safe) + (:translate truncate) + (:arg-types signed-num signed-num) + (:result-types signed-num signed-num)) - ((:arg dividend signed-reg nl0-offset) - (:arg divisor signed-reg nl1-offset) + ((:arg dividend signed-reg nl0-offset) + (:arg divisor signed-reg nl1-offset) - (:res quo signed-reg nl2-offset) - (:res rem signed-reg nl0-offset) + (:res quo signed-reg nl2-offset) + (:res rem signed-reg nl0-offset) + + (:temp quo-sign signed-reg nl5-offset) + (:temp rem-sign signed-reg nargs-offset)) - (:temp quo-sign signed-reg nl5-offset) - (:temp rem-sign signed-reg nargs-offset)) - (let ((error (generate-error-code nil division-by-zero-error - dividend divisor))) + dividend divisor))) (inst cmp divisor) (inst b :eq error)) @@ -415,37 +415,37 @@ (macrolet ((define-cond-assem-rtn (name translate static-fn cmp) `(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 nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) - (inst andcc zero-tn x fixnum-tag-mask) - (inst b :ne DO-STATIC-FN) - (inst andcc zero-tn y fixnum-tag-mask) - (inst b :eq DO-COMPARE) - (inst cmp x y) - - DO-STATIC-FN - (inst ld code-tn null-tn (static-fun-offset ',static-fn)) - (inst li nargs (fixnumize 2)) - (inst move ocfp cfp-tn) - (inst j code-tn - (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) - (inst move cfp-tn csp-tn) - - DO-COMPARE - (inst b ,cmp done) - (load-symbol res t) - (inst move res null-tn) - DONE))) + (: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 nargs any-reg nargs-offset) + (:temp ocfp any-reg ocfp-offset)) + (inst andcc zero-tn x fixnum-tag-mask) + (inst b :ne DO-STATIC-FN) + (inst andcc zero-tn y fixnum-tag-mask) + (inst b :eq DO-COMPARE) + (inst cmp x y) + + DO-STATIC-FN + (inst ld code-tn null-tn (static-fun-offset ',static-fn)) + (inst li nargs (fixnumize 2)) + (inst move ocfp cfp-tn) + (inst j code-tn + (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) + (inst move cfp-tn csp-tn) + + DO-COMPARE + (inst b ,cmp done) + (load-symbol res t) + (inst move res null-tn) + DONE))) (define-cond-assem-rtn generic-< < two-arg-< :lt) (define-cond-assem-rtn generic-<= <= two-arg-<= :le) @@ -454,19 +454,19 @@ (define-assembly-routine (generic-eql - (:cost 10) - (:return-style :full-call) - (:policy :safe) - (:translate eql) - (: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) + (:cost 10) + (:return-style :full-call) + (:policy :safe) + (:translate eql) + (:save-p t)) + ((:arg x (descriptor-reg any-reg) a0-offset) + (:arg y (descriptor-reg any-reg) a1-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) + (:res res descriptor-reg a0-offset) + + (:temp lra descriptor-reg lra-offset) + (:temp nargs any-reg nargs-offset) + (:temp ocfp any-reg ocfp-offset)) (inst cmp x y) (inst b :eq RETURN-T) (inst andcc zero-tn x fixnum-tag-mask) @@ -484,26 +484,26 @@ (inst li nargs (fixnumize 2)) (inst move ocfp cfp-tn) (inst j code-tn - (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) + (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) (inst move cfp-tn csp-tn) RETURN-T (load-symbol res t)) (define-assembly-routine (generic-= - (:cost 10) - (:return-style :full-call) - (:policy :safe) - (:translate =) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) + (:cost 10) + (:return-style :full-call) + (:policy :safe) + (: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) + (:res res descriptor-reg a0-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) + (:temp lra descriptor-reg lra-offset) + (:temp nargs any-reg nargs-offset) + (:temp ocfp any-reg ocfp-offset)) (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FN) (inst andcc zero-tn y fixnum-tag-mask) @@ -520,26 +520,26 @@ (inst li nargs (fixnumize 2)) (inst move ocfp cfp-tn) (inst j code-tn - (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) + (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) (inst move cfp-tn csp-tn) RETURN-T (load-symbol res t)) (define-assembly-routine (generic-/= - (:cost 10) - (:return-style :full-call) - (:policy :safe) - (:translate /=) - (:save-p t)) - ((:arg x (descriptor-reg any-reg) a0-offset) - (:arg y (descriptor-reg any-reg) a1-offset) + (:cost 10) + (:return-style :full-call) + (:policy :safe) + (: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) + (:res res descriptor-reg a0-offset) - (:temp lra descriptor-reg lra-offset) - (:temp nargs any-reg nargs-offset) - (:temp ocfp any-reg ocfp-offset)) + (:temp lra descriptor-reg lra-offset) + (:temp nargs any-reg nargs-offset) + (:temp ocfp any-reg ocfp-offset)) (inst cmp x y) (inst b :eq RETURN-NIL) (inst andcc zero-tn x fixnum-tag-mask) @@ -556,7 +556,7 @@ (inst li nargs (fixnumize 2)) (inst move ocfp cfp-tn) (inst j code-tn - (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) + (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag)) (inst move cfp-tn csp-tn) RETURN-NIL Index: array.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/assembly/sparc/array.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- array.lisp 13 May 2005 18:30:45 -0000 1.3 +++ array.lisp 14 Jul 2005 16:30:12 -0000 1.4 @@ -12,18 +12,18 @@ (in-package "SB!VM") (define-assembly-routine (allocate-vector - (:policy :fast-safe) - (:translate allocate-vector) - (:arg-types positive-fixnum - positive-fixnum - positive-fixnum)) - ((:arg type any-reg a0-offset) - (:arg length any-reg a1-offset) - (:arg words any-reg a2-offset) - (:res result descriptor-reg a0-offset) + (:policy :fast-safe) + (:translate allocate-vector) + (:arg-types positive-fixnum + positive-fixnum + positive-fixnum)) + ((:arg type any-reg a0-offset) + (:arg length any-reg a1-offset) + (:arg words any-reg a2-offset) + (:res result descriptor-reg a0-offset) - (:temp ndescr non-descriptor-reg nl0-offset) - (:temp vector descriptor-reg a3-offset)) + (:temp ndescr non-descriptor-reg nl0-offset) + (:temp vector descriptor-reg a3-offset)) (pseudo-atomic () (inst or vector alloc-tn other-pointer-lowtag) ;; boxed words == unboxed bytes Index: assem-rtns.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/assembly/sparc/assem-rtns.lisp,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- assem-rtns.lisp 15 Feb 2002 17:10:02 -0000 1.1 +++ assem-rtns.lisp 14 Jul 2005 16:30:12 -0000 1.2 @@ -69,7 +69,7 @@ (inst add dst n-word-bytes) (inst b :gt loop) (inst subcc count (fixnumize 1)) - + (inst b done) (inst nop) @@ -85,12 +85,12 @@ DEFAULT-A5-AND-ON (inst move a5 null-tn) DONE - + ;; Clear the stack. (move ocfp-tn cfp-tn) (move cfp-tn ocfp) (inst add csp-tn ocfp-tn nvals) - + ;; Return. (lisp-return lra)) @@ -127,7 +127,7 @@ ;; Calculate NARGS (as a fixnum) (inst sub nargs csp-tn args) - + ;; Load the argument regs (must do this now, 'cause the blt might ;; trash these locations) (inst ld a0 args (* 0 n-word-bytes)) @@ -142,7 +142,7 @@ (inst b :le done) (inst add src args (* n-word-bytes register-arg-count)) (inst add dst cfp-tn (* n-word-bytes register-arg-count)) - + LOOP ;; Copy one arg. (inst ld temp src) @@ -151,7 +151,7 @@ (inst addcc count (fixnumize -1)) (inst b :gt loop) (inst add dst dst n-word-bytes) - + DONE ;; We are done. Do the jump. (loadw temp lexenv closure-fun-slot fun-pointer-lowtag) @@ -162,32 +162,32 @@ ;;;; Non-local exit noise. (define-assembly-routine (unwind - (:return-style :none) - (:translate %continue-unwind) - (:policy :fast-safe)) - ((:arg block (any-reg descriptor-reg) a0-offset) - (:arg start (any-reg descriptor-reg) ocfp-offset) - (:arg count (any-reg descriptor-reg) nargs-offset) - (:temp lra descriptor-reg lra-offset) - (:temp cur-uwp any-reg nl0-offset) - (:temp next-uwp any-reg nl1-offset) - (:temp target-uwp any-reg nl2-offset)) + (:return-style :none) + (:translate %continue-unwind) + (:policy :fast-safe)) + ((:arg block (any-reg descriptor-reg) a0-offset) + (:arg start (any-reg descriptor-reg) ocfp-offset) + (:arg count (any-reg descriptor-reg) nargs-offset) + (:temp lra descriptor-reg lra-offset) + (:temp cur-uwp any-reg nl0-offset) + (:temp next-uwp any-reg nl1-offset) + (:temp target-uwp any-reg nl2-offset)) (declare (ignore start count)) (let ((error (generate-error-code nil invalid-unwind-error))) (inst cmp block) (inst b :eq error)) - + (load-symbol-value cur-uwp *current-unwind-protect-block*) (loadw target-uwp block unwind-block-current-uwp-slot) (inst cmp cur-uwp target-uwp) (inst b :ne do-uwp) (inst nop) - + (move cur-uwp block) DO-EXIT - + (loadw cfp-tn cur-uwp unwind-block-current-cont-slot) (loadw code-tn cur-uwp unwind-block-current-code-slot) (loadw lra cur-uwp unwind-block-entry-pc-slot) @@ -201,25 +201,25 @@ (define-assembly-routine (throw - (:return-style :none)) - ((:arg target descriptor-reg a0-offset) - (:arg start any-reg ocfp-offset) - (:arg count any-reg nargs-offset) - (:temp catch any-reg a1-offset) - (:temp tag descriptor-reg a2-offset) - (:temp temp non-descriptor-reg nl0-offset)) - + (:return-style :none)) + ((:arg target descriptor-reg a0-offset) + (:arg start any-reg ocfp-offset) + (:arg count any-reg nargs-offset) + (:temp catch any-reg a1-offset) + (:temp tag descriptor-reg a2-offset) + (:temp temp non-descriptor-reg nl0-offset)) + (declare (ignore start count)) (load-symbol-value catch *current-catch-block*) - + loop - + (let ((error (generate-error-code nil unseen-throw-tag-error target))) (inst cmp catch) (inst b :eq error) (inst nop)) - + (loadw tag catch catch-block-tag-slot) (inst cmp tag target) (inst b :eq exit) @@ -227,9 +227,9 @@ (loadw catch catch catch-block-previous-catch-slot) (inst b loop) (inst nop) - + exit - + (move target catch) (inst li temp (make-fixup 'unwind :assembly-routine)) (inst j temp) Index: support.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/assembly/sparc/support.lisp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- support.lisp 2 Aug 2004 12:29:30 -0000 1.2 +++ support.lisp 14 Jul 2005 16:30:12 -0000 1.3 @@ -15,59 +15,59 @@ (ecase style ((:raw :none) (let ((temp (make-symbol "TEMP")) - (lip (make-symbol "LIP"))) - (values - `((inst jali ,lip ,temp (make-fixup ',name :assembly-routine)) - (inst nop)) - `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1)) - ,temp) - (:temporary (:scs (interior-reg) :from (:eval 0) :to (:eval 1)) - ,lip))))) + (lip (make-symbol "LIP"))) + (values + `((inst jali ,lip ,temp (make-fixup ',name :assembly-routine)) + (inst nop)) + `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1)) + ,temp) + (:temporary (:scs (interior-reg) :from (:eval 0) :to (:eval 1)) + ,lip))))) (:full-call (let ((temp (make-symbol "TEMP")) - (nfp-save (make-symbol "NFP-SAVE")) - (lra (make-symbol "LRA"))) + (nfp-save (make-symbol "NFP-SAVE")) + (lra (make-symbol "LRA"))) (values - `((let ((lra-label (gen-label)) - (cur-nfp (current-nfp-tn ,vop))) - (when cur-nfp - (store-stack-tn ,nfp-save cur-nfp)) - (inst compute-lra-from-code ,lra code-tn lra-label ,temp) - (note-next-instruction ,vop :call-site) - (inst ji ,temp (make-fixup ',name :assembly-routine)) - (inst nop) - (emit-return-pc lra-label) - (note-this-location ,vop :single-value-return) - (without-scheduling () - (move csp-tn ocfp-tn) - (inst nop)) - (inst compute-code-from-lra code-tn code-tn - lra-label ,temp) - (when cur-nfp - (load-stack-tn cur-nfp ,nfp-save)))) - `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1)) - ,temp) - (:temporary (:sc descriptor-reg :offset lra-offset - :from (:eval 0) :to (:eval 1)) - ,lra) - (:temporary (:scs (control-stack) :offset nfp-save-offset) - ,nfp-save) - (:save-p :compute-only))))))) + `((let ((lra-label (gen-label)) + (cur-nfp (current-nfp-tn ,vop))) + (when cur-nfp + (store-stack-tn ,nfp-save cur-nfp)) + (inst compute-lra-from-code ,lra code-tn lra-label ,temp) + (note-next-instruction ,vop :call-site) + (inst ji ,temp (make-fixup ',name :assembly-routine)) + (inst nop) + (emit-return-pc lra-label) + (note-this-location ,vop :single-value-return) + (without-scheduling () + (move csp-tn ocfp-tn) + (inst nop)) + (inst compute-code-from-lra code-tn code-tn + lra-label ,temp) + (when cur-nfp + (load-stack-tn cur-nfp ,nfp-save)))) + `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1)) + ,temp) + (:temporary (:sc descriptor-reg :offset lra-offset + :from (:eval 0) :to (:eval 1)) + ,lra) + (:temporary (:scs (control-stack) :offset nfp-save-offset) + ,nfp-save) + (:save-p :compute-only))))))) (!def-vm-support-routine generate-return-sequence (style) (ecase style (:raw `((inst j - (make-random-tn :kind :normal - :sc (sc-or-lose 'interior-reg) - :offset lip-offset) - 8) + (make-random-tn :kind :normal + :sc (sc-or-lose 'interior-reg) + :offset lip-offset) + 8) (inst nop))) (:full-call `((lisp-return (make-random-tn :kind :normal - :sc (sc-or-lose 'descriptor-reg) - :offset lra-offset) - :offset 2))) + :sc (sc-or-lose 'descriptor-reg) + :offset lra-offset) + :offset 2))) (:none))) (defun return-machine-address (scp) |