[armedbear-cvs] r11697 - trunk/abcl/src/org/armedbear/lisp
Alessio Stalla
astalla at common-lisp.net
Thu Mar 5 23:12:24 UTC 2009
Author: astalla
Date: Thu Mar 5 23:12:24 2009
New Revision: 11697
Log:
Serialization support for some lisp objects.
Modified:
trunk/abcl/src/org/armedbear/lisp/Autoload.java
trunk/abcl/src/org/armedbear/lisp/Binding.java
trunk/abcl/src/org/armedbear/lisp/Closure.java
trunk/abcl/src/org/armedbear/lisp/Function.java
trunk/abcl/src/org/armedbear/lisp/HashTable.java
trunk/abcl/src/org/armedbear/lisp/Interpreter.java
trunk/abcl/src/org/armedbear/lisp/Java.java
trunk/abcl/src/org/armedbear/lisp/Lisp.java
trunk/abcl/src/org/armedbear/lisp/LispObject.java
trunk/abcl/src/org/armedbear/lisp/Load.java
trunk/abcl/src/org/armedbear/lisp/Nil.java
trunk/abcl/src/org/armedbear/lisp/Readtable.java
trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java
trunk/abcl/src/org/armedbear/lisp/Stream.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
trunk/abcl/src/org/armedbear/lisp/SymbolHashTable.java
trunk/abcl/src/org/armedbear/lisp/jvm.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java Thu Mar 5 23:12:24 2009
@@ -338,6 +338,16 @@
}
};
+ /*
+ public void writeObject(java.io.ObjectOutputStream stream) throws java.io.IOException {
+ try {
+ load();
+ } catch(ConditionThrowable t) {
+ throw new java.io.InvalidObjectException("Couldn't resolve autoload: " + t);
+ }
+ stream.defaultWriteObject();
+ }*/
+
static {
autoload("acos", "MathFunctions");
autoload("acosh", "MathFunctions");
Modified: trunk/abcl/src/org/armedbear/lisp/Binding.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Binding.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Binding.java Thu Mar 5 23:12:24 2009
@@ -34,7 +34,7 @@
package org.armedbear.lisp;
// Package accessibility.
-final class Binding
+final class Binding implements java.io.Serializable
{
final LispObject symbol;
LispObject value;
Modified: trunk/abcl/src/org/armedbear/lisp/Closure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Closure.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Closure.java Thu Mar 5 23:12:24 2009
@@ -1041,7 +1041,7 @@
}
}
- private static class Parameter
+ private static class Parameter implements java.io.Serializable
{
private final Symbol var;
private final LispObject initForm;
Modified: trunk/abcl/src/org/armedbear/lisp/Function.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Function.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Function.java Thu Mar 5 23:12:24 2009
@@ -324,4 +324,20 @@
{
++callCount;
}
+
+ protected Object writeReplace() throws java.io.ObjectStreamException {
+ if(getClass().getSimpleName().contains("ABCL_GENERATED_")) {
+ try {
+ return new ExternalizedCompiledFunction((byte[] ) getf(propertyList, Symbol.CLASS_BYTES,
+ new JavaObject(new byte[0])).javaInstance(),
+ lambdaName.writeToString(),
+ getClass().getName());
+ } catch(ConditionThrowable c) {
+ throw new java.io.InvalidClassException(getClass().getName());
+ }
+ } else {
+ return this;
+ }
+ }
+
}
Modified: trunk/abcl/src/org/armedbear/lisp/HashTable.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/HashTable.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/HashTable.java Thu Mar 5 23:12:24 2009
@@ -286,7 +286,7 @@
return NIL;
}
- protected static class HashEntry
+ protected static class HashEntry implements java.io.Serializable
{
LispObject key;
LispObject value;
Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java Thu Mar 5 23:12:24 2009
@@ -40,6 +40,7 @@
import java.io.InputStreamReader;
import java.io.OutputStream;
import java.lang.reflect.Method;
+import java.security.*;
public final class Interpreter extends Lisp
{
@@ -139,6 +140,14 @@
private Interpreter()
{
+ Policy.setPolicy(
+ new Policy() {
+ public PermissionCollection getPermissions(CodeSource codesource) {
+ Permissions perms = new Permissions();
+ perms.add(new AllPermission());
+ return (perms);
+ }
+ });
jlisp = false;
inputStream = null;
outputStream = null;
Modified: trunk/abcl/src/org/armedbear/lisp/Java.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Java.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Java.java Thu Mar 5 23:12:24 2009
@@ -620,13 +620,10 @@
final LispObject methodArg = args[0];
final LispObject instanceArg = args[1];
final Object instance;
- if (instanceArg instanceof AbstractString)
- instance = instanceArg.getStringValue();
- else if (instanceArg instanceof JavaObject)
- instance = ((JavaObject)instanceArg).getObject();
- else {
- type_error(instanceArg,
- list3(Symbol.OR, Symbol.STRING, Symbol.JAVA_OBJECT));
+ if (instanceArg != null) {
+ instance = instanceArg.javaInstance();
+ } else {
+ type_error(instanceArg, Symbol.T);
// Not reached.
return null;
}
Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java Thu Mar 5 23:12:24 2009
@@ -33,10 +33,7 @@
package org.armedbear.lisp;
-import java.io.File;
-import java.io.FileInputStream;
-import java.io.IOException;
-import java.io.InputStream;
+import java.io.*;
import java.lang.reflect.Constructor;
import java.math.BigInteger;
import java.net.URL;
@@ -984,51 +981,43 @@
}
if (device instanceof Pathname)
{
- // We're loading a fasl from j.jar.
+ // We're loading a fasl from a jar.
URL url = Lisp.class.getResource(namestring);
- if (url != null)
- {
- try
- {
+ if (url != null) {
+ try {
String s = url.toString();
- String zipFileName;
- String entryName;
- if (s.startsWith("jar:file:"))
- {
- s = s.substring(9);
- int index = s.lastIndexOf('!');
- if (index >= 0)
- {
- zipFileName = s.substring(0, index);
- entryName = s.substring(index + 1);
- if (entryName.length() > 0 && entryName.charAt(0) == '/')
- entryName = entryName.substring(1);
- if (Utilities.isPlatformWindows)
- {
- // "/C:/Documents%20and%20Settings/peter/Desktop/j.jar"
- if (zipFileName.length() > 0 && zipFileName.charAt(0) == '/')
- zipFileName = zipFileName.substring(1);
- }
- zipFileName = URLDecoder.decode(zipFileName, "UTF-8");
- ZipFile zipFile = new ZipFile(zipFileName);
- try
- {
- ZipEntry entry = zipFile.getEntry(entryName);
- if (entry != null)
- {
- long size = entry.getSize();
- InputStream in = zipFile.getInputStream(entry);
- LispObject obj = loadCompiledFunction(in, (int) size);
- return obj != null ? obj : NIL;
- }
- }
- finally
- {
- zipFile.close();
- }
- }
- }
- }
+ InputStream input = url.openStream();
+ ByteArrayOutputStream baos = new ByteArrayOutputStream();
+
+ byte[] bytes = new byte[4096];
+ int n = 0;
+ while (n >= 0) {
+ n = input.read(bytes, 0, 4096);
+ if(n >= 0) {
+ baos.write(bytes, 0, n);
+ }
+ }
+ input.close();
+ bytes = baos.toByteArray();
+ baos.close();
+ JavaClassLoader loader = new JavaClassLoader();
+ Class c =
+ loader.loadClassFromByteArray(null, bytes, 0, bytes.length);
+ if (c != null) {
+ Class[] parameterTypes = new Class[0];
+ Constructor constructor =
+ c.getConstructor(parameterTypes);
+ Object[] initargs = new Object[0];
+ LispObject obj =
+ (LispObject) constructor.newInstance(initargs);
+ if (obj instanceof Function)
+ ((Function)obj).setClassBytes(bytes);
+ else {
+ System.out.println("obj: " + obj);
+ }
+ return obj != null ? obj : NIL;
+ }
+ }
catch (VerifyError e)
{
return error(new LispError("Class verification failed: " +
@@ -1101,7 +1090,7 @@
new Pathname(namestring)));
}
- private static final LispObject loadCompiledFunction(InputStream in, int size)
+ protected static final LispObject loadCompiledFunction(InputStream in, int size)
{
try
{
@@ -1121,17 +1110,7 @@
Debug.trace("bytesRemaining = " + bytesRemaining);
//JavaClassLoader loader = new JavaClassLoader();
- Class c =
- (new JavaClassLoader()).loadClassFromByteArray(null, bytes, 0, bytes.length);
- if (c != null)
- {
- Constructor constructor = c.getConstructor((Class[])null);
- LispObject obj =
- (LispObject) constructor.newInstance((Object[])null);
- if (obj instanceof Function)
- ((Function)obj).setClassBytes(bytes);
- return obj;
- }
+ return loadCompiledFunction(bytes);
}
catch (Throwable t)
{
@@ -1140,6 +1119,21 @@
return null;
}
+ protected static final LispObject loadCompiledFunction(byte[] bytes) throws Throwable {
+ Class c = (new JavaClassLoader()).loadClassFromByteArray(null, bytes, 0, bytes.length);
+ if (c != null) {
+ Class sc = c.getSuperclass();
+ Constructor constructor = c.getConstructor((Class[])null);
+ LispObject obj = (LispObject) constructor.newInstance((Object[])null);
+ if (obj instanceof Function) {
+ ((Function)obj).setClassBytes(bytes);
+ }
+ return obj;
+ } else {
+ return null;
+ }
+ }
+
public static final LispObject makeCompiledClosure(LispObject template,
LispObject[] context)
throws ConditionThrowable
Modified: trunk/abcl/src/org/armedbear/lisp/LispObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/LispObject.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/LispObject.java Thu Mar 5 23:12:24 2009
@@ -33,7 +33,7 @@
package org.armedbear.lisp;
-public class LispObject extends Lisp
+public class LispObject extends Lisp implements java.io.Serializable
{
public LispObject typeOf()
{
@@ -108,10 +108,11 @@
public Object javaInstance(Class c) throws ConditionThrowable
{
- if (c == LispObject.class)
- return this;
- return error(new LispError("The value " + writeToString() +
- " is not of primitive type."));
+ if (c.isAssignableFrom(this.getClass())) {
+ return this;
+ }
+ return error(new LispError("The value " + writeToString() +
+ " is not of type " + c.getName()));
}
public LispObject car() throws ConditionThrowable
@@ -1159,4 +1160,5 @@
public void incrementCallCount()
{
}
+
}
Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java Thu Mar 5 23:12:24 2009
@@ -288,7 +288,8 @@
if (url != null) {
try {
in = url.openStream();
- if ("jar".equals(url.getProtocol()))
+ if ("jar".equals(url.getProtocol()) &&
+ url.getPath().startsWith("file:"))
pathname = new Pathname(url);
truename = getPath(url);
}
@@ -453,7 +454,7 @@
LispObject obj = in.read(false, EOF, false, thread);
if (obj == EOF)
break;
- LispObject result = eval(obj, env, thread);
+ LispObject result = eval(obj, env, thread);
if (print) {
Stream out =
checkCharacterOutputStream(Symbol.STANDARD_OUTPUT.symbolValue(thread));
Modified: trunk/abcl/src/org/armedbear/lisp/Nil.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Nil.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Nil.java Thu Mar 5 23:12:24 2009
@@ -249,4 +249,9 @@
return "|COMMON-LISP|::|NIL|";
return "NIL";
}
+
+ public Object readResolve() throws java.io.ObjectStreamException {
+ return NIL;
+ }
+
}
Modified: trunk/abcl/src/org/armedbear/lisp/Readtable.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Readtable.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Readtable.java Thu Mar 5 23:12:24 2009
@@ -306,7 +306,7 @@
dispatchTable.functions[LispCharacter.toUpperCase(subChar)] = function;
}
- protected static class DispatchTable
+ protected static class DispatchTable implements java.io.Serializable
{
public LispObject[] functions = new LispObject[CHAR_MAX];
Modified: trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java Thu Mar 5 23:12:24 2009
@@ -828,7 +828,7 @@
list1(Symbol.GENERIC_FUNCTION),
list1(StandardClass.STANDARD_GENERIC_FUNCTION));
- private static class CacheEntry
+ private static class CacheEntry implements java.io.Serializable
{
final LispObject[] array;
Modified: trunk/abcl/src/org/armedbear/lisp/Stream.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Stream.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Stream.java Thu Mar 5 23:12:24 2009
@@ -69,12 +69,12 @@
private boolean open = true;
// Character input.
- protected PushbackReader reader;
+ protected transient PushbackReader reader; //provvisorio finché non capisco chi serializza lo stream
protected int offset;
protected int lineNumber;
// Character output.
- private Writer writer;
+ private transient Writer writer;
/** The number of characters on the current line of output
*
@@ -110,10 +110,10 @@
protected char lastChar = 0;
// Binary input.
- private InputStream in;
+ private transient InputStream in;
// Binary output.
- private OutputStream out;
+ private transient OutputStream out;
protected Stream()
{
@@ -3024,4 +3024,21 @@
return second;
}
};
+
+ public OutputStream getJavaOutputStream() {
+ return out;
+ }
+
+ public InputStream getJavaInputStream() {
+ return in;
+ }
+
+ public Writer getJavaWriter() {
+ return writer;
+ }
+
+ public Reader getJavaReader() {
+ return reader;
+ }
+
}
Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Thu Mar 5 23:12:24 2009
@@ -57,7 +57,7 @@
public final SimpleString name;
private int hash = -1;
- private LispObject pkg; // Either a package object or NIL.
+ private transient LispObject pkg; // Either a package object or NIL.
private LispObject value;
private LispObject function;
private LispObject propertyList;
@@ -888,6 +888,35 @@
function.incrementCallCount();
}
+ private void readObject(java.io.ObjectInputStream stream) throws java.io.IOException, ClassNotFoundException {
+ stream.defaultReadObject();
+ Object pkg = stream.readObject();
+ if(pkg == NIL) {
+ this.pkg = NIL;
+ } else {
+ this.pkg = Packages.findPackage(pkg.toString());
+ }
+ }
+
+ public Object readResolve() throws java.io.ObjectStreamException {
+ if(pkg instanceof Package) {
+ Symbol s = ((Package) pkg).intern(name.getStringValue());
+ s.value = value;
+ s.function = function;
+ s.propertyList = propertyList;
+ s.hash = hash;
+ s.flags = flags;
+ return s;
+ }
+ return this;
+ }
+
+ private void writeObject(java.io.ObjectOutputStream stream) throws java.io.IOException {
+ stream.defaultWriteObject();
+ stream.writeObject(this.pkg == NIL ? NIL : ((Package) pkg).getName());
+ }
+
+
// External symbols in CL package.
public static final Symbol AND_ALLOW_OTHER_KEYS =
PACKAGE_CL.addExternalSymbol("&ALLOW-OTHER-KEYS");
Modified: trunk/abcl/src/org/armedbear/lisp/SymbolHashTable.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SymbolHashTable.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/SymbolHashTable.java Thu Mar 5 23:12:24 2009
@@ -36,7 +36,7 @@
import java.util.ArrayList;
import java.util.List;
-public final class SymbolHashTable
+public final class SymbolHashTable implements java.io.Serializable
{
private static final float LOAD_FACTOR = 0.75f;
@@ -221,7 +221,7 @@
return list;
}
- private static class HashEntry
+ private static class HashEntry implements java.io.Serializable
{
Symbol symbol;
HashEntry next;
Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp Thu Mar 5 23:12:24 2009
@@ -114,7 +114,7 @@
(declare (type fixnum i))
(when (char= (char name i) #\-)
(setf (char name i) #\_)))
- (concatenate 'string "org/armedbear/lisp/" name)))
+ (concatenate 'string "org/armedbear/lisp/ABCL_GENERATED_" name)))
(defun make-class-file (&key pathname lambda-name lambda-list)
(aver (not (null pathname)))
More information about the armedbear-cvs
mailing list