From 9ff9070e7930f238ba5da46aac5af3e1adcd638f Mon Sep 17 00:00:00 2001
From: Alan Ruttenberg <alanruttenberg@gmail.com>
Date: Tue, 17 Dec 2019 12:18:27 -0500
Subject: [PATCH 1/5] Add OSGI functionality to JSS, plus other minor
 improvements. Engage the #1".." reader, which allows java expressions e.g.
 #1"System.out.printLn("foo")"

---
 contrib/abcl-asdf/abcl-asdf.asd         |   6 +-
 contrib/abcl-asdf/asdf-osgi-bundle.lisp |  25 ++
 contrib/jss/invoke.lisp                 | 150 ++++++----
 contrib/jss/javaparser.lisp             |   1 +
 contrib/jss/jss.asd                     |   3 +-
 contrib/jss/osgi.lisp                   | 347 ++++++++++++++++++++++++
 contrib/jss/packages.lisp               |  11 +
 contrib/jss/util.lisp                   |  32 +++
 8 files changed, 524 insertions(+), 51 deletions(-)
 create mode 100644 contrib/abcl-asdf/asdf-osgi-bundle.lisp
 create mode 100644 contrib/jss/osgi.lisp

diff --git a/contrib/abcl-asdf/abcl-asdf.asd b/contrib/abcl-asdf/abcl-asdf.asd
index 276ae2285..ec49cea37 100644
--- a/contrib/abcl-asdf/abcl-asdf.asd
+++ b/contrib/abcl-asdf/abcl-asdf.asd
@@ -18,6 +18,10 @@
             :pathname "" 
             :components ((:file "maven")
                          (:file "mvn-module"))
-            :depends-on (base)))
+    :depends-on (base))
+   (:module osgi
+            :pathname "" 
+            :components ((:file "asdf-osgi-bundle"))
+    :depends-on (base)))
   :in-order-to ((test-op (test-op abcl-asdf-tests))))
 
diff --git a/contrib/abcl-asdf/asdf-osgi-bundle.lisp b/contrib/abcl-asdf/asdf-osgi-bundle.lisp
new file mode 100644
index 000000000..316a4e0ae
--- /dev/null
+++ b/contrib/abcl-asdf/asdf-osgi-bundle.lisp
@@ -0,0 +1,25 @@
+(in-package :asdf)
+
+(defclass bundle (jar-file)
+  ;; bootdelegation and system-packages correspond to the framework
+  ;; config vars org.osgi.framework.bootdelegation and
+  ;; org.osgi.framework.system.packages.extra implementation is to
+  ;; restart OSGI with the values appended to the existing
+  ;; configuration in *osgi-configuration* I thought I understood the
+  ;; difference but I don't - only system-packages has worked for me.
+  ;; These should be lists of strings .  What these accomplish might
+  ;; better be done with "extension bundles" but I haven't tried them
+  ;; yet.
+  ((bootdelegation :initarg :bootdelegation :initform nil)
+   (system-packages :initarg :system-packages :initform nil)))
+
+(defmethod perform ((operation load-op) (c bundle))
+  (let ((extra-bootdelegation (slot-value c 'bootdelegation))
+	(extra-system-packages (slot-value c 'system-packages)))
+    (if (or extra-bootdelegation extra-system-packages)
+	(warn "not handling :bootdelegation and :system-packages args yet"))
+    (jss:add-bundle  (component-pathname c))))
+
+(defmethod perform ((operation compile-op) (c bundle))
+  (jss:add-bundle (component-pathname c)))
+
diff --git a/contrib/jss/invoke.lisp b/contrib/jss/invoke.lisp
index b621659a8..87bd566c2 100644
--- a/contrib/jss/invoke.lisp
+++ b/contrib/jss/invoke.lisp
@@ -125,14 +125,22 @@
     "Whether to automatically introspect all Java classes on the classpath when JSS is loaded.")
   (defvar *muffle-warnings* t
     "Attempt to make JSS less chatting about how things are going.")
+  (defvar *loaded-osgi-bundles* nil)
   (defvar *imports-resolved-classes* (make-hash-table :test 'equalp)
     "Hashtable of all resolved imports by the current process."))
 
 (defun find-java-class (name)
-  "Returns the java.lang.Class representation of NAME.
-
-NAME can either string or a symbol according to the usual JSS conventions."
-  (jclass (maybe-resolve-class-against-imports name)))
+  (if (consp name) ;; invoke-restargs first calls maybe-resolve-class-against-imports, and this on the result.
+      (jcall "loadClass" (car name) (second name))
+      (let ((maybe (maybe-resolve-class-against-imports name)))
+	(or (and (atom maybe) (not (null maybe))
+		 (jstatic +for-name+ "java.lang.Class" maybe +true+ java::*classloader*))
+	    (ignore-errors
+	     (let ((resolved (maybe-resolve-class-against-imports name)))
+	       (if (consp resolved)
+		   (jcall "loadClass" (car resolved) (second resolved)) 
+		   (jclass resolved))))
+	    ))))
 
 (defmacro invoke-add-imports (&rest imports)
   "Push these imports onto the search path. If multiple, earlier in list take precedence"
@@ -145,14 +153,28 @@ NAME can either string or a symbol according to the usual JSS conventions."
 (defun clear-invoke-imports ()
   (clrhash *imports-resolved-classes*))
 
+;; Check against *imports-resolved-classes*. If there's a class or a bundle class that wins.
+;; Otherwise look through the bundles and if unique win
+;; Otherwise complain ambiguous
+
 (defun maybe-resolve-class-against-imports (classname)
-  (or (gethash (string classname) *imports-resolved-classes*)
-      (let ((found (lookup-class-name classname)))
-        (if found
-            (progn 
-              (setf (gethash classname *imports-resolved-classes*) found)
-              found)
-            (string classname)))))
+   (or (gethash (string classname) *imports-resolved-classes*)
+       (let ((found (lookup-class-name classname :muffle-warning t)))
+	 (if found
+	     (progn 
+	       (setf (gethash classname *imports-resolved-classes*) found)
+	       found)
+	     (let ((choices
+		     (loop for bundle-entry in *loaded-osgi-bundles*
+			   for found = (lookup-class-name classname :table (third bundle-entry) :muffle-warning  t)
+			   when found collect (list bundle-entry found))))
+	       (cond ((zerop (length choices)) (string classname))
+		     ((= (length choices) 1)
+		      (unless (gethash classname *imports-resolved-classes*)
+			(setf (gethash classname *imports-resolved-classes*) (list (second (caar choices)) (second (car choices)))))
+		      (list (second (caar choices)) (second (car choices))))
+		     (t (error "Ambiguous class name: ~{~a~^, ~}"  
+			       (mapcar (lambda(el) (format "~a in bundle ~a" (second el) (caar el))) choices)))))))))
 
 (defvar *class-name-to-full-case-insensitive* (make-hash-table :test 'equalp))
 
@@ -172,7 +194,7 @@ NAME can either string or a symbol according to the usual JSS conventions."
          (object-as-class 
           (if object-as-class-name (find-java-class object-as-class-name))))
     (if (eq method 'new)
-        (apply #'jnew (or object-as-class-name object) args)
+        (apply #'jnew (or object-as-class object-as-class-name object) args)
         (if raw?
             (if (symbolp object)
                 (apply #'jstatic-raw method object-as-class  args)
@@ -205,15 +227,19 @@ NAME can either string or a symbol according to the usual JSS conventions."
 ;; a regular Lisp string as ABCL converts the Java string to a Lisp string.
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun read-invoke (stream char arg) 
-    (unread-char char stream)
-    (let ((name (read stream)))
-      (if (or (find #\. name) (find #\{ name))
-          (jss-transform-to-field name arg)
-          (let ((object-var (gensym))
-                (args-var (gensym)))
-            `(lambda (,object-var &rest ,args-var) 
-               (invoke-restargs ,name  ,object-var ,args-var ,(eql arg 0)))))))
+  (defun read-invoke (stream char arg)
+    (if (eql arg 1)
+        (progn (require 'javaparser)
+               (read-sharp-java-expression stream))
+        (progn
+          (unread-char char stream)
+          (let ((name (read stream)))
+            (if (or (find #\. name) (find #\{ name))
+                (jss-transform-to-field name arg)
+                (let ((object-var (gensym))
+                      (args-var (gensym)))
+                  `(lambda (,object-var &rest ,args-var) 
+                     (invoke-restargs ,name  ,object-var ,args-var ,(eql arg 0)))))))))
   (set-dispatch-macro-character #\# #\" 'read-invoke))
 
 (defmacro with-constant-signature (fname-jname-pairs &body body)
@@ -263,9 +289,10 @@ want to avoid the overhead of the dynamic dispatch."
 
 
 (defun lookup-class-name (name &key
-                                 (table *class-name-to-full-case-insensitive*)
+                                 (table  *class-name-to-full-case-insensitive*)
                                  (muffle-warning *muffle-warnings*)
-                                 (return-ambiguous nil))
+                                 (return-ambiguous nil)
+                               &aux (symbol? (symbolp name)))
   (let ((overridden (maybe-found-in-overridden name)))
     (when overridden (return-from lookup-class-name overridden)))
   (setq name (string name))
@@ -279,7 +306,7 @@ want to avoid the overhead of the dynamic dispatch."
           (let ((matcher (#0"matcher" last-name-pattern name)))
             (#"matches" matcher)
             (#"group" matcher 1))))
-    (let* ((bucket (gethash last-name *class-name-to-full-case-insensitive*))
+    (let* ((bucket (gethash last-name table))
            (bucket-length (length bucket)))
       (or (find name bucket :test 'equalp)
           (flet ((matches-end (end full test)
@@ -292,7 +319,7 @@ want to avoid the overhead of the dynamic dispatch."
                        (error "Ambiguous class name: ~a can be ~{~a~^, ~}" name choices))))
             (if (zerop bucket-length)
                 (progn (unless muffle-warning (warn "can't find class named ~a" name)) nil)
-                (let ((matches (loop for el in bucket when (matches-end name el 'char=) collect el)))
+                (let ((matches (loop for el in bucket when (matches-end name el (if symbol? 'char-equal 'char=)) collect el)))
                   (if (= (length matches) 1)
                       (car matches)
                       (if (= (length matches) 0)
@@ -304,6 +331,15 @@ want to avoid the overhead of the dynamic dispatch."
                                     (ambiguous matches))))
                           (ambiguous matches))))))))))
 
+;; Interactive use: Give a full class name as a string, return the shortest unique abbreviation
+(defun shortest-unambiguous-java-class-abbreviation(name &optional as-string?)
+  (let ((components (mapcar (if as-string? 'identity 'string-upcase) (split-at-char name #\.))))
+    (loop for size from 1 to (length components)
+	  for abbreviation = (funcall (if as-string? 'identity (lambda(e) (intern (string-upcase e))))
+				      (format nil "~{~a~^.~}" (subseq components (- (length components) size) (length components))))
+	  for possible = (jss::lookup-class-name abbreviation :return-ambiguous t)
+	  when (not (listp possible)) do (return-from shortest-unambiguous-java-class-abbreviation abbreviation))))
+
 (defun get-all-jar-classnames (jar-file-name)
   (let* ((jar (jnew (jconstructor "java.util.jar.JarFile" (jclass "java.lang.String")) (namestring (truename jar-file-name))))
          (entries (#"entries" jar)))
@@ -324,13 +360,27 @@ want to avoid the overhead of the dynamic dispatch."
              (cons name fullname))
            ))))
 
+(defun index-class-names (names &key (table (make-hash-table :test 'equalp)))
+  (with-constant-signature ((matcher "matcher" t) (substring "substring")
+			    (jreplace "replace" t) (jlength "length")
+			    (matches "matches") 
+			    (group "group"))
+    (loop for name in names
+	  with class-pattern = (jstatic "compile" "java.util.regex.Pattern" ".*\\.class{0,1}$")
+	  with name-pattern = (jstatic "compile" "java.util.regex.Pattern" ".*?([^.]*)$")
+	  when (matches (matcher class-pattern name))
+	    do
+	       (let* ((fullname (substring (jreplace name #\/ #\.) 0 (- (jlength name) 6)))
+		      (matcher (matcher name-pattern fullname))
+		      (name (progn (matches matcher) (group matcher 1))))
+		 (pushnew fullname (gethash name table) 
+			  :test 'equal))))
+  table)
+
 (defun jar-import (file)
   "Import all the Java classes contained in the pathname FILE into the JSS dynamic lookup cache."
   (when (probe-file file)
-    (loop for (name . full-class-name) in (get-all-jar-classnames file)
-       do 
-         (pushnew full-class-name (gethash name *class-name-to-full-case-insensitive*) 
-                  :test 'equal))))
+    (index-class-names (get-all-jar-classnames file) :table *class-name-to-full-case-insensitive*)))
 
 (defun new (class-name &rest args)
   "Invoke the Java constructor for CLASS-NAME with ARGS.
@@ -423,10 +473,7 @@ associated is used to look up the static FIELD."
 (defconstant +for-name+ 
   (jmethod "java.lang.Class" "forName" "java.lang.String" "boolean" "java.lang.ClassLoader"))
 
-(defun find-java-class (name)
-  (or (jstatic +for-name+ "java.lang.Class" 
-               (maybe-resolve-class-against-imports name) +true+ java::*classloader*)
-      (ignore-errors (jclass (maybe-resolve-class-against-imports name)))))
+
 
 (defmethod print-object ((obj (jclass "java.lang.Class")) stream) 
   (print-unreadable-object (obj stream :identity nil)
@@ -512,28 +559,33 @@ associated is used to look up the static FIELD."
   (when *do-auto-imports* 
     (do-auto-imports)))
 
-(defun japropos (string)
+(defun japropos (string &optional (fn (lambda(match type bundle?) (format t "~a: ~a~a~%" match type bundle?))))
   "Output the names of all Java class names loaded in the current process which match STRING.."
-  (setq string (string string))
-  (let ((matches nil))
-    (maphash (lambda(key value) 
-               (declare (ignore key))
-               (loop for class in value
-                  when (search string class :test 'string-equal)
-                  do (pushnew (list class "Java Class") matches :test 'equal)))
-             *class-name-to-full-case-insensitive*)
-    (loop for (match type) in (sort matches 'string-lessp :key 'car)
-       do (format t "~a: ~a~%" match type))
-    ))
+  (flet ((searchit (table &optional bundle-name)
+	   (let ((bundle? (if bundle-name (format nil ", Bundle: ~a" bundle-name) "")))
+	     (setq string (string string))
+	     (let ((matches nil))
+	       (maphash (lambda(key value) 
+			  (declare (ignore key))
+			  (loop for class in value
+				when (search string class :test 'string-equal)
+				  do (pushnew (list class "Java Class") matches :test 'equal)))
+			table)
+	       (loop for (match type) in (sort matches 'string-lessp :key 'car)
+		     do (funcall fn  match type bundle?))))))
+    (searchit *class-name-to-full-case-insensitive*)
+    (loop for (name nil table) in *loaded-osgi-bundles*
+	  do (searchit table name))))
 
 (defun jclass-method-names (class &optional full)
   (if (java-object-p class)
       (if (equal (jclass-name (jobject-class class)) "java.lang.Class")
-          (setq class (jclass-name class))
-          (setq class (jclass-name (jobject-class class)))))
+	  nil
+          (setq class (jobject-class class)))
+      (setq class (find-java-class class)))
   (union
-   (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getMethods" (find-java-class class))) :test 'equal)
-   (ignore-errors (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getConstructors" (find-java-class class))) :test 'equal))))
+   (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getMethods" class)) :test 'equal)
+   (ignore-errors (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getConstructors" class)) :test 'equal))))
 
 (defun java-class-method-names (class &optional stream)
   "Return a list of the public methods encapsulated by the JVM CLASS.
diff --git a/contrib/jss/javaparser.lisp b/contrib/jss/javaparser.lisp
index 122f8e2ed..259314543 100644
--- a/contrib/jss/javaparser.lisp
+++ b/contrib/jss/javaparser.lisp
@@ -29,6 +29,7 @@
 
 (defmethod read-java-expression ((r javaparser) expression)
   `(let ((this *object-for-this*))
+     (declare (ignorable this))
      ,(process-node r (#"parseExpression" 'javaparser expression))))
 
 (def-java-read LongLiteralExpr javaparser ()
diff --git a/contrib/jss/jss.asd b/contrib/jss/jss.asd
index ffd31faa7..556afe08a 100644
--- a/contrib/jss/jss.asd
+++ b/contrib/jss/jss.asd
@@ -8,8 +8,9 @@
                         :components ((:file "packages")
                                      (:file "invoke")
                                      (:file "collections")
-                                     (:file "optimize-java-call")
                                      (:file "classpath")
+                                     (:file "osgi")
+                                     (:file "optimize-java-call")
                                      (:file "transform-to-field")
                                      (:file "compat")
                                      (:file "jtypecase")
diff --git a/contrib/jss/osgi.lisp b/contrib/jss/osgi.lisp
new file mode 100644
index 000000000..b6b6e99c7
--- /dev/null
+++ b/contrib/jss/osgi.lisp
@@ -0,0 +1,347 @@
+(in-package :jss)
+
+;; This is the start of an extension of JSS to be able to use OSGI
+;; Bundles.  Currently one can, at least, take advantage of the class
+;; hiding aspect - with the visible packages listed in a JAR manifest
+;; "Exported-Packages", those classes can be accessed while the others
+;; can't.
+
+;; General use:
+;; (add-bundle path-to-jar-file)
+;; (find-java-class <some class exported from your bundle>)
+;; Do stuff
+
+;; The current implementation assumes you aren't aiming to have
+;; multiple version of the same class exported from different bundles
+;; in that find-java-class will try to complain when a class name is
+;; ambiguous, but once a class is found it will continue to be found,
+;; even if another version of the class becomes available in another
+;; bundle. For finer control use:
+;; (find-bundle-class bundle classname)
+;; Class name can be abbreviated as with find-java-class
+
+;; bundle arguments can either be a string result of
+;; (#"getSymbolicName" bundle) or a bundle object loaded bundles are
+;; in an association list in *loaded-osgi-bundles*, with each element
+;; being (name object class-lookup-hash)
+
+;; My primary use is to use a project with dependencies that conflict
+;; with the jars I'm using.  Here's an example of how I package that
+;; using maven. It is from module-bundle/pom.xml from the project
+;; https://github.com/alanruttenberg/pagoda (that project uses maven
+;; modules in order to also be able to run the usual packaging)
+;;
+;; <plugin>
+;; boilerplate. The maven-bundle-plugin takes over the package phase from the default assembly plugin
+;; 	<groupId>org.apache.felix</groupId>
+;; 	<artifactId>maven-bundle-plugin</artifactId>
+;; 	<extensions>true</extensions>
+;; 	<configuration>
+;; 	  <descriptorRefs>
+;; This will be the prefix for the jar that is created. It will be prefix-<version>.jar
+;; 	    <descriptorRef>pagoda-bundle</descriptorRef>
+;; 	  </descriptorRefs>
+;; 	  <instructions>
+;; These are the packages that I want to be visible
+;; 	    <Export-Package>uk.ac.ox.cs.pagoda.*,uk.ac.ox.cs.JRDFox.*</Export-Package>
+;; This says to put absolutely every class/jar that they depend on in the created bundle
+;; 	    <Embed-Dependency>*;scope=compile</Embed-Dependency>   
+;; 	    <Embed-Transitive>true</Embed-Transitive>
+;; This avoids having the bundle plugin write dependencies that imply
+;; the jars of the dependency are also bundles. If they aren't then
+;; you get link errors when trying to install the bundle. (sheesh!)
+;; 	    <Import-Package/>
+;; 	  </instructions>
+;; 	</configuration>
+;; </plugin>
+
+
+(defvar *osgi-framework* nil)
+
+;; Beware the cache. Bundles are installed in a cache folder and
+;; reinstalling them without clearing that will cause a conflict - an
+;; error about duplicates. (Among other things, the installation
+;; unpacks the jars in the bundle and arranges the classpath to use
+;; them).  While I believe that the cache will be refreshed if the
+;; version number on the bundle is changed, it's annoying to do that
+;; during development. Instead, if the bundle is already installed
+;; (available via #"getBundles") then we compare the modification
+;; dates of the installed verison and file-write-date of the jar, and
+;; if the jar is newer uninstall the old bundle and install the new
+;; one.
+
+;; The cache location is taken from *osgi-cache-location*. The current
+;; location can be had by (osgi-cache-path) You can ensure a clean
+;; cache by calling (ensure-osgi-framework :clean-cache t) before
+;; calling add-bundle, or set *osgi-clean-cache-on-start* to t
+
+;; arg name is used to identify the bundle among the loaded bundles. If
+;; not supplied then the "symbolic name" is used, the value of the
+;; manifest header "Bundle-SymbolicName".
+
+(defvar *osgi-cache-location* (namestring (merge-pathnames 
+					   (make-pathname :directory '(:relative "abcl-felix-cache"))
+					   (user-homedir-pathname)))
+  "Where bundle jars are copied to and unpacked if necessary. Default is to have it distinct from the default, since who knows what's been put there")
+
+;;http://felix.apache.org/documentation/subprojects/apache-felix-framework/apache-felix-framework-configuration-properties.html
+
+(defvar *osgi-configuration* `(;; Where the cache should live
+			       ("org.osgi.framework.storage" ,*osgi-cache-location*)
+			       ;; So that imported system classes are loaded using ABCL's classloader
+			       ("org.osgi.framework.bundle.parent" "framework")
+			       ;; sounds good even though I'm not understanding bootdelegation yet
+			       ("felix.bootdelegation.implicit" "true")
+			       ;; just in case
+			       ("org.osgi.framework.library.extensions" "jnilib,dylib")
+			       ))
+
+(defvar *osgi-clean-cache-on-start* t "Clear the cache on startup. First add-bundle has this set as t and then flips to nil (so you don't lose the rest of your packages)")
+
+(defvar *osgi-native-libraries* nil "Alist of bundles -> native libraries they're to load. Informative - not prescriptive")
+
+(defvar *before-osgi-starting-hooks* nil "A list of functions to call before before OSGI starts, for example to modify *osgi-configuration*")
+
+;; Why is the native library not being loaded with system.load()?
+
+;; Because system.load looks up the stack for a caller and that
+;; caller's classloader is used to findLibrary, and the classloader
+;; is the wrong one.
+;; Proof: The call to loadlibary on the *right* classloader works.
+;; The class in question is FactPlusPlus which calls System.load() in its init.
+;; FaCTPlusPlusReasonerFactory is loaded by the same (osgi) classloader so we get *that* classloader
+;; and then call the loadLibrary method on it. It takes another class (which classloader is used for findLibrary
+;; (jstatic (find "loadLibrary"  (#"getDeclaredMethods"  (find-java-class 'lang.classloader)) :key #"getName" :test 'equal)  c (find-java-class 'FaCTPlusPlusReasonerFactory) "FaCTPlusPlusJNI" +false+)
+
+;; However in the context, when system.load is called, it doesn't have
+;; a class to look the classloader up with, so it looks down the stack
+;; and grabs a class and uses its classloaer. Apparently that's *not*
+;; the osgi classloader, presumably because it's called from the
+;; framework, and the framework's classloader is not the same as the
+;; classloader that the framework uses to load bundle classes.
+
+;; here's a guess. If calling with felix.main, the framework gets an
+;; osgi classloader and subsequently all is happy.
+;;
+;; Could be fixed in code by not calling system.load but rather
+;; speaking to the classloader directly as above.
+;; A theory: If a class in another bundle loaded factpp then it would work.
+;; THIS DOESN'T HAPPEN IF felix.main is used rather than felix.framework!!!
+
+;; configuration properties are set last to first, so you can prepend overrides to *osgi-configuration*
+
+(eval-when (:load-toplevel :execute)
+  (loop for function in *before-osgi-starting-hooks* do (funcall function)))
+
+(defun ensure-osgi-initialized (&key (empty-cache *osgi-clean-cache-on-start*))
+  (unless *osgi-framework*
+    (loop for function in *before-osgi-starting-hooks* do (funcall function))
+    (let ((map (new 'java.util.properties))
+	  (configuration *osgi-configuration*))
+      (loop for (prop val) in (reverse configuration) do (#"setProperty" map prop val))
+      (when empty-cache
+	(#"setProperty" map "org.osgi.framework.storage.clean" "onFirstInit"))
+      (flet ((resolve (artifact)
+	       (funcall (intern "RESOLVE" 'abcl-asdf) artifact)))
+	(add-to-classpath ;; sometimes resolve returns ":" separated pathnames of both main and framework jars. Only need the first.
+	 ;; 5.6.1 current as of Jan/17
+	 (car (split-at-char (resolve "org.apache.felix/org.apache.felix.main/5.6.1") ":"))))
+      (let* ((framework-factory-class (find-java-class 'org.osgi.framework.launch.FrameworkFactory))
+	     (ffs (#"load" 'ServiceLoader framework-factory-class (#"getClassLoader" framework-factory-class)))
+	     (factory (#"next" (#"iterator" ffs)))
+	     (framework (#"newFramework" factory map)))
+	(#"start" framework)
+	(setq *osgi-framework* framework)))))
+
+(defun force-unpack-native-libraries (bundle jar)
+  "Not used unless OSGI misbehaves again"
+  (let ((wiring (#"adapt" bundle (find-java-class 'BundleWiring))))
+    (loop for native in (jss::j2list (#"getNativeLibraries" wiring))
+	  for entry = (#"getEntryName" native)
+	  for library-path = (#"getEntryAsNativeLibrary" (#"getContent" (#"getRevision" wiring)) entry)
+	  do (pushnew (list jar library-path) *osgi-native-libraries* :test 'equalp)
+	     ;;(#"load" 'system library-path)
+	  )))
+
+(defun stop-osgi ()
+  (#"stop" *osgi-framework*)
+  (setq *osgi-framework* nil)
+  ;; should *loaded-osgi-bundles* be set to nil here?
+  )
+
+(defun reset-osgi ()
+  "Restart OSGI after emptying the cache, and reload bundles that were loaded"
+  (stop-osgi)
+  (ensure-osgi-initialized :empty-cache t)
+  (loop for (name nil nil jar) in (copy-list *loaded-osgi-bundles*)
+	do (add-bundle jar :name name)))
+
+(defun get-osgi-framework-property (property)
+  (ensure-osgi-initialized)
+  (#"getProperty" (#"getBundleContext" *osgi-framework*) property))
+
+(defun add-to-comma-separated-osgi-config (config-parameter elements)
+  (let* ((entry (find config-parameter *osgi-configuration* :test 'equal :key 'car))
+	 (value (if entry (second entry) ""))
+	 (new-value (format nil "~{~a~^,~}" 
+			    (sort (union elements (if (equal value "") nil (jss::split-at-char value #\,))
+					 :test 'equalp)
+				  'string-lessp))))
+    (if entry
+	(setf (second entry) new-value)
+	(push (list config-parameter new-value) *osgi-configuration*))))
+
+(defun osgi-cache-path ()
+  (ensure-osgi-initialized)
+  (get-osgi-framework-property "org.osgi.framework.storage"))
+			       
+;; this: http://lisptips.com/post/11649360174/the-common-lisp-and-unix-epochs is wrong!
+;; Compute the offset using (#"currentTimeMillis" 'system)
+(defun universal-to-bundle-time (universal-time)
+  "Convert from lisp time to unix time in milliseconds, used by osgi"
+  (let ((offset (- (get-universal-time) (floor (#"currentTimeMillis" 'system) 1000))))
+    (* 1000 (- universal-time offset))))
+
+(defun add-bundle (jar &key name)
+  (ensure-osgi-initialized)
+  (setq *osgi-clean-cache-on-start* nil)
+  (setq jar (namestring (translate-logical-pathname jar)))
+  (let* ((bundle-context (#"getBundleContext" *osgi-framework*))
+	 (bundle (find jar (#"getBundles" bundle-context) :key #"getLocation" :test 'search)))
+    (when (or (not bundle)
+	      (< (#"getLastModified" bundle) 
+		 (universal-to-bundle-time (file-write-date jar))))
+      (when bundle
+	(warn "reinstalling bundle ~a" jar)
+	(#"uninstall" bundle))
+      (unless (member :scheme (pathname-host jar))
+	(setq jar (concatenate 'string "file:" jar)))
+      (setq bundle (#"installBundle" bundle-context jar)))
+
+    (#"start" bundle)
+    (let ((name (or name (#"getSymbolicName" bundle))))
+      (let* ((index (index-class-names (bundle-exports bundle))))
+	(setq *loaded-osgi-bundles* (remove name *loaded-osgi-bundles* :test 'equalp :key 'car))
+	(push (list name bundle index jar) *loaded-osgi-bundles*)
+;	(force-unpack-native-libraries bundle jar)
+	bundle))))
+
+(defun bundle-headers (bundle)
+  (loop with headers = (#"getHeaders" bundle)
+	for key in (j2list (#"keys" headers))
+	collect (list key (#"get" headers key) (#"get" headers key))))
+
+(defun bundle-header (bundle key)
+  (#"get"  (#"getHeaders" bundle) key))
+
+;; Not useful yet
+(defun bundle-capabilities (bundle)
+  (let ((bundleWiring (#"adapt" bundle (find-java-class 'BundleWiring))))
+    (loop with i = (#"iterator" (#"getCapabilities" bundlewiring +null+)) 
+	  while (#"hasNext" i)
+	  for cap = (#"next" i) 
+	  for namespace = (#"getNamespace" cap)
+	  for es = (#"entrySet" (#"getAttributes" cap)) 
+	  collect (list* namespace cap (mapcar #"getValue" (set-to-list es))))))
+
+;; This is ugly but will do until there's a better way The exported
+;; packages are listed as the value of the header "Export-Package" The
+;; format is a concatenation of entries like the below
+
+;; package;key="...","..";key2="",
+;; package2,
+;; package3;..,
+
+;; i.e. for each package there are some optional key values pairs
+;; which we're not going to attend to now,
+
+;; Step 1: Since there are "," inside the string we take this apart by
+;; first emptying the strings, then splitting by ",", then tossing
+;; anything past a ";"
+
+;; Step 2: There may or may not be subpackages. Since we're going to
+;; match on the prefix, we throw away everything but the prefix. This
+;; is done by first sorting, then taking an element and comparing it
+;; to subsequent ones. When the first start the other we toss the other.
+;; Not really necessary - not doing it would just be wasted work.
+
+;; Step 3: The bundlewiring interface lets one iterate over all
+;; 'resources', which are like entries in a jar, some of which are
+;; class files. We only want the exported class files, so we only keep
+;; those that start with our prefix (.->/ to make it a path)
+
+;; Step 4: Extract the class name from the path (keep ".class" at the end)
+
+;; Learned about bundle wiring at
+;; http://stackoverflow.com/questions/22688997/how-i-can-get-list-of-all-classes-from-given-bundle
+
+;; Spun my wheels a while looking for a cleaner way to do this, but
+;; its confusing. This should do for now.
+
+(defun bundle-exports (bundle)
+  (let ((entry (bundle-header bundle "Export-Package"))
+	(bundleWiring (#"adapt" bundle (find-java-class 'BundleWiring))))
+    ;; if there's an "Export-package" then respect it
+    (if entry
+	(loop for package-prefix
+		in 
+		(loop with candidates = (sort (mapcar (lambda(el) (#"replaceAll" el ";.*$" "")) 
+						      (split-at-char (#"replaceAll" entry "(\\\".*?\\\")" "") #\,))			 
+					      'string-lessp)
+		      for first = (pop candidates)
+		      until (null candidates)
+		      do (loop for next = (car candidates)
+			       while (and next (eql 0 (search first next))) do (pop candidates))
+		      collect first)
+	      for path = (substitute #\/ #\. package-prefix) 
+	      append
+	      (loop for entry in (set-to-list (#"listResources" bundlewiring (concatenate 'string "/" path)
+								"*.*" (jfield (find-java-class 'BundleWiring) "FINDENTRIES_RECURSE")))
+		    for url = (#"toString" (#"getEntry" bundle entry))
+		    collect
+		    (substitute #\. #\/ (subseq 
+					 (#"toString" (#"getEntry" bundle entry))
+					 (search path url :test 'char=)))))
+	;; otherwise it's all good
+	(loop for entry in (set-to-list (#"listResources"
+					 bundlewiring "/"
+					 "*.*" (jfield (find-java-class 'BundleWiring) "FINDENTRIES_RECURSE")))
+	      for url = (#"toString" (#"getEntry" bundle entry))
+	      when (#"matches" url ".*\\.class$")
+		collect
+		(substitute #\. #\/ (subseq (subseq url 9) (1+ (search "/" (subseq url 9)))))))))
+
+(defun dwim-find-bundle-entry (name)
+  (let ((string (string name)))
+    (let ((candidates (remove-if-not (lambda(e) (search string (car e) :test 'string-equal))  jss::*loaded-osgi-bundles*)))
+      (cond ((= (length candidates) 0) (error "Bundle ~a not found" name))
+	    ((= (length candidates) 1) (car candidates))
+	    (t (error "Ambiguous \"~a\" could mean ~{~a~^, ~}" (mapcar 'car candidates)))))))
+    
+;; Like find java class, but looks in a bundle. no-cache means don't
+;; look for it like find-java-class and don't cache it for
+;; find-java-class. Default currently is to do so, but I might change
+;; the default, as it could lead to confusion in the case where both
+;; find-java-class and find-bundle-class are used and there are two
+;; versions of the same class in the environment.
+
+(defun find-bundle-class (bundle classname &key no-cache &aux bundle-entry)
+  (cond ((or (stringp bundle) (symbolp bundle) )
+	 (setq bundle-entry (dwim-find-bundle-entry bundle))
+	 (setq bundle (second bundle-entry)))
+	((java-object-p bundle)
+	 (setq bundle-entry (find bundle *loaded-osgi-bundles* :key 'second))))
+  (assert bundle () "No bundle named ~a" bundle)
+  ;; we'll allow one bundle to be in the cache. Check if we're the one.
+  (or (let ((found (and (not no-cache) (gethash (string classname) *imports-resolved-classes*))))
+	(and (consp found) (eq (car found) bundle) (second found)))
+      (let ((found (lookup-class-name classname :table (third bundle-entry))))
+	(if found
+	    (progn 
+	      (unless no-cache
+		(unless (gethash classname *imports-resolved-classes*)
+		  (setf (gethash classname *imports-resolved-classes*) (cons bundle found))))
+	      (#"loadClass" bundle found))
+	    (#"loadClass" bundle (string classname))))))
+  
+
diff --git a/contrib/jss/packages.lisp b/contrib/jss/packages.lisp
index ec935cc1b..eadbbf8dd 100644
--- a/contrib/jss/packages.lisp
+++ b/contrib/jss/packages.lisp
@@ -1,6 +1,9 @@
+(defvar cl-user::*before-osgi-starting-hooks* nil)
+(export 'cl-user::*before-osgi-starting-hooks* 'cl-user)
 (defpackage :jss
   (:nicknames "java-simple-syntax" "java-syntax-sucks")
   (:use :common-lisp :extensions :java)
+  (:import-from "CL-USER" cl-user::*before-osgi-starting-hooks*)
   (:export 
    #:*inhibit-add-to-classpath*
    #:*added-to-classpath*
@@ -12,6 +15,14 @@
 
    #:invoke-add-imports
    #:find-java-class
+
+   #:add-bundle
+   #:find-bundle-class
+   #:ensure-osgi-initialized
+   #:*osgi-cache-location*
+   #:*osgi-configuration*
+   #:*osgi-clean-cache-on-start*
+   
    #:jcmn #:java-class-method-names
    #:japropos
    #:new 
diff --git a/contrib/jss/util.lisp b/contrib/jss/util.lisp
index 1d6b6c32b..af3561b03 100644
--- a/contrib/jss/util.lisp
+++ b/contrib/jss/util.lisp
@@ -23,3 +23,35 @@
       )
     (#"appendTail" matcher sb)
     (#"toString" sb)))
+
+(defparameter *regex-chars-needing-escape* 
+  (concatenate 'string (string #\tab) ".[]()\\?*+{}^$&|"))
+
+;; add here even though in util
+(defun split-at-char (string char)
+  (let ((regex (string char)))
+    (when (simple-string-search regex *regex-chars-needing-escape*)
+      (setq regex (system::concatenate-to-string (list "\\" regex))))
+    (with-constant-signature ((split "split") (tostring "toString"))
+      (loop for v across (split string regex) collect (tostring v)))))
+
+(defun all-matches (string regex &rest which)
+  (declare (optimize (speed 3) (safety 0)))
+  (and string
+       (let ((matcher (#"matcher" 
+		       (if (stringp regex)
+			   (#"compile" 'java.util.regex.pattern regex)
+			   regex)
+		       string)))
+	 (with-constant-signature ((mfind "find") (mgroup "group"))
+	   (loop while (mfind matcher) 
+	      collect (loop for g in which collect
+			   (mgroup matcher g)))))))
+
+(define-compiler-macro all-matches
+    (&whole form  string regex &rest which)
+  "Compile constant regex to pattern at compile time"
+  (cond ((stringp regex)
+	 `(all-matches ,string (load-time-value (#"compile" 'java.util.regex.Pattern ,regex))
+		       ,@which))
+        (t form)))

From f21ede8ffd98ee716c27bfb3dc227363333d7f2e Mon Sep 17 00:00:00 2001
From: Alan Ruttenberg <alanruttenberg@gmail.com>
Date: Tue, 17 Dec 2019 12:24:07 -0500
Subject: [PATCH 2/5] Fix precompiler-setq to signal simple-error vs
 simple-program-error, since latter doesn't exist

---
 src/org/armedbear/lisp/precompiler.lisp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/org/armedbear/lisp/precompiler.lisp b/src/org/armedbear/lisp/precompiler.lisp
index af4866a74..23911bfaf 100644
--- a/src/org/armedbear/lisp/precompiler.lisp
+++ b/src/org/armedbear/lisp/precompiler.lisp
@@ -543,7 +543,7 @@
   (let* ((args (cdr form))
          (len (length args)))
     (when (oddp len)
-      (error 'simple-program-error
+      (error 'simple-error
              :format-control "Odd number of arguments to SETQ."))
     (if (= len 2)
         (let* ((sym (%car args))

From 8b2dbef01fe9224f598fd18d1f40bc1c23457ddf Mon Sep 17 00:00:00 2001
From: Alan Ruttenberg <alanruttenberg@gmail.com>
Date: Tue, 17 Dec 2019 14:07:32 -0500
Subject: [PATCH 3/5] Fix for bad merge + One more init call was necessary in
 maven.lisp.

---
 contrib/abcl-asdf/maven.lisp |  1 +
 contrib/jss/invoke.lisp      | 22 ++++------------------
 contrib/jss/osgi.lisp        | 19 +++++++++++++++++++
 3 files changed, 24 insertions(+), 18 deletions(-)

diff --git a/contrib/abcl-asdf/maven.lisp b/contrib/abcl-asdf/maven.lisp
index 17b40f25f..e0322b76e 100644
--- a/contrib/abcl-asdf/maven.lisp
+++ b/contrib/abcl-asdf/maven.lisp
@@ -367,6 +367,7 @@ hint."
 
 (defun make-session (repository-system)
   "Construct a new aether.RepositorySystemSession from the specified REPOSITORY-SYSTEM."
+  (unless *init* (init))
   (with-aether ()
     (let ((session
            (or 
diff --git a/contrib/jss/invoke.lisp b/contrib/jss/invoke.lisp
index 87bd566c2..8280f233e 100644
--- a/contrib/jss/invoke.lisp
+++ b/contrib/jss/invoke.lisp
@@ -360,27 +360,13 @@ want to avoid the overhead of the dynamic dispatch."
              (cons name fullname))
            ))))
 
-(defun index-class-names (names &key (table (make-hash-table :test 'equalp)))
-  (with-constant-signature ((matcher "matcher" t) (substring "substring")
-			    (jreplace "replace" t) (jlength "length")
-			    (matches "matches") 
-			    (group "group"))
-    (loop for name in names
-	  with class-pattern = (jstatic "compile" "java.util.regex.Pattern" ".*\\.class{0,1}$")
-	  with name-pattern = (jstatic "compile" "java.util.regex.Pattern" ".*?([^.]*)$")
-	  when (matches (matcher class-pattern name))
-	    do
-	       (let* ((fullname (substring (jreplace name #\/ #\.) 0 (- (jlength name) 6)))
-		      (matcher (matcher name-pattern fullname))
-		      (name (progn (matches matcher) (group matcher 1))))
-		 (pushnew fullname (gethash name table) 
-			  :test 'equal))))
-  table)
-
 (defun jar-import (file)
   "Import all the Java classes contained in the pathname FILE into the JSS dynamic lookup cache."
   (when (probe-file file)
-    (index-class-names (get-all-jar-classnames file) :table *class-name-to-full-case-insensitive*)))
+    (loop for (name . full-class-name) in (get-all-jar-classnames file)
+       do 
+         (pushnew full-class-name (gethash name *class-name-to-full-case-insensitive*) 
+                  :test 'equal))))
 
 (defun new (class-name &rest args)
   "Invoke the Java constructor for CLASS-NAME with ARGS.
diff --git a/contrib/jss/osgi.lisp b/contrib/jss/osgi.lisp
index b6b6e99c7..eb420c1b2 100644
--- a/contrib/jss/osgi.lisp
+++ b/contrib/jss/osgi.lisp
@@ -226,6 +226,25 @@
 ;	(force-unpack-native-libraries bundle jar)
 	bundle))))
 
+(defun index-class-names (names &key (table (make-hash-table :test 'equalp)))
+  (with-constant-signature ((matcher "matcher" t) (substring "substring")
+			    (jreplace "replace" t) (jlength "length")
+			    (matches "matches") 
+			    (group "group"))
+    (loop for name in names
+	  with class-pattern = (jstatic "compile" "java.util.regex.Pattern" ".*\\.class{0,1}$")
+	  with name-pattern = (jstatic "compile" "java.util.regex.Pattern" ".*?([^.]*)$")
+	  when (matches (matcher class-pattern name))
+	    do
+	       (let* ((fullname (substring (jreplace name #\/ #\.) 0 (- (jlength name) 6)))
+		      (matcher (matcher name-pattern fullname))
+		      (name (progn (matches matcher) (group matcher 1))))
+		 (pushnew fullname (gethash name table) 
+			  :test 'equal))))
+  table)
+
+
+
 (defun bundle-headers (bundle)
   (loop with headers = (#"getHeaders" bundle)
 	for key in (j2list (#"keys" headers))

From 41000e8029a9904a243aef9032e4b396ae9bfa29 Mon Sep 17 00:00:00 2001
From: Alan Ruttenberg <alanruttenberg@gmail.com>
Date: Sat, 21 Dec 2019 15:08:34 -0500
Subject: [PATCH 4/5] Package issue when compiling abcl

---
 contrib/jss/packages.lisp | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/contrib/jss/packages.lisp b/contrib/jss/packages.lisp
index eadbbf8dd..d93baa6e5 100644
--- a/contrib/jss/packages.lisp
+++ b/contrib/jss/packages.lisp
@@ -1,5 +1,6 @@
-(defvar cl-user::*before-osgi-starting-hooks* nil)
-(export 'cl-user::*before-osgi-starting-hooks* 'cl-user)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar cl-user::*before-osgi-starting-hooks* nil)
+  (export 'cl-user::*before-osgi-starting-hooks* 'cl-user))
 (defpackage :jss
   (:nicknames "java-simple-syntax" "java-syntax-sucks")
   (:use :common-lisp :extensions :java)

From fc804a9992d762f397a1533c2d10c412023a0fd2 Mon Sep 17 00:00:00 2001
From: Mark <evenson.not.org@gmail.com>
Date: Fri, 26 Jun 2020 08:04:29 +0200
Subject: [PATCH 5/5] abcl-asdf: fix bad merge choice for osgi work

---
 contrib/abcl-asdf/abcl-asdf.asd | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/contrib/abcl-asdf/abcl-asdf.asd b/contrib/abcl-asdf/abcl-asdf.asd
index 135ce5d18..27a3ad2b0 100644
--- a/contrib/abcl-asdf/abcl-asdf.asd
+++ b/contrib/abcl-asdf/abcl-asdf.asd
@@ -18,7 +18,7 @@
             :pathname "" 
             :components ((:file "maven")
                          (:file "mvn-module"))
-    :depends-on (base))
+    :depends-on (package))
    (:module osgi
             :pathname "" 
             :components ((:file "asdf-osgi-bundle"))