Initialize the thread system early in the cold load.

Thus with-thread-mutex-lock can be used during initialization of most
packages.  Avoid using the global set-interrupt-enables! binding in
dynamic-wind because it is now called so early.

This anticipates removing without-interrupts from gcfinal.scm and thus
calling with-thread-mutex-lock during make-gc-finalizer, e.g. during
the initialization of the (runtime string) package.

diff --git a/src/runtime/conpar.scm b/src/runtime/conpar.scm
index 8dc3c0717f18b4c4ab74b1f67c0f927c3375216b..5d89e4b849761db45bcebc2aba0f316f380cc30d 100644 (file)
--- a/src/runtime/conpar.scm
+++ b/src/runtime/conpar.scm
@@ -444,7 +444,7 @@ USA.
                          marker-instance)
                         (parser-state/block-thread-events? state)
                         (parser-state/interrupt-mask state)))
-             ((eq? marker-type set-interrupt-enables!)
+             ((eq? marker-type 'SET-INTERRUPT-ENABLES!)
               (continue (parser-state/dynamic-state state)
                         (parser-state/block-thread-events? state)
                         marker-instance))

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index d7228fcb756822f772008d4d01c88e1ab8896426..e04a023d2ecde04901ac57a81ace18ee7902da8a 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -372,6 +372,8 @@ USA.
       (files2
        '(("syntax-items" . (RUNTIME SYNTAX ITEMS))
         ("syntax-transforms" . (RUNTIME SYNTAX TRANSFORMS))
+        ("thread" . (RUNTIME THREAD))
+        ("wind" . (RUNTIME STATE-SPACE))
         ("prop1d" . (RUNTIME 1D-PROPERTY))
         ("events" . (RUNTIME EVENT-DISTRIBUTOR))
         ("gdatab" . (RUNTIME GLOBAL-DATABASE))
@@ -392,13 +394,15 @@ USA.
   (package-initialize '(RUNTIME POPULATION) #f #t)
   (package-initialize '(RUNTIME RECORD) 'INITIALIZE-RECORD-TYPE-TYPE! #t)
   (load-files files2)
-  (package-initialize '(RUNTIME 1D-PROPERTY) #f #t)
+  (package-initialize '(RUNTIME 1D-PROPERTY) #f #t)         ;First population.
+  (package-initialize '(RUNTIME STATE-SPACE) #f #t)
+  (package-initialize '(RUNTIME THREAD) 'INITIALIZE-LOW! #t) ;First 1d-table.
   (package-initialize '(RUNTIME EVENT-DISTRIBUTOR) #f #t)
   (package-initialize '(RUNTIME GLOBAL-DATABASE) #f #t)
   (package-initialize '(RUNTIME POPULATION) 'INITIALIZE-UNPARSER! #t)
   (package-initialize '(RUNTIME 1D-PROPERTY) 'INITIALIZE-UNPARSER! #t)
   (package-initialize '(RUNTIME GC-FINALIZER) #f #t)
-  (package-initialize '(RUNTIME STRING) #f #t)
+  (package-initialize '(RUNTIME STRING) #f #t)              ;First GC-finalizer
 
   (set! boot-defs
        (package/environment (name->package '(RUNTIME BOOT-DEFINITIONS))))
@@ -432,7 +436,6 @@ USA.
  '(
    ;; Microcode interface
    ((RUNTIME MICROCODE-TABLES) READ-MICROCODE-TABLES!)
-   (RUNTIME STATE-SPACE)
    (RUNTIME APPLY)
    (RUNTIME HASH)                      ; First GC daemon!
    (RUNTIME PRIMITIVE-IO)
@@ -478,8 +481,7 @@ USA.
    ((RUNTIME OS-PRIMITIVES) INITIALIZE-SYSTEM-PRIMITIVES!)
    ;; Floating-point environment -- needed by threads.
    (RUNTIME FLOATING-POINT-ENVIRONMENT)
-   ;; Threads
-   (RUNTIME THREAD)
+   ((RUNTIME THREAD) INITIALIZE-HIGH!)
    ;; I/O
    (RUNTIME PORT)
    (RUNTIME OUTPUT-PORT)

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 37916cdf14007c6bf1aa11da85fa9a6bfe01150d..733367ab973863e5275ba1e530ffe47dcfb4f3c7 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -28,6 +28,9 @@ USA.
 ;;; package: (runtime thread)
 
 (declare (usual-integrations))
+
+;;; This allows a host without the SMP primitives to avoid calling them.
+(define enable-smp? #f)
 \f
 (define-structure (thread
                   (constructor %make-thread ())
@@ -98,18 +101,28 @@ USA.
 (define next-scheduled-timeout)
 (define root-continuation-default)
 
-(define (initialize-package!)
-  (set! root-continuation-default (make-fluid #f))
-  (initialize-error-conditions!)
+(define (initialize-low!)
+  ;; Called early in the cold load to create the first thread.
   (set! thread-population (make-population))
   (set! first-running-thread #f)
   (set! last-running-thread #f)
   (set! next-scheduled-timeout #f)
   (set! timer-records #f)
   (set! timer-interval 100)
-  (initialize-io-blocking)
-  (add-event-receiver! event:after-restore initialize-io-blocking)
-  (detach-thread (make-thread #f))
+  (reset-threads-low!)
+  (let ((first (%make-thread)))
+    (set-thread/exit-value! first detached-thread-marker)
+    (set-thread/root-state-point! first
+                                 (current-state-point state-space:local))
+    (add-to-population!/unsafe thread-population first)
+    (%thread-running first)))
+
+(define (initialize-high!)
+  ;; Called later in the cold load, when more of the runtime is initialized.
+  (set! root-continuation-default (make-fluid #f))
+  (initialize-error-conditions!)
+  (reset-threads-high!)
+  (add-event-receiver! event:after-restore reset-threads!)
   (add-event-receiver! event:before-exit stop-thread-timer)
   (named-structure/set-tag-description! thread-mutex-tag
     (make-define-structure-type 'VECTOR
@@ -130,6 +143,20 @@ USA.
                                link-tag
                                4)))
 
+(define (reset-threads!)
+  (reset-threads-low!)
+  (reset-threads-high!))
+
+(define (reset-threads-low!)
+  (set! enable-smp?
+       (and ((ucode-primitive get-primitive-address 2) 'SMP-COUNT #f)
+            ((ucode-primitive smp-count 0)))))
+
+(define (reset-threads-high!)
+  (set! io-registry (and have-select? (make-select-registry)))
+  (set! io-registrations #f)
+  unspecific)
+
 (define (make-thread continuation)
   (let ((thread (%make-thread)))
     (set-thread/continuation! thread continuation)
@@ -465,11 +492,6 @@ USA.
   prev
   next)
 
-(define (initialize-io-blocking)
-  (set! io-registry (and have-select? (make-select-registry)))
-  (set! io-registrations #f)
-  unspecific)
-
 (define (wait-for-io)
   (%maybe-toggle-thread-timer #f)
   (let ((catch-errors

diff --git a/src/runtime/wind.scm b/src/runtime/wind.scm
index 30dbafac1bcf7b77d643ed168591b6d45932427f..5134b673f28246f40d4c4b23e4e66bba50127e11 100644 (file)
--- a/src/runtime/wind.scm
+++ b/src/runtime/wind.scm
@@ -113,10 +113,10 @@ USA.
                      (set-state-point/from-nearer! new-root #f)
                      (set-state-space/nearest-point! space new-root)
                      (with-stack-marker from-nearer
-                       set-interrupt-enables! interrupt-mask))
+                       'SET-INTERRUPT-ENABLES! interrupt-mask))
                    ;; Disable interrupts again in case FROM-NEARER
                    ;; re-enabled them.
-                   (set-interrupt-enables! interrupt-mask)
+                   ((ucode-primitive set-interrupt-enables! 1) interrupt-mask)
                    ;; Make sure that NEW-ROOT is still the root,
                    ;; because FROM-NEARER might have moved it.  If
                    ;; it has been moved, find the new root, and