From mevenson at common-lisp.net Sat Apr 12 17:25:53 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sat, 12 Apr 2014 17:25:53 -0000 Subject: [Armedbear-cvs] r14663 - trunk/abcl/contrib/mvn Message-ID: <20140412172553.28917.14533@lisp.not.org> Author: mevenson Date: Sat Apr 12 17:25:52 2014 New Revision: 14663 Log: jna: now retrieves jna-4.1.0 Maven artifacts. 32 out of 286 total tests failed: FUNCALL.F-S-P.1, CALLBACKS.LONG, CALLBACKS.UNSIGNED-LONG, CALLBACKS.LONG-LONG, CALLBACKS.UNSIGNED-LONG-LONG, CALLBACKS.POINTER, CALLBACKS.STRING-NOT-DOCSTRING, CALLBACKS.NIL-FOR-NULL, CALLBACKS.FUNCALL.1, CALLBACKS.FUNCALL.2, CALLBACKS.DOUBLE26.FUNCALL, CALLBACKS.FLOAT26.FUNCALL, FOREIGN-GLOBALS.NAMESPACE.1, FOREIGN-GLOBALS.NAMESPACE.2, FOREIGN-GLOBALS.NAMESPACE.4, MAKE-POINTER.HIGH, FOREIGN-ALLOC.1, FOREIGN-ALLOC.2, FOREIGN-ALLOC.3, FOREIGN-ALLOC.4, FOREIGN-ALLOC.6, FOREIGN-ALLOC.8, FOREIGN-ALLOC.9, NULL-POINTER-P.NON-POINTER.1, NULL-POINTER-P.NON-POINTER.2, NULL-POINTER-P.NON-POINTER.3, STRUCT-VALUES-DEFAULT.TRANSLATION.MEM-REF.1, STRUCT-VALUES-DEFAULT.TRANSLATION.MEM-REF.2, FSBV.2, FSBV.3, FSBV.4, FSBV.7. 32 unexpected failures: FUNCALL.F-S-P.1, CALLBACKS.LONG, Modified: trunk/abcl/contrib/mvn/jna.asd Modified: trunk/abcl/contrib/mvn/jna.asd ============================================================================== --- trunk/abcl/contrib/mvn/jna.asd Tue Mar 25 15:34:06 2014 (r14662) +++ trunk/abcl/contrib/mvn/jna.asd Sat Apr 12 17:25:52 2014 (r14663) @@ -2,11 +2,11 @@ ;;;; Need to have jna.jar present for CFFI to work. (asdf:defsystem :jna - :version "4.0.0" - :description "<> asdf:defsystem " + :version "4.1.0" + :description "<> asdf:defsystem " :defsystem-depends-on (jss abcl-asdf) - :components ((:mvn "net.java.dev.jna/jna/4.0.0" - :alternate-uri "http://repo1.maven.org/maven2/net/java/dev/jna/jna/4.0.0/jna-4.0.0.jar" + :components ((:mvn "net.java.dev.jna/jna/4.1.0" + :alternate-uri "http://repo1.maven.org/maven2/net/java/dev/jna/jna/4.1.0/jna-4.1.0.jar" :classname "com.sun.jna.Native"))) (in-package :asdf) From mevenson at common-lisp.net Thu Apr 17 10:18:31 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:18:31 -0000 Subject: [Armedbear-cvs] r14664 - branches/1.3.1 Message-ID: <20140417101831.12229.88993@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:18:30 2014 New Revision: 14664 Log: abcl-1.3.1 branch created. Added: branches/1.3.1/ - copied from r14663, branches/1.3.0/ From mevenson at common-lisp.net Thu Apr 17 10:32:44 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:32:44 -0000 Subject: [Armedbear-cvs] r14665 - branches/1.3.1/src/org/armedbear/lisp Message-ID: <20140417103244.12719.68866@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:32:44 2014 New Revision: 14665 Log: backport r14654: Remove trailing whitespace and untabify. Modified: branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Modified: branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Thu Apr 17 10:18:30 2014 (r14664) +++ branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Thu Apr 17 10:32:44 2014 (r14665) @@ -2,10 +2,10 @@ (require :asdf) -(defconstant +get-classloader+ +(defconstant +get-classloader+ (java:jmethod "java.lang.Class" "getClassLoader")) -(defun boot-classloader () +(defun boot-classloader () (let ((boot-class (java:jclass "org.armedbear.lisp.Main"))) (java:jcall +get-classloader+ boot-class))) @@ -18,35 +18,35 @@ (defun named-jar-p (name p) (and (pathnamep p) (equal (pathname-type p) "jar") - (or + (or (java:jstatic "matches" - "java.util.regex.Pattern" + "java.util.regex.Pattern" (concatenate 'string name "(-[0-9]\\.[0-9]\\.[0-9]([+~-].+)?)?") (pathname-name p)) (java:jstatic "matches" - "java.util.regex.Pattern" + "java.util.regex.Pattern" (concatenate 'string name "(-[0-9]\\.[0-9]\\.[0-9]\\.[0-9]([+~-]+)?)?") (pathname-name p))) (make-pathname :defaults p :name name))) (defun find-system () - "Find the location of the system. + "Find the location of the system. Used to determine relative pathname to find 'abcl-contrib.jar'." - (or - (ignore-errors + (or + (ignore-errors (find-system-jar)) (ignore-errors - (some - (lambda (u) - (probe-file (make-pathname - :defaults (java:jcall "toString" u) + (some + (lambda (u) + (probe-file (make-pathname + :defaults (java:jcall "toString" u) :name "abcl"))) (java:jcall "getURLs" (boot-classloader)))) - (ignore-errors + (ignore-errors #p"http://abcl.org/releases/current/abcl.jar"))) -(defun find-system-jar () +(defun find-system-jar () "Return the pathname of the system jar, one of `abcl.jar` or `abcl-m.n.p.jar` or `abcl-m.n.p[.~-]something.jar`." (dolist (loader (java:dump-classpath)) (let ((abcl-jar (some #'system-jar-p loader))) @@ -79,7 +79,7 @@ (if *abcl-contrib* (format verbose "~&Using already initialized value of abcl-contrib:~&'~A'.~%" *abcl-contrib*) - (progn + (progn (setf *abcl-contrib* (find-contrib)) (format verbose "~&Using probed value of abcl-contrib:~&'~A'.~%" *abcl-contrib*))) @@ -87,29 +87,21 @@ (defun find-contrib () "Introspect runtime classpaths to find a loadable ABCL-CONTRIB." - (or (ignore-errors - (when (find-system-jar) - (probe-file - (make-pathname :defaults (find-system-jar) - :name "abcl-contrib")))) - (some - (lambda (u) - (probe-file (make-pathname - :defaults (java:jcall "toString" u) - :name "abcl-contrib"))) - (java:jcall "getURLs" (boot-classloader))))) + (or (ignore-errors + (when (find-system-jar) + (probe-file + (make-pathname :defaults (find-system-jar) + :name "abcl-contrib")))) + (some + (lambda (u) + (probe-file (make-pathname + :defaults (java:jcall "toString" u) + :name "abcl-contrib"))) + (java:jcall "getURLs" (boot-classloader))))) -(export `(find-system +(export `(find-system find-contrib *abcl-contrib*)) + (when (find-and-add-contrib :verbose t) (provide :abcl-contrib)) - - - - - - - - - From mevenson at common-lisp.net Thu Apr 17 10:33:49 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:33:49 -0000 Subject: [Armedbear-cvs] r14666 - branches/1.3.1/src/org/armedbear/lisp Message-ID: <20140417103349.12818.61700@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:33:49 2014 New Revision: 14666 Log: Backport r14655: Normalized indentation. Modified: branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Modified: branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Thu Apr 17 10:32:44 2014 (r14665) +++ branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Thu Apr 17 10:33:49 2014 (r14666) @@ -48,10 +48,10 @@ (defun find-system-jar () "Return the pathname of the system jar, one of `abcl.jar` or `abcl-m.n.p.jar` or `abcl-m.n.p[.~-]something.jar`." - (dolist (loader (java:dump-classpath)) - (let ((abcl-jar (some #'system-jar-p loader))) - (when abcl-jar - (return abcl-jar))))) + (dolist (loader (java:dump-classpath)) + (let ((abcl-jar (some #'system-jar-p loader))) + (when abcl-jar + (return abcl-jar))))) (defvar *abcl-contrib* nil "Pathname of the ABCL contrib. @@ -63,41 +63,40 @@ "Introspects ABCL-CONTRIB-JAR for asdf systems to add to ASDF:*CENTRAL-REGISTRY*" (when abcl-contrib-jar (dolist (asdf-file - (directory (make-pathname :device (list abcl-contrib-jar) - :directory '(:absolute :wild) - :name :wild - :type "asd"))) + (directory (make-pathname :device (list abcl-contrib-jar) + :directory '(:absolute :wild) + :name :wild + :type "asd"))) (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*) (format *verbose* "~&Added ~A to ASDF.~&" asdf-directory)))))) - (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'.~%" *abcl-contrib*) - (progn - (setf *abcl-contrib* (find-contrib)) - (format verbose "~&Using probed value of abcl-contrib:~&'~A'.~%" - *abcl-contrib*))) + (progn + (setf *abcl-contrib* (find-contrib)) + (format verbose "~&Using probed value of abcl-contrib:~&'~A'.~%" + *abcl-contrib*))) (add-contrib *abcl-contrib*)) (defun find-contrib () "Introspect runtime classpaths to find a loadable ABCL-CONTRIB." (or (ignore-errors - (when (find-system-jar) - (probe-file - (make-pathname :defaults (find-system-jar) - :name "abcl-contrib")))) - (some - (lambda (u) - (probe-file (make-pathname - :defaults (java:jcall "toString" u) - :name "abcl-contrib"))) - (java:jcall "getURLs" (boot-classloader))))) + (when (find-system-jar) + (probe-file + (make-pathname :defaults (find-system-jar) + :name "abcl-contrib")))) + (some + (lambda (u) + (probe-file (make-pathname + :defaults (java:jcall "toString" u) + :name "abcl-contrib"))) + (java:jcall "getURLs" (boot-classloader))))) (export `(find-system find-contrib From mevenson at common-lisp.net Thu Apr 17 10:34:36 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:34:36 -0000 Subject: [Armedbear-cvs] r14667 - branches/1.3.1/src/org/armedbear/lisp Message-ID: <20140417103436.12886.84705@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:34:35 2014 New Revision: 14667 Log: Backport r14656: Find the versioned system and contrib jars when building with Maven Modified: branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Modified: branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Thu Apr 17 10:33:49 2014 (r14666) +++ branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Thu Apr 17 10:34:35 2014 (r14667) @@ -27,7 +27,7 @@ "java.util.regex.Pattern" (concatenate 'string name "(-[0-9]\\.[0-9]\\.[0-9]\\.[0-9]([+~-]+)?)?") (pathname-name p))) - (make-pathname :defaults p :name name))) + p)) (defun find-system () "Find the location of the system. @@ -46,12 +46,21 @@ (ignore-errors #p"http://abcl.org/releases/current/abcl.jar"))) -(defun find-system-jar () - "Return the pathname of the system jar, one of `abcl.jar` or `abcl-m.n.p.jar` or `abcl-m.n.p[.~-]something.jar`." +(defun find-jar (predicate) (dolist (loader (java:dump-classpath)) - (let ((abcl-jar (some #'system-jar-p loader))) - (when abcl-jar - (return abcl-jar))))) + (let ((jar (some predicate loader))) + (when jar + (return jar))))) + +(defun find-system-jar () + "Return the pathname of the system jar, one of `abcl.jar` or +`abcl-m.n.p.jar` or `abcl-m.n.p[.~-]something.jar`." + (find-jar #'system-jar-p)) + +(defun find-contrib-jar () + "Return the pathname of the contrib jar, one of `abcl-contrib.jar` or +`abcl-contrib-m.n.p.jar` or `abcl-contrib-m.n.p[.~-]something.jar`." + (find-jar #'contrib-jar-p)) (defvar *abcl-contrib* nil "Pathname of the ABCL contrib. @@ -87,10 +96,7 @@ (defun find-contrib () "Introspect runtime classpaths to find a loadable ABCL-CONTRIB." (or (ignore-errors - (when (find-system-jar) - (probe-file - (make-pathname :defaults (find-system-jar) - :name "abcl-contrib")))) + (find-contrib-jar)) (some (lambda (u) (probe-file (make-pathname From mevenson at common-lisp.net Thu Apr 17 10:35:18 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:35:18 -0000 Subject: [Armedbear-cvs] r14668 - branches/1.3.1/src/org/armedbear/lisp Message-ID: <20140417103518.12957.99527@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:35:17 2014 New Revision: 14668 Log: Backport r14657: Find contrib based on system jar name. >From Olof-Joachim Frahm. Modified: branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Modified: branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Thu Apr 17 10:34:35 2014 (r14667) +++ branches/1.3.1/src/org/armedbear/lisp/abcl-contrib.lisp Thu Apr 17 10:35:17 2014 (r14668) @@ -97,6 +97,14 @@ "Introspect runtime classpaths to find a loadable ABCL-CONTRIB." (or (ignore-errors (find-contrib-jar)) + (ignore-errors + (let ((system-jar (find-system-jar))) + (when system-jar + (probe-file (make-pathname + :defaults system-jar + :name (concatenate 'string + "abcl-contrib" + (subseq (pathname-name system-jar) 4))))))) (some (lambda (u) (probe-file (make-pathname From mevenson at common-lisp.net Thu Apr 17 10:36:11 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:36:11 -0000 Subject: [Armedbear-cvs] r14669 - branches/1.3.1/nbproject Message-ID: <20140417103611.13029.6974@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:36:10 2014 New Revision: 14669 Log: Backport r14658: Update build artifact for NetBeans 8.0 Modified: branches/1.3.1/nbproject/build-impl.xml branches/1.3.1/nbproject/genfiles.properties Modified: branches/1.3.1/nbproject/build-impl.xml ============================================================================== --- branches/1.3.1/nbproject/build-impl.xml Thu Apr 17 10:35:17 2014 (r14668) +++ branches/1.3.1/nbproject/build-impl.xml Thu Apr 17 10:36:10 2014 (r14669) @@ -80,9 +80,12 @@ - - - + + + + + + @@ -1199,11 +1202,14 @@ - + + + + - + @@ -1277,7 +1283,7 @@ - + Some tests failed; see details above. Modified: branches/1.3.1/nbproject/genfiles.properties ============================================================================== --- branches/1.3.1/nbproject/genfiles.properties Thu Apr 17 10:35:17 2014 (r14668) +++ branches/1.3.1/nbproject/genfiles.properties Thu Apr 17 10:36:10 2014 (r14669) @@ -4,8 +4,8 @@ # This file is used by a NetBeans-based IDE to track changes in generated files such as build-impl.xml. # Do not edit this file. You may delete it but then the IDE will never regenerate such files for you. nbproject/build-impl.xml.data.CRC32=742204ce -nbproject/build-impl.xml.script.CRC32=364c80b9 -nbproject/build-impl.xml.stylesheet.CRC32=5a01deb7 at 1.68.1.46 +nbproject/build-impl.xml.script.CRC32=768003f6 +nbproject/build-impl.xml.stylesheet.CRC32=876e7a8f at 1.74.1.48 nbproject/profiler-build-impl.xml.data.CRC32=71623fcd nbproject/profiler-build-impl.xml.script.CRC32=abda56ed nbproject/profiler-build-impl.xml.stylesheet.CRC32=42cb6bcf From mevenson at common-lisp.net Thu Apr 17 10:37:07 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:37:07 -0000 Subject: [Armedbear-cvs] r14670 - branches/1.3.1/src/org/armedbear/lisp Message-ID: <20140417103707.13136.2518@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:37:06 2014 New Revision: 14670 Log: Backport r14659: Fix Uniform Naming Convention (aka "UNC" or "network") paths under Windows. DIRECTORY now works again on UNC paths. UNC paths may be either specified with either back slash (#\\) or forward slash (#\/) doubled as the first character in a Pathname namestring. The patterns in ////[directories-and-files] are parsed as is stored as HOST. is stored as DEVICE. [directories-and-files] gets parsed as per the normal rules under Windows. Mixing namestrings with both backslash and slash characters can lead to unpredictable results. It is recommended not to use backslash characters in namestrings if it can be avoided. The pathname printed representation is always normalized to using forward slash delimiters. Modified: branches/1.3.1/src/org/armedbear/lisp/Pathname.java branches/1.3.1/src/org/armedbear/lisp/directory.lisp Modified: branches/1.3.1/src/org/armedbear/lisp/Pathname.java ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/Pathname.java Thu Apr 17 10:36:10 2014 (r14669) +++ branches/1.3.1/src/org/armedbear/lisp/Pathname.java Thu Apr 17 10:37:06 2014 (r14670) @@ -242,28 +242,34 @@ return; } if (Utilities.isPlatformWindows) { - if (s.startsWith("\\\\")) { // XXX What if string starts with '//'? - //UNC path support - // match \\\\[directories-and-files] - - int shareIndex = s.indexOf('\\', 2); - int dirIndex = s.indexOf('\\', shareIndex + 1); - - if (shareIndex == -1 || dirIndex == -1) { - error(new LispError("Unsupported UNC path format: \"" + s + '"')); - } + if (s.startsWith("\\\\") || s.startsWith("//")) { + // UNC path support + int shareIndex; + int dirIndex; + // match \\\\[directories-and-files] + if (s.startsWith("\\\\")) { + shareIndex = s.indexOf('\\', 2); + dirIndex = s.indexOf('\\', shareIndex + 1); + // match ////[directories-and-files] + } else { + shareIndex = s.indexOf('/', 2); + dirIndex = s.indexOf('/', shareIndex + 1); + } + if (shareIndex == -1 || dirIndex == -1) { + error(new LispError("Unsupported UNC path format: \"" + s + '"')); + } - host = new SimpleString(s.substring(2, shareIndex)); - device = new SimpleString(s.substring(shareIndex + 1, dirIndex)); + host = new SimpleString(s.substring(2, shareIndex)); + device = new SimpleString(s.substring(shareIndex + 1, dirIndex)); - Pathname p = new Pathname(s.substring(dirIndex)); - directory = p.directory; - name = p.name; - type = p.type; - version = p.version; - invalidateNamestring(); - return; - } + Pathname p = new Pathname(s.substring(dirIndex)); + directory = p.directory; + name = p.name; + type = p.type; + version = p.version; + invalidateNamestring(); + return; + } } // A JAR file @@ -381,10 +387,10 @@ String uriPath = uri.getPath(); if (null == uriPath) { - // Under Windows, deal with pathnames containing - // devices expressed as "file:z:/foo/path" - uriPath = uri.getSchemeSpecificPart(); - if (uriPath == null || uriPath.equals("")) { + // Under Windows, deal with pathnames containing + // devices expressed as "file:z:/foo/path" + uriPath = uri.getSchemeSpecificPart(); + if (uriPath == null || uriPath.equals("")) { error(new LispError("The URI has no path: " + uri)); } } @@ -651,8 +657,8 @@ sb.append(host.getStringValue()); sb.append(':'); } else { - // UNC paths now use unprintable representation - return null; + // A UNC path + sb.append("//").append(host.getStringValue()).append("/"); } } boolean uriEncoded = false; @@ -663,20 +669,20 @@ StringBuilder prefix = new StringBuilder(); for (int i = 0; i < jars.length; i++) { prefix.append("jar:"); - LispObject component = jars[i]; - if (!(component instanceof Pathname)) { - return null; // If DEVICE is a CONS, it should only contain Pathname - } + LispObject component = jars[i]; + if (!(component instanceof Pathname)) { + return null; // If DEVICE is a CONS, it should only contain Pathname + } if (! ((Pathname)component).isURL() && i == 0) { - sb.append("file:"); - uriEncoded = true; + sb.append("file:"); + uriEncoded = true; } Pathname jar = (Pathname) component; String encodedNamestring; if (uriEncoded) { - encodedNamestring = uriEncode(jar.getNamestring()); + encodedNamestring = uriEncode(jar.getNamestring()); } else { - encodedNamestring = jar.getNamestring(); + encodedNamestring = jar.getNamestring(); } sb.append(encodedNamestring); sb.append("!/"); @@ -685,8 +691,8 @@ } else if (device instanceof AbstractString) { sb.append(device.getStringValue()); if (this instanceof LogicalPathname - || host == NIL) { - sb.append(':'); // non-UNC paths + || host == NIL) { + sb.append(':'); // non-UNC paths } } else { Debug.assertTrue(false); Modified: branches/1.3.1/src/org/armedbear/lisp/directory.lisp ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/directory.lisp Thu Apr 17 10:36:10 2014 (r14669) +++ branches/1.3.1/src/org/armedbear/lisp/directory.lisp Thu Apr 17 10:37:06 2014 (r14670) @@ -121,9 +121,15 @@ (let ((namestring (directory-namestring pathname))) (when (and namestring (> (length namestring) 0)) (when (featurep :windows) - (let ((device (pathname-device pathname))) - (when device - (setq namestring (concatenate 'string device ":" namestring))))) + (let ((host (pathname-host pathname)) + (device (pathname-device pathname))) + (cond + ((and host device) + (setq namestring + (concatenate 'string "//" host "/" device namestring))) + (device + (setq namestring + (concatenate 'string device ":" namestring)))))) (let ((entries (list-directories-with-wildcards namestring nil resolve-symlinks)) (matching-entries ())) From mevenson at common-lisp.net Thu Apr 17 10:37:58 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:37:58 -0000 Subject: [Armedbear-cvs] r14671 - branches/1.3.1 Message-ID: <20140417103758.13207.86879@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:37:57 2014 New Revision: 14671 Log: Backport r14660: Don't emit warnings for JDK8 in build process: it seems to work just fine. Modified: branches/1.3.1/build.xml Modified: branches/1.3.1/build.xml ============================================================================== --- branches/1.3.1/build.xml Thu Apr 17 10:37:06 2014 (r14670) +++ branches/1.3.1/build.xml Thu Apr 17 10:37:57 2014 (r14671) @@ -156,6 +156,8 @@ + From mevenson at common-lisp.net Thu Apr 17 10:39:13 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:39:13 -0000 Subject: [Armedbear-cvs] r14672 - in branches/1.3.1: doc/asdf src/org/armedbear/lisp Message-ID: <20140417103913.13285.70484@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:39:12 2014 New Revision: 14672 Log: Backport r14661: Update to ASDF 3.1.0.103. Seems to fix loading of Ironclad, and other Quicklisp failures. Modified: branches/1.3.1/doc/asdf/asdf.texinfo branches/1.3.1/src/org/armedbear/lisp/asdf.lisp Modified: branches/1.3.1/doc/asdf/asdf.texinfo ============================================================================== --- branches/1.3.1/doc/asdf/asdf.texinfo Thu Apr 17 10:37:57 2014 (r14671) +++ branches/1.3.1/doc/asdf/asdf.texinfo Thu Apr 17 10:39:12 2014 (r14672) @@ -246,8 +246,9 @@ --- and we explain how to do that. @xref{Loading ASDF}. (In the context of compatibility requirements, ASDF 2.27, released on Feb 1st 2013, and further 2.x releases up to 2.33, -count as pre-releases of ASDF 3, and define the :asdf3 feature; +count as pre-releases of ASDF 3, and define the @code{:asdf3} feature; still, please use the latest release). +Release ASDF 3.1.1 and later also define the @code{:asdf3.1} feature. Also note that ASDF is not to be confused with ASDF-Install. ASDF-Install is not part of ASDF, but a separate piece of software. @@ -256,6 +257,9 @@ which works great and is being actively maintained. If you want to download software from version control instead of tarballs, so you may more easily modify it, we recommend clbuild. +We recommend @file{~/common-lisp/} +as a place into which to install Common Lisp software; +starting with ASDF 3.1.1, it is included in the default source-registry configuration. @node Quick start summary, Loading ASDF, Introduction, Top @chapter Quick start summary @@ -276,7 +280,9 @@ through proper source-registry configuration. For more details, @xref{Configuring ASDF to find your systems}. The simplest way is simply to put all your lisp code in subdirectories of - at file{~/.local/share/common-lisp/source/}. + at file{~/common-lisp/} (starting with ASDF 3.1.1), +or @file{~/.local/share/common-lisp/source/} +(for ASDF 2 and later, or if you want to keep source in a hidden directory). Such code will automatically be found. @item @@ -433,10 +439,12 @@ and are proficient enough to install this fasl. Still, the ASDF source repository contains a script @file{bin/install-asdf-as-module} that can help you do that. -It relies on cl-launch 4 for command-line invocation, +It relies on @file{cl-launch} 4 for command-line invocation, which may depend on ASDF being checked out in @file{~/cl/asdf/} if your implementation doesn't even have an ASDF 2; -but you can run the code it manually if needs be. +but if you don't have @file{cl-launch}, +you can instead @code{(load "bin/install-asdf-as-module")} +from your implementation's REPL. Finally, if your implementation only provides ASDF 2, and you can't or won't upgrade it or override its ASDF module, @@ -553,7 +561,7 @@ * Resetting the ASDF configuration:: @end menu - at node Configuring ASDF to find your systems, Configuring where ASDF stores object files, Configuring ASDF, Configuring ASDF + at node Configuring ASDF to find your systems, Configuring ASDF to find your systems --- old style, Configuring ASDF, Configuring ASDF @section Configuring ASDF to find your systems In order to compile and load your systems, ASDF must be configured to find @@ -566,9 +574,11 @@ @item Put all of your systems in subdirectories of + at file{~/common-lisp/} or @file{~/.local/share/common-lisp/source/}. -If you install software there (it can be a symlink), -you don't need further configuration. +If you install software there, you don't need further configuration. +(NB: @file{~/common-lisp/} is only included in the default configuration +starting with ASDF 3.1.1 or later) @item If you're using some tool to install software (e.g. Quicklisp), @@ -615,16 +625,6 @@ (asdf:clear-source-registry) @end lisp - at c FIXME: too specific. Push this down to discussion of dumping an - at c image? - - at c And you probably should do so before you dump your Lisp image, - at c if the configuration may change - at c between the machine where you save it at the time you save it - at c and the machine you resume it at the time you resume it. - at c Actually, you should use @code{(asdf:clear-configuration)} - at c before you dump your Lisp image, which includes the above. - @item In earlier versions of ASDF, the system source registry was configured using a global variable, @code{asdf:*central-registry*}. @@ -731,7 +731,7 @@ control what directories are added to the ASDF search path. - at node Configuring where ASDF stores object files, , Configuring ASDF to find your systems, Configuring ASDF + at node Configuring where ASDF stores object files, Resetting the ASDF configuration, Configuring ASDF to find your systems --- old style, Configuring ASDF @section Configuring where ASDF stores object files @findex clear-output-translations @@ -828,19 +828,15 @@ regarding source-registry or output-translations. @end defun -If you use SBCL, CMUCL or SCL, you may use this snippet -so that the ASDF configuration be cleared automatically as you dump an image: - - at example -#+(or cmu sbcl scl) -(pushnew 'clear-configuration - #+(or cmu scl) ext:*before-save-initializations* - #+sbcl sb-ext:*save-hooks*) - at end example - -For compatibility with all Lisp implementations, however, -you might want instead your build script to explicitly call - at code{(asdf:clear-configuration)} at an appropriate moment before dumping. +This function is pushed onto the @code{uiop:*image-dump-hook*} by default, +which means that if you save an image using @code{uiop:dump-image}, +or via @code{asdf:image-op} and @code{asdf:program-op}, +it will be automatically called to clear your configuration. +If for some reason you prefer to call your implementation's underlying functionality, +be sure to call @code{clear-configuration} manually, +or push it into your implementation's equivalent of @code{uiop:*image-dump-hook*}, +e.g. @code{sb-ext:*save-hooks*} on SBCL, or @code{ext:*before-save-initializations*} +on CMUCL and SCL, etc. @node Using ASDF, Defining systems with defsystem, Configuring ASDF, Top @chapter Using ASDF Modified: branches/1.3.1/src/org/armedbear/lisp/asdf.lisp ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/asdf.lisp Thu Apr 17 10:37:57 2014 (r14671) +++ branches/1.3.1/src/org/armedbear/lisp/asdf.lisp Thu Apr 17 10:39:12 2014 (r14672) @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.1.0.94: Another System Definition Facility. +;;; This is ASDF 3.1.0.103: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to . @@ -867,7 +867,7 @@ ;;;; Early meta-level tweaks -#+(or abcl allegro clisp cmu ecl mkcl clozure lispworks sbcl scl) +#+(or abcl allegro clisp cmu ecl mkcl clozure lispworks mkcl sbcl scl) (eval-when (:load-toplevel :compile-toplevel :execute) ;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode ;; but loaded in a non-unicode setting (e.g. on Allegro) won't tell a lie. @@ -1349,34 +1349,6 @@ (when x (c +crlf+) (c +lf+) (c +cr+) (values x nil))))) -;;; CLOS -(with-upgradability () - (defun coerce-class (class &key (package :cl) (super t) (error 'error)) - "Coerce CLASS to a class that is subclass of SUPER if specified, -or invoke ERROR handler as per CALL-FUNCTION. - -A keyword designates the name a symbol, which when found in PACKAGE, designates a class. -A string is read as a symbol while in PACKAGE, the symbol designates a class. - -A class object designates itself. -NIL designates itself (no class). -A symbol otherwise designates a class by name." - (let* ((normalized - (typecase class - (keyword (find-symbol* class package nil)) - (string (symbol-call :uiop :safe-read-from-string class :package package)) - (t class))) - (found - (etypecase normalized - ((or standard-class built-in-class) normalized) - ((or null keyword) nil) - (symbol (find-class normalized nil nil))))) - (or (and found - (or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super)) - found) - (call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super))))) - - ;;; stamps: a REAL or a boolean where NIL=-infinity, T=+infinity (eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) (deftype stamp () '(or real boolean))) @@ -1475,6 +1447,36 @@ (when call-now-p (call-function hook)))) +;;; CLOS +(with-upgradability () + (defun coerce-class (class &key (package :cl) (super t) (error 'error)) + "Coerce CLASS to a class that is subclass of SUPER if specified, +or invoke ERROR handler as per CALL-FUNCTION. + +A keyword designates the name a symbol, which when found in either PACKAGE, designates a class. +-- for backward compatibility, *PACKAGE* is also accepted for now, but this may go in the future. +A string is read as a symbol while in PACKAGE, the symbol designates a class. + +A class object designates itself. +NIL designates itself (no class). +A symbol otherwise designates a class by name." + (let* ((normalized + (typecase class + (keyword (or (find-symbol* class package nil) + (find-symbol* class *package* nil))) + (string (symbol-call :uiop :safe-read-from-string class :package package)) + (t class))) + (found + (etypecase normalized + ((or standard-class built-in-class) normalized) + ((or null keyword) nil) + (symbol (find-class normalized nil nil))))) + (or (and found + (or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super)) + found) + (call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super))))) + + ;;; Hash-tables (with-upgradability () (defun ensure-gethash (key table default) @@ -1564,10 +1566,10 @@ #+clisp 'system::$format-control #+clozure 'ccl::format-control #+(or cmu scl) 'conditions::format-control - #+ecl 'si::format-control + #+(or ecl mkcl) 'si::format-control #+(or gcl lispworks) 'conditions::format-string #+sbcl 'sb-kernel:format-control - #-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl) nil + #-(or abcl allegro clisp clozure cmu ecl gcl lispworks mkcl sbcl scl) nil "Name of the slot for FORMAT-CONTROL in simple-condition") (defun match-condition-p (x condition) @@ -1651,7 +1653,7 @@ (defun os-windows-p () "Is the underlying operating system Microsoft Windows?" (or #+abcl (featurep :windows) - #+(and (not (or abcl unix cygwin darwin)) (or win32 windows mswindows mingw32)) t)) + #+(and (not (or abcl unix cygwin darwin)) (or win32 windows mswindows mingw32 mingw64)) t)) (defun os-genera-p () "Is the underlying operating system Genera (running on a Symbolics Lisp Machine)?" @@ -2060,8 +2062,8 @@ ;; See CLHS make-pathname and 19.2.2.2.3. ;; This will be :unspecific if supported, or NIL if not. (defparameter *unspecific-pathname-type* - #+(or abcl allegro clozure cmu genera lispworks mkcl sbcl scl) :unspecific - #+(or clisp ecl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil + #+(or abcl allegro clozure cmu genera lispworks sbcl scl) :unspecific + #+(or clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME") (defun make-pathname* (&rest keys &key (directory nil) @@ -2159,8 +2161,9 @@ ;; But CMUCL decides to die on NIL. ;; MCL has issues with make-pathname, nil and defaulting (declare (ignorable defaults)) - #.`(make-pathname* :directory nil :name nil :type nil :version nil :device nil - :host (or #+cmu lisp::*unix-host*) + #.`(make-pathname* :directory nil :name nil :type nil :version nil + :device (or #+(and mkcl unix) :unspecific) + :host (or #+cmu lisp::*unix-host* #+(and mkcl unix) "localhost") #+scl ,@'(:scheme nil :scheme-specific-part nil :username nil :password nil :parameters nil :query nil :fragment nil) ;; the default shouldn't matter, but we really want something physical @@ -2193,11 +2196,11 @@ (or (and (null p1) (null p2)) (and (pathnamep p1) (pathnamep p2) (and (=? pathname-host) - (=? pathname-device) + #-(and mkcl unix) (=? pathname-device) (=? normalize-pathname-directory-component pathname-directory) (=? pathname-name) (=? pathname-type) - (=? pathname-version))))))) + #-mkcl (=? pathname-version))))))) (defun absolute-pathname-p (pathspec) "If PATHSPEC is a pathname or namestring object that parses as a pathname @@ -3299,7 +3302,7 @@ `(,dd directory-pathname) ;; requires SBCL 1.0.44 or later `(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname))) #+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname))) - #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks sbcl scl xcl) + #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks mkcl sbcl scl xcl) (error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera (defun delete-directory-tree (directory-pathname &key (validate nil validatep) (if-does-not-exist :error)) @@ -4004,7 +4007,7 @@ ,@(when directory `(:directory ,directory)) ,@(when prefix `(:prefix ,prefix)) ,@(when suffix `(:suffix ,suffix)) - ,@(when type `(:suffix ,type)) + ,@(when type `(:type ,type)) ,@(when keep `(:keep ,keep)) ,@(when after `(:after `#',afterf)) ,@(when element-type `(:element-type ,element-type)) @@ -4163,7 +4166,7 @@ (let ((debug:*debug-print-level* *print-level*) (debug:*debug-print-length* *print-length*)) (debug:backtrace (or count most-positive-fixnum) stream)) - #+ecl + #+(or ecl mkcl) (let* ((top (si:ihs-top)) (repeats (if count (min top count) top)) (backtrace (loop :for ihs :from 0 :below top @@ -4278,9 +4281,10 @@ #+gcl si:*command-args* #+(or genera mcl) nil #+lispworks sys:*line-arguments-list* + #+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i)) #+sbcl sb-ext:*posix-argv* #+xcl system:*argv* - #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl sbcl scl xcl) + #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl) (error "raw-command-line-arguments not implemented yet")) (defun command-line-arguments (&optional (arguments (raw-command-line-arguments))) @@ -4308,10 +4312,10 @@ Otherwise, return NIL." (cond ((eq *image-dumped-p* :executable) ; yes, this ARGV0 is our argv0 ! - ;; NB: not currently available on ABCL, Corman, Genera, MCL, MKCL + ;; NB: not currently available on ABCL, Corman, Genera, MCL (or #+(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl) (first (raw-command-line-arguments)) - #+ecl (si:argv 0))) + #+ecl (si:argv 0) #+mkcl (mkcl:argv 0))) (t ;; argv[0] is the name of the interpreter. ;; The wrapper script can export __CL_ARGV0. cl-launch does as of 4.0.1.8. (getenvp "__CL_ARGV0")))) @@ -4460,18 +4464,19 @@ (error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%" 'dump-image filename (nth-value 1 (implementation-type)))) - (defun create-image (destination object-files - &key kind output-name prologue-code epilogue-code + (defun create-image (destination lisp-object-files + &key kind output-name prologue-code epilogue-code extra-object-files (prelude () preludep) (postlude () postludep) (entry-point () entry-point-p) build-args) - (declare (ignorable destination object-files kind output-name prologue-code epilogue-code - prelude preludep postlude postludep entry-point entry-point-p build-args)) + (declare (ignorable destination lisp-object-files extra-object-files kind output-name + prologue-code epilogue-code prelude preludep postlude postludep + entry-point entry-point-p build-args)) "On ECL, create an executable at pathname DESTINATION from the specified OBJECT-FILES and options" ;; Is it meaningful to run these in the current environment? ;; only if we also track the object files that constitute the "current" image, ;; and otherwise simulate dump-image, including quitting at the end. - #-ecl (error "~S not implemented for your implementation (yet)" 'create-image) - #+ecl + #-(or ecl mkcl) (error "~S not implemented for your implementation (yet)" 'create-image) + #+(or ecl mkcl) (let ((epilogue-forms (append (when epilogue-code `(,epilogue-code)) @@ -4482,20 +4487,26 @@ ((:image) (setf kind :program) ;; to ECL, it's just another program. `((setf *image-dumped-p* t) - ;; fall through should be equivalent to: (si::top-level t) (quit) - )) + (si::top-level #+ecl t) (quit))) ((:program) `((setf *image-dumped-p* :executable) (shell-boolean-exit (restore-image)))))))) - (check-type kind (member :dll :lib :static-library :program :object :fasl :program)) - (apply 'c::builder - kind (pathname destination) - :lisp-files object-files - :init-name (c::compute-init-name (or output-name destination) :kind kind) - :prologue-code prologue-code - :epilogue-code (when epilogue-forms `(progn , at epilogue-forms)) - build-args)))) + #+ecl (check-type kind (member :dll :lib :static-library :program :object :fasl)) + (apply #+ecl 'c::builder #+ecl kind + #+mkcl (ecase kind + ((:dll) 'compiler::build-shared-library) + ((:lib :static-library) 'compiler::build-static-library) + ((:fasl) 'compiler::build-bundle) + ((:program) 'compiler::build-program)) + (pathname destination) + #+ecl :lisp-files #+mkcl :lisp-object-files (append lisp-object-files #+ecl extra-object-files) + #+ecl :init-name #+ecl (c::compute-init-name (or output-name destination) :kind kind) + (append + (when prologue-code `(:prologue-code ,prologue-code)) + (when epilogue-forms `(:epilogue-code (progn , at epilogue-forms))) + #+mkcl (when extra-object-files `(:object-files ,extra-object-files)) + build-args))))) ;;; Some universal image restore hooks @@ -4847,6 +4858,7 @@ #+os-unix (list command) #+os-windows (string + #+mkcl (list "cmd" '#:/c command) ;; NB: We do NOT add cmd /c here. You might want to. #+(or allegro clisp) command ;; On ClozureCL for Windows, we assume you are using @@ -4856,7 +4868,7 @@ ;; NB: On other Windows implementations, this is utterly bogus ;; except in the most trivial cases where no quoting is needed. ;; Use at your own risk. - #-(or allegro clisp clozure) (list "cmd" "/c" command)) + #-(or allegro clisp clozure mkcl) (list "cmd" "/c" command)) #+os-windows (list #+allegro (escape-windows-command command) @@ -4883,8 +4895,8 @@ ((eql :interactive) #+allegro nil #+clisp :terminal - #+(or clozure cmu ecl sbcl scl) t) - #+(or allegro clozure cmu ecl lispworks sbcl scl) + #+(or clozure cmu ecl mkcl sbcl scl) t) + #+(or allegro clozure cmu ecl lispworks mkcl sbcl scl) ((eql :output) (if (eq role :error-output) :output @@ -4915,12 +4927,12 @@ It returns a process-info plist with possible keys: PROCESS, EXIT-CODE, INPUT-STREAM, OUTPUT-STREAM, BIDIR-STREAM, ERROR-STREAM." ;; NB: these implementations have unix vs windows set at compile-time. - (declare (ignorable if-input-does-not-exist if-output-exists if-error-output-exists)) + (declare (ignorable directory if-input-does-not-exist if-output-exists if-error-output-exists)) (assert (not (and wait (member :stream (list input output error-output))))) - #-(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl) + #-(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl) (progn command keys directory (error "run-program not available")) - #+(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl) + #+(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl) (let* ((%command (%normalize-command command)) (%input (%normalize-io-specifier input :input)) (%output (%normalize-io-specifier output :output)) @@ -4940,7 +4952,7 @@ #+os-windows :show-window #+os-windows (if interactive nil :hide) :allow-other-keys t keys)) #-allegro - (with-current-directory (#-sbcl directory) + (with-current-directory (#-(or sbcl mkcl) directory) #+clisp (flet ((run (f x &rest args) (multiple-value-list @@ -4952,11 +4964,11 @@ #+os-windows (string (run 'ext:run-shell-command %command)) (list (run 'ext:run-program (car %command) :arguments (cdr %command))))) - #+(or clozure cmu ecl sbcl scl) - (#-ecl progn #+ecl multiple-value-list + #+(or clozure cmu ecl mkcl sbcl scl) + (#-(or ecl mkcl) progn #+(or ecl mkcl) multiple-value-list (apply '#+(or cmu ecl scl) ext:run-program - #+clozure ccl:run-program #+sbcl sb-ext:run-program + #+clozure ccl:run-program #+sbcl sb-ext:run-program #+mkcl mk-ext:run-program (car %command) (cdr %command) :input %input :output %output @@ -4964,7 +4976,7 @@ :wait wait :allow-other-keys t (append - #+(or clozure cmu sbcl scl) + #+(or clozure cmu mkcl sbcl scl) `(:if-input-does-not-exist ,if-input-does-not-exist :if-output-exists ,if-output-exists :if-error-exists ,if-error-output-exists) @@ -5031,8 +5043,8 @@ #+clozure (ccl:external-process-error-stream process*) #+(or cmu scl) (ext:process-error process*) #+sbcl (sb-ext:process-error process*)))) - #+ecl - (destructuring-bind (stream code process) process* + #+(or ecl mkcl) + (destructuring-bind #+ecl (stream code process) #+mkcl (stream process code) process* (let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0)))) (cond ((zerop mode)) @@ -5059,8 +5071,9 @@ #+clozure (ccl::external-process-pid process) #+ecl (si:external-process-pid process) #+(or cmu scl) (ext:process-pid process) + #+mkcl (mkcl:process-id process) #+sbcl (sb-ext:process-pid process) - #-(or allegro cmu sbcl scl) (error "~S not implemented" '%process-info-pid))) + #-(or allegro cmu mkcl sbcl scl) (error "~S not implemented" '%process-info-pid))) (defun %wait-process-result (process-info) (or (getf process-info :exit-code) @@ -5084,7 +5097,8 @@ (system:pipe-exit-status stream :wait t) (if-let ((f (find-symbol* :pid-exit-status :system nil))) (funcall f process :wait t))) - #+sbcl (sb-ext:process-exit-code process))))) + #+sbcl (sb-ext:process-exit-code process) + #+mkcl (mkcl:join-process process))))) (defun %check-result (exit-code &key command process ignore-error-status) (unless ignore-error-status @@ -5184,7 +5198,7 @@ (defun %use-run-program (command &rest keys &key input output error-output ignore-error-status &allow-other-keys) ;; helper for RUN-PROGRAM when using %run-program - #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) + #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) (progn command keys input output error-output ignore-error-status ;; ignore (error "Not implemented on this platform")) @@ -5294,11 +5308,7 @@ (ext:system %command)) #+gcl (system:system %command) #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command)) - #+mkcl ;; PROBABLY BOGUS -- ask jcb - (multiple-value-bind (io process exit-code) - (mkcl:run-program #+windows %command #+windows () - #-windows "/bin/sh" #-windows (list "-c" %command) - :input t :output t)) + #+mkcl (mkcl:system %command) #+xcl (system:%run-shell-command %command)))) (defun %use-system (command &rest keys @@ -5377,7 +5387,7 @@ 2- either 0 if the subprocess exited with success status, or an indication of failure via the EXIT-CODE of the process" (declare (ignorable ignore-error-status)) - #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl sbcl scl xcl) + #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl) (error "RUN-PROGRAM not implemented for this Lisp") (flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive)))) (apply (if (or force-shell @@ -5385,7 +5395,7 @@ #+clisp (eq error-output :interactive) #+(or abcl clisp) (eq :error-output :output) #+(and lispworks os-unix) (%interactivep input output error-output) - #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) t) + #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) t) '%use-system '%use-run-program) command :input (default input inputp output) @@ -5459,16 +5469,17 @@ "Optimization settings saved by PROCLAIM-OPTIMIZATION-SETTINGS") (defun get-optimization-settings () "Get current compiler optimization settings, ready to PROCLAIM again" - #-(or clisp clozure cmu ecl sbcl scl) + #-(or clisp clozure cmu ecl mkcl sbcl scl) (warn "~S does not support ~S. Please help me fix that." 'get-optimization-settings (implementation-type)) #+clozure (ccl:declaration-information 'optimize nil) - #+(or clisp cmu ecl sbcl scl) + #+(or clisp cmu ecl mkcl sbcl scl) (let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity))) #.`(loop :for x :in settings ,@(or #+ecl '(:for v :in '(c::*speed* c::*space* c::*safety* c::*debug*)) + #+mkcl '(:for v :in '(si::*speed* si::*space* si::*safety* si::*debug*)) #+(or cmu scl) '(:for f :in '(c::cookie-speed c::cookie-space c::cookie-safety c::cookie-debug c::cookie-cspeed c::cookie-brevity))) :for y = (or #+clisp (gethash x system::*optimize*) - #+(or ecl) (symbol-value v) + #+(or ecl mkcl) (symbol-value v) #+(or cmu scl) (funcall f c::*default-cookie*) #+sbcl (cdr (assoc x sb-c::*policy*))) :when y :collect (list x y)))) @@ -6523,6 +6534,8 @@ :uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image :uiop/run-program :uiop/lisp-build :uiop/configuration :uiop/backward-driver)) + +#+mkcl (provide :uiop) ;;;; ------------------------------------------------------------------------- ;;;; Handle upgrade as forward- and backward-compatibly as possible ;; See https://bugs.launchpad.net/asdf/+bug/485687 @@ -6559,15 +6572,6 @@ (defvar *asdf-version* nil) ;; We need to clear systems from versions yet older than the below: (defparameter *oldest-forward-compatible-asdf-version* "2.33") ;; 2.32.13 renames a slot in component. - (defmacro defparameter* (var value &optional docstring) - (let* ((name (string-trim "*" var)) - (valfun (intern (format nil "%~A-~A-~A" :compute name :value))) - (clearfun (intern (format nil "%~A-~A" :clear name)))) - `(progn - (defun ,valfun () ,value) - (defvar ,var (,valfun) ,@(ensure-list docstring)) - (defun ,clearfun () (setf ,var (,valfun))) - (register-hook-function '*post-upgrade-cleanup-hook* ',clearfun)))) (defvar *verbose-out* nil) (defun asdf-message (format-string &rest format-args) (when *verbose-out* (apply 'format *verbose-out* format-string format-args))) @@ -6576,6 +6580,14 @@ (defun upgrading-p (&optional (oldest-compatible-version *oldest-forward-compatible-asdf-version*)) (and *previous-asdf-versions* (version< (first *previous-asdf-versions*) oldest-compatible-version))) + (defmacro defparameter* (var value &optional docstring (version *oldest-forward-compatible-asdf-version*)) + (let* ((name (string-trim "*" var)) + (valfun (intern (format nil "%~A-~A-~A" :compute name :value)))) + `(progn + (defun ,valfun () ,value) + (defvar ,var (,valfun) ,@(ensure-list docstring)) + (when (upgrading-p ,version) + (setf ,var (,valfun)))))) (defmacro when-upgrading ((&key (version *oldest-forward-compatible-asdf-version*) (upgrading-p `(upgrading-p ,version)) when) &body body) "A wrapper macro for code that should only be run when upgrading a @@ -6593,7 +6605,7 @@ ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.1.0.94") + (asdf-version "3.1.0.103") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -7093,7 +7105,8 @@ (uiop/package:define-package :asdf/cache (:use :uiop/common-lisp :uiop :asdf/upgrade) (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp - #:consult-asdf-cache #:do-asdf-cache #:normalize-namestring + #:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache + #:do-asdf-cache #:normalize-namestring #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*)) (in-package :asdf/cache) @@ -7111,6 +7124,10 @@ (setf (gethash key *asdf-cache*) value-list) value-list))) + (defun unset-asdf-cache-entry (key) + (when *asdf-cache* + (remhash key *asdf-cache*))) + (defun consult-asdf-cache (key &optional thunk) (if *asdf-cache* (multiple-value-bind (results foundp) (gethash key *asdf-cache*) @@ -7122,14 +7139,15 @@ (defmacro do-asdf-cache (key &body body) `(consult-asdf-cache ,key #'(lambda () , at body))) - (defun call-with-asdf-cache (thunk &key override) - (if (and *asdf-cache* (not override)) - (funcall thunk) - (let ((*asdf-cache* (make-hash-table :test 'equal))) - (funcall thunk)))) + (defun call-with-asdf-cache (thunk &key override key) + (let ((fun (if key #'(lambda () (consult-asdf-cache key thunk)) thunk))) + (if (and *asdf-cache* (not override)) + (funcall fun) + (let ((*asdf-cache* (make-hash-table :test 'equal))) + (funcall fun))))) - (defmacro with-asdf-cache ((&key override) &body body) - `(call-with-asdf-cache #'(lambda () , at body) :override ,override)) + (defmacro with-asdf-cache ((&key key override) &body body) + `(call-with-asdf-cache #'(lambda () , at body) :override ,override :key ,key)) (defun normalize-namestring (pathname) (let ((resolved (resolve-symlinks* @@ -7158,21 +7176,21 @@ (uiop/package:define-package :asdf/find-system (:recycle :asdf/find-system :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade - :asdf/component :asdf/system :asdf/cache) + :asdf/cache :asdf/component :asdf/system) (:export #:remove-entry-from-registry #:coerce-entry-to-directory #:coerce-name #:primary-system-name #:coerce-filename - #:find-system #:locate-system #:load-asd #:with-system-definitions + #:find-system #:locate-system #:load-asd #:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems #:missing-component #:missing-requires #:missing-parent #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error #:load-system-definition-error #:error-name #:error-pathname #:error-condition #:*system-definition-search-functions* #:search-for-system-definition #:*central-registry* #:probe-asd #:sysdef-central-registry-search - #:find-system-if-being-defined #:*systems-being-defined* + #:find-system-if-being-defined #:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed #:sysdef-preloaded-system-search #:register-preloaded-system #:*preloaded-systems* - #:clear-defined-systems #:*defined-systems* + #:clear-defined-system #:clear-defined-systems #:*defined-systems* #:*immutable-systems* ;; defined in source-registry, but specially mentioned here: #:initialize-source-registry #:sysdef-source-registry-search)) @@ -7243,15 +7261,18 @@ (get-file-stamp file)) system))))) + (defun clear-defined-system (system) + (let ((name (coerce-name system))) + (remhash name *defined-systems*) + (unset-asdf-cache-entry `(locate-system ,name)) + (unset-asdf-cache-entry `(find-system ,name)) + nil)) + (defun clear-defined-systems () ;; Invalidate all systems but ASDF itself, if registered. - (let ((asdf (cdr (system-registered-p :asdf)))) - (setf *defined-systems* (make-hash-table :test 'equal)) - (when asdf - (setf (component-version asdf) *asdf-version*) - (setf (builtin-system-p asdf) t) - (register-system asdf))) - (values)) + (loop :for name :being :the :hash-keys :of *defined-systems* + :unless (equal name "asdf") + :do (clear-defined-system name))) (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil) @@ -7408,32 +7429,13 @@ (defmethod find-system (name &optional (error-p t)) (find-system (coerce-name name) error-p)) - (defvar *systems-being-defined* nil - "A hash-table of systems currently being defined keyed by name, or NIL") - (defun find-system-if-being-defined (name) - (when *systems-being-defined* - ;; notable side effect: mark the system as being defined, to avoid infinite loops - (ensure-gethash (coerce-name name) *systems-being-defined* nil))) - - (defun call-with-system-definitions (thunk) - (if *systems-being-defined* - (call-with-asdf-cache thunk) - (let ((*systems-being-defined* (make-hash-table :test 'equal))) - (call-with-asdf-cache thunk)))) - - (defun clear-systems-being-defined () - (when *systems-being-defined* - (clrhash *systems-being-defined*))) - - (register-hook-function '*post-upgrade-cleanup-hook* 'clear-systems-being-defined) - - (defmacro with-system-definitions ((&optional) &body body) - `(call-with-system-definitions #'(lambda () , at body))) + ;; notable side effect: mark the system as being defined, to avoid infinite loops + (first (gethash `(find-system ,(coerce-name name)) *asdf-cache*))) (defun load-asd (pathname &key name (external-format (encoding-external-format (detect-encoding pathname))) &aux (readtable *readtable*) (print-pprint-dispatch *print-pprint-dispatch*)) ;; Tries to load system definition with canonical NAME from PATHNAME. - (with-system-definitions () + (with-asdf-cache () (with-standard-io-syntax (let ((*package* (find-package :asdf-user)) ;; Note that our backward-compatible *readtable* is @@ -7528,41 +7530,41 @@ either associated with FOUND-SYSTEM, or with the PREVIOUS system. PREVIOUS when not null is a previously loaded SYSTEM object of same name. PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded." - (let* ((name (coerce-name name)) - (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk - (previous (cdr in-memory)) - (previous (and (typep previous 'system) previous)) - (previous-time (car in-memory)) - (found (search-for-system-definition name)) - (found-system (and (typep found 'system) found)) - (pathname (ensure-pathname - (or (and (typep found '(or pathname string)) (pathname found)) - (and found-system (system-source-file found-system)) - (and previous (system-source-file previous))) - :want-absolute t :resolve-symlinks *resolve-symlinks*)) - (foundp (and (or found-system pathname previous) t))) - (check-type found (or null pathname system)) - (unless (check-not-old-asdf-system name pathname) - (cond - (previous (setf found nil pathname nil)) - (t - (setf found (sysdef-preloaded-system-search "asdf")) - (assert (typep found 'system)) - (setf found-system found pathname nil)))) - (values foundp found-system pathname previous previous-time))) + (with-asdf-cache (:key `(locate-system ,name)) + (let* ((name (coerce-name name)) + (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk + (previous (cdr in-memory)) + (previous (and (typep previous 'system) previous)) + (previous-time (car in-memory)) + (found (search-for-system-definition name)) + (found-system (and (typep found 'system) found)) + (pathname (ensure-pathname + (or (and (typep found '(or pathname string)) (pathname found)) + (and found-system (system-source-file found-system)) + (and previous (system-source-file previous))) + :want-absolute t :resolve-symlinks *resolve-symlinks*)) + (foundp (and (or found-system pathname previous) t))) + (check-type found (or null pathname system)) + (unless (check-not-old-asdf-system name pathname) + (cond + (previous (setf found nil pathname nil)) + (t + (setf found (sysdef-preloaded-system-search "asdf")) + (assert (typep found 'system)) + (setf found-system found pathname nil)))) + (values foundp found-system pathname previous previous-time)))) (defmethod find-system ((name string) &optional (error-p t)) - (with-system-definitions () + (with-asdf-cache (:key `(find-system ,name)) (let ((primary-name (primary-system-name name))) - (unless (or (equal name primary-name) - (nth-value 1 (gethash primary-name *systems-being-defined*))) + (unless (equal name primary-name) (find-system primary-name nil))) (loop (restart-case (multiple-value-bind (foundp found-system pathname previous previous-time) (locate-system name) (when (and found-system (eq found-system previous) - (or (gethash name *systems-being-defined*) + (or (first (gethash `(find-system ,name) *asdf-cache*)) (and *immutable-systems* (gethash name *immutable-systems*)))) (return found-system)) (assert (eq foundp (and (or found-system pathname previous) t))) @@ -7596,6 +7598,7 @@ (reinitialize-source-registry-and-retry () :report (lambda (s) (format s (compatfmt "~@") name)) + (unset-asdf-cache-entry `(locate-system ,name)) (initialize-source-registry))))))) ;;;; ------------------------------------------------------------------------- @@ -7603,7 +7606,7 @@ (uiop/package:define-package :asdf/find-component (:recycle :asdf/find-component :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache :asdf/component :asdf/system :asdf/find-system) (:export #:find-component @@ -7706,7 +7709,12 @@ (or (null c) (and (typep c 'missing-dependency) (eq (missing-required-by c) component) - (equal (missing-requires c) name)))))))) + (equal (missing-requires c) name)))) + (unless (component-parent component) + (let ((name (coerce-name name))) + (unset-asdf-cache-entry `(find-system ,name)) + (unset-asdf-cache-entry `(locate-system ,name)))))))) + (defun resolve-dependency-spec (component dep-spec) (let ((component (find-component () component))) @@ -7845,7 +7853,6 @@ (component 'component) (opix (position operation formals)) (coix (position component formals)) - (prefix (subseq formals 0 opix)) (suffix (subseq formals (1+ coix) len)) (more-args (when keyp `(&rest ,rest &key &allow-other-keys)))) @@ -7969,9 +7976,7 @@ E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPARE-OP, each of its declared dependencies must first be loaded as by LOAD-OP.")) (defun sideway-operation-depends-on (o c) - `((,(or (sideway-operation o) o) - ,@(loop :for dep :in (component-sideway-dependencies c) - :collect (resolve-dependency-spec c dep))))) + `((,(or (sideway-operation o) o) ,@(component-sideway-dependencies c)))) (defmethod component-depends-on ((o sideway-operation) (c component)) `(,@(sideway-operation-depends-on o c) ,@(call-next-method))) @@ -8898,13 +8903,13 @@ (uiop/package:define-package :asdf/operate (:recycle :asdf/operate :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache :asdf/component :asdf/system :asdf/operation :asdf/action :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/plan) (:export #:operate #:oos #:*systems-being-operated* - #:build-op #:build + #:build-op #:make #:load-system #:load-systems #:load-systems* #:compile-system #:test-system #:require-system #:*load-system-operation* #:module-provide-asdf @@ -8968,7 +8973,7 @@ (return-from operate (apply 'operate (funcall operation-remaker) component-path keys)))) ;; Setup proper bindings around any operate call. - (with-system-definitions () + (with-asdf-cache () (let* ((*verbose-out* (and verbose *standard-output*)) (*compile-file-warnings-behaviour* on-warnings) (*compile-file-failure-behaviour* on-failure)) @@ -9005,6 +9010,9 @@ The default operation may change in the future if we implement a component-directed strategy for how to load or compile systems.") + (defmethod component-depends-on ((o prepare-op) (s system)) + `((,*load-system-operation* ,@(component-sideway-dependencies s)))) + (defclass build-op (non-propagating-operation) () (:documentation "Since ASDF3, BUILD-OP is the recommended 'master' operation, to operate by default on a system or component, via the function BUILD. @@ -9016,8 +9024,8 @@ (defmethod component-depends-on ((o build-op) (c component)) `((,(or (component-build-operation c) *load-system-operation*) ,c))) - (defun build (system &rest keys) - "The recommended way to interact with ASDF3.1 is via (ASDF:BUILD :FOO). + (defun make (system &rest keys) + "The recommended way to interact with ASDF3.1 is via (ASDF:MAKE :FOO). It will build system FOO using the operation BUILD-OP, the meaning of which is configurable by the system, and defaults to *LOAD-SYSTEM-OPERATION*, usually LOAD-OP, @@ -9117,11 +9125,11 @@ (with-upgradability () (defun restart-upgraded-asdf () ;; If we're in the middle of something, restart it. - (when *systems-being-defined* - (let ((l (loop :for name :being :the :hash-keys :of *systems-being-defined* :collect name))) - (clrhash *systems-being-defined*) + (when *asdf-cache* + (let ((l (loop* :for (x y) :being :the hash-keys :of *asdf-cache* + :when (eq x 'find-system) :collect y))) + (clrhash *asdf-cache*) (dolist (s l) (find-system s nil))))) - (register-hook-function '*post-upgrade-restart-hook* 'restart-upgraded-asdf)) @@ -9454,7 +9462,8 @@ #:collect-asds-in-directory #:collect-sub*directories-asd-files #:validate-source-registry-directive #:validate-source-registry-form #:validate-source-registry-file #:validate-source-registry-directory - #:parse-source-registry-string #:wrapping-source-registry #:default-source-registry + #:parse-source-registry-string #:wrapping-source-registry + #:default-user-source-registry #:default-system-source-registry #:user-source-registry #:system-source-registry #:user-source-registry-directory #:system-source-registry-directory #:environment-source-registry #:process-source-registry @@ -9583,9 +9592,11 @@ '(environment-source-registry user-source-registry user-source-registry-directory + default-user-source-registry system-source-registry system-source-registry-directory - default-source-registry)) + default-system-source-registry) + "List of default source registries" "3.1.0.102") (defparameter *source-registry-file* (parse-unix-namestring "source-registry.conf")) (defparameter *source-registry-directory* (parse-unix-namestring "source-registry.conf.d/")) @@ -9593,21 +9604,31 @@ (defun wrapping-source-registry () `(:source-registry #+(or ecl sbcl) (:tree ,(resolve-symlinks* (lisp-implementation-directory))) - #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:")) :inherit-configuration + #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:")) #+cmu (:tree #p"modules:") #+scl (:tree #p"file://modules/"))) - (defun default-source-registry () + (defun default-user-source-registry () `(:source-registry - #+sbcl (:directory ,(subpathname (user-homedir-pathname) ".sbcl/systems/")) + (:tree (:home "common-lisp/")) + #+sbcl (:directory (:home ".sbcl/systems/")) ,@(loop :for dir :in `(,@(when (os-unix-p) `(,(or (getenv-absolute-directory "XDG_DATA_HOME") - (subpathname (user-homedir-pathname) ".local/share/")) - ,@(or (getenv-absolute-directories "XDG_DATA_DIRS") - '("/usr/local/share" "/usr/share")))) + (subpathname (user-homedir-pathname) ".local/share/")))) + ,@(when (os-windows-p) + (mapcar 'get-folder-path '(:local-appdata :appdata)))) + :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) + :collect `(:tree ,(subpathname* dir "common-lisp/source/"))) + :inherit-configuration)) + (defun default-system-source-registry () + `(:source-registry + ,@(loop :for dir :in + `(,@(when (os-unix-p) + (or (getenv-absolute-directories "XDG_DATA_DIRS") + '("/usr/local/share" "/usr/share"))) ,@(when (os-windows-p) - (mapcar 'get-folder-path '(:local-appdata :appdata :common-appdata)))) + (list (get-folder-path :common-appdata)))) :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) :collect `(:tree ,(subpathname* dir "common-lisp/source/"))) :inherit-configuration)) @@ -9825,7 +9846,7 @@ (:recycle :asdf/parse-defsystem :asdf/defsystem :asdf) (:nicknames :asdf/defsystem) ;; previous name, to be compatible with, in case anyone cares (:use :uiop/common-lisp :asdf/driver :asdf/upgrade - :asdf/component :asdf/system :asdf/cache + :asdf/cache :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/operate :asdf/backward-internals) (:import-from :asdf/system #:depends-on #:weakly-depends-on) @@ -10057,8 +10078,8 @@ ;; of the same name to reuse options (e.g. pathname) from. ;; To avoid infinite recursion in cases where you defsystem a system ;; that is registered to a different location to find-system, - ;; we also need to remember it in a special variable *systems-being-defined*. - (with-system-definitions () + ;; we also need to remember it in the asdf-cache. + (with-asdf-cache () (let* ((name (coerce-name name)) (source-file (if sfp source-file (resolve-symlinks* (load-pathname)))) (registered (system-registered-p name)) @@ -10077,7 +10098,7 @@ (setf component-options (append `(:defsystem-depends-on ,(parse-dependency-defs defsystem-depends-on)) component-options))) - (setf (gethash name *systems-being-defined*) system) + (set-asdf-cache-entry `(find-system ,name) (list system)) (load-systems* defsystem-dependencies) ;; We change-class AFTER we loaded the defsystem-depends-on ;; since the class might be defined as part of those. @@ -10101,30 +10122,29 @@ (:recycle :asdf/bundle :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation - :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate) + :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/defsystem) (:export - #:bundle-op #:bundle-op-build-args #:bundle-type + #:bundle-op #:bundle-type #:program-system #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files #:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p - #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op + #:fasl-op #:load-fasl-op #:monolithic-fasl-op #:binary-op #:monolithic-binary-op + #:basic-compile-bundle-op #:prepare-bundle-op + #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op #:lib-op #:monolithic-lib-op #:dll-op #:monolithic-dll-op #:deliver-asd-op #:monolithic-deliver-asd-op #:program-op #:image-op #:compiled-file #:precompiled-system #:prebuilt-system #:user-system-p #:user-system #:trivial-system-p - #+ecl #:make-build - #:register-pre-built-system + #:make-build #:build-args #:name-suffix #:prologue-code #:epilogue-code #:static-library)) (in-package :asdf/bundle) (with-upgradability () (defclass bundle-op (basic-compile-op) - ((build-args :initarg :args :initform nil :accessor bundle-op-build-args) + ((build-args :initarg :args :initform nil :accessor extra-build-args) (name-suffix :initarg :name-suffix :initform nil) (bundle-type :initform :no-output-file :reader bundle-type) - #+ecl (lisp-files :initform nil :accessor bundle-op-lisp-files) - #+mkcl (do-fasb :initarg :do-fasb :initform t :reader bundle-op-do-fasb-p) - #+mkcl (do-static-library :initarg :do-static-library :initform t :reader bundle-op-do-static-library-p))) + #+ecl (lisp-files :initform nil :accessor extra-object-files))) (defclass monolithic-op (operation) () (:documentation "A MONOLITHIC operation operates on a system *and all of its @@ -10135,16 +10155,28 @@ (defclass monolithic-bundle-op (monolithic-op bundle-op) ;; Old style way of specifying prologue and epilogue on ECL: in the monolithic operation - ((prologue-code :accessor prologue-code) - (epilogue-code :accessor epilogue-code))) + ((prologue-code :initform nil :accessor prologue-code) + (epilogue-code :initform nil :accessor epilogue-code))) - (defclass bundle-system (system) + (defclass program-system (system) ;; New style (ASDF3.1) way of specifying prologue and epilogue on ECL: in the system - ((prologue-code :accessor prologue-code) - (epilogue-code :accessor epilogue-code))) + ((prologue-code :initform nil :initarg :prologue-code :reader prologue-code) + (epilogue-code :initform nil :initarg :epilogue-code :reader epilogue-code) + (prefix-lisp-object-files :initarg :prefix-lisp-object-files + :initform nil :accessor prefix-lisp-object-files) + (postfix-lisp-object-files :initarg :postfix-lisp-object-files + :initform nil :accessor postfix-lisp-object-files) + (extra-object-files :initarg :extra-object-files + :initform nil :accessor extra-object-files) + (extra-build-args :initarg :extra-build-args + :initform nil :accessor extra-build-args))) (defmethod prologue-code ((x t)) nil) (defmethod epilogue-code ((x t)) nil) + (defmethod prefix-lisp-object-files ((x t)) nil) + (defmethod postfix-lisp-object-files ((x t)) nil) + (defmethod extra-object-files ((x t)) nil) + (defmethod extra-build-args ((x t)) nil) (defclass link-op (bundle-op) () (:documentation "Abstract operation for linking files together")) @@ -10169,46 +10201,52 @@ ,@(call-next-method)))) ;; create a single fasl for the entire library - (defclass basic-fasl-op (bundle-op) + (defclass basic-compile-bundle-op (bundle-op) ((bundle-type :initform :fasl))) - (defclass prepare-fasl-op (sideway-operation) - ((sideway-operation :initform #+ecl 'load-fasl-op #-ecl 'load-op :allocation :class))) + (defclass prepare-bundle-op (sideway-operation) + ((sideway-operation :initform #+(or ecl mkcl) 'load-bundle-op #-(or ecl mkcl) 'load-op + :allocation :class))) (defclass lib-op (link-op gather-op non-propagating-operation) ((bundle-type :initform :lib)) (:documentation "compile the system and produce linkable (.a) library for it.")) - (defclass fasl-op (basic-fasl-op selfward-operation #+ecl link-op #-ecl gather-op) - ((selfward-operation :initform '(prepare-fasl-op #+ecl lib-op) :allocation :class))) + (defclass compile-bundle-op (basic-compile-bundle-op selfward-operation + #+(or ecl mkcl) link-op #-ecl gather-op) + ((selfward-operation :initform '(prepare-bundle-op #+ecl lib-op) :allocation :class))) - (defclass load-fasl-op (basic-load-op selfward-operation) - ((selfward-operation :initform '(prepare-op fasl-op) :allocation :class))) + (defclass load-bundle-op (basic-load-op selfward-operation) + ((selfward-operation :initform '(prepare-bundle-op compile-bundle-op) :allocation :class))) ;; NB: since the monolithic-op's can't be sideway-operation's, ;; if we wanted lib-op, dll-op, deliver-asd-op to be sideway-operation's, ;; we'd have to have the monolithic-op not inherit from the main op, - ;; but instead inherit from a basic-FOO-op as with basic-fasl-op above. + ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above. (defclass dll-op (link-op gather-op non-propagating-operation) ((bundle-type :initform :dll)) (:documentation "compile the system and produce dynamic (.so/.dll) library for it.")) (defclass deliver-asd-op (basic-compile-op selfward-operation) - ((selfward-operation :initform '(fasl-op #+(or ecl mkcl) lib-op) :allocation :class)) + ((selfward-operation :initform '(compile-bundle-op #+(or ecl mkcl) lib-op) :allocation :class)) (:documentation "produce an asd file for delivering the system as a single fasl")) (defclass monolithic-deliver-asd-op (monolithic-bundle-op deliver-asd-op) - ((selfward-operation :initform '(monolithic-fasl-op #+(or ecl mkcl) monolithic-lib-op) + ((selfward-operation :initform '(monolithic-compile-bundle-op #+(or ecl mkcl) monolithic-lib-op) :allocation :class)) (:documentation "produce fasl and asd files for combined system and dependencies.")) - (defclass monolithic-fasl-op (monolithic-bundle-op basic-fasl-op - #+ecl link-op gather-op non-propagating-operation) - ((gather-op :initform #+(or ecl mkcl) 'lib-op #-(or ecl mkcl) 'fasl-op :allocation :class)) + (defclass monolithic-compile-bundle-op (monolithic-bundle-op basic-compile-bundle-op + #+(or ecl mkcl) link-op gather-op non-propagating-operation) + ((gather-op :initform #+(or ecl mkcl) 'lib-op #-(or ecl mkcl) 'compile-bundle-op :allocation :class)) (:documentation "Create a single fasl for the system and its dependencies.")) + (defclass monolithic-load-bundle-op (monolithic-bundle-op load-bundle-op) + ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class)) + (:documentation "Load a single fasl for the system and its dependencies.")) + (defclass monolithic-lib-op (monolithic-bundle-op lib-op non-propagating-operation) () (:documentation "Create a single linkable library for the system and its dependencies.")) @@ -10217,9 +10255,9 @@ (:documentation "Create a single dynamic (.so/.dll) library for the system and its dependencies.")) (defclass image-op (monolithic-bundle-op selfward-operation - #+ecl link-op #+(or ecl mkcl) gather-op) + #+(or ecl mkcl) link-op #+(or ecl mkcl) gather-op) ((bundle-type :initform :image) - (selfward-operation :initform '(#-ecl load-op) :allocation :class)) + (selfward-operation :initform '(#-(or ecl mkcl) load-op) :allocation :class)) (:documentation "create an image file from the system and its dependencies")) (defclass program-op (image-op) @@ -10235,8 +10273,9 @@ ((member :dll :lib :shared-library :static-library :program :object :program) (compile-file-type :type bundle-type)) ((member :image) "image") - ((eql :dll) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) - ((member :lib :static-library) (cond ((os-unix-p) "a") ((os-windows-p) "lib"))) + ((member :dll :shared-library) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) + ((member :lib :static-library) (cond ((os-unix-p) "a") + ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib")))) ((eql :program) (cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) (defun bundle-output-files (o c) @@ -10253,10 +10292,11 @@ (bundle-output-files o c)) #-(or ecl mkcl) - (defmethod perform ((o program-op) (c system)) - (let ((output-file (output-file o c))) - (setf *image-entry-point* (ensure-function (component-entry-point c))) - (dump-image output-file :executable t))) + (progn + (defmethod perform ((o image-op) (c system)) + (dump-image (output-file o c) :executable (typep o 'program-op))) + (defmethod perform :before ((o program-op) (c system)) + (setf *image-entry-point* (ensure-function (component-entry-point c))))) (defclass compiled-file (file-component) ((type :initform #-(or ecl mkcl) (compile-file-type) #+(or ecl mkcl) "fasb"))) @@ -10285,16 +10325,16 @@ (unless name-suffix-p (setf (slot-value instance 'name-suffix) (unless (typep instance 'program-op) - (if (operation-monolithic-p instance) "--all-systems" #-ecl "--system")))) ; . no good for Logical Pathnames + (if (operation-monolithic-p instance) "--all-systems" #-(or ecl mkcl) "--system")))) ; . no good for Logical Pathnames (when (typep instance 'monolithic-bundle-op) (destructuring-bind (&key lisp-files prologue-code epilogue-code &allow-other-keys) (operation-original-initargs instance) (setf (prologue-code instance) prologue-code (epilogue-code instance) epilogue-code) - #-ecl (assert (null (or lisp-files epilogue-code prologue-code))) - #+ecl (setf (bundle-op-lisp-files instance) lisp-files))) - (setf (bundle-op-build-args instance) + #-ecl (assert (null (or lisp-files #-mkcl epilogue-code #-mkcl prologue-code))) + #+ecl (setf (extra-object-files instance) lisp-files))) + (setf (extra-build-args instance) (remove-plist-keys '(:type :monolithic :name-suffix :epilogue-code :prologue-code :lisp-files) (operation-original-initargs instance)))) @@ -10304,7 +10344,9 @@ (declare (ignorable type)) (or #+ecl (or (equalp type (compile-file-type :type :object)) (equalp type (compile-file-type :type :static-library))) - #+mkcl (equalp type (compile-file-type :fasl-p nil)) + #+mkcl (or (equalp type (compile-file-type :fasl-p nil)) + #+(or unix mingw32 mingw64) (equalp type "a") ;; valid on Unix and MinGW + #+(and windows (not (or mingw32 mingw64))) (equalp type "lib")) #+(or abcl allegro clisp clozure cmu lispworks sbcl scl xcl) (equalp type (compile-file-type))))) (defgeneric* (trivial-system-p) (component)) @@ -10326,11 +10368,6 @@ ;;; MONOLITHIC SHARED LIBRARIES, PROGRAMS, FASL ;;; (with-upgradability () - (defmethod component-depends-on :around ((o bundle-op) (c component)) - (if-let (op (and (eq (type-of o) 'bundle-op) (component-build-operation c))) - `((,op ,c)) - (call-next-method))) - (defun direct-dependency-files (o c &key (test 'identity) (key 'output-files) &allow-other-keys) ;; This file selects output files from direct dependencies; ;; your component-depends-on method better gathered the correct dependencies in the correct order. @@ -10351,13 +10388,13 @@ ((:lib :static-library) (if monolithic 'monolithic-lib-op 'lib-op)) ((:fasl) - (if monolithic 'monolithic-fasl-op 'fasl-op)) + (if monolithic 'monolithic-compile-bundle-op 'compile-bundle-op)) ((:image) 'image-op) ((:program) 'program-op))) - ;; This is originally from asdf-ecl.lisp. Does anyone use it? + ;; DEPRECATED. This is originally from asdf-ecl.lisp. Does anyone use it? (defun make-build (system &rest args &key (monolithic nil) (type :fasl) (move-here nil move-here-p) &allow-other-keys) @@ -10380,29 +10417,33 @@ :defaults dest-path) :do (rename-file-overwriting-target f new-f) :collect new-f) - files)))) + files))) + + ;; DEPRECATED. Does anyone use this? + (defun bundle-system (system &rest args &key force (verbose t) version &allow-other-keys) + (declare (ignore force verbose version)) + (apply #'operate 'deliver-asd-op system args))) ;;; -;;; LOAD-FASL-OP +;;; LOAD-BUNDLE-OP ;;; -;;; This is like ASDF's LOAD-OP, but using monolithic fasl files. +;;; This is like ASDF's LOAD-OP, but using bundle fasl files. ;;; (with-upgradability () - (defmethod component-depends-on ((o load-fasl-op) (c system)) - `((,o ,@(loop :for dep :in (component-sideway-dependencies c) - :collect (resolve-dependency-spec c dep))) - (,(if (user-system-p c) 'fasl-op 'load-op) ,c) + (defmethod component-depends-on ((o load-bundle-op) (c system)) + `((,o ,@(component-sideway-dependencies c)) + (,(if (user-system-p c) 'compile-bundle-op 'load-op) ,c) ,@(call-next-method))) - (defmethod input-files ((o load-fasl-op) (c system)) + (defmethod input-files ((o load-bundle-op) (c system)) (when (user-system-p c) - (output-files (find-operation o 'fasl-op) c))) + (output-files (find-operation o 'compile-bundle-op) c))) - (defmethod perform ((o load-fasl-op) (c system)) + (defmethod perform ((o load-bundle-op) (c system)) (when (input-files o c) (perform-lisp-load-fasl o c))) - (defmethod mark-operation-done :after ((o load-fasl-op) (c system)) + (defmethod mark-operation-done :after ((o load-bundle-op) (c system)) (mark-operation-done (find-operation o 'load-op) c))) ;;; @@ -10421,8 +10462,6 @@ (perform-lisp-load-fasl o c)) (defmethod perform ((o load-source-op) (c compiled-file)) (perform (find-operation o 'load-op) c)) - (defmethod perform ((o load-fasl-op) (c compiled-file)) - (perform (find-operation o 'load-op) c)) (defmethod perform ((o operation) (c compiled-file)) nil)) @@ -10433,14 +10472,23 @@ (defmethod trivial-system-p ((s prebuilt-system)) t) + (defmethod perform ((o link-op) (c prebuilt-system)) + nil) + + (defmethod perform ((o basic-compile-bundle-op) (c prebuilt-system)) + nil) + (defmethod perform ((o lib-op) (c prebuilt-system)) nil) - (defmethod component-depends-on ((o lib-op) (c prebuilt-system)) + (defmethod perform ((o dll-op) (c prebuilt-system)) nil) - (defmethod component-depends-on ((o monolithic-lib-op) (c prebuilt-system)) - nil)) + (defmethod component-depends-on ((o gather-op) (c prebuilt-system)) + nil) + + (defmethod output-files ((o lib-op) (c prebuilt-system)) + (values (list (prebuilt-system-static-library c)) t))) ;;; @@ -10457,6 +10505,7 @@ (library (second inputs)) (asd (first (output-files o s))) (name (if (and fasl asd) (pathname-name asd) (return-from perform))) + (version (component-version s)) (dependencies (if (operation-monolithic-p o) (remove-if-not 'builtin-system-p @@ -10486,6 +10535,7 @@ (let ((*package* (find-package :asdf-user))) (pprint `(defsystem ,name :class prebuilt-system + :version ,version :depends-on ,depends-on :components ((:compiled-file ,(pathname-name fasl))) ,@(when library `(:lib ,(file-namestring library)))) @@ -10493,7 +10543,7 @@ (terpri s))))) #-(or ecl mkcl) - (defmethod perform ((o basic-fasl-op) (c system)) + (defmethod perform ((o basic-compile-bundle-op) (c system)) (let* ((input-files (input-files o c)) (fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test-not #'equalp)) (non-fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test #'equalp)) @@ -10512,12 +10562,12 @@ (combine-fasls fasl-files output-file))))) (defmethod input-files ((o load-op) (s precompiled-system)) - (bundle-output-files (find-operation o 'fasl-op) s)) + (bundle-output-files (find-operation o 'compile-bundle-op) s)) (defmethod perform ((o load-op) (s precompiled-system)) (perform-lisp-load-fasl o s)) - (defmethod component-depends-on ((o load-fasl-op) (s precompiled-system)) + (defmethod component-depends-on ((o load-bundle-op) (s precompiled-system)) #+xcl (declare (ignorable o)) `((load-op ,s) ,@(call-next-method)))) @@ -10528,72 +10578,78 @@ #+(or ecl mkcl) (with-upgradability () - (defun uiop-library-file () - (or (and (find-system :uiop nil) - (system-source-directory :uiop) - (progn - (operate 'lib-op :uiop) - (output-file 'lib-op :uiop))) - (resolve-symlinks* (c::compile-file-pathname "sys:asdf" :type :lib)))) - (defmethod input-files :around ((o program-op) (c system)) - (let ((files (call-next-method)) - (plan (traverse-sub-actions o c :plan-class 'sequential-plan))) - (unless (or (and (system-source-directory :uiop) - (plan-operates-on-p plan '("uiop"))) - (and (system-source-directory :asdf) - (plan-operates-on-p plan '("asdf")))) - (pushnew (uiop-library-file) files :test 'pathname-equal)) - files)) - - (defun register-pre-built-system (name) - (register-system (make-instance 'system :name (coerce-name name) :source-file nil)))) - -#+ecl -(with-upgradability () - ;; I think that Juanjo intended for this to be. - ;; But it might break systems with missing dependencies, - ;; and there is a weird bug in test-xach-update-bug.script - ;;(unless (use-ecl-byte-compiler-p) - ;; (setf *load-system-operation* 'load-fasl-op)) + ;; I think that Juanjo intended for this to be, + ;; but beware the weird bug in test-xach-update-bug.script, + ;; and also it makes mkcl fail test-logical-pathname.script, + ;; and ecl fail test-bundle.script. + ;;(unless (or #+ecl (use-ecl-byte-compiler-p)) + ;; (setf *load-system-operation* 'load-bundle-op)) + + (defun asdf-library-pathname () + #+ecl (compile-file-pathname "sys:asdf" :type :lib) + #+mkcl (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;asdf")) + + (defun make-library-system (name pathname) + (make-instance 'prebuilt-system :name name :static-library (resolve-symlinks* pathname))) + + (defmethod component-depends-on :around ((o image-op) (c system)) + (destructuring-bind ((lib-op . deps)) (call-next-method) + (flet ((has-it-p (x) (find x deps :test 'equal :key 'coerce-name))) + `((,lib-op + #+mkcl ,@(unless (has-it-p "cmp") + `(,(make-library-system + "cmp" (make-pathname :type (bundle-pathname-type :lib) + :defaults #p"sys:cmp")))) + ,@(unless (or (has-it-p "asdf") (has-it-p "uiop")) + `(,(cond + ((system-source-directory :uiop) (find-system :uiop)) + ((system-source-directory :asdf) (find-system :asdf)) + (t (make-fake-asdf-system "asdf" (asdf-library-pathname)))))) + , at deps))))) (defmethod perform ((o link-op) (c system)) (let* ((object-files (input-files o c)) (output (output-files o c)) (bundle (first output)) - (targetp (eq (type-of o) (component-build-operation c))) + (programp (typep o 'program-op)) (kind (bundle-type o))) (when output (apply 'create-image - bundle (append object-files (bundle-op-lisp-files o)) + bundle (append + (when programp (prefix-lisp-object-files c)) + object-files + (when programp (postfix-lisp-object-files c))) :kind kind - :prologue-code (or (prologue-code o) (when targetp (prologue-code c))) - :epilogue-code (or (epilogue-code o) (when targetp (epilogue-code c))) - :build-args (bundle-op-build-args o) - (when targetp `(:entry-point ,(component-entry-point c)))))))) - -#+mkcl -(with-upgradability () - (defmethod perform ((o lib-op) (s system)) - (apply #'compiler::build-static-library (output-file o c) - :lisp-object-files (input-files o s) (bundle-op-build-args o))) - - (defmethod perform ((o basic-fasl-op) (s system)) - (apply #'compiler::build-bundle (output-file o c) ;; second??? - :lisp-object-files (input-files o s) (bundle-op-build-args o))) - - (defun bundle-system (system &rest args &key force (verbose t) version &allow-other-keys) - (declare (ignore force verbose version)) - (apply #'operate 'deliver-asd-op system args))) + :prologue-code (or (prologue-code o) (when programp (prologue-code c))) + :epilogue-code (or (epilogue-code o) (when programp (epilogue-code c))) + :build-args (or (extra-build-args o) (when programp (extra-build-args c))) + :extra-object-files (or (extra-object-files o) (when programp (extra-object-files c))) + (when programp `(:entry-point ,(component-entry-point c)))))))) #+(and (not asdf-use-unsafe-mac-bundle-op) (or (and ecl darwin) (and abcl darwin (not abcl-bundle-op-supported)))) -(defmethod perform :before ((o basic-fasl-op) (c component)) +(defmethod perform :before ((o basic-compile-bundle-op) (c component)) (unless (featurep :asdf-use-unsafe-mac-bundle-op) (cerror "Continue after modifying *FEATURES*." - "BASIC-FASL-OP bundle operations are not supported on Mac OS X for this lisp.~%~T~ + "BASIC-COMPILE-BUNDLE-OP operations are not supported on Mac OS X for this lisp.~%~T~ To continue, push :asdf-use-unsafe-mac-bundle-op onto *FEATURES*.~%~T~ Please report to ASDF-DEVEL if this works for you."))) + + +;;; Backward compatibility with pre-3.1.1 names +(defclass fasl-op (selfward-operation) + ((selfward-operation :initform 'compile-bundle-op :allocation :class))) +(defclass load-fasl-op (selfward-operation) + ((selfward-operation :initform 'load-bundle-op :allocation :class))) +(defclass binary-op (selfward-operation) + ((selfward-operation :initform 'deliver-asd-op :allocation :class))) +(defclass monolithic-fasl-op (selfward-operation) + ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class))) +(defclass monolithic-load-fasl-op (selfward-operation) + ((selfward-operation :initform 'monolithic-load-bundle-op :allocation :class))) +(defclass monolithic-binary-op (selfward-operation) + ((selfward-operation :initform 'monolithic-deliver-asd-op :allocation :class))) ;;;; ------------------------------------------------------------------------- ;;;; Concatenate-source @@ -10673,9 +10729,11 @@ (lisp-compilation-output-files o s)) (defmethod perform ((o basic-concatenate-source-op) (s system)) - (let ((inputs (input-files o s)) - (output (output-file o s))) - (concatenate-files inputs output))) + (let* ((ins (input-files o s)) + (out (output-file o s)) + (tmp (tmpize-pathname out))) + (concatenate-files ins tmp) + (rename-file-overwriting-target tmp out))) (defmethod perform ((o basic-load-concatenated-source-op) (s system)) (perform-lisp-load-source o s)) (defmethod perform ((o basic-compile-concatenated-source-op) (s system)) @@ -10989,41 +11047,40 @@ (:nicknames :asdf :asdf-utilities) (:recycle :asdf/interface :asdf) (:unintern - #:*asdf-revision* #:around #:asdf-method-combination - #:do-traverse #:do-dep #:do-one-dep #:visit-action #:component-visited-p - #:split #:make-collector #:loaded-systems ; makes for annoying SLIME completion - #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function + #:output-files-for-system-and-operation) ; ASDF-BINARY-LOCATION function we use to detect ABL (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action :asdf/output-translations :asdf/source-registry :asdf/plan :asdf/operate :asdf/parse-defsystem :asdf/bundle :asdf/concatenate-source :asdf/backward-internals :asdf/backward-interface :asdf/package-system) - ;; TODO: automatically generate interface with reexport? + ;; Note: (1) we are NOT automatically reexporting everything from previous packages. + ;; (2) we only reexport UIOP functionality when backward-compatibility requires it. (:export #:defsystem #:find-system #:locate-system #:coerce-name #:primary-system-name #:oos #:operate #:make-plan #:perform-plan #:sequential-plan - #:system-definition-pathname #:with-system-definitions + #:system-definition-pathname #:search-for-system-definition #:find-component #:component-find-path #:compile-system #:load-system #:load-systems #:load-systems* #:require-system #:test-system #:clear-system #:operation #:make-operation #:find-operation #:upward-operation #:downward-operation #:sideway-operation #:selfward-operation #:non-propagating-operation - #:build-op #:build + #:build-op #:make #:load-op #:prepare-op #:compile-op #:prepare-source-op #:load-source-op #:test-op #:feature #:version #:version-satisfies #:upgrade-asdf #:implementation-identifier #:implementation-type #:hostname - #:input-files #:output-files #:output-file #:perform + #:input-files #:output-files #:output-file #:perform #:perform-with-restarts #:operation-done-p #:explain #:action-description #:component-sideway-dependencies #:needed-in-image-p - ;; #:run-program ; we can't export it, because SB-GROVEL :use's both ASDF and SB-EXT. #:component-load-dependencies #:run-shell-command ; deprecated, do not use #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system - #+ecl #:make-build - #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op + #:program-system #:make-build + #:fasl-op #:load-fasl-op #:monolithic-fasl-op #:binary-op #:monolithic-binary-op + #:basic-compile-bundle-op #:prepare-bundle-op + #:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op #:lib-op #:dll-op #:deliver-asd-op #:program-op #:image-op #:monolithic-lib-op #:monolithic-dll-op #:monolithic-deliver-asd-op #:concatenate-source-op @@ -11185,7 +11242,7 @@ #+(or ecl mkcl) (progn - (pushnew '("fasb" . si::load-binary) si:*load-hooks* :test 'equal :key 'car) + (pushnew '("fasb" . si::load-binary) si::*load-hooks* :test 'equal :key 'car) #+(or (and ecl win32) (and mkcl windows)) (unless (assoc "asd" #+ecl ext:*load-hooks* #+mkcl si::*load-hooks* :test 'equal) From mevenson at common-lisp.net Thu Apr 17 10:39:59 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:39:59 -0000 Subject: [Armedbear-cvs] r14673 - branches/1.3.1 Message-ID: <20140417103959.13355.75693@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:39:58 2014 New Revision: 14673 Log: Backport r14662: Place JVM options after classpath specification. Under Windows (at least), one has to specifiy "-Djava.library.path=something" after the -classpath option for it to have any effect. Modified: branches/1.3.1/abcl.bat.in branches/1.3.1/abcl.in Modified: branches/1.3.1/abcl.bat.in ============================================================================== --- branches/1.3.1/abcl.bat.in Thu Apr 17 10:39:12 2014 (r14672) +++ branches/1.3.1/abcl.bat.in Thu Apr 17 10:39:58 2014 (r14673) @@ -1 +1 @@ -@"@JAVA@" @ABCL_JAVA_OPTIONS@ -cp "@ABCL_CLASSPATH@";"%CLASSPATH%" org.armedbear.lisp.Main %1 %2 %3 %4 %5 %6 %7 %8 %9 +@"@JAVA@" -cp "@ABCL_CLASSPATH@";"%CLASSPATH%" @ABCL_JAVA_OPTIONS@ org.armedbear.lisp.Main %1 %2 %3 %4 %5 %6 %7 %8 %9 Modified: branches/1.3.1/abcl.in ============================================================================== --- branches/1.3.1/abcl.in Thu Apr 17 10:39:12 2014 (r14672) +++ branches/1.3.1/abcl.in Thu Apr 17 10:39:58 2014 (r14673) @@ -19,8 +19,9 @@ # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -exec @JAVA@ @ABCL_JAVA_OPTIONS@ \ +exec @JAVA@ \ -cp @ABCL_CLASSPATH@:"$CLASSPATH" \ + @ABCL_JAVA_OPTIONS@ \ org.armedbear.lisp.Main \ "$@" From mevenson at common-lisp.net Thu Apr 17 10:41:12 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:41:12 -0000 Subject: [Armedbear-cvs] r14674 - branches/1.3.1/contrib/mvn Message-ID: <20140417104112.13432.21098@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:41:11 2014 New Revision: 14674 Log: Backport r14663: jna: now retrieves jna-4.1.0 Maven artifacts. TODO: fix CFFI upstream. 32 out of 286 total tests failed: FUNCALL.F-S-P.1, CALLBACKS.LONG, CALLBACKS.UNSIGNED-LONG, CALLBACKS.LONG-LONG, CALLBACKS.UNSIGNED-LONG-LONG, CALLBACKS.POINTER, CALLBACKS.STRING-NOT-DOCSTRING, CALLBACKS.NIL-FOR-NULL, CALLBACKS.FUNCALL.1, CALLBACKS.FUNCALL.2, CALLBACKS.DOUBLE26.FUNCALL, CALLBACKS.FLOAT26.FUNCALL, FOREIGN-GLOBALS.NAMESPACE.1, FOREIGN-GLOBALS.NAMESPACE.2, FOREIGN-GLOBALS.NAMESPACE.4, MAKE-POINTER.HIGH, FOREIGN-ALLOC.1, FOREIGN-ALLOC.2, FOREIGN-ALLOC.3, FOREIGN-ALLOC.4, FOREIGN-ALLOC.6, FOREIGN-ALLOC.8, FOREIGN-ALLOC.9, NULL-POINTER-P.NON-POINTER.1, NULL-POINTER-P.NON-POINTER.2, NULL-POINTER-P.NON-POINTER.3, STRUCT-VALUES-DEFAULT.TRANSLATION.MEM-REF.1, STRUCT-VALUES-DEFAULT.TRANSLATION.MEM-REF.2, FSBV.2, FSBV.3, FSBV.4, FSBV.7. 32 unexpected failures: FUNCALL.F-S-P.1, CALLBACKS.LONG, Modified: branches/1.3.1/contrib/mvn/jna.asd Modified: branches/1.3.1/contrib/mvn/jna.asd ============================================================================== --- branches/1.3.1/contrib/mvn/jna.asd Thu Apr 17 10:39:58 2014 (r14673) +++ branches/1.3.1/contrib/mvn/jna.asd Thu Apr 17 10:41:11 2014 (r14674) @@ -2,11 +2,11 @@ ;;;; Need to have jna.jar present for CFFI to work. (asdf:defsystem :jna - :version "4.0.0" - :description "<> asdf:defsystem " + :version "4.1.0" + :description "<> asdf:defsystem " :defsystem-depends-on (jss abcl-asdf) - :components ((:mvn "net.java.dev.jna/jna/4.0.0" - :alternate-uri "http://repo1.maven.org/maven2/net/java/dev/jna/jna/4.0.0/jna-4.0.0.jar" + :components ((:mvn "net.java.dev.jna/jna/4.1.0" + :alternate-uri "http://repo1.maven.org/maven2/net/java/dev/jna/jna/4.1.0/jna-4.1.0.jar" :classname "com.sun.jna.Native"))) (in-package :asdf) From mevenson at common-lisp.net Thu Apr 17 10:58:43 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:58:43 -0000 Subject: [Armedbear-cvs] r14675 - trunk/abcl/nbproject/private/configs Message-ID: <20140417105843.13916.25526@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:58:42 2014 New Revision: 14675 Log: Assume ASDF has been configured by using the DSL. Modified: trunk/abcl/nbproject/private/configs/slime.properties Modified: trunk/abcl/nbproject/private/configs/slime.properties ============================================================================== --- trunk/abcl/nbproject/private/configs/slime.properties Thu Apr 17 10:41:11 2014 (r14674) +++ trunk/abcl/nbproject/private/configs/slime.properties Thu Apr 17 10:58:42 2014 (r14675) @@ -1 +1 @@ -application.args=--eval "(require (quote asdf))" --eval '(push "~/.asdf-install-dir/systems/" asdf/find-system:*central-registry*)' --eval "(asdf:load-system :swank)" --eval "(swank:create-server)" +application.args=--eval "(require (quote asdf))" --eval "(asdf:load-system :swank)" --eval "(swank:create-server)" From mevenson at common-lisp.net Thu Apr 17 10:58:44 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 10:58:44 -0000 Subject: [Armedbear-cvs] r14676 - trunk/abcl Message-ID: <20140417105844.13939.62665@lisp.not.org> Author: mevenson Date: Thu Apr 17 10:58:44 2014 New Revision: 14676 Log: Note changes for 1.3.1. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Thu Apr 17 10:58:42 2014 (r14675) +++ trunk/abcl/CHANGES Thu Apr 17 10:58:44 2014 (r14676) @@ -3,6 +3,52 @@ http://abcl.org/svn/trunk/ Unreleased. +Version 1.3.1 +============= +http://abcl.org/svn/tags/1.3.1/ +20-APR-2014 + +## Fixed + +* Update to ASDF 3.1.0.103. + r14661 + + Fixes loading of Ironclad and other Quicklisp systems. + +* Fix Uniform Naming Convention (aka "UNC" or "network") paths under Windows. + r14659 + + DIRECTORY now works again on UNC paths. + + UNC paths may be either specified with either back slash (#\\) or + forward slash (#\/) doubled as the first character in a Pathname + namestring. + + The patterns in + + ////[directories-and-files] + + are parsed as + + is stored as HOST. + + is stored as DEVICE. + + [directories-and-files] gets parsed as per the normal rules under + Windows. + + Mixing namestrings with both backslash and slash characters can + lead to unpredictable results. It is recommended not to use + backslash characters in namestrings if it can be avoided. The + pathname printed representation is always normalized to using + forward slash delimiters. + + +* Find contrib based on system jar name. + r14657 + + From Olof-Joachim Frahm. + Version 1.3.0 ============= From mevenson at common-lisp.net Thu Apr 17 11:00:31 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 11:00:31 -0000 Subject: [Armedbear-cvs] r14677 - branches/1.3.1 Message-ID: <20140417110031.14042.43555@lisp.not.org> Author: mevenson Date: Thu Apr 17 11:00:30 2014 New Revision: 14677 Log: Backport r14676: Note changes for 1.3.1. Modified: branches/1.3.1/CHANGES Modified: branches/1.3.1/CHANGES ============================================================================== --- branches/1.3.1/CHANGES Thu Apr 17 10:58:44 2014 (r14676) +++ branches/1.3.1/CHANGES Thu Apr 17 11:00:30 2014 (r14677) @@ -1,3 +1,55 @@ +Version 1.4.0-dev +================= +http://abcl.org/svn/trunk/ +Unreleased. + +Version 1.3.1 +============= +http://abcl.org/svn/tags/1.3.1/ +20-APR-2014 + +## Fixed + +* Update to ASDF 3.1.0.103. + r14661 + + Fixes loading of Ironclad and other Quicklisp systems. + +* Fix Uniform Naming Convention (aka "UNC" or "network") paths under Windows. + r14659 + + DIRECTORY now works again on UNC paths. + + UNC paths may be either specified with either back slash (#\\) or + forward slash (#\/) doubled as the first character in a Pathname + namestring. + + The patterns in + + ////[directories-and-files] + + are parsed as + + is stored as HOST. + + is stored as DEVICE. + + [directories-and-files] gets parsed as per the normal rules under + Windows. + + Mixing namestrings with both backslash and slash characters can + lead to unpredictable results. It is recommended not to use + backslash characters in namestrings if it can be avoided. The + pathname printed representation is always normalized to using + forward slash delimiters. + + +* Find contrib based on system jar name. + r14657 + + From Olof-Joachim Frahm. + + Version 1.3.0 ============= http://abcl.org/svn/tags/1.3.0/ From mevenson at common-lisp.net Thu Apr 17 11:01:24 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 11:01:24 -0000 Subject: [Armedbear-cvs] r14678 - branches/1.3.1/nbproject/private/configs Message-ID: <20140417110124.14112.84879@lisp.not.org> Author: mevenson Date: Thu Apr 17 11:01:23 2014 New Revision: 14678 Log: Backport r14675: Assume ASDF has been configured by using the DSL. Modified: branches/1.3.1/nbproject/private/configs/slime.properties Modified: branches/1.3.1/nbproject/private/configs/slime.properties ============================================================================== --- branches/1.3.1/nbproject/private/configs/slime.properties Thu Apr 17 11:00:30 2014 (r14677) +++ branches/1.3.1/nbproject/private/configs/slime.properties Thu Apr 17 11:01:23 2014 (r14678) @@ -1 +1 @@ -application.args=--eval "(require (quote asdf))" --eval '(push "~/.asdf-install-dir/systems/" asdf/find-system:*central-registry*)' --eval "(asdf:load-system :swank)" --eval "(swank:create-server)" +application.args=--eval "(require (quote asdf))" --eval "(asdf:load-system :swank)" --eval "(swank:create-server)" From mevenson at common-lisp.net Thu Apr 17 11:29:34 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 11:29:34 -0000 Subject: [Armedbear-cvs] r14679 - trunk/abcl/src/org/armedbear/lisp Message-ID: <20140417112934.14702.89319@lisp.not.org> Author: mevenson Date: Thu Apr 17 11:29:33 2014 New Revision: 14679 Log: Non-zero timeouts CL:SLEEP and THREADS:OBJECT-WAIT below the timer Planck limit interpolated as a nanosecond. Thanks for James Lawrence for the consul. Addresses #14632. Modified: trunk/abcl/src/org/armedbear/lisp/LispThread.java Modified: trunk/abcl/src/org/armedbear/lisp/LispThread.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/LispThread.java Thu Apr 17 11:01:23 2014 (r14678) +++ trunk/abcl/src/org/armedbear/lisp/LispThread.java Thu Apr 17 11:29:33 2014 (r14679) @@ -1264,7 +1264,9 @@ doc="Causes the invoking thread to sleep for an interveral expressed in SECONDS.\n" + "SECONDS may be specified as a fraction of a second, with intervals\n" + "less than or equal to a nanosecond resulting in a yield of execution\n" - + "to other waiting threads rather than an actual sleep.") + + "to other waiting threads rather than an actual sleep.\n" + + "A zero value of SECONDS *may* result in the JVM sleeping indefinitely,\n" + + "depending on the implementation.") private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true) { @Override @@ -1272,10 +1274,15 @@ { long millis = sleepMillisPart(arg); int nanos = sleepNanosPart(arg); + boolean zeroArgP = arg.ZEROP() != NIL; try { if (millis == 0 && nanos == 0) { - Thread.yield(); + if (zeroArgP) { + Thread.sleep(0, 0); + } else { + Thread.sleep(0, 1); + } } else { Thread.sleep(millis, nanos); } @@ -1440,6 +1447,7 @@ doc="Causes the current thread to block until object-notify or object-notify-all is called on OBJECT.\n" + "Optionally unblock execution after TIMEOUT seconds. A TIMEOUT of zero\n" + "means to wait indefinitely.\n" + + "A non-zero TIMEOUT of less than a nanosecond is interpolated as a nanosecond wait." + "\n" + "See the documentation of java.lang.Object.wait() for further\n" + "information.\n" @@ -1467,9 +1475,20 @@ public LispObject execute(LispObject object, LispObject timeout) { + long millis = sleepMillisPart(timeout); + int nanos = sleepNanosPart(timeout); + boolean zeroArgP = timeout.ZEROP() != NIL; + try { - object.lockableInstance().wait(sleepMillisPart(timeout), - sleepNanosPart(timeout)); + if (millis == 0 && nanos == 0) { + if (zeroArgP) { + object.lockableInstance().wait(0, 0); + } else { + object.lockableInstance().wait(0, 1); + } + } else { + object.lockableInstance().wait(millis, nanos); + } } catch (InterruptedException e) { currentThread().processThreadInterrupts(); From mevenson at common-lisp.net Thu Apr 17 11:32:06 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 11:32:06 -0000 Subject: [Armedbear-cvs] r14680 - trunk/abcl Message-ID: <20140417113206.14829.31390@lisp.not.org> Author: mevenson Date: Thu Apr 17 11:32:05 2014 New Revision: 14680 Log: Changes for Planck timer resolution. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Thu Apr 17 11:29:33 2014 (r14679) +++ trunk/abcl/CHANGES Thu Apr 17 11:32:05 2014 (r14680) @@ -10,6 +10,9 @@ ## Fixed +* Interpolate CL:SLEEP and THREADS:OBJECT-WAIT for timeouts below the Planck + timer ("1ns") to a nanosecond + * Update to ASDF 3.1.0.103. r14661 From mevenson at common-lisp.net Thu Apr 17 11:33:22 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 11:33:22 -0000 Subject: [Armedbear-cvs] r14681 - in branches/1.3.1: . src/org/armedbear/lisp Message-ID: <20140417113322.14919.44729@lisp.not.org> Author: mevenson Date: Thu Apr 17 11:33:21 2014 New Revision: 14681 Log: Backport r14679-80: Non-zero timeouts CL:SLEEP and THREADS:OBJECT-WAIT below the timer Planck limit interpolated as a nanosecond. Thanks for James Lawrence for the consul. Addresses #14632. Modified: branches/1.3.1/CHANGES branches/1.3.1/src/org/armedbear/lisp/LispThread.java Modified: branches/1.3.1/CHANGES ============================================================================== --- branches/1.3.1/CHANGES Thu Apr 17 11:32:05 2014 (r14680) +++ branches/1.3.1/CHANGES Thu Apr 17 11:33:21 2014 (r14681) @@ -10,6 +10,9 @@ ## Fixed +* Interpolate CL:SLEEP and THREADS:OBJECT-WAIT for timeouts below the Planck + timer ("1ns") to a nanosecond + * Update to ASDF 3.1.0.103. r14661 Modified: branches/1.3.1/src/org/armedbear/lisp/LispThread.java ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/LispThread.java Thu Apr 17 11:32:05 2014 (r14680) +++ branches/1.3.1/src/org/armedbear/lisp/LispThread.java Thu Apr 17 11:33:21 2014 (r14681) @@ -2,7 +2,7 @@ * LispThread.java * * Copyright (C) 2003-2007 Peter Graves - * $Id: LispThread.java 14465 2013-04-24 12:50:37Z rschlatte $ + * $Id$ * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -1264,7 +1264,9 @@ doc="Causes the invoking thread to sleep for an interveral expressed in SECONDS.\n" + "SECONDS may be specified as a fraction of a second, with intervals\n" + "less than or equal to a nanosecond resulting in a yield of execution\n" - + "to other waiting threads rather than an actual sleep.") + + "to other waiting threads rather than an actual sleep.\n" + + "A zero value of SECONDS *may* result in the JVM sleeping indefinitely,\n" + + "depending on the implementation.") private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true) { @Override @@ -1272,10 +1274,15 @@ { long millis = sleepMillisPart(arg); int nanos = sleepNanosPart(arg); + boolean zeroArgP = arg.ZEROP() != NIL; try { if (millis == 0 && nanos == 0) { - Thread.yield(); + if (zeroArgP) { + Thread.sleep(0, 0); + } else { + Thread.sleep(0, 1); + } } else { Thread.sleep(millis, nanos); } @@ -1440,6 +1447,7 @@ doc="Causes the current thread to block until object-notify or object-notify-all is called on OBJECT.\n" + "Optionally unblock execution after TIMEOUT seconds. A TIMEOUT of zero\n" + "means to wait indefinitely.\n" + + "A non-zero TIMEOUT of less than a nanosecond is interpolated as a nanosecond wait." + "\n" + "See the documentation of java.lang.Object.wait() for further\n" + "information.\n" @@ -1467,9 +1475,20 @@ public LispObject execute(LispObject object, LispObject timeout) { + long millis = sleepMillisPart(timeout); + int nanos = sleepNanosPart(timeout); + boolean zeroArgP = timeout.ZEROP() != NIL; + try { - object.lockableInstance().wait(sleepMillisPart(timeout), - sleepNanosPart(timeout)); + if (millis == 0 && nanos == 0) { + if (zeroArgP) { + object.lockableInstance().wait(0, 0); + } else { + object.lockableInstance().wait(0, 1); + } + } else { + object.lockableInstance().wait(millis, nanos); + } } catch (InterruptedException e) { currentThread().processThreadInterrupts(); From mevenson at common-lisp.net Thu Apr 17 11:49:30 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 11:49:30 -0000 Subject: [Armedbear-cvs] r14682 - in trunk/abcl: src/org/armedbear/lisp test/lisp/abcl Message-ID: <20140417114930.15652.5751@lisp.not.org> Author: mevenson Date: Thu Apr 17 11:49:30 2014 New Revision: 14682 Log: Make JCALL work in more places. A reimplementation of org.apache.commons.lang.ClassUtils.isAssignable instead of the standard isAssignableFrom test. . >From Olof. Modified: trunk/abcl/src/org/armedbear/lisp/Java.java trunk/abcl/test/lisp/abcl/java-tests.lisp Modified: trunk/abcl/src/org/armedbear/lisp/Java.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Java.java Thu Apr 17 11:33:21 2014 (r14681) +++ trunk/abcl/src/org/armedbear/lisp/Java.java Thu Apr 17 11:49:30 2014 (r14682) @@ -1040,17 +1040,32 @@ return result; } + private static boolean isAssignable(Class from, Class to) { + from = maybeBoxClass(from); + to = maybeBoxClass(to); + if (to.isAssignableFrom(from)) { + return true; + } + if (Byte.class.equals(from)) { + return Short.class.equals(to) || Integer.class.equals(to) || Long.class.equals(to) || Float.class.equals(to) || Double.class.equals(to); + } else if (Short.class.equals(from) || Character.class.equals(from)) { + return Integer.class.equals(to) || Long.class.equals(to) || Float.class.equals(to) || Double.class.equals(to); + } else if (Integer.class.equals(from)) { + return Long.class.equals(to) || Float.class.equals(to) || Double.class.equals(to); + } else if (Long.class.equals(from)) { + return Float.class.equals(to) || Double.class.equals(to); + } else if (Float.class.equals(from)) { + return Double.class.equals(to); + } + return false; + } + private static boolean isApplicableMethod(Class[] methodTypes, Object[] args) { for (int i = 0; i < methodTypes.length; ++i) { Class methodType = methodTypes[i]; Object arg = args[i]; - if (methodType.isPrimitive()) { - Class x = getBoxedClass(methodType); - if (!x.isInstance(arg)) { - return false; - } - } else if (arg != null && !methodType.isInstance(arg)) { + if (!isAssignable(arg.getClass(), methodType)) { return false; } } @@ -1059,18 +1074,12 @@ private static boolean isMoreSpecialized(Class[] xtypes, Class[] ytypes) { for (int i = 0; i < xtypes.length; ++i) { - Class xtype = xtypes[i]; - if (xtype.isPrimitive()) { - xtype = getBoxedClass(xtype); - } - Class ytype = ytypes[i]; - if (ytype.isPrimitive()) { - ytype = getBoxedClass(ytype); - } + Class xtype = maybeBoxClass(xtypes[i]); + Class ytype = maybeBoxClass(ytypes[i]); if (xtype.equals(ytype)) { continue; } - if (ytype.isAssignableFrom(xtype)) { + if (isAssignable(xtype, ytype)) { return true; } } Modified: trunk/abcl/test/lisp/abcl/java-tests.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/java-tests.lisp Thu Apr 17 11:33:21 2014 (r14681) +++ trunk/abcl/test/lisp/abcl/java-tests.lisp Thu Apr 17 11:49:30 2014 (r14682) @@ -195,6 +195,14 @@ (jcall method "test" (make-immediate-object nil :boolean) 0 "this is a test" 10 4)) t) +(deftest jcall.5 + (jcall "join" (jstatic "currentThread" "java.lang.Thread") 1 1) + nil) + +(deftest jcall.6 + (jcall "offsetByCodePoints" "foobar" 0 #\Nul) + 0) + (deftest jfield.1 (type-of (jfield "java.lang.Integer" "TYPE")) #+abcl java-object From mevenson at common-lisp.net Thu Apr 17 11:50:50 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 11:50:50 -0000 Subject: [Armedbear-cvs] r14683 - in branches/1.3.1: src/org/armedbear/lisp test/lisp/abcl Message-ID: <20140417115050.15772.3529@lisp.not.org> Author: mevenson Date: Thu Apr 17 11:50:49 2014 New Revision: 14683 Log: Backport r14682: Make JCALL work in more places. A reimplementation of org.apache.commons.lang.ClassUtils.isAssignable instead of the standard isAssignableFrom test. . >From Olof. Modified: branches/1.3.1/src/org/armedbear/lisp/Java.java branches/1.3.1/test/lisp/abcl/java-tests.lisp Modified: branches/1.3.1/src/org/armedbear/lisp/Java.java ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/Java.java Thu Apr 17 11:49:30 2014 (r14682) +++ branches/1.3.1/src/org/armedbear/lisp/Java.java Thu Apr 17 11:50:49 2014 (r14683) @@ -1040,17 +1040,32 @@ return result; } + private static boolean isAssignable(Class from, Class to) { + from = maybeBoxClass(from); + to = maybeBoxClass(to); + if (to.isAssignableFrom(from)) { + return true; + } + if (Byte.class.equals(from)) { + return Short.class.equals(to) || Integer.class.equals(to) || Long.class.equals(to) || Float.class.equals(to) || Double.class.equals(to); + } else if (Short.class.equals(from) || Character.class.equals(from)) { + return Integer.class.equals(to) || Long.class.equals(to) || Float.class.equals(to) || Double.class.equals(to); + } else if (Integer.class.equals(from)) { + return Long.class.equals(to) || Float.class.equals(to) || Double.class.equals(to); + } else if (Long.class.equals(from)) { + return Float.class.equals(to) || Double.class.equals(to); + } else if (Float.class.equals(from)) { + return Double.class.equals(to); + } + return false; + } + private static boolean isApplicableMethod(Class[] methodTypes, Object[] args) { for (int i = 0; i < methodTypes.length; ++i) { Class methodType = methodTypes[i]; Object arg = args[i]; - if (methodType.isPrimitive()) { - Class x = getBoxedClass(methodType); - if (!x.isInstance(arg)) { - return false; - } - } else if (arg != null && !methodType.isInstance(arg)) { + if (!isAssignable(arg.getClass(), methodType)) { return false; } } @@ -1059,18 +1074,12 @@ private static boolean isMoreSpecialized(Class[] xtypes, Class[] ytypes) { for (int i = 0; i < xtypes.length; ++i) { - Class xtype = xtypes[i]; - if (xtype.isPrimitive()) { - xtype = getBoxedClass(xtype); - } - Class ytype = ytypes[i]; - if (ytype.isPrimitive()) { - ytype = getBoxedClass(ytype); - } + Class xtype = maybeBoxClass(xtypes[i]); + Class ytype = maybeBoxClass(ytypes[i]); if (xtype.equals(ytype)) { continue; } - if (ytype.isAssignableFrom(xtype)) { + if (isAssignable(xtype, ytype)) { return true; } } Modified: branches/1.3.1/test/lisp/abcl/java-tests.lisp ============================================================================== --- branches/1.3.1/test/lisp/abcl/java-tests.lisp Thu Apr 17 11:49:30 2014 (r14682) +++ branches/1.3.1/test/lisp/abcl/java-tests.lisp Thu Apr 17 11:50:49 2014 (r14683) @@ -195,6 +195,14 @@ (jcall method "test" (make-immediate-object nil :boolean) 0 "this is a test" 10 4)) t) +(deftest jcall.5 + (jcall "join" (jstatic "currentThread" "java.lang.Thread") 1 1) + nil) + +(deftest jcall.6 + (jcall "offsetByCodePoints" "foobar" 0 #\Nul) + 0) + (deftest jfield.1 (type-of (jfield "java.lang.Integer" "TYPE")) #+abcl java-object From mevenson at common-lisp.net Thu Apr 17 12:00:39 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 12:00:39 -0000 Subject: [Armedbear-cvs] r14684 - trunk/abcl Message-ID: <20140417120039.16359.5201@lisp.not.org> Author: mevenson Date: Thu Apr 17 12:00:39 2014 New Revision: 14684 Log: Further update with changes. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Thu Apr 17 11:50:49 2014 (r14683) +++ trunk/abcl/CHANGES Thu Apr 17 12:00:39 2014 (r14684) @@ -10,16 +10,20 @@ ## Fixed -* Interpolate CL:SLEEP and THREADS:OBJECT-WAIT for timeouts below the Planck - timer ("1ns") to a nanosecond +* Make JCALL work in more places. Thanks to Olof-Joachim Frahm. + + +* Interpolate CL:SLEEP and THREADS:OBJECT-WAIT for timeouts below the + Planck timer ("1ns") to a nanosecond. + * Update to ASDF 3.1.0.103. - r14661 + Fixes loading of Ironclad and other Quicklisp systems. * Fix Uniform Naming Convention (aka "UNC" or "network") paths under Windows. - r14659 + DIRECTORY now works again on UNC paths. @@ -48,7 +52,7 @@ * Find contrib based on system jar name. - r14657 + From Olof-Joachim Frahm. From mevenson at common-lisp.net Thu Apr 17 12:01:56 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 12:01:56 -0000 Subject: [Armedbear-cvs] r14685 - branches/1.3.1 Message-ID: <20140417120156.16447.60751@lisp.not.org> Author: mevenson Date: Thu Apr 17 12:01:55 2014 New Revision: 14685 Log: Backport r14684: Further update with changes. Modified: branches/1.3.1/CHANGES Modified: branches/1.3.1/CHANGES ============================================================================== --- branches/1.3.1/CHANGES Thu Apr 17 12:00:39 2014 (r14684) +++ branches/1.3.1/CHANGES Thu Apr 17 12:01:55 2014 (r14685) @@ -10,16 +10,20 @@ ## Fixed -* Interpolate CL:SLEEP and THREADS:OBJECT-WAIT for timeouts below the Planck - timer ("1ns") to a nanosecond +* Make JCALL work in more places. Thanks to Olof-Joachim Frahm. + + +* Interpolate CL:SLEEP and THREADS:OBJECT-WAIT for timeouts below the + Planck timer ("1ns") to a nanosecond. + * Update to ASDF 3.1.0.103. - r14661 + Fixes loading of Ironclad and other Quicklisp systems. * Fix Uniform Naming Convention (aka "UNC" or "network") paths under Windows. - r14659 + DIRECTORY now works again on UNC paths. @@ -48,7 +52,7 @@ * Find contrib based on system jar name. - r14657 + From Olof-Joachim Frahm. From mevenson at common-lisp.net Thu Apr 17 12:13:57 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 17 Apr 2014 12:13:57 -0000 Subject: [Armedbear-cvs] r14686 - trunk/abcl/test/lisp/ansi Message-ID: <20140417121357.16856.45882@lisp.not.org> Author: mevenson Date: Thu Apr 17 12:13:56 2014 New Revision: 14686 Log: abcl-1.3.1 compiled ansi-test results. Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures ============================================================================== --- trunk/abcl/test/lisp/ansi/ansi-test-failures Thu Apr 17 12:01:55 2014 (r14685) +++ trunk/abcl/test/lisp/ansi/ansi-test-failures Thu Apr 17 12:13:56 2014 (r14686) @@ -580,3 +580,14 @@ PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17)) +;;13 out of 21707 total tests failed: +(compileit abcl-1.3.1-rc-0 :id illin + +(CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 INVOKE-DEBUGGER.1 +MAKE-CONDITION.3 MAKE-CONDITION.4 SXHASH.8 MAP.48 TYPE-OF.1 TYPE-OF.4 +MAKE-CONCATENATED-STREAM.30 PRINT.RANDOM-STATE.1 +PPRINT-LOGICAL-BLOCK.17 TRACE.8) +;;453.45 seconds real time 6389761 cons cells +;;462.761 seconds real time +;;6389826 cons cells + From mevenson at common-lisp.net Fri Apr 18 06:03:28 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 18 Apr 2014 06:03:28 -0000 Subject: [Armedbear-cvs] r14687 - in trunk/abcl: src/org/armedbear/lisp test/lisp/abcl Message-ID: <20140418060328.7280.23261@lisp.not.org> Author: mevenson Date: Fri Apr 18 06:03:27 2014 New Revision: 14687 Log: Fix loading of JNA with recent JCALL improvements. >From Olof. Modified: trunk/abcl/src/org/armedbear/lisp/Java.java trunk/abcl/test/lisp/abcl/java-tests.lisp Modified: trunk/abcl/src/org/armedbear/lisp/Java.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Java.java Thu Apr 17 12:13:56 2014 (r14686) +++ trunk/abcl/src/org/armedbear/lisp/Java.java Fri Apr 18 06:03:27 2014 (r14687) @@ -1065,7 +1065,9 @@ for (int i = 0; i < methodTypes.length; ++i) { Class methodType = methodTypes[i]; Object arg = args[i]; - if (!isAssignable(arg.getClass(), methodType)) { + if (arg == null) { + return !methodType.isPrimitive(); + } else if (!isAssignable(arg.getClass(), methodType)) { return false; } } Modified: trunk/abcl/test/lisp/abcl/java-tests.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/java-tests.lisp Thu Apr 17 12:13:56 2014 (r14686) +++ trunk/abcl/test/lisp/abcl/java-tests.lisp Fri Apr 18 06:03:27 2014 (r14687) @@ -203,6 +203,11 @@ (jcall "offsetByCodePoints" "foobar" 0 #\Nul) 0) +(deftest jcall.7 + (signals-error (jcall "offsetByCodePoints" "foobar" 0 nil) + #+abcl 'java-exception + #+allegro 'jlinker-error)) + (deftest jfield.1 (type-of (jfield "java.lang.Integer" "TYPE")) #+abcl java-object From mevenson at common-lisp.net Fri Apr 18 06:15:47 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 18 Apr 2014 06:15:47 -0000 Subject: [Armedbear-cvs] r14688 - in branches/1.3.1: src/org/armedbear/lisp test/lisp/abcl Message-ID: <20140418061547.7572.35146@lisp.not.org> Author: mevenson Date: Fri Apr 18 06:15:47 2014 New Revision: 14688 Log: Backport r14687: Fix loading of JNA with recent JCALL improvements. >From Olof. Modified: branches/1.3.1/src/org/armedbear/lisp/Java.java branches/1.3.1/test/lisp/abcl/java-tests.lisp Modified: branches/1.3.1/src/org/armedbear/lisp/Java.java ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/Java.java Fri Apr 18 06:03:27 2014 (r14687) +++ branches/1.3.1/src/org/armedbear/lisp/Java.java Fri Apr 18 06:15:47 2014 (r14688) @@ -1065,7 +1065,9 @@ for (int i = 0; i < methodTypes.length; ++i) { Class methodType = methodTypes[i]; Object arg = args[i]; - if (!isAssignable(arg.getClass(), methodType)) { + if (arg == null) { + return !methodType.isPrimitive(); + } else if (!isAssignable(arg.getClass(), methodType)) { return false; } } Modified: branches/1.3.1/test/lisp/abcl/java-tests.lisp ============================================================================== --- branches/1.3.1/test/lisp/abcl/java-tests.lisp Fri Apr 18 06:03:27 2014 (r14687) +++ branches/1.3.1/test/lisp/abcl/java-tests.lisp Fri Apr 18 06:15:47 2014 (r14688) @@ -203,6 +203,11 @@ (jcall "offsetByCodePoints" "foobar" 0 #\Nul) 0) +(deftest jcall.7 + (signals-error (jcall "offsetByCodePoints" "foobar" 0 nil) + #+abcl 'java-exception + #+allegro 'jlinker-error)) + (deftest jfield.1 (type-of (jfield "java.lang.Integer" "TYPE")) #+abcl java-object From mevenson at common-lisp.net Tue Apr 22 11:24:51 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 22 Apr 2014 11:24:51 -0000 Subject: [Armedbear-cvs] r14690 - trunk/abcl/src/org/armedbear/lisp Message-ID: <20140422112451.13945.40233@lisp.not.org> Author: mevenson Date: Tue Apr 22 11:24:50 2014 New Revision: 14690 Log: THREADS:YIELD implements java.lang.Thread.yield(). Improved documenation strings in threads package. Modified: trunk/abcl/src/org/armedbear/lisp/LispThread.java trunk/abcl/src/org/armedbear/lisp/threads.lisp Modified: trunk/abcl/src/org/armedbear/lisp/LispThread.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/LispThread.java Fri Apr 18 06:20:54 2014 (r14689) +++ trunk/abcl/src/org/armedbear/lisp/LispThread.java Tue Apr 22 11:24:50 2014 (r14690) @@ -1365,83 +1365,93 @@ } }; + public static final Primitive CURRENT_THREAD + = new pf_current_thread(); @DocString(name="current-thread", - doc="Returns a reference to invoking thread.") - private static final Primitive CURRENT_THREAD = - new Primitive("current-thread", PACKAGE_THREADS, true) - { - @Override - public LispObject execute() - { - return currentThread(); - } + doc="Returns a reference to invoking thread.") + private static final class pf_current_thread extends Primitive { + pf_current_thread() { + super("current-thread", PACKAGE_THREADS, true); + } + @Override + public LispObject execute() { + return currentThread(); + } }; + public static final Primitive BACKTRACE + = new pf_backtrace(); @DocString(name="backtrace", - doc="Returns a backtrace of the invoking thread.") - private static final Primitive BACKTRACE = - new Primitive("backtrace", PACKAGE_SYS, true) - { - @Override - public LispObject execute(LispObject[] args) - - { - if (args.length > 1) - return error(new WrongNumberOfArgumentsException(this, -1, 1)); - int limit = args.length > 0 ? Fixnum.getValue(args[0]) : 0; - return currentThread().backtrace(limit); - } - }; - @DocString(name="frame-to-string", args="frame") - private static final Primitive FRAME_TO_STRING = - new Primitive("frame-to-string", PACKAGE_SYS, true) - { - @Override - public LispObject execute(LispObject[] args) - - { - if (args.length != 1) - return error(new WrongNumberOfArgumentsException(this, 1)); - - return checkStackFrame(args[0]).toLispString(); - } + doc="Returns a Java backtrace of the invoking thread.") + private static final class pf_backtrace extends Primitive { + pf_backtrace() { + super("backtrace", PACKAGE_SYS, true); + } + @Override + public LispObject execute(LispObject[] args) { + if (args.length > 1) + return error(new WrongNumberOfArgumentsException(this, -1, 1)); + int limit = args.length > 0 ? Fixnum.getValue(args[0]) : 0; + return currentThread().backtrace(limit); + } + }; + + public static final Primitive FRAME_TO_STRING + = new pf_frame_to_string(); + @DocString(name="frame-to-string", + args="frame", + doc="Convert stack FRAME to a (potentially) readable string.") + private static final class pf_frame_to_string extends Primitive { + pf_frame_to_string() { + super("frame-to-string", PACKAGE_SYS, true); + } + @Override + public LispObject execute(LispObject[] args) { + if (args.length != 1) + return error(new WrongNumberOfArgumentsException(this, 1)); + return checkStackFrame(args[0]).toLispString(); + } }; + public static final Primitive FRAME_TO_LIST + = new pf_frame_to_list(); @DocString(name="frame-to-list", args="frame") - private static final Primitive FRAME_TO_LIST = - new Primitive("frame-to-list", PACKAGE_SYS, true) - { - @Override - public LispObject execute(LispObject[] args) - - { - if (args.length != 1) - return error(new WrongNumberOfArgumentsException(this, 1)); + private static final class pf_frame_to_list extends Primitive { + pf_frame_to_list() { + super("frame-to-list", PACKAGE_SYS, true); + } + @Override + public LispObject execute(LispObject[] args) { + if (args.length != 1) + return error(new WrongNumberOfArgumentsException(this, 1)); - return checkStackFrame(args[0]).toLispList(); - } + return checkStackFrame(args[0]).toLispList(); + } }; + public static final SpecialOperator SYNCHRONIZED_ON + = new so_synchronized_on(); @DocString(name="synchronized-on", args="form &body body") - private static final SpecialOperator SYNCHRONIZED_ON = - new SpecialOperator("synchronized-on", PACKAGE_THREADS, true, - "form &body body") - { - @Override - public LispObject execute(LispObject args, Environment env) - - { - if (args == NIL) - return error(new WrongNumberOfArgumentsException(this, 1)); - - LispThread thread = LispThread.currentThread(); - synchronized (eval(args.car(), env, thread).lockableInstance()) { - return progn(args.cdr(), env, thread); - } - } - }; - + private static final class so_synchronized_on extends SpecialOperator { + so_synchronized_on() { + super("synchronized-on", PACKAGE_THREADS, true, "form &body body"); + } + @Override + public LispObject execute(LispObject args, Environment env) { + if (args == NIL) + return error(new WrongNumberOfArgumentsException(this, 1)); + + LispThread thread = LispThread.currentThread(); + synchronized (eval(args.car(), env, thread).lockableInstance()) { + return progn(args.cdr(), env, thread); + } + } + }; + + + public static final Primitive OBJECT_WAIT + = new pf_object_wait(); @DocString( name="object-wait", args="object &optional timeout", doc="Causes the current thread to block until object-notify or object-notify-all is called on OBJECT.\n" @@ -1452,90 +1462,89 @@ + "See the documentation of java.lang.Object.wait() for further\n" + "information.\n" ) - private static final Primitive OBJECT_WAIT = - new Primitive("object-wait", PACKAGE_THREADS, true) - { - @Override - public LispObject execute(LispObject object) - - { - try { - object.lockableInstance().wait(); - } - catch (InterruptedException e) { - currentThread().processThreadInterrupts(); - } - catch (IllegalMonitorStateException e) { - return error(new IllegalMonitorState(e.getMessage())); - } - return NIL; - } - - @Override - public LispObject execute(LispObject object, LispObject timeout) - - { - long millis = sleepMillisPart(timeout); - int nanos = sleepNanosPart(timeout); - boolean zeroArgP = timeout.ZEROP() != NIL; + private static final class pf_object_wait extends Primitive { + pf_object_wait() { + super("object-wait", PACKAGE_THREADS, true); + } + @Override + public LispObject execute(LispObject object) { + try { + object.lockableInstance().wait(); + } catch (InterruptedException e) { + currentThread().processThreadInterrupts(); + } catch (IllegalMonitorStateException e) { + return error(new IllegalMonitorState(e.getMessage())); + } + return NIL; + } + + @Override + public LispObject execute(LispObject object, LispObject timeout) { + long millis = sleepMillisPart(timeout); + int nanos = sleepNanosPart(timeout); + boolean zeroArgP = timeout.ZEROP() != NIL; - try { - if (millis == 0 && nanos == 0) { - if (zeroArgP) { - object.lockableInstance().wait(0, 0); - } else { - object.lockableInstance().wait(0, 1); - } - } else { - object.lockableInstance().wait(millis, nanos); - } - } - catch (InterruptedException e) { - currentThread().processThreadInterrupts(); - } - catch (IllegalMonitorStateException e) { - return error(new IllegalMonitorState(e.getMessage())); + try { + if (millis == 0 && nanos == 0) { + if (zeroArgP) { + object.lockableInstance().wait(0, 0); + } else { + object.lockableInstance().wait(0, 1); } - return NIL; - } - }; - - @DocString(name="object-notify", args="object") - private static final Primitive OBJECT_NOTIFY = - new Primitive("object-notify", PACKAGE_THREADS, true, - "object") - { - @Override - public LispObject execute(LispObject object) - - { - try { - object.lockableInstance().notify(); - } - catch (IllegalMonitorStateException e) { - return error(new IllegalMonitorState(e.getMessage())); - } - return NIL; - } - }; - - @DocString(name="object-notify-all", args="object") - private static final Primitive OBJECT_NOTIFY_ALL = - new Primitive("object-notify-all", PACKAGE_THREADS, true) - { - @Override - public LispObject execute(LispObject object) - - { - try { - object.lockableInstance().notifyAll(); - } - catch (IllegalMonitorStateException e) { - return error(new IllegalMonitorState(e.getMessage())); - } - return NIL; + } else { + object.lockableInstance().wait(millis, nanos); + } + } catch (InterruptedException e) { + currentThread().processThreadInterrupts(); + } catch (IllegalMonitorStateException e) { + return error(new IllegalMonitorState(e.getMessage())); + } + return NIL; + } + }; + + public static final Primitive OBJECT_NOTIFY + = new pf_object_notify(); + @DocString(name="object-notify", + args="object", + doc="Wakes up a single thread that is waiting on OBJECT's monitor." ++ "\nIf any threads are waiting on this object, one of them is chosen to be" ++ " awakened. The choice is arbitrary and occurs at the discretion of the" ++ " implementation. A thread waits on an object's monitor by calling one" ++ " of the wait methods.") + private static final class pf_object_notify extends Primitive { + pf_object_notify() { + super("object-notify", PACKAGE_THREADS, true, "object"); + } + @Override + public LispObject execute(LispObject object) { + try { + object.lockableInstance().notify(); + } catch (IllegalMonitorStateException e) { + return error(new IllegalMonitorState(e.getMessage())); + } + return NIL; + } + }; + + public static final Primitive OBJECT_NOTIFY_ALL + = new pf_object_notify_all(); + @DocString(name="object-notify-all", + args="object", + doc="Wakes up all threads that are waiting on this OBJECT's monitor." ++ "\nA thread waits on an object's monitor by calling one of the wait methods.") + private static final class pf_object_notify_all extends Primitive { + pf_object_notify_all() { + super("object-notify-all", PACKAGE_THREADS, true); + } + @Override + public LispObject execute(LispObject object) { + try { + object.lockableInstance().notifyAll(); + } catch (IllegalMonitorStateException e) { + return error(new IllegalMonitorState(e.getMessage())); } + return NIL; + } }; - - } Modified: trunk/abcl/src/org/armedbear/lisp/threads.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/threads.lisp Fri Apr 18 06:20:54 2014 (r14689) +++ trunk/abcl/src/org/armedbear/lisp/threads.lisp Tue Apr 22 11:24:50 2014 (r14690) @@ -32,13 +32,11 @@ (in-package #:threads) - (export '(make-mailbox mailbox-send mailbox-empty-p mailbox-read mailbox-peek make-thread-lock with-thread-lock + current-thread yield make-mutex get-mutex release-mutex with-mutex)) - - ;; ;; MAKE-THREAD helper to establish restarts ;; @@ -147,3 +145,8 @@ (synchronized-on ,glock , at body)))) +(defun yield () + "A hint to the scheduler that the current thread is willing to yield its current use of a processor. The scheduler is free to ignore this hint. + +See java.lang.Thread.yield()." + (java:jcall "yield" (JAVA:jstatic "currentThread" "java.lang.Thread"))) From mevenson at common-lisp.net Tue Apr 22 11:26:58 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 22 Apr 2014 11:26:58 -0000 Subject: [Armedbear-cvs] r14691 - branches/1.3.1/src/org/armedbear/lisp Message-ID: <20140422112658.14048.96783@lisp.not.org> Author: mevenson Date: Tue Apr 22 11:26:57 2014 New Revision: 14691 Log: Backport r14690: THREADS:YIELD implements java.lang.Thread.yield(). Improved documenation strings in threads package. Modified: branches/1.3.1/src/org/armedbear/lisp/LispThread.java branches/1.3.1/src/org/armedbear/lisp/threads.lisp Modified: branches/1.3.1/src/org/armedbear/lisp/LispThread.java ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/LispThread.java Tue Apr 22 11:24:50 2014 (r14690) +++ branches/1.3.1/src/org/armedbear/lisp/LispThread.java Tue Apr 22 11:26:57 2014 (r14691) @@ -1365,83 +1365,93 @@ } }; + public static final Primitive CURRENT_THREAD + = new pf_current_thread(); @DocString(name="current-thread", - doc="Returns a reference to invoking thread.") - private static final Primitive CURRENT_THREAD = - new Primitive("current-thread", PACKAGE_THREADS, true) - { - @Override - public LispObject execute() - { - return currentThread(); - } + doc="Returns a reference to invoking thread.") + private static final class pf_current_thread extends Primitive { + pf_current_thread() { + super("current-thread", PACKAGE_THREADS, true); + } + @Override + public LispObject execute() { + return currentThread(); + } }; + public static final Primitive BACKTRACE + = new pf_backtrace(); @DocString(name="backtrace", - doc="Returns a backtrace of the invoking thread.") - private static final Primitive BACKTRACE = - new Primitive("backtrace", PACKAGE_SYS, true) - { - @Override - public LispObject execute(LispObject[] args) - - { - if (args.length > 1) - return error(new WrongNumberOfArgumentsException(this, -1, 1)); - int limit = args.length > 0 ? Fixnum.getValue(args[0]) : 0; - return currentThread().backtrace(limit); - } - }; - @DocString(name="frame-to-string", args="frame") - private static final Primitive FRAME_TO_STRING = - new Primitive("frame-to-string", PACKAGE_SYS, true) - { - @Override - public LispObject execute(LispObject[] args) - - { - if (args.length != 1) - return error(new WrongNumberOfArgumentsException(this, 1)); - - return checkStackFrame(args[0]).toLispString(); - } + doc="Returns a Java backtrace of the invoking thread.") + private static final class pf_backtrace extends Primitive { + pf_backtrace() { + super("backtrace", PACKAGE_SYS, true); + } + @Override + public LispObject execute(LispObject[] args) { + if (args.length > 1) + return error(new WrongNumberOfArgumentsException(this, -1, 1)); + int limit = args.length > 0 ? Fixnum.getValue(args[0]) : 0; + return currentThread().backtrace(limit); + } + }; + + public static final Primitive FRAME_TO_STRING + = new pf_frame_to_string(); + @DocString(name="frame-to-string", + args="frame", + doc="Convert stack FRAME to a (potentially) readable string.") + private static final class pf_frame_to_string extends Primitive { + pf_frame_to_string() { + super("frame-to-string", PACKAGE_SYS, true); + } + @Override + public LispObject execute(LispObject[] args) { + if (args.length != 1) + return error(new WrongNumberOfArgumentsException(this, 1)); + return checkStackFrame(args[0]).toLispString(); + } }; + public static final Primitive FRAME_TO_LIST + = new pf_frame_to_list(); @DocString(name="frame-to-list", args="frame") - private static final Primitive FRAME_TO_LIST = - new Primitive("frame-to-list", PACKAGE_SYS, true) - { - @Override - public LispObject execute(LispObject[] args) - - { - if (args.length != 1) - return error(new WrongNumberOfArgumentsException(this, 1)); + private static final class pf_frame_to_list extends Primitive { + pf_frame_to_list() { + super("frame-to-list", PACKAGE_SYS, true); + } + @Override + public LispObject execute(LispObject[] args) { + if (args.length != 1) + return error(new WrongNumberOfArgumentsException(this, 1)); - return checkStackFrame(args[0]).toLispList(); - } + return checkStackFrame(args[0]).toLispList(); + } }; + public static final SpecialOperator SYNCHRONIZED_ON + = new so_synchronized_on(); @DocString(name="synchronized-on", args="form &body body") - private static final SpecialOperator SYNCHRONIZED_ON = - new SpecialOperator("synchronized-on", PACKAGE_THREADS, true, - "form &body body") - { - @Override - public LispObject execute(LispObject args, Environment env) - - { - if (args == NIL) - return error(new WrongNumberOfArgumentsException(this, 1)); - - LispThread thread = LispThread.currentThread(); - synchronized (eval(args.car(), env, thread).lockableInstance()) { - return progn(args.cdr(), env, thread); - } - } - }; - + private static final class so_synchronized_on extends SpecialOperator { + so_synchronized_on() { + super("synchronized-on", PACKAGE_THREADS, true, "form &body body"); + } + @Override + public LispObject execute(LispObject args, Environment env) { + if (args == NIL) + return error(new WrongNumberOfArgumentsException(this, 1)); + + LispThread thread = LispThread.currentThread(); + synchronized (eval(args.car(), env, thread).lockableInstance()) { + return progn(args.cdr(), env, thread); + } + } + }; + + + public static final Primitive OBJECT_WAIT + = new pf_object_wait(); @DocString( name="object-wait", args="object &optional timeout", doc="Causes the current thread to block until object-notify or object-notify-all is called on OBJECT.\n" @@ -1452,90 +1462,89 @@ + "See the documentation of java.lang.Object.wait() for further\n" + "information.\n" ) - private static final Primitive OBJECT_WAIT = - new Primitive("object-wait", PACKAGE_THREADS, true) - { - @Override - public LispObject execute(LispObject object) - - { - try { - object.lockableInstance().wait(); - } - catch (InterruptedException e) { - currentThread().processThreadInterrupts(); - } - catch (IllegalMonitorStateException e) { - return error(new IllegalMonitorState(e.getMessage())); - } - return NIL; - } - - @Override - public LispObject execute(LispObject object, LispObject timeout) - - { - long millis = sleepMillisPart(timeout); - int nanos = sleepNanosPart(timeout); - boolean zeroArgP = timeout.ZEROP() != NIL; + private static final class pf_object_wait extends Primitive { + pf_object_wait() { + super("object-wait", PACKAGE_THREADS, true); + } + @Override + public LispObject execute(LispObject object) { + try { + object.lockableInstance().wait(); + } catch (InterruptedException e) { + currentThread().processThreadInterrupts(); + } catch (IllegalMonitorStateException e) { + return error(new IllegalMonitorState(e.getMessage())); + } + return NIL; + } + + @Override + public LispObject execute(LispObject object, LispObject timeout) { + long millis = sleepMillisPart(timeout); + int nanos = sleepNanosPart(timeout); + boolean zeroArgP = timeout.ZEROP() != NIL; - try { - if (millis == 0 && nanos == 0) { - if (zeroArgP) { - object.lockableInstance().wait(0, 0); - } else { - object.lockableInstance().wait(0, 1); - } - } else { - object.lockableInstance().wait(millis, nanos); - } - } - catch (InterruptedException e) { - currentThread().processThreadInterrupts(); - } - catch (IllegalMonitorStateException e) { - return error(new IllegalMonitorState(e.getMessage())); + try { + if (millis == 0 && nanos == 0) { + if (zeroArgP) { + object.lockableInstance().wait(0, 0); + } else { + object.lockableInstance().wait(0, 1); } - return NIL; - } - }; - - @DocString(name="object-notify", args="object") - private static final Primitive OBJECT_NOTIFY = - new Primitive("object-notify", PACKAGE_THREADS, true, - "object") - { - @Override - public LispObject execute(LispObject object) - - { - try { - object.lockableInstance().notify(); - } - catch (IllegalMonitorStateException e) { - return error(new IllegalMonitorState(e.getMessage())); - } - return NIL; - } - }; - - @DocString(name="object-notify-all", args="object") - private static final Primitive OBJECT_NOTIFY_ALL = - new Primitive("object-notify-all", PACKAGE_THREADS, true) - { - @Override - public LispObject execute(LispObject object) - - { - try { - object.lockableInstance().notifyAll(); - } - catch (IllegalMonitorStateException e) { - return error(new IllegalMonitorState(e.getMessage())); - } - return NIL; + } else { + object.lockableInstance().wait(millis, nanos); + } + } catch (InterruptedException e) { + currentThread().processThreadInterrupts(); + } catch (IllegalMonitorStateException e) { + return error(new IllegalMonitorState(e.getMessage())); + } + return NIL; + } + }; + + public static final Primitive OBJECT_NOTIFY + = new pf_object_notify(); + @DocString(name="object-notify", + args="object", + doc="Wakes up a single thread that is waiting on OBJECT's monitor." ++ "\nIf any threads are waiting on this object, one of them is chosen to be" ++ " awakened. The choice is arbitrary and occurs at the discretion of the" ++ " implementation. A thread waits on an object's monitor by calling one" ++ " of the wait methods.") + private static final class pf_object_notify extends Primitive { + pf_object_notify() { + super("object-notify", PACKAGE_THREADS, true, "object"); + } + @Override + public LispObject execute(LispObject object) { + try { + object.lockableInstance().notify(); + } catch (IllegalMonitorStateException e) { + return error(new IllegalMonitorState(e.getMessage())); + } + return NIL; + } + }; + + public static final Primitive OBJECT_NOTIFY_ALL + = new pf_object_notify_all(); + @DocString(name="object-notify-all", + args="object", + doc="Wakes up all threads that are waiting on this OBJECT's monitor." ++ "\nA thread waits on an object's monitor by calling one of the wait methods.") + private static final class pf_object_notify_all extends Primitive { + pf_object_notify_all() { + super("object-notify-all", PACKAGE_THREADS, true); + } + @Override + public LispObject execute(LispObject object) { + try { + object.lockableInstance().notifyAll(); + } catch (IllegalMonitorStateException e) { + return error(new IllegalMonitorState(e.getMessage())); } + return NIL; + } }; - - } Modified: branches/1.3.1/src/org/armedbear/lisp/threads.lisp ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/threads.lisp Tue Apr 22 11:24:50 2014 (r14690) +++ branches/1.3.1/src/org/armedbear/lisp/threads.lisp Tue Apr 22 11:26:57 2014 (r14691) @@ -32,13 +32,11 @@ (in-package #:threads) - (export '(make-mailbox mailbox-send mailbox-empty-p mailbox-read mailbox-peek make-thread-lock with-thread-lock + current-thread yield make-mutex get-mutex release-mutex with-mutex)) - - ;; ;; MAKE-THREAD helper to establish restarts ;; @@ -147,3 +145,8 @@ (synchronized-on ,glock , at body)))) +(defun yield () + "A hint to the scheduler that the current thread is willing to yield its current use of a processor. The scheduler is free to ignore this hint. + +See java.lang.Thread.yield()." + (java:jcall "yield" (JAVA:jstatic "currentThread" "java.lang.Thread"))) From mevenson at common-lisp.net Tue Apr 22 11:27:53 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 22 Apr 2014 11:27:53 -0000 Subject: [Armedbear-cvs] r14692 - in branches/1.3.1: . src/org/armedbear/lisp Message-ID: <20140422112753.14109.85113@lisp.not.org> Author: mevenson Date: Tue Apr 22 11:27:52 2014 New Revision: 14692 Log: branches/1.3.1 now builds 1.3.1-rc-2. Modified: branches/1.3.1/abcl.rdf branches/1.3.1/src/org/armedbear/lisp/Version.java Modified: branches/1.3.1/abcl.rdf ============================================================================== --- branches/1.3.1/abcl.rdf Tue Apr 22 11:26:57 2014 (r14691) +++ branches/1.3.1/abcl.rdf Tue Apr 22 11:27:52 2014 (r14692) @@ -24,7 +24,7 @@ dc:modified "27-JAN-2014" ; dc:version "abcl-1.3.1" ; - abcl:release-candidate "rc-1" . + abcl:release-candidate "rc-2" . <> rdfs:seeAlso ; Modified: branches/1.3.1/src/org/armedbear/lisp/Version.java ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/Version.java Tue Apr 22 11:26:57 2014 (r14691) +++ branches/1.3.1/src/org/armedbear/lisp/Version.java Tue Apr 22 11:27:52 2014 (r14692) @@ -41,7 +41,7 @@ { private Version() {} - static final String baseVersion = "1.3.1-rc-1"; + static final String baseVersion = "1.3.1-rc-2"; static void init() { try { From mevenson at common-lisp.net Tue Apr 22 12:14:21 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 22 Apr 2014 12:14:21 -0000 Subject: [Armedbear-cvs] r14693 - trunk/abcl/contrib/asdf-jar Message-ID: <20140422121421.14875.56371@lisp.not.org> Author: mevenson Date: Tue Apr 22 12:14:21 2014 New Revision: 14693 Log: PREPARE-FOR-WAR packages ASDF systems for deployment in WAR archives. With archives packages under 'WEB-INF/resources', placing these jar files in the 'WEB-INF/lib' directory enables the Java Servlet ServletContext().getResourceAsStream() method to access their contents. Modified: trunk/abcl/contrib/asdf-jar/asdf-jar.asd trunk/abcl/contrib/asdf-jar/asdf-jar.lisp Modified: trunk/abcl/contrib/asdf-jar/asdf-jar.asd ============================================================================== --- trunk/abcl/contrib/asdf-jar/asdf-jar.asd Tue Apr 22 11:27:52 2014 (r14692) +++ trunk/abcl/contrib/asdf-jar/asdf-jar.asd Tue Apr 22 12:14:21 2014 (r14693) @@ -3,8 +3,8 @@ (defsystem :asdf-jar :author "Mark Evenson" - :version "0.2.1" - :description "<> asdf:defsystem " + :version "0.3.0" + :description "<> asdf:defsystem " :components ((:module base :pathname "" :components ((:file "asdf-jar") Modified: trunk/abcl/contrib/asdf-jar/asdf-jar.lisp ============================================================================== --- trunk/abcl/contrib/asdf-jar/asdf-jar.lisp Tue Apr 22 11:27:52 2014 (r14692) +++ trunk/abcl/contrib/asdf-jar/asdf-jar.lisp Tue Apr 22 12:14:21 2014 (r14693) @@ -5,17 +5,20 @@ (defpackage #:asdf-jar (:use :cl) (:export #:package + ;; "Si vis pacem, para bellum" -- Publius Flavius Vegetius Renatus + #:prepare-for-war #:add-to-asdf)) -(in-package :asdf-jar) +(in-package #:asdf-jar) (defvar *debug* nil) -(defun package (system - &key (out #p"/var/tmp/") - (recursive t) ; whether to package dependencies - (force nil) ; whether to force ASDF compilation - (verbose t)) +(defun package (system &key + (out #p"/var/tmp/") + (recursive t) ; whether to package dependencies + (force nil) ; whether to force ASDF compilation + (root nil) + (verbose t)) "Compile and package the asdf SYSTEM in a jar. When RECURSIVE is true (the default), recursively add all asdf @@ -31,11 +34,13 @@ (setf system (asdf:find-system system))) (let* ((name (slot-value system 'asdf::name)) - (version - (handler-case (slot-value system 'asdf:version) - (unbound-slot () "unknown"))) + (version (let ((v (slot-value system 'asdf:version))) + (when v + v))) (package-jar-name - (format nil "~A~A-~A" name (if recursive "-all" "") version)) + (format nil "~A~A~A" name (if recursive "-all" "") (if version + (format nil "-~A" version) + ""))) (package-jar (make-pathname :name package-jar-name :type "jar" @@ -57,12 +62,20 @@ (let ((base (slot-value system 'asdf::absolute-pathname)) (name (slot-value system 'asdf::name)) (asdf (slot-value system 'asdf::source-file))) - (setf (gethash asdf mapping) (archive-relative-path base name asdf)) + (setf (gethash asdf mapping) (let ((relative-path (archive-relative-path + base name asdf))) + (if root + (merge-pathnames + relative-path + (make-pathname :directory root)) + relative-path))) (loop :for component :in (all-files system) :for source = (slot-value component 'asdf::absolute-pathname) :for source-entry = (archive-relative-path base name source) :do (setf (gethash source mapping) - source-entry) + (if root + (merge-pathnames source-entry (make-pathname :directory root)) + source-entry)) :do (when *debug* (format verbose "~&~A~& => ~A" source source-entry)) :when (and (typep component 'asdf::source-file) @@ -72,8 +85,10 @@ :defaults (asdf:apply-output-translations source) :type "abcl")) (output-entry - (make-pathname :defaults source-entry - :type "abcl"))) + (make-pathname :defaults source-entry + :type "abcl" + :directory (append root + (rest (pathname-directory source-entry)))))) (when *debug* (format verbose "~&~A~& => ~A" output output-entry)) (setf (gethash output mapping) @@ -140,4 +155,19 @@ `(:output-translations (,(merge-pathnames "/**/*.*" jar)) :inherit-configuration)))) +(defun prepare-for-war (system &key + (out #p"/var/tmp/") + (recursive nil) ; whether to package dependencies + (force nil) ; whether to force ASDF compilation + (root (list :relative "WEB-INF" "resources")) + (verbose t)) + "Package named asdf SYSTEM for deployment in a Java Servlet container war file. + +c.f. PACKAGE for further options." + + (warn "Unaudited. Please see your local Honey dealer.") + (package system :out out :recursive recursive :force force :verbose verbose + :root root)) + + (provide :asdf-jar) From mevenson at common-lisp.net Fri Apr 25 07:55:54 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 25 Apr 2014 07:55:54 -0000 Subject: [Armedbear-cvs] r14694 - in trunk/abcl: . src/org/armedbear/lisp test/lisp/abcl Message-ID: <20140425075554.15061.68636@lisp.not.org> Author: mevenson Date: Fri Apr 25 07:55:53 2014 New Revision: 14694 Log: Convert Lisp truth values to Java equivalents in JCALL/JSTATIC. We now convert CL:T and CL:NIL to JAVA:+TRUE+ and JAVA:+FALSE+ respectively when invoking JVM methods through the JAVA package, establishing the "natural" equivalence for boolean truth values. This may break some existing usage in that previously CL:NIL was converted to a Java 'null' reference. Users now need to specify JAVA:+NULL+ explicitly when desiring to pass 'null' Java references as an argument in invoking JVM methods. Addresses (#84) and (#339). Added: trunk/abcl/test/lisp/abcl/java.lisp Modified: trunk/abcl/abcl.asd trunk/abcl/src/org/armedbear/lisp/Java.java trunk/abcl/test/lisp/abcl/java-tests.lisp Modified: trunk/abcl/abcl.asd ============================================================================== --- trunk/abcl/abcl.asd Tue Apr 22 12:14:21 2014 (r14693) +++ trunk/abcl/abcl.asd Fri Apr 25 07:55:53 2014 (r14694) @@ -17,7 +17,7 @@ ;;; We guard with #+abcl for tests that other Lisps cannot load. This ;;; could be possibly be done at finer granularity in the files ;;; themselves. -(defsystem :abcl-test-lisp :version "1.2" :components +(defsystem :abcl-test-lisp :version "1.3.0" :components ((:module abcl-rt :pathname "test/lisp/abcl/" :serial t :components ((:file "rt-package") @@ -59,6 +59,8 @@ (:file "weak-hash-tables") #+abcl (:file "zip") + #+abcl + (:file "java") #+abcl (:file "pathname-tests" :depends-on ("utilities")) Modified: trunk/abcl/src/org/armedbear/lisp/Java.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Java.java Tue Apr 22 12:14:21 2014 (r14693) +++ trunk/abcl/src/org/armedbear/lisp/Java.java Fri Apr 25 07:55:53 2014 (r14694) @@ -457,16 +457,20 @@ if (m == null) error(new LispError("no such method")); } - } else + } else { type_error(methodRef, Symbol.STRING); + } Object[] methodArgs = new Object[args.length-2]; Class[] argTypes = m.getParameterTypes(); for (int i = 2; i < args.length; i++) { LispObject arg = args[i]; - if (arg == NIL) - methodArgs[i-2] = null; - else - methodArgs[i-2] = arg.javaInstance(argTypes[i-2]); + if (arg.equals(NIL)) { + methodArgs[i-2] = false; + } else if (arg.equals(T)) { + methodArgs[i-2] = true; + } else { + methodArgs[i-2] = arg.javaInstance(argTypes[i-2]); + } } m.setAccessible(true); Object result = m.invoke(null, methodArgs); @@ -562,10 +566,12 @@ Object[] initargs = new Object[args.length-1]; for (int i = 1; i < args.length; i++) { LispObject arg = args[i]; - if (arg == NIL) - initargs[i-1] = null; - else { - initargs[i-1] = arg.javaInstance(argTypes[i-1]); + if (arg.equals(NIL)) { + initargs[i-1] = false ; + } else if (arg.equals(T)) { + initargs[i-1] = true; + } else { + initargs[i-1] = arg.javaInstance(argTypes[i-1]); } } return JavaObject.getInstance(constructor.newInstance(initargs)); @@ -878,11 +884,14 @@ } methodArgs = new Object[argTypes.length]; for (int i = 2; i < args.length; i++) { - LispObject arg = args[i]; - if (arg == NIL) - methodArgs[i-2] = null; - else - methodArgs[i-2] = arg.javaInstance(argTypes[i-2]); + LispObject arg = args[i]; + if (arg.equals(NIL)) { + methodArgs[i-2] = false; + } else if (arg.equals(T)) { + methodArgs[i-2] = true; + } else { + methodArgs[i-2] = arg.javaInstance(argTypes[i-2]); + } } if (!method.isAccessible()) { // Possible for static member classes: see #229 @@ -923,12 +932,14 @@ int argCount = args.length - offs; Object[] javaArgs = new Object[argCount]; for (int i = 0; i < argCount; ++i) { - Object x = args[i + offs]; - if (x == NIL) { - javaArgs[i] = null; - } else { - javaArgs[i] = ((LispObject) x).javaInstance(); - } + Object x = args[i + offs]; + if (x.equals(NIL)) { + javaArgs[i] = false; + } else if (x.equals(T)) { + javaArgs[i] = true; + } else { + javaArgs[i] = ((LispObject) x).javaInstance(); + } } return javaArgs; } Modified: trunk/abcl/test/lisp/abcl/java-tests.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/java-tests.lisp Tue Apr 22 12:14:21 2014 (r14693) +++ trunk/abcl/test/lisp/abcl/java-tests.lisp Fri Apr 25 07:55:53 2014 (r14694) @@ -446,3 +446,4 @@ ;;#+allegro ;;(jlinker-end) + Added: trunk/abcl/test/lisp/abcl/java.lisp ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ trunk/abcl/test/lisp/abcl/java.lisp Fri Apr 25 07:55:53 2014 (r14694) @@ -0,0 +1,18 @@ +(in-package #:abcl.test.lisp) + +(deftest java.truth.1 + (let ((java.lang.boolean.compare + (java:jmethod "java.lang.Boolean" "compare" "boolean" "boolean")) + (java.lang.boolean.equals + (java:jmethod "java.lang.Boolean" "equals" "java.lang.Object"))) + (values + (java:jstatic java.lang.Boolean.compare "java.lang.Boolean" java:+true+ t) + (java:jstatic java.lang.Boolean.compare "java.lang.Boolean" java:+false+ nil) + (java:jcall java.lang.Boolean.equals java:+true+ t) + (java:jcall java.lang.Boolean.equals java:+false+ nil) + (java:jstatic java.lang.Boolean.compare "java.lang.Boolean" java:+false+ t) + (java:jstatic java.lang.Boolean.compare "java.lang.Boolean" java:+false+ t) + (java:jcall java.lang.Boolean.equals java:+true+ nil) + (java:jcall java.lang.Boolean.equals java:+false+ t))) + 0 0 t t -1 -1 nil nil) + From mevenson at common-lisp.net Fri Apr 25 15:39:08 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 25 Apr 2014 15:39:08 -0000 Subject: [Armedbear-cvs] r14695 - trunk/abcl/contrib/asdf-jar Message-ID: <20140425153908.32514.38548@lisp.not.org> Author: mevenson Date: Fri Apr 25 15:39:07 2014 New Revision: 14695 Log: Enable PACKAGE-FOR-WAR to work by reading the servlet spec and disabling WARN. Modified: trunk/abcl/contrib/asdf-jar/asdf-jar.lisp Modified: trunk/abcl/contrib/asdf-jar/asdf-jar.lisp ============================================================================== --- trunk/abcl/contrib/asdf-jar/asdf-jar.lisp Fri Apr 25 07:55:53 2014 (r14694) +++ trunk/abcl/contrib/asdf-jar/asdf-jar.lisp Fri Apr 25 15:39:07 2014 (r14695) @@ -159,13 +159,12 @@ (out #p"/var/tmp/") (recursive nil) ; whether to package dependencies (force nil) ; whether to force ASDF compilation - (root (list :relative "WEB-INF" "resources")) + (root (list :relative "META-INF" "resources")) (verbose t)) "Package named asdf SYSTEM for deployment in a Java Servlet container war file. c.f. PACKAGE for further options." - (warn "Unaudited. Please see your local Honey dealer.") (package system :out out :recursive recursive :force force :verbose verbose :root root)) From mevenson at common-lisp.net Sun Apr 27 07:46:10 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sun, 27 Apr 2014 07:46:10 -0000 Subject: [Armedbear-cvs] r14696 - trunk/abcl/contrib/abcl-asdf Message-ID: <20140427074610.18497.45928@lisp.not.org> Author: mevenson Date: Sun Apr 27 07:46:08 2014 New Revision: 14696 Log: Patch the Maven locator code to probe "/usr/local/maven/lib/". >From a patch for OpenBSD provided by Timo Myyr?. Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd ============================================================================== --- trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Fri Apr 25 15:39:07 2014 (r14695) +++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Sun Apr 27 07:46:08 2014 (r14696) @@ -2,8 +2,8 @@ (asdf:defsystem :abcl-asdf :author "Mark Evenson" - :version "1.3.0" - :description "<> asdf:defsystem " + :version "1.3.1" + :description "<> asdf:defsystem " :depends-on (jss) :components ((:module packages :pathname "" Modified: trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp ============================================================================== --- trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Fri Apr 25 15:39:07 2014 (r14695) +++ trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Sun Apr 27 07:46:08 2014 (r14696) @@ -107,14 +107,16 @@ (warn "Unable to locate Maven executable to find Maven Aether adaptors.")) (defun find-mvn-libs () - (let ((mvn (find-mvn))) - (unless mvn - (warn "Failed to find Maven3 libraries.") - (return-from find-mvn-libs nil)) - (truename (make-pathname - :defaults (merge-pathnames "../lib/" mvn) - :name nil :type nil)))) - + (unless (find-mvn) + (warn "Failed to find Maven executable to determine Aether library location.")) + (some + (lambda (d) + (when (directory (merge-pathnames "maven-core-*.jar" d)) + (truename d))) + (list (make-pathname :defaults (merge-pathnames "../lib/" (find-mvn)) + :name nil :type nil) + #p"/usr/local/maven/lib/"))) ;; OpenBSD location suggested by Timo Myyr? + (defparameter *mvn-libs-directory* nil "Location of 'maven-core-3..

.jar', 'maven-embedder-3..

.jar' etc.") @@ -158,7 +160,11 @@ (defparameter *init* nil) (defun init (&optional &key (force nil)) - "Run the initialization strategy to bootstrap a Maven dependency node." + "Run the initialization strategy to bootstrap a Maven dependency node. + +Set *MVN-LIBS-DIRECTORY* to an explicit value before running this +function in order to bypass the dynamic introspection of the location +of the mvn executable with an explicit value." (unless (or force *mvn-libs-directory*) (setf *mvn-libs-directory* (find-mvn-libs))) (unless (and *mvn-libs-directory* From mevenson at common-lisp.net Sun Apr 27 14:11:38 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sun, 27 Apr 2014 14:11:38 -0000 Subject: [Armedbear-cvs] r14697 - branches/1.3.1/contrib/asdf-jar Message-ID: <20140427141138.29677.81265@lisp.not.org> Author: mevenson Date: Sun Apr 27 14:11:37 2014 New Revision: 14697 Log: Backport r14693: PREPARE-FOR-WAR packages ASDF systems for deployment in WAR archives. With archives packages under 'WEB-INF/resources', placing these jar files in the 'WEB-INF/lib' directory enables the Java Servlet ServletContext().getResourceAsStream() method to access their contents. Modified: branches/1.3.1/contrib/asdf-jar/asdf-jar.asd branches/1.3.1/contrib/asdf-jar/asdf-jar.lisp Modified: branches/1.3.1/contrib/asdf-jar/asdf-jar.asd ============================================================================== --- branches/1.3.1/contrib/asdf-jar/asdf-jar.asd Sun Apr 27 07:46:08 2014 (r14696) +++ branches/1.3.1/contrib/asdf-jar/asdf-jar.asd Sun Apr 27 14:11:37 2014 (r14697) @@ -3,8 +3,8 @@ (defsystem :asdf-jar :author "Mark Evenson" - :version "0.2.1" - :description "<> asdf:defsystem " + :version "0.3.0" + :description "<> asdf:defsystem " :components ((:module base :pathname "" :components ((:file "asdf-jar") Modified: branches/1.3.1/contrib/asdf-jar/asdf-jar.lisp ============================================================================== --- branches/1.3.1/contrib/asdf-jar/asdf-jar.lisp Sun Apr 27 07:46:08 2014 (r14696) +++ branches/1.3.1/contrib/asdf-jar/asdf-jar.lisp Sun Apr 27 14:11:37 2014 (r14697) @@ -5,17 +5,20 @@ (defpackage #:asdf-jar (:use :cl) (:export #:package + ;; "Si vis pacem, para bellum" -- Publius Flavius Vegetius Renatus + #:prepare-for-war #:add-to-asdf)) -(in-package :asdf-jar) +(in-package #:asdf-jar) (defvar *debug* nil) -(defun package (system - &key (out #p"/var/tmp/") - (recursive t) ; whether to package dependencies - (force nil) ; whether to force ASDF compilation - (verbose t)) +(defun package (system &key + (out #p"/var/tmp/") + (recursive t) ; whether to package dependencies + (force nil) ; whether to force ASDF compilation + (root nil) + (verbose t)) "Compile and package the asdf SYSTEM in a jar. When RECURSIVE is true (the default), recursively add all asdf @@ -31,11 +34,13 @@ (setf system (asdf:find-system system))) (let* ((name (slot-value system 'asdf::name)) - (version - (handler-case (slot-value system 'asdf:version) - (unbound-slot () "unknown"))) + (version (let ((v (slot-value system 'asdf:version))) + (when v + v))) (package-jar-name - (format nil "~A~A-~A" name (if recursive "-all" "") version)) + (format nil "~A~A~A" name (if recursive "-all" "") (if version + (format nil "-~A" version) + ""))) (package-jar (make-pathname :name package-jar-name :type "jar" @@ -57,12 +62,20 @@ (let ((base (slot-value system 'asdf::absolute-pathname)) (name (slot-value system 'asdf::name)) (asdf (slot-value system 'asdf::source-file))) - (setf (gethash asdf mapping) (archive-relative-path base name asdf)) + (setf (gethash asdf mapping) (let ((relative-path (archive-relative-path + base name asdf))) + (if root + (merge-pathnames + relative-path + (make-pathname :directory root)) + relative-path))) (loop :for component :in (all-files system) :for source = (slot-value component 'asdf::absolute-pathname) :for source-entry = (archive-relative-path base name source) :do (setf (gethash source mapping) - source-entry) + (if root + (merge-pathnames source-entry (make-pathname :directory root)) + source-entry)) :do (when *debug* (format verbose "~&~A~& => ~A" source source-entry)) :when (and (typep component 'asdf::source-file) @@ -72,8 +85,10 @@ :defaults (asdf:apply-output-translations source) :type "abcl")) (output-entry - (make-pathname :defaults source-entry - :type "abcl"))) + (make-pathname :defaults source-entry + :type "abcl" + :directory (append root + (rest (pathname-directory source-entry)))))) (when *debug* (format verbose "~&~A~& => ~A" output output-entry)) (setf (gethash output mapping) @@ -140,4 +155,19 @@ `(:output-translations (,(merge-pathnames "/**/*.*" jar)) :inherit-configuration)))) +(defun prepare-for-war (system &key + (out #p"/var/tmp/") + (recursive nil) ; whether to package dependencies + (force nil) ; whether to force ASDF compilation + (root (list :relative "WEB-INF" "resources")) + (verbose t)) + "Package named asdf SYSTEM for deployment in a Java Servlet container war file. + +c.f. PACKAGE for further options." + + (warn "Unaudited. Please see your local Honey dealer.") + (package system :out out :recursive recursive :force force :verbose verbose + :root root)) + + (provide :asdf-jar) From mevenson at common-lisp.net Sun Apr 27 14:12:39 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sun, 27 Apr 2014 14:12:39 -0000 Subject: [Armedbear-cvs] r14698 - in branches/1.3.1: . src/org/armedbear/lisp test/lisp/abcl Message-ID: <20140427141239.29757.11753@lisp.not.org> Author: mevenson Date: Sun Apr 27 14:12:38 2014 New Revision: 14698 Log: Backport r14694: Convert Lisp truth values to Java equivalents in JCALL/JSTATIC. We now convert CL:T and CL:NIL to JAVA:+TRUE+ and JAVA:+FALSE+ respectively when invoking JVM methods through the JAVA package, establishing the "natural" equivalence for boolean truth values. This may break some existing usage in that previously CL:NIL was converted to a Java 'null' reference. Users now need to specify JAVA:+NULL+ explicitly when desiring to pass 'null' Java references as an argument in invoking JVM methods. Addresses (#84) and (#339). Added: branches/1.3.1/test/lisp/abcl/java.lisp - copied unchanged from r14694, trunk/abcl/test/lisp/abcl/java.lisp Modified: branches/1.3.1/abcl.asd branches/1.3.1/src/org/armedbear/lisp/Java.java branches/1.3.1/test/lisp/abcl/java-tests.lisp Modified: branches/1.3.1/abcl.asd ============================================================================== --- branches/1.3.1/abcl.asd Sun Apr 27 14:11:37 2014 (r14697) +++ branches/1.3.1/abcl.asd Sun Apr 27 14:12:38 2014 (r14698) @@ -17,7 +17,7 @@ ;;; We guard with #+abcl for tests that other Lisps cannot load. This ;;; could be possibly be done at finer granularity in the files ;;; themselves. -(defsystem :abcl-test-lisp :version "1.2" :components +(defsystem :abcl-test-lisp :version "1.3.0" :components ((:module abcl-rt :pathname "test/lisp/abcl/" :serial t :components ((:file "rt-package") @@ -59,6 +59,8 @@ (:file "weak-hash-tables") #+abcl (:file "zip") + #+abcl + (:file "java") #+abcl (:file "pathname-tests" :depends-on ("utilities")) Modified: branches/1.3.1/src/org/armedbear/lisp/Java.java ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/Java.java Sun Apr 27 14:11:37 2014 (r14697) +++ branches/1.3.1/src/org/armedbear/lisp/Java.java Sun Apr 27 14:12:38 2014 (r14698) @@ -457,16 +457,20 @@ if (m == null) error(new LispError("no such method")); } - } else + } else { type_error(methodRef, Symbol.STRING); + } Object[] methodArgs = new Object[args.length-2]; Class[] argTypes = m.getParameterTypes(); for (int i = 2; i < args.length; i++) { LispObject arg = args[i]; - if (arg == NIL) - methodArgs[i-2] = null; - else - methodArgs[i-2] = arg.javaInstance(argTypes[i-2]); + if (arg.equals(NIL)) { + methodArgs[i-2] = false; + } else if (arg.equals(T)) { + methodArgs[i-2] = true; + } else { + methodArgs[i-2] = arg.javaInstance(argTypes[i-2]); + } } m.setAccessible(true); Object result = m.invoke(null, methodArgs); @@ -562,10 +566,12 @@ Object[] initargs = new Object[args.length-1]; for (int i = 1; i < args.length; i++) { LispObject arg = args[i]; - if (arg == NIL) - initargs[i-1] = null; - else { - initargs[i-1] = arg.javaInstance(argTypes[i-1]); + if (arg.equals(NIL)) { + initargs[i-1] = false ; + } else if (arg.equals(T)) { + initargs[i-1] = true; + } else { + initargs[i-1] = arg.javaInstance(argTypes[i-1]); } } return JavaObject.getInstance(constructor.newInstance(initargs)); @@ -878,11 +884,14 @@ } methodArgs = new Object[argTypes.length]; for (int i = 2; i < args.length; i++) { - LispObject arg = args[i]; - if (arg == NIL) - methodArgs[i-2] = null; - else - methodArgs[i-2] = arg.javaInstance(argTypes[i-2]); + LispObject arg = args[i]; + if (arg.equals(NIL)) { + methodArgs[i-2] = false; + } else if (arg.equals(T)) { + methodArgs[i-2] = true; + } else { + methodArgs[i-2] = arg.javaInstance(argTypes[i-2]); + } } if (!method.isAccessible()) { // Possible for static member classes: see #229 @@ -923,12 +932,14 @@ int argCount = args.length - offs; Object[] javaArgs = new Object[argCount]; for (int i = 0; i < argCount; ++i) { - Object x = args[i + offs]; - if (x == NIL) { - javaArgs[i] = null; - } else { - javaArgs[i] = ((LispObject) x).javaInstance(); - } + Object x = args[i + offs]; + if (x.equals(NIL)) { + javaArgs[i] = false; + } else if (x.equals(T)) { + javaArgs[i] = true; + } else { + javaArgs[i] = ((LispObject) x).javaInstance(); + } } return javaArgs; } Modified: branches/1.3.1/test/lisp/abcl/java-tests.lisp ============================================================================== --- branches/1.3.1/test/lisp/abcl/java-tests.lisp Sun Apr 27 14:11:37 2014 (r14697) +++ branches/1.3.1/test/lisp/abcl/java-tests.lisp Sun Apr 27 14:12:38 2014 (r14698) @@ -446,3 +446,4 @@ ;;#+allegro ;;(jlinker-end) + Copied: branches/1.3.1/test/lisp/abcl/java.lisp (from r14694, trunk/abcl/test/lisp/abcl/java.lisp) ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ branches/1.3.1/test/lisp/abcl/java.lisp Sun Apr 27 14:12:38 2014 (r14698, copy of r14694, trunk/abcl/test/lisp/abcl/java.lisp) @@ -0,0 +1,18 @@ +(in-package #:abcl.test.lisp) + +(deftest java.truth.1 + (let ((java.lang.boolean.compare + (java:jmethod "java.lang.Boolean" "compare" "boolean" "boolean")) + (java.lang.boolean.equals + (java:jmethod "java.lang.Boolean" "equals" "java.lang.Object"))) + (values + (java:jstatic java.lang.Boolean.compare "java.lang.Boolean" java:+true+ t) + (java:jstatic java.lang.Boolean.compare "java.lang.Boolean" java:+false+ nil) + (java:jcall java.lang.Boolean.equals java:+true+ t) + (java:jcall java.lang.Boolean.equals java:+false+ nil) + (java:jstatic java.lang.Boolean.compare "java.lang.Boolean" java:+false+ t) + (java:jstatic java.lang.Boolean.compare "java.lang.Boolean" java:+false+ t) + (java:jcall java.lang.Boolean.equals java:+true+ nil) + (java:jcall java.lang.Boolean.equals java:+false+ t))) + 0 0 t t -1 -1 nil nil) + From mevenson at common-lisp.net Sun Apr 27 14:16:03 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sun, 27 Apr 2014 14:16:03 -0000 Subject: [Armedbear-cvs] r14699 - branches/1.3.1/contrib/asdf-jar Message-ID: <20140427141603.29901.51539@lisp.not.org> Author: mevenson Date: Sun Apr 27 14:16:02 2014 New Revision: 14699 Log: Backport r14695: Enable PACKAGE-FOR-WAR to work by reading the servlet spec and disabling WARN. Modified: branches/1.3.1/contrib/asdf-jar/asdf-jar.lisp Modified: branches/1.3.1/contrib/asdf-jar/asdf-jar.lisp ============================================================================== --- branches/1.3.1/contrib/asdf-jar/asdf-jar.lisp Sun Apr 27 14:12:38 2014 (r14698) +++ branches/1.3.1/contrib/asdf-jar/asdf-jar.lisp Sun Apr 27 14:16:02 2014 (r14699) @@ -159,13 +159,12 @@ (out #p"/var/tmp/") (recursive nil) ; whether to package dependencies (force nil) ; whether to force ASDF compilation - (root (list :relative "WEB-INF" "resources")) + (root (list :relative "META-INF" "resources")) (verbose t)) "Package named asdf SYSTEM for deployment in a Java Servlet container war file. c.f. PACKAGE for further options." - (warn "Unaudited. Please see your local Honey dealer.") (package system :out out :recursive recursive :force force :verbose verbose :root root)) From mevenson at common-lisp.net Sun Apr 27 14:17:39 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sun, 27 Apr 2014 14:17:39 -0000 Subject: [Armedbear-cvs] r14700 - branches/1.3.1/contrib/abcl-asdf Message-ID: <20140427141739.29999.72706@lisp.not.org> Author: mevenson Date: Sun Apr 27 14:17:38 2014 New Revision: 14700 Log: Backport r14696: Patch the Maven locator code to probe "/usr/local/maven/lib/". >From a patch for OpenBSD provided by Timo Myyr?. Modified: branches/1.3.1/contrib/abcl-asdf/abcl-asdf.asd branches/1.3.1/contrib/abcl-asdf/maven-embedder.lisp Modified: branches/1.3.1/contrib/abcl-asdf/abcl-asdf.asd ============================================================================== --- branches/1.3.1/contrib/abcl-asdf/abcl-asdf.asd Sun Apr 27 14:16:02 2014 (r14699) +++ branches/1.3.1/contrib/abcl-asdf/abcl-asdf.asd Sun Apr 27 14:17:38 2014 (r14700) @@ -2,8 +2,8 @@ (asdf:defsystem :abcl-asdf :author "Mark Evenson" - :version "1.3.0" - :description "<> asdf:defsystem " + :version "1.3.1" + :description "<> asdf:defsystem " :depends-on (jss) :components ((:module packages :pathname "" Modified: branches/1.3.1/contrib/abcl-asdf/maven-embedder.lisp ============================================================================== --- branches/1.3.1/contrib/abcl-asdf/maven-embedder.lisp Sun Apr 27 14:16:02 2014 (r14699) +++ branches/1.3.1/contrib/abcl-asdf/maven-embedder.lisp Sun Apr 27 14:17:38 2014 (r14700) @@ -107,14 +107,16 @@ (warn "Unable to locate Maven executable to find Maven Aether adaptors.")) (defun find-mvn-libs () - (let ((mvn (find-mvn))) - (unless mvn - (warn "Failed to find Maven3 libraries.") - (return-from find-mvn-libs nil)) - (truename (make-pathname - :defaults (merge-pathnames "../lib/" mvn) - :name nil :type nil)))) - + (unless (find-mvn) + (warn "Failed to find Maven executable to determine Aether library location.")) + (some + (lambda (d) + (when (directory (merge-pathnames "maven-core-*.jar" d)) + (truename d))) + (list (make-pathname :defaults (merge-pathnames "../lib/" (find-mvn)) + :name nil :type nil) + #p"/usr/local/maven/lib/"))) ;; OpenBSD location suggested by Timo Myyr? + (defparameter *mvn-libs-directory* nil "Location of 'maven-core-3..

.jar', 'maven-embedder-3..

.jar' etc.") @@ -158,7 +160,11 @@ (defparameter *init* nil) (defun init (&optional &key (force nil)) - "Run the initialization strategy to bootstrap a Maven dependency node." + "Run the initialization strategy to bootstrap a Maven dependency node. + +Set *MVN-LIBS-DIRECTORY* to an explicit value before running this +function in order to bypass the dynamic introspection of the location +of the mvn executable with an explicit value." (unless (or force *mvn-libs-directory*) (setf *mvn-libs-directory* (find-mvn-libs))) (unless (and *mvn-libs-directory* From mevenson at common-lisp.net Sun Apr 27 14:24:34 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sun, 27 Apr 2014 14:24:34 -0000 Subject: [Armedbear-cvs] r14701 - in branches/1.3.1: . src/org/armedbear/lisp Message-ID: <20140427142434.30154.5592@lisp.not.org> Author: mevenson Date: Sun Apr 27 14:24:33 2014 New Revision: 14701 Log: branches/1.3.1 now builds abcl-1.3.1-rc-3. Modified: branches/1.3.1/abcl.rdf branches/1.3.1/src/org/armedbear/lisp/Version.java Modified: branches/1.3.1/abcl.rdf ============================================================================== --- branches/1.3.1/abcl.rdf Sun Apr 27 14:17:38 2014 (r14700) +++ branches/1.3.1/abcl.rdf Sun Apr 27 14:24:33 2014 (r14701) @@ -18,13 +18,13 @@ @prefix dc: . <> abcl:branch ; - dc:identifier ; + dc:identifier ; doap:language "Common Lisp" ; dc:created "01-JAN-2004" ; dc:modified "27-JAN-2014" ; dc:version "abcl-1.3.1" ; - abcl:release-candidate "rc-2" . + abcl:release-candidate "rc-3" . <> rdfs:seeAlso ; @@ -95,9 +95,8 @@ rdf:_2 ; rdf:_3 ; rdf:_3 ; - rdf:_4 - + rdf:_4 ] ; ] . @@ -134,6 +133,8 @@ rdf:_9 abcl:quicklisp-abcl ; ] . +abcl:asdf dc:version "3.1.0.103" . + abcl:asdf-install dc:version "3.0.1.94" . abcl:abcl-contrib @@ -143,7 +144,6 @@ rdfs:seeAlso . abcl:abcl-asdf - rdfs:seeAlso . abcl:asdf-jar Modified: branches/1.3.1/src/org/armedbear/lisp/Version.java ============================================================================== --- branches/1.3.1/src/org/armedbear/lisp/Version.java Sun Apr 27 14:17:38 2014 (r14700) +++ branches/1.3.1/src/org/armedbear/lisp/Version.java Sun Apr 27 14:24:33 2014 (r14701) @@ -41,7 +41,7 @@ { private Version() {} - static final String baseVersion = "1.3.1-rc-2"; + static final String baseVersion = "1.3.1-rc-3"; static void init() { try { From mevenson at common-lisp.net Tue Apr 29 21:01:17 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 29 Apr 2014 21:01:17 -0000 Subject: [Armedbear-cvs] r14703 - tags/1.3.1 Message-ID: <20140429210117.12653.36025@lisp.not.org> Author: mevenson Date: Tue Apr 29 21:01:16 2014 New Revision: 14703 Log: Tag abcl-1.3.1. Added: tags/1.3.1/ - copied from r14702, branches/1.3.1/ From mevenson at common-lisp.net Tue Apr 29 21:01:55 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 29 Apr 2014 21:01:55 -0000 Subject: [Armedbear-cvs] r14704 - branches/1.3.2 Message-ID: <20140429210155.12699.91483@lisp.not.org> Author: mevenson Date: Tue Apr 29 21:01:55 2014 New Revision: 14704 Log: Branch 1.3.2 (if needed). Added: branches/1.3.2/ - copied from r14703, tags/1.3.1/ From mevenson at common-lisp.net Tue Apr 29 21:06:53 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 29 Apr 2014 21:06:53 -0000 Subject: [Armedbear-cvs] r14705 - public_html/releases/1.3.1 Message-ID: <20140429210653.12832.96853@lisp.not.org> Author: mevenson Date: Tue Apr 29 21:06:52 2014 New Revision: 14705 Log: abcl-1.3.1 binaries. Added: public_html/releases/1.3.1/ public_html/releases/1.3.1/abcl-1.3.1.jar (contents, props changed) public_html/releases/1.3.1/abcl-bin-1.3.1.tar.gz (contents, props changed) public_html/releases/1.3.1/abcl-bin-1.3.1.zip (contents, props changed) public_html/releases/1.3.1/abcl-contrib-1.3.1.jar (contents, props changed) public_html/releases/1.3.1/abcl-contrib.jar (contents, props changed) public_html/releases/1.3.1/abcl-src-1.3.1.tar.gz (contents, props changed) public_html/releases/1.3.1/abcl-src-1.3.1.zip (contents, props changed) public_html/releases/1.3.1/abcl.jar (contents, props changed) Added: public_html/releases/1.3.1/abcl-1.3.1.jar ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-bin-1.3.1.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-bin-1.3.1.zip ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-contrib-1.3.1.jar ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-contrib.jar ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-src-1.3.1.tar.gz ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-src-1.3.1.zip ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl.jar ============================================================================== Binary file. No diff available. From mevenson at common-lisp.net Tue Apr 29 21:10:20 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 29 Apr 2014 21:10:20 -0000 Subject: [Armedbear-cvs] r14706 - public_html/releases/1.3.1 Message-ID: <20140429211020.12997.33392@lisp.not.org> Author: mevenson Date: Tue Apr 29 21:10:19 2014 New Revision: 14706 Log: Add a 'fresh' copy of the fine Manual. Added: public_html/releases/1.3.1/abcl-20140430a.pdf (contents, props changed) Added: public_html/releases/1.3.1/abcl-20140430a.pdf ============================================================================== Binary file. No diff available. From mevenson at common-lisp.net Tue Apr 29 23:36:19 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Tue, 29 Apr 2014 23:36:19 -0000 Subject: [Armedbear-cvs] r14707 - public_html Message-ID: <20140429233619.18580.98696@lisp.not.org> Author: mevenson Date: Tue Apr 29 23:36:19 2014 New Revision: 14707 Log: Release notes for abcl-1.3.1 published. Added: public_html/release-notes-1.3.1.shtml Modified: public_html/left-menu Modified: public_html/left-menu ============================================================================== --- public_html/left-menu Tue Apr 29 21:10:19 2014 (r14706) +++ public_html/left-menu Tue Apr 29 23:36:19 2014 (r14707) @@ -11,7 +11,7 @@ Testimonials

  • - 1.3.0 Release notes + 1.3.1 Release notes
  • Paid support Added: public_html/release-notes-1.3.1.shtml ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ public_html/release-notes-1.3.1.shtml Tue Apr 29 23:36:19 2014 (r14707) @@ -0,0 +1,112 @@ + + + + + Release Notes for ABCL 1.3.1 + + + + + + + +
    +

    Release Notes for ABCL 1.3.1

    +
    + + + +
    + +

    + abcl-1.3.1 is a maintenance release. +

    + +
    +
+http://abcl.org/svn/tags/1.3.1/
+30-APR-2014
+
+## Fixed
+
+*  The underlying Java Function Interface (JFI) now converts CL:T and
+   CL:NIL to JAVA:+TRUE+ and JAVA:+FALSE+.  Users who wish to
+   reference a JAVA:+NULL+ should do so explicitly.
+   
+
+*  Make JCALL work in more places.  Thanks to Olof-Joachim Frahm.
+   
+
+*  Interpolate CL:SLEEP and THREADS:OBJECT-WAIT for timeouts below the
+   Planck timer ("1ns") to a nanosecond.
+   
+
+*  Update to ASDF 3.1.0.103.
+   
+
+   Fixes loading of Ironclad and other Quicklisp systems.
+
+*  Fix Uniform Naming Convention (aka "UNC" or "network") paths under Windows.
+   
+
+   DIRECTORY now works again on UNC paths.
+
+   UNC paths may be either specified with either back slash (#\\) or
+   forward slash (#\/) doubled as the first character in a Pathname
+   namestring.
+
+   The patterns in
+
+        ////[directories-and-files]
+
+   are parsed as
+
+     is stored as HOST.
+
+     is stored as DEVICE.
+
+    [directories-and-files] gets parsed as per the normal rules under
+    Windows.
+
+   Mixing namestrings with both backslash and slash characters can
+   lead to unpredictable results.  It is recommended not to use
+   backslash characters in namestrings if it can be avoided.  The
+   pathname printed representation is always normalized to using
+   forward slash delimiters.
+
+*  Find contrib based on system jar name.
+   
+
+   From Olof-Joachim Frahm.
+
+
+## Tested
+
+### "Java_HotSpot(TM)_64-Bit_Server_VM-Oracle_Corporation-1.7.0_51-b13" "x86_64-Mac_OS_X-10.9.1"
+
+### "Java_HotSpot(TM)_64-Bit_Server_VM-Oracle_Corporation-1.8.0-b129" "x86_64-Mac_OS_X-10.9.2"
+
+
+
    + +

    The distribution (perhaps) contains a more detailed documentation of CHANGES.

    + + +

    Release notes for older releases of ABCL.

    + +
    + +
    +

    ABCL is Armed Bear Common Lisp.

    +

    Hosted via lisp.not.org.

    + +
    + Valid XHTML 1.0 Strict +
    +
    $Id: release-notes-1.0.1.shtml 13748 2012-01-10 18:58:49Z mevenson $
    +
    + + + From mevenson at common-lisp.net Wed Apr 30 07:07:31 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 30 Apr 2014 07:07:31 -0000 Subject: [Armedbear-cvs] r14708 - public_html/releases/1.3.1 Message-ID: <20140430070731.6033.48456@lisp.not.org> Author: mevenson Date: Wed Apr 30 07:07:30 2014 New Revision: 14708 Log: abcl-1.3.1 cryptographics signatures by 2048D/4DB1773D 2012-12-09. aka 2A9641104DB1773D Mark Evenson Added: public_html/releases/1.3.1/abcl-1.3.1.jar.asc (contents, props changed) public_html/releases/1.3.1/abcl-20140430a.pdf.asc (contents, props changed) public_html/releases/1.3.1/abcl-bin-1.3.1.tar.gz.asc (contents, props changed) public_html/releases/1.3.1/abcl-bin-1.3.1.zip.asc (contents, props changed) public_html/releases/1.3.1/abcl-contrib-1.3.1.jar.asc (contents, props changed) public_html/releases/1.3.1/abcl-contrib.jar.asc (contents, props changed) public_html/releases/1.3.1/abcl-src-1.3.1.tar.gz.asc (contents, props changed) public_html/releases/1.3.1/abcl-src-1.3.1.zip.asc (contents, props changed) public_html/releases/1.3.1/abcl.jar.asc (contents, props changed) Added: public_html/releases/1.3.1/abcl-1.3.1.jar.asc ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-20140430a.pdf.asc ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-bin-1.3.1.tar.gz.asc ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-bin-1.3.1.zip.asc ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-contrib-1.3.1.jar.asc ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-contrib.jar.asc ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-src-1.3.1.tar.gz.asc ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl-src-1.3.1.zip.asc ============================================================================== Binary file. No diff available. Added: public_html/releases/1.3.1/abcl.jar.asc ============================================================================== Binary file. No diff available. From mevenson at common-lisp.net Wed Apr 30 07:10:10 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 30 Apr 2014 07:10:10 -0000 Subject: [Armedbear-cvs] r14709 - public_html Message-ID: <20140430071010.6136.63860@lisp.not.org> Author: mevenson Date: Wed Apr 30 07:10:09 2014 New Revision: 14709 Log: Note abcl-1.3.1 release on main page now that sigs are in place. Modified: public_html/index.shtml Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml Wed Apr 30 07:07:30 2014 (r14708) +++ public_html/index.shtml Wed Apr 30 07:10:09 2014 (r14709) @@ -26,31 +26,31 @@ Binary - abcl-bin-1.3.0.tar.gz - (pgp) + abcl-bin-1.3.1.tar.gz + (pgp) - abcl-bin-1.3.0.zip - (pgp) + abcl-bin-1.3.1.zip + (pgp) - abcl-contrib-1.3.0.jar - (pgp) + abcl-contrib-1.3.1.jar + (pgp) Source - abcl-src-1.3.0.tar.gz - (pgp) + abcl-src-1.3.1.tar.gz + (pgp) - abcl-src-1.3.0.zip - (pgp) + abcl-src-1.3.0.zip + (pgp) - + abcl-contrib source @@ -125,6 +125,7 @@
  • JRE 1.6.0 (patch level 10 or higher)
  • JRE 1.7.0
    • +
  • JRE 1.8.0

    • Running on one of the explictly supported platforms: @@ -140,6 +141,7 @@

  • JDK 1.5.0
  • JDK 1.6.0 (patch level 10 or higher)
  • JDK 1.7.0
    • +
  • JDK 1.8.0

    • And either

      From mevenson at common-lisp.net Wed Apr 30 09:49:02 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 30 Apr 2014 09:49:02 -0000 Subject: [Armedbear-cvs] r14710 - public_html Message-ID: <20140430094902.12104.63121@lisp.not.org> Author: mevenson Date: Wed Apr 30 09:49:01 2014 New Revision: 14710 Log: Fix reference to 1.3.1 CHANGES from svn. Modified: public_html/release-notes-1.3.1.shtml Modified: public_html/release-notes-1.3.1.shtml ============================================================================== --- public_html/release-notes-1.3.1.shtml Wed Apr 30 07:10:09 2014 (r14709) +++ public_html/release-notes-1.3.1.shtml Wed Apr 30 09:49:01 2014 (r14710) @@ -91,7 +91,7 @@ -

      The distribution (perhaps) contains a more detailed documentation of CHANGES.

      +

      The distribution (perhaps) contains a more detailed documentation of CHANGES.

      Release notes for older releases of ABCL.

      From mevenson at common-lisp.net Wed Apr 30 13:54:09 2014 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 30 Apr 2014 13:54:09 -0000 Subject: [Armedbear-cvs] r14711 - trunk/abcl Message-ID: <20140430135409.21260.78631@lisp.not.org> Author: mevenson Date: Wed Apr 30 13:54:08 2014 New Revision: 14711 Log: Note JFI boolean conversion in CHANGES. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Wed Apr 30 09:49:01 2014 (r14710) +++ trunk/abcl/CHANGES Wed Apr 30 13:54:08 2014 (r14711) @@ -6,10 +6,15 @@ Version 1.3.1 ============= http://abcl.org/svn/tags/1.3.1/ -20-APR-2014 +30-APR-2014 ## Fixed +* The underlying Java Function Interface (JFI) now converts CL:T and + CL:NIL to JAVA:+TRUE+ and JAVA:+FALSE+. Users who wish to + reference a JAVA:+NULL+ should do so explicitly. + + * Make JCALL work in more places. Thanks to Olof-Joachim Frahm.