Changeset 12749


Ignore:
Timestamp:
06/09/10 11:27:42 (7 years ago)
Author:
mevenson
Message:

Undo previous commmit.

Location:
trunk/abcl
Files:
8 deleted
24 edited
12 copied

Legend:

Unmodified
Added
Removed
  • trunk/abcl/build.xml

    r12748 r12749  
    465465      <include name="abcl.bat.in"/>
    466466     
    467       <include name="examples/**"/>
    468      
    469467      <!-- The remainder of these files are used by the Lisp hosted
    470468           build in 'build-abcl.lisp' but not used by Ant, so include
  • trunk/abcl/nbproject/build-impl.xml

    r12748 r12749  
    2121        -->
    2222<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">
     23    <fail message="Please build using Ant 1.7.1 or higher.">
     24        <condition>
     25            <not>
     26                <antversion atleast="1.7.1"/>
     27            </not>
     28        </condition>
     29    </fail>
    2330    <target depends="test,jar,javadoc" description="Build and test whole project." name="default"/>
    2431    <!--
     
    4956    <target depends="-pre-init,-init-private,-init-user,-init-project,-init-macrodef-property" name="-do-init">
    5057        <available file="${manifest.file}" property="manifest.available"/>
    51         <condition property="manifest.available+main.class">
     58        <condition property="main.class.available">
    5259            <and>
    53                 <isset property="manifest.available"/>
    5460                <isset property="main.class"/>
    5561                <not>
     
    5864            </and>
    5965        </condition>
     66        <condition property="manifest.available+main.class">
     67            <and>
     68                <isset property="manifest.available"/>
     69                <isset property="main.class.available"/>
     70            </and>
     71        </condition>
     72        <condition property="do.mkdist">
     73            <and>
     74                <isset property="libs.CopyLibs.classpath"/>
     75                <not>
     76                    <istrue value="${mkdist.disabled}"/>
     77                </not>
     78            </and>
     79        </condition>
    6080        <condition property="manifest.available+main.class+mkdist.available">
    6181            <and>
    6282                <istrue value="${manifest.available+main.class}"/>
    63                 <isset property="libs.CopyLibs.classpath"/>
     83                <isset property="do.mkdist"/>
    6484            </and>
     85        </condition>
     86        <condition property="manifest.available+mkdist.available">
     87            <and>
     88                <istrue value="${manifest.available}"/>
     89                <isset property="do.mkdist"/>
     90            </and>
     91        </condition>
     92        <condition property="manifest.available-mkdist.available">
     93            <or>
     94                <istrue value="${manifest.available}"/>
     95                <isset property="do.mkdist"/>
     96            </or>
     97        </condition>
     98        <condition property="manifest.available+main.class-mkdist.available">
     99            <or>
     100                <istrue value="${manifest.available+main.class}"/>
     101                <isset property="do.mkdist"/>
     102            </or>
    65103        </condition>
    66104        <condition property="have.tests">
     
    98136        <property name="application.args" value=""/>
    99137        <property name="source.encoding" value="${file.encoding}"/>
     138        <property name="runtime.encoding" value="${source.encoding}"/>
    100139        <condition property="javadoc.encoding.used" value="${javadoc.encoding}">
    101140            <and>
     
    113152            <istrue value="${do.depend}"/>
    114153        </condition>
    115         <condition else="" property="javac.compilerargs.jaxws" value="-Djava.endorsed.dirs='${jaxws.endorsed.dir}'">
    116             <and>
    117                 <isset property="jaxws.endorsed.dir"/>
    118                 <available file="nbproject/jaxws-build.xml"/>
    119             </and>
    120         </condition>
     154        <path id="endorsed.classpath.path" path="${endorsed.classpath}"/>
     155        <condition else="" property="endorsed.classpath.cmd.line.arg" value="-Xbootclasspath/p:'${toString:endorsed.classpath.path}'">
     156            <length length="0" string="${endorsed.classpath}" when="greater"/>
     157        </condition>
     158        <property name="javac.fork" value="false"/>
    121159    </target>
    122160    <target name="-post-init">
     
    153191            <attribute default="${excludes}" name="excludes"/>
    154192            <attribute default="${javac.debug}" name="debug"/>
    155             <attribute default="/does/not/exist" name="sourcepath"/>
     193            <attribute default="${empty.dir}" name="sourcepath"/>
     194            <attribute default="${empty.dir}" name="gensrcdir"/>
    156195            <element name="customize" optional="true"/>
    157196            <sequential>
    158                 <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}">
     197                <property location="${build.dir}/empty" name="empty.dir"/>
     198                <mkdir dir="${empty.dir}"/>
     199                <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}">
     200                    <src>
     201                        <dirset dir="@{gensrcdir}" erroronmissingdir="false">
     202                            <include name="*"/>
     203                        </dirset>
     204                    </src>
    159205                    <classpath>
    160206                        <path path="@{classpath}"/>
    161207                    </classpath>
    162                     <compilerarg line="${javac.compilerargs} ${javac.compilerargs.jaxws}"/>
     208                    <compilerarg line="${endorsed.classpath.cmd.line.arg}"/>
     209                    <compilerarg line="${javac.compilerargs}"/>
    163210                    <customize/>
    164211                </javac>
     
    199246            <attribute default="**" name="testincludes"/>
    200247            <sequential>
    201                 <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true">
     248                <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true" tempdir="${build.dir}">
    202249                    <batchtest todir="${build.test.results.dir}">
    203250                        <fileset dir="${test.src.dir}" excludes="@{excludes},${excludes}" includes="@{includes}">
     
    214261                    <formatter type="brief" usefile="false"/>
    215262                    <formatter type="xml"/>
     263                    <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
    216264                    <jvmarg line="${run.jvmargs}"/>
    217265                </junit>
     
    270318            <sequential>
    271319                <java classname="@{classname}" dir="${work.dir}" fork="true">
     320                    <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
    272321                    <jvmarg line="${debug-args-line}"/>
    273322                    <jvmarg value="-Xrunjdwp:transport=${debug-transport},address=${jpda.address}"/>
     323                    <jvmarg value="-Dfile.encoding=${runtime.encoding}"/>
     324                    <redirector errorencoding="${runtime.encoding}" inputencoding="${runtime.encoding}" outputencoding="${runtime.encoding}"/>
    274325                    <jvmarg line="${run.jvmargs}"/>
    275326                    <classpath>
     
    288339        <macrodef name="java" uri="http://www.netbeans.org/ns/j2se-project/1">
    289340            <attribute default="${main.class}" name="classname"/>
     341            <attribute default="${run.classpath}" name="classpath"/>
    290342            <element name="customize" optional="true"/>
    291343            <sequential>
    292344                <java classname="@{classname}" dir="${work.dir}" fork="true">
     345                    <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
     346                    <jvmarg value="-Dfile.encoding=${runtime.encoding}"/>
     347                    <redirector errorencoding="${runtime.encoding}" inputencoding="${runtime.encoding}" outputencoding="${runtime.encoding}"/>
    293348                    <jvmarg line="${run.jvmargs}"/>
    294349                    <classpath>
    295                         <path path="${run.classpath}"/>
     350                        <path path="@{classpath}"/>
    296351                    </classpath>
    297352                    <syspropertyset>
     
    317372                ===================
    318373            -->
    319     <target depends="init" name="deps-jar" unless="no.deps"/>
     374    <target name="-deps-jar-init" unless="built-jar.properties">
     375        <property location="${build.dir}/built-jar.properties" name="built-jar.properties"/>
     376        <delete file="${built-jar.properties}" quiet="true"/>
     377    </target>
     378    <target if="already.built.jar.${basedir}" name="-warn-already-built-jar">
     379        <echo level="warn" message="Cycle detected: abcl was already built"/>
     380    </target>
     381    <target depends="init,-deps-jar-init" name="deps-jar" unless="no.deps">
     382        <mkdir dir="${build.dir}"/>
     383        <touch file="${built-jar.properties}" verbose="false"/>
     384        <property file="${built-jar.properties}" prefix="already.built.jar."/>
     385        <antcall target="-warn-already-built-jar"/>
     386        <propertyfile file="${built-jar.properties}">
     387            <entry key="${basedir}" value=""/>
     388        </propertyfile>
     389    </target>
    320390    <target depends="init,-check-automatic-build,-clean-after-automatic-build" name="-verify-automatic-build"/>
    321391    <target depends="init" name="-check-automatic-build">
     
    333403    </target>
    334404    <target if="do.depend.true" name="-compile-depend">
    335         <j2seproject3:depend/>
     405        <pathconvert property="build.generated.subdirs">
     406            <dirset dir="${build.generated.sources.dir}" erroronmissingdir="false">
     407                <include name="*"/>
     408            </dirset>
     409        </pathconvert>
     410        <j2seproject3:depend srcdir="${src.dir}:${build.generated.subdirs}"/>
    336411    </target>
    337412    <target depends="init,deps-jar,-pre-pre-compile,-pre-compile,-compile-depend" if="have.sources" name="-do-compile">
    338         <j2seproject3:javac/>
     413        <j2seproject3:javac gensrcdir="${build.generated.sources.dir}"/>
    339414        <copy todir="${build.classes.dir}">
    340415            <fileset dir="${src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
     
    353428        <fail unless="javac.includes">Must select some files in the IDE or set javac.includes</fail>
    354429        <j2seproject3:force-recompile/>
    355         <j2seproject3:javac excludes="" includes="${javac.includes}" sourcepath="${src.dir}"/>
     430        <j2seproject3:javac excludes="" gensrcdir="${build.generated.sources.dir}" includes="${javac.includes}" sourcepath="${src.dir}"/>
    356431    </target>
    357432    <target name="-post-compile-single">
     
    373448        <!-- You can override this target in the ../build.xml file. -->
    374449    </target>
    375     <target depends="init,compile,-pre-pre-jar,-pre-jar" name="-do-jar-without-manifest" unless="manifest.available">
     450    <target depends="init,compile,-pre-pre-jar,-pre-jar" name="-do-jar-without-manifest" unless="manifest.available-mkdist.available">
    376451        <j2seproject1:jar/>
    377452    </target>
    378     <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class">
     453    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class-mkdist.available">
    379454        <j2seproject1:jar manifest="${manifest.file}"/>
    380455    </target>
     
    419494        <echo>java -jar "${dist.jar.resolved}"</echo>
    420495    </target>
     496    <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">
     497        <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
     498        <pathconvert property="run.classpath.without.build.classes.dir">
     499            <path path="${run.classpath}"/>
     500            <map from="${build.classes.dir.resolved}" to=""/>
     501        </pathconvert>
     502        <pathconvert pathsep=" " property="jar.classpath">
     503            <path path="${run.classpath.without.build.classes.dir}"/>
     504            <chainedmapper>
     505                <flattenmapper/>
     506                <globmapper from="*" to="lib/*"/>
     507            </chainedmapper>
     508        </pathconvert>
     509        <taskdef classname="org.netbeans.modules.java.j2seproject.copylibstask.CopyLibs" classpath="${libs.CopyLibs.classpath}" name="copylibs"/>
     510        <copylibs compress="${jar.compress}" jarfile="${dist.jar}" manifest="${manifest.file}" runtimeclasspath="${run.classpath.without.build.classes.dir}">
     511            <fileset dir="${build.classes.dir}"/>
     512            <manifest>
     513                <attribute name="Class-Path" value="${jar.classpath}"/>
     514            </manifest>
     515        </copylibs>
     516    </target>
     517    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="do.mkdist" name="-do-jar-with-libraries-without-manifest" unless="manifest.available">
     518        <property location="${build.classes.dir}" name="build.classes.dir.resolved"/>
     519        <pathconvert property="run.classpath.without.build.classes.dir">
     520            <path path="${run.classpath}"/>
     521            <map from="${build.classes.dir.resolved}" to=""/>
     522        </pathconvert>
     523        <pathconvert pathsep=" " property="jar.classpath">
     524            <path path="${run.classpath.without.build.classes.dir}"/>
     525            <chainedmapper>
     526                <flattenmapper/>
     527                <globmapper from="*" to="lib/*"/>
     528            </chainedmapper>
     529        </pathconvert>
     530        <taskdef classname="org.netbeans.modules.java.j2seproject.copylibstask.CopyLibs" classpath="${libs.CopyLibs.classpath}" name="copylibs"/>
     531        <copylibs compress="${jar.compress}" jarfile="${dist.jar}" runtimeclasspath="${run.classpath.without.build.classes.dir}">
     532            <fileset dir="${build.classes.dir}"/>
     533            <manifest>
     534                <attribute name="Class-Path" value="${jar.classpath}"/>
     535            </manifest>
     536        </copylibs>
     537    </target>
    421538    <target name="-post-jar">
    422539        <!-- Empty placeholder for easier customization. -->
    423540        <!-- You can override this target in the ../build.xml file. -->
    424541    </target>
    425     <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"/>
     542    <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"/>
    426543    <!--
    427544                =================
     
    439556        <property name="javac.includes.binary" value=""/>
    440557    </target>
    441     <target depends="init,-do-not-recompile,compile-single" name="run-single">
     558    <target depends="init,compile-single" name="run-single">
    442559        <fail unless="run.class">Must select one file in the IDE or set run.class</fail>
    443560        <j2seproject1:java classname="${run.class}"/>
     561    </target>
     562    <target depends="init,compile-test-single" name="run-test-with-main">
     563        <fail unless="run.class">Must select one file in the IDE or set run.class</fail>
     564        <j2seproject1:java classname="${run.class}" classpath="${run.test.classpath}"/>
    444565    </target>
    445566    <!--
     
    450571    <target depends="init" if="netbeans.home" name="-debug-start-debugger">
    451572        <j2seproject1:nbjpdastart name="${debug.class}"/>
     573    </target>
     574    <target depends="init" if="netbeans.home" name="-debug-start-debugger-main-test">
     575        <j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${debug.class}"/>
    452576    </target>
    453577    <target depends="init,compile" name="-debug-start-debuggee">
     
    467591        <j2seproject3:debug classname="${debug.class}"/>
    468592    </target>
    469     <target depends="init,-do-not-recompile,compile-single,-debug-start-debugger,-debug-start-debuggee-single" if="netbeans.home" name="debug-single"/>
     593    <target depends="init,compile-single,-debug-start-debugger,-debug-start-debuggee-single" if="netbeans.home" name="debug-single"/>
     594    <target depends="init,compile-test-single" if="netbeans.home" name="-debug-start-debuggee-main-test">
     595        <fail unless="debug.class">Must select one file in the IDE or set debug.class</fail>
     596        <j2seproject3:debug classname="${debug.class}" classpath="${debug.test.classpath}"/>
     597    </target>
     598    <target depends="init,compile-test-single,-debug-start-debugger-main-test,-debug-start-debuggee-main-test" if="netbeans.home" name="debug-test-with-main"/>
    470599    <target depends="init" name="-pre-debug-fix">
    471600        <fail unless="fix.includes">Must set fix.includes</fail>
     
    490619                <filename name="**/*.java"/>
    491620            </fileset>
     621            <fileset dir="${build.generated.sources.dir}" erroronmissingdir="false">
     622                <include name="**/*.java"/>
     623            </fileset>
    492624        </javadoc>
    493625    </target>
     
    551683    </target>
    552684    <target depends="init,compile-test,-pre-test-run,-do-test-run" if="have.tests" name="-post-test-run">
    553         <fail if="tests.failed">Some tests failed; see details above.</fail>
     685        <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
    554686    </target>
    555687    <target depends="init" if="have.tests" name="test-report"/>
     
    564696    </target>
    565697    <target depends="init,compile-test-single,-pre-test-run-single,-do-test-run-single" if="have.tests" name="-post-test-run-single">
    566         <fail if="tests.failed">Some tests failed; see details above.</fail>
    567     </target>
    568     <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"/>
     698        <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
     699    </target>
     700    <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"/>
    569701    <!--
    570702                =======================
     
    593725        <j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${test.class}"/>
    594726    </target>
    595     <target depends="init,-do-not-recompile,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
     727    <target depends="init,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
    596728    <target depends="init,-pre-debug-fix,compile-test-single" if="netbeans.home" name="-do-debug-fix-test">
    597729        <j2seproject1:nbjpdareload dir="${build.test.classes.dir}"/>
     
    630762                ===============
    631763            -->
    632     <target depends="init" name="deps-clean" unless="no.deps"/>
     764    <target name="-deps-clean-init" unless="built-clean.properties">
     765        <property location="${build.dir}/built-clean.properties" name="built-clean.properties"/>
     766        <delete file="${built-clean.properties}" quiet="true"/>
     767    </target>
     768    <target if="already.built.clean.${basedir}" name="-warn-already-built-clean">
     769        <echo level="warn" message="Cycle detected: abcl was already built"/>
     770    </target>
     771    <target depends="init,-deps-clean-init" name="deps-clean" unless="no.deps">
     772        <mkdir dir="${build.dir}"/>
     773        <touch file="${built-clean.properties}" verbose="false"/>
     774        <property file="${built-clean.properties}" prefix="already.built.clean."/>
     775        <antcall target="-warn-already-built-clean"/>
     776        <propertyfile file="${built-clean.properties}">
     777            <entry key="${basedir}" value=""/>
     778        </propertyfile>
     779    </target>
    633780    <target depends="init" name="-do-clean">
    634781        <delete dir="${build.dir}"/>
    635         <delete dir="${dist.dir}"/>
     782        <delete dir="${dist.dir}" followsymlinks="false" includeemptydirs="true"/>
    636783    </target>
    637784    <target name="-post-clean">
     
    640787    </target>
    641788    <target depends="init,deps-clean,-do-clean,-post-clean" description="Clean build products." name="clean"/>
     789    <target name="-check-call-dep">
     790        <property file="${call.built.properties}" prefix="already.built."/>
     791        <condition property="should.call.dep">
     792            <not>
     793                <isset property="already.built.${call.subproject}"/>
     794            </not>
     795        </condition>
     796    </target>
     797    <target depends="-check-call-dep" if="should.call.dep" name="-maybe-call-dep">
     798        <ant antfile="${call.script}" inheritall="false" target="${call.target}">
     799            <propertyset>
     800                <propertyref prefix="transfer."/>
     801                <mapper from="transfer.*" to="*" type="glob"/>
     802            </propertyset>
     803        </ant>
     804    </target>
    642805</project>
  • trunk/abcl/nbproject/genfiles.properties

    r12748 r12749  
    55# Do not edit this file. You may delete it but then the IDE will never regenerate such files for you.
    66nbproject/build-impl.xml.data.CRC32=742204ce
    7 nbproject/build-impl.xml.script.CRC32=b7bf05a5
    8 nbproject/build-impl.xml.stylesheet.CRC32=65b8de21
     7nbproject/build-impl.xml.script.CRC32=29122cc4
     8nbproject/build-impl.xml.stylesheet.CRC32=576378a2@1.32.1.45
    99nbproject/profiler-build-impl.xml.data.CRC32=71623fcd
    1010nbproject/profiler-build-impl.xml.script.CRC32=abda56ed
  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r12748 r12749  
    9898                                                  "org.armedbear.lisp.".concat(className)));
    9999    }
    100 
     100   
    101101    public void load()
    102102    {
     
    685685        autoload(Symbol.COPY_LIST, "copy_list");
    686686
     687  autoload(PACKAGE_SYS, "make-fasl-class-loader", "FaslClassLoader", false);
     688  autoload(PACKAGE_SYS, "get-fasl-function", "FaslClassLoader", false);
     689
    687690        autoload(Symbol.SET_CHAR, "StringFunctions");
    688691        autoload(Symbol.SET_SCHAR, "StringFunctions");
  • trunk/abcl/src/org/armedbear/lisp/Function.java

    r12748 r12749  
    176176    }
    177177
     178    public final LispObject getClassBytes() {
     179  LispObject o = getf(propertyList, Symbol.CLASS_BYTES, NIL);
     180  if(o != NIL) {
     181      return o;
     182  } else {
     183      ClassLoader c = getClass().getClassLoader();
     184      if(c instanceof FaslClassLoader) {
     185    return new JavaObject(((FaslClassLoader) c).getFunctionClassBytes(this));
     186      } else {
     187    return NIL;
     188      }
     189  }
     190    }
     191
     192    public static final Primitive FUNCTION_CLASS_BYTES = new pf_function_class_bytes();
     193    public static final class pf_function_class_bytes extends Primitive {
     194  public pf_function_class_bytes() {
     195      super("function-class-bytes", PACKAGE_SYS, false, "function");
     196        }
     197        @Override
     198        public LispObject execute(LispObject arg) {
     199            if (arg instanceof Function) {
     200                return ((Function) arg).getClassBytes();
     201      }
     202            return type_error(arg, Symbol.FUNCTION);
     203        }
     204    }
     205
    178206    @Override
    179207    public LispObject execute()
    180208    {
    181         return error(new WrongNumberOfArgumentsException(this));
     209        return error(new WrongNumberOfArgumentsException(this, 0));
    182210    }
    183211
     
    185213    public LispObject execute(LispObject arg)
    186214    {
    187         return error(new WrongNumberOfArgumentsException(this));
     215        return error(new WrongNumberOfArgumentsException(this, 1));
    188216    }
    189217
     
    192220
    193221    {
    194         return error(new WrongNumberOfArgumentsException(this));
     222        return error(new WrongNumberOfArgumentsException(this, 2));
    195223    }
    196224
     
    200228
    201229    {
    202         return error(new WrongNumberOfArgumentsException(this));
     230        return error(new WrongNumberOfArgumentsException(this, 3));
    203231    }
    204232
     
    208236
    209237    {
    210         return error(new WrongNumberOfArgumentsException(this));
     238        return error(new WrongNumberOfArgumentsException(this, 4));
    211239    }
    212240
     
    217245
    218246    {
    219         return error(new WrongNumberOfArgumentsException(this));
     247        return error(new WrongNumberOfArgumentsException(this, 5));
    220248    }
    221249
     
    226254
    227255    {
    228         return error(new WrongNumberOfArgumentsException(this));
     256        return error(new WrongNumberOfArgumentsException(this, 6));
    229257    }
    230258
     
    236264
    237265    {
    238         return error(new WrongNumberOfArgumentsException(this));
     266        return error(new WrongNumberOfArgumentsException(this, 7));
    239267    }
    240268
     
    246274
    247275    {
    248         return error(new WrongNumberOfArgumentsException(this));
     276        return error(new WrongNumberOfArgumentsException(this, 8));
    249277    }
    250278
  • trunk/abcl/src/org/armedbear/lisp/Interpreter.java

    r12748 r12749  
    178178            catch (ClassNotFoundException e) { } // FIXME: what to do?
    179179
    180             Load.loadSystemFile("j.lisp");
     180            Load.loadSystemFile("j.lisp", false); // not being autoloaded
    181181
    182182            initialized = true;
     
    218218    private static synchronized void initializeSystem()
    219219    {
    220         Load.loadSystemFile("system");
     220        Load.loadSystemFile("system", false); // not being autoloaded
    221221    }
    222222
     
    309309
    310310                        else
    311                             Load.loadSystemFile(args[i + 1]);
     311                            Load.loadSystemFile(args[i + 1], false); // not being autoloaded
    312312                        ++i;
    313313                    } else {
  • trunk/abcl/src/org/armedbear/lisp/Lisp.java

    r12748 r12749  
    4444import java.net.URLDecoder;
    4545import java.util.Hashtable;
    46 import java.util.zip.ZipEntry;
    47 import java.util.zip.ZipFile;
    4846
    4947public final class Lisp
     
    702700   * This version is used by the interpreter.
    703701   */
    704   public static final LispObject nonLocalGo(Binding binding,
    705                                             LispObject tag)
    706 
     702  static final LispObject nonLocalGo(Binding binding,
     703                                     LispObject tag)
    707704  {
    708705    if (binding.env.inactive)
     
    739736   * This version is used by the interpreter.
    740737   */
    741   public static final LispObject nonLocalReturn(Binding binding,
    742                                                 Symbol block,
    743                                                 LispObject result)
    744 
     738  static final LispObject nonLocalReturn(Binding binding,
     739                                         Symbol block,
     740                                         LispObject result)
    745741  {
    746742    if (binding == null)
     
    12691265              input = url.openStream();
    12701266          } catch (IOException e) {
     1267        System.err.println("Failed to read class bytes from boot class " + url);
    12711268              error(new LispError("Failed to read class bytes from boot class " + url));
    12721269          }
     
    23882385    internSpecial("*LOAD-STREAM*", PACKAGE_SYS, NIL);
    23892386
     2387    // ### *fasl-loader*
     2388    public static final Symbol _FASL_LOADER_ =
     2389  exportSpecial("*FASL-LOADER*", PACKAGE_SYS, NIL);
     2390
    23902391  // ### *source*
    23912392  // internal symbol
     
    27612762  }
    27622763
     2764  private static final SpecialOperator WITH_INLINE_CODE = new with_inline_code();
     2765  private static class with_inline_code extends SpecialOperator {
     2766    with_inline_code() {
     2767      super("with-inline-code", PACKAGE_JVM, true, "(&optional target repr) &body body");
     2768    }
     2769    @Override
     2770    public LispObject execute(LispObject args, Environment env)
     2771    {
     2772  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."));
     2773    }
     2774  }
     2775
    27632776}
  • trunk/abcl/src/org/armedbear/lisp/Load.java

    r12748 r12749  
    217217    }
    218218
    219     public static final LispObject loadSystemFile(String filename)
    220 
    221     {
    222         final LispThread thread = LispThread.currentThread();
    223         return loadSystemFile(filename,
    224                               Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL,
    225                               Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
    226                               false);
    227     }
    228 
    229219    public static final LispObject loadSystemFile(String filename, boolean auto)
    230220
     
    253243    }
    254244
     245    private static final Symbol FASL_LOADER = PACKAGE_SYS.intern("*FASL-LOADER*");
    255246    static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
    256247
     
    279270            url = Lisp.class.getResource(path);
    280271            if (url == null || url.toString().endsWith("/")) {
    281                 url = Lisp.class.getResource(path + ".abcl");
     272                url = Lisp.class.getResource(path.replace('-', '_') + ".abcl");
    282273                if (url == null) {
    283274                    url = Lisp.class.getResource(path + ".lisp");
     
    333324            final SpecialBindingsMark mark = thread.markSpecialBindings();
    334325            thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL);
     326      thread.bindSpecial(FASL_LOADER, NIL);
    335327            try {
    336328                Stream stream = new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER);
     
    441433    }
    442434
     435    private static Symbol[] savedSpecials =
     436        new Symbol[] { // CLHS Specified
     437                       Symbol.CURRENT_READTABLE, Symbol._PACKAGE_,
     438                       // Compiler policy
     439                       _SPEED_, _SPACE_, _SAFETY_, _DEBUG_, _EXPLAIN_ };
     440
    443441    // A nil TRUENAME signals a load from stream which has no possible path
    444442    private static final LispObject loadFileFromStream(LispObject pathname,
     
    454452        final LispThread thread = LispThread.currentThread();
    455453        final SpecialBindingsMark mark = thread.markSpecialBindings();
    456         // "LOAD binds *READTABLE* and *PACKAGE* to the values they held before
    457         // loading the file."
    458         thread.bindSpecialToCurrentValue(Symbol.CURRENT_READTABLE);
    459         thread.bindSpecialToCurrentValue(Symbol._PACKAGE_);
     454
     455        for (Symbol special : savedSpecials)
     456            thread.bindSpecialToCurrentValue(special);
     457
    460458        int loadDepth = Fixnum.getValue(_LOAD_DEPTH_.symbolValue(thread));
    461459        thread.bindSpecial(_LOAD_DEPTH_, Fixnum.getInstance(++loadDepth));
    462         // Compiler policy.
    463         thread.bindSpecialToCurrentValue(_SPEED_);
    464         thread.bindSpecialToCurrentValue(_SPACE_);
    465         thread.bindSpecialToCurrentValue(_SAFETY_);
    466         thread.bindSpecialToCurrentValue(_DEBUG_);
    467         thread.bindSpecialToCurrentValue(_EXPLAIN_);
    468460        final String prefix = getLoadVerbosePrefix(loadDepth);
    469461        try {
     
    562554
    563555    private static final LispObject loadStream(Stream in, boolean print,
    564                                                LispThread thread)
    565         {
    566         return loadStream(in, print, thread, false);
    567     }
    568 
    569     private static final LispObject loadStream(Stream in, boolean print,
    570556                                               LispThread thread, boolean returnLastResult)
    571557
     
    584570                if (obj == EOF)
    585571                    break;
    586                 result = eval(obj, env, thread);
     572    result = eval(obj, env, thread);
    587573                if (print) {
    588574                    Stream out =
  • trunk/abcl/src/org/armedbear/lisp/Readtable.java

    r12748 r12749  
    172172
    173173  @Override
    174   public LispObject typeOf()
     174  public final LispObject typeOf()
    175175  {
    176176    return Symbol.READTABLE;
     
    178178
    179179  @Override
    180   public LispObject classOf()
     180  public final LispObject classOf()
    181181  {
    182182    return BuiltInClass.READTABLE;
     
    184184
    185185  @Override
    186   public LispObject typep(LispObject type)
     186  public final LispObject typep(LispObject type)
    187187  {
    188188    if (type == Symbol.READTABLE)
     
    194194
    195195  @Override
    196   public String toString()
     196  public final String toString()
    197197  {
    198198    return unreadableString("READTABLE");
    199199  }
    200200
    201   public LispObject getReadtableCase()
     201  public final LispObject getReadtableCase()
    202202  {
    203203    return readtableCase;
    204204  }
    205205
    206   public boolean isWhitespace(char c)
     206  public final boolean isWhitespace(char c)
    207207  {
    208208    return getSyntaxType(c) == SYNTAX_TYPE_WHITESPACE;
    209209  }
    210210
    211   public byte getSyntaxType(char c)
     211  public final byte getSyntaxType(char c)
    212212  {
    213213    return syntax.get(c);
    214214  }
    215215
    216   public boolean isInvalid(char c)
     216  public final boolean isInvalid(char c)
    217217  {
    218218    switch (c)
     
    231231  }
    232232
    233   public void checkInvalid(char c, Stream stream)
     233  public final void checkInvalid(char c, Stream stream)
    234234  {
    235235    // "... no mechanism is provided for changing the constituent trait of a
     
    248248  }
    249249
    250   public LispObject getReaderMacroFunction(char c)
     250  public final LispObject getReaderMacroFunction(char c)
    251251  {
    252252    return readerMacroFunctions.get(c);
    253253  }
    254254
    255   LispObject getMacroCharacter(char c)
     255  final LispObject getMacroCharacter(char c)
    256256  {
    257257    LispObject function = getReaderMacroFunction(c);
     
    272272  }
    273273
    274   void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
     274  final void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
    275275  {
    276276    byte syntaxType;
     
    285285  }
    286286
    287   public LispObject getDispatchMacroCharacter(char dispChar, char subChar)
     287  public final LispObject getDispatchMacroCharacter(char dispChar, char subChar)
    288288
    289289  {
     
    300300  }
    301301
    302   public void setDispatchMacroCharacter(char dispChar, char subChar,
     302  public final void setDispatchMacroCharacter(char dispChar, char subChar,
    303303                                        LispObject function)
    304304
  • trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java

    r12748 r12749  
    4545  }
    4646
     47    public SlotDefinition(StandardClass clazz)
     48  {
     49    super(clazz, clazz.getClassLayout().getLength());
     50    slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = NIL;
     51  }
     52
    4753  public SlotDefinition(LispObject name, LispObject readers)
    4854  {
     
    114120  }
    115121
    116   // ### make-slot-definition
     122  // ### make-slot-definition &optional class
    117123  private static final Primitive MAKE_SLOT_DEFINITION =
    118     new Primitive("make-slot-definition", PACKAGE_SYS, true, "")
     124    new Primitive("make-slot-definition", PACKAGE_SYS, true, "&optional class")
    119125    {
    120126      @Override
     
    122128      {
    123129        return new SlotDefinition();
     130      }
     131      @Override
     132      public LispObject execute(LispObject slotDefinitionClass)
     133      {
     134    return new SlotDefinition((StandardClass) slotDefinitionClass);
    124135      }
    125136    };
  • trunk/abcl/src/org/armedbear/lisp/StandardClass.java

    r12748 r12749  
    384384    STANDARD_CLASS.setDirectSlotDefinitions(standardClassSlotDefinitions());
    385385  }
     386
     387    public static final StandardClass DIRECT_SLOT_DEFINITION =
     388      addStandardClass(Symbol.DIRECT_SLOT_DEFINITION, list(SLOT_DEFINITION));
     389    public static final StandardClass EFFECTIVE_SLOT_DEFINITION =
     390      addStandardClass(Symbol.EFFECTIVE_SLOT_DEFINITION, list(SLOT_DEFINITION));
    386391
    387392  // BuiltInClass.FUNCTION is also null here (see previous comment).
     
    722727    SLOT_DEFINITION.setSlotDefinitions(SLOT_DEFINITION.getDirectSlotDefinitions());
    723728
     729    DIRECT_SLOT_DEFINITION.setCPL(DIRECT_SLOT_DEFINITION, SLOT_DEFINITION,
     730          STANDARD_OBJECT, BuiltInClass.CLASS_T);
     731    DIRECT_SLOT_DEFINITION.finalizeClass();
     732    EFFECTIVE_SLOT_DEFINITION.setCPL(EFFECTIVE_SLOT_DEFINITION, SLOT_DEFINITION,
     733             STANDARD_OBJECT, BuiltInClass.CLASS_T);
     734    EFFECTIVE_SLOT_DEFINITION.finalizeClass();
     735
    724736    // STANDARD-METHOD
    725737    Debug.assertTrue(STANDARD_METHOD.isFinalized());
  • trunk/abcl/src/org/armedbear/lisp/Stream.java

    r12748 r12749  
    11391139                sb.append(readMultipleEscape(rt));
    11401140                flags = new BitSet(sb.length());
    1141                 for (int i = sb.length(); i-- > 0;)
    1142                     flags.set(i);
     1141                flags.set(0, sb.length());
    11431142            } else if (rt.isInvalid(c)) {
    11441143                rt.checkInvalid(c, this); // Signals a reader-error.
     
    11811180                    if (flags == null)
    11821181                        flags = new BitSet(sb.length());
    1183                     for (int i = begin; i < end; i++)
    1184                         flags.set(i);
     1182                    flags.set(begin, end);
    11851183                    continue;
    11861184                }
  • trunk/abcl/src/org/armedbear/lisp/Symbol.java

    r12748 r12749  
    29442944  public static final Symbol STANDARD_READER_METHOD =
    29452945    PACKAGE_MOP.addExternalSymbol("STANDARD-READER-METHOD");
     2946  public static final Symbol DIRECT_SLOT_DEFINITION =
     2947    PACKAGE_MOP.addExternalSymbol("DIRECT-SLOT-DEFINITION");
     2948  public static final Symbol EFFECTIVE_SLOT_DEFINITION =
     2949    PACKAGE_MOP.addExternalSymbol("EFFECTIVE-SLOT-DEFINITION");
    29462950
    29472951  // Java interface.
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r12748 r12749  
    6161  (find-class 'standard-generic-function))
    6262(defconstant +the-T-class+ (find-class 'T))
     63(defconstant +the-direct-slot-definition-class+ (find-class 'direct-slot-definition))
     64(defconstant +the-effective-slot-definition-class+ (find-class 'effective-slot-definition))
    6365
    6466;; Don't use DEFVAR, because that disallows loading clos.lisp
     
    260262  `(function (lambda () ,initform)))
    261263
    262 (defun make-direct-slot-definition (class &key name
    263                                           (initargs ())
    264                                           (initform nil)
    265                                           (initfunction nil)
    266                                           (readers ())
    267                                           (writers ())
    268                                           (allocation :instance)
    269                                           &allow-other-keys)
    270   (let ((slot (make-slot-definition)))
    271     (set-slot-definition-name slot name)
    272     (set-slot-definition-initargs slot initargs)
    273     (set-slot-definition-initform slot initform)
    274     (set-slot-definition-initfunction slot initfunction)
    275     (set-slot-definition-readers slot readers)
    276     (set-slot-definition-writers slot writers)
    277     (set-slot-definition-allocation slot allocation)
    278     (set-slot-definition-allocation-class slot class)
    279     slot))
    280 
    281 (defun make-effective-slot-definition (&key name
    282                                             (initargs ())
    283                                             (initform nil)
    284                                             (initfunction nil)
    285                                             (allocation :instance)
    286                                             (allocation-class nil)
    287                                             &allow-other-keys)
    288   (let ((slot (make-slot-definition)))
    289     (set-slot-definition-name slot name)
    290     (set-slot-definition-initargs slot initargs)
    291     (set-slot-definition-initform slot initform)
    292     (set-slot-definition-initfunction slot initfunction)
    293     (set-slot-definition-allocation slot allocation)
    294     (set-slot-definition-allocation-class slot allocation-class)
    295     slot))
     264(defun init-slot-definition (slot &key name
     265           (initargs ())
     266           (initform nil)
     267           (initfunction nil)
     268           (readers ())
     269           (writers ())
     270           (allocation :instance)
     271           (allocation-class nil)
     272            &allow-other-keys)
     273  (set-slot-definition-name slot name)
     274  (set-slot-definition-initargs slot initargs)
     275  (set-slot-definition-initform slot initform)
     276  (set-slot-definition-initfunction slot initfunction)
     277  (set-slot-definition-readers slot readers)
     278  (set-slot-definition-writers slot writers)
     279  (set-slot-definition-allocation slot allocation)
     280  (set-slot-definition-allocation-class slot allocation-class)
     281  slot)
     282
     283(defun make-direct-slot-definition (class &rest args)
     284  (let ((slot-class (direct-slot-definition-class class)))
     285    (if (eq slot-class +the-direct-slot-definition-class+)
     286  (let ((slot (make-slot-definition +the-direct-slot-definition-class+)))
     287    (apply #'init-slot-definition slot :allocation-class class args)
     288    slot)
     289  (progn
     290    (let ((slot (apply #'make-instance slot-class :allocation-class class
     291           args)))
     292      slot)))))
     293
     294(defun make-effective-slot-definition (class &rest args)
     295  (let ((slot-class (effective-slot-definition-class class)))
     296    (if (eq slot-class +the-effective-slot-definition-class+)
     297  (let ((slot (make-slot-definition +the-effective-slot-definition-class+)))
     298    (apply #'init-slot-definition slot args)
     299    slot)
     300  (progn
     301    (let ((slot (apply #'make-instance slot-class args)))
     302      slot)))))
    296303
    297304;;; finalize-inheritance
     
    456463
    457464(defun std-compute-effective-slot-definition (class direct-slots)
    458   (declare (ignore class))
    459465  (let ((initer (find-if-not #'null direct-slots
    460466                             :key #'%slot-definition-initfunction)))
    461467    (make-effective-slot-definition
     468     class
    462469     :name (%slot-definition-name (car direct-slots))
    463470     :initform (if initer
     
    559566                                          :direct-default-initargs direct-default-initargs)
    560567    class))
     568
     569;(defun convert-to-direct-slot-definition (class canonicalized-slot)
     570;  (apply #'make-instance
     571;         (apply #'direct-slot-definition-class
     572;                class canonicalized-slot)
     573;         canonicalized-slot))
    561574
    562575(defun std-after-initialization-for-classes (class
     
    19001913(redefine-class-forwarder (setf class-direct-default-initargs) direct-default-initargs)
    19011914
    1902 
     1915(defgeneric direct-slot-definition-class (class &rest initargs))
     1916
     1917(defmethod direct-slot-definition-class ((class class) &rest initargs)
     1918  (declare (ignore initargs))
     1919  +the-direct-slot-definition-class+)
     1920
     1921(defgeneric effective-slot-definition-class (class &rest initargs))
     1922
     1923(defmethod effective-slot-definition-class ((class class) &rest initargs)
     1924  (declare (ignore initargs))
     1925  +the-effective-slot-definition-class+)
    19031926
    19041927(fmakunbound 'documentation)
     
    22122235(defmethod shared-initialize ((instance standard-object) slot-names &rest initargs)
    22132236  (std-shared-initialize instance slot-names initargs))
     2237
     2238(defmethod shared-initialize ((slot slot-definition) slot-names
     2239            &rest initargs
     2240            &key name initargs initform initfunction
     2241            readers writers allocation
     2242            &allow-other-keys)
     2243  ;;Keyword args are duplicated from init-slot-definition only to have
     2244  ;;them checked.
     2245  (declare (ignore slot-names)) ;;TODO?
     2246  (declare (ignore name initargs initform initfunction readers writers allocation))
     2247  (apply #'init-slot-definition slot initargs))
    22142248
    22152249;;; change-class
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r12748 r12749  
    4141(defvar *output-file-pathname*)
    4242
     43(defun base-classname (&optional (output-file-pathname *output-file-pathname*))
     44  (sanitize-class-name (pathname-name output-file-pathname)))
     45
     46(defun fasl-loader-classname (&optional (output-file-pathname *output-file-pathname*))
     47  (%format nil "~A_0" (base-classname output-file-pathname)))
     48
    4349(declaim (ftype (function (t) t) compute-classfile-name))
    4450(defun compute-classfile-name (n &optional (output-file-pathname
     
    4652  "Computes the name of the class file associated with number `n'."
    4753  (let ((name
    48          (%format nil "~A-~D"
    49                   (substitute #\_ #\.
    50                               (pathname-name output-file-pathname)) n)))
     54         (sanitize-class-name
     55    (%format nil "~A_~D" (pathname-name output-file-pathname) n))))
    5156    (namestring (merge-pathnames (make-pathname :name name :type "cls")
    5257                                 output-file-pathname))))
     58
     59(defun sanitize-class-name (name)
     60  (let ((name (copy-seq name)))
     61    (dotimes (i (length name))
     62      (declare (type fixnum i))
     63      (when (or (char= (char name i) #\-)
     64    (char= (char name i) #\.)
     65    (char= (char name i) #\Space))
     66        (setf (char name i) #\_)))
     67    name))
     68 
    5369
    5470(declaim (ftype (function () t) next-classfile-name))
     
    7086(declaim (ftype (function (t) t) verify-load))
    7187(defun verify-load (classfile)
    72   (if (> *safety* 0)
    73     (and classfile
     88  #|(if (> *safety* 0)
     89      (and classfile
    7490         (let ((*load-truename* *output-file-pathname*))
    7591           (report-error
    7692            (load-compiled-function classfile))))
    77     t))
     93    t)|#
     94  (declare (ignore classfile))
     95  t)
    7896
    7997(declaim (ftype (function (t) t) process-defconstant))
     
    145163                 (let* ((expr `(lambda ,lambda-list
    146164                                 ,@decls (block ,block-name ,@body)))
     165      (saved-class-number *class-number*)
    147166                        (classfile (next-classfile-name))
    148167                        (internal-compiler-errors nil)
     
    169188                      (setf form
    170189                            `(fset ',name
    171                                    (proxy-preloaded-function ',name ,(file-namestring classfile))
     190           (sys::get-fasl-function *fasl-loader*
     191                 ,saved-class-number)
    172192                                   ,*source-position*
    173193                                   ',lambda-list
     
    226246             (eval form)
    227247             (let* ((expr (function-lambda-expression (macro-function name)))
     248        (saved-class-number *class-number*)
    228249                    (classfile (next-classfile-name)))
    229250         (with-open-file
     
    242263                             `(put ',name 'macroexpand-macro
    243264                                   (make-macro ',name
    244                                                (proxy-preloaded-function
    245                                                 '(macro-function ,name)
    246                                                 ,(file-namestring classfile))))
     265                 (sys::get-fasl-function *fasl-loader* ,saved-class-number)))
    247266                             `(fset ',name
    248267                                    (make-macro ',name
    249                                                 (proxy-preloaded-function
    250                                                  '(macro-function ,name)
    251                                                  ,(file-namestring classfile)))
     268            (sys::get-fasl-function *fasl-loader* ,saved-class-number))
    252269                                    ,*source-position*
    253270                                    ',(third form)))))))))
     
    349366  ;; was already used in verify-load before I used it,
    350367  ;; however, binding *load-truename* isn't fully compliant, I think.
    351   (let ((*load-truename* *output-file-pathname*))
    352     (when compile-time-too
     368  (when compile-time-too
     369    (let ((*load-truename* *output-file-pathname*)
     370    (*fasl-loader* (make-fasl-class-loader
     371        *class-number*
     372        (concatenate 'string "org.armedbear.lisp." (base-classname))
     373        nil)))
    353374      (eval form))))
    354375
     
    367388      (let ((lambda-expression (cadr function-form)))
    368389        (jvm::with-saved-compiler-policy
    369           (let* ((classfile (next-classfile-name))
     390          (let* ((saved-class-number *class-number*)
     391     (classfile (next-classfile-name))
    370392                 (result
    371393      (with-open-file
     
    380402            (cond (compiled-function
    381403                   (setf (getf tail key)
    382                          `(load-compiled-function ,(file-namestring classfile))))
     404       `(sys::get-fasl-function *fasl-loader* ,saved-class-number)))
     405;;                         `(load-compiled-function ,(file-namestring classfile))))
    383406                  (t
    384407                   ;; FIXME This should be a warning or error of some sort...
     
    413436      (precompiler:precompile-form form nil *compile-file-environment*)))
    414437  (let* ((expr `(lambda () ,form))
     438   (saved-class-number *class-number*)
    415439         (classfile (next-classfile-name))
    416440         (result
     
    426450    (setf form
    427451          (if compiled-function
    428               `(funcall (load-compiled-function ,(file-namestring classfile)))
     452              `(funcall (sys::get-fasl-function *fasl-loader* ,saved-class-number))
    429453              (precompiler:precompile-form form nil *compile-file-environment*)))))
    430454
     
    573597                     :stream out)
    574598              (%stream-terpri out)
    575               ;; Note: Beyond this point, you can't use DUMP-FORM,
    576               ;; because the list of uninterned symbols has been fixed now.
    577               (when *fasl-uninterned-symbols*
    578                 (write (list 'setq '*fasl-uninterned-symbols*
    579                              (coerce (mapcar #'car
    580                                              (nreverse *fasl-uninterned-symbols*))
    581                                      'vector))
    582                        :stream out))
    583               (%stream-terpri out)
    584               ;; we work with a fixed variable name here to work around the
    585               ;; lack of availability of the circle reader in the fasl reader
    586               ;; but it's a toplevel form anyway
    587               (write `(dotimes (i ,*class-number*)
    588                         (function-preload
    589                          (%format nil "~A-~D.cls"
    590                                   ,(substitute #\_ #\. (pathname-name output-file))
    591                                   (1+ i))))
    592                      :stream out
    593                      :circle t)
     599        ;; Note: Beyond this point, you can't use DUMP-FORM,
     600        ;; because the list of uninterned symbols has been fixed now.
     601        (when *fasl-uninterned-symbols*
     602    (write (list 'setq '*fasl-uninterned-symbols*
     603           (coerce (mapcar #'car
     604               (nreverse *fasl-uninterned-symbols*))
     605             'vector))
     606           :stream out))
     607        (%stream-terpri out)
     608
     609        (when (> *class-number* 0)
     610    (generate-loader-function)
     611    (write (list 'setq '*fasl-loader*
     612           `(sys::make-fasl-class-loader
     613             ,*class-number*
     614             ,(concatenate 'string "org.armedbear.lisp." (base-classname)))) :stream out))
    594615              (%stream-terpri out))
    595616
     
    610631                           (merge-pathnames (make-pathname :type type)
    611632                                            output-file)))
    612                  (pathnames ()))
     633                 (pathnames nil)
     634     (fasl-loader (namestring (merge-pathnames (make-pathname :name (fasl-loader-classname) :type "cls")
     635                 output-file))))
     636      (when (probe-file fasl-loader)
     637        (push fasl-loader pathnames))
    613638            (dotimes (i *class-number*)
    614639              (let* ((pathname (compute-classfile-name (1+ i))))
     
    632657                  (namestring output-file) elapsed))))
    633658    (values (truename output-file) warnings-p failure-p)))
     659
     660(defmacro ncase (expr min max &rest clauses)
     661  "A CASE where all test clauses are numbers ranging from a minimum to a maximum."
     662  ;;Expr is subject to multiple evaluation, but since we only use ncase for
     663  ;;fn-index below, let's ignore it.
     664  (let* ((half (floor (/ (- max min) 2)))
     665   (middle (+ min half)))
     666    (if (> (- max min) 10)
     667  `(if (< ,expr ,middle)
     668       (ncase ,expr ,min ,middle ,@(subseq clauses 0 half))
     669       (ncase ,expr ,middle ,max ,@(subseq clauses half)))
     670  `(case ,expr ,@clauses))))
     671
     672(defun generate-loader-function ()
     673  (let* ((basename (base-classname))
     674   (expr `(lambda (fasl-loader fn-index)
     675      (identity fasl-loader) ;;to avoid unused arg
     676      (ncase fn-index 0 ,(1- *class-number*)
     677        ,@(loop
     678       :for i :from 1 :to *class-number*
     679       :collect
     680       (let ((class (%format nil "org/armedbear/lisp/~A_~A" basename i)))
     681         `(,(1- i)
     682            (jvm::with-inline-code ()
     683        (jvm::emit 'jvm::aload 1)
     684        (jvm::emit-invokevirtual jvm::+lisp-object-class+ "javaInstance"
     685               nil jvm::+java-object+)
     686        (jvm::emit 'jvm::checkcast "org/armedbear/lisp/FaslClassLoader")
     687        (jvm::emit 'jvm::dup)
     688        (jvm::emit-push-constant-int ,(1- i))
     689        (jvm::emit 'jvm::new ,class)
     690        (jvm::emit 'jvm::dup)
     691        (jvm::emit-invokespecial-init ,class '())
     692        (jvm::emit-invokevirtual "org/armedbear/lisp/FaslClassLoader" "putFunction"
     693               (list "I" jvm::+lisp-object+) jvm::+lisp-object+)
     694        (jvm::emit 'jvm::pop))
     695            t))))))
     696   (classname (fasl-loader-classname))
     697   (classfile (namestring (merge-pathnames (make-pathname :name classname :type "cls")
     698             *output-file-pathname*))))
     699    (jvm::with-saved-compiler-policy
     700  (jvm::with-file-compilation
     701      (with-open-file
     702    (f classfile
     703       :direction :output
     704       :element-type '(unsigned-byte 8)
     705       :if-exists :supersede)
     706        (jvm:compile-defun nil expr nil
     707         classfile f nil))))))
    634708
    635709(defun compile-file-if-needed (input-file &rest allargs &key force-compile
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r12748 r12749  
    12991299                 (return-from p1-function-call
    13001300       (let ((*inline-declarations*
    1301         (remove op *inline-declarations* :key #'car)))
     1301        (remove op *inline-declarations* :key #'car :test #'equal)))
    13021302         (p1 expansion))))))
    13031303
     
    14331433                  (UNWIND-PROTECT       p1-unwind-protect)
    14341434                  (THREADS:SYNCHRONIZED-ON
    1435                                         p1-threads-synchronized-on)))
     1435                                        p1-threads-synchronized-on)
     1436      (JVM::WITH-INLINE-CODE identity)))
    14361437    (install-p1-handler (%car pair) (%cadr pair))))
    14371438
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12748 r12749  
    199199          n)))
    200200
     201(defconstant +fasl-loader-class+
     202  "org/armedbear/lisp/FaslClassLoader")
    201203(defconstant +java-string+ "Ljava/lang/String;")
    202204(defconstant +java-object+ "Ljava/lang/Object;")
     
    22682270   (setf g (symbol-name (gensym "LFUN")))
    22692271   (let* ((pathname (abcl-class-file-pathname (local-function-class-file local-function)))
     2272    (class-name (concatenate 'string "org/armedbear/lisp/" (pathname-name pathname)))
    22702273    (*code* *static-code*))
    22712274     ;; fixme *declare-inline*
    2272      (declare-field g +lisp-object+ +field-access-default+)
    2273      (emit 'ldc (pool-string (file-namestring pathname)))
    2274      (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
    2275       (list +java-string+) +lisp-object+)
     2275     (declare-field g +lisp-object+ +field-access-private+)
     2276     (emit 'new class-name)
     2277     (emit 'dup)
     2278     (emit-invokespecial-init class-name '())
     2279
     2280     ;(emit 'ldc (pool-string (pathname-name pathname)))
     2281     ;(emit-invokestatic +fasl-loader-class+ "faslLoadFunction"
     2282     ;(list +java-string+) +lisp-object+)
     2283
     2284;     (emit 'ldc (pool-string (file-namestring pathname)))
     2285     
     2286;     (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
     2287;     (list +java-string+) +lisp-object+)
    22762288     (emit 'putstatic *this-class* g +lisp-object+)
    22772289     (setf *static-code* *code*)
     
    24182430             (typep form 'double-float)
    24192431             (characterp form)
    2420              (stringp form)
    2421              (packagep form)
    2422              (pathnamep form)
    2423              (vectorp form)
    24242432             (stringp form)
    24252433             (packagep form)
     
    50995107               (emit 'getstatic *this-class*
    51005108                     g +lisp-object+))))) ; Stack: template-function
    5101          ((member name *functions-defined-in-current-file* :test #'equal)
     5109         ((and (member name *functions-defined-in-current-file* :test #'equal)
     5110         (not (notinline-p name)))
    51025111          (emit 'getstatic *this-class*
    51035112                (declare-setf-function name) +lisp-object+)
     
    75497558      (compile-function-call form target representation))))
    75507559
     7560#|(defknown p2-java-jcall (t t t) t)
     7561(define-inlined-function p2-java-jcall (form target representation)
     7562  ((and (> *speed* *safety*)
     7563  (< 1 (length form))
     7564  (eq 'jmethod (car (cadr form)))
     7565  (every #'stringp (cdr (cadr form)))))
     7566  (let ((m (ignore-errors (eval (cadr form)))))
     7567    (if m
     7568  (let ((must-clear-values nil)
     7569        (arg-types (raw-arg-types (jmethod-params m))))
     7570    (declare (type boolean must-clear-values))
     7571    (dolist (arg (cddr form))
     7572      (compile-form arg 'stack nil)
     7573      (unless must-clear-values
     7574        (unless (single-valued-p arg)
     7575    (setf must-clear-values t))))
     7576    (when must-clear-values
     7577      (emit-clear-values))
     7578    (dotimes (i (jarray-length raw-arg-types))
     7579      (push (jarray-ref raw-arg-types i) arg-types))
     7580    (emit-invokevirtual (jclass-name (jmethod-declaring-class m))
     7581            (jmethod-name m)
     7582            (nreverse arg-types)
     7583            (jmethod-return-type m)))
     7584      ;; delay resolving the method to run-time; it's unavailable now
     7585      (compile-function-call form target representation))))|#
    75517586
    75527587(defknown p2-char= (t t t) t)
     
    82258260  t)
    82268261
     8262(defun p2-with-inline-code (form target representation)
     8263  ;;form = (with-inline-code (&optional target-var repr-var) ...body...)
     8264  (destructuring-bind (&optional target-var repr-var) (cadr form)
     8265    (eval `(let (,@(when target-var `((,target-var ,target)))
     8266     ,@(when repr-var `((,repr-var ,representation))))
     8267       ,@(cddr form)))))
     8268
    82278269(defun compile-1 (compiland stream)
    82288270  (let ((*all-variables* nil)
     
    85178559  (install-p2-handler 'java:jconstructor   'p2-java-jconstructor)
    85188560  (install-p2-handler 'java:jmethod        'p2-java-jmethod)
     8561;  (install-p2-handler 'java:jcall          'p2-java-jcall)
    85198562  (install-p2-handler 'char=               'p2-char=)
    85208563  (install-p2-handler 'characterp          'p2-characterp)
     
    86018644  (install-p2-handler 'write-8-bits        'p2-write-8-bits)
    86028645  (install-p2-handler 'zerop               'p2-zerop)
     8646  (install-p2-handler 'with-inline-code    'p2-with-inline-code)
    86038647  t)
    86048648
  • trunk/abcl/src/org/armedbear/lisp/disassemble.lisp

    r12748 r12749  
    4848      (unless (compiled-function-p function)
    4949        (setf function (compile nil function)))
    50       (when (getf (function-plist function) 'class-bytes)
    51         (with-input-from-string
    52           (stream (disassemble-class-bytes (getf (function-plist function) 'class-bytes)))
    53           (loop
    54             (let ((line (read-line stream nil)))
    55               (unless line (return))
    56               (write-string "; ")
    57               (write-string line)
    58               (terpri))))
    59         (return-from disassemble)))
    60     (%format t "; Disassembly is not available.~%")))
     50      (let ((class-bytes (function-class-bytes function)))
     51  (when class-bytes
     52    (with-input-from-string
     53        (stream (disassemble-class-bytes class-bytes))
     54      (loop
     55         (let ((line (read-line stream nil)))
     56     (unless line (return))
     57     (write-string "; ")
     58     (write-string line)
     59     (terpri))))
     60    (return-from disassemble)))
     61      (%format t "; Disassembly is not available.~%"))))
  • trunk/abcl/src/org/armedbear/lisp/gui.lisp

    r12748 r12749  
    11(in-package :extensions)
     2
     3(require :java)
    24
    35(defvar *gui-backend* :swing)
  • trunk/abcl/src/org/armedbear/lisp/load.lisp

    r12748 r12749  
    3939             (external-format :default))
    4040  (declare (ignore external-format)) ; FIXME
    41   (%load (if (streamp filespec)
    42              filespec
    43              (merge-pathnames (pathname filespec)))
    44          verbose print if-does-not-exist))
     41  (let (*fasl-loader*)
     42    (%load (if (streamp filespec)
     43         filespec
     44         (merge-pathnames (pathname filespec)))
     45     verbose print if-does-not-exist)))
    4546
    4647(defun load-returning-last-result (filespec
     
    5152             (external-format :default))
    5253  (declare (ignore external-format)) ; FIXME
    53   (%load-returning-last-result (if (streamp filespec)
    54              filespec
    55              (merge-pathnames (pathname filespec)))
    56          verbose print if-does-not-exist))
     54  (let (*fasl-loader*)
     55    (%load-returning-last-result (if (streamp filespec)
     56             filespec
     57             (merge-pathnames (pathname filespec)))
     58         verbose print if-does-not-exist)))
  • trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

    r12748 r12749  
    3333
    3434
    35 (export '(*inline-declarations*
    36           process-optimization-declarations
     35(export '(process-optimization-declarations
    3736          inline-p notinline-p inline-expansion expand-inline
    3837          *defined-functions* *undefined-functions* note-name-defined))
    39 
    40 (defvar *inline-declarations* nil)
    4138
    4239(declaim (ftype (function (t) t) process-optimization-declarations))
     
    8784(defun inline-p (name)
    8885  (declare (optimize speed))
    89   (let ((entry (assoc name *inline-declarations*)))
     86  (let ((entry (assoc name *inline-declarations* :test #'equal)))
    9087    (if entry
    9188        (eq (cdr entry) 'INLINE)
     
    9592(defun notinline-p (name)
    9693  (declare (optimize speed))
    97   (let ((entry (assoc name *inline-declarations*)))
     94  (let ((entry (assoc name *inline-declarations* :test #'equal)))
    9895    (if entry
    9996        (eq (cdr entry) 'NOTINLINE)
     
    962959                                  'precompiler))))
    963960    (unless (and handler (fboundp handler))
    964       (error "No handler for ~S." symbol))
     961      (error "No handler for ~S." (let ((*package* (find-package :keyword)))
     962            (format nil "~S" symbol))))
    965963    (setf (get symbol 'precompile-handler) handler)))
    966964
     
    10251023
    10261024                  (THREADS:SYNCHRONIZED-ON
    1027                                         precompile-threads-synchronized-on)))
     1025                                        precompile-threads-synchronized-on)
     1026     
     1027      (JVM::WITH-INLINE-CODE precompile-identity)))
    10281028    (install-handler (first pair) (second pair))))
    10291029
  • trunk/abcl/src/org/armedbear/lisp/proclaim.lisp

    r12748 r12749  
    3232(in-package #:system)
    3333
    34 (export '(check-declaration-type proclaimed-type proclaimed-ftype ftype-result-type))
     34(export '(check-declaration-type proclaimed-type proclaimed-ftype ftype-result-type *inline-declarations*))
    3535
    3636(defmacro declaim (&rest decls)
     
    4444         :format-arguments (list name)))
    4545
     46(defvar *inline-declarations* nil)
    4647(defvar *declaration-types* (make-hash-table :test 'eq))
    4748
     
    9293    ((INLINE NOTINLINE)
    9394     (dolist (name (cdr declaration-specifier))
    94        (when (symbolp name) ; FIXME Need to support non-symbol function names.
    95          (setf (get name '%inline) (car declaration-specifier)))))
     95       (if (symbolp name)
     96         (setf (get name '%inline) (car declaration-specifier))
     97   (push (cons name (car declaration-specifier)) *inline-declarations*))))
    9698    (DECLARATION
    9799     (dolist (name (cdr declaration-specifier))
  • trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java

    r12748 r12749  
    279279  }
    280280 
    281   @Override
    282281  public <T> T getInterface(Class<T> clasz) {
    283282    try {
     
    289288
    290289  @SuppressWarnings("unchecked")
    291   @Override
    292290  public <T> T getInterface(Object thiz, Class<T> clasz) {
    293291      Symbol s = findSymbol("jmake-proxy", "JAVA");
     
    296294  }
    297295 
    298     @Override
    299296    public Object invokeFunction(String name, Object... args) throws ScriptException, NoSuchMethodException {
    300297  Symbol s;
     
    321318    }
    322319
    323     @Override
    324320    public Object invokeMethod(Object thiz, String name, Object... args) throws ScriptException, NoSuchMethodException {
    325321  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

    r12748 r12749  
    3232    private static final AbclScriptEngine THE_ONLY_ONE_ENGINE = new AbclScriptEngine();
    3333 
    34   @Override
    35   public String getEngineName() {
    36     return "ABCL Script";
     34    public String getEngineName() {
     35  return "ABCL Script";
     36    }
     37
     38    public String getEngineVersion() {
     39  return "0.1";
     40    }
     41
     42    public List<String> getExtensions() {
     43  List<String> extensions = new ArrayList<String>(1);
     44  extensions.add("lisp");
     45  return Collections.unmodifiableList(extensions);
     46    }
     47
     48    public String getLanguageName() {
     49  return "ANSI Common Lisp";
     50    }
     51
     52    public String getLanguageVersion() {
     53  return "ANSI X3.226:1994";
     54    }
     55
     56    public static String escape(String raw) {
     57  StringBuilder sb = new StringBuilder();
     58  int len = raw.length();
     59  char c;
     60  for(int i = 0; i < len; ++i) {
     61      c = raw.charAt(i);
     62      if(c != '"') {
     63    sb.append(c);
     64      } else {
     65    sb.append("\\\"");
     66      }
    3767  }
     68  return sb.toString();
     69    }
     70 
     71    public String getMethodCallSyntax(String obj, String method, String... args) {
     72  StringBuilder sb = new StringBuilder();
     73  sb.append("(jcall \"");
     74  sb.append(method);
     75  sb.append("\" ");
     76  sb.append(obj);
     77  for(String arg : args) {
     78      sb.append(" ");
     79      sb.append(arg);
     80  }
     81  sb.append(")");
     82  return sb.toString();
     83    }
     84   
     85    public List<String> getMimeTypes() {
     86  return Collections.unmodifiableList(new ArrayList<String>());
     87    }
    3888
    39   @Override
    40   public String getEngineVersion() {
    41     return "0.1";
     89    public List<String> getNames() {
     90  List<String> names = new ArrayList<String>(1);
     91  names.add("ABCL");
     92  names.add("cl");
     93  names.add("Lisp");
     94  names.add("Common Lisp");
     95  return Collections.unmodifiableList(names);
     96    }
     97
     98    public String getOutputStatement(String str) {
     99  return "(cl:print \"" + str + "\")";
     100    }
     101
     102    public Object getParameter(String key) {
     103  // TODO Auto-generated method stub
     104  return null;
     105    }
     106
     107    public String getProgram(String... statements) {
     108  StringBuilder sb = new StringBuilder();
     109  sb.append("(cl:progn");
     110  for(String stmt : statements) {
     111      sb.append("\n\t");
     112      sb.append(stmt);
    42113  }
    43 
    44   @Override
    45   public List<String> getExtensions() {
    46     List<String> extensions = new ArrayList<String>(1);
    47     extensions.add("lisp");
    48     return Collections.unmodifiableList(extensions);
    49   }
    50 
    51   @Override
    52   public String getLanguageName() {
    53     return "ANSI Common Lisp";
    54   }
    55 
    56   @Override
    57   public String getLanguageVersion() {
    58     return "ANSI X3.226:1994";
    59   }
    60 
    61   public static String escape(String raw) {
    62     StringBuilder sb = new StringBuilder();
    63     int len = raw.length();
    64     char c;
    65     for(int i = 0; i < len; ++i) {
    66       c = raw.charAt(i);
    67       if(c != '"') {
    68         sb.append(c);
    69       } else {
    70         sb.append("\\\"");
    71       }
    72     }
    73     return sb.toString();
    74   }
    75  
    76   @Override
    77   public String getMethodCallSyntax(String obj, String method, String... args) {
    78     StringBuilder sb = new StringBuilder();
    79     sb.append("(jcall \"");
    80     sb.append(method);
    81     sb.append("\" ");
    82     sb.append(obj);
    83     for(String arg : args) {
    84       sb.append(" ");
    85       sb.append(arg);
    86     }
    87     sb.append(")");
    88     return sb.toString();
    89   }
    90 
    91   @Override
    92   public List<String> getMimeTypes() {
    93       return Collections.unmodifiableList(new ArrayList<String>());
    94   }
    95 
    96   @Override
    97   public List<String> getNames() {
    98     List<String> names = new ArrayList<String>(1);
    99     names.add("ABCL");
    100     names.add("cl");
    101     names.add("Lisp");
    102     names.add("Common Lisp");
    103     return Collections.unmodifiableList(names);
    104   }
    105 
    106   @Override
    107   public String getOutputStatement(String str) {
    108     return "(cl:print \"" + str + "\")";
    109   }
    110 
    111   @Override
    112   public Object getParameter(String key) {
    113     // TODO Auto-generated method stub
    114     return null;
    115   }
    116 
    117   @Override
    118   public String getProgram(String... statements) {
    119     StringBuilder sb = new StringBuilder();
    120     sb.append("(cl:progn");
    121     for(String stmt : statements) {
    122       sb.append("\n\t");
    123       sb.append(stmt);
    124     }
    125     sb.append(")");
    126     return sb.toString();
    127   }
    128 
    129   @Override
    130   public ScriptEngine getScriptEngine() {
    131     return THE_ONLY_ONE_ENGINE;
    132   }
     114  sb.append(")");
     115  return sb.toString();
     116    }
     117   
     118    public ScriptEngine getScriptEngine() {
     119  return THE_ONLY_ONE_ENGINE;
     120    }
    133121
    134122}
Note: See TracChangeset for help on using the changeset viewer.