Changeset 12514

Timestamp:

03/03/10 15:18:41 (13 years ago)

Author:

Mark Evenson

Message:

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.

Location:

trunk/abcl

Files:

• CHANGES (modified) (1 diff)
• build.xml (modified) (1 diff)
• src/org/armedbear/lisp/boot.lisp (modified) (1 diff)
• src/org/armedbear/lisp/compile-system.lisp (modified) (1 diff)

trunk/abcl/CHANGES

@@ -6 +6 @@
 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

trunk/abcl/build.xml

@@ -81 +81 @@
 
     <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"/> 

trunk/abcl/src/org/armedbear/lisp/boot.lisp

@@ -192 +192 @@
     (%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 ()))
+

trunk/abcl/src/org/armedbear/lisp/compile-system.lisp

@@ -285 +285 @@
          (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))))
+