1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
From: Stephane Glondu <[email protected]>
Date: Fri, 9 Aug 2024 04:06:08 0200
Subject: Fix compilation with OCaml 5.2.0
Bug-Debian: https://bugs.debian.org/1073876
---
Makefile.template | 2 -
src/Makefile | 7 --
src/cothread.mli | 3 ---
src/process/Makefile | 2 -
src/process/coordinator.ml | 2 -
src/process/cothread.ml | 2 -
src/process/mutex.ml | 12
src/process/stm.ml | 4 --
src/process/thread.mli | 9 ---------
src/threads/cothread.ml | 4 --
10 files changed, 25 insertions( ), 22 deletions(-)
diff --git a/Makefile.template b/Makefile.template
index b2af8f1..8c8209a 100644
--- a/Makefile.template
b/Makefile.template
@@ -16,7 16,7 @@ OCAMLDOC = ocamldoc
OCAMLSTDLIBPATH = $(shell $(OCAMLC) -where)
-INCLUDES= # all relevant -I options here
INCLUDES=-I unix # all relevant -I options here
OCAMLCFLAGS=$(INCLUDES) # add other options for ocamlc here
OCAMLOPTFLAGS=$(INCLUDES) # add other options for ocamlopt here
diff --git a/src/Makefile b/src/Makefile
index 3b3ec76..f7d77d7 100644
--- a/src/Makefile
b/src/Makefile
@@ -18,9 18,12 @@ EXTRAMODINTFCOM = $(EXTRAMOD:%=%.cmi)
INSTALLFILES = $(COMMONMODINTFCOM) $(EXTRAMODINTFSRC) $(EXTRAMODINTFCOM)
-OCAMLTHREADLIB = $(if $(wildcard $(OCAMLSTDLIBPATH)/mutex.mli),$(OCAMLSTDLIBPATH),$(OCAMLSTDLIBPATH)/threads)
OCAMLTHREADLIB = $(OCAMLSTDLIBPATH)/threads
-$(COMMONMODINTFSRC): %: $(OCAMLTHREADLIB)/%
mutex.mli condition.mli: %: $(OCAMLSTDLIBPATH)/%
@if [ ! -L $@ ]; then ln -s $< .; fi
$(filter-out mutex.mli condition.mli,$(COMMONMODINTFSRC)): %: $(OCAMLTHREADLIB)/%
@if [ ! -L $@ ]; then ln -s $< .; fi
.PHONY: all install clean uninstall sub%
diff --git a/src/cothread.mli b/src/cothread.mli
index 464fec0..0b839c3 100644
--- a/src/cothread.mli
b/src/cothread.mli
@@ -11,11 11,8 @@ val create : ('a -> 'b) -> 'a -> t
val self : unit -> t
val id : t -> int
val exit : unit -> unit
-val kill : t -> unit
val delay: float -> unit
val join : t -> unit
-val wait_read : Unix.file_descr -> unit
-val wait_write : Unix.file_descr -> unit
val wait_timed_read : Unix.file_descr -> float -> bool
val wait_timed_write : Unix.file_descr -> float -> bool
val select :
diff --git a/src/process/Makefile b/src/process/Makefile
index 7677423..2dd47e6 100644
--- a/src/process/Makefile
b/src/process/Makefile
@@ -1,6 1,6 @@
include ../../Makefile.template
-INCLUDES = -I ..
INCLUDES = -I unix -I ..
BACKEND = process
diff --git a/src/process/coordinator.ml b/src/process/coordinator.ml
index 97419f2..a1140e9 100644
--- a/src/process/coordinator.ml
b/src/process/coordinator.ml
@@ -16,7 16,7 @@ let dir_perm = 0o700
let work_dir_name = "cothread"
let work_dir =
- let name = Filename.concat Filename.temp_dir_name work_dir_name in
let name = Filename.concat (Filename.get_temp_dir_name ()) work_dir_name in
(try mkdir name dir_perm with Unix_error (EEXIST,_,_) -> ());
name
diff --git a/src/process/cothread.ml b/src/process/cothread.ml
index 0fa32de..bec0bda 100644
--- a/src/process/cothread.ml
b/src/process/cothread.ml
@@ -6,7 6,7 @@ type t = thread
let self = self
let id = id
-let exit () = Pervasives.exit 0
let exit () = Stdlib.exit 0
let kill = signal Sys.sigterm
let create f x =
diff --git a/src/process/mutex.ml b/src/process/mutex.ml
index b729546..e9785f4 100644
--- a/src/process/mutex.ml
b/src/process/mutex.ml
@@ -25,6 25,18 @@ let unlock lk =
if lk <> lseek lock_fd lk SEEK_SET then assert false;
lockf lock_fd F_ULOCK 1
external reraise : exn -> 'a = "%reraise"
(* cannot inline, otherwise flambda might move code around. *)
let[@inline never] protect m f =
lock m;
match f() with
| x ->
unlock m; x
| exception e ->
(* NOTE: [unlock] does not poll for asynchronous exceptions *)
unlock m;
reraise e
diff --git a/src/process/stm.ml b/src/process/stm.ml
index 25bf25a..069da75 100644
--- a/src/process/stm.ml
b/src/process/stm.ml
@@ -5,8 5,8 @@ let stm_magic = "STM2007MTS"
type tvid = string * int * int and version = int and value = Obj.t
-module TvMap = Map_Make (struct type t = tvid let compare = Pervasives.compare end)
-module TvSet = Set.Make (struct type t = tvid let compare = Pervasives.compare end)
module TvMap = Map_Make (struct type t = tvid let compare = Stdlib.compare end)
module TvSet = Set.Make (struct type t = tvid let compare = Stdlib.compare end)
type tv_repr = {version: version; value: value; ref_to: TvSet.t}
diff --git a/src/process/thread.mli b/src/process/thread.mli
index 6c432d5..2d0536d 100644
--- a/src/process/thread.mli
b/src/process/thread.mli
@@ -43,9 43,6 @@ val id : t -> int
val exit : unit -> unit
(** Terminate prematurely the currently executing thread. *)
-val kill : t -> unit
-(** Terminate prematurely the thread whose handle is given. *)
-
(** {6 Suspending threads} *)
val delay: float -> unit
@@ -57,12 54,6 @@ val join : t -> unit
(** [join th] suspends the execution of the calling thread
until the thread [th] has terminated. *)
-val wait_read : Unix.file_descr -> unit
-(** See {!Thread.wait_write}.*)
-
-val wait_write : Unix.file_descr -> unit
-(** This function does nothing in this implementation. *)
-
val wait_timed_read : Unix.file_descr -> float -> bool
(** See {!Thread.wait_timed_read}.*)
diff --git a/src/threads/cothread.ml b/src/threads/cothread.ml
index 6e384ce..6e13a9c 100644
--- a/src/threads/cothread.ml
b/src/threads/cothread.ml
@@ -19,6 19,6 @@ let spawnl f x =
let ch = Event.new_channel () in
let thread_fun () = Event.sync (Event.send ch (f x)) in
let launch () =
- let worker = Thread.create thread_fun () in
- Event.wrap_abort (Event.receive ch) (fun () -> Thread.kill worker) in
let _worker = Thread.create thread_fun () in
Event.wrap_abort (Event.receive ch) (fun () -> invalid_arg "kill") in
Event.guard launch
|
