From astalla at common-lisp.net  Sat Apr  2 21:56:06 2011
From: astalla at common-lisp.net (Alessio Stalla)
Date: Sat, 02 Apr 2011 17:56:06 -0400
Subject: [armedbear-cvs] r13259 - in trunk/abcl: . src/org/armedbear/lisp
Message-ID: <E1Q68nd-0004eD-Ve@common-lisp.net>

Author: astalla
Date: Sat Apr  2 17:56:04 2011
New Revision: 13259

Log:
Java method resolution algorithm used by JCALL extracted to a method and exposed as the Lisp function JAVA:JRESOLVE-METHOD


Modified:
   trunk/abcl/pom.xml
   trunk/abcl/src/org/armedbear/lisp/FaslClassLoader.java
   trunk/abcl/src/org/armedbear/lisp/Java.java
   trunk/abcl/src/org/armedbear/lisp/Symbol.java
   trunk/abcl/src/org/armedbear/lisp/WrongNumberOfArgumentsException.java

Modified: trunk/abcl/pom.xml
==============================================================================
--- trunk/abcl/pom.xml	(original)
+++ trunk/abcl/pom.xml	Sat Apr  2 17:56:04 2011
@@ -13,7 +13,7 @@
   </parent>
   <groupId>org.armedbear.lisp</groupId>
   <artifactId>abcl</artifactId>
-  <version>0.25.0-SNAPSHOT</version>
+  <version>0.26.0-SNAPSHOT</version>
   <packaging>jar</packaging>
   <name>ABCL - Armed Bear Common Lisp</name>
   <description>Common Lisp implementation running on the JVM</description>

Modified: trunk/abcl/src/org/armedbear/lisp/FaslClassLoader.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/FaslClassLoader.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/FaslClassLoader.java	Sat Apr  2 17:56:04 2011
@@ -105,16 +105,16 @@
     }
 
     public LispObject loadFunction(int fnNumber) {
+        //Function name is fnIndex + 1
+        String name = baseName + "_" + (fnNumber + 1);
         try {
-            //Function name is fnIndex + 1
-            String name = baseName + "_" + (fnNumber + 1);
             Function f = (Function) loadClass(name).newInstance();
             f.setClassBytes(getFunctionClassBytes(name));
             return f;
-        } catch(Exception e) {
+        } catch(Throwable e) {
             if(e instanceof ControlTransfer) { throw (ControlTransfer) e; }
             Debug.trace(e);
-            return error(new LispError("Compiled function can't be loaded: " + baseName + "_" + (fnNumber + 1) + " " + Symbol.LOAD_TRUENAME.symbolValue()));
+            return error(new LispError("Compiled function can't be loaded: " + name + " from " + Symbol.LOAD_TRUENAME.symbolValue()));
         }
     }
 

Modified: trunk/abcl/src/org/armedbear/lisp/Java.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Java.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Java.java	Sat Apr  2 17:56:04 2011
@@ -62,16 +62,16 @@
     private static final Primitive ENSURE_JAVA_OBJECT = new pf_ensure_java_object();
     @DocString(name="ensure-java-object", args="obj",
     doc="Ensures OBJ is wrapped in a JAVA-OBJECT, wrapping it if necessary.")
-    private static final class pf_ensure_java_object extends Primitive 
+    private static final class pf_ensure_java_object extends Primitive
     {
-        pf_ensure_java_object() 
+        pf_ensure_java_object()
         {
             super("ensure-java-object", PACKAGE_JAVA, true);
         }
 
         @Override
         public LispObject execute(LispObject obj) {
-	    return obj instanceof JavaObject ? obj : new JavaObject(obj);
+            return obj instanceof JavaObject ? obj : new JavaObject(obj);
         }
     };
 
@@ -80,9 +80,9 @@
     args="exception-name condition-symbol",
     doc="Registers the Java Throwable named by the symbol EXCEPTION-NAME as the condition " +
         "designated by CONDITION-SYMBOL.  Returns T if successful, NIL if not.")
-    private static final class pf_register_java_exception extends Primitive 
+    private static final class pf_register_java_exception extends Primitive
     {
-        pf_register_java_exception() 
+        pf_register_java_exception()
         {
             super("register-java-exception", PACKAGE_JAVA, true);
         }
@@ -108,7 +108,7 @@
         " by REGISTER-JAVA-EXCEPTION.")
     private static final class pf_unregister_java_exception extends Primitive
     {
-        pf_unregister_java_exception() 
+        pf_unregister_java_exception()
         {
             super("unregister-java-exception", PACKAGE_JAVA, true);
         }
@@ -447,16 +447,16 @@
                 if (c != null) {
                     String methodName = methodRef.getStringValue();
                     Method[] methods = c.getMethods();
-		    List<Method> staticMethods = new ArrayList<Method>();
+                    List<Method> staticMethods = new ArrayList<Method>();
                     int argCount = args.length - 2;
-		    for(Method m1 : methods) {
-			if(Modifier.isStatic(m1.getModifiers())) {
-			    staticMethods.add(m1);
-			}
-		    }
-		    if(staticMethods.size() > 0) {
-			m = findMethod(staticMethods.toArray(new Method[staticMethods.size()]), methodName, args);
-		    }
+                    for(Method m1 : methods) {
+                        if(Modifier.isStatic(m1.getModifiers())) {
+                            staticMethods.add(m1);
+                        }
+                    }
+                    if(staticMethods.size() > 0) {
+                        m = findMethod(staticMethods.toArray(new Method[staticMethods.size()]), methodName, args, 2);
+                    }
                     if (m == null)
                         error(new LispError("no such method"));
                 }
@@ -748,7 +748,7 @@
         }
     };
 
-    /** 
+    /**
      * Does no type conversion. The result of the call is simply wrapped in a
      *   JavaObject.
      */
@@ -770,53 +770,86 @@
         }
     };
 
+    private static final Primitive JRESOLVE_METHOD = new pf_jresolve_method();
+    @DocString(name="jresolve_method", args="method-name instance &rest args",
+    doc="Finds the most specific Java method METHOD-NAME on INSTANCE " +
+        "applicable to arguments ARGS. Returns NIL if no suitable method is " +
+        "found. The algorithm used for resolution is the same used by JCALL " +
+        "when it is called with a string as the first parameter (METHOD-REF).")
+    private static final class pf_jresolve_method extends Primitive {
+
+        pf_jresolve_method() {
+            super(Symbol.JRESOLVE_METHOD);
+        }
+
+        @Override
+        public LispObject execute(LispObject[] args) {
+            if (args.length < 2) {
+                error(new WrongNumberOfArgumentsException(this, 2));
+            }
+            final LispObject methodArg = args[0];
+            final LispObject instanceArg = args[1];
+            final Object instance;
+            Class<?> intendedClass = null;
+            if (instanceArg instanceof AbstractString) {
+                instance = instanceArg.getStringValue();
+            } else if (instanceArg instanceof JavaObject) {
+                JavaObject jobj = ((JavaObject)instanceArg);
+                instance = jobj.getObject();
+                intendedClass = jobj.getIntendedClass();
+            } else {
+                instance = instanceArg.javaInstance();
+            }
+            if(instance == null) {
+                return error(new ProgramError("JRESOLVE-METHOD: instance must not be null"));
+            }
+            String methodName = methodArg.getStringValue();
+            Object[] methodArgs = translateMethodArguments(args, 2);
+            Method method = findMethod(instance, intendedClass, methodName, methodArgs);
+            if (method != null) {
+                return JavaObject.getInstance(method);
+            } else {
+                return NIL;
+            }
+        }
+    };
+
     static LispObject jcall(Primitive fun, LispObject[] args, boolean translate)
 
     {
         if (args.length < 2)
-            error(new WrongNumberOfArgumentsException(fun));
+            error(new WrongNumberOfArgumentsException(fun, 2));
         try {
-	    final LispObject methodArg = args[0];
-	    final LispObject instanceArg = args[1];
-	    final Object instance;
-	    Class<?> intendedClass = null;
-	    if (instanceArg instanceof AbstractString) {
-		instance = instanceArg.getStringValue();
-	    } else if (instanceArg instanceof JavaObject) {
-		JavaObject jobj = ((JavaObject)instanceArg);
-		instance = jobj.getObject();
-		intendedClass = jobj.getIntendedClass();
-	    } else {
-		instance = instanceArg.javaInstance();
-	    }
-	    if(instance == null) {
-		throw new NullPointerException(); //Handled below
-	    }
+            final LispObject methodArg = args[0];
+            final LispObject instanceArg = args[1];
+            final Object instance;
             Method method;
-	    Object[] methodArgs;
+            Object[] methodArgs;
+            Class<?> intendedClass = null;
+            if (instanceArg instanceof AbstractString) {
+                instance = instanceArg.getStringValue();
+            } else if (instanceArg instanceof JavaObject) {
+                JavaObject jobj = ((JavaObject)instanceArg);
+                instance = jobj.getObject();
+                intendedClass = jobj.getIntendedClass();
+            } else {
+                instance = instanceArg.javaInstance();
+            }
+            if(instance == null) {
+                throw new NullPointerException(); //Handled below
+            }
             if (methodArg instanceof AbstractString) {
-		methodArgs = translateMethodArguments(args, 2);
                 String methodName = methodArg.getStringValue();
-		if(intendedClass == null) {
-		    intendedClass = instance.getClass();
-		}
-                method = findMethod(intendedClass, methodName, methodArgs);
-		Class actualClass = null;
-		if(method == null) {		    
-		    actualClass = instance.getClass();
-		    if(intendedClass != actualClass &&
-		       Modifier.isPublic(actualClass.getModifiers())) {
-			method = findMethod(actualClass, methodName, methodArgs);
-		    }
-		}
-		if (method == null) {
-		    String classes = intendedClass.getName();
-		    if(actualClass != null && actualClass != intendedClass) {
-			classes += " or " + actualClass.getName();
-		    }
-		    throw new NoSuchMethodException("No applicable method named " + methodName + " found in " + classes);
-		}
-
+                methodArgs = translateMethodArguments(args, 2);
+                method = findMethod(instance, intendedClass, methodName, methodArgs);
+                if (method == null) {
+                    String classes = intendedClass.getName();
+                    Class<?> actualClass = instance.getClass();
+                    if(actualClass != intendedClass) {
+                        classes += " or " + actualClass.getName();
+                    }
+                    throw new NoSuchMethodException("No applicable method named " + methodName + " found in " + classes);
+                }
             } else
                 method = (Method) JavaObject.getObject(methodArg);
             Class<?>[] argTypes = (Class<?>[])method.getParameterTypes();
@@ -833,7 +866,7 @@
             }
             return JavaObject.getInstance(method.invoke(instance, methodArgs),
                                           translate,
-					  method.getReturnType());
+                                          method.getReturnType());
         }
         catch (ControlTransfer t) {
             throw t;
@@ -875,7 +908,7 @@
     }
 
     private static Method findMethod(Method[] methods, String methodName, Object[] javaArgs) {
-	int argCount = javaArgs.length;
+        int argCount = javaArgs.length;
         Method result = null;
         for (int i = methods.length; i-- > 0;) {
             Method method = methods[i];
@@ -896,23 +929,39 @@
         return result;
     }
 
+    private static Method findMethod(Object instance, Class<?> intendedClass, String methodName, Object[] methodArgs) {
+        if(intendedClass == null) {
+            intendedClass = instance.getClass();
+        }
+        Method method = findMethod(intendedClass, methodName, methodArgs);
+        Class actualClass = null;
+        if(method == null) {
+            actualClass = instance.getClass();
+            if(intendedClass != actualClass &&
+               Modifier.isPublic(actualClass.getModifiers())) {
+                method = findMethod(actualClass, methodName, methodArgs);
+            }
+        }
+        return method;
+    }
+
     private static Method findMethod(Class<?> c, String methodName, Object[] javaArgs) {
         Method[] methods = c.getMethods();
-	return findMethod(methods, methodName, javaArgs);
+        return findMethod(methods, methodName, javaArgs);
     }
 
-    private static Method findMethod(Class<?> c, String methodName, LispObject[] args) {
-        Object[] javaArgs = translateMethodArguments(args, 2);
-	return findMethod(c, methodName, javaArgs);
+    private static Method findMethod(Class<?> c, String methodName, LispObject[] args, int offset) {
+        Object[] javaArgs = translateMethodArguments(args, offset);
+        return findMethod(c, methodName, javaArgs);
     }
 
-    private static Method findMethod(Method[] methods, String methodName, LispObject[] args) {
-        Object[] javaArgs = translateMethodArguments(args, 2);
-	return findMethod(methods, methodName, javaArgs);
+    private static Method findMethod(Method[] methods, String methodName, LispObject[] args, int offset) {
+        Object[] javaArgs = translateMethodArguments(args, offset);
+        return findMethod(methods, methodName, javaArgs);
     }
 
     static Constructor findConstructor(Class<?> c, LispObject[] args) throws NoSuchMethodException {
-	int argCount = args.length - 1;
+        int argCount = args.length - 1;
         Object[] javaArgs = translateMethodArguments(args, 1);
         Constructor[] ctors = c.getConstructors();
         Constructor result = null;

Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java	Sat Apr  2 17:56:04 2011
@@ -2970,7 +2970,7 @@
   public static final Symbol JAVA_OBJECT =
     PACKAGE_JAVA.addExternalSymbol("JAVA-OBJECT");
   public static final Symbol JAVA_CLASS =
-	    PACKAGE_JAVA.addExternalSymbol("JAVA-CLASS");
+      PACKAGE_JAVA.addExternalSymbol("JAVA-CLASS");
   public static final Symbol JCALL =
     PACKAGE_JAVA.addExternalSymbol("JCALL");
   public static final Symbol JCALL_RAW =
@@ -2983,6 +2983,8 @@
     PACKAGE_JAVA.addExternalSymbol("JCLASS-OF");
   public static final Symbol JMETHOD_RETURN_TYPE =
     PACKAGE_JAVA.addExternalSymbol("JMETHOD-RETURN-TYPE");
+  public static final Symbol JRESOLVE_METHOD =
+    PACKAGE_JAVA.addExternalSymbol("JRESOLVE-METHOD");
 
   // External symbols in SYSTEM package.
   public static final Symbol _ENABLE_AUTOCOMPILE_ =

Modified: trunk/abcl/src/org/armedbear/lisp/WrongNumberOfArgumentsException.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/WrongNumberOfArgumentsException.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/WrongNumberOfArgumentsException.java	Sat Apr  2 17:56:04 2011
@@ -42,7 +42,7 @@
     private String message;
 
     public WrongNumberOfArgumentsException(Operator operator) {
-	this(operator, -1);
+        this(operator, -1);
     }
 
     public WrongNumberOfArgumentsException(Operator operator, int expectedArgs) {



From mevenson at common-lisp.net  Sun Apr  3 16:02:46 2011
From: mevenson at common-lisp.net (Mark Evenson)
Date: Sun, 03 Apr 2011 12:02:46 -0400
Subject: [armedbear-cvs] r13260 - in trunk/abcl: . test/lisp/abcl
Message-ID: <E1Q6PlG-0004Vs-5j@common-lisp.net>

Author: mevenson
Date: Sun Apr  3 12:02:44 2011
New Revision: 13260

Log:
Test for ticket #142.

Modified:
   trunk/abcl/abcl.asd
   trunk/abcl/test/lisp/abcl/math-tests.lisp

Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd	(original)
+++ trunk/abcl/abcl.asd	Sun Apr  3 12:02:44 2011
@@ -52,7 +52,8 @@
                              ("utilities" "pathname-tests" "file-system-tests"))
                       #+abcl
                       (:file "url-pathname")
-                      (:file "math-tests")
+                      (:file "math-tests" 
+                             :depends-on ("compiler-tests"))
                       (:file "misc-tests")
                       (:file "latin1-tests")
                       #+abcl

Modified: trunk/abcl/test/lisp/abcl/math-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/math-tests.lisp	(original)
+++ trunk/abcl/test/lisp/abcl/math-tests.lisp	Sun Apr  3 12:02:44 2011
@@ -463,3 +463,17 @@
   #-(or cmu sbcl)
   (signals-error (read-from-string "1.0f-1000") 'reader-error)
   t)
+
+;;; Test for http://trac.common-lisp.net/armedbear/ticket/142
+(define-compiler-test math.logand.1
+    (lambda (switchp)
+      (logand 
+       (if switchp
+           nil
+           2)
+       1))
+  :args (nil)
+  :results 0)
+
+
+     
\ No newline at end of file



From mevenson at common-lisp.net  Mon Apr  4 08:41:45 2011
From: mevenson at common-lisp.net (Mark Evenson)
Date: Mon, 04 Apr 2011 04:41:45 -0400
Subject: [armedbear-cvs] r13261 - trunk/abcl
Message-ID: <E1Q6fM1-0000DS-4Z@common-lisp.net>

Author: mevenson
Date: Mon Apr  4 04:41:43 2011
New Revision: 13261

Log:
Only invoke ABCL internal Lisp tests by default.

Housecleaning in ASDF defintion removing uncessary ABCL-ASDF pacakge.
Move to the more friendly ASDF2 invocations.

Normalize ASDF-TEST-LISP convention to "hanging keyword".

Modified:
   trunk/abcl/abcl.asd

Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd	(original)
+++ trunk/abcl/abcl.asd	Mon Apr  4 04:41:43 2011
@@ -2,22 +2,15 @@
 ;;; $Id$
 
 (require 'asdf)
-(defpackage :abcl-asdf
-  (:use :cl :asdf))
-(in-package :abcl-asdf)
+(in-package :asdf)
 
 ;;; Wrapper for all ABCL ASDF definitions.
-(defsystem :abcl :version "0.5.0")
-
-(defmethod perform :after ((o load-op) (c (eql (find-system :abcl))))
-  (operate 'load-op :abcl-test-lisp :force t)
-  (operate 'load-op :cl-bench :force t)
-  (operate 'load-op :ansi-compiled :force t)
-  (operate 'load-op :ansi-interpreted :force t))
+(defsystem :abcl :version "0.6.0")
 
 ;;;  Run via (asdf:operate 'asdf:test-op :abcl :force t)
 (defmethod perform ((o test-op) (c (eql (find-system :abcl))))
-  (operate 'test-op :abcl-tests :force t))
+  (load-system (find-system :abcl-test-lisp))
+  (operate 'test-op :abcl-test-lisp))
 
 ;;; Test ABCL with the Lisp unit tests collected in "test/lisp/abcl"
 ;;;
@@ -45,22 +38,26 @@
                       #+abcl
                       (:file "mop-tests-setup")
                       #+abcl
-                      (:file "mop-tests" :depends-on ("mop-tests-setup"))
+                      (:file "mop-tests" :depends-on 
+                             ("mop-tests-setup"))
                       (:file "file-system-tests")
                       #+abcl
-                      (:file "jar-pathname" :depends-on
+                      (:file "jar-pathname" :depends-on 
                              ("utilities" "pathname-tests" "file-system-tests"))
                       #+abcl
                       (:file "url-pathname")
-                      (:file "math-tests" 
-                             :depends-on ("compiler-tests"))
+                      (:file "math-tests" :depends-on 
+                             ("compiler-tests"))
                       (:file "misc-tests")
                       (:file "latin1-tests")
                       #+abcl
-                      (:file "bugs" :depends-on ("file-system-tests"))
-                      (:file "wild-pathnames" :depends-on ("file-system-tests"))
+                      (:file "bugs" :depends-on 
+                             ("file-system-tests"))
+                      (:file "wild-pathnames" :depends-on 
+                             ("file-system-tests"))
                       #+abcl
-                      (:file "pathname-tests" :depends-on ("utilities"))))))
+                      (:file "pathname-tests" :depends-on 
+                             ("utilities"))))))
 
 (defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp))))
    "Invoke tests with (asdf:oos 'asdf:test-op :abcl-test-lisp)."
@@ -73,7 +70,7 @@
 	       ((:file "package")
                 (:file "parse-ansi-errors" :depends-on ("package"))))))
 (defmethod perform :before ((o test-op) (c (eql (find-system :ansi-interpreted))))
-  (operate 'load-op :ansi-interpreted))
+  (load-system  :ansi-interpreted))
 (defmethod perform ((o test-op) (c (eql (find-system :ansi-interpreted))))
   (funcall (intern (symbol-name 'run) :abcl.test.ansi)
 	   :compile-tests nil))
@@ -85,12 +82,11 @@
 	       ((:file "package")
                 (:file "parse-ansi-errors" :depends-on ("package"))))))
 (defmethod perform :before ((o test-op) (c (eql (find-system :ansi-compiled))))
-  (operate 'load-op :ansi-compiled))
+  (load-system :ansi-compiled))
 (defmethod perform ((o test-op) (c (eql (find-system :ansi-compiled))))
   (funcall (intern (symbol-name 'run) :abcl.test.ansi)
 	   :compile-tests t))
 
-
 ;;; Test ABCL with CL-BENCH 
 (defsystem :cl-bench :components
            ((:module cl-bench-package :pathname "../cl-bench/"
@@ -99,7 +95,7 @@
                      :depends-on (cl-bench-package) :components
                      ((:file "wrapper")))))
 (defmethod perform :before ((o test-op) (c (eql (find-system :cl-bench))))
-  (operate 'load-op :cl-bench :force t))
+  (load-system :cl-bench))
 (defmethod perform ((o test-op) (c (eql (find-system :cl-bench))))
   (funcall (intern (symbol-name 'run) :abcl.test.cl-bench)))
  



From mevenson at common-lisp.net  Mon Apr  4 12:30:55 2011
From: mevenson at common-lisp.net (Mark Evenson)
Date: Mon, 04 Apr 2011 08:30:55 -0400
Subject: [armedbear-cvs] r13262 - trunk/abcl/test/lisp/abcl
Message-ID: <E1Q6ivn-0002bd-Jk@common-lisp.net>

Author: mevenson
Date: Mon Apr  4 08:30:54 2011
New Revision: 13262

Log:
Fix UNUSED.2 for ABCL.

Allow CLISP to compile compiler-tests.lisp.

Modified:
   trunk/abcl/test/lisp/abcl/compiler-tests.lisp

Modified: trunk/abcl/test/lisp/abcl/compiler-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/compiler-tests.lisp	(original)
+++ trunk/abcl/test/lisp/abcl/compiler-tests.lisp	Mon Apr  4 08:30:54 2011
@@ -66,10 +66,10 @@
              (not (null (second list)))
              (third list)))
      (unused.2)))
-  #+(or abcl allegro) (unused.2 t   nil)
-  #+clisp             (unused.2 1   nil)
-  #+(or cmu sbcl)     (unused.2 nil nil)
-  #+lispworks         (unused.2 t   nil)
+  #+allegro            (unused.2 t   nil)
+  #+clisp              (unused.2 1   nil)
+  #+(or cmu sbcl abcl) (unused.2 nil nil)
+  #+lispworks          (unused.2 t   nil)
   17)
 
 (deftest plus.1
@@ -104,6 +104,7 @@
   #.(+ most-positive-fixnum most-positive-fixnum))
 #+allegro (pushnew 'plus.3 *expected-failures*)
 
+#-clisp
 (define-compiler-test plus.4
   (lambda (x y)
     (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
@@ -118,6 +119,7 @@
   :args (#.most-negative-fixnum)
   :results #.(- most-negative-fixnum))
 
+#-clisp
 (define-compiler-test minus.2
   (lambda (x)
     (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x))
@@ -125,6 +127,7 @@
   :args (#.most-negative-java-long)
   :results #.(- most-negative-java-long))
 
+#-clisp
 (define-compiler-test minus.3
   (lambda (x y)
     (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
@@ -132,6 +135,7 @@
   :args (#.most-negative-java-long #.most-positive-java-long)
   :results #.(- most-negative-java-long most-positive-java-long))
 
+#-clisp
 (define-compiler-test logxor-minus.1
   (lambda (x)
     (declare (type (integer 0 255) x))
@@ -139,6 +143,7 @@
   :args (17)
   :results -9223372036854775792)
 
+#-clisp
 (deftest times.1
   (progn
     (fmakunbound 'times.1)
@@ -255,6 +260,7 @@
   134217727
   3)
 
+#-clisp
 (deftest bignum-constant.1
   (progn
     (fmakunbound 'bignum-constant.1)
@@ -268,6 +274,7 @@
   t
   #.most-positive-java-long)
 
+#-clisp
 (deftest bignum-constant.2
   (progn
     (fmakunbound 'bignum-constant.2)
@@ -281,6 +288,7 @@
   t
   #.(1+ most-positive-java-long))
 
+#-clisp
 (deftest bignum-constant.3
   (progn
     (fmakunbound 'bignum-constant.3)
@@ -294,6 +302,7 @@
   t
   #.most-negative-java-long)
 
+#-clisp
 (deftest bignum-constant.4
   (progn
     (fmakunbound 'bignum-constant.4)
@@ -387,6 +396,7 @@
   :args (#.most-positive-fixnum #.most-negative-fixnum)
   :results #.most-negative-fixnum)
 
+#-clisp
 (define-compiler-test min.3
   (lambda (x y)
     (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
@@ -394,6 +404,7 @@
   :args (3 4)
   :results 3)
 
+#-clisp
 (define-compiler-test min.4
   (lambda (x y)
     (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
@@ -408,6 +419,7 @@
   :args (3 4)
   :results 4)
 
+#-clisp
 (define-compiler-test max.2
   (lambda (x y)
     (declare (type fixnum x y))
@@ -415,6 +427,7 @@
   :args (#.most-positive-fixnum #.most-negative-fixnum)
   :results #.most-positive-fixnum)
 
+#-clisp
 (define-compiler-test max.3
   (lambda (x y)
     (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
@@ -422,6 +435,7 @@
   :args (3 4)
   :results 4)
 
+#-clisp
 (define-compiler-test max.4
   (lambda (x y)
     (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))



From mevenson at common-lisp.net  Wed Apr  6 08:29:45 2011
From: mevenson at common-lisp.net (Mark Evenson)
Date: Wed, 06 Apr 2011 04:29:45 -0400
Subject: [armedbear-cvs] r13263 - trunk/abcl/test/lisp/abcl
Message-ID: <E1Q7O7V-00055f-U6@common-lisp.net>

Author: mevenson
Date: Wed Apr  6 04:29:44 2011
New Revision: 13263

Log:
MAKE-PATHNAME erroneously merges directories as in  MERGE-PATHNAMES

As noted in http://article.gmane.org/gmane.lisp.armedbear.devel/1867
MAKE-PATHNAME the following form mistakenly returns #p"/home/fare/"
when it should return #p""

{{{
(make-pathname :directory nil :defaults "/home/fare/")
}}}

Discovered by Fare in working through ASDF-2.014

Modified:
   trunk/abcl/test/lisp/abcl/pathname-tests.lisp

Modified: trunk/abcl/test/lisp/abcl/pathname-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/pathname-tests.lisp	(original)
+++ trunk/abcl/test/lisp/abcl/pathname-tests.lisp	Wed Apr  6 04:29:44 2011
@@ -1713,3 +1713,7 @@
             (write *foo.lisp* :stream s))
           (load file))))
   t)
+
+(deftest pathname.make-pathname.1
+    (make-pathname :directory nil :defaults "/home/fare/")
+  #p"")



From mevenson at common-lisp.net  Sat Apr  9 07:12:48 2011
From: mevenson at common-lisp.net (Mark Evenson)
Date: Sat, 09 Apr 2011 03:12:48 -0400
Subject: [armedbear-cvs] r13264 - in trunk/abcl/examples/google-app-engine:
	. war/WEB-INF
Message-ID: <E1Q8SLg-0002mX-R3@common-lisp.net>

Author: mevenson
Date: Sat Apr  9 03:12:47 2011
New Revision: 13264

Log:
Fix the GAE example so that the 'ant runserver' target works.

Now invoke ABCL to compile the necessary FASL.

The web.xml descriptor contained an incorrect absolute path for the
welcome file.

In the interest of speeding up the (presumably) morecommon use case of
merely running the example, the GAE build.xml now merely checks for
the presence of 'abcl.jar' rather than invoking the main ABCL build
each time.

Modified:
   trunk/abcl/examples/google-app-engine/README
   trunk/abcl/examples/google-app-engine/build.xml
   trunk/abcl/examples/google-app-engine/war/WEB-INF/web.xml

Modified: trunk/abcl/examples/google-app-engine/README
==============================================================================
--- trunk/abcl/examples/google-app-engine/README	(original)
+++ trunk/abcl/examples/google-app-engine/README	Sat Apr  9 03:12:47 2011
@@ -5,12 +5,32 @@
 
 Running ABCL in a Google App Engine container.
 
-This example shows how to run your servlet off ABCL in general
+This example shows how to run your Java servlet off ABCL in general
 and in Google App Engine (GAE) in particular.
 
 When uploading your code to the server, be sure to put abcl.jar
 in war/WEB-INF/lib.
 
 
+Running Locally
+---------------
+
+1.  Download the [Google App Engine SDK for Java][1], unzipping the
+    distribution somewhere on your filesystem
+    (e.g. "~/work/appengine-java-sdk-1.4.3").
+
+[1]: http://googleappengine.googlecode.com/files/appengine-java-sdk-1.4.3.zip
+
+2.  Simply invoke Ant on the `build.xml' in this directory with the
+    `runserver' target, setting the `sdk.dir' JVM property to specify
+    the location of the SDK.
+
+        unix$ ant -Dsdk.dir=$HOME/work/appengine-java-sdk-1.4.3/ runserver
+
+3.  Visit `http://localhost:8080/hello' in a web browser to see the example run.
+
+
+
+
 
 

Modified: trunk/abcl/examples/google-app-engine/build.xml
==============================================================================
--- trunk/abcl/examples/google-app-engine/build.xml	(original)
+++ trunk/abcl/examples/google-app-engine/build.xml	Sat Apr  9 03:12:47 2011
@@ -1,72 +1,92 @@
 <project default="compile">
-
+  <!-- 
+       'sdk.dir' contains the location of the Google AppEngine for Java SDK
+       http://googleappengine.googlecode.com/files/appengine-java-sdk-1.4.3.zip
+  -->
   <property name="sdk.dir" 
-            location="../../../appengine-java-sdk" />
+            location="${user.home}/work/appengine-java-sdk-1.4.3/" />
   <import file="${sdk.dir}/config/user/ant-macros.xml" />
 
   <path id="project.classpath">
-	<pathelement path="war/WEB-INF/classes" />
-	<fileset dir="war/WEB-INF/lib">
-	  <include name="**/*.jar" />
-	</fileset>
-	<fileset dir="${sdk.dir}/lib">
-	  <include name="shared/**/*.jar" />
-	</fileset>
+    <pathelement path="war/WEB-INF/classes" />
+    <fileset dir="war/WEB-INF/lib">
+      <include name="**/*.jar" />
+    </fileset>
+    <fileset dir="${sdk.dir}/lib">
+      <include name="shared/**/*.jar" />
+    </fileset>
   </path>
 
   <target name="copyjars"
 	  description="Copies the App Engine and ABCL JARs to the WAR.">
-	<copy
-		todir="war/WEB-INF/lib"
-		flatten="true">
-	  <fileset dir="${sdk.dir}/lib/user">
-		  <include name="**/*.jar" />
-	  </fileset>
-	  <fileset dir="../..">
-		  <include name="dist/*.jar" />
-	  </fileset>
-	</copy>
-	<copy
-		todir="war/fasls">
-	  <fileset dir="src">
-		<include name="*.abcl" />
-	  </fileset>
-	</copy>
-  </target>
+    <copy
+        todir="war/WEB-INF/lib"
+        flatten="true">
+      <fileset dir="${sdk.dir}/lib/user">
+        <include name="**/*.jar" />
+      </fileset>
+      <fileset dir="../..">
+        <include name="dist/*.jar" />
+      </fileset>
+    </copy>
+    <copy
+        todir="war/fasls">
+      <fileset dir="src">
+        <include name="*.abcl" />
+      </fileset>
+    </copy>
+  </target>
+  
+  <target name="compile"
+          depends="compile.java,compile.lisp"/>
 
-  <target name="compile" depends="copyjars,abcl.jar"
+  <target name="compile.java" depends="copyjars,abcl.jar"
 	  description="Compiles Java source and copies other source files to the WAR.">
-	<mkdir dir="war/WEB-INF/classes" />
-	<copy todir="war/WEB-INF/classes">
-	  <fileset dir="src">
-		  <exclude name="**/*.java" />
-	  </fileset>
-	</copy>
-	<javac
-		srcdir="src"
-		destdir="war/WEB-INF/classes"
-		classpathref="project.classpath"
-                includeantruntime="false"
-		debug="on" />
-  </target>
-
-  <target name="abcl.jar">
-    <ant dir="../.." target="abcl.jar"/>
+    <mkdir dir="war/WEB-INF/classes" />
+    <copy todir="war/WEB-INF/classes">
+      <fileset dir="src">
+        <exclude name="**/*.java" />
+      </fileset>
+    </copy>
+    <javac srcdir="src"
+           destdir="war/WEB-INF/classes"
+           classpathref="project.classpath"
+           includeantruntime="false"
+           debug="on" />
+  </target>
+  
+  <property name="abcl.jar" value="${basedir}/../../dist/abcl.jar"/>
+  <target name="compile.lisp" depends="abcl.jar">
+    <java fork="true"
+          classpath="${abcl.jar}"
+          classname="org.armedbear.lisp.Main"
+          inputstring="(compile-file &quot;${basedir}/war/WEB-INF/classes/first-servlet.lisp&quot;)">
+      <arg value="--noinit"/>
+    </java>
+  </target>
+
+  <available file="${abcl.jar}" property="abcl.jar.p"/>
+  <target name="abcl.jar" unless="abcl.jar.p">
+    <ant dir="${basedir}/../.." target="abcl.jar"/>
   </target>
 
   <target name="clean" description="Cleans all the jars and fasls.">
     <delete>
-      <fileset dir="." includes="**/*.jar" />
-      <fileset dir="." includes="**/*.class" />
-      <fileset dir="." includes="**/*.abcl" />
+      <fileset dir="${basedir}">
+        <include name="**/*.jar" />
+        <include name="**/*.class" />
+        <include name="**/*.abcl" />
+      </fileset>
     </delete>
   </target>
-  <target name="runserver" depends="compile"
+
+  <target name="runserver" 
+          depends="compile"
 	  description="Starts the development server.">
-	<dev_appserver war="war" />
+    <dev_appserver war="war" />
   </target>
   <target name="runserver-debug" depends="compile"
 	  description="Starts the development server.">
-	<dev_appserver war="war" port="8888"/>
+    <dev_appserver war="war" port="8888"/>
   </target>
 </project>
\ No newline at end of file

Modified: trunk/abcl/examples/google-app-engine/war/WEB-INF/web.xml
==============================================================================
--- trunk/abcl/examples/google-app-engine/war/WEB-INF/web.xml	(original)
+++ trunk/abcl/examples/google-app-engine/war/WEB-INF/web.xml	Sat Apr  9 03:12:47 2011
@@ -13,6 +13,6 @@
 		<url-pattern>/hello</url-pattern>
 	</servlet-mapping>
 	<welcome-file-list>
-		<welcome-file>/index.html</welcome-file>
+		<welcome-file>index.html</welcome-file>
 	</welcome-file-list>
 </web-app>
\ No newline at end of file



From mevenson at common-lisp.net  Sat Apr  9 15:48:49 2011
From: mevenson at common-lisp.net (Mark Evenson)
Date: Sat, 09 Apr 2011 11:48:49 -0400
Subject: [armedbear-cvs] r13265 - in trunk/abcl/examples/google-app-engine:
	. war/WEB-INF/classes
Message-ID: <E1Q8aP3-0006l3-8T@common-lisp.net>

Author: mevenson
Date: Sat Apr  9 11:48:48 2011
New Revision: 13265

Log:
Further corrections to GAE example.

Removed:
   trunk/abcl/examples/google-app-engine/war/WEB-INF/classes/
Modified:
   trunk/abcl/examples/google-app-engine/build.xml

Modified: trunk/abcl/examples/google-app-engine/build.xml
==============================================================================
--- trunk/abcl/examples/google-app-engine/build.xml	(original)
+++ trunk/abcl/examples/google-app-engine/build.xml	Sat Apr  9 11:48:48 2011
@@ -17,15 +17,19 @@
     </fileset>
   </path>
 
-  <target name="copyjars"
-	  description="Copies the App Engine and ABCL JARs to the WAR.">
+  <property name="abcl.dir"
+            location="${basedir}/../.."/>
+
+  <target name="resources.copy"
+          depends="compile.lisp,abcl.jar"
+	  description="Copies the necessary resources to the WAR.">
     <copy
         todir="war/WEB-INF/lib"
         flatten="true">
       <fileset dir="${sdk.dir}/lib/user">
         <include name="**/*.jar" />
       </fileset>
-      <fileset dir="../..">
+      <fileset dir="${abcl.dir}">
         <include name="dist/*.jar" />
       </fileset>
     </copy>
@@ -40,7 +44,7 @@
   <target name="compile"
           depends="compile.java,compile.lisp"/>
 
-  <target name="compile.java" depends="copyjars,abcl.jar"
+  <target name="compile.java" depends="resources.copy,abcl.jar"
 	  description="Compiles Java source and copies other source files to the WAR.">
     <mkdir dir="war/WEB-INF/classes" />
     <copy todir="war/WEB-INF/classes">
@@ -55,22 +59,22 @@
            debug="on" />
   </target>
   
-  <property name="abcl.jar" value="${basedir}/../../dist/abcl.jar"/>
+  <property name="abcl.jar" value="${abcl.dir}/dist/abcl.jar"/>
   <target name="compile.lisp" depends="abcl.jar">
     <java fork="true"
           classpath="${abcl.jar}"
           classname="org.armedbear.lisp.Main"
-          inputstring="(compile-file &quot;${basedir}/war/WEB-INF/classes/first-servlet.lisp&quot;)">
+          inputstring="(compile-file &quot;${basedir}/src/first-servlet.lisp&quot;)">
       <arg value="--noinit"/>
     </java>
   </target>
 
   <available file="${abcl.jar}" property="abcl.jar.p"/>
   <target name="abcl.jar" unless="abcl.jar.p">
-    <ant dir="${basedir}/../.." target="abcl.jar"/>
+    <ant dir="${abcl.dir}" target="abcl.jar"/>
   </target>
 
-  <target name="clean" description="Cleans all the jars and fasls.">
+  <target name="clean" description="Cleans all the jars, classes, and FASLs.">
     <delete>
       <fileset dir="${basedir}">
         <include name="**/*.jar" />
@@ -81,11 +85,12 @@
   </target>
 
   <target name="runserver" 
-          depends="compile"
+          depends="compile,resources.copy"
 	  description="Starts the development server.">
     <dev_appserver war="war" />
   </target>
-  <target name="runserver-debug" depends="compile"
+
+  <target name="runserver-debug" depends="compile,resources.copy"
 	  description="Starts the development server.">
     <dev_appserver war="war" port="8888"/>
   </target>



From mevenson at common-lisp.net  Mon Apr 11 05:51:37 2011
From: mevenson at common-lisp.net (Mark Evenson)
Date: Mon, 11 Apr 2011 01:51:37 -0400
Subject: [armedbear-cvs] r13266 - in trunk/abcl/examples/google-app-engine:
	. war/WEB-INF
Message-ID: <E1Q9A2D-0006R6-9a@common-lisp.net>

Author: mevenson
Date: Mon Apr 11 01:51:36 2011
New Revision: 13266

Log:
Add an 'update' task to upload application to GAE.

Modified:
   trunk/abcl/examples/google-app-engine/README
   trunk/abcl/examples/google-app-engine/build.xml
   trunk/abcl/examples/google-app-engine/war/WEB-INF/appengine-web.xml

Modified: trunk/abcl/examples/google-app-engine/README
==============================================================================
--- trunk/abcl/examples/google-app-engine/README	(original)
+++ trunk/abcl/examples/google-app-engine/README	Mon Apr 11 01:51:36 2011
@@ -30,6 +30,29 @@
 3.  Visit `http://localhost:8080/hello' in a web browser to see the example run.
 
 
+Deploying to GAE
+----------------
+
+1.  To deploy the included example to GAE, you need to first obtain a
+    GAE account, and pick a GAE application id to use with the
+    application.
+
+2.  Then you need to edit 'war/WEB-INF/appengine-web.xml' to specify
+    this application.  Just replace the contents of the <applciation>
+    tag (initially 'GAE-APPLICATION-ID-GOES-HERE') in the file with
+    your GAE ID. 
+
+3.  Then the Ant task 'update' should upload your application to GAE:
+
+        unix$ ant update
+
+    You will be prompted for the Google Account credentials associated
+    with the application ID.
+
+    
+
+         
+
 
 
 

Modified: trunk/abcl/examples/google-app-engine/build.xml
==============================================================================
--- trunk/abcl/examples/google-app-engine/build.xml	(original)
+++ trunk/abcl/examples/google-app-engine/build.xml	Mon Apr 11 01:51:36 2011
@@ -26,9 +26,11 @@
     <copy
         todir="war/WEB-INF/lib"
         flatten="true">
+      <!--
       <fileset dir="${sdk.dir}/lib/user">
         <include name="**/*.jar" />
       </fileset>
+      -->
       <fileset dir="${abcl.dir}">
         <include name="dist/*.jar" />
       </fileset>
@@ -90,8 +92,14 @@
     <dev_appserver war="war" />
   </target>
 
-  <target name="runserver-debug" depends="compile,resources.copy"
+  <target name="runserver-debug" depends="compile"
 	  description="Starts the development server.">
     <dev_appserver war="war" port="8888"/>
   </target>
+  
+  <target name="update" depends="compile"
+          description="Uploads the application to App Engine.">
+    <appcfg action="update" war="war" />
+  </target>
+   
 </project>
\ No newline at end of file

Modified: trunk/abcl/examples/google-app-engine/war/WEB-INF/appengine-web.xml
==============================================================================
--- trunk/abcl/examples/google-app-engine/war/WEB-INF/appengine-web.xml	(original)
+++ trunk/abcl/examples/google-app-engine/war/WEB-INF/appengine-web.xml	Mon Apr 11 01:51:36 2011
@@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="utf-8"?>
 <appengine-web-app xmlns="http://appengine.google.com/ns/1.0">
-	<application>abcl-test</application>
-	<version>1</version>
+  <application>GAE-APPLICATION-ID-GOES-HERE</application>
+  <version>1</version>
 </appengine-web-app>



From mevenson at common-lisp.net  Thu Apr 14 05:56:27 2011
From: mevenson at common-lisp.net (Mark Evenson)
Date: Thu, 14 Apr 2011 01:56:27 -0400
Subject: [armedbear-cvs] r13267 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1QAFXX-0000zR-GT@common-lisp.net>

Author: mevenson
Date: Thu Apr 14 01:56:24 2011
New Revision: 13267

Log:
Fix #146 so MAKE-PATHNAME uses :DIRECTORY argument even if NIL.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Pathname.java

Modified: trunk/abcl/src/org/armedbear/lisp/Pathname.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Pathname.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Pathname.java	Thu Apr 14 01:56:24 2011
@@ -1253,6 +1253,7 @@
         boolean deviceSupplied = false;
         boolean nameSupplied = false;
         boolean typeSupplied = false;
+        boolean directorySupplied = false;
         for (int i = 0; i < args.length; i += 2) {
             LispObject key = args[i];
             LispObject value = args[i + 1];
@@ -1262,6 +1263,7 @@
                 device = value;
                 deviceSupplied = true;
             } else if (key == Keyword.DIRECTORY) {
+                directorySupplied = true;
                 if (value instanceof AbstractString) {
                     directory = list(Keyword.ABSOLUTE, value);
                 } else if (value == Keyword.WILD) {
@@ -1298,7 +1300,7 @@
             if (host == NIL) {
                 host = defaults.host;
             }
-            if (directory == NIL) {
+            if (!directorySupplied) {
                 directory = defaults.directory;
             }
             if (!deviceSupplied) {



From mevenson at common-lisp.net  Thu Apr 14 11:16:27 2011
From: mevenson at common-lisp.net (Mark Evenson)
Date: Thu, 14 Apr 2011 07:16:27 -0400
Subject: [armedbear-cvs] r13268 - trunk/abcl/test/lisp/ansi
Message-ID: <E1QAKXD-00070O-Cv@common-lisp.net>

Author: mevenson
Date: Thu Apr 14 07:16:26 2011
New Revision: 13268

Log:
Start of tool grab and analyze ANSI error reports from SLIME.

Added:
   trunk/abcl/test/lisp/ansi/slime-ansi.el

Added: trunk/abcl/test/lisp/ansi/slime-ansi.el
==============================================================================
--- (empty file)
+++ trunk/abcl/test/lisp/ansi/slime-ansi.el	Thu Apr 14 07:16:26 2011
@@ -0,0 +1,11 @@
+(defun copy-previous-ansi-failures ()
+  "From the SLIME REPL buffer, copy the previous ANSI error report to kill ring."
+  (interactive)
+  (save-excursion 
+    (unless 
+        (search-backward "<--- Invocation of ")
+      (error "Failed to find end of test invocation"))
+    (previous-line 4)
+    (let ((end (point)))
+      (backward-sexp)
+      (copy-region-as-kill (point) end))))



From astalla at common-lisp.net  Fri Apr 15 20:00:06 2011
From: astalla at common-lisp.net (Alessio Stalla)
Date: Fri, 15 Apr 2011 16:00:06 -0400
Subject: [armedbear-cvs] r13269 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1QApBV-0004SN-F9@common-lisp.net>

Author: astalla
Date: Fri Apr 15 15:59:56 2011
New Revision: 13269

Log:
Fix error message


Modified:
   trunk/abcl/src/org/armedbear/lisp/jvm.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Fri Apr 15 15:59:56 2011
@@ -86,7 +86,7 @@
   (declare (optimize speed))
   (declare (type (signed-byte 8) n))
   (when (not (<= -128 n 127))
-    (error "s2 argument ~A out of 16-bit signed range." n))
+    (error "s1 argument ~A out of 8-bit signed range." n))
   (if (< n 0)
       (1+ (logxor (- n) #xFF))
       n))



From astalla at common-lisp.net  Fri Apr 15 23:34:44 2011
From: astalla at common-lisp.net (Alessio Stalla)
Date: Fri, 15 Apr 2011 19:34:44 -0400
Subject: [armedbear-cvs] r13270 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1QAsXE-000262-Kd@common-lisp.net>

Author: astalla
Date: Fri Apr 15 19:34:43 2011
New Revision: 13270

Log:
simple run-program implementation using the JRE ProcessBuilder class.


Added:
   trunk/abcl/src/org/armedbear/lisp/run-program.lisp
Modified:
   trunk/abcl/src/org/armedbear/lisp/autoloads.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/autoloads.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/autoloads.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/autoloads.lisp	Fri Apr 15 19:34:43 2011
@@ -248,6 +248,8 @@
 (autoload 'jarray-length "java")
 (export 'jnew-array-from-array "JAVA")
 (autoload 'jnew-array-from-array "java")
+(export 'jnew-array-from-list "JAVA")
+(autoload 'jnew-array-from-list "java")
 (export 'jclass-constructors "JAVA")
 (autoload 'jclass-constructors "java")
 (export 'jconstructor-params "JAVA")
@@ -301,6 +303,26 @@
 (autoload 'simple-search "search")
 (export 'run-shell-command)
 (autoload 'run-shell-command)
+(export 'run-program)
+(autoload 'run-program)
+(export 'process)
+(autoload 'process "run-program")
+(export 'process-p)
+(autoload 'process-p "run-program")
+(export 'process-input)
+(autoload 'process-input "run-program")
+(export 'process-output)
+(autoload 'process-output "run-program")
+(export 'process-error)
+(autoload 'process-error "run-program")
+(export 'process-alive-p)
+(autoload 'process-alive-p "run-program")
+(export 'process-wait)
+(autoload 'process-wait "run-program")
+(export 'process-exit-code)
+(autoload 'process-exit-code "run-program")
+(export 'process-kill)
+(autoload 'process-kill "run-program")
 
 (export 'make-socket)
 (autoload 'make-socket "socket")

Added: trunk/abcl/src/org/armedbear/lisp/run-program.lisp
==============================================================================
--- (empty file)
+++ trunk/abcl/src/org/armedbear/lisp/run-program.lisp	Fri Apr 15 19:34:43 2011
@@ -0,0 +1,103 @@
+;;; run-program.lisp
+;;;
+;;; Copyright (C) 2011 Alessio Stalla
+;;; $Id$
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+;;;
+;;; As a special exception, the copyright holders of this library give you
+;;; permission to link this library with independent modules to produce an
+;;; executable, regardless of the license terms of these independent
+;;; modules, and to copy and distribute the resulting executable under
+;;; terms of your choice, provided that you also meet, for each linked
+;;; independent module, the terms and conditions of the license of that
+;;; module.  An independent module is a module which is not derived from
+;;; or based on this library.  If you modify this library, you may extend
+;;; this exception to your version of the library, but you are not
+;;; obligated to do so.  If you do not wish to do so, delete this
+;;; exception statement from your version.
+
+(in-package "SYSTEM")
+
+(require "JAVA")
+
+;;Vaguely inspired by sb-ext:run-program in SBCL. See <http://www.sbcl.org/manual/Running-external-programs.html>. This implementation uses the JVM facilities for running external processes: <http://download.oracle.com/javase/6/docs/api/java/lang/ProcessBuilder.html>.
+(defun run-program (program args &key environment (wait t))
+  ;;For documentation, see below.
+  (let ((pb (java:jnew "java.lang.ProcessBuilder"
+                       (java:jnew-array-from-list "java.lang.String" (cons program args)))))
+    (when environment
+      (let ((env-map (java:jcall "environment" pb)))
+        (dolist (entry environment)
+          (java:jcall "put" env-map
+                 (princ-to-string (car entry))
+                 (princ-to-string (cdr entry))))))
+    (let ((process (make-process (java:jcall "start" pb))))
+      (when wait (process-wait process))
+      process)))
+
+;;The process structure.
+
+(defstruct (process (:constructor %make-process (jprocess)))
+  jprocess input output error)
+
+(defun make-process (proc)
+  (let ((process (%make-process proc)))
+    (setf (process-input process)
+          (java:jnew "org.armedbear.lisp.Stream" 'system-stream
+                     (java:jcall "getOutputStream" proc)
+                     'character)) ;;not a typo!
+    (setf (process-output process)
+          (java:jnew "org.armedbear.lisp.Stream" 'system-stream
+                (java:jcall "getInputStream" proc) ;;not a typo|
+                'character))
+    (setf (process-error process)
+          (java:jnew "org.armedbear.lisp.Stream" 'system-stream
+                (java:jcall "getErrorStream" proc)
+                'character))
+    process))
+
+(defun process-alive-p (process)
+  "Return t if process is still alive, nil otherwise."
+  (not (ignore-errors (java:jcall "exitValue" (process-jprocess process)))))
+
+(defun process-wait (process)
+  "Wait for process to quit running for some reason."
+  (java:jcall "waitFor" (process-jprocess process)))
+
+(defun process-exit-code (instance)
+  "The exit code of a process."
+  (ignore-errors (java:jcall "exitValue" (process-jprocess instance))))
+
+(defun process-kill (process)
+  "Kills the process."
+  (java:jcall "destroy" (process-jprocess process)))
+
+(setf (documentation 'run-program 'function)
+      "run-program creates a new process specified by the program argument. args are the standard arguments that can be passed to a program. For no arguments, use nil (which means that just the name of the program is passed as arg 0).
+
+run-program will return a process structure.
+
+Notes about Unix environments (as in the :environment):
+
+    * The ABCL implementation of run-program, like SBCL, Perl and many other programs, copies the Unix environment by default.
+    * Running Unix programs from a setuid process, or in any other situation where the Unix environment is under the control of someone else, is a mother lode of security problems. If you are contemplating doing this, read about it first. (The Perl community has a lot of good documentation about this and other security issues in script-like programs.)
+
+The &key arguments have the following meanings:
+
+:environment
+    a alist of STRINGs (name . value) describing the new environment. The default is to copy the environment of the current process.
+:wait
+    If non-NIL (default), wait until the created process finishes. If nil, continue running Lisp until the program finishes.")



From astalla at common-lisp.net  Mon Apr 18 20:34:00 2011
From: astalla at common-lisp.net (Alessio Stalla)
Date: Mon, 18 Apr 2011 16:34:00 -0400
Subject: [armedbear-cvs] r13271 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1QBv8x-0003my-W2@common-lisp.net>

Author: astalla
Date: Mon Apr 18 16:33:58 2011
New Revision: 13271

Log:
Included changes to compile-system.lisp missing from previous commit.
Refactored run-program to abstract jnew and jcall to low-level functions
(to be replaced by primitives).


Modified:
   trunk/abcl/src/org/armedbear/lisp/compile-system.lisp
   trunk/abcl/src/org/armedbear/lisp/run-program.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-system.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compile-system.lisp	Mon Apr 18 16:33:58 2011
@@ -238,6 +238,7 @@
                            "revappend.lisp"
                            "rotatef.lisp"
                            ;;"run-benchmarks.lisp"
+                           "run-program.lisp"
                            "run-shell-command.lisp"
                            ;;"runtime-class.lisp"
                            "search.lisp"

Modified: trunk/abcl/src/org/armedbear/lisp/run-program.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/run-program.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/run-program.lisp	Mon Apr 18 16:33:58 2011
@@ -36,18 +36,34 @@
 ;;Vaguely inspired by sb-ext:run-program in SBCL. See <http://www.sbcl.org/manual/Running-external-programs.html>. This implementation uses the JVM facilities for running external processes: <http://download.oracle.com/javase/6/docs/api/java/lang/ProcessBuilder.html>.
 (defun run-program (program args &key environment (wait t))
   ;;For documentation, see below.
-  (let ((pb (java:jnew "java.lang.ProcessBuilder"
-                       (java:jnew-array-from-list "java.lang.String" (cons program args)))))
+  (let ((pb (%make-process-builder program args)))
     (when environment
-      (let ((env-map (java:jcall "environment" pb)))
+      (let ((env-map (%process-builder-environment pb)))
         (dolist (entry environment)
-          (java:jcall "put" env-map
-                 (princ-to-string (car entry))
-                 (princ-to-string (cdr entry))))))
-    (let ((process (make-process (java:jcall "start" pb))))
+          (%process-builder-env-put env-map
+                                    (princ-to-string (car entry))
+                                    (princ-to-string (cdr entry))))))
+    (let ((process (make-process (%process-builder-start pb))))
       (when wait (process-wait process))
       process)))
 
+(setf (documentation 'run-program 'function)
+      "run-program creates a new process specified by the program argument. args are the standard arguments that can be passed to a program. For no arguments, use nil (which means that just the name of the program is passed as arg 0).
+
+run-program will return a process structure.
+
+Notes about Unix environments (as in the :environment):
+
+    * The ABCL implementation of run-program, like SBCL, Perl and many other programs, copies the Unix environment by default.
+    * Running Unix programs from a setuid process, or in any other situation where the Unix environment is under the control of someone else, is a mother lode of security problems. If you are contemplating doing this, read about it first. (The Perl community has a lot of good documentation about this and other security issues in script-like programs.)
+
+The &key arguments have the following meanings:
+
+:environment
+    a alist of STRINGs (name . value) describing the new environment. The default is to copy the environment of the current process.
+:wait
+    If non-NIL (default), wait until the created process finishes. If nil, continue running Lisp until the program finishes.")
+
 ;;The process structure.
 
 (defstruct (process (:constructor %make-process (jprocess)))
@@ -55,49 +71,67 @@
 
 (defun make-process (proc)
   (let ((process (%make-process proc)))
-    (setf (process-input process)
-          (java:jnew "org.armedbear.lisp.Stream" 'system-stream
-                     (java:jcall "getOutputStream" proc)
-                     'character)) ;;not a typo!
-    (setf (process-output process)
-          (java:jnew "org.armedbear.lisp.Stream" 'system-stream
-                (java:jcall "getInputStream" proc) ;;not a typo|
-                'character))
-    (setf (process-error process)
-          (java:jnew "org.armedbear.lisp.Stream" 'system-stream
-                (java:jcall "getErrorStream" proc)
-                'character))
+    (setf (process-input process) (%make-process-input-stream proc))
+    (setf (process-output process) (%make-process-output-stream proc))
+    (setf (process-error process) (%make-process-error-stream proc))
     process))
 
 (defun process-alive-p (process)
   "Return t if process is still alive, nil otherwise."
-  (not (ignore-errors (java:jcall "exitValue" (process-jprocess process)))))
+  (%process-alive-p (process-jprocess process)))
 
 (defun process-wait (process)
   "Wait for process to quit running for some reason."
-  (java:jcall "waitFor" (process-jprocess process)))
+  (%process-wait (process-jprocess process)))
 
 (defun process-exit-code (instance)
   "The exit code of a process."
-  (ignore-errors (java:jcall "exitValue" (process-jprocess instance))))
+  (%process-exit-code (process-jprocess instance)))
 
 (defun process-kill (process)
   "Kills the process."
-  (java:jcall "destroy" (process-jprocess process)))
+  (%process-kill (process-jprocess process)))
 
-(setf (documentation 'run-program 'function)
-      "run-program creates a new process specified by the program argument. args are the standard arguments that can be passed to a program. For no arguments, use nil (which means that just the name of the program is passed as arg 0).
+;;Low-level functions. For now they're just a refactoring of the initial implementation with direct
+;;jnew & jcall forms in the code. As per Ville's suggestion, these should really be implemented as
+;;primitives.
 
-run-program will return a process structure.
+(defun %make-process-builder (program args)
+  (java:jnew "java.lang.ProcessBuilder"
+             (java:jnew-array-from-list "java.lang.String" (cons program args))))
 
-Notes about Unix environments (as in the :environment):
+(defun %process-builder-environment (pb)
+  (java:jcall "environment" pb))
 
-    * The ABCL implementation of run-program, like SBCL, Perl and many other programs, copies the Unix environment by default.
-    * Running Unix programs from a setuid process, or in any other situation where the Unix environment is under the control of someone else, is a mother lode of security problems. If you are contemplating doing this, read about it first. (The Perl community has a lot of good documentation about this and other security issues in script-like programs.)
+(defun %process-builder-env-put (env-map key value)
+  (java:jcall "put" env-map key value))
 
-The &key arguments have the following meanings:
+(defun %process-builder-start (pb)
+  (java:jcall "start" pb))
 
-:environment
-    a alist of STRINGs (name . value) describing the new environment. The default is to copy the environment of the current process.
-:wait
-    If non-NIL (default), wait until the created process finishes. If nil, continue running Lisp until the program finishes.")
+(defun %make-process-input-stream (proc)
+  (java:jnew "org.armedbear.lisp.Stream" 'system-stream
+             (java:jcall "getOutputStream" proc) ;;not a typo!
+             'character))
+
+(defun %make-process-output-stream (proc)
+  (java:jnew "org.armedbear.lisp.Stream" 'system-stream
+             (java:jcall "getInputStream" proc) ;;not a typo|
+             'character))
+
+(defun %make-process-error-stream (proc)
+  (java:jnew "org.armedbear.lisp.Stream" 'system-stream
+             (java:jcall "getErrorStream" proc)
+             'character))
+
+(defun %process-alive-p (jprocess)
+  (not (ignore-errors (java:jcall "exitValue" jprocess))))
+
+(defun %process-wait (jprocess)
+  (java:jcall "waitFor" jprocess))
+
+(defun %process-exit-code (jprocess)
+  (ignore-errors (java:jcall "exitValue" jprocess)))
+
+(defun %process-kill (jprocess)
+  (java:jcall "destroy" jprocess))
\ No newline at end of file