Commit 7eeeb414 authored by ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

Fix #116 (fail to load cl-unicode) by saving serialized resources with a

size bigger that 64k in a separate file instead of within-classfile.
parent 6e362697
......@@ -33,9 +33,9 @@
package org.armedbear.lisp;
import static org.armedbear.lisp.Lisp.*;
import java.util.*;
public class FaslClassLoader extends JavaClassLoader {
......@@ -89,6 +89,27 @@ public class FaslClassLoader extends JavaClassLoader {
public InputStream getResourceAsStream(String resourceName) {
final LispThread thread = LispThread.currentThread();
Pathname name = new Pathname(resourceName.substring("org/armedbear/lisp/".length()));
LispObject truenameFasl = Symbol.LOAD_TRUENAME_FASL.symbolValue(thread);
LispObject truename = Symbol.LOAD_TRUENAME.symbolValue(thread);
if (truenameFasl instanceof Pathname) {
return Pathname.mergePathnames(name, (Pathname)truenameFasl, Keyword.NEWEST)
} else if (truename instanceof Pathname) {
return Pathname.mergePathnames(name, (Pathname) truename, Keyword.NEWEST)
} else if (!Pathname.truename(name).equals(NIL)) {
return name.getInputStream();
return null;
public byte[] getFunctionClassBytes(String name) {
Pathname pathname = new Pathname(name.substring("org/armedbear/lisp/".length()) + ".cls");
return readFunctionBytes(pathname);
......@@ -585,7 +585,15 @@ interpreted toplevel form, non-NIL if it is 'simple enough'."
(when (probe-file fasl-loader)
(push fasl-loader pathnames))
(dotimes (i *class-number*)
(push (probe-file (compute-classfile-name (1+ i))) pathnames))
(let ((truename (probe-file (compute-classfile-name (1+ i)))))
(when truename
(push truename pathnames)
(dolist (resource (directory
(make-pathname :name (format nil "~A_*"
(pathname-name truename))
:type "clc"
:defaults truename)))
(push resource pathnames)))))
(setf pathnames (nreverse (remove nil pathnames)))
(let ((load-file (merge-pathnames (make-pathname :type "_")
......@@ -1181,11 +1181,14 @@ extend the class any further."
(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 compiland-external-constant-resource-name (compiland)
(let ((resource-number (compiland-next-resource compiland))
(pathname (abcl-class-file-pathname (compiland-class-file compiland))))
(incf (compiland-next-resource compiland))
(make-pathname :name (format nil "~A_~D"
(pathname-name pathname) resource-number)
:type "clc"
:defaults pathname)))
(defun serialize-object (object)
"Generate code to restore a serialized object which is not of any
......@@ -1198,10 +1201,19 @@ of the other types."
(emit-invokestatic +lisp+ "readObjectFromString"
(list +java-string+) +lisp-object+))
(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*)))
(let ((pathname
(compiland-external-constant-resource-name *current-compiland*)))
(with-open-file (f pathname
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(write-string s f))
(emit 'ldc (pool-string
(namestring (make-pathname :name (pathname-name pathname)
:type (pathname-type pathname)
:version nil)))))
(emit-invokevirtual +java-class+ "getResourceAsStream"
(list +java-string+)
......@@ -198,6 +198,7 @@ using `make-unique-class-name'."
children ; List of local functions
; defined with FLET, LABELS or LAMBDA
blocks ; TAGBODY, PROGV, BLOCK, etc. blocks
(next-resource 0)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment