Changeset 12749

Timestamp:

06/09/10 11:27:42 (13 years ago)

Author:

Mark Evenson

Message:

Undo previous commmit.

Location:

trunk/abcl

Files:

• build.xml (modified) (1 diff)
• examples/.abclrc (deleted)
• examples/README (copied) (copied from trunk/abcl/examples/README)
• examples/complete.lisp (deleted)
• examples/google-app-engine (copied) (copied from trunk/abcl/examples/google-app-engine)
• examples/gui (copied) (copied from trunk/abcl/examples/gui)
• examples/hello.java (deleted)
• examples/init.lisp (deleted)
• examples/java-exception (copied) (copied from trunk/abcl/examples/java-exception)
• examples/java-interface (copied) (copied from trunk/abcl/examples/java-interface)
• examples/java-to-lisp-1 (copied) (copied from trunk/abcl/examples/java-to-lisp-1)
• examples/java-to-lisp-2 (copied) (copied from trunk/abcl/examples/java-to-lisp-2)
• examples/jsr-223 (copied) (copied from trunk/abcl/examples/jsr-223)
• examples/key-pressed.lisp (deleted)
• examples/lisp-to-java (copied) (copied from trunk/abcl/examples/lisp-to-java)
• examples/misc (copied) (copied from trunk/abcl/examples/misc)
• examples/update-check-enabled.lisp (deleted)
• 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 (copied) (copied from trunk/abcl/src/org/armedbear/lisp/FaslClassLoader.java)
• 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 (deleted)
• src/org/armedbear/lisp/java/swing/REPLConsole.java (copied) (copied from trunk/abcl/src/org/armedbear/lisp/java/swing/REPLConsole.java)
• src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java (deleted)
• 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"/>
     <!-- 
@@ -49 +56 @@
     <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="manifest.available+main.class">
+        <condition property="main.class.available">
             <and>
-                <isset property="manifest.available"/>
                 <isset property="main.class"/>
                 <not>
@@ -58 +64 @@
             </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="libs.CopyLibs.classpath"/>
+                <isset property="do.mkdist"/>
             </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">
@@ -98 +136 @@
         <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>
@@ -113 +152 @@
             <istrue value="${do.depend}"/>
         </condition>
-        <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>
+        <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"/>
     </target>
     <target name="-post-init">
@@ -153 +191 @@
             <attribute default="${excludes}" name="excludes"/>
             <attribute default="${javac.debug}" name="debug"/>
-            <attribute default="/does/not/exist" name="sourcepath"/>
+            <attribute default="${empty.dir}" name="sourcepath"/>
+            <attribute default="${empty.dir}" name="gensrcdir"/>
             <element name="customize" optional="true"/>
             <sequential>
-                <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}">
+                <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>
                     <classpath>
                         <path path="@{classpath}"/>
                     </classpath>
-                    <compilerarg line="${javac.compilerargs} ${javac.compilerargs.jaxws}"/>
+                    <compilerarg line="${endorsed.classpath.cmd.line.arg}"/>
+                    <compilerarg line="${javac.compilerargs}"/>
                     <customize/>
                 </javac>
@@ -199 +246 @@
             <attribute default="**" name="testincludes"/>
             <sequential>
-                <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true">
+                <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true" tempdir="${build.dir}">
                     <batchtest todir="${build.test.results.dir}">
                         <fileset dir="${test.src.dir}" excludes="@{excludes},${excludes}" includes="@{includes}">
@@ -214 +261 @@
                     <formatter type="brief" usefile="false"/>
                     <formatter type="xml"/>
+                    <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
                     <jvmarg line="${run.jvmargs}"/>
                 </junit>
@@ -270 +318 @@
             <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>
@@ -288 +339 @@
         <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="${run.classpath}"/>
+                        <path path="@{classpath}"/>
                     </classpath>
                     <syspropertyset>
@@ -317 +372 @@
                 ===================
             -->
-    <target depends="init" name="deps-jar" unless="no.deps"/>
+    <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,-check-automatic-build,-clean-after-automatic-build" name="-verify-automatic-build"/>
     <target depends="init" name="-check-automatic-build">
@@ -333 +403 @@
     </target>
     <target if="do.depend.true" name="-compile-depend">
-        <j2seproject3: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}"/>
     </target>
     <target depends="init,deps-jar,-pre-pre-compile,-pre-compile,-compile-depend" if="have.sources" name="-do-compile">
-        <j2seproject3:javac/>
+        <j2seproject3:javac gensrcdir="${build.generated.sources.dir}"/>
         <copy todir="${build.classes.dir}">
             <fileset dir="${src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
@@ -353 +428 @@
         <fail unless="javac.includes">Must select some files in the IDE or set javac.includes</fail>
         <j2seproject3:force-recompile/>
-        <j2seproject3:javac excludes="" includes="${javac.includes}" sourcepath="${src.dir}"/>
+        <j2seproject3:javac excludes="" gensrcdir="${build.generated.sources.dir}" includes="${javac.includes}" sourcepath="${src.dir}"/>
     </target>
     <target name="-post-compile-single">
@@ -373 +448 @@
         <!-- 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">
+    <target depends="init,compile,-pre-pre-jar,-pre-jar" name="-do-jar-without-manifest" unless="manifest.available-mkdist.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">
+    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class-mkdist.available">
         <j2seproject1:jar manifest="${manifest.file}"/>
     </target>
@@ -419 +494 @@
         <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,-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,-do-jar-with-libraries-without-mainclass,-do-jar-with-libraries-without-manifest,-post-jar" description="Build JAR." name="jar"/>
     <!--
                 =================
@@ -439 +556 @@
         <property name="javac.includes.binary" value=""/>
     </target>
-    <target depends="init,-do-not-recompile,compile-single" name="run-single">
+    <target depends="init,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>
     <!--
@@ -450 +571 @@
     <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">
@@ -467 +591 @@
         <j2seproject3:debug classname="${debug.class}"/>
     </target>
-    <target depends="init,-do-not-recompile,compile-single,-debug-start-debugger,-debug-start-debuggee-single" if="netbeans.home" name="debug-single"/>
+    <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" name="-pre-debug-fix">
         <fail unless="fix.includes">Must set fix.includes</fail>
@@ -490 +619 @@
                 <filename name="**/*.java"/>
             </fileset>
+            <fileset dir="${build.generated.sources.dir}" erroronmissingdir="false">
+                <include name="**/*.java"/>
+            </fileset>
         </javadoc>
     </target>
@@ -551 +683 @@
     </target>
     <target depends="init,compile-test,-pre-test-run,-do-test-run" if="have.tests" name="-post-test-run">
-        <fail if="tests.failed">Some tests failed; see details above.</fail>
+        <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
     </target>
     <target depends="init" if="have.tests" name="test-report"/>
@@ -564 +696 @@
     </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">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"/>
+        <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"/>
     <!--
                 =======================
@@ -593 +725 @@
         <j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${test.class}"/>
     </target>
-    <target depends="init,-do-not-recompile,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
+    <target depends="init,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}"/>
@@ -630 +762 @@
                 ===============
             -->
-    <target depends="init" name="deps-clean" unless="no.deps"/>
+    <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="-do-clean">
         <delete dir="${build.dir}"/>
-        <delete dir="${dist.dir}"/>
+        <delete dir="${dist.dir}" followsymlinks="false" includeemptydirs="true"/>
     </target>
     <target name="-post-clean">
@@ -640 +787 @@
     </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=b7bf05a5
-nbproject/build-impl.xml.stylesheet.CRC32=65b8de21
+nbproject/build-impl.xml.script.CRC32=29122cc4
+nbproject/build-impl.xml.stylesheet.CRC32=576378a2@1.32.1.45
 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));
+        return error(new WrongNumberOfArgumentsException(this, 0));
     }
 
@@ -185 +213 @@
     public LispObject execute(LispObject arg)
     {
-        return error(new WrongNumberOfArgumentsException(this));
+        return error(new WrongNumberOfArgumentsException(this, 1));
     }
 
@@ -192 +220 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this));
+        return error(new WrongNumberOfArgumentsException(this, 2));
     }
 
@@ -200 +228 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this));
+        return error(new WrongNumberOfArgumentsException(this, 3));
     }
 
@@ -208 +236 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this));
+        return error(new WrongNumberOfArgumentsException(this, 4));
     }
 
@@ -217 +245 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this));
+        return error(new WrongNumberOfArgumentsException(this, 5));
     }
 
@@ -226 +254 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this));
+        return error(new WrongNumberOfArgumentsException(this, 6));
     }
 
@@ -236 +264 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this));
+        return error(new WrongNumberOfArgumentsException(this, 7));
     }
 
@@ -246 +274 @@
 
     {
-        return error(new WrongNumberOfArgumentsException(this));
+        return error(new WrongNumberOfArgumentsException(this, 8));
     }
 

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

@@ -178 +178 @@
             catch (ClassNotFoundException e) { } // FIXME: what to do?
 
-            Load.loadSystemFile("j.lisp");
+            Load.loadSystemFile("j.lisp", false); // not being autoloaded
 
             initialized = true;
@@ -218 +218 @@
     private static synchronized void initializeSystem() 
     {
-        Load.loadSystemFile("system");
+        Load.loadSystemFile("system", false); // not being autoloaded
     }
 
@@ -309 +309 @@
 
                         else
-                            Load.loadSystemFile(args[i + 1]);
+                            Load.loadSystemFile(args[i + 1], false); // not being autoloaded
                         ++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
@@ -702 +700 @@
    * This version is used by the interpreter.
    */
-  public static final LispObject nonLocalGo(Binding binding,
-                                            LispObject tag)
-
+  static final LispObject nonLocalGo(Binding binding,
+                                     LispObject tag)
   {
     if (binding.env.inactive)
@@ -739 +736 @@
    * This version is used by the interpreter.
    */
-  public static final LispObject nonLocalReturn(Binding binding,
-                                                Symbol block,
-                                                LispObject result)
-
+  static final LispObject nonLocalReturn(Binding binding,
+                                         Symbol block,
+                                         LispObject result)
   {
     if (binding == null)
@@ -1269 +1265 @@
               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));
           }
@@ -2388 +2385 @@
     internSpecial("*LOAD-STREAM*", PACKAGE_SYS, NIL);
 
+    // ### *fasl-loader*
+    public static final Symbol _FASL_LOADER_ =
+  exportSpecial("*FASL-LOADER*", PACKAGE_SYS, NIL);
+
   // ### *source*
   // internal symbol
@@ -2761 +2762 @@
   }
 
+  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)
 
@@ -253 +243 @@
     }
 
+    private static final Symbol FASL_LOADER = PACKAGE_SYS.intern("*FASL-LOADER*");
     static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
 
@@ -279 +270 @@
             url = Lisp.class.getResource(path);
             if (url == null || url.toString().endsWith("/")) {
-                url = Lisp.class.getResource(path + ".abcl");
+                url = Lisp.class.getResource(path.replace('-', '_') + ".abcl");
                 if (url == null) {
                     url = Lisp.class.getResource(path + ".lisp");
@@ -333 +324 @@
             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);
@@ -441 +433 @@
     }
 
+    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,
@@ -454 +452 @@
         final LispThread thread = LispThread.currentThread();
         final SpecialBindingsMark mark = thread.markSpecialBindings();
-        // "LOAD binds *READTABLE* and *PACKAGE* to the values they held before
-        // loading the file."
-        thread.bindSpecialToCurrentValue(Symbol.CURRENT_READTABLE);
-        thread.bindSpecialToCurrentValue(Symbol._PACKAGE_);
+
+        for (Symbol special : savedSpecials)
+            thread.bindSpecialToCurrentValue(special);
+
         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 {
@@ -562 +554 @@
 
     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)
 
@@ -584 +570 @@
                 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 LispObject typeOf()
+  public final LispObject typeOf()
   {
     return Symbol.READTABLE;
@@ -178 +178 @@
 
   @Override
-  public LispObject classOf()
+  public final LispObject classOf()
   {
     return BuiltInClass.READTABLE;
@@ -184 +184 @@
 
   @Override
-  public LispObject typep(LispObject type)
+  public final LispObject typep(LispObject type)
   {
     if (type == Symbol.READTABLE)
@@ -194 +194 @@
 
   @Override
-  public String toString()
+  public final String toString()
   {
     return unreadableString("READTABLE");
   }
 
-  public LispObject getReadtableCase()
+  public final LispObject getReadtableCase()
   {
     return readtableCase;
   }
 
-  public boolean isWhitespace(char c)
+  public final boolean isWhitespace(char c)
   {
     return getSyntaxType(c) == SYNTAX_TYPE_WHITESPACE;
   }
 
-  public byte getSyntaxType(char c)
+  public final byte getSyntaxType(char c)
   {
     return syntax.get(c);
   }
 
-  public boolean isInvalid(char c)
+  public final boolean isInvalid(char c)
   {
     switch (c)
@@ -231 +231 @@
   }
 
-  public void checkInvalid(char c, Stream stream)
+  public final void checkInvalid(char c, Stream stream)
   {
     // "... no mechanism is provided for changing the constituent trait of a
@@ -248 +248 @@
   }
 
-  public LispObject getReaderMacroFunction(char c)
+  public final LispObject getReaderMacroFunction(char c)
   {
     return readerMacroFunctions.get(c);
   }
 
-  LispObject getMacroCharacter(char c)
+  final LispObject getMacroCharacter(char c)
   {
     LispObject function = getReaderMacroFunction(c);
@@ -272 +272 @@
   }
 
-  void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
+  final void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
   {
     byte syntaxType;
@@ -285 +285 @@
   }
 
-  public LispObject getDispatchMacroCharacter(char dispChar, char subChar)
+  public final LispObject getDispatchMacroCharacter(char dispChar, char subChar)
 
   {
@@ -300 +300 @@
   }
 
-  public void setDispatchMacroCharacter(char dispChar, char subChar,
+  public final 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)
   {
@@ -114 +120 @@
   }
 
-  // ### make-slot-definition
+  // ### make-slot-definition &optional class
   private static final Primitive MAKE_SLOT_DEFINITION =
-    new Primitive("make-slot-definition", PACKAGE_SYS, true, "")
+    new Primitive("make-slot-definition", PACKAGE_SYS, true, "&optional class")
     {
       @Override
@@ -122 +128 @@
       {
         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).
@@ -722 +727 @@
     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());
-                for (int i = sb.length(); i-- > 0;)
-                    flags.set(i);
+                flags.set(0, sb.length());
             } else if (rt.isInvalid(c)) {
                 rt.checkInvalid(c, this); // Signals a reader-error.
@@ -1181 +1180 @@
                     if (flags == null)
                         flags = new BitSet(sb.length());
-                    for (int i = begin; i < end; i++)
-                        flags.set(i);
+                    flags.set(begin, end);
                     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
@@ -260 +262 @@
   `(function (lambda () ,initform)))
 
-(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))
+(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)))))
 
 ;;; finalize-inheritance
@@ -456 +463 @@
 
 (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
@@ -559 +566 @@
                                           :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
@@ -1900 +1913 @@
 (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)
@@ -2212 +2235 @@
 (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
@@ -46 +52 @@
   "Computes the name of the class file associated with number `n'."
   (let ((name
-         (%format nil "~A-~D"
-                  (substitute #\_ #\.
-                              (pathname-name output-file-pathname)) n)))
+         (sanitize-class-name
+    (%format nil "~A_~D" (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))
@@ -70 +86 @@
 (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))
+    t)|#
+  (declare (ignore classfile))
+  t)
 
 (declaim (ftype (function (t) t) process-defconstant))
@@ -145 +163 @@
                  (let* ((expr `(lambda ,lambda-list
                                  ,@decls (block ,block-name ,@body)))
+      (saved-class-number *class-number*)
                         (classfile (next-classfile-name))
                         (internal-compiler-errors nil)
@@ -169 +188 @@
                       (setf form
                             `(fset ',name
-                                   (proxy-preloaded-function ',name ,(file-namestring classfile))
+           (sys::get-fasl-function *fasl-loader*
+                 ,saved-class-number)
                                    ,*source-position*
                                    ',lambda-list
@@ -226 +246 @@
              (eval form)
              (let* ((expr (function-lambda-expression (macro-function name)))
+        (saved-class-number *class-number*)
                     (classfile (next-classfile-name)))
          (with-open-file
@@ -242 +263 @@
                              `(put ',name 'macroexpand-macro
                                    (make-macro ',name
-                                               (proxy-preloaded-function
-                                                '(macro-function ,name)
-                                                ,(file-namestring classfile))))
+                 (sys::get-fasl-function *fasl-loader* ,saved-class-number)))
                              `(fset ',name
                                     (make-macro ',name
-                                                (proxy-preloaded-function
-                                                 '(macro-function ,name)
-                                                 ,(file-namestring classfile)))
+            (sys::get-fasl-function *fasl-loader* ,saved-class-number))
                                     ,*source-position*
                                     ',(third form)))))))))
@@ -349 +366 @@
   ;; was already used in verify-load before I used it,
   ;; however, binding *load-truename* isn't fully compliant, I think.
-  (let ((*load-truename* *output-file-pathname*))
-    (when compile-time-too
+  (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)))
       (eval form))))
 
@@ -367 +388 @@
       (let ((lambda-expression (cadr function-form)))
         (jvm::with-saved-compiler-policy
-          (let* ((classfile (next-classfile-name))
+          (let* ((saved-class-number *class-number*)
+     (classfile (next-classfile-name))
                  (result
       (with-open-file
@@ -380 +402 @@
             (cond (compiled-function
                    (setf (getf tail key)
-                         `(load-compiled-function ,(file-namestring classfile))))
+       `(sys::get-fasl-function *fasl-loader* ,saved-class-number)))
+;;                         `(load-compiled-function ,(file-namestring classfile))))
                   (t
                    ;; FIXME This should be a warning or error of some sort...
@@ -413 +436 @@
       (precompiler:precompile-form form nil *compile-file-environment*)))
   (let* ((expr `(lambda () ,form))
+   (saved-class-number *class-number*)
          (classfile (next-classfile-name))
          (result
@@ -426 +450 @@
     (setf form
           (if compiled-function
-              `(funcall (load-compiled-function ,(file-namestring classfile)))
+              `(funcall (sys::get-fasl-function *fasl-loader* ,saved-class-number))
               (precompiler:precompile-form form nil *compile-file-environment*)))))
 
@@ -573 +597 @@
                      :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)
-              ;; 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)
+        ;; 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))
               (%stream-terpri out))
 
@@ -610 +631 @@
                            (merge-pathnames (make-pathname :type type)
                                             output-file)))
-                 (pathnames ()))
+                 (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))
             (dotimes (i *class-number*)
               (let* ((pathname (compute-classfile-name (1+ i))))
@@ -632 +657 @@
                   (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)))
+        (remove op *inline-declarations* :key #'car :test #'equal)))
          (p1 expansion))))))
 
@@ -1433 +1433 @@
                   (UNWIND-PROTECT       p1-unwind-protect)
                   (THREADS:SYNCHRONIZED-ON
-                                        p1-threads-synchronized-on)))
+                                        p1-threads-synchronized-on)
+      (JVM::WITH-INLINE-CODE identity)))
     (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;")
@@ -2268 +2270 @@
    (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-default+)
-     (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-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+)
      (emit 'putstatic *this-class* g +lisp-object+)
      (setf *static-code* *code*)
@@ -2418 +2430 @@
              (typep form 'double-float)
              (characterp form)
-             (stringp form)
-             (packagep form)
-             (pathnamep form)
-             (vectorp form)
              (stringp form)
              (packagep form)
@@ -5099 +5107 @@
                (emit 'getstatic *this-class*
                      g +lisp-object+))))) ; Stack: template-function
-         ((member name *functions-defined-in-current-file* :test #'equal)
+         ((and (member name *functions-defined-in-current-file* :test #'equal)
+         (not (notinline-p name)))
           (emit 'getstatic *this-class*
                 (declare-setf-function name) +lisp-object+)
@@ -7549 +7558 @@
       (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)
@@ -8225 +8260 @@
   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)
@@ -8517 +8559 @@
   (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)
@@ -8601 +8644 @@
   (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)))
-      (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.~%")))
+      (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.~%"))))

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/load.lisp

@@ -39 +39 @@
              (external-format :default))
   (declare (ignore external-format)) ; FIXME
-  (%load (if (streamp filespec)
-             filespec
-             (merge-pathnames (pathname filespec)))
-         verbose print if-does-not-exist))
+  (let (*fasl-loader*)
+    (%load (if (streamp filespec)
+         filespec
+         (merge-pathnames (pathname filespec)))
+     verbose print if-does-not-exist)))
 
 (defun load-returning-last-result (filespec
@@ -51 +52 @@
              (external-format :default))
   (declare (ignore external-format)) ; FIXME
-  (%load-returning-last-result (if (streamp filespec)
-             filespec
-             (merge-pathnames (pathname filespec)))
-         verbose print if-does-not-exist))
+  (let (*fasl-loader*)
+    (%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 '(*inline-declarations*
-          process-optimization-declarations
+(export '(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))
@@ -87 +84 @@
 (defun inline-p (name)
   (declare (optimize speed))
-  (let ((entry (assoc name *inline-declarations*)))
+  (let ((entry (assoc name *inline-declarations* :test #'equal)))
     (if entry
         (eq (cdr entry) 'INLINE)
@@ -95 +92 @@
 (defun notinline-p (name)
   (declare (optimize speed))
-  (let ((entry (assoc name *inline-declarations*)))
+  (let ((entry (assoc name *inline-declarations* :test #'equal)))
     (if entry
         (eq (cdr entry) 'NOTINLINE)
@@ -962 +959 @@
                                   'precompiler))))
     (unless (and handler (fboundp handler))
-      (error "No handler for ~S." symbol))
+      (error "No handler for ~S." (let ((*package* (find-package :keyword)))
+            (format nil "~S" symbol))))
     (setf (get symbol 'precompile-handler) handler)))
 
@@ -1025 +1023 @@
 
                   (THREADS:SYNCHRONIZED-ON
-                                        precompile-threads-synchronized-on)))
+                                        precompile-threads-synchronized-on)
+      
+      (JVM::WITH-INLINE-CODE precompile-identity)))
     (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))
+(export '(check-declaration-type proclaimed-type proclaimed-ftype ftype-result-type *inline-declarations*))
 
 (defmacro declaim (&rest decls)
@@ -44 +44 @@
          :format-arguments (list name)))
 
+(defvar *inline-declarations* nil)
 (defvar *declaration-types* (make-hash-table :test 'eq))
 
@@ -92 +93 @@
     ((INLINE NOTINLINE)
      (dolist (name (cdr declaration-specifier))
-       (when (symbolp name) ; FIXME Need to support non-symbol function names.
-         (setf (get name '%inline) (car declaration-specifier)))))
+       (if (symbolp name)
+         (setf (get name '%inline) (car declaration-specifier))
+   (push (cons name (car declaration-specifier)) *inline-declarations*))))
     (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 {
@@ -289 +288 @@
 
   @SuppressWarnings("unchecked")
-  @Override
   public <T> T getInterface(Object thiz, Class<T> clasz) {
       Symbol s = findSymbol("jmake-proxy", "JAVA");
@@ -296 +294 @@
   }
   
-    @Override
     public Object invokeFunction(String name, Object... args) throws ScriptException, NoSuchMethodException {
   Symbol s;
@@ -321 +318 @@
     }
 
-    @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();
   
-  @Override
-  public String getEngineName() {
-    return "ABCL Script";
+    public String getEngineName() {
+  return "ABCL Script";
+    }
+
+    public String getEngineVersion() {
+  return "0.1";
+    }
+
+    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";
+    }
+
+    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("\\\"");
+      }
   }
+  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);
+  }
+  sb.append(")");
+  return sb.toString();
+    }
+    
+    public List<String> getMimeTypes() {
+  return Collections.unmodifiableList(new ArrayList<String>());
+    }
 
-  @Override
-  public String getEngineVersion() {
-    return "0.1";
+    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 String getOutputStatement(String str) {
+  return "(cl:print \"" + str + "\")";
+    }
+
+    public Object getParameter(String key) {
+  // TODO Auto-generated method stub
+  return null;
+    }
+
+    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 List<String> getExtensions() {
-    List<String> extensions = new ArrayList<String>(1);
-    extensions.add("lisp");
-    return Collections.unmodifiableList(extensions);
-  }
-
-  @Override
-  public String getLanguageName() {
-    return "ANSI Common Lisp";
-  }
-
-  @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("\\\"");
-      }
-    }
-    return sb.toString();
-  }
-  
-  @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();
-  }
-
-  @Override
-  public List<String> getMimeTypes() {
-      return Collections.unmodifiableList(new ArrayList<String>());
-  }
-
-  @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);
-  }
-
-  @Override
-  public String getOutputStatement(String str) {
-    return "(cl:print \"" + str + "\")";
-  }
-
-  @Override
-  public Object getParameter(String key) {
-    // TODO Auto-generated method stub
-    return null;
-  }
-
-  @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;
-  }
+  sb.append(")");
+  return sb.toString();
+    }
+    
+    public ScriptEngine getScriptEngine() {
+  return THE_ONLY_ONE_ENGINE;
+    }
 
 }