diff --git a/Makefile b/Makefile index dc74d5a..8239d16 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ DESTDIR = /usr/local LISP := sbcl ifeq ($(LISP),sbcl) -FLAGS=--noinform --no-userinit --no-sysinit --disable-debugger +FLAGS=--no-userinit --no-sysinit --disable-debugger else FLAGS=--quiet --no-init endif diff --git a/buildapp.lisp b/buildapp.lisp index a53d12c..c9109a6 100644 --- a/buildapp.lisp +++ b/buildapp.lisp @@ -118,11 +118,25 @@ Other flags:" --core-only Make a core file only, not an executable" #+sbcl " - --dynamic-space-size MB Pass a --dynamic-space-size option to SBCL - when building; value is megabytes" + --space-size MB Pass a --dynamic-space-size option to SBCL + when building and into the built app; value + is megabytes. + Note that the argument has a *different* + name from the SBCL command line argument. + This is necessary to keep SBCL from + swallowing the argument." +#+sbcl +" + --turn-off-ldb Pass --disable-ldb to SBCL when building (and into the + built application). + Note that the argument has a *different* + name from the SBCL command line argument. + This is necessary to keep SBCL from + swallowing the argument." " --help Show this usage message - --logfile FILE Log compilation and load output to FILE" + --logfile FILE Log compilation and load output to FILE + --dumpfile-copy FILE Write a copy of the dumpfile to FILE." #+sbcl " --sbcl PATH-TO-SBCL Use PATH-TO-SBCL instead of the sbcl program @@ -382,7 +396,6 @@ it. If an exact filename is not found, file.lisp is also tried." (let ((*print-case* :downcase)) (write-dumpfile dumper stream)))) - (defun main (argv) "Create an executable from the command-line arguments provided in ARGV. See *USAGE* for details." @@ -397,23 +410,49 @@ ARGV. See *USAGE* for details." (force-output stream) (when (dumpfile-copy dumper) (copy-file file (dumpfile-copy dumper))) - (let ((process (run-program #+sbcl (sbcl dumper) - #+ccl (ccl dumper) - (flatten - (list - #+sbcl - (when dynamic-space-size - (list "--dynamic-space-size" - (princ-to-string - dynamic-space-size))) - #+sbcl "--noinform" - #+ccl "--quiet" - #+sbcl "--disable-debugger" - #+sbcl "--no-userinit" - #+sbcl "--no-sysinit" - #+ccl "--no-init" - "--load" (native-namestring - (probe-file file))))))) + (format t "~&About to recursively start SBCL, dynamic-space-size is ~a~%" dynamic-space-size) + (let ((process + (let ((cmd `(run-program #+sbcl ,(sbcl dumper) + #+ccl ,(ccl dumper) + ',(flatten + (list + #+sbcl + (when dynamic-space-size + (list "--dynamic-space-size" + (princ-to-string + dynamic-space-size))) + #+sbcl + (when (disable-ldb dumper) + "--disable-ldb") + #+sbcl "--noinform" + #+ccl "--quiet" + #+sbcl "--disable-debugger" + #+sbcl "--no-userinit" + #+sbcl "--no-sysinit" + #+ccl "--no-init" + "--load" (native-namestring + (probe-file file))))))) + ;;(format t "~&running this command to try to build the application:~%") + ;;(pprint cmd) (terpri) + (eval cmd)) + ;; (run-program #+sbcl (sbcl dumper) + ;; #+ccl (ccl dumper) + ;; (flatten + ;; (list + ;; #+sbcl + ;; (when dynamic-space-size + ;; (list "--dynamic-space-size" + ;; (princ-to-string + ;; dynamic-space-size))) + ;; #+sbcl "--noinform" + ;; #+ccl "--quiet" + ;; #+sbcl "--disable-debugger" + ;; #+sbcl "--no-userinit" + ;; #+sbcl "--no-sysinit" + ;; #+ccl "--no-init" + ;; "--load" (native-namestring + ;; (probe-file file))))) + )) (if (zerop #+sbcl (sb-ext:process-exit-code process) #+ccl (ccl::external-process-%exit-code process)) (probe-file (output dumper)) @@ -438,4 +477,3 @@ ARGV. See *USAGE* for details." 'command-line-debugger)) #+sbcl (pushnew 'buildapp-init sb-ext:*init-hooks*) - diff --git a/command-line.lisp b/command-line.lisp index 41cb9c8..387cb74 100644 --- a/command-line.lisp +++ b/command-line.lisp @@ -102,6 +102,9 @@ (setf (compress-core plan) t)) (when (popflag "--core-only" args) (setf (core-only plan) t)) + #+sbcl + (when (popflag "--turn-off-ldb" args) + (setf (slot-value plan 'disable-ldb) t)) (when (oddp (length args)) (error 'odd-number-of-arguments)) (loop @@ -142,7 +145,7 @@ (:ccl (when (ccl plan) (setf (ccl plan) value))) - (:entry + (:entry (when (dispatched-entries plan) (error 'entry-and-dispatched-entry)) (when (entry plan) @@ -158,11 +161,8 @@ :flag (format nil "~A ~A" argument value)) (setf default-dispatched-entry entry))) (push entry (dispatched-entries plan)))) - (:dynamic-space-size + #+sbcl + (:space-size ;; :dynamic-space-size (setf (dynamic-space-size plan) (parse-integer value))) (t (error 'unknown-argument :flag argument))))))) - - - - diff --git a/dumper.lisp b/dumper.lisp index 6a3cdf6..a49e001 100644 --- a/dumper.lisp +++ b/dumper.lisp @@ -86,6 +86,10 @@ (dynamic-space-size :initarg :dynamic-space-size :accessor dynamic-space-size + :initform nil) + (disable-ldb + :initarg :disable-ldb + :reader disable-ldb :initform nil))) (defgeneric needs-asdf-p (dumper) @@ -126,7 +130,7 @@ (list `(format *error-output* "Unknown dispatch name '~A', quitting~%" binary-name) - (macroexpand-1 (quit 1))))))))))) + (macroexpand-1 '(quit 1))))))))))) (defgeneric entry-function-form (dumper) (:method (dumper) @@ -161,4 +165,3 @@ (defun dump-form (name) (gethash name *dumpable-forms*)) - diff --git a/utils.lisp b/utils.lisp index 345e845..105f000 100644 --- a/utils.lisp +++ b/utils.lisp @@ -35,8 +35,15 @@ #+sbcl 'sb-ext:*posix-argv* #+ccl '(ccl::command-line-arguments)) +#+sbcl +(eval-when (:compile-toplevel :load-toplevel :execute) + (let ((version (uiop:lisp-version-string))) + (unless (uiop:version<= version "1.12.5") + (push :sb-list-backtrace *features*)))) + (defmacro backtrace-as-list () - #+sbcl '(sb-debug:backtrace-as-list) + #+(and sbcl sb-list-backtrace) '(sb-debug:list-backtrace) + #+(and sbcl (not sb-list-backtrace)) '(sb-debug:backtrace-as-list) #+ccl '(ccl::backtrace-as-list)) (defmacro quit (&optional (errno 0))