Move additional symbols into THREADS package.

The symbols

  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

have been moved from EXTENSIONS into THREADS.

These primitives are still part of the EXTENSIONS package but are now
to be considered as deprecated, marked to be removed with 0.22.
parent 4264d9fd
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)
......
......@@ -489,34 +489,23 @@ public class Autoload extends Function
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 @@ public class Autoload extends Function
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");
......
......@@ -111,7 +111,6 @@ public class BuiltInClass extends LispClass
public static final BuiltInClass MAILBOX = addClass(Symbol.MAILBOX);
public static final BuiltInClass METHOD_COMBINATION = addClass(Symbol.METHOD_COMBINATION);
public static final BuiltInClass MUTEX = addClass(Symbol.MUTEX);
public static final BuiltInClass GATE = addClass(Symbol.GATE);
public static final BuiltInClass NIL_VECTOR = addClass(Symbol.NIL_VECTOR);
public static final BuiltInClass NULL = addClass(Symbol.NULL);
public static final BuiltInClass NUMBER = addClass(Symbol.NUMBER);
......
/*
* Gate.java
*
* Copyright (C) 2009 Tobias Rittweiler
* $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;
/**
* 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."));
}
}
};
}
......@@ -118,6 +118,7 @@ public abstract class Lisp
PACKAGE_LISP.usePackage(PACKAGE_CL);
PACKAGE_LISP.usePackage(PACKAGE_EXT);
PACKAGE_LISP.usePackage(PACKAGE_SYS);
PACKAGE_THREADS.usePackage(PACKAGE_CL);
}
catch (Throwable t)
{
......
......@@ -101,6 +101,17 @@ public final class Mutex extends LispObject
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, "")
......
......@@ -2891,8 +2891,6 @@ public class Symbol extends LispObject
PACKAGE_EXT.addExternalSymbol("COMPILER-UNSUPPORTED-FEATURE-ERROR");
public static final Symbol MUTEX =
PACKAGE_EXT.addExternalSymbol("MUTEX");
public static final Symbol GATE =
PACKAGE_EXT.addExternalSymbol("GATE");
public static final Symbol THREAD =
PACKAGE_EXT.addExternalSymbol("THREAD");
public static final Symbol SUPPRESS_COMPILER_WARNINGS =
......
......@@ -72,7 +72,7 @@ public final class ThreadLock extends LispObject
// ### 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 @@ public final class ThreadLock extends LispObject
// ### 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 @@ public final class ThreadLock extends LispObject
// ### 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 @@ public final class ThreadLock extends LispObject
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();
}
}
}
......@@ -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)
......@@ -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)))
......
......@@ -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)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment