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