more APIs in TQueue and CThread

These are now sufficient to implement PIDE

4 files changed, 31 insertions, 0 deletions

diff --git a/lib/cThread.ml b/lib/cThread.ml
index a38c88d80..76e975d2d 100644
--- a/lib/cThread.ml
+++ b/lib/cThread.ml
@@ -34,6 +34,25 @@ let really_read_fd fd s off len =
     i := !i + r
   done
 
+let thread_friendly_really_read ic s ~off ~len =
+  try
+    let fd = Unix.descr_of_in_channel ic in
+    really_read_fd fd s off len
+  with Unix.Unix_error _ -> raise End_of_file
+
+let thread_friendly_really_read_line ic =
+  try
+    let fd = Unix.descr_of_in_channel ic in
+    let b = Buffer.create 1024 in
+    let s = String.make 1 '\000' in
+    while s <> "\n" do
+      let n = thread_friendly_read_fd fd s ~off:0 ~len:1 in
+      if n = 0 then raise End_of_file;
+      if s <> "\n" then Buffer.add_string b s;
+    done;
+    Buffer.contents b
+  with Unix.Unix_error _ -> raise End_of_file
+
 let thread_friendly_input_value ic =
   try
     let fd = Unix.descr_of_in_channel ic in
diff --git a/lib/cThread.mli b/lib/cThread.mli
index 6c635748e..ada492dd4 100644
--- a/lib/cThread.mli
+++ b/lib/cThread.mli
@@ -18,4 +18,7 @@ val prepare_in_channel_for_thread_friendly_io : in_channel -> unit
 val thread_friendly_input_value : in_channel -> 'a
 val thread_friendly_read :
   in_channel -> string -> off:int -> len:int -> int
+val thread_friendly_really_read :
+  in_channel -> string -> off:int -> len:int -> unit
+val thread_friendly_really_read_line : in_channel -> string
 
diff --git a/stm/tQueue.ml b/stm/tQueue.ml
index 783c545fd..bf55eaf77 100644
--- a/stm/tQueue.ml
+++ b/stm/tQueue.ml
@@ -42,6 +42,13 @@ let push { queue = q; lock = m; cond = c } x =
   Condition.signal c;
   Mutex.unlock m
 
+let clear { queue = q; lock = m; cond = c } =
+  Mutex.lock m;
+  Queue.clear q;
+  Mutex.unlock m
+
+let is_empty { queue = q } = Queue.is_empty q
+
 let wait_until_n_are_waiting_and_queue_empty j tq =
   Mutex.lock tq.lock;
   while not (Queue.is_empty tq.queue) || tq.nwaiting < j do
diff --git a/stm/tQueue.mli b/stm/tQueue.mli
index a3ea5532f..f3703285a 100644
--- a/stm/tQueue.mli
+++ b/stm/tQueue.mli
@@ -15,3 +15,5 @@ val push : 'a t -> 'a -> unit
 val reorder : 'a t -> ('a -> 'a -> int) -> unit
 val wait_until_n_are_waiting_and_queue_empty : int -> 'a t -> unit
 val dump : 'a t -> 'a list
+val clear : 'a t -> unit
+val is_empty : 'a t -> bool