Switch back to linked-list Squeue implementation. The speed benefit

was marginal (maybe measurement error), and the penalty for the
fixed-size queue buffers in the array implementation might become a
problem when large numbers of queues are created.

squeue.ml

@@ -22,9 +22,7 @@ type 'a t = {
     mutable capacity: int;
     nonfull: Condition.t;
     nonempty: Condition.t;
-    queue: 'a array;
+    queue: 'a Queue.t
-    mutable read_pointer: int;
-    mutable write_pointer: int;
   }
 
 let create n = {
@@ -32,9 +30,7 @@ let create n = {
   capacity = n;
   nonfull = Condition.create ();
   nonempty = Condition.create ();
-  queue = Array.make n (Obj.magic None);
+  queue = Queue.create ()
-  read_pointer = 0;
-  write_pointer = 0
 }
 
 let approx_capacity q = q.capacity
@@ -45,27 +41,17 @@ let add v q =
     Condition.wait q.nonfull q.mtx
   done;
   q.capacity <- q.capacity - 1;
-  Array.set q.queue q.write_pointer v;
+  Queue.add v q.queue;
-  q.write_pointer <- (q.write_pointer + 1) mod (Array.length q.queue);
   Condition.signal q.nonempty;
   Mutex.unlock q.mtx
 
-let _locked_empty q =
-  q.capacity = (Array.length q.queue)
-
-let _locked_pop q =
-  let result = Array.get q.queue q.read_pointer in
-  Array.set q.queue q.read_pointer (Obj.magic None);
-  q.read_pointer <- (q.read_pointer + 1) mod (Array.length q.queue);
-  q.capacity <- q.capacity + 1;
-  result
-
 let pop q =
   Mutex.lock q.mtx;
-  while _locked_empty q do
+  while Queue.is_empty q.queue do
     Condition.wait q.nonempty q.mtx
   done;
-  let result = _locked_pop q in
+  let result = Queue.pop q.queue in
+  q.capacity <- q.capacity + 1;
   Condition.signal q.nonfull;
   Mutex.unlock q.mtx;
   result
@@ -73,10 +59,11 @@ let pop q =
 let peek q =
   Mutex.lock q.mtx;
   let result =
-    if _locked_empty q
+    if Queue.is_empty q.queue
     then None
-    else (Condition.signal q.nonfull;
+    else (q.capacity <- q.capacity + 1;
-	  Some (_locked_pop q))
+	  Condition.signal q.nonfull;
+	  Some (Queue.pop q.queue))
   in
   Mutex.unlock q.mtx;
   result

squeue_array.ml

@@ -22,7 +22,9 @@ type 'a t = {
     mutable capacity: int;
     nonfull: Condition.t;
     nonempty: Condition.t;
-    queue: 'a Queue.t
+    queue: 'a array;
+    mutable read_pointer: int;
+    mutable write_pointer: int;
   }
 
 let create n = {
@@ -30,7 +32,9 @@ let create n = {
   capacity = n;
   nonfull = Condition.create ();
   nonempty = Condition.create ();
-  queue = Queue.create ()
+  queue = Array.make n (Obj.magic None);
+  read_pointer = 0;
+  write_pointer = 0
 }
 
 let approx_capacity q = q.capacity
@@ -41,17 +45,27 @@ let add v q =
     Condition.wait q.nonfull q.mtx
   done;
   q.capacity <- q.capacity - 1;
-  Queue.add v q.queue;
+  Array.set q.queue q.write_pointer v;
+  q.write_pointer <- (q.write_pointer + 1) mod (Array.length q.queue);
   Condition.signal q.nonempty;
   Mutex.unlock q.mtx
 
+let _locked_empty q =
+  q.capacity = (Array.length q.queue)
+
+let _locked_pop q =
+  let result = Array.get q.queue q.read_pointer in
+  Array.set q.queue q.read_pointer (Obj.magic None);
+  q.read_pointer <- (q.read_pointer + 1) mod (Array.length q.queue);
+  q.capacity <- q.capacity + 1;
+  result
+
 let pop q =
   Mutex.lock q.mtx;
-  while Queue.is_empty q.queue do
+  while _locked_empty q do
     Condition.wait q.nonempty q.mtx
   done;
-  let result = Queue.pop q.queue in
+  let result = _locked_pop q in
-  q.capacity <- q.capacity + 1;
   Condition.signal q.nonfull;
   Mutex.unlock q.mtx;
   result
@@ -59,11 +73,10 @@ let pop q =
 let peek q =
   Mutex.lock q.mtx;
   let result =
-    if Queue.is_empty q.queue
+    if _locked_empty q
     then None
-    else (q.capacity <- q.capacity + 1;
+    else (Condition.signal q.nonfull;
-	  Condition.signal q.nonfull;
+	  Some (_locked_pop q))
-	  Some (Queue.pop q.queue))
   in
   Mutex.unlock q.mtx;
   result