Changeset 12748


Ignore:
Timestamp:
06/09/10 11:17:17 (12 years ago)
Author:
Mark Evenson
Message:

Include 'examples' in release source distribution.

Reported by Mario Lang.

Location:
trunk/abcl
Files:
3 added
12 deleted
24 edited
5 copied

Legend:

Unmodified
Added
Removed
  • trunk/abcl/build.xml

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

    r12730 r12748  
    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>
    3023    <target depends="test,jar,javadoc" description="Build and test whole project." name="default"/>
    3124    <!--
     
    5649    <target depends="-pre-init,-init-private,-init-user,-init-project,-init-macrodef-property" name="-do-init">
    5750        <available file="${manifest.file}" property="manifest.available"/>
    58         <condition property="main.class.available">
     51        <condition property="manifest.available+main.class">
    5952            <and>
     53                <isset property="manifest.available"/>
    6054                <isset property="main.class"/>
    6155                <not>
     
    6458            </and>
    6559        </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>
    8060        <condition property="manifest.available+main.class+mkdist.available">
    8161            <and>
    8262                <istrue value="${manifest.available+main.class}"/>
    83                 <isset property="do.mkdist"/>
     63                <isset property="libs.CopyLibs.classpath"/>
    8464            </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>
    10365        </condition>
    10466        <condition property="have.tests">
     
    13698        <property name="application.args" value=""/>
    13799        <property name="source.encoding" value="${file.encoding}"/>
    138         <property name="runtime.encoding" value="${source.encoding}"/>
    139100        <condition property="javadoc.encoding.used" value="${javadoc.encoding}">
    140101            <and>
     
    152113            <istrue value="${do.depend}"/>
    153114        </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"/>
     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>
    159121    </target>
    160122    <target name="-post-init">
     
    191153            <attribute default="${excludes}" name="excludes"/>
    192154            <attribute default="${javac.debug}" name="debug"/>
    193             <attribute default="${empty.dir}" name="sourcepath"/>
    194             <attribute default="${empty.dir}" name="gensrcdir"/>
     155            <attribute default="/does/not/exist" name="sourcepath"/>
    195156            <element name="customize" optional="true"/>
    196157            <sequential>
    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>
     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}">
    205159                    <classpath>
    206160                        <path path="@{classpath}"/>
    207161                    </classpath>
    208                     <compilerarg line="${endorsed.classpath.cmd.line.arg}"/>
    209                     <compilerarg line="${javac.compilerargs}"/>
     162                    <compilerarg line="${javac.compilerargs} ${javac.compilerargs.jaxws}"/>
    210163                    <customize/>
    211164                </javac>
     
    246199            <attribute default="**" name="testincludes"/>
    247200            <sequential>
    248                 <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true" tempdir="${build.dir}">
     201                <junit dir="${work.dir}" errorproperty="tests.failed" failureproperty="tests.failed" fork="true" showoutput="true">
    249202                    <batchtest todir="${build.test.results.dir}">
    250203                        <fileset dir="${test.src.dir}" excludes="@{excludes},${excludes}" includes="@{includes}">
     
    261214                    <formatter type="brief" usefile="false"/>
    262215                    <formatter type="xml"/>
    263                     <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
    264216                    <jvmarg line="${run.jvmargs}"/>
    265217                </junit>
     
    318270            <sequential>
    319271                <java classname="@{classname}" dir="${work.dir}" fork="true">
    320                     <jvmarg line="${endorsed.classpath.cmd.line.arg}"/>
    321272                    <jvmarg line="${debug-args-line}"/>
    322273                    <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}"/>
    325274                    <jvmarg line="${run.jvmargs}"/>
    326275                    <classpath>
     
    339288        <macrodef name="java" uri="http://www.netbeans.org/ns/j2se-project/1">
    340289            <attribute default="${main.class}" name="classname"/>
    341             <attribute default="${run.classpath}" name="classpath"/>
    342290            <element name="customize" optional="true"/>
    343291            <sequential>
    344292                <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}"/>
    348293                    <jvmarg line="${run.jvmargs}"/>
    349294                    <classpath>
    350                         <path path="@{classpath}"/>
     295                        <path path="${run.classpath}"/>
    351296                    </classpath>
    352297                    <syspropertyset>
     
    372317                ===================
    373318            -->
    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>
     319    <target depends="init" name="deps-jar" unless="no.deps"/>
    390320    <target depends="init,-check-automatic-build,-clean-after-automatic-build" name="-verify-automatic-build"/>
    391321    <target depends="init" name="-check-automatic-build">
     
    403333    </target>
    404334    <target if="do.depend.true" name="-compile-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}"/>
     335        <j2seproject3:depend/>
    411336    </target>
    412337    <target depends="init,deps-jar,-pre-pre-compile,-pre-compile,-compile-depend" if="have.sources" name="-do-compile">
    413         <j2seproject3:javac gensrcdir="${build.generated.sources.dir}"/>
     338        <j2seproject3:javac/>
    414339        <copy todir="${build.classes.dir}">
    415340            <fileset dir="${src.dir}" excludes="${build.classes.excludes},${excludes}" includes="${includes}"/>
     
    428353        <fail unless="javac.includes">Must select some files in the IDE or set javac.includes</fail>
    429354        <j2seproject3:force-recompile/>
    430         <j2seproject3:javac excludes="" gensrcdir="${build.generated.sources.dir}" includes="${javac.includes}" sourcepath="${src.dir}"/>
     355        <j2seproject3:javac excludes="" includes="${javac.includes}" sourcepath="${src.dir}"/>
    431356    </target>
    432357    <target name="-post-compile-single">
     
    448373        <!-- You can override this target in the ../build.xml file. -->
    449374    </target>
    450     <target depends="init,compile,-pre-pre-jar,-pre-jar" name="-do-jar-without-manifest" unless="manifest.available-mkdist.available">
     375    <target depends="init,compile,-pre-pre-jar,-pre-jar" name="-do-jar-without-manifest" unless="manifest.available">
    451376        <j2seproject1:jar/>
    452377    </target>
    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">
     378    <target depends="init,compile,-pre-pre-jar,-pre-jar" if="manifest.available" name="-do-jar-with-manifest" unless="manifest.available+main.class">
    454379        <j2seproject1:jar manifest="${manifest.file}"/>
    455380    </target>
     
    494419        <echo>java -jar "${dist.jar.resolved}"</echo>
    495420    </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>
    538421    <target name="-post-jar">
    539422        <!-- Empty placeholder for easier customization. -->
    540423        <!-- You can override this target in the ../build.xml file. -->
    541424    </target>
    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"/>
     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"/>
    543426    <!--
    544427                =================
     
    556439        <property name="javac.includes.binary" value=""/>
    557440    </target>
    558     <target depends="init,compile-single" name="run-single">
     441    <target depends="init,-do-not-recompile,compile-single" name="run-single">
    559442        <fail unless="run.class">Must select one file in the IDE or set run.class</fail>
    560443        <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}"/>
    565444    </target>
    566445    <!--
     
    571450    <target depends="init" if="netbeans.home" name="-debug-start-debugger">
    572451        <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}"/>
    576452    </target>
    577453    <target depends="init,compile" name="-debug-start-debuggee">
     
    591467        <j2seproject3:debug classname="${debug.class}"/>
    592468    </target>
    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"/>
     469    <target depends="init,-do-not-recompile,compile-single,-debug-start-debugger,-debug-start-debuggee-single" if="netbeans.home" name="debug-single"/>
    599470    <target depends="init" name="-pre-debug-fix">
    600471        <fail unless="fix.includes">Must set fix.includes</fail>
     
    619490                <filename name="**/*.java"/>
    620491            </fileset>
    621             <fileset dir="${build.generated.sources.dir}" erroronmissingdir="false">
    622                 <include name="**/*.java"/>
    623             </fileset>
    624492        </javadoc>
    625493    </target>
     
    683551    </target>
    684552    <target depends="init,compile-test,-pre-test-run,-do-test-run" if="have.tests" name="-post-test-run">
    685         <fail if="tests.failed" unless="ignore.failing.tests">Some tests failed; see details above.</fail>
     553        <fail if="tests.failed">Some tests failed; see details above.</fail>
    686554    </target>
    687555    <target depends="init" if="have.tests" name="test-report"/>
     
    696564    </target>
    697565    <target depends="init,compile-test-single,-pre-test-run-single,-do-test-run-single" if="have.tests" name="-post-test-run-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"/>
     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"/>
    701569    <!--
    702570                =======================
     
    725593        <j2seproject1:nbjpdastart classpath="${debug.test.classpath}" name="${test.class}"/>
    726594    </target>
    727     <target depends="init,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
     595    <target depends="init,-do-not-recompile,compile-test-single,-debug-start-debugger-test,-debug-start-debuggee-test" name="debug-test"/>
    728596    <target depends="init,-pre-debug-fix,compile-test-single" if="netbeans.home" name="-do-debug-fix-test">
    729597        <j2seproject1:nbjpdareload dir="${build.test.classes.dir}"/>
     
    762630                ===============
    763631            -->
    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>
     632    <target depends="init" name="deps-clean" unless="no.deps"/>
    780633    <target depends="init" name="-do-clean">
    781634        <delete dir="${build.dir}"/>
    782         <delete dir="${dist.dir}" followsymlinks="false" includeemptydirs="true"/>
     635        <delete dir="${dist.dir}"/>
    783636    </target>
    784637    <target name="-post-clean">
     
    787640    </target>
    788641    <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>
    805642</project>
  • trunk/abcl/nbproject/genfiles.properties

    r12730 r12748  
    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=29122cc4
    8 nbproject/build-impl.xml.stylesheet.CRC32=576378a2@1.32.1.45
     7nbproject/build-impl.xml.script.CRC32=b7bf05a5
     8nbproject/build-impl.xml.stylesheet.CRC32=65b8de21
    99nbproject/profiler-build-impl.xml.data.CRC32=71623fcd
    1010nbproject/profiler-build-impl.xml.script.CRC32=abda56ed
  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r12742 r12748  
    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 
    690687        autoload(Symbol.SET_CHAR, "StringFunctions");
    691688        autoload(Symbol.SET_SCHAR, "StringFunctions");
  • trunk/abcl/src/org/armedbear/lisp/Function.java

    r12742 r12748  
    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 
    206178    @Override
    207179    public LispObject execute()
    208180    {
    209         return error(new WrongNumberOfArgumentsException(this, 0));
     181        return error(new WrongNumberOfArgumentsException(this));
    210182    }
    211183
     
    213185    public LispObject execute(LispObject arg)
    214186    {
    215         return error(new WrongNumberOfArgumentsException(this, 1));
     187        return error(new WrongNumberOfArgumentsException(this));
    216188    }
    217189
     
    220192
    221193    {
    222         return error(new WrongNumberOfArgumentsException(this, 2));
     194        return error(new WrongNumberOfArgumentsException(this));
    223195    }
    224196
     
    228200
    229201    {
    230         return error(new WrongNumberOfArgumentsException(this, 3));
     202        return error(new WrongNumberOfArgumentsException(this));
    231203    }
    232204
     
    236208
    237209    {
    238         return error(new WrongNumberOfArgumentsException(this, 4));
     210        return error(new WrongNumberOfArgumentsException(this));
    239211    }
    240212
     
    245217
    246218    {
    247         return error(new WrongNumberOfArgumentsException(this, 5));
     219        return error(new WrongNumberOfArgumentsException(this));
    248220    }
    249221
     
    254226
    255227    {
    256         return error(new WrongNumberOfArgumentsException(this, 6));
     228        return error(new WrongNumberOfArgumentsException(this));
    257229    }
    258230
     
    264236
    265237    {
    266         return error(new WrongNumberOfArgumentsException(this, 7));
     238        return error(new WrongNumberOfArgumentsException(this));
    267239    }
    268240
     
    274246
    275247    {
    276         return error(new WrongNumberOfArgumentsException(this, 8));
     248        return error(new WrongNumberOfArgumentsException(this));
    277249    }
    278250
  • trunk/abcl/src/org/armedbear/lisp/Interpreter.java

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

    r12742 r12748  
    4444import java.net.URLDecoder;
    4545import java.util.Hashtable;
     46import java.util.zip.ZipEntry;
     47import java.util.zip.ZipFile;
    4648
    4749public final class Lisp
     
    700702   * This version is used by the interpreter.
    701703   */
    702   static final LispObject nonLocalGo(Binding binding,
    703                                      LispObject tag)
     704  public static final LispObject nonLocalGo(Binding binding,
     705                                            LispObject tag)
     706
    704707  {
    705708    if (binding.env.inactive)
     
    736739   * This version is used by the interpreter.
    737740   */
    738   static final LispObject nonLocalReturn(Binding binding,
    739                                          Symbol block,
    740                                          LispObject result)
     741  public static final LispObject nonLocalReturn(Binding binding,
     742                                                Symbol block,
     743                                                LispObject result)
     744
    741745  {
    742746    if (binding == null)
     
    12651269              input = url.openStream();
    12661270          } catch (IOException e) {
    1267         System.err.println("Failed to read class bytes from boot class " + url);
    12681271              error(new LispError("Failed to read class bytes from boot class " + url));
    12691272          }
     
    23852388    internSpecial("*LOAD-STREAM*", PACKAGE_SYS, NIL);
    23862389
    2387     // ### *fasl-loader*
    2388     public static final Symbol _FASL_LOADER_ =
    2389   exportSpecial("*FASL-LOADER*", PACKAGE_SYS, NIL);
    2390 
    23912390  // ### *source*
    23922391  // internal symbol
     
    27622761  }
    27632762
    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 
    27762763}
  • trunk/abcl/src/org/armedbear/lisp/Load.java

    r12742 r12748  
    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
    219229    public static final LispObject loadSystemFile(String filename, boolean auto)
    220230
     
    243253    }
    244254
    245     private static final Symbol FASL_LOADER = PACKAGE_SYS.intern("*FASL-LOADER*");
    246255    static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
    247256
     
    270279            url = Lisp.class.getResource(path);
    271280            if (url == null || url.toString().endsWith("/")) {
    272                 url = Lisp.class.getResource(path.replace('-', '_') + ".abcl");
     281                url = Lisp.class.getResource(path + ".abcl");
    273282                if (url == null) {
    274283                    url = Lisp.class.getResource(path + ".lisp");
     
    324333            final SpecialBindingsMark mark = thread.markSpecialBindings();
    325334            thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL);
    326       thread.bindSpecial(FASL_LOADER, NIL);
    327335            try {
    328336                Stream stream = new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER);
     
    433441    }
    434442
    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 
    441443    // A nil TRUENAME signals a load from stream which has no possible path
    442444    private static final LispObject loadFileFromStream(LispObject pathname,
     
    452454        final LispThread thread = LispThread.currentThread();
    453455        final SpecialBindingsMark mark = thread.markSpecialBindings();
    454 
    455         for (Symbol special : savedSpecials)
    456             thread.bindSpecialToCurrentValue(special);
    457 
     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_);
    458460        int loadDepth = Fixnum.getValue(_LOAD_DEPTH_.symbolValue(thread));
    459461        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_);
    460468        final String prefix = getLoadVerbosePrefix(loadDepth);
    461469        try {
     
    554562
    555563    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,
    556570                                               LispThread thread, boolean returnLastResult)
    557571
     
    570584                if (obj == EOF)
    571585                    break;
    572     result = eval(obj, env, thread);
     586                result = eval(obj, env, thread);
    573587                if (print) {
    574588                    Stream out =
  • trunk/abcl/src/org/armedbear/lisp/Readtable.java

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

    r12738 r12748  
    4545  }
    4646
    47     public SlotDefinition(StandardClass clazz)
    48   {
    49     super(clazz, clazz.getClassLayout().getLength());
    50     slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = NIL;
    51   }
    52 
    5347  public SlotDefinition(LispObject name, LispObject readers)
    5448  {
     
    120114  }
    121115
    122   // ### make-slot-definition &optional class
     116  // ### make-slot-definition
    123117  private static final Primitive MAKE_SLOT_DEFINITION =
    124     new Primitive("make-slot-definition", PACKAGE_SYS, true, "&optional class")
     118    new Primitive("make-slot-definition", PACKAGE_SYS, true, "")
    125119    {
    126120      @Override
     
    128122      {
    129123        return new SlotDefinition();
    130       }
    131       @Override
    132       public LispObject execute(LispObject slotDefinitionClass)
    133       {
    134     return new SlotDefinition((StandardClass) slotDefinitionClass);
    135124      }
    136125    };
  • trunk/abcl/src/org/armedbear/lisp/StandardClass.java

    r12738 r12748  
    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));
    391386
    392387  // BuiltInClass.FUNCTION is also null here (see previous comment).
     
    727722    SLOT_DEFINITION.setSlotDefinitions(SLOT_DEFINITION.getDirectSlotDefinitions());
    728723
    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 
    736724    // STANDARD-METHOD
    737725    Debug.assertTrue(STANDARD_METHOD.isFinalized());
  • trunk/abcl/src/org/armedbear/lisp/Stream.java

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

    r12738 r12748  
    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");
    29502946
    29512947  // Java interface.
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r12741 r12748  
    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))
    6563
    6664;; Don't use DEFVAR, because that disallows loading clos.lisp
     
    262260  `(function (lambda () ,initform)))
    263261
    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)))))
     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))
    303296
    304297;;; finalize-inheritance
     
    463456
    464457(defun std-compute-effective-slot-definition (class direct-slots)
     458  (declare (ignore class))
    465459  (let ((initer (find-if-not #'null direct-slots
    466460                             :key #'%slot-definition-initfunction)))
    467461    (make-effective-slot-definition
    468      class
    469462     :name (%slot-definition-name (car direct-slots))
    470463     :initform (if initer
     
    566559                                          :direct-default-initargs direct-default-initargs)
    567560    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))
    574561
    575562(defun std-after-initialization-for-classes (class
     
    19131900(redefine-class-forwarder (setf class-direct-default-initargs) direct-default-initargs)
    19141901
    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+)
     1902
    19261903
    19271904(fmakunbound 'documentation)
     
    22352212(defmethod shared-initialize ((instance standard-object) slot-names &rest initargs)
    22362213  (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))
    22482214
    22492215;;; change-class
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r12742 r12748  
    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 
    4943(declaim (ftype (function (t) t) compute-classfile-name))
    5044(defun compute-classfile-name (n &optional (output-file-pathname
     
    5246  "Computes the name of the class file associated with number `n'."
    5347  (let ((name
    54          (sanitize-class-name
    55     (%format nil "~A_~D" (pathname-name output-file-pathname) n))))
     48         (%format nil "~A-~D"
     49                  (substitute #\_ #\.
     50                              (pathname-name output-file-pathname)) n)))
    5651    (namestring (merge-pathnames (make-pathname :name name :type "cls")
    5752                                 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  
    6953
    7054(declaim (ftype (function () t) next-classfile-name))
     
    8670(declaim (ftype (function (t) t) verify-load))
    8771(defun verify-load (classfile)
    88   #|(if (> *safety* 0)
    89       (and classfile
     72  (if (> *safety* 0)
     73    (and classfile
    9074         (let ((*load-truename* *output-file-pathname*))
    9175           (report-error
    9276            (load-compiled-function classfile))))
    93     t)|#
    94   (declare (ignore classfile))
    95   t)
     77    t))
    9678
    9779(declaim (ftype (function (t) t) process-defconstant))
     
    163145                 (let* ((expr `(lambda ,lambda-list
    164146                                 ,@decls (block ,block-name ,@body)))
    165       (saved-class-number *class-number*)
    166147                        (classfile (next-classfile-name))
    167148                        (internal-compiler-errors nil)
     
    188169                      (setf form
    189170                            `(fset ',name
    190            (sys::get-fasl-function *fasl-loader*
    191                  ,saved-class-number)
     171                                   (proxy-preloaded-function ',name ,(file-namestring classfile))
    192172                                   ,*source-position*
    193173                                   ',lambda-list
     
    246226             (eval form)
    247227             (let* ((expr (function-lambda-expression (macro-function name)))
    248         (saved-class-number *class-number*)
    249228                    (classfile (next-classfile-name)))
    250229         (with-open-file
     
    263242                             `(put ',name 'macroexpand-macro
    264243                                   (make-macro ',name
    265                  (sys::get-fasl-function *fasl-loader* ,saved-class-number)))
     244                                               (proxy-preloaded-function
     245                                                '(macro-function ,name)
     246                                                ,(file-namestring classfile))))
    266247                             `(fset ',name
    267248                                    (make-macro ',name
    268             (sys::get-fasl-function *fasl-loader* ,saved-class-number))
     249                                                (proxy-preloaded-function
     250                                                 '(macro-function ,name)
     251                                                 ,(file-namestring classfile)))
    269252                                    ,*source-position*
    270253                                    ',(third form)))))))))
     
    366349  ;; was already used in verify-load before I used it,
    367350  ;; however, binding *load-truename* isn't fully compliant, I think.
    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)))
     351  (let ((*load-truename* *output-file-pathname*))
     352    (when compile-time-too
    374353      (eval form))))
    375354
     
    388367      (let ((lambda-expression (cadr function-form)))
    389368        (jvm::with-saved-compiler-policy
    390           (let* ((saved-class-number *class-number*)
    391      (classfile (next-classfile-name))
     369          (let* ((classfile (next-classfile-name))
    392370                 (result
    393371      (with-open-file
     
    402380            (cond (compiled-function
    403381                   (setf (getf tail key)
    404        `(sys::get-fasl-function *fasl-loader* ,saved-class-number)))
    405 ;;                         `(load-compiled-function ,(file-namestring classfile))))
     382                         `(load-compiled-function ,(file-namestring classfile))))
    406383                  (t
    407384                   ;; FIXME This should be a warning or error of some sort...
     
    436413      (precompiler:precompile-form form nil *compile-file-environment*)))
    437414  (let* ((expr `(lambda () ,form))
    438    (saved-class-number *class-number*)
    439415         (classfile (next-classfile-name))
    440416         (result
     
    450426    (setf form
    451427          (if compiled-function
    452               `(funcall (sys::get-fasl-function *fasl-loader* ,saved-class-number))
     428              `(funcall (load-compiled-function ,(file-namestring classfile)))
    453429              (precompiler:precompile-form form nil *compile-file-environment*)))))
    454430
     
    597573                     :stream out)
    598574              (%stream-terpri out)
    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))
     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)
    615594              (%stream-terpri out))
    616595
     
    631610                           (merge-pathnames (make-pathname :type type)
    632611                                            output-file)))
    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))
     612                 (pathnames ()))
    638613            (dotimes (i *class-number*)
    639614              (let* ((pathname (compute-classfile-name (1+ i))))
     
    657632                  (namestring output-file) elapsed))))
    658633    (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))))))
    708634
    709635(defun compile-file-if-needed (input-file &rest allargs &key force-compile
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

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

    r12742 r12748  
    199199          n)))
    200200
    201 (defconstant +fasl-loader-class+
    202   "org/armedbear/lisp/FaslClassLoader")
    203201(defconstant +java-string+ "Ljava/lang/String;")
    204202(defconstant +java-object+ "Ljava/lang/Object;")
     
    22702268   (setf g (symbol-name (gensym "LFUN")))
    22712269   (let* ((pathname (abcl-class-file-pathname (local-function-class-file local-function)))
    2272     (class-name (concatenate 'string "org/armedbear/lisp/" (pathname-name pathname)))
    22732270    (*code* *static-code*))
    22742271     ;; fixme *declare-inline*
    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+)
     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+)
    22882276     (emit 'putstatic *this-class* g +lisp-object+)
    22892277     (setf *static-code* *code*)
     
    24302418             (typep form 'double-float)
    24312419             (characterp form)
     2420             (stringp form)
     2421             (packagep form)
     2422             (pathnamep form)
     2423             (vectorp form)
    24322424             (stringp form)
    24332425             (packagep form)
     
    51075099               (emit 'getstatic *this-class*
    51085100                     g +lisp-object+))))) ; Stack: template-function
    5109          ((and (member name *functions-defined-in-current-file* :test #'equal)
    5110          (not (notinline-p name)))
     5101         ((member name *functions-defined-in-current-file* :test #'equal)
    51115102          (emit 'getstatic *this-class*
    51125103                (declare-setf-function name) +lisp-object+)
     
    75587549      (compile-function-call form target representation))))
    75597550
    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))))|#
    75867551
    75877552(defknown p2-char= (t t t) t)
     
    82608225  t)
    82618226
    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 
    82698227(defun compile-1 (compiland stream)
    82708228  (let ((*all-variables* nil)
     
    85598517  (install-p2-handler 'java:jconstructor   'p2-java-jconstructor)
    85608518  (install-p2-handler 'java:jmethod        'p2-java-jmethod)
    8561 ;  (install-p2-handler 'java:jcall          'p2-java-jcall)
    85628519  (install-p2-handler 'char=               'p2-char=)
    85638520  (install-p2-handler 'characterp          'p2-characterp)
     
    86448601  (install-p2-handler 'write-8-bits        'p2-write-8-bits)
    86458602  (install-p2-handler 'zerop               'p2-zerop)
    8646   (install-p2-handler 'with-inline-code    'p2-with-inline-code)
    86478603  t)
    86488604
  • trunk/abcl/src/org/armedbear/lisp/disassemble.lisp

    r12742 r12748  
    4848      (unless (compiled-function-p function)
    4949        (setf function (compile nil function)))
    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.~%"))))
     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.~%")))
  • trunk/abcl/src/org/armedbear/lisp/gui.lisp

    r12742 r12748  
    11(in-package :extensions)
    2 
    3 (require :java)
    42
    53(defvar *gui-backend* :swing)
  • trunk/abcl/src/org/armedbear/lisp/java/DialogPromptStream.java

    r12742 r12748  
    1 package abcl;
     1package org.armedbear.lisp.java;
    22
    33import java.io.IOException;
     
    77
    88import org.armedbear.lisp.Stream;
    9 
    109/**
    11  * A bidirectional stream that captures input from a modal dialog. The
    12  * dialog reports a label (prompt line) which shows to the user
    13  * everything that has been printed to the stream up to the moment
    14  * when the dialog became visible. It is usable as a drop-in
    15  * replacement for e.g. *debug-io*.<br /> This is an abstract class
    16  * that does not depend on any GUI library. Subclasses are expected to
    17  * provide the actual code to show the dialog and read input from the
    18  * user.
    19  *
     10 * A bidirectional stream that captures input from a modal dialog. The dialog reports a label (prompt line)
     11 * which shows to the user everything that has been printed to the stream up to the moment when the dialog
     12 * became visible. It is usable as a drop-in replacement for e.g. *debug-io*.<br />
     13 * This is an abstract class that does not depend on any GUI library. Subclasses are expected to provide
     14 * the actual code to show the dialog and read input from the user.
    2015 * @author Alessio Stalla
    2116 *
  • trunk/abcl/src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java

    r12742 r12748  
    1 package swing;
     1package org.armedbear.lisp.java.swing;
    22
    33import java.awt.BorderLayout;
     
    1313import javax.swing.JTextField;
    1414
    15 import abcl.DialogPromptStream;
     15import org.armedbear.lisp.java.DialogPromptStream;
    1616
    1717public class SwingDialogPromptStream extends DialogPromptStream {
  • trunk/abcl/src/org/armedbear/lisp/load.lisp

    r12742 r12748  
    3939             (external-format :default))
    4040  (declare (ignore external-format)) ; FIXME
    41   (let (*fasl-loader*)
    42     (%load (if (streamp filespec)
    43          filespec
    44          (merge-pathnames (pathname filespec)))
    45      verbose print if-does-not-exist)))
     41  (%load (if (streamp filespec)
     42             filespec
     43             (merge-pathnames (pathname filespec)))
     44         verbose print if-does-not-exist))
    4645
    4746(defun load-returning-last-result (filespec
     
    5251             (external-format :default))
    5352  (declare (ignore external-format)) ; FIXME
    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)))
     53  (%load-returning-last-result (if (streamp filespec)
     54             filespec
     55             (merge-pathnames (pathname filespec)))
     56         verbose print if-does-not-exist))
  • trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

    r12742 r12748  
    3333
    3434
    35 (export '(process-optimization-declarations
     35(export '(*inline-declarations*
     36          process-optimization-declarations
    3637          inline-p notinline-p inline-expansion expand-inline
    3738          *defined-functions* *undefined-functions* note-name-defined))
     39
     40(defvar *inline-declarations* nil)
    3841
    3942(declaim (ftype (function (t) t) process-optimization-declarations))
     
    8487(defun inline-p (name)
    8588  (declare (optimize speed))
    86   (let ((entry (assoc name *inline-declarations* :test #'equal)))
     89  (let ((entry (assoc name *inline-declarations*)))
    8790    (if entry
    8891        (eq (cdr entry) 'INLINE)
     
    9295(defun notinline-p (name)
    9396  (declare (optimize speed))
    94   (let ((entry (assoc name *inline-declarations* :test #'equal)))
     97  (let ((entry (assoc name *inline-declarations*)))
    9598    (if entry
    9699        (eq (cdr entry) 'NOTINLINE)
     
    959962                                  'precompiler))))
    960963    (unless (and handler (fboundp handler))
    961       (error "No handler for ~S." (let ((*package* (find-package :keyword)))
    962             (format nil "~S" symbol))))
     964      (error "No handler for ~S." symbol))
    963965    (setf (get symbol 'precompile-handler) handler)))
    964966
     
    10231025
    10241026                  (THREADS:SYNCHRONIZED-ON
    1025                                         precompile-threads-synchronized-on)
    1026      
    1027       (JVM::WITH-INLINE-CODE precompile-identity)))
     1027                                        precompile-threads-synchronized-on)))
    10281028    (install-handler (first pair) (second pair))))
    10291029
  • trunk/abcl/src/org/armedbear/lisp/proclaim.lisp

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

    r12740 r12748  
    279279  }
    280280 
     281  @Override
    281282  public <T> T getInterface(Class<T> clasz) {
    282283    try {
     
    288289
    289290  @SuppressWarnings("unchecked")
     291  @Override
    290292  public <T> T getInterface(Object thiz, Class<T> clasz) {
    291293      Symbol s = findSymbol("jmake-proxy", "JAVA");
     
    294296  }
    295297 
     298    @Override
    296299    public Object invokeFunction(String name, Object... args) throws ScriptException, NoSuchMethodException {
    297300  Symbol s;
     
    318321    }
    319322
     323    @Override
    320324    public Object invokeMethod(Object thiz, String name, Object... args) throws ScriptException, NoSuchMethodException {
    321325  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

    r12740 r12748  
    3232    private static final AbclScriptEngine THE_ONLY_ONE_ENGINE = new AbclScriptEngine();
    3333 
    34     public String getEngineName() {
    35   return "ABCL Script";
    36     }
     34  @Override
     35  public String getEngineName() {
     36    return "ABCL Script";
     37  }
    3738
    38     public String getEngineVersion() {
    39   return "0.1";
    40     }
     39  @Override
     40  public String getEngineVersion() {
     41    return "0.1";
     42  }
    4143
    42     public List<String> getExtensions() {
    43   List<String> extensions = new ArrayList<String>(1);
    44   extensions.add("lisp");
    45   return Collections.unmodifiableList(extensions);
    46     }
     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  }
    4750
    48     public String getLanguageName() {
    49   return "ANSI Common Lisp";
    50     }
     51  @Override
     52  public String getLanguageName() {
     53    return "ANSI Common Lisp";
     54  }
    5155
    52     public String getLanguageVersion() {
    53   return "ANSI X3.226:1994";
    54     }
     56  @Override
     57  public String getLanguageVersion() {
     58    return "ANSI X3.226:1994";
     59  }
    5560
    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       }
     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();
    6774  }
    68   return sb.toString();
    69     }
    7075 
    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);
     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();
    8089  }
    81   sb.append(")");
    82   return sb.toString();
    83     }
    84    
    85     public List<String> getMimeTypes() {
    86   return Collections.unmodifiableList(new ArrayList<String>());
    87     }
    8890
    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     }
     91  @Override
     92  public List<String> getMimeTypes() {
     93      return Collections.unmodifiableList(new ArrayList<String>());
     94  }
    9795
    98     public String getOutputStatement(String str) {
    99   return "(cl:print \"" + str + "\")";
    100     }
     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  }
    101105
    102     public Object getParameter(String key) {
    103   // TODO Auto-generated method stub
    104   return null;
    105     }
     106  @Override
     107  public String getOutputStatement(String str) {
     108    return "(cl:print \"" + str + "\")";
     109  }
    106110
    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);
     111  @Override
     112  public Object getParameter(String key) {
     113    // TODO Auto-generated method stub
     114    return null;
    113115  }
    114   sb.append(")");
    115   return sb.toString();
    116     }
    117    
    118     public ScriptEngine getScriptEngine() {
    119   return THE_ONLY_ONE_ENGINE;
    120     }
     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  }
    121133
    122134}
Note: See TracChangeset for help on using the changeset viewer.