From vvoutilainen at common-lisp.net  Wed Dec  1 08:33:04 2010
From: vvoutilainen at common-lisp.net (Ville Voutilainen)
Date: Wed, 01 Dec 2010 03:33:04 -0500
Subject: [armedbear-cvs] r13073 - public_html
Message-ID: <E1PNi7c-0002AM-Bs@common-lisp.net>

Author: vvoutilainen
Date: Wed Dec  1 03:32:58 2010
New Revision: 13073

Log:
Fix the wiki link and the mailing list link.


Modified:
   public_html/faq.shtml

Modified: public_html/faq.shtml
==============================================================================
--- public_html/faq.shtml	(original)
+++ public_html/faq.shtml	Wed Dec  1 03:32:58 2010
@@ -93,7 +93,7 @@
 
 <p>If you found a bug which is not on the list, or you want to stress
 the importance of one that is, please mail our <a
-href="https://lists.sourceforge.net/lists/listinfo/armedbear-j-devel">mailing list</a> about it.</p>
+href="http://common-lisp.net/cgi-bin/mailman/listinfo/armedbear-devel">mailing list</a> about it.</p>
 </div>
 
 
@@ -169,7 +169,7 @@
   kind of documentation you're looking for.</p>
 
 <ol>
-  <li>Our <a href="http://trac.common-lisp.net/project/wiki">wiki</a></li>
+  <li>Our <a href="http://trac.common-lisp.net/armedbear/wiki">wiki</a></li>
   <li>The <a href="http://trac.common-lisp.net/armedbear/browser">source
     code (JavaDoc and general comments)</a></li>
   <li>Specific <a



From ehuelsmann at common-lisp.net  Wed Dec  1 21:38:43 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Wed, 01 Dec 2010 16:38:43 -0500
Subject: [armedbear-cvs] r13074 - branches/0.23.x/abcl
Message-ID: <E1PNuNv-0000cp-PO@common-lisp.net>

Author: ehuelsmann
Date: Wed Dec  1 16:38:40 2010
New Revision: 13074

Log:
Update changes with release date.


Modified:
   branches/0.23.x/abcl/CHANGES

Modified: branches/0.23.x/abcl/CHANGES
==============================================================================
--- branches/0.23.x/abcl/CHANGES	(original)
+++ branches/0.23.x/abcl/CHANGES	Wed Dec  1 16:38:40 2010
@@ -1,7 +1,7 @@
 Version 0.23.1
 ==============
 svn://common-lisp.net/project/armedbear/svn/tags/0.23.1/abcl
-(unreleased)
+(1 December, 2010)
 
 Fixes
 -----
@@ -17,8 +17,8 @@
   RFC3986.  
 
 
-Version 0.23
-============
+Version 0.23.0
+==============
 svn://common-lisp.net/project/armedbear/svn/tags/0.23.0/abcl
 (25 November, 2010)
 



From ehuelsmann at common-lisp.net  Wed Dec  1 21:41:42 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Wed, 01 Dec 2010 16:41:42 -0500
Subject: [armedbear-cvs] r13075 - tags/0.23.1
Message-ID: <E1PNuQo-0001IT-BP@common-lisp.net>

Author: ehuelsmann
Date: Wed Dec  1 16:41:41 2010
New Revision: 13075

Log:
Tag 0.23.1.

Added:
   tags/0.23.1/
      - copied from r13074, /branches/0.23.x/



From ehuelsmann at common-lisp.net  Wed Dec  1 21:42:53 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Wed, 01 Dec 2010 16:42:53 -0500
Subject: [armedbear-cvs] r13076 - branches/0.23.x/abcl/src/org/armedbear/lisp
Message-ID: <E1PNuRx-0001JQ-Cf@common-lisp.net>

Author: ehuelsmann
Date: Wed Dec  1 16:42:52 2010
New Revision: 13076

Log:
With 0.23.1 tagged, increase version number on
0.23.x development line.

Modified:
   branches/0.23.x/abcl/src/org/armedbear/lisp/Version.java

Modified: branches/0.23.x/abcl/src/org/armedbear/lisp/Version.java
==============================================================================
--- branches/0.23.x/abcl/src/org/armedbear/lisp/Version.java	(original)
+++ branches/0.23.x/abcl/src/org/armedbear/lisp/Version.java	Wed Dec  1 16:42:52 2010
@@ -41,7 +41,7 @@
 
   public static String getVersion()
   {
-    return "0.23.1-dev";
+    return "0.23.2-dev";
   }
 
   public static void main(String args[]) {



From ehuelsmann at common-lisp.net  Wed Dec  1 22:33:55 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Wed, 01 Dec 2010 17:33:55 -0500
Subject: [armedbear-cvs] r13077 - public_html/releases/0.23.1
Message-ID: <E1PNvFL-0004Db-8M@common-lisp.net>

Author: ehuelsmann
Date: Wed Dec  1 17:33:50 2010
New Revision: 13077

Log:
Add 0.23.1 tarballs to our releases/ directory.

Added:
   public_html/releases/0.23.1/
   public_html/releases/0.23.1/abcl-bin-0.23.1-dev.tar.gz   (contents, props changed)
   public_html/releases/0.23.1/abcl-bin-0.23.1-dev.zip   (contents, props changed)
   public_html/releases/0.23.1/abcl-src-0.23.1-dev.tar.gz   (contents, props changed)
   public_html/releases/0.23.1/abcl-src-0.23.1-dev.zip   (contents, props changed)

Added: public_html/releases/0.23.1/abcl-bin-0.23.1-dev.tar.gz
==============================================================================
Binary file. No diff available.

Added: public_html/releases/0.23.1/abcl-bin-0.23.1-dev.zip
==============================================================================
Binary file. No diff available.

Added: public_html/releases/0.23.1/abcl-src-0.23.1-dev.tar.gz
==============================================================================
Binary file. No diff available.

Added: public_html/releases/0.23.1/abcl-src-0.23.1-dev.zip
==============================================================================
Binary file. No diff available.



From mevenson at common-lisp.net  Wed Dec  1 22:44:35 2010
From: mevenson at common-lisp.net (Mark Evenson)
Date: Wed, 01 Dec 2010 17:44:35 -0500
Subject: [armedbear-cvs] r13078 - in trunk/abcl: nbproject
	src/org/armedbear/lisp
Message-ID: <E1PNvPf-0004wq-HJ@common-lisp.net>

Author: mevenson
Date: Wed Dec  1 17:44:34 2010
New Revision: 13078

Log:
The classfile writer now handles the creation of interfaces.

JVM::MAKE-CLASS-INTERFACE-FILE will create a classfile structure
suitable for defining a Java interface.  Simply add abstract methods
to complete the definition.

JVM::ADD-SUPERINTERFACE adds an interface definition to a classfile.
For a classfile denoting a Java object, these interfaces correspond
to the contents of a Java language "implements" clause.  For a classfile
denoting a Java interface, these interfaces are all added to the
contract defined by this interfaces corresponding to the Java language
"extends" clause.

Modified:
   trunk/abcl/nbproject/build-impl.xml
   trunk/abcl/nbproject/genfiles.properties
   trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

Modified: trunk/abcl/nbproject/build-impl.xml
==============================================================================
--- trunk/abcl/nbproject/build-impl.xml	(original)
+++ trunk/abcl/nbproject/build-impl.xml	Wed Dec  1 17:44:34 2010
@@ -55,6 +55,7 @@
     </target>
     <target depends="-pre-init,-init-private,-init-user,-init-project,-init-macrodef-property" name="-do-init">
         <available file="${manifest.file}" property="manifest.available"/>
+        <available file="${application.splash}" property="splashscreen.available"/>
         <condition property="main.class.available">
             <and>
                 <isset property="main.class"/>
@@ -83,23 +84,40 @@
                 <isset property="do.mkdist"/>
             </and>
         </condition>
-        <condition property="manifest.available+mkdist.available">
+        <condition property="manifest.available+main.class+mkdist.available+splashscreen.available">
             <and>
-                <istrue value="${manifest.available}"/>
-                <isset property="do.mkdist"/>
+                <istrue value="${manifest.available+main.class+mkdist.available}"/>
+                <istrue value="${splashscreen.available}"/>
             </and>
         </condition>
-        <condition property="manifest.available-mkdist.available">
-            <or>
-                <istrue value="${manifest.available}"/>
-                <isset property="do.mkdist"/>
-            </or>
+        <condition property="do.archive">
+            <not>
+                <istrue value="${jar.archive.disabled}"/>
+            </not>
         </condition>
-        <condition property="manifest.available+main.class-mkdist.available">
-            <or>
+        <condition property="do.archive+manifest.available">
+            <and>
+                <isset property="manifest.available"/>
+                <istrue value="${do.archive}"/>
+            </and>
+        </condition>
+        <condition property="do.archive+manifest.available+main.class">
+            <and>
                 <istrue value="${manifest.available+main.class}"/>
-                <isset property="do.mkdist"/>
-            </or>
+                <istrue value="${do.archive}"/>
+            </and>
+        </condition>
+        <condition property="do.archive+manifest.available+main.class+mkdist.available">
+            <and>
+                <istrue value="${manifest.available+main.class+mkdist.available}"/>
+                <istrue value="${do.archive}"/>
+            </and>
+        </condition>
+        <condition property="do.archive+manifest.available+main.class+mkdist.available+splashscreen.available">
+            <and>
+                <istrue value="${manifest.available+main.class+mkdist.available+splashscreen.available}"/>
+                <istrue value="${do.archive}"/>
+            </and>
         </condition>
         <condition property="have.tests">
             <or>
@@ -156,6 +174,8 @@
             <length length="0" string="${endorsed.classpath}" when="greater"/>
         </condition>
         <property name="javac.fork" value="false"/>
+        <property name="jar.index" value="false"/>
+        <available file="${meta.inf.dir}/persistence.xml" property="has.persistence.xml"/>
     </target>
     <target name="-post-init">
         <!-- Empty placeholder for easier customization. -->
@@ -182,11 +202,53 @@
             </sequential>
         </macrodef>
     </target>
-    <target name="-init-macrodef-javac">
+    <target depends="-init-ap-cmdline-properties" if="ap.supported.internal" name="-init-macrodef-javac-with-processors">
+        <macrodef name="javac" uri="http://www.netbeans.org/ns/j2se-project/3">
+            <attribute default="${src.dir}" name="srcdir"/>
+            <attribute default="${build.classes.dir}" name="destdir"/>
+            <attribute default="${javac.classpath}" name="classpath"/>
+            <attribute default="${javac.processorpath}" name="processorpath"/>
+            <attribute default="${build.generated.sources.dir}/ap-source-output" name="apgeneratedsrcdir"/>
+            <attribute default="${includes}" name="includes"/>
+            <attribute default="${excludes}" name="excludes"/>
+            <attribute default="${javac.debug}" name="debug"/>
+            <attribute default="${empty.dir}" name="sourcepath"/>
+            <attribute default="${empty.dir}" name="gensrcdir"/>
+            <element name="customize" optional="true"/>
+            <sequential>
+                <property location="${build.dir}/empty" name="empty.dir"/>
+                <mkdir dir="${empty.dir}"/>
+                <mkdir dir="@{apgeneratedsrcdir}"/>
+                <javac debug="@{debug}" deprecation="${javac.deprecation}" destdir="@{destdir}" encoding="${source.encoding}" excludes="@{excludes}" fork="${javac.fork}" includeantruntime="false" includes="@{includes}" source="${javac.source}" sourcepath="@{sourcepath}" srcdir="@{srcdir}" target="${javac.target}" tempdir="${java.io.tmpdir}">
+                    <src>
+                        <dirset dir="@{gensrcdir}" erroronmissingdir="false">
+                            <include name="*"/>
+                        </dirset>
+                    </src>
+                    <classpath>
+                        <path path="@{classpath}"/>
+                    </classpath>
+                    <compilerarg line="${endorsed.classpath.cmd.line.arg}"/>
+                    <compilerarg line="${javac.compilerargs}"/>
+                    <compilerarg value="-processorpath"/>
+                    <compilerarg path="@{processorpath}:${empty.dir}"/>
+                    <compilerarg line="${ap.processors.internal}"/>
+                    <compilerarg line="${annotation.processing.processor.options}"/>
+                    <compilerarg value="-s"/>
+                    <compilerarg path="@{apgeneratedsrcdir}"/>
+                    <compilerarg line="${ap.proc.none.internal}"/>
+                    <customize/>
+                </javac>
+            </sequential>
+        </macrodef>
+    </target>
+    <target depends="-init-ap-cmdline-properties" name="-init-macrodef-javac-without-processors" unless="ap.supported.internal">
         <macrodef name="javac" uri="http://www.netbeans.org/ns/j2se-project/3">
             <attribute default="${src.dir}" name="srcdir"/>
             <attribute default="${build.classes.dir}" name="destdir"/>
             <attribute default="${javac.classpath}" name="classpath"/>
+            <attribute default="${javac.processorpath}" name="processorpath"/>
+            <attribute default="${build.generated.sources.dir}/ap-source-output" name="apgeneratedsrcdir"/>
             <attribute default="${includes}" name="includes"/>
             <attribute default="${excludes}" name="excludes"/>
             <attribute default="${javac.debug}" name="debug"/>
@@ -211,6 +273,8 @@
                 </javac>
             </sequential>
         </macrodef>
+    </target>
+    <target depends="-init-macrodef-javac-with-processors,-init-macrodef-javac-without-processors" name="-init-macrodef-javac">
         <macrodef name="depend" uri="http://www.netbeans.org/ns/j2se-project/3">
             <attribute default="${src.dir}" name="srcdir"/>
             <attribute default="${build.classes.dir}" name="destdir"/>
@@ -227,15 +291,18 @@
             <attribute default="${build.classes.dir}" name="destdir"/>
             <sequential>
                 <fail unless="javac.includes">Must set javac.includes</fail>
-                <pathconvert pathsep="," property="javac.includes.binary">
+                <pathconvert pathsep="${line.separator}" property="javac.includes.binary">
                     <path>
                         <filelist dir="@{destdir}" files="${javac.includes}"/>
                     </path>
                     <globmapper from="*.java" to="*.class"/>
                 </pathconvert>
+                <tempfile deleteonexit="true" property="javac.includesfile.binary"/>
+                <echo file="${javac.includesfile.binary}" message="${javac.includes.binary}"/>
                 <delete>
-                    <files includes="${javac.includes.binary}"/>
+                    <files includesfile="${javac.includesfile.binary}"/>
                 </delete>
+                <delete file="${javac.includesfile.binary}"/>
             </sequential>
         </macrodef>
     </target>
@@ -358,14 +425,65 @@
             </sequential>
         </macrodef>
     </target>
+    <target name="-init-macrodef-copylibs">
+        <macrodef name="copylibs" uri="http://www.netbeans.org/ns/j2se-project/3">
+            <element name="customize" optional="true"/>
+            <sequential>
+                <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
+                <pathconvert property="run.classpath.without.build.classes.dir">
+                    <path path="${run.classpath}"/>
+                    <map from="${build.classes.dir.resolved}" to=""/>
+                </pathconvert>
+                <pathconvert pathsep=" " property="jar.classpath">
+                    <path path="${run.classpath.without.build.classes.dir}"/>
+                    <chainedmapper>
+                        <flattenmapper/>
+                        <globmapper from="*" to="lib/*"/>
+                    </chainedmapper>
+                </pathconvert>
+                <taskdef classname="org.netbeans.modules.java.j2seproject.copylibstask.CopyLibs" classpath="${libs.CopyLibs.classpath}" name="copylibs"/>
+                <copylibs compress="${jar.compress}" index="${jar.index}" jarfile="${dist.jar}" manifest="${manifest.file}" runtimeclasspath="${run.classpath.without.build.classes.dir}">
+                    <fileset dir="${build.classes.dir}"/>
+                    <manifest>
+                        <attribute name="Class-Path" value="${jar.classpath}"/>
+                        <customize/>
+                    </manifest>
+                </copylibs>
+            </sequential>
+        </macrodef>
+    </target>
     <target name="-init-presetdef-jar">
         <presetdef name="jar" uri="http://www.netbeans.org/ns/j2se-project/1">
-            <jar compress="${jar.compress}" jarfile="${dist.jar}">
+            <jar compress="${jar.compress}" index="${jar.index}" jarfile="${dist.jar}">
                 <j2seproject1:fileset dir="${build.classes.dir}"/>
             </jar>
         </presetdef>
     </target>
-    <target depends="-pre-init,-init-private,-init-user,-init-project,-do-init,-post-init,-init-check,-init-macrodef-property,-init-macrodef-javac,-init-macrodef-junit,-init-macrodef-nbjpda,-init-macrodef-debug,-init-macrodef-java,-init-presetdef-jar" name="init"/>
+    <target name="-init-ap-cmdline-properties">
+        <property name="annotation.processing.enabled" value="true"/>
+        <property name="annotation.processing.processors.list" value=""/>
+        <property name="annotation.processing.processor.options" value=""/>
+        <property name="annotation.processing.run.all.processors" value="true"/>
+        <property name="javac.processorpath" value="${javac.classpath}"/>
+        <property name="javac.test.processorpath" value="${javac.test.classpath}"/>
+        <condition property="ap.supported.internal" value="true">
+            <not>
+                <matches pattern="1\.[0-5](\..*)?" string="${javac.source}"/>
+            </not>
+        </condition>
+    </target>
+    <target depends="-init-ap-cmdline-properties" if="ap.supported.internal" name="-init-ap-cmdline-supported">
+        <condition else="" property="ap.processors.internal" value="-processor ${annotation.processing.processors.list}">
+            <isfalse value="${annotation.processing.run.all.processors}"/>
+        </condition>
+        <condition else="" property="ap.proc.none.internal" value="-proc:none">
+            <isfalse value="${annotation.processing.enabled}"/>
+        </condition>
+    </target>
+    <target depends="-init-ap-cmdline-properties,-init-ap-cmdline-supported" name="-init-ap-cmdline">
+        <property name="ap.cmd.line.internal" value=""/>
+    </target>
+    <target depends="-pre-init,-init-private,-init-user,-init-project,-do-init,-post-init,-init-check,-init-macrodef-property,-init-macrodef-javac,-init-macrodef-junit,-init-macrodef-nbjpda,-init-macrodef-debug,-init-macrodef-java,-init-presetdef-jar,-init-ap-cmdline" name="init"/>
     <!--
                 ===================
                 COMPILATION SECTION
@@ -409,12 +527,18 @@
         </pathconvert>
         <j2seproject3:depend srcdir="${src.dir}:${build.generated.subdirs}"/>
     </target>
-    <target depends="init,deps-jar,-pre-pre-compile,-pre-compile,-compile-depend" if="have.sources" name="-do-compile">
+    <target depends="init,deps-jar,-pre-pre-compile,-pre-compile, -copy-persistence-xml,-compile-depend" if="have.sources" name="-do-compile">
         <j2seproject3:javac gensrcdir="${build.generated.sources.dir}"/>
         <copy todir="${build.classes.dir}">
             <fileset dir="${src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
         </copy>
     </target>
+    <target if="has.persistence.xml" name="-copy-persistence-xml">
+        <mkdir dir="${build.classes.dir}/META-INF"/>
+        <copy todir="${build.classes.dir}/META-INF">
+            <fileset dir="${meta.inf.dir}" includes="persistence.xml"/>
+        </copy>
+    </target>
     <target name="-post-compile">
         <!-- Empty placeholder for easier customization. -->
         <!-- You can override this target in the ../build.xml file. -->
@@ -447,13 +571,13 @@
         <!-- Empty placeholder for easier customization. -->
         <!-- You can override this target in the ../build.xml file. -->
     </target>
-    <target depends="init,compile,-pre-pre-jar,-pre-jar" name="-do-jar-without-manifest" unless="manifest.available-mkdist.available">
+    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="do.archive" name="-do-jar-without-manifest" unless="manifest.available">
         <j2seproject1:jar/>
     </target>
-    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class-mkdist.available">
+    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="do.archive+manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class">
         <j2seproject1:jar manifest="${manifest.file}"/>
     </target>
-    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available+main.class" name="-do-jar-with-mainclass" unless="manifest.available+main.class+mkdist.available">
+    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="do.archive+manifest.available+main.class" name="-do-jar-with-mainclass" unless="manifest.available+main.class+mkdist.available">
         <j2seproject1:jar manifest="${manifest.file}">
             <j2seproject1:manifest>
                 <j2seproject1:attribute name="Main-Class" value="${main.class}"/>
@@ -468,78 +592,35 @@
         </pathconvert>
         <echo>java -cp "${run.classpath.with.dist.jar}" ${main.class}</echo>
     </target>
-    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available+main.class+mkdist.available" name="-do-jar-with-libraries">
-        <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
-        <pathconvert property="run.classpath.without.build.classes.dir">
-            <path path="${run.classpath}"/>
-            <map from="${build.classes.dir.resolved}" to=""/>
-        </pathconvert>
-        <pathconvert pathsep=" " property="jar.classpath">
-            <path path="${run.classpath.without.build.classes.dir}"/>
-            <chainedmapper>
-                <flattenmapper/>
-                <globmapper from="*" to="lib/*"/>
-            </chainedmapper>
-        </pathconvert>
-        <taskdef classname="org.netbeans.modules.java.j2seproject.copylibstask.CopyLibs" classpath="${libs.CopyLibs.classpath}" name="copylibs"/>
-        <copylibs compress="${jar.compress}" jarfile="${dist.jar}" manifest="${manifest.file}" runtimeclasspath="${run.classpath.without.build.classes.dir}">
-            <fileset dir="${build.classes.dir}"/>
-            <manifest>
+    <target depends="init,compile,-pre-pre-jar,-pre-jar,-init-macrodef-copylibs" if="do.archive+manifest.available+main.class+mkdist.available+splashscreen.available" name="-do-jar-with-libraries-and-splashscreen">
+        <basename file="${application.splash}" property="splashscreen.basename"/>
+        <mkdir dir="${build.classes.dir}/META-INF"/>
+        <copy failonerror="false" file="${application.splash}" todir="${build.classes.dir}/META-INF"/>
+        <j2seproject3:copylibs>
+            <customize>
                 <attribute name="Main-Class" value="${main.class}"/>
-                <attribute name="Class-Path" value="${jar.classpath}"/>
-            </manifest>
-        </copylibs>
+                <attribute name="SplashScreen-Image" value="META-INF/${splashscreen.basename}"/>
+            </customize>
+        </j2seproject3:copylibs>
         <echo>To run this application from the command line without Ant, try:</echo>
         <property location="${dist.jar}" name="dist.jar.resolved"/>
         <echo>java -jar "${dist.jar.resolved}"</echo>
     </target>
-    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available+mkdist.available" name="-do-jar-with-libraries-without-mainclass" unless="main.class.available">
-        <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
-        <pathconvert property="run.classpath.without.build.classes.dir">
-            <path path="${run.classpath}"/>
-            <map from="${build.classes.dir.resolved}" to=""/>
-        </pathconvert>
-        <pathconvert pathsep=" " property="jar.classpath">
-            <path path="${run.classpath.without.build.classes.dir}"/>
-            <chainedmapper>
-                <flattenmapper/>
-                <globmapper from="*" to="lib/*"/>
-            </chainedmapper>
-        </pathconvert>
-        <taskdef classname="org.netbeans.modules.java.j2seproject.copylibstask.CopyLibs" classpath="${libs.CopyLibs.classpath}" name="copylibs"/>
-        <copylibs compress="${jar.compress}" jarfile="${dist.jar}" manifest="${manifest.file}" runtimeclasspath="${run.classpath.without.build.classes.dir}">
-            <fileset dir="${build.classes.dir}"/>
-            <manifest>
-                <attribute name="Class-Path" value="${jar.classpath}"/>
-            </manifest>
-        </copylibs>
-    </target>
-    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="do.mkdist" name="-do-jar-with-libraries-without-manifest" unless="manifest.available">
-        <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
-        <pathconvert property="run.classpath.without.build.classes.dir">
-            <path path="${run.classpath}"/>
-            <map from="${build.classes.dir.resolved}" to=""/>
-        </pathconvert>
-        <pathconvert pathsep=" " property="jar.classpath">
-            <path path="${run.classpath.without.build.classes.dir}"/>
-            <chainedmapper>
-                <flattenmapper/>
-                <globmapper from="*" to="lib/*"/>
-            </chainedmapper>
-        </pathconvert>
-        <taskdef classname="org.netbeans.modules.java.j2seproject.copylibstask.CopyLibs" classpath="${libs.CopyLibs.classpath}" name="copylibs"/>
-        <copylibs compress="${jar.compress}" jarfile="${dist.jar}" runtimeclasspath="${run.classpath.without.build.classes.dir}">
-            <fileset dir="${build.classes.dir}"/>
-            <manifest>
-                <attribute name="Class-Path" value="${jar.classpath}"/>
-            </manifest>
-        </copylibs>
+    <target depends="init,compile,-pre-pre-jar,-pre-jar,-init-macrodef-copylibs" if="do.archive+manifest.available+main.class+mkdist.available" name="-do-jar-with-libraries" unless="splashscreen.available">
+        <j2seproject3:copylibs>
+            <customize>
+                <attribute name="Main-Class" value="${main.class}"/>
+            </customize>
+        </j2seproject3:copylibs>
+        <echo>To run this application from the command line without Ant, try:</echo>
+        <property location="${dist.jar}" name="dist.jar.resolved"/>
+        <echo>java -jar "${dist.jar.resolved}"</echo>
     </target>
     <target name="-post-jar">
         <!-- Empty placeholder for easier customization. -->
         <!-- You can override this target in the ../build.xml file. -->
     </target>
-    <target depends="init,compile,-pre-jar,-do-jar-with-manifest,-do-jar-without-manifest,-do-jar-with-mainclass,-do-jar-with-libraries,-do-jar-with-libraries-without-mainclass,-do-jar-with-libraries-without-manifest,-post-jar" description="Build JAR." name="jar"/>
+    <target depends="init,compile,-pre-jar,-do-jar-with-manifest,-do-jar-without-manifest,-do-jar-with-mainclass,-do-jar-with-libraries-and-splashscreen,-do-jar-with-libraries,-post-jar" description="Build JAR." name="jar"/>
     <!--
                 =================
                 EXECUTION SECTION
@@ -609,7 +690,7 @@
                 JAVADOC SECTION
                 ===============
             -->
-    <target depends="init" name="-javadoc-build">
+    <target depends="init" if="have.sources" name="-javadoc-build">
         <mkdir dir="${dist.javadoc.dir}"/>
         <javadoc additionalparam="${javadoc.additionalparam}" author="${javadoc.author}" charset="UTF-8" destdir="${dist.javadoc.dir}" docencoding="UTF-8" encoding="${javadoc.encoding.used}" failonerror="true" noindex="${javadoc.noindex}" nonavbar="${javadoc.nonavbar}" notree="${javadoc.notree}" private="${javadoc.private}" source="${javac.source}" splitindex="${javadoc.splitindex}" use="${javadoc.use}" useexternalfile="true" version="${javadoc.version}" windowtitle="${javadoc.windowtitle}">
             <classpath>
@@ -622,6 +703,14 @@
                 <include name="**/*.java"/>
             </fileset>
         </javadoc>
+        <copy todir="${dist.javadoc.dir}">
+            <fileset dir="${src.dir}" excludes="${excludes}" includes="${includes}">
+                <filename name="**/doc-files/**"/>
+            </fileset>
+            <fileset dir="${build.generated.sources.dir}" erroronmissingdir="false">
+                <include name="**/doc-files/**"/>
+            </fileset>
+        </copy>
     </target>
     <target depends="init,-javadoc-build" if="netbeans.home" name="-javadoc-browse" unless="no.javadoc.preview">
         <nbbrowse file="${dist.javadoc.dir}/index.html"/>
@@ -643,7 +732,7 @@
         <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="${test.src.dir}"/>
+        <j2seproject3:javac apgeneratedsrcdir="${build.test.classes.dir}" classpath="${javac.test.classpath}" debug="true" destdir="${build.test.classes.dir}" processorpath="${javac.test.processorpath}" srcdir="${test.src.dir}"/>
         <copy todir="${build.test.classes.dir}">
             <fileset dir="${test.src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
         </copy>
@@ -660,7 +749,7 @@
     <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="${test.src.dir}" srcdir="${test.src.dir}"/>
+        <j2seproject3:javac apgeneratedsrcdir="${build.test.classes.dir}" classpath="${javac.test.classpath}" debug="true" destdir="${build.test.classes.dir}" excludes="" includes="${javac.includes}" processorpath="${javac.test.processorpath}" 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>

Modified: trunk/abcl/nbproject/genfiles.properties
==============================================================================
--- trunk/abcl/nbproject/genfiles.properties	(original)
+++ trunk/abcl/nbproject/genfiles.properties	Wed Dec  1 17:44:34 2010
@@ -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=29122cc4
-nbproject/build-impl.xml.stylesheet.CRC32=576378a2 at 1.32.1.45
+nbproject/build-impl.xml.script.CRC32=330b50b7
+nbproject/build-impl.xml.stylesheet.CRC32=229523de at 1.38.3.45
 nbproject/profiler-build-impl.xml.data.CRC32=71623fcd
 nbproject/profiler-build-impl.xml.script.CRC32=abda56ed
 nbproject/profiler-build-impl.xml.stylesheet.CRC32=42cb6bcf

Modified: trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	Wed Dec  1 17:44:34 2010
@@ -511,12 +511,16 @@
   access-flags
   class
   superclass
-  ;; support for implementing interfaces not yet available
-  ;; interfaces
+  interfaces
   fields
   methods
   attributes)
 
+(defun make-class-interface-file (class)
+  "Create the components of a class file representing a public Java
+interface."
+  (make-class-file class +java-object+ '(:public :abstract :interface)))
+
 (defun class-add-field (class field)
   "Adds a `field' created by `make-field'."
   (push field (class-file-fields class)))
@@ -551,11 +555,34 @@
 structure classes which include the `attribute' structure class."
   (push attribute (class-file-attributes class)))
 
+(defun class-add-superinterface (class interface)
+  "Adds the java-class-name contained in `interface' as a superinterface of the `class'.
+
+For a class that represents an object, the requirements in `interface'
+must then be implemented in the class.  For a class that represents an
+interface, the `interface' imposes additional requirements to the
+classes which implement this class."
+  (push interface (class-file-interfaces class)))
+
 (defun class-attribute (class name)
   "Returns the attribute which is named `name'."
   (find name (class-file-attributes class)
         :test #'string= :key #'attribute-name))
 
+(defun finalize-interfaces (class)
+  "Finalize the interfaces for `class'.
+
+Interface finalization first ensures that all the classes referenced
+by the interfaces members exist in the pool.  Then, it destructively
+modfies the interfaces members with a list of the references to the
+corresponding pool indices."
+  (let ((interface-refs nil))
+    (dolist (interface (class-file-interfaces class))
+      (push 
+       (pool-add-class (class-file-constants class)
+                       interface)
+       interface-refs))
+    (setf (class-file-interfaces class) interface-refs)))
 
 (defun finalize-class-file (class)
   "Transforms the representation of the class-file from one
@@ -574,7 +601,7 @@
         (class-file-class class)
         (pool-add-class (class-file-constants class)
                         (class-file-class class)))
-  ;;  (finalize-interfaces)
+  (finalize-interfaces class)
   (dolist (field (class-file-fields class))
     (finalize-field field class))
   (dolist (method (class-file-methods class))
@@ -684,7 +711,12 @@
   (write-u2 (class-file-superclass class) stream)
 
   ;; interfaces
-  (write-u2 0 stream)
+  (if (class-file-interfaces class)
+      (progn 
+        (write-u2 (length (class-file-interfaces class)) stream)
+        (dolist (interface-ref (class-file-interfaces class))
+          (write-u2 interface-ref stream)))
+      (write-u2 0 stream))
 
   ;; fields
   (write-u2 (length (class-file-fields class)) stream)



From ehuelsmann at common-lisp.net  Thu Dec  2 09:38:30 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Thu, 02 Dec 2010 04:38:30 -0500
Subject: [armedbear-cvs] r13079 - tags/0.23.1
Message-ID: <E1PO5cU-0003LV-HC@common-lisp.net>

Author: ehuelsmann
Date: Thu Dec  2 04:38:29 2010
New Revision: 13079

Log:
Delete 0.23.1 tag; it reports 0.23.1-dev.
Retagging 0.23.1 in a minute.

Removed:
   tags/0.23.1/



From ehuelsmann at common-lisp.net  Thu Dec  2 09:39:48 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Thu, 02 Dec 2010 04:39:48 -0500
Subject: [armedbear-cvs] r13080 - in tags/0.23.1: .
	abcl/src/org/armedbear/lisp
Message-ID: <E1PO5dk-0003Mp-06@common-lisp.net>

Author: ehuelsmann
Date: Thu Dec  2 04:39:47 2010
New Revision: 13080

Log:
Re-tag 0.23.1.

Added:
   tags/0.23.1/
      - copied from r13074, /branches/0.23.x/
Modified:
   tags/0.23.1/abcl/src/org/armedbear/lisp/Version.java

Modified: tags/0.23.1/abcl/src/org/armedbear/lisp/Version.java
==============================================================================
--- /branches/0.23.x/abcl/src/org/armedbear/lisp/Version.java	(original)
+++ tags/0.23.1/abcl/src/org/armedbear/lisp/Version.java	Thu Dec  2 04:39:47 2010
@@ -41,7 +41,7 @@
 
   public static String getVersion()
   {
-    return "0.23.1-dev";
+    return "0.23.1";
   }
 
   public static void main(String args[]) {



From ehuelsmann at common-lisp.net  Thu Dec  2 09:42:07 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Thu, 02 Dec 2010 04:42:07 -0500
Subject: [armedbear-cvs] r13081 - public_html/releases/0.23.1
Message-ID: <E1PO5fz-00041G-8O@common-lisp.net>

Author: ehuelsmann
Date: Thu Dec  2 04:42:05 2010
New Revision: 13081

Log:
Delete tars which report the wrong version number.

Removed:
   public_html/releases/0.23.1/abcl-bin-0.23.1-dev.tar.gz
   public_html/releases/0.23.1/abcl-bin-0.23.1-dev.zip
   public_html/releases/0.23.1/abcl-src-0.23.1-dev.tar.gz
   public_html/releases/0.23.1/abcl-src-0.23.1-dev.zip



From ehuelsmann at common-lisp.net  Thu Dec  2 10:14:03 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Thu, 02 Dec 2010 05:14:03 -0500
Subject: [armedbear-cvs] r13082 - public_html/releases/0.23.1
Message-ID: <E1PO6At-0005bY-Jf@common-lisp.net>

Author: ehuelsmann
Date: Thu Dec  2 05:13:53 2010
New Revision: 13082

Log:
Add the right tarballs with the right version numbers
(no other changes).

Added:
   public_html/releases/0.23.1/abcl-bin-0.23.1.tar.gz   (contents, props changed)
   public_html/releases/0.23.1/abcl-bin-0.23.1.zip   (contents, props changed)
   public_html/releases/0.23.1/abcl-src-0.23.1.tar.gz   (contents, props changed)
   public_html/releases/0.23.1/abcl-src-0.23.1.zip   (contents, props changed)

Added: public_html/releases/0.23.1/abcl-bin-0.23.1.tar.gz
==============================================================================
Binary file. No diff available.

Added: public_html/releases/0.23.1/abcl-bin-0.23.1.zip
==============================================================================
Binary file. No diff available.

Added: public_html/releases/0.23.1/abcl-src-0.23.1.tar.gz
==============================================================================
Binary file. No diff available.

Added: public_html/releases/0.23.1/abcl-src-0.23.1.zip
==============================================================================
Binary file. No diff available.



From ehuelsmann at common-lisp.net  Thu Dec  2 11:48:56 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Thu, 02 Dec 2010 06:48:56 -0500
Subject: [armedbear-cvs] r13083 - public_html/releases/0.23.1
Message-ID: <E1PO7ei-0004dr-As@common-lisp.net>

Author: ehuelsmann
Date: Thu Dec  2 06:48:52 2010
New Revision: 13083

Log:
Add 0.23.1 signature files.

Added:
   public_html/releases/0.23.1/abcl-bin-0.23.1.tar.gz.asc
   public_html/releases/0.23.1/abcl-bin-0.23.1.zip.asc
   public_html/releases/0.23.1/abcl-src-0.23.1.tar.gz.asc
   public_html/releases/0.23.1/abcl-src-0.23.1.zip.asc

Added: public_html/releases/0.23.1/abcl-bin-0.23.1.tar.gz.asc
==============================================================================
--- (empty file)
+++ public_html/releases/0.23.1/abcl-bin-0.23.1.tar.gz.asc	Thu Dec  2 06:48:52 2010
@@ -0,0 +1,7 @@
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.9 (GNU/Linux)
+
+iEYEABECAAYFAkz3hMYACgkQi5O0Epaz9Tk42wCfeObZJgxZuIMLPQBG7V0zJrYV
+d1gAniTi+cRPkN659v0leFZnhiUODyFL
+=86RC
+-----END PGP SIGNATURE-----

Added: public_html/releases/0.23.1/abcl-bin-0.23.1.zip.asc
==============================================================================
--- (empty file)
+++ public_html/releases/0.23.1/abcl-bin-0.23.1.zip.asc	Thu Dec  2 06:48:52 2010
@@ -0,0 +1,7 @@
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.9 (GNU/Linux)
+
+iEYEABECAAYFAkz3hM4ACgkQi5O0Epaz9TkBiQCePHQC8513RnUBOYDu5YtMx/CF
+hrsAn2KkyPC5lgQvPRj+5I24VpfzP2u/
+=T4xE
+-----END PGP SIGNATURE-----

Added: public_html/releases/0.23.1/abcl-src-0.23.1.tar.gz.asc
==============================================================================
--- (empty file)
+++ public_html/releases/0.23.1/abcl-src-0.23.1.tar.gz.asc	Thu Dec  2 06:48:52 2010
@@ -0,0 +1,7 @@
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.9 (GNU/Linux)
+
+iEYEABECAAYFAkz3hOEACgkQi5O0Epaz9TkcxwCfUVc3TpsjkedptDhP/5eQ38k9
+tA0An3kvBV4j80h7l+w/zbdUuTedeQKY
+=Fp5f
+-----END PGP SIGNATURE-----

Added: public_html/releases/0.23.1/abcl-src-0.23.1.zip.asc
==============================================================================
--- (empty file)
+++ public_html/releases/0.23.1/abcl-src-0.23.1.zip.asc	Thu Dec  2 06:48:52 2010
@@ -0,0 +1,7 @@
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.9 (GNU/Linux)
+
+iEYEABECAAYFAkz3hOkACgkQi5O0Epaz9TlMoACfWfvVJaLOxymi+/aiGPKYOiJr
+w8oAn2GhCS5oWg+cb12kyzdUBbhL+8Op
+=/kUX
+-----END PGP SIGNATURE-----



From ehuelsmann at common-lisp.net  Thu Dec  2 11:52:00 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Thu, 02 Dec 2010 06:52:00 -0500
Subject: [armedbear-cvs] r13084 - public_html
Message-ID: <E1PO7hg-0004fL-8B@common-lisp.net>

Author: ehuelsmann
Date: Thu Dec  2 06:51:58 2010
New Revision: 13084

Log:
Update main page to refer to 0.23.1 as the latest available version.


Modified:
   public_html/index.shtml

Modified: public_html/index.shtml
==============================================================================
--- public_html/index.shtml	(original)
+++ public_html/index.shtml	Thu Dec  2 06:51:58 2010
@@ -61,24 +61,24 @@
     <tr>
       <td style="font-weight: bold">Binary</td>
       <td>
-        <a href="releases/0.23.0/abcl-bin-0.23.0.tar.gz">abcl-bin-0.23.0.tar.gz</a>
-        <a href="releases/0.23.0/abcl-bin-0.23.0.tar.gz.asc" class="asc">(pgp)</a>
+        <a href="releases/0.23.1/abcl-bin-0.23.1.tar.gz">abcl-bin-0.23.1.tar.gz</a>
+        <a href="releases/0.23.1/abcl-bin-0.23.1.tar.gz.asc" class="asc">(pgp)</a>
       </td>
       <td>
-        <a href="releases/0.23.0/abcl-bin-0.23.0.zip">abcl-bin-0.23.0.zip</a>
-        <a href="releases/0.23.0/abcl-bin-0.23.0.zip.asc" class="asc">(pgp)</a>
+        <a href="releases/0.23.1/abcl-bin-0.23.1.zip">abcl-bin-0.23.1.zip</a>
+        <a href="releases/0.23.1/abcl-bin-0.23.1.zip.asc" class="asc">(pgp)</a>
       </td>
     </tr>
 
     <tr>
       <td style="font-weight: bold">Source</td>
       <td>
-        <a href="releases/0.23.0/abcl-src-0.23.0.tar.gz">abcl-src-0.23.0.tar.gz</a>
-        <a href="releases/0.23.0/abcl-src-0.23.0.tar.gz.asc" class="asc">(pgp)</a>
+        <a href="releases/0.23.1/abcl-src-0.23.1.tar.gz">abcl-src-0.23.1.tar.gz</a>
+        <a href="releases/0.23.1/abcl-src-0.23.1.tar.gz.asc" class="asc">(pgp)</a>
       </td>
       <td>
-        <a href="releases/0.23.0/abcl-src-0.23.0.zip">abcl-src-0.23.0.zip</a>
-        <a href="releases/0.23.0/abcl-src-0.23.0.zip.asc" class="asc">(pgp)</a>
+        <a href="releases/0.23.1/abcl-src-0.23.1.zip">abcl-src-0.23.1.zip</a>
+        <a href="releases/0.23.1/abcl-src-0.23.1.zip.asc" class="asc">(pgp)</a>
       </td>
     </tr>
       



From ehuelsmann at common-lisp.net  Thu Dec  2 11:59:28 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Thu, 02 Dec 2010 06:59:28 -0500
Subject: [armedbear-cvs] r13085 - developer-resources
Message-ID: <E1PO7ou-0004l3-7D@common-lisp.net>

Author: ehuelsmann
Date: Thu Dec  2 06:59:27 2010
New Revision: 13085

Log:
Update announcement template with new tarball links.

Modified:
   developer-resources/release-announcement.txt

Modified: developer-resources/release-announcement.txt
==============================================================================
--- developer-resources/release-announcement.txt	(original)
+++ developer-resources/release-announcement.txt	Thu Dec  2 06:59:27 2010
@@ -1,9 +1,9 @@
-Subject: [ANNOUNCE] ABCL 0.18.0 released
+Subject: [ANNOUNCE] ABCL 0.23.1 released
 
 
 
 On behalf of the developers of ABCL (Armed Bear Common Lisp) I'm glad to
-be able to announce the 0.18.0 release.
+be able to announce the 0.23.1 release.
 
 ABCL is a Common Lisp implementation implemented in Java and running on the
 JVM, featuring both an interpreter and a compiler. The compiler targets the
@@ -13,11 +13,10 @@
 Java Specification Request (JSR) 223: Java scripting API.
 
 
-This release features - among lots of other things - faster initial startup,
-faster special variable lookup and portable fasl files. You can find the full
-release notes at:
+This release features - among lots of other things - <ADD_STUFF_HERE>.
+You can find the full release notes at:
 
- http://common-lisp.net/project/armedbear/release-notes-0.17.shtml
+ http://common-lisp.net/project/armedbear/release-notes-0.23.shtml
 
 and the list of changes at:
 
@@ -32,21 +31,21 @@
 
 Source distribution archives can be downloaded in ZIP or gzipped tar form:
 
- http://common-lisp.net/project/armedbear/releases/abcl-src-0.18.0.tar.gz
- http://common-lisp.net/project/armedbear/releases/abcl-src-0.18.0.zip
+ http://common-lisp.net/project/armedbear/releases/0.23.1/abcl-src-0.23.1.tar.gz
+ http://common-lisp.net/project/armedbear/releases/0.23.1/abcl-src-0.23.1.zip
 
 Signatures are available under:
- http://common-lisp.net/project/armedbear/releases/abcl-src-0.18.0.tar.gz.asc
- http://common-lisp.net/project/armedbear/releases/abcl-src-0.18.0.zip.asc
+ http://common-lisp.net/project/armedbear/0.23.1/releases/abcl-src-0.23.1.tar.gz.asc
+ http://common-lisp.net/project/armedbear/0.23.1/releases/abcl-src-0.23.1.zip.asc
 
 
 
 In addition, binaries are also available:
 
- http://common-lisp.net/project/armedbear/releases/abcl-bin-0.18.0.tar.gz
- http://common-lisp.net/project/armedbear/releases/abcl-bin-0.18.0.zip
+ http://common-lisp.net/project/armedbear/releases/0.23.1/abcl-bin-0.23.1.tar.gz
+ http://common-lisp.net/project/armedbear/releases/0.23.1/abcl-bin-0.23.1.zip
 
 With associated signatures:
- http://common-lisp.net/project/armedbear/releases/abcl-bin-0.18.0.tar.gz.asc
- http://common-lisp.net/project/armedbear/releases/abcl-bin-0.18.0.zip.asc
+ http://common-lisp.net/project/armedbear/releases/abcl-bin-0.23.1.tar.gz.asc
+ http://common-lisp.net/project/armedbear/releases/abcl-bin-0.23.1.zip.asc
 



From mevenson at common-lisp.net  Fri Dec  3 12:25:25 2010
From: mevenson at common-lisp.net (Mark Evenson)
Date: Fri, 03 Dec 2010 07:25:25 -0500
Subject: [armedbear-cvs] r13086 - trunk/abcl/test/lisp/abcl
Message-ID: <E1POUhZ-00057N-6T@common-lisp.net>

Author: mevenson
Date: Fri Dec  3 07:25:24 2010
New Revision: 13086

Log:
Update HTTP LOAD tests for FASL version 37.

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

Modified: trunk/abcl/test/lisp/abcl/jar-pathname.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/jar-pathname.lisp	(original)
+++ trunk/abcl/test/lisp/abcl/jar-pathname.lisp	Fri Dec  3 07:25:24 2010
@@ -102,7 +102,7 @@
 ;;; XXX come up with a better abstraction
 
 (defvar *url-jar-pathname-base*
-  "jar:http://abcl-dynamic-install.googlecode.com/files/baz-20100505a.jar!/")
+  "jar:http://abcl-dynamic-install.googlecode.com/files/baz-20101103a.jar!/")
 
 (defmacro load-url-relative (path) 
   `(load (format nil "~A~A" *url-jar-pathname-base* ,path)))



From mevenson at common-lisp.net  Fri Dec  3 14:02:12 2010
From: mevenson at common-lisp.net (Mark Evenson)
Date: Fri, 03 Dec 2010 09:02:12 -0500
Subject: [armedbear-cvs] r13087 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1POWDE-0005nv-Es@common-lisp.net>

Author: mevenson
Date: Fri Dec  3 09:02:11 2010
New Revision: 13087

Log:
Upgrade to ASDF-2.011.

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

Modified: trunk/abcl/src/org/armedbear/lisp/asdf.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/asdf.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/asdf.lisp	Fri Dec  3 09:02:11 2010
@@ -68,20 +68,25 @@
 
 ;;;; Create packages in a way that is compatible with hot-upgrade.
 ;;;; See https://bugs.launchpad.net/asdf/+bug/485687
-;;;; See more at the end of the file.
+;;;; See more near the end of the file.
 
 (eval-when (:load-toplevel :compile-toplevel :execute)
   (defvar *asdf-version* nil)
   (defvar *upgraded-p* nil)
-  (let* ((asdf-version "2.010.1") ;; bump this version when you modify this file. Same as 2.147
+  (let* (;; For bug reporting sanity, please always bump this version when you modify this file.
+         ;; "2.345" would be an official release
+         ;; "2.345.6" would be a development version in the official upstream
+         ;; "2.345.0.7" would be your local modification of an official release
+         ;; "2.345.6.7" would be your local modification of a development version
+         (asdf-version "2.011")
          (existing-asdf (fboundp 'find-system))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
     (unless (and existing-asdf already-there)
       (when existing-asdf
-        (format *error-output*
-                "~&Upgrading ASDF package ~@[from version ~A ~]to version ~A~%"
-                existing-version asdf-version))
+        (format *trace-output*
+         "~&~@<; ~@;Upgrading ASDF package ~@[from version ~A ~]to version ~A~@:>~%"
+         existing-version asdf-version))
       (labels
           ((unlink-package (package)
              (let ((u (find-package package)))
@@ -182,7 +187,8 @@
             #:apply-output-translations #:translate-pathname* #:resolve-location)
            :unintern
            (#:*asdf-revision* #:around #:asdf-method-combination
-            #:split #:make-collector)
+            #:split #:make-collector
+            #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function
            :fmakunbound
            (#:system-source-file
             #:component-relative-pathname #:system-relative-pathname
@@ -236,6 +242,7 @@
             #:system-relative-pathname
             #:map-systems
 
+            #:operation-description
             #:operation-on-warnings
             #:operation-on-failure
             #:component-visited-p
@@ -288,7 +295,7 @@
 
             ;; Utilities
             #:absolute-pathname-p
-	    ;; #:aif #:it
+            ;; #:aif #:it
             ;; #:appendf
             #:coerce-name
             #:directory-pathname-p
@@ -297,11 +304,12 @@
             #:getenv
             ;; #:get-uid
             ;; #:length=n-p
+            ;; #:find-symbol*
             #:merge-pathnames*
             #:pathname-directory-pathname
             #:read-file-forms
-	    ;; #:remove-keys
-	    ;; #:remove-keyword
+            ;; #:remove-keys
+            ;; #:remove-keyword
             #:resolve-symlinks
             #:split-string
             #:component-name-to-pathname-components
@@ -314,26 +322,6 @@
                                (cons existing-version *upgraded-p*)
                                *upgraded-p*))))))
 
-;; More cleanups in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
-(when *upgraded-p*
-   #+ecl
-   (when (find-class 'compile-op nil)
-     (defmethod update-instance-for-redefined-class :after
-         ((c compile-op) added deleted plist &key)
-       (declare (ignore added deleted))
-       (let ((system-p (getf plist 'system-p)))
-         (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))))
-   (when (find-class 'module nil)
-     (eval
-      '(defmethod update-instance-for-redefined-class :after
-           ((m module) added deleted plist &key)
-         (declare (ignorable deleted plist))
-         (when *asdf-verbose* (format *trace-output* "Updating ~A~%" m))
-         (when (member 'components-by-name added)
-           (compute-module-components-by-name m))
-         (when (and (typep m 'system) (member 'source-file added))
-           (%set-system-source-file (probe-asd (component-name m) (component-pathname m)) m))))))
-
 ;;;; -------------------------------------------------------------------------
 ;;;; User-visible parameters
 ;;;;
@@ -375,7 +363,8 @@
     (setf excl:*warn-on-nested-reader-conditionals* nil)))
 
 ;;;; -------------------------------------------------------------------------
-;;;; ASDF Interface, in terms of generic functions.
+;;;; General Purpose Utilities
+
 (macrolet
     ((defdef (def* def)
        `(defmacro ,def* (name formals &rest rest)
@@ -387,113 +376,6 @@
   (defdef defgeneric* defgeneric)
   (defdef defun* defun))
 
-(defgeneric* find-system (system &optional error-p))
-(defgeneric* perform-with-restarts (operation component))
-(defgeneric* perform (operation component))
-(defgeneric* operation-done-p (operation component))
-(defgeneric* explain (operation component))
-(defgeneric* output-files (operation component))
-(defgeneric* input-files (operation component))
-(defgeneric* component-operation-time (operation component))
-(defgeneric* operation-description (operation component)
-  (:documentation "returns a phrase that describes performing this operation
-on this component, e.g. \"loading /a/b/c\".
-You can put together sentences using this phrase."))
-
-(defgeneric* system-source-file (system)
-  (:documentation "Return the source file in which system is defined."))
-
-(defgeneric* component-system (component)
-  (:documentation "Find the top-level system containing COMPONENT"))
-
-(defgeneric* component-pathname (component)
-  (:documentation "Extracts the pathname applicable for a particular component."))
-
-(defgeneric* component-relative-pathname (component)
-  (:documentation "Returns a pathname for the component argument intended to be
-interpreted relative to the pathname of that component's parent.
-Despite the function's name, the return value may be an absolute
-pathname, because an absolute pathname may be interpreted relative to
-another pathname in a degenerate way."))
-
-(defgeneric* component-property (component property))
-
-(defgeneric* (setf component-property) (new-value component property))
-
-(defgeneric* version-satisfies (component version))
-
-(defgeneric* find-component (base path)
-  (:documentation "Finds the component with PATH starting from BASE module;
-if BASE is nil, then the component is assumed to be a system."))
-
-(defgeneric* source-file-type (component system))
-
-(defgeneric* operation-ancestor (operation)
-  (:documentation
-   "Recursively chase the operation's parent pointer until we get to
-the head of the tree"))
-
-(defgeneric* component-visited-p (operation component)
-  (:documentation "Returns the value stored by a call to
-VISIT-COMPONENT, if that has been called, otherwise NIL.
-This value stored will be a cons cell, the first element
-of which is a computed key, so not interesting.  The
-CDR wil be the DATA value stored by VISIT-COMPONENT; recover
-it as (cdr (component-visited-p op c)).
-  In the current form of ASDF, the DATA value retrieved is
-effectively a boolean, indicating whether some operations are
-to be performed in order to do OPERATION X COMPONENT.  If the
-data value is NIL, the combination had been explored, but no
-operations needed to be performed."))
-
-(defgeneric* visit-component (operation component data)
-  (:documentation "Record DATA as being associated with OPERATION
-and COMPONENT.  This is a side-effecting function:  the association
-will be recorded on the ROOT OPERATION \(OPERATION-ANCESTOR of the
-OPERATION\).
-  No evidence that DATA is ever interesting, beyond just being
-non-NIL.  Using the data field is probably very risky; if there is
-already a record for OPERATION X COMPONENT, DATA will be quietly
-discarded instead of recorded.
-  Starting with 2.006, TRAVERSE will store an integer in data,
-so that nodes can be sorted in decreasing order of traversal."))
-
-
-(defgeneric* (setf visiting-component) (new-value operation component))
-
-(defgeneric* component-visiting-p (operation component))
-
-(defgeneric* component-depends-on (operation component)
-  (:documentation
-   "Returns a list of dependencies needed by the component to perform
-    the operation.  A dependency has one of the following forms:
-
-      (<operation> <component>*), where <operation> is a class
-        designator and each <component> is a component
-        designator, which means that the component depends on
-        <operation> having been performed on each <component>; or
-
-      (FEATURE <feature>), which means that the component depends
-        on <feature>'s presence in *FEATURES*.
-
-    Methods specialized on subclasses of existing component types
-    should usually append the results of CALL-NEXT-METHOD to the
-    list."))
-
-(defgeneric* component-self-dependencies (operation component))
-
-(defgeneric* traverse (operation component)
-  (:documentation
-"Generate and return a plan for performing OPERATION on COMPONENT.
-
-The plan returned is a list of dotted-pairs. Each pair is the CONS
-of ASDF operation object and a COMPONENT object. The pairs will be
-processed in order by OPERATE."))
-
-
-;;;; -------------------------------------------------------------------------
-;;;; General Purpose Utilities
-
 (defmacro while-collecting ((&rest collectors) &body body)
   "COLLECTORS should be a list of names for collections.  A collector
 defines a function that, when applied to an argument inside BODY, will
@@ -672,9 +554,8 @@
     :append (list k v)))
 
 (defun* getenv (x)
-  (#+abcl ext:getenv
+  (#+(or abcl clisp) ext:getenv
    #+allegro sys:getenv
-   #+clisp ext:getenv
    #+clozure ccl:getenv
    #+(or cmu scl) (lambda (x) (cdr (assoc x ext:*environment-list* :test #'string=)))
    #+ecl si:getenv
@@ -720,7 +601,8 @@
                    :defaults pathspec))))
 
 (defun* absolute-pathname-p (pathspec)
-  (and pathspec (eq :absolute (car (pathname-directory (pathname pathspec))))))
+  (and (typep pathspec '(or pathname string))
+       (eq :absolute (car (pathname-directory (pathname pathspec))))))
 
 (defun* length=n-p (x n) ;is it that (= (length x) n) ?
   (check-type n (integer 0 *))
@@ -752,7 +634,7 @@
   (defun* get-uid ()
     #+allegro (excl.osi:getuid)
     #+clisp (loop :for s :in '("posix:uid" "LINUX:getuid")
-	          :for f = (ignore-errors (read-from-string s))
+                  :for f = (ignore-errors (read-from-string s))
                   :when f :return (funcall f))
     #+(or cmu scl) (unix:unix-getuid)
     #+ecl #.(cl:if (cl:< ext:+ecl-version-number+ 100601)
@@ -774,6 +656,9 @@
                  :directory '(:absolute)
                  :name nil :type nil :version nil))
 
+(defun* find-symbol* (s p)
+  (find-symbol (string s) p))
+
 (defun* probe-file* (p)
   "when given a pathname P, probes the filesystem for a file or directory
 with given pathname and if it exists return its truename."
@@ -782,8 +667,8 @@
    (string (probe-file* (parse-namestring p)))
    (pathname (unless (wild-pathname-p p)
                #.(or #+(or allegro clozure cmu ecl sbcl scl) '(probe-file p)
-               #+clisp (aif (find-symbol (string :probe-pathname) :ext) `(ignore-errors (,it p)))
-	       '(ignore-errors (truename p)))))))
+               #+clisp (aif (find-symbol (string '#:probe-pathname) :ext) `(ignore-errors (,it p)))
+               '(ignore-errors (truename p)))))))
 
 (defun* truenamize (p)
   "Resolve as much of a pathname as possible"
@@ -856,6 +741,134 @@
         (translate-pathname absolute-pathname wild-root (wilden new-base))))))
 
 ;;;; -------------------------------------------------------------------------
+;;;; ASDF Interface, in terms of generic functions.
+(defgeneric* find-system (system &optional error-p))
+(defgeneric* perform-with-restarts (operation component))
+(defgeneric* perform (operation component))
+(defgeneric* operation-done-p (operation component))
+(defgeneric* explain (operation component))
+(defgeneric* output-files (operation component))
+(defgeneric* input-files (operation component))
+(defgeneric* component-operation-time (operation component))
+(defgeneric* operation-description (operation component)
+  (:documentation "returns a phrase that describes performing this operation
+on this component, e.g. \"loading /a/b/c\".
+You can put together sentences using this phrase."))
+
+(defgeneric* system-source-file (system)
+  (:documentation "Return the source file in which system is defined."))
+
+(defgeneric* component-system (component)
+  (:documentation "Find the top-level system containing COMPONENT"))
+
+(defgeneric* component-pathname (component)
+  (:documentation "Extracts the pathname applicable for a particular component."))
+
+(defgeneric* component-relative-pathname (component)
+  (:documentation "Returns a pathname for the component argument intended to be
+interpreted relative to the pathname of that component's parent.
+Despite the function's name, the return value may be an absolute
+pathname, because an absolute pathname may be interpreted relative to
+another pathname in a degenerate way."))
+
+(defgeneric* component-property (component property))
+
+(defgeneric* (setf component-property) (new-value component property))
+
+(defgeneric* version-satisfies (component version))
+
+(defgeneric* find-component (base path)
+  (:documentation "Finds the component with PATH starting from BASE module;
+if BASE is nil, then the component is assumed to be a system."))
+
+(defgeneric* source-file-type (component system))
+
+(defgeneric* operation-ancestor (operation)
+  (:documentation
+   "Recursively chase the operation's parent pointer until we get to
+the head of the tree"))
+
+(defgeneric* component-visited-p (operation component)
+  (:documentation "Returns the value stored by a call to
+VISIT-COMPONENT, if that has been called, otherwise NIL.
+This value stored will be a cons cell, the first element
+of which is a computed key, so not interesting.  The
+CDR wil be the DATA value stored by VISIT-COMPONENT; recover
+it as (cdr (component-visited-p op c)).
+  In the current form of ASDF, the DATA value retrieved is
+effectively a boolean, indicating whether some operations are
+to be performed in order to do OPERATION X COMPONENT.  If the
+data value is NIL, the combination had been explored, but no
+operations needed to be performed."))
+
+(defgeneric* visit-component (operation component data)
+  (:documentation "Record DATA as being associated with OPERATION
+and COMPONENT.  This is a side-effecting function:  the association
+will be recorded on the ROOT OPERATION \(OPERATION-ANCESTOR of the
+OPERATION\).
+  No evidence that DATA is ever interesting, beyond just being
+non-NIL.  Using the data field is probably very risky; if there is
+already a record for OPERATION X COMPONENT, DATA will be quietly
+discarded instead of recorded.
+  Starting with 2.006, TRAVERSE will store an integer in data,
+so that nodes can be sorted in decreasing order of traversal."))
+
+
+(defgeneric* (setf visiting-component) (new-value operation component))
+
+(defgeneric* component-visiting-p (operation component))
+
+(defgeneric* component-depends-on (operation component)
+  (:documentation
+   "Returns a list of dependencies needed by the component to perform
+    the operation.  A dependency has one of the following forms:
+
+      (<operation> <component>*), where <operation> is a class
+        designator and each <component> is a component
+        designator, which means that the component depends on
+        <operation> having been performed on each <component>; or
+
+      (FEATURE <feature>), which means that the component depends
+        on <feature>'s presence in *FEATURES*.
+
+    Methods specialized on subclasses of existing component types
+    should usually append the results of CALL-NEXT-METHOD to the
+    list."))
+
+(defgeneric* component-self-dependencies (operation component))
+
+(defgeneric* traverse (operation component)
+  (:documentation
+"Generate and return a plan for performing OPERATION on COMPONENT.
+
+The plan returned is a list of dotted-pairs. Each pair is the CONS
+of ASDF operation object and a COMPONENT object. The pairs will be
+processed in order by OPERATE."))
+
+
+;;;; -------------------------------------------------------------------------
+;;; Methods in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
+(when *upgraded-p*
+   #+ecl
+   (when (find-class 'compile-op nil)
+     (defmethod update-instance-for-redefined-class :after
+         ((c compile-op) added deleted plist &key)
+       (declare (ignore added deleted))
+       (let ((system-p (getf plist 'system-p)))
+         (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))))
+   (when (find-class 'module nil)
+     (eval
+      `(defmethod update-instance-for-redefined-class :after
+           ((m module) added deleted plist &key)
+         (declare (ignorable deleted plist))
+         (when (or *asdf-verbose* *load-verbose*)
+           (asdf-message "~&~@<; ~@; Updating ~A for ASDF ~A~@:>~%" m ,(asdf-version)))
+         (when (member 'components-by-name added)
+           (compute-module-components-by-name m))
+         (when (and (typep m 'system) (member 'source-file added))
+           (%set-system-source-file (probe-asd (component-name m) (component-pathname m)) m))))))
+
+;;;; -------------------------------------------------------------------------
 ;;;; Classes, Conditions
 
 (define-condition system-definition-error (error) ()
@@ -997,7 +1010,7 @@
   (format s "~@<component ~S not found~@[ in ~A~]~@:>"
           (missing-requires c)
           (when (missing-parent c)
-            (component-name (missing-parent c)))))
+            (coerce-name (missing-parent c)))))
 
 (defmethod print-object ((c missing-component-of-version) s)
   (format s "~@<component ~S does not match version ~A~@[ in ~A~]~@:>"
@@ -1292,7 +1305,7 @@
                                     :condition condition))))
                  (let ((*package* package))
                    (asdf-message
-                    "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%"
+                    "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%"
                     on-disk *package*)
                    (load on-disk)))
             (delete-package package))))
@@ -1306,19 +1319,22 @@
            (error 'missing-component :requires name)))))))
 
 (defun* register-system (name system)
-  (asdf-message "~&~@<; ~@;registering ~A as ~A~@:>~%" system name)
+  (asdf-message "~&~@<; ~@;Registering ~A as ~A~@:>~%" system name)
   (setf (gethash (coerce-name name) *defined-systems*)
         (cons (get-universal-time) system)))
 
 (defun* find-system-fallback (requested fallback &rest keys &key source-file &allow-other-keys)
   (setf fallback (coerce-name fallback)
-        source-file (or source-file *compile-file-truename* *load-truename*)
+        source-file (or source-file
+                        (if *resolve-symlinks*
+                            (or *compile-file-truename* *load-truename*)
+                            (or *compile-file-pathname* *load-pathname*)))
         requested (coerce-name requested))
   (when (equal requested fallback)
     (let* ((registered (cdr (gethash fallback *defined-systems*)))
            (system (or registered
                        (apply 'make-instance 'system
-			      :name fallback :source-file source-file keys))))
+                              :name fallback :source-file source-file keys))))
       (unless registered
         (register-system fallback system))
       (throw 'find-system system))))
@@ -2198,9 +2214,9 @@
 
 (defun* class-for-type (parent type)
   (or (loop :for symbol :in (list
-                             (unless (keywordp type) type)
-                             (find-symbol (symbol-name type) *package*)
-                             (find-symbol (symbol-name type) :asdf))
+                             type
+                             (find-symbol* type *package*)
+                             (find-symbol* type :asdf))
         :for class = (and symbol (find-class symbol nil))
         :when (and class (subtypep class 'component))
         :return class)
@@ -2387,8 +2403,8 @@
                  #+mswindows "sh" #-mswindows "/bin/sh" command)
          :input nil :whole nil
          #+mswindows :show-window #+mswindows :hide)
-      (format *verbose-out* "~{~&; ~a~%~}~%" stderr)
-      (format *verbose-out* "~{~&; ~a~%~}~%" stdout)
+      (asdf-message "~{~&; ~a~%~}~%" stderr)
+      (asdf-message "~{~&; ~a~%~}~%" stdout)
       exit-code)
 
     #+clisp                     ;XXX not exactly *verbose-out*, I know
@@ -3118,6 +3134,18 @@
 ;;;; -----------------------------------------------------------------
 ;;;; Compatibility mode for ASDF-Binary-Locations
 
+(defmethod operate :before (operation-class system &rest args &key &allow-other-keys)
+  (declare (ignorable operation-class system args))
+  (when (find-symbol* '#:output-files-for-system-and-operation :asdf)
+    (error "ASDF 2 is not compatible with ASDF-BINARY-LOCATIONS, which you are using.
+ASDF 2 now achieves the same purpose with its builtin ASDF-OUTPUT-TRANSLATIONS,
+which should be easier to configure. Please stop using ASDF-BINARY-LOCATIONS,
+and instead use ASDF-OUTPUT-TRANSLATIONS. See the ASDF manual for details.
+In case you insist on preserving your previous A-B-L configuration, but
+do not know how to achieve the same effect with A-O-T, you may use function
+ASDF:ENABLE-ASDF-BINARY-LOCATIONS-COMPATIBILITY as documented in the manual;
+call that function where you would otherwise have loaded and configured A-B-L.")))
+
 (defun* enable-asdf-binary-locations-compatibility
     (&key
      (centralize-lisp-binaries nil)
@@ -3545,7 +3573,7 @@
   (clear-output-translations))
 
 ;;;; -----------------------------------------------------------------
-;;;; Hook into REQUIRE for ABCL, ClozureCL, CMUCL, ECL and SBCL
+;;;; Hook into REQUIRE for ABCL, CLISP, ClozureCL, CMUCL, ECL and SBCL
 ;;;;
 (defun* module-provide-asdf (name)
   (handler-bind
@@ -3561,7 +3589,7 @@
         t))))
 
 #+(or abcl clisp clozure cmu ecl sbcl)
-(let ((x (and #+clisp (find-symbol "*MODULE-PROVIDER-FUNCTIONS*" :custom))))
+(let ((x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom))))
   (when x
     (eval `(pushnew 'module-provide-asdf
             #+abcl sys::*module-provider-functions*



From ehuelsmann at common-lisp.net  Sat Dec  4 19:25:48 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 04 Dec 2010 14:25:48 -0500
Subject: [armedbear-cvs] r13078 - svn:log
Message-ID: <E1POxjw-00016A-2w@common-lisp.net>

Author: ehuelsmann
Revision: 13078
Property Name: svn:log
Action: added

Property value:
The classfile writer now handles the creation of interfaces.

JVM::MAKE-CLASS-INTERFACE-FILE will create a classfile structure
suitable for defining a Java interface.  Simply add abstract methods
to complete the definition.

JVM::ADD-SUPERINTERFACE adds an interface definition to a classfile.
For a classfile denoting a Java object, these interfaces correspond
to the contents of a Java language "implements" clause.  For a classfile
denoting a Java interface, these interfaces are all added to the
contract defined by this interfaces corresponding to the Java language
"extends" clause.

[Includes accidental update of NetBeans project files.]



From mevenson at common-lisp.net  Sun Dec  5 07:50:48 2010
From: mevenson at common-lisp.net (Mark Evenson)
Date: Sun, 05 Dec 2010 02:50:48 -0500
Subject: [armedbear-cvs] r13088 - trunk/abcl/src/org/armedbear/lisp/util
Message-ID: <E1PP9Mu-0003VO-8W@common-lisp.net>

Author: mevenson
Date: Sun Dec  5 02:50:47 2010
New Revision: 13088

Log:
Fix algorithim error in writing byte sequences via RandomAccessCharacterFile.

Found and fixed by David Kirkman.

Modified:
   trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java

Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	Sun Dec  5 02:50:47 2010
@@ -547,7 +547,7 @@
     final void write(byte[] b, int off, int len) throws IOException {
         int pos = off;
         while (pos < off + len) {
-            int want = len;
+            int want = len - pos + off;
             if (want > bbuf.remaining()) {
                 want = bbuf.remaining();
             }



From mevenson at common-lisp.net  Sun Dec  5 17:13:15 2010
From: mevenson at common-lisp.net (Mark Evenson)
Date: Sun, 05 Dec 2010 12:13:15 -0500
Subject: [armedbear-cvs] r13089 - trunk/abcl/examples/misc
Message-ID: <E1PPI9D-0001ki-Fi@common-lisp.net>

Author: mevenson
Date: Sun Dec  5 12:13:13 2010
New Revision: 13089

Log:
An example of using the ability to dynamically create Java interfaces.

This can probably be cleaned up a lot.  Among other things, it shows a
nearly constant need to protect the "raw" Java values from ABCL's
interpretation to do anything useful.  For example

  (let ((c (jclass "java.io.File")))
    (jnew-array-from-array "java.lang.Class" #(c c c)))

fails to construct an array as the java.lang.Class members are
promoted to JAVA-OBJECT.  Does this mean we need
JNEW-ARRAY-FROM-ARRAY-RAW?  Or do we need to try both interpretations?

Added:
   trunk/abcl/examples/misc/dynamic-interfaces.lisp

Added: trunk/abcl/examples/misc/dynamic-interfaces.lisp
==============================================================================
--- (empty file)
+++ trunk/abcl/examples/misc/dynamic-interfaces.lisp	Sun Dec  5 12:13:13 2010
@@ -0,0 +1,147 @@
+(in-package :cl-user)
+;;;; Copyright (C) 2010 by Mark Evenson
+
+#|
+
+A tour of the ABCL Java FFI by defining a Java interface at return,
+creating a Java proxy implementation that provides a Lisp
+implementation, and then use of the Java Reflection API to actually
+invoke the Lisp implementation.
+
+This needs abcl-0.24.0-dev or later.
+
+|#
+
+(defun define-java-interface (name package methods 
+                              &optional (superinterfaces nil))
+"Define a class for a Java interface called NAME in PACKAGE with METHODS.
+
+METHODS is a list of (NAME RETURN-TYPE (ARG-TYPES)) entries.  NAME is
+a string.  The values of RETURN-TYPE and the list of ARG-TYPES for the
+defined method follow the are either references to Java objects as
+created by JVM::MAKE-JVM-CLASS-NAME, or keywords representing Java
+primtive types as contained in JVM::MAP-PRIMITIVE-TYPE.
+
+SUPERINTERFACES optionally contains a list of interfaces that this
+interface extends specified as fully qualifed dotted Java names."
+  (let* ((class-name-string (format nil "~A/~A" package name))
+         (class-name (jvm::make-jvm-class-name class-name-string))
+         (class (jvm::make-class-interface-file class-name)))
+    (dolist (superinterface superinterfaces)
+      (jvm::class-add-superinterface 
+       class 
+       (if (type-of superinterface 'jvm::jvm-class-name)
+           superinterface
+           (jvm::make-jvm-class-name superinterface))))
+    (dolist (method methods)
+      (let ((name (first method))
+            (returns (second method))
+            (args (third method)))
+      (jvm::class-add-method
+       class
+       (jvm::make-jvm-method name returns args
+                             :flags '(:public :abstract)))))
+    (jvm::finalize-class-file class)
+    (let ((s (sys::%make-byte-array-output-stream)))
+      (jvm::write-class-file class s)
+      (sys::%get-output-stream-bytes s))))
+    
+(defun load-class (class-bytes) 
+  "Load the Java byte[] array CLASS-BYTES as a Java class."
+  (let ((load-class-method 
+         (jmethod "org.armedbear.lisp.JavaClassLoader"
+                  "loadClassFromByteArray" "[B")))
+    (jcall load-class-method java::*classloader* class-bytes)))
+
+;;; Unused in the interface example, but useful to get at the class
+;;; definition with javap or jad
+(defun write-class (class-bytes pathname)
+  "Write the Java byte[] array CLASS-BYTES to PATHNAME."
+  (with-open-file (stream pathname 
+                          :direction :output 
+                          :element-type '(signed-byte 8))
+    (dotimes (i (jarray-length class-bytes))
+      (write-byte (jarray-ref class-bytes i) stream))))
+
+;;;; The example begins here.  We store all the intermediate values as
+;;;; parameters so they may be inspected by those that follow this example.
+
+;;; Construct a Java interface as an array of bytes containing the
+;;; Java class
+;;;
+;;; This corresponds to the Java source:
+;;;
+;;;   package org.not.tmp;
+;;;   public interface Foo {
+;;;     public int add(int a, int b);
+;;;   }
+(defparameter *foo-bytes*
+  (define-java-interface "Foo" "org/not/tmp" 
+    '(("add" :int (:int :int)))))
+
+;;; Load the class definition into the JVM
+(defparameter *foo-interface-class* (load-class *foo-bytes*))
+
+;;; Create an implementation of the interface in Lisp. 
+(defparameter *foo*
+  (jinterface-implementation "org.not.tmp.Foo"
+                             "add" 
+                             (lambda (a b) 
+                               (reduce  #'+
+                                        (mapcar (lambda (n) 
+                                                  (jcall "intValue" n))
+                                                (list a b))))))
+
+;;; To get the class of what we just defined, we have to use Proxy.getProxyClass()
+(defparameter *foo-class*
+       ;; XXX would prettier if something like 
+       ;;   (jarray-from-array-raw `#(,*foo-class*)) 
+       ;; existed.
+       (let ((interface-array (jnew-array "java.lang.Class" 1)))
+         (setf (jarray-ref interface-array 0) *foo-interface-class*)
+         (jstatic-raw "getProxyClass" "java.lang.reflect.Proxy" 
+                      java::*classloader* interface-array)))
+         
+
+;;; Get a reference to the callable instance of this method.
+(defparameter *callable-foo* 
+  (jstatic-raw "getInvocationHandler" "java.lang.reflect.Proxy"  *foo*))
+
+;;; In order to use *callable-foo* we need to reflect the method we are
+;;; going to invoke.
+
+;;; First we construct a Java array of classes for the parameters
+(defparameter *add-parameters*
+  ;; XXX again a jnew-array-from-array-raw would help here.
+  (let ((parameters (jnew-array "java.lang.Class" 2)))
+    (setf (jarray-ref parameters 0)
+          (jfield-raw "java.lang.Integer" "TYPE")
+          (jarray-ref parameters 1)
+          (jfield-raw "java.lang.Integer" "TYPE"))
+    parameters))
+
+;;; Then we get the reflected instance of the method.
+(defparameter *add-method*
+  (jcall "getMethod" *foo-class* "add" *add-parameters*))
+
+;;; Now we construct the actual arguments we are going to call with
+(defparameter *add-args*
+  (let ((args (jnew-array "java.lang.Integer" 2)))
+    (setf (jarray-ref args 0)
+          (jnew "java.lang.Integer" 2)
+          (jarray-ref args 1)
+          (jnew "java.lang.Integer" 2))
+    args))
+
+;;; It isn't strictly necessary to define the method parameter to
+;;; JCALL in this manner, but it is more efficient in that the runtime
+;;; does not have to dynamically introspect for the correct method.  
+(defconstant +invocation-handler-invoke+
+  (jmethod "java.lang.reflect.InvocationHandler" 
+           "invoke" "java.lang.Object" "java.lang.reflect.Method" "[Ljava.lang.Object;"))
+
+;; And finally we can make the call
+#|
+(jcall +invocation-handler-invoke+ *callable-foo* *foo* *add-method* *add-args*)
+|#
+



From vvoutilainen at common-lisp.net  Fri Dec 10 15:58:12 2010
From: vvoutilainen at common-lisp.net (Ville Voutilainen)
Date: Fri, 10 Dec 2010 10:58:12 -0500
Subject: [armedbear-cvs] r13090 - in trunk/abcl/src/org/armedbear/lisp: .
	java/swing
Message-ID: <E1PR5MK-0001dI-L0@common-lisp.net>

Author: vvoutilainen
Date: Fri Dec 10 10:58:09 2010
New Revision: 13090

Log:
Make --batch exit, use Lisp.exit() in places where applicable so
that the streams are flushed, hence allowing --eval output
to be flushed.


Modified:
   trunk/abcl/src/org/armedbear/lisp/Extensions.java
   trunk/abcl/src/org/armedbear/lisp/Interpreter.java
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/java/swing/REPLConsole.java

Modified: trunk/abcl/src/org/armedbear/lisp/Extensions.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Extensions.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Extensions.java	Fri Dec 10 10:58:09 2010
@@ -227,6 +227,8 @@
     @Override
     public LispObject execute()
     {
+      ((Stream)Symbol.STANDARD_OUTPUT.getSymbolValue())._finishOutput();
+      ((Stream)Symbol.ERROR_OUTPUT.getSymbolValue())._finishOutput();
       exit(0);
       return LispThread.currentThread().nothing();
     }

Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java	Fri Dec 10 10:58:09 2010
@@ -244,7 +244,7 @@
                         ++i;
                     } else {
                         System.err.println("No argument supplied to --eval");
-                        System.exit(1);
+                        exit(1);
                     }
                 } else if (arg.equals("--load") ||
                            arg.equals("--load-system-file")) {
@@ -252,7 +252,7 @@
                         ++i;
                     } else {
                         System.err.println("No argument supplied to --load");
-                        System.exit(1);
+                        exit(1);
                     }
                 } else {
                     arglist = new Cons(args[i], arglist);
@@ -292,13 +292,13 @@
                             sb.append(c.getCondition().writeToString());
                             sb.append(separator);
                             System.err.print(sb.toString());
-                            System.exit(2);
+                            exit(2);
                         }
                         ++i;
                     } else {
                         // Shouldn't happen.
                         System.err.println("No argument supplied to --eval");
-                        System.exit(1);
+                        exit(1);
                     }
                 } else if (arg.equals("--load") ||
                            arg.equals("--load-system-file")) {
@@ -313,11 +313,14 @@
                     } else {
                         // Shouldn't happen.
                         System.err.println("No argument supplied to --load");
-                        System.exit(1);
+                        exit(1);
                     }
                 }
             }
         }
+        if (_BATCH_MODE_.getSymbolValue() == T) {
+            exit(0);
+        }
     }
 
     public void run()
@@ -437,8 +440,11 @@
             catch (IOException e) {
                 Debug.trace(e);
             }
-        } else
+        } else {
+            ((Stream)Symbol.STANDARD_OUTPUT.getSymbolValue())._finishOutput();
+            ((Stream)Symbol.ERROR_OUTPUT.getSymbolValue())._finishOutput();
             System.exit(status);
+        }
     }
 
     public synchronized void dispose()

Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java	Fri Dec 10 10:58:09 2010
@@ -1596,7 +1596,7 @@
                     System.out.println(a.writeToString());
 
             //###FIXME: Bail out, but do it nicer...
-            System.exit(1);
+            exit(1);
             return NIL;
         }
     };

Modified: trunk/abcl/src/org/armedbear/lisp/java/swing/REPLConsole.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/java/swing/REPLConsole.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/java/swing/REPLConsole.java	Fri Dec 10 10:58:09 2010
@@ -302,7 +302,7 @@
       repl = Interpreter.createInstance().eval("#'top-level::top-level-loop");
     } catch (Throwable e) {
       e.printStackTrace();
-      System.exit(1);
+      exit(1);
     }
     final REPLConsole d = new REPLConsole(repl);
     final JTextComponent txt = new JTextArea(d);



From ehuelsmann at common-lisp.net  Sat Dec 11 23:19:22 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 11 Dec 2010 18:19:22 -0500
Subject: [armedbear-cvs] r13091 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PRYio-0006mn-So@common-lisp.net>

Author: ehuelsmann
Date: Sat Dec 11 18:19:21 2010
New Revision: 13091

Log:
Override UnhandledCondition's getMessage() function to report
the original text.

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

Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java	Sat Dec 11 18:19:21 2010
@@ -471,6 +471,20 @@
         public LispObject getCondition() {
             return condition;
         }
+
+        @Override
+        public String getMessage() {
+            String conditionText;
+            try {
+                conditionText = getCondition().writeToString();
+            } catch (Throwable t) {
+                conditionText = "<error printing Lisp condition>";
+            }
+
+            return "Unhandled lisp condition: " + conditionText;
+        }
+
+
     };
 
     private static final Primitive _DEBUGGER_HOOK_FUNCTION =



From ehuelsmann at common-lisp.net  Sat Dec 11 23:52:36 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 11 Dec 2010 18:52:36 -0500
Subject: [armedbear-cvs] r13092 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PRZEy-0000Hf-4V@common-lisp.net>

Author: ehuelsmann
Date: Sat Dec 11 18:52:35 2010
New Revision: 13092

Log:
Store the original Java error in the "cause" field
of the UnhandledCondition error, *if* the cause is a Java exception.

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

Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java	Sat Dec 11 18:52:35 2010
@@ -492,7 +492,6 @@
     {
         @Override
         public LispObject execute(LispObject first, LispObject second)
-            throws UnhandledCondition
         {
             final LispObject condition = first;
             if (interpreter == null) {
@@ -525,7 +524,11 @@
                     thread.resetSpecialBindings(mark);
                 }
             }
-            throw new UnhandledCondition(condition);
+            UnhandledCondition uc = new UnhandledCondition(condition);
+            if (condition.typep(Symbol.JAVA_EXCEPTION) != NIL)
+                uc.initCause((Throwable)JavaException
+                        .JAVA_EXCEPTION_CAUSE.execute(condition).javaInstance());
+            throw uc;
         }
     };
 



From ehuelsmann at common-lisp.net  Sun Dec 12 09:54:45 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 12 Dec 2010 04:54:45 -0500
Subject: [armedbear-cvs] r13093 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PRidh-00042Y-JL@common-lisp.net>

Author: ehuelsmann
Date: Sun Dec 12 04:54:44 2010
New Revision: 13093

Log:
Change JAVA-EXCEPTION-CAUSE to protected.
Set format control and arguments.

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

Modified: trunk/abcl/src/org/armedbear/lisp/JavaException.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/JavaException.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/JavaException.java	Sun Dec 12 04:54:44 2010
@@ -49,6 +49,8 @@
         Debug.assertTrue(throwable != null);
         this.throwable = throwable;
         setInstanceSlotValue(Symbol.CAUSE, new JavaObject(throwable));
+        setFormatControl("Java exception: ~A.");
+        setFormatArguments(new Cons(new JavaObject(throwable)));
     }
 
     @Override
@@ -87,7 +89,7 @@
     }
 
     // ### java-exception-cause java-exception => cause
-    private static final Primitive JAVA_EXCEPTION_CAUSE =
+    protected static final Primitive JAVA_EXCEPTION_CAUSE =
         new Primitive(Symbol.JAVA_EXCEPTION_CAUSE, "java-exception",
 "Returns the cause of JAVA-EXCEPTION. (The cause is the Java Throwable\n" +
 "  object that caused JAVA-EXCEPTION to be signalled.)")



From ehuelsmann at common-lisp.net  Sun Dec 12 10:04:51 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 12 Dec 2010 05:04:51 -0500
Subject: [armedbear-cvs] r13094 - in
	trunk/abcl/src/org/armedbear/lisp/scripting: . util
Message-ID: <E1PRinT-0005Uz-2Y@common-lisp.net>

Author: ehuelsmann
Date: Sun Dec 12 05:04:45 2010
New Revision: 13094

Log:
Eliminate flushes after every character in javax.scripting support.

This fixes Ant output for embedded scriptlets in Ant files.

Removed:
   trunk/abcl/src/org/armedbear/lisp/scripting/util/
Modified:
   trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java

Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java	Sun Dec 12 05:04:45 2010
@@ -25,15 +25,11 @@
 import java.io.InputStream;
 import java.io.Reader;
 import java.io.StringWriter;
-import java.math.BigInteger;
 import java.util.Map;
-import java.util.Properties;
 
 import javax.script.*;
 
 import org.armedbear.lisp.*;
-import org.armedbear.lisp.scripting.util.ReaderInputStream;
-import org.armedbear.lisp.scripting.util.WriterOutputStream;
 
 
 public class AbclScriptEngine extends AbstractScriptEngine implements Invocable, Compilable {
@@ -230,22 +226,14 @@
 	}
 
     Object eval(Function evaluator, LispObject code, ScriptContext ctx) throws ScriptException {
-	ReaderInputStream in = null;
-	WriterOutputStream out = null;
 	LispObject retVal = null;
-	try {
-	    in = new ReaderInputStream(ctx.getReader());
-	    out = new WriterOutputStream(ctx.getWriter());
-	    Stream outStream = new Stream(Symbol.SYSTEM_STREAM, out, Symbol.CHARACTER);
-	    Stream inStream  = new Stream(Symbol.SYSTEM_STREAM, in,  Symbol.CHARACTER);
+	    Stream outStream = new Stream(Symbol.SYSTEM_STREAM, ctx.getWriter());
+	    Stream inStream  = new Stream(Symbol.SYSTEM_STREAM, ctx.getReader());
 	    retVal = evaluator.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
 				       makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
 				       inStream, outStream,
 				       code, new JavaObject(ctx));
 	    return retVal.javaInstance();
-	} catch (IOException e) {
-	    throw new ScriptException(e);
-	}
     }
 	
 	@Override



From ehuelsmann at common-lisp.net  Wed Dec 15 21:43:17 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Wed, 15 Dec 2010 16:43:17 -0500
Subject: [armedbear-cvs] r13095 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PSz81-0007os-MR@common-lisp.net>

Author: ehuelsmann
Date: Wed Dec 15 16:43:14 2010
New Revision: 13095

Log:
Remove unused packages.

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

Modified: trunk/abcl/src/org/armedbear/lisp/Site.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Site.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Site.java	Wed Dec 15 16:43:14 2010
@@ -35,9 +35,7 @@
 
 import static org.armedbear.lisp.Lisp.*;
 
-import java.io.File;
 import java.net.URL;
-import java.net.URLDecoder;
 
 
 public final class Site



From ehuelsmann at common-lisp.net  Fri Dec 17 21:38:30 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Fri, 17 Dec 2010 16:38:30 -0500
Subject: [armedbear-cvs] r13096 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PTi0U-0002ye-Jp@common-lisp.net>

Author: ehuelsmann
Date: Fri Dec 17 16:38:29 2010
New Revision: 13096

Log:
Add initialization with the default value of the element type
if neither INITIAL-ELEMENT nor INITIAL-CONTENT have been specified.

Found by: dmalves_ (freenode irc nick)


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

Modified: trunk/abcl/src/org/armedbear/lisp/make_array.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/make_array.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/make_array.java	Fri Dec 17 16:38:29 2010
@@ -141,12 +141,14 @@
             return error(new LispError(sb.toString()));
           }
         final AbstractVector v;
+        final LispObject defaultInitialElement;
         if (upgradedType == Symbol.CHARACTER)
           {
             if (fillPointer != NIL || adjustable != NIL)
               v = new ComplexString(size);
             else
               v = new SimpleString(size);
+            defaultInitialElement = LispCharacter.getInstance('\0');
           }
         else if (upgradedType == Symbol.BIT)
           {
@@ -154,6 +156,7 @@
               v = new ComplexBitVector(size);
             else
               v = new SimpleBitVector(size);
+            defaultInitialElement = Fixnum.ZERO;
           }
         else if (upgradedType.equal(UNSIGNED_BYTE_8))
           {
@@ -161,11 +164,13 @@
               v = new ComplexVector_UnsignedByte8(size);
             else
               v = new BasicVector_UnsignedByte8(size);
+            defaultInitialElement = Fixnum.ZERO;
           }
         else if (upgradedType.equal(UNSIGNED_BYTE_16) &&
                  fillPointer == NIL && adjustable == NIL)
           {
             v = new BasicVector_UnsignedByte16(size);
+            defaultInitialElement = Fixnum.ZERO;
           }
         else if (upgradedType.equal(UNSIGNED_BYTE_32))
           {
@@ -173,15 +178,20 @@
               v = new ComplexVector_UnsignedByte32(size);
             else
               v = new BasicVector_UnsignedByte32(size);
+            defaultInitialElement = Fixnum.ZERO;
           }
         else if (upgradedType == NIL)
-          v = new NilVector(size);
+          {
+            v = new NilVector(size);
+            defaultInitialElement = NIL;
+          }
         else
           {
             if (fillPointer != NIL || adjustable != NIL)
               v = new ComplexVector(size);
             else
               v = new SimpleVector(size);
+            defaultInitialElement = NIL;
           }
         if (initialElementProvided != NIL)
           {
@@ -207,6 +217,10 @@
             else
               return type_error(initialContents, Symbol.SEQUENCE);
           }
+        else
+          {
+            v.fill(defaultInitialElement);
+          }
         if (fillPointer != NIL)
           v.setFillPointer(fillPointer);
         return v;
@@ -226,6 +240,8 @@
                 array = new SimpleArray_UnsignedByte8(dimv);
                 if (initialElementProvided != NIL)
                   array.fill(initialElement);
+                else
+                  array.fill(Fixnum.ZERO);
               }
           }
         else if (upgradedType.equal(UNSIGNED_BYTE_16))
@@ -239,6 +255,8 @@
                 array = new SimpleArray_UnsignedByte16(dimv);
                 if (initialElementProvided != NIL)
                   array.fill(initialElement);
+                else
+                  array.fill(Fixnum.ZERO);
               }
           }
         else if (upgradedType.equal(UNSIGNED_BYTE_32))
@@ -252,6 +270,8 @@
                 array = new SimpleArray_UnsignedByte32(dimv);
                 if (initialElementProvided != NIL)
                   array.fill(initialElement);
+                else
+                  array.fill(Fixnum.ZERO);
               }
           }
         else
@@ -265,6 +285,8 @@
                 array = new SimpleArray_T(dimv, upgradedType);
                 if (initialElementProvided != NIL)
                   array.fill(initialElement);
+                else
+                  array.fill(NIL);
               }
           }
       }
@@ -282,6 +304,8 @@
                 array = new ComplexArray_UnsignedByte8(dimv);
                 if (initialElementProvided != NIL)
                   array.fill(initialElement);
+                else
+                  array.fill(Fixnum.ZERO);
               }
           }
         else if (upgradedType.equal(UNSIGNED_BYTE_32))
@@ -295,6 +319,8 @@
                 array = new ComplexArray_UnsignedByte32(dimv);
                 if (initialElementProvided != NIL)
                   array.fill(initialElement);
+                else
+                  array.fill(Fixnum.ZERO);
               }
           }
         else
@@ -308,6 +334,8 @@
                 array = new ComplexArray(dimv, upgradedType);
                 if (initialElementProvided != NIL)
                   array.fill(initialElement);
+                else
+                  array.fill(NIL);
               }
           }
       }



From ehuelsmann at common-lisp.net  Fri Dec 17 22:16:28 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Fri, 17 Dec 2010 17:16:28 -0500
Subject: [armedbear-cvs] r13097 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PTibE-0006We-HB@common-lisp.net>

Author: ehuelsmann
Date: Fri Dec 17 17:16:27 2010
New Revision: 13097

Log:
Remove redundant function [toURL(Pathname p)] from Pathname. 

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

Modified: trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java	Fri Dec 17 17:16:27 2010
@@ -232,17 +232,13 @@
     };
 
     protected static void addURL(JavaClassLoader jcl, LispObject jar) {
-	try {
-	    if(jar instanceof Pathname) {
-		jcl.addURL(((Pathname) jar).toURL());
-	    } else if(jar instanceof AbstractString) {
-		jcl.addURL(new Pathname(jar.toString()).toURL());
-	    } else {
-		error(new TypeError(jar + " must be a pathname designator"));
-	    }
-	} catch(java.net.MalformedURLException e) {
-	    error(new LispError(jar + " is not a valid URL"));
-	}
+        if (jar instanceof Pathname) {
+            jcl.addURL(((Pathname) jar).toURL());
+        } else if (jar instanceof AbstractString) {
+            jcl.addURL(new Pathname(jar.toString()).toURL());
+        } else {
+            error(new TypeError(jar + " must be a pathname designator"));
+        }
     }
 
 

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	Fri Dec 17 17:16:27 2010
@@ -997,22 +997,18 @@
         return true;
     }
 
-    public static URL toURL(Pathname p) {
-        URL url = null;
-        if (!(p.host instanceof Cons)) {
-            Debug.assertTrue(false); // XXX
-        }
-        try {
-            url = new URL(p.getNamestring());
-        } catch (MalformedURLException e) {
-            Debug.assertTrue(false); // XXX
-        }
-        return url;
-    }
+//    public static URL toURL(Pathname p) {
+ //       try {
+//            return p.toURL();
+//        } catch (MalformedURLException e) {
+//            Debug.assertTrue(false);
+//            return null; // not reached
+//        }
+//    }
 
     URLConnection getURLConnection() {
         Debug.assertTrue(isURL());
-        URL url = Pathname.toURL(this);
+        URL url = this.toURL();
         URLConnection result = null;
         try {
             result = url.openConnection();
@@ -2163,7 +2159,7 @@
                 }
             }
         } else if (isURL()) {
-            URL url = toURL(this);
+            URL url = this.toURL();
             try { 
                 result = url.openStream();
             } catch (IOException e) {
@@ -2381,11 +2377,16 @@
         return getNamestring();
     }
 
-    public URL toURL() throws MalformedURLException {
-        if(isURL()) {
-            return new URL(getNamestring());
-        } else {
-            return toFile().toURL();
+    public URL toURL() {
+        try {
+            if (isURL()) {
+                return new URL(getNamestring());
+            } else {
+                return toFile().toURL();
+            }
+        } catch (MalformedURLException e) {
+            error(new LispError(getNamestring() + " is not a valid URL"));
+            return null; // not reached
         }
     }
 



From vvoutilainen at common-lisp.net  Fri Dec 17 22:18:34 2010
From: vvoutilainen at common-lisp.net (Ville Voutilainen)
Date: Fri, 17 Dec 2010 17:18:34 -0500
Subject: [armedbear-cvs] r13098 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PTidG-0006Zp-Q3@common-lisp.net>

Author: vvoutilainen
Date: Fri Dec 17 17:18:33 2010
New Revision: 13098

Log:
Add a --help parameter that prints out command line arg help.


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

Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java	Fri Dec 17 17:18:33 2010
@@ -54,6 +54,7 @@
     private static boolean noinit = false;
     private static boolean nosystem = false;
     private static boolean noinform = false;
+    private static boolean help = false;
 
     public static synchronized Interpreter getInstance()
     {
@@ -84,6 +85,12 @@
             out._writeString(banner());
             out._finishOutput();
         }
+        if (help) {
+            Stream out = getStandardOutput();
+            out._writeString(help());
+            out._finishOutput();
+            exit(0);
+        }
         if (noinform)
             _NOINFORM_.setSymbolValue(T);
         else {
@@ -237,6 +244,8 @@
                     nosystem = true;
                 } else if (arg.equals("--noinform")) {
                     noinform = true;
+                } else if (arg.equals("--help")) {
+                    help = true;
                 } else if (arg.equals("--batch")) {
                     _BATCH_MODE_.setSymbolValue(T);
                 } else if (arg.equals("--eval")) {
@@ -607,4 +616,28 @@
         }
         return sb.toString();
     }
+    private static String help()
+    {
+        final String sep = System.getProperty("line.separator");
+        StringBuilder sb = new StringBuilder("Parameters:");
+        sb.append(sep);
+        sb.append("--help displays this help");
+        sb.append(sep);
+        sb.append("--noinform suppresses the printing of version info");
+        sb.append(sep);
+        sb.append("--eval <form> evaluates the <form> before initializing REPL");
+        sb.append(sep);
+        sb.append("--load <file> loads the file <file> before initializing REPL");
+        sb.append(sep);
+        sb.append("--load-system-file <file> loads the system file <file> before initializing REPL");
+        sb.append(sep);
+        sb.append("--batch enables batch mode. The --load, --load-system-file and --eval parameters are handled, and abcl exits without entering REPL");
+        sb.append(sep);
+        sb.append("--noinit suppresses loading a .abclrc startup file");
+        sb.append(sep); 
+        sb.append("--nosystem suppresses loading the system startup file");
+        sb.append(sep);
+       
+        return sb.toString();
+    }
 }



From ehuelsmann at common-lisp.net  Fri Dec 17 22:20:45 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Fri, 17 Dec 2010 17:20:45 -0500
Subject: [armedbear-cvs] r13099 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PTifN-0007Dd-R1@common-lisp.net>

Author: ehuelsmann
Date: Fri Dec 17 17:20:44 2010
New Revision: 13099

Log:
Stop using a deprecated function (File.toURL()).

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	Fri Dec 17 17:20:44 2010
@@ -2382,7 +2382,7 @@
             if (isURL()) {
                 return new URL(getNamestring());
             } else {
-                return toFile().toURL();
+                return toFile().toURI().toURL();
             }
         } catch (MalformedURLException e) {
             error(new LispError(getNamestring() + " is not a valid URL"));



From ehuelsmann at common-lisp.net  Fri Dec 17 22:23:24 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Fri, 17 Dec 2010 17:23:24 -0500
Subject: [armedbear-cvs] r13100 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PTihw-0007Kj-QQ@common-lisp.net>

Author: ehuelsmann
Date: Fri Dec 17 17:23:24 2010
New Revision: 13100

Log:
Remove dead code and unused imports from Pathname.

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	Fri Dec 17 17:23:24 2010
@@ -38,14 +38,11 @@
 import java.io.IOException;
 import java.io.InputStream;
 import java.io.FileInputStream;
-import java.io.UnsupportedEncodingException;
 import java.net.MalformedURLException;
 import java.net.URI;
 import java.net.URISyntaxException;
 import java.net.URL;
-import java.net.URLDecoder;
 import java.net.URLConnection;
-import java.net.URLEncoder;
 import java.util.Enumeration;
 import java.util.StringTokenizer;
 import java.util.zip.ZipEntry;
@@ -2097,21 +2094,6 @@
     }
 
 
-    /** Make a JarURL from a Pathname that references a file */
-    private static URL makeJarURL(Pathname p) {
-        String jarURL = "jar:file:" + p.getNamestring() + "!/";
-        URL result = null;
-        try {
-            result = new URL(jarURL);
-        } catch (MalformedURLException ex) {
-            // XXX
-            Debug.trace("Could not form URL from pathname "
-              + "'" + jarURL + "'"
-              + " because " + ex);
-        }
-        return result;
-    }
-
     protected static URL makeURL(Pathname pathname) {
         URL result = null;
         try {



From astalla at common-lisp.net  Thu Dec 23 23:43:51 2010
From: astalla at common-lisp.net (Alessio Stalla)
Date: Thu, 23 Dec 2010 18:43:51 -0500
Subject: [armedbear-cvs] r13101 - trunk/abcl/src/org/armedbear/lisp/scripting
Message-ID: <E1PVup5-0001RE-2W@common-lisp.net>

Author: astalla
Date: Thu Dec 23 18:43:44 2010
New Revision: 13101

Log:
Reduced verbosity of the AbclScriptEngine


Modified:
   trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java

Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java	Thu Dec 23 18:43:44 2010
@@ -61,11 +61,12 @@
 	loadFromClasspath("/org/armedbear/lisp/scripting/lisp/abcl-script.lisp");
 	loadFromClasspath("/org/armedbear/lisp/scripting/lisp/config.lisp");
 	if(getClass().getResource("/abcl-script-config.lisp") != null) {
-	    System.out.println("ABCL: loading configuration from " + getClass().getResource("/abcl-script-config.lisp"));
+            //TODO: find a way to log this if wanted
+            //System.out.println("ABCL: loading configuration from " + getClass().getResource("/abcl-script-config.lisp"));
 	    loadFromClasspath("/abcl-script-config.lisp");
 	}
 	((Function) interpreter.eval("#'abcl-script:configure-abcl")).execute(new JavaObject(this));
-	System.out.println("ABCL: configured");
+        //System.out.println("ABCL: configured");
 	evalScript = (Function) this.findSymbol("EVAL-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
 	compileScript = (Function) this.findSymbol("COMPILE-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
 	evalCompiledScript = (Function) this.findSymbol("EVAL-COMPILED-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
@@ -108,18 +109,19 @@
 		return load(stream);
 	}
 
-	public LispObject load(Stream stream) {
-		Symbol keyword_verbose = Lisp.internKeyword("VERBOSE");
-		Symbol keyword_print = Lisp.internKeyword("PRINT");
-		/*
-		 * load (filespec &key (verbose *load-verbose*) (print *load-print*)
-		 * (if-does-not-exist t) (external-format :default)
-		 */
-		return Symbol.LOAD.getSymbolFunction().execute(
-				new LispObject[] { stream, keyword_verbose, Lisp.NIL,
-						keyword_print, Lisp.T, Keyword.IF_DOES_NOT_EXIST,
-						Lisp.T, Keyword.EXTERNAL_FORMAT, Keyword.DEFAULT });
-	}
+    public LispObject load(Stream stream) {
+        Symbol keyword_verbose = Lisp.internKeyword("VERBOSE");
+        Symbol keyword_print = Lisp.internKeyword("PRINT");
+        /*
+         * load (filespec &key (verbose *load-verbose*) (print *load-print*)
+         * (if-does-not-exist t) (external-format :default)
+         */
+        return Symbol.LOAD.getSymbolFunction().execute
+            (new LispObject[] { stream, keyword_verbose, Lisp.NIL,
+                                keyword_print, Lisp.NIL,
+                                Keyword.IF_DOES_NOT_EXIST, Lisp.T,
+                                Keyword.EXTERNAL_FORMAT, Keyword.DEFAULT });
+    }
 
 	public LispObject load(String filespec) {
 		return load(filespec, true);



From ehuelsmann at common-lisp.net  Sat Dec 25 11:03:53 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 25 Dec 2010 06:03:53 -0500
Subject: [armedbear-cvs] r13102 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PWRuj-0006TC-GC@common-lisp.net>

Author: ehuelsmann
Date: Sat Dec 25 06:03:50 2010
New Revision: 13102

Log:
Add more type-conversion helpers to java.lisp.

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

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 Dec 25 06:03:50 2010
@@ -219,6 +219,26 @@
 	    i (1+ i)))
     jarray))
 
+(defun list-from-jarray (jarray)
+  "Returns a list with the elements of `jarray`."
+  (loop for i from 0 below (jarray-length jarray)
+        collect (jarray-ref jarray i)))
+
+(defun vector-from-jarray (jarray)
+  "Returns a vector with the elements of `jarray`."
+  (loop with vec = (make-array (jarray-length jarray))
+        for i from 0 below (jarray-length jarray)
+        do (setf (aref vec i) (jarray-ref jarray i))
+        finally (return vec)))
+
+(defun list-from-jenumeration (jenumeration)
+  "Returns a list with the elements returned by successive `nextElement`
+calls on the java.util.Enumeration `jenumeration`."
+  (loop while (jcall jenumeration
+                     (jmethod "java.util.Enumeration" "hasMoreElements"))
+        collect (jcall jenumeration
+                       (jmethod "java.util.Enumeration" "nextElement"))))
+
 (defun jclass-constructors (class)
   "Returns a vector of constructors for CLASS"
   (jcall (jmethod "java.lang.Class" "getConstructors") (jclass class)))



From ehuelsmann at common-lisp.net  Sun Dec 26 12:00:01 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 26 Dec 2010 07:00:01 -0500
Subject: [armedbear-cvs] r13103 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PWpGb-0006DI-KR@common-lisp.net>

Author: ehuelsmann
Date: Sun Dec 26 06:59:59 2010
New Revision: 13103

Log:
Add JNULL_REF to check for a JavaObject containing a 'null' value.

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

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	Sun Dec 26 06:59:59 2010
@@ -1055,6 +1055,31 @@
         }
     };
 
+    private static final Primitive JNULL_REF = new pf_jnull_ref();
+    @DocString(name="jnull-ref", args="object",
+    doc="Returns a non-NIL value when the JAVA-OBJECT `object` is `null`,\n"
+            + "or signals a TYPE-ERROR condition if the object isn't of\n"
+            + "the right type.")
+    private static final class pf_jnull_ref extends Primitive
+    {
+        pf_jnull_ref()
+        {
+            super("jnull-ref", PACKAGE_JAVA, true);
+        }
+
+        @Override
+        public LispObject execute(LispObject ref)
+        {
+            if (ref instanceof JavaObject)
+            {
+                JavaObject jref = (JavaObject)ref;
+                return (jref.javaInstance() == null) ? T : NIL;
+            } else
+                return Lisp.type_error(ref, Symbol.JAVA_OBJECT);
+        }
+    };
+
+
     private static final Primitive JAVA_OBJECT_P = new pf_java_object_p();
     @DocString(name="java-object-p", args="object",
     doc="Returns T if OBJECT is a JAVA-OBJECT.")



From ehuelsmann at common-lisp.net  Sun Dec 26 12:14:01 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 26 Dec 2010 07:14:01 -0500
Subject: [armedbear-cvs] r13104 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PWpU9-0007Rp-Fu@common-lisp.net>

Author: ehuelsmann
Date: Sun Dec 26 07:14:00 2010
New Revision: 13104

Log:
Export Object.equals() wrapper from java.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	Sun Dec 26 07:14:00 2010
@@ -286,6 +286,8 @@
 (autoload-macro 'chain "java")
 (export 'jmethod-let "JAVA")
 (autoload-macro 'jmethod-let "java")
+(export 'jequal "JAVA")
+(autoload-macro 'jequal "java")
 
 ;; Profiler.
 (in-package "PROFILER")



From ehuelsmann at common-lisp.net  Mon Dec 27 22:06:56 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Mon, 27 Dec 2010 17:06:56 -0500
Subject: [armedbear-cvs] r13105 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PXLDU-0003q3-3J@common-lisp.net>

Author: ehuelsmann
Date: Mon Dec 27 17:06:54 2010
New Revision: 13105

Log:
Fix Pathname.java failing to find boot.lisp in an "unpacked JAR" situation
found by running ABCL in the Glassfish v3 servlet container.

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	Mon Dec 27 17:06:54 2010
@@ -265,15 +265,6 @@
                                     jar.length() - jarSeparator.length());
                 Pathname jarPathname;
                 if (file.length() > 0) {
-                    // Instead of "use URL constructor to normalize Windows' use of device"
-                    // attempt to shorten the URL to pass through the normal constructor.
-                    if (Utilities.isPlatformWindows
-                        && file.charAt(0) == '/'
-                        && file.charAt(2) == ':'
-                        && Character.isLetter(file.charAt(1)))
-                        {
-                            file = file.substring(1);
-                        }
                     URL url = null;
                     URI uri = null;
                     try {
@@ -294,7 +285,7 @@
                         // path for jar files, so MERGE-PATHNAMES means something.
                         jarPathname = new Pathname(uri.getSchemeSpecificPart());
                     } else {
-                        jarPathname = new Pathname(path);
+                        jarPathname = new Pathname((new File(path)).getPath());
                     }
                 } else {
                     jarPathname = new Pathname("");
@@ -365,7 +356,8 @@
                                     + "'" + url.toString() + "'"
                                     + ": " + ex.toString()));
                 }
-                Pathname p = new Pathname(uri.getPath());
+                File file = new File(uri.getPath());
+                Pathname p = new Pathname(file.getPath());
                 this.host = p.host;
                 this.device = p.device;
                 this.directory = p.directory;



From ehuelsmann at common-lisp.net  Mon Dec 27 22:10:34 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Mon, 27 Dec 2010 17:10:34 -0500
Subject: [armedbear-cvs] r13106 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PXLH0-0003sb-Sd@common-lisp.net>

Author: ehuelsmann
Date: Mon Dec 27 17:10:34 2010
New Revision: 13106

Log:
Make Interpreter.UnhandledCondition print its message formatted, instead of
the rather uninformative #<[class-name here] {@...}>.

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

Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java	Mon Dec 27 17:10:34 2010
@@ -484,10 +484,15 @@
         @Override
         public String getMessage() {
             String conditionText;
+            LispThread thread = LispThread.currentThread();
+            SpecialBindingsMark mark = thread.markSpecialBindings();
+            thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL);
             try {
                 conditionText = getCondition().writeToString();
             } catch (Throwable t) {
                 conditionText = "<error printing Lisp condition>";
+            } finally {
+                thread.resetSpecialBindings(mark);
             }
 
             return "Unhandled lisp condition: " + conditionText;



From ehuelsmann at common-lisp.net  Tue Dec 28 20:51:44 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Tue, 28 Dec 2010 15:51:44 -0500
Subject: [armedbear-cvs] r13107 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PXgWG-0005uy-LA@common-lisp.net>

Author: ehuelsmann
Date: Tue Dec 28 15:51:37 2010
New Revision: 13107

Log:
Rename JNULL_REF to JNULL_REF_P.

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

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	Tue Dec 28 15:51:37 2010
@@ -1055,14 +1055,14 @@
         }
     };
 
-    private static final Primitive JNULL_REF = new pf_jnull_ref();
+    private static final Primitive JNULL_REF_P = new pf_jnull_ref_p();
     @DocString(name="jnull-ref", args="object",
     doc="Returns a non-NIL value when the JAVA-OBJECT `object` is `null`,\n"
             + "or signals a TYPE-ERROR condition if the object isn't of\n"
             + "the right type.")
-    private static final class pf_jnull_ref extends Primitive
+    private static final class pf_jnull_ref_p extends Primitive
     {
-        pf_jnull_ref()
+        pf_jnull_ref_p()
         {
             super("jnull-ref", PACKAGE_JAVA, true);
         }



From mevenson at common-lisp.net  Tue Dec 28 21:00:23 2010
From: mevenson at common-lisp.net (Mark Evenson)
Date: Tue, 28 Dec 2010 16:00:23 -0500
Subject: [armedbear-cvs] r13108 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PXged-0006fT-Dj@common-lisp.net>

Author: mevenson
Date: Tue Dec 28 16:00:22 2010
New Revision: 13108

Log:
Fix strange backtrace growth as reported in ticket #114.

There may be other code paths through the error() routines that need
similar exceptions to omit their code paths as well.

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

Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java	Tue Dec 28 16:00:22 2010
@@ -331,6 +331,19 @@
       final LispThread thread = LispThread.currentThread();
       final StackTraceElement[] frames = thread.getJavaStackTrace();
 
+      // frames[0] java.lang.Thread.getStackTrace
+      // frames[1] org.armedbear.lisp.LispThread.getJavaStackTrace
+      // frames[2] org.armedbear.lisp.Lisp.pushJavaStackFrames
+
+      if (frames.length > 5
+        && frames[3].getClassName().equals("org.armedbear.lisp.Lisp")
+        && frames[3].getMethodName().equals("error")
+        && frames[4].getClassName().startsWith("org.armedbear.lisp.Lisp")
+        && frames[4].getMethodName().equals("eval")) {
+          // Error condition arising from within Lisp.eval(), so no
+          // Java stack frames should be visible to the consumer of the stack abstraction
+          return;
+      }
       // Search for last Primitive in the StackTrace; that was the
       // last entry point from Lisp.
       int last = frames.length - 1;
@@ -338,9 +351,8 @@
           if (frames[i].getClassName().startsWith("org.armedbear.lisp.Primitive"))
             last = i;
       }
-      // Do not include the first three frames:
-      //   Thread.getStackTrace, LispThread.getJavaStackTrace,
-      //   Lisp.pushJavaStackFrames.
+      // Do not include the first three frames which, as noted above, constitute
+      // the invocation of this method.
       while (last > 2) {
         thread.pushStackFrame(new JavaStackFrame(frames[last]));
         last--;



From mevenson at common-lisp.net  Tue Dec 28 21:00:50 2010
From: mevenson at common-lisp.net (Mark Evenson)
Date: Tue, 28 Dec 2010 16:00:50 -0500
Subject: [armedbear-cvs] r13109 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PXgf4-00073L-8m@common-lisp.net>

Author: mevenson
Date: Tue Dec 28 16:00:49 2010
New Revision: 13109

Log:
Remove the deprecated and dangerously non-functional getStack()/setStack() methods.

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	(original)
+++ trunk/abcl/src/org/armedbear/lisp/LispThread.java	Tue Dec 28 16:00:49 2010
@@ -512,24 +512,12 @@
 
     private StackFrame stack = null;
 
-    @Deprecated
-    public LispObject getStack()
+   public final void pushStackFrame(StackFrame frame)
     {
-        return NIL;
+        frame.setNext(stack);
+        stack = frame;
     }
 
-    @Deprecated
-    public void setStack(LispObject stack)
-    {
-    }
-
-    public final void pushStackFrame(StackFrame frame)
-    {
-	frame.setNext(stack);
-	stack = frame;
-    }
-
-
     public final void popStackFrame()
     {
         if (stack != null)



From mevenson at common-lisp.net  Tue Dec 28 21:01:12 2010
From: mevenson at common-lisp.net (Mark Evenson)
Date: Tue, 28 Dec 2010 16:01:12 -0500
Subject: [armedbear-cvs] r13110 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PXgfP-00074W-MZ@common-lisp.net>

Author: mevenson
Date: Tue Dec 28 16:01:10 2010
New Revision: 13110

Log:
Always emit a newline at the end of printing a backtrace for aesthetics.

Modified:
   trunk/abcl/src/org/armedbear/lisp/top-level.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/top-level.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/top-level.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/top-level.lisp	Tue Dec 28 16:01:10 2010
@@ -134,7 +134,9 @@
           (print-frame frame *debug-io* :prefix (format nil "~3D: " n))
           (incf n)
           (when (>= n count)
+            (fresh-line *debug-io*)
             (return))))))
+  (fresh-line *debug-io*)
   (values))
 
 (defun frame-command (args)



From ehuelsmann at common-lisp.net  Tue Dec 28 21:38:20 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Tue, 28 Dec 2010 16:38:20 -0500
Subject: [armedbear-cvs] r13111 - trunk/abcl/tools
Message-ID: <E1PXhFM-0001tY-CB@common-lisp.net>

Author: ehuelsmann
Date: Tue Dec 28 16:38:18 2010
New Revision: 13111

Log:
Add a tools/ directory and a code-graphing tool to visualize instruction
flow and stack depth using GraphViz.

Added:
   trunk/abcl/tools/
   trunk/abcl/tools/code-grapher.lisp

Added: trunk/abcl/tools/code-grapher.lisp
==============================================================================
--- (empty file)
+++ trunk/abcl/tools/code-grapher.lisp	Tue Dec 28 16:38:18 2010
@@ -0,0 +1,126 @@
+
+;; Raw outlines of a graphViz tool to visualize the instruction graph of ABCL generated code.
+;;  and the associated stack depths.
+
+(defvar *graph* nil)
+
+(declaim (ftype (function (t) t) branch-opcode-p))
+(declaim (inline branch-opcode-p))
+(defun branch-opcode-p (opcode)
+  (declare (optimize speed))
+  (declare (type '(integer 0 255) opcode))
+  (or (<= 153 opcode 168)
+      (= opcode 198)))
+
+(declaim (ftype (function (t t t) t) walk-code))
+(defun walk-code (code start-index depth last-instruction)
+  (declare (optimize speed))
+  (declare (type fixnum start-index depth))
+  (do* ((i start-index (1+ i))
+        (limit (length code)))
+       ((>= i limit))
+    (declare (type fixnum i limit))
+    (let* ((instruction (aref code i))
+           (instruction-depth (jvm::instruction-depth instruction))
+           (instruction-stack (jvm::instruction-stack instruction))
+           (this-instruction (format nil "i~A" i)))
+      (declare (type fixnum instruction-stack))
+      (format t "~A ~A~%" last-instruction this-instruction)
+      (push (list last-instruction  this-instruction depth) *graph*)
+      (setf last-instruction this-instruction)
+      (when instruction-depth
+        (unless (= (the fixnum instruction-depth)
+                   (the fixnum (+ depth instruction-stack)))
+          (internal-compiler-error 
+           "Stack inconsistency detected in ~A at index ~D: found ~S, expected ~S." 
+           (compiland-name *current-compiland*)
+           i instruction-depth (+ depth instruction-stack))
+          (return-from walk-code)))
+      (let ((opcode (jvm::instruction-opcode instruction)))
+        (setf depth (+ depth instruction-stack))
+        (setf (jvm::instruction-depth instruction) depth)
+        (when (branch-opcode-p opcode)
+          (let ((label (car (jvm::instruction-args instruction))))
+            (declare (type symbol label))
+            (walk-code code (symbol-value label) depth this-instruction)))
+        (when (member opcode '(167 176 191)) ; GOTO ARETURN ATHROW
+          ;; Current path ends.
+          (return-from walk-code))))))
+
+(declaim (ftype (function () t) analyze-stack))
+(defun analyze-stack ()
+  (declare (optimize speed))
+  (let* ((code *code*)
+         (code-length (length code)))
+    (declare (type vector code))
+    (dotimes (i code-length)
+      (declare (type (unsigned-byte 16) i))
+      (let* ((instruction (aref code i))
+             (opcode (jvm::instruction-opcode instruction)))
+        (when (eql opcode 202) ; LABEL
+          (let ((label (car (jvm::instruction-args instruction))))
+            (set label i)))
+        (if (jvm::instruction-stack instruction)
+            (when (jvm::opcode-stack-effect opcode)
+              (unless (eql (jvm::instruction-stack instruction)
+                           (jvm::opcode-stack-effect opcode))
+                (sys::%format t "instruction-stack = ~S opcode-stack-effect = ~S~%"
+                         (jvm::instruction-stack instruction)
+                         (jvm::opcode-stack-effect opcode))
+                (sys::%format t "index = ~D instruction = ~A~%" i
+                              (jvm::print-instruction instruction))))
+            (setf (jvm::instruction-stack instruction)
+                  (jvm::opcode-stack-effect opcode)))
+        (unless (jvm::instruction-stack instruction)
+          (sys::%format t "no stack information for instruction ~D~%"
+                        (jvm::instruction-opcode instruction))
+          (aver nil))))
+    (walk-code code 0 0 (gensym))
+    (dolist (handler *handlers*)
+      ;; Stack depth is always 1 when handler is called.
+      (walk-code code (symbol-value (jvm::handler-code handler)) 1 (gensym)))
+    (let ((max-stack 0))
+      (declare (type fixnum max-stack))
+      (dotimes (i code-length)
+        (declare (type (unsigned-byte 16) i))
+        (let* ((instruction (aref code i))
+               (instruction-depth (jvm::instruction-depth instruction)))
+          (when instruction-depth
+            (setf max-stack (max max-stack (the fixnum instruction-depth))))))
+;;       (when *compiler-debug*
+;;         (sys::%format t "compiland name = ~S~%" (compiland-name *current-compiland*))
+;;         (sys::%format t "max-stack = ~D~%" max-stack)
+;;         (sys::%format t "----- after stack analysis -----~%")
+;;         (print-code))
+      max-stack)))
+
+
+(defvar *code*)
+(defvar *handlers*)
+(compile nil '(lambda () nil))
+(setq *handlers* nil)
+(setq *code* nil)
+(setq jvm::*saved-code* nil)
+(setq jvm::*compiler-debug* t)
+(defun f ()
+  (let ((stream (make-string-input-stream "f" 0)))
+    (read-line stream)
+    (lambda () 
+      (return-from f))))
+(ignore-errors  (compile 'f))
+
+(setq *graph* nil)
+(let ((*code* (coerce (car jvm::*saved-code*) 'vector))
+      (*handlers* (car jvm::*saved-handlers*)))
+  (analyze-stack))
+(with-open-file (f #p"g.gvz" :direction :output :if-exists :supersede)
+  (format f "digraph main {~%")
+  (dolist (e *graph*)
+    (format f "~A -> ~A [label=\"~A\"];~%"
+            (first e) (second e) (third e)))
+  (let ((*code* (coerce (car jvm::*saved-code*) 'vector)))
+    (dotimes (i (length *code*))
+      (format f "i~A [label=\"~A:~A\"]~%" i i
+              (jvm::opcode-name (jvm::instruction-opcode (aref *code* i))))))
+  (format f "}~%"))
+



From mevenson at common-lisp.net  Tue Dec 28 21:55:30 2010
From: mevenson at common-lisp.net (Mark Evenson)
Date: Tue, 28 Dec 2010 16:55:30 -0500
Subject: [armedbear-cvs] r13112 - trunk/abcl/tools
Message-ID: <E1PXhVy-00037p-OW@common-lisp.net>

Author: mevenson
Date: Tue Dec 28 16:55:29 2010
New Revision: 13112

Log:
Set EOL to native.


Modified:
   trunk/abcl/tools/code-grapher.lisp   (contents, props changed)

Modified: trunk/abcl/tools/code-grapher.lisp
==============================================================================
--- trunk/abcl/tools/code-grapher.lisp	(original)
+++ trunk/abcl/tools/code-grapher.lisp	Tue Dec 28 16:55:29 2010
@@ -1,126 +1,126 @@
-
-;; Raw outlines of a graphViz tool to visualize the instruction graph of ABCL generated code.
-;;  and the associated stack depths.
-
-(defvar *graph* nil)
-
-(declaim (ftype (function (t) t) branch-opcode-p))
-(declaim (inline branch-opcode-p))
-(defun branch-opcode-p (opcode)
-  (declare (optimize speed))
-  (declare (type '(integer 0 255) opcode))
-  (or (<= 153 opcode 168)
-      (= opcode 198)))
-
-(declaim (ftype (function (t t t) t) walk-code))
-(defun walk-code (code start-index depth last-instruction)
-  (declare (optimize speed))
-  (declare (type fixnum start-index depth))
-  (do* ((i start-index (1+ i))
-        (limit (length code)))
-       ((>= i limit))
-    (declare (type fixnum i limit))
-    (let* ((instruction (aref code i))
-           (instruction-depth (jvm::instruction-depth instruction))
-           (instruction-stack (jvm::instruction-stack instruction))
-           (this-instruction (format nil "i~A" i)))
-      (declare (type fixnum instruction-stack))
-      (format t "~A ~A~%" last-instruction this-instruction)
-      (push (list last-instruction  this-instruction depth) *graph*)
-      (setf last-instruction this-instruction)
-      (when instruction-depth
-        (unless (= (the fixnum instruction-depth)
-                   (the fixnum (+ depth instruction-stack)))
-          (internal-compiler-error 
-           "Stack inconsistency detected in ~A at index ~D: found ~S, expected ~S." 
-           (compiland-name *current-compiland*)
-           i instruction-depth (+ depth instruction-stack))
-          (return-from walk-code)))
-      (let ((opcode (jvm::instruction-opcode instruction)))
-        (setf depth (+ depth instruction-stack))
-        (setf (jvm::instruction-depth instruction) depth)
-        (when (branch-opcode-p opcode)
-          (let ((label (car (jvm::instruction-args instruction))))
-            (declare (type symbol label))
-            (walk-code code (symbol-value label) depth this-instruction)))
-        (when (member opcode '(167 176 191)) ; GOTO ARETURN ATHROW
-          ;; Current path ends.
-          (return-from walk-code))))))
-
-(declaim (ftype (function () t) analyze-stack))
-(defun analyze-stack ()
-  (declare (optimize speed))
-  (let* ((code *code*)
-         (code-length (length code)))
-    (declare (type vector code))
-    (dotimes (i code-length)
-      (declare (type (unsigned-byte 16) i))
-      (let* ((instruction (aref code i))
-             (opcode (jvm::instruction-opcode instruction)))
-        (when (eql opcode 202) ; LABEL
-          (let ((label (car (jvm::instruction-args instruction))))
-            (set label i)))
-        (if (jvm::instruction-stack instruction)
-            (when (jvm::opcode-stack-effect opcode)
-              (unless (eql (jvm::instruction-stack instruction)
-                           (jvm::opcode-stack-effect opcode))
-                (sys::%format t "instruction-stack = ~S opcode-stack-effect = ~S~%"
-                         (jvm::instruction-stack instruction)
-                         (jvm::opcode-stack-effect opcode))
-                (sys::%format t "index = ~D instruction = ~A~%" i
-                              (jvm::print-instruction instruction))))
-            (setf (jvm::instruction-stack instruction)
-                  (jvm::opcode-stack-effect opcode)))
-        (unless (jvm::instruction-stack instruction)
-          (sys::%format t "no stack information for instruction ~D~%"
-                        (jvm::instruction-opcode instruction))
-          (aver nil))))
-    (walk-code code 0 0 (gensym))
-    (dolist (handler *handlers*)
-      ;; Stack depth is always 1 when handler is called.
-      (walk-code code (symbol-value (jvm::handler-code handler)) 1 (gensym)))
-    (let ((max-stack 0))
-      (declare (type fixnum max-stack))
-      (dotimes (i code-length)
-        (declare (type (unsigned-byte 16) i))
-        (let* ((instruction (aref code i))
-               (instruction-depth (jvm::instruction-depth instruction)))
-          (when instruction-depth
-            (setf max-stack (max max-stack (the fixnum instruction-depth))))))
-;;       (when *compiler-debug*
-;;         (sys::%format t "compiland name = ~S~%" (compiland-name *current-compiland*))
-;;         (sys::%format t "max-stack = ~D~%" max-stack)
-;;         (sys::%format t "----- after stack analysis -----~%")
-;;         (print-code))
-      max-stack)))
-
-
-(defvar *code*)
-(defvar *handlers*)
-(compile nil '(lambda () nil))
-(setq *handlers* nil)
-(setq *code* nil)
-(setq jvm::*saved-code* nil)
-(setq jvm::*compiler-debug* t)
-(defun f ()
-  (let ((stream (make-string-input-stream "f" 0)))
-    (read-line stream)
-    (lambda () 
-      (return-from f))))
-(ignore-errors  (compile 'f))
-
-(setq *graph* nil)
-(let ((*code* (coerce (car jvm::*saved-code*) 'vector))
-      (*handlers* (car jvm::*saved-handlers*)))
-  (analyze-stack))
-(with-open-file (f #p"g.gvz" :direction :output :if-exists :supersede)
-  (format f "digraph main {~%")
-  (dolist (e *graph*)
-    (format f "~A -> ~A [label=\"~A\"];~%"
-            (first e) (second e) (third e)))
-  (let ((*code* (coerce (car jvm::*saved-code*) 'vector)))
-    (dotimes (i (length *code*))
-      (format f "i~A [label=\"~A:~A\"]~%" i i
-              (jvm::opcode-name (jvm::instruction-opcode (aref *code* i))))))
-  (format f "}~%"))
-
+
+;; Raw outlines of a graphViz tool to visualize the instruction graph of ABCL generated code.
+;;  and the associated stack depths.
+
+(defvar *graph* nil)
+
+(declaim (ftype (function (t) t) branch-opcode-p))
+(declaim (inline branch-opcode-p))
+(defun branch-opcode-p (opcode)
+  (declare (optimize speed))
+  (declare (type '(integer 0 255) opcode))
+  (or (<= 153 opcode 168)
+      (= opcode 198)))
+
+(declaim (ftype (function (t t t) t) walk-code))
+(defun walk-code (code start-index depth last-instruction)
+  (declare (optimize speed))
+  (declare (type fixnum start-index depth))
+  (do* ((i start-index (1+ i))
+        (limit (length code)))
+       ((>= i limit))
+    (declare (type fixnum i limit))
+    (let* ((instruction (aref code i))
+           (instruction-depth (jvm::instruction-depth instruction))
+           (instruction-stack (jvm::instruction-stack instruction))
+           (this-instruction (format nil "i~A" i)))
+      (declare (type fixnum instruction-stack))
+      (format t "~A ~A~%" last-instruction this-instruction)
+      (push (list last-instruction  this-instruction depth) *graph*)
+      (setf last-instruction this-instruction)
+      (when instruction-depth
+        (unless (= (the fixnum instruction-depth)
+                   (the fixnum (+ depth instruction-stack)))
+          (internal-compiler-error 
+           "Stack inconsistency detected in ~A at index ~D: found ~S, expected ~S." 
+           (compiland-name *current-compiland*)
+           i instruction-depth (+ depth instruction-stack))
+          (return-from walk-code)))
+      (let ((opcode (jvm::instruction-opcode instruction)))
+        (setf depth (+ depth instruction-stack))
+        (setf (jvm::instruction-depth instruction) depth)
+        (when (branch-opcode-p opcode)
+          (let ((label (car (jvm::instruction-args instruction))))
+            (declare (type symbol label))
+            (walk-code code (symbol-value label) depth this-instruction)))
+        (when (member opcode '(167 176 191)) ; GOTO ARETURN ATHROW
+          ;; Current path ends.
+          (return-from walk-code))))))
+
+(declaim (ftype (function () t) analyze-stack))
+(defun analyze-stack ()
+  (declare (optimize speed))
+  (let* ((code *code*)
+         (code-length (length code)))
+    (declare (type vector code))
+    (dotimes (i code-length)
+      (declare (type (unsigned-byte 16) i))
+      (let* ((instruction (aref code i))
+             (opcode (jvm::instruction-opcode instruction)))
+        (when (eql opcode 202) ; LABEL
+          (let ((label (car (jvm::instruction-args instruction))))
+            (set label i)))
+        (if (jvm::instruction-stack instruction)
+            (when (jvm::opcode-stack-effect opcode)
+              (unless (eql (jvm::instruction-stack instruction)
+                           (jvm::opcode-stack-effect opcode))
+                (sys::%format t "instruction-stack = ~S opcode-stack-effect = ~S~%"
+                         (jvm::instruction-stack instruction)
+                         (jvm::opcode-stack-effect opcode))
+                (sys::%format t "index = ~D instruction = ~A~%" i
+                              (jvm::print-instruction instruction))))
+            (setf (jvm::instruction-stack instruction)
+                  (jvm::opcode-stack-effect opcode)))
+        (unless (jvm::instruction-stack instruction)
+          (sys::%format t "no stack information for instruction ~D~%"
+                        (jvm::instruction-opcode instruction))
+          (aver nil))))
+    (walk-code code 0 0 (gensym))
+    (dolist (handler *handlers*)
+      ;; Stack depth is always 1 when handler is called.
+      (walk-code code (symbol-value (jvm::handler-code handler)) 1 (gensym)))
+    (let ((max-stack 0))
+      (declare (type fixnum max-stack))
+      (dotimes (i code-length)
+        (declare (type (unsigned-byte 16) i))
+        (let* ((instruction (aref code i))
+               (instruction-depth (jvm::instruction-depth instruction)))
+          (when instruction-depth
+            (setf max-stack (max max-stack (the fixnum instruction-depth))))))
+;;       (when *compiler-debug*
+;;         (sys::%format t "compiland name = ~S~%" (compiland-name *current-compiland*))
+;;         (sys::%format t "max-stack = ~D~%" max-stack)
+;;         (sys::%format t "----- after stack analysis -----~%")
+;;         (print-code))
+      max-stack)))
+
+
+(defvar *code*)
+(defvar *handlers*)
+(compile nil '(lambda () nil))
+(setq *handlers* nil)
+(setq *code* nil)
+(setq jvm::*saved-code* nil)
+(setq jvm::*compiler-debug* t)
+(defun f ()
+  (let ((stream (make-string-input-stream "f" 0)))
+    (read-line stream)
+    (lambda () 
+      (return-from f))))
+(ignore-errors  (compile 'f))
+
+(setq *graph* nil)
+(let ((*code* (coerce (car jvm::*saved-code*) 'vector))
+      (*handlers* (car jvm::*saved-handlers*)))
+  (analyze-stack))
+(with-open-file (f #p"g.gvz" :direction :output :if-exists :supersede)
+  (format f "digraph main {~%")
+  (dolist (e *graph*)
+    (format f "~A -> ~A [label=\"~A\"];~%"
+            (first e) (second e) (third e)))
+  (let ((*code* (coerce (car jvm::*saved-code*) 'vector)))
+    (dotimes (i (length *code*))
+      (format f "i~A [label=\"~A:~A\"]~%" i i
+              (jvm::opcode-name (jvm::instruction-opcode (aref *code* i))))))
+  (format f "}~%"))
+



From ehuelsmann at common-lisp.net  Wed Dec 29 21:24:02 2010
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Wed, 29 Dec 2010 16:24:02 -0500
Subject: [armedbear-cvs] r13113 - trunk/abcl/src/org/armedbear/lisp
Message-ID: <E1PY3V4-0001W9-MB@common-lisp.net>

Author: ehuelsmann
Date: Wed Dec 29 16:24:01 2010
New Revision: 13113

Log:
Finalize renaming JNULL_REF to JNULL_REF_P.

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

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	Wed Dec 29 16:24:01 2010
@@ -1056,7 +1056,7 @@
     };
 
     private static final Primitive JNULL_REF_P = new pf_jnull_ref_p();
-    @DocString(name="jnull-ref", args="object",
+    @DocString(name="jnull-ref-p", args="object",
     doc="Returns a non-NIL value when the JAVA-OBJECT `object` is `null`,\n"
             + "or signals a TYPE-ERROR condition if the object isn't of\n"
             + "the right type.")
@@ -1064,7 +1064,7 @@
     {
         pf_jnull_ref_p()
         {
-            super("jnull-ref", PACKAGE_JAVA, true);
+            super("jnull-ref-p", PACKAGE_JAVA, true);
         }
 
         @Override