Permalink
Browse files

Add --dynamic-space-size support.

SBCL's new default 1GB heap on AMD64 is too small for some of my
applications. Passing --dynamic-space-size will help me get the size I
need.
  • Loading branch information...
1 parent 0e77f88 commit bb5a4c675a552e30eef80dcbc409d7724d8426a3 @xach committed Mar 9, 2012
Showing with 40 additions and 11 deletions.
  1. +20 −9 buildapp.lisp
  2. +2 −2 command-line.lisp
  3. +4 −0 dumper.lisp
  4. +14 −0 utils.lisp
View
@@ -103,7 +103,11 @@ There may be any number of load-path/asdf-path/asdf-tree/manifest-file
flags. They take priority in command-line order.
Other flags:
+ --compress-core Compress the core or executable; requires
+ configuration support in SBCL
--core-only Make a core file only, not an executable
+ --dynamic-space-size MB Pass a --dynamic-space-size option to SBCL
+ when building; value is megabytes
--help Show this usage message
--logfile FILE Log compilation and load output to FILE
--sbcl PATH-TO-SBCL Use PATH-TO-SBCL instead of the sbcl program
@@ -386,22 +390,29 @@ ARGV. See *USAGE* for details."
(when (string-equal (second argv) "--help")
(write-string *usage* *standard-output*)
(sb-ext:quit))
- (let ((dumper (command-line-dumper (rest argv)))
- (*package* (find-package :buildapp)))
+ (let* ((dumper (command-line-dumper (rest argv)))
+ (*package* (find-package :buildapp))
+ (dynamic-space-size (dynamic-space-size dumper)))
(with-tempfile (stream ("dumper.lisp" file))
(write-dumpfile dumper stream)
(force-output stream)
(when (dumpfile-copy dumper)
(copy-file file (dumpfile-copy dumper)))
(let ((process
(sb-ext:run-program (sbcl dumper)
- (list "--noinform"
- "--disable-debugger"
- "--no-userinit"
- "--no-sysinit"
- "--disable-debugger"
- "--load" (sb-ext:native-namestring
- (probe-file file)))
+ (flatten
+ (list
+ (when dynamic-space-size
+ (list "--dynamic-space-size"
+ (princ-to-string
+ dynamic-space-size)))
+ "--noinform"
+ "--disable-debugger"
+ "--no-userinit"
+ "--no-sysinit"
+ "--disable-debugger"
+ "--load" (sb-ext:native-namestring
+ (probe-file file))))
:output *standard-output*
:search t)))
(let ((status (sb-ext:process-exit-code process)))
View
@@ -155,8 +155,8 @@
:flag (format nil "~A ~A" argument value))
(setf default-dispatched-entry entry)))
(push entry (dispatched-entries plan))))
- (:core-only
- (setf (core-only plan) t))
+ (:dynamic-space-size
+ (setf (dynamic-space-size plan) (parse-integer value)))
(t
(error 'unknown-argument :flag argument)))))))
View
@@ -78,6 +78,10 @@
(compress-core
:initarg :compress-core
:accessor compress-core
+ :initform nil)
+ (dynamic-space-size
+ :initarg :dynamic-space-size
+ :accessor dynamic-space-size
:initform nil)))
(defgeneric needs-asdf-p (dumper)
View
@@ -166,3 +166,17 @@ location."
(with-open-file (stream file)
(loop for line = (read-line stream nil)
while line collect line)))
+
+;; Cribbed from alexandria
+(defun flatten (tree)
+ "Traverses the tree in order, collecting non-null leaves into a list."
+ (let (list)
+ (labels ((traverse (subtree)
+ (when subtree
+ (if (consp subtree)
+ (progn
+ (traverse (car subtree))
+ (traverse (cdr subtree)))
+ (push subtree list)))))
+ (traverse tree))
+ (nreverse list)))

0 comments on commit bb5a4c6

Please sign in to comment.