Add libsbcl support functions

src/environment.lisp

@@ -27,8 +27,19 @@
 (defun gc ()
   (sb-ext:gc :full t))
 
+(defun funcall0-by-name (name package-name)
+  "Calls the function called NAME in the PACKAGE called PACKAGE-NAME
+passing no arguments and throwing away the return value."
+  (let* ((package (if (string= "" package-name)
+                      (sb-int:sane-package)
+                      (string-upcase package-name)))
+         (symbol (find-symbol (string-upcase name) package)))
+    (funcall (symbol-function symbol)))
+  (values))
+
 (define-api environment (:function-prefix "")
   (:function
    (("lisp_enable_debugger" enable-debugger) :void ())
    (("lisp_disable_debugger" disable-debugger) :void ())
-   (("lisp_gc" gc) :void ())))
+   (("lisp_gc" gc) :void ())
+   (("lisp_funcall0_by_name" funcall0-by-name) :void ((name :string) (package-name :string)))))

src/loader.lisp

@@ -4,9 +4,58 @@
 (in-package #:sbcl-librarian)
 
 (defun lisp-load (pathname)
-  (let ((*initialize-callables-p* t))
-    (load pathname)))
+  "Load the file at PATHNAME into the running environment, initializing
+any alien callable symbols and muffling any redefinition warnings.
+
+On Darwin, additionally set SB-THREAD::*INITIAL-THREAD* to the current
+thread around the LOAD call. This is because CFFI on Darwin forces all
+foreign library loads to occur on the initial thread[^1]. If the
+current thread when the load happens is the initial thread, this is
+trivial. If the current thread is NOT the initial thread, then CFFI
+uses SB-THREAD:INTERRUPT-THREAD to invoke the library load on the
+initial thread[^2]. INTERRUPT-THREAD is asynchronous, meaning that the
+requested function will run on the requested thread sometime in the
+future when the requested thread is running and has interrupts
+enabled. This does not work when the core file used at startup was
+saved with :CALLABLE-EXPORTS because the initial thread never runs
+after initializing callable symbols[^3].
+
+[^1]: https://github.com/cffi/cffi/blob/5bfca29deb8b4c214a86ccf37279cc5cea2151e1/src/cffi-sbcl.lisp#L369
+[^2]: https://github.com/cffi/cffi/blob/5bfca29deb8b4c214a86ccf37279cc5cea2151e1/src/cffi-sbcl.lisp#L344
+[^3]: https://github.com/sbcl/sbcl/blob/6e2df19952cfc3a526dcc42a5c0f8fa6b571f312/src/code/save.lisp#L83"
+  (let ((*initialize-callables-p* t)
+        #+darwin
+        (initial-thread sb-thread::*initial-thread*))
+    #+darwin
+    (setf sb-thread::*initial-thread* sb-thread:*current-thread*)
+    (unwind-protect
+         (locally
+             (declare (sb-ext:muffle-conditions sb-kernel:redefinition-warning))
+           (load pathname))
+      #+darwin
+      (setf sb-thread::*initial-thread* initial-thread))))
+
+(defun load-array-as-system  (data size system-name)
+  "Assuming DATA is a pointer to an array of SIZE bytes constituting a
+FASL or Common Lisp source code for the entire ASDF system named
+SYSTEM-NAME, dump the array to a temporary file and then load it if
+SYSTEM-NAME has not already been loaded into the current
+image. Additionally, initialize any alien callable symbols while
+loading."
+  (unless (asdf:component-loaded-p system-name)
+    (uiop:with-temporary-file (:stream stream :pathname filename :direction :io :element-type 'unsigned-byte)
+      (loop :for i :from 0 :below size
+            :do (write-byte (sb-alien:deref (sb-alien:cast data (* (sb-alien:unsigned 8)))
+					    i)
+			    stream))
+      (finish-output stream)
+      (lisp-load filename))
+    (asdf:register-immutable-system system-name)
+    (values)))
 
 (define-api loader (:function-prefix "")
   (:function
-   (("lisp_load" lisp-load) :void ((pathname :string)))))
+   (("lisp_load" lisp-load) :void ((pathname :string)))
+   (("lisp_load_array_as_system" load-array-as-system) :void ((data :pointer) (size :int) (system-name :string)))
+   (("lisp_require" require) :void ((module-name :string)))
+   (("lisp_load_shared_object" load-shared-object) :void ((pathname :string)))))