From 8d1a9dcec1f786c6a339fdf0b162d4f8ce883732 Mon Sep 17 00:00:00 2001 From: "Paul M. Rodriguez" Date: Fri, 29 Nov 2024 11:13:15 -0600 Subject: [PATCH] WIP Allow building a executable with Kiln --- bootstrap/build0.lisp | 34 +++++++++++++++++++--------------- bootstrap/build1.lisp | 12 +++++++----- build.sh | 3 +-- dispatch.lisp | 5 ++++- image.lisp | 16 ++++++++++------ scripts/rebuild.lisp | 14 +++++++++++--- scripts/self-test.lisp | 12 ++++++++++++ 7 files changed, 64 insertions(+), 32 deletions(-) diff --git a/bootstrap/build0.lisp b/bootstrap/build0.lisp index a180c48..8a344d4 100644 --- a/bootstrap/build0.lisp +++ b/bootstrap/build0.lisp @@ -18,20 +18,24 @@ required-version) (finish-output *error-output*) (uiop:quit 1))) -(defparameter *target-system* (uiop:getenv "KILN_TARGET_SYSTEM")) -(assert (stringp *target-system*)) -(assert (not (= 0 (length *target-system*)))) -(if (find-package :ql) - (progn - (format *error-output* "Found Quicklisp~%") - (uiop:symbol-call :ql :register-local-projects) - (multiple-value-call #'uiop:symbol-call - :ql :quickload *target-system* - (if (uiop:getenvp "KILN_DEBUG") (values) - (values :silent t)))) - (progn - (format *error-output* "Quicklisp not found~%") - (asdf:load-system *target-system*))) -(kiln/image:load-all-script-systems) +(defun load-system (system) + (assert (stringp system)) + (assert (not (= 0 (length system)))) + (if (find-package :ql) + (progn + (format *error-output* "Found Quicklisp~%") + (uiop:symbol-call :ql :register-local-projects) + (multiple-value-call #'uiop:symbol-call + :ql :quickload system + (if (uiop:getenvp "KILN_DEBUG") (values) + (values :silent t)))) + (progn + (format *error-output* "Quicklisp not found~%") + (asdf:load-system system)))) +(load-system "kiln/build") +(let ((target-system (uiop:getenvp "KILN_TARGET_SYSTEM"))) + (if target-system + (load-system target-system) + (kiln/image:load-all-script-systems))) (finish-output *error-output*) (uiop:quit) diff --git a/bootstrap/build1.lisp b/bootstrap/build1.lisp index 0b4037f..a8c22bc 100644 --- a/bootstrap/build1.lisp +++ b/bootstrap/build1.lisp @@ -19,14 +19,16 @@ "2.2.6") -7 1))) -(defparameter *target-system* (uiop:getenv "KILN_TARGET_SYSTEM")) -(assert (stringp *target-system*)) -(assert (not (= 0 (length *target-system*)))) +(let ((target-system (uiop:getenvp "KILN_TARGET_SYSTEM"))) + (when target-system + (setf (uiop:getenv "KILN_ENTRY_POINT") + (asdf/system:component-entry-point + (asdf:find-system target-system))))) (setf (asdf/system:component-build-pathname - (asdf:find-system *target-system*)) + (asdf:find-system "kiln/build")) (let ((string (uiop:getenvp "KILN_TARGET_FILE"))) (if string (uiop:parse-unix-namestring string) #p"kiln"))) -(asdf:make *target-system* :type :program :monolithic t) +(asdf:make "kiln/build" :type :program :monolithic t) (uiop:quit) diff --git a/build.sh b/build.sh index 0672b03..e7e2ba6 100755 --- a/build.sh +++ b/build.sh @@ -6,13 +6,12 @@ set -eu : "${KILN_LISP:=sbcl}" : "${KILN_HEAP_SIZE:=32768}" : "${KILN_STACK_SIZE:=}" +: "${KILN_TARGET_SYSTEM:=}" if test -n "$KILN_DEBUG"; then set -x fi -export KILN_TARGET_SYSTEM="${KILN_TARGET_SYSTEM:-"kiln/build"}" - # We will rebind KILN_TARGET_FILE to a tmpfile during the build. real_target_file="${KILN_TARGET_FILE:-"kiln"}" diff --git a/dispatch.lisp b/dispatch.lisp index e7279be..de0a602 100644 --- a/dispatch.lisp +++ b/dispatch.lisp @@ -29,7 +29,10 @@ (deftype args-state () '(member :flags :script-name :script-args)) -(defparameter *entry-point* 'dispatch/argv) +(defparameter *entry-point* + (if-let (entry-point (uiop:getenvp "KILN_ENTRY_POINT")) + (uiop:ensure-function entry-point) + 'dispatch/argv)) (-> parse-args (list) (values list (or null string) list)) (defun parse-args (args) diff --git a/image.lisp b/image.lisp index c5ffd77..a38d207 100644 --- a/image.lisp +++ b/image.lisp @@ -62,16 +62,19 @@ (print e uiop:*stderr*) (uiop:print-backtrace e :stream uiop:*stderr*)))) (with-user-abort - (record-builtins) + (record-builtins) ;; NB Quicklisp doesn't work if it's called inside of the ASDF ;; build-op. So we run it in a separate thread. (Is this still true?) - (let* ((subsystems (list-builtin-script-subsystems))) - (load-all-script-systems :script-systems subsystems) + (let* ((subsystems (list-builtin-script-subsystems)) + (entry-point? (uiop:getenvp "KILN_ENTRY_POINT"))) + (unless entry-point? + (load-all-script-systems :script-systems subsystems)) ;; Mark systems immutable twice: first anything loaded by the ;; package scripts (so the shebang scripts load faster), then ;; again for anything loaded after the shebang scripts. (mark-other-systems-immutable :script-systems subsystems) - (populate-script-cache) + (unless entry-point? + (populate-script-cache)) (mark-other-systems-immutable :script-systems subsystems)) (finalize-all-classes) (asdf:clear-configuration) @@ -87,8 +90,9 @@ (defun kiln-after-restore-image () #+sbcl (sb-ext:disable-debugger) ;; TODO Would it be better to preload them all? - #+sbcl (setf sb-sys::*sbcl-homedir-pathname* *sbcl-home*) - #+sbcl (setf sb-ext:*derive-function-types* nil) + (unless (uiop:getenvp "KILN_ENTRY_POINT") + #+sbcl (setf sb-sys::*sbcl-homedir-pathname* *sbcl-home*) + #+sbcl (setf sb-ext:*derive-function-types* nil)) (setf uiop/image::*lisp-interaction* nil) (setpgrp) (reload-all-foreign-libraries)) diff --git a/scripts/rebuild.lisp b/scripts/rebuild.lisp index c7fb9df..58953df 100644 --- a/scripts/rebuild.lisp +++ b/scripts/rebuild.lisp @@ -61,7 +61,13 @@ :long-name "tolerant" :initial-value :false :env-vars '("KILN_TOLERANT") - :key :tolerant))) + :key :tolerant) + (cli:make-option + :string + :description "Use this system's entry point" + :long-name "entry-point-system" + :env-vars '("KILN_ENTRY_POINT") + :key :entry-point-system))) (def command (cli:make-command @@ -80,7 +86,8 @@ (setf (getenv "KILN_TARGET_SYSTEM") target-system)) (when-let (target-file (cli:getopt opts :target-file)) (setf (getenv "KILN_TARGET_FILE") target-file)) - (when (cli:getopt opts :no-version) + (when (or (cli:getopt opts :no-version) + (cli:getopt opts :entry-point-system)) (setf (getenv "NO_PRINT_VERSION") "1")) (when-let (heap-size (cli:getopt opts :heap-size)) (setf (getenv "KILN_HEAP_SIZE") @@ -96,7 +103,8 @@ (error "Quicklisp requested but not available")))) (when (cli:getopt opts :tolerant) (setf (getenv "KILN_TOLERANT") "1")) - + (when-let (entry-point-system (cli:getopt opts :entry-point-system)) + (setf (getenv "KILN_ENTRY_POINT") entry-point-system)) (let ((path (asdf:system-relative-pathname "kiln" ""))) (uiop:chdir (namestring path)) (exec "sh build.sh")))) diff --git a/scripts/self-test.lisp b/scripts/self-test.lisp index 1bfaa18..9422bc6 100644 --- a/scripts/self-test.lisp +++ b/scripts/self-test.lisp @@ -220,6 +220,18 @@ This is useful when we need to test the exact output." (is (equal (fmt "Before exec~%Unwinding happened~%exec happened") result)))) +(5am:test entry-point + (with-templated-test-system (:name "kiln-entry-point-system" + :path path + :kiln-path nil) + (uiop:with-temporary-file (:pathname tmp) + (cmd *self* + "--target-file" + tmp + "--entry-point-system kiln-entry-point-system") + (is (file-exists-p tmp)) + (is (equal "Hello, world" ($cmd tmp)))))) + (defun main (args) (destructuring-bind (&optional (test 'test)) args (when (stringp test)