[armedbear-cvs] r11528 - in trunk/abcl: . nbproject src/org/armedbear/lisp
Mark Evenson
mevenson at common-lisp.net
Sat Jan 3 13:08:57 UTC 2009
Author: mevenson
Date: Sat Jan 3 13:08:56 2009
New Revision: 11528
Log:
Enable optional use of JFluid profiler.
Modified:
trunk/abcl/build.properties.in
trunk/abcl/nbproject/build-impl.xml
trunk/abcl/nbproject/genfiles.properties
trunk/abcl/nbproject/project.properties
trunk/abcl/nbproject/project.xml
trunk/abcl/netbeans-build.xml
trunk/abcl/src/org/armedbear/lisp/Autoload.java
trunk/abcl/src/org/armedbear/lisp/Closure.java
trunk/abcl/src/org/armedbear/lisp/StandardClass.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
trunk/abcl/src/org/armedbear/lisp/Version.java
trunk/abcl/src/org/armedbear/lisp/autoloads.lisp
trunk/abcl/src/org/armedbear/lisp/java.lisp
trunk/abcl/src/org/armedbear/lisp/print-object.lisp
Modified: trunk/abcl/build.properties.in
==============================================================================
--- trunk/abcl/build.properties.in (original)
+++ trunk/abcl/build.properties.in Sat Jan 3 13:08:56 2009
@@ -1,2 +1,10 @@
# build.properties
# $Id: build.properties,v 1.23 2007-03-03 19:19:11 piso Exp $
+
+#additional.jars=${user.home}/work/lsw/lib/bsh-2.0b4.jar:${user.home}/work/lsw/lib/jscheme.jar
+#java.options=-Xmx2g
+
+#abcl.src.version=r14888+possibly-scripting
+
+
+#abcl.build.module=scripting
Modified: trunk/abcl/nbproject/build-impl.xml
==============================================================================
--- trunk/abcl/nbproject/build-impl.xml (original)
+++ trunk/abcl/nbproject/build-impl.xml Sat Jan 3 13:08:56 2009
@@ -64,7 +64,9 @@
</and>
</condition>
<condition property="have.tests">
- <or/>
+ <or>
+ <available file="${test.src.dir}"/>
+ </or>
</condition>
<condition property="have.sources">
<or>
@@ -123,6 +125,7 @@
</target>
<target depends="-pre-init,-init-private,-init-user,-init-project,-do-init" name="-init-check">
<fail unless="src.dir">Must set src.dir</fail>
+ <fail unless="test.src.dir">Must set test.src.dir</fail>
<fail unless="build.dir">Must set build.dir</fail>
<fail unless="dist.dir">Must set dist.dir</fail>
<fail unless="build.classes.dir">Must set build.classes.dir</fail>
@@ -196,7 +199,11 @@
<attribute default="**" name="testincludes"/>
<sequential>
<junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true">
- <batchtest todir="${build.test.results.dir}"/>
+ <batchtest todir="${build.test.results.dir}">
+ <fileset dir="${test.src.dir}" excludes="@{excludes},${excludes}" includes="@{includes}">
+ <filename name="@{testincludes}"/>
+ </fileset>
+ </batchtest>
<classpath>
<path path="${run.test.classpath}"/>
</classpath>
@@ -501,11 +508,13 @@
<!-- You can override this target in the ../build.xml file. -->
</target>
<target if="do.depend.true" name="-compile-test-depend">
- <j2seproject3:depend classpath="${javac.test.classpath}" destdir="${build.test.classes.dir}" srcdir=""/>
+ <j2seproject3:depend classpath="${javac.test.classpath}" destdir="${build.test.classes.dir}" srcdir="${test.src.dir}"/>
</target>
<target depends="init,compile,-pre-pre-compile-test,-pre-compile-test,-compile-test-depend" if="have.tests" name="-do-compile-test">
- <j2seproject3:javac classpath="${javac.test.classpath}" debug="true" destdir="${build.test.classes.dir}" srcdir=""/>
- <copy todir="${build.test.classes.dir}"/>
+ <j2seproject3:javac classpath="${javac.test.classpath}" debug="true" destdir="${build.test.classes.dir}" srcdir="${test.src.dir}"/>
+ <copy todir="${build.test.classes.dir}">
+ <fileset dir="${test.src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
+ </copy>
</target>
<target name="-post-compile-test">
<!-- Empty placeholder for easier customization. -->
@@ -519,8 +528,10 @@
<target depends="init,compile,-pre-pre-compile-test,-pre-compile-test-single" if="have.tests" name="-do-compile-test-single">
<fail unless="javac.includes">Must select some files in the IDE or set javac.includes</fail>
<j2seproject3:force-recompile destdir="${build.test.classes.dir}"/>
- <j2seproject3:javac classpath="${javac.test.classpath}" debug="true" destdir="${build.test.classes.dir}" excludes="" includes="${javac.includes}" sourcepath="" srcdir=""/>
- <copy todir="${build.test.classes.dir}"/>
+ <j2seproject3:javac classpath="${javac.test.classpath}" debug="true" destdir="${build.test.classes.dir}" excludes="" includes="${javac.includes}" sourcepath="${test.src.dir}" srcdir="${test.src.dir}"/>
+ <copy todir="${build.test.classes.dir}">
+ <fileset dir="${test.src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
+ </copy>
</target>
<target name="-post-compile-test-single">
<!-- Empty placeholder for easier customization. -->
Modified: trunk/abcl/nbproject/genfiles.properties
==============================================================================
--- trunk/abcl/nbproject/genfiles.properties (original)
+++ trunk/abcl/nbproject/genfiles.properties Sat Jan 3 13:08:56 2009
@@ -3,8 +3,8 @@
build.xml.stylesheet.CRC32=be360661
# 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=71623fcd
-nbproject/build-impl.xml.script.CRC32=7d8238bd
+nbproject/build-impl.xml.data.CRC32=742204ce
+nbproject/build-impl.xml.script.CRC32=b94c76f8
nbproject/build-impl.xml.stylesheet.CRC32=e55b27f5
nbproject/profiler-build-impl.xml.data.CRC32=71623fcd
nbproject/profiler-build-impl.xml.script.CRC32=abda56ed
Modified: trunk/abcl/nbproject/project.properties
==============================================================================
--- trunk/abcl/nbproject/project.properties (original)
+++ trunk/abcl/nbproject/project.properties Sat Jan 3 13:08:56 2009
@@ -17,10 +17,11 @@
dist.dir=dist
dist.jar=${dist.dir}/abcl.jar
dist.javadoc.dir=${dist.dir}/javadoc
-excludes=
+excludes=org/armedbear/lisp/scripting/*.java
file.reference.abcl-src=src
includes=org/armedbear/lisp/**/*.java,org/armedbear/lisp/**/*.lisp
jar.compress=true
+javac.classpath=
# Space-separated list of extra javac options
javac.compilerargs=
javac.deprecation=false
@@ -65,3 +66,4 @@
src.dir=${file.reference.abcl-src}
src.doc.dir=doc
src.themes.dir=themes
+test.src.dir=test/src
Modified: trunk/abcl/nbproject/project.xml
==============================================================================
--- trunk/abcl/nbproject/project.xml (original)
+++ trunk/abcl/nbproject/project.xml Sat Jan 3 13:08:56 2009
@@ -8,7 +8,9 @@
<source-roots>
<root id="src.dir"/>
</source-roots>
- <test-roots/>
+ <test-roots>
+ <root id="test.src.dir" name="test/src"/>
+ </test-roots>
</data>
</configuration>
</project>
Modified: trunk/abcl/netbeans-build.xml
==============================================================================
--- trunk/abcl/netbeans-build.xml (original)
+++ trunk/abcl/netbeans-build.xml Sat Jan 3 13:08:56 2009
@@ -5,6 +5,7 @@
<!-- XXX need way to autodetect NetBeans as installed, as this will
probably fail otherwise. -->
<import file="nbproject/build-impl.xml"/>
+ <import file="nbproject/profiler-build-impl.xml" optional="true"/>
<target name="-post-compile">
<echo>build.classes.dir: ${build.classes.dir}</echo>
Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java Sat Jan 3 13:08:56 2009
@@ -452,6 +452,8 @@
autoload("print-not-readable-object", "PrintNotReadable");
autoload("probe-file", "probe_file");
autoload("rational", "FloatFunctions");
+ autoload("read-char-no-hang", "read_char_no_hang");
+ autoload("read-delimited-list", "read_delimited_list");
autoload("rem", "rem");
autoload("remhash", "HashTableFunctions");
autoload("remhash", "HashTableFunctions");
@@ -513,6 +515,9 @@
autoload(PACKAGE_EXT, "thread-lock", "ThreadLock", true);
autoload(PACKAGE_EXT, "thread-unlock", "ThreadLock", true);
autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy");
+ autoload(PACKAGE_JAVA, "%find-java-class", "JavaClass");
+ autoload(PACKAGE_JAVA, "%jmake-invocation-handler", "JProxy");
+ autoload(PACKAGE_JAVA, "%jmake-proxy", "JProxy");
autoload(PACKAGE_JAVA, "%jnew-runtime-class", "RuntimeClass");
autoload(PACKAGE_JAVA, "%jredefine-method", "RuntimeClass");
autoload(PACKAGE_JAVA, "%jregister-handler", "JHandler");
Modified: trunk/abcl/src/org/armedbear/lisp/Closure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Closure.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Closure.java Sat Jan 3 13:08:56 2009
@@ -595,6 +595,8 @@
final LispThread thread = LispThread.currentThread();
SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
Environment ext = new Environment(environment);
+ for (Symbol special: specials)
+ ext.declareSpecial(special);
bindRequiredParameters(ext, thread, first, second, third, fourth,
fifth, sixth, seventh);
return bindParametersAndExecute(ext, thread,
Modified: trunk/abcl/src/org/armedbear/lisp/StandardClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardClass.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/StandardClass.java Sat Jan 3 13:08:56 2009
@@ -123,6 +123,9 @@
public static final StandardClass BUILT_IN_CLASS =
addStandardClass(Symbol.BUILT_IN_CLASS, list1(CLASS));
+ public static final StandardClass JAVA_CLASS =
+ addStandardClass(Symbol.JAVA_CLASS, list1(CLASS));
+
public static final StandardClass FORWARD_REFERENCED_CLASS =
addStandardClass(Symbol.FORWARD_REFERENCED_CLASS, list1(CLASS));
@@ -280,6 +283,8 @@
list1(PACKAGE_CL.intern("ARITHMETIC-ERROR-OPERANDS")))));
BUILT_IN_CLASS.setCPL(BUILT_IN_CLASS, CLASS, STANDARD_OBJECT,
BuiltInClass.CLASS_T);
+ JAVA_CLASS.setCPL(JAVA_CLASS, CLASS, STANDARD_OBJECT,
+ BuiltInClass.CLASS_T);
CELL_ERROR.setCPL(CELL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
STANDARD_OBJECT, BuiltInClass.CLASS_T);
CELL_ERROR.setDirectSlotDefinitions(
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 Jan 3 13:08:56 2009
@@ -2900,6 +2900,8 @@
PACKAGE_JAVA.addExternalSymbol("JAVA-EXCEPTION-CAUSE");
public static final Symbol JAVA_OBJECT =
PACKAGE_JAVA.addExternalSymbol("JAVA-OBJECT");
+ public static final Symbol JAVA_CLASS =
+ PACKAGE_JAVA.addExternalSymbol("JAVA-CLASS");
public static final Symbol JCALL =
PACKAGE_JAVA.addExternalSymbol("JCALL");
public static final Symbol JCALL_RAW =
Modified: trunk/abcl/src/org/armedbear/lisp/Version.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Version.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Version.java Sat Jan 3 13:08:56 2009
@@ -41,6 +41,6 @@
public static String getVersion()
{
- return "0.13.0-dev";
+ return "0.12.25";
}
}
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 Sat Jan 3 13:08:56 2009
@@ -201,6 +201,8 @@
(autoload 'jinterface-implementation "java")
(export 'jobject-class "JAVA")
(autoload 'jobject-class "java")
+(export 'jproperty-value "JAVA")
+(autoload 'jproperty-value "java")
(export 'jclass-superclass "JAVA")
(autoload 'jclass-superclass "java")
(export 'jclass-interfaces "JAVA")
Modified: trunk/abcl/src/org/armedbear/lisp/java.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/java.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/java.lisp Sat Jan 3 13:08:56 2009
@@ -75,6 +75,79 @@
(push method-name method-names-and-defs)))
(apply #'%jnew-proxy interface method-names-and-defs)))
+(defun jmake-invocation-handler (function)
+ (%jmake-invocation-handler function))
+
+(when (autoloadp 'jmake-proxy)
+ (fmakunbound 'jmake-proxy))
+
+(defgeneric jmake-proxy (interface implementation &optional lisp-this)
+ (:documentation "Returns a proxy Java object implementing the
+ provided interface using methods implemented in Lisp - typically
+ closures, but implementations are free to provide other
+ mechanisms. You can pass an optional 'lisp-this' object that will
+ be passed to the implementing methods as their first argument. If
+ you don't provide this object, NIL will be used. The second
+ argument of the Lisp methods is the name of the Java method being
+ implemented. This has the implication that overloaded methods are
+ merged, so you have to manually discriminate them if you want
+ to. The remaining arguments are java-objects wrapping the method's
+ parameters."))
+
+(defmethod jmake-proxy (interface invocation-handler &optional lisp-this)
+ "Basic implementation that directly uses an invocation handler."
+ (%jmake-proxy (jclass interface) invocation-handler lisp-this))
+
+(defmethod jmake-proxy (interface (implementation function) &optional lisp-this)
+ "Implements a Java interface forwarding method calls to a Lisp function."
+ (%jmake-proxy (jclass interface) (jmake-invocation-handler implementation) lisp-this))
+
+ (defmethod jmake-proxy (interface (implementation package) &optional lisp-this)
+ "Implements a Java interface mapping Java method names to symbols
+in a given package. javaMethodName is mapped to a JAVA-METHOD-NAME
+symbol. An error is signaled if no such symbol exists in the package,
+or if the symbol exists but does not name a function."
+
+ (flet ((java->lisp (name)
+ (with-output-to-string (str)
+ (let ((last-lower-p nil))
+ (map nil (lambda (char)
+ (let ((upper-p (char= (char-upcase char) char)))
+ (when (and last-lower-p upper-p)
+ (princ "-" str))
+ (setf last-lower-p (not upper-p))
+ (princ (char-upcase char) str)))
+ name)))))
+ (%jmake-proxy (jclass interface)
+ (jmake-invocation-handler
+ (lambda (obj method &rest args)
+ (let ((sym (find-symbol
+ (java->lisp method)
+ implementation)))
+ (unless sym
+ (error "Symbol ~A, implementation of method ~A, not found in ~A"
+ (java->lisp method)
+ method
+ implementation))
+ (if (fboundp sym)
+ (apply (symbol-function sym) obj method args)
+ (error "Function ~A, implementation of method ~A, not found in ~A"
+ sym method implementation)))))
+ lisp-this)))
+
+(defmethod jmake-proxy (interface (implementation hash-table) &optional lisp-this)
+ "Implements a Java interface using closures in an hash-table keyed
+by Java method name."
+ (%jmake-proxy (jclass interface)
+ (jmake-invocation-handler
+ (lambda (obj method &rest args)
+ (let ((fn (gethash method implementation)))
+ (if fn
+ (apply fn obj args)
+ (error "Implementation for method ~A not found in ~A"
+ method implementation)))))
+ lisp-this))
+
(defun jobject-class (obj)
"Returns the Java class that OBJ belongs to"
(jcall (jmethod "java.lang.Object" "getClass") obj))
@@ -233,3 +306,9 @@
(error "Unknown load-from for ~A" class-name)))))
(provide "JAVA-EXTENSIONS")
+ (defun jproperty-value (obj prop)
+ (%jget-property-value obj prop))
+
+ (defun (setf jproperty-value) (value obj prop)
+ (%jset-property-value obj prop value))
+
Modified: trunk/abcl/src/org/armedbear/lisp/print-object.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/print-object.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/print-object.lisp Sat Jan 3 13:08:56 2009
@@ -50,6 +50,9 @@
(format stream "~S" (class-name (class-of object))))
object)
+(defmethod print-object ((class java:java-class) stream)
+ (write-string (%write-to-string class) stream))
+
(defmethod print-object ((class class) stream)
(print-unreadable-object (class stream :identity t)
(format stream "~S ~S"
@@ -120,6 +123,16 @@
(defmethod print-object ((e java:java-exception) stream)
(if *print-escape*
(print-unreadable-object (e stream :type t :identity t)
+ (format stream "~A"
+ (java:jcall (java:jmethod "java.lang.Object" "toString")
+ (java:java-exception-cause e))))
+ (format stream "Java exception '~A'."
+ (java:jcall (java:jmethod "java.lang.Object" "toString")
+ (java:java-exception-cause e)))))
+
+(defmethod print-object ((e java:java-exception) stream)
+ (if *print-escape*
+ (print-unreadable-object (e stream :type t :identity t)
(format stream "~A"
(java:jcall (java:jmethod "java.lang.Object" "toString")
(java:java-exception-cause e))))
More information about the armedbear-cvs
mailing list