From a90bef303e5a5be7f21bdf990d3cad7c78e51c16 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Sun, 8 Aug 2004 11:15:12 +0000 Subject: [PATCH] Define allocation macro to handle allocation. Use it. (Incomplete, but everything should still work.) --- assembly/ppc/array.lisp | 5 ++--- compiler/ppc/alloc.lisp | 14 +++++++------- compiler/ppc/array.lisp | 6 +++--- compiler/ppc/macros.lisp | 35 ++++++++++++++++++++++++++++++++++- 4 files changed, 46 insertions(+), 14 deletions(-) diff --git a/assembly/ppc/array.lisp b/assembly/ppc/array.lisp index cd6dac467..0887e0494 100644 --- a/assembly/ppc/array.lisp +++ b/assembly/ppc/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.2 2003/08/03 11:27:51 gerd Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.3 2004/08/08 11:15:11 rtoy Exp $ ;;; ;;; This file contains the support routines for arrays and vectors. ;;; @@ -31,10 +31,9 @@ (:temp pa-flag non-descriptor-reg nl3-offset) (:temp vector descriptor-reg a3-offset)) (pseudo-atomic (pa-flag) - (inst ori vector alloc-tn vm:other-pointer-type) (inst addi ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes)) (inst clrrwi ndescr ndescr lowtag-bits) - (inst add alloc-tn alloc-tn ndescr) + (allocation vector ndescr other-pointer-type) (inst srwi ndescr type vm:word-shift) (storew ndescr vector 0 vm:other-pointer-type) (storew length vector vm:vector-length-slot vm:other-pointer-type)) diff --git a/compiler/ppc/alloc.lisp b/compiler/ppc/alloc.lisp index e773f04b7..5dddf30c2 100644 --- a/compiler/ppc/alloc.lisp +++ b/compiler/ppc/alloc.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/alloc.lisp,v 1.5 2004/07/25 18:15:52 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/alloc.lisp,v 1.6 2004/08/08 11:15:11 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -43,6 +43,7 @@ (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result) res) (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) + (:temporary (:scs (non-descriptor-reg)) alloc-temp) (:info num dynamic-extent) (:results (result :scs (descriptor-reg))) (:variant-vars star) @@ -64,9 +65,8 @@ temp))))) (let* ((cons-cells (if star (1- num) num)) (alloc (* (pad-data-block cons-size) cons-cells))) - (pseudo-atomic (pa-flag :extra alloc) - (inst clrrwi res alloc-tn lowtag-bits) - (inst ori res res list-pointer-type) + (pseudo-atomic (pa-flag) + (allocation res alloc list-pointer-type :temp-tn alloc-temp) (move ptr res) (dotimes (i (1- cons-cells)) (storew (maybe-load (tn-ref-tn things)) ptr @@ -98,6 +98,7 @@ (unboxed-arg :scs (any-reg))) (:results (result :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) ndescr) + (:temporary (:scs (non-descriptor-reg)) size) (:temporary (:scs (any-reg) :from (:argument 0)) boxed) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) unboxed) (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) @@ -111,9 +112,8 @@ ;; Note: we don't have to subtract off the 4 that was added by ;; pseudo-atomic, because oring in other-pointer-type just adds ;; it right back. - (inst ori result alloc-tn other-pointer-type) - (inst add alloc-tn alloc-tn boxed) - (inst add alloc-tn alloc-tn unboxed) + (inst add size boxed unboxed) + (allocation result size other-pointer-type :temp-tn ndescr) (inst slwi ndescr boxed (- type-bits word-shift)) (inst ori ndescr ndescr code-header-type) (storew ndescr result 0 other-pointer-type) diff --git a/compiler/ppc/array.lisp b/compiler/ppc/array.lisp index 99b26f7e1..77b9e93af 100644 --- a/compiler/ppc/array.lisp +++ b/compiler/ppc/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/array.lisp,v 1.4 2004/07/25 18:15:52 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/array.lisp,v 1.5 2004/08/08 11:15:12 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -29,13 +29,13 @@ (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header) (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) (:temporary (:scs (non-descriptor-reg)) ndescr) + (:temporary (:scs (non-descriptor-reg)) gc-temp) ; gencgc (:results (result :scs (descriptor-reg))) (:generator 0 (pseudo-atomic (pa-flag) - (inst ori header alloc-tn other-pointer-type) (inst addi ndescr rank (* (1+ array-dimensions-offset) vm:word-bytes)) (inst clrrwi ndescr ndescr lowtag-bits) - (inst add alloc-tn alloc-tn ndescr) + (allocation header ndescr other-pointer-type :temp-tn gc-temp) (inst addi ndescr rank (fixnumize (1- vm:array-dimensions-offset))) (inst slwi ndescr ndescr vm:type-bits) (inst or ndescr ndescr type) diff --git a/compiler/ppc/macros.lisp b/compiler/ppc/macros.lisp index 78db756e0..55a363a11 100644 --- a/compiler/ppc/macros.lisp +++ b/compiler/ppc/macros.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/macros.lisp,v 1.2 2004/07/25 18:15:52 pmai Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/macros.lisp,v 1.3 2004/08/08 11:15:12 rtoy Exp $ ;;; ;;; This file contains various useful macros for generating PC code. ;;; @@ -165,6 +165,21 @@ ;;;; Storage allocation: +(defmacro allocation (result-tn size lowtag &key stack-p temp-tn) + (declare (ignore stack-p temp-tn)) + (let ((alloc-size (gensym))) + `(let ((,alloc-size ,size)) + (if (logbitp (1- lowtag-bits) ,lowtag) + (progn + (inst ori ,result-tn alloc-tn ,lowtag)) + (progn + (inst clrrwi ,result-tn alloc-tn lowtag-bits) + (inst ori ,result-tn ,result-tn ,lowtag))) + (if (numberp ,alloc-size) + (inst addi alloc-tn alloc-tn ,alloc-size) + (inst add alloc-tn alloc-tn ,alloc-size))))) + +#+nil (defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size) &body body) "Do stuff to allocate an other-pointer object of fixed Size with a single @@ -180,6 +195,24 @@ (storew ,temp-tn ,result-tn 0 other-pointer-type) ,@body))) +(defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size + &key (lowtag other-pointer-type)) + &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 + Result-TN, and Temp-TN is a non-descriptor temp (which may be randomly used + 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) (flag-tn flag-tn) + (type-code type-code) (size size)) + `(pseudo-atomic (,flag-tn) + (allocation ,result-tn (pad-data-block ,size) ,lowtag + :temp-tn temp-tn) + (when ,type-code + (inst lr ,temp-tn (logior (ash (1- ,size) type-bits) ,type-code)) + (storew ,temp-tn ,result-tn 0 other-pointer-type)) + ,@body))) + ;;;; Type testing noise. -- GitLab