SBCL directory hack

Yoni Rabkin <[email protected]> Sun, 30 Mar 2008 23:08:38 +0300
Newsgroups gmane.lisp.movitz.devel
Message-ID <[email protected]>
I use these two patches as a shortcut to giving `create-image' the correct directory.


-- 
   "Cut your own wood and it will warm you twice"
add-global-variable-lpd-to-movitz.patch (text/x-diff, 552 B)
Index: movitz.lisp
===================================================================
RCS file: /project/movitz/cvsroot/movitz/movitz.lisp,v
retrieving revision 1.12
diff -u -r1.12 movitz.lisp
--- movitz.lisp	13 Mar 2007 20:40:10 -0000	1.12
+++ movitz.lisp	30 Mar 2008 19:57:14 -0000
@@ -33,6 +33,10 @@
 
 (defvar +movitz-multiple-values-limit+ 63)
 
+(defvar *lpd*
+  (load-time-value *load-pathname*)
+  "Base directory.")
+
 (defvar *bq-level* 0)
 (defvar *default-image-init-file* #p"losp/los0.lisp")
 (defvar *default-image-file* #p"los0-image")
bind-default-pathname-defaults-during-make-movitz-image.patch (text/x-diff, 997 B)
Index: image.lisp
===================================================================
RCS file: /project/movitz/cvsroot/movitz/image.lisp,v
retrieving revision 1.118
diff -u -r1.118 image.lisp
--- image.lisp	20 Mar 2008 22:24:06 -0000	1.118
+++ image.lisp	30 Mar 2008 19:58:39 -0000
@@ -815,13 +815,14 @@
 			  (gc t)
 			  ;; (start-address #x100000)
 			  &allow-other-keys)
-  (psetq *image* (let ((*image* (apply #'make-movitz-image
-				       :start-address #x100000
-				       init-args)))
-		   (when init-file
-		     (movitz-compile-file init-file))
-		   *image*)
-	 *i* *image*)
+  (let ((*default-pathname-defaults* (pathname (directory-namestring *lpd*))))
+    (psetq *image* (let ((*image* (apply #'make-movitz-image
+					 :start-address #x100000
+					 init-args)))
+		     (when init-file
+		       (movitz-compile-file init-file))
+		     *image*)
+	   *i* *image*))
   (when gc
     #+allegro (setf (sys:gsgc-parameter :generation-spread) 8)
     #+allegro (excl:gc :tenure)