From: Alastair Bridgewater Date: Sat, 7 Aug 2010 15:19:29 +0000 (+0000) Subject: 1.0.41.23: ppc: Calling-convention fixes for LRA handling during return. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8974d768a634343d958de35e9ce90cec235590a3;p=sbcl.git 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. --- diff --git a/src/assembly/ppc/assem-rtns.lisp b/src/assembly/ppc/assem-rtns.lisp index b0b7057..d6201a7 100644 --- a/src/assembly/ppc/assem-rtns.lisp +++ b/src/assembly/ppc/assem-rtns.lisp @@ -169,7 +169,7 @@ (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) - (lisp-return lra lip :frob-code nil) + (lisp-return lra lip) DO-UWP diff --git a/src/assembly/ppc/support.lisp b/src/assembly/ppc/support.lisp index 6b60e61..a6d9cfc 100644 --- a/src/assembly/ppc/support.lisp +++ b/src/assembly/ppc/support.lisp @@ -40,7 +40,7 @@ (without-scheduling () (move csp-tn ocfp-tn) (inst nop)) - (inst compute-code-from-lra code-tn code-tn + (inst compute-code-from-lra code-tn lra-tn lra-label ,temp) (when cur-nfp (load-stack-tn cur-nfp ,nfp-save)))) diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp index b490dee..229a078 100644 --- a/src/compiler/ppc/call.lisp +++ b/src/compiler/ppc/call.lisp @@ -258,7 +258,7 @@ default-value-8 (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 @@ default-value-8 (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 @@ default-value-8 (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 @@ default-value-8 (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 @@ default-value-8 ;;; 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 @@ default-value-8 (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 @@ default-value-8 (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 @@ default-value-8 (: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 @@ default-value-8 (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 @@ default-value-8 (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 @@ default-value-8 (: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 @@ default-value-8 ;; 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)) diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index e8de508..8b70474 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -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) diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index e31f474..e20d141 100644 --- a/src/compiler/ppc/vm.lisp +++ b/src/compiler/ppc/vm.lisp @@ -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) diff --git a/src/runtime/breakpoint.c b/src/runtime/breakpoint.c index 45639c4..a325693 100644 --- a/src/runtime/breakpoint.c +++ b/src/runtime/breakpoint.c @@ -173,10 +173,17 @@ void *handle_fun_end_breakpoint(os_context_t *context) lra = codeptr->constants[REAL_LRA_SLOT]; +#ifdef LISP_FEATURE_PPC + /* PPC now passes LRA objects in reg_LRA during return. Other + * platforms should as well, but haven't been fixed yet. */ + if (codeptr->constants[KNOWN_RETURN_P_SLOT] == NIL) + *os_context_register_addr(context, reg_LRA) = lra; +#else #ifdef reg_CODE if (codeptr->constants[KNOWN_RETURN_P_SLOT] == NIL) *os_context_register_addr(context, reg_CODE) = lra; #endif +#endif undo_fake_foreign_function_call(context); diff --git a/src/runtime/ppc-assem.S b/src/runtime/ppc-assem.S index 13175df..318d576 100644 --- a/src/runtime/ppc-assem.S +++ b/src/runtime/ppc-assem.S @@ -601,14 +601,14 @@ CSYMBOL(funcallable_instance_tramp) = . + 1 /* Compute the correct value for reg_CODE based on the LRA. This is a "simple" matter of subtracting a constant from - reg_CODE (where the LRA is stored by the return sequence) to + reg_LRA (where the LRA is stored by the return sequence) to obtain a tagged pointer to the enclosing code component. Both values are tagged OTHER_POINTER_LOWTAG, so we just have to account for the eight words (see calculation for RETURN_PC_HEADER_WIDETAG, above) between the two addresses. Restoring reg_CODE doesn't appear to be strictly necessary here, but let's observe the niceties.*/ - addi reg_CODE, reg_CODE, -32 + addi reg_CODE, reg_LRA, -32 /* Multiple values are stored relative to reg_OCFP, which we set to be the current top-of-stack. */ @@ -631,7 +631,7 @@ CSYMBOL(funcallable_instance_tramp) = . + 1 fun_end_breakpoint_multiple_values: /* Compute the correct value for reg_CODE. See the explanation for the single-value case, above. */ - addi reg_CODE, reg_CODE, -32 + addi reg_CODE, reg_LRA, -32 /* The actual magic trap. */ CSYMBOL(fun_end_breakpoint_trap): diff --git a/version.lisp-expr b/version.lisp-expr index 5d28a90..f356232 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.41.22" +"1.0.41.23"