Changeset 12834
- Timestamp:
- 07/29/10 19:38:25 (13 years ago)
- Location:
- branches/generic-class-file/abcl
- Files:
-
- 27 edited
- 2 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/generic-class-file/abcl/CHANGES
r12687 r12834 1 Version 0.21 2 ============ 3 svn://common-lisp.net/project/armedbear/svn/tags/0.21.0/abcl 4 (???, 2010) 5 6 7 Features 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 22 Fixes 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 33 Other 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 1 40 Version 0.20 2 41 ============ 3 yet-to-be-tagged 4 ( ???)42 svn://common-lisp.net/project/armedbear/svn/tags/0.20.0/abcl 43 (24 May, 2010) 5 44 6 45 -
branches/generic-class-file/abcl/build.xml
r12750 r12834 446 446 447 447 <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"/> 449 451 <arg value="--regex=|[ \t]+//[ \t]+###[ \t]+\([^ \t]+\)|\1|"/> 452 <arg value='--regex=|[ \t]*@DocString([ \t]*name=\"\([^\"]*\)|\1|'/> 450 453 <fileset dir="${src.dir}"> 451 454 <patternset refid="abcl.source.java"/> -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Condition.java
r12576 r12834 105 105 public final LispObject getFormatControl() 106 106 { 107 return getInstanceSlotValue(Symbol.FORMAT_CONTROL);107 return getInstanceSlotValue(Symbol.FORMAT_CONTROL); 108 108 } 109 109 … … 136 136 public String getMessage() 137 137 { 138 return getFormatControl().toString(); 138 LispObject formatControl = getFormatControl(); 139 return formatControl != UNBOUND_VALUE ? formatControl.writeToString() : null; 139 140 } 140 141 -
branches/generic-class-file/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java
r12481 r12834 77 77 } 78 78 79 // ### make-forward-referenced-class79 @DocString(name="make-forward-referenced=class") 80 80 private static final Primitive MAKE_FORWARD_REFERENCED_CLASS = 81 81 new Primitive("make-forward-referenced-class", PACKAGE_SYS, true) -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Function.java
r12796 r12834 54 54 public Function(String name) 55 55 { 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)); 57 64 if (name != null) { 58 65 Symbol symbol = Symbol.addFunction(name.toUpperCase(), this); … … 63 70 } 64 71 72 public Function(Symbol symbol) 73 { 74 this(symbol, null, null); 75 } 76 65 77 public Function(Symbol symbol, String arglist) 78 { 79 this(symbol, arglist, null); 80 } 81 82 public Function(Symbol symbol, String arglist, String docstring) 66 83 { 67 84 this(); … … 70 87 symbol.setBuiltInFunction(true); 71 88 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) 84 92 symbol.setDocumentation(Symbol.FUNCTION, 85 93 new SimpleString(docstring)); 86 }87 }88 89 public Function(String name, String arglist)90 {91 this(name);92 setLambdaList(new SimpleString(arglist));93 94 } 94 95 -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Java.java
r12715 r12834 61 61 62 62 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.") 63 65 private static final class pf_ensure_java_object extends Primitive 64 66 { 65 67 pf_ensure_java_object() 66 68 { 67 super("ensure-java-object", PACKAGE_JAVA, true , "obj");69 super("ensure-java-object", PACKAGE_JAVA, true); 68 70 } 69 71 … … 74 76 }; 75 77 76 // ### register-java-exception exception-name condition-symbol => T77 78 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.") 78 83 private static final class pf_register_java_exception extends Primitive 79 84 { 80 85 pf_register_java_exception() 81 86 { 82 super("register-java-exception", PACKAGE_JAVA, true, 83 "exception-name condition-symbol"); 87 super("register-java-exception", PACKAGE_JAVA, true); 84 88 } 85 89 … … 99 103 }; 100 104 101 // ### unregister-java-exception exception-name => T or NIL102 105 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.") 103 109 private static final class pf_unregister_java_exception extends Primitive 104 110 { 105 111 pf_unregister_java_exception() 106 112 { 107 super("unregister-java-exception", PACKAGE_JAVA, true, 108 "exception-name"); 113 super("unregister-java-exception", PACKAGE_JAVA, true); 109 114 } 110 115 … … 130 135 } 131 136 132 // ### jclass name-or-class-ref &optional class-loader => class-ref133 137 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.") 134 142 private static final class pf_jclass extends Primitive 135 143 { … … 137 145 pf_jclass() 138 146 { 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); 141 148 } 142 149 … … 154 161 } 155 162 }; 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 be175 // confused with an instance-ref).176 //177 // Case 6: field-name instance:178 // to retrieve the value of a field of the instance. The179 // 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 is183 // derived from the instance.184 //185 163 186 164 static final LispObject jfield(Primitive fun, LispObject[] args, boolean translate) … … 259 237 } 260 238 261 // ### jfield class-ref-or-field field-or-instance &optional instance value 239 262 240 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 ) 263 263 private static final class pf_jfield extends Primitive 264 264 { 265 265 pf_jfield() 266 266 { 267 super("jfield", PACKAGE_JAVA, true, 268 "class-ref-or-field field-or-instance &optional instance value"); 267 super("jfield", PACKAGE_JAVA, true); 269 268 } 270 269 … … 276 275 }; 277 276 278 // ### jfield-raw - retrieve or modify a field in a Java class or instance.279 277 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 ) 280 301 private static final class pf_jfield_raw extends Primitive 281 302 { 282 303 pf_jfield_raw() 283 304 { 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); 286 306 } 287 307 … … 293 313 }; 294 314 295 // ### jconstructor class-ref &rest parameter-class-refs296 315 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.") 297 319 private static final class pf_jconstructor extends Primitive 298 320 { 299 321 pf_jconstructor() 300 322 { 301 super("jconstructor", PACKAGE_JAVA, true, 302 "class-ref &rest parameter-class-refs"); 323 super("jconstructor", PACKAGE_JAVA, true); 303 324 } 304 325 … … 343 364 }; 344 365 345 // ### jmethod class-ref name &rest parameter-class-refs346 366 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.") 347 371 private static final class pf_jmethod extends Primitive 348 372 { 349 373 pf_jmethod() 350 374 { 351 super("jmethod", PACKAGE_JAVA, true, 352 "class-ref name &rest parameter-class-refs"); 375 super("jmethod", PACKAGE_JAVA, true); 353 376 } 354 377 … … 471 494 } 472 495 473 // ### jstatic method class &rest args474 496 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.") 475 499 private static final class pf_jstatic extends Primitive 476 500 { 477 501 pf_jstatic() 478 502 { 479 super("jstatic", PACKAGE_JAVA, true , "method class &rest args");503 super("jstatic", PACKAGE_JAVA, true); 480 504 } 481 505 … … 487 511 }; 488 512 489 // ### jstatic-raw method class &rest args490 513 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.") 491 517 private static final class pf_jstatic_raw extends Primitive 492 518 { 493 519 pf_jstatic_raw() 494 520 { 495 super("jstatic-raw", PACKAGE_JAVA, true, 496 "method class &rest args"); 521 super("jstatic-raw", PACKAGE_JAVA, true); 497 522 } 498 523 … … 504 529 }; 505 530 506 // ### jnew constructor &rest args507 531 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.") 508 534 private static final class pf_jnew extends Primitive 509 535 { 510 536 pf_jnew() 511 537 { 512 super("jnew", PACKAGE_JAVA, true , "constructor &rest args");538 super("jnew", PACKAGE_JAVA, true); 513 539 } 514 540 … … 524 550 constructor = findConstructor(javaClass(classRef), args); 525 551 } 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 } 527 560 } 528 561 Class[] argTypes = constructor.getParameterTypes(); … … 560 593 }; 561 594 562 // ### jnew-array element-type &rest dimensions563 595 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.") 564 599 private static final class pf_jnew_array extends Primitive 565 600 { 566 601 pf_jnew_array() 567 602 { 568 super("jnew-array", PACKAGE_JAVA, true, 569 "element-type &rest dimensions"); 603 super("jnew-array", PACKAGE_JAVA, true); 570 604 } 571 605 … … 618 652 } 619 653 620 // ### jarray-ref java-array &rest indices621 654 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.") 622 658 private static final class pf_jarray_ref extends Primitive 623 659 { 624 660 pf_jarray_ref() 625 661 { 626 super("jarray-ref", PACKAGE_JAVA, true, 627 "java-array &rest indices"); 662 super("jarray-ref", PACKAGE_JAVA, true); 628 663 } 629 664 … … 635 670 }; 636 671 637 // ### jarray-ref-raw java-array &rest indices638 672 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.") 639 676 private static final class pf_jarray_ref_raw extends Primitive 640 677 { 641 678 pf_jarray_ref_raw() 642 679 { 643 super("jarray-ref-raw", PACKAGE_JAVA, true, 644 "java-array &rest indices"); 680 super("jarray-ref-raw", PACKAGE_JAVA, true); 645 681 } 646 682 … … 652 688 }; 653 689 654 // ### jarray-set java-array new-value &rest indices655 690 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.") 656 693 private static final class pf_jarray_set extends Primitive 657 694 { 658 695 pf_jarray_set() 659 696 { 660 super("jarray-set", PACKAGE_JAVA, true, 661 "java-array new-value &rest indices"); 697 super("jarray-set", PACKAGE_JAVA, true); 662 698 } 663 699 … … 692 728 }; 693 729 694 // ### jcall method instance &rest args695 730 /** Calls makeLispObject() to convert the result to an appropriate Lisp type. */ 696 731 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.") 697 735 private static final class pf_jcall extends Primitive 698 736 { 699 737 pf_jcall() 700 738 { 701 super(Symbol.JCALL , "method-ref instance &rest args");739 super(Symbol.JCALL); 702 740 } 703 741 … … 709 747 }; 710 748 711 // ### jcall-raw method instance &rest args712 749 /** 713 750 * Does no type conversion. The result of the call is simply wrapped in a … … 715 752 */ 716 753 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.") 717 757 private static final class pf_jcall_raw extends Primitive 718 758 { 719 759 pf_jcall_raw() 720 760 { 721 super(Symbol.JCALL_RAW , "method-ref instance &rest args");761 super(Symbol.JCALL_RAW); 722 762 } 723 763 … … 977 1017 } 978 1018 979 // ### make-immediate-object object &optional type980 1019 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.") 981 1025 private static final class pf_make_immediate_object extends Primitive 982 1026 { 983 1027 pf_make_immediate_object() 984 1028 { 985 super("make-immediate-object", PACKAGE_JAVA, true, 986 "object &optional type"); 1029 super("make-immediate-object", PACKAGE_JAVA, true); 987 1030 } 988 1031 … … 1013 1056 }; 1014 1057 1015 // ### java-object-p1016 1058 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.") 1017 1061 private static final class pf_java_object_p extends Primitive 1018 1062 { 1019 1063 pf_java_object_p() 1020 1064 { 1021 super("java-object-p", PACKAGE_JAVA, true , "object");1065 super("java-object-p", PACKAGE_JAVA, true); 1022 1066 } 1023 1067 … … 1029 1073 }; 1030 1074 1031 // ### jobject-lisp-value java-object1032 1075 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.") 1033 1078 private static final class pf_jobject_lisp_value extends Primitive 1034 1079 { … … 1045 1090 }; 1046 1091 1047 // ### jcoerce java-object intended-class1048 1092 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.") 1049 1096 private static final class pf_jcoerce extends Primitive 1050 1097 { 1051 1098 pf_jcoerce() 1052 1099 { 1053 super("jcoerce", PACKAGE_JAVA, true , "java-object intended-class");1100 super("jcoerce", PACKAGE_JAVA, true); 1054 1101 } 1055 1102 … … 1067 1114 }; 1068 1115 1069 // ### %jget-property-value java-object property-name1070 1116 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.") 1071 1120 private static final class pf__jget_property_value extends Primitive 1072 1121 { … … 1096 1145 }; 1097 1146 1098 // ### %jset-property-value java-object property-name value1099 1147 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.") 1100 1151 private static final class pf__jset_property_value extends Primitive 1101 1152 { … … 1132 1183 }; 1133 1184 1134 1135 // ### jrun-exception-protected closure1136 1185 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.") 1137 1189 private static final class pf_jrun_exception_protection extends Primitive 1138 1190 { 1139 1191 pf_jrun_exception_protection() 1140 1192 { 1141 super("jrun-exception-protected", PACKAGE_JAVA, true, 1142 "closure"); 1193 super("jrun-exception-protected", PACKAGE_JAVA, true); 1143 1194 } 1144 1195 -
branches/generic-class-file/abcl/src/org/armedbear/lisp/JavaObject.java
r12755 r12834 98 98 if (type == BuiltInClass.JAVA_OBJECT) 99 99 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) { 101 108 if(obj != null) { 102 Class c = (Class) JAVA_CLASS_JCLASS.execute( type).javaInstance();109 Class c = (Class) JAVA_CLASS_JCLASS.execute(cls).javaInstance(); 103 110 return c.isAssignableFrom(obj.getClass()) ? T : NIL; 104 111 } else { 105 112 return T; 106 113 } 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 } 107 121 } 108 122 return super.typep(type); 109 123 } 110 111 124 112 125 @Override -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Lisp.java
r12749 r12834 90 90 91 91 92 // ### nil92 @DocString(name="nil") 93 93 public static final LispObject NIL = Nil.NIL; 94 94 … … 262 262 } 263 263 264 // ### interactive-eval264 @DocString(name="interactive-eval") 265 265 private static final Primitive INTERACTIVE_EVAL = 266 266 new Primitive("interactive-eval", PACKAGE_SYS, true) -
branches/generic-class-file/abcl/src/org/armedbear/lisp/LispObject.java
r12637 r12834 658 658 return ((Cons)entry).cdr; 659 659 } 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 } 660 677 return NIL; 661 678 } -
branches/generic-class-file/abcl/src/org/armedbear/lisp/LispThread.java
r12634 r12834 861 861 } 862 862 863 // ### make-thread863 @DocString(name="make-thread", args="function &optional &key name") 864 864 private static final Primitive MAKE_THREAD = 865 865 new Primitive("make-thread", PACKAGE_THREADS, true, "function &optional &key name") … … 887 887 }; 888 888 889 // ### threadp 889 @DocString(name="threadp", args="object", 890 doc="Boolean predicate testing if OBJECT is a thread.") 890 891 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) 893 893 { 894 894 @Override … … 899 899 }; 900 900 901 // ### thread-alive-p 901 @DocString(name="thread-alive-p", args="thread", 902 doc="Returns T if THREAD is alive.") 902 903 private static final Primitive THREAD_ALIVE_P = 903 904 new Primitive("thread-alive-p", PACKAGE_THREADS, true, "thread", … … 918 919 }; 919 920 920 // ### thread-name 921 @DocString(name="thread-name", args="thread", 922 doc="Return the name of THREAD, if it has one.") 921 923 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) 924 925 { 925 926 @Override … … 973 974 } 974 975 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) 978 980 { 979 981 @Override … … 991 993 }; 992 994 993 // ### mapcar-threads 995 @DocString(name="mapcar-threads", args= "function", 996 doc="Applies FUNCTION to all existing threads.") 994 997 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) 997 999 { 998 1000 @Override … … 1012 1014 }; 1013 1015 1014 // ### destroy-thread1016 @DocString(name="destroy-thread", args="thread", doc="Mark THREAD as destroyed") 1015 1017 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) 1018 1019 { 1019 1020 @Override … … 1032 1033 }; 1033 1034 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.") 1039 1041 private static final Primitive INTERRUPT_THREAD = 1040 1042 new Primitive("interrupt-thread", PACKAGE_THREADS, true, … … 1063 1065 }; 1064 1066 1065 // ### current-thread 1067 @DocString(name="current-thread", 1068 doc="Returns a reference to invoking thread.") 1066 1069 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) 1069 1071 { 1070 1072 @Override … … 1075 1077 }; 1076 1078 1077 // ### backtrace 1079 @DocString(name="backtrace", 1080 doc="Returns a backtrace of the invoking thread.") 1078 1081 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) 1081 1083 { 1082 1084 @Override … … 1090 1092 } 1091 1093 }; 1092 // ### frame-to-string1094 @DocString(name="frame-to-string", args="frame") 1093 1095 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) 1095 1097 { 1096 1098 @Override … … 1105 1107 }; 1106 1108 1107 // ### frame-to-list1109 @DocString(name="frame-to-list", args="frame") 1108 1110 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) 1110 1112 { 1111 1113 @Override … … 1121 1123 1122 1124 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") 1137 1126 private static final Primitive USE_FAST_CALLS = 1138 1127 new Primitive("use-fast-calls", PACKAGE_SYS, true) … … 1146 1135 }; 1147 1136 1148 // ### synchronized-on1137 @DocString(name="synchronized-on", args="form &body body") 1149 1138 private static final SpecialOperator SYNCHRONIZED_ON = 1150 1139 new SpecialOperator("synchronized-on", PACKAGE_THREADS, true, … … 1165 1154 }; 1166 1155 1167 // ### object-wait1156 @DocString(name="object-wait", args="object &optional timeout") 1168 1157 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) 1171 1159 { 1172 1160 @Override … … 1203 1191 }; 1204 1192 1205 // ### object-notify1193 @DocString(name="object-notify", args="object") 1206 1194 private static final Primitive OBJECT_NOTIFY = 1207 1195 new Primitive("object-notify", PACKAGE_THREADS, true, … … 1222 1210 }; 1223 1211 1224 // ### object-notify-all1212 @DocString(name="object-notify-all", args="object") 1225 1213 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) 1228 1215 { 1229 1216 @Override -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Operator.java
r12288 r12834 54 54 public final LispObject getLambdaList() 55 55 { 56 if(lambdaList == null) { 57 DocString ds = getClass().getAnnotation(DocString.class); 58 if(ds != null) 59 lambdaList = new SimpleString(ds.args()); 60 } 56 61 return lambdaList; 57 62 } -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Pathname.java
r12807 r12834 861 861 } 862 862 StringBuilder sb = new StringBuilder(); 863 863 864 if (useNamestring) { 864 865 if (printReadably || printEscape) { … … 878 879 sb.append('"'); 879 880 } 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()); 935 920 } 936 921 // A logical host is represented as the string that names it. -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Primitive.java
r12254 r12834 46 46 } 47 47 48 public Primitive(Symbol symbol) 49 { 50 super(symbol); 51 } 52 48 53 public Primitive(Symbol symbol, String arglist) 49 54 { -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Primitives.java
r12576 r12834 891 891 else 892 892 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); 894 903 return first; 895 904 } -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Stream.java
r12796 r12834 535 535 LispObject obj = read(true, NIL, false, 536 536 LispThread.currentThread(), rta); 537 if (obj instanceof AbstractString) 537 if (obj instanceof AbstractString) { 538 538 return Pathname.parseNamestring((AbstractString)obj); 539 } 539 540 if (obj.listp()) 540 541 return Pathname.makePathname(obj); 541 return error(new TypeError("#p requires a string or listargument."));542 return error(new TypeError("#p requires a string argument.")); 542 543 } 543 544 -
branches/generic-class-file/abcl/src/org/armedbear/lisp/Version.java
r12670 r12834 42 42 public static String getVersion() 43 43 { 44 return "0.2 1.0-dev";44 return "0.22.0-dev"; 45 45 } 46 46 47 47 public static void main(String args[]) { 48 48 System.out.println(Version.getVersion()); -
branches/generic-class-file/abcl/src/org/armedbear/lisp/asdf.lisp
r12796 r12834 71 71 (eval-when (:load-toplevel :compile-toplevel :execute) 72 72 (let* ((asdf-version ;; the 1+ helps the version bumping script discriminate 73 (subseq "VERSION:2.00 3" (1+ (length "VERSION")))) ; NB: same as 2.105.73 (subseq "VERSION:2.004" (1+ (length "VERSION")))) ; NB: same as 2.111. 74 74 (existing-asdf (find-package :asdf)) 75 75 (vername '#:*asdf-version*) … … 728 728 #+sbcl (defun get-uid () (sb-unix:unix-getuid)) 729 729 #+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))) 732 736 #+allegro (defun get-uid () (excl.osi:getuid)) 733 737 #-(or cmu sbcl clisp allegro ecl) … … 1073 1077 (defun system-registered-p (name) 1074 1078 (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. 1082 Note 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)) 1075 1090 1076 1091 (defun map-systems (fn) … … 2396 2411 :java-1.4 :java-1.5 :java-1.6 :java-1.7)) 2397 2412 2413 2398 2414 (defun lisp-version-string () 2399 2415 (let ((s (lisp-implementation-version))) … … 2411 2427 (:+ics "")) 2412 2428 (if (member :64bit *features*) "-64bit" "")) 2429 #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*) 2413 2430 #+clisp (subseq s 0 (position #\space s)) 2414 2431 #+clozure (format nil "~d.~d-fasl~d" … … 2425 2442 #+lispworks (format nil "~A~@[~A~]" s 2426 2443 (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 2429 2445 #+(or cormanlisp mcl sbcl scl) s 2430 2446 #-(or allegro armedbear clisp clozure cmu cormanlisp digitool … … 2511 2527 ;;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Common AppData 2512 2528 ,(try (getenv "ALLUSERSPROFILE") "Application Data/common-lisp/config/")))) 2513 (list #p"/etc/ "))))2529 (list #p"/etc/common-lisp/")))) 2514 2530 (defun in-first-directory (dirs x) 2515 2531 (loop :for dir :in dirs … … 2958 2974 2959 2975 (defun delete-file-if-exists (x) 2960 (when ( probe-file x)2976 (when (and x (probe-file x)) 2961 2977 (delete-file x))) 2962 2978 … … 3355 3371 (setf (source-registry) (compute-source-registry parameter))) 3356 3372 3357 ;; checks an initial variable to see whether the state is initialized3373 ;; Checks an initial variable to see whether the state is initialized 3358 3374 ;; or cleared. In the former case, return current configuration; in 3359 3375 ;; 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) 3362 3382 (if (source-registry-initialized-p) 3363 3383 (source-registry) 3364 (initialize-source-registry )))3384 (initialize-source-registry parameter))) 3365 3385 3366 3386 (defun sysdef-source-registry-search (system) -
branches/generic-class-file/abcl/src/org/armedbear/lisp/autoloads.lisp
r12756 r12834 346 346 (export '(make-mutex get-mutex release-mutex with-mutex)) 347 347 348 (progn349 ;; block to be removed at 0.22350 ;; It exists solely for pre-0.17 compatibility351 ;; FIXME 0.22352 (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 block358 348 359 349 (in-package "EXTENSIONS") … … 429 419 (in-package "COMMON-LISP") 430 420 421 (sys::autoload '(documentation) "clos") 422 431 423 (sys::autoload '(write print prin1 princ pprint write-to-string 432 424 prin1-to-string princ-to-string write-char -
branches/generic-class-file/abcl/src/org/armedbear/lisp/compile-system.lisp
r12764 r12834 188 188 ;;"j.lisp" 189 189 "java.lisp" 190 "java-collections.lisp" 190 191 "known-functions.lisp" 191 192 "known-symbols.lisp" -
branches/generic-class-file/abcl/src/org/armedbear/lisp/debug.lisp
r12587 r12834 86 86 (fresh-line *debug-io*) 87 87 (with-standard-io-syntax 88 (let ((*print-structure* nil)) 88 (let ((*print-structure* nil) 89 (*print-readably* nil)) 89 90 (when (and *load-truename* (streamp *load-stream*)) 90 91 (simple-format *debug-io* -
branches/generic-class-file/abcl/src/org/armedbear/lisp/java.lisp
r12796 r12834 149 149 method implementation))))) 150 150 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)) 151 156 152 157 (defun jobject-class (obj) … … 364 369 :java-class +java-lang-object+))) 365 370 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 366 380 (defun ensure-java-class (jclass) 367 381 (let ((class (%find-java-class jclass))) … … 379 393 (list (jclass-superclass jclass)) 380 394 (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))) 384 396 :java-class jclass))))) 385 397 -
branches/generic-class-file/abcl/src/org/armedbear/lisp/logorc2.java
r12288 r12834 38 38 import java.math.BigInteger; 39 39 40 // ### logorc241 40 // logorc2 integer-1 integer-2 => result-integer 42 41 // or integer-1 with complement of integer-2 42 @DocString(name="logorc2", args="integer-1 integer-2") 43 43 public final class logorc2 extends Primitive 44 44 { -
branches/generic-class-file/abcl/src/org/armedbear/lisp/package_error_package.java
r12288 r12834 36 36 import static org.armedbear.lisp.Lisp.*; 37 37 38 // ### package-error-package 38 @DocString(name="package-error-package") 39 39 public final class package_error_package extends Primitive 40 40 { -
branches/generic-class-file/abcl/src/org/armedbear/lisp/print.lisp
r12390 r12834 281 281 282 282 (defun %print-object (object stream) 283 (when (and *print-readably* 284 (typep object 'string) 285 (search "#<" object)) 286 (error 'print-not-readable :object object)) 283 287 (if *print-pretty* 284 288 (xp::output-pretty-object object stream) -
branches/generic-class-file/abcl/src/org/armedbear/lisp/threads.lisp
r12587 r12834 1 1 ;;; threads.lisp 2 2 ;;; 3 ;;; Copyright (C) 2009 Erik Huelsmann <ehuelsmann@common-lisp.net>3 ;;; Copyright (C) 2009-2010 Erik Huelsmann <ehuelsmann@common-lisp.net> 4 4 ;;; 5 5 ;;; $Id$ … … 143 143 ,@body)))) 144 144 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 33 33 (format t "Invoking ABCL hosted on ~A ~A.~%" 34 34 (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")))) 42 51 (time (load boot-file)) 43 52 (format t "<--- ~A ends.~%" message)) -
branches/generic-class-file/abcl/test/lisp/ansi/parse-ansi-errors.lisp
r12509 r12834 75 75 76 76 (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*))) 78 80 79 81 (defun parse (&optional (file *default-database-file*))
Note: See TracChangeset
for help on using the changeset viewer.