Slightly clean up the force-system-tlab hack

* Put the predicate in generic/utils.

* Put avlnode definition back into src/code/avlnode
  (where it matches the file patterns in target-compile-stem)
  and add :c-headers flag for header autogeneration

* Get #+(and system-tlabs (not immobile-space)) working

src/code/arena.lisp

@@ -96,17 +96,14 @@ one or more times, not to exceed MAX-EXTENSIONS times"
 (define-vop (delete-arena)
   (:args (x :scs (descriptor-reg)))
   (:temporary (:sc unsigned-reg :offset rdi-offset :from (:argument 0)) rdi)
-  #+immobile-space
   (:temporary (:sc unsigned-reg :offset rbx-offset) rsp-save)
   (:vop-var vop)
   (:generator 1
     (move rdi x)
-    #-immobile-space (inst break halt-trap)
-    #+immobile-space
     (pseudo-atomic ()
       (inst mov rsp-save rsp-tn)
       (inst and rsp-tn -16) ; align as required by some ABIs
-      (inst call (make-fixup "sbcl_delete_arena" :foreign))
+      (inst call (ea (make-fixup "sbcl_delete_arena" :foreign 8)))
       (inst mov rsp-tn rsp-save)))))
 
 ;;; Destroy memory associated with ARENA, unlinking it from the global chain.

src/code/avltree.lisp

@@ -1,6 +1,15 @@
 
 (in-package sb-thread)
 
+(sb-xc:defstruct (avlnode (:constructor avlnode (key data left right)))
+  (left  nil :read-only t)
+  (right nil :read-only t)
+  (key   0   :read-only t :type sb-vm:word)
+  data)
+
+;;; The remainder of this file is not for the host.
+#-sb-xc-host
+(progn
 ;;; Return the difference in left and right heights. Some people do the subtraction
 ;;; the other way around (like on Wikipedia). Oh well, it is what it is.
 (defun avl-balance-factor (node)
@@ -202,3 +211,4 @@
           (t
            (format stream "~s ~d" :count ct))))
   (format stream " #x~x>" (get-lisp-obj-address self)))
+) ; end PROGN

src/cold/build-order.lisp-expr

@@ -556,7 +556,7 @@
  ("src/code/early-step")                  ; target-thread needs *STEP-OUT*
 
  ("src/code/gc"                :not-host)
- ("src/code/avltree"           :not-host)
+ ("src/code/avltree"           :c-headers)
  ("src/code/target-thread"     :not-host)
 
  ("src/code/error-error" :not-host) ; needs WITH-STANDARD-IO-SYNTAX macro

src/cold/shared.lisp

@@ -300,9 +300,9 @@
         #+nil
         (when (target-featurep '(:and :sb-futex :x86-64 :linux))
           (pushnew :futex-wait-metric sb-xc:*features*))
+        (when (target-featurep '(:and :x86-64 :sb-thread))
+          (pushnew :system-tlabs sb-xc:*features*))
         (when (target-featurep :immobile-space)
-          (when (member :sb-thread sb-xc:*features*)
-            (pushnew :system-tlabs sb-xc:*features*))
           (pushnew :compact-instance-header sb-xc:*features*)
           (pushnew :immobile-code sb-xc:*features*))
         (when (target-featurep :64-bit)
@@ -775,6 +775,9 @@
              (search "src/code/arena" stem)
              (search "src/code/avltree" stem)
              (search "src/code/brothertree" stem)
+             (search "src/code/early-classoid" stem)
+             (search "src/code/type-class" stem)
+             (search "src/code/class" stem)
              (search "src/code/debug" stem) ; also matches debug-{info,int,var-io}
              (search "src/code/early-defmethod" stem)
              (search "src/code/final" stem)

src/compiler/generic/late-objdef.lisp

@@ -278,14 +278,3 @@ static inline lispobj compute_lispobj(lispobj* base_addr) {
   ;; It is 0 until added to the global chain so we can tell the difference between
   ;; an arena that was made but never used, and one that was used at some point.
   (link 0))
-
-;;; AVLNODE is primitive-object-like because it is needed by C code that looks up
-;;; entries in the tree of lisp threads.  But objdef doesn't have SB-XC:DEFSTRUCT
-;;; working, and I'm reluctant to create yet another 'something-thread' file to
-;;; put this in, not to mention that SB-THREAD is the wrong package anyway.
-(in-package "SB-THREAD")
-(sb-xc:defstruct (avlnode (:constructor avlnode (key data left right)))
-  (left  nil :read-only t)
-  (right nil :read-only t)
-  (key   0   :read-only t :type sb-vm:word)
-  data)

src/compiler/generic/utils.lisp

@@ -446,3 +446,22 @@
                     smallest-f d n))
            (values (ceiling (expt 2 fraction-bits) d) fraction-bits)))))
 
+(defun system-tlab-p (type node)
+  #-system-tlabs (declare (ignore type node))
+  #+system-tlabs
+  (or sb-c::*force-system-tlab*
+      (let ((typename (cond ((sb-kernel::wrapper-p type)
+                             (classoid-name (wrapper-classoid type)))
+                            ((sb-kernel::defstruct-description-p type)
+                             (dd-name type)))))
+        (when (and typename (sb-xc:subtypep typename 'ctype))
+          (error "~S instance constructor called in a non-system file"
+                 typename)))
+      (and node
+           (named-let search-env ((env (sb-c::node-lexenv node)))
+             (dolist (data (sb-c::lexenv-user-data env)
+                           (and (sb-c::lexenv-parent env)
+                                (search-env (sb-c::lexenv-parent env))))
+               (when (and (eq (first data) :declare)
+                          (eq (second data) 'sb-c::tlab))
+                 (return (eq (third data) :system))))))))

src/compiler/x86-64/alloc.lisp

@@ -176,31 +176,6 @@
       (when rax-save (inst pop rax-tn))
       (emit-label skip-instrumentation))))
 
-(defun system-tlab-p (type node)
-  #-system-tlabs (declare (ignore type node))
-  #+system-tlabs
-  (or sb-c::*force-system-tlab*
-      ;; FIXME: for some reason, even though "src/code/avltree" is listed
-      ;; in src/cold/shared as forcing system-tlab allocation, we still end up
-      ;; withe AVLNODE function consing its node into an arena (if active).
-      ;; This means that thread creation will cause *ALL-THREADS* to point
-      ;; to an arena, which is terrible. Hence this kludge.
-      ;; Unfortunately, if not using #+compact-instance-header, then we don't
-      ;; receive a literal #<layout> for the type here. Maybe it's a constant TN?
-      ;; I stopped caring at some point.
-      (and (sb-kernel::wrapper-p type)
-           (let ((typename (classoid-name (wrapper-classoid type))))
-             (or (sb-xc:subtypep typename 'ctype)
-                 (eq typename 'sb-thread::avlnode))))
-      (and node
-           (named-let search-env ((env (sb-c::node-lexenv node)))
-             (dolist (data (sb-c::lexenv-user-data env)
-                           (and (sb-c::lexenv-parent env)
-                                (search-env (sb-c::lexenv-parent env))))
-               (when (and (eq (first data) :declare)
-                          (eq (second data) 'sb-c::tlab))
-                 (return (eq (third data) :system))))))))
-
 ;;; An arbitrary marker for the cons primitive-type, not to be confused
 ;;; with the CONS-TYPE in our type-algebraic sense. Mostly just informs
 ;;; the allocator to use cons_tlab.

tests/arena.impure.lisp

@@ -1,5 +1,4 @@
-#+(or (not system-tlabs) (not compact-instance-header) interpreter)
-(invoke-restart 'run-tests::skip-file)
+#+(or (not system-tlabs) interpreter) (invoke-restart 'run-tests::skip-file)
 
 (in-package sb-vm)