;;; 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
;;; 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
(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))
popl %eax
ret
.size GNAME(alloc_16_to_edi),.-GNAME(alloc_16_to_edi)
+
+
+/* Called from lisp when an inline allocation overflows.
+ Every register except the result needs to be preserved.
+ We depend on C to preserve ebx, esi, edi, and ebp.
+ But where necessary must save eax, ecx, edx. */
+
+#ifdef LISP_FEATURE_SB_THREAD
+#define START_REGION %fs:THREAD_ALLOC_REGION_OFFSET
+#define DISPLACEMENT $7
+#else
+#define START_REGION boxed_region
+#define DISPLACEMENT $6
+#endif
+/* This routine handles an overflow with eax=crfp+size. So the
+ size=eax-crfp. */
+ .align align_4byte
+ .globl GNAME(alloc_overflow_eax)
+ .type GNAME(alloc_overflow_eax),@function
+GNAME(alloc_overflow_eax):
+ pushl %ecx # Save ecx
+ pushl %edx # Save edx
+ /* Calculate the size for the allocation. */
+ subl START_REGION,%eax
+ pushl %eax # Push the size
+ call GNAME(alloc)
+ addl $4,%esp # pop the size arg.
+ popl %edx # Restore edx.
+ popl %ecx # Restore ecx.
+ addl DISPLACEMENT,(%esp) # Adjust the return address to skip the next inst.
+ ret
+ .size GNAME(alloc_overflow_eax),.-GNAME(alloc_overflow_eax)
+
+ .align align_4byte
+ .globl GNAME(alloc_overflow_ecx)
+ .type GNAME(alloc_overflow_ecx),@function
+GNAME(alloc_overflow_ecx):
+ pushl %eax # Save eax
+ pushl %edx # Save edx
+ /* Calculate the size for the allocation. */
+ subl START_REGION,%ecx
+ pushl %ecx # Push the size
+ call GNAME(alloc)
+ addl $4,%esp # pop the size arg.
+ movl %eax,%ecx # setup the destination.
+ popl %edx # Restore edx.
+ popl %eax # Restore eax.
+ addl DISPLACEMENT,(%esp) # Adjust the return address to skip the next inst.
+ ret
+ .size GNAME(alloc_overflow_ecx),.-GNAME(alloc_overflow_ecx)
+
+ .align align_4byte
+ .globl GNAME(alloc_overflow_edx)
+ .type GNAME(alloc_overflow_edx),@function
+GNAME(alloc_overflow_edx):
+ pushl %eax # Save eax
+ pushl %ecx # Save ecx
+ /* Calculate the size for the allocation. */
+ subl START_REGION,%edx
+ pushl %edx # Push the size
+ call GNAME(alloc)
+ addl $4,%esp # pop the size arg.
+ movl %eax,%edx # setup the destination.
+ popl %ecx # Restore ecx.
+ popl %eax # Restore eax.
+ addl DISPLACEMENT,(%esp) # Adjust the return address to skip the next inst.
+ ret
+ .size GNAME(alloc_overflow_edx),.-GNAME(alloc_overflow_edx)
+
+/* This routine handles an overflow with ebx=crfp+size. So the
+ size=ebx-crfp. */
+ .align align_4byte
+ .globl GNAME(alloc_overflow_ebx)
+ .type GNAME(alloc_overflow_ebx),@function
+GNAME(alloc_overflow_ebx):
+ pushl %eax # Save eax
+ pushl %ecx # Save ecx
+ pushl %edx # Save edx
+ /* Calculate the size for the allocation. */
+ subl START_REGION,%ebx
+ pushl %ebx # Push the size
+ call GNAME(alloc)
+ addl $4,%esp # pop the size arg.
+ movl %eax,%ebx # setup the destination.
+ popl %edx # Restore edx.
+ popl %ecx # Restore ecx.
+ popl %eax # Restore eax.
+ addl DISPLACEMENT,(%esp) # Adjust the return address to skip the next inst.
+ ret
+ .size GNAME(alloc_overflow_ebx),.-GNAME(alloc_overflow_ebx)
+
+/* This routine handles an overflow with esi=crfp+size. So the
+ size=esi-crfp. */
+ .align align_4byte
+ .globl GNAME(alloc_overflow_esi)
+ .type GNAME(alloc_overflow_esi),@function
+GNAME(alloc_overflow_esi):
+ pushl %eax # Save eax
+ pushl %ecx # Save ecx
+ pushl %edx # Save edx
+ /* Calculate the size for the allocation. */
+ subl START_REGION,%esi
+ pushl %esi # Push the size
+ call GNAME(alloc)
+ addl $4,%esp # pop the size arg.
+ movl %eax,%esi # setup the destination.
+ popl %edx # Restore edx.
+ popl %ecx # Restore ecx.
+ popl %eax # Restore eax.
+ addl DISPLACEMENT,(%esp) # Adjust the return address to skip the next inst.
+ ret
+ .size GNAME(alloc_overflow_esi),.-GNAME(alloc_overflow_esi)
+
+ .align align_4byte
+ .globl GNAME(alloc_overflow_edi)
+ .type GNAME(alloc_overflow_edi),@function
+GNAME(alloc_overflow_edi):
+ pushl %eax # Save eax
+ pushl %ecx # Save ecx
+ pushl %edx # Save edx
+ /* Calculate the size for the allocation. */
+ subl START_REGION,%edi
+ pushl %edi # Push the size
+ call GNAME(alloc)
+ addl $4,%esp # pop the size arg.
+ movl %eax,%edi # setup the destination.
+ popl %edx # Restore edx.
+ popl %ecx # Restore ecx.
+ popl %eax # Restore eax.
+ addl DISPLACEMENT,(%esp) # Adjust the return address to skip the next inst.
+ ret
+ .size GNAME(alloc_overflow_edi),.-GNAME(alloc_overflow_edi)
.align align_4byte,0x90
.globl GNAME(post_signal_tramp)
.size GNAME(post_signal_tramp),.-GNAME(post_signal_tramp)
-\f
-#ifdef GENCGC_INLINE_ALLOC /* LISP_FEATURE_GENCGC */
-
-/* These routines are called from Lisp when an inline allocation
- * overflows. Every register except the result needs to be preserved.
- * We depend on C to preserve ebx, esi, edi, and ebp.
- * But where necessary must save eax, ecx, edx. */
-
-/* This routine handles an overflow with eax=crfp+size. So the
- * size=eax-crfp. */
- .align align_4byte
- .globl GNAME(alloc_overflow_eax)
- .type GNAME(alloc_overflow_eax),@function
-GNAME(alloc_overflow_eax):
- pushl %ecx # Save ecx
- pushl %edx # Save edx
- /* Calculate the size for the allocation. */
- subl GNAME(current_region_free_pointer),%eax
- pushl %eax # Push the size
- call GNAME(alloc)
- addl $4,%esp # pop the size arg.
- popl %edx # Restore edx.
- popl %ecx # Restore ecx.
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
- .size GNAME(alloc_overflow_eax),.-GNAME(alloc_overflow_eax)
-
-/* This routine handles an overflow with ecx=crfp+size. So the
- * size=ecx-crfp. */
- .align align_4byte
- .globl GNAME(alloc_overflow_ecx)
- .type GNAME(alloc_overflow_ecx),@function
-GNAME(alloc_overflow_ecx):
- pushl %eax # Save eax
- pushl %edx # Save edx
- /* Calculate the size for the allocation. */
- subl GNAME(current_region_free_pointer),%ecx
- pushl %ecx # Push the size
- call GNAME(alloc)
- addl $4,%esp # pop the size arg.
- movl %eax,%ecx # setup the destination.
- popl %edx # Restore edx.
- popl %eax # Restore eax.
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
- .size GNAME(alloc_overflow_ecx),.-GNAME(alloc_overflow_ecx)
-
-/* This routine handles an overflow with edx=crfp+size. So the
- * size=edx-crfp. */
- .align align_4byte
- .globl GNAME(alloc_overflow_edx)
- .type GNAME(alloc_overflow_edx),@function
-GNAME(alloc_overflow_edx):
- pushl %eax # Save eax
- pushl %ecx # Save ecx
- /* Calculate the size for the allocation. */
- subl GNAME(current_region_free_pointer),%edx
- pushl %edx # Push the size
- call GNAME(alloc)
- addl $4,%esp # pop the size arg.
- movl %eax,%edx # setup the destination.
- popl %ecx # Restore ecx.
- popl %eax # Restore eax.
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
- .size GNAME(alloc_overflow_edx),.-GNAME(alloc_overflow_edx)
-
-/* This routine handles an overflow with ebx=crfp+size. So the
- * size=ebx-crfp. */
- .align align_4byte
- .globl GNAME(alloc_overflow_ebx)
- .type GNAME(alloc_overflow_ebx),@function
-GNAME(alloc_overflow_ebx):
- pushl %eax # Save eax
- pushl %ecx # Save ecx
- pushl %edx # Save edx
- /* Calculate the size for the allocation. */
- subl GNAME(current_region_free_pointer),%ebx
- pushl %ebx # Push the size
- call GNAME(alloc)
- addl $4,%esp # pop the size arg.
- movl %eax,%ebx # setup the destination.
- popl %edx # Restore edx.
- popl %ecx # Restore ecx.
- popl %eax # Restore eax.
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
- .size GNAME(alloc_overflow_ebx),.-GNAME(alloc_overflow_ebx)
-
-/* This routine handles an overflow with esi=crfp+size. So the
- * size=esi-crfp. */
- .align align_4byte
- .globl GNAME(alloc_overflow_esi)
- .type GNAME(alloc_overflow_esi),@function
-GNAME(alloc_overflow_esi):
- pushl %eax # Save eax
- pushl %ecx # Save ecx
- pushl %edx # Save edx
- /* Calculate the size for the allocation. */
- subl GNAME(current_region_free_pointer),%esi
- pushl %esi # Push the size
- call GNAME(alloc)
- addl $4,%esp # pop the size arg.
- movl %eax,%esi # setup the destination.
- popl %edx # Restore edx.
- popl %ecx # Restore ecx.
- popl %eax # Restore eax.
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
- .size GNAME(alloc_overflow_esi),.-GNAME(alloc_overflow_esi)
-
-/* This routine handles an overflow with edi=crfp+size. So the
- * size=edi-crfp. */
- .align align_4byte
- .globl GNAME(alloc_overflow_edi)
- .type GNAME(alloc_overflow_edi),@function
-GNAME(alloc_overflow_edi):
- pushl %eax # Save eax
- pushl %ecx # Save ecx
- pushl %edx # Save edx
- /* Calculate the size for the allocation. */
- subl GNAME(current_region_free_pointer),%edi
- pushl %edi # Push the size
- call GNAME(alloc)
- addl $4,%esp # pop the size arg.
- movl %eax,%edi # setup the destination.
- popl %edx # Restore edx.
- popl %ecx # Restore ecx.
- popl %eax # Restore eax.
- addl $6,(%esp) # Adjust the return address to skip the next inst.
- ret
- .size GNAME(alloc_overflow_edi),.-GNAME(alloc_overflow_edi)
-
-#endif
-
.end
projects / sbcl.git / commitdiff