From 279847906ad7a7174b2df75ac28758ffa3dc2496 Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Tue, 26 Aug 2003 11:50:04 +0000 Subject: [PATCH] Merge the Sparc dynamic-extent changes to HEAD. Still not functional. --- compiler/sparc/alloc.lisp | 50 ++++++++++++++++++++++++++++++++------ compiler/sparc/call.lisp | 4 +-- compiler/sparc/macros.lisp | 8 +++--- 3 files changed, 47 insertions(+), 15 deletions(-) diff --git a/compiler/sparc/alloc.lisp b/compiler/sparc/alloc.lisp index 5a761b607..34d53709f 100644 --- a/compiler/sparc/alloc.lisp +++ b/compiler/sparc/alloc.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/sparc/alloc.lisp,v 1.16 2003/08/22 13:20:03 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/alloc.lisp,v 1.17 2003/08/26 11:50:04 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -16,6 +16,38 @@ (in-package "SPARC") + +;;;; Dynamic-Extent. + +;;; +;;; Take an arg where to move the stack pointer instead of returning +;;; it via :results, because the former generates a single move. +;;; +(define-vop (%dynamic-extent-start) + (:args (saved-stack-pointer :scs (any-reg control-stack))) + (:results) + (:policy :safe) + (:generator 0 + (sc-case saved-stack-pointer + (control-stack + (let ((offset (tn-offset saved-stack-pointer))) + (storew csp-tn cfp-tn offset))) + (any-reg + (format t "DE-START Using any-reg ~A~%" saved-stack-pointer) + (move saved-stack-pointer csp-tn))))) + +(define-vop (%dynamic-extent-end) + (:args (saved-stack-pointer :scs (any-reg control-stack))) + (:results) + (:policy :safe) + (:generator 0 + (sc-case saved-stack-pointer + (control-stack + (let ((offset (tn-offset saved-stack-pointer))) + (loadw csp-tn cfp-tn offset))) + (any-reg + (format t "DE-END Using any-reg ~A~%" saved-stack-pointer) + (move csp-tn saved-stack-pointer))))) ;;;; LIST and LIST* @@ -25,7 +57,8 @@ (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result) res) - (:info num) + (:temporary (:scs (non-descriptor-reg)) alloc-temp) + (:info num dynamic-extent) (:results (result :scs (descriptor-reg))) (:variant-vars star) (:policy :safe) @@ -47,7 +80,9 @@ (let* ((cons-cells (if star (1- num) num)) (alloc (* (pad-data-block cons-size) cons-cells))) (pseudo-atomic () - (allocation res alloc list-pointer-type :temp-tn temp) + (allocation res alloc list-pointer-type + :stack-p dynamic-extent + :temp-tn alloc-temp) (move ptr res) (dotimes (i (1- cons-cells)) (storew (maybe-load (tn-ref-tn things)) ptr @@ -82,7 +117,6 @@ (:temporary (:scs (non-descriptor-reg)) size) (:temporary (:scs (any-reg) :from (:argument 0)) boxed) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) unboxed) - ;;(:temporary (:scs (any-reg)) gc-temp) (:generator 100 (inst add boxed boxed-arg (fixnumize (1+ code-trace-table-offset-slot))) (inst and boxed (lognot lowtag-mask)) @@ -119,13 +153,11 @@ (:info length dynamic-extent) (:temporary (:scs (non-descriptor-reg)) temp) (:results (result :scs (descriptor-reg))) - (:node-var node) (:generator 10 (let ((size (+ length closure-info-offset))) (pseudo-atomic () (allocation result (pad-data-block size) function-pointer-type :stack-p dynamic-extent - :node node :temp-tn temp) (inst li temp (logior (ash (1- size) type-bits) closure-header-type)) (storew temp result 0 function-pointer-type))) @@ -154,13 +186,15 @@ (define-vop (fixed-alloc) (:args) - (:info name words type lowtag) + (:info name words type lowtag dynamic-extent) (:ignore name) (:results (result :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) (:generator 4 (pseudo-atomic () - (allocation result (pad-data-block words) lowtag :temp-tn temp) + (allocation result (pad-data-block words) lowtag + :stack-p dynamic-extent + :temp-tn temp) (when type (inst li temp (logior (ash (1- words) type-bits) type)) (storew temp result 0 lowtag))))) diff --git a/compiler/sparc/call.lisp b/compiler/sparc/call.lisp index caae79012..7b2bdff45 100644 --- a/compiler/sparc/call.lisp +++ b/compiler/sparc/call.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/sparc/call.lisp,v 1.33 2003/08/06 14:45:50 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/call.lisp,v 1.34 2003/08/26 11:50:04 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1178,7 +1178,6 @@ default-value-8 (:results (result :scs (descriptor-reg))) (:translate %listify-rest-args) (:policy :safe) - (:node-var node) (:generator 20 (move context context-arg) (move count count-arg) @@ -1194,7 +1193,6 @@ default-value-8 (inst sll temp count 1) (allocation result temp list-pointer-type :stack-p dynamic-extent - :node node :temp-tn dst) (inst b enter) (move dst result) diff --git a/compiler/sparc/macros.lisp b/compiler/sparc/macros.lisp index 7a0586506..51a60edb6 100644 --- a/compiler/sparc/macros.lisp +++ b/compiler/sparc/macros.lisp @@ -5,11 +5,11 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.21 2003/08/22 13:20:03 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.22 2003/08/26 11:50:04 toy Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.21 2003/08/22 13:20:03 toy Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.22 2003/08/26 11:50:04 toy Exp $ ;;; ;;; This file contains various useful macros for generating SPARC code. ;;; @@ -205,12 +205,12 @@ ;; because a temp register is needed to do inline allocation. ;; TEMP-TN, in this case, can be any register, since it holds a ;; double-word aligned address (essentially a fixnum). -(defmacro allocation (result-tn size lowtag &key stack-p node temp-tn) +(defmacro allocation (result-tn size lowtag &key stack-p temp-tn) ;; We assume we're in a pseudo-atomic so the pseudo-atomic bit is ;; set. If the lowtag also has a 1 bit in the same position, we're all ;; set. Otherwise, we need to zap out the lowtag from alloc-tn, and ;; then or in the lowtag. - `(cond ((and ,stack-p ,node (trust-dynamic-extent-declaration-p ,node)) + `(cond (,stack-p ;; Stack allocation ;; ;; The control stack grows up, so round up CSP to a -- GitLab