[armedbear-cvs] r12382 - branches/0.18.x/abcl/src/org/armedbear/lisp

[Ville Voutilainen]

Author: vvoutilainen
Date: Sun Jan 17 15:53:21 2010
New Revision: 12382

Log:
Backport r12376-r12379 and r12381. This fixes maxima,
adds support for disassembling proxied functions, and
adds fixes to printing java objects.


Modified:
   branches/0.18.x/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java
   branches/0.18.x/abcl/src/org/armedbear/lisp/JavaClass.java
   branches/0.18.x/abcl/src/org/armedbear/lisp/LispStackFrame.java
   branches/0.18.x/abcl/src/org/armedbear/lisp/print-object.lisp

Modified: branches/0.18.x/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java
==============================================================================
--- branches/0.18.x/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java	(original)
+++ branches/0.18.x/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java	Sun Jan 17 15:53:21 2010
@@ -81,6 +81,7 @@
         return load();
     }
 
+
     final private synchronized Function load() {
         if (fun != null)
             return fun;
@@ -91,6 +92,14 @@
         for (int i = 0; i < symsToSave.length; i++)
             thread.bindSpecial(symsToSave[i], savedSyms[i]);
 
+        // set a specific reader environment, because we may be triggered in
+        // any undefined dynamic environment; we want something predictable
+        thread.bindSpecial(Symbol.READ_SUPPRESS, NIL);
+        thread.bindSpecial(Symbol.READ_EVAL, T);
+        thread.bindSpecial(Symbol.READ_BASE, LispInteger.getInstance(10));
+        // don't need to bind *READ-DEFAULT-FLOAT-FORMAT*,
+        // because DUMP-FORM sets it to NIL, forcing exponent markers everywhere
+
         byte[] classbytes =
             (byte[])((Hashtable)cache.javaInstance()).get(name);
         try {
@@ -275,7 +284,8 @@
 
             fun = new AutoloadedFunctionProxy(sym, name, cache,
                                               cachedSyms, fType);
-
+            fun.setClassBytes((byte[])((Hashtable)cache.javaInstance())
+                              .get(name.getStringValue()));
         }
 
         return fun;

Modified: branches/0.18.x/abcl/src/org/armedbear/lisp/JavaClass.java
==============================================================================
--- branches/0.18.x/abcl/src/org/armedbear/lisp/JavaClass.java	(original)
+++ branches/0.18.x/abcl/src/org/armedbear/lisp/JavaClass.java	Sun Jan 17 15:53:21 2010
@@ -40,8 +40,9 @@
 	private static final Map<Class<?>, JavaClass> cache = new HashMap<Class<?>, JavaClass>();
 
 	private JavaClass(Class<?> javaClass) {
-		this.javaClass = javaClass;
-		setDirectSuperclass(BuiltInClass.JAVA_OBJECT);
+	    super(new Symbol(javaClass.getCanonicalName()));
+	    this.javaClass = javaClass;
+	    setDirectSuperclass(BuiltInClass.JAVA_OBJECT);
 	}
 
 	private void initCPL() {

Modified: branches/0.18.x/abcl/src/org/armedbear/lisp/LispStackFrame.java
==============================================================================
--- branches/0.18.x/abcl/src/org/armedbear/lisp/LispStackFrame.java	(original)
+++ branches/0.18.x/abcl/src/org/armedbear/lisp/LispStackFrame.java	Sun Jan 17 15:53:21 2010
@@ -119,8 +119,7 @@
      String result = "";
      final String LISP_STACK_FRAME = "LISP-STACK-FRAME";
      try {
-       result =  unreadableString(LISP_STACK_FRAME + " " 
-				  + toLispString().getStringValue());
+	 result = Symbol.PRIN1_TO_STRING.execute(this.toLispList()).writeToString();
      } catch (Throwable t) { // error while printing stack
        Debug.trace("Serious printing error: ");
        Debug.trace(t);

Modified: branches/0.18.x/abcl/src/org/armedbear/lisp/print-object.lisp
==============================================================================
--- branches/0.18.x/abcl/src/org/armedbear/lisp/print-object.lisp	(original)
+++ branches/0.18.x/abcl/src/org/armedbear/lisp/print-object.lisp	Sun Jan 17 15:53:21 2010
@@ -50,6 +50,9 @@
     (format stream "~S" (class-name (class-of object))))
   object)
 
+(defmethod print-object ((obj java:java-object) stream)
+  (write-string (%write-to-string obj) stream))
+
 (defmethod print-object ((class java:java-class) stream)
   (write-string (%write-to-string class) stream))