From bef0d90d91cc9dcfed1247c7e5f111f28f55fdf1 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Fri, 30 Sep 2005 01:51:29 +0000 Subject: [PATCH] The callback trampoline needs to save at least r13 and r24 to prevent them from getting clobbered because the linkage-table trampoline uses them. This was causing the callback qsort example from Luis Oliviera to fail. There might be other registers that need saving. --- compiler/ppc/c-call.lisp | 210 ++++++++++++++++++++++----------------- 1 file changed, 120 insertions(+), 90 deletions(-) diff --git a/compiler/ppc/c-call.lisp b/compiler/ppc/c-call.lisp index 723ff51d2..b5d9db8ec 100644 --- a/compiler/ppc/c-call.lisp +++ b/compiler/ppc/c-call.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/c-call.lisp,v 1.8 2005/09/27 02:04:10 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/c-call.lisp,v 1.9 2005/09/30 01:51:29 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -421,99 +421,129 @@ a pointer to the arguments." (linkage-area-size 24)) (assemble (segment) - ;; To save our arguments, we follow the algorithm sketched in the - ;; "PowerPC Calling Conventions" section of that document. - (let ((words-processed 0) - (gprs (mapcar #'make-gpr '(3 4 5 6 7 8 9 10))) - (fprs (mapcar #'make-fpr '(1 2 3 4 5 6 7 8 9 10 11 12 13))) - (stack-pointer (make-gpr 1))) - (labels ((handle-arg (type words) - (let ((integerp (not (alien-float-type-p type))) - (offset (+ (* words-processed vm:word-bytes) - linkage-area-size))) - (cond - (integerp - (loop repeat words - for gpr = (pop gprs) - when gpr do - (inst stw gpr stack-pointer offset) - do (incf words-processed))) - ;; The handling of floats is a little ugly because we - ;; hard-code the number of words for single- and - ;; double-floats. - ((alien-single-float-type-p type) - (pop gprs) - (let ((fpr (pop fprs))) - (inst stfs fpr stack-pointer offset)) - (incf words-processed)) - ((alien-double-float-type-p type) - (setf gprs (cddr gprs)) - (let ((fpr (pop fprs))) - (inst stfd fpr stack-pointer offset)) - (incf words-processed 2)))))) - (mapc #'handle-arg argument-types argument-words))) + ;; Save the non-volatile (callee-saved) registers. The caller + ;; expects r13-r31 to be unchanged! The linkage table stuff + ;; uses r13 and r24 (aka reg_NFP and reg_A0), so we have to + ;; save these. Are the others we need to save? We don't save + ;; other important lisp regs like bsp, cfp, csp, alloc, and + ;; null, because they should been saved already. But what + ;; about the others? We don't use an FP registers, so no need + ;; to save any. + (let ((sp (make-gpr 1)) + (save-gprs (mapcar #'make-gpr '(13 24)))) + + (inst addi sp sp (- (* (length save-gprs) vm:word-bytes))) + (let ((save-offset 0)) + (dolist (r save-gprs) + (inst stw r sp save-offset) + (incf save-offset vm:word-bytes))) + + ;; To save our arguments, we follow the algorithm sketched in the + ;; "PowerPC Calling Conventions" section of that document. + (let ((words-processed 0) + (gprs (mapcar #'make-gpr '(3 4 5 6 7 8 9 10))) + (fprs (mapcar #'make-fpr '(1 2 3 4 5 6 7 8 9 10 11 12 13))) + (stack-pointer (make-gpr 1))) + (labels ((handle-arg (type words) + (let ((integerp (not (alien-float-type-p type))) + (offset (+ (* words-processed vm:word-bytes) + linkage-area-size))) + (cond + (integerp + (loop repeat words + for gpr = (pop gprs) + when gpr do + (inst stw gpr stack-pointer offset) + do (incf words-processed))) + ;; The handling of floats is a little ugly because we + ;; hard-code the number of words for single- and + ;; double-floats. + ((alien-single-float-type-p type) + (pop gprs) + (let ((fpr (pop fprs))) + (inst stfs fpr stack-pointer offset)) + (incf words-processed)) + ((alien-double-float-type-p type) + (setf gprs (cddr gprs)) + (let ((fpr (pop fprs))) + (inst stfd fpr stack-pointer offset)) + (incf words-processed 2)))))) + (mapc #'handle-arg argument-types argument-words))) - ;; Set aside room for the return area just below sp, then acutally call - ;; funcall3: funcall3 (call-callback, index, args, return-area) - ;; - ;; INDEX is fixnumized, ARGS and RETURN-AREA don't need to be because - ;; they're word-aligned. Kinda gross, but hey ... - (let* ((return-area-size (ceiling (or (alien-type-bits return-type) - 0) - vm:word-bits)) - (args-size (* 3 vm:word-bytes)) - (frame-size (+ linkage-area-size - (* return-area-size vm:word-bytes) - args-size))) - (destructuring-bind (sp r0 arg1 arg2 arg3 arg4) - (mapcar #'make-gpr '(1 0 3 4 5 6)) - (labels ((load-address-into (reg addr) + ;; Set aside room for the return area just below sp, then + ;; actually call funcall3: funcall3 (call-callback, index, + ;; args, return-area) + ;; + ;; INDEX is fixnumized, ARGS and RETURN-AREA don't need to + ;; be because they're word-aligned. Kinda gross, but hey + ;; ... + (let* ((return-area-size (ceiling (or (alien-type-bits return-type) + 0) + vm:word-bits)) + (args-size (* 3 vm:word-bytes)) + (frame-size (+ linkage-area-size + (* return-area-size vm:word-bytes) + args-size))) + (destructuring-bind (r0 arg1 arg2 arg3 arg4) + (mapcar #'make-gpr '(0 3 4 5 6)) + (flet ((load-address-into (reg addr) (let ((high (ldb (byte 16 16) addr)) (low (ldb (byte 16 0) addr))) - (inst li reg high) - (inst slwi reg reg 16) - (inst ori reg reg low)))) - ;; Setup the args - (load-address-into arg1 (alien::address-of-call-callback)) - (inst li arg2 (fixnumize index)) - (inst addi arg3 sp linkage-area-size) - (inst addi arg4 sp (- (* return-area-size vm:word-bytes))) - ;; FIXME! - ;; Save sp, setup the frame - (inst mflr r0) - (inst stw r0 sp (* 2 vm:word-bytes)) - (inst stwu sp sp (- frame-size)) - ;; Make the call - (load-address-into r0 (alien::address-of-funcall3)) - (inst mtlr r0) - (inst blrl)) + #+nil (inst li reg high) + #+nil (inst slwi reg reg 16) + #+nil (inst lis reg high) + #+nil (inst ori reg reg low) + (inst lr reg addr)))) + ;; Setup the args + #+nil(load-address-into arg1 (alien::address-of-call-callback)) + (inst lr arg1 (alien::address-of-call-callback)) + (inst li arg2 (fixnumize index)) + (inst addi arg3 sp linkage-area-size) + (inst addi arg4 sp (- (* return-area-size vm:word-bytes))) + ;; FIXME! + ;; Save sp, setup the frame + (inst mflr r0) + (inst stw r0 sp (* 2 vm:word-bytes)) + (inst stwu sp sp (- frame-size)) + ;; Make the call + #+nil(load-address-into r0 (alien::address-of-funcall3)) + (inst lr r0 (alien::address-of-funcall3)) + (inst mtlr r0) + (inst blrl)) - ;; We're back! Restore sp and lr, load the return value from just - ;; under sp, and return. - (inst lwz sp sp 0) - (inst lwz r0 sp (* 2 vm:word-bytes)) - (inst mtlr r0) - (etypecase return-type - ((or alien::integer$ alien::pointer$ alien::sap$ - alien::integer-64$) - (loop repeat ;;(ceiling return-area-size vm:word-bytes) - return-area-size - with gprs = (mapcar #'make-gpr '(3 4)) - for gpr = (pop gprs) - for offset downfrom (- vm:word-bytes) by vm:word-bytes - do (inst lwz gpr sp offset))) - (alien::single$ - ;; Get the FP value into F1 - (let ((f1 (make-fpr 1))) - (inst lfs f1 sp (- (* return-area-size vm:word-bytes)))) - ) - (alien::double$ - ;; Get the FP value into F1 - (let ((f1 (make-fpr 1))) - (inst lfd f1 sp (- (* return-area-size vm:word-bytes))))) - (alien::void$ - )) - (inst blr)))) + ;; We're back! Restore sp and lr, load the return value from just + ;; under sp, and return. + (inst lwz sp sp 0) + (inst lwz r0 sp (* 2 vm:word-bytes)) + (inst mtlr r0) + (etypecase return-type + ((or alien::integer$ alien::pointer$ alien::sap$ + alien::integer-64$) + (loop repeat ;;(ceiling return-area-size vm:word-bytes) + return-area-size + with gprs = (mapcar #'make-gpr '(3 4)) + for gpr = (pop gprs) + for offset downfrom (- vm:word-bytes) by vm:word-bytes + do (inst lwz gpr sp offset))) + (alien::single$ + ;; Get the FP value into F1 + (let ((f1 (make-fpr 1))) + (inst lfs f1 sp (- (* return-area-size vm:word-bytes)))) + ) + (alien::double$ + ;; Get the FP value into F1 + (let ((f1 (make-fpr 1))) + (inst lfd f1 sp (- (* return-area-size vm:word-bytes))))) + (alien::void$ + ;; Nothing to do + )) + ;; Restore the GPRS we saved. + (let ((save-offset 0)) + (dolist (r save-gprs) + (inst lwz r sp save-offset) + (incf save-offset vm:word-bytes))) + (inst addi sp sp (* (length save-gprs) vm:word-bytes)) + (inst blr))))) (let ((length (finalize-segment segment))) (prog1 (alien::segment-to-trampoline segment length) -- GitLab