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.
parent 331d2ef6
......@@ -6,6 +6,10 @@ svn://common-lisp.net/project/armedbear/svn/trunk/abcl
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.
......
......@@ -80,6 +80,8 @@ For help on the automatic tests available, use the Ant target 'help.test'.
</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"/>
......
......@@ -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 ()))
......@@ -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))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment