From: Alastair B. <lis...@us...> - 2010-08-07 15:19:39
|
Update of /cvsroot/sbcl/sbcl/src/compiler/ppc In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv24866/src/compiler/ppc Modified Files: call.lisp macros.lisp vm.lisp Log Message: 1.0.41.23: ppc: Calling-convention fixes for LRA handling during return. * For GC purposes, seven times never clobber reg_CODE while still within a component. * During return processing, store the LRA in reg_LRA instead of reg_CODE (see previous point). * During fun end breakpoint processing, use reg_LRA instead of reg_CODE to store the LRA object on ppc. * The upshot of this is that, during returns, the program counter and link register can always be found within the body of reg_CODE or reg_LRA, no matter which side of the blr instruction we check, thus always allowing the GC to correctly update them. Index: call.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/call.lisp,v retrieving revision 1.23 retrieving revision 1.24 diff -u -d -r1.23 -r1.24 --- call.lisp 21 May 2009 21:03:37 -0000 1.23 +++ call.lisp 7 Aug 2010 15:19:29 -0000 1.24 @@ -258,7 +258,7 @@ (note-this-location vop :single-value-return) (move csp-tn ocfp-tn) (inst nop)) - (inst compute-code-from-lra code-tn code-tn lra-label temp)) + (inst compute-code-from-lra code-tn lra-tn lra-label temp)) (let ((regs-defaulted (gen-label)) (defaulting-done (gen-label)) (default-stack-vals (gen-label))) @@ -314,7 +314,7 @@ (inst b defaulting-done) (trace-table-entry trace-table-normal)))))) - (inst compute-code-from-lra code-tn code-tn lra-label temp))) + (inst compute-code-from-lra code-tn lra-tn lra-label temp))) (values)) @@ -344,7 +344,7 @@ (inst b variable-values) (inst nop)) - (inst compute-code-from-lra code-tn code-tn lra-label temp) + (inst compute-code-from-lra code-tn lra-tn lra-label temp) (inst addi csp-tn csp-tn 4) (storew (first *register-arg-tns*) csp-tn -1) (inst subi start csp-tn 4) @@ -355,7 +355,7 @@ (assemble (*elsewhere*) (trace-table-entry trace-table-fun-prologue) (emit-label variable-values) - (inst compute-code-from-lra code-tn code-tn lra-label temp) + (inst compute-code-from-lra code-tn lra-tn lra-label temp) (do ((arg *register-arg-tns* (rest arg)) (i 0 (1+ i))) ((null arg)) @@ -882,14 +882,16 @@ ;;; Return a single value using the unknown-values convention. (define-vop (return-single) - (:args (old-fp :scs (any-reg)) - (return-pc :scs (descriptor-reg)) + (:args (old-fp :scs (any-reg) :to :eval) + (return-pc :scs (descriptor-reg) :target lra) (value)) (:ignore value) + (:temporary (:sc descriptor-reg :offset lra-offset :from (:argument 1)) lra) (:temporary (:scs (interior-reg)) lip) (:vop-var vop) (:generator 6 (trace-table-entry trace-table-fun-epilogue) + (move lra return-pc) ;; Clear the number stack. (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp @@ -900,7 +902,7 @@ (move csp-tn cfp-tn) (move cfp-tn old-fp) ;; Out of here. - (lisp-return return-pc lip :offset 2) + (lisp-return lra lip :offset 2) (trace-table-entry trace-table-normal))) ;;; Do unknown-values return of a fixed number of values. The Values are @@ -918,7 +920,7 @@ (define-vop (return) (:args (old-fp :scs (any-reg)) - (return-pc :scs (descriptor-reg) :to (:eval 1)) + (return-pc :scs (descriptor-reg) :to (:eval 1) :target lra) (values :more t)) (:ignore values) (:info nvals) @@ -926,12 +928,14 @@ (:temporary (:sc descriptor-reg :offset a1-offset :from (:eval 0)) a1) (:temporary (:sc descriptor-reg :offset a2-offset :from (:eval 0)) a2) (:temporary (:sc descriptor-reg :offset a3-offset :from (:eval 0)) a3) + (:temporary (:sc descriptor-reg :offset lra-offset :from (:eval 1)) lra) (:temporary (:sc any-reg :offset nargs-offset) nargs) (:temporary (:sc any-reg :offset ocfp-offset) val-ptr) (:temporary (:scs (interior-reg)) lip) (:vop-var vop) (:generator 6 (trace-table-entry trace-table-fun-epilogue) + (move lra return-pc) ;; Clear the number stack. (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp @@ -943,7 +947,7 @@ (move csp-tn cfp-tn) (move cfp-tn old-fp) ;; Out of here. - (lisp-return return-pc lip :offset 2)) + (lisp-return lra lip :offset 2)) (t ;; Establish the values pointer and values count. (move val-ptr cfp-tn) @@ -957,7 +961,7 @@ (dolist (reg (subseq (list a0 a1 a2 a3) nvals)) (move reg null-tn))) ;; And away we go. - (lisp-return return-pc lip))) + (lisp-return lra lip))) (trace-table-entry trace-table-normal))) ;;; Do unknown-values return of an arbitrary number of values (passed @@ -981,6 +985,7 @@ (:vop-var vop) (:generator 13 (trace-table-entry trace-table-fun-epilogue) + (move lra lra-arg) (let ((not-single (gen-label))) ;; Clear the number stack. (let ((cur-nfp (current-nfp-tn vop))) @@ -999,7 +1004,6 @@ ;; Nope, not the single case. (emit-label not-single) (move old-fp old-fp-arg) - (move lra lra-arg) (move vals vals-arg) (move nvals nvals-arg) (inst lr temp (make-fixup 'return-multiple :assembly-routine)) Index: macros.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/macros.lisp,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- macros.lisp 6 Aug 2010 18:49:42 -0000 1.18 +++ macros.lisp 7 Aug 2010 15:19:29 -0000 1.19 @@ -79,16 +79,13 @@ ;; (loadw ,lip ,function function-code-offset function-pointer-type) (inst addi ,lip ,function (- (* n-word-bytes simple-fun-code-offset) fun-pointer-lowtag)) (inst mtctr ,lip) - (move code-tn ,function) (inst bctr))) -(defmacro lisp-return (return-pc lip &key (offset 0) (frob-code t)) +(defmacro lisp-return (return-pc lip &key (offset 0)) "Return to RETURN-PC." `(progn (inst addi ,lip ,return-pc (- (* (1+ ,offset) n-word-bytes) other-pointer-lowtag)) (inst mtlr ,lip) - ,@(if frob-code - `((move code-tn ,return-pc))) (inst blr))) (defmacro emit-return-pc (label) Index: vm.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/vm.lisp,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- vm.lisp 6 Jun 2010 19:53:44 -0000 1.17 +++ vm.lisp 7 Aug 2010 15:19:29 -0000 1.18 @@ -261,6 +261,7 @@ (defregtn null descriptor-reg) (defregtn code descriptor-reg) (defregtn alloc any-reg) + (defregtn lra descriptor-reg) (defregtn nargs any-reg) (defregtn bsp any-reg) |