From 56a4d0b9b114ec4365ec5561396ee44f9b9f1d48 Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Mon, 22 Sep 2003 13:28:26 +0000
Subject: [PATCH] 	* src/compiler/sparc/macros.lisp
 (with-fixed-allocation): Extend 	macro to allow user-supplied lowtag
 and allow stack allocation.

	* src/compiler/sparc/alloc.lisp (make-closure): Use new
	with-fixed-allocation macro
	(fixed-alloc): Use new with-fixed-allocation macro.
---
 compiler/sparc/alloc.lisp  | 22 +++++++---------------
 compiler/sparc/macros.lisp | 21 +++++++++++++--------
 2 files changed, 20 insertions(+), 23 deletions(-)

diff --git a/compiler/sparc/alloc.lisp b/compiler/sparc/alloc.lisp
index 87cee08e4..b5915461d 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.18 2003/09/03 20:09:31 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/alloc.lisp,v 1.19 2003/09/22 13:28:26 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -153,13 +153,10 @@
   (:results (result :scs (descriptor-reg)))
   (:generator 10
     (let ((size (+ length closure-info-offset)))
-      (pseudo-atomic ()
-        (allocation result (pad-data-block size) function-pointer-type
-		    :stack-p dynamic-extent
-		    :temp-tn temp)
-	(inst li temp (logior (ash (1- size) type-bits) closure-header-type))
-	(storew temp result 0 function-pointer-type)))
-    (storew function result closure-function-slot function-pointer-type)))
+      (with-fixed-allocation (result temp closure-header-type size
+				     :lowtag function-pointer-type
+				     :stack-p dynamic-extent))
+      (storew function result closure-function-slot function-pointer-type))))
 
 ;;; The compiler likes to be able to directly make value cells.
 ;;; 
@@ -189,13 +186,8 @@
   (:results (result :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 4
-    (pseudo-atomic ()
-      (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)))))
+    (with-fixed-allocation (result temp type words :lowtag lowtag :stack-p dynamic-extent)
+      )))
 
 (define-vop (var-alloc)
   (:args (extra :scs (any-reg)))
diff --git a/compiler/sparc/macros.lisp b/compiler/sparc/macros.lisp
index 8ad2a923e..1de30e8f6 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.24 2003/09/05 16:49:35 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.25 2003/09/22 13:28:26 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.24 2003/09/05 16:49:35 toy Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.25 2003/09/22 13:28:26 toy Exp $
 ;;;
 ;;; This file contains various useful macros for generating SPARC code.
 ;;;
@@ -275,7 +275,9 @@
 	    (inst or ,result-tn ,lowtag)))))
 
 
-(defmacro with-fixed-allocation ((result-tn temp-tn type-code size)
+(defmacro with-fixed-allocation ((result-tn temp-tn type-code size
+					    &key (lowtag other-pointer-type)
+					    stack-p)
 				 &body body)
   "Do stuff to allocate an other-pointer object of fixed Size with a single
   word header having the specified Type-Code.  The result is placed in
@@ -283,12 +285,15 @@
   by the body.)  The body is placed inside the PSEUDO-ATOMIC, and presumably
   initializes the object."
   (once-only ((result-tn result-tn) (temp-tn temp-tn)
-	      (type-code type-code) (size size))
+	      (type-code type-code) (size size)
+	      (lowtag lowtag))
     `(pseudo-atomic ()
-       (allocation ,result-tn (pad-data-block ,size) other-pointer-type
-	           #+gencgc :temp-tn #+gencgc ,temp-tn)
-       (inst li ,temp-tn (logior (ash (1- ,size) type-bits) ,type-code))
-       (storew ,temp-tn ,result-tn 0 other-pointer-type)
+       (allocation ,result-tn (pad-data-block ,size) ,lowtag
+	           #+gencgc :temp-tn #+gencgc ,temp-tn
+	           :stack-p ,stack-p)
+      (when ,type-code
+	(inst li ,temp-tn (logior (ash (1- ,size) type-bits) ,type-code))
+	(storew ,temp-tn ,result-tn 0 ,lowtag))
        ,@body)))
 
 
-- 
GitLab