aio: use jar manifest to declare location of packaged entities

A Jar manifest may have sections which we use to declare locations
within the Jar for packaged entities.  The key 'name' denotes the
relative path within the jar.  The key 'Implementation-Title' uniquely
defines an id for the packaged entity.  We define 'org.abcl-contrib'
to be the key that identifies the location of ABCL-CONTRIB, and we
modify the search strategy defined by SYS:FIND-CONTRIB and friends

parent c6885b05
......@@ -40,7 +40,7 @@ For help on the automatic tests available, use the Ant target 'help.test'.
<property name="abcl.jar.path"
<property name="abcl.aio.jar.path"
<property name="abcl-aio.jar.path"
<property name="abcl.ext.dir"
......@@ -492,9 +492,9 @@ from ${abcl.home.dir}
<target name="abcl.aio" depends="abcl.compile,abcl.stamp">
<target name="abcl-aio.jar" depends="abcl.compile,abcl.version">
<mkdir dir="${dist.dir}"/>
<jar destfile="${abcl.aio.jar.path}"
<jar destfile="${abcl-aio.jar.path}"
......@@ -506,6 +506,9 @@ from ${abcl.home.dir}
<fileset dir="${basedir}">
<patternset refid="abcl.contrib.source"/>
<!-- According to <>
any attributes not specified are ignored, so we are free to make up new attributes if necessary. For now we just overload Implementation-Title and Implementation-Version.
<attribute name="Main-Class" value="org.armedbear.lisp.Main"/>
<section name="org/armedbear/lisp">
......@@ -516,6 +519,23 @@ from ${abcl.home.dir}
<attribute name="Implementation-Build"
<section name="contrib">
<attribute name="Implementation-Title"
<!-- FIXME: declare separate abcl-contrib version? -->
<attribute name="Implementation-Version"
<section name="tools">
<attribute name="Implementation-Title"
<section name="src">
<attribute name="Implementation-Title"
<attribute name="Implementation-Version"
<metainf dir="${src.dir}/META-INF">
<exclude name="services/javax.script.ScriptEngineFactory"
......@@ -528,7 +548,8 @@ from ${abcl.home.dir}
<target name="abcl.wrapper"
Creates in-place executable shell wrapper in '${abcl.wrapper.file}'
Creates in-place executable shell wrapper in
<!-- Set from commandline or in '' -->
<property name="additional.jars" value=""/>
......@@ -1172,9 +1193,4 @@ user.dir
<import file="build-snapshot.xml" optional="true"/>
<import file="build-maven.xml" optional="true"/>
<import file="build-maven.xml" optional="true"/> </project>
......@@ -33,7 +33,7 @@
(defun find-system ()
"Find the location of the system.
"Find the location of the Armed Bear system implementation
Used to determine relative pathname to find 'abcl-contrib.jar'."
......@@ -71,14 +71,15 @@ Initialized via SYSTEM:FIND-CONTRIB.")
(defparameter *verbose* t)
(defun add-contrib (abcl-contrib-jar &optional relative)
"Introspects ABCL-CONTRIB-JAR for asdf systems to add to ASDF:*CENTRAL-REGISTRY*"
(when abcl-contrib-jar
;;; FIXME: stop using the obsolete ASDF:*CENTRAL-REGISTRY*
(defun add-contrib (abcl-contrib-jar)
"Introspects a abcl-contrib-jar path whose immediate sub-directories
contain asdf definitions, adding those found to asdf."
(let ((jar-path (if (ext:pathname-jar-p abcl-contrib-jar)
(make-pathname :device (list abcl-contrib-jar)))))
(dolist (asdf-file
(directory (make-pathname :device (list abcl-contrib-jar)
:directory (if relative `(:absolute ,relative :wild) '(:absolute :wild))
:name :wild
:type "asd")))
(directory (merge-pathnames "*/*.asd" jar-path)))
(let ((asdf-directory (make-pathname :defaults asdf-file :name nil :type nil)))
(unless (find asdf-directory asdf:*central-registry* :test #'equal)
(push asdf-directory asdf:*central-registry*)
......@@ -86,45 +87,83 @@ Initialized via SYSTEM:FIND-CONTRIB.")
(defun find-and-add-contrib (&key (verbose nil))
"Attempt to find the ABCL contrib jar and add its contents to ASDF.
Returns the pathname of the contrib if it can be found."
(if *abcl-contrib*
(format verbose "~&Using already initialized value of abcl-contrib:~&'~A'.~%"
(setf *abcl-contrib* (find-contrib))
(format verbose "~&Using probed value of abcl-contrib:~&'~A'.~%"
(add-contrib *abcl-contrib*
(and (equalp *abcl-contrib* (find-system-jar))
returns the pathname of the contrib if it can be found."
(if *abcl-contrib*
(format verbose "~&Using already initialized value of abcl-contrib:~&'~A'.~%"
(let ((contrib (find-contrib)))
(when contrib
(format verbose "~&Using probed value of abcl-contrib:~&'~A'.~%"
(setf *abcl-contrib* contrib)))))
(when *abcl-contrib* ;; For bootstrap compile there will be no contrib
(add-contrib *abcl-contrib*)))
(defun find-name-for-implementation-title (file id)
"For a jar FILE containing a manifest, return the name of the
section which annotates 'Implementation-Title' whose string value is
(declare (type pathname file))
(let* ((jar (java:jnew "java.util.jar.JarFile" (namestring file)))
(manifest (java:jcall "getManifest" jar))
(entries (java:jcall "toArray"
(java:jcall "entrySet"
(java:jcall "getEntries" manifest)))))
(dolist (entry
(loop :for entry :across entries
:collecting entry))
(let ((title (java:jcall "getValue"
(java:jcall "getValue" entry)
(when (string-equal title id)
(return-from find-name-for-implementation-title
(java:jcall "getKey" entry))))
(defun find-contrib ()
"Introspect runtime classpaths to find a loadable ABCL-CONTRIB."
(or (ignore-errors
(let ((system-jar (find-system-jar)))
(probe-file (make-pathname
:device (list system-jar)
:directory '(:absolute "contrib")
:name "README" :type "markdown" ))
(let ((system-jar (find-system-jar)))
(when system-jar
(probe-file (make-pathname
:defaults system-jar
:name (concatenate 'string
(subseq (pathname-name system-jar) 4)))))))
(lambda (u)
"Introspect runtime classpaths to return a pathname containing
subdirectories containing ASDF definitions."
;; We identify the location of the directory within a jar file
;; containing abcl-contrib ASDF definitions by looking for a section
;; which contains the Implementation-Title "org.abcl-contrib". The
;; name of that section then identifies the relative pathname to the
;; top-most directory in the Jar
;; e.g. for an entry of the form
;; Name: contrib
;; Implementation-Title: org.abcl-contrib
;; the directory 'contrib' would be searched for ASDF definitions.
(let* ((system-jar
(find-name-for-implementation-title system-jar "org.abcl-contrib")))
(when (and system-jar relative-pathname)
(merge-pathnames (pathname (concatenate 'string
relative-pathname "/"))
:device (list system-jar))))))
(let ((system-jar (find-system-jar)))
(when system-jar
(probe-file (make-pathname
:defaults (java:jcall "toString" u)
:name "abcl-contrib")))
(java:jcall "getURLs" (boot-classloader)))))
:defaults system-jar
:name (concatenate 'string
(subseq (pathname-name system-jar) 4)))))))
(lambda (u)
(probe-file (make-pathname
:defaults (java:jcall "toString" u)
:name "abcl-contrib")))
(java:jcall "getURLs" (boot-classloader)))))
(export `(find-system
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