From 9be60f4711fe25b98470b20c27698ccbd8c98267 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Mon, 9 Feb 2004 17:04:36 +0000 Subject: [PATCH] thread library (actually contains just ThreadSafe module) --- helm/ocaml/thread/.cvsignore | 1 + helm/ocaml/thread/.depend | 2 + helm/ocaml/thread/Makefile | 8 +++ helm/ocaml/thread/threadSafe.ml | 98 ++++++++++++++++++++++++++++++++ helm/ocaml/thread/threadSafe.mli | 44 ++++++++++++++ 5 files changed, 153 insertions(+) create mode 100644 helm/ocaml/thread/.cvsignore create mode 100644 helm/ocaml/thread/.depend create mode 100644 helm/ocaml/thread/Makefile create mode 100644 helm/ocaml/thread/threadSafe.ml create mode 100644 helm/ocaml/thread/threadSafe.mli diff --git a/helm/ocaml/thread/.cvsignore b/helm/ocaml/thread/.cvsignore new file mode 100644 index 000000000..88689d91a --- /dev/null +++ b/helm/ocaml/thread/.cvsignore @@ -0,0 +1 @@ +*.cm[iaox] *.cmxa *.[ao] diff --git a/helm/ocaml/thread/.depend b/helm/ocaml/thread/.depend new file mode 100644 index 000000000..8838cb307 --- /dev/null +++ b/helm/ocaml/thread/.depend @@ -0,0 +1,2 @@ +threadSafe.cmo: threadSafe.cmi +threadSafe.cmx: threadSafe.cmi diff --git a/helm/ocaml/thread/Makefile b/helm/ocaml/thread/Makefile new file mode 100644 index 000000000..6a5dd3d84 --- /dev/null +++ b/helm/ocaml/thread/Makefile @@ -0,0 +1,8 @@ + +PACKAGE = thread +REQUIRES = threads +INTERFACE_FILES = threadSafe.mli +IMPLEMENTATION_FILES = $(INTERFACE_FILES:%.mli=%.ml) + +include ../Makefile.common + diff --git a/helm/ocaml/thread/threadSafe.ml b/helm/ocaml/thread/threadSafe.ml new file mode 100644 index 000000000..4be6618e7 --- /dev/null +++ b/helm/ocaml/thread/threadSafe.ml @@ -0,0 +1,98 @@ +(* + * Copyright (C) 2003-2004: + * Stefano Zacchiroli + * for the HELM Team http://helm.cs.unibo.it/ + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM 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. + * + * HELM 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 HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://helm.cs.unibo.it/ + *) + +let debug = false +let debug_print s = if debug then prerr_endline s + +class threadSafe = + object (self) + + val mutex = Mutex.create () + + (** condition variable: 'no readers is currently reading' *) + val noReaders = Condition.create () + + (** readers count *) + val mutable readersCount = 0 + + method private incrReadersCount = (* internal, not exported *) + self#doCritical (lazy ( + readersCount <- readersCount + 1 + )) + + method private decrReadersCount = (* internal, not exported *) + self#doCritical (lazy ( + if readersCount > 0 then readersCount <- readersCount - 1; + )) + + method private signalNoReaders = (* internal, not exported *) + self#doCritical (lazy ( + if readersCount = 0 then Condition.signal noReaders + )) + + method private doCritical: 'a. 'a lazy_t -> 'a = + fun action -> + debug_print ""; + (try + Mutex.lock mutex; + let res = Lazy.force action in + Mutex.unlock mutex; + debug_print ""; + res + with e -> + Mutex.unlock mutex; + raise e); + + method private doReader: 'a. 'a lazy_t -> 'a = + fun action -> + debug_print ""; + let cleanup () = + self#decrReadersCount; + self#signalNoReaders + in + self#incrReadersCount; + let res = (try Lazy.force action with e -> (cleanup (); raise e)) in + cleanup (); + debug_print ""; + res + + (* TODO may starve!!!! is what we want or not? *) + method private doWriter: 'a. 'a lazy_t -> 'a = + fun action -> + debug_print ""; + self#doCritical (lazy ( + while readersCount > 0 do + Condition.wait noReaders mutex + done; + let res = Lazy.force action in + debug_print ""; + res + )) + + end + diff --git a/helm/ocaml/thread/threadSafe.mli b/helm/ocaml/thread/threadSafe.mli new file mode 100644 index 000000000..0023c89e6 --- /dev/null +++ b/helm/ocaml/thread/threadSafe.mli @@ -0,0 +1,44 @@ +(* + * Copyright (C) 2003-2004: + * Stefano Zacchiroli + * for the HELM Team http://helm.cs.unibo.it/ + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM 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. + * + * HELM 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 HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://helm.cs.unibo.it/ + *) + +class threadSafe: + object + + (** execute 'action' in mutual exclusion between all other threads *) + method private doCritical: 'a lazy_t -> 'a + + (** execute 'action' acting as a 'reader' i.e.: multiple readers can act + at the same time but no writer can act until no readers are acting *) + method private doReader: 'a lazy_t -> 'a + + (** execute 'action' acting as a 'writer' i.e.: when a writer is acting, + no readers or writer can act, beware that writers can starve *) + method private doWriter: 'a lazy_t -> 'a + + end + -- 2.39.2