[armedbear-cvs] r13511 - trunk/abcl/src/org/armedbear/lisp

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Fri Aug 19 08:42:38 2011
New Revision: 13511

Log:
Re #116: while working to fix the issue, at least tell the user we're
unable to generate a conforming class file.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
   trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Tue Aug 16 06:45:28 2011	(r13510)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Fri Aug 19 08:42:38 2011	(r13511)
@@ -51,6 +51,10 @@
 
 (declaim (special *memory-class-loader*))
 
+
+(declaim (inline pool-name pool-name-and-type pool-string
+                 pool-field pool-method pool-int pool-float pool-long
+                 pool-double add-exception-handler))
 (defun pool-name (name)
   (pool-add-utf8 *pool* name))
 
@@ -1177,14 +1181,33 @@
   (emit-invokestatic +lisp+ "readObjectFromString"
                      (list +java-string+) +lisp-object+))
 
+(defun external-constant-resource-name (class)
+  (declare (ignore class))
+  ;; dummy implementation to suppress compiler warnings
+  ;; which break abcl compilation
+  )
+
 (defun serialize-object (object)
   "Generate code to restore a serialized object which is not of any
 of the other types."
   (let ((s (with-output-to-string (stream)
              (dump-form object stream))))
-    (emit 'ldc (pool-string s))
-    (emit-invokestatic +lisp+ "readObjectFromString"
-                       (list +java-string+) +lisp-object+)))
+    (cond
+      ((< (length s) #xFFFF)  ;; maximum string size in class file
+       (emit 'ldc (pool-string s))
+       (emit-invokestatic +lisp+ "readObjectFromString"
+                          (list +java-string+) +lisp-object+))
+      (t
+       (assert (not "Serialized representation too long to be stored in a string"))
+       (aload 0) ;; this
+       (emit-invokevirtual +java-object+ "getClass" '() +java-class+)
+       (emit 'ldc (pool-string (external-constant-resource-name *this-class*)))
+       (emit-invokevirtual +java-class+ "getResourceAsStream"
+                           (list +java-string+)
+                           +java-io-input-stream+)
+       (emit-invokestatic +lisp+ "readObjectFromStream"
+                          (list +java-io-input-stream+)
+                          +lisp-object+)))))
 
 (defun serialize-symbol (symbol)
   "Generate code to restore a serialized symbol."

Modified: trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	Tue Aug 16 06:45:28 2011	(r13510)
+++ trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	Fri Aug 19 08:42:38 2011	(r13511)
@@ -130,9 +130,11 @@
   `(defconstant ,symbol (make-jvm-class-name ,java-dotted-name)
      ,documentation))
 
+(define-class-name +java-class+ "java.lang.Class")
 (define-class-name +java-object+ "java.lang.Object")
 (define-class-name +java-string+ "java.lang.String")
 (define-class-name +java-system+ "java.lang.System")
+(define-class-name +java-io-input-stream+ "java.io.InputStream")
 (define-class-name +lisp-object+ "org.armedbear.lisp.LispObject")
 (defconstant +lisp-object-array+ (class-array +lisp-object+))
 (define-class-name +lisp-simple-string+ "org.armedbear.lisp.SimpleString")