From ehuelsmann at common-lisp.net  Sat Nov  1 20:23:19 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 01 Nov 2008 20:23:19 +0000
Subject: [armedbear-cvs] r11371 - in trunk/j: . src/org/armedbear/lisp
Message-ID: <E1KwN0B-0007aA-6E@common-lisp.net>

Author: ehuelsmann
Date: Sat Nov  1 20:23:18 2008
New Revision: 11371

Log:
Greatly reduce the size of abcl.jar:

 * src/org/armedbear/lisp/compile-system.lisp: Include package.lisp and print-object.lisp in
     system compilation.
 * build.xml: No longer include all .lisp files in the JAR; more specifically, no longer
     specifically include top-level. Don't exclude package.lisp and print-object.lisp, they're
     compiled now.

Modified:
   trunk/j/build.xml
   trunk/j/src/org/armedbear/lisp/compile-system.lisp

Modified: trunk/j/build.xml
==============================================================================
--- trunk/j/build.xml	(original)
+++ trunk/j/build.xml	Sat Nov  1 20:23:18 2008
@@ -113,8 +113,7 @@
     <!-- Lisp files required at runtime -->
     <patternset id="abcl.source.lisp.dist">
       <include name="org/armedbear/lisp/boot.lisp"/>
-      <include name="org/armedbear/lisp/top-level.lisp"/>
-      <include name="org/armedbear/lisp/*.lisp"/> 
+      <include name="org/armedbear/lisp/autoloads.lisp"/>
     </patternset>
 
     <patternset id="abcl.objects">
@@ -253,8 +252,6 @@
       <exclude name="org/armedbear/lisp/slime-loader.lisp"/>
       <exclude name="org/armedbear/lisp/runtime-class.lisp"/>
       <exclude name="org/armedbear/lisp/run-benchmarks.lisp"/>
-      <exclude name="org/armedbear/lisp/print-object.lisp"/>
-      <exclude name="org/armedbear/lisp/package.lisp"/>
       <exclude name="org/armedbear/lisp/j.lisp"/>
     </patternset>
 

Modified: trunk/j/src/org/armedbear/lisp/compile-system.lisp
==============================================================================
--- trunk/j/src/org/armedbear/lisp/compile-system.lisp	(original)
+++ trunk/j/src/org/armedbear/lisp/compile-system.lisp	Sat Nov  1 20:23:18 2008
@@ -190,8 +190,8 @@
                                      "parse-integer.lisp"
                                      "parse-lambda-list.lisp"
                                      "pathnames.lisp"
-                                     ;;"package.lisp"
-                                     ;;"print-object.lisp"
+                                     "package.lisp"
+                                     "print-object.lisp"
                                      "print-unreadable-object.lisp"
                                      "proclaim.lisp"
                                      "profiler.lisp"



From ehuelsmann at common-lisp.net  Sat Nov  1 20:45:15 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 01 Nov 2008 20:45:15 +0000
Subject: [armedbear-cvs] r11372 - in trunk/j: . src/org/armedbear/lisp
Message-ID: <E1KwNLP-00005i-LD@common-lisp.net>

Author: ehuelsmann
Date: Sat Nov  1 20:45:15 2008
New Revision: 11372

Log:
Compile and include autoloads in compiled form into abcl.jar.

Modified:
   trunk/j/build.xml
   trunk/j/src/org/armedbear/lisp/compile-system.lisp

Modified: trunk/j/build.xml
==============================================================================
--- trunk/j/build.xml	(original)
+++ trunk/j/build.xml	Sat Nov  1 20:45:15 2008
@@ -113,7 +113,6 @@
     <!-- Lisp files required at runtime -->
     <patternset id="abcl.source.lisp.dist">
       <include name="org/armedbear/lisp/boot.lisp"/>
-      <include name="org/armedbear/lisp/autoloads.lisp"/>
     </patternset>
 
     <patternset id="abcl.objects">
@@ -240,7 +239,6 @@
     <patternset id="abcl.source.lisp.fasls">
       <patternset refid="abcl.source.lisp"/>
       <exclude name="org/armedbear/lisp/tests/*.lisp"/>
-      <exclude name="org/armedbear/lisp/autoloads.lisp"/>
       <exclude name="org/armedbear/lisp/boot.lisp"/>
       <exclude name="org/armedbear/lisp/emacs.lisp"/>
       <exclude name="org/armedbear/lisp/with-mutex.lisp"/>

Modified: trunk/j/src/org/armedbear/lisp/compile-system.lisp
==============================================================================
--- trunk/j/src/org/armedbear/lisp/compile-system.lisp	(original)
+++ trunk/j/src/org/armedbear/lisp/compile-system.lisp	Sat Nov  1 20:45:15 2008
@@ -108,7 +108,7 @@
                                      "asdf.lisp"
                                      "assert.lisp"
                                      "assoc.lisp"
-                                     ;;"autoloads.lisp"
+                                     "autoloads.lisp"
                                      "aver.lisp"
                                      "bit-array-ops.lisp"
                                      "boole.lisp"



From ehuelsmann at common-lisp.net  Sat Nov  1 21:00:32 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 01 Nov 2008 21:00:32 +0000
Subject: [armedbear-cvs] r11373 - trunk/j/src/org/armedbear/lisp
Message-ID: <E1KwNaC-0000jc-Uu@common-lisp.net>

Author: ehuelsmann
Date: Sat Nov  1 21:00:32 2008
New Revision: 11373

Log:
Given recent improvements (including JAR building), call this 0.0.11.1.

Modified:
   trunk/j/src/org/armedbear/lisp/Version.java

Modified: trunk/j/src/org/armedbear/lisp/Version.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Version.java	(original)
+++ trunk/j/src/org/armedbear/lisp/Version.java	Sat Nov  1 21:00:32 2008
@@ -29,6 +29,6 @@
 
   public static String getVersion()
   {
-    return "0.0.11";
+    return "0.0.11.1";
   }
 }



From ehuelsmann at common-lisp.net  Sun Nov  2 11:36:33 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 02 Nov 2008 11:36:33 +0000
Subject: [armedbear-cvs] r11374 - trunk/j/src/org/armedbear/lisp
Message-ID: <E1KwbFx-0007Db-8C@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov  2 11:36:31 2008
New Revision: 11374

Log:
Add with-mutex.lisp to the set of files to be compiled.

Found by: mark evenson.

Modified:
   trunk/j/src/org/armedbear/lisp/compile-system.lisp

Modified: trunk/j/src/org/armedbear/lisp/compile-system.lisp
==============================================================================
--- trunk/j/src/org/armedbear/lisp/compile-system.lisp	(original)
+++ trunk/j/src/org/armedbear/lisp/compile-system.lisp	Sun Nov  2 11:36:31 2008
@@ -234,6 +234,7 @@
                                      "with-accessors.lisp"
                                      "with-hash-table-iterator.lisp"
                                      "with-input-from-string.lisp"
+                                     "with-mutex.lisp"
                                      "with-open-file.lisp"
                                      "with-output-to-string.lisp"
                                      "with-package-iterator.lisp"



From ehuelsmann at common-lisp.net  Sun Nov  2 12:21:18 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 02 Nov 2008 12:21:18 +0000
Subject: [armedbear-cvs] r11375 - trunk/j/src/org/armedbear/lisp
Message-ID: <E1KwbxG-0001bP-9f@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov  2 12:21:16 2008
New Revision: 11375

Log:
Resolve (?) ticket 7: removal of out-of-date slime.

Note: SlimeInputStream.java and SlimeOutputStream.java still remain as they're
 used by slime/swank.

Patch by: mevenson


Removed:
   trunk/j/src/org/armedbear/lisp/slime-loader.lisp
   trunk/j/src/org/armedbear/lisp/slime.lisp
   trunk/j/src/org/armedbear/lisp/swank-abcl.lisp
   trunk/j/src/org/armedbear/lisp/swank-allegro.lisp
   trunk/j/src/org/armedbear/lisp/swank-loader.lisp
   trunk/j/src/org/armedbear/lisp/swank-package.lisp
   trunk/j/src/org/armedbear/lisp/swank-protocol.lisp
   trunk/j/src/org/armedbear/lisp/swank-sbcl.lisp
   trunk/j/src/org/armedbear/lisp/swank-xcl.lisp
   trunk/j/src/org/armedbear/lisp/swank.lisp



From ehuelsmann at common-lisp.net  Sun Nov  2 19:22:11 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 02 Nov 2008 19:22:11 +0000
Subject: [armedbear-cvs] r11376 - in trunk/j: . src/org/armedbear/lisp
Message-ID: <E1KwiWZ-0005Yk-7T@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov  2 19:22:09 2008
New Revision: 11376

Log:
Clean up build system artifacts of slime.
Follow up for compilation of with-mutex.lisp.

Patch by: mevenson


Modified:
   trunk/j/build.xml
   trunk/j/src/org/armedbear/lisp/compile-system.lisp

Modified: trunk/j/build.xml
==============================================================================
--- trunk/j/build.xml	(original)
+++ trunk/j/build.xml	Sun Nov  2 19:22:09 2008
@@ -241,13 +241,6 @@
       <exclude name="org/armedbear/lisp/tests/*.lisp"/>
       <exclude name="org/armedbear/lisp/boot.lisp"/>
       <exclude name="org/armedbear/lisp/emacs.lisp"/>
-      <exclude name="org/armedbear/lisp/with-mutex.lisp"/>
-      <exclude name="org/armedbear/lisp/swank-xcl.lisp"/>
-      <exclude name="org/armedbear/lisp/swank-sbcl.lisp"/>
-      <exclude name="org/armedbear/lisp/swank-package.lisp"/>
-      <exclude name="org/armedbear/lisp/swank-loader.lisp"/>
-      <exclude name="org/armedbear/lisp/swank-allegro.lisp"/>
-      <exclude name="org/armedbear/lisp/slime-loader.lisp"/>
       <exclude name="org/armedbear/lisp/runtime-class.lisp"/>
       <exclude name="org/armedbear/lisp/run-benchmarks.lisp"/>
       <exclude name="org/armedbear/lisp/j.lisp"/>

Modified: trunk/j/src/org/armedbear/lisp/compile-system.lisp
==============================================================================
--- trunk/j/src/org/armedbear/lisp/compile-system.lisp	(original)
+++ trunk/j/src/org/armedbear/lisp/compile-system.lisp	Sun Nov  2 19:22:09 2008
@@ -242,10 +242,6 @@
                                      "with-standard-io-syntax.lisp"
                                      "with-thread-lock.lisp"
                                      "write-sequence.lisp"))
-    (mapc #'compile-file-if-needed '("swank-protocol.lisp"
-                                     "slime.lisp"
-                                     "swank-abcl.lisp"
-                                     "swank.lisp"))
     t))
 
 (defun compile-system (&key quit (zip t))



From astalla at common-lisp.net  Mon Nov  3 22:33:07 2008
From: astalla at common-lisp.net (Alessio Stalla)
Date: Mon, 03 Nov 2008 22:33:07 +0000
Subject: [armedbear-cvs] r11378 - branches/scripting/j/src/org/armedbear/lisp
Message-ID: <E1Kx7yt-0000tb-70@common-lisp.net>

Author: astalla
Date: Mon Nov  3 22:33:06 2008
New Revision: 11378

Log:
Added CLOS method dispatch on Java classes: a new java:jclass specializer is provided, plus a new JAVA-CLASS metaclass has been introduced to represent all Java classes in the context of CLOS.

Modified:
   branches/scripting/j/src/org/armedbear/lisp/Autoload.java
   branches/scripting/j/src/org/armedbear/lisp/JavaObject.java
   branches/scripting/j/src/org/armedbear/lisp/StandardClass.java
   branches/scripting/j/src/org/armedbear/lisp/Symbol.java
   branches/scripting/j/src/org/armedbear/lisp/clos.lisp

Modified: branches/scripting/j/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/Autoload.java	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/Autoload.java	Mon Nov  3 22:33:06 2008
@@ -489,6 +489,7 @@
         autoload(PACKAGE_EXT, "thread-unlock", "ThreadLock", true);
         autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy");
         autoload(PACKAGE_JAVA, "%jimplement-interface", "JProxy");
+        autoload(PACKAGE_JAVA, "%find-java-class", "JavaClass");
         autoload(PACKAGE_JAVA, "%jmake-invocation-handler", "JProxy");
         autoload(PACKAGE_JAVA, "%jmake-proxy", "JProxy");
         autoload(PACKAGE_JAVA, "%jnew-runtime-class", "RuntimeClass");

Modified: branches/scripting/j/src/org/armedbear/lisp/JavaObject.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/JavaObject.java	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/JavaObject.java	Mon Nov  3 22:33:06 2008
@@ -37,7 +37,11 @@
 
     public LispObject classOf()
     {
-        return BuiltInClass.JAVA_OBJECT;
+    	if(obj == null) {
+    		return BuiltInClass.JAVA_OBJECT;
+    	} else {
+    		return JavaClass.findJavaClass(obj.getClass());
+    	}
     }
 
     public LispObject typep(LispObject type) throws ConditionThrowable
@@ -46,6 +50,9 @@
             return T;
         if (type == BuiltInClass.JAVA_OBJECT)
             return T;
+        if(type instanceof JavaClass && obj != null) {
+        	return ((JavaClass) type).getJavaClass().isAssignableFrom(obj.getClass()) ? T : NIL;
+        }
         return super.typep(type);
     }
 

Modified: branches/scripting/j/src/org/armedbear/lisp/StandardClass.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/StandardClass.java	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/StandardClass.java	Mon Nov  3 22:33:06 2008
@@ -107,6 +107,9 @@
   public static final StandardClass BUILT_IN_CLASS =
     addStandardClass(Symbol.BUILT_IN_CLASS, list1(CLASS));
 
+  public static final StandardClass JAVA_CLASS =
+	    addStandardClass(Symbol.JAVA_CLASS, list1(CLASS));
+  
   public static final StandardClass FORWARD_REFERENCED_CLASS =
     addStandardClass(Symbol.FORWARD_REFERENCED_CLASS, list1(CLASS));
 
@@ -264,6 +267,8 @@
                                list1(PACKAGE_CL.intern("ARITHMETIC-ERROR-OPERANDS")))));
     BUILT_IN_CLASS.setCPL(BUILT_IN_CLASS, CLASS, STANDARD_OBJECT,
                           BuiltInClass.CLASS_T);
+    JAVA_CLASS.setCPL(JAVA_CLASS, CLASS, STANDARD_OBJECT,
+            BuiltInClass.CLASS_T);
     CELL_ERROR.setCPL(CELL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
                       STANDARD_OBJECT, BuiltInClass.CLASS_T);
     CELL_ERROR.setDirectSlotDefinitions(

Modified: branches/scripting/j/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/Symbol.java	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/Symbol.java	Mon Nov  3 22:33:06 2008
@@ -2874,6 +2874,8 @@
     PACKAGE_JAVA.addExternalSymbol("JAVA-EXCEPTION-CAUSE");
   public static final Symbol JAVA_OBJECT =
     PACKAGE_JAVA.addExternalSymbol("JAVA-OBJECT");
+  public static final Symbol JAVA_CLASS =
+	    PACKAGE_JAVA.addExternalSymbol("JAVA-CLASS");
   public static final Symbol JCALL =
     PACKAGE_JAVA.addExternalSymbol("JCALL");
   public static final Symbol JCALL_RAW =

Modified: branches/scripting/j/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/clos.lisp	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/clos.lisp	Mon Nov  3 22:33:06 2008
@@ -896,6 +896,13 @@
                       (eq (car object) 'quote))
              (setf object (cadr object)))
            (intern-eql-specializer object)))
+	((and (consp specializer)
+              (eq (car specializer) 'java:jclass))
+         (let ((class-name (cadr specializer)))
+           (when (and (consp class-name)
+                      (eq (car class-name) 'quote))
+             (setf class-name (cadr class-name)))
+           (java::%find-java-class class-name)))
         (t
          (error "Unknown specializer: ~S" specializer))))
 



From astalla at common-lisp.net  Wed Nov  5 20:20:58 2008
From: astalla at common-lisp.net (Alessio Stalla)
Date: Wed, 05 Nov 2008 20:20:58 +0000
Subject: [armedbear-cvs] r11379 - in
	branches/scripting/j/src/org/armedbear/lisp: . scripting/lisp
Message-ID: <E1Kxos6-0007fa-8k@common-lisp.net>

Author: astalla
Date: Wed Nov  5 20:20:57 2008
New Revision: 11379

Log:
jmake-proxy now is a generic function. A couple of simple methods are provided. TBD: automagic proxy generation from functions in a package.

Modified:
   branches/scripting/j/src/org/armedbear/lisp/Autoload.java
   branches/scripting/j/src/org/armedbear/lisp/JProxy.java
   branches/scripting/j/src/org/armedbear/lisp/autoloads.lisp
   branches/scripting/j/src/org/armedbear/lisp/java.lisp
   branches/scripting/j/src/org/armedbear/lisp/print-object.lisp
   branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp

Modified: branches/scripting/j/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/Autoload.java	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/Autoload.java	Wed Nov  5 20:20:57 2008
@@ -488,7 +488,6 @@
         autoload(PACKAGE_EXT, "thread-lock", "ThreadLock", true);
         autoload(PACKAGE_EXT, "thread-unlock", "ThreadLock", true);
         autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy");
-        autoload(PACKAGE_JAVA, "%jimplement-interface", "JProxy");
         autoload(PACKAGE_JAVA, "%find-java-class", "JavaClass");
         autoload(PACKAGE_JAVA, "%jmake-invocation-handler", "JProxy");
         autoload(PACKAGE_JAVA, "%jmake-proxy", "JProxy");

Modified: branches/scripting/j/src/org/armedbear/lisp/JProxy.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/JProxy.java	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/JProxy.java	Wed Nov  5 20:20:57 2008
@@ -221,80 +221,6 @@
 	    
 	private static LispObject toLispObject(Object obj) {
 		return (obj instanceof LispObject) ? (LispObject) obj : new JavaObject(obj);
-	}    
-	    
-  	private static final Primitive _JIMPLEMENT_INTERFACE =
-	    new Primitive("%jimplement-interface", PACKAGE_JAVA, false,
-	                  "interface &rest method-names-and-defs") {
-  		
-	      	public LispObject execute(LispObject[] args) throws ConditionThrowable {
-	      		int length = args.length;
-	      		if (length < 3 || length % 2 != 1) {
-	      			return error(new WrongNumberOfArgumentsException(this));
-	      		}
-	      		final Map<String,Function> lispDefinedMethods = new HashMap<String,Function>();
-	      		for (int i = 1; i < length; i += 2) {
-	      			lispDefinedMethods.put(args[i].getStringValue(), (Function) args[i + 1]);
-	      		}
-	      		final Class<?> iface = (Class<?>) args[0].javaInstance();
-	      		return new Function() {
-
-	      			public LispObject execute(LispObject lispProxy) {
-	      				Object proxy = Proxy.newProxyInstance(
-	    	      				iface.getClassLoader(),
-	    	      				new Class[] { iface },
-	    	      				new LispHandler2(lispProxy, lispDefinedMethods));
-	    	      		return new JavaObject(proxy);	      				
-	      			}
-	      			
-	      		};
-	      		
-	      	}
-	    };
-  
-    private static class LispHandler2 implements InvocationHandler {
-
-  		private Map<String, Function> lispDefinedMethods;
-  		private LispObject lispProxy;
-
-	    LispHandler2(LispObject lispProxy, Map<String, Function> lispDefinedMethods) {
-	    	this.lispProxy = lispProxy;
-	    	this.lispDefinedMethods = lispDefinedMethods;
-	    }
-		
-	    public Object invoke(Object proxy, Method method, Object[] args) throws ConditionThrowable {
-	    	String methodName = method.getName();
-	
-	    	//TODO are these implemented correctly?
-	    	if(methodName.equals("hashCode")) {
-	    		return lispProxy.hashCode();
-	    	}
-	    	if (methodName.equals("equals")) {
-	    		return (args[0] instanceof LispObject) && (T == lispProxy.EQ((LispObject) args[0]));
-	    	}
-	    	if (methodName.equals("toString")) {
-	    		return lispProxy.writeToString();
-	    	}	
-
-	    	Function f = lispDefinedMethods.get(methodName);
-	    	if (f != null) {
-	    		try {
-	    			LispObject lispArgs = NIL;
-	    			if (args != null) {
-	    				for (int i = args.length - 1 ; 0 <= i  ; i--) {
-	    					lispArgs = lispArgs.push(new JavaObject(args[i]));
-	    				}
-	    			}
-	    			lispArgs = lispArgs.push(lispProxy);
-	    			LispObject result = evalCall(f, lispArgs, new Environment(),
-	    										 LispThread.currentThread());
-	    			return (method.getReturnType() == void.class ? null : result.javaInstance());
-	    		} catch (ConditionThrowable t) {
-	    			t.printStackTrace();
-	    		}
-        	}
-	    	return null;
-	    }
-  	}	    
+	}
 	    
 }

Modified: branches/scripting/j/src/org/armedbear/lisp/autoloads.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/autoloads.lisp	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/autoloads.lisp	Wed Nov  5 20:20:57 2008
@@ -187,8 +187,6 @@
 (autoload 'jregister-handler "java")
 (export 'jinterface-implementation "JAVA")
 (autoload 'jinterface-implementation "java")
-(export 'jimplement-interface "JAVA")
-(autoload 'jimplement-interface "java")
 (export 'jmake-invocation-handler "JAVA")
 (autoload 'jmake-invocation-handler "java")
 (export 'jmake-proxy "JAVA")

Modified: branches/scripting/j/src/org/armedbear/lisp/java.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/java.lisp	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/java.lisp	Wed Nov  5 20:20:57 2008
@@ -63,53 +63,47 @@
         (push method-name method-names-and-defs)))
     (apply #'%jnew-proxy interface method-names-and-defs)))
 
-(defun jimplement-interface (interface &rest method-names-and-defs)
-  "Creates and returns an implementation of a Java interface with
-   methods calling Lisp closures as given in METHOD-NAMES-AND-DEFS.
-
-   INTERFACE is either a Java interface or a string naming one.
-
-   METHOD-NAMES-AND-DEFS is an alternating list of method names
-   (strings) and method definitions (closures).
-
-   For missing methods, a dummy implementation is provided that
-   returns nothing or null depending on whether the return type is
-   void or not. This is for convenience only, and a warning is issued
-   for each undefined method."
-  (let ((interface (jclass interface))
-        (implemented-methods
-         (loop for m in method-names-and-defs
-           for i from 0
-           if (evenp i)
-           do (assert (stringp m) (m) "Method names must be strings: ~s" m) and collect m
-           else
-           do (assert (or (symbolp m) (functionp m)) (m) "Methods must be function designators: ~s" m)))
-        (null (make-immediate-object nil :ref)))
-    (loop for method across
-      (jclass-methods interface :declared nil :public t)
-      for method-name = (jmethod-name method)
-      when (not (member method-name implemented-methods :test #'string=))
-      do
-      (let* ((void-p (string= (jclass-name (jmethod-return-type method)) "void"))
-             (arglist '(&rest ignore))
-             (def `(lambda
-                     ,arglist
-                     ,(when arglist '(declare (ignore ignore)))
-                     ,(if void-p '(values) null))))
-        (warn "Implementing dummy method ~a for interface ~a"
-              method-name (jclass-name interface))
-        (push (coerce def 'function) method-names-and-defs)
-        (push method-name method-names-and-defs)))
-    (apply #'%jimplement-interface interface method-names-and-defs)))
-
 (defun jmake-invocation-handler (function)
   (%jmake-invocation-handler function))
 
-(defun jmake-proxy (interface invocation-handler)
-  (let ((handler (if (functionp invocation-handler)
-		     (jmake-invocation-handler invocation-handler)
-		     invocation-handler)))
-    (%jmake-proxy (jclass interface) handler)))
+(when (autoloadp 'jmake-proxy)
+  (fmakunbound 'jmake-proxy))
+
+(defgeneric jmake-proxy (interface implementation))
+
+;(defun jmake-proxy (interface implementation)
+;  (jmake-proxy-impl interface implementation))
+
+(defmethod jmake-proxy (interface invocation-handler)
+  (%jmake-proxy (jclass interface) invocation-handler))
+
+(defmethod jmake-proxy (interface (implementation function))
+  (%jmake-proxy (jclass interface) (jmake-invocation-handler implementation)))
+
+#|
+TODO java->lisp wrong (coding at night has nasty effects)
+(defmethod jmake-proxy (interface (implementation package))
+  (flet ((java->lisp (name)
+	   (substitute #\- #\. (string-upcase name))))
+    (%jmake-proxy (jclass interface)
+		  (jmake-invocation-handler 
+		   (lambda (obj method &rest args)
+		     (let* ((sym (find-symbol (java->lisp (jmethod-name method))))
+			    (fn (symbol-function sym)))
+		       (if fn
+			   (apply fn obj args)
+			   (error "Function ~A, implementation of method ~A, not found in ~A"
+				  sym (jmethod-name method) implementation))))))))
+|#
+(defmethod jmake-proxy (interface (implementation hash-table))
+  (%jmake-proxy (jclass interface)
+		(jmake-invocation-handler 
+		 (lambda (obj method &rest args)
+		   (let ((fn (gethash (jmethod-name method) implementation)))
+		     (if fn
+			 (apply fn obj args)
+			 (error "Implementation for method ~A not found in ~A"
+				(jmethod-name method) implementation)))))))
 
 (defun jobject-class (obj)
   "Returns the Java class that OBJ belongs to"

Modified: branches/scripting/j/src/org/armedbear/lisp/print-object.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/print-object.lisp	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/print-object.lisp	Wed Nov  5 20:20:57 2008
@@ -37,6 +37,9 @@
     (format stream "~S" (class-name (class-of object))))
   object)
 
+(defmethod print-object ((class java:java-class) stream)
+  (write-string (%write-to-string object) stream))
+
 (defmethod print-object ((class class) stream)
   (print-unreadable-object (class stream :identity t)
     (format stream "~S ~S"

Modified: branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp	Wed Nov  5 20:20:57 2008
@@ -71,32 +71,4 @@
 		  ,@(generate-java-bindings
 		     engine-bindings 
 		     actual-engine-bindings
-		     (jcall +get-bindings+ script-context +engine-scope+)))))))))
-
-(defstruct (java-interface-implementation (:type list))
-  (method-definitions (list) :type list))
-
-(defun define-java-interface-implementation (interface &rest method-definitions)
-  (register-java-interface-implementation
-   (canonicalize-interface interface)
-   (make-java-interface-implementation :method-definitions method-definitions)))
-
-(defun canonicalize-interface (interface)
-  (cond
-    ((stringp interface) interface)
-    ((jclass-interface-p interface) (jclass-name interface))
-    (t (error "not an interface: ~A" interface))))
-
-(defun register-java-interface-implementation (interface implementation)
-  (setf (gethash (canonicalize-interface interface)
-		 *java-interface-implementations*)
-	(implement-java-interface interface implementation)))
-
-(defun find-java-interface-implementation (interface)
-  (gethash (canonicalize-interface interface)
-	   *java-interface-implementations*))
-
-(defun implement-java-interface (interface implementation)
-  (apply #'jimplement-interface
-	 `(,interface
-	   ,@(java-interface-implementation-method-definitions implementation))))
\ No newline at end of file
+		     (jcall +get-bindings+ script-context +engine-scope+)))))))))
\ No newline at end of file



From ehuelsmann at common-lisp.net  Wed Nov  5 22:14:39 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Wed, 05 Nov 2008 22:14:39 +0000
Subject: [armedbear-cvs] r11380 - public_html
Message-ID: <E1Kxqe7-0003jw-8O@common-lisp.net>

Author: ehuelsmann
Date: Wed Nov  5 22:14:38 2008
New Revision: 11380

Log:
Implement testimonials page. Will still need linkage from the main page.


Added:
   public_html/testimonials.shtml   (contents, props changed)

Added: public_html/testimonials.shtml
==============================================================================
--- (empty file)
+++ public_html/testimonials.shtml	Wed Nov  5 22:14:38 2008
@@ -0,0 +1,68 @@
+<?xml version="1.0"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+  <title><!--#include virtual="project-name" -->: Testimonials</title>
+  <link rel="stylesheet" type="text/css" href="style.css"/>
+  <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/>
+</head>
+
+<body>
+
+<h1>Testimonials</h1>
+
+
+<dl>
+<dt>Hunter Monroe
+</dt>
+<dd>"Maxima algebraic computation software compiles with ABCL. The test suite
+runs fairly quickly on Windows XP and, after work by Robert Dodier, 86
+percent of the test suite is passed successfully, although some individual
+tests crash the suite. If you want to compile Maxima with ABCL lisp, check
+out the Maxima source code and following the instructions in INSTALL.lisp."
+</dd>
+
+<dt>Alex Mizhari
+</dt>
+<dd>
+
+I'm using ABCL for various web projects since aproximately 2004. None of them have gone public (so far), so i can't give a link.
+I released sort of framework for building web apps with ABCL was released into
+open source: <a href="http://abcl-web.sourceforge.net/">abcl-web</a>.
+Another thing probably worth mentioning -- bindings to Jena2 RDF/SPARQL library:
+http://abcl-web.sourceforge.net/rdf.html (it's sort of incomplete but usable, i think).
+<br />
+What i like in ABCL is that it has reasonably stable multithreading, does
+not crash unpredictably (unlike some other implementations) and can be
+fixed in more-or-less easy way if something goes bad, and access to Java
+libs, of course. I had some problems with it, though, to name some:
+<ul>
+<li>SLIME being botched (i suspect due to CLOS invoking compiler which is not
+reentrant),</li>
+<li>CLOS not thread safe,</li>
+<li>compiler producing wrong code.</li>
+</ul>
+That certainly made experience with ABCL less pleasant that it could be,
+but in general it was more-or-less good.
+</dd>
+
+<dt>Alessio Stalla
+</dt>
+<dd>I'm currently integrating ABCL in a small, unreleased open source
+project. It's a sort of graphical object browser for Java (but its GUI
+sucks badly for now...). It can be run locally or as a client-server
+application. I'm adding scripting support so you can access some
+functionality from Lisp (or in principle any other Java Scripting API
+compatible script engine, though I'm focusing on ABCL).
+</dd>
+
+<dt>Ted Kosan
+</dt>
+<dd>I am in the process of integrating ABCL with <a href="http://mathrider.org">MathRider</a> in preparation for when Maxima is able to run on it.
+</dd>
+
+</dl>
+
+</body>
+</html>



From astalla at common-lisp.net  Thu Nov  6 19:27:23 2008
From: astalla at common-lisp.net (Alessio Stalla)
Date: Thu, 06 Nov 2008 19:27:23 +0000
Subject: [armedbear-cvs] r11381 - branches/scripting/j/src/org/armedbear/lisp
Message-ID: <E1KyAVn-0006Ca-Ra@common-lisp.net>

Author: astalla
Date: Thu Nov  6 19:27:23 2008
New Revision: 11381

Log:
Added missing JavaClass.java

Added:
   branches/scripting/j/src/org/armedbear/lisp/JavaClass.java

Added: branches/scripting/j/src/org/armedbear/lisp/JavaClass.java
==============================================================================
--- (empty file)
+++ branches/scripting/j/src/org/armedbear/lisp/JavaClass.java	Thu Nov  6 19:27:23 2008
@@ -0,0 +1,147 @@
+/*
+ * BuiltInClass.java
+ *
+ * Copyright (C) 2003-2007 Peter Graves
+ * $Id: BuiltInClass.java 11297 2008-08-31 13:26:45Z ehuelsmann $
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ */
+
+package org.armedbear.lisp;
+
+import java.util.HashMap;
+import java.util.HashSet;
+import java.util.LinkedList;
+import java.util.Map;
+import java.util.Queue;
+import java.util.Set;
+import java.util.Stack;
+
+public class JavaClass extends LispClass {
+
+	private Class<?> javaClass;
+	//There is no point for this Map to be weak since values keep a reference to the corresponding
+	//key (the Java class). This should not be a problem since Java classes are limited in number - 
+	//if they grew indefinitely, the JVM itself would crash.
+	private static final Map<Class<?>, JavaClass> cache = new HashMap<Class<?>, JavaClass>();
+
+	private JavaClass(Class<?> javaClass) {
+		this.javaClass = javaClass;
+		setDirectSuperclass(BuiltInClass.JAVA_OBJECT);
+	}
+
+	private void initCPL() {
+		LispObject cpl = Lisp.NIL;
+		try {
+			cpl = cpl.push(BuiltInClass.CLASS_T);
+			cpl = cpl.push(BuiltInClass.JAVA_OBJECT);
+			Set<Class<?>> alreadySeen = new HashSet<Class<?>>();
+			Stack<JavaClass> stack = new Stack<JavaClass>();
+			Class<?> theClass = javaClass;
+			boolean stop = false;
+			while(!stop && theClass != null) {
+				stop = addClass(alreadySeen, stack, theClass);
+				for(Class<?> c : theClass.getInterfaces()) {
+					stop = addClass(alreadySeen, stack, c) && stop; //watch out for short-circuiting!
+				}
+				theClass = theClass.getSuperclass();
+			}
+			while(!stack.isEmpty()) {
+				cpl = cpl.push(stack.pop());
+			}
+		} catch (ConditionThrowable e) {
+			throw new Error("Cannot push class in class precedence list", e);
+		}
+		setCPL(cpl);
+	}
+
+	private static boolean addClass(Set<Class<?>> alreadySeen, Stack<JavaClass> stack, Class<?> theClass) {
+		if(!alreadySeen.contains(theClass)) {
+			alreadySeen.add(theClass);
+			stack.push(findJavaClass(theClass));
+			return false;
+		}
+		return true;
+	}
+
+	public LispObject typeOf() {
+		return Symbol.JAVA_CLASS;
+	}
+
+	public LispObject classOf() {
+		return StandardClass.JAVA_CLASS;
+	}
+
+	public LispObject typep(LispObject type) throws ConditionThrowable {
+		if (type == Symbol.JAVA_CLASS)
+			return T;
+		if (type == StandardClass.JAVA_CLASS)
+			return T;
+		return super.typep(type);
+	}
+
+	public LispObject getDescription() throws ConditionThrowable {
+		return new SimpleString(writeToString());
+	}
+
+	public String writeToString() throws ConditionThrowable {
+		FastStringBuffer sb = new FastStringBuffer("#<JAVA-CLASS ");
+		sb.append(javaClass.getCanonicalName());
+		sb.append('>');
+		return sb.toString();
+	}
+
+	public static JavaClass findJavaClass(Class<?> javaClass) {
+		synchronized (cache) {
+			JavaClass c = cache.get(javaClass);
+			if (c == null) {
+				c = new JavaClass(javaClass);
+				cache.put(javaClass, c);
+				c.initCPL();
+			}
+			return c;
+		}
+	}
+
+	public Class<?> getJavaClass() {
+		return javaClass;
+	}
+
+	public boolean subclassp(LispObject obj) throws ConditionThrowable {
+		if(obj == BuiltInClass.CLASS_T) {
+			return true;
+		}
+		if(obj == BuiltInClass.JAVA_OBJECT) {
+			return true;
+		}
+		if(obj instanceof JavaClass) {
+			return ((JavaClass) obj).getJavaClass().isAssignableFrom(javaClass);
+		}
+		return false;
+	}
+
+	private static final Primitive _FIND_JAVA_CLASS = new Primitive(
+			"%find-java-class", PACKAGE_JAVA, false, "string") {
+		public LispObject execute(LispObject arg) throws ConditionThrowable {
+			try {
+				return findJavaClass(Class.forName((String) arg.getStringValue()));
+			} catch (ClassNotFoundException e) {
+				throw new ConditionThrowable("Cannot find Java class " + arg.getStringValue());
+			}
+		}
+
+	};
+
+}



From vvoutilainen at common-lisp.net  Fri Nov  7 22:55:44 2008
From: vvoutilainen at common-lisp.net (Ville Voutilainen)
Date: Fri, 07 Nov 2008 22:55:44 +0000
Subject: [armedbear-cvs] r11382 - in trunk/j/examples/abcl: .
	interface_implementation_in_lisp javacall_from_lisp
	lispcall_from_java_simple lispcall_from_java_with_params_and_return
Message-ID: <E1KyaEy-0008HO-MK@common-lisp.net>

Author: vvoutilainen
Date: Fri Nov  7 22:55:43 2008
New Revision: 11382

Log:
Examples for using abcl, initial commit.


Added:
   trunk/j/examples/abcl/
   trunk/j/examples/abcl/interface_implementation_in_lisp/
   trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java
   trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java
   trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp
   trunk/j/examples/abcl/javacall_from_lisp/
   trunk/j/examples/abcl/javacall_from_lisp/Main.java
   trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp
   trunk/j/examples/abcl/lispcall_from_java_simple/
   trunk/j/examples/abcl/lispcall_from_java_simple/Main.java
   trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java
   trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp
   trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/
   trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java
   trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp

Added: trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,49 @@
+import org.armedbear.lisp.*;
+
+public class Main
+{
+    /**
+     * This example loads a lisp file and gets two function symbols
+     * from it. The functions return implementations of MyInterface.
+     * The example gets two separate implementations and invokes
+     * the functions in the interface for both implementations.
+     */
+    public static void main(String[] argv)
+    {
+	try
+	    {
+		Interpreter interpreter = Interpreter.createInstance();
+		interpreter.eval("(load \"interface_implementation.lisp\")");
+		// the function is not in a separate package, thus the
+		// correct package is CL-USER. Symbol names are
+		// upper case. Package needs the prefix, because java
+		// also has a class named Package.
+		org.armedbear.lisp.Package defaultPackage = 
+		    Packages.findPackage("CL-USER");
+		Symbol interfacesym = 
+		    defaultPackage.findAccessibleSymbol("GET-INTERFACE");
+		Function interfaceFunction = 
+		    (Function) interfacesym.getSymbolFunction();
+		LispObject myinterface = interfaceFunction.execute();
+		MyInterface x = 
+		    (MyInterface) JavaObject.getObject(myinterface);
+		x.firstFunction();
+		x.secondFunction();
+		Symbol interfacesym2 = 
+		    defaultPackage.
+		    findAccessibleSymbol("GET-ANOTHER-INTERFACE");
+		Function interfaceFunction2 = 
+		    (Function) interfacesym2.getSymbolFunction();
+		LispObject myInterface2 = interfaceFunction2.execute();
+		MyInterface y = 
+		    (MyInterface) JavaObject.getObject(myInterface2);
+		y.firstFunction();
+		y.secondFunction();
+	    }
+	catch (Throwable t)
+	    {
+		System.out.println("abcl exception!");
+		t.printStackTrace();
+	    }
+    }
+}
\ No newline at end of file

Added: trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,8 @@
+/**
+ * Example interface, with two methods.
+ */
+public interface MyInterface
+{
+    public void firstFunction();
+    public void secondFunction();
+}
\ No newline at end of file

Added: trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,60 @@
+; first we define a class hierarchy. No slots defined,
+; we don't need them in the example.
+(defclass base ())
+
+(defclass derived1 (base))
+
+(defclass derived2 (base))
+
+; then a couple of generic methods
+(defgeneric invoke (param) (:documentation "Sample generic function"))
+
+(defgeneric invoke2 (param) (:documentation "Sample generic function"))
+
+; and their methods, for different classes
+(defmethod invoke ((param derived1))
+  (format t "in derived1 invoke~%"))
+
+(defmethod invoke ((param derived2))
+  (format t "in derived2 invoke~%"))
+
+(defmethod invoke2 ((param derived1))
+  (format t "in derived1 invoke2~%"))
+
+(defmethod invoke2 ((param derived2))
+  (format t "in derived2 invoke2~%"))
+
+; closure for interface implementation, closes
+; over a provided object and calls the invoke
+; method with the object. Thus the firstFunction()
+; in MyInterface will call the invoke method.
+(defun make-first-function (object)
+  (lambda () (invoke object)))
+
+; closure for interface implementation, closes
+; over a provided object and invokes the invoke2
+; method with the object. Thus the secondFunction()
+; in MyInterface will call the invoke2 method.
+(defun make-second-function (object)
+  (lambda () (invoke2 object)))
+
+; gets an interface implementation, uses an instance of
+; class derived1
+(defun get-interface ()
+  (let ((firstobject (make-instance 'derived1)))
+    (jinterface-implementation "MyInterface"
+			       "firstFunction" 
+			       (make-first-function firstobject)
+			       "secondFunction"
+			       (make-second-function firstobject))))
+
+; gets an interface implementation, uses an instance of
+; class derived2
+(defun get-another-interface ()
+  (let ((secondobject (make-instance 'derived2)))
+    (jinterface-implementation "MyInterface"
+			       "firstFunction" 
+			       (make-first-function secondobject)
+			       "secondFunction"
+			       (make-second-function secondobject))))
+						

Added: trunk/j/examples/abcl/javacall_from_lisp/Main.java
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/javacall_from_lisp/Main.java	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,42 @@
+import org.armedbear.lisp.*;
+
+public class Main
+{
+    /**
+     * This example creates an Interpreter instance, loads our
+     * lisp code from a file and then looks up a function defined
+     * in the loaded lisp file and executes the function. 
+     *
+     * The function takes a single parameter and invokes a java method
+     * on the object provided. We provide our Main object as the parameter.
+     *
+     */
+    public static void main(String[] argv)
+    {
+	try
+	    {
+		Main thisObject = new Main();
+		Interpreter interpreter = Interpreter.createInstance();
+		interpreter.eval("(load \"lispfunctions.lisp\")");
+		// the function is not in a separate package, thus the
+		// correct package is CL-USER. Symbol names are
+		// upper case. Package needs the prefix, because java
+		// also has a class named Package.
+		org.armedbear.lisp.Package defaultPackage = 
+		    Packages.findPackage("CL-USER");
+		Symbol voidsym = 
+		    defaultPackage.findAccessibleSymbol("VOID-FUNCTION");
+		Function voidFunction = (Function) voidsym.getSymbolFunction();
+		voidFunction.execute(new JavaObject(thisObject));
+	    }
+	catch (Throwable t)
+	    {
+		System.out.println("abcl exception!");
+		t.printStackTrace();
+	    }
+    }
+    public int addTwoNumbers(int a, int b)
+    {
+	return a + b;
+    }
+}
\ No newline at end of file

Added: trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,18 @@
+; we need to get the
+; 1) class (Main)
+; 2) classes of the parameters (int)
+; 3) method reference (getting that requires the class
+; of our object and the classes of the parameters
+
+; After that we can invoke the function with jcall,
+; giving the method reference, the object and the parameters.
+; The result is a lisp object (no need to do jobject-lisp-value), 
+; unless we invoke the method
+; with jcall-raw. 
+(defun void-function (param)
+  (let* ((class (jclass "Main"))
+	 (intclass (jclass "int"))
+	 (method (jmethod class "addTwoNumbers" intclass intclass))
+	 (result (jcall method param 2 4)))
+    (format t "in void-function, result of calling addTwoNumbers(2, 4): ~a~%" result)))
+

Added: trunk/j/examples/abcl/lispcall_from_java_simple/Main.java
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/lispcall_from_java_simple/Main.java	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,24 @@
+import org.armedbear.lisp.*;
+
+public class Main
+{
+    /**
+     * This example creates an Interpreter instance, loads our
+     * lisp code from a file and then evaluates a function defined
+     * in the loaded lisp file.
+     */
+    public static void main(String[] argv)
+    {
+	try
+	    {
+		Interpreter interpreter = Interpreter.createInstance();
+		interpreter.eval("(load \"lispfunction.lisp\")"); 
+		LispObject myInterface = interpreter.eval("(lispfunction)");
+	    }
+	catch (Throwable t)
+	    {
+		System.out.println("abcl exception!");
+		t.printStackTrace();
+	    }
+    }
+}
\ No newline at end of file

Added: trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,33 @@
+import org.armedbear.lisp.*;
+
+public class MainAlternative
+{
+    /**
+     * This example creates an Interpreter instance, loads our
+     * lisp code from a file and then looks up a function defined
+     * in the loaded lisp file and executes the function.
+     */
+    public static void main(String[] argv)
+    {
+	try
+	    {
+		Interpreter interpreter = Interpreter.createInstance();
+		interpreter.eval("(load \"lispfunction.lisp\")");
+		// the function is not in a separate package, thus the
+		// correct package is CL-USER. Symbol names are
+		// upper case. Package needs the prefix, because java
+		// also has a class named Package.
+		org.armedbear.lisp.Package defaultPackage = 
+		    Packages.findPackage("CL-USER");
+		Symbol sym = 
+		    defaultPackage.findAccessibleSymbol("LISPFUNCTION");
+		Function function = (Function) sym.getSymbolFunction();
+		function.execute();
+	    }
+	catch (Throwable t)
+	    {
+		System.out.println("abcl exception!");
+		t.printStackTrace();
+	    }
+    }
+}
\ No newline at end of file

Added: trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,2 @@
+(defun lispfunction ()
+  (format t "in lispfunction~%"))

Added: trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,51 @@
+import org.armedbear.lisp.*;
+
+public class Main
+{
+    /**
+     * This example creates an Interpreter instance, loads our
+     * lisp code from a file and then looks up two functions defined
+     * in the loaded lisp file and executes the functions. 
+     *
+     * The first function takes a single parameter and prints its value, 
+     * so we can provide any Object, so we use a String.
+     *
+     * The second function takes two numbers, adds them together, prints
+     * the parameters and the result, and returns the result. 
+     * We use two integers as parameters and just print the result
+     * from java side.
+     */
+    public static void main(String[] argv)
+    {
+	try
+	    {
+		Interpreter interpreter = Interpreter.createInstance();
+		interpreter.eval("(load \"lispfunctions.lisp\")");
+		// the function is not in a separate package, thus the
+		// correct package is CL-USER. Symbol names are
+		// upper case. Package needs the prefix, because java
+		// also has a class named Package.
+		org.armedbear.lisp.Package defaultPackage = 
+		    Packages.findPackage("CL-USER");
+
+		Symbol voidsym = 
+		    defaultPackage.findAccessibleSymbol("VOID-FUNCTION");
+		Function voidFunction = (Function) voidsym.getSymbolFunction();
+		voidFunction.execute(new JavaObject("String given from java"));
+
+		Symbol intsym = 
+		    defaultPackage.findAccessibleSymbol("INT-FUNCTION");
+		Function intFunction = (Function) intsym.getSymbolFunction();
+		LispObject result = 
+		    intFunction.execute(new JavaObject(1), 
+					new JavaObject(6));
+		System.out.print("The result on the java side: ");
+		System.out.println(result.intValue());
+	    }
+	catch (Throwable t)
+	    {
+		System.out.println("abcl exception!");
+		t.printStackTrace();
+	    }
+    }
+}
\ No newline at end of file

Added: trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp	Fri Nov  7 22:55:43 2008
@@ -0,0 +1,14 @@
+; param comes from java, so accessing it require
+; calling jobject-lisp-value on it
+(defun void-function (param)
+  (format t "in void-function, param: ~a~%" (jobject-lisp-value param)))
+
+; params come from java, so accessing them require
+; calling jobject-lisp-value on them
+(defun int-function (jparam1 jparam2)
+  (let* ((param1 (jobject-lisp-value jparam1))
+	 (param2 (jobject-lisp-value jparam2))
+	 (result (+ param1 param2)))
+    (format t "in int-function, params: ~a ~a~%result: ~a~%" 
+	    param1 param2 result) 
+    result))
\ No newline at end of file



From vvoutilainen at common-lisp.net  Sat Nov  8 01:18:59 2008
From: vvoutilainen at common-lisp.net (Ville Voutilainen)
Date: Sat, 08 Nov 2008 01:18:59 +0000
Subject: [armedbear-cvs] r11383 - in trunk/j/examples/abcl:
	interface_implementation_in_lisp javacall_from_lisp
	lispcall_from_java_simple lispcall_from_java_with_params_and_return
Message-ID: <E1KycTb-0006gW-13@common-lisp.net>

Author: vvoutilainen
Date: Sat Nov  8 01:18:58 2008
New Revision: 11383

Log:
Add copyright/license headers.


Modified:
   trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java
   trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java
   trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp
   trunk/j/examples/abcl/javacall_from_lisp/Main.java
   trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp
   trunk/j/examples/abcl/lispcall_from_java_simple/Main.java
   trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java
   trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp
   trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java
   trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp

Modified: trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java
==============================================================================
--- trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java	(original)
+++ trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java	Sat Nov  8 01:18:58 2008
@@ -1,3 +1,23 @@
+/*
+ * Main.java
+ *
+ * Copyright (C) 2008 Ville Voutilainen
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ */
+
 import org.armedbear.lisp.*;
 
 public class Main

Modified: trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java
==============================================================================
--- trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java	(original)
+++ trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java	Sat Nov  8 01:18:58 2008
@@ -1,3 +1,23 @@
+/*
+ * MyInterface.java
+ *
+ * Copyright (C) 2008 Ville Voutilainen
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ */
+
 /**
  * Example interface, with two methods.
  */

Modified: trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp
==============================================================================
--- trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp	(original)
+++ trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp	Sat Nov  8 01:18:58 2008
@@ -1,3 +1,21 @@
+;;; interface_implementation.lisp
+;;;
+;;; Copyright (C) 2008 Ville Voutilainen
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
 ; first we define a class hierarchy. No slots defined,
 ; we don't need them in the example.
 (defclass base ())

Modified: trunk/j/examples/abcl/javacall_from_lisp/Main.java
==============================================================================
--- trunk/j/examples/abcl/javacall_from_lisp/Main.java	(original)
+++ trunk/j/examples/abcl/javacall_from_lisp/Main.java	Sat Nov  8 01:18:58 2008
@@ -1,3 +1,23 @@
+/*
+ * Main.java
+ *
+ * Copyright (C) 2008 Ville Voutilainen
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ */
+
 import org.armedbear.lisp.*;
 
 public class Main

Modified: trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp
==============================================================================
--- trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp	(original)
+++ trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp	Sat Nov  8 01:18:58 2008
@@ -1,3 +1,21 @@
+;;; lispfunctions.lisp
+;;;
+;;; Copyright (C) 2008 Ville Voutilainen
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
 ; we need to get the
 ; 1) class (Main)
 ; 2) classes of the parameters (int)

Modified: trunk/j/examples/abcl/lispcall_from_java_simple/Main.java
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_simple/Main.java	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_simple/Main.java	Sat Nov  8 01:18:58 2008
@@ -1,3 +1,23 @@
+/*
+ * Main.java
+ *
+ * Copyright (C) 2008 Ville Voutilainen
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ */
+
 import org.armedbear.lisp.*;
 
 public class Main

Modified: trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java	Sat Nov  8 01:18:58 2008
@@ -1,3 +1,23 @@
+/*
+ * MainAlternative.java
+ *
+ * Copyright (C) 2008 Ville Voutilainen
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ */
+
 import org.armedbear.lisp.*;
 
 public class MainAlternative

Modified: trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp	Sat Nov  8 01:18:58 2008
@@ -1,2 +1,20 @@
+;;; lispfunction.lisp
+;;;
+;;; Copyright (C) 2008 Ville Voutilainen
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
 (defun lispfunction ()
   (format t "in lispfunction~%"))

Modified: trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java	Sat Nov  8 01:18:58 2008
@@ -1,3 +1,23 @@
+/*
+ * Main.java
+ *
+ * Copyright (C) 2008 Ville Voutilainen
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ */
+
 import org.armedbear.lisp.*;
 
 public class Main

Modified: trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp	Sat Nov  8 01:18:58 2008
@@ -1,3 +1,21 @@
+;;; lispfunctions.lisp
+;;;
+;;; Copyright (C) 2008 Ville Voutilainen
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
 ; param comes from java, so accessing it require
 ; calling jobject-lisp-value on it
 (defun void-function (param)



From vvoutilainen at common-lisp.net  Sat Nov  8 09:27:30 2008
From: vvoutilainen at common-lisp.net (Ville Voutilainen)
Date: Sat, 08 Nov 2008 09:27:30 +0000
Subject: [armedbear-cvs] r11384 - in trunk/j/examples/abcl:
	interface_implementation_in_lisp javacall_from_lisp
	lispcall_from_java_simple lispcall_from_java_with_params_and_return
Message-ID: <E1Kyk6L-0004OO-Ur@common-lisp.net>

Author: vvoutilainen
Date: Sat Nov  8 09:27:29 2008
New Revision: 11384

Log:
Add Id tags and thus keyword properties.


Modified:
   trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java   (contents, props changed)
   trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java   (contents, props changed)
   trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp   (contents, props changed)
   trunk/j/examples/abcl/javacall_from_lisp/Main.java   (contents, props changed)
   trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp   (contents, props changed)
   trunk/j/examples/abcl/lispcall_from_java_simple/Main.java   (contents, props changed)
   trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java   (contents, props changed)
   trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp   (contents, props changed)
   trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java   (contents, props changed)
   trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp   (contents, props changed)

Modified: trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java
==============================================================================
--- trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java	(original)
+++ trunk/j/examples/abcl/interface_implementation_in_lisp/Main.java	Sat Nov  8 09:27:29 2008
@@ -2,6 +2,7 @@
  * Main.java
  *
  * Copyright (C) 2008 Ville Voutilainen
+ * $Id$
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License

Modified: trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java
==============================================================================
--- trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java	(original)
+++ trunk/j/examples/abcl/interface_implementation_in_lisp/MyInterface.java	Sat Nov  8 09:27:29 2008
@@ -2,6 +2,7 @@
  * MyInterface.java
  *
  * Copyright (C) 2008 Ville Voutilainen
+ * $Id$
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License

Modified: trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp
==============================================================================
--- trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp	(original)
+++ trunk/j/examples/abcl/interface_implementation_in_lisp/interface_implementation.lisp	Sat Nov  8 09:27:29 2008
@@ -1,6 +1,7 @@
 ;;; interface_implementation.lisp
 ;;;
 ;;; Copyright (C) 2008 Ville Voutilainen
+;;; $Id$
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License

Modified: trunk/j/examples/abcl/javacall_from_lisp/Main.java
==============================================================================
--- trunk/j/examples/abcl/javacall_from_lisp/Main.java	(original)
+++ trunk/j/examples/abcl/javacall_from_lisp/Main.java	Sat Nov  8 09:27:29 2008
@@ -2,6 +2,7 @@
  * Main.java
  *
  * Copyright (C) 2008 Ville Voutilainen
+ * $Id$
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License

Modified: trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp
==============================================================================
--- trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp	(original)
+++ trunk/j/examples/abcl/javacall_from_lisp/lispfunctions.lisp	Sat Nov  8 09:27:29 2008
@@ -1,6 +1,7 @@
 ;;; lispfunctions.lisp
 ;;;
 ;;; Copyright (C) 2008 Ville Voutilainen
+;;; $Id$
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License

Modified: trunk/j/examples/abcl/lispcall_from_java_simple/Main.java
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_simple/Main.java	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_simple/Main.java	Sat Nov  8 09:27:29 2008
@@ -2,6 +2,7 @@
  * Main.java
  *
  * Copyright (C) 2008 Ville Voutilainen
+ * $Id$
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License

Modified: trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_simple/MainAlternative.java	Sat Nov  8 09:27:29 2008
@@ -2,6 +2,7 @@
  * MainAlternative.java
  *
  * Copyright (C) 2008 Ville Voutilainen
+ * $Id$
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License

Modified: trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_simple/lispfunction.lisp	Sat Nov  8 09:27:29 2008
@@ -1,6 +1,7 @@
 ;;; lispfunction.lisp
 ;;;
 ;;; Copyright (C) 2008 Ville Voutilainen
+;;; $Id$
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License

Modified: trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/Main.java	Sat Nov  8 09:27:29 2008
@@ -2,6 +2,7 @@
  * Main.java
  *
  * Copyright (C) 2008 Ville Voutilainen
+ * $Id$
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License

Modified: trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp
==============================================================================
--- trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp	(original)
+++ trunk/j/examples/abcl/lispcall_from_java_with_params_and_return/lispfunctions.lisp	Sat Nov  8 09:27:29 2008
@@ -1,6 +1,7 @@
 ;;; lispfunctions.lisp
 ;;;
 ;;; Copyright (C) 2008 Ville Voutilainen
+;;; $Id$
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License



From vvoutilainen at common-lisp.net  Sat Nov  8 19:06:53 2008
From: vvoutilainen at common-lisp.net (Ville Voutilainen)
Date: Sat, 08 Nov 2008 19:06:53 +0000
Subject: [armedbear-cvs] r11385 -
	trunk/j/examples/abcl/java_exception_in_lisp
Message-ID: <E1Kyt93-00012V-OY@common-lisp.net>

Author: vvoutilainen
Date: Sat Nov  8 19:06:53 2008
New Revision: 11385

Log:
Add a simple example of catching a java exception in lisp code.


Added:
   trunk/j/examples/abcl/java_exception_in_lisp/
   trunk/j/examples/abcl/java_exception_in_lisp/Main.java   (contents, props changed)
   trunk/j/examples/abcl/java_exception_in_lisp/lispfunctions.lisp   (contents, props changed)

Added: trunk/j/examples/abcl/java_exception_in_lisp/Main.java
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/java_exception_in_lisp/Main.java	Sat Nov  8 19:06:53 2008
@@ -0,0 +1,63 @@
+/*
+ * Main.java
+ *
+ * Copyright (C) 2008 Ville Voutilainen
+ * $Id$
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ */
+
+import org.armedbear.lisp.*;
+
+public class Main
+{
+    /**
+     * This example creates an Interpreter instance, loads our
+     * lisp code from a file and then looks up a function defined
+     * in the loaded lisp file and executes the function. 
+     *
+     * The function takes a single parameter and invokes a java method
+     * on the object provided. We provide our Main object as the parameter.
+     *
+     */
+    public static void main(String[] argv)
+    {
+	try
+	    {
+		Main thisObject = new Main();
+		Interpreter interpreter = Interpreter.createInstance();
+		interpreter.eval("(load \"lispfunctions.lisp\")");
+		// the function is not in a separate package, thus the
+		// correct package is CL-USER. Symbol names are
+		// upper case. Package needs the prefix, because java
+		// also has a class named Package.
+		org.armedbear.lisp.Package defaultPackage = 
+		    Packages.findPackage("CL-USER");
+		Symbol voidsym = 
+		    defaultPackage.findAccessibleSymbol("VOID-FUNCTION");
+		Function voidFunction = (Function) voidsym.getSymbolFunction();
+		voidFunction.execute(new JavaObject(thisObject));
+	    }
+	catch (Throwable t)
+	    {
+		System.out.println("abcl exception!");
+		t.printStackTrace();
+	    }
+    }
+    public int addTwoNumbers(int a, int b)
+    {
+	throw new RuntimeException("Exception from java code");
+    }
+}
\ No newline at end of file

Added: trunk/j/examples/abcl/java_exception_in_lisp/lispfunctions.lisp
==============================================================================
--- (empty file)
+++ trunk/j/examples/abcl/java_exception_in_lisp/lispfunctions.lisp	Sat Nov  8 19:06:53 2008
@@ -0,0 +1,38 @@
+;;; lispfunctions.lisp
+;;;
+;;; Copyright (C) 2008 Ville Voutilainen
+;;; $Id$
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License
+;;; as published by the Free Software Foundation; either version 2
+;;; of the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+; we need to get the
+; 1) class (Main)
+; 2) classes of the parameters (int)
+; 3) method reference (getting that requires the class
+; of our object and the classes of the parameters
+
+; After that we can invoke the function with jcall,
+; giving the method reference, the object and the parameters.
+; The function throws an exception, so we wrap the call in
+; handler-case.
+(defun void-function (param)
+  (let* ((class (jclass "Main"))
+	 (intclass (jclass "int"))
+	 (method (jmethod class "addTwoNumbers" intclass intclass)))
+    (handler-case
+	(jcall method param 2 4)
+      (java-exception (exception)
+	(format t "Caught a java exception in void-function~%")))))
+



From ehuelsmann at common-lisp.net  Sun Nov  9 11:05:25 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 09 Nov 2008 11:05:25 +0000
Subject: [armedbear-cvs] r11386 - trunk/j
Message-ID: <E1Kz86f-0003V0-Fu@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov  9 11:05:24 2008
New Revision: 11386

Log:
Don't warn about Java 1.6.0_10, as it seems to resolve our 1.6 performance issues.

Patch by: mevenson


Modified:
   trunk/j/build.xml

Modified: trunk/j/build.xml
==============================================================================
--- trunk/j/build.xml	(original)
+++ trunk/j/build.xml	Sun Nov  9 11:05:24 2008
@@ -191,12 +191,17 @@
       <exec executable="hostname" os="Linux" outputproperty="hostname"/>
 
       <condition property="abcl.java.version">
-	<matches string="${java.version}" pattern="1\.5"/>
+	<or>
+	  <matches string="${java.version}" pattern="1\.5"/>
+	  <matches string="${java.version}" pattern="1\.6\.0_1[0-9]"/>
+	</or>  
       </condition>
       <echo>java.version: ${java.version}</echo>
     </target>
     
-    <target name="abcl.java.warning" unless="abcl.java.version">
+    <target name="abcl.java.warning" 
+	    depends="abcl.pre-compile"
+	    unless="abcl.java.version">
       <echo>WARNING: Java version ${java.version} not recommended.</echo>
     </target>
 	



From ehuelsmann at common-lisp.net  Sun Nov  9 11:29:07 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 09 Nov 2008 11:29:07 +0000
Subject: [armedbear-cvs] r11387 - trunk/j/src/org/armedbear/lisp
Message-ID: <E1Kz8Tb-0004M5-SH@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov  9 11:29:07 2008
New Revision: 11387

Log:
Document API that Java-side Lisp streams need to implement.
Add some @Override markers.

Modified:
   trunk/j/src/org/armedbear/lisp/Stream.java

Modified: trunk/j/src/org/armedbear/lisp/Stream.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Stream.java	(original)
+++ trunk/j/src/org/armedbear/lisp/Stream.java	Sun Nov  9 11:29:07 2008
@@ -36,6 +36,12 @@
 import java.math.BigInteger;
 import java.util.BitSet;
 
+
+/** The stream class
+ * 
+ * A base class for all Lisp built-in streams.
+ * 
+ */
 public class Stream extends LispObject
 {
   protected LispObject elementType;
@@ -55,7 +61,11 @@
   // Character output.
   private Writer writer;
 
-  // The number of characters on the current line of output (-1 if unknown).
+  /** The number of characters on the current line of output
+   * 
+   * Used to determine whether additional line feeds are
+   * required when calling FRESH-LINE
+   */
   protected int charPos;
 
   // Binary input.
@@ -188,16 +198,19 @@
     open = b;
   }
 
+  @Override
   public LispObject typeOf()
   {
     return Symbol.STREAM;
   }
 
+  @Override
   public LispObject classOf()
   {
     return BuiltInClass.STREAM;
   }
 
+  @Override
   public LispObject typep(LispObject typeSpecifier) throws ConditionThrowable
   {
     if (typeSpecifier == Symbol.STREAM)
@@ -1518,6 +1531,7 @@
     return T;
   }
 
+  @Override
   public String toString()
   {
     return unreadableString("STREAM");
@@ -1618,7 +1632,11 @@
                                 " is neither a string nor a character."));
   }
 
-  // Returns -1 at end of file.
+  /** Reads a character off an underlying stream
+   * 
+   * @return a character, or -1 at end-of-file
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   protected int _readChar() throws ConditionThrowable
   {
     try
@@ -1647,6 +1665,11 @@
     return -1;
   }
 
+  /** Puts a character back into the (underlying) stream
+   * 
+   * @param n
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   protected void _unreadChar(int n) throws ConditionThrowable
   {
     try
@@ -1667,6 +1690,11 @@
       }
   }
 
+  /** Returns a boolean indicating input readily available
+   * 
+   * @return true if a character is available
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   protected boolean _charReady() throws ConditionThrowable
   {
     try
@@ -1686,6 +1714,12 @@
     return false;
   }
 
+  /** Writes a character into the underlying stream,
+   * updating charPos while doing so
+   * 
+   * @param c
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   public void _writeChar(char c) throws ConditionThrowable
   {
     try
@@ -1710,6 +1744,14 @@
       }
   }
 
+  /** Writes a series of characters in the underlying stream,
+   * updating charPos while doing so
+   * 
+   * @param chars
+   * @param start
+   * @param end
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   public void _writeChars(char[] chars, int start, int end)
     throws ConditionThrowable
   {
@@ -1749,6 +1791,12 @@
       }
   }
 
+  /** Writes a string to the underlying stream,
+   * updating charPos while doing so
+   * 
+   * @param s
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   public void _writeString(String s) throws ConditionThrowable
   {
     try
@@ -1776,6 +1824,12 @@
       }
   }
 
+  /** Writes a string to the underlying stream, appending
+   * a new line and updating charPos while doing so
+   * 
+   * @param s
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   public void _writeLine(String s) throws ConditionThrowable
   {
     try
@@ -1797,6 +1851,11 @@
   }
 
   // Reads an 8-bit byte.
+  /** Reads an 8-bit byte off the underlying stream
+   * 
+   * @return
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   public int _readByte() throws ConditionThrowable
   {
     try
@@ -1812,6 +1871,11 @@
   }
 
   // Writes an 8-bit byte.
+  /** Writes an 8-bit byte off the underlying stream
+   * 
+   * @param n
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   public void _writeByte(int n) throws ConditionThrowable
   {
     try
@@ -1829,6 +1893,10 @@
       }
   }
 
+  /** Flushes any buffered output in the (underlying) stream
+   * 
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   public void _finishOutput() throws ConditionThrowable
   {
     try
@@ -1844,6 +1912,11 @@
       }
   }
 
+  /** Reads all input from the underlying stream,
+   * until _charReady() indicates no more input to be available
+   * 
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   public void _clearInput() throws ConditionThrowable
   {
     if (reader != null)
@@ -1865,16 +1938,33 @@
       }
   }
 
+  /** Returns a (non-negative) file position integer or a negative value
+   * if the position cannot be determined.
+   * 
+   * @return non-negative value as a position spec
+   * @return negative value for 'unspecified'
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   protected long _getFilePosition() throws ConditionThrowable
   {
     return -1;
   }
 
+  /** Sets the file position based on a position designator passed in arg
+   * 
+   * @param arg File position specifier as described in the CLHS
+   * @return true on success, false on failure
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   protected boolean _setFilePosition(LispObject arg) throws ConditionThrowable
   {
     return false;
   }
 
+  /** Closes the stream and underlying streams
+   * 
+   * @throws org.armedbear.lisp.ConditionThrowable
+   */
   public void _close() throws ConditionThrowable
   {
     try



From ehuelsmann at common-lisp.net  Mon Nov 10 22:30:53 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Mon, 10 Nov 2008 22:30:53 +0000
Subject: [armedbear-cvs] r11388 - trunk/j/src/org/armedbear/lisp
Message-ID: <E1KzfHZ-00060x-Jt@common-lisp.net>

Author: ehuelsmann
Date: Mon Nov 10 22:30:51 2008
New Revision: 11388

Log:
Add @Override markers.

Modified:
   trunk/j/src/org/armedbear/lisp/Stream.java

Modified: trunk/j/src/org/armedbear/lisp/Stream.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Stream.java	(original)
+++ trunk/j/src/org/armedbear/lisp/Stream.java	Mon Nov 10 22:30:51 2008
@@ -2034,6 +2034,7 @@
     new Primitive("%stream-write-char", PACKAGE_SYS, true,
                   "character output-stream")
     {
+      @Override
       public LispObject execute(LispObject first, LispObject second)
         throws ConditionThrowable
       {
@@ -2057,6 +2058,7 @@
     new Primitive("%write-char", PACKAGE_SYS, false,
                   "character output-stream")
     {
+      @Override
       public LispObject execute(LispObject first, LispObject second)
         throws ConditionThrowable
       {
@@ -2092,6 +2094,7 @@
     new Primitive("%write-string", PACKAGE_SYS, false,
                   "string output-stream start end")
     {
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third, LispObject fourth)
         throws ConditionThrowable
@@ -2153,6 +2156,7 @@
   private static final Primitive _FINISH_OUTPUT =
     new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream")
     {
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         return finishOutput(arg);
@@ -2163,6 +2167,7 @@
   private static final Primitive _FORCE_OUTPUT =
     new Primitive("%force-output", PACKAGE_SYS, false, "output-stream")
     {
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         return finishOutput(arg);
@@ -2193,6 +2198,7 @@
   private static final Primitive CLEAR_INPUT =
     new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream")
     {
+      @Override
       public LispObject execute(LispObject[] args) throws ConditionThrowable
       {
         if (args.length > 1)
@@ -2213,6 +2219,7 @@
   private static final Primitive _CLEAR_OUTPUT =
     new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream")
     {
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         if (arg == T) // *TERMINAL-IO*
@@ -2229,6 +2236,7 @@
   private static final Primitive CLOSE =
     new Primitive(Symbol.CLOSE, "stream &key abort")
     {
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         try
@@ -2240,6 +2248,8 @@
             return type_error(arg, Symbol.STREAM);
           }
       }
+
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third)
         throws ConditionThrowable
@@ -2264,6 +2274,7 @@
   private static final Primitive OUT_SYNONYM_OF =
     new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator")
     {
+      @Override
       public LispObject execute (LispObject arg) throws ConditionThrowable
       {
         if (arg instanceof Stream)
@@ -2281,6 +2292,7 @@
   private static final Primitive WRITE_8_BITS =
     new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream")
     {
+      @Override
       public LispObject execute (LispObject first, LispObject second)
         throws ConditionThrowable
       {
@@ -2313,6 +2325,7 @@
     new Primitive("read-8-bits", PACKAGE_SYS, true,
                   "stream &optional eof-error-p eof-value")
     {
+      @Override
       public LispObject execute (LispObject first, LispObject second,
                                  LispObject third)
         throws ConditionThrowable
@@ -2320,6 +2333,8 @@
         return checkBinaryInputStream(first).readByte((second != NIL),
                                                       third);
       }
+
+      @Override
       public LispObject execute (LispObject[] args) throws ConditionThrowable
       {
         int length = args.length;
@@ -2338,6 +2353,7 @@
     new Primitive(Symbol.READ_LINE,
                   "&optional input-stream eof-error-p eof-value recursive-p")
     {
+      @Override
       public LispObject execute() throws ConditionThrowable
       {
         final LispObject obj = Symbol.STANDARD_INPUT.symbolValue();
@@ -2352,6 +2368,7 @@
           }
         return stream.readLine(true, NIL);
       }
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         if (arg == T)
@@ -2369,6 +2386,7 @@
           }
         return stream.readLine(true, NIL);
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second)
         throws ConditionThrowable
       {
@@ -2387,6 +2405,7 @@
           }
         return stream.readLine(second != NIL, NIL);
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third)
         throws ConditionThrowable
@@ -2406,6 +2425,7 @@
           }
         return stream.readLine(second != NIL, third);
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third, LispObject fourth)
         throws ConditionThrowable
@@ -2433,6 +2453,7 @@
   private static final Primitive _READ_FROM_STRING =
     new Primitive("%read-from-string", PACKAGE_SYS, false)
     {
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third, LispObject fourth,
                                 LispObject fifth, LispObject sixth)
@@ -2469,6 +2490,7 @@
     new Primitive(Symbol.READ,
                   "&optional input-stream eof-error-p eof-value recursive-p")
     {
+      @Override
       public LispObject execute() throws ConditionThrowable
       {
         final LispThread thread = LispThread.currentThread();
@@ -2484,6 +2506,7 @@
           }
         return stream.read(true, NIL, false, thread);
       }
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         final LispThread thread = LispThread.currentThread();
@@ -2502,6 +2525,7 @@
           }
         return stream.read(true, NIL, false, thread);
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second)
         throws ConditionThrowable
       {
@@ -2521,6 +2545,7 @@
           }
         return stream.read(second != NIL, NIL, false, thread);
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third)
         throws ConditionThrowable
@@ -2541,6 +2566,7 @@
           }
         return stream.read(second != NIL, third, false, thread);
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third, LispObject fourth)
         throws ConditionThrowable
@@ -2569,6 +2595,7 @@
     new Primitive(Symbol.READ_PRESERVING_WHITESPACE,
                   "&optional input-stream eof-error-p eof-value recursive-p")
     {
+      @Override
       public LispObject execute(LispObject[] args) throws ConditionThrowable
       {
         int length = args.length;
@@ -2591,25 +2618,30 @@
     new Primitive(Symbol.READ_CHAR,
                   "&optional input-stream eof-error-p eof-value recursive-p")
     {
+      @Override
       public LispObject execute() throws ConditionThrowable
       {
         return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar();
       }
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         return inSynonymOf(arg).readChar();
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second)
         throws ConditionThrowable
       {
         return inSynonymOf(first).readChar(second != NIL, NIL);
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third)
         throws ConditionThrowable
       {
         return inSynonymOf(first).readChar(second != NIL, third);
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third, LispObject fourth)
         throws ConditionThrowable
@@ -2623,6 +2655,7 @@
   private static final Primitive READ_CHAR_NO_HANG =
     new Primitive("read-char-no-hang", "&optional input-stream eof-error-p eof-value recursive-p") {
 
+      @Override
       public LispObject execute(LispObject[] args) throws ConditionThrowable
       {
         int length = args.length;
@@ -2642,6 +2675,7 @@
   private static final Primitive READ_DELIMITED_LIST =
     new Primitive("read-delimited-list", "char &optional input-stream recursive-p") {
 
+      @Override
       public LispObject execute(LispObject[] args) throws ConditionThrowable
       {
         int length = args.length;
@@ -2659,10 +2693,12 @@
   private static final Primitive UNREAD_CHAR =
     new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream")
     {
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         return getStandardInput().unreadChar(checkCharacter(arg));
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second)
         throws ConditionThrowable
       {
@@ -2676,6 +2712,7 @@
     new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true,
                   "vector stream start end")
     {
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third, LispObject fourth)
         throws ConditionThrowable
@@ -2703,6 +2740,7 @@
     new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true,
                   "vector stream start end")
     {
+      @Override
       public LispObject execute(LispObject first, LispObject second,
                                 LispObject third, LispObject fourth)
         throws ConditionThrowable
@@ -2732,6 +2770,7 @@
   private static final Primitive FILE_POSITION =
     new Primitive("file-position", "stream &optional position-spec")
     {
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         final Stream stream;
@@ -2745,6 +2784,7 @@
           }
         return stream.getFilePosition();
       }
+      @Override
       public LispObject execute(LispObject first, LispObject second)
         throws ConditionThrowable
       {
@@ -2765,6 +2805,7 @@
   private static final Primitive STREAM_LINE_NUMBER =
     new Primitive("stream-line-number", PACKAGE_SYS, false, "stream")
     {
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         Stream stream = checkStream(arg);
@@ -2776,6 +2817,7 @@
   private static final Primitive STREAM_OFFSET =
     new Primitive("stream-offset", PACKAGE_SYS, false, "stream")
     {
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         Stream stream = checkStream(arg);
@@ -2787,6 +2829,7 @@
   private static final Primitive STREAM_CHARPOS =
     new Primitive("stream-charpos", PACKAGE_SYS, false)
     {
+      @Override
       public LispObject execute(LispObject arg) throws ConditionThrowable
       {
         Stream stream = checkCharacterOutputStream(arg);
@@ -2798,6 +2841,7 @@
   private static final Primitive STREAM_SET_CHARPOS =
     new Primitive("stream-%set-charpos", PACKAGE_SYS, false)
     {
+      @Override
       public LispObject execute(LispObject first, LispObject second)
         throws ConditionThrowable
       {



From astalla at common-lisp.net  Mon Nov 10 22:34:37 2008
From: astalla at common-lisp.net (Alessio Stalla)
Date: Mon, 10 Nov 2008 22:34:37 +0000
Subject: [armedbear-cvs] r11389 - in
	branches/scripting/j/src/org/armedbear/lisp: . scripting
	scripting/lisp
Message-ID: <E1KzfLB-0006DR-H9@common-lisp.net>

Author: astalla
Date: Mon Nov 10 22:34:36 2008
New Revision: 11389

Log:
- Added support for lisp-this for interface implementations
- Correctly implemented package-based jmake-proxy
- Passed only the method name to lisp functions implementing java interfaces, instead of the full blown method metaobject

Modified:
   branches/scripting/j/src/org/armedbear/lisp/JProxy.java
   branches/scripting/j/src/org/armedbear/lisp/java.lisp
   branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
   branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp

Modified: branches/scripting/j/src/org/armedbear/lisp/JProxy.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/JProxy.java	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/JProxy.java	Mon Nov 10 22:34:36 2008
@@ -124,6 +124,8 @@
   
   	//NEW IMPLEMENTATION by Alessio Stalla 
   
+  	private static final Map<Object, LispObject> proxyMap = new WeakHashMap<Object, LispObject>();
+  
   	public static class LispInvocationHandler implements InvocationHandler {
   		
   		private Function function;
@@ -148,21 +150,23 @@
 		@Override
 		public Object invoke(Object proxy, Method method, Object[] args) throws Throwable {
 	    	if(hashCodeMethod.equals(method)) {
-	    		return proxy.hashCode();
+	    		return System.identityHashCode(proxy);
 	    	}
 	    	if(equalsMethod.equals(method)) {
-	    		return proxy.equals(args[0]);
+	    		return proxy == args[0];
 	    	}
 	    	if(toStringMethod.equals(method)) {
-	    		return proxy.toString();
+	    		return proxy.getClass().getName() + '@' + Integer.toHexString(proxy.hashCode());
 	    	}
 	    	
 	    	if(args == null) {
 	    		args = new Object[0];
 	    	}
 			LispObject[] lispArgs = new LispObject[args.length + 2];
-			lispArgs[0] = toLispObject(proxy);
-			lispArgs[1] = new JavaObject(method);
+			synchronized(proxyMap) {
+				lispArgs[0] = toLispObject(proxyMap.get(proxy));
+			}
+			lispArgs[1] = new SimpleString(method.getName());
 			for(int i = 0; i < args.length; i++) {
 				lispArgs[i + 2] = toLispObject(args[i]);
 			}
@@ -187,7 +191,6 @@
 	      		if(!(args[0] instanceof Function)) {
 	      			return error(new TypeError(args[0], Symbol.FUNCTION));
 	      		}
-	      		
 	      		return new JavaObject(new LispInvocationHandler((Function) args[0]));
 	      	}
 	    };
@@ -198,7 +201,7 @@
 		
 	      	public LispObject execute(final LispObject[] args) throws ConditionThrowable {
 	      		int length = args.length;
-	      		if (length != 2) {
+	      		if (length != 3) {
 	      			return error(new WrongNumberOfArgumentsException(this));
 	      		}
 	      		if(!(args[0] instanceof JavaObject) ||
@@ -207,14 +210,17 @@
 	      		}
 	      		if(!(args[1] instanceof JavaObject) ||
  	      		   !(((JavaObject) args[1]).javaInstance() instanceof InvocationHandler)) {
-	 	      			return error(new TypeError(args[1], new SimpleString(InvocationHandler.class.getName())));
-	 	      		}
+ 	      			return error(new TypeError(args[1], new SimpleString(InvocationHandler.class.getName())));
+ 	      		}
 	      		Class<?> iface = (Class<?>) ((JavaObject) args[0]).javaInstance();
-	      		InvocationHandler invocationHandler = (InvocationHandler) ((JavaObject) args[1]).javaInstance(); 
+	      		InvocationHandler invocationHandler = (InvocationHandler) ((JavaObject) args[1]).javaInstance();
 	      		Object proxy = Proxy.newProxyInstance(
 	      				iface.getClassLoader(),
 	      				new Class[] { iface },
 	      				invocationHandler);
+	      		synchronized(proxyMap) {
+	      			proxyMap.put(proxy, args[2]);
+	      		}
 	      		return new JavaObject(proxy);
 	      	}
 	    };    

Modified: branches/scripting/j/src/org/armedbear/lisp/java.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/java.lisp	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/java.lisp	Mon Nov 10 22:34:36 2008
@@ -69,41 +69,57 @@
 (when (autoloadp 'jmake-proxy)
   (fmakunbound 'jmake-proxy))
 
-(defgeneric jmake-proxy (interface implementation))
+(defgeneric jmake-proxy (interface implementation &optional lisp-this)
+  (:documentation "Returns a proxy Java object implementing the provided interface using methods implemented in Lisp - typically closures, but implementations are free to provide other mechanisms. You can pass an optional 'lisp-this' object that will be passed to the implementing methods as their first argument. If you don't provide this object, NIL will be used. The second argument of the Lisp methods is the name of the Java method being implemented. This has the implication that overloaded methods are merged, so you have to manually discriminate them if you want to. The remaining arguments are java-objects wrapping the method's parameters."))
 
-;(defun jmake-proxy (interface implementation)
-;  (jmake-proxy-impl interface implementation))
+(defmethod jmake-proxy (interface invocation-handler &optional lisp-this)
+  "Basic implementation that directly uses an invocation handler."
+  (%jmake-proxy (jclass interface) invocation-handler lisp-this))
+
+(defmethod jmake-proxy (interface (implementation function) &optional lisp-this)
+  "Implements a Java interface forwarding method calls to a Lisp function."
+  (%jmake-proxy (jclass interface) (jmake-invocation-handler implementation) lisp-this))
 
-(defmethod jmake-proxy (interface invocation-handler)
-  (%jmake-proxy (jclass interface) invocation-handler))
-
-(defmethod jmake-proxy (interface (implementation function))
-  (%jmake-proxy (jclass interface) (jmake-invocation-handler implementation)))
-
-#|
-TODO java->lisp wrong (coding at night has nasty effects)
-(defmethod jmake-proxy (interface (implementation package))
+(defmethod jmake-proxy (interface (implementation package) &optional lisp-this)
+  "Implements a Java interface mapping Java method names to symbols in a given package. javaMethodName is mapped to a JAVA-METHOD-NAME symbol. An error is signaled if no such symbol exists in the package, or if the symbol exists but does not name a function."
   (flet ((java->lisp (name)
-	   (substitute #\- #\. (string-upcase name))))
+	   (with-output-to-string (str)
+	     (let ((last-lower-p nil))
+	       (map nil (lambda (char)
+			  (let ((upper-p (char= (char-upcase char) char)))
+			    (when (and last-lower-p upper-p)
+			      (princ "-" str))
+			    (setf last-lower-p (not upper-p))
+			    (princ (char-upcase char) str)))
+		    name)))))
     (%jmake-proxy (jclass interface)
 		  (jmake-invocation-handler 
 		   (lambda (obj method &rest args)
-		     (let* ((sym (find-symbol (java->lisp (jmethod-name method))))
-			    (fn (symbol-function sym)))
-		       (if fn
-			   (apply fn obj args)
-			   (error "Function ~A, implementation of method ~A, not found in ~A"
-				  sym (jmethod-name method) implementation))))))))
-|#
-(defmethod jmake-proxy (interface (implementation hash-table))
+		     (let ((sym (find-symbol
+				 (java->lisp method)
+				 implementation)))
+		       (unless sym
+			 (error "Symbol ~A, implementation of method ~A, not found in ~A"
+				  (java->lisp method)
+				  method
+				  implementation))
+			 (if (fboundp sym)
+			     (apply (symbol-function sym) obj method args)
+			     (error "Function ~A, implementation of method ~A, not found in ~A"
+				    sym method implementation)))))
+		  lisp-this)))
+
+(defmethod jmake-proxy (interface (implementation hash-table) &optional lisp-this)
+  "Implements a Java interface using closures in an hash-table keyed by Java method name."
   (%jmake-proxy (jclass interface)
 		(jmake-invocation-handler 
 		 (lambda (obj method &rest args)
-		   (let ((fn (gethash (jmethod-name method) implementation)))
+		   (let ((fn (gethash method implementation)))
 		     (if fn
 			 (apply fn obj args)
 			 (error "Implementation for method ~A not found in ~A"
-				(jmethod-name method) implementation)))))))
+				method implementation)))))
+		lisp-this))
 
 (defun jobject-class (obj)
   "Returns the Java class that OBJ belongs to"

Modified: branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java	Mon Nov 10 22:34:36 2008
@@ -278,15 +278,11 @@
 			in = new ReaderInputStream(ctx.getReader());
 			out = new WriterOutputStream(ctx.getWriter());
 			Stream outStream = new Stream(out, Symbol.CHARACTER);
+			Stream inStream  = new Stream(in,  Symbol.CHARACTER);
 			retVal = evalScript.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
 										makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
-										new Stream(in, Symbol.CHARACTER),
-										outStream,
+										inStream, outStream,
 										new SimpleString(code), new JavaObject(ctx));
-			outStream._finishOutput();
-			out.flush();
-			//in.close();
-			out.close();
 			return toJava(retVal);
 		} catch (ConditionThrowable e) {
 			throw new ScriptException(new Exception(e));
@@ -322,24 +318,6 @@
 
 	private static Object toJava(LispObject lispObject) throws ConditionThrowable {
 		return lispObject.javaInstance();
-		/*
-		if(lispObject instanceof JavaObject) {
-			return ((JavaObject) lispObject).getObject();
-		} else if(lispObject instanceof SingleFloat) {
-			return ((SingleFloat) lispObject).value;
-		} else if(lispObject instanceof DoubleFloat) {
-			return ((DoubleFloat) lispObject).value;
-		} else if(lispObject instanceof LispCharacter) {
-			return ((LispCharacter) lispObject).value;
-		} else if(lispObject instanceof Bignum) {
-			return ((Bignum) lispObject).value;
-		} else if(lispObject instanceof Fixnum) {
-			return ((Fixnum) lispObject).value;
-		} else if(lispObject instanceof SimpleString) {
-			return ((SimpleString) lispObject).javaInstance();
-		} else {
-			return lispObject;
-		}*/
 	}
 	
 	public static LispObject toLisp(Object javaObject) {
@@ -385,8 +363,11 @@
 	
 	@Override
 	public <T> T getInterface(Class<T> clasz) {
-		//return getInterface(Lisp.NIL, clasz);
-		throw new UnsupportedOperationException("Not implemented");
+		try {
+			return getInterface(eval("(cl:find-package '#:ABCL-SCRIPT-USER)"), clasz);
+		} catch (ScriptException e) {
+			throw new Error(e);
+		}
 	}
 
 	@SuppressWarnings("unchecked")
@@ -394,9 +375,8 @@
 	public <T> T getInterface(Object thiz, Class<T> clasz) {
 		try {
 			Symbol s = findSymbol("jmake-proxy", "JAVA");
-			LispObject f = s.getSymbolFunction();
 			JavaObject iface = new JavaObject(clasz);
-			return (T) ((JavaObject) f.execute(iface, (LispObject) thiz)).javaInstance();
+			return (T) ((JavaObject) s.execute(iface, (LispObject) thiz)).javaInstance();
 		} catch (ConditionThrowable e) {
 			throw new Error(e);
 		}

Modified: branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp	Mon Nov 10 22:34:36 2008
@@ -18,8 +18,6 @@
 
 (in-package :abcl-script)
 
-(defvar *java-interface-implementations* (make-hash-table :test #'equal))
-
 (defconstant +global-scope+
   (jfield "javax.script.ScriptContext" "GLOBAL_SCOPE"))
 



From ehuelsmann at common-lisp.net  Sat Nov 15 22:12:32 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 15 Nov 2008 22:12:32 +0000
Subject: [armedbear-cvs] r11390 - trunk/j/src/org/armedbear/lisp
Message-ID: <E1L1TNY-0003fp-5v@common-lisp.net>

Author: ehuelsmann
Date: Sat Nov 15 22:12:31 2008
New Revision: 11390

Log:
Make JAVA-EXCEPTION objects print more human readable.

Inspired by: Mark Evenson


Modified:
   trunk/j/src/org/armedbear/lisp/print-object.lisp

Modified: trunk/j/src/org/armedbear/lisp/print-object.lisp
==============================================================================
--- trunk/j/src/org/armedbear/lisp/print-object.lisp	(original)
+++ trunk/j/src/org/armedbear/lisp/print-object.lisp	Sat Nov 15 22:12:31 2008
@@ -20,6 +20,7 @@
 (in-package #:system)
 
 (require 'clos)
+(require 'java)
 
 (when (autoloadp 'print-object)
   (fmakunbound 'print-object))
@@ -104,4 +105,14 @@
                 (cell-error-name x)))
       (format stream "The variable ~S is unbound." (cell-error-name x))))
 
+(defmethod print-object ((e java:java-exception) stream)
+  (if *print-escape*
+      (print-unreadable-object (e stream :type t :identity t)
+        (format stream "~A"
+                (java:jcall (java:jmethod "java.lang.Object" "toString")
+                            (java:java-exception-cause e))))
+      (format stream "Java exception '~A'."
+              (java:jcall (java:jmethod "java.lang.Object" "toString")
+                          (java:java-exception-cause e)))))
+
 (provide 'print-object)



From ehuelsmann at common-lisp.net  Sun Nov 16 21:41:26 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 16 Nov 2008 21:41:26 +0000
Subject: [armedbear-cvs] r11392 - trunk/j/src/org/armedbear/lisp
Message-ID: <E1L1pN0-0004zX-H3@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov 16 21:41:25 2008
New Revision: 11392

Log:
Add @Override markers as I'm working on the file.

Modified:
   trunk/j/src/org/armedbear/lisp/FileStream.java

Modified: trunk/j/src/org/armedbear/lisp/FileStream.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/FileStream.java	(original)
+++ trunk/j/src/org/armedbear/lisp/FileStream.java	Sun Nov 16 21:41:25 2008
@@ -119,16 +119,19 @@
             outputBuffer = null;
     }
 
+    @Override
     public LispObject typeOf()
     {
         return Symbol.FILE_STREAM;
     }
 
+    @Override
     public LispObject classOf()
     {
         return BuiltInClass.FILE_STREAM;
     }
 
+    @Override
     public LispObject typep(LispObject typeSpecifier) throws ConditionThrowable
     {
         if (typeSpecifier == Symbol.FILE_STREAM)
@@ -143,6 +146,7 @@
         return pathname;
     }
 
+    @Override
     public LispObject listen() throws ConditionThrowable
     {
         try {
@@ -158,6 +162,7 @@
         return NIL;
     }
 
+    @Override
     public LispObject fileLength() throws ConditionThrowable
     {
         final long length;
@@ -185,6 +190,7 @@
         return number(length / bytesPerUnit);
     }
 
+    @Override
     public LispObject readLine(boolean eofError, LispObject eofValue)
         throws ConditionThrowable
     {
@@ -213,6 +219,7 @@
     }
 
     // Returns -1 at end of file.
+    @Override
     protected int _readChar() throws ConditionThrowable
     {
         try {
@@ -252,6 +259,7 @@
         return -1;
     }
 
+    @Override
     protected void _unreadChar(int n) throws ConditionThrowable
     {
         if (inputBuffer != null && inputBufferOffset > 0) {
@@ -299,11 +307,13 @@
         }
     }
 
+    @Override
     protected boolean _charReady() throws ConditionThrowable
     {
         return true;
     }
 
+    @Override
     public void _writeChar(char c) throws ConditionThrowable
     {
         if (c == '\n') {
@@ -317,6 +327,7 @@
         }
     }
 
+    @Override
     public void _writeChars(char[] chars, int start, int end)
         throws ConditionThrowable
     {
@@ -345,6 +356,7 @@
         }
     }
 
+    @Override
     public void _writeString(String s) throws ConditionThrowable
     {
         final int length = s.length();
@@ -373,6 +385,7 @@
         }
     }
 
+    @Override
     public void _writeLine(String s) throws ConditionThrowable
     {
         _writeString(s);
@@ -383,6 +396,7 @@
     }
 
     // Reads an 8-bit byte.
+    @Override
     public int _readByte() throws ConditionThrowable
     {
         if (inputBuffer != null)
@@ -401,6 +415,7 @@
     }
 
     // Writes an 8-bit byte.
+    @Override
     public void _writeByte(int n) throws ConditionThrowable
     {
         if (outputBuffer != null) {
@@ -418,12 +433,14 @@
         }
     }
 
+    @Override
     public void _finishOutput() throws ConditionThrowable
     {
         if (outputBuffer != null)
             flushOutputBuffer();
     }
 
+    @Override
     public void _clearInput() throws ConditionThrowable
     {
         try {
@@ -438,6 +455,7 @@
         }
     }
 
+    @Override
     protected long _getFilePosition() throws ConditionThrowable
     {
         if (inputBuffer != null) {
@@ -457,6 +475,7 @@
         }
     }
 
+    @Override
     protected boolean _setFilePosition(LispObject arg) throws ConditionThrowable
     {
         if (outputBuffer != null)
@@ -481,6 +500,7 @@
         return true;
     }
 
+    @Override
     public void _close() throws ConditionThrowable
     {
         if (outputBuffer != null)
@@ -549,6 +569,7 @@
         }
     }
 
+    @Override
     public String writeToString() throws ConditionThrowable
     {
         return unreadableString(Symbol.FILE_STREAM);
@@ -559,6 +580,7 @@
         new Primitive("make-file-stream", PACKAGE_SYS, true,
                       "pathname namestring element-type direction if-exists")
     {
+        @Override
         public LispObject execute(LispObject first, LispObject second,
                                   LispObject third, LispObject fourth,
                                   LispObject fifth)



From astalla at common-lisp.net  Wed Nov 19 20:57:09 2008
From: astalla at common-lisp.net (Alessio Stalla)
Date: Wed, 19 Nov 2008 20:57:09 +0000
Subject: [armedbear-cvs] r11393 - in
	branches/scripting/j/src/org/armedbear/lisp/scripting: . lisp
Message-ID: <E1L2u6n-00044R-AB@common-lisp.net>

Author: astalla
Date: Wed Nov 19 20:57:04 2008
New Revision: 11393

Log:
Implemented the Compilable interface and refactored the script evaluation code in the process.

Modified:
   branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
   branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp
   branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/packages.lisp

Modified: branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java	Wed Nov 19 20:57:04 2008
@@ -30,8 +30,11 @@
 
 import javax.script.AbstractScriptEngine;
 import javax.script.Bindings;
+import javax.script.Compilable;
+import javax.script.CompiledScript;
 import javax.script.Invocable;
 import javax.script.ScriptContext;
+import javax.script.ScriptEngine;
 import javax.script.ScriptEngineFactory;
 import javax.script.ScriptException;
 import javax.script.SimpleBindings;
@@ -58,13 +61,16 @@
 import org.armedbear.lisp.scripting.util.WriterOutputStream;
 
 
-public class AbclScriptEngine extends AbstractScriptEngine implements Invocable {
+public class AbclScriptEngine extends AbstractScriptEngine implements Invocable, Compilable {
 
 	private Interpreter interpreter;
 	private LispObject nonThrowingDebugHook;
 	private Function evalScript;
+	private Function compileScript;
+	private Function evalCompiledScript;
 
 	public AbclScriptEngine(Interpreter interpreter, boolean enableThrowingDebugger) {
+		
 		this.interpreter = interpreter;
 		Interpreter.initializeLisp();
 		final LispThread thread = LispThread.currentThread();
@@ -80,8 +86,10 @@
 			loadFromClasspath("/org/armedbear/lisp/scripting/lisp/packages.lisp");
 			loadFromClasspath("/org/armedbear/lisp/scripting/lisp/abcl-script.lisp");
 			evalScript = (Function) this.findSymbol("EVAL-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
+			compileScript = (Function) this.findSymbol("COMPILE-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
+			evalCompiledScript = (Function) this.findSymbol("EVAL-COMPILED-SCRIPT", "ABCL-SCRIPT").getSymbolFunction();
 		} catch (ConditionThrowable e) {
-			e.printStackTrace();
+			throw new Error(e);
 		}
 	}
 
@@ -269,8 +277,7 @@
 		return super.getContext();
 	}
 
-	@Override
-	public Object eval(String code, ScriptContext ctx) throws ScriptException {
+	private Object eval(Function evaluator, LispObject code, ScriptContext ctx) throws ScriptException {
 		ReaderInputStream in = null;
 		WriterOutputStream out = null;
 		LispObject retVal = null;
@@ -279,10 +286,10 @@
 			out = new WriterOutputStream(ctx.getWriter());
 			Stream outStream = new Stream(out, Symbol.CHARACTER);
 			Stream inStream  = new Stream(in,  Symbol.CHARACTER);
-			retVal = evalScript.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
-										makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
-										inStream, outStream,
-										new SimpleString(code), new JavaObject(ctx));
+			retVal = evaluator.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
+									   makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
+									   inStream, outStream,
+									   code, new JavaObject(ctx));
 			return toJava(retVal);
 		} catch (ConditionThrowable e) {
 			throw new ScriptException(new Exception(e));
@@ -290,18 +297,27 @@
 			throw new ScriptException(e);
 		}
 	}
-
+	
 	@Override
-	public Object eval(Reader code, ScriptContext ctx) throws ScriptException {
+	public Object eval(String code, ScriptContext ctx) throws ScriptException {
+		return eval(evalScript, new SimpleString(code), ctx);
+	}
+
+	private static String toString(Reader reader) throws IOException {
 		StringWriter w = new StringWriter();
 		int i;
+		i = reader.read();
+		while (i != -1) {
+			w.write(i);
+			i = reader.read();
+		}
+		return w.toString();
+	}
+	
+	@Override
+	public Object eval(Reader code, ScriptContext ctx) throws ScriptException {
 		try {
-			i = code.read();
-			while (i != -1) {
-				w.write(i);
-				i = code.read();
-			}
-			return eval(w.toString(), ctx);
+			return eval(toString(code), ctx);
 		} catch (IOException e) {
 			return new ScriptException(e);
 		}
@@ -350,7 +366,7 @@
             	try {
 					v.aset(i, new JavaObject(array[i]));
 				} catch (ConditionThrowable e) {
-					throw new Error("Can't set simplevector index " + i, e);
+					throw new Error("Can't set SimpleVector index " + i, e);
 				}
             }
             return v;
@@ -431,4 +447,46 @@
 		throw new UnsupportedOperationException("Common Lisp does not have methods in the Java sense.");
 	}
 
+	public class AbclCompiledScript extends CompiledScript {
+
+		private LispObject function;
+		
+		public AbclCompiledScript(LispObject function) {
+			this.function = function;
+		}
+		
+		@Override
+		public Object eval(ScriptContext context) throws ScriptException {
+			return AbclScriptEngine.this.eval(evalCompiledScript, function, context);
+		}
+
+		@Override
+		public ScriptEngine getEngine() {
+			return AbclScriptEngine.this;
+		}
+
+	}
+
+	
+	@Override
+	public CompiledScript compile(String script) throws ScriptException {
+		try {
+			Function f = (Function) compileScript.execute(new SimpleString(script));
+			return new AbclCompiledScript(f);
+		} catch (ConditionThrowable e) {
+			throw new ScriptException(new Exception(e));
+		} catch(ClassCastException e) {
+			throw new ScriptException(e);
+		}
+	}
+
+	@Override
+	public CompiledScript compile(Reader script) throws ScriptException {
+		try {
+			return compile(toString(script));
+		} catch (IOException e) {
+			throw new ScriptException(e);
+		}
+	}
+
 }

Modified: branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp	Wed Nov 19 20:57:04 2008
@@ -45,28 +45,45 @@
 	:collect `(jcall +put-binding+
 		   ,java-bindings ,(car jbinding) ,(car binding))))
 
+(defmacro with-script-context ((global-bindings engine-bindings stdin stdout script-context)
+			       body)
+  (let ((actual-global-bindings (gensym))
+	(actual-engine-bindings (gensym)))
+    `(let ((*package* (find-package :abcl-script-user))
+	   (*standard-input* ,stdin)
+	   (*standard-output* ,stdout)
+	   (,actual-global-bindings (generate-bindings ,global-bindings))
+	   (,actual-engine-bindings (generate-bindings ,engine-bindings)))
+      (eval `(let ((*standard-input* ,,stdin)
+		   (*standard-output* ,,stdout)
+		   (*package* (find-package :abcl-script-user)))
+	      (let (,@,actual-global-bindings)
+		(let (,@,actual-engine-bindings)
+		  (prog1
+		      (progn ,@,body)
+		    (finish-output *standard-output*)
+		    ,@(generate-java-bindings
+		       ,global-bindings 
+		       ,actual-global-bindings
+		       (jcall +get-bindings+ ,script-context +global-scope+))
+		    ,@(generate-java-bindings
+		       ,engine-bindings 
+		       ,actual-engine-bindings
+		       (jcall +get-bindings+ ,script-context +engine-scope+))))))))))
+  
 (defun eval-script (global-bindings engine-bindings stdin stdout
 		    code-string script-context)
-  (let ((*package* (find-package :abcl-script-user))
-	(*standard-input* stdin)
-	(*standard-output* stdout)
-	(actual-global-bindings (generate-bindings global-bindings))
-	(actual-engine-bindings (generate-bindings engine-bindings)))
-    (eval `(let ((*standard-input* ,stdin)
-		 (*standard-output* ,stdout)
-		 (*package* (find-package :abcl-script-user)))
-	    (let (, at actual-global-bindings)
-	      (let (, at actual-engine-bindings)
-		(prog1
-		    (progn
-		      ,@(read-from-string
-			 (concatenate 'string "(" code-string ")")))
-		  (finish-output *standard-output*)
-		  ,@(generate-java-bindings
-		     global-bindings 
-		     actual-global-bindings
-		     (jcall +get-bindings+ script-context +global-scope+))
-		  ,@(generate-java-bindings
-		     engine-bindings 
-		     actual-engine-bindings
-		     (jcall +get-bindings+ script-context +engine-scope+)))))))))
\ No newline at end of file
+  (with-script-context (global-bindings engine-bindings stdin stdout script-context)
+    (read-from-string
+     (concatenate 'string "(" code-string ")"))))
+
+(defun eval-compiled-script (global-bindings engine-bindings stdin stdout
+			     function script-context)
+  (with-script-context (global-bindings engine-bindings stdin stdout script-context)
+    `((funcall ,function))))
+
+(defun compile-script (code-string)
+  (let ((*package* (find-package :abcl-script-user)))
+    (eval `(compile nil
+	    (lambda ()
+	      ,@(read-from-string (concatenate 'string "(" code-string ")")))))))
\ No newline at end of file

Modified: branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/packages.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/packages.lisp	(original)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/packages.lisp	Wed Nov 19 20:57:04 2008
@@ -19,6 +19,8 @@
 (defpackage :abcl-script
   (:use :cl :java)
   (:export #:eval-script
+	   #:compile-script
+	   #:eval-compiled-script
 	   #:define-java-interface-implementation
 	   #:find-java-interface-implementation
 	   #:implement-java-interface))



From ehuelsmann at common-lisp.net  Sun Nov 23 11:27:07 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 23 Nov 2008 11:27:07 +0000
Subject: [armedbear-cvs] r11394 - branches/open-external-format
Message-ID: <E1L4D7L-000188-Qa@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov 23 11:27:07 2008
New Revision: 11394

Log:
Create branch to commit support :EXTERNAL-FORMAT progress for OPEN.

Added:
   branches/open-external-format/
      - copied from r11393, /trunk/j/



From ehuelsmann at common-lisp.net  Sun Nov 23 11:29:10 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 23 Nov 2008 11:29:10 +0000
Subject: [armedbear-cvs] r11395 - in branches/open-external-format: .
	src/org/armedbear/lisp src/org/armedbear/lisp/util
Message-ID: <E1L4D9K-0001CT-O1@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov 23 11:29:10 2008
New Revision: 11395

Log:
Commit in-progress implementation.

Note: This commit still fails ansi test FILE-POSITION.5: it just locks up.

Added:
   branches/open-external-format/src/org/armedbear/lisp/util/
   branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java
Modified:
   branches/open-external-format/build.xml
   branches/open-external-format/src/org/armedbear/lisp/FileStream.java
   branches/open-external-format/src/org/armedbear/lisp/open.lisp

Modified: branches/open-external-format/build.xml
==============================================================================
--- branches/open-external-format/build.xml	(original)
+++ branches/open-external-format/build.xml	Sun Nov 23 11:29:10 2008
@@ -100,6 +100,7 @@
 
     <patternset id="abcl.source.java">
       <include name="org/armedbear/lisp/*.java"/>
+      <include name="org/armedbear/lisp/util/*.java"/>
       <include name="org/armedbear/Main.java"/>
     </patternset>
     
@@ -117,6 +118,7 @@
 
     <patternset id="abcl.objects">
       <include name="org/armedbear/lisp/*.class"/>
+      <include name="org/armedbear/lisp/util/*.class"/>
       <include name="org/armedbear/lisp/*.cls"/> 
       <include name="org/armedbear/lisp/*.abcl"/>
       <patternset refid="abcl.source.lisp.dist"/>

Modified: branches/open-external-format/src/org/armedbear/lisp/FileStream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/FileStream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/FileStream.java	Sun Nov 23 11:29:10 2008
@@ -37,29 +37,47 @@
 import java.io.FileNotFoundException;
 import java.io.IOException;
 import java.io.RandomAccessFile;
+import org.armedbear.lisp.util.RandomAccessCharacterFile;
 
 public final class FileStream extends Stream
 {
-    private static final int BUFSIZE = 4096;
-
-    private final RandomAccessFile raf;
-    private final RandomAccessFile in;
-    private final RandomAccessFile out;
+    private final RandomAccessCharacterFile racf;
+    private final RandomAccessCharacterFile in;
+    private final RandomAccessCharacterFile out;
     private final Pathname pathname;
     private final int bytesPerUnit;
-    private final byte[] inputBuffer;
-    private final byte[] outputBuffer;
-
-    private long inputBufferFilePosition;
-    private int inputBufferOffset;
-    private int inputBufferCount;
-    private int outputBufferOffset;
 
+    public enum EolStyle {
+        CR,
+        CRLF,
+        LF
+    }
+    
+    static final private Symbol keywordCodePage = Packages.internKeyword("CODE-PAGE");
+    
+    private final static EolStyle platformEolStyle = Utilities.isPlatformWindows ? EolStyle.CRLF : EolStyle.LF;
+    
+    private EolStyle eolStyle = platformEolStyle;
+    private char eolChar = 0;
+    
     public FileStream(Pathname pathname, String namestring,
                       LispObject elementType, LispObject direction,
-                      LispObject ifExists)
+                      LispObject ifExists, String encoding, EolStyle eol)
         throws IOException
     {
+        /* externalFormat is a LispObject of which the first char is a
+         * name of a character encoding (such as :UTF-8 or :ISO-8859-1), used
+         * by ABCL as a string designator, unless the name is :CODE-PAGE.
+         * A real string is (thus) also allowed.
+         * 
+         * Then, a property list follows with 3 possible keys:
+         *   :ID (values: code page numbers supported by MS-DOS/IBM-DOS/MS-Windows
+         *   :EOL-STYLE (values: :CR / :LF / :CRLF [none means native])
+         *   :LITTLE-ENDIAN (values: NIL / T)
+         * 
+         * These definitions have been taken from FLEXI-STREAMS:
+         *    http://www.weitz.de/flexi-streams/#make-external-format
+         */
         final File file = new File(namestring);
         String mode = null;
         if (direction == Keyword.INPUT) {
@@ -73,10 +91,12 @@
             isInputStream = true;
             isOutputStream = true;
         }
+        
         Debug.assertTrue(mode != null);
-        raf = new RandomAccessFile(file, mode);
-        in = isInputStream ? raf : null;
-        out = isOutputStream ? raf : null;
+        RandomAccessFile raf = new RandomAccessFile(file, mode);
+        racf = new RandomAccessCharacterFile(raf, encoding);
+        in = isInputStream ? racf : null;
+        out = isOutputStream ? racf : null;
         // ifExists is ignored unless we have an output stream.
         if (isOutputStream) {
             final long length = file.isFile() ? file.length() : 0;
@@ -105,18 +125,7 @@
             }
             bytesPerUnit = width / 8;
         }
-        if (isBinaryStream && isInputStream && !isOutputStream && bytesPerUnit == 1)
-            inputBuffer = new byte[BUFSIZE];
-        else if (isCharacterStream && isInputStream && !isOutputStream)
-            inputBuffer = new byte[BUFSIZE];
-        else
-            inputBuffer = null;
-        if (isBinaryStream && isOutputStream && !isInputStream && bytesPerUnit == 1)
-            outputBuffer = new byte[BUFSIZE];
-        else if (isCharacterStream && isOutputStream && !isInputStream)
-            outputBuffer = new byte[BUFSIZE];
-        else
-            outputBuffer = null;
+        eolChar = (eol == EolStyle.CR) ? '\r' : '\n';
     }
 
     @Override
@@ -150,7 +159,7 @@
     public LispObject listen() throws ConditionThrowable
     {
         try {
-            return in.getFilePointer() < in.length() ? T : NIL;
+            return in.dataIsAvailableForRead() ? T : NIL;
         }
         catch (NullPointerException e) {
             streamNotInputStream();
@@ -168,7 +177,7 @@
         final long length;
         if (isOpen()) {
             try {
-                length = raf.length();
+                length = racf.length();
             }
             catch (IOException e) {
                 error(new StreamError(this, e));
@@ -190,60 +199,28 @@
         return number(length / bytesPerUnit);
     }
 
-    @Override
-    public LispObject readLine(boolean eofError, LispObject eofValue)
-        throws ConditionThrowable
-    {
-        if (inputBuffer != null) {
-            final LispThread thread = LispThread.currentThread();
-            final FastStringBuffer sb = new FastStringBuffer();
-            while (true) {
-                int n = _readChar();
-                if (n < 0) {
-                    // End of file.
-                    if (sb.length() == 0) {
-                        if (eofError)
-                            return error(new EndOfFile(this));
-                        return thread.setValues(eofValue, T);
-                    }
-                    return thread.setValues(new SimpleString(sb), T);
-                }
-                char c = (char) n;
-                if (c == '\n')
-                    return thread.setValues(new SimpleString(sb), NIL);
-                else
-                    sb.append(c);
-            }
-        } else
-            return super.readLine(eofError, eofValue);
-    }
-
     // Returns -1 at end of file.
     @Override
     protected int _readChar() throws ConditionThrowable
     {
         try {
-            int c = _readByte();
-            if (Utilities.isPlatformWindows) {
+            int c = in.getReader().read();
+            if (eolStyle == EolStyle.CRLF) {
                 if (c == '\r') {
-                    int c2 = _readByte();
+                    long mark = in.position();
+                    int c2 = in.getReader().read();
                     if (c2 == '\n') {
                         ++lineNumber;
                         return c2;
                     }
                     // '\r' was not followed by '\n'
-                    if (inputBuffer != null && inputBufferOffset > 0) {
-                        --inputBufferOffset;
-                    } else {
-                        clearInputBuffer();
-                        long pos = in.getFilePointer();
-                        if (pos > 0)
-                            in.seek(pos - 1);
-                    }
+                    // we cannot depend on characters to contain 1 byte only
+                    // so we need to revert to the last known position.
+                    in.position(mark);
                 }
                 return c;
             }
-            if (c == '\n') {
+            if (c == eolChar) {
                 ++lineNumber;
                 return c;
             }
@@ -262,45 +239,8 @@
     @Override
     protected void _unreadChar(int n) throws ConditionThrowable
     {
-        if (inputBuffer != null && inputBufferOffset > 0) {
-            --inputBufferOffset;
-            if (n != '\n')
-                return;
-            --lineNumber;
-            if (!Utilities.isPlatformWindows)
-                return;
-            // Check for preceding '\r'.
-            if (inputBufferOffset > 0) {
-                if (inputBuffer[--inputBufferOffset] != '\r')
-                    ++inputBufferOffset;
-                return;
-            }
-            // We can't go back far enough in the buffered input. Reset and
-            // fall through...
-            ++inputBufferOffset;
-        }
         try {
-            long pos;
-            if (inputBuffer != null && inputBufferFilePosition >= 0)
-                pos = inputBufferFilePosition + inputBufferOffset;
-            else
-                pos = in.getFilePointer();
-            clearInputBuffer();
-            if (pos > 0)
-                in.seek(pos - 1);
-            if (Utilities.isPlatformWindows && n == '\n') {
-                // Check for preceding '\r'.
-                pos = in.getFilePointer();
-                if (pos > 0) {
-                    in.seek(pos - 1);
-                    n = in.read();
-                    if (n == '\r')
-                        in.seek(pos - 1);
-                }
-            }
-        }
-        catch (NullPointerException e) {
-            streamNotInputStream();
+            in.unreadChar((char)n);
         }
         catch (IOException e) {
             error(new StreamError(this, e));
@@ -316,14 +256,19 @@
     @Override
     public void _writeChar(char c) throws ConditionThrowable
     {
-        if (c == '\n') {
-            if (Utilities.isPlatformWindows)
-                _writeByte((byte)'\r');
-            _writeByte((byte)c);
-            charPos = 0;
-        } else {
-            _writeByte((byte)c);
-            ++charPos;
+        try {
+            if (c == '\n') {
+                if (eolStyle == EolStyle.CRLF)
+                    out.getWriter().write((byte)'\r');
+                out.getWriter().write((byte)eolChar);
+                charPos = 0;
+            } else {
+                out.getWriter().write((byte)c);
+                ++charPos;
+            }
+        }
+        catch (IOException e) {
+            error(new StreamError(this, e));
         }
     }
 
@@ -331,67 +276,51 @@
     public void _writeChars(char[] chars, int start, int end)
         throws ConditionThrowable
     {
-        if (Utilities.isPlatformWindows) {
-            for (int i = start; i < end; i++) {
-                char c = chars[i];
-                if (c == '\n') {
-                    _writeByte((byte)'\r');
-                    _writeByte((byte)c);
-                    charPos = 0;
-                } else {
-                    _writeByte((byte)c);
-                    ++charPos;
+        try {
+            if (eolStyle == EolStyle.CRLF) {
+                for (int i = start; i < end; i++) {
+                    char c = chars[i];
+                    if (c == '\n') {
+                        out.getWriter().write((byte)'\r');
+                        out.getWriter().write((byte)'\n');
+                        charPos = 0;
+                    } else {
+                        out.getWriter().write((byte)c);
+                        ++charPos;
+                    }
+                }
+            } else {
+                for (int i = start; i < end; i++) {
+                    char c = chars[i];
+                    out.getWriter().write((byte)c);
+                    if (c == '\n') {
+                        out.getWriter().write((byte)eolChar);
+                        charPos = 0;
+                    } else {
+                        out.getWriter().write((byte)c);
+                        ++charPos;
+                    }
                 }
-            }
-        } else {
-            // We're not on Windows, so no newline conversion is necessary.
-            for (int i = start; i < end; i++) {
-                char c = chars[i];
-                _writeByte((byte)c);
-                if (c == '\n')
-                    charPos = 0;
-                else
-                    ++charPos;
             }
         }
+        catch (IOException e) {
+            error(new StreamError(this, e));
+        }
     }
 
     @Override
     public void _writeString(String s) throws ConditionThrowable
     {
-        final int length = s.length();
-        if (Utilities.isPlatformWindows) {
-            for (int i = 0; i < length; i++) {
-                char c = s.charAt(i);
-                if (c == '\n') {
-                    _writeByte((byte)'\r');
-                    _writeByte((byte)c);
-                    charPos = 0;
-                } else {
-                    _writeByte((byte)c);
-                    ++charPos;
-                }
-            }
-        } else {
-            // We're not on Windows, so no newline conversion is necessary.
-            for (int i = 0; i < length; i++) {
-                char c = s.charAt(i);
-                _writeByte((byte)c);
-                if (c == '\n')
-                    charPos = 0;
-                else
-                    ++charPos;
-            }
-        }
+        _writeChars(s.toCharArray(), 0, s.length());
     }
 
     @Override
     public void _writeLine(String s) throws ConditionThrowable
     {
         _writeString(s);
-        if (Utilities.isPlatformWindows)
-            _writeByte((byte)'\r');
-        _writeByte((byte)'\n');
+        if (eolStyle == EolStyle.CRLF)
+            _writeChar('\r');
+        _writeChar(eolChar);
         charPos = 0;
     }
 
@@ -399,10 +328,8 @@
     @Override
     public int _readByte() throws ConditionThrowable
     {
-        if (inputBuffer != null)
-            return readByteFromBuffer();
         try {
-            return in.read(); // Reads an 8-bit byte.
+            return in.getInputStream().read(); // Reads an 8-bit byte.
         }
         catch (NullPointerException e) {
             streamNotInputStream();
@@ -418,34 +345,22 @@
     @Override
     public void _writeByte(int n) throws ConditionThrowable
     {
-        if (outputBuffer != null) {
-            writeByteToBuffer((byte)n);
-        } else {
-            try {
-                out.write((byte)n); // Writes an 8-bit byte.
-            }
-            catch (NullPointerException e) {
-                streamNotOutputStream();
-            }
-            catch (IOException e) {
-                error(new StreamError(this, e));
-            }
+        try {
+            out.getOutputStream().write(n); // Writes an 8-bit byte.
+        }
+        catch (NullPointerException e) {
+            streamNotOutputStream();
+        }
+        catch (IOException e) {
+            error(new StreamError(this, e));
         }
-    }
-
-    @Override
-    public void _finishOutput() throws ConditionThrowable
-    {
-        if (outputBuffer != null)
-            flushOutputBuffer();
     }
 
     @Override
     public void _clearInput() throws ConditionThrowable
     {
         try {
-            in.seek(in.length());
-            clearInputBuffer();
+            in.position(in.length());
         }
         catch (NullPointerException e) {
             streamNotInputStream();
@@ -458,14 +373,8 @@
     @Override
     protected long _getFilePosition() throws ConditionThrowable
     {
-        if (inputBuffer != null) {
-            if (inputBufferFilePosition >= 0)
-                return inputBufferFilePosition + inputBufferOffset;
-        }
-        if (outputBuffer != null)
-            flushOutputBuffer();
         try {
-            long pos = raf.getFilePointer();
+            long pos = racf.position();
             return pos / bytesPerUnit;
         }
         catch (IOException e) {
@@ -478,21 +387,17 @@
     @Override
     protected boolean _setFilePosition(LispObject arg) throws ConditionThrowable
     {
-        if (outputBuffer != null)
-            flushOutputBuffer();
-        if (inputBuffer != null)
-            clearInputBuffer();
         try {
             long pos;
             if (arg == Keyword.START)
                 pos = 0;
             else if (arg == Keyword.END)
-                pos = raf.length();
+                pos = racf.length();
             else {
                 long n = Fixnum.getValue(arg); // FIXME arg might be a bignum
                 pos = n * bytesPerUnit;
             }
-            raf.seek(pos);
+            racf.position(pos);
         }
         catch (IOException e) {
             error(new StreamError(this, e));
@@ -503,10 +408,8 @@
     @Override
     public void _close() throws ConditionThrowable
     {
-        if (outputBuffer != null)
-            flushOutputBuffer();
         try {
-            raf.close();
+            racf.close();
             setOpen(false);
         }
         catch (IOException e) {
@@ -514,61 +417,6 @@
         }
     }
 
-    private int readByteFromBuffer() throws ConditionThrowable
-    {
-        if (inputBufferOffset >= inputBufferCount) {
-            fillInputBuffer();
-            if (inputBufferCount < 0)
-                return -1;
-        }
-        return inputBuffer[inputBufferOffset++] & 0xff;
-    }
-
-    private void fillInputBuffer() throws ConditionThrowable
-    {
-        try {
-            inputBufferFilePosition = in.getFilePointer();
-            inputBufferOffset = 0;
-            inputBufferCount = in.read(inputBuffer, 0, BUFSIZE);
-        }
-        catch (NullPointerException e) {
-            streamNotInputStream();
-        }
-        catch (IOException e) {
-            error(new StreamError(this, e));
-        }
-    }
-
-    private void clearInputBuffer()
-    {
-        inputBufferFilePosition = -1;
-        inputBufferOffset = 0;
-        inputBufferCount = 0;
-    }
-
-    private void writeByteToBuffer(byte b) throws ConditionThrowable
-    {
-        if (outputBufferOffset == BUFSIZE)
-            flushOutputBuffer();
-        outputBuffer[outputBufferOffset++] = b;
-    }
-
-    private void flushOutputBuffer() throws ConditionThrowable
-    {
-        if (outputBufferOffset > 0) {
-            try {
-                out.write(outputBuffer, 0, outputBufferOffset);
-                outputBufferOffset = 0;
-            }
-            catch (NullPointerException e) {
-                streamNotOutputStream();
-            }
-            catch (IOException e) {
-                error(new StreamError(this, e));
-            }
-        }
-    }
-
     @Override
     public String writeToString() throws ConditionThrowable
     {
@@ -578,12 +426,12 @@
     // ### make-file-stream pathname namestring element-type direction if-exists => stream
     private static final Primitive MAKE_FILE_STREAM =
         new Primitive("make-file-stream", PACKAGE_SYS, true,
-                      "pathname namestring element-type direction if-exists")
+                      "pathname namestring element-type direction if-exists external-format")
     {
         @Override
         public LispObject execute(LispObject first, LispObject second,
                                   LispObject third, LispObject fourth,
-                                  LispObject fifth)
+                                  LispObject fifth, LispObject sixth)
             throws ConditionThrowable
         {
             final Pathname pathname;
@@ -603,12 +451,29 @@
             LispObject elementType = third;
             LispObject direction = fourth;
             LispObject ifExists = fifth;
+            LispObject externalFormat = sixth;
+            
+            String encoding = "ISO-8859-1";
+            if (externalFormat != NIL) {
+                Symbol enc = (Symbol)externalFormat.car(); //FIXME: class cast exception to be caught
+                if (enc != NIL) {
+                    if (enc != keywordCodePage) {
+                        encoding = enc.getName();
+                    }
+                    //FIXME: the else for the keywordCodePage to be filled in
+                }
+                //FIXME: the else for the == NIL to be filled in: raise an error...
+            }
+        
+            
+            
             if (direction != Keyword.INPUT && direction != Keyword.OUTPUT &&
                 direction != Keyword.IO)
                 error(new LispError("Direction must be :INPUT, :OUTPUT, or :IO."));
             try {
                 return new FileStream(pathname, namestring.getStringValue(),
-                                      elementType, direction, ifExists);
+                                      elementType, direction, ifExists,
+                                      encoding, platformEolStyle);
             }
             catch (FileNotFoundException e) {
                 return NIL;

Modified: branches/open-external-format/src/org/armedbear/lisp/open.lisp
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/open.lisp	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/open.lisp	Sun Nov 23 11:29:10 2008
@@ -143,7 +143,7 @@
                    :pathname pathname
                    :format-control "The file ~S does not exist."
                    :format-arguments (list namestring)))))
-       (make-file-stream pathname namestring element-type :input nil))
+       (make-file-stream pathname namestring element-type :input nil nil))
       (:probe
        (case if-does-not-exist
          (:error
@@ -157,7 +157,8 @@
           ;; this abstract pathname if and only if a file with this name does
           ;; not yet exist." See java.io.File.createNewFile().
           (create-new-file namestring)))
-       (let ((stream (make-file-stream pathname namestring element-type :input nil)))
+       (let ((stream (make-file-stream pathname namestring element-type
+                                       :input nil nil)))
          (when stream
            (close stream))
          stream))
@@ -204,7 +205,8 @@
           (error 'simple-error
                  :format-control "Option not supported: ~S."
                  :format-arguments (list if-exists))))
-       (let ((stream (make-file-stream pathname namestring element-type direction if-exists)))
+       (let ((stream (make-file-stream pathname namestring element-type
+                                       direction if-exists nil)))
          (unless stream
            (error 'file-error
                   :pathname pathname

Added: branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java
==============================================================================
--- (empty file)
+++ branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	Sun Nov 23 11:29:10 2008
@@ -0,0 +1,446 @@
+/*
+ * RandomAccessCharacterFile.java
+ *
+ * Copyright (C) 2008 Hideo at Yokohama
+ * Copyright (C) 2008 Erik Huelsmann
+ * $Id$
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ *
+ * As a special exception, the copyright holders of this library give you
+ * permission to link this library with independent modules to produce an
+ * executable, regardless of the license terms of these independent
+ * modules, and to copy and distribute the resulting executable under
+ * terms of your choice, provided that you also meet, for each linked
+ * independent module, the terms and conditions of the license of that
+ * module.  An independent module is a module which is not derived from
+ * or based on this library.  If you modify this library, you may extend
+ * this exception to your version of the library, but you are not
+ * obligated to do so.  If you do not wish to do so, delete this
+ * exception statement from your version.
+ */
+
+package org.armedbear.lisp.util;
+
+import java.io.IOException;
+import java.io.InputStream;
+import java.io.OutputStream;
+import java.io.RandomAccessFile;
+import java.io.Reader;
+import java.io.Writer;
+import java.nio.ByteBuffer;
+import java.nio.CharBuffer;
+import java.nio.channels.FileChannel;
+import java.nio.charset.Charset;
+import java.nio.charset.CharsetDecoder;
+import java.nio.charset.CharsetEncoder;
+import java.nio.charset.CoderResult;
+
+public class RandomAccessCharacterFile {
+
+        public class RandomAccessInputStream extends InputStream {
+
+                private RandomAccessCharacterFile racf;
+
+                public RandomAccessInputStream(RandomAccessCharacterFile racf) {
+                        this.racf = racf;
+                }
+                private byte[] buf = new byte[1];
+
+                public int read() throws IOException {
+                        int len = read(buf);
+                        if (len == 1) {
+                                // byte is signed, char is unsigned, int is signed.
+                                // buf can hold 0xff, we want it as 0xff in int, not -1.
+                                return 0xff & (int) buf[0];
+                        } else {
+                                return -1;
+                        }
+                }
+                
+                @Override
+                public int read(byte[] b, int off, int len) throws IOException {
+                        return racf.read(b, off, len);
+                }
+        }
+
+        public class RandomAccessOutputStream extends OutputStream {
+
+                private RandomAccessCharacterFile racf;
+
+                public RandomAccessOutputStream(RandomAccessCharacterFile racf) {
+                        this.racf = racf;
+                }
+
+                private byte[] buf = new byte[1];
+                public void write(int b) throws IOException {
+                        buf[0] = (byte)b;
+                        write(buf);
+                }
+
+                @Override
+                public void write(byte[] b, int off, int len) throws IOException {
+                        racf.write(b, off, len);
+                }
+        }
+
+        public class RandomAccessReader extends Reader {
+
+                private RandomAccessCharacterFile racf;
+
+                public RandomAccessReader(
+                                RandomAccessCharacterFile racf) {
+                        this.racf = racf;
+                }
+
+                public void close() throws IOException {
+                        racf.close();
+                }
+
+                public int read(char[] cb, int off, int len) throws IOException {
+                        return racf.read(cb, off, len);
+                }
+        }
+
+        public class RandomAccessWriter extends Writer {
+
+                private RandomAccessCharacterFile racf;
+
+                public RandomAccessWriter(
+                                RandomAccessCharacterFile racf) {
+                        this.racf = racf;
+                }
+
+                public void close() throws IOException {
+                        racf.close();
+                }
+
+                public void flush() throws IOException {
+                        racf.flush();
+                }
+
+                public void write(char[] cb, int off, int len) throws IOException {
+                        racf.write(cb, off, len);
+                }
+
+        }
+
+
+	final static int BUFSIZ = 4*1024; // setting this to a small value like 8 is helpful for testing.
+	
+	private RandomAccessWriter writer;
+	private RandomAccessReader reader;
+	private RandomAccessInputStream inputStream;
+	private RandomAccessOutputStream outputStream;
+	private FileChannel fcn;
+	private long fcnpos; /* where fcn is pointing now. */
+	private long fcnsize; /* the file size */
+	
+	private Charset cset;
+	private CharsetEncoder cenc;
+	private CharsetDecoder cdec;
+	
+	/**
+	 * bbuf is treated as a cache of the file content.
+	 * If it points to somewhere in the middle of the file, it holds the copy of the file content,
+	 * even when you are writing a large chunk of data.  If you write in the middle of a file,
+	 * bbuf first gets filled with contents of the data, and only after that any new data is
+	 * written on bbuf.
+	 * The exception is when you are appending data at the end of the file.
+	 */
+	private ByteBuffer bbuf;
+	private boolean bbufIsDirty; /* whether bbuf holds data that must be written. */
+	private long bbufpos; /* where the beginning of bbuf is pointing in the file now. */
+
+	public RandomAccessCharacterFile(RandomAccessFile raf, String encoding) throws IOException {
+		fcn = raf.getChannel();
+		fcnpos = 0; // fcn points at BOF.
+		fcnsize = fcn.size();
+		
+		cset = Charset.forName(encoding);
+		cdec = cset.newDecoder();
+		cenc = cset.newEncoder(); 
+		
+		bbuf = ByteBuffer.allocate(BUFSIZ);
+		
+		// there is no readable data available in the buffers.
+		bbuf.flip();
+		
+		// there is no write pending data in the buffers.
+		bbufIsDirty = false;
+		
+		bbufpos = fcn.position(); // so as the byte buffer.
+
+		reader = new RandomAccessReader(this);
+		writer = new RandomAccessWriter(this);
+		inputStream = new RandomAccessInputStream(this);
+		outputStream = new RandomAccessOutputStream(this);
+	}
+	
+	public Writer getWriter() {
+		return writer;
+	}
+	
+	public Reader getReader() {
+		return reader;
+	}
+	
+	public InputStream getInputStream() {
+		return inputStream;
+	}
+	
+	public OutputStream getOutputStream() {
+		return outputStream;
+	}
+	
+	public void close() throws IOException {
+		internalFlush(true);
+		fcn.close();
+	}
+	
+	public void flush() throws IOException {
+		internalFlush(false);
+	}
+
+	public int read(char[] cb, int off, int len) throws IOException {
+		CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
+		boolean decodeWasUnderflow = false;
+                boolean atEof = false;
+		while ((cbuf.remaining() > 0) && dataIsAvailableForRead()
+                        && ! atEof) {
+			if ((bbuf.remaining() == 0) || decodeWasUnderflow) {
+				// need to read from the file.
+				flushBbuf(); // in case bbuf is dirty.
+				// update bbufpos.
+				bbufpos += bbuf.position();
+				int partialBytes = bbuf.remaining(); // partialBytes > 0 happens when decodeWasUnderflow
+				// if reads and writes are mixed, we may need to seek first.
+				if (bbufpos + partialBytes != fcnpos) {
+					fcn.position(bbufpos + partialBytes);
+				}
+				// need to read data from file.
+				bbuf.compact();
+                                //###FIXME: we're ignoring end-of-stream here!!!
+				atEof = (fcn.read(bbuf) == -1);
+				bbuf.flip();
+				fcnpos = bbufpos + bbuf.remaining();
+			}
+			CoderResult r = cdec.decode(bbuf, cbuf, pointingAtEOF() );
+			decodeWasUnderflow = (CoderResult.UNDERFLOW == r);
+		}
+		if (cbuf.remaining() == len) {
+			return -1;
+		} else {
+			return len - cbuf.remaining();
+		}
+	}
+
+	public boolean dataIsAvailableForRead() throws IOException {
+		return ((bbuf.remaining() > 0) || (fcn.position() < fcn.size()));
+	}
+	
+	private boolean pointingAtEOF() {
+		return (bbuf.remaining() == 0) && (fcnpos == fcnsize);
+	}
+
+	public void write(char[] cb, int off, int len) throws IOException {
+		CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
+		encodeAndWrite(cbuf, false, false);
+	}
+
+	private void internalFlush(boolean endOfFile) throws IOException {
+		if (endOfFile) {
+			CharBuffer cbuf = CharBuffer.allocate(0);
+			encodeAndWrite(cbuf, true, endOfFile);
+		} else {
+			flushBbuf();
+		}
+	}
+
+	private void encodeAndWrite(CharBuffer cbuf, boolean flush, boolean endOfFile) throws IOException {
+		if (bbufpos == fcnsize) {
+			bbuf.clear();
+		}
+		while (cbuf.remaining() > 0) {
+			CoderResult r = cenc.encode(cbuf, bbuf, endOfFile);
+			bbufIsDirty = true;
+			long curpos = bbufpos + bbuf.position();
+			if (curpos > fcnsize) {
+				// the file is extended.
+				fcnsize = curpos;
+			}
+			if (CoderResult.OVERFLOW == r || bbuf.remaining() == 0) {
+				flushBbuf();
+				bbufpos += bbuf.limit();
+				bbuf.clear();
+				if (fcnpos < fcnsize) {
+					fcn.read(bbuf);
+					bbuf.flip();
+					fcnpos += bbuf.remaining();
+				}
+				// if we are at the end of file, bbuf is simply cleared.
+				// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
+			}
+		}
+		if (bbuf.position() > 0 && bbufIsDirty && flush) {
+			flushBbuf();
+		}
+	}
+
+	public void position(long newPosition) throws IOException {
+                flushBbuf();
+		long bbufend = bbufpos + bbuf.limit();
+		if (newPosition >= bbufpos && newPosition < bbufend) {
+			// near seek. within existing data of bbuf.
+			bbuf.position((int)(newPosition - bbufpos));
+		} else {
+			// far seek. discard the buffer.
+			flushBbuf();
+			fcn.position(newPosition);
+			fcnpos = newPosition;
+			bbuf.clear();
+			bbuf.flip(); // "there is no useful data on this buffer yet."
+			bbufpos = fcnpos;
+		}
+	}
+	
+	public long position() throws IOException {
+                flushBbuf();
+		return bbufpos + bbuf.position(); // the logical position within the file.
+	}
+
+        public long length() throws IOException {
+            flushBbuf();
+            return fcn.size();
+        }
+        
+	private void flushBbuf() throws IOException {
+		if (bbufIsDirty) {
+			if (fcnpos != bbufpos) {
+				fcn.position(bbufpos);
+			}
+			bbuf.position(0);
+			if (bbufpos + bbuf.limit() > fcnsize) {
+				// the buffer is at the end of the file.
+				// area beyond fcnsize does not have data.
+				bbuf.limit((int)(fcnsize - bbufpos));
+			}
+			fcn.write(bbuf);
+			fcnpos = bbufpos + bbuf.limit();
+			bbufIsDirty = false;
+		}
+	}
+
+	public int read(byte[] b, int off, int len) throws IOException {
+		int pos = off;
+                boolean atEof = false;
+		while (pos - off < len && dataIsAvailableForRead()
+                        && ! atEof) {
+			if (bbuf.remaining() == 0) {
+				// need to read from the file.
+				flushBbuf(); // in case bbuf is dirty.
+				// update bbufpos.
+				bbufpos += bbuf.limit();
+				// if reads and writes are mixed, we may need to seek first.
+				if (bbufpos != fcnpos) {
+					fcn.position(bbufpos);
+				}
+				// need to read data from file.
+				bbuf.clear();
+				atEof = (fcn.read(bbuf) == -1);
+				bbuf.flip();
+				fcnpos = bbufpos + bbuf.remaining();
+			}
+			int want = len - pos;
+			if (want > bbuf.remaining()) {
+				want = bbuf.remaining();
+			}
+			bbuf.get(b, pos, want);
+			pos += want;
+		}
+		return pos - off;
+	}
+        
+	// a method corresponding to the good ol' ungetc in C.
+	// This function may fail when using (combined) character codes that use
+	// escape sequences to switch between sub-codes.
+	// ASCII, ISO-8859 series, any 8bit code are OK, all unicode variations are OK,
+	// but applications of the ISO-2022 encoding framework can have trouble.
+	// Example of such code is ISO-2022-JP which is used in Japanese e-mail.
+	private CharBuffer singleCharBuf;
+	private ByteBuffer shortByteBuf;
+	public void unreadChar(char c) throws IOException {
+		// algorithm : 
+		//  1. encode c into bytes, to find out how many bytes it corresponds to
+		//  2. move the position backwards that many bytes.
+		//  ** we stop here.  Don't bother to write the bytes to the buffer,
+		//     assuming that it is the same as the original data.
+		//     If we allow to write back different characters, the buffer must get 'dirty'
+		//     but that would require read/write permissions on files you use unreadChar,
+		//     even if you are just reading for some tokenizer.
+		//
+		//  So we don't do the following.
+		//  3. write the bytes.
+		//  4. move the position back again.
+		if (singleCharBuf == null) {
+			singleCharBuf = CharBuffer.allocate(1);
+			shortByteBuf = ByteBuffer.allocate((int)cenc.maxBytesPerChar());
+		}
+		singleCharBuf.clear();
+		singleCharBuf.append(c);
+		singleCharBuf.flip();
+		shortByteBuf.clear();
+		cenc.encode(singleCharBuf, shortByteBuf, false);
+		int n = shortByteBuf.position();
+		long pos = position() - n;
+		position(pos);
+	}
+	
+	public void unreadByte(byte b) throws IOException {
+		long pos = position() - 1;
+		position(pos);
+	}
+
+	public void write(byte[] b, int off, int len) throws IOException {
+		int pos = off;
+		while (pos < off + len) {
+			int want = len;
+			if (want > bbuf.remaining()) {
+				want = bbuf.remaining();
+			}
+			bbuf.put(b, pos, want);
+			pos += want;
+			bbufIsDirty = true;
+			long curpos = bbufpos + bbuf.position();
+			if (curpos > fcn.size()) {
+				// the file is extended.
+				fcnsize = curpos;
+			}
+			if (bbuf.remaining() == 0) {
+				flushBbuf();
+				bbufpos += bbuf.limit();
+				bbuf.clear();
+				if (fcn.position() < fcn.size()) {
+                                        bbufpos = fcn.position();
+					fcn.read(bbuf);
+					bbuf.flip();
+					fcnpos += bbuf.remaining();
+				}
+				// if we are at the end of file, bbuf is simply cleared.
+				// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
+			}
+		}
+	}
+}



From vvoutilainen at common-lisp.net  Mon Nov 24 19:01:51 2008
From: vvoutilainen at common-lisp.net (Ville Voutilainen)
Date: Mon, 24 Nov 2008 19:01:51 +0000
Subject: [armedbear-cvs] r11396 - trunk/j/src/org/armedbear/lisp
Message-ID: <E1L4ggx-000477-1R@common-lisp.net>

Author: vvoutilainen
Date: Mon Nov 24 19:01:42 2008
New Revision: 11396

Log:
Fix return in an anonymous lambda. An anynonymous lambda
should not generate a block around the lambda body.


Modified:
   trunk/j/src/org/armedbear/lisp/jvm.lisp

Modified: trunk/j/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/j/src/org/armedbear/lisp/jvm.lisp	(original)
+++ trunk/j/src/org/armedbear/lisp/jvm.lisp	Mon Nov 24 19:01:42 2008
@@ -867,7 +867,7 @@
              (multiple-value-bind (body decls)
                  (parse-body body)
                (setf (compiland-lambda-expression compiland)
-                     `(lambda ,lambda-list , at decls (block nil , at body)))
+                     `(lambda ,lambda-list , at decls , at body))
                (let ((*visible-variables* *visible-variables*)
                      (*current-compiland* compiland))
                  (p1-compiland compiland)))



From mevenson at common-lisp.net  Tue Nov 25 18:14:33 2008
From: mevenson at common-lisp.net (Mark Evenson)
Date: Tue, 25 Nov 2008 18:14:33 +0000
Subject: [armedbear-cvs] r11397 - trunk/j/examples
Message-ID: <E1L52Qj-0001ez-Bs@common-lisp.net>

Author: mevenson
Date: Tue Nov 25 18:14:32 2008
New Revision: 11397

Log:
Start of instructions on using the examples.

Gratiously contributed by Blake McBride.


Added:
   trunk/j/examples/README

Added: trunk/j/examples/README
==============================================================================
--- (empty file)
+++ trunk/j/examples/README	Tue Nov 25 18:14:32 2008
@@ -0,0 +1,24 @@
+Building and running instructions
+=================================
+
+by Blake McBride
+
+In general, to compile a Java class file (like Main.java for example)
+use:
+
+	javac  -cp  ../../../abcl.jar  Main.java
+
+where the "../../../" represents the path to your abcl.jar file.
+
+This compiles the Java source file "Main.java" into a JVM runtime or
+class file named "Main.class".
+
+To run the example (Main.class for example) from a Unix-like OS use:
+
+	java  -cp  ../../../abcl.jar:.  Main
+
+or in Windows use:
+
+	java  -cp  ../../../abcl.jar;.  Main
+
+where "Main" is the initial class to run in your Java program.
\ No newline at end of file



From mevenson at common-lisp.net  Tue Nov 25 18:16:53 2008
From: mevenson at common-lisp.net (Mark Evenson)
Date: Tue, 25 Nov 2008 18:16:53 +0000
Subject: [armedbear-cvs] r11398 - in trunk/j/examples: . abcl
Message-ID: <E1L52Sz-0001iI-4s@common-lisp.net>

Author: mevenson
Date: Tue Nov 25 18:16:52 2008
New Revision: 11398

Log:
Move to more natural place "above" Ville's examples.


Added:
   trunk/j/examples/abcl/README
      - copied unchanged from r11397, /trunk/j/examples/README
Removed:
   trunk/j/examples/README



From mevenson at common-lisp.net  Wed Nov 26 06:46:22 2008
From: mevenson at common-lisp.net (Mark Evenson)
Date: Wed, 26 Nov 2008 06:46:22 +0000
Subject: [armedbear-cvs] r11399 - tags/abcl-0-0-11
Message-ID: <E1L5EAI-0008Ch-Vw@common-lisp.net>

Author: mevenson
Date: Wed Nov 26 06:46:22 2008
New Revision: 11399

Log:
Tagged r113960 as ABCL-0.0.11.


Added:
   tags/abcl-0-0-11/
      - copied from r11360, /trunk/



From ehuelsmann at common-lisp.net  Sat Nov 29 16:42:47 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 29 Nov 2008 16:42:47 +0000
Subject: [armedbear-cvs] r11400 -
	branches/open-external-format/src/org/armedbear/lisp/util
Message-ID: <E1L6Su7-0000Y4-Gi@common-lisp.net>

Author: ehuelsmann
Date: Sat Nov 29 16:42:46 2008
New Revision: 11400

Log:
Set fixed line ending style.

Found by: Hideo

Modified:
   branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java   (contents, props changed)

Modified: branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	Sat Nov 29 16:42:46 2008
@@ -1,446 +1,446 @@
-/*
- * RandomAccessCharacterFile.java
- *
- * Copyright (C) 2008 Hideo at Yokohama
- * Copyright (C) 2008 Erik Huelsmann
- * $Id$
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
- *
- * As a special exception, the copyright holders of this library give you
- * permission to link this library with independent modules to produce an
- * executable, regardless of the license terms of these independent
- * modules, and to copy and distribute the resulting executable under
- * terms of your choice, provided that you also meet, for each linked
- * independent module, the terms and conditions of the license of that
- * module.  An independent module is a module which is not derived from
- * or based on this library.  If you modify this library, you may extend
- * this exception to your version of the library, but you are not
- * obligated to do so.  If you do not wish to do so, delete this
- * exception statement from your version.
- */
-
-package org.armedbear.lisp.util;
-
-import java.io.IOException;
-import java.io.InputStream;
-import java.io.OutputStream;
-import java.io.RandomAccessFile;
-import java.io.Reader;
-import java.io.Writer;
-import java.nio.ByteBuffer;
-import java.nio.CharBuffer;
-import java.nio.channels.FileChannel;
-import java.nio.charset.Charset;
-import java.nio.charset.CharsetDecoder;
-import java.nio.charset.CharsetEncoder;
-import java.nio.charset.CoderResult;
-
-public class RandomAccessCharacterFile {
-
-        public class RandomAccessInputStream extends InputStream {
-
-                private RandomAccessCharacterFile racf;
-
-                public RandomAccessInputStream(RandomAccessCharacterFile racf) {
-                        this.racf = racf;
-                }
-                private byte[] buf = new byte[1];
-
-                public int read() throws IOException {
-                        int len = read(buf);
-                        if (len == 1) {
-                                // byte is signed, char is unsigned, int is signed.
-                                // buf can hold 0xff, we want it as 0xff in int, not -1.
-                                return 0xff & (int) buf[0];
-                        } else {
-                                return -1;
-                        }
-                }
-                
-                @Override
-                public int read(byte[] b, int off, int len) throws IOException {
-                        return racf.read(b, off, len);
-                }
-        }
-
-        public class RandomAccessOutputStream extends OutputStream {
-
-                private RandomAccessCharacterFile racf;
-
-                public RandomAccessOutputStream(RandomAccessCharacterFile racf) {
-                        this.racf = racf;
-                }
-
-                private byte[] buf = new byte[1];
-                public void write(int b) throws IOException {
-                        buf[0] = (byte)b;
-                        write(buf);
-                }
-
-                @Override
-                public void write(byte[] b, int off, int len) throws IOException {
-                        racf.write(b, off, len);
-                }
-        }
-
-        public class RandomAccessReader extends Reader {
-
-                private RandomAccessCharacterFile racf;
-
-                public RandomAccessReader(
-                                RandomAccessCharacterFile racf) {
-                        this.racf = racf;
-                }
-
-                public void close() throws IOException {
-                        racf.close();
-                }
-
-                public int read(char[] cb, int off, int len) throws IOException {
-                        return racf.read(cb, off, len);
-                }
-        }
-
-        public class RandomAccessWriter extends Writer {
-
-                private RandomAccessCharacterFile racf;
-
-                public RandomAccessWriter(
-                                RandomAccessCharacterFile racf) {
-                        this.racf = racf;
-                }
-
-                public void close() throws IOException {
-                        racf.close();
-                }
-
-                public void flush() throws IOException {
-                        racf.flush();
-                }
-
-                public void write(char[] cb, int off, int len) throws IOException {
-                        racf.write(cb, off, len);
-                }
-
-        }
-
-
-	final static int BUFSIZ = 4*1024; // setting this to a small value like 8 is helpful for testing.
-	
-	private RandomAccessWriter writer;
-	private RandomAccessReader reader;
-	private RandomAccessInputStream inputStream;
-	private RandomAccessOutputStream outputStream;
-	private FileChannel fcn;
-	private long fcnpos; /* where fcn is pointing now. */
-	private long fcnsize; /* the file size */
-	
-	private Charset cset;
-	private CharsetEncoder cenc;
-	private CharsetDecoder cdec;
-	
-	/**
-	 * bbuf is treated as a cache of the file content.
-	 * If it points to somewhere in the middle of the file, it holds the copy of the file content,
-	 * even when you are writing a large chunk of data.  If you write in the middle of a file,
-	 * bbuf first gets filled with contents of the data, and only after that any new data is
-	 * written on bbuf.
-	 * The exception is when you are appending data at the end of the file.
-	 */
-	private ByteBuffer bbuf;
-	private boolean bbufIsDirty; /* whether bbuf holds data that must be written. */
-	private long bbufpos; /* where the beginning of bbuf is pointing in the file now. */
-
-	public RandomAccessCharacterFile(RandomAccessFile raf, String encoding) throws IOException {
-		fcn = raf.getChannel();
-		fcnpos = 0; // fcn points at BOF.
-		fcnsize = fcn.size();
-		
-		cset = Charset.forName(encoding);
-		cdec = cset.newDecoder();
-		cenc = cset.newEncoder(); 
-		
-		bbuf = ByteBuffer.allocate(BUFSIZ);
-		
-		// there is no readable data available in the buffers.
-		bbuf.flip();
-		
-		// there is no write pending data in the buffers.
-		bbufIsDirty = false;
-		
-		bbufpos = fcn.position(); // so as the byte buffer.
-
-		reader = new RandomAccessReader(this);
-		writer = new RandomAccessWriter(this);
-		inputStream = new RandomAccessInputStream(this);
-		outputStream = new RandomAccessOutputStream(this);
-	}
-	
-	public Writer getWriter() {
-		return writer;
-	}
-	
-	public Reader getReader() {
-		return reader;
-	}
-	
-	public InputStream getInputStream() {
-		return inputStream;
-	}
-	
-	public OutputStream getOutputStream() {
-		return outputStream;
-	}
-	
-	public void close() throws IOException {
-		internalFlush(true);
-		fcn.close();
-	}
-	
-	public void flush() throws IOException {
-		internalFlush(false);
-	}
-
-	public int read(char[] cb, int off, int len) throws IOException {
-		CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
-		boolean decodeWasUnderflow = false;
-                boolean atEof = false;
-		while ((cbuf.remaining() > 0) && dataIsAvailableForRead()
-                        && ! atEof) {
-			if ((bbuf.remaining() == 0) || decodeWasUnderflow) {
-				// need to read from the file.
-				flushBbuf(); // in case bbuf is dirty.
-				// update bbufpos.
-				bbufpos += bbuf.position();
-				int partialBytes = bbuf.remaining(); // partialBytes > 0 happens when decodeWasUnderflow
-				// if reads and writes are mixed, we may need to seek first.
-				if (bbufpos + partialBytes != fcnpos) {
-					fcn.position(bbufpos + partialBytes);
-				}
-				// need to read data from file.
-				bbuf.compact();
-                                //###FIXME: we're ignoring end-of-stream here!!!
-				atEof = (fcn.read(bbuf) == -1);
-				bbuf.flip();
-				fcnpos = bbufpos + bbuf.remaining();
-			}
-			CoderResult r = cdec.decode(bbuf, cbuf, pointingAtEOF() );
-			decodeWasUnderflow = (CoderResult.UNDERFLOW == r);
-		}
-		if (cbuf.remaining() == len) {
-			return -1;
-		} else {
-			return len - cbuf.remaining();
-		}
-	}
-
-	public boolean dataIsAvailableForRead() throws IOException {
-		return ((bbuf.remaining() > 0) || (fcn.position() < fcn.size()));
-	}
-	
-	private boolean pointingAtEOF() {
-		return (bbuf.remaining() == 0) && (fcnpos == fcnsize);
-	}
-
-	public void write(char[] cb, int off, int len) throws IOException {
-		CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
-		encodeAndWrite(cbuf, false, false);
-	}
-
-	private void internalFlush(boolean endOfFile) throws IOException {
-		if (endOfFile) {
-			CharBuffer cbuf = CharBuffer.allocate(0);
-			encodeAndWrite(cbuf, true, endOfFile);
-		} else {
-			flushBbuf();
-		}
-	}
-
-	private void encodeAndWrite(CharBuffer cbuf, boolean flush, boolean endOfFile) throws IOException {
-		if (bbufpos == fcnsize) {
-			bbuf.clear();
-		}
-		while (cbuf.remaining() > 0) {
-			CoderResult r = cenc.encode(cbuf, bbuf, endOfFile);
-			bbufIsDirty = true;
-			long curpos = bbufpos + bbuf.position();
-			if (curpos > fcnsize) {
-				// the file is extended.
-				fcnsize = curpos;
-			}
-			if (CoderResult.OVERFLOW == r || bbuf.remaining() == 0) {
-				flushBbuf();
-				bbufpos += bbuf.limit();
-				bbuf.clear();
-				if (fcnpos < fcnsize) {
-					fcn.read(bbuf);
-					bbuf.flip();
-					fcnpos += bbuf.remaining();
-				}
-				// if we are at the end of file, bbuf is simply cleared.
-				// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
-			}
-		}
-		if (bbuf.position() > 0 && bbufIsDirty && flush) {
-			flushBbuf();
-		}
-	}
-
-	public void position(long newPosition) throws IOException {
-                flushBbuf();
-		long bbufend = bbufpos + bbuf.limit();
-		if (newPosition >= bbufpos && newPosition < bbufend) {
-			// near seek. within existing data of bbuf.
-			bbuf.position((int)(newPosition - bbufpos));
-		} else {
-			// far seek. discard the buffer.
-			flushBbuf();
-			fcn.position(newPosition);
-			fcnpos = newPosition;
-			bbuf.clear();
-			bbuf.flip(); // "there is no useful data on this buffer yet."
-			bbufpos = fcnpos;
-		}
-	}
-	
-	public long position() throws IOException {
-                flushBbuf();
-		return bbufpos + bbuf.position(); // the logical position within the file.
-	}
-
-        public long length() throws IOException {
-            flushBbuf();
-            return fcn.size();
-        }
-        
-	private void flushBbuf() throws IOException {
-		if (bbufIsDirty) {
-			if (fcnpos != bbufpos) {
-				fcn.position(bbufpos);
-			}
-			bbuf.position(0);
-			if (bbufpos + bbuf.limit() > fcnsize) {
-				// the buffer is at the end of the file.
-				// area beyond fcnsize does not have data.
-				bbuf.limit((int)(fcnsize - bbufpos));
-			}
-			fcn.write(bbuf);
-			fcnpos = bbufpos + bbuf.limit();
-			bbufIsDirty = false;
-		}
-	}
-
-	public int read(byte[] b, int off, int len) throws IOException {
-		int pos = off;
-                boolean atEof = false;
-		while (pos - off < len && dataIsAvailableForRead()
-                        && ! atEof) {
-			if (bbuf.remaining() == 0) {
-				// need to read from the file.
-				flushBbuf(); // in case bbuf is dirty.
-				// update bbufpos.
-				bbufpos += bbuf.limit();
-				// if reads and writes are mixed, we may need to seek first.
-				if (bbufpos != fcnpos) {
-					fcn.position(bbufpos);
-				}
-				// need to read data from file.
-				bbuf.clear();
-				atEof = (fcn.read(bbuf) == -1);
-				bbuf.flip();
-				fcnpos = bbufpos + bbuf.remaining();
-			}
-			int want = len - pos;
-			if (want > bbuf.remaining()) {
-				want = bbuf.remaining();
-			}
-			bbuf.get(b, pos, want);
-			pos += want;
-		}
-		return pos - off;
-	}
-        
-	// a method corresponding to the good ol' ungetc in C.
-	// This function may fail when using (combined) character codes that use
-	// escape sequences to switch between sub-codes.
-	// ASCII, ISO-8859 series, any 8bit code are OK, all unicode variations are OK,
-	// but applications of the ISO-2022 encoding framework can have trouble.
-	// Example of such code is ISO-2022-JP which is used in Japanese e-mail.
-	private CharBuffer singleCharBuf;
-	private ByteBuffer shortByteBuf;
-	public void unreadChar(char c) throws IOException {
-		// algorithm : 
-		//  1. encode c into bytes, to find out how many bytes it corresponds to
-		//  2. move the position backwards that many bytes.
-		//  ** we stop here.  Don't bother to write the bytes to the buffer,
-		//     assuming that it is the same as the original data.
-		//     If we allow to write back different characters, the buffer must get 'dirty'
-		//     but that would require read/write permissions on files you use unreadChar,
-		//     even if you are just reading for some tokenizer.
-		//
-		//  So we don't do the following.
-		//  3. write the bytes.
-		//  4. move the position back again.
-		if (singleCharBuf == null) {
-			singleCharBuf = CharBuffer.allocate(1);
-			shortByteBuf = ByteBuffer.allocate((int)cenc.maxBytesPerChar());
-		}
-		singleCharBuf.clear();
-		singleCharBuf.append(c);
-		singleCharBuf.flip();
-		shortByteBuf.clear();
-		cenc.encode(singleCharBuf, shortByteBuf, false);
-		int n = shortByteBuf.position();
-		long pos = position() - n;
-		position(pos);
-	}
-	
-	public void unreadByte(byte b) throws IOException {
-		long pos = position() - 1;
-		position(pos);
-	}
-
-	public void write(byte[] b, int off, int len) throws IOException {
-		int pos = off;
-		while (pos < off + len) {
-			int want = len;
-			if (want > bbuf.remaining()) {
-				want = bbuf.remaining();
-			}
-			bbuf.put(b, pos, want);
-			pos += want;
-			bbufIsDirty = true;
-			long curpos = bbufpos + bbuf.position();
-			if (curpos > fcn.size()) {
-				// the file is extended.
-				fcnsize = curpos;
-			}
-			if (bbuf.remaining() == 0) {
-				flushBbuf();
-				bbufpos += bbuf.limit();
-				bbuf.clear();
-				if (fcn.position() < fcn.size()) {
-                                        bbufpos = fcn.position();
-					fcn.read(bbuf);
-					bbuf.flip();
-					fcnpos += bbuf.remaining();
-				}
-				// if we are at the end of file, bbuf is simply cleared.
-				// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
-			}
-		}
-	}
-}
+/*
+ * RandomAccessCharacterFile.java
+ *
+ * Copyright (C) 2008 Hideo at Yokohama
+ * Copyright (C) 2008 Erik Huelsmann
+ * $Id$
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ *
+ * As a special exception, the copyright holders of this library give you
+ * permission to link this library with independent modules to produce an
+ * executable, regardless of the license terms of these independent
+ * modules, and to copy and distribute the resulting executable under
+ * terms of your choice, provided that you also meet, for each linked
+ * independent module, the terms and conditions of the license of that
+ * module.  An independent module is a module which is not derived from
+ * or based on this library.  If you modify this library, you may extend
+ * this exception to your version of the library, but you are not
+ * obligated to do so.  If you do not wish to do so, delete this
+ * exception statement from your version.
+ */
+
+package org.armedbear.lisp.util;
+
+import java.io.IOException;
+import java.io.InputStream;
+import java.io.OutputStream;
+import java.io.RandomAccessFile;
+import java.io.Reader;
+import java.io.Writer;
+import java.nio.ByteBuffer;
+import java.nio.CharBuffer;
+import java.nio.channels.FileChannel;
+import java.nio.charset.Charset;
+import java.nio.charset.CharsetDecoder;
+import java.nio.charset.CharsetEncoder;
+import java.nio.charset.CoderResult;
+
+public class RandomAccessCharacterFile {
+
+        public class RandomAccessInputStream extends InputStream {
+
+                private RandomAccessCharacterFile racf;
+
+                public RandomAccessInputStream(RandomAccessCharacterFile racf) {
+                        this.racf = racf;
+                }
+                private byte[] buf = new byte[1];
+
+                public int read() throws IOException {
+                        int len = read(buf);
+                        if (len == 1) {
+                                // byte is signed, char is unsigned, int is signed.
+                                // buf can hold 0xff, we want it as 0xff in int, not -1.
+                                return 0xff & (int) buf[0];
+                        } else {
+                                return -1;
+                        }
+                }
+                
+                @Override
+                public int read(byte[] b, int off, int len) throws IOException {
+                        return racf.read(b, off, len);
+                }
+        }
+
+        public class RandomAccessOutputStream extends OutputStream {
+
+                private RandomAccessCharacterFile racf;
+
+                public RandomAccessOutputStream(RandomAccessCharacterFile racf) {
+                        this.racf = racf;
+                }
+
+                private byte[] buf = new byte[1];
+                public void write(int b) throws IOException {
+                        buf[0] = (byte)b;
+                        write(buf);
+                }
+
+                @Override
+                public void write(byte[] b, int off, int len) throws IOException {
+                        racf.write(b, off, len);
+                }
+        }
+
+        public class RandomAccessReader extends Reader {
+
+                private RandomAccessCharacterFile racf;
+
+                public RandomAccessReader(
+                                RandomAccessCharacterFile racf) {
+                        this.racf = racf;
+                }
+
+                public void close() throws IOException {
+                        racf.close();
+                }
+
+                public int read(char[] cb, int off, int len) throws IOException {
+                        return racf.read(cb, off, len);
+                }
+        }
+
+        public class RandomAccessWriter extends Writer {
+
+                private RandomAccessCharacterFile racf;
+
+                public RandomAccessWriter(
+                                RandomAccessCharacterFile racf) {
+                        this.racf = racf;
+                }
+
+                public void close() throws IOException {
+                        racf.close();
+                }
+
+                public void flush() throws IOException {
+                        racf.flush();
+                }
+
+                public void write(char[] cb, int off, int len) throws IOException {
+                        racf.write(cb, off, len);
+                }
+
+        }
+
+
+	final static int BUFSIZ = 4*1024; // setting this to a small value like 8 is helpful for testing.
+	
+	private RandomAccessWriter writer;
+	private RandomAccessReader reader;
+	private RandomAccessInputStream inputStream;
+	private RandomAccessOutputStream outputStream;
+	private FileChannel fcn;
+	private long fcnpos; /* where fcn is pointing now. */
+	private long fcnsize; /* the file size */
+	
+	private Charset cset;
+	private CharsetEncoder cenc;
+	private CharsetDecoder cdec;
+	
+	/**
+	 * bbuf is treated as a cache of the file content.
+	 * If it points to somewhere in the middle of the file, it holds the copy of the file content,
+	 * even when you are writing a large chunk of data.  If you write in the middle of a file,
+	 * bbuf first gets filled with contents of the data, and only after that any new data is
+	 * written on bbuf.
+	 * The exception is when you are appending data at the end of the file.
+	 */
+	private ByteBuffer bbuf;
+	private boolean bbufIsDirty; /* whether bbuf holds data that must be written. */
+	private long bbufpos; /* where the beginning of bbuf is pointing in the file now. */
+
+	public RandomAccessCharacterFile(RandomAccessFile raf, String encoding) throws IOException {
+		fcn = raf.getChannel();
+		fcnpos = 0; // fcn points at BOF.
+		fcnsize = fcn.size();
+		
+		cset = Charset.forName(encoding);
+		cdec = cset.newDecoder();
+		cenc = cset.newEncoder(); 
+		
+		bbuf = ByteBuffer.allocate(BUFSIZ);
+		
+		// there is no readable data available in the buffers.
+		bbuf.flip();
+		
+		// there is no write pending data in the buffers.
+		bbufIsDirty = false;
+		
+		bbufpos = fcn.position(); // so as the byte buffer.
+
+		reader = new RandomAccessReader(this);
+		writer = new RandomAccessWriter(this);
+		inputStream = new RandomAccessInputStream(this);
+		outputStream = new RandomAccessOutputStream(this);
+	}
+	
+	public Writer getWriter() {
+		return writer;
+	}
+	
+	public Reader getReader() {
+		return reader;
+	}
+	
+	public InputStream getInputStream() {
+		return inputStream;
+	}
+	
+	public OutputStream getOutputStream() {
+		return outputStream;
+	}
+	
+	public void close() throws IOException {
+		internalFlush(true);
+		fcn.close();
+	}
+	
+	public void flush() throws IOException {
+		internalFlush(false);
+	}
+
+	public int read(char[] cb, int off, int len) throws IOException {
+		CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
+		boolean decodeWasUnderflow = false;
+                boolean atEof = false;
+		while ((cbuf.remaining() > 0) && dataIsAvailableForRead()
+                        && ! atEof) {
+			if ((bbuf.remaining() == 0) || decodeWasUnderflow) {
+				// need to read from the file.
+				flushBbuf(); // in case bbuf is dirty.
+				// update bbufpos.
+				bbufpos += bbuf.position();
+				int partialBytes = bbuf.remaining(); // partialBytes > 0 happens when decodeWasUnderflow
+				// if reads and writes are mixed, we may need to seek first.
+				if (bbufpos + partialBytes != fcnpos) {
+					fcn.position(bbufpos + partialBytes);
+				}
+				// need to read data from file.
+				bbuf.compact();
+                                //###FIXME: we're ignoring end-of-stream here!!!
+				atEof = (fcn.read(bbuf) == -1);
+				bbuf.flip();
+				fcnpos = bbufpos + bbuf.remaining();
+			}
+			CoderResult r = cdec.decode(bbuf, cbuf, pointingAtEOF() );
+			decodeWasUnderflow = (CoderResult.UNDERFLOW == r);
+		}
+		if (cbuf.remaining() == len) {
+			return -1;
+		} else {
+			return len - cbuf.remaining();
+		}
+	}
+
+	public boolean dataIsAvailableForRead() throws IOException {
+		return ((bbuf.remaining() > 0) || (fcn.position() < fcn.size()));
+	}
+	
+	private boolean pointingAtEOF() {
+		return (bbuf.remaining() == 0) && (fcnpos == fcnsize);
+	}
+
+	public void write(char[] cb, int off, int len) throws IOException {
+		CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
+		encodeAndWrite(cbuf, false, false);
+	}
+
+	private void internalFlush(boolean endOfFile) throws IOException {
+		if (endOfFile) {
+			CharBuffer cbuf = CharBuffer.allocate(0);
+			encodeAndWrite(cbuf, true, endOfFile);
+		} else {
+			flushBbuf();
+		}
+	}
+
+	private void encodeAndWrite(CharBuffer cbuf, boolean flush, boolean endOfFile) throws IOException {
+		if (bbufpos == fcnsize) {
+			bbuf.clear();
+		}
+		while (cbuf.remaining() > 0) {
+			CoderResult r = cenc.encode(cbuf, bbuf, endOfFile);
+			bbufIsDirty = true;
+			long curpos = bbufpos + bbuf.position();
+			if (curpos > fcnsize) {
+				// the file is extended.
+				fcnsize = curpos;
+			}
+			if (CoderResult.OVERFLOW == r || bbuf.remaining() == 0) {
+				flushBbuf();
+				bbufpos += bbuf.limit();
+				bbuf.clear();
+				if (fcnpos < fcnsize) {
+					fcn.read(bbuf);
+					bbuf.flip();
+					fcnpos += bbuf.remaining();
+				}
+				// if we are at the end of file, bbuf is simply cleared.
+				// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
+			}
+		}
+		if (bbuf.position() > 0 && bbufIsDirty && flush) {
+			flushBbuf();
+		}
+	}
+
+	public void position(long newPosition) throws IOException {
+                flushBbuf();
+		long bbufend = bbufpos + bbuf.limit();
+		if (newPosition >= bbufpos && newPosition < bbufend) {
+			// near seek. within existing data of bbuf.
+			bbuf.position((int)(newPosition - bbufpos));
+		} else {
+			// far seek. discard the buffer.
+			flushBbuf();
+			fcn.position(newPosition);
+			fcnpos = newPosition;
+			bbuf.clear();
+			bbuf.flip(); // "there is no useful data on this buffer yet."
+			bbufpos = fcnpos;
+		}
+	}
+	
+	public long position() throws IOException {
+                flushBbuf();
+		return bbufpos + bbuf.position(); // the logical position within the file.
+	}
+
+        public long length() throws IOException {
+            flushBbuf();
+            return fcn.size();
+        }
+        
+	private void flushBbuf() throws IOException {
+		if (bbufIsDirty) {
+			if (fcnpos != bbufpos) {
+				fcn.position(bbufpos);
+			}
+			bbuf.position(0);
+			if (bbufpos + bbuf.limit() > fcnsize) {
+				// the buffer is at the end of the file.
+				// area beyond fcnsize does not have data.
+				bbuf.limit((int)(fcnsize - bbufpos));
+			}
+			fcn.write(bbuf);
+			fcnpos = bbufpos + bbuf.limit();
+			bbufIsDirty = false;
+		}
+	}
+
+	public int read(byte[] b, int off, int len) throws IOException {
+		int pos = off;
+                boolean atEof = false;
+		while (pos - off < len && dataIsAvailableForRead()
+                        && ! atEof) {
+			if (bbuf.remaining() == 0) {
+				// need to read from the file.
+				flushBbuf(); // in case bbuf is dirty.
+				// update bbufpos.
+				bbufpos += bbuf.limit();
+				// if reads and writes are mixed, we may need to seek first.
+				if (bbufpos != fcnpos) {
+					fcn.position(bbufpos);
+				}
+				// need to read data from file.
+				bbuf.clear();
+				atEof = (fcn.read(bbuf) == -1);
+				bbuf.flip();
+				fcnpos = bbufpos + bbuf.remaining();
+			}
+			int want = len - pos;
+			if (want > bbuf.remaining()) {
+				want = bbuf.remaining();
+			}
+			bbuf.get(b, pos, want);
+			pos += want;
+		}
+		return pos - off;
+	}
+        
+	// a method corresponding to the good ol' ungetc in C.
+	// This function may fail when using (combined) character codes that use
+	// escape sequences to switch between sub-codes.
+	// ASCII, ISO-8859 series, any 8bit code are OK, all unicode variations are OK,
+	// but applications of the ISO-2022 encoding framework can have trouble.
+	// Example of such code is ISO-2022-JP which is used in Japanese e-mail.
+	private CharBuffer singleCharBuf;
+	private ByteBuffer shortByteBuf;
+	public void unreadChar(char c) throws IOException {
+		// algorithm : 
+		//  1. encode c into bytes, to find out how many bytes it corresponds to
+		//  2. move the position backwards that many bytes.
+		//  ** we stop here.  Don't bother to write the bytes to the buffer,
+		//     assuming that it is the same as the original data.
+		//     If we allow to write back different characters, the buffer must get 'dirty'
+		//     but that would require read/write permissions on files you use unreadChar,
+		//     even if you are just reading for some tokenizer.
+		//
+		//  So we don't do the following.
+		//  3. write the bytes.
+		//  4. move the position back again.
+		if (singleCharBuf == null) {
+			singleCharBuf = CharBuffer.allocate(1);
+			shortByteBuf = ByteBuffer.allocate((int)cenc.maxBytesPerChar());
+		}
+		singleCharBuf.clear();
+		singleCharBuf.append(c);
+		singleCharBuf.flip();
+		shortByteBuf.clear();
+		cenc.encode(singleCharBuf, shortByteBuf, false);
+		int n = shortByteBuf.position();
+		long pos = position() - n;
+		position(pos);
+	}
+	
+	public void unreadByte(byte b) throws IOException {
+		long pos = position() - 1;
+		position(pos);
+	}
+
+	public void write(byte[] b, int off, int len) throws IOException {
+		int pos = off;
+		while (pos < off + len) {
+			int want = len;
+			if (want > bbuf.remaining()) {
+				want = bbuf.remaining();
+			}
+			bbuf.put(b, pos, want);
+			pos += want;
+			bbufIsDirty = true;
+			long curpos = bbufpos + bbuf.position();
+			if (curpos > fcn.size()) {
+				// the file is extended.
+				fcnsize = curpos;
+			}
+			if (bbuf.remaining() == 0) {
+				flushBbuf();
+				bbufpos += bbuf.limit();
+				bbuf.clear();
+				if (fcn.position() < fcn.size()) {
+                                        bbufpos = fcn.position();
+					fcn.read(bbuf);
+					bbuf.flip();
+					fcnpos += bbuf.remaining();
+				}
+				// if we are at the end of file, bbuf is simply cleared.
+				// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
+			}
+		}
+	}
+}



From ehuelsmann at common-lisp.net  Sat Nov 29 18:42:35 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 29 Nov 2008 18:42:35 +0000
Subject: [armedbear-cvs] r11401 -
	branches/open-external-format/src/org/armedbear/lisp
Message-ID: <E1L6Um3-0006v7-Oa@common-lisp.net>

Author: ehuelsmann
Date: Sat Nov 29 18:42:35 2008
New Revision: 11401

Log:
Fix character doubling issue and the end-of-line style being written.


Modified:
   branches/open-external-format/src/org/armedbear/lisp/FileStream.java

Modified: branches/open-external-format/src/org/armedbear/lisp/FileStream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/FileStream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/FileStream.java	Sat Nov 29 18:42:35 2008
@@ -292,8 +292,9 @@
             } else {
                 for (int i = start; i < end; i++) {
                     char c = chars[i];
-                    out.getWriter().write((byte)c);
                     if (c == '\n') {
+                        if (eolStyle == EolStyle.CRLF)
+                            out.getWriter().write((byte)'\r');
                         out.getWriter().write((byte)eolChar);
                         charPos = 0;
                     } else {



From ehuelsmann at common-lisp.net  Sat Nov 29 20:43:49 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 29 Nov 2008 20:43:49 +0000
Subject: [armedbear-cvs] r11402 -
	branches/open-external-format/src/org/armedbear/lisp
Message-ID: <E1L6WfN-00051J-Cv@common-lisp.net>

Author: ehuelsmann
Date: Sat Nov 29 20:43:49 2008
New Revision: 11402

Log:
Undo part of r11401.

Modified:
   branches/open-external-format/src/org/armedbear/lisp/FileStream.java

Modified: branches/open-external-format/src/org/armedbear/lisp/FileStream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/FileStream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/FileStream.java	Sat Nov 29 20:43:49 2008
@@ -293,8 +293,6 @@
                 for (int i = start; i < end; i++) {
                     char c = chars[i];
                     if (c == '\n') {
-                        if (eolStyle == EolStyle.CRLF)
-                            out.getWriter().write((byte)'\r');
                         out.getWriter().write((byte)eolChar);
                         charPos = 0;
                     } else {



From ehuelsmann at common-lisp.net  Sat Nov 29 21:40:19 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sat, 29 Nov 2008 21:40:19 +0000
Subject: [armedbear-cvs] r11403 - in
	branches/open-external-format/src/org/armedbear/lisp: . util
Message-ID: <E1L6XY3-0007li-5L@common-lisp.net>

Author: ehuelsmann
Date: Sat Nov 29 21:40:18 2008
New Revision: 11403

Log:
Adjust integration between RandomAccessCharacterFile and FileStream.

Patch by: Hideo at Yokohama

Modified:
   branches/open-external-format/src/org/armedbear/lisp/FileStream.java
   branches/open-external-format/src/org/armedbear/lisp/open.lisp
   branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java

Modified: branches/open-external-format/src/org/armedbear/lisp/FileStream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/FileStream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/FileStream.java	Sat Nov 29 21:40:18 2008
@@ -2,6 +2,7 @@
  * FileStream.java
  *
  * Copyright (C) 2004-2006 Peter Graves
+ * Copyright (C) 2008 Hideo at Yokohama
  * $Id$
  *
  * This program is free software; you can redistribute it and/or
@@ -34,6 +35,10 @@
 package org.armedbear.lisp;
 
 import java.io.File;
+import java.io.InputStream;
+import java.io.OutputStream;
+import java.io.Reader;
+import java.io.Writer;
 import java.io.FileNotFoundException;
 import java.io.IOException;
 import java.io.RandomAccessFile;
@@ -42,10 +47,12 @@
 public final class FileStream extends Stream
 {
     private final RandomAccessCharacterFile racf;
-    private final RandomAccessCharacterFile in;
-    private final RandomAccessCharacterFile out;
     private final Pathname pathname;
     private final int bytesPerUnit;
+    private InputStream inst;
+    private OutputStream outst;
+    private Reader reader;
+    private Writer writer;
 
     public enum EolStyle {
         CR,
@@ -94,9 +101,7 @@
         
         Debug.assertTrue(mode != null);
         RandomAccessFile raf = new RandomAccessFile(file, mode);
-        racf = new RandomAccessCharacterFile(raf, encoding);
-        in = isInputStream ? racf : null;
-        out = isOutputStream ? racf : null;
+	
         // ifExists is ignored unless we have an output stream.
         if (isOutputStream) {
             final long length = file.isFile() ? file.length() : 0;
@@ -109,11 +114,21 @@
                     raf.setLength(0);
             }
         }
+	// don't touch raf directly after passing it to racf.
+	// the state will become inconsistent if you do that.
+        racf = new RandomAccessCharacterFile(raf, encoding);
+
         this.pathname = pathname;
         this.elementType = elementType;
         if (elementType == Symbol.CHARACTER || elementType == Symbol.BASE_CHAR) {
             isCharacterStream = true;
             bytesPerUnit = 1;
+	    if (isInputStream) {
+		reader = racf.getReader();
+	    }
+	    if (isOutputStream) {
+		writer = racf.getWriter();
+	    }
         } else {
             isBinaryStream = true;
             int width;
@@ -124,6 +139,12 @@
                 width = 8;
             }
             bytesPerUnit = width / 8;
+	    if (isInputStream) {
+		inst = racf.getInputStream();
+	    }
+	    if (isOutputStream) {
+		outst = racf.getOutputStream();
+	    }
         }
         eolChar = (eol == EolStyle.CR) ? '\r' : '\n';
     }
@@ -159,12 +180,13 @@
     public LispObject listen() throws ConditionThrowable
     {
         try {
-            return in.dataIsAvailableForRead() ? T : NIL;
-        }
-        catch (NullPointerException e) {
-            streamNotInputStream();
+	    if (isInputStream) {
+		return (racf.position() < racf.length()) ? T : NIL;
+	    } else {
+		streamNotInputStream();
+	    }
         }
-        catch (IOException e) {
+	catch (IOException e) {
             error(new StreamError(this, e));
         }
         // Not reached.
@@ -204,27 +226,28 @@
     protected int _readChar() throws ConditionThrowable
     {
         try {
-            int c = in.getReader().read();
+            int c = reader.read();
             if (eolStyle == EolStyle.CRLF) {
                 if (c == '\r') {
-                    long mark = in.position();
-                    int c2 = in.getReader().read();
+                    int c2 = reader.read();
                     if (c2 == '\n') {
                         ++lineNumber;
                         return c2;
-                    }
-                    // '\r' was not followed by '\n'
-                    // we cannot depend on characters to contain 1 byte only
-                    // so we need to revert to the last known position.
-                    in.position(mark);
+                    } else {
+			// '\r' was not followed by '\n'
+			// we cannot depend on characters to contain 1 byte only
+			// so we need to revert to the last known position.
+			// The classical use case for unreadChar
+			racf.unreadChar((char)c2);
+		    }
                 }
                 return c;
-            }
-            if (c == eolChar) {
+            } else if (c == eolChar) {
                 ++lineNumber;
                 return c;
-            }
-            return c;
+            } else {
+		return c;
+	    }
         }
         catch (NullPointerException e) {
             streamNotInputStream();
@@ -240,7 +263,7 @@
     protected void _unreadChar(int n) throws ConditionThrowable
     {
         try {
-            in.unreadChar((char)n);
+            racf.unreadChar((char)n);
         }
         catch (IOException e) {
             error(new StreamError(this, e));
@@ -259,11 +282,11 @@
         try {
             if (c == '\n') {
                 if (eolStyle == EolStyle.CRLF)
-                    out.getWriter().write((byte)'\r');
-                out.getWriter().write((byte)eolChar);
+                    writer.write('\r');
+                writer.write(eolChar);
                 charPos = 0;
             } else {
-                out.getWriter().write((byte)c);
+                writer.write(c);
                 ++charPos;
             }
         }
@@ -272,20 +295,41 @@
         }
     }
 
-    @Override
+
     public void _writeChars(char[] chars, int start, int end)
+        throws ConditionThrowable {
+	_writeChars(chars, start, end, true);
+    }
+
+    public void _writeChars(char[] chars, int start, int end, boolean maintainCharPos)
         throws ConditionThrowable
     {
         try {
-            if (eolStyle == EolStyle.CRLF) {
+	    if (eolStyle == EolStyle.LF) {
+		/* we can do a little bit better in this special case */
+		writer.write(chars, start, end);
+		if (maintainCharPos) {
+		    int lastlfpos = -1;
+		    for (int i = start; i < end; i++) {
+			if (chars[i] == '\n') {
+			    lastlfpos = i;
+			}
+		    }
+		    if (lastlfpos == -1) {
+			charPos += end - start;
+		    } else {
+			charPos = end - lastlfpos;
+		    }
+		}
+	    } else if (eolStyle == EolStyle.CRLF) {
                 for (int i = start; i < end; i++) {
                     char c = chars[i];
                     if (c == '\n') {
-                        out.getWriter().write((byte)'\r');
-                        out.getWriter().write((byte)'\n');
+                        writer.write('\r');
+                        writer.write('\n');
                         charPos = 0;
                     } else {
-                        out.getWriter().write((byte)c);
+                        writer.write(c);
                         ++charPos;
                     }
                 }
@@ -293,10 +337,10 @@
                 for (int i = start; i < end; i++) {
                     char c = chars[i];
                     if (c == '\n') {
-                        out.getWriter().write((byte)eolChar);
+                        writer.write(eolChar);
                         charPos = 0;
                     } else {
-                        out.getWriter().write((byte)c);
+                        writer.write(c);
                         ++charPos;
                     }
                 }
@@ -310,13 +354,13 @@
     @Override
     public void _writeString(String s) throws ConditionThrowable
     {
-        _writeChars(s.toCharArray(), 0, s.length());
+        _writeChars(s.toCharArray(), 0, s.length(), true);
     }
 
     @Override
     public void _writeLine(String s) throws ConditionThrowable
     {
-        _writeString(s);
+	_writeChars(s.toCharArray(), 0, s.length(), false);
         if (eolStyle == EolStyle.CRLF)
             _writeChar('\r');
         _writeChar(eolChar);
@@ -328,7 +372,7 @@
     public int _readByte() throws ConditionThrowable
     {
         try {
-            return in.getInputStream().read(); // Reads an 8-bit byte.
+            return inst.read(); // Reads an 8-bit byte.
         }
         catch (NullPointerException e) {
             streamNotInputStream();
@@ -345,7 +389,7 @@
     public void _writeByte(int n) throws ConditionThrowable
     {
         try {
-            out.getOutputStream().write(n); // Writes an 8-bit byte.
+            outst.write(n); // Writes an 8-bit byte.
         }
         catch (NullPointerException e) {
             streamNotOutputStream();
@@ -359,10 +403,11 @@
     public void _clearInput() throws ConditionThrowable
     {
         try {
-            in.position(in.length());
-        }
-        catch (NullPointerException e) {
-            streamNotInputStream();
+	    if (isInputStream) {
+		racf.position(racf.length());
+	    } else {
+		streamNotInputStream();
+	    }
         }
         catch (IOException e) {
             error(new StreamError(this, e));
@@ -422,7 +467,7 @@
         return unreadableString(Symbol.FILE_STREAM);
     }
 
-    // ### make-file-stream pathname namestring element-type direction if-exists => stream
+    // ### make-file-stream pathname namestring element-type direction if-exists external-format => stream
     private static final Primitive MAKE_FILE_STREAM =
         new Primitive("make-file-stream", PACKAGE_SYS, true,
                       "pathname namestring element-type direction if-exists external-format")
@@ -454,16 +499,20 @@
             
             String encoding = "ISO-8859-1";
             if (externalFormat != NIL) {
-                Symbol enc = (Symbol)externalFormat.car(); //FIXME: class cast exception to be caught
-                if (enc != NIL) {
-                    if (enc != keywordCodePage) {
-                        encoding = enc.getName();
-                    }
-                    //FIXME: the else for the keywordCodePage to be filled in
-                }
-                //FIXME: the else for the == NIL to be filled in: raise an error...
+		if (externalFormat instanceof Symbol) {
+		    Symbol enc = (Symbol)externalFormat; //FIXME: class cast exception to be caught
+		    if (enc != NIL) {
+			if (enc != keywordCodePage) {
+			    encoding = enc.getName();
+			}
+			//FIXME: the else for the keywordCodePage to be filled in
+		    }
+		    //FIXME: the else for the == NIL to be filled in: raise an error...
+		} else if (externalFormat instanceof AbstractString) {
+		    AbstractString encName = (AbstractString) externalFormat;
+		    encoding = encName.getStringValue();
+		}
             }
-        
             
             
             if (direction != Keyword.INPUT && direction != Keyword.OUTPUT &&

Modified: branches/open-external-format/src/org/armedbear/lisp/open.lisp
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/open.lisp	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/open.lisp	Sat Nov 29 21:40:18 2008
@@ -106,7 +106,7 @@
 	     (if-exists nil if-exists-given)
 	     (if-does-not-exist nil if-does-not-exist-given)
 	     (external-format :default))
-  (declare (ignore external-format)) ; FIXME
+;  (declare (ignore external-format)) ; FIXME
   (setf element-type (case element-type
                        ((character base-char)
                         'character)
@@ -143,7 +143,7 @@
                    :pathname pathname
                    :format-control "The file ~S does not exist."
                    :format-arguments (list namestring)))))
-       (make-file-stream pathname namestring element-type :input nil nil))
+       (make-file-stream pathname namestring element-type :input nil external-format))
       (:probe
        (case if-does-not-exist
          (:error
@@ -158,7 +158,7 @@
           ;; not yet exist." See java.io.File.createNewFile().
           (create-new-file namestring)))
        (let ((stream (make-file-stream pathname namestring element-type
-                                       :input nil nil)))
+                                       :input nil external-format)))
          (when stream
            (close stream))
          stream))
@@ -206,7 +206,7 @@
                  :format-control "Option not supported: ~S."
                  :format-arguments (list if-exists))))
        (let ((stream (make-file-stream pathname namestring element-type
-                                       direction if-exists nil)))
+                                       direction if-exists external-format)))
          (unless stream
            (error 'file-error
                   :pathname pathname

Modified: branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	Sat Nov 29 21:40:18 2008
@@ -40,6 +40,8 @@
 import java.io.RandomAccessFile;
 import java.io.Reader;
 import java.io.Writer;
+import java.io.PrintWriter;
+import java.io.FileWriter;
 import java.nio.ByteBuffer;
 import java.nio.CharBuffer;
 import java.nio.channels.FileChannel;
@@ -50,397 +52,399 @@
 
 public class RandomAccessCharacterFile {
 
-        public class RandomAccessInputStream extends InputStream {
+    private class RandomAccessInputStream extends InputStream {
 
-                private RandomAccessCharacterFile racf;
+	private RandomAccessInputStream() {
+	}
+	
+	private byte[] buf = new byte[1];
 
-                public RandomAccessInputStream(RandomAccessCharacterFile racf) {
-                        this.racf = racf;
-                }
-                private byte[] buf = new byte[1];
-
-                public int read() throws IOException {
-                        int len = read(buf);
-                        if (len == 1) {
-                                // byte is signed, char is unsigned, int is signed.
-                                // buf can hold 0xff, we want it as 0xff in int, not -1.
-                                return 0xff & (int) buf[0];
-                        } else {
-                                return -1;
-                        }
-                }
+	public int read() throws IOException {
+	    int len = read(buf);
+	    if (len == 1) {
+		// byte is signed, char is unsigned, int is signed.
+		// buf can hold 0xff, we want it as 0xff in int, not -1.
+		return 0xff & (int) buf[0];
+	    } else {
+		return -1;
+	    }
+	}
                 
-                @Override
-                public int read(byte[] b, int off, int len) throws IOException {
-                        return racf.read(b, off, len);
-                }
-        }
-
-        public class RandomAccessOutputStream extends OutputStream {
-
-                private RandomAccessCharacterFile racf;
-
-                public RandomAccessOutputStream(RandomAccessCharacterFile racf) {
-                        this.racf = racf;
-                }
-
-                private byte[] buf = new byte[1];
-                public void write(int b) throws IOException {
-                        buf[0] = (byte)b;
-                        write(buf);
-                }
-
-                @Override
-                public void write(byte[] b, int off, int len) throws IOException {
-                        racf.write(b, off, len);
-                }
-        }
-
-        public class RandomAccessReader extends Reader {
-
-                private RandomAccessCharacterFile racf;
-
-                public RandomAccessReader(
-                                RandomAccessCharacterFile racf) {
-                        this.racf = racf;
-                }
-
-                public void close() throws IOException {
-                        racf.close();
-                }
-
-                public int read(char[] cb, int off, int len) throws IOException {
-                        return racf.read(cb, off, len);
-                }
-        }
-
-        public class RandomAccessWriter extends Writer {
-
-                private RandomAccessCharacterFile racf;
-
-                public RandomAccessWriter(
-                                RandomAccessCharacterFile racf) {
-                        this.racf = racf;
-                }
-
-                public void close() throws IOException {
-                        racf.close();
-                }
-
-                public void flush() throws IOException {
-                        racf.flush();
-                }
-
-                public void write(char[] cb, int off, int len) throws IOException {
-                        racf.write(cb, off, len);
-                }
-
-        }
-
-
-	final static int BUFSIZ = 4*1024; // setting this to a small value like 8 is helpful for testing.
-	
-	private RandomAccessWriter writer;
-	private RandomAccessReader reader;
-	private RandomAccessInputStream inputStream;
-	private RandomAccessOutputStream outputStream;
-	private FileChannel fcn;
-	private long fcnpos; /* where fcn is pointing now. */
-	private long fcnsize; /* the file size */
-	
-	private Charset cset;
-	private CharsetEncoder cenc;
-	private CharsetDecoder cdec;
-	
-	/**
-	 * bbuf is treated as a cache of the file content.
-	 * If it points to somewhere in the middle of the file, it holds the copy of the file content,
-	 * even when you are writing a large chunk of data.  If you write in the middle of a file,
-	 * bbuf first gets filled with contents of the data, and only after that any new data is
-	 * written on bbuf.
-	 * The exception is when you are appending data at the end of the file.
-	 */
-	private ByteBuffer bbuf;
-	private boolean bbufIsDirty; /* whether bbuf holds data that must be written. */
-	private long bbufpos; /* where the beginning of bbuf is pointing in the file now. */
-
-	public RandomAccessCharacterFile(RandomAccessFile raf, String encoding) throws IOException {
-		fcn = raf.getChannel();
-		fcnpos = 0; // fcn points at BOF.
-		fcnsize = fcn.size();
-		
-		cset = Charset.forName(encoding);
-		cdec = cset.newDecoder();
-		cenc = cset.newEncoder(); 
-		
-		bbuf = ByteBuffer.allocate(BUFSIZ);
-		
-		// there is no readable data available in the buffers.
-		bbuf.flip();
-		
-		// there is no write pending data in the buffers.
-		bbufIsDirty = false;
-		
-		bbufpos = fcn.position(); // so as the byte buffer.
+	@Override
+	    public int read(byte[] b, int off, int len) throws IOException {
+	    return RandomAccessCharacterFile.this.read(b, off, len);
+	}
 
-		reader = new RandomAccessReader(this);
-		writer = new RandomAccessWriter(this);
-		inputStream = new RandomAccessInputStream(this);
-		outputStream = new RandomAccessOutputStream(this);
+	public void close() throws IOException {
+	    RandomAccessCharacterFile.this.close();
 	}
-	
-	public Writer getWriter() {
-		return writer;
+    }
+
+    private class RandomAccessOutputStream extends OutputStream {
+
+	private RandomAccessOutputStream() {
 	}
-	
-	public Reader getReader() {
-		return reader;
+
+	private byte[] buf = new byte[1];
+	public void write(int b) throws IOException {
+	    buf[0] = (byte)b;
+	    write(buf);
 	}
-	
-	public InputStream getInputStream() {
-		return inputStream;
+
+	@Override
+	    public void write(byte[] b, int off, int len) throws IOException {
+	    RandomAccessCharacterFile.this.write(b, off, len);
 	}
-	
-	public OutputStream getOutputStream() {
-		return outputStream;
+
+	public void flush() throws IOException {
+	    RandomAccessCharacterFile.this.flush();
 	}
-	
+
 	public void close() throws IOException {
-		internalFlush(true);
-		fcn.close();
-	}
-	
-	public void flush() throws IOException {
-		internalFlush(false);
+	    RandomAccessCharacterFile.this.close();
 	}
+    }
 
-	public int read(char[] cb, int off, int len) throws IOException {
-		CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
-		boolean decodeWasUnderflow = false;
-                boolean atEof = false;
-		while ((cbuf.remaining() > 0) && dataIsAvailableForRead()
-                        && ! atEof) {
-			if ((bbuf.remaining() == 0) || decodeWasUnderflow) {
-				// need to read from the file.
-				flushBbuf(); // in case bbuf is dirty.
-				// update bbufpos.
-				bbufpos += bbuf.position();
-				int partialBytes = bbuf.remaining(); // partialBytes > 0 happens when decodeWasUnderflow
-				// if reads and writes are mixed, we may need to seek first.
-				if (bbufpos + partialBytes != fcnpos) {
-					fcn.position(bbufpos + partialBytes);
-				}
-				// need to read data from file.
-				bbuf.compact();
-                                //###FIXME: we're ignoring end-of-stream here!!!
-				atEof = (fcn.read(bbuf) == -1);
-				bbuf.flip();
-				fcnpos = bbufpos + bbuf.remaining();
-			}
-			CoderResult r = cdec.decode(bbuf, cbuf, pointingAtEOF() );
-			decodeWasUnderflow = (CoderResult.UNDERFLOW == r);
-		}
-		if (cbuf.remaining() == len) {
-			return -1;
-		} else {
-			return len - cbuf.remaining();
-		}
+    private class RandomAccessReader extends Reader {
+
+	private RandomAccessReader() {
 	}
 
-	public boolean dataIsAvailableForRead() throws IOException {
-		return ((bbuf.remaining() > 0) || (fcn.position() < fcn.size()));
+	public void close() throws IOException {
+	    RandomAccessCharacterFile.this.close();
 	}
-	
-	private boolean pointingAtEOF() {
-		return (bbuf.remaining() == 0) && (fcnpos == fcnsize);
+
+	@Override
+	    public int read(char[] cb, int off, int len) throws IOException {
+	    return RandomAccessCharacterFile.this.read(cb, off, len);
 	}
+    }
+
+    private class RandomAccessWriter extends Writer {
 
-	public void write(char[] cb, int off, int len) throws IOException {
-		CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
-		encodeAndWrite(cbuf, false, false);
+	private RandomAccessWriter() {
 	}
 
-	private void internalFlush(boolean endOfFile) throws IOException {
-		if (endOfFile) {
-			CharBuffer cbuf = CharBuffer.allocate(0);
-			encodeAndWrite(cbuf, true, endOfFile);
-		} else {
-			flushBbuf();
-		}
+	public void close() throws IOException {
+	    RandomAccessCharacterFile.this.close();
 	}
 
-	private void encodeAndWrite(CharBuffer cbuf, boolean flush, boolean endOfFile) throws IOException {
-		if (bbufpos == fcnsize) {
-			bbuf.clear();
-		}
-		while (cbuf.remaining() > 0) {
-			CoderResult r = cenc.encode(cbuf, bbuf, endOfFile);
-			bbufIsDirty = true;
-			long curpos = bbufpos + bbuf.position();
-			if (curpos > fcnsize) {
-				// the file is extended.
-				fcnsize = curpos;
-			}
-			if (CoderResult.OVERFLOW == r || bbuf.remaining() == 0) {
-				flushBbuf();
-				bbufpos += bbuf.limit();
-				bbuf.clear();
-				if (fcnpos < fcnsize) {
-					fcn.read(bbuf);
-					bbuf.flip();
-					fcnpos += bbuf.remaining();
-				}
-				// if we are at the end of file, bbuf is simply cleared.
-				// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
-			}
-		}
-		if (bbuf.position() > 0 && bbufIsDirty && flush) {
-			flushBbuf();
-		}
+	public void flush() throws IOException {
+	    RandomAccessCharacterFile.this.flush();
 	}
 
-	public void position(long newPosition) throws IOException {
-                flushBbuf();
-		long bbufend = bbufpos + bbuf.limit();
-		if (newPosition >= bbufpos && newPosition < bbufend) {
-			// near seek. within existing data of bbuf.
-			bbuf.position((int)(newPosition - bbufpos));
-		} else {
-			// far seek. discard the buffer.
-			flushBbuf();
-			fcn.position(newPosition);
-			fcnpos = newPosition;
-			bbuf.clear();
-			bbuf.flip(); // "there is no useful data on this buffer yet."
-			bbufpos = fcnpos;
-		}
+	@Override
+	    public void write(char[] cb, int off, int len) throws IOException {
+	    RandomAccessCharacterFile.this.write(cb, off, len);
 	}
+
+    }
+
+
+    final static int BUFSIZ = 4*1024; // setting this to a small value like 8 is helpful for testing.
 	
-	public long position() throws IOException {
-                flushBbuf();
-		return bbufpos + bbuf.position(); // the logical position within the file.
-	}
+    private RandomAccessWriter writer;
+    private RandomAccessReader reader;
+    private RandomAccessInputStream inputStream;
+    private RandomAccessOutputStream outputStream;
+    private FileChannel fcn;
+    private long fcnpos; /* where fcn is pointing now. */
+    private long fcnsize; /* the file size */
+	
+    private Charset cset;
+    private CharsetEncoder cenc;
+    private CharsetDecoder cdec;
+	
+    /**
+     * bbuf is treated as a cache of the file content.
+     * If it points to somewhere in the middle of the file, it holds the copy of the file content,
+     * even when you are writing a large chunk of data.  If you write in the middle of a file,
+     * bbuf first gets filled with contents of the data, and only after that any new data is
+     * written on bbuf.
+     * The exception is when you are appending data at the end of the file.
+     */
+    private ByteBuffer bbuf;
+    private boolean bbufIsDirty; /* whether bbuf holds data that must be written. */
+    private long bbufpos; /* where the beginning of bbuf is pointing in the file now. */
 
-        public long length() throws IOException {
-            flushBbuf();
-            return fcn.size();
-        }
-        
-	private void flushBbuf() throws IOException {
-		if (bbufIsDirty) {
-			if (fcnpos != bbufpos) {
-				fcn.position(bbufpos);
-			}
-			bbuf.position(0);
-			if (bbufpos + bbuf.limit() > fcnsize) {
-				// the buffer is at the end of the file.
-				// area beyond fcnsize does not have data.
-				bbuf.limit((int)(fcnsize - bbufpos));
-			}
-			fcn.write(bbuf);
-			fcnpos = bbufpos + bbuf.limit();
-			bbufIsDirty = false;
-		}
-	}
+    public RandomAccessCharacterFile(RandomAccessFile raf, String encoding) throws IOException {
 
-	public int read(byte[] b, int off, int len) throws IOException {
-		int pos = off;
-                boolean atEof = false;
-		while (pos - off < len && dataIsAvailableForRead()
-                        && ! atEof) {
-			if (bbuf.remaining() == 0) {
-				// need to read from the file.
-				flushBbuf(); // in case bbuf is dirty.
-				// update bbufpos.
-				bbufpos += bbuf.limit();
-				// if reads and writes are mixed, we may need to seek first.
-				if (bbufpos != fcnpos) {
-					fcn.position(bbufpos);
-				}
-				// need to read data from file.
-				bbuf.clear();
-				atEof = (fcn.read(bbuf) == -1);
-				bbuf.flip();
-				fcnpos = bbufpos + bbuf.remaining();
-			}
-			int want = len - pos;
-			if (want > bbuf.remaining()) {
-				want = bbuf.remaining();
-			}
-			bbuf.get(b, pos, want);
-			pos += want;
-		}
-		return pos - off;
+	fcn = raf.getChannel();
+	fcnpos = fcn.position();
+	fcnsize = fcn.size();
+		
+	cset = Charset.forName(encoding);
+	cdec = cset.newDecoder();
+	cenc = cset.newEncoder(); 
+		
+	bbuf = ByteBuffer.allocate(BUFSIZ);
+		
+	// there is no readable data available in the buffers.
+	bbuf.flip();
+		
+	// there is no write pending data in the buffers.
+	bbufIsDirty = false;
+		
+	bbufpos = fcn.position();
+
+	reader = new RandomAccessReader();
+	writer = new RandomAccessWriter();
+	inputStream = new RandomAccessInputStream();
+	outputStream = new RandomAccessOutputStream();
+    }
+	
+    public Writer getWriter() {
+	return writer;
+    }
+	
+    public Reader getReader() {
+	return reader;
+    }
+	
+    public InputStream getInputStream() {
+	return inputStream;
+    }
+	
+    public OutputStream getOutputStream() {
+	return outputStream;
+    }
+	
+    public void close() throws IOException {
+	internalFlush(true);
+	fcn.close();
+    }
+	
+    public void flush() throws IOException {
+	internalFlush(false);
+    }
+
+    private int read(char[] cb, int off, int len) throws IOException {
+	CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
+	boolean decodeWasUnderflow = false;
+	boolean atEof = false;
+	while ((cbuf.remaining() > 0) && dataIsAvailableForRead()
+	       && ! atEof) {
+	    if ((bbuf.remaining() == 0) || decodeWasUnderflow) {
+		// need to read from the file.
+		flushBbuf(); // in case bbuf is dirty.
+		// update bbufpos.
+		bbufpos += bbuf.position();
+		int partialBytes = bbuf.remaining(); // partialBytes > 0 happens when decodeWasUnderflow
+		// if reads and writes are mixed, we may need to seek first.
+		if (bbufpos + partialBytes != fcnpos) {
+		    fcn.position(bbufpos + partialBytes);
+		}
+		// need to read data from file.
+		bbuf.compact();
+		//###FIXME: we're ignoring end-of-stream here!!!
+		atEof = (fcn.read(bbuf) == -1);
+		bbuf.flip();
+		fcnpos = bbufpos + bbuf.remaining();
+	    }
+	    CoderResult r = cdec.decode(bbuf, cbuf, pointingAtEOF() );
+	    decodeWasUnderflow = (CoderResult.UNDERFLOW == r);
+	}
+	if (cbuf.remaining() == len) {
+	    return -1;
+	} else {
+	    return len - cbuf.remaining();
+	}
+    }
+
+    private boolean dataIsAvailableForRead() throws IOException {
+	return ((bbuf.remaining() > 0) || (fcn.position() < fcn.size()));
+    }
+	
+    private boolean pointingAtEOF() {
+	return (bbuf.remaining() == 0) && (fcnpos == fcnsize);
+    }
+
+    private void write(char[] cb, int off, int len) throws IOException {
+	CharBuffer cbuf = CharBuffer.wrap(cb, off, len);
+	encodeAndWrite(cbuf, false, false);
+    }
+
+    private void internalFlush(boolean endOfFile) throws IOException {
+	if (endOfFile) {
+	    CharBuffer cbuf = CharBuffer.allocate(0);
+	    encodeAndWrite(cbuf, true, endOfFile);
+	} else {
+	    flushBbuf();
+	}
+    }
+
+    private void encodeAndWrite(CharBuffer cbuf, boolean flush, boolean endOfFile) throws IOException {
+	if (bbufpos == fcnsize) {
+	    bbuf.clear();
+	}
+	while (cbuf.remaining() > 0) {
+	    CoderResult r = cenc.encode(cbuf, bbuf, endOfFile);
+	    bbufIsDirty = true;
+	    long curpos = bbufpos + bbuf.position();
+	    if (curpos > fcnsize) {
+		// the file is extended.
+		fcnsize = curpos;
+	    }
+	    if (CoderResult.OVERFLOW == r || bbuf.remaining() == 0) {
+		flushBbuf();
+		bbufpos += bbuf.limit();
+		bbuf.clear();
+		if (fcnpos < fcnsize) {
+		    fcn.read(bbuf);
+		    bbuf.flip();
+		    fcnpos += bbuf.remaining();
+		}
+		// if we are at the end of file, bbuf is simply cleared.
+		// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
+	    }
+	}
+	if (bbuf.position() > 0 && bbufIsDirty && flush) {
+	    flushBbuf();
+	}
+    }
+
+    public void position(long newPosition) throws IOException {
+	flushBbuf();
+	long bbufend = bbufpos + bbuf.limit();
+	if (newPosition >= bbufpos && newPosition < bbufend) {
+	    // near seek. within existing data of bbuf.
+	    bbuf.position((int)(newPosition - bbufpos));
+	} else {
+	    // far seek. discard the buffer.
+	    flushBbuf();
+	    fcn.position(newPosition);
+	    fcnpos = newPosition;
+	    bbuf.clear();
+	    bbuf.flip(); // "there is no useful data on this buffer yet."
+	    bbufpos = fcnpos;
+	}
+    }
+	
+    public long position() throws IOException {
+	flushBbuf();
+	return bbufpos + bbuf.position(); // the logical position within the file.
+    }
+
+    public long length() throws IOException {
+	flushBbuf();
+	return fcn.size();
+    }
+        
+    private void flushBbuf() throws IOException {
+	if (bbufIsDirty) {
+	    if (fcnpos != bbufpos) {
+		fcn.position(bbufpos);
+	    }
+	    bbuf.position(0);
+	    if (bbufpos + bbuf.limit() > fcnsize) {
+		// the buffer is at the end of the file.
+		// area beyond fcnsize does not have data.
+		bbuf.limit((int)(fcnsize - bbufpos));
+	    }
+	    fcn.write(bbuf);
+	    fcnpos = bbufpos + bbuf.limit();
+	    bbufIsDirty = false;
+	}
+    }
+
+    public int read(byte[] b, int off, int len) throws IOException {
+	int pos = off;
+	boolean atEof = false;
+	while (pos - off < len && dataIsAvailableForRead()
+	       && ! atEof) {
+	    if (bbuf.remaining() == 0) {
+		// need to read from the file.
+		flushBbuf(); // in case bbuf is dirty.
+		// update bbufpos.
+		bbufpos += bbuf.limit();
+		// if reads and writes are mixed, we may need to seek first.
+		if (bbufpos != fcnpos) {
+		    fcn.position(bbufpos);
+		}
+		// need to read data from file.
+		bbuf.clear();
+		atEof = (fcn.read(bbuf) == -1);
+		bbuf.flip();
+		fcnpos = bbufpos + bbuf.remaining();
+	    }
+	    int want = len - pos;
+	    if (want > bbuf.remaining()) {
+		want = bbuf.remaining();
+	    }
+	    bbuf.get(b, pos, want);
+	    pos += want;
 	}
+	return pos - off;
+    }
         
-	// a method corresponding to the good ol' ungetc in C.
-	// This function may fail when using (combined) character codes that use
-	// escape sequences to switch between sub-codes.
-	// ASCII, ISO-8859 series, any 8bit code are OK, all unicode variations are OK,
-	// but applications of the ISO-2022 encoding framework can have trouble.
-	// Example of such code is ISO-2022-JP which is used in Japanese e-mail.
-	private CharBuffer singleCharBuf;
-	private ByteBuffer shortByteBuf;
-	public void unreadChar(char c) throws IOException {
-		// algorithm : 
-		//  1. encode c into bytes, to find out how many bytes it corresponds to
-		//  2. move the position backwards that many bytes.
-		//  ** we stop here.  Don't bother to write the bytes to the buffer,
-		//     assuming that it is the same as the original data.
-		//     If we allow to write back different characters, the buffer must get 'dirty'
-		//     but that would require read/write permissions on files you use unreadChar,
-		//     even if you are just reading for some tokenizer.
-		//
-		//  So we don't do the following.
-		//  3. write the bytes.
-		//  4. move the position back again.
-		if (singleCharBuf == null) {
-			singleCharBuf = CharBuffer.allocate(1);
-			shortByteBuf = ByteBuffer.allocate((int)cenc.maxBytesPerChar());
-		}
-		singleCharBuf.clear();
-		singleCharBuf.append(c);
-		singleCharBuf.flip();
-		shortByteBuf.clear();
-		cenc.encode(singleCharBuf, shortByteBuf, false);
-		int n = shortByteBuf.position();
-		long pos = position() - n;
-		position(pos);
-	}
-	
-	public void unreadByte(byte b) throws IOException {
-		long pos = position() - 1;
-		position(pos);
-	}
-
-	public void write(byte[] b, int off, int len) throws IOException {
-		int pos = off;
-		while (pos < off + len) {
-			int want = len;
-			if (want > bbuf.remaining()) {
-				want = bbuf.remaining();
-			}
-			bbuf.put(b, pos, want);
-			pos += want;
-			bbufIsDirty = true;
-			long curpos = bbufpos + bbuf.position();
-			if (curpos > fcn.size()) {
-				// the file is extended.
-				fcnsize = curpos;
-			}
-			if (bbuf.remaining() == 0) {
-				flushBbuf();
-				bbufpos += bbuf.limit();
-				bbuf.clear();
-				if (fcn.position() < fcn.size()) {
-                                        bbufpos = fcn.position();
-					fcn.read(bbuf);
-					bbuf.flip();
-					fcnpos += bbuf.remaining();
-				}
-				// if we are at the end of file, bbuf is simply cleared.
-				// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
-			}
-		}
+    // a method corresponding to the good ol' ungetc in C.
+    // This function may fail when using (combined) character codes that use
+    // escape sequences to switch between sub-codes.
+    // ASCII, ISO-8859 series, any 8bit code are OK, all unicode variations are OK,
+    // but applications of the ISO-2022 encoding framework can have trouble.
+    // Example of such code is ISO-2022-JP which is used in Japanese e-mail.
+    private CharBuffer singleCharBuf;
+    private ByteBuffer shortByteBuf;
+    public void unreadChar(char c) throws IOException {
+	// algorithm : 
+	//  1. encode c into bytes, to find out how many bytes it corresponds to
+	//  2. move the position backwards that many bytes.
+	//  ** we stop here.  Don't bother to write the bytes to the buffer,
+	//     assuming that it is the same as the original data.
+	//     If we allow to write back different characters, the buffer must get 'dirty'
+	//     but that would require read/write permissions on files you use unreadChar,
+	//     even if you are just reading for some tokenizer.
+	//
+	//  So we don't do the following.
+	//  3. write the bytes.
+	//  4. move the position back again.
+	if (singleCharBuf == null) {
+	    singleCharBuf = CharBuffer.allocate(1);
+	    shortByteBuf = ByteBuffer.allocate((int)cenc.maxBytesPerChar());
+	}
+	singleCharBuf.clear();
+	singleCharBuf.append(c);
+	singleCharBuf.flip();
+	shortByteBuf.clear();
+	cenc.encode(singleCharBuf, shortByteBuf, false);
+	int n = shortByteBuf.position();
+	long pos = position() - n;
+	position(pos);
+    }
+	
+    public void unreadByte(byte b) throws IOException {
+	long pos = position() - 1;
+	position(pos);
+    }
+
+    private void write(byte[] b, int off, int len) throws IOException {
+	int pos = off;
+	while (pos < off + len) {
+	    int want = len;
+	    if (want > bbuf.remaining()) {
+		want = bbuf.remaining();
+	    }
+	    bbuf.put(b, pos, want);
+	    pos += want;
+	    bbufIsDirty = true;
+	    long curpos = bbufpos + bbuf.position();
+	    if (curpos > fcn.size()) {
+		// the file is extended.
+		fcnsize = curpos;
+	    }
+	    if (bbuf.remaining() == 0) {
+		flushBbuf();
+		bbufpos += bbuf.limit();
+		bbuf.clear();
+		if (fcn.position() < fcn.size()) {
+		    bbufpos = fcn.position();
+		    fcn.read(bbuf);
+		    bbuf.flip();
+		    fcnpos += bbuf.remaining();
+		}
+		// if we are at the end of file, bbuf is simply cleared.
+		// in that case, bbufpos + bbuf.position points to the EOF, not fcnpos. 
+	    }
 	}
+    }
 }



From ehuelsmann at common-lisp.net  Sun Nov 30 13:32:17 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 30 Nov 2008 13:32:17 +0000
Subject: [armedbear-cvs] r11404 -
	branches/open-external-format/src/org/armedbear/lisp
Message-ID: <E1L6mPJ-0007E3-20@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov 30 13:32:16 2008
New Revision: 11404

Log:
Default to the system encoding for input/output streams when no ENCODING specified.

Note: The default/fallback encoding would be ISO-8859-1 (latin-1).

Patch by: Hideo
Tweaked by: me


Modified:
   branches/open-external-format/src/org/armedbear/lisp/Stream.java

Modified: branches/open-external-format/src/org/armedbear/lisp/Stream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/Stream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/Stream.java	Sun Nov 30 13:32:16 2008
@@ -79,7 +79,7 @@
    * required when calling FRESH-LINE
    */
   protected int charPos;
-
+  
   // Binary input.
   private BufferedInputStream in;
 
@@ -90,8 +90,14 @@
   {
   }
 
-  // Input stream constructors.
   public Stream(InputStream inputStream, LispObject elementType)
+    {
+	this(inputStream, elementType, null);
+    }
+
+
+  // Input stream constructors.
+    public Stream(InputStream inputStream, LispObject elementType, String encoding)
   {
     this.elementType = elementType;
     if (elementType == Symbol.CHARACTER || elementType == Symbol.BASE_CHAR)
@@ -101,7 +107,9 @@
         try
           {
             inputStreamReader =
-              new InputStreamReader(inputStream, "ISO-8859-1");
+                    (encoding == null) ?
+                        new InputStreamReader(inputStream)
+                        : new InputStreamReader(inputStream, encoding);
           }
         catch (java.io.UnsupportedEncodingException e)
           {
@@ -127,8 +135,13 @@
     setInteractive(interactive);
   }
 
-  // Output stream constructors.
   public Stream(OutputStream outputStream, LispObject elementType)
+    {
+	this(outputStream, elementType, null);
+    }
+    
+  // Output stream constructors.
+  public Stream(OutputStream outputStream, LispObject elementType, String encoding)
   {
     this.elementType = elementType;
     if (elementType == Symbol.CHARACTER || elementType == Symbol.BASE_CHAR)
@@ -136,7 +149,9 @@
         isCharacterStream = true;
         try
           {
-            writer = new OutputStreamWriter(outputStream, "ISO-8859-1");
+            writer = (encoding == null) ?
+                new OutputStreamWriter(outputStream)
+                : new OutputStreamWriter(outputStream, encoding);
           }
         catch (java.io.UnsupportedEncodingException e)
           {



From ehuelsmann at common-lisp.net  Sun Nov 30 20:02:36 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 30 Nov 2008 20:02:36 +0000
Subject: [armedbear-cvs] r11405 -
	branches/open-external-format/src/org/armedbear/lisp/util
Message-ID: <E1L6sV2-0001EJ-53@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov 30 20:02:35 2008
New Revision: 11405

Log:
Cleanup: Add some @Override modifiers and remove unused imports.

Modified:
   branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java

Modified: branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	Sun Nov 30 20:02:35 2008
@@ -40,8 +40,6 @@
 import java.io.RandomAccessFile;
 import java.io.Reader;
 import java.io.Writer;
-import java.io.PrintWriter;
-import java.io.FileWriter;
 import java.nio.ByteBuffer;
 import java.nio.CharBuffer;
 import java.nio.channels.FileChannel;
@@ -71,10 +69,11 @@
 	}
                 
 	@Override
-	    public int read(byte[] b, int off, int len) throws IOException {
+        public int read(byte[] b, int off, int len) throws IOException {
 	    return RandomAccessCharacterFile.this.read(b, off, len);
 	}
 
+	@Override
 	public void close() throws IOException {
 	    RandomAccessCharacterFile.this.close();
 	}
@@ -96,10 +95,12 @@
 	    RandomAccessCharacterFile.this.write(b, off, len);
 	}
 
+	@Override
 	public void flush() throws IOException {
 	    RandomAccessCharacterFile.this.flush();
 	}
 
+	@Override
 	public void close() throws IOException {
 	    RandomAccessCharacterFile.this.close();
 	}



From ehuelsmann at common-lisp.net  Sun Nov 30 20:47:00 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 30 Nov 2008 20:47:00 +0000
Subject: [armedbear-cvs] r11406 -
	branches/open-external-format/src/org/armedbear/lisp
Message-ID: <E1L6tC0-0003Iw-6v@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov 30 20:46:59 2008
New Revision: 11406

Log:
Handle external format in Stream.java, in preparation of it being generally applicable to streams.

Modified:
   branches/open-external-format/src/org/armedbear/lisp/FileStream.java
   branches/open-external-format/src/org/armedbear/lisp/Stream.java

Modified: branches/open-external-format/src/org/armedbear/lisp/FileStream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/FileStream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/FileStream.java	Sun Nov 30 20:46:59 2008
@@ -54,22 +54,9 @@
     private Reader reader;
     private Writer writer;
 
-    public enum EolStyle {
-        CR,
-        CRLF,
-        LF
-    }
-    
-    static final private Symbol keywordCodePage = Packages.internKeyword("CODE-PAGE");
-    
-    private final static EolStyle platformEolStyle = Utilities.isPlatformWindows ? EolStyle.CRLF : EolStyle.LF;
-    
-    private EolStyle eolStyle = platformEolStyle;
-    private char eolChar = 0;
-    
     public FileStream(Pathname pathname, String namestring,
                       LispObject elementType, LispObject direction,
-                      LispObject ifExists, String encoding, EolStyle eol)
+                      LispObject ifExists, LispObject format)
         throws IOException
     {
         /* externalFormat is a LispObject of which the first char is a
@@ -114,6 +101,8 @@
                     raf.setLength(0);
             }
         }
+        setExternalFormat(format);
+        
 	// don't touch raf directly after passing it to racf.
 	// the state will become inconsistent if you do that.
         racf = new RandomAccessCharacterFile(raf, encoding);
@@ -146,7 +135,6 @@
 		outst = racf.getOutputStream();
 	    }
         }
-        eolChar = (eol == EolStyle.CR) ? '\r' : '\n';
     }
 
     @Override
@@ -295,7 +283,7 @@
         }
     }
 
-
+    @Override
     public void _writeChars(char[] chars, int start, int end)
         throws ConditionThrowable {
 	_writeChars(chars, start, end, true);
@@ -497,31 +485,13 @@
             LispObject ifExists = fifth;
             LispObject externalFormat = sixth;
             
-            String encoding = "ISO-8859-1";
-            if (externalFormat != NIL) {
-		if (externalFormat instanceof Symbol) {
-		    Symbol enc = (Symbol)externalFormat; //FIXME: class cast exception to be caught
-		    if (enc != NIL) {
-			if (enc != keywordCodePage) {
-			    encoding = enc.getName();
-			}
-			//FIXME: the else for the keywordCodePage to be filled in
-		    }
-		    //FIXME: the else for the == NIL to be filled in: raise an error...
-		} else if (externalFormat instanceof AbstractString) {
-		    AbstractString encName = (AbstractString) externalFormat;
-		    encoding = encName.getStringValue();
-		}
-            }
-            
-            
             if (direction != Keyword.INPUT && direction != Keyword.OUTPUT &&
                 direction != Keyword.IO)
                 error(new LispError("Direction must be :INPUT, :OUTPUT, or :IO."));
             try {
                 return new FileStream(pathname, namestring.getStringValue(),
                                       elementType, direction, ifExists,
-                                      encoding, platformEolStyle);
+                                      externalFormat);
             }
             catch (FileNotFoundException e) {
                 return NIL;

Modified: branches/open-external-format/src/org/armedbear/lisp/Stream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/Stream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/Stream.java	Sun Nov 30 20:46:59 2008
@@ -80,6 +80,31 @@
    */
   protected int charPos;
   
+  public enum EolStyle {
+    RAW,
+    CR,
+    CRLF,
+    LF
+  }
+
+  static final private Symbol keywordDefault = Packages.internKeyword("DEFAULT");
+  
+  static final private Symbol keywordCodePage = Packages.internKeyword("CODE-PAGE");
+  static final private Symbol keywordID = Packages.internKeyword("ID");
+
+  static final private Symbol keywordEolStyle = Packages.internKeyword("EOL-STYLE");
+  static final private Symbol keywordCR = Packages.internKeyword("CR");
+  static final private Symbol keywordLF = Packages.internKeyword("LF");
+  static final private Symbol keywordCRLF = Packages.internKeyword("CRLF");
+  static final private Symbol keywordRAW = Packages.internKeyword("RAW");
+    
+  public final static EolStyle platformEolStyle = Utilities.isPlatformWindows ? EolStyle.CRLF : EolStyle.LF;
+    
+  protected EolStyle eolStyle = platformEolStyle;
+  protected char eolChar = 0;
+  protected LispObject externalFormat = LispObject.NIL;
+  protected String encoding = null;
+  
   // Binary input.
   private BufferedInputStream in;
 
@@ -215,6 +240,71 @@
     interactive = b;
   }
 
+  public LispObject getExternalFormat() {
+      return externalFormat;
+  }
+  
+  public String getEncoding() {
+      return encoding;
+  }
+  
+  public void setExternalFormat(LispObject format) {
+    if (format == keywordDefault) {
+      encoding = null;
+      eolStyle = platformEolStyle;
+      eolChar = (eolStyle == EolStyle.CR) ? '\r' : '\n';
+      externalFormat = format;
+      
+      return;
+    }
+      
+    try {
+      LispObject enc;
+      boolean encIsCp = false;
+      
+      if (format instanceof Cons) {
+          // meaning a non-empty list
+          enc = format.car();
+
+          if (enc == keywordCodePage) {
+              encIsCp = true;
+
+              enc = LispObject.getf(format.cdr(), keywordID, null);
+          }
+          
+          LispObject eol = LispObject.getf(format.cdr(), keywordEolStyle, keywordRAW);
+          if (eol == keywordCR)
+              eolStyle = EolStyle.CR;
+          else if (eol == keywordLF)
+              eolStyle = EolStyle.LF;
+          else if (eol == keywordCRLF)
+              eolStyle = EolStyle.CRLF;
+          else if (eol != keywordRAW)
+              //###FIXME: raise an error
+              ;
+          
+      } else
+        enc = format;
+      
+      if (enc.numberp())
+          encoding = enc.toString();
+      else if (enc instanceof AbstractString)
+          encoding = enc.getStringValue();
+      else if (enc instanceof Symbol)
+          encoding = ((Symbol)enc).getName();
+      else
+          //###FIXME: raise an error!
+          ;
+      
+      if (encIsCp)
+          encoding = "Cp" + encoding;
+    }
+    catch (ConditionThrowable ct) { }
+    
+    eolChar = (eolStyle == EolStyle.CR) ? '\r' : '\n';
+    externalFormat = format;
+  }
+  
   public boolean isOpen()
   {
     return open;



From ehuelsmann at common-lisp.net  Sun Nov 30 21:54:52 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 30 Nov 2008 21:54:52 +0000
Subject: [armedbear-cvs] r11407 - in
	branches/open-external-format/src/org/armedbear/lisp: . util
Message-ID: <E1L6uFg-0006bm-L7@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov 30 21:54:52 2008
New Revision: 11407

Log:
Allow for null ENCODING values: they mean "default".

Modified:
   branches/open-external-format/src/org/armedbear/lisp/socket.lisp
   branches/open-external-format/src/org/armedbear/lisp/socket_stream.java
   branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java

Modified: branches/open-external-format/src/org/armedbear/lisp/socket.lisp
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/socket.lisp	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/socket.lisp	Sun Nov 30 21:54:52 2008
@@ -31,7 +31,7 @@
 
 (in-package "SYSTEM")
 
-(defun get-socket-stream (socket &key (element-type 'character))
+(defun get-socket-stream (socket &key (element-type 'character) (external-format :default))
   ":ELEMENT-TYPE must be CHARACTER or (UNSIGNED-BYTE 8); the default is CHARACTER."
   (cond ((eq element-type 'character))
         ((equal element-type '(unsigned-byte 8)))
@@ -39,7 +39,7 @@
          (error 'simple-type-error
                 :format-control
                 ":ELEMENT-TYPE must be CHARACTER or (UNSIGNED-BYTE 8).")))
-  (%socket-stream socket element-type))
+  (%socket-stream socket element-type external-format))
 
 (defun make-socket (host port)
   (%make-socket host port))

Modified: branches/open-external-format/src/org/armedbear/lisp/socket_stream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/socket_stream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/socket_stream.java	Sun Nov 30 21:54:52 2008
@@ -40,19 +40,38 @@
 {
     private socket_stream()
     {
-        super("%socket-stream", PACKAGE_SYS, false, "socket element-type");
+        super("%socket-stream", PACKAGE_SYS, false, "socket element-type external-format");
     }
 
-    public LispObject execute(LispObject first, LispObject second)
+    static final private Symbol keywordCodePage = Packages.internKeyword("CODE-PAGE");
+
+    public LispObject execute(LispObject first, LispObject second, LispObject third)
         throws ConditionThrowable
     {
         Socket socket = (Socket) ((JavaObject)first).getObject();
         LispObject elementType = second; // Checked by caller.
+	LispObject externalFormat = third;
+	String encoding = "ISO-8859-1"; // for default
+	if (externalFormat != NIL) {
+	    if (externalFormat instanceof Symbol) {
+		Symbol enc = (Symbol)externalFormat; //FIXME: class cast exception to be caught
+		if (enc != NIL) {
+		    if (enc != keywordCodePage) {
+			encoding = enc.getName();
+		    }
+		    //FIXME: the else for the keywordCodePage to be filled in
+		}
+		//FIXME: the else for the == NIL to be filled in: raise an error...
+	    } else if (externalFormat instanceof AbstractString) {
+		AbstractString encName = (AbstractString) externalFormat;
+		encoding = encName.getStringValue();
+	    }
+	}
         try {
              Stream in =
-                 new Stream(socket.getInputStream(), elementType);
+                 new Stream(socket.getInputStream(), elementType, encoding);
              Stream out =
-                 new Stream(socket.getOutputStream(), elementType);
+                 new Stream(socket.getOutputStream(), elementType, encoding);
              return new SocketStream(socket, in, out);
         }
         catch (Exception e) {

Modified: branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java	Sun Nov 30 21:54:52 2008
@@ -173,8 +173,8 @@
 	fcn = raf.getChannel();
 	fcnpos = fcn.position();
 	fcnsize = fcn.size();
-		
-	cset = Charset.forName(encoding);
+	
+	cset = (encoding == null) ? Charset.defaultCharset() : Charset.forName(encoding);
 	cdec = cset.newDecoder();
 	cenc = cset.newEncoder(); 
 		



From ehuelsmann at common-lisp.net  Sun Nov 30 22:03:20 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 30 Nov 2008 22:03:20 +0000
Subject: [armedbear-cvs] r11408 -
	branches/open-external-format/src/org/armedbear/lisp
Message-ID: <E1L6uNs-0007QQ-Nj@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov 30 22:03:16 2008
New Revision: 11408

Log:
Revert unintended part from r11407.

Modified:
   branches/open-external-format/src/org/armedbear/lisp/socket.lisp
   branches/open-external-format/src/org/armedbear/lisp/socket_stream.java

Modified: branches/open-external-format/src/org/armedbear/lisp/socket.lisp
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/socket.lisp	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/socket.lisp	Sun Nov 30 22:03:16 2008
@@ -31,7 +31,7 @@
 
 (in-package "SYSTEM")
 
-(defun get-socket-stream (socket &key (element-type 'character) (external-format :default))
+(defun get-socket-stream (socket &key (element-type 'character))
   ":ELEMENT-TYPE must be CHARACTER or (UNSIGNED-BYTE 8); the default is CHARACTER."
   (cond ((eq element-type 'character))
         ((equal element-type '(unsigned-byte 8)))
@@ -39,7 +39,7 @@
          (error 'simple-type-error
                 :format-control
                 ":ELEMENT-TYPE must be CHARACTER or (UNSIGNED-BYTE 8).")))
-  (%socket-stream socket element-type external-format))
+  (%socket-stream socket element-type))
 
 (defun make-socket (host port)
   (%make-socket host port))

Modified: branches/open-external-format/src/org/armedbear/lisp/socket_stream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/socket_stream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/socket_stream.java	Sun Nov 30 22:03:16 2008
@@ -40,38 +40,19 @@
 {
     private socket_stream()
     {
-        super("%socket-stream", PACKAGE_SYS, false, "socket element-type external-format");
+        super("%socket-stream", PACKAGE_SYS, false, "socket element-type");
     }
 
-    static final private Symbol keywordCodePage = Packages.internKeyword("CODE-PAGE");
-
-    public LispObject execute(LispObject first, LispObject second, LispObject third)
+    public LispObject execute(LispObject first, LispObject second)
         throws ConditionThrowable
     {
         Socket socket = (Socket) ((JavaObject)first).getObject();
         LispObject elementType = second; // Checked by caller.
-	LispObject externalFormat = third;
-	String encoding = "ISO-8859-1"; // for default
-	if (externalFormat != NIL) {
-	    if (externalFormat instanceof Symbol) {
-		Symbol enc = (Symbol)externalFormat; //FIXME: class cast exception to be caught
-		if (enc != NIL) {
-		    if (enc != keywordCodePage) {
-			encoding = enc.getName();
-		    }
-		    //FIXME: the else for the keywordCodePage to be filled in
-		}
-		//FIXME: the else for the == NIL to be filled in: raise an error...
-	    } else if (externalFormat instanceof AbstractString) {
-		AbstractString encName = (AbstractString) externalFormat;
-		encoding = encName.getStringValue();
-	    }
-	}
         try {
              Stream in =
-                 new Stream(socket.getInputStream(), elementType, encoding);
+                 new Stream(socket.getInputStream(), elementType);
              Stream out =
-                 new Stream(socket.getOutputStream(), elementType, encoding);
+                 new Stream(socket.getOutputStream(), elementType);
              return new SocketStream(socket, in, out);
         }
         catch (Exception e) {



From ehuelsmann at common-lisp.net  Sun Nov 30 23:05:51 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 30 Nov 2008 23:05:51 +0000
Subject: [armedbear-cvs] r11409 -
	branches/open-external-format/src/org/armedbear/lisp
Message-ID: <E1L6vMN-00028s-UC@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov 30 23:05:51 2008
New Revision: 11409

Log:
End-of-line translation for generic streams.

Modified:
   branches/open-external-format/src/org/armedbear/lisp/Stream.java

Modified: branches/open-external-format/src/org/armedbear/lisp/Stream.java
==============================================================================
--- branches/open-external-format/src/org/armedbear/lisp/Stream.java	(original)
+++ branches/open-external-format/src/org/armedbear/lisp/Stream.java	Sun Nov 30 23:05:51 2008
@@ -1760,13 +1760,19 @@
       {
         int n = reader.read();
         ++offset;
-        if (n == '\r')
-          {
-            if (interactive && Utilities.isPlatformWindows)
-              return _readChar();
-          }
-        if (n == '\n')
+        if (eolStyle == EolStyle.CRLF && n == '\r') {
+            n = _readChar();
+            if (n != '\n') {
+                _unreadChar(n);
+                return '\r';
+            }
+        }
+
+        if (n == eolChar) {
           ++lineNumber;
+          return '\n';
+        }
+
         return n;
       }
     catch (NullPointerException e)
@@ -1793,7 +1799,7 @@
       {
         reader.unread(n);
         --offset;
-        if (n == '\n')
+        if (n == eolChar)
           --lineNumber;
       }
     catch (NullPointerException e)
@@ -1841,14 +1847,16 @@
   {
     try
       {
-        writer.write(c);
-        if (c == '\n')
-          {
-            writer.flush();
-            charPos = 0;
-          }
-        else
+        if (c == '\n') {
+          if (eolStyle == EolStyle.CRLF)
+              writer.write('\r');
+          writer.write(eolChar);
+          writer.flush();
+          charPos = 0;
+        } else {
+          writer.write(c);
           ++charPos;
+        }
       }
     catch (NullPointerException e)
       {
@@ -1874,6 +1882,13 @@
   {
     try
       {
+        if (eolStyle != EolStyle.RAW) {
+          for (int i = start; i++ < end;)
+            //###FIXME: the number of writes can be greatly reduced by
+            // writing the space between newlines as chunks.
+            _writeChar(chars[i]);
+        }
+        
         writer.write(chars, start, end - start);
         int index = -1;
         for (int i = end; i-- > start;)
@@ -1918,15 +1933,10 @@
   {
     try
       {
-        writer.write(s);
-        int index = s.lastIndexOf('\n');
-        if (index < 0)
-          charPos += s.length();
-        else
-          {
-            charPos = s.length() - (index + 1);
-            writer.flush();
-          }
+        for (int i = 0; i++ < s.length();)
+          //###FIXME: the number of writes can be greatly reduced by
+          // writing the space between newlines as chunks.
+          _writeChar(s.charAt(i));
       }
     catch (NullPointerException e)
       {
@@ -1935,10 +1945,6 @@
         else
           throw e;
       }
-    catch (IOException e)
-      {
-        error(new StreamError(this, e));
-      }
   }
 
   /** Writes a string to the underlying stream, appending
@@ -1951,20 +1957,14 @@
   {
     try
       {
-        writer.write(s);
-        writer.write('\n');
-        writer.flush();
-        charPos = 0;
+        _writeString(s);
+        _writeChar('\n');
       }
     catch (NullPointerException e)
       {
         // writer is null
         streamNotCharacterOutputStream();
       }
-    catch (IOException e)
-      {
-        error(new StreamError(this, e));
-      }
   }
 
   // Reads an 8-bit byte.



From ehuelsmann at common-lisp.net  Sun Nov  2 22:06:34 2008
From: ehuelsmann at common-lisp.net (Erik Huelsmann)
Date: Sun, 02 Nov 2008 22:06:34 -0000
Subject: [armedbear-cvs] r11377 - trunk/j/src/org/armedbear/lisp
Message-ID: <E1Kwl5e-0005hM-FC@common-lisp.net>

Author: ehuelsmann
Date: Sun Nov  2 22:06:34 2008
New Revision: 11377

Log:
Code reorganization: move stream related primitives from Primitives.java to Stream.java
for easier finding. (There were already some primitives in Stream.java.)

Also, merge read_char_no_hang.java and read_delimited_list.java into Stream.java.

Removed:
   trunk/j/src/org/armedbear/lisp/read_char_no_hang.java
   trunk/j/src/org/armedbear/lisp/read_delimited_list.java
Modified:
   trunk/j/src/org/armedbear/lisp/Autoload.java
   trunk/j/src/org/armedbear/lisp/Primitives.java
   trunk/j/src/org/armedbear/lisp/Stream.java

Modified: trunk/j/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Autoload.java	(original)
+++ trunk/j/src/org/armedbear/lisp/Autoload.java	Sun Nov  2 22:06:34 2008
@@ -425,8 +425,6 @@
         autoload("print-not-readable-object", "PrintNotReadable");
         autoload("probe-file", "probe_file");
         autoload("rational", "FloatFunctions");
-        autoload("read-char-no-hang", "read_char_no_hang");
-        autoload("read-delimited-list", "read_delimited_list");
         autoload("rem", "rem");
         autoload("remhash", "HashTableFunctions");
         autoload("remhash", "HashTableFunctions");

Modified: trunk/j/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Primitives.java	(original)
+++ trunk/j/src/org/armedbear/lisp/Primitives.java	Sun Nov  2 22:06:34 2008
@@ -3999,238 +3999,6 @@
       }
     };
 
-  // ### %stream-write-char character output-stream => character
-  // OUTPUT-STREAM must be a real stream, not an output stream designator!
-  private static final Primitive _WRITE_CHAR =
-    new Primitive("%stream-write-char", PACKAGE_SYS, true,
-                  "character output-stream")
-    {
-      public LispObject execute(LispObject first, LispObject second)
-        throws ConditionThrowable
-      {
-        try
-          {
-            ((Stream)second)._writeChar(((LispCharacter)first).value);
-          }
-        catch (ClassCastException e)
-          {
-            if (second instanceof Stream)
-              return type_error(first, Symbol.CHARACTER);
-            else
-              return type_error(second, Symbol.STREAM);
-          }
-        return first;
-      }
-    };
-
-  // ### %write-char character output-stream => character
-  private static final Primitive _STREAM_WRITE_CHAR =
-    new Primitive("%write-char", PACKAGE_SYS, false,
-                  "character output-stream")
-    {
-      public LispObject execute(LispObject first, LispObject second)
-        throws ConditionThrowable
-      {
-        final char c;
-        try
-          {
-            c = ((LispCharacter)first).value;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.CHARACTER);
-          }
-        if (second == T)
-          second = Symbol.TERMINAL_IO.symbolValue();
-        else if (second == NIL)
-          second = Symbol.STANDARD_OUTPUT.symbolValue();
-        final Stream stream;
-        try
-          {
-            stream = (Stream) second;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(second, Symbol.STREAM);
-          }
-        stream._writeChar(c);
-        return first;
-      }
-    };
-
-  // ### %write-string string output-stream start end => string
-  private static final Primitive _WRITE_STRING =
-    new Primitive("%write-string", PACKAGE_SYS, false,
-                  "string output-stream start end")
-    {
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third, LispObject fourth)
-        throws ConditionThrowable
-      {
-        final AbstractString s;
-        try
-          {
-            s = (AbstractString) first;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.STRING);
-          }
-        char[] chars = s.chars();
-        final Stream out;
-        try
-          {
-            if (second == T)
-              out = (Stream) Symbol.TERMINAL_IO.symbolValue();
-            else if (second == NIL)
-              out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
-            else
-              out = (Stream) second;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(second, Symbol.STREAM);
-          }
-        final int start;
-        try
-          {
-            start = ((Fixnum)third).value;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(third, Symbol.FIXNUM);
-          }
-        final int end;
-        if (fourth == NIL)
-          end = chars.length;
-        else
-          {
-            try
-              {
-                end = ((Fixnum)fourth).value;
-              }
-            catch (ClassCastException e)
-              {
-                return type_error(fourth, Symbol.FIXNUM);
-              }
-          }
-        checkBounds(start, end, chars.length);
-        out._writeChars(chars, start, end);
-        return first;
-      }
-    };
-
-  // ### %finish-output output-stream => nil
-  private static final Primitive _FINISH_OUTPUT =
-    new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream")
-    {
-      public LispObject execute(LispObject arg) throws ConditionThrowable
-      {
-        return finishOutput(arg);
-      }
-    };
-
-  // ### %force-output output-stream => nil
-  private static final Primitive _FORCE_OUTPUT =
-    new Primitive("%force-output", PACKAGE_SYS, false, "output-stream")
-    {
-      public LispObject execute(LispObject arg) throws ConditionThrowable
-      {
-        return finishOutput(arg);
-      }
-    };
-
-  private static final LispObject finishOutput(LispObject arg)
-    throws ConditionThrowable
-  {
-    final Stream out;
-    try
-      {
-        if (arg == T)
-          out = (Stream) Symbol.TERMINAL_IO.symbolValue();
-        else if (arg == NIL)
-          out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
-        else
-          out = (Stream) arg;
-      }
-    catch (ClassCastException e)
-      {
-        return type_error(arg, Symbol.STREAM);
-      }
-    return out.finishOutput();
-  }
-
-  // ### clear-input &optional input-stream => nil
-  private static final Primitive CLEAR_INPUT =
-    new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream")
-    {
-      public LispObject execute(LispObject[] args) throws ConditionThrowable
-      {
-        if (args.length > 1)
-          return error(new WrongNumberOfArgumentsException(this));
-        final Stream in;
-        if (args.length == 0)
-          in = checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue());
-        else
-          in = inSynonymOf(args[0]);
-        in.clearInput();
-        return NIL;
-      }
-    };
-
-  // ### %clear-output output-stream => nil
-  // "If any of these operations does not make sense for output-stream, then
-  // it does nothing."
-  private static final Primitive _CLEAR_OUTPUT =
-    new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream")
-    {
-      public LispObject execute(LispObject arg) throws ConditionThrowable
-      {
-        if (arg == T) // *TERMINAL-IO*
-          return NIL;
-        if (arg == NIL) // *STANDARD-OUTPUT*
-          return NIL;
-        if (arg instanceof Stream)
-          return NIL;
-        return type_error(arg, Symbol.STREAM);
-      }
-    };
-
-  // ### close stream &key abort => result
-  private static final Primitive CLOSE =
-    new Primitive(Symbol.CLOSE, "stream &key abort")
-    {
-      public LispObject execute(LispObject arg) throws ConditionThrowable
-      {
-        try
-          {
-            return ((Stream)arg).close(NIL);
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(arg, Symbol.STREAM);
-          }
-      }
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third)
-        throws ConditionThrowable
-      {
-        final Stream stream;
-        try
-          {
-            stream = (Stream) first;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.STREAM);
-          }
-        if (second == Keyword.ABORT)
-          return stream.close(third);
-        return error(new ProgramError("Unrecognized keyword argument " +
-                                       second.writeToString() + "."));
-      }
-    };
-
   // ### multiple-value-list form => list
   // Evaluates form and creates a list of the multiple values it returns.
   // Should be a macro.
@@ -4285,210 +4053,6 @@
       }
     };
 
-  // ### out-synonym-of stream-designator => stream
-  private static final Primitive OUT_SYNONYM_OF =
-    new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator")
-    {
-      public LispObject execute (LispObject arg) throws ConditionThrowable
-      {
-        if (arg instanceof Stream)
-          return arg;
-        if (arg == T)
-          return Symbol.TERMINAL_IO.symbolValue();
-        if (arg == NIL)
-          return Symbol.STANDARD_OUTPUT.symbolValue();
-        return arg;
-      }
-    };
-
-  // ### write-8-bits
-  // write-8-bits byte stream => nil
-  private static final Primitive WRITE_8_BITS =
-    new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream")
-    {
-      public LispObject execute (LispObject first, LispObject second)
-        throws ConditionThrowable
-      {
-        int n;
-        try
-          {
-            n = ((Fixnum)first).value;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.FIXNUM);
-          }
-        if (n < 0 || n > 255)
-          return type_error(first, UNSIGNED_BYTE_8);
-        try
-          {
-            ((Stream)second)._writeByte(n);
-            return NIL;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(second, Symbol.STREAM);
-          }
-      }
-    };
-
-  // ### read-8-bits
-  // read-8-bits stream &optional eof-error-p eof-value => byte
-  private static final Primitive READ_8_BITS =
-    new Primitive("read-8-bits", PACKAGE_SYS, true,
-                  "stream &optional eof-error-p eof-value")
-    {
-      public LispObject execute (LispObject first, LispObject second,
-                                 LispObject third)
-        throws ConditionThrowable
-      {
-        return checkBinaryInputStream(first).readByte((second != NIL),
-                                                      third);
-      }
-      public LispObject execute (LispObject[] args) throws ConditionThrowable
-      {
-        int length = args.length;
-        if (length < 1 || length > 3)
-          return error(new WrongNumberOfArgumentsException(this));
-        final Stream in = checkBinaryInputStream(args[0]);
-        boolean eofError = length > 1 ? (args[1] != NIL) : true;
-        LispObject eofValue = length > 2 ? args[2] : NIL;
-        return in.readByte(eofError, eofValue);
-      }
-    };
-
-  // ### read-line &optional input-stream eof-error-p eof-value recursive-p
-  // => line, missing-newline-p
-  private static final Primitive READ_LINE =
-    new Primitive(Symbol.READ_LINE,
-                  "&optional input-stream eof-error-p eof-value recursive-p")
-    {
-      public LispObject execute() throws ConditionThrowable
-      {
-        final LispObject obj = Symbol.STANDARD_INPUT.symbolValue();
-        final Stream stream;
-        try
-          {
-            stream = (Stream) obj;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(obj, Symbol.STREAM);
-          }
-        return stream.readLine(true, NIL);
-      }
-      public LispObject execute(LispObject arg) throws ConditionThrowable
-      {
-        if (arg == T)
-          arg = Symbol.TERMINAL_IO.symbolValue();
-        else if (arg == NIL)
-          arg = Symbol.STANDARD_INPUT.symbolValue();
-        final Stream stream;
-        try
-          {
-            stream = (Stream) arg;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(arg, Symbol.STREAM);
-          }
-        return stream.readLine(true, NIL);
-      }
-      public LispObject execute(LispObject first, LispObject second)
-        throws ConditionThrowable
-      {
-        if (first == T)
-          first = Symbol.TERMINAL_IO.symbolValue();
-        else if (first == NIL)
-          first = Symbol.STANDARD_INPUT.symbolValue();
-        final Stream stream;
-        try
-          {
-            stream = (Stream) first;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.STREAM);
-          }
-        return stream.readLine(second != NIL, NIL);
-      }
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third)
-        throws ConditionThrowable
-      {
-        if (first == T)
-          first = Symbol.TERMINAL_IO.symbolValue();
-        else if (first == NIL)
-          first = Symbol.STANDARD_INPUT.symbolValue();
-        final Stream stream;
-        try
-          {
-            stream = (Stream) first;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.STREAM);
-          }
-        return stream.readLine(second != NIL, third);
-      }
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third, LispObject fourth)
-        throws ConditionThrowable
-      {
-        // recursive-p is ignored
-        if (first == T)
-          first = Symbol.TERMINAL_IO.symbolValue();
-        else if (first == NIL)
-          first = Symbol.STANDARD_INPUT.symbolValue();
-        final Stream stream;
-        try
-          {
-            stream = (Stream) first;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.STREAM);
-          }
-        return stream.readLine(second != NIL, third);
-      }
-    };
-
-  // ### %read-from-string string eof-error-p eof-value start end preserve-whitespace
-  // => object, position
-  private static final Primitive _READ_FROM_STRING =
-    new Primitive("%read-from-string", PACKAGE_SYS, false)
-    {
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third, LispObject fourth,
-                                LispObject fifth, LispObject sixth)
-        throws ConditionThrowable
-      {
-        String s = first.getStringValue();
-        boolean eofError = (second != NIL);
-        boolean preserveWhitespace = (sixth != NIL);
-        final int startIndex;
-        if (fourth != NIL)
-          startIndex = Fixnum.getValue(fourth);
-        else
-          startIndex = 0;
-        final int endIndex;
-        if (fifth != NIL)
-          endIndex = Fixnum.getValue(fifth);
-        else
-          endIndex = s.length();
-        StringInputStream in =
-          new StringInputStream(s, startIndex, endIndex);
-        final LispThread thread = LispThread.currentThread();
-        LispObject result;
-        if (preserveWhitespace)
-          result = in.readPreservingWhitespace(eofError, third, false,
-                                               thread);
-        else
-          result = in.read(eofError, third, false, thread);
-        return thread.setValues(result, new Fixnum(in.getOffset()));
-      }
-    };
-
   // ### call-count
   private static final Primitive CALL_COUNT =
     new Primitive("call-count", PACKAGE_SYS, true)
@@ -4511,176 +4075,6 @@
       }
     };
 
-  // ### read &optional input-stream eof-error-p eof-value recursive-p => object
-  private static final Primitive READ =
-    new Primitive(Symbol.READ,
-                  "&optional input-stream eof-error-p eof-value recursive-p")
-    {
-      public LispObject execute() throws ConditionThrowable
-      {
-        final LispThread thread = LispThread.currentThread();
-        final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(thread);
-        final Stream stream;
-        try
-          {
-            stream = (Stream) obj;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(obj, Symbol.STREAM);
-          }
-        return stream.read(true, NIL, false, thread);
-      }
-      public LispObject execute(LispObject arg) throws ConditionThrowable
-      {
-        final LispThread thread = LispThread.currentThread();
-        if (arg == T)
-          arg = Symbol.TERMINAL_IO.symbolValue(thread);
-        else if (arg == NIL)
-          arg = Symbol.STANDARD_INPUT.symbolValue(thread);
-        final Stream stream;
-        try
-          {
-            stream = (Stream) arg;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(arg, Symbol.STREAM);
-          }
-        return stream.read(true, NIL, false, thread);
-      }
-      public LispObject execute(LispObject first, LispObject second)
-        throws ConditionThrowable
-      {
-        final LispThread thread = LispThread.currentThread();
-        if (first == T)
-          first = Symbol.TERMINAL_IO.symbolValue(thread);
-        else if (first == NIL)
-          first = Symbol.STANDARD_INPUT.symbolValue(thread);
-        final Stream stream;
-        try
-          {
-            stream = (Stream) first;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.STREAM);
-          }
-        return stream.read(second != NIL, NIL, false, thread);
-      }
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third)
-        throws ConditionThrowable
-      {
-        final LispThread thread = LispThread.currentThread();
-        if (first == T)
-          first = Symbol.TERMINAL_IO.symbolValue(thread);
-        else if (first == NIL)
-          first = Symbol.STANDARD_INPUT.symbolValue(thread);
-        final Stream stream;
-        try
-          {
-            stream = (Stream) first;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.STREAM);
-          }
-        return stream.read(second != NIL, third, false, thread);
-      }
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third, LispObject fourth)
-        throws ConditionThrowable
-      {
-        final LispThread thread = LispThread.currentThread();
-        if (first == T)
-          first = Symbol.TERMINAL_IO.symbolValue(thread);
-        else if (first == NIL)
-          first = Symbol.STANDARD_INPUT.symbolValue(thread);
-        final Stream stream;
-        try
-          {
-            stream = (Stream) first;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(first, Symbol.STREAM);
-          }
-        return stream.read(second != NIL, third, fourth != NIL, thread);
-      }
-    };
-
-  // ### read-preserving-whitespace
-  // &optional input-stream eof-error-p eof-value recursive-p => object
-  private static final Primitive READ_PRESERVING_WHITESPACE =
-    new Primitive(Symbol.READ_PRESERVING_WHITESPACE,
-                  "&optional input-stream eof-error-p eof-value recursive-p")
-    {
-      public LispObject execute(LispObject[] args) throws ConditionThrowable
-      {
-        int length = args.length;
-        if (length > 4)
-          return error(new WrongNumberOfArgumentsException(this));
-        Stream stream =
-          length > 0 ? inSynonymOf(args[0]) : getStandardInput();
-        boolean eofError = length > 1 ? (args[1] != NIL) : true;
-        LispObject eofValue = length > 2 ? args[2] : NIL;
-        boolean recursive = length > 3 ? (args[3] != NIL) : false;
-        return stream.readPreservingWhitespace(eofError, eofValue,
-                                               recursive,
-                                               LispThread.currentThread());
-      }
-    };
-
-  // ### read-char &optional input-stream eof-error-p eof-value recursive-p
-  // => char
-  private static final Primitive READ_CHAR =
-    new Primitive(Symbol.READ_CHAR,
-                  "&optional input-stream eof-error-p eof-value recursive-p")
-    {
-      public LispObject execute() throws ConditionThrowable
-      {
-        return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar();
-      }
-      public LispObject execute(LispObject arg) throws ConditionThrowable
-      {
-        return inSynonymOf(arg).readChar();
-      }
-      public LispObject execute(LispObject first, LispObject second)
-        throws ConditionThrowable
-      {
-        return inSynonymOf(first).readChar(second != NIL, NIL);
-      }
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third)
-        throws ConditionThrowable
-      {
-        return inSynonymOf(first).readChar(second != NIL, third);
-      }
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third, LispObject fourth)
-        throws ConditionThrowable
-      {
-        return inSynonymOf(first).readChar(second != NIL, third);
-      }
-    };
-
-  // ### unread-char character &optional input-stream => nil
-  private static final Primitive UNREAD_CHAR =
-    new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream")
-    {
-      public LispObject execute(LispObject arg) throws ConditionThrowable
-      {
-        return getStandardInput().unreadChar(checkCharacter(arg));
-      }
-      public LispObject execute(LispObject first, LispObject second)
-        throws ConditionThrowable
-      {
-        Stream stream = inSynonymOf(second);
-        return stream.unreadChar(checkCharacter(first));
-      }
-    };
-
   // ### lambda-name
   private static final Primitive LAMBDA_NAME =
     new Primitive("lambda-name", PACKAGE_SYS, true)
@@ -6127,63 +5521,6 @@
       }
     };
 
-  // ### write-vector-unsigned-byte-8
-  private static final Primitive WRITE_VECTOR_UNSIGNED_BYTE_8 =
-    new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true,
-                  "vector stream start end")
-    {
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third, LispObject fourth)
-        throws ConditionThrowable
-      {
-        final AbstractVector v = checkVector(first);
-        final Stream stream;
-        try
-          {
-            stream = (Stream) second;
-          }
-        catch (ClassCastException e)
-          {
-            return type_error(second, Symbol.STREAM);
-          }
-        int start = Fixnum.getValue(third);
-        int end = Fixnum.getValue(fourth);
-        for (int i = start; i < end; i++)
-          stream._writeByte(v.aref(i));
-        return v;
-      }
-    };
-
-  // ### read-vector-unsigned-byte-8 vector stream start end => position
-  private static final Primitive READ_VECTOR_UNSIGNED_BYTE_8 =
-    new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true,
-                  "vector stream start end")
-    {
-      public LispObject execute(LispObject first, LispObject second,
-                                LispObject third, LispObject fourth)
-        throws ConditionThrowable
-      {
-        AbstractVector v = checkVector(first);
-        Stream stream = checkBinaryInputStream(second);
-        int start = Fixnum.getValue(third);
-        int end = Fixnum.getValue(fourth);
-        if (!v.getElementType().equal(UNSIGNED_BYTE_8))
-          return type_error(first, list2(Symbol.VECTOR,
-                                              UNSIGNED_BYTE_8));
-        for (int i = start; i < end; i++)
-          {
-            int n = stream._readByte();
-            if (n < 0)
-              {
-                // End of file.
-                return new Fixnum(i);
-              }
-            v.aset(i, n);
-          }
-        return fourth;
-      }
-    };
-
   // ### %documentation
   private static final Primitive _DOCUMENTATION =
     new Primitive("%documentation", PACKAGE_SYS, true,

Modified: trunk/j/src/org/armedbear/lisp/Stream.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Stream.java	(original)
+++ trunk/j/src/org/armedbear/lisp/Stream.java	Sun Nov  2 22:06:34 2008
@@ -1478,6 +1478,7 @@
     return _charReady() ? readChar(eofError, eofValue) : NIL;
   }
 
+
   // unread-char character &optional input-stream => nil
   public LispObject unreadChar(LispCharacter c) throws ConditionThrowable
   {
@@ -1937,6 +1938,706 @@
     return error(new StreamError(this, writeToString() + " is not a character output stream."));
   }
 
+  // ### %stream-write-char character output-stream => character
+  // OUTPUT-STREAM must be a real stream, not an output stream designator!
+  private static final Primitive _WRITE_CHAR =
+    new Primitive("%stream-write-char", PACKAGE_SYS, true,
+                  "character output-stream")
+    {
+      public LispObject execute(LispObject first, LispObject second)
+        throws ConditionThrowable
+      {
+        try
+          {
+            ((Stream)second)._writeChar(((LispCharacter)first).value);
+          }
+        catch (ClassCastException e)
+          {
+            if (second instanceof Stream)
+              return type_error(first, Symbol.CHARACTER);
+            else
+              return type_error(second, Symbol.STREAM);
+          }
+        return first;
+      }
+    };
+
+  // ### %write-char character output-stream => character
+  private static final Primitive _STREAM_WRITE_CHAR =
+    new Primitive("%write-char", PACKAGE_SYS, false,
+                  "character output-stream")
+    {
+      public LispObject execute(LispObject first, LispObject second)
+        throws ConditionThrowable
+      {
+        final char c;
+        try
+          {
+            c = ((LispCharacter)first).value;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.CHARACTER);
+          }
+        if (second == T)
+          second = Symbol.TERMINAL_IO.symbolValue();
+        else if (second == NIL)
+          second = Symbol.STANDARD_OUTPUT.symbolValue();
+        final Stream stream;
+        try
+          {
+            stream = (Stream) second;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(second, Symbol.STREAM);
+          }
+        stream._writeChar(c);
+        return first;
+      }
+    };
+
+  // ### %write-string string output-stream start end => string
+  private static final Primitive _WRITE_STRING =
+    new Primitive("%write-string", PACKAGE_SYS, false,
+                  "string output-stream start end")
+    {
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third, LispObject fourth)
+        throws ConditionThrowable
+      {
+        final AbstractString s;
+        try
+          {
+            s = (AbstractString) first;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.STRING);
+          }
+        char[] chars = s.chars();
+        final Stream out;
+        try
+          {
+            if (second == T)
+              out = (Stream) Symbol.TERMINAL_IO.symbolValue();
+            else if (second == NIL)
+              out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
+            else
+              out = (Stream) second;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(second, Symbol.STREAM);
+          }
+        final int start;
+        try
+          {
+            start = ((Fixnum)third).value;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(third, Symbol.FIXNUM);
+          }
+        final int end;
+        if (fourth == NIL)
+          end = chars.length;
+        else
+          {
+            try
+              {
+                end = ((Fixnum)fourth).value;
+              }
+            catch (ClassCastException e)
+              {
+                return type_error(fourth, Symbol.FIXNUM);
+              }
+          }
+        checkBounds(start, end, chars.length);
+        out._writeChars(chars, start, end);
+        return first;
+      }
+    };
+
+  // ### %finish-output output-stream => nil
+  private static final Primitive _FINISH_OUTPUT =
+    new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream")
+    {
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+        return finishOutput(arg);
+      }
+    };
+
+  // ### %force-output output-stream => nil
+  private static final Primitive _FORCE_OUTPUT =
+    new Primitive("%force-output", PACKAGE_SYS, false, "output-stream")
+    {
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+        return finishOutput(arg);
+      }
+    };
+
+  private static final LispObject finishOutput(LispObject arg)
+    throws ConditionThrowable
+  {
+    final Stream out;
+    try
+      {
+        if (arg == T)
+          out = (Stream) Symbol.TERMINAL_IO.symbolValue();
+        else if (arg == NIL)
+          out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
+        else
+          out = (Stream) arg;
+      }
+    catch (ClassCastException e)
+      {
+        return type_error(arg, Symbol.STREAM);
+      }
+    return out.finishOutput();
+  }
+
+  // ### clear-input &optional input-stream => nil
+  private static final Primitive CLEAR_INPUT =
+    new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream")
+    {
+      public LispObject execute(LispObject[] args) throws ConditionThrowable
+      {
+        if (args.length > 1)
+          return error(new WrongNumberOfArgumentsException(this));
+        final Stream in;
+        if (args.length == 0)
+          in = checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue());
+        else
+          in = inSynonymOf(args[0]);
+        in.clearInput();
+        return NIL;
+      }
+    };
+
+  // ### %clear-output output-stream => nil
+  // "If any of these operations does not make sense for output-stream, then
+  // it does nothing."
+  private static final Primitive _CLEAR_OUTPUT =
+    new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream")
+    {
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+        if (arg == T) // *TERMINAL-IO*
+          return NIL;
+        if (arg == NIL) // *STANDARD-OUTPUT*
+          return NIL;
+        if (arg instanceof Stream)
+          return NIL;
+        return type_error(arg, Symbol.STREAM);
+      }
+    };
+
+  // ### close stream &key abort => result
+  private static final Primitive CLOSE =
+    new Primitive(Symbol.CLOSE, "stream &key abort")
+    {
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+        try
+          {
+            return ((Stream)arg).close(NIL);
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(arg, Symbol.STREAM);
+          }
+      }
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third)
+        throws ConditionThrowable
+      {
+        final Stream stream;
+        try
+          {
+            stream = (Stream) first;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.STREAM);
+          }
+        if (second == Keyword.ABORT)
+          return stream.close(third);
+        return error(new ProgramError("Unrecognized keyword argument " +
+                                       second.writeToString() + "."));
+      }
+    };
+
+  // ### out-synonym-of stream-designator => stream
+  private static final Primitive OUT_SYNONYM_OF =
+    new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator")
+    {
+      public LispObject execute (LispObject arg) throws ConditionThrowable
+      {
+        if (arg instanceof Stream)
+          return arg;
+        if (arg == T)
+          return Symbol.TERMINAL_IO.symbolValue();
+        if (arg == NIL)
+          return Symbol.STANDARD_OUTPUT.symbolValue();
+        return arg;
+      }
+    };
+
+  // ### write-8-bits
+  // write-8-bits byte stream => nil
+  private static final Primitive WRITE_8_BITS =
+    new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream")
+    {
+      public LispObject execute (LispObject first, LispObject second)
+        throws ConditionThrowable
+      {
+        int n;
+        try
+          {
+            n = ((Fixnum)first).value;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.FIXNUM);
+          }
+        if (n < 0 || n > 255)
+          return type_error(first, UNSIGNED_BYTE_8);
+        try
+          {
+            ((Stream)second)._writeByte(n);
+            return NIL;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(second, Symbol.STREAM);
+          }
+      }
+    };
+
+  // ### read-8-bits
+  // read-8-bits stream &optional eof-error-p eof-value => byte
+  private static final Primitive READ_8_BITS =
+    new Primitive("read-8-bits", PACKAGE_SYS, true,
+                  "stream &optional eof-error-p eof-value")
+    {
+      public LispObject execute (LispObject first, LispObject second,
+                                 LispObject third)
+        throws ConditionThrowable
+      {
+        return checkBinaryInputStream(first).readByte((second != NIL),
+                                                      third);
+      }
+      public LispObject execute (LispObject[] args) throws ConditionThrowable
+      {
+        int length = args.length;
+        if (length < 1 || length > 3)
+          return error(new WrongNumberOfArgumentsException(this));
+        final Stream in = checkBinaryInputStream(args[0]);
+        boolean eofError = length > 1 ? (args[1] != NIL) : true;
+        LispObject eofValue = length > 2 ? args[2] : NIL;
+        return in.readByte(eofError, eofValue);
+      }
+    };
+
+  // ### read-line &optional input-stream eof-error-p eof-value recursive-p
+  // => line, missing-newline-p
+  private static final Primitive READ_LINE =
+    new Primitive(Symbol.READ_LINE,
+                  "&optional input-stream eof-error-p eof-value recursive-p")
+    {
+      public LispObject execute() throws ConditionThrowable
+      {
+        final LispObject obj = Symbol.STANDARD_INPUT.symbolValue();
+        final Stream stream;
+        try
+          {
+            stream = (Stream) obj;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(obj, Symbol.STREAM);
+          }
+        return stream.readLine(true, NIL);
+      }
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+        if (arg == T)
+          arg = Symbol.TERMINAL_IO.symbolValue();
+        else if (arg == NIL)
+          arg = Symbol.STANDARD_INPUT.symbolValue();
+        final Stream stream;
+        try
+          {
+            stream = (Stream) arg;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(arg, Symbol.STREAM);
+          }
+        return stream.readLine(true, NIL);
+      }
+      public LispObject execute(LispObject first, LispObject second)
+        throws ConditionThrowable
+      {
+        if (first == T)
+          first = Symbol.TERMINAL_IO.symbolValue();
+        else if (first == NIL)
+          first = Symbol.STANDARD_INPUT.symbolValue();
+        final Stream stream;
+        try
+          {
+            stream = (Stream) first;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.STREAM);
+          }
+        return stream.readLine(second != NIL, NIL);
+      }
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third)
+        throws ConditionThrowable
+      {
+        if (first == T)
+          first = Symbol.TERMINAL_IO.symbolValue();
+        else if (first == NIL)
+          first = Symbol.STANDARD_INPUT.symbolValue();
+        final Stream stream;
+        try
+          {
+            stream = (Stream) first;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.STREAM);
+          }
+        return stream.readLine(second != NIL, third);
+      }
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third, LispObject fourth)
+        throws ConditionThrowable
+      {
+        // recursive-p is ignored
+        if (first == T)
+          first = Symbol.TERMINAL_IO.symbolValue();
+        else if (first == NIL)
+          first = Symbol.STANDARD_INPUT.symbolValue();
+        final Stream stream;
+        try
+          {
+            stream = (Stream) first;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.STREAM);
+          }
+        return stream.readLine(second != NIL, third);
+      }
+    };
+
+  // ### %read-from-string string eof-error-p eof-value start end preserve-whitespace
+  // => object, position
+  private static final Primitive _READ_FROM_STRING =
+    new Primitive("%read-from-string", PACKAGE_SYS, false)
+    {
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third, LispObject fourth,
+                                LispObject fifth, LispObject sixth)
+        throws ConditionThrowable
+      {
+        String s = first.getStringValue();
+        boolean eofError = (second != NIL);
+        boolean preserveWhitespace = (sixth != NIL);
+        final int startIndex;
+        if (fourth != NIL)
+          startIndex = Fixnum.getValue(fourth);
+        else
+          startIndex = 0;
+        final int endIndex;
+        if (fifth != NIL)
+          endIndex = Fixnum.getValue(fifth);
+        else
+          endIndex = s.length();
+        StringInputStream in =
+          new StringInputStream(s, startIndex, endIndex);
+        final LispThread thread = LispThread.currentThread();
+        LispObject result;
+        if (preserveWhitespace)
+          result = in.readPreservingWhitespace(eofError, third, false,
+                                               thread);
+        else
+          result = in.read(eofError, third, false, thread);
+        return thread.setValues(result, new Fixnum(in.getOffset()));
+      }
+    };
+
+  // ### read &optional input-stream eof-error-p eof-value recursive-p => object
+  private static final Primitive READ =
+    new Primitive(Symbol.READ,
+                  "&optional input-stream eof-error-p eof-value recursive-p")
+    {
+      public LispObject execute() throws ConditionThrowable
+      {
+        final LispThread thread = LispThread.currentThread();
+        final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(thread);
+        final Stream stream;
+        try
+          {
+            stream = (Stream) obj;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(obj, Symbol.STREAM);
+          }
+        return stream.read(true, NIL, false, thread);
+      }
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+        final LispThread thread = LispThread.currentThread();
+        if (arg == T)
+          arg = Symbol.TERMINAL_IO.symbolValue(thread);
+        else if (arg == NIL)
+          arg = Symbol.STANDARD_INPUT.symbolValue(thread);
+        final Stream stream;
+        try
+          {
+            stream = (Stream) arg;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(arg, Symbol.STREAM);
+          }
+        return stream.read(true, NIL, false, thread);
+      }
+      public LispObject execute(LispObject first, LispObject second)
+        throws ConditionThrowable
+      {
+        final LispThread thread = LispThread.currentThread();
+        if (first == T)
+          first = Symbol.TERMINAL_IO.symbolValue(thread);
+        else if (first == NIL)
+          first = Symbol.STANDARD_INPUT.symbolValue(thread);
+        final Stream stream;
+        try
+          {
+            stream = (Stream) first;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.STREAM);
+          }
+        return stream.read(second != NIL, NIL, false, thread);
+      }
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third)
+        throws ConditionThrowable
+      {
+        final LispThread thread = LispThread.currentThread();
+        if (first == T)
+          first = Symbol.TERMINAL_IO.symbolValue(thread);
+        else if (first == NIL)
+          first = Symbol.STANDARD_INPUT.symbolValue(thread);
+        final Stream stream;
+        try
+          {
+            stream = (Stream) first;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.STREAM);
+          }
+        return stream.read(second != NIL, third, false, thread);
+      }
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third, LispObject fourth)
+        throws ConditionThrowable
+      {
+        final LispThread thread = LispThread.currentThread();
+        if (first == T)
+          first = Symbol.TERMINAL_IO.symbolValue(thread);
+        else if (first == NIL)
+          first = Symbol.STANDARD_INPUT.symbolValue(thread);
+        final Stream stream;
+        try
+          {
+            stream = (Stream) first;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(first, Symbol.STREAM);
+          }
+        return stream.read(second != NIL, third, fourth != NIL, thread);
+      }
+    };
+
+  // ### read-preserving-whitespace
+  // &optional input-stream eof-error-p eof-value recursive-p => object
+  private static final Primitive READ_PRESERVING_WHITESPACE =
+    new Primitive(Symbol.READ_PRESERVING_WHITESPACE,
+                  "&optional input-stream eof-error-p eof-value recursive-p")
+    {
+      public LispObject execute(LispObject[] args) throws ConditionThrowable
+      {
+        int length = args.length;
+        if (length > 4)
+          return error(new WrongNumberOfArgumentsException(this));
+        Stream stream =
+          length > 0 ? inSynonymOf(args[0]) : getStandardInput();
+        boolean eofError = length > 1 ? (args[1] != NIL) : true;
+        LispObject eofValue = length > 2 ? args[2] : NIL;
+        boolean recursive = length > 3 ? (args[3] != NIL) : false;
+        return stream.readPreservingWhitespace(eofError, eofValue,
+                                               recursive,
+                                               LispThread.currentThread());
+      }
+    };
+
+  // ### read-char &optional input-stream eof-error-p eof-value recursive-p
+  // => char
+  private static final Primitive READ_CHAR =
+    new Primitive(Symbol.READ_CHAR,
+                  "&optional input-stream eof-error-p eof-value recursive-p")
+    {
+      public LispObject execute() throws ConditionThrowable
+      {
+        return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar();
+      }
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+        return inSynonymOf(arg).readChar();
+      }
+      public LispObject execute(LispObject first, LispObject second)
+        throws ConditionThrowable
+      {
+        return inSynonymOf(first).readChar(second != NIL, NIL);
+      }
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third)
+        throws ConditionThrowable
+      {
+        return inSynonymOf(first).readChar(second != NIL, third);
+      }
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third, LispObject fourth)
+        throws ConditionThrowable
+      {
+        return inSynonymOf(first).readChar(second != NIL, third);
+      }
+    };
+
+  // ### read-char-no-hang &optional input-stream eof-error-p eof-value
+  // recursive-p => char
+  private static final Primitive READ_CHAR_NO_HANG =
+    new Primitive("read-char-no-hang", "&optional input-stream eof-error-p eof-value recursive-p") {
+
+      public LispObject execute(LispObject[] args) throws ConditionThrowable
+      {
+        int length = args.length;
+        if (length > 4)
+            error(new WrongNumberOfArgumentsException(this));
+        Stream stream =
+            length > 0 ? inSynonymOf(args[0]) : getStandardInput();
+        boolean eofError = length > 1 ? (args[1] != NIL) : true;
+        LispObject eofValue = length > 2 ? args[2] : NIL;
+        // recursive-p is ignored
+        // boolean recursive = length > 3 ? (args[3] != NIL) : false;
+        return stream.readCharNoHang(eofError, eofValue);
+      }
+  };
+
+  // ### read-delimited-list char &optional input-stream recursive-p => list
+  private static final Primitive READ_DELIMITED_LIST =
+    new Primitive("read-delimited-list", "char &optional input-stream recursive-p") {
+
+      public LispObject execute(LispObject[] args) throws ConditionThrowable
+      {
+        int length = args.length;
+        if (length < 1 || length > 3)
+            error(new WrongNumberOfArgumentsException(this));
+        char c = LispCharacter.getValue(args[0]);
+        Stream stream =
+            length > 1 ? inSynonymOf(args[1]) : getStandardInput();
+        return stream.readDelimitedList(c);
+      }
+  };
+
+
+  // ### unread-char character &optional input-stream => nil
+  private static final Primitive UNREAD_CHAR =
+    new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream")
+    {
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+        return getStandardInput().unreadChar(checkCharacter(arg));
+      }
+      public LispObject execute(LispObject first, LispObject second)
+        throws ConditionThrowable
+      {
+        Stream stream = inSynonymOf(second);
+        return stream.unreadChar(checkCharacter(first));
+      }
+    };
+
+  // ### write-vector-unsigned-byte-8
+  private static final Primitive WRITE_VECTOR_UNSIGNED_BYTE_8 =
+    new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true,
+                  "vector stream start end")
+    {
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third, LispObject fourth)
+        throws ConditionThrowable
+      {
+        final AbstractVector v = checkVector(first);
+        final Stream stream;
+        try
+          {
+            stream = (Stream) second;
+          }
+        catch (ClassCastException e)
+          {
+            return type_error(second, Symbol.STREAM);
+          }
+        int start = Fixnum.getValue(third);
+        int end = Fixnum.getValue(fourth);
+        for (int i = start; i < end; i++)
+          stream._writeByte(v.aref(i));
+        return v;
+      }
+    };
+
+  // ### read-vector-unsigned-byte-8 vector stream start end => position
+  private static final Primitive READ_VECTOR_UNSIGNED_BYTE_8 =
+    new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true,
+                  "vector stream start end")
+    {
+      public LispObject execute(LispObject first, LispObject second,
+                                LispObject third, LispObject fourth)
+        throws ConditionThrowable
+      {
+        AbstractVector v = checkVector(first);
+        Stream stream = checkBinaryInputStream(second);
+        int start = Fixnum.getValue(third);
+        int end = Fixnum.getValue(fourth);
+        if (!v.getElementType().equal(UNSIGNED_BYTE_8))
+          return type_error(first, list2(Symbol.VECTOR,
+                                              UNSIGNED_BYTE_8));
+        for (int i = start; i < end; i++)
+          {
+            int n = stream._readByte();
+            if (n < 0)
+              {
+                // End of file.
+                return new Fixnum(i);
+              }
+            v.aset(i, n);
+          }
+        return fourth;
+      }
+    };
+
   // ### file-position
   private static final Primitive FILE_POSITION =
     new Primitive("file-position", "stream &optional position-spec")