Update of /cvsroot/sbcl/sbcl/src/compiler/x86
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13663/src/compiler/x86
Modified Files:
macros.lisp
Log Message:
0.8.3.11
Inline allocation for GENCGC ...
... add allocation-inline, which does direct access to
allocation region fields based on %fs (for threads)
or &boxed_region (unithread), falling through to
assembler routines and eventual call to alloc()
if we've run out of space in the region
... relevant assembler glue, partly borrowed from CMUCL
but with changes to do thread-local access when appropriate
... patch alloc() to use boxed_region instead of
all_threads->region on unithread builds
... clean up cut/pasted code in allocation-notinline
Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/macros.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- macros.lisp 30 Mar 2004 16:58:28 -0000 1.20
+++ macros.lisp 29 Jul 2004 22:41:27 -0000 1.21
@@ -135,7 +135,7 @@
;;; eventually invoke the C alloc() function. Once upon a time
;;; (before threads) allocation within an alloc_region could also be
;;; done inline, with the aid of two C symbols storing the current
-;;; allocation region boundaries; however, C cymbols are global.
+;;; allocation region boundaries; however, C symbols are global.
;;; C calls for allocation don't /seem/ to make an awful lot of
;;; difference to speed. Guessing from historical context, it looks
@@ -145,13 +145,6 @@
;;; no need for that overhead. Still, inline alloc would be a neat
;;; addition someday
-(defvar *maybe-use-inline-allocation* t) ; FIXME unused
-
-;;; Emit code to allocate an object with a size in bytes given by
-;;; SIZE. The size may be an integer of a TN. If Inline is a VOP
-;;; node-var then it is used to make an appropriate speed vs size
-;;; decision.
-
(defun allocation-dynamic-extent (alloc-tn size)
(inst sub esp-tn size)
;; FIXME: SIZE _should_ be double-word aligned (suggested but
@@ -166,84 +159,77 @@
(values))
(defun allocation-notinline (alloc-tn size)
- (flet ((load-size (dst-tn size)
- (unless (and (tn-p size) (location= alloc-tn size))
- (inst mov dst-tn size))))
- (let ((alloc-tn-offset (tn-offset alloc-tn)))
- ;; C call to allocate via dispatch routines. Each
- ;; destination has a special entry point. The size may be a
- ;; register or a constant.
- (ecase alloc-tn-offset
- (#.eax-offset
- (case size
- (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_eax")
- :foreign)))
- (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_eax")
- :foreign)))
- (t
- (load-size eax-tn size)
- (inst call (make-fixup (extern-alien-name "alloc_to_eax")
- :foreign)))))
- (#.ecx-offset
- (case size
- (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ecx")
- :foreign)))
- (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ecx")
- :foreign)))
- (t
- (load-size ecx-tn size)
- (inst call (make-fixup (extern-alien-name "alloc_to_ecx")
- :foreign)))))
- (#.edx-offset
- (case size
- (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edx")
- :foreign)))
- (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edx")
- :foreign)))
- (t
- (load-size edx-tn size)
- (inst call (make-fixup (extern-alien-name "alloc_to_edx")
- :foreign)))))
- (#.ebx-offset
- (case size
- (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ebx")
- :foreign)))
- (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ebx")
- :foreign)))
- (t
- (load-size ebx-tn size)
- (inst call (make-fixup (extern-alien-name "alloc_to_ebx")
- :foreign)))))
- (#.esi-offset
- (case size
- (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_esi")
- :foreign)))
- (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_esi")
- :foreign)))
- (t
- (load-size esi-tn size)
- (inst call (make-fixup (extern-alien-name "alloc_to_esi")
- :foreign)))))
- (#.edi-offset
- (case size
- (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edi")
- :foreign)))
- (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edi")
- :foreign)))
- (t
- (load-size edi-tn size)
- (inst call (make-fixup (extern-alien-name "alloc_to_edi")
- :foreign)))))))))
-
-;;; This macro should only be used inside a pseudo-atomic section,
-;;; which should also cover subsequent initialization of the object.
+ (let* ((alloc-tn-offset (tn-offset alloc-tn))
+ ;; C call to allocate via dispatch routines. Each
+ ;; destination has a special entry point. The size may be a
+ ;; register or a constant.
+ (tn-text (ecase alloc-tn-offset
+ (#.eax-offset "eax")
+ (#.ecx-offset "ecx")
+ (#.edx-offset "edx")
+ (#.ebx-offset "ebx")
+ (#.esi-offset "esi")
+ (#.edi-offset "edi")))
+ (size-text (case size (8 "8_") (16 "16_") (t ""))))
+ (unless (or (eql size 8) (eql size 16))
+ (unless (and (tn-p size) (location= alloc-tn size))
+ (inst mov alloc-tn size)))
+ (inst call (make-fixup (extern-alien-name
+ (concatenate 'string
+ "alloc_" size-text
+ "to_" tn-text))
+ :foreign))))
+
+(defun allocation-inline (alloc-tn size)
+ (let ((ok (gen-label))
+ (free-pointer
+ (make-ea :dword :disp
+ #!+sb-thread (* n-word-bytes thread-alloc-region-slot)
+ #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
+ :foreign)
+ :scale 1)) ; thread->alloc_region.free_pointer
+ (end-addr
+ (make-ea :dword :disp
+ #!+sb-thread (* n-word-bytes (1+ thread-alloc-region-slot))
+ #!-sb-thread (make-fixup (extern-alien-name "boxed_region")
+ :foreign 4)
+ :scale 1))) ; thread->alloc_region.end_addr
+ (unless (and (tn-p size) (location= alloc-tn size))
+ (inst mov alloc-tn size))
+ #!+sb-thread (inst fs-segment-prefix)
+ (inst add alloc-tn free-pointer)
+ #!+sb-thread (inst fs-segment-prefix)
+ (inst cmp alloc-tn end-addr)
+ (inst jmp :be OK)
+ (let ((dst (ecase (tn-offset alloc-tn)
+ (#.eax-offset "alloc_overflow_eax")
+ (#.ecx-offset "alloc_overflow_ecx")
+ (#.edx-offset "alloc_overflow_edx")
+ (#.ebx-offset "alloc_overflow_ebx")
+ (#.esi-offset "alloc_overflow_esi")
+ (#.edi-offset "alloc_overflow_edi"))))
+ (inst call (make-fixup (extern-alien-name dst) :foreign)))
+ (emit-label ok)
+ #!+sb-thread (inst fs-segment-prefix)
+ (inst xchg free-pointer alloc-tn))
+ (values))
+
+
+;;; Emit code to allocate an object with a size in bytes given by
+;;; SIZE. The size may be an integer or a TN. If Inline is a VOP
+;;; node-var then it is used to make an appropriate speed vs size
+;;; decision.
+
+;;; Allocation should only be used inside a pseudo-atomic section, which
+;;; should also cover subsequent initialization of the object.
+
;;; (FIXME: so why aren't we asserting this?)
+
(defun allocation (alloc-tn size &optional inline dynamic-extent)
- ;; FIXME: since it appears that inline allocation is gone, we should
- ;; remove the INLINE parameter and *MAYBE-USE-INLINE-ALLOCATION*
- (declare (ignore inline))
(cond
(dynamic-extent (allocation-dynamic-extent alloc-tn size))
+ ((or (null inline) (policy inline (>= speed space)))
+ (allocation-inline alloc-tn size))
(t (allocation-notinline alloc-tn size)))
(values))
|