From af09965ae903c6c422cc1a82099a24b3b9db883c Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Sat, 3 Mar 2007 01:52:07 +0000 Subject: [PATCH] compiler/ir2tran.lisp: o Implement stack clearing stuff for ppc. compiler/ppc/call.lisp: o Implement stack clearing for xep-allocate-frame and allocate-frame, mostly cargo-culting the sparc version. --- compiler/ir2tran.lisp | 12 +++++------ compiler/ppc/call.lisp | 48 +++++++++++++++++++++++++++++++++++++++--- 2 files changed, 51 insertions(+), 9 deletions(-) diff --git a/compiler/ir2tran.lisp b/compiler/ir2tran.lisp index 75ff9c213..e150c7ed7 100644 --- a/compiler/ir2tran.lisp +++ b/compiler/ir2tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.74 2003/08/25 20:51:00 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.75 2007/03/03 01:52:06 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -23,12 +23,12 @@ funcallable-instance-lexenv)) -#+sparc +#+(or sparc ppc) (defvar *always-clear-stack* nil "Always perform stack clearing if non-NIL, independent of the compilation policy") -#+sparc +#+(or sparc ppc) (defvar *enable-stack-clearing* t "If non-NIL and the compilation policy allows, stack clearing is enabled.") @@ -840,7 +840,7 @@ compilation policy") (vop current-fp node block old-fp) (vop allocate-frame node block (environment-info (lambda-environment fun)) - #+sparc + #+(or sparc ppc) (or *always-clear-stack* (and *enable-stack-clearing* (policy node (= speed 3) (>= space 2)))) @@ -1133,7 +1133,7 @@ compilation policy") (cond ((and (optional-dispatch-p ef) (optional-dispatch-more-entry ef)) ;; Special case the xep-allocate-frame + copy-more-arg case. (vop xep-allocate-frame node block start-label t - #+sparc + #+(or sparc ppc) (or *always-clear-stack* (and *enable-stack-clearing* (policy node (= speed 3) (>= space 2))))) @@ -1141,7 +1141,7 @@ compilation policy") (t ;; No more args, so normal entry. (vop xep-allocate-frame node block start-label nil - #+sparc + #+(or sparc ppc) (or *always-clear-stack* (and *enable-stack-clearing* (policy node (>= space 2) (= speed 3))))))) diff --git a/compiler/ppc/call.lisp b/compiler/ppc/call.lisp index 6daf539cb..fdbc0047e 100644 --- a/compiler/ppc/call.lisp +++ b/compiler/ppc/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/call.lisp,v 1.14 2006/11/03 03:29:34 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.15 2007/03/03 01:52:07 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -168,7 +168,7 @@ (define-vop (xep-allocate-frame) - (:info start-lab copy-more-arg-follows) + (:info start-lab copy-more-arg-follows clear-memory-p) (:ignore copy-more-arg-follows) (:vop-var vop) (:temporary (:scs (non-descriptor-reg)) temp) @@ -186,6 +186,30 @@ (emit-label entry-label) ;; The start of the actual code. (inst compute-code-from-fn code-tn lip-tn entry-label temp)) + ;; Rob says we should zero out the words that are allocated for + ;; the args that are passed in registers and also zero out the + ;; words from CSP to CFP+size. + (when clear-memory-p + + ;; Zero out the args that correspond to register args + (dotimes (k register-arg-count) + (inst stw zero-tn cfp-tn (* k vm:word-bytes))) + + ;; Zero out memory from CSP to CFP+size + (let ((zero-out-mem (gen-label)) + (loop-test (gen-label))) + + (inst addi temp cfp-tn + (* vm:word-bytes (1- (sb-allocated-size 'control-stack)))) + (inst b loop-test) + + (emit-label zero-out-mem) + (inst stw zero-tn csp-tn (- vm:word-bytes)) + (emit-label loop-test) + (inst cmpw csp-tn temp) + (inst addi csp-tn csp-tn vm:word-bytes) + (inst blt zero-out-mem))) + ;; Build our stack frames. (inst addi csp-tn cfp-tn (* vm:word-bytes (sb-allocated-size 'control-stack))) @@ -200,10 +224,28 @@ (define-vop (allocate-frame) (:results (res :scs (any-reg)) (nfp :scs (any-reg))) - (:info callee) + (:info callee clear-memory-p) + (:temporary (:scs (non-descriptor-reg)) temp) + (:temporary (:scs (non-descriptor-reg)) ptr) (:generator 2 (trace-table-entry trace-table-function-prologue) (move res csp-tn) + (when clear-memory-p + ;; Rob Maclaclan says we should zero out this memory. + (let ((zero-out-loop (gen-label)) + (zero-out-test (gen-label))) + (inst li temp (* vm:word-bytes (sb-allocated-size 'control-stack))) + (move ptr csp-tn) + (inst b zero-out-test) + + (emit-label zero-out-loop) + (emit-label zero-out-test) + (inst addi ptr ptr vm:word-bytes) + (inst stw zero-tn ptr 0) + (inst addic. temp temp (- vm:word-bytes)) + (inst bgt zero-out-loop) + )) + (inst addi csp-tn csp-tn (* vm:word-bytes (sb-allocated-size 'control-stack))) (when (ir2-environment-number-stack-p callee) -- GitLab