Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler/sparc alloc.lisp,1.6,1.7 call.lisp,1.7,1.8 macros.lisp,1.11,1.12
|
From: Christophe R. <cr...@us...> - 2005-06-20 16:53:17
|
Update of /cvsroot/sbcl/sbcl/src/compiler/sparc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25122/src/compiler/sparc Modified Files: alloc.lisp call.lisp macros.lisp Log Message: 0.9.1.63: DX for sparc. Index: alloc.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/alloc.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- alloc.lisp 11 Jun 2005 20:46:20 -0000 1.6 +++ alloc.lisp 20 Jun 2005 16:52:54 -0000 1.7 @@ -12,6 +12,10 @@ (in-package "SB!VM") ;;;; LIST and LIST* +(defoptimizer (list stack-allocate-result) ((&rest args)) + (not (null args))) +(defoptimizer (list* stack-allocate-result) ((&rest args)) + (not (null (rest args)))) (define-vop (list-or-list*) (:args (things :more t)) @@ -23,6 +27,7 @@ (:results (result :scs (descriptor-reg))) (:variant-vars star) (:policy :safe) + (:node-var node) (:generator 0 (cond ((zerop num) (move result null-tn)) @@ -38,11 +43,17 @@ (control-stack (load-stack-tn temp ,tn) temp))))) - (let* ((cons-cells (if star (1- num) num)) + (let* ((dx-p (node-stack-allocate-p node)) + (cons-cells (if star (1- num) num)) (alloc (* (pad-data-block cons-size) cons-cells))) - (pseudo-atomic (:extra alloc) - (inst andn res alloc-tn lowtag-mask) - (inst or res list-pointer-lowtag) + (pseudo-atomic (:extra (if dx-p 0 alloc)) + (let ((allocation-area-tn (if dx-p csp-tn alloc-tn))) + (when dx-p + (align-csp res)) + (inst andn res allocation-area-tn lowtag-mask) + (inst or res list-pointer-lowtag) + (when dx-p + (inst add csp-tn csp-tn alloc))) (move ptr res) (dotimes (i (1- cons-cells)) (storew (maybe-load (tn-ref-tn things)) ptr @@ -116,17 +127,23 @@ (define-vop (make-closure) (:args (function :to :save :scs (descriptor-reg))) (:info length stack-allocate-p) - (:ignore stack-allocate-p) (:temporary (:scs (non-descriptor-reg)) temp) (:results (result :scs (descriptor-reg))) (:generator 10 - (let ((size (+ length closure-info-offset))) - (pseudo-atomic (:extra (pad-data-block size)) - (inst andn result alloc-tn lowtag-mask) - (inst or result fun-pointer-lowtag) + (let* ((size (+ length closure-info-offset)) + (alloc-size (pad-data-block size))) + (pseudo-atomic (:extra (if stack-allocate-p 0 alloc-size)) + (cond (stack-allocate-p + (align-csp temp) + (inst andn result csp-tn lowtag-mask) + (inst or result fun-pointer-lowtag) + (inst add csp-tn alloc-size)) + (t + (inst andn result alloc-tn lowtag-mask) + (inst or result fun-pointer-lowtag))) (inst li temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag)) - (storew temp result 0 fun-pointer-lowtag))) - (storew function result closure-fun-slot fun-pointer-lowtag))) + (storew temp result 0 fun-pointer-lowtag)) + (storew function result closure-fun-slot fun-pointer-lowtag)))) ;;; The compiler likes to be able to directly make value cells. (define-vop (make-value-cell) Index: call.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/call.lisp,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- call.lisp 4 May 2005 10:35:51 -0000 1.7 +++ call.lisp 20 Jun 2005 16:52:54 -0000 1.8 @@ -1068,8 +1068,10 @@ (:variant 0 0) (:translate %more-arg)) - ;;; Turn more arg (context, count) into a list. +(defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args)) + t) + (define-vop (listify-rest-args) (:args (context-arg :target context :scs (descriptor-reg)) (count-arg :target count :scs (any-reg))) @@ -1081,32 +1083,39 @@ (:results (result :scs (descriptor-reg))) (:translate %listify-rest-args) (:policy :safe) + (:node-var node) (:generator 20 - (move context context-arg) - (move count count-arg) - ;; Check to see if there are any arguments. - (inst cmp count) - (inst b :eq done) - (move result null-tn) + (let* ((enter (gen-label)) + (loop (gen-label)) + (done (gen-label)) + (dx-p (node-stack-allocate-p node)) + (alloc-area-tn (if dx-p csp-tn alloc-tn))) + (move context context-arg) + (move count count-arg) + ;; Check to see if there are any arguments. + (inst cmp count) + (inst b :eq done) + (move result null-tn) - ;; We need to do this atomically. - (pseudo-atomic () - (assemble () + ;; We need to do this atomically. + (pseudo-atomic () + (when dx-p + (align-csp temp)) ;; Allocate a cons (2 words) for each item. - (inst andn result alloc-tn lowtag-mask) + (inst andn result alloc-area-tn lowtag-mask) (inst or result list-pointer-lowtag) (move dst result) (inst sll temp count 1) (inst b enter) - (inst add alloc-tn temp) + (inst add alloc-area-tn temp) ;; Compute the next cons and store it in the current one. - LOOP + (emit-label loop) (inst add dst dst (* 2 n-word-bytes)) (storew dst dst -1 list-pointer-lowtag) ;; Grab one value. - ENTER + (emit-label enter) (loadw temp context) (inst add context context n-word-bytes) @@ -1119,8 +1128,8 @@ (storew temp dst 0 list-pointer-lowtag) ;; NIL out the last cons. - (storew null-tn dst 1 list-pointer-lowtag))) - DONE)) + (storew null-tn dst 1 list-pointer-lowtag)) + (emit-label done)))) ;;; Return the location and size of the more arg glob created by Copy-More-Arg. Index: macros.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/macros.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- macros.lisp 13 May 2005 18:30:46 -0000 1.11 +++ macros.lisp 20 Jun 2005 16:52:55 -0000 1.12 @@ -150,6 +150,16 @@ (storew ,temp-tn ,result-tn 0 other-pointer-lowtag) ,@body))) +(defun align-csp (temp) + (let ((aligned (gen-label))) + ;; FIXME: why use a TEMP? Why not just ZERO-TN? + (inst andcc temp csp-tn lowtag-mask) + (if (member :sparc-v9 *backend-subfeatures*) + (inst b :eq aligned :pt) + (inst b :eq aligned)) + (storew zero-tn csp-tn 0) ; sneaky use of delay slot + (inst add csp-tn csp-tn n-word-bytes) + (emit-label aligned))) ;;;; Error Code (eval-when (:compile-toplevel :load-toplevel :execute) |