Changeset 12834


Ignore:
Timestamp:
07/29/10 19:38:25 (13 years ago)
Author:
ehuelsmann
Message:

Backport r12805-12833 from trunk.

Location:
branches/generic-class-file/abcl
Files:
27 edited
2 copied

Legend:

Unmodified
Added
Removed
  • branches/generic-class-file/abcl/CHANGES

    r12687 r12834  
     1Version 0.21
     2============
     3svn://common-lisp.net/project/armedbear/svn/tags/0.21.0/abcl
     4(???, 2010)
     5
     6
     7Features
     8--------
     9
     10* [svn r12818] Update to ASDF 2.004
     11
     12* [svn r12738-805] Support for custom CLOS slot definitions and custom class options.
     13
     14* [svn r12756] slot-* functions work on structures too.
     15
     16* [svn r12774] Improved Java integration: jmake-proxy can implement more than one interface.
     17
     18* [svn r12773] Improved Java integration: functions to dynamically manipulate the classpath.
     19
     20* [svn r12755] Improved Java integration: CL:STRING can convert Java strings to Lisp strings.
     21
     22Fixes
     23-----
     24
     25* [svn 12809-10-20] Various printing fixes.
     26
     27* [svn 12804] Fixed elimination of unused local functions shadowed by macrolet.
     28
     29* [svn r12798-803] Fixed pathname serialization across OSes. On Windows pathnames are always printed with forward slashes, but can still be read with backslashes.
     30
     31* [svn r12740] Make JSR-223 classes compilable with Java 1.5
     32
     33Other
     34-----
     35
     36* [svn r12754] Changed class file generation and FASL loading to minimize reflection.
     37
     38* [svn r12734] A minimal Swing GUI Console with a REPL is now included with ABCL.
     39
    140Version 0.20
    241============
    3 yet-to-be-tagged
    4 (???)
     42svn://common-lisp.net/project/armedbear/svn/tags/0.20.0/abcl
     43(24 May, 2010)
    544
    645
  • branches/generic-class-file/abcl/build.xml

    r12750 r12834  
    446446
    447447    <target name="TAGS">
    448       <apply executable="etags" parallel="true" verbose="true">
     448      <delete file="TAGS"/>
     449      <apply executable="etags" parallel="true" verbose="true" maxparallel="300">
     450        <arg value="--append"/>
    449451  <arg value="--regex=|[ \t]+//[ \t]+###[ \t]+\([^ \t]+\)|\1|"/>
     452  <arg value='--regex=|[ \t]*@DocString([ \t]*name=\"\([^\"]*\)|\1|'/>
    450453  <fileset dir="${src.dir}">
    451454    <patternset refid="abcl.source.java"/>
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Condition.java

    r12576 r12834  
    105105  public final LispObject getFormatControl()
    106106  {
    107     return getInstanceSlotValue(Symbol.FORMAT_CONTROL);
     107      return getInstanceSlotValue(Symbol.FORMAT_CONTROL);
    108108  }
    109109
     
    136136  public String getMessage()
    137137  {
    138     return getFormatControl().toString();
     138      LispObject formatControl = getFormatControl();
     139      return formatControl != UNBOUND_VALUE ? formatControl.writeToString() : null;
    139140  }
    140141
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java

    r12481 r12834  
    7777    }
    7878
    79     // ### make-forward-referenced-class
     79    @DocString(name="make-forward-referenced=class")
    8080    private static final Primitive MAKE_FORWARD_REFERENCED_CLASS =
    8181        new Primitive("make-forward-referenced-class", PACKAGE_SYS, true)
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Function.java

    r12796 r12834  
    5454    public Function(String name)
    5555    {
    56   this();
     56        this(name, (String)null);
     57    }
     58
     59    public Function(String name, String arglist)
     60    {
     61  this();
     62        if(arglist != null)
     63            setLambdaList(new SimpleString(arglist));
    5764        if (name != null) {
    5865            Symbol symbol = Symbol.addFunction(name.toUpperCase(), this);
     
    6370    }
    6471
     72    public Function(Symbol symbol)
     73    {
     74  this(symbol, null, null);
     75    }
     76
    6577    public Function(Symbol symbol, String arglist)
     78    {
     79  this(symbol, arglist, null);
     80    }
     81
     82    public Function(Symbol symbol, String arglist, String docstring)
    6683    {
    6784  this();
     
    7087            symbol.setBuiltInFunction(true);
    7188        setLambdaName(symbol);
    72         setLambdaList(new SimpleString(arglist));
    73     }
    74 
    75     public Function(Symbol symbol, String arglist, String docstring)
    76     {
    77   this();
    78         symbol.setSymbolFunction(this);
    79         if (cold)
    80             symbol.setBuiltInFunction(true);
    81         setLambdaName(symbol);
    82         setLambdaList(new SimpleString(arglist));
    83         if (docstring != null) {
     89        if(arglist != null)
     90            setLambdaList(new SimpleString(arglist));
     91        if (docstring != null)
    8492            symbol.setDocumentation(Symbol.FUNCTION,
    8593                                    new SimpleString(docstring));
    86         }
    87     }
    88 
    89     public Function(String name, String arglist)
    90     {
    91         this(name);
    92         setLambdaList(new SimpleString(arglist));
    9394    }
    9495
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Java.java

    r12715 r12834  
    6161
    6262    private static final Primitive ENSURE_JAVA_OBJECT = new pf_ensure_java_object();
     63    @DocString(name="ensure-java-object", args="obj",
     64    doc="Ensures OBJ is wrapped in a JAVA-OBJECT, wrapping it if necessary.")
    6365    private static final class pf_ensure_java_object extends Primitive
    6466    {
    6567        pf_ensure_java_object()
    6668        {
    67             super("ensure-java-object", PACKAGE_JAVA, true, "obj");
     69            super("ensure-java-object", PACKAGE_JAVA, true);
    6870        }
    6971
     
    7476    };
    7577
    76     // ### register-java-exception exception-name condition-symbol => T
    7778    private static final Primitive REGISTER_JAVA_EXCEPTION = new pf_register_java_exception();
     79    @DocString(name="register-java-exception", // => T
     80    args="exception-name condition-symbol",
     81    doc="Registers the Java Throwable named by the symbol EXCEPTION-NAME as the condition " +
     82        "designated by CONDITION-SYMBOL.  Returns T if successful, NIL if not.")
    7883    private static final class pf_register_java_exception extends Primitive
    7984    {
    8085        pf_register_java_exception()
    8186        {
    82             super("register-java-exception", PACKAGE_JAVA, true,
    83                   "exception-name condition-symbol");
     87            super("register-java-exception", PACKAGE_JAVA, true);
    8488        }
    8589
     
    99103    };
    100104
    101     // ### unregister-java-exception exception-name => T or NIL
    102105    private static final Primitive UNREGISTER_JAVA_EXCEPTION = new pf_unregister_java_exception();
     106    @DocString(name="unregister-java-exception", args="exception-name",
     107    doc="Unregisters the Java Throwable EXCEPTION-NAME previously registered" +
     108        " by REGISTER-JAVA-EXCEPTION.")
    103109    private static final class pf_unregister_java_exception extends Primitive
    104110    {
    105111        pf_unregister_java_exception()
    106112        {
    107             super("unregister-java-exception", PACKAGE_JAVA, true,
    108                   "exception-name");
     113            super("unregister-java-exception", PACKAGE_JAVA, true);
    109114        }
    110115
     
    130135    }
    131136
    132     // ### jclass name-or-class-ref &optional class-loader => class-ref
    133137    private static final Primitive JCLASS = new pf_jclass();
     138    @DocString(name="jclass", args="name-or-class-ref &optional class-loader",
     139    doc="Returns a reference to the Java class designated by" +
     140        " NAME-OR-CLASS-REF. If the CLASS-LOADER parameter is passed, the" +
     141        " class is resolved with respect to the given ClassLoader.")
    134142    private static final class pf_jclass extends Primitive
    135143    {
     
    137145        pf_jclass()
    138146        {
    139             super(Symbol.JCLASS, "name-or-class-ref &optional class-loader",
    140                   "Returns a reference to the Java class designated by NAME-OR-CLASS-REF. If the CLASS-LOADER parameter is passed, the class is resolved with respect to the given ClassLoader.");
     147            super(Symbol.JCLASS);
    141148        }
    142149
     
    154161        }
    155162    };
    156 
    157     // ### jfield - retrieve or modify a field in a Java class or instance.
    158     //
    159     // Supported argument patterns:
    160     //
    161     //   Case 1: class-ref  field-name:
    162     //               to retrieve the value of a static field.
    163     //
    164     //   Case 2: class-ref  field-name  instance-ref:
    165     //               to retrieve the value of a class field of the instance.
    166     //
    167     //   Case 3: class-ref  field-name  primitive-value:
    168     //               to store primitive-value in a static field.
    169     //
    170     //   Case 4: class-ref  field-name  instance-ref  value:
    171     //               to store value in a class field of the instance.
    172     //
    173     //   Case 5: class-ref  field-name  nil  value:
    174     //               to store value in a static field (when value may be
    175     //               confused with an instance-ref).
    176     //
    177     //   Case 6: field-name  instance:
    178     //               to retrieve the value of a field of the instance. The
    179     //               class is derived from the instance.
    180     //
    181     //   Case 7: field-name  instance  value:
    182     //               to store value in a field of the instance. The class is
    183     //               derived from the instance.
    184     //
    185163
    186164    static final LispObject jfield(Primitive fun, LispObject[] args, boolean translate)
     
    259237    }
    260238
    261     // ### jfield class-ref-or-field field-or-instance &optional instance value
     239
    262240    private static final Primitive JFIELD = new pf_jfield();
     241    @DocString(name="jfield",
     242    args="class-ref-or-field field-or-instance &optional instance value",
     243    doc="Retrieves or modifies a field in a Java class or instance.\n\n"+
     244        "Supported argument patterns:\n\n"+
     245        "   Case 1: class-ref  field-name:\n"+
     246        "      Retrieves the value of a static field.\n\n"+
     247        "   Case 2: class-ref  field-name  instance-ref:\n"+
     248        "      Retrieves the value of a class field of the instance.\n\n"+
     249        "   Case 3: class-ref  field-name  primitive-value:\n"+
     250        "      Stores a primitive-value in a static field.\n\n"+
     251        "   Case 4: class-ref  field-name  instance-ref  value:\n"+
     252        "      Stores value in a class field of the instance.\n\n"+
     253        "   Case 5: class-ref  field-name  nil  value:\n"+
     254        "      Stores value in a static field (when value may be\n"+
     255        "      confused with an instance-ref).\n\n"+
     256        "   Case 6: field-name  instance:\n"+
     257        "      Retrieves the value of a field of the instance. The\n"+
     258        "      class is derived from the instance.\n\n"+
     259        "   Case 7: field-name  instance  value:\n"+
     260        "      Stores value in a field of the instance. The class is\n"+
     261        "      derived from the instance.\n\n"
     262        )
    263263    private static final class pf_jfield extends Primitive
    264264    {
    265265        pf_jfield()
    266266        {
    267             super("jfield", PACKAGE_JAVA, true,
    268                   "class-ref-or-field field-or-instance &optional instance value");
     267            super("jfield", PACKAGE_JAVA, true);
    269268        }
    270269
     
    276275    };
    277276
    278     // ### jfield-raw - retrieve or modify a field in a Java class or instance.
    279277    private static final Primitive JFIELD_RAW = new pf_jfield_raw();
     278    @DocString(name="jfield",
     279    args="class-ref-or-field field-or-instance &optional instance value",
     280    doc="Retrieves or modifies a field in a Java class or instance. Does not\n"+
     281        "attempt to coerce its value or the result into a Lisp object.\n\n"+
     282        "Supported argument patterns:\n\n"+
     283        "   Case 1: class-ref  field-name:\n"+
     284        "      Retrieves the value of a static field.\n\n"+
     285        "   Case 2: class-ref  field-name  instance-ref:\n"+
     286        "      Retrieves the value of a class field of the instance.\n\n"+
     287        "   Case 3: class-ref  field-name  primitive-value:\n"+
     288        "      Stores a primitive-value in a static field.\n\n"+
     289        "   Case 4: class-ref  field-name  instance-ref  value:\n"+
     290        "      Stores value in a class field of the instance.\n\n"+
     291        "   Case 5: class-ref  field-name  nil  value:\n"+
     292        "      Stores value in a static field (when value may be\n"+
     293        "      confused with an instance-ref).\n\n"+
     294        "   Case 6: field-name  instance:\n"+
     295        "      Retrieves the value of a field of the instance. The\n"+
     296        "      class is derived from the instance.\n\n"+
     297        "   Case 7: field-name  instance  value:\n"+
     298        "      Stores value in a field of the instance. The class is\n"+
     299        "      derived from the instance.\n\n"
     300        )
    280301    private static final class pf_jfield_raw extends Primitive
    281302    {
    282303        pf_jfield_raw()
    283304        {
    284             super("jfield-raw", PACKAGE_JAVA, true,
    285                   "class-ref-or-field field-or-instance &optional instance value");
     305            super("jfield-raw", PACKAGE_JAVA, true);
    286306        }
    287307
     
    293313    };
    294314
    295     // ### jconstructor class-ref &rest parameter-class-refs
    296315    private static final Primitive JCONSTRUCTOR = new pf_jconstructor();
     316    @DocString(name="jconstructor", args="class-ref &rest parameter-class-refs",
     317    doc="Returns a reference to the Java constructor of CLASS-REF with the" +
     318        " given PARAMETER-CLASS-REFS.")
    297319    private static final class pf_jconstructor extends Primitive
    298320    {
    299321        pf_jconstructor()
    300322        {
    301             super("jconstructor", PACKAGE_JAVA, true,
    302                   "class-ref &rest parameter-class-refs");
     323            super("jconstructor", PACKAGE_JAVA, true);
    303324        }
    304325
     
    343364    };
    344365
    345     // ### jmethod class-ref name &rest parameter-class-refs
    346366    private static final Primitive JMETHOD = new pf_jmethod();
     367
     368    @DocString(name="jmethod", args="class-ref method-name &rest parameter-class-refs",
     369    doc="Returns a reference to the Java method METHOD-NAME of CLASS-REF with the" +
     370        " given PARAMETER-CLASS-REFS.")
    347371    private static final class pf_jmethod extends Primitive
    348372    {
    349373        pf_jmethod()
    350374        {
    351             super("jmethod", PACKAGE_JAVA, true,
    352                   "class-ref name &rest parameter-class-refs");
     375            super("jmethod", PACKAGE_JAVA, true);
    353376        }
    354377
     
    471494    }
    472495
    473     // ### jstatic method class &rest args
    474496    private static final Primitive JSTATIC = new pf_jstatic();
     497    @DocString(name="jstatic", args="method class &rest args",
     498    doc="Invokes the static method METHOD on class CLASS with ARGS.")
    475499    private static final class pf_jstatic extends Primitive
    476500    {
    477501        pf_jstatic()
    478502        {
    479             super("jstatic", PACKAGE_JAVA, true, "method class &rest args");
     503            super("jstatic", PACKAGE_JAVA, true);
    480504        }
    481505
     
    487511    };
    488512
    489     // ### jstatic-raw method class &rest args
    490513    private static final Primitive JSTATIC_RAW = new pf_jstatic_raw();
     514    @DocString(name="jstatic-raw", args="method class &rest args",
     515    doc="Invokes the static method METHOD on class CLASS with ARGS. Does not "+
     516        "attempt to coerce the arguments or result into a Lisp object.")
    491517    private static final class pf_jstatic_raw extends Primitive
    492518    {
    493519        pf_jstatic_raw()
    494520        {
    495             super("jstatic-raw", PACKAGE_JAVA, true,
    496                   "method class &rest args");
     521            super("jstatic-raw", PACKAGE_JAVA, true);
    497522        }
    498523
     
    504529    };
    505530
    506     // ### jnew constructor &rest args
    507531    private static final Primitive JNEW = new pf_jnew();
     532    @DocString(name="jnew", args="constructor &rest args",
     533    doc="Invokes the Java constructor CONSTRUCTOR with the arguments ARGS.")
    508534    private static final class pf_jnew extends Primitive
    509535    {
    510536        pf_jnew()
    511537        {
    512             super("jnew", PACKAGE_JAVA, true, "constructor &rest args");
     538            super("jnew", PACKAGE_JAVA, true);
    513539        }
    514540
     
    524550        constructor = findConstructor(javaClass(classRef), args);
    525551    } else {
    526         constructor = (Constructor) JavaObject.getObject(classRef);
     552        Object object = JavaObject.getObject(classRef);
     553        if(object instanceof Constructor) {
     554      constructor = (Constructor) object;
     555        } else if(object instanceof Class<?>) {
     556      constructor = findConstructor((Class<?>) object, args);
     557        } else {
     558      return error(new LispError(classRef.writeToString() + " is neither a Constructor nor a Class"));
     559        }
    527560    }
    528561                Class[] argTypes = constructor.getParameterTypes();
     
    560593    };
    561594
    562     // ### jnew-array element-type &rest dimensions
    563595    private static final Primitive JNEW_ARRAY = new pf_jnew_array();
     596    @DocString(name="jnew-array", args="element-type &rest dimensions",
     597    doc="Creates a new Java array of type ELEMENT-TYPE, with the given" +
     598        " DIMENSIONS.")
    564599    private static final class pf_jnew_array extends Primitive
    565600    {
    566601        pf_jnew_array()
    567602        {
    568             super("jnew-array", PACKAGE_JAVA, true,
    569                   "element-type &rest dimensions");
     603            super("jnew-array", PACKAGE_JAVA, true);
    570604        }
    571605
     
    618652    }
    619653
    620     // ### jarray-ref java-array &rest indices
    621654    private static final Primitive JARRAY_REF = new pf_jarray_ref();
     655    @DocString(name="jarray-ref", args="java-array &rest indices",
     656    doc="Dereferences the Java array JAVA-ARRAY using the given INDICIES, " +
     657        "coercing the result into a Lisp object, if possible.")
    622658    private static final class pf_jarray_ref extends Primitive
    623659    {
    624660        pf_jarray_ref()
    625661        {
    626             super("jarray-ref", PACKAGE_JAVA, true,
    627                   "java-array &rest indices");
     662            super("jarray-ref", PACKAGE_JAVA, true);
    628663        }
    629664
     
    635670    };
    636671
    637     // ### jarray-ref-raw java-array &rest indices
    638672    private static final Primitive JARRAY_REF_RAW = new pf_jarray_ref_raw();
     673    @DocString(name="jarray-ref-raw", args="java-array &rest indices",
     674    doc="Dereference the Java array JAVA-ARRAY using the given INDICIES. " +
     675        "Does not attempt to coerce the result into a Lisp object.")
    639676    private static final class pf_jarray_ref_raw extends Primitive
    640677    {
    641678        pf_jarray_ref_raw()
    642679        {
    643             super("jarray-ref-raw", PACKAGE_JAVA, true,
    644                   "java-array &rest indices");
     680            super("jarray-ref-raw", PACKAGE_JAVA, true);
    645681        }
    646682
     
    652688    };
    653689
    654     // ### jarray-set java-array new-value &rest indices
    655690    private static final Primitive JARRAY_SET = new pf_jarray_set();
     691    @DocString(name="jarray-set", args="java-array new-value &rest indices",
     692    doc="Stores NEW-VALUE at the given index in JAVA-ARRAY.")
    656693    private static final class pf_jarray_set extends Primitive
    657694    {
    658695        pf_jarray_set()
    659696        {
    660             super("jarray-set", PACKAGE_JAVA, true,
    661                   "java-array new-value &rest indices");
     697            super("jarray-set", PACKAGE_JAVA, true);
    662698        }
    663699
     
    692728    };
    693729
    694     // ### jcall method instance &rest args
    695730    /**  Calls makeLispObject() to convert the result to an appropriate Lisp type. */
    696731    private static final Primitive JCALL = new pf_jcall();
     732    @DocString(name="jcall", args="method-ref instance &rest args",
     733    doc="Invokes the Java method METHOD-REF on INSTANCE with arguments ARGS," +
     734        " coercing the result into a Lisp object, if possible.")
    697735    private static final class pf_jcall extends Primitive
    698736    {
    699737        pf_jcall()
    700738        {
    701             super(Symbol.JCALL, "method-ref instance &rest args");
     739            super(Symbol.JCALL);
    702740        }
    703741
     
    709747    };
    710748
    711     // ### jcall-raw method instance &rest args
    712749    /**
    713750     * Does no type conversion. The result of the call is simply wrapped in a
     
    715752     */
    716753    private static final Primitive JCALL_RAW = new pf_jcall_raw();
     754    @DocString(name="jcall-raw", args="method-ref instance &rest args",
     755    doc="Invokes the Java method METHOD-REF on INSTANCE with arguments ARGS." +
     756        " Does not attempt to coerce the result into a Lisp object.")
    717757    private static final class pf_jcall_raw extends Primitive
    718758    {
    719759        pf_jcall_raw()
    720760        {
    721             super(Symbol.JCALL_RAW, "method-ref instance &rest args");
     761            super(Symbol.JCALL_RAW);
    722762        }
    723763
     
    9771017    }
    9781018
    979     // ### make-immediate-object object &optional type
    9801019    private static final Primitive MAKE_IMMEDIATE_OBJECT = new pf_make_immediate_object();
     1020    @DocString(name="make-immediate-object", args="object &optional type",
     1021    doc="Attempts to coerce a given Lisp object into a java-object of the\n"+
     1022        "given type.  If type is not provided, works as jobject-lisp-value.\n"+
     1023        "Currently, type may be :BOOLEAN, treating the object as a truth value,\n"+
     1024        "or :REF, which returns Java null if NIL is provided.")
    9811025    private static final class pf_make_immediate_object extends Primitive
    9821026    {
    9831027        pf_make_immediate_object()
    9841028        {
    985             super("make-immediate-object", PACKAGE_JAVA, true,
    986                   "object &optional type");
     1029            super("make-immediate-object", PACKAGE_JAVA, true);
    9871030        }
    9881031
     
    10131056    };
    10141057
    1015     // ### java-object-p
    10161058    private static final Primitive JAVA_OBJECT_P = new pf_java_object_p();
     1059    @DocString(name="java-object-p", args="object",
     1060    doc="Returns T if OBJECT is a JAVA-OBJECT.")
    10171061    private static final class pf_java_object_p extends Primitive
    10181062    {
    10191063        pf_java_object_p()
    10201064        {
    1021             super("java-object-p", PACKAGE_JAVA, true, "object");
     1065            super("java-object-p", PACKAGE_JAVA, true);
    10221066        }
    10231067
     
    10291073    };
    10301074
    1031     // ### jobject-lisp-value java-object
    10321075    private static final Primitive JOBJECT_LISP_VALUE = new pf_jobject_lisp_value();
     1076    @DocString(name="jobject-lisp-value", args="java-object",
     1077    doc="Attempts to coerce JAVA-OBJECT into a Lisp object.")
    10331078    private static final class pf_jobject_lisp_value extends Primitive
    10341079    {
     
    10451090    };
    10461091
    1047     // ### jcoerce java-object intended-class
    10481092    private static final Primitive JCOERCE = new pf_jcoerce();
     1093    @DocString(name="jcoerce", args="object intended-class",
     1094    doc="Attempts to coerce OBJECT into a JavaObject of class INTENDED-CLASS." +
     1095        "  Raises a TYPE-ERROR if no conversion is possible.")
    10491096    private static final class pf_jcoerce extends Primitive
    10501097    {
    10511098        pf_jcoerce()
    10521099        {
    1053             super("jcoerce", PACKAGE_JAVA, true, "java-object intended-class");
     1100            super("jcoerce", PACKAGE_JAVA, true);
    10541101        }
    10551102
     
    10671114    };
    10681115
    1069     // ### %jget-property-value java-object property-name
    10701116    private static final Primitive JGET_PROPERTY_VALUE = new pf__jget_property_value();
     1117    @DocString(name="%jget-propety-value", args="java-object property-name",
     1118    doc="Gets a JavaBeans property on JAVA-OBJECT.\n" +
     1119        "SYSTEM-INTERNAL: Use jproperty-value instead.")
    10711120    private static final class pf__jget_property_value extends Primitive
    10721121    {
     
    10961145    };
    10971146   
    1098     // ### %jset-property-value java-object property-name value
    10991147    private static final Primitive JSET_PROPERTY_VALUE = new pf__jset_property_value();
     1148    @DocString(name="%jset-propety-value", args="java-object property-name value",
     1149    doc="Sets a JavaBean property on JAVA-OBJECT.\n" +
     1150        "SYSTEM-INTERNAL: Use (setf jproperty-value) instead.")
    11001151    private static final class pf__jset_property_value extends Primitive
    11011152    {
     
    11321183    };
    11331184
    1134 
    1135     // ### jrun-exception-protected closure
    11361185    private static final Primitive JRUN_EXCEPTION_PROTECTED = new pf_jrun_exception_protection();
     1186    @DocString(name="jrun-exception-protected", args="closure",
     1187    doc="Invokes the function CLOSURE and returns the result.  "+
     1188        "Signals an error if stack or heap exhaustion occurs.")
    11371189    private static final class pf_jrun_exception_protection extends Primitive
    11381190    {
    11391191        pf_jrun_exception_protection()
    11401192        {
    1141             super("jrun-exception-protected", PACKAGE_JAVA, true,
    1142                   "closure");
     1193            super("jrun-exception-protected", PACKAGE_JAVA, true);
    11431194        }
    11441195
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/JavaObject.java

    r12755 r12834  
    9898        if (type == BuiltInClass.JAVA_OBJECT)
    9999            return T;
    100   if(type.typep(LispClass.findClass(JAVA_CLASS, false)) != NIL) {
     100  LispObject cls = NIL;
     101  if(type instanceof Symbol) {
     102      cls = LispClass.findClass(type, false);
     103  }
     104  if(cls == NIL) {
     105      cls = type;
     106  }
     107  if(cls.typep(LispClass.findClass(JAVA_CLASS, false)) != NIL) {
    101108      if(obj != null) {
    102     Class c = (Class) JAVA_CLASS_JCLASS.execute(type).javaInstance();
     109    Class c = (Class) JAVA_CLASS_JCLASS.execute(cls).javaInstance();
    103110    return c.isAssignableFrom(obj.getClass()) ? T : NIL;
    104111      } else {
    105112    return T;
    106113      }
     114  } else if(cls == BuiltInClass.SEQUENCE) {
     115      //This information is replicated here from java.lisp; it is a very
     116      //specific case, not worth implementing CPL traversal in typep
     117      if(java.util.List.class.isInstance(obj) ||
     118         java.util.Set.class.isInstance(obj)) {
     119    return T;
     120      }
    107121  }
    108122        return super.typep(type);
    109123    }
    110 
    111124
    112125    @Override
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Lisp.java

    r12749 r12834  
    9090
    9191
    92   // ### nil
     92  @DocString(name="nil")
    9393  public static final LispObject NIL = Nil.NIL;
    9494
     
    262262  }
    263263
    264   // ### interactive-eval
     264  @DocString(name="interactive-eval")
    265265  private static final Primitive INTERACTIVE_EVAL =
    266266    new Primitive("interactive-eval", PACKAGE_SYS, true)
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/LispObject.java

    r12637 r12834  
    658658          return ((Cons)entry).cdr;
    659659      }
     660    if(docType == Symbol.FUNCTION && this instanceof Symbol) {
     661        Object fn = ((Symbol)this).getSymbolFunction();
     662        if(fn instanceof Function) {
     663            DocString ds = fn.getClass().getAnnotation(DocString.class);
     664            if(ds != null) {
     665                String arglist = ds.args();
     666                String docstring = ds.doc();
     667                if(arglist.length() != 0)
     668                    ((Function)fn).setLambdaList(new SimpleString(arglist));
     669                if(docstring.length() != 0) {
     670                    SimpleString doc = new SimpleString(docstring);
     671                    ((Symbol)this).setDocumentation(Symbol.FUNCTION, doc);
     672                    return doc;
     673                }
     674            }
     675        }
     676    }
    660677    return NIL;
    661678  }
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/LispThread.java

    r12634 r12834  
    861861    }
    862862
    863     // ### make-thread
     863    @DocString(name="make-thread", args="function &optional &key name")
    864864    private static final Primitive MAKE_THREAD =
    865865        new Primitive("make-thread", PACKAGE_THREADS, true, "function &optional &key name")
     
    887887    };
    888888
    889     // ### threadp
     889    @DocString(name="threadp", args="object",
     890    doc="Boolean predicate testing if OBJECT is a thread.")
    890891    private static final Primitive THREADP =
    891         new Primitive("threadp", PACKAGE_THREADS, true, "object",
    892           "Boolean predicate as whether OBJECT is a thread.")
     892        new Primitive("threadp", PACKAGE_THREADS, true)
    893893    {
    894894        @Override
     
    899899    };
    900900
    901     // ### thread-alive-p
     901    @DocString(name="thread-alive-p", args="thread",
     902    doc="Returns T if THREAD is alive.")
    902903    private static final Primitive THREAD_ALIVE_P =
    903904        new Primitive("thread-alive-p", PACKAGE_THREADS, true, "thread",
     
    918919    };
    919920
    920     // ### thread-name
     921    @DocString(name="thread-name", args="thread",
     922    doc="Return the name of THREAD, if it has one.")
    921923    private static final Primitive THREAD_NAME =
    922         new Primitive("thread-name", PACKAGE_THREADS, true, "thread",
    923           "Return the name of THREAD if it has one.")
     924        new Primitive("thread-name", PACKAGE_THREADS, true)
    924925    {
    925926        @Override
     
    973974    }
    974975
    975     // ### sleep
    976     private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true, "seconds",
    977                "Causes the invoking thread to sleep for SECONDS seconds.\nSECONDS may be a value between 0 1and 1.")
     976    @DocString(name="sleep", args="seconds",
     977    doc="Causes the invoking thread to sleep for SECONDS seconds.\n"+
     978        "SECONDS may be a value between 0 1and 1.")
     979    private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true)
    978980    {
    979981        @Override
     
    991993    };
    992994
    993     // ### mapcar-threads
     995    @DocString(name="mapcar-threads", args= "function",
     996    doc="Applies FUNCTION to all existing threads.")
    994997    private static final Primitive MAPCAR_THREADS =
    995         new Primitive("mapcar-threads", PACKAGE_THREADS, true, "function",
    996           "Applies FUNCTION to all existing threads.")
     998        new Primitive("mapcar-threads", PACKAGE_THREADS, true)
    997999    {
    9981000        @Override
     
    10121014    };
    10131015
    1014     // ### destroy-thread
     1016    @DocString(name="destroy-thread", args="thread", doc="Mark THREAD as destroyed")
    10151017    private static final Primitive DESTROY_THREAD =
    1016         new Primitive("destroy-thread", PACKAGE_THREADS, true, "thread",
    1017           "Mark THREAD as destroyed.")
     1018        new Primitive("destroy-thread", PACKAGE_THREADS, true)
    10181019    {
    10191020        @Override
     
    10321033    };
    10331034
    1034     // ### interrupt-thread thread function &rest args => T
    1035     // Interrupts thread and forces it to apply function to args. When the
    1036     // function returns, the thread's original computation continues. If
    1037     // multiple interrupts are queued for a thread, they are all run, but the
    1038     // order is not guaranteed.
     1035    // => T
     1036    @DocString(name="interrupt-thread", args="thread function &rest args",
     1037    doc="Interrupts thread and forces it to apply function to args. When the\n"+
     1038        "function returns, the thread's original computation continues. If\n"+
     1039        "multiple interrupts are queued for a thread, they are all run, but the\n"+
     1040        "order is not guaranteed.")
    10391041    private static final Primitive INTERRUPT_THREAD =
    10401042        new Primitive("interrupt-thread", PACKAGE_THREADS, true,
     
    10631065    };
    10641066
    1065     // ### current-thread
     1067    @DocString(name="current-thread",
     1068    doc="Returns a reference to invoking thread.")
    10661069    private static final Primitive CURRENT_THREAD =
    1067         new Primitive("current-thread", PACKAGE_THREADS, true, "",
    1068           "Returns a reference to invoking thread.")
     1070        new Primitive("current-thread", PACKAGE_THREADS, true)
    10691071    {
    10701072        @Override
     
    10751077    };
    10761078
    1077     // ### backtrace
     1079    @DocString(name="backtrace",
     1080               doc="Returns a backtrace of the invoking thread.")
    10781081    private static final Primitive BACKTRACE =
    1079         new Primitive("backtrace", PACKAGE_SYS, true, "",
    1080           "Returns a backtrace of the invoking thread.")
     1082        new Primitive("backtrace", PACKAGE_SYS, true)
    10811083    {
    10821084        @Override
     
    10901092        }
    10911093    };
    1092     // ### frame-to-string
     1094    @DocString(name="frame-to-string", args="frame")
    10931095    private static final Primitive FRAME_TO_STRING =
    1094         new Primitive("frame-to-string", PACKAGE_SYS, true, "frame")
     1096        new Primitive("frame-to-string", PACKAGE_SYS, true)
    10951097    {
    10961098        @Override
     
    11051107    };
    11061108
    1107     // ### frame-to-list
     1109    @DocString(name="frame-to-list", args="frame")
    11081110    private static final Primitive FRAME_TO_LIST =
    1109         new Primitive("frame-to-list", PACKAGE_SYS, true, "frame")
     1111        new Primitive("frame-to-list", PACKAGE_SYS, true)
    11101112    {
    11111113        @Override
     
    11211123
    11221124
    1123     static {
    1124         //FIXME: this block has been added for pre-0.16 compatibility
    1125         // and can be removed the latest at release 0.22
    1126         PACKAGE_EXT.export(intern("MAKE-THREAD", PACKAGE_THREADS));
    1127         PACKAGE_EXT.export(intern("THREADP", PACKAGE_THREADS));
    1128         PACKAGE_EXT.export(intern("THREAD-ALIVE-P", PACKAGE_THREADS));
    1129         PACKAGE_EXT.export(intern("THREAD-NAME", PACKAGE_THREADS));
    1130         PACKAGE_EXT.export(intern("MAPCAR-THREADS", PACKAGE_THREADS));
    1131         PACKAGE_EXT.export(intern("DESTROY-THREAD", PACKAGE_THREADS));
    1132         PACKAGE_EXT.export(intern("INTERRUPT-THREAD", PACKAGE_THREADS));
    1133         PACKAGE_EXT.export(intern("CURRENT-THREAD", PACKAGE_THREADS));
    1134     }
    1135 
    1136     // ### use-fast-calls
     1125    @DocString(name="use-fast-calls")
    11371126    private static final Primitive USE_FAST_CALLS =
    11381127        new Primitive("use-fast-calls", PACKAGE_SYS, true)
     
    11461135    };
    11471136
    1148     // ### synchronized-on
     1137    @DocString(name="synchronized-on", args="form &body body")
    11491138    private static final SpecialOperator SYNCHRONIZED_ON =
    11501139        new SpecialOperator("synchronized-on", PACKAGE_THREADS, true,
     
    11651154    };
    11661155
    1167     // ### object-wait
     1156    @DocString(name="object-wait", args="object &optional timeout")
    11681157    private static final Primitive OBJECT_WAIT =
    1169         new Primitive("object-wait", PACKAGE_THREADS, true,
    1170                       "object &optional timeout")
     1158        new Primitive("object-wait", PACKAGE_THREADS, true)
    11711159    {
    11721160        @Override
     
    12031191    };
    12041192
    1205     // ### object-notify
     1193    @DocString(name="object-notify", args="object")
    12061194    private static final Primitive OBJECT_NOTIFY =
    12071195        new Primitive("object-notify", PACKAGE_THREADS, true,
     
    12221210    };
    12231211
    1224     // ### object-notify-all
     1212    @DocString(name="object-notify-all", args="object")
    12251213    private static final Primitive OBJECT_NOTIFY_ALL =
    1226         new Primitive("object-notify-all", PACKAGE_THREADS, true,
    1227                       "object")
     1214        new Primitive("object-notify-all", PACKAGE_THREADS, true)
    12281215    {
    12291216        @Override
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Operator.java

    r12288 r12834  
    5454    public final LispObject getLambdaList()
    5555    {
     56        if(lambdaList == null) {
     57            DocString ds = getClass().getAnnotation(DocString.class);
     58            if(ds != null)
     59                lambdaList = new SimpleString(ds.args());
     60        }
    5661        return lambdaList;
    5762    }
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Pathname.java

    r12807 r12834  
    861861        }
    862862        StringBuilder sb = new StringBuilder();
     863
    863864        if (useNamestring) {
    864865            if (printReadably || printEscape) {
     
    878879                sb.append('"');
    879880            }
    880         } else {
    881             final SpecialBindingsMark mark = thread.markSpecialBindings();
    882             thread.bindSpecial(Symbol.PRINT_ESCAPE, T);
    883             try {
    884                 final boolean ANSI_COMPATIBLE = true;
    885                 final String SPACE = " ";
    886                 if (ANSI_COMPATIBLE) {
    887                     sb.append("#P(\"");
    888                 } else {
    889                     sb.append("#P(");
    890 
    891                 }
    892                 if (host != NIL) {
    893                     sb.append(":HOST ");
    894                     sb.append(host.writeToString());
    895                     sb.append(SPACE);
    896                 }
    897                 if (device != NIL) {
    898                     sb.append(":DEVICE ");
    899                     sb.append(device.writeToString());
    900                     sb.append(SPACE);
    901                 }
    902                 if (directory != NIL) {
    903                     sb.append(":DIRECTORY ");
    904                     sb.append(directory.writeToString());
    905                     sb.append(SPACE);
    906                 }
    907                 if (name != NIL) {
    908                     sb.append(":NAME ");
    909                     sb.append(name.writeToString());
    910                     sb.append(SPACE);
    911                 }
    912                 if (type != NIL) {
    913                     sb.append(":TYPE ");
    914                     sb.append(type.writeToString());
    915                     sb.append(SPACE);
    916                 }
    917                 if (version != NIL) {
    918                     sb.append(":VERSION ");
    919                     sb.append(version.writeToString());
    920                     sb.append(SPACE);
    921                 }
    922                 if (sb.charAt(sb.length() - 1) == ' ') { // XXX
    923                     sb.setLength(sb.length() - 1);
    924                 }
    925                 if (ANSI_COMPATIBLE) {
    926                     sb.append(')' + "\"");
    927                 } else {
    928                     sb.append(')');
    929                 }
    930             } finally {
    931                 thread.resetSpecialBindings(mark);
    932             }
    933         }
    934         return sb.toString();
     881            return sb.toString();
     882        }
     883
     884        sb.append("PATHNAME (with no namestring) ");
     885        if (host != NIL) {
     886            sb.append(":HOST ");
     887            sb.append(host.writeToString());
     888            sb.append(" ");
     889        }
     890        if (device != NIL) {
     891            sb.append(":DEVICE ");
     892            sb.append(device.writeToString());
     893            sb.append(" ");
     894        }
     895        if (directory != NIL) {
     896            sb.append(":DIRECTORY ");
     897            sb.append(directory.writeToString());
     898            sb.append(" ");
     899        }
     900        if (name != NIL) {
     901            sb.append(":NAME ");
     902            sb.append(name.writeToString());
     903            sb.append(" ");
     904        }
     905        if (type != NIL) {
     906            sb.append(":TYPE ");
     907            sb.append(type.writeToString());
     908            sb.append(" ");
     909        }
     910        if (version != NIL) {
     911            sb.append(":VERSION ");
     912            sb.append(version.writeToString());
     913            sb.append(" ");
     914        }
     915        if (sb.charAt(sb.length() - 1) == ' ') {
     916            sb.setLength(sb.length() - 1);
     917        }
     918
     919        return unreadableString(sb.toString());
    935920    }
    936921    // A logical host is represented as the string that names it.
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Primitive.java

    r12254 r12834  
    4646    }
    4747
     48    public Primitive(Symbol symbol)
     49    {
     50        super(symbol);
     51    }
     52
    4853    public Primitive(Symbol symbol, String arglist)
    4954    {
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Primitives.java

    r12576 r12834  
    891891            else
    892892                out = second;
    893             checkStream(out)._writeString(first.writeToString());
     893            String output = first.writeToString();
     894            if (Symbol.PRINT_READABLY.symbolValue(LispThread.currentThread()) != NIL
     895                && output.contains("#<")) {
     896                LispObject args = NIL;
     897                args = args.push(first);
     898                args = args.push(Keyword.OBJECT);
     899                args = args.nreverse();
     900                return error(new PrintNotReadable(args));
     901            }
     902            checkStream(out)._writeString(output);
    894903            return first;
    895904        }
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Stream.java

    r12796 r12834  
    535535        LispObject obj = read(true, NIL, false,
    536536                              LispThread.currentThread(), rta);
    537         if (obj instanceof AbstractString)
     537        if (obj instanceof AbstractString) {
    538538            return Pathname.parseNamestring((AbstractString)obj);
     539        }
    539540        if (obj.listp())
    540541            return Pathname.makePathname(obj);
    541         return error(new TypeError("#p requires a string or list argument."));
     542        return error(new TypeError("#p requires a string argument."));
    542543    }
    543544
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/Version.java

    r12670 r12834  
    4242  public static String getVersion()
    4343  {
    44     return "0.21.0-dev";
     44    return "0.22.0-dev";
    4545  }
    46  
     46
    4747  public static void main(String args[]) {
    4848    System.out.println(Version.getVersion());
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/asdf.lisp

    r12796 r12834  
    7171(eval-when (:load-toplevel :compile-toplevel :execute)
    7272  (let* ((asdf-version ;; the 1+ helps the version bumping script discriminate
    73           (subseq "VERSION:2.003" (1+ (length "VERSION")))) ; NB: same as 2.105.
     73          (subseq "VERSION:2.004" (1+ (length "VERSION")))) ; NB: same as 2.111.
    7474         (existing-asdf (find-package :asdf))
    7575         (vername '#:*asdf-version*)
     
    728728#+sbcl (defun get-uid () (sb-unix:unix-getuid))
    729729#+cmu (defun get-uid () (unix:unix-getuid))
    730 #+ecl (ffi:clines "#include <sys/types.h>" "#include <unistd.h>")
    731 #+ecl (defun get-uid () (ffi:c-inline () () :int "getuid()" :one-liner t))
     730#+ecl #.(cl:and (cl:< ext:+ecl-version-number+ 100601)
     731         '(ffi:clines "#include <sys/types.h>" "#include <unistd.h>"))
     732#+ecl (defun get-uid ()
     733        #.(cl:if (cl:< ext:+ecl-version-number+ 100601)
     734            '(ffi:c-inline () () :int "getuid()" :one-liner t)
     735            '(ext::getuid)))
    732736#+allegro (defun get-uid () (excl.osi:getuid))
    733737#-(or cmu sbcl clisp allegro ecl)
     
    10731077(defun system-registered-p (name)
    10741078  (gethash (coerce-name name) *defined-systems*))
     1079
     1080(defun clear-system (name)
     1081  "Clear the entry for a system in the database of systems previously loaded.
     1082Note that this does NOT in any way cause the code of the system to be unloaded."
     1083  ;; There is no "unload" operation in Common Lisp, and a general such operation
     1084  ;; cannot be portably written, considering how much CL relies on side-effects
     1085  ;; of global data structures.
     1086  ;; Note that this does a setf gethash instead of a remhash
     1087  ;; this way there remains a hint in the *defined-systems* table
     1088  ;; that the system was loaded at some point.
     1089  (setf (gethash (coerce-name name) *defined-systems*) nil))
    10751090
    10761091(defun map-systems (fn)
     
    23962411    :java-1.4 :java-1.5 :java-1.6 :java-1.7))
    23972412
     2413
    23982414(defun lisp-version-string ()
    23992415  (let ((s (lisp-implementation-version)))
     
    24112427                       (:+ics ""))
    24122428                      (if (member :64bit *features*) "-64bit" ""))
     2429    #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*)
    24132430    #+clisp (subseq s 0 (position #\space s))
    24142431    #+clozure (format nil "~d.~d-fasl~d"
     
    24252442    #+lispworks (format nil "~A~@[~A~]" s
    24262443                        (when (member :lispworks-64bit *features*) "-64bit"))
    2427     ;; #+sbcl (format nil "~a-fasl~d" s sb-fasl:+fasl-file-version+) ; fasl-f-v is redundant
    2428     #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*)
     2444    ;; #+sbcl (format nil "~a-fasl~d" s sb-fasl:+fasl-file-version+) ; f-f-v redundant w/ version
    24292445    #+(or cormanlisp mcl sbcl scl) s
    24302446    #-(or allegro armedbear clisp clozure cmu cormanlisp digitool
     
    25112527           ;;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Common AppData
    25122528        ,(try (getenv "ALLUSERSPROFILE") "Application Data/common-lisp/config/"))))
    2513     (list #p"/etc/"))))
     2529    (list #p"/etc/common-lisp/"))))
    25142530(defun in-first-directory (dirs x)
    25152531  (loop :for dir :in dirs
     
    29582974
    29592975(defun delete-file-if-exists (x)
    2960   (when (probe-file x)
     2976  (when (and x (probe-file x))
    29612977    (delete-file x)))
    29622978
     
    33553371  (setf (source-registry) (compute-source-registry parameter)))
    33563372
    3357 ;; checks an initial variable to see whether the state is initialized
     3373;; Checks an initial variable to see whether the state is initialized
    33583374;; or cleared. In the former case, return current configuration; in
    33593375;; the latter, initialize.  ASDF will call this function at the start
    3360 ;; of (asdf:find-system).
    3361 (defun ensure-source-registry ()
     3376;; of (asdf:find-system) to make sure the source registry is initialized.
     3377;; However, it will do so *without* a parameter, at which point it
     3378;; will be too late to provide a parameter to this function, though
     3379;; you may override the configuration explicitly by calling
     3380;; initialize-source-registry directly with your parameter.
     3381(defun ensure-source-registry (&optional parameter)
    33623382  (if (source-registry-initialized-p)
    33633383      (source-registry)
    3364       (initialize-source-registry)))
     3384      (initialize-source-registry parameter)))
    33653385
    33663386(defun sysdef-source-registry-search (system)
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/autoloads.lisp

    r12756 r12834  
    346346(export '(make-mutex get-mutex release-mutex with-mutex))
    347347
    348 (progn
    349   ;; block to be removed at 0.22
    350   ;; It exists solely for pre-0.17 compatibility
    351   ;; FIXME 0.22
    352   (in-package "EXTENSIONS")
    353   (export '(mailbox-send mailbox-empty-p mailbox-read mailbox-peek))
    354   (export '(make-thread-lock thread-lock thread-unlock with-thread-lock))
    355   (export '(with-mutex make-mutex get-mutex release-mutex)))
    356 
    357 ;; end of 0.22 block
    358348
    359349(in-package "EXTENSIONS")
     
    429419(in-package "COMMON-LISP")
    430420
     421(sys::autoload '(documentation) "clos")
     422
    431423(sys::autoload '(write print prin1 princ pprint write-to-string
    432424            prin1-to-string princ-to-string write-char
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compile-system.lisp

    r12764 r12834  
    188188                           ;;"j.lisp"
    189189                           "java.lisp"
     190                           "java-collections.lisp"
    190191                           "known-functions.lisp"
    191192                           "known-symbols.lisp"
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/debug.lisp

    r12587 r12834  
    8686    (fresh-line *debug-io*)
    8787    (with-standard-io-syntax
    88       (let ((*print-structure* nil))
     88      (let ((*print-structure* nil)
     89      (*print-readably* nil))
    8990        (when (and *load-truename* (streamp *load-stream*))
    9091          (simple-format *debug-io*
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/java.lisp

    r12796 r12834  
    149149        method implementation)))))
    150150    lisp-this))
     151
     152(defun jequal (obj1 obj2)
     153  "Compares obj1 with obj2 using java.lang.Object.equals()"
     154  (jcall (jmethod "java.lang.Object" "equals" "java.lang.Object")
     155   obj1 obj2))
    151156
    152157(defun jobject-class (obj)
     
    364369             :java-class +java-lang-object+)))
    365370
     371(defun jclass-additional-superclasses (jclass)
     372  "Extension point to put additional CLOS classes on the CPL of a CLOS Java class."
     373  (let ((supers nil))
     374    (when (jclass-interface-p jclass)
     375      (push (find-class 'java-object) supers))
     376    (when (jequal jclass (jclass "java.util.List"))
     377      (push (find-class 'sequence) supers))
     378    supers))
     379
    366380(defun ensure-java-class (jclass)
    367381  (let ((class (%find-java-class jclass)))
     
    379393                 (list (jclass-superclass jclass))
    380394                 (jclass-interfaces jclass))))))
    381        (if (jclass-interface-p jclass)
    382            (append supers (list (find-class 'java-object)))
    383            supers))
     395       (append supers (jclass-additional-superclasses jclass)))
    384396     :java-class jclass)))))
    385397
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/logorc2.java

    r12288 r12834  
    3838import java.math.BigInteger;
    3939
    40 // ### logorc2
    4140// logorc2 integer-1 integer-2 => result-integer
    4241// or integer-1 with complement of integer-2
     42@DocString(name="logorc2", args="integer-1 integer-2")
    4343public final class logorc2 extends Primitive
    4444{
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/package_error_package.java

    r12288 r12834  
    3636import static org.armedbear.lisp.Lisp.*;
    3737
    38 // ### package-error-package
     38@DocString(name="package-error-package")
    3939public final class package_error_package extends Primitive
    4040{
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/print.lisp

    r12390 r12834  
    281281
    282282(defun %print-object (object stream)
     283  (when (and *print-readably*
     284             (typep object 'string)
     285             (search "#<" object))
     286    (error 'print-not-readable :object object))
    283287  (if *print-pretty*
    284288      (xp::output-pretty-object object stream)
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/threads.lisp

    r12587 r12834  
    11;;; threads.lisp
    22;;;
    3 ;;; Copyright (C) 2009 Erik Huelsmann <ehuelsmann@common-lisp.net>
     3;;; Copyright (C) 2009-2010 Erik Huelsmann <ehuelsmann@common-lisp.net>
    44;;;
    55;;; $Id$
     
    143143          ,@body))))
    144144
    145 (defun thread-lock (lock)
    146   "Deprecated; due for removal in 0.22"
    147   (declare (ignore lock)))
    148 (defun thread-unlock (lock)
    149   "Deprecated; due for removal in 0.22"
    150   (declare (ignore lock)))
  • branches/generic-class-file/abcl/test/lisp/ansi/package.lisp

    r12618 r12834  
    3333    (format t "Invoking ABCL hosted on ~A ~A.~%"
    3434      (software-type) (software-version))
    35     (if (find :unix *features*)
    36         (run-shell-command "cd ~A; make clean" ansi-tests-directory)
    37         ;; XXX -- what to invoke on win32?  Untested:
    38         (run-shell-command
    39          (format nil "~A~%~A"
    40            (format nil "cd ~A" *ansi-tests-directory*)
    41            (format nil "erase *.cls *.abcl"))))
     35          ;; Do what 'make clean' would do from the GCL ANSI tests,
     36          ;; so we don't have to hunt for 'make' on win32.
     37          (mapcar #'delete-file
     38                  (append (directory (format nil "~A/*.cls" *default-pathname-defaults*))
     39                          (directory (format nil "~A/*.abcl" *default-pathname-defaults*))
     40                          (directory (format nil "~A/scratch/*" *default-pathname-defaults*))
     41                          (mapcar (lambda(x) (format nil "~A/~A" *default-pathname-defaults* x))
     42                                  '("scratch/"
     43                                    "scratch.txt" "foo.txt" "foo.lsp"
     44                                    "foo.dat"
     45                                    "tmp.txt" "tmp.dat" "tmp2.dat"
     46                                    "temp.dat" "out.class"
     47                                    "file-that-was-renamed.txt"
     48                                    "compile-file-test-lp.lsp"
     49                                    "compile-file-test-lp.out"
     50                                    "ldtest.lsp"))))
    4251    (time (load boot-file))
    4352    (format t "<--- ~A ends.~%" message))
  • branches/generic-class-file/abcl/test/lisp/ansi/parse-ansi-errors.lisp

    r12509 r12834  
    7575
    7676(defvar *default-database-file*
    77   (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*)))
     77  (if (find :asdf2 *features*)
     78      (asdf:system-relative-pathname :ansi-compiled "test/lisp/ansi/ansi-test-failures")
     79      (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*)))
    7880
    7981(defun parse (&optional (file *default-database-file*))
Note: See TracChangeset for help on using the changeset viewer.