+(defun allocation-tramp (alloc-tn size &optional ignored)
+ (declare (ignore ignored))
+ (inst push size)
+ (inst lea r13-tn (make-ea :qword
+ :disp (make-fixup "alloc_tramp" :foreign)))
+ (inst call r13-tn)
+ (inst pop alloc-tn)
+ (values))
+
+(defun allocation (alloc-tn size &optional ignored dynamic-extent)
+ (declare (ignore ignored))
+ (when dynamic-extent
+ (allocation-dynamic-extent alloc-tn size)
+ (return-from allocation (values)))
+ (let ((NOT-INLINE (gen-label))
+ (DONE (gen-label))
+ ;; Yuck.
+ (in-elsewhere (eq *elsewhere* sb!assem::**current-segment**))
+ ;; thread->alloc_region.free_pointer
+ (free-pointer
+ #!+sb-thread
+ (make-ea :qword
+ :base thread-base-tn :scale 1
+ :disp (* n-word-bytes thread-alloc-region-slot))
+ #!-sb-thread
+ (make-ea :qword
+ :scale 1 :disp
+ (make-fixup (extern-alien-name "boxed_region") :foreign)))
+ ;; thread->alloc_region.end_addr
+ (end-addr
+ #!+sb-thread
+ (make-ea :qword
+ :base thread-base-tn :scale 1
+ :disp (* n-word-bytes (1+ thread-alloc-region-slot)))
+ #!-sb-thread
+ (make-ea :qword
+ :scale 1 :disp
+ (make-fixup (extern-alien-name "boxed_region") :foreign 8))))
+ (cond (in-elsewhere
+ (allocation-tramp alloc-tn size))
+ (t
+ (unless (and (tn-p size) (location= alloc-tn size))
+ (inst mov alloc-tn size))
+ (inst add alloc-tn free-pointer)
+ (inst cmp end-addr alloc-tn)
+ (inst jmp :be NOT-INLINE)
+ (inst xchg free-pointer alloc-tn)
+ (emit-label DONE)
+ (assemble (*elsewhere*)
+ (emit-label NOT-INLINE)
+ (cond ((numberp size)
+ (allocation-tramp alloc-tn size))
+ (t
+ (inst sub alloc-tn free-pointer)
+ (allocation-tramp alloc-tn alloc-tn)))
+ (inst jmp DONE))
+ (values)))))
+
+#+nil