[armedbear-cvs] r12514 - in trunk/abcl: . src/org/armedbear/lisp

[Mark Evenson]

Author: mevenson
Date: Wed Mar  3 10:18:41 2010
New Revision: 12514

Log:
Create logical pathnames translations for "SYS:SRC" and "SYS:JAVA".

COMPILE-SYSTEM now dumps the file "system.lisp" to the output path,
which gets picked up by the build process and packaged in abcl.jar.
boot.lisp now has a (REQUIRE :system) form to load this, trapping any
errors to be non-fatal.



Modified:
   trunk/abcl/CHANGES
   trunk/abcl/build.xml
   trunk/abcl/src/org/armedbear/lisp/boot.lisp
   trunk/abcl/src/org/armedbear/lisp/compile-system.lisp

Modified: trunk/abcl/CHANGES
==============================================================================
--- trunk/abcl/CHANGES	(original)
+++ trunk/abcl/CHANGES	Wed Mar  3 10:18:41 2010
@@ -6,6 +6,10 @@
 Features
 --------
 
+* [svn 12513] Implement SYS:SRC and SYS:JAVA logical pathname
+  translations for system Lisp source and the root of the Java package
+  structure, respectively.
+
 * [svn 12505] All calls to anonymous functions and local functions that have
   been declared inline are now converted to LET* forms, reducing stack usage
   and the number of generated classes.

Modified: trunk/abcl/build.xml
==============================================================================
--- trunk/abcl/build.xml	(original)
+++ trunk/abcl/build.xml	Wed Mar  3 10:18:41 2010
@@ -80,6 +80,8 @@
     </patternset>
 
     <patternset id="abcl.objects">
+      <!-- "system.lisp" is dynamically created by COMPILE-SYSTEM -->
+      <include name="org/armedbear/lisp/system.lisp"/> 
       <include name="org/armedbear/lisp/**/*.class"/>
       <include name="org/armedbear/lisp/**/*.cls"/> 
       <include name="org/armedbear/lisp/**/*.abcl"/>

Modified: trunk/abcl/src/org/armedbear/lisp/boot.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/boot.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/boot.lisp	Wed Mar  3 10:18:41 2010
@@ -191,3 +191,13 @@
   (unless *noinform*
     (%format t "Startup completed in ~A seconds.~%"
              (float (/ (ext:uptime) 1000)))))
+
+;;; "system.lisp" contains system installation specific information
+;;; (currently only the logical pathname definition for "SYS;SRC")
+;;; that is not currently required for ABCL to run.  Since
+;;; LOAD-SYSTEM-FILE exits the JVM if its argument cannot be found, we
+;;; use REQUIRE trapping any error.
+(handler-case 
+    (require 'system)
+  (t ()))
+

Modified: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-system.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compile-system.lisp	Wed Mar  3 10:18:41 2010
@@ -284,5 +284,20 @@
            (%compile-system :output-path output-path))
          (unless failure-p
            (setf status 0)))))
+    (create-system-logical-translations output-path)
     (when quit
       (quit :status status))))
+
+(defun create-system-logical-translations (output-path)
+  (let* ((dir (directory-namestring (pathname output-path)))
+         (system (merge-pathnames "system.lisp" dir))
+         (home (pathname *lisp-home*))
+         (src (format nil "~A**/*.*" home))
+         (java (format nil "~A../../../**/*.*" home)))
+    (with-open-file (s system :direction :output 
+                       :if-exists :supersede)
+      (write `(setf (logical-pathname-translations "sys")
+                    '(("SYS:SRC;**;*.*" ,src)
+                      ("SYS:JAVA;**;*.*" ,java)))
+       :stream s))))
+