From 65fbb5c536e243c7284d736e999c28546d05d6ae Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Fri, 10 May 2002 14:48:24 +0000 Subject: [PATCH] Abstract all allocation through the ALLOCATION macro. --- assembly/sparc/array.lisp | 15 ++++++++++----- compiler/sparc/alloc.lisp | 38 ++++++++++++++------------------------ compiler/sparc/array.lisp | 5 ++--- compiler/sparc/call.lisp | 9 ++++----- compiler/sparc/macros.lisp | 31 ++++++++++++++++++++++++++----- 5 files changed, 56 insertions(+), 42 deletions(-) diff --git a/assembly/sparc/array.lisp b/assembly/sparc/array.lisp index 738dd0a5a..d4829a284 100644 --- a/assembly/sparc/array.lisp +++ b/assembly/sparc/array.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/assembly/sparc/array.lisp,v 1.5 1995/02/27 00:51:49 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/array.lisp,v 1.6 2002/05/10 14:48:23 toy Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/array.lisp,v 1.5 1995/02/27 00:51:49 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/array.lisp,v 1.6 2002/05/10 14:48:23 toy Exp $ ;;; ;;; This file contains the support routines for arrays and vectors. ;;; @@ -32,16 +32,21 @@ (:temp ndescr non-descriptor-reg nl0-offset) (:temp vector descriptor-reg a3-offset)) (pseudo-atomic () - (inst or vector alloc-tn vm:other-pointer-type) (inst add ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes)) (inst andn ndescr 7) - (inst add alloc-tn ndescr) + (allocation vector ndescr other-pointer-type) (inst srl ndescr type vm:word-shift) (storew ndescr vector 0 vm:other-pointer-type) (storew length vector vm:vector-length-slot vm:other-pointer-type)) ;; This makes sure the zero byte at the end of a string is paged in so ;; the kernel doesn't bitch if we pass it the string. - (storew zero-tn alloc-tn 0) + ;; + ;; This used to write to the word after the last allocated word. I + ;; (RLT) made it write to the last allocated word, which is where + ;; the zero-byte of the string is. Look at the deftransform for + ;; make-array in array-tran.lisp. For strings we always allocate + ;; enough space to hold the zero-byte. + (storew zero-tn alloc-tn -1) (move result vector)) diff --git a/compiler/sparc/alloc.lisp b/compiler/sparc/alloc.lisp index 53dade920..40dd14cf9 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.12 2001/05/18 16:22:53 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/alloc.lisp,v 1.13 2002/05/10 14:48:23 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -46,9 +46,8 @@ temp))))) (let* ((cons-cells (if star (1- num) num)) (alloc (* (pad-data-block cons-size) cons-cells))) - (pseudo-atomic (:extra alloc) - (inst andn res alloc-tn lowtag-mask) - (inst or res list-pointer-type) + (pseudo-atomic () + (allocation res alloc list-pointer-type) (move ptr res) (dotimes (i (1- cons-cells)) (storew (maybe-load (tn-ref-tn things)) ptr @@ -80,6 +79,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) (:generator 100 @@ -92,9 +92,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 or result alloc-tn other-pointer-type) - (inst add alloc-tn boxed) - (inst add alloc-tn unboxed) + (inst add size boxed unboxed) + (allocation result size other-pointer-type) (inst sll ndescr boxed (- type-bits word-shift)) (inst or ndescr code-header-type) (storew ndescr result 0 other-pointer-type) @@ -123,9 +122,8 @@ (:results (result :scs (descriptor-reg))) (:generator 10 (let ((size (+ length closure-info-offset))) - (pseudo-atomic (:extra (pad-data-block size)) - (inst andn result alloc-tn lowtag-mask) - (inst or result function-pointer-type) + (pseudo-atomic () + (allocation result (pad-data-block size) function-pointer-type) (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))) @@ -158,12 +156,8 @@ (:results (result :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) (:generator 4 - (pseudo-atomic (:extra (pad-data-block words)) - (cond ((logbitp (1- lowtag-bits) lowtag) - (inst or result alloc-tn lowtag)) - (t - (inst andn result alloc-tn lowtag-mask) - (inst or result lowtag))) + (pseudo-atomic () + (allocation result (pad-data-block words) lowtag) (when type (inst li temp (logior (ash (1- words) type-bits) type)) (storew temp result 0 lowtag))))) @@ -175,6 +169,7 @@ (:ignore name) (:results (result :scs (descriptor-reg))) (:temporary (:scs (any-reg)) bytes header) + (:temporary (:scs (descriptor-reg)) temp) (:generator 6 (inst add bytes extra (* (1+ words) word-bytes)) (inst sll header bytes (- type-bits 2)) @@ -182,11 +177,6 @@ (inst and bytes (lognot lowtag-mask)) (pseudo-atomic () ;; Need to be careful if the lowtag and the pseudo-atomic flag - ;; are not compatible. - (cond ((logbitp (1- lowtag-bits) lowtag) - (inst or result alloc-tn lowtag)) - (t - (inst andn result alloc-tn lowtag-mask) - (inst or result lowtag))) - (storew header result 0 lowtag) - (inst add alloc-tn alloc-tn bytes)))) + ;; are not compatible + (allocation result bytes lowtag) + (storew header result 0 lowtag)))) diff --git a/compiler/sparc/array.lisp b/compiler/sparc/array.lisp index f682960ea..42e1953e9 100644 --- a/compiler/sparc/array.lisp +++ b/compiler/sparc/array.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/array.lisp,v 1.22 2001/05/18 16:22:53 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/array.lisp,v 1.23 2002/05/10 14:48:24 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -31,10 +31,9 @@ (:results (result :scs (descriptor-reg))) (:generator 0 (pseudo-atomic () - (inst or header alloc-tn other-pointer-type) (inst add ndescr rank (* (1+ array-dimensions-offset) vm:word-bytes)) (inst andn ndescr 4) - (inst add alloc-tn ndescr) + (allocation header ndescr other-pointer-type) (inst add ndescr rank (fixnum (1- vm:array-dimensions-offset))) (inst sll ndescr ndescr vm:type-bits) (inst or ndescr ndescr type) diff --git a/compiler/sparc/call.lisp b/compiler/sparc/call.lisp index c876b6afc..70cf8b1ad 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.29 2001/09/25 21:28:04 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/call.lisp,v 1.30 2002/05/10 14:48:24 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1189,12 +1189,11 @@ default-value-8 (pseudo-atomic () (assemble () ;; Allocate a cons (2 words) for each item. - (inst andn result alloc-tn lowtag-mask) - (inst or result list-pointer-type) - (move dst result) (inst sll temp count 1) + (allocation result temp list-pointer-type) (inst b enter) - (inst add alloc-tn temp) + (move dst result) + ;; Compute the next cons and store it in the current one. LOOP diff --git a/compiler/sparc/macros.lisp b/compiler/sparc/macros.lisp index 58c2eea51..b08fe960b 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.15 2001/09/24 15:59:43 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.16 2002/05/10 14:48:24 toy Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.15 2001/09/24 15:59:43 toy Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.16 2002/05/10 14:48:24 toy Exp $ ;;; ;;; This file contains various useful macros for generating SPARC code. ;;; @@ -169,6 +169,28 @@ ;;;; Storage allocation: +;; Allocation macro +;; +;; This macro does the appropriate stuff to allocate space. +;; +;; The allocated space is stored in RESULT-TN with the lowtag LOWTAG +;; applied. The amount of space to be allocated is SIZE bytes (which +;; must be a multiple of the lisp object size). +(defmacro allocation (result-tn size lowtag) + ;; 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. + `(if (logbitp (1- lowtag-bits) ,lowtag) + (progn + (inst or ,result-tn alloc-tn ,lowtag) + (inst add alloc-tn ,size)) + (progn + (inst andn ,result-tn alloc-tn lowtag-mask) + (inst or ,result-tn ,lowtag) + (inst add alloc-tn ,size)))) + + (defmacro with-fixed-allocation ((result-tn temp-tn type-code size) &body body) "Do stuff to allocate an other-pointer object of fixed Size with a single @@ -178,8 +200,8 @@ initializes the object." (once-only ((result-tn result-tn) (temp-tn temp-tn) (type-code type-code) (size size)) - `(pseudo-atomic (:extra (pad-data-block ,size)) - (inst or ,result-tn alloc-tn other-pointer-type) + `(pseudo-atomic () + (allocation ,result-tn (pad-data-block ,size) other-pointer-type) (inst li ,temp-tn (logior (ash (1- ,size) type-bits) ,type-code)) (storew ,temp-tn ,result-tn 0 other-pointer-type) ,@body))) @@ -466,7 +488,6 @@ ,@forms ;; Reset the pseudo-atomic flag (without-scheduling () - #+nil (inst taddcctv alloc-tn (- ,n-extra 4)) ;; Remove the pseudo-atomic flag (inst add alloc-tn (- ,n-extra 4)) ;; Check to see if pseudo-atomic interrupted flag is set (bit 0 = 1) -- GitLab