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

[armedbear-devel] Optimizing startup time
by Erik Huelsmann 21 Oct '09

21 Oct '09

Yesterday, Alex Muscar and I were chatting about the options and possibilities to use ABCL on GAE. It turns out that ABCL's startup gets triggered more often than we expected: instances of ABCL may get swapped out of memory or mapped to different servers, meaning ABCL needs to load all from scratch. So, we were evaluating what options we have to optimize ABCL's startup time. As always, I want to base such a decision on facts, so I ran the profiler on ABCL's startup yesterday. The conclusion is that ~ 40 to 45% of our startup time is spent in "privateGetDeclaredConstructors()". This is due to loadCompiledFunction calling the class's newInstance() method. That however, is the processing time spent. I'd love to be able to reduce it, but the function body delegates to a C/C++ function which means I can't fully understand its performance characteristics. Now, the other thing might be "I/O waiting time". Although the profiler measures "run time" and "wait time", I'm not sure how to deduce I/O wait time from that, or how to profile I/O times in another way. If there is considerable I/O wait time, we could probably speed up ABCL's startup process without having to drastically change any design decisions. Does anybody have any comments to that? Helpful remarks on how to find out about I/O wait time? Bye, Erik.

1 0

Re: [armedbear-devel] Using named classes for primitives
by Erik Huelsmann 21 Oct '09

21 Oct '09

On Mon, Oct 19, 2009 at 2:59 PM, Alessio Stalla <alessiostalla(a)gmail.com> wrote: > On Mon, Oct 19, 2009 at 2:22 PM, Alex Muscar <muscar(a)gmail.com> wrote: >> Hi, >> >> I've been messing around with the code. I've managed to load the fasl, >> but I think we're missing some initializations because I get the >> following error: >> >> ERROR placeholder called with arguments: >> #<UNDEFINED-FUNCTION SYSTEM::ENSURE-AVAILABLE-SYMBOLS {E5F46E}> >> >> Here's a full stack trace: >> >> org.armedbear.lisp.ConditionThrowable: java.lang.Error >> at org.armedbear.lisp.Primitives$70.execute(Primitives.java:1459) > > OT, but not too much: if we used named classes for primitives we could > get more meaningful stack traces (say, JCALL instead of > Primitives$XY). I.e. instead of > > private static final Primitive xyz = new Primitive(...) { ... }; > > we could use > > private static class JCALL extends Primitive { > JCALL(...) { super(...); } > ... > } > private static final Primitive xyz = new JCALL(...); > > a bit more verbose, but worth the effort imho. I think so too. However, there are a few too many of these to start changing them over now. Or does anybody feel like hacking up a perl script to get it done? :-) Bye, Erik.

4 7

[armedbear-devel] abcl on AppEngine
by Alex Muscar 19 Oct '09

19 Oct '09

Here's the first abcl "app" running on Google AppEngine: http://1.latest.abcl-test.appspot.com/hello . It's not much, but it's a start ;). -- All the best, Alex Muscar

1 0

[armedbear-devel] Using Java Libraries
by nitralime 19 Oct '09

19 Oct '09

Hi folks, I'm searching for a (more systematic) documentation (or tutorial) about how to use Java libraries from ABCL. I couldn't find anything else except the examples on "http://trac.common-lisp.net/armedbear/browser/trunk/abcl/examples/abcl". Is there any such tutorial (or documentation) at all? Any feedback is very much appreciated! Regards Nik

3 5

[armedbear-devel] Google AppEngine
by Alex Muscar 19 Oct '09

19 Oct '09

Hi, I've been messing around with the code. I've managed to load the fasl, but I think we're missing some initializations because I get the following error: ERROR placeholder called with arguments: #<UNDEFINED-FUNCTION SYSTEM::ENSURE-AVAILABLE-SYMBOLS {E5F46E}> Here's a full stack trace: org.armedbear.lisp.ConditionThrowable: java.lang.Error at org.armedbear.lisp.Primitives$70.execute(Primitives.java:1459) at org.armedbear.lisp.Primitive.execute(Primitive.java:108) at org.armedbear.lisp.Symbol.execute(Symbol.java:781) at org.armedbear.lisp.Lisp.error(Lisp.java:349) at org.armedbear.lisp.Primitives$72.execute(Primitives.java:1509) at org.armedbear.lisp.Symbol.execute(Symbol.java:792) at org.armedbear.lisp.LispThread.execute(LispThread.java:528) at org.armedbear.lisp.Symbol.undefinedFunction(Symbol.java:898) at org.armedbear.lisp.Symbol.execute(Symbol.java:779) at org.armedbear.lisp.LispThread.execute(LispThread.java:511) at org.armedbear.lisp.Lisp.evalCall(Lisp.java:488) at org.armedbear.lisp.Lisp.eval(Lisp.java:453) at org.armedbear.lisp.Lisp.evalCall(Lisp.java:511) at org.armedbear.lisp.Lisp.eval(Lisp.java:453) at org.armedbear.lisp.Lisp.eval(Lisp.java:451) at org.armedbear.lisp.Load.faslLoadStream(Load.java:523) at org.armedbear.lisp.Load.access$100(Load.java:47) at org.armedbear.lisp.Load$1.execute(Load.java:381) at org.armedbear.lisp.LispThread.execute(LispThread.java:528) at org.armedbear.lisp.Lisp.evalCall(Lisp.java:495) at org.armedbear.lisp.Lisp.eval(Lisp.java:453) at org.armedbear.lisp.Load.loadStream(Load.java:491) at org.armedbear.lisp.Load.loadFileFromStream(Load.java:452) at org.armedbear.lisp.Load.load(Load.java:165) at org.armedbear.lisp.Load.load(Load.java:94) at org.armedbear.lisp.Load.load(Load.java:53) at abcl_ae.AbclInit.<clinit>(AbclInit.java:32) at abcl_ae.HelloWorldServlet.doGet(HelloWorldServlet.java:17) at javax.servlet.http.HttpServlet.service(HttpServlet.java:693) at javax.servlet.http.HttpServlet.service(HttpServlet.java:806) at org.mortbay.jetty.servlet.ServletHolder.handle(ServletHolder.java:487) at org.mortbay.jetty.servlet.ServletHandler$CachedChain.doFilter(ServletHandler.java:1093) at com.google.apphosting.utils.servlet.TransactionCleanupFilter.doFilter(TransactionCleanupFilter.java:43) at org.mortbay.jetty.servlet.ServletHandler$CachedChain.doFilter(ServletHandler.java:1084) at com.google.appengine.tools.development.StaticFileFilter.doFilter(StaticFileFilter.java:121) at org.mortbay.jetty.servlet.ServletHandler$CachedChain.doFilter(ServletHandler.java:1084) at org.mortbay.jetty.servlet.ServletHandler.handle(ServletHandler.java:360) at org.mortbay.jetty.security.SecurityHandler.handle(SecurityHandler.java:216) at org.mortbay.jetty.servlet.SessionHandler.handle(SessionHandler.java:181) at org.mortbay.jetty.handler.ContextHandler.handle(ContextHandler.java:712) at org.mortbay.jetty.webapp.WebAppContext.handle(WebAppContext.java:405) at com.google.apphosting.utils.jetty.DevAppEngineWebAppContext.handle(DevAppEngineWebAppContext.java:54) at org.mortbay.jetty.handler.HandlerWrapper.handle(HandlerWrapper.java:139) at com.google.appengine.tools.development.JettyContainerService$ApiProxyHandler.handle(JettyContainerService.java:342) at org.mortbay.jetty.handler.HandlerWrapper.handle(HandlerWrapper.java:139) at org.mortbay.jetty.Server.handle(Server.java:313) at org.mortbay.jetty.HttpConnection.handleRequest(HttpConnection.java:506) at org.mortbay.jetty.HttpConnection$RequestHandler.headerComplete(HttpConnection.java:830) at org.mortbay.jetty.HttpParser.parseNext(HttpParser.java:514) at org.mortbay.jetty.HttpParser.parseAvailable(HttpParser.java:211) at org.mortbay.jetty.HttpConnection.handle(HttpConnection.java:381) at org.mortbay.io.nio.SelectChannelEndPoint.run(SelectChannelEndPoint.java:396) at org.mortbay.thread.BoundedThreadPool$PoolThread.run(BoundedThreadPool.java:442) ERROR placeholder called with arguments: #<UNDEFINED-FUNCTION SYSTEM::ENSURE-AVAILABLE-SYMBOLS {E5F46E}> I've made Primitives.ERROR throw a ConditionThrowable instead of calling exit -- for debugging purpose. The fasls need to be in the war directory (or in a subdirectory). An ant task copies the .abcl files from src to war\fasls. I've attached an archive with the code as it looks now. -- All the best, Alex Muscar

3 2

[armedbear-devel] ABCL on Google App Engine (progress)
by Erik Huelsmann 19 Oct '09

19 Oct '09

Today, on IRC (irc://irc.freenode.net/#abcl) Alex and I have been working on getting ABCL to run on GAE (Google App Engine). We didn't complete our work, but since this mailing list has a wider audience than the IRC channel, I thought I'd forward our progress (his typing) to the mailing list. Possibly there are additional people interested. If others want to join in this effort to get ABCL running on GAE, I could commit the code to the examples directory in the repository. From there, we could make this a joint effort. One of the things we were running into is that we knew how to get a stream to the first-servlet.abcl file, but not how to get a path/URL to it. Can anybody contribute by answering how we should? When we know, we can do with the existing public functions, if there's not way, we need to make additional functions public. Bye, Erik. ---------- Forwarded message ---------- From: Alex Muscar <muscar(a)gmail.com> Date: Sun, Oct 18, 2009 at 6:13 PM Subject: The GAE bits To: ehuels(a)gmail.com Still hackish, though :(. We'll talk more about this tomorrow. -- All the best, Alex Muscar

2 3

[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