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