diff -r 5333a0a60a46 -r 2d7463c9970c CHANGES --- a/CHANGES Mon Jul 20 06:52:11 2009 +0200 +++ b/CHANGES Mon Jul 20 15:46:31 2009 +0200 @@ -1,8 +1,27 @@ Version 0.16.0 Summary of changes: - * Implementation of Franz Allegro CL Gates MP primitive (Tobias Rittweiler). - * improve performance of CLOS eql-specializers (Anton Vodonosov). + * Improve performance of CLOS eql-specializers via cache (Anton Vodonosov). * 'build-from-lisp.sh' shell script (Tobias Rittweiler). + * New threading primitives aligned with Java/JVM constructs (Erik Huselman) + + SYNCHRONIZED-ON + OBJECT-NOTIFY + OBJECT-NOTIFY-ALL + + * THREADS package created to hold threads related primitives: + + THREADP THREAD-UNLOCK THREAD-LOCK THREAD-NAME THREAD-ALIVE-P + CURRENT-THREAD DESTROY-THREAD INTERRUPT-THREAD WITH-THREAD-LOCK + MAKE-THREAD-LOCK MAKE-THREAD INTERRUPT-THREAD + + MAPCAR-THREADS + + GET-MUTEX MAKE-MUTEX WITH-MUTEX RELEASE-MUTEX + + These primitives are still part of the EXTENSIONS package but are + now to be considered as deprecated, marked to be removed with + 0.22. + Version 0.15.0 (07 Jun, 2009) diff -r 5333a0a60a46 -r 2d7463c9970c src/org/armedbear/lisp/Autoload.java --- a/src/org/armedbear/lisp/Autoload.java Mon Jul 20 06:52:11 2009 +0200 +++ b/src/org/armedbear/lisp/Autoload.java Mon Jul 20 15:46:31 2009 +0200 @@ -489,34 +489,23 @@ autoload(PACKAGE_EXT, "arglist", "arglist", true); autoload(PACKAGE_EXT, "assq", "assq", true); autoload(PACKAGE_EXT, "assql", "assql", true); - autoload(PACKAGE_EXT, "close-gate", "Gate", true); autoload(PACKAGE_EXT, "file-directory-p", "probe_file", true); autoload(PACKAGE_EXT, "gc", "gc", true); autoload(PACKAGE_EXT, "get-floating-point-modes", "FloatFunctions", true); - autoload(PACKAGE_EXT, "get-mutex", "Mutex", true); - autoload(PACKAGE_EXT, "make-gate", "Gate", true); autoload(PACKAGE_EXT, "mailbox-empty-p", "Mailbox", true); autoload(PACKAGE_EXT, "mailbox-peek", "Mailbox", true); autoload(PACKAGE_EXT, "mailbox-read", "Mailbox", true); autoload(PACKAGE_EXT, "mailbox-send", "Mailbox", true); autoload(PACKAGE_EXT, "make-mailbox", "Mailbox", true); - autoload(PACKAGE_EXT, "make-mutex", "Mutex", true); autoload(PACKAGE_EXT, "make-slime-input-stream", "SlimeInputStream", true); autoload(PACKAGE_EXT, "make-slime-output-stream", "SlimeOutputStream", true); - autoload(PACKAGE_EXT, "make-thread-lock", "ThreadLock", true); - autoload(PACKAGE_EXT, "open-gate", "Gate", true); - autoload(PACKAGE_EXT, "open-gate-p", "Gate", true); autoload(PACKAGE_EXT, "probe-directory", "probe_file", true); - autoload(PACKAGE_EXT, "release-mutex", "Mutex", true); autoload(PACKAGE_EXT, "set-floating-point-modes", "FloatFunctions", true); autoload(PACKAGE_EXT, "simple-string-fill", "StringFunctions"); autoload(PACKAGE_EXT, "simple-string-search", "StringFunctions"); autoload(PACKAGE_EXT, "string-input-stream-current", "StringInputStream", true); autoload(PACKAGE_EXT, "string-find", "StringFunctions"); autoload(PACKAGE_EXT, "string-position", "StringFunctions"); - autoload(PACKAGE_EXT, "thread-lock", "ThreadLock", true); - autoload(PACKAGE_EXT, "thread-unlock", "ThreadLock", true); - autoload(PACKAGE_EXT, "wait-open-gate", "Gate", true); autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy"); autoload(PACKAGE_JAVA, "%find-java-class", "JavaClass"); autoload(PACKAGE_JAVA, "%jmake-invocation-handler", "JProxy"); @@ -681,6 +670,13 @@ autoload(PACKAGE_SYS, "std-allocate-instance", "StandardObjectFunctions", true); autoload(PACKAGE_SYS, "zip", "zip", true); + autoload(PACKAGE_THREADS, "make-mutex", "Mutex", true); + autoload(PACKAGE_THREADS, "get-mutex", "Mutex", true); + autoload(PACKAGE_THREADS, "release-mutex", "Mutex", true); + autoload(PACKAGE_THREADS, "make-thread-lock", "ThreadLock", true); + autoload(PACKAGE_THREADS, "thread-lock", "ThreadLock", true); + autoload(PACKAGE_THREADS, "thread-unlock", "ThreadLock", true); + autoload(Symbol.COPY_LIST, "copy_list"); autoload(Symbol.SET_CHAR, "StringFunctions"); diff -r 5333a0a60a46 -r 2d7463c9970c src/org/armedbear/lisp/Gate.java --- a/src/org/armedbear/lisp/Gate.java Mon Jul 20 06:52:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,187 +0,0 @@ -/* - * Gate.java - * - * Copyright (C) 2009 Tobias Rittweiler - * $Id: Gate.java 12033 2009-07-06 09:24:59Z mevenson $ - * - * 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; - -/** - * A GATE is an object with two states, open and closed. It is - * created with MAKE-GATE. Its state can be opened (OPEN-GATE) or - * closed (CLOSE-GATE) and can be explicitly tested with - * GATE-OPEN-P. Usually though, a thread awaits the opening of a - * gate by WAIT-OPEN-GATE. - */ -final public class Gate extends LispObject -{ - private boolean open; - - private Gate(boolean open) - { - this.open = open; - } - - @Override - public LispObject typeOf() { return Symbol.GATE; } - - @Override - public LispObject classOf() { return BuiltInClass.GATE; } - - @Override - public String writeToString() { return unreadableString("GATE"); } - - @Override - public LispObject typep(LispObject typeSpecifier) - throws ConditionThrowable - { - if (typeSpecifier == Symbol.GATE) - return T; - if (typeSpecifier == BuiltInClass.GATE) - return T; - return super.typep(typeSpecifier); - } - - public boolean isOpen() { - return open; - } - - public synchronized void close() { - open = false; - } - - public synchronized void open() { - open = true; - notifyAll(); - } - - public synchronized void waitForOpen(long timeout) - throws InterruptedException - { - if (open) - return; - wait(timeout); - } - - - private static final void checkForGate(LispObject arg) - throws ConditionThrowable - { - if (arg instanceof Gate) - return; - type_error(arg, Symbol.GATE); - } - - // ### make-gate => gate - private static final Primitive MAKE_GATE - = new Primitive("make-gate", PACKAGE_EXT, true, "openp", - "Creates a gate with initial state OPENP.") { - @Override - public LispObject execute(LispObject arg) - throws ConditionThrowable - { - return new Gate(arg.getBooleanValue()); - } - }; - - // ### open-gate-p gate => generalized-boolean - private static final Primitive OPEN_GATE_P - = new Primitive("open-gate-p", PACKAGE_EXT, true, "gate", - "Boolean predicate as to whether GATE is open or not.") { - @Override - public LispObject execute(LispObject arg) - throws ConditionThrowable - { - checkForGate(arg); - return ((Gate) arg).isOpen() ? T : NIL; - } - }; - - - // ### open-gate gate => generalized-boolean - private static final Primitive OPEN_GATE - = new Primitive("open-gate", PACKAGE_EXT, true, "gate", - "Makes the state of GATE open.") - { - @Override - public LispObject execute(LispObject arg) throws ConditionThrowable - { - checkForGate(arg); - ((Gate) arg).open(); - return T; - } - }; - - // ### close-gate gate - private static final Primitive CLOSE_GATE - = new Primitive("close-gate", PACKAGE_EXT, true, "gate", - "Makes the state of GATE closed.") { - @Override - public LispObject execute(LispObject arg) - throws ConditionThrowable - { - checkForGate(arg); - ((Gate)arg).close(); - return T; - } - }; - - - // ### wait-open-gate gate - private static final Primitive WAIT_OPEN_GATE - = new Primitive("wait-open-gate", PACKAGE_EXT, true, - "gate &optional timeout", - "Wait for GATE to be open with an optional TIMEOUT in seconds." ) { - @Override - public LispObject execute(LispObject gate) - throws ConditionThrowable - { - return execute(gate, Fixnum.ZERO); - } - - @Override - public LispObject execute(LispObject gate, LispObject timeout) - throws ConditionThrowable - { - checkForGate(gate); - - long msecs = LispThread.javaSleepInterval(timeout); - try { - ((Gate)gate).waitForOpen(msecs); - return T; - } catch (InterruptedException e) { - return error(new LispError("The thread " - + LispThread.currentThread().writeToString() - + " was interrupted.")); - } - } - }; -} - diff -r 5333a0a60a46 -r 2d7463c9970c src/org/armedbear/lisp/Lisp.java --- a/src/org/armedbear/lisp/Lisp.java Mon Jul 20 06:52:11 2009 +0200 +++ b/src/org/armedbear/lisp/Lisp.java Mon Jul 20 15:46:31 2009 +0200 @@ -2,7 +2,7 @@ * Lisp.java * * Copyright (C) 2002-2007 Peter Graves - * $Id: Lisp.java 12050 2009-07-16 22:17:10Z ehuelsmann $ + * $Id: Lisp.java 12039 2009-07-11 20:58:28Z ehuelsmann $ * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -118,6 +118,7 @@ PACKAGE_LISP.usePackage(PACKAGE_CL); PACKAGE_LISP.usePackage(PACKAGE_EXT); PACKAGE_LISP.usePackage(PACKAGE_SYS); + PACKAGE_THREADS.usePackage(PACKAGE_CL); } catch (Throwable t) { diff -r 5333a0a60a46 -r 2d7463c9970c src/org/armedbear/lisp/Mutex.java --- a/src/org/armedbear/lisp/Mutex.java Mon Jul 20 06:52:11 2009 +0200 +++ b/src/org/armedbear/lisp/Mutex.java Mon Jul 20 15:46:31 2009 +0200 @@ -101,6 +101,17 @@ return unreadableString("MUTEX"); } + static { + //FIXME: this block has been added for pre-0.16 compatibility + // and can be removed the latest at release 0.22 + try { + PACKAGE_EXT.export(Symbol.intern("WITH-MUTEX", PACKAGE_THREADS)); + PACKAGE_EXT.export(Symbol.intern("WITH-THREAD-LOCK", PACKAGE_THREADS)); + } catch (ConditionThrowable t) { + Debug.bug(); + } + } + // ### make-mutex => mutex private static final Primitive MAKE_MUTEX = new Primitive("make-mutex", PACKAGE_EXT, true, "") diff -r 5333a0a60a46 -r 2d7463c9970c src/org/armedbear/lisp/ThreadLock.java --- a/src/org/armedbear/lisp/ThreadLock.java Mon Jul 20 06:52:11 2009 +0200 +++ b/src/org/armedbear/lisp/ThreadLock.java Mon Jul 20 15:46:31 2009 +0200 @@ -72,7 +72,7 @@ // ### make-thread-lock private static final Primitive MAKE_THREAD_LOCK = - new Primitive("make-thread-lock", PACKAGE_EXT, true) + new Primitive("make-thread-lock", PACKAGE_THREADS, true) { @Override public LispObject execute() throws ConditionThrowable @@ -83,7 +83,7 @@ // ### thread-lock lock private static final Primitive THREAD_LOCK = - new Primitive("thread-lock", PACKAGE_EXT, true) + new Primitive("thread-lock", PACKAGE_THREADS, true) { @Override public LispObject execute(LispObject arg) throws ConditionThrowable @@ -96,7 +96,7 @@ // ### thread-unlock lock private static final Primitive THREAD_UNLOCK = - new Primitive("thread-unlock", PACKAGE_EXT, true) + new Primitive("thread-unlock", PACKAGE_THREADS, true) { @Override public LispObject execute(LispObject arg) throws ConditionThrowable @@ -106,4 +106,16 @@ return NIL; } }; + + static { + //FIXME: this block has been added for pre-0.16 compatibility + // and can be removed the latest at release 0.22 + try { + PACKAGE_EXT.export(Symbol.intern("MAKE-THREAD-LOCK", PACKAGE_THREADS)); + PACKAGE_EXT.export(Symbol.intern("THREAD-LOCK", PACKAGE_THREADS)); + PACKAGE_EXT.export(Symbol.intern("THREAD-UNLOCK", PACKAGE_THREADS)); + } catch (ConditionThrowable t) { + Debug.bug(); + } + } } diff -r 5333a0a60a46 -r 2d7463c9970c src/org/armedbear/lisp/autoloads.lisp --- a/src/org/armedbear/lisp/autoloads.lisp Mon Jul 20 06:52:11 2009 +0200 +++ b/src/org/armedbear/lisp/autoloads.lisp Mon Jul 20 15:46:31 2009 +0200 @@ -293,15 +293,11 @@ (export '(grovel-java-definitions compile-system)) (autoload '(grovel-java-definitions compile-system) "compile-system") -(export 'with-thread-lock) -(autoload-macro 'with-thread-lock) (export 'aver) (autoload-macro 'aver) (autoload 'sys::%failed-aver "aver") (export 'collect) (autoload-macro 'collect) -(export 'with-mutex) -(autoload-macro 'with-mutex) (export 'compile-file-if-needed) (autoload 'compile-file-if-needed "compile-file") (export 'describe-compiler-policy) @@ -315,7 +311,6 @@ (export 'make-dialog-prompt-stream) (autoload 'make-dialog-prompt-stream "gui") - ;; JVM compiler. (in-package "JVM") (export '(jvm-compile-package)) @@ -324,3 +319,9 @@ (in-package "LISP") (export 'compiler-let) (autoload 'compiler-let) + +(in-package "THREADS") +(export 'with-thread-lock) +(ext:autoload-macro 'with-thread-lock) +(export 'with-mutex) +(ext:autoload-macro 'with-mutex) diff -r 5333a0a60a46 -r 2d7463c9970c src/org/armedbear/lisp/compiler-pass2.lisp diff -r 5333a0a60a46 -r 2d7463c9970c src/org/armedbear/lisp/with-mutex.lisp --- a/src/org/armedbear/lisp/with-mutex.lisp Mon Jul 20 06:52:11 2009 +0200 +++ b/src/org/armedbear/lisp/with-mutex.lisp Mon Jul 20 15:46:31 2009 +0200 @@ -29,7 +29,7 @@ ;;; obligated to do so. If you do not wish to do so, delete this ;;; exception statement from your version. -(in-package #:extensions) +(in-package #:threads) (defmacro with-mutex ((mutex) &body body) (let ((m (gensym))) diff -r 5333a0a60a46 -r 2d7463c9970c src/org/armedbear/lisp/with-thread-lock.lisp --- a/src/org/armedbear/lisp/with-thread-lock.lisp Mon Jul 20 06:52:11 2009 +0200 +++ b/src/org/armedbear/lisp/with-thread-lock.lisp Mon Jul 20 15:46:31 2009 +0200 @@ -29,7 +29,7 @@ ;;; obligated to do so. If you do not wish to do so, delete this ;;; exception statement from your version. -(in-package "EXTENSIONS") +(in-package #:threads) (defmacro with-thread-lock ((lock) &body body) (let ((glock (gensym)))