[armedbear-cvs] r12028 - trunk/abcl/src/org/armedbear/lisp
Mark Evenson
mevenson at common-lisp.net
Sat Jul 4 07:59:45 UTC 2009
Author: mevenson
Date: Sat Jul 4 03:59:42 2009
New Revision: 12028
Log:
Implementation of Franz Allegro Gates MP sync primitive by Tobias Rittweiler.
See http://www.franz.com/support/documentation/8.1/doc/multiprocessing.htm#gates-1.
Added:
trunk/abcl/src/org/armedbear/lisp/Gate.java
Modified:
trunk/abcl/src/org/armedbear/lisp/Autoload.java
trunk/abcl/src/org/armedbear/lisp/BuiltInClass.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java Sat Jul 4 03:59:42 2009
@@ -489,10 +489,12 @@
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);
@@ -502,6 +504,8 @@
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);
@@ -512,6 +516,7 @@
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");
Modified: trunk/abcl/src/org/armedbear/lisp/BuiltInClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/BuiltInClass.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/BuiltInClass.java Sat Jul 4 03:59:42 2009
@@ -111,6 +111,7 @@
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);
Added: trunk/abcl/src/org/armedbear/lisp/Gate.java
==============================================================================
--- (empty file)
+++ trunk/abcl/src/org/armedbear/lisp/Gate.java Sat Jul 4 03:59:42 2009
@@ -0,0 +1,187 @@
+/*
+ * AbstractArray.java
+ *
+ * Copyright (C) 2009 Tobias Rittweiler
+ * $Id: AbstractArray.java 11711 2009-03-15 15:51:40Z ehuelsmann $
+ *
+ * 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 ms." ) {
+ @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."));
+ }
+ }
+ };
+}
+
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 Jul 4 03:59:42 2009
@@ -2843,6 +2843,8 @@
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 =
More information about the armedbear-cvs
mailing list