October 2009 - armedbear-devel - mailman3.common-lisp.net

[armedbear-devel] Serious bug involving UWP
by Tobias C. Rittweiler 18 Oct '09

18 Oct '09

Steps to reproduce: * ABCL from svn, updated a few minutes ago. * Slime from CVS. * M-x slime-scratch * Put (defun test (x) ,bar) in the buffer * Press C-c C-c You'll see "Evaluation aborted." in the minibuffer even though the debugger should have popped up complaining about comma not being inside backquote. C-c C-c is SWANK-COMPILE-STRING in swank-abcl.lisp. If you follow the control flow, you'll see that in SLDB-LOOP (we come here through *DEBUGGER-HOOK*) in swank.lisp, __the UNWINDED-PROTECT's protected form is *never* executed and it goes straight to the cleanup forms.__ -T.

4 13

[armedbear-devel] ABCL 0.16.1 released
by Erik Huelsmann 18 Oct '09

18 Oct '09

On behalf of the ABCL development team, I would like to announce the new ABCL release: 0.16.1 This release is a maintenance release on the 0.16 version line. In total four issues have been fixed: - In case of unsuccessful completion of a COMPILE call, ABCL would leak (= not correctly clean up behind itself) temporary files - In some cases, an exception thrown by a GO or RETURN-FROM form would not be correctly caught, causing the thread in which it occurs to terminate - Honor appearance of *&allow-other-keys* in CLOS MAKE-INSTANCE argument checking - More careful checking of 'null' arguments when processing stack frames Should you have any comments, remarks or bugs to be found in this release, please contact the developers through the mailing list mentioned on the ABCL project home page <http://common-lisp.net/project/armedbear/>.

1 0

[armedbear-devel] How to build the abcl.jar file within Eclipse
by dusan lukic 16 Oct '09

16 Oct '09

Hi all, I've downloaded ABCL from http://common-lisp.net/project/armedbear/ site, and, on it's building & running page, I've read that I can build abcl.jar file within Eclipse. I already have Eclipse installed on my computer, so can anyone, please, tell me how to do it. I do not have much experience with Eclipse, so a step-by-step procedure is preferred. Thanks, in advance.

2 1

Re: [armedbear-devel] [armedbear-cvs] r12180 - trunk/abcl/src/org/armedbear/lisp
by Erik Huelsmann 15 Oct '09

15 Oct '09

John, The commit below removes temporary file use from the COMPILE function. This is the minimal requirement to get running on GAE. So, I hope that you'll be using ABCL as of this version in your testing. I'm eager to learn about your progress. If you run into issues, please don't hesitate, we definitely want to fix them. If at all possible I'm for doing that ASAP. Bye, Erik. On Wed, Oct 7, 2009 at 11:51 PM, Alessio Stalla <astalla(a)common-lisp.net> wrote: > Author: astalla > Date: Wed Oct 7 17:51:00 2009 > New Revision: 12180 > > Log: > Ticket #56: eliminated use of temporary files for COMPILE > > > Modified: > trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java > trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java > trunk/abcl/src/org/armedbear/lisp/Lisp.java > trunk/abcl/src/org/armedbear/lisp/Stream.java > trunk/abcl/src/org/armedbear/lisp/compile-file.lisp > trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp > > Modified: trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java > ============================================================================== > --- trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java (original) > +++ trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java Wed Oct 7 17:51:00 2009 > @@ -207,7 +207,7 @@ > > // ### load-compiled-function > private static final Primitive LOAD_COMPILED_FUNCTION = > - new Primitive("load-compiled-function", PACKAGE_SYS, true, "pathname") > + new Primitive("load-compiled-function", PACKAGE_SYS, true, "source") > { > @Override > public LispObject execute(LispObject arg) throws ConditionThrowable > @@ -219,6 +219,14 @@ > namestring = arg.getStringValue(); > if (namestring != null) > return loadCompiledFunction(namestring); > + if(arg instanceof JavaObject) { > + try { > + return loadCompiledFunction((byte[]) arg.javaInstance(byte[].class)); > + } catch(Throwable t) { > + Debug.trace(t); > + return error(new LispError("Unable to load " + arg.writeToString())); > + } > + } > return error(new LispError("Unable to load " + arg.writeToString())); > } > }; > > Modified: trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java > ============================================================================== > --- trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java (original) > +++ trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java Wed Oct 7 17:51:00 2009 > @@ -37,17 +37,7 @@ > import java.util.HashSet; > import java.util.Set; > > -public class JavaClassLoader extends ClassLoader > -{ > - private static final boolean isSableVM; > - > - static { > - String vm = System.getProperty("java.vm.name"); > - if (vm != null && vm.equals("SableVM")) > - isSableVM = true; > - else > - isSableVM = false; > - } > +public class JavaClassLoader extends ClassLoader { > > private static JavaClassLoader persistentInstance; > > @@ -79,6 +69,10 @@ > } > } > > + public Class<?> loadClassFromByteArray(byte[] classbytes) { > + return loadClassFromByteArray(null, classbytes); > + } > + > public Class<?> loadClassFromByteArray(String className, > byte[] classbytes) > { > > Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java > ============================================================================== > --- trunk/abcl/src/org/armedbear/lisp/Lisp.java (original) > +++ trunk/abcl/src/org/armedbear/lisp/Lisp.java Wed Oct 7 17:51:00 2009 > @@ -1376,6 +1376,16 @@ > new Pathname(namestring))); > } > > + public static final LispObject makeCompiledFunctionFromClass(Class<?> c) > + throws Exception { > + if (c != null) { > + LispObject obj = (LispObject)c.newInstance(); > + return obj; > + } else { > + return null; > + } > + } > + > private static final LispObject loadCompiledFunction(InputStream in, int size) > { > try > @@ -1405,21 +1415,19 @@ > } > > public static final LispObject loadCompiledFunction(byte[] bytes) throws Throwable { > - Class<?> c = (new JavaClassLoader()) > - .loadClassFromByteArray(null, bytes, 0, bytes.length); > - if (c != null) { > - Constructor constructor = c.getConstructor((Class[])null); > - LispObject obj = (LispObject)constructor > - .newInstance((Object[])null); > - if (obj instanceof Function) { > - ((Function)obj).setClassBytes(bytes); > - } > - return obj; > - } else { > - return null; > - } > + return loadCompiledFunction(bytes, new JavaClassLoader()); > } > > + public static final LispObject loadCompiledFunction(byte[] bytes, JavaClassLoader cl) throws Throwable { > + Class<?> c = cl.loadClassFromByteArray(null, bytes, 0, bytes.length); > + LispObject obj = makeCompiledFunctionFromClass(c); > + if (obj instanceof Function) { > + ((Function)obj).setClassBytes(bytes); > + } > + return obj; > + } > + > + > public static final LispObject makeCompiledClosure(LispObject template, > ClosureBinding[] context) > throws ConditionThrowable > > Modified: trunk/abcl/src/org/armedbear/lisp/Stream.java > ============================================================================== > --- trunk/abcl/src/org/armedbear/lisp/Stream.java (original) > +++ trunk/abcl/src/org/armedbear/lisp/Stream.java Wed Oct 7 17:51:00 2009 > @@ -119,6 +119,14 @@ > { > } > > + public Stream(Reader r) { > + initAsCharacterInputStream(r); > + } > + > + public Stream(Writer w) { > + initAsCharacterOutputStream(w); > + } > + > public Stream(InputStream inputStream, LispObject elementType) > { > this(inputStream, elementType, keywordDefault); > > Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp > ============================================================================== > --- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp (original) > +++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp Wed Oct 7 17:51:00 2009 > @@ -146,11 +146,17 @@ > (parse-body body) > (let* ((expr `(lambda ,lambda-list > ,@decls (block ,block-name ,@body))) > - (classfile-name (next-classfile-name)) > - (classfile (report-error > - (jvm:compile-defun name expr nil > - classfile-name))) > + (classfile (next-classfile-name)) > + (result (with-open-file > + (f classfile > + :direction :output > + :element-type '(unsigned-byte 8) > + :if-exists :supersede) > + (report-error > + (jvm:compile-defun name expr nil > + classfile f)))) > (compiled-function (verify-load classfile))) > + (declare (ignore result)) > (cond > (compiled-function > (setf form > @@ -205,10 +211,14 @@ > (let ((name (second form))) > (eval form) > (let* ((expr (function-lambda-expression (macro-function name))) > - (classfile-name (next-classfile-name)) > - (classfile > - (ignore-errors > - (jvm:compile-defun nil expr nil classfile-name)))) > + (classfile (next-classfile-name))) > + (with-open-file > + (f classfile > + :direction :output > + :element-type '(unsigned-byte 8) > + :if-exists :supersede) > + (ignore-errors > + (jvm:compile-defun nil expr nil classfile f))) > (if (null (verify-load classfile)) > ;; FIXME error or warning > (format *error-output* "; Unable to compile macro ~A~%" name) > @@ -342,10 +352,17 @@ > (eq (%car function-form) 'FUNCTION)) > (let ((lambda-expression (cadr function-form))) > (jvm::with-saved-compiler-policy > - (let* ((classfile-name (next-classfile-name)) > - (classfile (report-error > - (jvm:compile-defun nil lambda-expression nil classfile-name))) > + (let* ((classfile (next-classfile-name)) > + (result > + (with-open-file > + (f classfile > + :direction :output > + :element-type '(unsigned-byte 8) > + :if-exists :supersede) > + (report-error > + (jvm:compile-defun nil lambda-expression nil classfile f)))) > (compiled-function (verify-load classfile))) > + (declare (ignore result)) > (cond (compiled-function > (setf (getf tail key) > `(load-compiled-function ,(file-namestring classfile)))) > @@ -356,9 +373,16 @@ > (declaim (ftype (function (t) t) convert-toplevel-form)) > (defun convert-toplevel-form (form) > (let* ((expr `(lambda () ,form)) > - (classfile-name (next-classfile-name)) > - (classfile (report-error (jvm:compile-defun nil expr nil classfile-name))) > + (classfile (next-classfile-name)) > + (result > + (with-open-file > + (f classfile > + :direction :output > + :element-type '(unsigned-byte 8) > + :if-exists :supersede) > + (report-error (jvm:compile-defun nil expr nil classfile f)))) > (compiled-function (verify-load classfile))) > + (declare (ignore result)) > (setf form > (if compiled-function > `(funcall (load-compiled-function ,(file-namestring classfile))) > > Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp > ============================================================================== > --- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original) > +++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Wed Oct 7 17:51:00 2009 > @@ -4921,16 +4921,16 @@ > (emit-push-nil) > (emit-move-from-stack target))) > > -(defun compile-and-write-to-file (class-file compiland) > +(defun compile-and-write-to-stream (class-file compiland stream) > (with-class-file class-file > (let ((*current-compiland* compiland)) > (with-saved-compiler-policy > (p2-compiland compiland) > - (write-class-file (compiland-class-file compiland)))))) > + (write-class-file (compiland-class-file compiland) stream))))) > > -(defun set-compiland-and-write-class-file (class-file compiland) > +(defun set-compiland-and-write-class (class-file compiland stream) > (setf (compiland-class-file compiland) class-file) > - (compile-and-write-to-file class-file compiland)) > + (compile-and-write-to-stream class-file compiland stream)) > > > (defmacro with-temp-class-file (pathname class-file lambda-list &body body) > @@ -4949,15 +4949,18 @@ > (let* ((pathname (funcall *pathnames-generator*)) > (class-file (make-class-file :pathname pathname > :lambda-list lambda-list))) > - (set-compiland-and-write-class-file class-file compiland) > + (with-open-class-file (f class-file) > + (set-compiland-and-write-class class-file compiland f)) > (setf (local-function-class-file local-function) class-file))) > (t > - (with-temp-class-file > - pathname class-file lambda-list > - (set-compiland-and-write-class-file class-file compiland) > + (let ((class-file (make-class-file > + :pathname (funcall *pathnames-generator*) > + :lambda-list lambda-list))) > + (with-open-stream (stream (sys::%make-byte-array-output-stream)) > + (set-compiland-and-write-class class-file compiland stream) > (setf (local-function-class-file local-function) class-file) > (setf (local-function-function local-function) > - (load-compiled-function pathname))))))) > + (load-compiled-function (sys::%get-output-stream-bytes stream))))))))) > > (defun emit-make-compiled-closure-for-labels > (local-function compiland declaration) > @@ -4981,19 +4984,24 @@ > (let* ((pathname (funcall *pathnames-generator*)) > (class-file (make-class-file :pathname pathname > :lambda-list lambda-list))) > - (set-compiland-and-write-class-file class-file compiland) > + (with-open-class-file (f class-file) > + (set-compiland-and-write-class class-file compiland f)) > (setf (local-function-class-file local-function) class-file) > (let ((g (declare-local-function local-function))) > (emit-make-compiled-closure-for-labels > local-function compiland g)))) > (t > - (with-temp-class-file > - pathname class-file lambda-list > - (set-compiland-and-write-class-file class-file compiland) > + (let ((class-file (make-class-file > + :pathname (funcall *pathnames-generator*) > + :lambda-list lambda-list))) > + (with-open-stream (stream (sys::%make-byte-array-output-stream)) > + (set-compiland-and-write-class class-file compiland stream) > (setf (local-function-class-file local-function) class-file) > - (let ((g (declare-object (load-compiled-function pathname)))) > + (let ((g (declare-object > + (load-compiled-function > + (sys::%get-output-stream-bytes stream))))) > (emit-make-compiled-closure-for-labels > - local-function compiland g))))))) > + local-function compiland g)))))))) > > (defknown p2-flet-node (t t t) t) > (defun p2-flet-node (block target representation) > @@ -5041,7 +5049,8 @@ > (make-class-file :pathname (funcall *pathnames-generator*) > :lambda-list lambda-list)) > (let ((class-file (compiland-class-file compiland))) > - (compile-and-write-to-file class-file compiland) > + (with-open-class-file (f class-file) > + (compile-and-write-to-stream class-file compiland f)) > (emit 'getstatic *this-class* > (declare-local-function (make-local-function :class-file > class-file)) > @@ -5051,14 +5060,13 @@ > (setf (compiland-class-file compiland) > (make-class-file :pathname pathname > :lambda-list lambda-list)) > - (unwind-protect > - (progn > - (compile-and-write-to-file (compiland-class-file compiland) > - compiland) > - (emit 'getstatic *this-class* > - (declare-object (load-compiled-function pathname)) > - +lisp-object+)) > - (delete-file pathname))))) > + (with-open-stream (stream (sys::%make-byte-array-output-stream)) > + (compile-and-write-to-stream (compiland-class-file compiland) > + compiland stream) > + (emit 'getstatic *this-class* > + (declare-object (load-compiled-function > + (sys::%get-output-stream-bytes stream))) > + +lisp-object+))))) > (cond ((null *closure-variables*)) ; Nothing to do. > ((compiland-closure-register *current-compiland*) > (duplicate-closure-array *current-compiland*) > @@ -8030,7 +8038,14 @@ > (setf (compiland-arity compiland) arg-count) > (get-descriptor (list +lisp-object-array+) +lisp-object+))))) > > -(defun write-class-file (class-file) > +(defmacro with-open-class-file ((var class-file) &body body) > + `(with-open-file (,var (class-file-pathname ,class-file) > + :direction :output > + :element-type '(unsigned-byte 8) > + :if-exists :supersede) > + ,@body)) > + > +(defun write-class-file (class-file stream) > (let* ((super (class-file-superclass class-file)) > (this-index (pool-class (class-file-class class-file))) > (super-index (pool-class super)) > @@ -8045,43 +8060,39 @@ > (when (and (boundp '*source-line-number*) > (fixnump *source-line-number*)) > (pool-name "LineNumberTable")) ; Must be in pool! > - > - ;; Write out the class file. > - (with-open-file (stream (class-file-pathname class-file) > - :direction :output > - :element-type '(unsigned-byte 8) > - :if-exists :supersede) > - (write-u4 #xCAFEBABE stream) > - (write-u2 3 stream) > - (write-u2 45 stream) > - (write-constant-pool stream) > - ;; access flags > - (write-u2 #x21 stream) > - (write-u2 this-index stream) > - (write-u2 super-index stream) > - ;; interfaces count > - (write-u2 0 stream) > - ;; fields count > - (write-u2 (length *fields*) stream) > - ;; fields > - (dolist (field *fields*) > - (write-field field stream)) > - ;; methods count > - (write-u2 (1+ (length (class-file-methods class-file))) stream) > - ;; methods > - (dolist (method (class-file-methods class-file)) > - (write-method method stream)) > - (write-method constructor stream) > - ;; attributes count > - (cond (*file-compilation* > - ;; attributes count > - (write-u2 1 stream) > - ;; attributes table > - (write-source-file-attr (file-namestring *compile-file-truename*) > - stream)) > - (t > - ;; attributes count > - (write-u2 0 stream)))))) > + > + (write-u4 #xCAFEBABE stream) > + (write-u2 3 stream) > + (write-u2 45 stream) > + (write-constant-pool stream) > + ;; access flags > + (write-u2 #x21 stream) > + (write-u2 this-index stream) > + (write-u2 super-index stream) > + ;; interfaces count > + (write-u2 0 stream) > + ;; fields count > + (write-u2 (length *fields*) stream) > + ;; fields > + (dolist (field *fields*) > + (write-field field stream)) > + ;; methods count > + (write-u2 (1+ (length (class-file-methods class-file))) stream) > + ;; methods > + (dolist (method (class-file-methods class-file)) > + (write-method method stream)) > + (write-method constructor stream) > + ;; attributes count > + (cond (*file-compilation* > + ;; attributes count > + (write-u2 1 stream) > + ;; attributes table > + (write-source-file-attr (file-namestring *compile-file-truename*) > + stream)) > + (t > + ;; attributes count > + (write-u2 0 stream))) > + stream)) > > (defknown p2-compiland-process-type-declarations (list) t) > (defun p2-compiland-process-type-declarations (body) > @@ -8359,7 +8370,7 @@ > (push execute-method (class-file-methods class-file))) > t) > > -(defun compile-1 (compiland) > +(defun compile-1 (compiland stream) > (let ((*all-variables* nil) > (*closure-variables* nil) > (*undefined-variables* nil) > @@ -8393,8 +8404,7 @@ > ;; Pass 2. > (with-class-file (compiland-class-file compiland) > (p2-compiland compiland) > - (write-class-file (compiland-class-file compiland))) > - (class-file-pathname (compiland-class-file compiland))))) > + (write-class-file (compiland-class-file compiland) stream))))) > > (defvar *compiler-error-bailout*) > > @@ -8402,7 +8412,7 @@ > `(lambda ,(cadr form) > (error 'program-error :format-control "Execution of a form compiled with errors."))) > > -(defun compile-defun (name form environment filespec) > +(defun compile-defun (name form environment filespec stream) > (aver (eq (car form) 'LAMBDA)) > (catch 'compile-defun-abort > (let* ((class-file (make-class-file :pathname filespec > @@ -8415,13 +8425,15 @@ > :class-file > (make-class-file :pathname ,filespec > :lambda-name ',name > - :lambda-list (cadr ',form)))))) > + :lambda-list (cadr ',form))) > + ,stream))) > (*compile-file-environment* environment)) > (compile-1 (make-compiland :name name > :lambda-expression > (precompiler:precompile-form form t > environment) > - :class-file class-file))))) > + :class-file class-file) > + stream)))) > > (defvar *catch-errors* t) > > @@ -8517,11 +8529,22 @@ > (tempfile (make-temp-file))) > (with-compilation-unit () > (with-saved-compiler-policy > - (unwind-protect > - (setf compiled-function > - (load-compiled-function > - (compile-defun name expr env tempfile)))) > - (delete-file tempfile))) > + (setf compiled-function > + (load-compiled-function > + (if *file-compilation* > + (unwind-protect > + (progn > + (with-open-file (f tempfile > + :direction :output > + :element-type '(unsigned-byte 8) > + :if-exists :supersede) > + (compile-defun name expr env tempfile f)) > + tempfile) > + (delete-file tempfile)) > + (with-open-stream (s (sys::%make-byte-array-output-stream)) > + (compile-defun name expr env tempfile s) > + (finish-output s) > + (sys::%get-output-stream-bytes s))))))) > (when (and name (functionp compiled-function)) > (sys::set-function-definition name compiled-function definition)) > (or name compiled-function))) > > _______________________________________________ > armedbear-cvs mailing list > armedbear-cvs(a)common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/armedbear-cvs >

3 3

Re: [armedbear-devel] [j-devel] regression
by Erik Huelsmann 15 Oct '09

15 Oct '09

On Thu, Oct 15, 2009 at 2:21 PM, Alan Ruttenberg <alanruttenberg(a)gmail.com> wrote: > On Thu, Oct 15, 2009 at 5:50 AM, Erik Huelsmann <ehuels(a)gmail.com> wrote: >> Hi Alan, >> >> On Thu, Oct 15, 2009 at 5:53 AM, Alan Ruttenberg >> <alanruttenberg(a)gmail.com> wrote: >>> I'm sorry about this bug report. Basically, a system I've been working >>> with for a long time has ceased to function in odd ways. I suspect it >>> has to do with exception handling changes recently introduced because >>> the symptom seems to be that a java function that I call that has a >>> timeout function continues to run even after the timeout is supposed >>> to have happened. >> >> Are you talking about ABCL? Or about something else? Which version of >> ABCL? Trunk? 0.16? > > Both it appears. The java code being called is from the pellet > reasoner, which has timers which it checks while it does it's work, > and when they are exceeded it throws the exception. Ok. The most helpful would be a version number (or repository revision number) which starts failing. >> Could you provide a bit more information on what the code is doing? One of the things I mean to ask here: are you calling the lisp code from the EVAL function? Or straight SYMBOL.execute() calls? >>> Unfortunately working on isolating the bug isn't something I have time >>> for so I've had to revert back to an earlier version. >>> >>> Wish I could say more at this point, but perhaps just notice that this >>> is happening might ring a bell for someone. >> >> If you're not talking about J, but specifically about ABCL, then, no, >> no bell yet. However, I'd like to look into it, ofcourse. > > abcl. I'll try to narrow it when I have some time. Thanks! Bye, Erik.

1 0

[armedbear-devel] CLOS optimizations
by Erik Huelsmann 15 Oct '09

15 Oct '09

This weekend, I committed an optimization which shows 4 - 12% performance gain on the CL-BENCH common lisp benchmarking toolset tests for CLOS. However, the test collects performance results from a high number of invocations. Low numbers of invocations should show even better improvements. Profiling one of the performance tests for CL-BENCH which shows huge difference with CLISP, it turned out that our CHECK-INITARGS function in the MOP package is taking 40% of the object instantiation time consumed by MAKE-INSTANCE. After the first invocation, it's possible to replace this function by a lookup in a cache. The same applies to args checking for some of the other functions defined to object instantiation and class modification. However, the time required to build this into our CLOS in a structured manner, exceeds "just" a few evenings, meaning that I probably will be delaying this task until I have a more time to undertake this effort. Ofcourse, I remain on the look out for possibilities to increase the performance of our clos implementation. An important input are the issues you experience with our performance, especially if you have example code to demonstrate it. Bye, Erik.

3 4

[armedbear-devel] Implementing non local exits in a runtime with structured exception handling
by Matthew D. Swank 15 Oct '09

15 Oct '09

I am playing with a lisp dialect (at least in my head) that I am thinking about implementing on the CLR. Like Java the CLR requires jumps across method call boundaries to be done using the exception handling mechanism. If I have code like the following in abcl: (block foo (flet ((callback () (return-from foo t))) (something-that-calls-into-java #'callback) ... stuff that won't happen if the callback is invoked)) And the plain old Java I'm calling into is pathological and catches the exception raised by calling the callback without re-throwing it, the non-local return never happens. Is that correct? If so, is there no way around it? Matt -- "You do not really understand something unless you can explain it to your grandmother." -- Albert Einstein.

2 1

[armedbear-devel] Java callbacks
by Alessio Stalla 14 Oct '09

14 Oct '09

Hello, I was thinking about the integration of lisp and java with abcl and it struck me that we don't have an easy way to pass a callback from Java to Lisp (e.g. a function acting as a factory of objects): one can extend Function, Primitive or even LispObject and implement the appropriate execute() method overload; however, one must perform conversion to/from Lisp objects manually, and while this is a minor inconvenience, it adds boilerplate code that could be easily avoided. So I was thinking about adding a Callback class extending Function, with overloads for execute() taking and returning regular java.lang.Object instances, and corresponding execute() based on LispObjects that perform the necessary conversions and call the Java-friendly versions. Example: public LispObject execute(LispObject arg0) { return JavaObject.getInstance(execute(arg0.javaInstance())); } /** To be overridden by the implementing subclass */ protected Object execute(Object arg0) { return error(new WrongNumberOfArgumentsException(this)); } Such a class could have convenience factory methods taking Runnables, Callables and other popular kinds of Java callback objects. Thoughts? Ale

2 2

Re: [armedbear-devel] [armedbear-cvs] r12183 - trunk/abcl/src/org/armedbear/lisp
by Erik Huelsmann 10 Oct '09

10 Oct '09

Mark, The commit below should enable the use of Gray streams with ABCL. I think this means SLIME can now switch to its normal pattern of using Gray streams to wrap its input and output processors. At least, I'd like to remove the SlimeInputStream and SlimeOutputStream Java classes and move the problem to SLIME, if that's possible. Maybe I want to do the same thing for socket streams. Bye, Erik. On Fri, Oct 9, 2009 at 11:31 PM, Erik Huelsmann <ehuelsmann(a)common-lisp.net> wrote: > Author: ehuelsmann > Date: Fri Oct 9 17:31:50 2009 > New Revision: 12183 > > Log: > Fix last Gray stream incompatibilities: generic functions > overlapping with CL functions are no longer have the STREAM- prefix. > > Note: this commit also removes gray stream testing code which does > not belong in the "production" image of our software. > > Modified: > trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp > > Modified: trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp > ============================================================================== > --- trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp (original) > +++ trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp Fri Oct 9 17:31:50 2009 > @@ -94,25 +94,7 @@ > ;;;; > ;;;; Notes > ;;;; ===== > -;;;; CLOSE is not a generic function in this implementation. Instead, > -;;;; the generic is called STREAM-CLOSE and the function CLOSE calls > -;;;; STREAM-CLOSE. The same goes for STREAMP, INPUT-STREAM-P, > -;;;; OUTPUT-STREAM-P and STREAM-ELEMENT-TYPE. The generic functions for > -;;;; these are STREAM-STREAMP, STREAM-INPUT-STREAM-P, > -;;;; STREAM-OUTPUT-STREAM-P and STREAM-STREAM-ELEMENT-TYPE. > ;;;; > -;;;; The standard Corman Lisp streams are not derived from > -;;;; FUNDAMENTAL-STREAM. All the stream functions check to see if the > -;;;; stream is an original Corman Lisp stream and forward on to the > -;;;; original function implementations. > -;;;; > -;;;; The string streams are implemented in this file as Gray streams > -;;;; but do not replace the Corman Lisp string streams. They are only > -;;;; implemented here to test the Gray stream functionality. These methods > -;;;; are called: > -;;;; GRAY-MAKE-STRING-OUTPUT-STREAM > -;;;; GRAY-GET-OUTPUT-STREAM-STRING > -;;;; GRAY-MAKE-STRING-INPUT-STREAM > ;;;; > ;;;; Much of the implementation of the Gray streams below is from the > ;;;; document referenced earlier. > @@ -123,7 +105,6 @@ > (:nicknames "GS") ;; # fb 1.01 > (:export > "FUNDAMENTAL-STREAM" > - "STREAM-CLOSE" > "STREAM-OPEN-STREAM-P" > "STREAM-STREAMP" > "STREAM-INPUT-STREAM-P" > @@ -200,21 +181,14 @@ > > (defclass fundamental-stream ()) > > -(defgeneric stream-close (stream &key abort)) > -(defgeneric stream-open-stream-p (stream)) > -(defgeneric stream-streamp (stream)) > -(defgeneric stream-input-stream-p (stream)) > -(defgeneric stream-input-character-stream-p (stream)) ;; # fb 1.01 > -(defgeneric stream-output-stream-p (stream)) > -(defgeneric stream-stream-element-type (stream)) > +(defgeneric gray-close (stream &key abort)) > +(defgeneric gray-open-stream-p (stream)) > +(defgeneric gray-streamp (stream)) > +(defgeneric gray-input-stream-p (stream)) > +(defgeneric gray-input-character-stream-p (stream)) ;; # fb 1.01 > +(defgeneric gray-output-stream-p (stream)) > +(defgeneric gray-stream-element-type (stream)) > > -(defmethod stream-close (stream &key abort) > - (declare (ignore stream abort)) > - nil) > - > -(defmethod stream-streamp (s) > - (declare (ignore s)) > - nil) > > (defmethod stream-streamp ((s fundamental-stream)) > s) > @@ -225,20 +199,12 @@ > (and (stream-input-stream-p s) > (eq (stream-stream-element-type s) 'character))) > > -(defmethod stream-input-stream-p (s) > - (declare (ignore s)) > - nil) > - > (defmethod stream-input-stream-p ((s fundamental-input-stream)) > (declare (ignore s)) > t) > > (defclass fundamental-output-stream (fundamental-stream)) > > -(defmethod stream-output-stream-p (s) > - (declare (ignore s)) > - nil) > - > (defmethod stream-output-stream-p ((s fundamental-output-stream)) > (declare (ignore s)) > t) > @@ -539,72 +505,6 @@ > (funcall *old-write-byte* integer binary-output-stream) > (stream-write-byte binary-output-stream integer))) > > -(defclass string-input-stream (fundamental-character-input-stream) > - ((string :initarg :string :type string) > - (index :initarg :start :type fixnum) > - (end :initarg :end :type fixnum))) > - > -(defun gray-make-string-input-stream (string &optional (start 0) end) > - (make-instance 'string-input-stream :string string > - :start start :end (or end (length string)))) > - > -(defmethod stream-read-char ((stream string-input-stream)) > - (with-slots (index end string) stream > - (if (>= index end) > - :eof > - (prog1 > - (char string index) > - (incf index))))) > - > -(defmethod stream-unread-char ((stream string-input-stream) character) > - (with-slots (index end string) stream > - (decf index) > - (assert (eql (char string index) character)) > - nil)) > - > -(defmethod stream-read-line ((stream string-input-stream)) > - (with-slots (index end string) stream > - (let* ((endline (position #\newline string :start index :end end)) > - (line (subseq string index endline))) > - (if endline > - (progn > - (setq index (1+ endline)) > - (values line nil)) > - (progn > - (setq index end) > - (values line t)))))) > - > -(defclass string-output-stream (fundamental-character-output-stream) > - ((string :initform nil :initarg :string))) > - > -(defun gray-make-string-output-stream () > - (make-instance 'string-output-stream)) > - > -(defun gray-get-output-stream-string (stream) > - (with-slots (string) stream > - (if (null string) > - "" > - (prog1 > - (coerce string 'string) > - (setq string nil))))) > - > -(defmethod stream-write-char ((stream string-output-stream) character) > - (with-slots (string) stream > - (when (null string) > - (setq string (make-array 64 :slement-type 'character > - :fill-pointer 0 :adjustable t))) > - (vector-push-extend character string) > - character)) > - > -(defmethod stream-line-column ((stream string-output-stream)) > - (with-slots (string) stream > - (if (null string) > - 0 > - (let ((nx (position #\newline string :from-end t))) > - (if (null nx) > - (length string) > - (- (length string) nx 1)))))) > - > (defmethod stream-line-column ((stream stream)) > nil) > > @@ -614,40 +514,26 @@ > nil ;(funcall *old-stream-column* stream) > (stream-line-column stream)))) > > -(defun gray-stream-element-type (stream) > - (if (old-streamp stream) > - (funcall *old-stream-element-type* stream) > - (stream-stream-element-type stream))) > +(defmethod gray-stream-element-type (stream) > + (funcall *old-stream-element-type* stream)) > > -(defun gray-close (stream &key abort) > - (if (old-streamp stream) > - (funcall *old-close* stream :abort abort) > - (stream-close stream :abort nil))) > +(defmethod gray-close (stream &key abort) > + (funcall *old-close* stream :abort abort)) > > -(defun gray-input-stream-p (stream) > - (if (old-streamp stream) > - (funcall *old-input-stream-p* stream) > - (stream-input-stream-p stream))) > +(defmethod gray-input-stream-p (stream) > + (funcall *old-input-stream-p* stream)) > > -(defun gray-input-character-stream-p (stream) > - (if (old-streamp stream) > - (funcall *old-input-character-stream-p* stream) > - (stream-input-character-stream-p stream))) > +(defmethod gray-input-character-stream-p (stream) > + (funcall *old-input-character-stream-p* stream)) > > -(defun gray-output-stream-p (stream) > - (if (old-streamp stream) > - (funcall *old-output-stream-p* stream) > - (stream-output-stream-p stream))) > +(defmethod gray-output-stream-p (stream) > + (funcall *old-output-stream-p* stream)) > > -(defun gray-open-stream-p (stream) > - (if (old-streamp stream) > - (funcall *old-open-stream-p* stream) > - (stream-open-stream-p stream))) > +(defmethod gray-open-stream-p (stream) > + (funcall *old-open-stream-p* stream)) > > -(defun gray-streamp (stream) > - (if (old-streamp stream) > - (funcall *old-streamp* stream) > - (stream-streamp stream))) > +(defmethod gray-streamp (stream) > + (funcall *old-streamp* stream)) > > (defun gray-write-sequence (sequence stream &key (start 0) end) > (if (old-streamp stream) > @@ -659,24 +545,6 @@ > (funcall *old-read-sequence* sequence stream :start start :end end) > (stream-read-sequence stream sequence start end))) > > -(defstruct two-way-stream-g > - input-stream output-stream) > - > -(defun gray-make-two-way-stream (in out) > - (if (and (old-streamp in) (old-streamp out)) > - (funcall *old-make-two-way-stream* in out) > - (make-two-way-stream-g :input-stream in :output-stream out))) > - > -(defun gray-two-way-stream-input-stream (stream) > - (if (old-streamp stream) > - (funcall *old-two-way-stream-input-stream* stream) > - (two-way-stream-g-input-stream stream))) > - > -(defun gray-two-way-stream-output-stream (stream) > - (if (old-streamp stream) > - (funcall *old-two-way-stream-output-stream* stream) > - (two-way-stream-g-output-stream stream))) > - > (setf (symbol-function 'common-lisp::read-char) #'gray-read-char) > (setf (symbol-function 'common-lisp::peek-char) #'gray-peek-char) > (setf (symbol-function 'common-lisp::unread-char) #'gray-unread-char) > @@ -703,8 +571,5 @@ > (setf (symbol-function 'common-lisp::streamp) #'gray-streamp) > (setf (symbol-function 'common-lisp::read-sequence) #'gray-read-sequence) > (setf (symbol-function 'common-lisp::write-sequence) #'gray-write-sequence) > -(setf (symbol-function 'common-lisp::make-two-way-stream) #'gray-make-two-way-stream) > -(setf (symbol-function 'common-lisp::two-way-stream-input-stream) #'gray-two-way-stream-input-stream) > -(setf (symbol-function 'common-lisp::two-way-stream-output-stream) #'gray-two-way-stream-output-stream) > > (provide 'gray-streams) > > _______________________________________________ > armedbear-cvs mailing list > armedbear-cvs(a)common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/armedbear-cvs >

3 3

[armedbear-devel] bug with initialize-instance and keyword arguments
by Steve Rolls 10 Oct '09

10 Oct '09

This is present in 0.16 and latest from svn, but not in 0.15. Specifying a keyword arg in an initialize-instance method does not make the keyword a valid initarg for make-instance. Armed Bear Common Lisp 0.16.0 Java 1.6.0_12 Sun Microsystems Inc. Java HotSpot(TM) 64-Bit Server VM Low-level initialization completed in 0.425 seconds. Startup completed in 2.086 seconds. Type ":help" for a list of available commands. CL-USER(1): (defclass c1() (x)) #<STANDARD-CLASS C1 {5A347448}> CL-USER(2): (defmethod initialize-instance :after ((c c1) &key x2) (setf (slot-value c 'x) x2)) #<STANDARD-METHOD INITIALIZE-INSTANCE :AFTER (C1) {79A1EA46}> CL-USER(3): (make-instance 'c1 :x2 1) Debugger invoked on condition of type PROGRAM-ERROR: Invalid initarg :X2. Restarts: 0: TOP-LEVEL Return to top level. [1] CL-USER(4): Works as expected in 0.15 Armed Bear Common Lisp 0.15.0 Java 1.6.0_12 Sun Microsystems Inc. Java HotSpot(TM) 64-Bit Server VM Low-level initialization completed in 0.45 seconds. Startup completed in 2.021 seconds. Type ":help" for a list of available commands. CL-USER(1): (defclass c1() (x)) #<STANDARD-CLASS C1 {615E7597}> CL-USER(2): (defmethod initialize-instance :after ((c c1) &key x2) (setf (slot-value c 'x) x2)) #<STANDARD-METHOD INITIALIZE-INSTANCE :AFTER (C1) {7346B111}> CL-USER(3): (make-instance 'c1 :x2 1) #<C1 {772EDF9A}> CL-USER(4):

3 8