Changeset 12748

Timestamp:

06/09/10 11:17:17 (13 years ago)

Author:

Mark Evenson

Message:

Include 'examples' in release source distribution.

Reported by Mario Lang.

Location:

trunk/abcl

Files:

• build.xml (modified) (1 diff)
• examples/.abclrc (copied) (copied from trunk/abcl/examples/misc/dotabclrc)
• examples/README (deleted)
• examples/complete.lisp (added)
• examples/google-app-engine (deleted)
• examples/gui (deleted)
• examples/hello.java (copied) (copied from trunk/abcl/examples/misc/hello.java)
• examples/init.lisp (added)
• examples/java-exception (deleted)
• examples/java-interface (deleted)
• examples/java-to-lisp-1 (deleted)
• examples/java-to-lisp-2 (deleted)
• examples/jsr-223 (deleted)
• examples/key-pressed.lisp (added)
• examples/lisp-to-java (deleted)
• examples/misc (deleted)
• examples/update-check-enabled.lisp (copied) (copied from trunk/abcl/examples/misc/update-check-enabled.lisp)
• nbproject/build-impl.xml (modified) (24 diffs)
• nbproject/genfiles.properties (modified) (1 diff)
• src/org/armedbear/lisp/Autoload.java (modified) (2 diffs)
• src/org/armedbear/lisp/FaslClassLoader.java (deleted)
• src/org/armedbear/lisp/Function.java (modified) (9 diffs)
• src/org/armedbear/lisp/Interpreter.java (modified) (3 diffs)
• src/org/armedbear/lisp/Lisp.java (modified) (6 diffs)
• src/org/armedbear/lisp/Load.java (modified) (8 diffs)
• src/org/armedbear/lisp/Readtable.java (modified) (9 diffs)
• src/org/armedbear/lisp/SlotDefinition.java (modified) (3 diffs)
• src/org/armedbear/lisp/StandardClass.java (modified) (2 diffs)
• src/org/armedbear/lisp/Stream.java (modified) (2 diffs)
• src/org/armedbear/lisp/Symbol.java (modified) (1 diff)
• src/org/armedbear/lisp/clos.lisp (modified) (6 diffs)
• src/org/armedbear/lisp/compile-file.lisp (modified) (15 diffs)
• src/org/armedbear/lisp/compiler-pass1.lisp (modified) (2 diffs)
• src/org/armedbear/lisp/compiler-pass2.lisp (modified) (8 diffs)
• src/org/armedbear/lisp/disassemble.lisp (modified) (1 diff)
• src/org/armedbear/lisp/gui.lisp (modified) (1 diff)
• src/org/armedbear/lisp/java/DialogPromptStream.java (copied) (copied from trunk/abcl/examples/gui/abcl/DialogPromptStream.java) (2 diffs)
• src/org/armedbear/lisp/java/swing/REPLConsole.java (deleted)
• src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java (copied) (copied from trunk/abcl/examples/gui/swing/SwingDialogPromptStream.java) (2 diffs)
• src/org/armedbear/lisp/load.lisp (modified) (2 diffs)
• src/org/armedbear/lisp/precompiler.lisp (modified) (5 diffs)
• src/org/armedbear/lisp/proclaim.lisp (modified) (3 diffs)
• src/org/armedbear/lisp/scripting/AbclScriptEngine.java (modified) (4 diffs)
• src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java (modified) (1 diff)

trunk/abcl/build.xml

@@ -465 +465 @@
       <include name="abcl.bat.in"/>
       
+      <include name="examples/**"/>
+      
       <!-- The remainder of these files are used by the Lisp hosted
            build in 'build-abcl.lisp' but not used by Ant, so include

trunk/abcl/nbproject/build-impl.xml

@@ -21 +21 @@
         -->
 <project xmlns:j2seproject1="http://www.netbeans.org/ns/j2se-project/1" xmlns:j2seproject3="http://www.netbeans.org/ns/j2se-project/3" xmlns:jaxrpc="http://www.netbeans.org/ns/j2se-project/jax-rpc" basedir=".." default="default" name="abcl-impl">
-    <fail message="Please build using Ant 1.7.1 or higher.">
-        <condition>
-            <not>
-                <antversion atleast="1.7.1"/>
-            </not>
-        </condition>
-    </fail>
     <target depends="test,jar,javadoc" description="Build and test whole project." name="default"/>
     <!-- 
@@ -56 +49 @@
     <target depends="-pre-init,-init-private,-init-user,-init-project,-init-macrodef-property" name="-do-init">
         <available file="${manifest.file}" property="manifest.available"/>
-        <condition property="main.class.available">
+        <condition property="manifest.available+main.class">
             <and>
+                <isset property="manifest.available"/>
                 <isset property="main.class"/>
                 <not>
@@ -64 +58 @@
             </and>
         </condition>
-        <condition property="manifest.available+main.class">
-            <and>
-                <isset property="manifest.available"/>
-                <isset property="main.class.available"/>
-            </and>
-        </condition>
-        <condition property="do.mkdist">
-            <and>
-                <isset property="libs.CopyLibs.classpath"/>
-                <not>
-                    <istrue value="${mkdist.disabled}"/>
-                </not>
-            </and>
-        </condition>
         <condition property="manifest.available+main.class+mkdist.available">
             <and>
                 <istrue value="${manifest.available+main.class}"/>
-                <isset property="do.mkdist"/>
+                <isset property="libs.CopyLibs.classpath"/>
             </and>
-        </condition>
-        <condition property="manifest.available+mkdist.available">
-            <and>
-                <istrue value="${manifest.available}"/>
-                <isset property="do.mkdist"/>
-            </and>
-        </condition>
-        <condition property="manifest.available-mkdist.available">
-            <or>
-                <istrue value="${manifest.available}"/>
-                <isset property="do.mkdist"/>
-            </or>
-        </condition>
-        <condition property="manifest.available+main.class-mkdist.available">
-            <or>
-                <istrue value="${manifest.available+main.class}"/>
-                <isset property="do.mkdist"/>
-            </or>
         </condition>
         <condition property="have.tests">
@@ -136 +98 @@
         <property name="application.args" value=""/>
         <property name="source.encoding" value="${file.encoding}"/>
-        <property name="runtime.encoding" value="${source.encoding}"/>
         <condition property="javadoc.encoding.used" value="${javadoc.encoding}">
             <and>
@@ -152 +113 @@
             <istrue value="${do.depend}"/>
         </condition>
-        <path id="endorsed.classpath.path" path="${endorsed.classpath}"/>
-        <condition else="" property="endorsed.classpath.cmd.line.arg" value="-Xbootclasspath/p:'${toString:endorsed.classpath.path}'">
-            <length length="0" string="${endorsed.classpath}" when="greater"/>
-        </condition>
-        <property name="javac.fork" value="false"/>
+        <condition else="" property="javac.compilerargs.jaxws" value="-Djava.endorsed.dirs='${jaxws.endorsed.dir}'">
+            <and>
+                <isset property="jaxws.endorsed.dir"/>
+                <available file="nbproject/jaxws-build.xml"/>
+            </and>
+        </condition>
     </target>
     <target name="-post-init">
@@ -191 +153 @@
             <attribute default="${excludes}" name="excludes"/>
             <attribute default="${javac.debug}" name="debug"/>
-            <attribute default="${empty.dir}" name="sourcepath"/>
-            <attribute default="${empty.dir}" name="gensrcdir"/>
+            <attribute default="/does/not/exist" name="sourcepath"/>
             <element name="customize" optional="true"/>
             <sequential>
-                <property location="${build.dir}/empty" name="empty.dir"/>
-                <mkdir dir="${empty.dir}"/>
-                <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>
+                <javac debug="@{debug}" deprecation="${javac.deprecation}" destdir="@{destdir}" encoding="${source.encoding}" excludes="@{excludes}" includeantruntime="false" includes="@{includes}" source="${javac.source}" sourcepath="@{sourcepath}" srcdir="@{srcdir}" target="${javac.target}">
                     <classpath>
                         <path path="@{classpath}"/>
                     </classpath>
-                    <compilerarg line="${endorsed.classpath.cmd.line.arg}"/>
-                    <compilerarg line="${javac.compilerargs}"/>
+                    <compilerarg line="${javac.compilerargs} ${javac.compilerargs.jaxws}"/>
                     <customize/>
                 </javac>
@@ -246 +199 @@
             <attribute default="**" name="testincludes"/>
             <sequential>
-                <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true" tempdir="${build.dir}">
+                <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true">
                     <batchtest todir="${build.test.results.dir}">
                         <fileset dir="${test.src.dir}" excludes="@{excludes},${excludes}" includes="@{includes}">
@@ -261 +214 @@
                     <formatter type="brief" usefile="false"/>
                     <formatter type="xml"/>
-                    <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
                     <jvmarg line="${run.jvmargs}"/>
                 </junit>
@@ -318 +270 @@
             <sequential>
                 <java classname="@{classname}" dir="${work.dir}" fork="true">
-                    <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
                     <jvmarg line="${debug-args-line}"/>
                     <jvmarg value="-Xrunjdwp:transport=${debug-transport},address=${jpda.address}"/>
-                    <jvmarg value="-Dfile.encoding=${runtime.encoding}"/>
-                    <redirector errorencoding="${runtime.encoding}" inputencoding="${runtime.encoding}" outputencoding="${runtime.encoding}"/>
                     <jvmarg line="${run.jvmargs}"/>
                     <classpath>
@@ -339 +288 @@
         <macrodef name="java" uri="http://www.netbeans.org/ns/j2se-project/1">
             <attribute default="${main.class}" name="classname"/>
-            <attribute default="${run.classpath}" name="classpath"/>
             <element name="customize" optional="true"/>
             <sequential>
                 <java classname="@{classname}" dir="${work.dir}" fork="true">
-                    <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
-                    <jvmarg value="-Dfile.encoding=${runtime.encoding}"/>
-                    <redirector errorencoding="${runtime.encoding}" inputencoding="${runtime.encoding}" outputencoding="${runtime.encoding}"/>
                     <jvmarg line="${run.jvmargs}"/>
                     <classpath>
-                        <path path="@{classpath}"/>
+                        <path path="${run.classpath}"/>
                     </classpath>
                     <syspropertyset>
@@ -372 +317 @@
                 ===================
             -->
-    <target name="-deps-jar-init" unless="built-jar.properties">
-        <property location="${build.dir}/built-jar.properties" name="built-jar.properties"/>
-        <delete file="${built-jar.properties}" quiet="true"/>
-    </target>
-    <target if="already.built.jar.${basedir}" name="-warn-already-built-jar">
-        <echo level="warn" message="Cycle detected: abcl was already built"/>
-    </target>
-    <target depends="init,-deps-jar-init" name="deps-jar" unless="no.deps">
-        <mkdir dir="${build.dir}"/>
-        <touch file="${built-jar.properties}" verbose="false"/>
-        <property file="${built-jar.properties}" prefix="already.built.jar."/>
-        <antcall target="-warn-already-built-jar"/>
-        <propertyfile file="${built-jar.properties}">
-            <entry key="${basedir}" value=""/>
-        </propertyfile>
-    </target>
+    <target depends="init" name="deps-jar" unless="no.deps"/>
     <target depends="init,-check-automatic-build,-clean-after-automatic-build" name="-verify-automatic-build"/>
     <target depends="init" name="-check-automatic-build">
@@ -403 +333 @@
     </target>
     <target if="do.depend.true" name="-compile-depend">
-        <pathconvert property="build.generated.subdirs">
-            <dirset dir="${build.generated.sources.dir}" erroronmissingdir="false">
-                <include name="*"/>
-            </dirset>
-        </pathconvert>
-        <j2seproject3:depend srcdir="${src.dir}:${build.generated.subdirs}"/>
+        <j2seproject3:depend/>
     </target>
     <target depends="init,deps-jar,-pre-pre-compile,-pre-compile,-compile-depend" if="have.sources" name="-do-compile">
-        <j2seproject3:javac gensrcdir="${build.generated.sources.dir}"/>
+        <j2seproject3:javac/>
         <copy todir="${build.classes.dir}">
             <fileset dir="${src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
@@ -428 +353 @@
         <fail unless="javac.includes">Must select some files in the IDE or set javac.includes</fail>
         <j2seproject3:force-recompile/>
-        <j2seproject3:javac excludes="" gensrcdir="${build.generated.sources.dir}" includes="${javac.includes}" sourcepath="${src.dir}"/>
+        <j2seproject3:javac excludes="" includes="${javac.includes}" sourcepath="${src.dir}"/>
     </target>
     <target name="-post-compile-single">
@@ -448 +373 @@
         <!-- 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" 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="manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class">
         <j2seproject1:jar manifest="${manifest.file}"/>
     </target>
@@ -494 +419 @@
         <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>
     <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,-post-jar" description="Build JAR." name="jar"/>
     <!--
                 =================
@@ -556 +439 @@
         <property name="javac.includes.binary" value=""/>
     </target>
-    <target depends="init,compile-single" name="run-single">
+    <target depends="init,-do-not-recompile,compile-single" name="run-single">
         <fail unless="run.class">Must select one file in the IDE or set run.class</fail>
         <j2seproject1:java classname="${run.class}"/>
-    </target>
-    <target depends="init,compile-test-single" name="run-test-with-main">
-        <fail unless="run.class">Must select one file in the IDE or set run.class</fail>
-        <j2seproject1:java classname="${run.class}" classpath="${run.test.classpath}"/>
     </target>
     <!--
@@ -571 +450 @@
     <target depends="init" if="netbeans.home" name="-debug-start-debugger">
         <j2seproject1:nbjpdastart name="${debug.class}"/>
-    </target>
-    <target depends="init" if="netbeans.home" name="-debug-start-debugger-main-test">
-        <j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${debug.class}"/>
     </target>
     <target depends="init,compile" name="-debug-start-debuggee">
@@ -591 +467 @@
         <j2seproject3:debug classname="${debug.class}"/>
     </target>
-    <target depends="init,compile-single,-debug-start-debugger,-debug-start-debuggee-single" if="netbeans.home" name="debug-single"/>
-    <target depends="init,compile-test-single" if="netbeans.home" name="-debug-start-debuggee-main-test">
-        <fail unless="debug.class">Must select one file in the IDE or set debug.class</fail>
-        <j2seproject3:debug classname="${debug.class}" classpath="${debug.test.classpath}"/>
-    </target>
-    <target depends="init,compile-test-single,-debug-start-debugger-main-test,-debug-start-debuggee-main-test" if="netbeans.home" name="debug-test-with-main"/>
+    <target depends="init,-do-not-recompile,compile-single,-debug-start-debugger,-debug-start-debuggee-single" if="netbeans.home" name="debug-single"/>
     <target depends="init" name="-pre-debug-fix">
         <fail unless="fix.includes">Must set fix.includes</fail>
@@ -619 +490 @@
                 <filename name="**/*.java"/>
             </fileset>
-            <fileset dir="${build.generated.sources.dir}" erroronmissingdir="false">
-                <include name="**/*.java"/>
-            </fileset>
         </javadoc>
     </target>
@@ -683 +551 @@
     </target>
     <target depends="init,compile-test,-pre-test-run,-do-test-run" if="have.tests" name="-post-test-run">
-        <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
+        <fail if="tests.failed">Some tests failed; see details above.</fail>
     </target>
     <target depends="init" if="have.tests" name="test-report"/>
@@ -696 +564 @@
     </target>
     <target depends="init,compile-test-single,-pre-test-run-single,-do-test-run-single" if="have.tests" name="-post-test-run-single">
-        <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
-    </target>
-    <target depends="init,compile-test-single,-pre-test-run-single,-do-test-run-single,-post-test-run-single" description="Run single unit test." name="test-single"/>
+        <fail if="tests.failed">Some tests failed; see details above.</fail>
+    </target>
+    <target depends="init,-do-not-recompile,compile-test-single,-pre-test-run-single,-do-test-run-single,-post-test-run-single" description="Run single unit test." name="test-single"/>
     <!--
                 =======================
@@ -725 +593 @@
         <j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${test.class}"/>
     </target>
-    <target depends="init,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
+    <target depends="init,-do-not-recompile,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
     <target depends="init,-pre-debug-fix,compile-test-single" if="netbeans.home" name="-do-debug-fix-test">
         <j2seproject1:nbjpdareload dir="${build.test.classes.dir}"/>
@@ -762 +630 @@
                 ===============
             -->
-    <target name="-deps-clean-init" unless="built-clean.properties">
-        <property location="${build.dir}/built-clean.properties" name="built-clean.properties"/>
-        <delete file="${built-clean.properties}" quiet="true"/>
-    </target>
-    <target if="already.built.clean.${basedir}" name="-warn-already-built-clean">
-        <echo level="warn" message="Cycle detected: abcl was already built"/>
-    </target>
-    <target depends="init,-deps-clean-init" name="deps-clean" unless="no.deps">
-        <mkdir dir="${build.dir}"/>
-        <touch file="${built-clean.properties}" verbose="false"/>
-        <property file="${built-clean.properties}" prefix="already.built.clean."/>
-        <antcall target="-warn-already-built-clean"/>
-        <propertyfile file="${built-clean.properties}">
-            <entry key="${basedir}" value=""/>
-        </propertyfile>
-    </target>
+    <target depends="init" name="deps-clean" unless="no.deps"/>
     <target depends="init" name="-do-clean">
         <delete dir="${build.dir}"/>
-        <delete dir="${dist.dir}" followsymlinks="false" includeemptydirs="true"/>
+        <delete dir="${dist.dir}"/>
     </target>
     <target name="-post-clean">
@@ -787 +640 @@
     </target>
     <target depends="init,deps-clean,-do-clean,-post-clean" description="Clean build products." name="clean"/>
-    <target name="-check-call-dep">
-        <property file="${call.built.properties}" prefix="already.built."/>
-        <condition property="should.call.dep">
-            <not>
-                <isset property="already.built.${call.subproject}"/>
-            </not>
-        </condition>
-    </target>
-    <target depends="-check-call-dep" if="should.call.dep" name="-maybe-call-dep">
-        <ant antfile="${call.script}" inheritall="false" target="${call.target}">
-            <propertyset>
-                <propertyref prefix="transfer."/>
-                <mapper from="transfer.*" to="*" type="glob"/>
-            </propertyset>
-        </ant>
-    </target>
 </project>

trunk/abcl/nbproject/genfiles.properties

@@ -5 +5 @@
 # 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@1.32.1.45
+nbproject/build-impl.xml.script.CRC32=b7bf05a5
+nbproject/build-impl.xml.stylesheet.CRC32=65b8de21
 nbproject/profiler-build-impl.xml.data.CRC32=71623fcd
 nbproject/profiler-build-impl.xml.script.CRC32=abda56ed

trunk/abcl/src/org/armedbear/lisp/Autoload.java

@@ -98 +98 @@
                                                   "org.armedbear.lisp.".concat(className)));
     }
-    
+
     public void load()
     {
@@ -685 +685 @@
         autoload(Symbol.COPY_LIST, "copy_list");
 
-  autoload(PACKAGE_SYS, "make-fasl-class-loader", "FaslClassLoader", false);
-  autoload(PACKAGE_SYS, "get-fasl-function", "FaslClassLoader", false);
-
         autoload(Symbol.SET_CHAR, "StringFunctions");
         autoload(Symbol.SET_SCHAR, "StringFunctions");

trunk/abcl/src/org/armedbear/lisp/Function.java

@@ -176 +176 @@
     }
 
-    public final LispObject getClassBytes() {
-  LispObject o = getf(propertyList, Symbol.CLASS_BYTES, NIL);
-  if(o != NIL) {
-      return o;
-  } else {
-      ClassLoader c = getClass().getClassLoader();
-      if(c instanceof FaslClassLoader) {
-    return new JavaObject(((FaslClassLoader) c).getFunctionClassBytes(this));
-      } else {
-    return NIL;
-      }
-  }
-    }
-
-    public static final Primitive FUNCTION_CLASS_BYTES = new pf_function_class_bytes();
-    public static final class pf_function_class_bytes extends Primitive {
-  public pf_function_class_bytes() {
-      super("function-class-bytes", PACKAGE_SYS, false, "function");
-        }
-        @Override
-        public LispObject execute(LispObject arg) {
-            if (arg instanceof Function) {
-                return ((Function) arg).getClassBytes();
-      }
-            return type_error(arg, Symbol.FUNCTION);
-        }
-    }
-
     @Override
     public LispObject execute()
     {
-        return error(new WrongNumberOfArgumentsException(this, 0));
+        return error(new WrongNumberOfArgumentsException(this));
     }
 
@@ -213 +185 @@
     public LispObject execute(LispObject arg)
     {
-        return error(new WrongNumberOfArgumentsException(this, 1));
+        return error(new WrongNumberOfArgumentsException(this));
     }
 
@@ -220 +192 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this, 2));
+        return error(new WrongNumberOfArgumentsException(this));
     }
 
@@ -228 +200 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this, 3));
+        return error(new WrongNumberOfArgumentsException(this));
     }
 
@@ -236 +208 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this, 4));
+        return error(new WrongNumberOfArgumentsException(this));
     }
 
@@ -245 +217 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this, 5));
+        return error(new WrongNumberOfArgumentsException(this));
     }
 
@@ -254 +226 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this, 6));
+        return error(new WrongNumberOfArgumentsException(this));
     }
 
@@ -264 +236 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this, 7));
+        return error(new WrongNumberOfArgumentsException(this));
     }
 
@@ -274 +246 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this, 8));
+        return error(new WrongNumberOfArgumentsException(this));
     }
 

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

@@ -178 +178 @@
             catch (ClassNotFoundException e) { } // FIXME: what to do?
 
-            Load.loadSystemFile("j.lisp", false); // not being autoloaded
+            Load.loadSystemFile("j.lisp");
 
             initialized = true;
@@ -218 +218 @@
     private static synchronized void initializeSystem() 
     {
-        Load.loadSystemFile("system", false); // not being autoloaded
+        Load.loadSystemFile("system");
     }
 
@@ -309 +309 @@
 
                         else
-                            Load.loadSystemFile(args[i + 1], false); // not being autoloaded
+                            Load.loadSystemFile(args[i + 1]);
                         ++i;
                     } else {

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

@@ -44 +44 @@
 import java.net.URLDecoder;
 import java.util.Hashtable;
+import java.util.zip.ZipEntry;
+import java.util.zip.ZipFile;
 
 public final class Lisp
@@ -700 +702 @@
    * This version is used by the interpreter.
    */
-  static final LispObject nonLocalGo(Binding binding,
-                                     LispObject tag)
+  public static final LispObject nonLocalGo(Binding binding,
+                                            LispObject tag)
+
   {
     if (binding.env.inactive)
@@ -736 +739 @@
    * This version is used by the interpreter.
    */
-  static final LispObject nonLocalReturn(Binding binding,
-                                         Symbol block,
-                                         LispObject result)
+  public static final LispObject nonLocalReturn(Binding binding,
+                                                Symbol block,
+                                                LispObject result)
+
   {
     if (binding == null)
@@ -1265 +1269 @@
               input = url.openStream();
           } catch (IOException e) {
-        System.err.println("Failed to read class bytes from boot class " + url);
               error(new LispError("Failed to read class bytes from boot class " + url));
           }
@@ -2385 +2388 @@
     internSpecial("*LOAD-STREAM*", PACKAGE_SYS, NIL);
 
-    // ### *fasl-loader*
-    public static final Symbol _FASL_LOADER_ =
-  exportSpecial("*FASL-LOADER*", PACKAGE_SYS, NIL);
-
   // ### *source*
   // internal symbol
@@ -2762 +2761 @@
   }
 
-  private static final SpecialOperator WITH_INLINE_CODE = new with_inline_code();
-  private static class with_inline_code extends SpecialOperator {
-    with_inline_code() {
-      super("with-inline-code", PACKAGE_JVM, true, "(&optional target repr) &body body");
-    }
-    @Override
-    public LispObject execute(LispObject args, Environment env)
-    {
-  return error(new SimpleError("This is a placeholder. It should only be called in compiled code, and tranformed by the compiler using special form handlers."));
-    }
-  }
-
 }

trunk/abcl/src/org/armedbear/lisp/Load.java

@@ -217 +217 @@
     }
 
+    public static final LispObject loadSystemFile(String filename)
+
+    {
+        final LispThread thread = LispThread.currentThread();
+        return loadSystemFile(filename,
+                              Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL,
+                              Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
+                              false);
+    }
+
     public static final LispObject loadSystemFile(String filename, boolean auto)
 
@@ -243 +253 @@
     }
 
-    private static final Symbol FASL_LOADER = PACKAGE_SYS.intern("*FASL-LOADER*");
     static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
 
@@ -270 +279 @@
             url = Lisp.class.getResource(path);
             if (url == null || url.toString().endsWith("/")) {
-                url = Lisp.class.getResource(path.replace('-', '_') + ".abcl");
+                url = Lisp.class.getResource(path + ".abcl");
                 if (url == null) {
                     url = Lisp.class.getResource(path + ".lisp");
@@ -324 +333 @@
             final SpecialBindingsMark mark = thread.markSpecialBindings();
             thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL);
-      thread.bindSpecial(FASL_LOADER, NIL);
             try {
                 Stream stream = new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER);
@@ -433 +441 @@
     }
 
-    private static Symbol[] savedSpecials =
-        new Symbol[] { // CLHS Specified
-                       Symbol.CURRENT_READTABLE, Symbol._PACKAGE_,
-                       // Compiler policy
-                       _SPEED_, _SPACE_, _SAFETY_, _DEBUG_, _EXPLAIN_ };
-
     // A nil TRUENAME signals a load from stream which has no possible path
     private static final LispObject loadFileFromStream(LispObject pathname,
@@ -452 +454 @@
         final LispThread thread = LispThread.currentThread();
         final SpecialBindingsMark mark = thread.markSpecialBindings();
-
-        for (Symbol special : savedSpecials)
-            thread.bindSpecialToCurrentValue(special);
-
+        // "LOAD binds *READTABLE* and *PACKAGE* to the values they held before
+        // loading the file."
+        thread.bindSpecialToCurrentValue(Symbol.CURRENT_READTABLE);
+        thread.bindSpecialToCurrentValue(Symbol._PACKAGE_);
         int loadDepth = Fixnum.getValue(_LOAD_DEPTH_.symbolValue(thread));
         thread.bindSpecial(_LOAD_DEPTH_, Fixnum.getInstance(++loadDepth));
+        // Compiler policy.
+        thread.bindSpecialToCurrentValue(_SPEED_);
+        thread.bindSpecialToCurrentValue(_SPACE_);
+        thread.bindSpecialToCurrentValue(_SAFETY_);
+        thread.bindSpecialToCurrentValue(_DEBUG_);
+        thread.bindSpecialToCurrentValue(_EXPLAIN_);
         final String prefix = getLoadVerbosePrefix(loadDepth);
         try {
@@ -554 +562 @@
 
     private static final LispObject loadStream(Stream in, boolean print,
+                                               LispThread thread)
+        {
+        return loadStream(in, print, thread, false);
+    }
+
+    private static final LispObject loadStream(Stream in, boolean print,
                                                LispThread thread, boolean returnLastResult)
 
@@ -570 +584 @@
                 if (obj == EOF)
                     break;
-    result = eval(obj, env, thread);
+                result = eval(obj, env, thread);
                 if (print) {
                     Stream out =

trunk/abcl/src/org/armedbear/lisp/Readtable.java

@@ -172 +172 @@
 
   @Override
-  public final LispObject typeOf()
+  public LispObject typeOf()
   {
     return Symbol.READTABLE;
@@ -178 +178 @@
 
   @Override
-  public final LispObject classOf()
+  public LispObject classOf()
   {
     return BuiltInClass.READTABLE;
@@ -184 +184 @@
 
   @Override
-  public final LispObject typep(LispObject type)
+  public LispObject typep(LispObject type)
   {
     if (type == Symbol.READTABLE)
@@ -194 +194 @@
 
   @Override
-  public final String toString()
+  public String toString()
   {
     return unreadableString("READTABLE");
   }
 
-  public final LispObject getReadtableCase()
+  public LispObject getReadtableCase()
   {
     return readtableCase;
   }
 
-  public final boolean isWhitespace(char c)
+  public boolean isWhitespace(char c)
   {
     return getSyntaxType(c) == SYNTAX_TYPE_WHITESPACE;
   }
 
-  public final byte getSyntaxType(char c)
+  public byte getSyntaxType(char c)
   {
     return syntax.get(c);
   }
 
-  public final boolean isInvalid(char c)
+  public boolean isInvalid(char c)
   {
     switch (c)
@@ -231 +231 @@
   }
 
-  public final void checkInvalid(char c, Stream stream)
+  public void checkInvalid(char c, Stream stream)
   {
     // "... no mechanism is provided for changing the constituent trait of a
@@ -248 +248 @@
   }
 
-  public final LispObject getReaderMacroFunction(char c)
+  public LispObject getReaderMacroFunction(char c)
   {
     return readerMacroFunctions.get(c);
   }
 
-  final LispObject getMacroCharacter(char c)
+  LispObject getMacroCharacter(char c)
   {
     LispObject function = getReaderMacroFunction(c);
@@ -272 +272 @@
   }
 
-  final void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
+  void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
   {
     byte syntaxType;
@@ -285 +285 @@
   }
 
-  public final LispObject getDispatchMacroCharacter(char dispChar, char subChar)
+  public LispObject getDispatchMacroCharacter(char dispChar, char subChar)
 
   {
@@ -300 +300 @@
   }
 
-  public final void setDispatchMacroCharacter(char dispChar, char subChar,
+  public void setDispatchMacroCharacter(char dispChar, char subChar,
                                         LispObject function)
 

trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java

@@ -45 +45 @@
   }
 
-    public SlotDefinition(StandardClass clazz)
-  {
-    super(clazz, clazz.getClassLayout().getLength());
-    slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = NIL;
-  }
-
   public SlotDefinition(LispObject name, LispObject readers)
   {
@@ -120 +114 @@
   }
 
-  // ### make-slot-definition &optional class
+  // ### make-slot-definition
   private static final Primitive MAKE_SLOT_DEFINITION =
-    new Primitive("make-slot-definition", PACKAGE_SYS, true, "&optional class")
+    new Primitive("make-slot-definition", PACKAGE_SYS, true, "")
     {
       @Override
@@ -128 +122 @@
       {
         return new SlotDefinition();
-      }
-      @Override
-      public LispObject execute(LispObject slotDefinitionClass)
-      {
-    return new SlotDefinition((StandardClass) slotDefinitionClass);
       }
     };

trunk/abcl/src/org/armedbear/lisp/StandardClass.java

@@ -384 +384 @@
     STANDARD_CLASS.setDirectSlotDefinitions(standardClassSlotDefinitions());
   }
-
-    public static final StandardClass DIRECT_SLOT_DEFINITION =
-      addStandardClass(Symbol.DIRECT_SLOT_DEFINITION, list(SLOT_DEFINITION));
-    public static final StandardClass EFFECTIVE_SLOT_DEFINITION =
-      addStandardClass(Symbol.EFFECTIVE_SLOT_DEFINITION, list(SLOT_DEFINITION));
 
   // BuiltInClass.FUNCTION is also null here (see previous comment).
@@ -727 +722 @@
     SLOT_DEFINITION.setSlotDefinitions(SLOT_DEFINITION.getDirectSlotDefinitions());
 
-    DIRECT_SLOT_DEFINITION.setCPL(DIRECT_SLOT_DEFINITION, SLOT_DEFINITION,
-          STANDARD_OBJECT, BuiltInClass.CLASS_T);
-    DIRECT_SLOT_DEFINITION.finalizeClass();
-    EFFECTIVE_SLOT_DEFINITION.setCPL(EFFECTIVE_SLOT_DEFINITION, SLOT_DEFINITION,
-             STANDARD_OBJECT, BuiltInClass.CLASS_T);
-    EFFECTIVE_SLOT_DEFINITION.finalizeClass();
-
     // STANDARD-METHOD
     Debug.assertTrue(STANDARD_METHOD.isFinalized());

trunk/abcl/src/org/armedbear/lisp/Stream.java

@@ -1139 +1139 @@
                 sb.append(readMultipleEscape(rt));
                 flags = new BitSet(sb.length());
-                flags.set(0, sb.length());
+                for (int i = sb.length(); i-- > 0;)
+                    flags.set(i);
             } else if (rt.isInvalid(c)) {
                 rt.checkInvalid(c, this); // Signals a reader-error.
@@ -1180 +1181 @@
                     if (flags == null)
                         flags = new BitSet(sb.length());
-                    flags.set(begin, end);
+                    for (int i = begin; i < end; i++)
+                        flags.set(i);
                     continue;
                 }

trunk/abcl/src/org/armedbear/lisp/Symbol.java

@@ -2944 +2944 @@
   public static final Symbol STANDARD_READER_METHOD =
     PACKAGE_MOP.addExternalSymbol("STANDARD-READER-METHOD");
-  public static final Symbol DIRECT_SLOT_DEFINITION =
-    PACKAGE_MOP.addExternalSymbol("DIRECT-SLOT-DEFINITION");
-  public static final Symbol EFFECTIVE_SLOT_DEFINITION =
-    PACKAGE_MOP.addExternalSymbol("EFFECTIVE-SLOT-DEFINITION");
 
   // Java interface.

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -61 +61 @@
   (find-class 'standard-generic-function))
 (defconstant +the-T-class+ (find-class 'T))
-(defconstant +the-direct-slot-definition-class+ (find-class 'direct-slot-definition))
-(defconstant +the-effective-slot-definition-class+ (find-class 'effective-slot-definition))
 
 ;; Don't use DEFVAR, because that disallows loading clos.lisp
@@ -262 +260 @@
   `(function (lambda () ,initform)))
 
-(defun init-slot-definition (slot &key name
-           (initargs ())
-           (initform nil)
-           (initfunction nil)
-           (readers ())
-           (writers ())
-           (allocation :instance)
-           (allocation-class nil)
-            &allow-other-keys)
-  (set-slot-definition-name slot name)
-  (set-slot-definition-initargs slot initargs)
-  (set-slot-definition-initform slot initform)
-  (set-slot-definition-initfunction slot initfunction)
-  (set-slot-definition-readers slot readers)
-  (set-slot-definition-writers slot writers)
-  (set-slot-definition-allocation slot allocation)
-  (set-slot-definition-allocation-class slot allocation-class)
-  slot)
-
-(defun make-direct-slot-definition (class &rest args)
-  (let ((slot-class (direct-slot-definition-class class)))
-    (if (eq slot-class +the-direct-slot-definition-class+)
-  (let ((slot (make-slot-definition +the-direct-slot-definition-class+)))
-    (apply #'init-slot-definition slot :allocation-class class args)
-    slot)
-  (progn
-    (let ((slot (apply #'make-instance slot-class :allocation-class class
-           args)))
-      slot)))))
-
-(defun make-effective-slot-definition (class &rest args)
-  (let ((slot-class (effective-slot-definition-class class)))
-    (if (eq slot-class +the-effective-slot-definition-class+)
-  (let ((slot (make-slot-definition +the-effective-slot-definition-class+)))
-    (apply #'init-slot-definition slot args)
-    slot)
-  (progn
-    (let ((slot (apply #'make-instance slot-class args)))
-      slot)))))
+(defun make-direct-slot-definition (class &key name
+                                          (initargs ())
+                                          (initform nil)
+                                          (initfunction nil)
+                                          (readers ())
+                                          (writers ())
+                                          (allocation :instance)
+                                          &allow-other-keys)
+  (let ((slot (make-slot-definition)))
+    (set-slot-definition-name slot name)
+    (set-slot-definition-initargs slot initargs)
+    (set-slot-definition-initform slot initform)
+    (set-slot-definition-initfunction slot initfunction)
+    (set-slot-definition-readers slot readers)
+    (set-slot-definition-writers slot writers)
+    (set-slot-definition-allocation slot allocation)
+    (set-slot-definition-allocation-class slot class)
+    slot))
+
+(defun make-effective-slot-definition (&key name
+                                            (initargs ())
+                                            (initform nil)
+                                            (initfunction nil)
+                                            (allocation :instance)
+                                            (allocation-class nil)
+                                            &allow-other-keys)
+  (let ((slot (make-slot-definition)))
+    (set-slot-definition-name slot name)
+    (set-slot-definition-initargs slot initargs)
+    (set-slot-definition-initform slot initform)
+    (set-slot-definition-initfunction slot initfunction)
+    (set-slot-definition-allocation slot allocation)
+    (set-slot-definition-allocation-class slot allocation-class)
+    slot))
 
 ;;; finalize-inheritance
@@ -463 +456 @@
 
 (defun std-compute-effective-slot-definition (class direct-slots)
+  (declare (ignore class))
   (let ((initer (find-if-not #'null direct-slots
                              :key #'%slot-definition-initfunction)))
     (make-effective-slot-definition
-     class
      :name (%slot-definition-name (car direct-slots))
      :initform (if initer
@@ -566 +559 @@
                                           :direct-default-initargs direct-default-initargs)
     class))
-
-;(defun convert-to-direct-slot-definition (class canonicalized-slot)
-;  (apply #'make-instance
-;         (apply #'direct-slot-definition-class
-;                class canonicalized-slot)
-;         canonicalized-slot))
 
 (defun std-after-initialization-for-classes (class
@@ -1913 +1900 @@
 (redefine-class-forwarder (setf class-direct-default-initargs) direct-default-initargs)
 
-(defgeneric direct-slot-definition-class (class &rest initargs))
-
-(defmethod direct-slot-definition-class ((class class) &rest initargs)
-  (declare (ignore initargs))
-  +the-direct-slot-definition-class+)
-
-(defgeneric effective-slot-definition-class (class &rest initargs))
-
-(defmethod effective-slot-definition-class ((class class) &rest initargs)
-  (declare (ignore initargs))
-  +the-effective-slot-definition-class+)
+
 
 (fmakunbound 'documentation)
@@ -2235 +2212 @@
 (defmethod shared-initialize ((instance standard-object) slot-names &rest initargs)
   (std-shared-initialize instance slot-names initargs))
-
-(defmethod shared-initialize ((slot slot-definition) slot-names
-            &rest initargs
-            &key name initargs initform initfunction
-            readers writers allocation
-            &allow-other-keys)
-  ;;Keyword args are duplicated from init-slot-definition only to have
-  ;;them checked.
-  (declare (ignore slot-names)) ;;TODO?
-  (declare (ignore name initargs initform initfunction readers writers allocation))
-  (apply #'init-slot-definition slot initargs))
 
 ;;; change-class

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -41 +41 @@
 (defvar *output-file-pathname*)
 
-(defun base-classname (&optional (output-file-pathname *output-file-pathname*))
-  (sanitize-class-name (pathname-name output-file-pathname)))
-
-(defun fasl-loader-classname (&optional (output-file-pathname *output-file-pathname*))
-  (%format nil "~A_0" (base-classname output-file-pathname)))
-
 (declaim (ftype (function (t) t) compute-classfile-name))
 (defun compute-classfile-name (n &optional (output-file-pathname
@@ -52 +46 @@
   "Computes the name of the class file associated with number `n'."
   (let ((name
-         (sanitize-class-name
-    (%format nil "~A_~D" (pathname-name output-file-pathname) n))))
+         (%format nil "~A-~D"
+                  (substitute #\_ #\.
+                              (pathname-name output-file-pathname)) n)))
     (namestring (merge-pathnames (make-pathname :name name :type "cls")
                                  output-file-pathname))))
-
-(defun sanitize-class-name (name)
-  (let ((name (copy-seq name)))
-    (dotimes (i (length name))
-      (declare (type fixnum i))
-      (when (or (char= (char name i) #\-)
-    (char= (char name i) #\.)
-    (char= (char name i) #\Space))
-        (setf (char name i) #\_)))
-    name))
-  
 
 (declaim (ftype (function () t) next-classfile-name))
@@ -86 +70 @@
 (declaim (ftype (function (t) t) verify-load))
 (defun verify-load (classfile)
-  #|(if (> *safety* 0) 
-      (and classfile
+  (if (> *safety* 0)
+    (and classfile
          (let ((*load-truename* *output-file-pathname*))
            (report-error
             (load-compiled-function classfile))))
-    t)|#
-  (declare (ignore classfile))
-  t)
+    t))
 
 (declaim (ftype (function (t) t) process-defconstant))
@@ -163 +145 @@
                  (let* ((expr `(lambda ,lambda-list
                                  ,@decls (block ,block-name ,@body)))
-      (saved-class-number *class-number*)
                         (classfile (next-classfile-name))
                         (internal-compiler-errors nil)
@@ -188 +169 @@
                       (setf form
                             `(fset ',name
-           (sys::get-fasl-function *fasl-loader*
-                 ,saved-class-number)
+                                   (proxy-preloaded-function ',name ,(file-namestring classfile))
                                    ,*source-position*
                                    ',lambda-list
@@ -246 +226 @@
              (eval form)
              (let* ((expr (function-lambda-expression (macro-function name)))
-        (saved-class-number *class-number*)
                     (classfile (next-classfile-name)))
          (with-open-file
@@ -263 +242 @@
                              `(put ',name 'macroexpand-macro
                                    (make-macro ',name
-                 (sys::get-fasl-function *fasl-loader* ,saved-class-number)))
+                                               (proxy-preloaded-function
+                                                '(macro-function ,name)
+                                                ,(file-namestring classfile))))
                              `(fset ',name
                                     (make-macro ',name
-            (sys::get-fasl-function *fasl-loader* ,saved-class-number))
+                                                (proxy-preloaded-function
+                                                 '(macro-function ,name)
+                                                 ,(file-namestring classfile)))
                                     ,*source-position*
                                     ',(third form)))))))))
@@ -366 +349 @@
   ;; was already used in verify-load before I used it,
   ;; however, binding *load-truename* isn't fully compliant, I think.
-  (when compile-time-too
-    (let ((*load-truename* *output-file-pathname*)
-    (*fasl-loader* (make-fasl-class-loader
-        *class-number*
-        (concatenate 'string "org.armedbear.lisp." (base-classname))
-        nil)))
+  (let ((*load-truename* *output-file-pathname*))
+    (when compile-time-too
       (eval form))))
 
@@ -388 +367 @@
       (let ((lambda-expression (cadr function-form)))
         (jvm::with-saved-compiler-policy
-          (let* ((saved-class-number *class-number*)
-     (classfile (next-classfile-name))
+          (let* ((classfile (next-classfile-name))
                  (result
       (with-open-file
@@ -402 +380 @@
             (cond (compiled-function
                    (setf (getf tail key)
-       `(sys::get-fasl-function *fasl-loader* ,saved-class-number)))
-;;                         `(load-compiled-function ,(file-namestring classfile))))
+                         `(load-compiled-function ,(file-namestring classfile))))
                   (t
                    ;; FIXME This should be a warning or error of some sort...
@@ -436 +413 @@
       (precompiler:precompile-form form nil *compile-file-environment*)))
   (let* ((expr `(lambda () ,form))
-   (saved-class-number *class-number*)
          (classfile (next-classfile-name))
          (result
@@ -450 +426 @@
     (setf form
           (if compiled-function
-              `(funcall (sys::get-fasl-function *fasl-loader* ,saved-class-number))
+              `(funcall (load-compiled-function ,(file-namestring classfile)))
               (precompiler:precompile-form form nil *compile-file-environment*)))))
 
@@ -597 +573 @@
                      :stream out)
               (%stream-terpri out)
-        ;; Note: Beyond this point, you can't use DUMP-FORM,
-        ;; because the list of uninterned symbols has been fixed now.
-        (when *fasl-uninterned-symbols*
-    (write (list 'setq '*fasl-uninterned-symbols*
-           (coerce (mapcar #'car
-               (nreverse *fasl-uninterned-symbols*))
-             'vector))
-           :stream out))
-        (%stream-terpri out)
-
-        (when (> *class-number* 0)
-    (generate-loader-function)
-    (write (list 'setq '*fasl-loader*
-           `(sys::make-fasl-class-loader
-             ,*class-number*
-             ,(concatenate 'string "org.armedbear.lisp." (base-classname)))) :stream out))
+              ;; Note: Beyond this point, you can't use DUMP-FORM,
+              ;; because the list of uninterned symbols has been fixed now.
+              (when *fasl-uninterned-symbols*
+                (write (list 'setq '*fasl-uninterned-symbols*
+                             (coerce (mapcar #'car
+                                             (nreverse *fasl-uninterned-symbols*))
+                                     'vector))
+                       :stream out))
+              (%stream-terpri out)
+              ;; we work with a fixed variable name here to work around the
+              ;; lack of availability of the circle reader in the fasl reader
+              ;; but it's a toplevel form anyway
+              (write `(dotimes (i ,*class-number*)
+                        (function-preload
+                         (%format nil "~A-~D.cls"
+                                  ,(substitute #\_ #\. (pathname-name output-file))
+                                  (1+ i))))
+                     :stream out
+                     :circle t)
               (%stream-terpri out))
 
@@ -631 +610 @@
                            (merge-pathnames (make-pathname :type type)
                                             output-file)))
-                 (pathnames nil)
-     (fasl-loader (namestring (merge-pathnames (make-pathname :name (fasl-loader-classname) :type "cls")
-                 output-file))))
-      (when (probe-file fasl-loader)
-        (push fasl-loader pathnames))
+                 (pathnames ()))
             (dotimes (i *class-number*)
               (let* ((pathname (compute-classfile-name (1+ i))))
@@ -657 +632 @@
                   (namestring output-file) elapsed))))
     (values (truename output-file) warnings-p failure-p)))
-
-(defmacro ncase (expr min max &rest clauses)
-  "A CASE where all test clauses are numbers ranging from a minimum to a maximum."
-  ;;Expr is subject to multiple evaluation, but since we only use ncase for
-  ;;fn-index below, let's ignore it.
-  (let* ((half (floor (/ (- max min) 2)))
-   (middle (+ min half)))
-    (if (> (- max min) 10)
-  `(if (< ,expr ,middle)
-       (ncase ,expr ,min ,middle ,@(subseq clauses 0 half))
-       (ncase ,expr ,middle ,max ,@(subseq clauses half)))
-  `(case ,expr ,@clauses))))
-
-(defun generate-loader-function ()
-  (let* ((basename (base-classname))
-   (expr `(lambda (fasl-loader fn-index)
-      (identity fasl-loader) ;;to avoid unused arg
-      (ncase fn-index 0 ,(1- *class-number*)
-        ,@(loop
-       :for i :from 1 :to *class-number*
-       :collect
-       (let ((class (%format nil "org/armedbear/lisp/~A_~A" basename i)))
-         `(,(1- i)
-            (jvm::with-inline-code ()
-        (jvm::emit 'jvm::aload 1)
-        (jvm::emit-invokevirtual jvm::+lisp-object-class+ "javaInstance"
-               nil jvm::+java-object+)
-        (jvm::emit 'jvm::checkcast "org/armedbear/lisp/FaslClassLoader")
-        (jvm::emit 'jvm::dup)
-        (jvm::emit-push-constant-int ,(1- i))
-        (jvm::emit 'jvm::new ,class)
-        (jvm::emit 'jvm::dup)
-        (jvm::emit-invokespecial-init ,class '())
-        (jvm::emit-invokevirtual "org/armedbear/lisp/FaslClassLoader" "putFunction"
-               (list "I" jvm::+lisp-object+) jvm::+lisp-object+)
-        (jvm::emit 'jvm::pop))
-            t))))))
-   (classname (fasl-loader-classname))
-   (classfile (namestring (merge-pathnames (make-pathname :name classname :type "cls")
-             *output-file-pathname*))))
-    (jvm::with-saved-compiler-policy
-  (jvm::with-file-compilation
-      (with-open-file
-    (f classfile
-       :direction :output
-       :element-type '(unsigned-byte 8)
-       :if-exists :supersede)
-        (jvm:compile-defun nil expr nil
-         classfile f nil))))))
 
 (defun compile-file-if-needed (input-file &rest allargs &key force-compile

trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

@@ -1299 +1299 @@
                  (return-from p1-function-call
        (let ((*inline-declarations*
-        (remove op *inline-declarations* :key #'car :test #'equal)))
+        (remove op *inline-declarations* :key #'car)))
          (p1 expansion))))))
 
@@ -1433 +1433 @@
                   (UNWIND-PROTECT       p1-unwind-protect)
                   (THREADS:SYNCHRONIZED-ON
-                                        p1-threads-synchronized-on)
-      (JVM::WITH-INLINE-CODE identity)))
+                                        p1-threads-synchronized-on)))
     (install-p1-handler (%car pair) (%cadr pair))))
 

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -199 +199 @@
           n)))
 
-(defconstant +fasl-loader-class+
-  "org/armedbear/lisp/FaslClassLoader")
 (defconstant +java-string+ "Ljava/lang/String;")
 (defconstant +java-object+ "Ljava/lang/Object;")
@@ -2270 +2268 @@
    (setf g (symbol-name (gensym "LFUN")))
    (let* ((pathname (abcl-class-file-pathname (local-function-class-file local-function)))
-    (class-name (concatenate 'string "org/armedbear/lisp/" (pathname-name pathname)))
     (*code* *static-code*))
      ;; fixme *declare-inline*
-     (declare-field g +lisp-object+ +field-access-private+)
-     (emit 'new class-name)
-     (emit 'dup)
-     (emit-invokespecial-init class-name '())
-
-     ;(emit 'ldc (pool-string (pathname-name pathname)))
-     ;(emit-invokestatic +fasl-loader-class+ "faslLoadFunction"
-     ;(list +java-string+) +lisp-object+)
-
-;     (emit 'ldc (pool-string (file-namestring pathname)))
-     
-;     (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
-;     (list +java-string+) +lisp-object+)
+     (declare-field g +lisp-object+ +field-access-default+)
+     (emit 'ldc (pool-string (file-namestring pathname)))
+     (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
+      (list +java-string+) +lisp-object+)
      (emit 'putstatic *this-class* g +lisp-object+)
      (setf *static-code* *code*)
@@ -2430 +2418 @@
              (typep form 'double-float)
              (characterp form)
+             (stringp form)
+             (packagep form)
+             (pathnamep form)
+             (vectorp form)
              (stringp form)
              (packagep form)
@@ -5107 +5099 @@
                (emit 'getstatic *this-class*
                      g +lisp-object+))))) ; Stack: template-function
-         ((and (member name *functions-defined-in-current-file* :test #'equal)
-         (not (notinline-p name)))
+         ((member name *functions-defined-in-current-file* :test #'equal)
           (emit 'getstatic *this-class*
                 (declare-setf-function name) +lisp-object+)
@@ -7558 +7549 @@
       (compile-function-call form target representation))))
 
-#|(defknown p2-java-jcall (t t t) t)
-(define-inlined-function p2-java-jcall (form target representation)
-  ((and (> *speed* *safety*)
-  (< 1 (length form))
-  (eq 'jmethod (car (cadr form)))
-  (every #'stringp (cdr (cadr form)))))
-  (let ((m (ignore-errors (eval (cadr form)))))
-    (if m 
-  (let ((must-clear-values nil)
-        (arg-types (raw-arg-types (jmethod-params m))))
-    (declare (type boolean must-clear-values))
-    (dolist (arg (cddr form))
-      (compile-form arg 'stack nil)
-      (unless must-clear-values
-        (unless (single-valued-p arg)
-    (setf must-clear-values t))))
-    (when must-clear-values
-      (emit-clear-values))
-    (dotimes (i (jarray-length raw-arg-types))
-      (push (jarray-ref raw-arg-types i) arg-types))
-    (emit-invokevirtual (jclass-name (jmethod-declaring-class m))
-            (jmethod-name m)
-            (nreverse arg-types)
-            (jmethod-return-type m)))
-      ;; delay resolving the method to run-time; it's unavailable now
-      (compile-function-call form target representation))))|#
 
 (defknown p2-char= (t t t) t)
@@ -8260 +8225 @@
   t)
 
-(defun p2-with-inline-code (form target representation)
-  ;;form = (with-inline-code (&optional target-var repr-var) ...body...)
-  (destructuring-bind (&optional target-var repr-var) (cadr form)
-    (eval `(let (,@(when target-var `((,target-var ,target)))
-     ,@(when repr-var `((,repr-var ,representation))))
-       ,@(cddr form)))))
-
 (defun compile-1 (compiland stream)
   (let ((*all-variables* nil)
@@ -8559 +8517 @@
   (install-p2-handler 'java:jconstructor   'p2-java-jconstructor)
   (install-p2-handler 'java:jmethod        'p2-java-jmethod)
-;  (install-p2-handler 'java:jcall          'p2-java-jcall)
   (install-p2-handler 'char=               'p2-char=)
   (install-p2-handler 'characterp          'p2-characterp)
@@ -8644 +8601 @@
   (install-p2-handler 'write-8-bits        'p2-write-8-bits)
   (install-p2-handler 'zerop               'p2-zerop)
-  (install-p2-handler 'with-inline-code    'p2-with-inline-code)
   t)
 

trunk/abcl/src/org/armedbear/lisp/disassemble.lisp

@@ -48 +48 @@
       (unless (compiled-function-p function)
         (setf function (compile nil function)))
-      (let ((class-bytes (function-class-bytes function)))
-  (when class-bytes
-    (with-input-from-string
-        (stream (disassemble-class-bytes class-bytes))
-      (loop
-         (let ((line (read-line stream nil)))
-     (unless line (return))
-     (write-string "; ")
-     (write-string line)
-     (terpri))))
-    (return-from disassemble)))
-      (%format t "; Disassembly is not available.~%"))))
+      (when (getf (function-plist function) 'class-bytes)
+        (with-input-from-string
+          (stream (disassemble-class-bytes (getf (function-plist function) 'class-bytes)))
+          (loop
+            (let ((line (read-line stream nil)))
+              (unless line (return))
+              (write-string "; ")
+              (write-string line)
+              (terpri))))
+        (return-from disassemble)))
+    (%format t "; Disassembly is not available.~%")))

trunk/abcl/src/org/armedbear/lisp/gui.lisp

@@ -1 +1 @@
 (in-package :extensions)
-
-(require :java)
 
 (defvar *gui-backend* :swing)

trunk/abcl/src/org/armedbear/lisp/java/DialogPromptStream.java

@@ -1 @@
-package abcl;
+package org.armedbear.lisp.java;
 
 import java.io.IOException;
@@ -7 +7 @@
 
 import org.armedbear.lisp.Stream;
-
 /**
- * A bidirectional stream that captures input from a modal dialog. The
- * dialog reports a label (prompt line) which shows to the user
- * everything that has been printed to the stream up to the moment
- * when the dialog became visible. It is usable as a drop-in
- * replacement for e.g. *debug-io*.<br /> This is an abstract class
- * that does not depend on any GUI library. Subclasses are expected to
- * provide the actual code to show the dialog and read input from the
- * user.
- *
+ * A bidirectional stream that captures input from a modal dialog. The dialog reports a label (prompt line)
+ * which shows to the user everything that has been printed to the stream up to the moment when the dialog
+ * became visible. It is usable as a drop-in replacement for e.g. *debug-io*.<br />
+ * This is an abstract class that does not depend on any GUI library. Subclasses are expected to provide
+ * the actual code to show the dialog and read input from the user.
  * @author Alessio Stalla
  *

trunk/abcl/src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java

@@ -1 @@
-package swing;
+package org.armedbear.lisp.java.swing;
 
 import java.awt.BorderLayout;
@@ -13 +13 @@
 import javax.swing.JTextField;
 
-import abcl.DialogPromptStream;
+import org.armedbear.lisp.java.DialogPromptStream;
 
 public class SwingDialogPromptStream extends DialogPromptStream {

trunk/abcl/src/org/armedbear/lisp/load.lisp

@@ -39 +39 @@
              (external-format :default))
   (declare (ignore external-format)) ; FIXME
-  (let (*fasl-loader*)
-    (%load (if (streamp filespec)
-         filespec
-         (merge-pathnames (pathname filespec)))
-     verbose print if-does-not-exist)))
+  (%load (if (streamp filespec)
+             filespec
+             (merge-pathnames (pathname filespec)))
+         verbose print if-does-not-exist))
 
 (defun load-returning-last-result (filespec
@@ -52 +51 @@
              (external-format :default))
   (declare (ignore external-format)) ; FIXME
-  (let (*fasl-loader*)
-    (%load-returning-last-result (if (streamp filespec)
-             filespec
-             (merge-pathnames (pathname filespec)))
-         verbose print if-does-not-exist)))
+  (%load-returning-last-result (if (streamp filespec)
+             filespec
+             (merge-pathnames (pathname filespec)))
+         verbose print if-does-not-exist))

trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

@@ -33 +33 @@
 
 
-(export '(process-optimization-declarations
+(export '(*inline-declarations*
+          process-optimization-declarations
           inline-p notinline-p inline-expansion expand-inline
           *defined-functions* *undefined-functions* note-name-defined))
+
+(defvar *inline-declarations* nil)
 
 (declaim (ftype (function (t) t) process-optimization-declarations))
@@ -84 +87 @@
 (defun inline-p (name)
   (declare (optimize speed))
-  (let ((entry (assoc name *inline-declarations* :test #'equal)))
+  (let ((entry (assoc name *inline-declarations*)))
     (if entry
         (eq (cdr entry) 'INLINE)
@@ -92 +95 @@
 (defun notinline-p (name)
   (declare (optimize speed))
-  (let ((entry (assoc name *inline-declarations* :test #'equal)))
+  (let ((entry (assoc name *inline-declarations*)))
     (if entry
         (eq (cdr entry) 'NOTINLINE)
@@ -959 +962 @@
                                   'precompiler))))
     (unless (and handler (fboundp handler))
-      (error "No handler for ~S." (let ((*package* (find-package :keyword)))
-            (format nil "~S" symbol))))
+      (error "No handler for ~S." symbol))
     (setf (get symbol 'precompile-handler) handler)))
 
@@ -1023 +1025 @@
 
                   (THREADS:SYNCHRONIZED-ON
-                                        precompile-threads-synchronized-on)
-      
-      (JVM::WITH-INLINE-CODE precompile-identity)))
+                                        precompile-threads-synchronized-on)))
     (install-handler (first pair) (second pair))))
 

trunk/abcl/src/org/armedbear/lisp/proclaim.lisp

@@ -32 +32 @@
 (in-package #:system)
 
-(export '(check-declaration-type proclaimed-type proclaimed-ftype ftype-result-type *inline-declarations*))
+(export '(check-declaration-type proclaimed-type proclaimed-ftype ftype-result-type))
 
 (defmacro declaim (&rest decls)
@@ -44 +44 @@
          :format-arguments (list name)))
 
-(defvar *inline-declarations* nil)
 (defvar *declaration-types* (make-hash-table :test 'eq))
 
@@ -93 +92 @@
     ((INLINE NOTINLINE)
      (dolist (name (cdr declaration-specifier))
-       (if (symbolp name)
-         (setf (get name '%inline) (car declaration-specifier))
-   (push (cons name (car declaration-specifier)) *inline-declarations*))))
+       (when (symbolp name) ; FIXME Need to support non-symbol function names.
+         (setf (get name '%inline) (car declaration-specifier)))))
     (DECLARATION
      (dolist (name (cdr declaration-specifier))

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

@@ -279 +279 @@
   }
   
+  @Override
   public <T> T getInterface(Class<T> clasz) {
     try {
@@ -288 +289 @@
 
   @SuppressWarnings("unchecked")
+  @Override
   public <T> T getInterface(Object thiz, Class<T> clasz) {
       Symbol s = findSymbol("jmake-proxy", "JAVA");
@@ -294 +296 @@
   }
   
+    @Override
     public Object invokeFunction(String name, Object... args) throws ScriptException, NoSuchMethodException {
   Symbol s;
@@ -318 +321 @@
     }
 
+    @Override
     public Object invokeMethod(Object thiz, String name, Object... args) throws ScriptException, NoSuchMethodException {
   throw new UnsupportedOperationException("Common Lisp does not have methods in the Java sense. Use invokeFunction instead.");

trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java

@@ -32 +32 @@
     private static final AbclScriptEngine THE_ONLY_ONE_ENGINE = new AbclScriptEngine();
   
-    public String getEngineName() {
-  return "ABCL Script";
-    }
+  @Override
+  public String getEngineName() {
+    return "ABCL Script";
+  }
 
-    public String getEngineVersion() {
-  return "0.1";
-    }
+  @Override
+  public String getEngineVersion() {
+    return "0.1";
+  }
 
-    public List<String> getExtensions() {
-  List<String> extensions = new ArrayList<String>(1);
-  extensions.add("lisp");
-  return Collections.unmodifiableList(extensions);
-    }
+  @Override
+  public List<String> getExtensions() {
+    List<String> extensions = new ArrayList<String>(1);
+    extensions.add("lisp");
+    return Collections.unmodifiableList(extensions);
+  }
 
-    public String getLanguageName() {
-  return "ANSI Common Lisp";
-    }
+  @Override
+  public String getLanguageName() {
+    return "ANSI Common Lisp";
+  }
 
-    public String getLanguageVersion() {
-  return "ANSI X3.226:1994";
-    }
+  @Override
+  public String getLanguageVersion() {
+    return "ANSI X3.226:1994";
+  }
 
-    public static String escape(String raw) {
-  StringBuilder sb = new StringBuilder();
-  int len = raw.length();
-  char c;
-  for(int i = 0; i < len; ++i) {
-      c = raw.charAt(i);
-      if(c != '"') {
-    sb.append(c);
-      } else {
-    sb.append("\\\"");
-      }
+  public static String escape(String raw) {
+    StringBuilder sb = new StringBuilder();
+    int len = raw.length();
+    char c;
+    for(int i = 0; i < len; ++i) {
+      c = raw.charAt(i);
+      if(c != '"') {
+        sb.append(c);
+      } else {
+        sb.append("\\\"");
+      }
+    }
+    return sb.toString();
   }
-  return sb.toString();
-    }
   
-    public String getMethodCallSyntax(String obj, String method, String... args) {
-  StringBuilder sb = new StringBuilder();
-  sb.append("(jcall \"");
-  sb.append(method);
-  sb.append("\" ");
-  sb.append(obj);
-  for(String arg : args) {
-      sb.append(" ");
-      sb.append(arg);
+  @Override
+  public String getMethodCallSyntax(String obj, String method, String... args) {
+    StringBuilder sb = new StringBuilder();
+    sb.append("(jcall \"");
+    sb.append(method);
+    sb.append("\" ");
+    sb.append(obj);
+    for(String arg : args) {
+      sb.append(" ");
+      sb.append(arg);
+    }
+    sb.append(")");
+    return sb.toString();
   }
-  sb.append(")");
-  return sb.toString();
-    }
-    
-    public List<String> getMimeTypes() {
-  return Collections.unmodifiableList(new ArrayList<String>());
-    }
 
-    public List<String> getNames() {
-  List<String> names = new ArrayList<String>(1);
-  names.add("ABCL");
-  names.add("cl");
-  names.add("Lisp");
-  names.add("Common Lisp");
-  return Collections.unmodifiableList(names);
-    }
+  @Override
+  public List<String> getMimeTypes() {
+      return Collections.unmodifiableList(new ArrayList<String>());
+  }
 
-    public String getOutputStatement(String str) {
-  return "(cl:print \"" + str + "\")";
-    }
+  @Override
+  public List<String> getNames() {
+    List<String> names = new ArrayList<String>(1);
+    names.add("ABCL");
+    names.add("cl");
+    names.add("Lisp");
+    names.add("Common Lisp");
+    return Collections.unmodifiableList(names);
+  }
 
-    public Object getParameter(String key) {
-  // TODO Auto-generated method stub
-  return null;
-    }
+  @Override
+  public String getOutputStatement(String str) {
+    return "(cl:print \"" + str + "\")";
+  }
 
-    public String getProgram(String... statements) {
-  StringBuilder sb = new StringBuilder();
-  sb.append("(cl:progn");
-  for(String stmt : statements) {
-      sb.append("\n\t");
-      sb.append(stmt);
+  @Override
+  public Object getParameter(String key) {
+    // TODO Auto-generated method stub
+    return null;
   }
-  sb.append(")");
-  return sb.toString();
-    }
-    
-    public ScriptEngine getScriptEngine() {
-  return THE_ONLY_ONE_ENGINE;
-    }
+
+  @Override
+  public String getProgram(String... statements) {
+    StringBuilder sb = new StringBuilder();
+    sb.append("(cl:progn");
+    for(String stmt : statements) {
+      sb.append("\n\t");
+      sb.append(stmt);
+    }
+    sb.append(")");
+    return sb.toString();
+  }
+
+  @Override
+  public ScriptEngine getScriptEngine() {
+    return THE_ONLY_ONE_ENGINE;
+  }
 
 }