From a72b6978928e45212ef174643d4408f3f7cbfe51 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Tue, 17 Nov 2009 23:33:52 +0000
Subject: [PATCH] cl: Dump a core image to improve startup times.

This is cheating: the core image is massive because SBCL doesn't tree-
shake.
---
 .gitignore     |  1 +
 Makefile       |  5 ++++-
 cl-fringe.lisp | 23 ++++++++++++-----------
 3 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/.gitignore b/.gitignore
index 44e0f13..a66409a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,4 +5,5 @@ test.log
 *.o
 *.exe
 *.hi
+*.core
 *-fringe
diff --git a/Makefile b/Makefile
index 8ea4f74..86e5616 100644
--- a/Makefile
+++ b/Makefile
@@ -84,9 +84,12 @@ icon-fringe: icon-fringe.icn
 ###--------------------------------------------------------------------------
 ### Common Lisp.
 
+CLEANFILES		+= *.core
+
 LANGS			+= cl
 cl-fringe: cl-fringe.lisp
-	cl-launch -R -o $@ -f `pwd`/$^
+##	cl-launch -R -o $@ -f `pwd`/$^	-- slow to start
+	cl-launch -o $@ -f `pwd`/$^ +I -r launch -d $@.core
 
 ###--------------------------------------------------------------------------
 ### F#.
diff --git a/cl-fringe.lisp b/cl-fringe.lisp
index 0081ee3..7386c38 100644
--- a/cl-fringe.lisp
+++ b/cl-fringe.lisp
@@ -95,16 +95,17 @@
 				       (iterate-fringe (parse-tree b))))))))
 
 #+cl-launch
-(flet ((bail (format args)
-	 (format *error-output* "~A: ~?~%"
-		 (cl-launch:getenv "CL_LAUNCH_FILE") format args)
-	 (cl-launch:quit 1)))
-  (handler-case
-      (main cl-launch:*arguments*)
-    (simple-error (err)
-      (bail (simple-condition-format-control err)
-	    (simple-condition-format-arguments err)))
-    (error (err)
-      (bail "~A" err))))
+(defun launch ()
+  (flet ((bail (format args)
+	   (format *error-output* "~A: ~?~%"
+		   (cl-launch:getenv "CL_LAUNCH_FILE") format args)
+	   (cl-launch:quit 1)))
+    (handler-case
+	(main cl-launch:*arguments*)
+      (simple-error (err)
+	(bail (simple-condition-format-control err)
+	      (simple-condition-format-arguments err)))
+      (error (err)
+	(bail "~A" err)))))
 
 ;;;----- That's all, folks --------------------------------------------------
-- 
2.11.0