From ehuelsmann at common-lisp.net Mon Jun 1 07:53:26 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 03:53:26 -0400 Subject: [armedbear-cvs] r11973 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 03:53:07 2009 New Revision: 11973 Log: Don't clear the buffer. It could be non-empty. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 03:53:07 2009 @@ -387,9 +387,6 @@ } 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; From ehuelsmann at common-lisp.net Mon Jun 1 09:25:31 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 05:25:31 -0400 Subject: [armedbear-cvs] r11974 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 05:25:01 2009 New Revision: 11974 Log: Remove pointingAtEOF(); it was used only once and the same information is available at lower cost. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 05:25:01 2009 @@ -354,7 +354,7 @@ while ((cbuf.remaining() > 0) && dataIsAvailableForRead() && ! atEof) { atEof = ! ensureReadBbuf(decodeWasUnderflow); - CoderResult r = cdec.decode(bbuf, cbuf, pointingAtEOF() ); + CoderResult r = cdec.decode(bbuf, cbuf, atEof); decodeWasUnderflow = (CoderResult.UNDERFLOW == r); } if (cbuf.remaining() == len) { @@ -367,10 +367,6 @@ 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); From ehuelsmann at common-lisp.net Mon Jun 1 09:40:36 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 05:40:36 -0400 Subject: [armedbear-cvs] r11975 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 05:40:14 2009 New Revision: 11975 Log: Where the underlying stream is positioned should have *no* bearing on what we do: we have bbufpos and bbuf.position()/bbuf.limit() to determine where and what to read. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 05:40:14 2009 @@ -248,7 +248,6 @@ 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; @@ -270,7 +269,6 @@ public RandomAccessCharacterFile(RandomAccessFile raf, String encoding) throws IOException { fcn = raf.getChannel(); - fcnpos = fcn.position(); fcnsize = fcn.size(); cset = (encoding == null) ? Charset.defaultCharset() : Charset.forName(encoding); @@ -339,8 +337,6 @@ } bufReady = (fcn.read(bbuf) != -1); - fcnpos = fcn.position(); - // update bbufpos. bbuf.flip(); } @@ -354,7 +350,7 @@ while ((cbuf.remaining() > 0) && dataIsAvailableForRead() && ! atEof) { atEof = ! ensureReadBbuf(decodeWasUnderflow); - CoderResult r = cdec.decode(bbuf, cbuf, atEof); + CoderResult r = cdec.decode(bbuf, cbuf, atEof ); decodeWasUnderflow = (CoderResult.UNDERFLOW == r); } if (cbuf.remaining() == len) { @@ -365,7 +361,7 @@ } private boolean dataIsAvailableForRead() throws IOException { - return ((bbuf.remaining() > 0) || (fcn.position() < fcn.size())); + return ((bbuf.remaining() > 0) || (bbufpos + bbuf.position() < fcn.size())); } private void write(char[] cb, int off, int len) throws IOException { @@ -395,10 +391,9 @@ flushBbuf(); bbufpos += bbuf.limit(); bbuf.clear(); - if (fcnpos < fcnsize) { + if (bbufpos < 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. @@ -419,10 +414,9 @@ // 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; + bbufpos = newPosition; } } @@ -440,8 +434,7 @@ if (! bbufIsDirty) return; - if (fcnpos != bbufpos) - fcn.position(bbufpos); + fcn.position(bbufpos); bbuf.position(0); if (bbufpos + bbuf.limit() > fcnsize) { @@ -450,7 +443,6 @@ bbuf.limit((int)(fcnsize - bbufpos)); } fcn.write(bbuf); - fcnpos = bbufpos + bbuf.limit(); bbufIsDirty = false; } @@ -517,9 +509,7 @@ if (bbufIsDirty) flushBbuf(); fcn.write(ByteBuffer.wrap(b, off, len)); - fcnpos = fcn.position(); - if (fcnpos > fcnsize) - fcnsize = fcnpos; + fcnsize = fcn.size(); } while (pos < off + len) { int want = len; @@ -538,11 +528,10 @@ flushBbuf(); bbufpos += bbuf.limit(); bbuf.clear(); - if (fcn.position() < fcnsize) { - bbufpos = fcn.position(); + if (bbufpos < fcnsize) { + fcn.position(bbufpos); 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 Mon Jun 1 14:46:00 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 10:46:00 -0400 Subject: [armedbear-cvs] r11976 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 10:45:54 2009 New Revision: 11976 Log: Move flushBbuf() related bbufpos modifications into flushBbuf(). Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 10:45:54 2009 @@ -328,7 +328,7 @@ bbuf.flip(); fcn.position(bbufpos); fcn.write(bbuf); - bbufpos = bbufpos+bbuf.position(); + bbufpos += bbuf.position(); bbuf.clear(); } else { fcn.position(bbufpos + bbuf.limit()); @@ -389,7 +389,6 @@ } if (CoderResult.OVERFLOW == r || bbuf.remaining() == 0) { flushBbuf(); - bbufpos += bbuf.limit(); bbuf.clear(); if (bbufpos < fcnsize) { fcn.read(bbuf); @@ -443,6 +442,10 @@ bbuf.limit((int)(fcnsize - bbufpos)); } fcn.write(bbuf); + + bbufpos += bbuf.position(); + bbuf.clear(); + bbuf.flip(); // there's no useable data in this buffer bbufIsDirty = false; } @@ -526,7 +529,6 @@ } if (bbuf.remaining() == 0) { flushBbuf(); - bbufpos += bbuf.limit(); bbuf.clear(); if (bbufpos < fcnsize) { fcn.position(bbufpos); From ehuelsmann at common-lisp.net Mon Jun 1 15:30:34 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 11:30:34 -0400 Subject: [armedbear-cvs] r11977 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 11:30:30 2009 New Revision: 11977 Log: Use a slighly less contrived calculation method to calculate the buffer window to be written to disk. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 11:30:30 2009 @@ -435,12 +435,10 @@ 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)); - } + // if the buffer is dirty, the modifications have to be + // before position(): before re-positioning, this.position() + // calls this function. + bbuf.flip(); fcn.write(bbuf); bbufpos += bbuf.position(); From ehuelsmann at common-lisp.net Mon Jun 1 18:08:49 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 14:08:49 -0400 Subject: [armedbear-cvs] r11978 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 14:08:38 2009 New Revision: 11978 Log: Remove check for dataIsAvailableForRead(): it's redundant. Introduce the concept of "non-readable bbuf.remaining() content" in order to prevent having to read the block we're writing anyway. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 14:08:38 2009 @@ -264,6 +264,7 @@ */ private ByteBuffer bbuf; private boolean bbufIsDirty; /* whether bbuf holds data that must be written. */ + private boolean bbufIsReadable; /* whether bbuf.remaining() contains readable content. */ private long bbufpos; /* where the beginning of bbuf is pointing in the file now. */ public RandomAccessCharacterFile(RandomAccessFile raf, String encoding) throws IOException { @@ -285,6 +286,8 @@ // there is no write pending data in the buffers. bbufIsDirty = false; + bbufIsReadable = false; + bbufpos = fcn.position(); reader = new RandomAccessReader(); @@ -321,7 +324,7 @@ private final boolean ensureReadBbuf(boolean force) throws IOException { boolean bufReady = true; - if ((bbuf.remaining() == 0) || force) { + if ((bbuf.remaining() == 0) || force || ! bbufIsReadable) { // need to read from the file. if (bbufIsDirty) { @@ -331,13 +334,15 @@ bbufpos += bbuf.position(); bbuf.clear(); } else { - fcn.position(bbufpos + bbuf.limit()); + int bbufEnd = bbufIsReadable ? bbuf.limit() : bbuf.position(); + fcn.position(bbufpos + bbufEnd); bbufpos += bbuf.position(); bbuf.compact(); } bufReady = (fcn.read(bbuf) != -1); bbuf.flip(); + bbufIsReadable = true; } return bufReady; @@ -347,7 +352,7 @@ CharBuffer cbuf = CharBuffer.wrap(cb, off, len); boolean decodeWasUnderflow = false; boolean atEof = false; - while ((cbuf.remaining() > 0) && dataIsAvailableForRead() && ! atEof) { + while ((cbuf.remaining() > 0) && ! atEof) { atEof = ! ensureReadBbuf(decodeWasUnderflow); CoderResult r = cdec.decode(bbuf, cbuf, atEof ); @@ -360,10 +365,6 @@ } } - private boolean dataIsAvailableForRead() throws IOException { - return ((bbuf.remaining() > 0) || (bbufpos + bbuf.position() < fcn.size())); - } - private void write(char[] cb, int off, int len) throws IOException { CharBuffer cbuf = CharBuffer.wrap(cb, off, len); encodeAndWrite(cbuf, false, false); @@ -390,12 +391,6 @@ if (CoderResult.OVERFLOW == r || bbuf.remaining() == 0) { flushBbuf(); bbuf.clear(); - if (bbufpos < fcnsize) { - fcn.read(bbuf); - bbuf.flip(); - } - // 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) { @@ -445,13 +440,13 @@ bbuf.clear(); bbuf.flip(); // there's no useable data in this buffer bbufIsDirty = false; + bbufIsReadable = false; } public int read(byte[] b, int off, int len) throws IOException { int pos = off; boolean atEof = false; - while (pos - off < len && dataIsAvailableForRead() - && ! atEof) { + while (pos - off < len && ! atEof) { atEof = ! ensureReadBbuf(false); int want = len - pos; @@ -528,13 +523,6 @@ if (bbuf.remaining() == 0) { flushBbuf(); bbuf.clear(); - if (bbufpos < fcnsize) { - fcn.position(bbufpos); - fcn.read(bbuf); - bbuf.flip(); - } - // 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 Mon Jun 1 18:23:57 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 14:23:57 -0400 Subject: [armedbear-cvs] r11979 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 14:23:56 2009 New Revision: 11979 Log: Make RACF a little bit less virtual; hopefully it speeds things up. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 14:23:56 2009 @@ -62,7 +62,7 @@ private byte[] read_buf = new byte[1]; @Override - public int read() throws IOException { + public final int read() throws IOException { int len = read(read_buf); if (len == 1) { // byte is signed, char is unsigned, int is signed. @@ -74,59 +74,59 @@ } @Override - public int read(byte[] b, int off, int len) throws IOException { + public final int read(byte[] b, int off, int len) throws IOException { return RandomAccessCharacterFile.this.read(b, off, len); } @Override - public void unread(int b) throws IOException { + public final void unread(int b) throws IOException { RandomAccessCharacterFile.this.unreadByte((byte)b); } @Override - public void unread(byte[] b, int off, int len) throws IOException { + public final void unread(byte[] b, int off, int len) throws IOException { for (int i = 0; i < len; i++) this.unread(b[off+i]); } @Override - public void unread(byte[] b) throws IOException { + public final void unread(byte[] b) throws IOException { this.unread(b, 0, b.length); } @Override - public int available() throws IOException { + public final int available() throws IOException { return (int)(RandomAccessCharacterFile.this.length() - RandomAccessCharacterFile.this.position()); } @Override - public synchronized void mark(int readlimit) { + public final synchronized void mark(int readlimit) { } @Override - public boolean markSupported() { + public final boolean markSupported() { return false; } @Override - public synchronized void reset() throws IOException { + public final synchronized void reset() throws IOException { throw new IOException("Operation not supported"); } @Override - public long skip(long n) throws IOException { + public final long skip(long n) throws IOException { RandomAccessCharacterFile.this.position(RandomAccessCharacterFile.this.position()+n); return n; } @Override - public int read(byte[] b) throws IOException { + public final int read(byte[] b) throws IOException { return this.read(b, 0, b.length); } @Override - public void close() throws IOException { + public final void close() throws IOException { RandomAccessCharacterFile.this.close(); } } @@ -137,23 +137,23 @@ } private byte[] buf = new byte[1]; - public void write(int b) throws IOException { + public final void write(int b) throws IOException { buf[0] = (byte)b; write(buf); } @Override - public void write(byte[] b, int off, int len) throws IOException { + public final void write(byte[] b, int off, int len) throws IOException { RandomAccessCharacterFile.this.write(b, off, len); } @Override - public void flush() throws IOException { + public final void flush() throws IOException { RandomAccessCharacterFile.this.flush(); } @Override - public void close() throws IOException { + public final void close() throws IOException { RandomAccessCharacterFile.this.close(); } } @@ -170,15 +170,15 @@ super(staticReader); } - @Override - public void close() throws IOException { + @Override + public final void close() throws IOException { RandomAccessCharacterFile.this.close(); } private char[] read_buf = new char[1]; @Override - public int read() throws IOException { + public final int read() throws IOException { int n = this.read(read_buf); if (n == 1) @@ -188,34 +188,34 @@ } @Override - public void unread(int c) throws IOException { + public final void unread(int c) throws IOException { RandomAccessCharacterFile.this.unreadChar((char)c); } @Override - public void unread(char[] cbuf, int off, int len) throws IOException { + public final void unread(char[] cbuf, int off, int len) throws IOException { for (int i = 0; i < len; i++) this.unread(cbuf[off+i]); } @Override - public void unread(char[] cbuf) throws IOException { + public final void unread(char[] cbuf) throws IOException { this.unread(cbuf, 0, cbuf.length); } @Override - public int read(CharBuffer target) throws IOException { + public final int read(CharBuffer target) throws IOException { //FIXME: to be implemented throw new IOException("Not implemented"); } @Override - public int read(char[] cbuf) throws IOException { + public final int read(char[] cbuf) throws IOException { return RandomAccessCharacterFile.this.read(cbuf, 0, cbuf.length); } @Override - public int read(char[] cb, int off, int len) throws IOException { + public final int read(char[] cb, int off, int len) throws IOException { return RandomAccessCharacterFile.this.read(cb, off, len); } } @@ -225,16 +225,16 @@ private RandomAccessWriter() { } - public void close() throws IOException { + public final void close() throws IOException { RandomAccessCharacterFile.this.close(); } - public void flush() throws IOException { + public final void flush() throws IOException { RandomAccessCharacterFile.this.flush(); } @Override - public void write(char[] cb, int off, int len) throws IOException { + public final void write(char[] cb, int off, int len) throws IOException { RandomAccessCharacterFile.this.write(cb, off, len); } @@ -312,12 +312,12 @@ return outputStream; } - public void close() throws IOException { + public final void close() throws IOException { internalFlush(true); fcn.close(); } - public void flush() throws IOException { + public final void flush() throws IOException { internalFlush(false); } @@ -348,7 +348,7 @@ return bufReady; } - private int read(char[] cb, int off, int len) throws IOException { + private final int read(char[] cb, int off, int len) throws IOException { CharBuffer cbuf = CharBuffer.wrap(cb, off, len); boolean decodeWasUnderflow = false; boolean atEof = false; @@ -365,12 +365,12 @@ } } - private void write(char[] cb, int off, int len) throws IOException { + private final 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 { + private final void internalFlush(boolean endOfFile) throws IOException { if (endOfFile) { CharBuffer cbuf = CharBuffer.allocate(0); encodeAndWrite(cbuf, true, endOfFile); @@ -379,7 +379,7 @@ } } - private void encodeAndWrite(CharBuffer cbuf, boolean flush, boolean endOfFile) throws IOException { + private final void encodeAndWrite(CharBuffer cbuf, boolean flush, boolean endOfFile) throws IOException { while (cbuf.remaining() > 0) { CoderResult r = cenc.encode(cbuf, bbuf, endOfFile); bbufIsDirty = true; @@ -398,7 +398,7 @@ } } - public void position(long newPosition) throws IOException { + public final void position(long newPosition) throws IOException { flushBbuf(); long bbufend = bbufpos + bbuf.limit(); if (newPosition >= bbufpos && newPosition < bbufend) { @@ -414,17 +414,17 @@ } } - public long position() throws IOException { + public final long position() throws IOException { flushBbuf(); return bbufpos + bbuf.position(); // the logical position within the file. } - public long length() throws IOException { + public final long length() throws IOException { flushBbuf(); return fcn.size(); } - private void flushBbuf() throws IOException { + private final void flushBbuf() throws IOException { if (! bbufIsDirty) return; @@ -443,7 +443,7 @@ bbufIsReadable = false; } - public int read(byte[] b, int off, int len) throws IOException { + public final int read(byte[] b, int off, int len) throws IOException { int pos = off; boolean atEof = false; while (pos - off < len && ! atEof) { @@ -467,7 +467,7 @@ // 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 { + public final 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. @@ -494,12 +494,12 @@ position(pos); } - public void unreadByte(byte b) throws IOException { + public final void unreadByte(byte b) throws IOException { long pos = position() - 1; position(pos); } - private void write(byte[] b, int off, int len) throws IOException { + private final void write(byte[] b, int off, int len) throws IOException { int pos = off; if (len > bbuf.limit()) { if (bbufIsDirty) From ehuelsmann at common-lisp.net Mon Jun 1 18:24:55 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 14:24:55 -0400 Subject: [armedbear-cvs] r11980 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Mon Jun 1 14:24:53 2009 New Revision: 11980 Log: Remove a catch {} block we can manually check for, we expect this improves performance. Modified: trunk/abcl/src/org/armedbear/lisp/Stream.java 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 Mon Jun 1 14:24:53 2009 @@ -1793,9 +1793,9 @@ */ protected int _readChar() throws ConditionThrowable { - if (pastEnd) - return -1; - + if (reader == null) + streamNotCharacterInputStream(); + try { int n = reader.read(); @@ -1823,11 +1823,6 @@ return n; } - catch (NullPointerException e) - { - // reader is null - streamNotCharacterInputStream(); - } catch (IOException e) { error(new StreamError(this, e)); From ehuelsmann at common-lisp.net Mon Jun 1 19:15:37 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 15:15:37 -0400 Subject: [armedbear-cvs] r11981 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 15:15:33 2009 New Revision: 11981 Log: Override PushbackReader.ready() too [in RACF]: the standard implementation uses a synchronized call on a buffer we don't use. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 15:15:33 2009 @@ -218,6 +218,11 @@ public final int read(char[] cb, int off, int len) throws IOException { return RandomAccessCharacterFile.this.read(cb, off, len); } + + @Override + public final boolean ready() throws IOException { + return true; + } } private class RandomAccessWriter extends Writer { From ehuelsmann at common-lisp.net Mon Jun 1 19:18:27 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 15:18:27 -0400 Subject: [armedbear-cvs] r11982 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Mon Jun 1 15:18:24 2009 New Revision: 11982 Log: Don't use exceptions to find out the reader is null; instead, check it on function entry. Modified: trunk/abcl/src/org/armedbear/lisp/Stream.java 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 Mon Jun 1 15:18:24 2009 @@ -1838,6 +1838,9 @@ */ protected void _unreadChar(int n) throws ConditionThrowable { + if (reader == null) + streamNotCharacterInputStream(); + try { reader.unread(n); @@ -1846,11 +1849,6 @@ if (n == eolChar) --lineNumber; } - catch (NullPointerException e) - { - // reader is null - streamNotCharacterInputStream(); - } catch (IOException e) { error(new StreamError(this, e)); @@ -1864,15 +1862,13 @@ */ protected boolean _charReady() throws ConditionThrowable { + if (reader == null) + streamNotCharacterInputStream(); + try { return reader.ready(); } - catch (NullPointerException e) - { - // reader is null - streamNotCharacterInputStream(); - } catch (IOException e) { error(new StreamError(this, e)); From ehuelsmann at common-lisp.net Mon Jun 1 20:48:49 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 16:48:49 -0400 Subject: [armedbear-cvs] r11983 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 16:48:46 2009 New Revision: 11983 Log: Immediately call RACF.write(byte[]) in 2 ROAS methods. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 16:48:46 2009 @@ -139,7 +139,12 @@ private byte[] buf = new byte[1]; public final void write(int b) throws IOException { buf[0] = (byte)b; - write(buf); + RandomAccessCharacterFile.this.write(buf, 0, 1); + } + + @Override + public final void write(byte[] b) throws IOException { + RandomAccessCharacterFile.this.write(b, 0, b.length); } @Override From ehuelsmann at common-lisp.net Mon Jun 1 20:52:20 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 16:52:20 -0400 Subject: [armedbear-cvs] r11984 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 16:52:17 2009 New Revision: 11984 Log: Delete the fcnsize field: in a multiprocessing environment, this is one huge race. Also, its value isn't used for anything but bookkeeping anymore. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 16:52:17 2009 @@ -258,7 +258,6 @@ private RandomAccessInputStream inputStream; private RandomAccessOutputStream outputStream; private FileChannel fcn; - private long fcnsize; /* the file size */ private Charset cset; private CharsetEncoder cenc; @@ -280,7 +279,6 @@ public RandomAccessCharacterFile(RandomAccessFile raf, String encoding) throws IOException { fcn = raf.getChannel(); - fcnsize = fcn.size(); cset = (encoding == null) ? Charset.defaultCharset() : Charset.forName(encoding); cdec = cset.newDecoder(); @@ -393,11 +391,6 @@ 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(); bbuf.clear(); @@ -515,7 +508,6 @@ if (bbufIsDirty) flushBbuf(); fcn.write(ByteBuffer.wrap(b, off, len)); - fcnsize = fcn.size(); } while (pos < off + len) { int want = len; @@ -525,11 +517,6 @@ bbuf.put(b, pos, want); pos += want; bbufIsDirty = true; - long curpos = bbufpos + bbuf.position(); - if (curpos > fcnsize) { - // the file is extended. - fcnsize = curpos; - } if (bbuf.remaining() == 0) { flushBbuf(); bbuf.clear(); From ehuelsmann at common-lisp.net Mon Jun 1 20:55:33 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 16:55:33 -0400 Subject: [armedbear-cvs] r11985 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 16:55:31 2009 New Revision: 11985 Log: We can't move beyond position() in bbuf if it's not readable, set the seek() limits accordingly. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 16:55:31 2009 @@ -403,7 +403,8 @@ public final void position(long newPosition) throws IOException { flushBbuf(); - long bbufend = bbufpos + bbuf.limit(); + long bbufend = bbufpos + // in case bbuf is readable, its contents is valid + bbufIsReadable ? bbuf.limit() : bbuf.position(); // beyond position() if (newPosition >= bbufpos && newPosition < bbufend) { // near seek. within existing data of bbuf. bbuf.position((int)(newPosition - bbufpos)); From ehuelsmann at common-lisp.net Mon Jun 1 21:02:48 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 17:02:48 -0400 Subject: [armedbear-cvs] r11986 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 17:02:33 2009 New Revision: 11986 Log: Flush buffers sparingly. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 17:02:33 2009 @@ -403,15 +403,14 @@ public final void position(long newPosition) throws IOException { flushBbuf(); - long bbufend = bbufpos + // in case bbuf is readable, its contents is valid - bbufIsReadable ? bbuf.limit() : bbuf.position(); // beyond position() + long bbufend = bbufpos // in case bbuf is readable, its contents is valid + + (bbufIsReadable ? bbuf.limit() : bbuf.position()); // beyond position() 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); + // far seek; discard the buffer (it's already cleared) bbuf.clear(); bbuf.flip(); // "there is no useful data on this buffer yet." bbufpos = newPosition; @@ -419,7 +418,6 @@ } public final long position() throws IOException { - flushBbuf(); return bbufpos + bbuf.position(); // the logical position within the file. } From ehuelsmann at common-lisp.net Mon Jun 1 21:26:38 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 17:26:38 -0400 Subject: [armedbear-cvs] r11987 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 17:26:37 2009 New Revision: 11987 Log: Don't destroy buffer content when not necessary: the unread/unwritten part may be valuable as re-reading may come at a high cost (that of I/O). Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 17:26:37 2009 @@ -383,7 +383,7 @@ CharBuffer cbuf = CharBuffer.allocate(0); encodeAndWrite(cbuf, true, endOfFile); } else { - flushBbuf(); + flushBbuf(false); } } @@ -392,17 +392,17 @@ CoderResult r = cenc.encode(cbuf, bbuf, endOfFile); bbufIsDirty = true; if (CoderResult.OVERFLOW == r || bbuf.remaining() == 0) { - flushBbuf(); + flushBbuf(false); bbuf.clear(); } } if (bbuf.position() > 0 && bbufIsDirty && flush) { - flushBbuf(); + flushBbuf(false); } } public final void position(long newPosition) throws IOException { - flushBbuf(); + flushBbuf(true); long bbufend = bbufpos // in case bbuf is readable, its contents is valid + (bbufIsReadable ? bbuf.limit() : bbuf.position()); // beyond position() if (newPosition >= bbufpos && newPosition < bbufend) { @@ -422,11 +422,11 @@ } public final long length() throws IOException { - flushBbuf(); + flushBbuf(false); return fcn.size(); } - private final void flushBbuf() throws IOException { + private final void flushBbuf(boolean commitOnly) throws IOException { if (! bbufIsDirty) return; @@ -435,6 +435,12 @@ // if the buffer is dirty, the modifications have to be // before position(): before re-positioning, this.position() // calls this function. + if (commitOnly || bbufIsReadable) { + ByteBuffer dup = bbuf.duplicate(); + dup.flip(); + fcn.write(dup); + return; + } bbuf.flip(); fcn.write(bbuf); @@ -505,7 +511,7 @@ int pos = off; if (len > bbuf.limit()) { if (bbufIsDirty) - flushBbuf(); + flushBbuf(false); fcn.write(ByteBuffer.wrap(b, off, len)); } while (pos < off + len) { @@ -517,7 +523,7 @@ pos += want; bbufIsDirty = true; if (bbuf.remaining() == 0) { - flushBbuf(); + flushBbuf(false); bbuf.clear(); } } From ehuelsmann at common-lisp.net Mon Jun 1 21:35:11 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 01 Jun 2009 17:35:11 -0400 Subject: [armedbear-cvs] r11988 - trunk/abcl/src/org/armedbear/lisp/util Message-ID: Author: ehuelsmann Date: Mon Jun 1 17:35:05 2009 New Revision: 11988 Log: Remove the 'large block write' special case code: it interacts badly with flushBbuf() and we seem to have an issue with *small* writes/reads, not large ones. Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Modified: trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java (original) +++ trunk/abcl/src/org/armedbear/lisp/util/RandomAccessCharacterFile.java Mon Jun 1 17:35:05 2009 @@ -509,11 +509,6 @@ private final void write(byte[] b, int off, int len) throws IOException { int pos = off; - if (len > bbuf.limit()) { - if (bbufIsDirty) - flushBbuf(false); - fcn.write(ByteBuffer.wrap(b, off, len)); - } while (pos < off + len) { int want = len; if (want > bbuf.remaining()) { From astalla at common-lisp.net Tue Jun 2 09:50:09 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Tue, 02 Jun 2009 05:50:09 -0400 Subject: [armedbear-cvs] r11989 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: astalla Date: Tue Jun 2 05:50:07 2009 New Revision: 11989 Log: Temporary fix for preserving the case of symbols in compiled files. The default readtable-case for fasls has been changed :preserve. Modified: trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java Modified: trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java (original) +++ trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java Tue Jun 2 05:50:07 2009 @@ -99,7 +99,7 @@ dt.functions[13] = FaslReader.FASL_SHARP_ILLEGAL; // return dispatchTables['#'] = dt; - readtableCase = Keyword.UPCASE; + readtableCase = Keyword.PRESERVE; } private static final FaslReadtable instance = new FaslReadtable(); From astalla at common-lisp.net Tue Jun 2 09:52:54 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Tue, 02 Jun 2009 05:52:54 -0400 Subject: [armedbear-cvs] r11990 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: astalla Date: Tue Jun 2 05:52:53 2009 New Revision: 11990 Log: Fixed class name generation from file names: spaces are now converted to underscores. Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/jvm.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp Tue Jun 2 05:52:53 2009 @@ -112,7 +112,8 @@ (declare (type string name)) (dotimes (i (length name)) (declare (type fixnum i)) - (when (char= (char name i) #\-) + (when (or (char= (char name i) #\-) + (char= (char name i) #\Space)) (setf (char name i) #\_))) (concatenate 'string "org/armedbear/lisp/" name))) From vvoutilainen at common-lisp.net Wed Jun 3 20:05:51 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Wed, 03 Jun 2009 16:05:51 -0400 Subject: [armedbear-cvs] r11991 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: vvoutilainen Date: Wed Jun 3 16:05:46 2009 New Revision: 11991 Log: Move IOException handling away from reader's tight loops. Modified: trunk/abcl/src/org/armedbear/lisp/ConcatenatedStream.java trunk/abcl/src/org/armedbear/lisp/EchoStream.java trunk/abcl/src/org/armedbear/lisp/FaslReader.java trunk/abcl/src/org/armedbear/lisp/LispReader.java trunk/abcl/src/org/armedbear/lisp/Stream.java trunk/abcl/src/org/armedbear/lisp/SynonymStream.java trunk/abcl/src/org/armedbear/lisp/TwoWayStream.java Modified: trunk/abcl/src/org/armedbear/lisp/ConcatenatedStream.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/ConcatenatedStream.java (original) +++ trunk/abcl/src/org/armedbear/lisp/ConcatenatedStream.java Wed Jun 3 16:05:46 2009 @@ -111,7 +111,14 @@ else return eofValue; } - return _charReady() ? readChar(eofError, eofValue) : NIL; + try + { + return _charReady() ? readChar(eofError, eofValue) : NIL; + } + catch (java.io.IOException e) + { + return error(new StreamError(this, e)); + } } @Override @@ -132,7 +139,7 @@ // Returns -1 at end of file. @Override - protected int _readChar() throws ConditionThrowable + protected int _readChar() throws ConditionThrowable, java.io.IOException { int n; if (unreadChar >= 0) { @@ -159,7 +166,7 @@ } @Override - protected boolean _charReady() throws ConditionThrowable + protected boolean _charReady() throws ConditionThrowable, java.io.IOException { if (unreadChar >= 0) return true; Modified: trunk/abcl/src/org/armedbear/lisp/EchoStream.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/EchoStream.java (original) +++ trunk/abcl/src/org/armedbear/lisp/EchoStream.java Wed Jun 3 16:05:46 2009 @@ -133,7 +133,7 @@ // Returns -1 at end of file. @Override - protected int _readChar() throws ConditionThrowable + protected int _readChar() throws ConditionThrowable, java.io.IOException { int n = in._readChar(); if (n >= 0) { @@ -147,14 +147,14 @@ } @Override - protected void _unreadChar(int n) throws ConditionThrowable + protected void _unreadChar(int n) throws ConditionThrowable, java.io.IOException { in._unreadChar(n); unreadChar = n; } @Override - protected boolean _charReady() throws ConditionThrowable + protected boolean _charReady() throws ConditionThrowable, java.io.IOException { return in._charReady(); } Modified: trunk/abcl/src/org/armedbear/lisp/FaslReader.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/FaslReader.java (original) +++ trunk/abcl/src/org/armedbear/lisp/FaslReader.java Wed Jun 3 16:05:46 2009 @@ -44,12 +44,19 @@ public LispObject execute(Stream stream, char ignored) throws ConditionThrowable { - while (true) { + try + { + while (true) { int n = stream._readChar(); if (n < 0) - return null; + return null; if (n == '\n') - return null; + return null; + } + } + catch (java.io.IOException e) + { + return null; } } }; @@ -65,49 +72,57 @@ { final Readtable rt = FaslReadtable.getInstance(); FastStringBuffer sb = new FastStringBuffer(); - while (true) { - int n = stream._readChar(); - if (n < 0) { + try + { + while (true) { + int n = stream._readChar(); + if (n < 0) { error(new EndOfFile(stream)); // Not reached. return null; - } - char c = (char) n; - if (rt.getSyntaxType(c) == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) { + } + char c = (char) n; + if (rt.getSyntaxType(c) == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) { // Single escape. n = stream._readChar(); if (n < 0) { - error(new EndOfFile(stream)); - // Not reached. - return null; + error(new EndOfFile(stream)); + // Not reached. + return null; } sb.append((char)n); continue; - } - if (Utilities.isPlatformWindows) { + } + if (Utilities.isPlatformWindows) { if (c == '\r') { - n = stream._readChar(); - if (n < 0) { - error(new EndOfFile(stream)); - // Not reached. - return null; - } - if (n == '\n') { - sb.append('\n'); - } else { - // '\r' was not followed by '\n'. - stream._unreadChar(n); - sb.append('\r'); - } - continue; + n = stream._readChar(); + if (n < 0) { + error(new EndOfFile(stream)); + // Not reached. + return null; + } + if (n == '\n') { + sb.append('\n'); + } else { + // '\r' was not followed by '\n'. + stream._unreadChar(n); + sb.append('\r'); + } + continue; } - } - if (c == terminator) + } + if (c == terminator) break; - // Default. - sb.append(c); - } - return new SimpleString(sb); + // Default. + sb.append(c); + } + return new SimpleString(sb); + } + catch (java.io.IOException e) + { + return new SimpleString(sb); + // return null; + } } }; @@ -206,28 +221,38 @@ final boolean suppress = (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL); FastStringBuffer sb = new FastStringBuffer(); - while (true) { - int ch = stream._readChar(); - if (ch < 0) + try + { + while (true) { + int ch = stream._readChar(); + if (ch < 0) break; - char c = (char) ch; - if (c == '0' || c == '1') + char c = (char) ch; + if (c == '0' || c == '1') sb.append(c); - else { + else { int syntaxType = rt.getSyntaxType(c); if (syntaxType == Readtable.SYNTAX_TYPE_WHITESPACE || syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) { - stream._unreadChar(c); - break; + stream._unreadChar(c); + break; } else if (!suppress) { - String name = LispCharacter.charToName(c); - if (name == null) - name = "#\\" + c; - error(new ReaderError("Illegal element for bit-vector: " + name, - stream)); + String name = LispCharacter.charToName(c); + if (name == null) + name = "#\\" + c; + error(new ReaderError("Illegal element for bit-vector: " + name, + stream)); } - } - } + } + } + } + catch (java.io.IOException e) + { + error(new ReaderError("IO error: ", + stream)); + return NIL; + } + if (suppress) return NIL; if (n >= 0) { Modified: trunk/abcl/src/org/armedbear/lisp/LispReader.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/LispReader.java (original) +++ trunk/abcl/src/org/armedbear/lisp/LispReader.java Wed Jun 3 16:05:46 2009 @@ -44,12 +44,19 @@ public LispObject execute(Stream stream, char ignored) throws ConditionThrowable { - while (true) { + try + { + while (true) { int n = stream._readChar(); if (n < 0) - return null; + return null; if (n == '\n') - return null; + return null; + } + } + catch (java.io.IOException e) + { + return null; } } }; @@ -66,48 +73,56 @@ final LispThread thread = LispThread.currentThread(); final Readtable rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread); FastStringBuffer sb = new FastStringBuffer(); - while (true) { - int n = stream._readChar(); - if (n < 0) { + try + { + while (true) { + int n = stream._readChar(); + if (n < 0) { error(new EndOfFile(stream)); // Not reached. return null; - } - char c = (char) n; - if (rt.getSyntaxType(c) == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) { + } + char c = (char) n; + if (rt.getSyntaxType(c) == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) { // Single escape. n = stream._readChar(); if (n < 0) { - error(new EndOfFile(stream)); - // Not reached. - return null; + error(new EndOfFile(stream)); + // Not reached. + return null; } sb.append((char)n); continue; - } - if (Utilities.isPlatformWindows) { + } + if (Utilities.isPlatformWindows) { if (c == '\r') { - n = stream._readChar(); - if (n < 0) { - error(new EndOfFile(stream)); - // Not reached. - return null; - } - if (n == '\n') { - sb.append('\n'); - } else { - // '\r' was not followed by '\n'. - stream._unreadChar(n); - sb.append('\r'); - } - continue; + n = stream._readChar(); + if (n < 0) { + error(new EndOfFile(stream)); + // Not reached. + return null; + } + if (n == '\n') { + sb.append('\n'); + } else { + // '\r' was not followed by '\n'. + stream._unreadChar(n); + sb.append('\r'); + } + continue; } - } - if (c == terminator) + } + if (c == terminator) break; - // Default. - sb.append(c); - } + // Default. + sb.append(c); + } + } + catch (java.io.IOException e) + { + //error(new EndOfFile(stream)); + return new SimpleString(sb); + } return new SimpleString(sb); } }; @@ -206,28 +221,36 @@ final Readtable rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread); final boolean suppress = Symbol.READ_SUPPRESS.symbolValue(thread) != NIL; FastStringBuffer sb = new FastStringBuffer(); - while (true) { - int ch = stream._readChar(); - if (ch < 0) + try + { + while (true) { + int ch = stream._readChar(); + if (ch < 0) break; - char c = (char) ch; - if (c == '0' || c == '1') + char c = (char) ch; + if (c == '0' || c == '1') sb.append(c); - else { + else { int syntaxType = rt.getSyntaxType(c); if (syntaxType == Readtable.SYNTAX_TYPE_WHITESPACE || syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) { - stream._unreadChar(c); - break; + stream._unreadChar(c); + break; } else if (!suppress) { - String name = LispCharacter.charToName(c); - if (name == null) - name = "#\\" + c; - error(new ReaderError("Illegal element for bit-vector: " + name, - stream)); + String name = LispCharacter.charToName(c); + if (name == null) + name = "#\\" + c; + error(new ReaderError("Illegal element for bit-vector: " + name, + stream)); } + } } - } + } + catch (java.io.IOException e) + { + error(new ReaderError("IO error-vector: ", + stream)); + } if (suppress) return NIL; if (n >= 0) { 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 Jun 3 16:05:46 2009 @@ -398,16 +398,22 @@ recursive, thread); if (result != eofValue && !recursive) { - if (_charReady()) + try { + if (_charReady()) + { + int n = _readChar(); + if (n >= 0) + { + char c = (char) n; + Readtable rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread); + if (!rt.isWhitespace(c)) + _unreadChar(c); + } + } + } + catch (IOException e) { - int n = _readChar(); - if (n >= 0) - { - char c = (char) n; - Readtable rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread); - if (!rt.isWhitespace(c)) - _unreadChar(c); - } + return error(new StreamError(this, e)); } } if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) @@ -432,7 +438,15 @@ final Readtable rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread); while (true) { - int n = _readChar(); + int n = -1; + try + { + n = _readChar(); + } + catch (IOException e) + { + error(new StreamError(this, e)); + } if (n < 0) { if (eofError) @@ -467,33 +481,40 @@ boolean recursive, LispThread thread) throws ConditionThrowable { - LispObject result = faslReadPreservingWhitespace(eofError, eofValue, - recursive, thread); - if (result != eofValue && !recursive) + try { - if (_charReady()) + LispObject result = faslReadPreservingWhitespace(eofError, eofValue, + recursive, thread); + if (result != eofValue && !recursive) { - int n = _readChar(); - if (n >= 0) + if (_charReady()) { - char c = (char) n; - Readtable rt = FaslReadtable.getInstance(); - if (!rt.isWhitespace(c)) - _unreadChar(c); + int n = _readChar(); + if (n >= 0) + { + char c = (char) n; + Readtable rt = FaslReadtable.getInstance(); + if (!rt.isWhitespace(c)) + _unreadChar(c); + } } } + if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) + return NIL; + else + return result; + } + catch (IOException e) + { + return error(new StreamError(this, e)); } - if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) - return NIL; - else - return result; } private final LispObject faslReadPreservingWhitespace(boolean eofError, LispObject eofValue, boolean recursive, LispThread thread) - throws ConditionThrowable + throws ConditionThrowable, IOException { if (recursive) { @@ -504,16 +525,16 @@ if (n < 0) { if (eofError) - return error(new EndOfFile(this)); + return error(new EndOfFile(this)); else - return eofValue; + return eofValue; } char c = (char) n; if (rt.isWhitespace(c)) - continue; + continue; LispObject result = processChar(c, rt); if (result != null) - return result; + return result; } } else @@ -683,66 +704,74 @@ Readtable rt = null; if (useFaslReadtable) rt = FaslReadtable.getInstance(); - while (true) + try { - if (!useFaslReadtable) - rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread); - char c = flushWhitespace(rt); - if (c == ')') - { - return first == null ? NIL : first; - } - if (c == '.') + while (true) { - int n = _readChar(); - if (n < 0) - return error(new EndOfFile(this)); - char nextChar = (char) n; - if (isTokenDelimiter(nextChar, rt)) + if (!useFaslReadtable) + rt = (Readtable) Symbol.CURRENT_READTABLE.symbolValue(thread); + char c = flushWhitespace(rt); + if (c == ')') + { + return first == null ? NIL : first; + } + if (c == '.') { - if (last == null) + int n = _readChar(); + if (n < 0) + return error(new EndOfFile(this)); + char nextChar = (char) n; + if (isTokenDelimiter(nextChar, rt)) { - if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) - return NIL; - else - return error(new ReaderError("Nothing appears before . in list.", - this)); + if (last == null) + { + if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) + return NIL; + else + return error(new ReaderError("Nothing appears before . in list.", + this)); + } + _unreadChar(nextChar); + LispObject obj = read(true, NIL, true, thread); + if (requireProperList) + { + if (!obj.listp()) + error(new ReaderError("The value " + + obj.writeToString() + + " is not of type " + + Symbol.LIST.writeToString() + ".", + this)); + } + last.cdr = obj; + continue; } + // normal token beginning with '.' _unreadChar(nextChar); - LispObject obj = read(true, NIL, true, thread); - if (requireProperList) - { - if (!obj.listp()) - error(new ReaderError("The value " + - obj.writeToString() + - " is not of type " + - Symbol.LIST.writeToString() + ".", - this)); - } - last.cdr = obj; + } + LispObject obj = processChar(c, rt); + if (obj == null) + { + // A comment. continue; } - // normal token beginning with '.' - _unreadChar(nextChar); - } - LispObject obj = processChar(c, rt); - if (obj == null) - { - // A comment. - continue; - } - if (first == null) - { - first = new Cons(obj); - last = first; - } - else - { - Cons newCons = new Cons(obj); - last.cdr = newCons; - last = newCons; + if (first == null) + { + first = new Cons(obj); + last = first; + } + else + { + Cons newCons = new Cons(obj); + last.cdr = newCons; + last = newCons; + } } } + catch (IOException e) + { + error(new StreamError(this, e)); + return null; + } } private static final boolean isTokenDelimiter(char c, Readtable rt) @@ -767,18 +796,25 @@ throws ConditionThrowable { int numArg = -1; - char c; - while (true) + char c = 0; + try { - int n = _readChar(); - if (n < 0) - return error(new EndOfFile(this)); - c = (char) n; - if (c < '0' || c > '9') - break; - if (numArg < 0) - numArg = 0; - numArg = numArg * 10 + c - '0'; + while (true) + { + int n = _readChar(); + if (n < 0) + return error(new EndOfFile(this)); + c = (char) n; + if (c < '0' || c > '9') + break; + if (numArg < 0) + numArg = 0; + numArg = numArg * 10 + c - '0'; + } + } + catch (IOException e) + { + error(new StreamError(this, e)); } final LispThread thread = LispThread.currentThread(); final Readtable rt; @@ -809,61 +845,75 @@ public LispObject readCharacterLiteral(Readtable rt, LispThread thread) throws ConditionThrowable { - int n = _readChar(); - if (n < 0) - return error(new EndOfFile(this)); - char c = (char) n; - FastStringBuffer sb = new FastStringBuffer(c); - while (true) + try { - n = _readChar(); + int n = _readChar(); if (n < 0) - break; - c = (char) n; - if (rt.isWhitespace(c)) - break; - if (c == '(' || c == ')') + return error(new EndOfFile(this)); + char c = (char) n; + FastStringBuffer sb = new FastStringBuffer(c); + while (true) { - _unreadChar(c); - break; + n = _readChar(); + if (n < 0) + break; + c = (char) n; + if (rt.isWhitespace(c)) + break; + if (c == '(' || c == ')') + { + _unreadChar(c); + break; + } + sb.append(c); } - sb.append(c); + if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) + return NIL; + if (sb.length() == 1) + return LispCharacter.getInstance(sb.charAt(0)); + String token = sb.toString(); + n = LispCharacter.nameToChar(token); + if (n >= 0) + return LispCharacter.getInstance((char)n); + return error(new LispError("Unrecognized character name: \"" + token + '"')); + } + catch (IOException e) + { + return error(new StreamError(this, e)); } - if (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL) - return NIL; - if (sb.length() == 1) - return LispCharacter.getInstance(sb.charAt(0)); - String token = sb.toString(); - n = LispCharacter.nameToChar(token); - if (n >= 0) - return LispCharacter.getInstance((char)n); - return error(new LispError("Unrecognized character name: \"" + token + '"')); } public void skipBalancedComment() throws ConditionThrowable { - while (true) + try { - int n = _readChar(); - if (n < 0) - return; - if (n == '|') - { - n = _readChar(); - if (n == '#') - return; - else - _unreadChar(n); - } - else if (n == '#') + while (true) { - n = _readChar(); + int n = _readChar(); + if (n < 0) + return; if (n == '|') - skipBalancedComment(); // Nested comment. Recurse! - else - _unreadChar(n); + { + n = _readChar(); + if (n == '#') + return; + else + _unreadChar(n); + } + else if (n == '#') + { + n = _readChar(); + if (n == '|') + skipBalancedComment(); // Nested comment. Recurse! + else + _unreadChar(n); + } } } + catch (IOException e) + { + error(new StreamError(this, e)); + } } public LispObject readArray(int rank) throws ConditionThrowable @@ -979,32 +1029,39 @@ private String readMultipleEscape(Readtable rt) throws ConditionThrowable { FastStringBuffer sb = new FastStringBuffer(); - while (true) + try { - int n = _readChar(); - if (n < 0) - { - error(new EndOfFile(this)); - // Not reached. - return null; - } - char c = (char) n; - byte syntaxType = rt.getSyntaxType(c); - if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) + while (true) { - n = _readChar(); + int n = _readChar(); if (n < 0) { error(new EndOfFile(this)); // Not reached. return null; } - sb.append((char)n); - continue; + char c = (char) n; + byte syntaxType = rt.getSyntaxType(c); + if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) + { + n = _readChar(); + if (n < 0) + { + error(new EndOfFile(this)); + // Not reached. + return null; + } + sb.append((char)n); + continue; + } + if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) + break; + sb.append(c); } - if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) - break; - sb.append(c); + } + catch (IOException e) + { + error(new StreamError(this, e)); } return sb.toString(); } @@ -1159,7 +1216,16 @@ byte syntaxType = rt.getSyntaxType(c); if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) { - int n = _readChar(); + int n = -1; + try + { + n = _readChar(); + } + catch (IOException e) + { + error(new StreamError(this, e)); + return flags; + } if (n < 0) { error(new EndOfFile(this)); @@ -1191,52 +1257,60 @@ sb.setCharAt(0, LispCharacter.toLowerCase(c)); } } - while (true) - { - int n = _readChar(); - if (n < 0) - break; - char c = (char) n; - if (rt.isWhitespace(c)) - { - _unreadChar(n); - break; - } - byte syntaxType = rt.getSyntaxType(c); - if (syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) - { - _unreadChar(c); - break; - } - rt.checkInvalid(c, this); - if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) - { - n = _readChar(); - if (n < 0) + try { + while (true) + { + int n = _readChar(); + if (n < 0) break; - sb.append((char)n); - if (flags == null) - flags = new BitSet(sb.length()); - flags.set(sb.length() - 1); - continue; - } - if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) - { - int begin = sb.length(); - sb.append(readMultipleEscape(rt)); - int end = sb.length(); - if (flags == null) - flags = new BitSet(sb.length()); - for (int i = begin; i < end; i++) - flags.set(i); - continue; - } - if (readtableCase == Keyword.UPCASE) - c = LispCharacter.toUpperCase(c); - else if (readtableCase == Keyword.DOWNCASE) - c = LispCharacter.toLowerCase(c); - sb.append(c); + char c = (char) n; + if (rt.isWhitespace(c)) + { + _unreadChar(n); + break; + } + byte syntaxType = rt.getSyntaxType(c); + if (syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) + { + _unreadChar(c); + break; + } + rt.checkInvalid(c, this); + if (syntaxType == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) + { + n = _readChar(); + if (n < 0) + break; + sb.append((char)n); + if (flags == null) + flags = new BitSet(sb.length()); + flags.set(sb.length() - 1); + continue; + } + if (syntaxType == Readtable.SYNTAX_TYPE_MULTIPLE_ESCAPE) + { + int begin = sb.length(); + sb.append(readMultipleEscape(rt)); + int end = sb.length(); + if (flags == null) + flags = new BitSet(sb.length()); + for (int i = begin; i < end; i++) + flags.set(i); + continue; + } + if (readtableCase == Keyword.UPCASE) + c = LispCharacter.toUpperCase(c); + else if (readtableCase == Keyword.DOWNCASE) + c = LispCharacter.toLowerCase(c); + sb.append(c); + } + } + catch (IOException e) + { + error(new StreamError(this, e)); + return flags; } + return flags; } @@ -1537,18 +1611,26 @@ private char flushWhitespace(Readtable rt) throws ConditionThrowable { - while (true) + try { - int n = _readChar(); - if (n < 0) + while (true) { - error(new EndOfFile(this)); - // Not reached. - return 0; + int n = _readChar(); + if (n < 0) + { + error(new EndOfFile(this)); + // Not reached. + return 0; + } + char c = (char) n; + if (!rt.isWhitespace(c)) + return c; } - char c = (char) n; - if (!rt.isWhitespace(c)) - return c; + } + catch (IOException e) + { + error(new StreamError(this, e)); + return 0; } } @@ -1581,23 +1663,30 @@ { final LispThread thread = LispThread.currentThread(); FastStringBuffer sb = new FastStringBuffer(); - while (true) + try { - int n = _readChar(); - if (n < 0) + while (true) { - if (sb.length() == 0) + int n = _readChar(); + if (n < 0) { - if (eofError) - return error(new EndOfFile(this)); - return thread.setValues(eofValue, T); + if (sb.length() == 0) + { + if (eofError) + return error(new EndOfFile(this)); + return thread.setValues(eofValue, T); + } + return thread.setValues(new SimpleString(sb), T); } - return thread.setValues(new SimpleString(sb), T); + if (n == '\n') + return thread.setValues(new SimpleString(sb), NIL); + else + sb.append((char)n); } - if (n == '\n') - return thread.setValues(new SimpleString(sb), NIL); - else - sb.append((char)n); + } + catch (IOException e) + { + return error(new StreamError(this, e)); } } @@ -1605,24 +1694,39 @@ // recursive-p is ignored public LispObject readChar() throws ConditionThrowable { - int n = _readChar(); - if (n < 0) - return error(new EndOfFile(this)); - return LispCharacter.getInstance((char)n); + try + { + int n = _readChar(); + if (n < 0) + return error(new EndOfFile(this)); + return LispCharacter.getInstance((char)n); + } + catch (IOException e) + { + return error(new StreamError(this, e)); + } + } public LispObject readChar(boolean eofError, LispObject eofValue) throws ConditionThrowable { - int n = _readChar(); - if (n < 0) + try { - if (eofError) - return error(new EndOfFile(this)); - else - return eofValue; + int n = _readChar(); + if (n < 0) + { + if (eofError) + return error(new EndOfFile(this)); + else + return eofValue; + } + return LispCharacter.getInstance((char)n); + } + catch (IOException e) + { + return error(new StreamError(this, e)); } - return LispCharacter.getInstance((char)n); } // read-char-no-hang &optional stream eof-error-p eof-value recursive-p => char @@ -1630,15 +1734,29 @@ public LispObject readCharNoHang(boolean eofError, LispObject eofValue) throws ConditionThrowable { - return _charReady() ? readChar(eofError, eofValue) : NIL; + try + { + return _charReady() ? readChar(eofError, eofValue) : NIL; + } + catch (IOException e) + { + return error(new StreamError(this, e)); + } } // unread-char character &optional input-stream => nil public LispObject unreadChar(LispCharacter c) throws ConditionThrowable { - _unreadChar(c.value); - return NIL; + try + { + _unreadChar(c.value); + return NIL; + } + catch (IOException e) + { + return error(new StreamError(this, e)); + } } public LispObject finishOutput() throws ConditionThrowable @@ -1735,17 +1853,23 @@ { if (pastEnd) return NIL; - - if (! _charReady()) - return NIL; - - int n = _readChar(); - if (n < 0) - return NIL; - - _unreadChar(n); - - return T; + try + { + if (! _charReady()) + return NIL; + + int n = _readChar(); + if (n < 0) + return NIL; + + _unreadChar(n); + + return T; + } + catch (IOException e) + { + return error(new StreamError(this, e)); + } } public LispObject fileLength() throws ConditionThrowable @@ -1791,44 +1915,35 @@ * @return a character, or -1 at end-of-file * @throws org.armedbear.lisp.ConditionThrowable */ - protected int _readChar() throws ConditionThrowable + protected int _readChar() throws ConditionThrowable, IOException { if (reader == null) streamNotCharacterInputStream(); - try - { - int n = reader.read(); - - if (n < 0) { - pastEnd = true; - return -1; - } + int n = reader.read(); + + if (n < 0) { + pastEnd = true; + return -1; + } - ++offset; - if (eolStyle == EolStyle.CRLF && n == '\r') { - n = _readChar(); - if (n != '\n') { - _unreadChar(n); - return '\r'; - } - else - return '\n'; + ++offset; + if (eolStyle == EolStyle.CRLF && n == '\r') { + n = _readChar(); + if (n != '\n') { + _unreadChar(n); + return '\r'; } + else + return '\n'; + } - if (n == eolChar) { - ++lineNumber; - return '\n'; - } + if (n == eolChar) { + ++lineNumber; + return '\n'; + } - return n; - } - catch (IOException e) - { - error(new StreamError(this, e)); - } - // Not reached. - return -1; + return n; } /** Puts a character back into the (underlying) stream @@ -1836,45 +1951,28 @@ * @param n * @throws org.armedbear.lisp.ConditionThrowable */ - protected void _unreadChar(int n) throws ConditionThrowable + protected void _unreadChar(int n) throws ConditionThrowable, IOException { if (reader == null) streamNotCharacterInputStream(); - - try - { - reader.unread(n); - --offset; - pastEnd = false; - if (n == eolChar) - --lineNumber; - } - catch (IOException e) - { - error(new StreamError(this, e)); - } + reader.unread(n); + --offset; + pastEnd = false; + if (n == eolChar) + --lineNumber; } + /** Returns a boolean indicating input readily available * * @return true if a character is available * @throws org.armedbear.lisp.ConditionThrowable */ - protected boolean _charReady() throws ConditionThrowable + protected boolean _charReady() throws ConditionThrowable, IOException { if (reader == null) streamNotCharacterInputStream(); - - try - { - return reader.ready(); - } - catch (IOException e) - { - error(new StreamError(this, e)); - } - // Not reached. - return false; + return reader.ready(); } /** Writes a character into the underlying stream, @@ -2087,8 +2185,15 @@ if (reader != null) { int c = 0; - while (_charReady() && (c >= 0)) - c = _readChar(); + try + { + while (_charReady() && (c >= 0)) + c = _readChar(); + } + catch (IOException e) + { + error(new StreamError(this, e)); + } } else if (in != null) { Modified: trunk/abcl/src/org/armedbear/lisp/SynonymStream.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/SynonymStream.java (original) +++ trunk/abcl/src/org/armedbear/lisp/SynonymStream.java Wed Jun 3 16:05:46 2009 @@ -125,19 +125,19 @@ } @Override - protected int _readChar() throws ConditionThrowable + protected int _readChar() throws ConditionThrowable, java.io.IOException { return checkStream(symbol.symbolValue())._readChar(); } @Override - protected void _unreadChar(int n) throws ConditionThrowable + protected void _unreadChar(int n) throws ConditionThrowable, java.io.IOException { checkStream(symbol.symbolValue())._unreadChar(n); } @Override - protected boolean _charReady() throws ConditionThrowable + protected boolean _charReady() throws ConditionThrowable, java.io.IOException { return checkStream(symbol.symbolValue())._charReady(); } Modified: trunk/abcl/src/org/armedbear/lisp/TwoWayStream.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/TwoWayStream.java (original) +++ trunk/abcl/src/org/armedbear/lisp/TwoWayStream.java Wed Jun 3 16:05:46 2009 @@ -120,19 +120,19 @@ // Returns -1 at end of file. @Override - protected int _readChar() throws ConditionThrowable + protected int _readChar() throws ConditionThrowable, java.io.IOException { return in._readChar(); } @Override - protected void _unreadChar(int n) throws ConditionThrowable + protected void _unreadChar(int n) throws ConditionThrowable, java.io.IOException { in._unreadChar(n); } @Override - protected boolean _charReady() throws ConditionThrowable + protected boolean _charReady() throws ConditionThrowable, java.io.IOException { return in._charReady(); } From astalla at common-lisp.net Sat Jun 6 08:58:53 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Sat, 06 Jun 2009 04:58:53 -0400 Subject: [armedbear-cvs] r11992 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: astalla Date: Sat Jun 6 04:58:45 2009 New Revision: 11992 Log: Exported MOP functions class-slots and slot-definition-name. Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/clos.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/clos.lisp Sat Jun 6 04:58:45 2009 @@ -51,7 +51,13 @@ (in-package #:mop) -(export '(class-precedence-list)) +(export '(class-precedence-list class-slots slot-definition-name)) + +(defun class-slots (class) + (%class-slots class)) + +(defun slot-definition-name (slot-definition) + (%slot-definition-name slot-definition)) (defmacro push-on-end (value location) `(setf ,location (nconc ,location (list ,value)))) From ehuelsmann at common-lisp.net Sat Jun 6 09:17:47 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 06 Jun 2009 05:17:47 -0400 Subject: [armedbear-cvs] r11993 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Jun 6 05:17:40 2009 New Revision: 11993 Log: Followup to r11992: add CLOS external symbols to the autoloader. Modified: trunk/abcl/src/org/armedbear/lisp/autoloads.lisp Modified: trunk/abcl/src/org/armedbear/lisp/autoloads.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/autoloads.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/autoloads.lisp Sat Jun 6 05:17:40 2009 @@ -190,8 +190,9 @@ (autoload 'disassemble) (in-package "MOP") -(export 'class-precedence-list) -(autoload 'class-precedence-list "clos") +(export '(class-precedence-list class-slots slot-definition-name)) +(autoload '(class-precedence-list class-slots slot-definition-name) "clos") + ;; Java interface. (in-package "JAVA") From vvoutilainen at common-lisp.net Sat Jun 6 14:03:18 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Sat, 06 Jun 2009 10:03:18 -0400 Subject: [armedbear-cvs] r11994 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: vvoutilainen Date: Sat Jun 6 10:03:16 2009 New Revision: 11994 Log: Move macroexpand-all and compiler-let to EXT and LISP packages, respectively. Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java trunk/abcl/src/org/armedbear/lisp/Symbol.java trunk/abcl/src/org/armedbear/lisp/autoloads.lisp trunk/abcl/src/org/armedbear/lisp/precompiler.lisp 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 Sat Jun 6 10:03:16 2009 @@ -76,6 +76,8 @@ Packages.createPackage("PROFILER"); public static final Package PACKAGE_JAVA = Packages.createPackage("JAVA"); + public static final Package PACKAGE_LISP = + Packages.createPackage("LISP"); // ### nil public static final LispObject NIL = Nil.NIL; @@ -110,6 +112,9 @@ PACKAGE_PROF.usePackage(PACKAGE_EXT); PACKAGE_JAVA.usePackage(PACKAGE_CL); PACKAGE_JAVA.usePackage(PACKAGE_EXT); + PACKAGE_LISP.usePackage(PACKAGE_CL); + PACKAGE_LISP.usePackage(PACKAGE_EXT); + PACKAGE_LISP.usePackage(PACKAGE_SYS); } catch (Throwable t) { Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Symbol.java (original) +++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Sat Jun 6 10:03:16 2009 @@ -2857,6 +2857,8 @@ PACKAGE_EXT.addExternalSymbol("INTERRUPT-LISP"); public static final Symbol GETENV = PACKAGE_EXT.addExternalSymbol("GETENV"); + public static final Symbol MACROEXPAND_ALL = + PACKAGE_EXT.addExternalSymbol("MACROEXPAND-ALL"); // MOP. public static final Symbol STANDARD_READER_METHOD = @@ -2986,4 +2988,6 @@ public static final Symbol _INSPECTOR_HOOK_ = PACKAGE_EXT.addExternalSymbol("*INSPECTOR-HOOK*"); + public static final Symbol COMPILER_LET= + PACKAGE_LISP.addExternalSymbol("COMPILER-LET"); } Modified: trunk/abcl/src/org/armedbear/lisp/autoloads.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/autoloads.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/autoloads.lisp Sat Jun 6 10:03:16 2009 @@ -306,8 +306,14 @@ (autoload 'compile-file-if-needed "compile-file") (export 'describe-compiler-policy) (autoload 'describe-compiler-policy) +(export 'macroexpand-all) +(autoload 'macroexpand-all) ;; JVM compiler. (in-package "JVM") (export '(jvm-compile-package)) (autoload '%with-compilation-unit "jvm") + +(in-package "LISP") +(export 'compiler-let) +(autoload 'compiler-let) Modified: trunk/abcl/src/org/armedbear/lisp/precompiler.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/precompiler.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/precompiler.lisp Sat Jun 6 10:03:16 2009 @@ -1000,11 +1000,12 @@ (export '(precompile-form)) -(in-package #:system) - +(in-package #:ext) (defun macroexpand-all (form &optional env) (precompiler:precompile-form form nil env)) +(in-package #:lisp) + (defmacro compiler-let (bindings &body forms &environment env) (let ((bindings (mapcar #'(lambda (binding) (if (atom binding) (list binding) binding)) @@ -1014,6 +1015,8 @@ (eval (cadr binding))) bindings) (macroexpand-all `(progn , at forms) env)))) +(in-package #:system) + (defun set-function-definition (name new old) (let ((*warn-on-redefinition* nil)) (sys::%set-lambda-name new name) From vvoutilainen at common-lisp.net Sat Jun 6 14:15:01 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Sat, 06 Jun 2009 10:15:01 -0400 Subject: [armedbear-cvs] r11995 - branches/0.15.x/abcl/src/org/armedbear/lisp Message-ID: Author: vvoutilainen Date: Sat Jun 6 10:15:00 2009 New Revision: 11995 Log: Backport the packaging changes for macroexpand-all and compiler-let. Modified: branches/0.15.x/abcl/src/org/armedbear/lisp/Lisp.java branches/0.15.x/abcl/src/org/armedbear/lisp/Symbol.java branches/0.15.x/abcl/src/org/armedbear/lisp/autoloads.lisp branches/0.15.x/abcl/src/org/armedbear/lisp/precompiler.lisp Modified: branches/0.15.x/abcl/src/org/armedbear/lisp/Lisp.java ============================================================================== --- branches/0.15.x/abcl/src/org/armedbear/lisp/Lisp.java (original) +++ branches/0.15.x/abcl/src/org/armedbear/lisp/Lisp.java Sat Jun 6 10:15:00 2009 @@ -76,6 +76,8 @@ Packages.createPackage("PROFILER"); public static final Package PACKAGE_JAVA = Packages.createPackage("JAVA"); + public static final Package PACKAGE_LISP = + Packages.createPackage("LISP"); // ### nil public static final LispObject NIL = Nil.NIL; @@ -110,6 +112,9 @@ PACKAGE_PROF.usePackage(PACKAGE_EXT); PACKAGE_JAVA.usePackage(PACKAGE_CL); PACKAGE_JAVA.usePackage(PACKAGE_EXT); + PACKAGE_LISP.usePackage(PACKAGE_CL); + PACKAGE_LISP.usePackage(PACKAGE_EXT); + PACKAGE_LISP.usePackage(PACKAGE_SYS); } catch (Throwable t) { Modified: branches/0.15.x/abcl/src/org/armedbear/lisp/Symbol.java ============================================================================== --- branches/0.15.x/abcl/src/org/armedbear/lisp/Symbol.java (original) +++ branches/0.15.x/abcl/src/org/armedbear/lisp/Symbol.java Sat Jun 6 10:15:00 2009 @@ -2888,6 +2888,8 @@ PACKAGE_EXT.addExternalSymbol("INTERRUPT-LISP"); public static final Symbol GETENV = PACKAGE_EXT.addExternalSymbol("GETENV"); + public static final Symbol MACROEXPAND_ALL = + PACKAGE_EXT.addExternalSymbol("MACROEXPAND-ALL"); // MOP. public static final Symbol STANDARD_READER_METHOD = @@ -3017,4 +3019,6 @@ public static final Symbol _INSPECTOR_HOOK_ = PACKAGE_EXT.addExternalSymbol("*INSPECTOR-HOOK*"); + public static final Symbol COMPILER_LET= + PACKAGE_LISP.addExternalSymbol("COMPILER-LET"); } Modified: branches/0.15.x/abcl/src/org/armedbear/lisp/autoloads.lisp ============================================================================== --- branches/0.15.x/abcl/src/org/armedbear/lisp/autoloads.lisp (original) +++ branches/0.15.x/abcl/src/org/armedbear/lisp/autoloads.lisp Sat Jun 6 10:15:00 2009 @@ -305,8 +305,14 @@ (autoload 'compile-file-if-needed "compile-file") (export 'describe-compiler-policy) (autoload 'describe-compiler-policy) +(export 'macroexpand-all) +(autoload 'macroexpand-all) ;; JVM compiler. (in-package "JVM") (export '(jvm-compile-package)) (autoload '%with-compilation-unit "jvm") + +(in-package "LISP") +(export 'compiler-let) +(autoload 'compiler-let) Modified: branches/0.15.x/abcl/src/org/armedbear/lisp/precompiler.lisp ============================================================================== --- branches/0.15.x/abcl/src/org/armedbear/lisp/precompiler.lisp (original) +++ branches/0.15.x/abcl/src/org/armedbear/lisp/precompiler.lisp Sat Jun 6 10:15:00 2009 @@ -1000,11 +1000,12 @@ (export '(precompile-form)) -(in-package #:system) - +(in-package #:ext) (defun macroexpand-all (form &optional env) (precompiler:precompile-form form nil env)) +(in-package #:lisp) + (defmacro compiler-let (bindings &body forms &environment env) (let ((bindings (mapcar #'(lambda (binding) (if (atom binding) (list binding) binding)) @@ -1014,6 +1015,8 @@ (eval (cadr binding))) bindings) (macroexpand-all `(progn , at forms) env)))) +(in-package #:system) + (defun set-function-definition (name new old) (let ((*warn-on-redefinition* nil)) (sys::%set-lambda-name new name) From vvoutilainen at common-lisp.net Sat Jun 6 16:36:03 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Sat, 06 Jun 2009 12:36:03 -0400 Subject: [armedbear-cvs] r11996 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: vvoutilainen Date: Sat Jun 6 12:35:56 2009 New Revision: 11996 Log: Change the parameters of precompile-form in macroexpand-all, as requested by our users. Modified: trunk/abcl/src/org/armedbear/lisp/precompiler.lisp Modified: trunk/abcl/src/org/armedbear/lisp/precompiler.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/precompiler.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/precompiler.lisp Sat Jun 6 12:35:56 2009 @@ -1002,7 +1002,7 @@ (in-package #:ext) (defun macroexpand-all (form &optional env) - (precompiler:precompile-form form nil env)) + (precompiler:precompile-form form t env)) (in-package #:lisp) From vvoutilainen at common-lisp.net Sat Jun 6 16:38:50 2009 From: vvoutilainen at common-lisp.net (Ville Voutilainen) Date: Sat, 06 Jun 2009 12:38:50 -0400 Subject: [armedbear-cvs] r11997 - branches/0.15.x/abcl/src/org/armedbear/lisp Message-ID: Author: vvoutilainen Date: Sat Jun 6 12:38:45 2009 New Revision: 11997 Log: Change the parameters of precompile-form in macroexpand-all, as requested by our users. This is a backport of the fix done in trunk in r11996. Modified: branches/0.15.x/abcl/src/org/armedbear/lisp/precompiler.lisp Modified: branches/0.15.x/abcl/src/org/armedbear/lisp/precompiler.lisp ============================================================================== --- branches/0.15.x/abcl/src/org/armedbear/lisp/precompiler.lisp (original) +++ branches/0.15.x/abcl/src/org/armedbear/lisp/precompiler.lisp Sat Jun 6 12:38:45 2009 @@ -1002,7 +1002,7 @@ (in-package #:ext) (defun macroexpand-all (form &optional env) - (precompiler:precompile-form form nil env)) + (precompiler:precompile-form form t env)) (in-package #:lisp) From ehuelsmann at common-lisp.net Sat Jun 6 17:47:06 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 06 Jun 2009 13:47:06 -0400 Subject: [armedbear-cvs] r11998 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Jun 6 13:46:59 2009 New Revision: 11998 Log: Add a cache for opened '.zip' files. Before this change, consecutive calls to loadCompiledFunction() would open the same zip file over and over. Added: trunk/abcl/src/org/armedbear/lisp/ZipCache.java (contents, props changed) Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java trunk/abcl/src/org/armedbear/lisp/Load.java 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 Sat Jun 6 13:46:59 2009 @@ -1075,7 +1075,7 @@ zipFileName = zipFileName.substring(1); } zipFileName = URLDecoder.decode(zipFileName, "UTF-8"); - ZipFile zipFile = new ZipFile(zipFileName); + ZipFile zipFile = ZipCache.getZip(zipFileName); try { ZipEntry entry = zipFile.getEntry(entryName); @@ -1089,7 +1089,7 @@ } finally { - zipFile.close(); + ZipCache.removeZip(zipFile.getName()); } } } @@ -1139,7 +1139,7 @@ { LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValue(thread); String zipFileName = ((Pathname)loadTruename).getNamestring(); - ZipFile zipFile = new ZipFile(zipFileName); + ZipFile zipFile = ZipCache.getZip(zipFileName); try { ZipEntry entry = zipFile.getEntry(namestring); @@ -1155,7 +1155,7 @@ } finally { - zipFile.close(); + ZipCache.removeZip(zipFile.getName()); } } catch (Throwable t) @@ -1197,7 +1197,6 @@ public static final LispObject loadCompiledFunction(byte[] bytes) throws Throwable { Class c = (new JavaClassLoader()).loadClassFromByteArray(null, bytes, 0, bytes.length); if (c != null) { - Class sc = c.getSuperclass(); Constructor constructor = c.getConstructor((Class[])null); LispObject obj = (LispObject) constructor.newInstance((Object[])null); if (obj instanceof Function) { Modified: trunk/abcl/src/org/armedbear/lisp/Load.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Load.java (original) +++ trunk/abcl/src/org/armedbear/lisp/Load.java Sat Jun 6 13:46:59 2009 @@ -123,7 +123,7 @@ if (checkZipFile(file)) { try { - zipfile = new ZipFile(file); + zipfile = ZipCache.getZip(file.getPath()); } catch (Throwable t) { // Fall through. @@ -175,7 +175,7 @@ finally { if (in != null) { try { - in.close(); + in.close(); } catch (IOException e) { return error(new LispError(e.getMessage())); @@ -183,7 +183,7 @@ } if (zipfile != null) { try { - zipfile.close(); + ZipCache.removeZip(zipfile.getName()); } catch (IOException e) { return error(new LispError(e.getMessage())); @@ -265,7 +265,7 @@ String ext = getExtension(s); if (ext.equalsIgnoreCase(".abcl")) { try { - zipfile = new ZipFile(file); + zipfile = ZipCache.getZip(file.getPath()); String name = file.getName(); int index = name.lastIndexOf('.'); Debug.assertTrue(index >= 0); @@ -338,7 +338,7 @@ finally { if (zipfile != null) { try { - zipfile.close(); + ZipCache.removeZip(zipfile.getName()); } catch (IOException e) { return error(new LispError(e.getMessage())); Added: trunk/abcl/src/org/armedbear/lisp/ZipCache.java ============================================================================== --- (empty file) +++ trunk/abcl/src/org/armedbear/lisp/ZipCache.java Sat Jun 6 13:46:59 2009 @@ -0,0 +1,82 @@ +/* + * ZipCache.java + * + * Copyright (C) 2009 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; + +import java.io.IOException; +import java.util.HashMap; +import java.util.Map; +import java.util.zip.ZipFile; + +/** + * + * @author Erik + */ +class ZipCache { + + static Map zips = new HashMap(); + + synchronized static ZipFile getZip(String name) throws IOException { + Entry zip = zips.get(name); + + if (zip == null) + zips.put(name, zip = new Entry(new ZipFile(name))); + + zip.refcount++; + return zip.value; + } + + synchronized static void removeZip(String name) throws IOException { + Entry zip = zips.get(name); + + if (zip == null) + return; + + zip.refcount--; + if (zip.refcount == 0) { + zip.value.close(); + zips.remove(name); + } + } + + static class Entry { + ZipFile value; + int refcount = 0; + + Entry(ZipFile v) { + value = v; + } + } + +} From ehuelsmann at common-lisp.net Sat Jun 6 19:39:17 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 06 Jun 2009 15:39:17 -0400 Subject: [armedbear-cvs] r11999 - trunk/abcl Message-ID: Author: ehuelsmann Date: Sat Jun 6 15:39:07 2009 New Revision: 11999 Log: Update CHANGES with my MOP backport plan. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES (original) +++ trunk/abcl/CHANGES Sat Jun 6 15:39:07 2009 @@ -2,6 +2,7 @@ (?? Jun, 2009) - Anticipate a June date Summary of changes: + * 2 more MOP exported symbols to support Cells port * Updated FASL version * Support (pre)compilation of functions with a non-null lexical environment * Compiler and precompiler cleanups From ehuelsmann at common-lisp.net Sat Jun 6 19:40:44 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 06 Jun 2009 15:40:44 -0400 Subject: [armedbear-cvs] r12000 - in branches/0.15.x/abcl: . src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Jun 6 15:40:42 2009 New Revision: 12000 Log: Backport r11992, 11993 and 11999: Cells support in MOP package. Modified: branches/0.15.x/abcl/CHANGES branches/0.15.x/abcl/src/org/armedbear/lisp/autoloads.lisp branches/0.15.x/abcl/src/org/armedbear/lisp/clos.lisp Modified: branches/0.15.x/abcl/CHANGES ============================================================================== --- branches/0.15.x/abcl/CHANGES (original) +++ branches/0.15.x/abcl/CHANGES Sat Jun 6 15:40:42 2009 @@ -2,6 +2,7 @@ (?? Jun, 2009) - Anticipate a June date Summary of changes: + * 2 more MOP exported symbols to support Cells port * Updated FASL version * Support (pre)compilation of functions with a non-null lexical environment * Compiler and precompiler cleanups Modified: branches/0.15.x/abcl/src/org/armedbear/lisp/autoloads.lisp ============================================================================== --- branches/0.15.x/abcl/src/org/armedbear/lisp/autoloads.lisp (original) +++ branches/0.15.x/abcl/src/org/armedbear/lisp/autoloads.lisp Sat Jun 6 15:40:42 2009 @@ -190,8 +190,9 @@ (autoload 'disassemble) (in-package "MOP") -(export 'class-precedence-list) -(autoload 'class-precedence-list "clos") +(export '(class-precedence-list class-slots slot-definition-name)) +(autoload '(class-precedence-list class-slots slot-definition-name) "clos") + ;; Java interface. (in-package "JAVA") Modified: branches/0.15.x/abcl/src/org/armedbear/lisp/clos.lisp ============================================================================== --- branches/0.15.x/abcl/src/org/armedbear/lisp/clos.lisp (original) +++ branches/0.15.x/abcl/src/org/armedbear/lisp/clos.lisp Sat Jun 6 15:40:42 2009 @@ -51,7 +51,13 @@ (in-package #:mop) -(export '(class-precedence-list)) +(export '(class-precedence-list class-slots slot-definition-name)) + +(defun class-slots (class) + (%class-slots class)) + +(defun slot-definition-name (slot-definition) + (%slot-definition-name slot-definition)) (defmacro push-on-end (value location) `(setf ,location (nconc ,location (list ,value)))) From ehuelsmann at common-lisp.net Sun Jun 7 12:55:18 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 07 Jun 2009 08:55:18 -0400 Subject: [armedbear-cvs] r12001 - in tags/0.15.0: . abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Jun 7 08:54:57 2009 New Revision: 12001 Log: Create new 0.15.0 release tag. Added: tags/0.15.0/ - copied from r12000, /branches/0.15.x/ Modified: tags/0.15.0/abcl/src/org/armedbear/lisp/Version.java Modified: tags/0.15.0/abcl/src/org/armedbear/lisp/Version.java ============================================================================== --- /branches/0.15.x/abcl/src/org/armedbear/lisp/Version.java (original) +++ tags/0.15.0/abcl/src/org/armedbear/lisp/Version.java Sun Jun 7 08:54:57 2009 @@ -41,6 +41,6 @@ public static String getVersion() { - return "0.15.0-dev"; + return "0.15.0"; } } From ehuelsmann at common-lisp.net Sun Jun 7 15:32:58 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 07 Jun 2009 11:32:58 -0400 Subject: [armedbear-cvs] r12002 - tags/0.15.0/abcl Message-ID: Author: ehuelsmann Date: Sun Jun 7 11:32:50 2009 New Revision: 12002 Log: Add the release date. Modified: tags/0.15.0/abcl/CHANGES Modified: tags/0.15.0/abcl/CHANGES ============================================================================== --- tags/0.15.0/abcl/CHANGES (original) +++ tags/0.15.0/abcl/CHANGES Sun Jun 7 11:32:50 2009 @@ -1,5 +1,5 @@ Version 0.15.0 -(?? Jun, 2009) - Anticipate a June date +(07 Jun, 2009) - Anticipate a June date Summary of changes: * 2 more MOP exported symbols to support Cells port From ehuelsmann at common-lisp.net Sun Jun 7 15:56:25 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 07 Jun 2009 11:56:25 -0400 Subject: [armedbear-cvs] r12003 - public_html/staging Message-ID: Author: ehuelsmann Date: Sun Jun 7 11:56:15 2009 New Revision: 12003 Log: Update website. Modified: public_html/staging/index.shtml public_html/staging/left-menu Modified: public_html/staging/index.shtml ============================================================================== --- public_html/staging/index.shtml (original) +++ public_html/staging/index.shtml Sun Jun 7 11:56:15 2009 @@ -100,35 +100,6 @@ -
- -
- -

- Repository -

-
-
- The project's Common-Lisp.net Subversion repository can be checked - out through anonymous access with the following command: - 
-
-      $ svn co svn://common-lisp.net/project/armedbear/svn/trunk/abcl abcl
-
-
- -
-

- Installation -

-
-
- The README file in the root directory of the source distribution contains - instructions for building ABCL.
-
- -
-

Back to Common-lisp.net.

Modified: public_html/staging/left-menu ============================================================================== --- public_html/staging/left-menu (original) +++ public_html/staging/left-menu Sun Jun 7 11:56:15 2009 @@ -1,6 +1,7 @@
Project page
Testimonials +Release notes

From ehuelsmann at common-lisp.net Sun Jun 7 15:57:05 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 07 Jun 2009 11:57:05 -0400 Subject: [armedbear-cvs] r12004 - public_html/staging Message-ID: Author: ehuelsmann Date: Sun Jun 7 11:57:03 2009 New Revision: 12004 Log: Add missing line separator. Modified: public_html/staging/left-menu Modified: public_html/staging/left-menu ============================================================================== --- public_html/staging/left-menu (original) +++ public_html/staging/left-menu Sun Jun 7 11:57:03 2009 @@ -1,6 +1,6 @@
Project page
-Testimonials +Testimonials
Release notes
From ehuelsmann at common-lisp.net Sun Jun 7 21:04:59 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 07 Jun 2009 17:04:59 -0400 Subject: [armedbear-cvs] r12005 - public_html/staging Message-ID: Author: ehuelsmann Date: Sun Jun 7 17:04:51 2009 New Revision: 12005 Log: Direct link to version 0.15.0 source tar and zip distributions. Modified: public_html/staging/index.shtml Modified: public_html/staging/index.shtml ============================================================================== --- public_html/staging/index.shtml (original) +++ public_html/staging/index.shtml Sun Jun 7 17:04:51 2009 @@ -31,8 +31,8 @@ Additionally, it can be used to implement (parts of) the application using Java to Lisp integration APIs. - -Download your copy from SourceForge: 0.15.0 (zip) + +Download your copy from SourceForge: 0.15.0 (zip) Users (development with ABCL) From ehuelsmann at common-lisp.net Sun Jun 7 21:11:21 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 07 Jun 2009 17:11:21 -0400 Subject: [armedbear-cvs] r12006 - public_html/staging Message-ID: Author: ehuelsmann Date: Sun Jun 7 17:10:55 2009 New Revision: 12006 Log: Change the mailing list address. Modified: public_html/staging/index.shtml Modified: public_html/staging/index.shtml ============================================================================== --- public_html/staging/index.shtml (original) +++ public_html/staging/index.shtml Sun Jun 7 17:10:55 2009 @@ -53,7 +53,7 @@
    -
  • Mailing list
    • +
  • Mailing list
  • Mailing list access on gmane
  • Repository
  • Technical wiki
    • From ehuelsmann at common-lisp.net Sun Jun 7 21:15:31 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 07 Jun 2009 17:15:31 -0400 Subject: [armedbear-cvs] r12007 - public_html/staging Message-ID: Author: ehuelsmann Date: Sun Jun 7 17:15:29 2009 New Revision: 12007 Log: Keep the old mailing list address around. Modified: public_html/staging/index.shtml Modified: public_html/staging/index.shtml ============================================================================== --- public_html/staging/index.shtml (original) +++ public_html/staging/index.shtml Sun Jun 7 17:15:29 2009 @@ -53,7 +53,7 @@
      -
    • Mailing list
      • +
    • Mailing list and the old mailing list (abandoned)
    • Mailing list access on gmane
    • Repository
    • Technical wiki
      • From ehuelsmann at common-lisp.net Sun Jun 7 21:25:51 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 07 Jun 2009 17:25:51 -0400 Subject: [armedbear-cvs] r12008 - in public_html: . staging Message-ID: Author: ehuelsmann Date: Sun Jun 7 17:25:48 2009 New Revision: 12008 Log: Send in the new site. Added: public_html/contributing.shtml - copied unchanged from r12007, /public_html/staging/contributing.shtml public_html/faq.shtml - copied unchanged from r12007, /public_html/staging/faq.shtml public_html/index.shtml - copied unchanged from r12007, /public_html/staging/index.shtml public_html/left-menu - copied unchanged from r12007, /public_html/staging/left-menu public_html/project-name - copied unchanged from r12007, /public_html/staging/project-name public_html/release-notes-0.13.shtml - copied unchanged from r12007, /public_html/staging/release-notes-0.13.shtml public_html/release-notes-0.14.shtml - copied unchanged from r12007, /public_html/staging/release-notes-0.14.shtml public_html/release-notes-0.15.shtml - copied unchanged from r12007, /public_html/staging/release-notes-0.15.shtml public_html/style.css - copied unchanged from r12007, /public_html/staging/style.css public_html/testimonials.shtml - copied unchanged from r12007, /public_html/staging/testimonials.shtml public_html/toctool.py - copied unchanged from r12007, /public_html/staging/toctool.py Removed: public_html/staging/ From ehuelsmann at common-lisp.net Mon Jun 8 21:36:39 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 08 Jun 2009 17:36:39 -0400 Subject: [armedbear-cvs] r12009 - public_html Message-ID: Author: ehuelsmann Date: Mon Jun 8 17:36:06 2009 New Revision: 12009 Log: Add Ohloh button below the left menu. Modified: public_html/left-menu Modified: public_html/left-menu ============================================================================== --- public_html/left-menu (original) +++ public_html/left-menu Mon Jun 8 17:36:06 2009 @@ -5,6 +5,10 @@

      -J - the editor +J - the editor
      +
      +
From ehuelsmann at common-lisp.net Mon Jun 8 21:38:04 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 08 Jun 2009 17:38:04 -0400 Subject: [armedbear-cvs] r12010 - public_html Message-ID: Author: ehuelsmann Date: Mon Jun 8 17:37:59 2009 New Revision: 12010 Log: Put the button lower below the menu. Modified: public_html/left-menu Modified: public_html/left-menu ============================================================================== --- public_html/left-menu (original) +++ public_html/left-menu Mon Jun 8 17:37:59 2009 @@ -11,4 +11,6 @@ src="http://www.ohloh.net/p/16553/widgets/project_users_logo.js"> +
+
From ehuelsmann at common-lisp.net Mon Jun 8 21:40:29 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 08 Jun 2009 17:40:29 -0400 Subject: [armedbear-cvs] r12011 - public_html Message-ID: Author: ehuelsmann Date: Mon Jun 8 17:40:27 2009 New Revision: 12011 Log: Next iteration trial. Modified: public_html/left-menu Modified: public_html/left-menu ============================================================================== --- public_html/left-menu (original) +++ public_html/left-menu Mon Jun 8 17:40:27 2009 @@ -11,6 +11,6 @@ src="http://www.ohloh.net/p/16553/widgets/project_users_logo.js"> -
+
From ehuelsmann at common-lisp.net Mon Jun 8 21:41:28 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Mon, 08 Jun 2009 17:41:28 -0400 Subject: [armedbear-cvs] r12012 - public_html Message-ID: Author: ehuelsmann Date: Mon Jun 8 17:41:26 2009 New Revision: 12012 Log: Duh! (Put the div *before* the logo...) Modified: public_html/left-menu Modified: public_html/left-menu ============================================================================== --- public_html/left-menu (original) +++ public_html/left-menu Mon Jun 8 17:41:26 2009 @@ -7,10 +7,13 @@
J - the editor

+ + +
+ + -
- From ehuelsmann at common-lisp.net Wed Jun 10 19:09:35 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Wed, 10 Jun 2009 15:09:35 -0400 Subject: [armedbear-cvs] r12013 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Jun 10 15:09:32 2009 New Revision: 12013 Log: Fix Gray streams interaction with the pretty printer. Fix Gray streams STREAM-READ-SEQUENCE and STREAM-WRITE-SEQUENCE not having the same &OPTIONAL arguments as in Allegro CL. Compensate for the fact that the upperbound of a "bounding sequence designator" pair (END) may be NIL (even when supplied). Modified: trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp trunk/abcl/src/org/armedbear/lisp/pprint.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 Wed Jun 10 15:09:32 2009 @@ -195,7 +195,8 @@ (defun old-streamp (stream) - (funcall *old-streamp* stream)) + (or (xp::xp-structure-p stream) + (funcall *old-streamp* stream))) (defclass fundamental-stream ()) @@ -304,8 +305,8 @@ (defgeneric stream-force-output (stream)) (defgeneric stream-clear-output (stream)) (defgeneric stream-advance-to-column (stream column)) -(defgeneric stream-read-sequence (stream sequence start end)) -(defgeneric stream-write-sequence (stream sequence start end)) +(defgeneric stream-read-sequence (stream sequence &optional start end)) +(defgeneric stream-write-sequence (stream sequence &optional start end)) (defmethod stream-force-output (stream) (declare (ignore stream)) @@ -316,11 +317,8 @@ (defmethod stream-write-string ((stream fundamental-character-output-stream) string - &optional - (start 0) - (end (length string))) - (let ((start (or start 0)) - (end (or end (length string)))) + &optional (start 0) end) + (let ((end (or end (length string)))) (do ((i start (1+ i))) ((>= i end) string) (stream-write-char stream (char string i))))) @@ -339,10 +337,10 @@ (dotimes (i (- current column) t) (stream-write-char stream #\Space))))) -(defmethod stream-read-sequence ((stream fundamental-character-input-stream) sequence start end) - (if (null end) - (setf end (length sequence))) +(defmethod stream-read-sequence ((stream fundamental-character-input-stream) + sequence &optional (start 0) end) (let ((element-type (stream-element-type stream)) + (end (or end (length sequence))) (eof (cons nil nil))) (cond ((eq element-type 'character) @@ -359,13 +357,13 @@ (if (eq b eof) (return (+ count start))) (setf (elt sequence (+ count start)) b)))) - (t (error "Cannot READ-SEQUENCE on stream of :ELEMENT-TYPE ~A" element-type))))) + (t (error "Cannot READ-SEQUENCE on stream of :ELEMENT-TYPE ~A" + element-type))))) (defmethod stream-write-sequence ((stream fundamental-character-output-stream) - sequence start end) + sequence &optional (start 0) end) (let ((element-type (stream-element-type stream)) - (start (if start start 0)) - (end (if end end (length sequence)))) + (end (or end (length sequence)))) (if (eq element-type 'character) (do ((n start (+ n 1))) ((= n end)) @@ -645,7 +643,7 @@ (funcall *old-write-sequence* sequence stream :start start :end end) (stream-write-sequence stream sequence start end))) -(defun gray-read-sequence (sequence stream &key (start 0) (end nil)) +(defun gray-read-sequence (sequence stream &key (start 0) end) (if (old-streamp stream) (funcall *old-read-sequence* sequence stream :start start :end end) (stream-read-sequence stream sequence start end))) Modified: trunk/abcl/src/org/armedbear/lisp/pprint.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/pprint.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/pprint.lisp Wed Jun 10 15:09:32 2009 @@ -766,8 +766,9 @@ char) (defun write-string (string &optional (stream *standard-output*) - &key (start 0) (end (length string))) + &key (start 0) end) (setf stream (sys:out-synonym-of stream)) + (setf end (or end (length string))) ;; default value for end is NIL (if (xp-structure-p stream) (write-string+ string stream start end) (progn @@ -780,8 +781,9 @@ string) (defun write-line (string &optional (stream *standard-output*) - &key (start 0) (end (length string))) + &key (start 0) end) (setf stream (sys:out-synonym-of stream)) + (setf end (or end (length string))) (cond ((xp-structure-p stream) (write-string+ string stream start end) (pprint-newline+ :unconditional stream)) From ehuelsmann at common-lisp.net Wed Jun 10 21:00:43 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Wed, 10 Jun 2009 17:00:43 -0400 Subject: [armedbear-cvs] r12014 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Wed Jun 10 17:00:32 2009 New Revision: 12014 Log: Implement sane defaults for STREAM-CLEAR-INPUT, STREAM-CLEAR-OUTPUT and STREAM-TERPRI. 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 Wed Jun 10 17:00:32 2009 @@ -292,6 +292,10 @@ (return (values line nil)) (vector-push-extend character line))))))) +(defmethod stream-clear-input (stream) + (declare (ignore stream)) + nil) + (defclass fundamental-character-output-stream (fundamental-output-stream fundamental-character-stream)) @@ -300,6 +304,9 @@ (defgeneric stream-start-line-p (stream)) (defgeneric stream-write-string (stream string &optional start end)) (defgeneric stream-terpri (stream)) +(defmethod stream-terpri (stream) + (stream-write-char stream #\Newline)) + (defgeneric stream-fresh-line (stream)) (defgeneric stream-finish-output (stream)) (defgeneric stream-force-output (stream)) @@ -312,6 +319,10 @@ (declare (ignore stream)) nil) +(defmethod stream-clear-output (stream) + (declare (ignore stream)) + nil) + (defmethod stream-start-line-p ((stream fundamental-character-output-stream)) (equal (stream-line-column stream) 0)) From ehuelsmann at common-lisp.net Thu Jun 11 21:11:42 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Thu, 11 Jun 2009 17:11:42 -0400 Subject: [armedbear-cvs] r12015 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Thu Jun 11 17:11:40 2009 New Revision: 12015 Log: Stop verifying compiled files: this seriously slows down compilation. Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp 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 Thu Jun 11 17:11:40 2009 @@ -67,11 +67,14 @@ (assert nil)) (declaim (ftype (function (t) t) verify-load)) +;(defun verify-load (classfile) +; (and classfile +; (let ((*load-truename* *output-file-pathname*)) +; (report-error +; (load-compiled-function classfile))))) (defun verify-load (classfile) - (and classfile - (let ((*load-truename* *output-file-pathname*)) - (report-error - (load-compiled-function classfile))))) + (declare (ignore classfile)) + t) (declaim (ftype (function (t stream) t) process-defconstant)) (defun process-defconstant (form stream) From mevenson at common-lisp.net Sat Jun 13 14:49:08 2009 From: mevenson at common-lisp.net (Mark Evenson) Date: Sat, 13 Jun 2009 10:49:08 -0400 Subject: [armedbear-cvs] r12016 - in trunk/abcl: . test/lisp/abcl Message-ID: Author: mevenson Date: Sat Jun 13 10:48:45 2009 New Revision: 12016 Log: Fix current directory problems with ABCL Lisp-based test suite. Now the ABCL Lisp-based test suite (invoked form ant via 'ant test.abcl') reports 7 out of 228 tests failing (x64-darwin-9.7.0 on apple-jdk-1.5.0_16). Modified: trunk/abcl/abcl.asd trunk/abcl/build.xml trunk/abcl/test/lisp/abcl/package.lisp Modified: trunk/abcl/abcl.asd ============================================================================== --- trunk/abcl/abcl.asd (original) +++ trunk/abcl/abcl.asd Sat Jun 13 10:48:45 2009 @@ -52,8 +52,9 @@ (:module package :depends (abcl-rt) :pathname "test/lisp/abcl/" :components ((:file "package"))))) + (defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp)))) - "Invoke tests with: (asdf:oos 'asdf:test-op :abcl-tests :force t)." + "Invoke tests with: (asdf:oos 'asdf:test-op :abcl-test-lisp :force t)." ;;; FIXME needs ASDF:OOS to be invoked with :FORCE t (funcall (intern (symbol-name 'run) :abcl.test.lisp))) Modified: trunk/abcl/build.xml ============================================================================== --- trunk/abcl/build.xml (original) +++ trunk/abcl/build.xml Sat Jun 13 10:48:45 2009 @@ -503,7 +503,6 @@ - Recording test output in ${abcl.test.log.file}. Modified: trunk/abcl/test/lisp/abcl/package.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/package.lisp (original) +++ trunk/abcl/test/lisp/abcl/package.lisp Sat Jun 13 10:48:45 2009 @@ -3,15 +3,14 @@ (:export #:run)) (in-package #:abcl.test.lisp) -(defparameter *abcl-lisp-test-pathname* nil) - -(eval-when (:load-toplevel) - (setf *abcl-lisp-test-pathname* *load-truename*)) +(defvar *abcl-lisp-test-directory* + (pathname (directory-namestring *load-truename*)) + "The directory in which the ABCL test source files are located.") (defun run () - (progv - '(*default-pathname-defaults*) - `(,(merge-pathnames *abcl-lisp-test-pathname* *default-pathname-defaults*)) + "Run the Lisp test suite for ABCL." + + (let ((*default-pathname-defaults* *abcl-lisp-test-directory*)) (rem-all-tests) (load "test-utilities.lisp") @@ -25,9 +24,4 @@ (do-tests))) - - - - - \ No newline at end of file From ehuelsmann at common-lisp.net Sun Jun 14 15:32:56 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sun, 14 Jun 2009 11:32:56 -0400 Subject: [armedbear-cvs] r12017 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sun Jun 14 11:32:51 2009 New Revision: 12017 Log: Performance improvement for non-recursive #= and ##: In the non-recursive case it's not required to recurse into each of the branches of the structure. Modified: trunk/abcl/src/org/armedbear/lisp/boot.lisp Modified: trunk/abcl/src/org/armedbear/lisp/boot.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/boot.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/boot.lisp Sun Jun 14 11:32:51 2009 @@ -251,7 +251,7 @@ :format-control "Multiply defined label: #~D=" :format-arguments (list label))) (let* ((tag (gensym)) - (*sharp-sharp-alist* (acons label tag *sharp-sharp-alist*)) + (*sharp-sharp-alist* (cons (list label tag nil) *sharp-sharp-alist*)) (obj (read stream t nil t))) (when (eq obj tag) (error 'reader-error @@ -259,8 +259,10 @@ :format-control "Must tag something more than just #~D#" :format-arguments (list label))) (push (list label tag obj) *sharp-equal-alist*) - (let ((*sharp-equal-circle-table* (make-hash-table :test 'eq :size 20))) - (circle-subst *sharp-equal-alist* obj)))) + (when (third (car *sharp-sharp-alist*)) ;; set to T on circularity + (let ((*sharp-equal-circle-table* (make-hash-table :test 'eq :size 20))) + (circle-subst *sharp-equal-alist* obj))) + obj)) (defun sharp-sharp (stream ignore label) (declare (ignore ignore)) @@ -276,7 +278,8 @@ :stream stream :format-control "Object is not labelled #~S#" :format-arguments (list label))) - (cdr pair))))) + (setf (third pair) t) + (second pair))))) (set-dispatch-macro-character #\# #\= #'sharp-equal +standard-readtable+) (set-dispatch-macro-character #\# #\# #'sharp-sharp +standard-readtable+) From ehuelsmann at common-lisp.net Tue Jun 16 20:46:11 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Tue, 16 Jun 2009 16:46:11 -0400 Subject: [armedbear-cvs] r12018 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Tue Jun 16 16:46:06 2009 New Revision: 12018 Log: Reconstruct NaNs upon reading, if readable output is requested. Modified: trunk/abcl/src/org/armedbear/lisp/DoubleFloat.java trunk/abcl/src/org/armedbear/lisp/SingleFloat.java Modified: trunk/abcl/src/org/armedbear/lisp/DoubleFloat.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/DoubleFloat.java (original) +++ trunk/abcl/src/org/armedbear/lisp/DoubleFloat.java Tue Jun 16 16:46:06 2009 @@ -591,11 +591,18 @@ sb.append(Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.writeToString()); return sb.toString(); } - if (value != value) - return "#"; - String s1 = String.valueOf(value); + LispThread thread = LispThread.currentThread(); - if (Symbol.PRINT_READABLY.symbolValue(thread) != NIL || + boolean printReadably = Symbol.PRINT_READABLY.symbolValue(thread) != NIL; + + if (value != value) { + if (printReadably) + return "#.(progn \"Comment: create a NaN.\" (/ 0.0d0 0.0d0))"; + else + return "#"; + } + String s1 = String.valueOf(value); + if (printReadably || !memq(Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue(thread), list(Symbol.DOUBLE_FLOAT, Symbol.LONG_FLOAT))) { Modified: trunk/abcl/src/org/armedbear/lisp/SingleFloat.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/SingleFloat.java (original) +++ trunk/abcl/src/org/armedbear/lisp/SingleFloat.java Tue Jun 16 16:46:06 2009 @@ -580,11 +580,18 @@ sb.append(Symbol.SINGLE_FLOAT_NEGATIVE_INFINITY.writeToString()); return sb.toString(); } - if (value != value) - return "#"; - String s1 = String.valueOf(value); + LispThread thread = LispThread.currentThread(); - if (Symbol.PRINT_READABLY.symbolValue(thread) != NIL || + boolean printReadably = Symbol.PRINT_READABLY.symbolValue(thread) != NIL; + + if (value != value) { + if (printReadably) + return "#.(progn \"Comment: create a NaN.\" (/ 0.0s0 0.0s0))"; + else + return "#"; + } + String s1 = String.valueOf(value); + if (printReadably || !memq(Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue(thread), list(Symbol.SINGLE_FLOAT, Symbol.SHORT_FLOAT))) { From ehuelsmann at common-lisp.net Sat Jun 20 18:38:47 2009 From: ehuelsmann at common-lisp.net (Erik Huelsmann) Date: Sat, 20 Jun 2009 14:38:47 -0400 Subject: [armedbear-cvs] r12019 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Sat Jun 20 14:38:43 2009 New Revision: 12019 Log: Don't GC before returning the free amount; it clobbers the programmers' view on the state of memory. At the same time extend the information made available to the programmer; return free and maximum amounts too. This is possible because the return value of ROOM is implementation dependant. Modified: trunk/abcl/src/org/armedbear/lisp/room.java Modified: trunk/abcl/src/org/armedbear/lisp/room.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/room.java (original) +++ trunk/abcl/src/org/armedbear/lisp/room.java Sat Jun 20 14:38:43 2009 @@ -47,26 +47,9 @@ if (args.length > 1) return error(new WrongNumberOfArgumentsException(this)); Runtime runtime = Runtime.getRuntime(); - long total = 0; - long free = 0; - long maxFree = 0; - while (true) { - try { - runtime.gc(); - Thread.sleep(100); - runtime.runFinalization(); - Thread.sleep(100); - runtime.gc(); - Thread.sleep(100); - } - catch (InterruptedException e) {} - total = runtime.totalMemory(); - free = runtime.freeMemory(); - if (free > maxFree) - maxFree = free; - else - break; - } + long total = runtime.totalMemory(); + long free = runtime.freeMemory(); + long used = total - free; Stream out = getStandardOutput(); StringBuffer sb = new StringBuffer("Total memory "); @@ -81,7 +64,8 @@ sb.append(System.getProperty("line.separator")); out._writeString(sb.toString()); out._finishOutput(); - return number(used); + return LispThread.currentThread().setValues(number(used), + number(total),number(runtime.maxMemory())); } private static final Primitive ROOM = new room(); From astalla at common-lisp.net Wed Jun 24 19:07:41 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Wed, 24 Jun 2009 15:07:41 -0400 Subject: [armedbear-cvs] r12020 - trunk/abcl/src/org/armedbear/lisp/scripting/lisp Message-ID: Author: astalla Date: Wed Jun 24 15:07:33 2009 New Revision: 12020 Log: Corrected the installation and use of the throwing debugger (sys:%debugger-hook-function). Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp Wed Jun 24 15:07:33 2009 @@ -65,15 +65,12 @@ (defmacro eval-in-script-context ((global-bindings engine-bindings stdin stdout script-context) body) - "Sets up an environment in which to evaluate a piece of code coming from Java through the JSR-223 methods." + "Sets up a context in which to evaluate a piece of code coming from Java through the JSR-223 methods." (let ((actual-global-bindings (gensym)) (actual-engine-bindings (gensym))) `(let ((*package* (find-package :abcl-script-user)) (*standard-input* ,stdin) (*standard-output* ,stdout) - (*debugger-hook* (if *use-throwing-debugger* - #'sys::%debugger-hook-function - *debugger-hook*)) (,actual-global-bindings (generate-bindings ,global-bindings)) (,actual-engine-bindings (generate-bindings ,engine-bindings))) (eval `(let (,@,actual-global-bindings) Modified: trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/scripting/lisp/config.lisp Wed Jun 24 15:07:33 2009 @@ -40,11 +40,11 @@ (defparameter *use-throwing-debugger* t) (defun configure-abcl (abcl-script-engine) + (when *use-throwing-debugger* + (setf *debugger-hook* #'sys::%debugger-hook-function)) (when *launch-swank-at-startup* (unless *swank-dir* (error "Swank directory not specified, please set *swank-dir*")) - (when *use-throwing-debugger* - (setf *debugger-hook* #'sys::%debugger-hook-function)) (pushnew *swank-dir* asdf:*central-registry* :test #'equal) (asdf:oos 'asdf:load-op :swank) (ext:make-thread (lambda () (funcall (find-symbol From astalla at common-lisp.net Wed Jun 24 19:10:07 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Wed, 24 Jun 2009 15:10:07 -0400 Subject: [armedbear-cvs] r12021 - trunk/abcl/src/org/armedbear/lisp/scripting Message-ID: Author: astalla Date: Wed Jun 24 15:10:06 2009 New Revision: 12021 Log: Used javaObject.getInstance(x, true) instead of ad-hoc toLisp method which did basically the same thing. Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java Modified: trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java (original) +++ trunk/abcl/src/org/armedbear/lisp/scripting/AbclScriptEngine.java Wed Jun 24 15:10:06 2009 @@ -227,7 +227,8 @@ LispObject[] argList = new LispObject[bindings.size()]; int i = 0; for (Map.Entry entry : bindings.entrySet()) { - argList[i++] = Symbol.CONS.execute(new SimpleString(entry.getKey()), toLisp(entry.getValue())); + argList[i++] = Symbol.CONS.execute(new SimpleString(entry.getKey()), + JavaObject.getInstance(entry.getValue(), true)); } return Symbol.LIST.getSymbolFunction().execute(argList); } @@ -283,47 +284,6 @@ return new AbclScriptEngineFactory(); } - public static LispObject toLisp(Object javaObject) { - if(javaObject == null) { - return Lisp.NIL; - } else if(javaObject instanceof Boolean) { - return ((Boolean)javaObject).booleanValue() ? Lisp.T : Lisp.NIL; - } else if(javaObject instanceof Byte) { - return Fixnum.getInstance(((Byte)javaObject).intValue()); - } else if(javaObject instanceof Integer) { - return Fixnum.getInstance(((Integer)javaObject).intValue()); - } else if(javaObject instanceof Short) { - return Fixnum.getInstance(((Short)javaObject).shortValue()); - } else if(javaObject instanceof Long) { - return Bignum.getInstance((Long)javaObject); - } else if(javaObject instanceof BigInteger) { - return Bignum.getInstance((BigInteger) javaObject); - } else if(javaObject instanceof Float) { - return new SingleFloat(((Float)javaObject).floatValue()); - } else if(javaObject instanceof Double) { - return new DoubleFloat(((Double)javaObject).doubleValue()); - } else if(javaObject instanceof String) { - return new SimpleString((String)javaObject); - } else if(javaObject instanceof Character) { - return LispCharacter.getInstance((Character)javaObject); - } else if(javaObject instanceof Object[]) { - Object[] array = (Object[]) javaObject; - SimpleVector v = new SimpleVector(array.length); - for(int i = array.length; i > 0; --i) { - try { - v.aset(i, new JavaObject(array[i])); - } catch (ConditionThrowable e) { - throw new Error("Can't set SimpleVector index " + i, e); - } - } - return v; - } else if(javaObject instanceof LispObject) { - return (LispObject) javaObject; - } else { - return new JavaObject(javaObject); - } - } - @Override public T getInterface(Class clasz) { try { @@ -359,7 +319,7 @@ if(f != null && f instanceof Function) { LispObject functionAndArgs = Lisp.NIL.push(f); for(int i = 0; i < args.length; ++i) { - functionAndArgs = functionAndArgs.push(toLisp(args[i])); + functionAndArgs = functionAndArgs.push(JavaObject.getInstance(args[i], true)); } functionAndArgs = functionAndArgs.reverse(); return eval(evalFunction, functionAndArgs, getContext()); From astalla at common-lisp.net Wed Jun 24 19:14:53 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Wed, 24 Jun 2009 15:14:53 -0400 Subject: [armedbear-cvs] r12022 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: astalla Date: Wed Jun 24 15:14:51 2009 New Revision: 12022 Log: Better type conversion Lisp <-> Java for property getters/setters. Modified: trunk/abcl/src/org/armedbear/lisp/Java.java Modified: trunk/abcl/src/org/armedbear/lisp/Java.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Java.java (original) +++ trunk/abcl/src/org/armedbear/lisp/Java.java Wed Jun 24 15:14:51 2009 @@ -755,7 +755,7 @@ if(value instanceof LispObject) { return (LispObject) value; } else if(value != null) { - return JavaObject.getInstance(value); + return JavaObject.getInstance(value, true); } else { return NIL; } @@ -778,15 +778,16 @@ obj = javaObject.javaInstance(); PropertyDescriptor pd = getPropertyDescriptor(obj, propertyName); Object jValue; - if(value == NIL) { + //TODO maybe we should do this in javaInstance(Class) + if(value instanceof JavaObject) { + jValue = value.javaInstance(); + } else { if(Boolean.TYPE.equals(pd.getPropertyType()) || Boolean.class.equals(pd.getPropertyType())) { - jValue = false; + jValue = value != NIL; } else { - jValue = null; + jValue = value != NIL ? value.javaInstance() : null; } - } else { - jValue = value.javaInstance(); } pd.getWriteMethod().invoke(obj, jValue); return value; From astalla at common-lisp.net Mon Jun 29 21:12:39 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Mon, 29 Jun 2009 17:12:39 -0400 Subject: [armedbear-cvs] r12023 - in trunk/abcl/src/org/armedbear/lisp/java: . awt swing Message-ID: Author: astalla Date: Mon Jun 29 17:12:35 2009 New Revision: 12023 Log: Added simple GUI-based stream to query the user for input. Added: trunk/abcl/src/org/armedbear/lisp/java/DialogPromptStream.java (contents, props changed) trunk/abcl/src/org/armedbear/lisp/java/awt/AwtDialogPromptStream.java (contents, props changed) trunk/abcl/src/org/armedbear/lisp/java/swing/ trunk/abcl/src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java (contents, props changed) Added: trunk/abcl/src/org/armedbear/lisp/java/DialogPromptStream.java ============================================================================== --- (empty file) +++ trunk/abcl/src/org/armedbear/lisp/java/DialogPromptStream.java Mon Jun 29 17:12:35 2009 @@ -0,0 +1,75 @@ +package org.armedbear.lisp.java; + +import java.io.IOException; +import java.io.Reader; +import java.io.StringReader; +import java.io.StringWriter; + +import org.armedbear.lisp.Stream; + +/** + * A bidirectional stream that captures input from a modal dialog. The dialog reports a label (prompt line) + * which shows to the user everything that has been printed to the stream up to the moment when the dialog + * became visible. It is usable as a drop-in replacement for e.g. *debug-io*.
+ * This is an abstract class that does not depend on any GUI library. Subclasses are expected to provide + * the actual code to show the dialog and read input from the user. + * @author Alessio Stalla + * + */ +public abstract class DialogPromptStream extends Stream { + + private StringWriter writtenSoFar = new StringWriter(); + private Reader reader = new Reader() { + + private StringReader stringReader = null; + private int inputSize = 0; + + @Override + public void close() throws IOException { + closeDialog(); + } + + @Override + public int read(char[] cbuf, int off, int len) throws IOException { + if(stringReader == null) { + writtenSoFar.flush(); + String promptText = writtenSoFar.toString(); + writtenSoFar.getBuffer().delete(0, Integer.MAX_VALUE); + String inputStr = readInputFromModalDialog(promptText) + System.getProperty("line.separator", "\n"); + stringReader = new StringReader(inputStr); + inputSize = inputStr.length(); + } + int read = stringReader.read(cbuf, off, len); + if(read != -1) { + inputSize -= read; + } + if(read == -1 || inputSize == 0) { + inputSize = 0; + stringReader = null; + } + return read; + } + + }; + + /** + * Inits this stream. Should be called by subclasses' constructors. + */ + protected DialogPromptStream() { + initAsCharacterOutputStream(writtenSoFar); + initAsCharacterInputStream(reader); + } + + /** + * Closes the dialog when this stream is closed, aborting the read operation. + */ + protected abstract void closeDialog(); + + /** + * Shows the dialog and blocks the calling thread until the user has closed the dialog. + * @param promptText the text to be shown to the user (the prompt). + * @return a string holding input from the user. + */ + protected abstract String readInputFromModalDialog(String promptText); + +} Added: trunk/abcl/src/org/armedbear/lisp/java/awt/AwtDialogPromptStream.java ============================================================================== --- (empty file) +++ trunk/abcl/src/org/armedbear/lisp/java/awt/AwtDialogPromptStream.java Mon Jun 29 17:12:35 2009 @@ -0,0 +1,62 @@ +package org.armedbear.lisp.java.awt; + +import java.awt.BorderLayout; +import java.awt.Dialog; +import java.awt.FlowLayout; +import java.awt.Frame; +import java.awt.Label; +import java.awt.Panel; +import java.awt.TextField; +import java.awt.event.ActionEvent; +import java.awt.event.ActionListener; + +import javax.swing.JButton; + +import org.armedbear.lisp.java.DialogPromptStream; + +public class AwtDialogPromptStream extends DialogPromptStream { + + private Dialog dialog = new Dialog((Frame)null, true); + private Label prompt = new Label(); + private TextField input = new TextField(32); + + public AwtDialogPromptStream() { + this("Prompt"); + } + + public AwtDialogPromptStream(String title) { + super(); + dialog.setTitle(title); + Panel tmpPanel = new Panel(); + tmpPanel.add(prompt); + tmpPanel.add(input); + dialog.add(tmpPanel); + JButton okBtn = new JButton("Ok"); + okBtn.addActionListener(new ActionListener() { + + @Override + public void actionPerformed(ActionEvent e) { + synchronized(dialog) { + dialog.dispose(); + } + } + }); + tmpPanel = new Panel(new FlowLayout()); + tmpPanel.add(okBtn); + dialog.add(tmpPanel, BorderLayout.SOUTH); + } + + @Override + protected void closeDialog() { + dialog.dispose(); + } + + @Override + protected String readInputFromModalDialog(String promptText) { + prompt.setText(promptText); + dialog.pack(); + dialog.setVisible(true); + return input.getText(); + } + +} Added: trunk/abcl/src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java ============================================================================== --- (empty file) +++ trunk/abcl/src/org/armedbear/lisp/java/swing/SwingDialogPromptStream.java Mon Jun 29 17:12:35 2009 @@ -0,0 +1,62 @@ +package org.armedbear.lisp.java.swing; + +import java.awt.BorderLayout; +import java.awt.FlowLayout; +import java.awt.Frame; +import java.awt.event.ActionEvent; +import java.awt.event.ActionListener; + +import javax.swing.JButton; +import javax.swing.JDialog; +import javax.swing.JLabel; +import javax.swing.JPanel; +import javax.swing.JTextField; + +import org.armedbear.lisp.java.DialogPromptStream; + +public class SwingDialogPromptStream extends DialogPromptStream { + + private JDialog dialog = new JDialog((Frame)null, true); + private JLabel prompt = new JLabel(); + private JTextField input = new JTextField(32); + + public SwingDialogPromptStream() { + this("Prompt"); + } + + public SwingDialogPromptStream(String title) { + super(); + dialog.setTitle(title); + JPanel tmpPanel = new JPanel(); + tmpPanel.add(prompt); + tmpPanel.add(input); + dialog.add(tmpPanel); + JButton okBtn = new JButton("Ok"); + okBtn.addActionListener(new ActionListener() { + + @Override + public void actionPerformed(ActionEvent e) { + synchronized(dialog) { + dialog.dispose(); + } + } + }); + tmpPanel = new JPanel(new FlowLayout()); + tmpPanel.add(okBtn); + dialog.add(tmpPanel, BorderLayout.SOUTH); + } + + @Override + protected void closeDialog() { + dialog.dispose(); + } + + @Override + protected String readInputFromModalDialog(String promptText) { + prompt.setText(promptText); + dialog.pack(); + dialog.setVisible(true); + return input.getText(); + } + +} From astalla at common-lisp.net Mon Jun 29 21:13:54 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Mon, 29 Jun 2009 17:13:54 -0400 Subject: [armedbear-cvs] r12024 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: astalla Date: Mon Jun 29 17:13:53 2009 New Revision: 12024 Log: Added Lisp-side support for the dialog-based GUI prompt stream. Added: trunk/abcl/src/org/armedbear/lisp/gui.lisp Modified: trunk/abcl/src/org/armedbear/lisp/autoloads.lisp trunk/abcl/src/org/armedbear/lisp/compile-system.lisp Modified: trunk/abcl/src/org/armedbear/lisp/autoloads.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/autoloads.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/autoloads.lisp Mon Jun 29 17:13:53 2009 @@ -309,6 +309,13 @@ (export 'macroexpand-all) (autoload 'macroexpand-all) +(export '*gui-backend*) +(export 'init-gui) +(autoload 'init-gui "gui") +(export 'make-dialog-prompt-stream) +(autoload 'make-dialog-prompt-stream "gui") + + ;; JVM compiler. (in-package "JVM") (export '(jvm-compile-package)) Modified: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/compile-system.lisp (original) +++ trunk/abcl/src/org/armedbear/lisp/compile-system.lisp Mon Jun 29 17:13:53 2009 @@ -178,6 +178,7 @@ "find-all-symbols.lisp" "gentemp.lisp" "gray-streams.lisp" + "gui.lisp" "inline.lisp" "inspect.lisp" ;;"j.lisp" Added: trunk/abcl/src/org/armedbear/lisp/gui.lisp ============================================================================== --- (empty file) +++ trunk/abcl/src/org/armedbear/lisp/gui.lisp Mon Jun 29 17:13:53 2009 @@ -0,0 +1,20 @@ +(in-package :extensions) + +(defvar *gui-backend* :swing) + +(defun init-gui () + "Dummy function used to autoload this file" + t) + +(defun make-dialog-prompt-stream () + (%make-dialog-prompt-stream *gui-backend*)) + +(defgeneric %make-dialog-prompt-stream (gui-backend)) + +(defmethod %make-dialog-prompt-stream ((gui-backend (eql :swing))) + (java:jnew (java:jconstructor + "org.armedbear.lisp.java.swing.SwingDialogPromptStream"))) + +(defmethod %make-dialog-prompt-stream ((gui-backend (eql :awt))) + (java:jnew (java:jconstructor + "org.armedbear.lisp.java.awt.AwtDialogPromptStream"))) \ No newline at end of file From astalla at common-lisp.net Mon Jun 29 21:14:31 2009 From: astalla at common-lisp.net (Alessio Stalla) Date: Mon, 29 Jun 2009 17:14:31 -0400 Subject: [armedbear-cvs] r12025 - trunk/abcl Message-ID: Author: astalla Date: Mon Jun 29 17:14:29 2009 New Revision: 12025 Log: Modified build.xml to build the gui-based prompt stream. Modified: trunk/abcl/build.xml Modified: trunk/abcl/build.xml ============================================================================== --- trunk/abcl/build.xml (original) +++ trunk/abcl/build.xml Mon Jun 29 17:14:29 2009 @@ -44,6 +44,7 @@ + @@ -51,6 +52,7 @@ + @@ -68,14 +70,13 @@ - + - - - - + + +