new files

Task/Checkpoint-synchronization/0DESCRIPTION

@@ -0,0 +1,11 @@
+The checkpoint synchronization is a problem of synchronizing multiple [[task]]s. Consider a workshop where several workers ([[task]]s) assembly details of some mechanism. When each of them completes his work they put the details together. There is no store, so a worker who finished its part first must wait for others before starting another one. Putting details together is the ''checkpoint'' at which [[task]]s synchronize themselves before going their paths apart.
+
+'''The task'''
+
+Implement checkpoint synchronization in your language.
+
+Make sure that the solution is [[Race condition|race condition]]-free. Note that a straightforward solution based on [[event]]s is exposed to [[Race condition|race condition]]. Let two [[task]]s A and B need to be synchronized at a checkpoint. Each signals its event (''EA'' and ''EB'' correspondingly), then waits for the AND-combination of the events (''EA''&''EB'') and resets its event. Consider the following scenario: A signals ''EA'' first and gets blocked waiting for ''EA''&''EB''. Then B signals ''EB'' and loses the processor. Then A is released (both events are signaled) and resets ''EA''. Now if B returns and enters waiting for ''EA''&''EB'', it gets lost.
+
+When a worker is ready it shall not continue before others finish. A typical implementation bug is when a worker is counted twice within one working cycle causing its premature completion. This happens when the quickest worker serves its cycle two times while the laziest one is lagging behind.
+
+If you can, implement workers joining and leaving.

Task/Checkpoint-synchronization/1META.yaml

@@ -0,0 +1,6 @@
+---
+category:
+- Classic CS problems and programs
+note: Concurrency
+requires:
+- Concurrency

Task/Checkpoint-synchronization/Ada/checkpoint-synchronization.ada

@@ -0,0 +1,101 @@
+with Ada.Calendar;               use Ada.Calendar;
+with Ada.Numerics.Float_Random;
+with Ada.Text_IO;                use Ada.Text_IO;
+
+procedure Test_Checkpoint is
+
+   package FR renames Ada.Numerics.Float_Random;
+   No_Of_Cubicles: constant Positive := 3;
+     -- That many workers can work in parallel
+   No_Of_Workers: constant Positive := 6;
+     -- That many workers are potentially available
+     -- some will join the team when others quit the job
+
+   type Activity_Array is array(Character) of Boolean;
+     -- we want to know who is currently working
+
+   protected Checkpoint is
+      entry Deliver;
+      entry Join (Label : out Character; Tolerance: out Float);
+      entry Leave(Label : in Character);
+   private
+      Signaling     : Boolean   := False;
+      Ready_Count   : Natural   := 0;
+      Worker_Count  : Natural   := 0;
+      Unused_Label  : Character := 'A';
+      Likelyhood_To_Quit: Float := 1.0;
+      Active        : Activity_Array := (others => false);
+      entry Lodge;
+   end Checkpoint;
+
+   protected body Checkpoint is
+      entry Join (Label : out Character; Tolerance: out Float)
+      when not Signaling and Worker_Count < No_Of_Cubicles is
+      begin
+         Label        := Unused_Label;
+         Active(Label):= True;
+         Unused_Label := Character'Succ (Unused_Label);
+         Worker_Count := Worker_Count + 1;
+         Likelyhood_To_Quit := Likelyhood_To_Quit / 2.0;
+         Tolerance    := Likelyhood_To_Quit;
+      end Join;
+
+      entry Leave(Label: in Character) when not Signaling is
+      begin
+         Worker_Count  := Worker_Count - 1;
+         Active(Label) := False;
+      end Leave;
+
+      entry Deliver when not Signaling is
+      begin
+         Ready_Count := Ready_Count + 1;
+         requeue Lodge;
+      end Deliver;
+
+      entry Lodge when Ready_Count = Worker_Count or Signaling is
+      begin
+         if Ready_Count = Worker_Count then
+            Put("---Sync Point [");
+            for C in Character loop
+               if Active(C) then
+                  Put(C);
+               end if;
+            end loop;
+            Put_Line("]---");
+         end if;
+         Ready_Count := Ready_Count - 1;
+         Signaling   := Ready_Count /= 0;
+      end Lodge;
+   end Checkpoint;
+
+   task type Worker;
+
+   task body Worker is
+      Dice      : FR.Generator;
+      Label     : Character;
+      Tolerance : Float;
+      Shift_End : Time := Clock + 2.0;
+        -- Trade unions are hard!
+   begin
+      FR.Reset (Dice);
+      Checkpoint.Join (Label, Tolerance);
+      Put_Line(Label & " joins the team");
+      loop
+         Put_Line (Label & " is working");
+         delay Duration (FR.Random (Dice) * 0.500);
+         Put_Line (Label & " is ready");
+         Checkpoint.Deliver;
+         if FR.Random(Dice) < Tolerance then
+            Put_Line(Label & " leaves the team");
+            exit;
+         elsif Clock >= Shift_End then
+            Put_Line(Label & " ends shift");
+            exit;
+         end if;
+      end loop;
+      Checkpoint.Leave(Label);
+   end Worker;
+   Set : array (1..No_Of_Workers) of Worker;
+begin
+   null; -- Nothing to do here
+end Test_Checkpoint;

Task/Checkpoint-synchronization/C/checkpoint-synchronization.c

@@ -0,0 +1,31 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <omp.h>
+
+int main()
+{
+        int jobs = 41, tid;
+        omp_set_num_threads(5);
+
+        #pragma omp parallel shared(jobs) private(tid)
+        {
+                tid = omp_get_thread_num();
+                while (jobs > 0) {
+                        /* this is the checkpoint */
+                        #pragma omp barrier
+                        if (!jobs) break;
+
+                        printf("%d: taking job %d\n", tid, jobs--);
+                        usleep(100000 + rand() / (double) RAND_MAX * 3000000);
+                        printf("%d: done job\n", tid);
+                }
+
+                printf("[%d] leaving\n", tid);
+
+                /* this stops jobless thread from exiting early and killing workers */
+                #pragma omp barrier
+        }
+
+        return 0;
+}

Task/Checkpoint-synchronization/Go/checkpoint-synchronization.go

@@ -0,0 +1,68 @@
+package main
+
+import (
+    "log"
+    "math/rand"
+    "os"
+    "sync"
+    "time"
+)
+
+const nMech = 5
+const detailsPerMech = 4
+
+var l = log.New(os.Stdout, "", 0)
+
+func main() {
+    assemble := make(chan int)
+    var complete sync.WaitGroup
+
+    go solicit(assemble, &complete, nMech*detailsPerMech)
+
+    for i := 1; i <= nMech; i++ {
+        complete.Add(detailsPerMech)
+        for j := 0; j < detailsPerMech; j++ {
+            assemble <- 0
+        }
+        // Go checkpoint feature
+        complete.Wait()
+        // checkpoint reached
+        l.Println("mechanism", i, "completed")
+    }
+}
+
+func solicit(a chan int, c *sync.WaitGroup, nDetails int) {
+    rand.Seed(time.Now().UnixNano())
+    var id int // worker id, for output
+    for nDetails > 0 {
+        // some random time to find a worker
+        time.Sleep(time.Duration(5e8 + rand.Int63n(5e8)))
+        id++
+        // contract to assemble a certain number of details
+        contract := rand.Intn(5) + 1
+        if contract > nDetails {
+            contract = nDetails
+        }
+        dword := "details"
+        if contract == 1 {
+            dword = "detail"
+        }
+        l.Println("worker", id, "contracted to assemble", contract, dword)
+        go worker(a, c, contract, id)
+        nDetails -= contract
+    }
+}
+
+func worker(a chan int, c *sync.WaitGroup, contract, id int) {
+    // some random time it takes for this worker to assemble a detail
+    assemblyTime := time.Duration(5e8 + rand.Int63n(5e8))
+    l.Println("worker", id, "enters shop")
+    for i := 0; i < contract; i++ {
+        <-a
+        l.Println("worker", id, "assembling")
+        time.Sleep(assemblyTime)
+        l.Println("worker", id, "completed detail")
+        c.Done()
+    }
+    l.Println("worker", id, "leaves shop")
+}

Task/Checkpoint-synchronization/Haskell/checkpoint-synchronization-1.hs

@@ -0,0 +1,82 @@
+import Control.Parallel
+
+data Task a = Idle | Make a
+type TaskList a = [a]
+type Results a = [a]
+type TaskGroups a = [TaskList a]
+type WorkerList a = [Worker a]
+type Worker a = [Task a]
+
+-- run tasks in parallel and collect their results
+-- the function doesn't return until all tasks are done, therefore
+-- finished threads wait for the others to finish.
+runTasks :: TaskList a -> Results a
+runTasks [] = []
+runTasks (x:[]) = x : []
+runTasks (x:y:[]) = y `par` x : y : []
+runTasks (x:y:ys) = y `par` x : y : runTasks ys
+
+-- take a list of workers with different numbers of tasks and group
+-- them: first the first task of each worker, then the second one etc.
+groupTasks :: WorkerList a -> TaskGroups a
+groupTasks [] = []
+groupTasks xs
+    | allWorkersIdle xs = []
+    | otherwise =
+        concatMap extractTask xs : groupTasks (map removeTask xs)
+
+-- return a task as a plain value
+extractTask :: Worker a -> [a]
+extractTask [] = []
+extractTask (Idle:_) = []
+extractTask (Make a:_) = [a]
+
+-- remove the foremost task of each worker
+removeTask :: Worker a -> Worker a
+removeTask = drop 1
+
+-- checks whether all workers are idle in this task
+allWorkersIdle :: WorkerList a -> Bool
+allWorkersIdle = all null . map extractTask
+
+-- the workers must calculate big sums. the first sum of each worker
+-- belongs to the first task, and so on.
+-- because of laziness, nothing is computed yet.
+
+-- worker1 has 5 tasks to do
+worker1 :: Worker Integer
+worker1 = map Make [ sum [1..n*1000000] | n <- [1..5] ]
+
+-- worker2 has 4 tasks to do
+worker2 :: Worker Integer
+worker2 = map Make [ sum [1..n*100000] | n <- [1..4] ]
+
+-- worker3 has 3 tasks to do
+worker3 :: Worker Integer
+worker3 = map Make [ sum [1..n*1000000] | n <- [1..3] ]
+
+-- worker4 has 5 tasks to do
+worker4 :: Worker Integer
+worker4 = map Make [ sum [1..n*300000] | n <- [1..5] ]
+
+-- worker5 has 4 tasks to do, but starts at the second task.
+worker5 :: Worker Integer
+worker5 = [Idle] ++ map Make [ sum [1..n*400000] | n <- [1..4] ]
+
+-- group the workers' tasks
+tasks :: TaskGroups Integer
+tasks = groupTasks [worker1, worker2, worker3, worker4, worker5]
+
+-- a workshop: take a function to operate the results and a group of tasks,
+-- execute the tasks showing the process and process the results
+workshop :: (Show a, Num a, Show b, Num b) => ([a] -> b) -> [[a]] -> IO ()
+workshop func a = mapM_ doWork $ zip [1..length a] a
+    where
+        doWork (x, y) = do
+            putStrLn $ "Doing task " ++ show x ++ "."
+            putStrLn $ "There are " ++ show (length y) ++ " workers for this task."
+            putStrLn "Waiting for all workers..."
+            print $ func $ runTasks y
+            putStrLn $ "Task " ++ show x ++ " done."
+
+main = workshop sum tasks

Task/Checkpoint-synchronization/Haskell/checkpoint-synchronization-2.hs

@@ -0,0 +1,112 @@
+import Control.Concurrent
+import Control.Monad        -- needed for "forM", "forM_"
+
+-- (workers working, workers done, workers total)
+type Workshop = MVar (Int, Int, Int)
+-- list of IO actions to be performed by one worker
+type Actions = [IO ()]
+
+newWorkshop :: IO Workshop
+newWorkshop = newMVar (0, 0, 0)
+
+-- check point: workers wait here for the other workers to
+-- finish, before resuming execution/restarting
+checkPoint :: Workshop -> IO ()
+checkPoint w = do
+    (working, done, count) <- takeMVar w
+    -- all workers are done: reset counters and return (threads
+    -- resume execution or restart)
+    if working <= 0 && done == count
+    then do
+            putStrLn "---- Check Point"
+            putMVar w (0, 0, count)
+    -- mvar was just initialized: do nothing, just return.
+    -- otherwise, a race condition may arise
+    else if working == 0 && done == 0
+            then putMVar w (working, done, count)
+    -- workers are still working: wait for them (loop)
+    else do
+            putMVar w (working, done, count)
+            checkPoint w
+
+-- join the workshop
+addWorker :: Workshop -> ThreadId -> IO ()
+addWorker w i = do
+    (working, done, count) <- takeMVar w
+    putStrLn $ "Worker " ++ show i ++ " has joined the group."
+    putMVar w (working, done, count + 1)
+
+-- leave the workshop
+removeWorker :: Workshop -> ThreadId -> IO ()
+removeWorker w i = do
+    (working, done, count) <- takeMVar w
+    putStrLn $ "Worker " ++ show i ++ " has left the group."
+    putMVar w (working, done, count - 1)
+
+-- increase the number of workers doing something.
+-- optionally, print a message using the thread's ID
+startWork :: Workshop -> ThreadId -> IO ()
+startWork w i = do
+    (working, done, count) <- takeMVar w
+    putStrLn $ "Worker " ++ show i ++ " has started."
+    putMVar w (working + 1, done, count)
+
+-- decrease the number of workers doing something and increase the
+-- number of workers done. optionally, print a message using
+-- the thread's ID
+finishWork :: Workshop -> ThreadId -> IO ()
+finishWork w i = do
+    (working, done, count) <- takeMVar w
+    putStrLn $ "Worker " ++ show i ++ " is ready."
+    putMVar w (working - 1, done + 1, count)
+
+-- put a worker to do his tasks. the steps are:
+-- 1. join the workshop "w"
+-- 2. report that the worker has started an action
+-- 3. perform one action
+-- 4. report that the worker is ready for the next action
+-- 5. wait for the other workers to finish
+-- 6. repeat from 2 until the worker has nothing more to do
+-- 7. leave the workshop
+worker :: Workshop -> Actions -> IO ()
+worker w actions = do
+    i <- myThreadId
+    addWorker w i
+    forM_ actions $ \action -> do
+        startWork w i
+        action
+        finishWork w i
+        checkPoint w
+    removeWorker w i
+
+-- launch several worker threads. their thread ID's are returned
+shop :: Workshop -> [Actions] -> IO [ThreadId]
+shop w actions = do
+    forM actions $ \x -> forkIO (worker w x)
+
+main = do
+    -- make a workshop
+    w <- newWorkshop
+
+    -- the workers won't be doing anything special, just wait for n
+    -- regular intervals. pids gathers the ID's of the threads
+
+    -- this are the first workers joining the workshop
+    pids1 <- shop w
+        [replicate 5 $ threadDelay 1300000
+        ,replicate 10 $ threadDelay 759191
+        ,replicate 7 $ threadDelay 965300]
+
+    -- wait for 5 secs before the next workers join
+    threadDelay 5000000
+
+    -- these are other workers that join the workshop later
+    pids2 <- shop w
+        [replicate 6 $ threadDelay 380000
+        ,replicate 4 $ threadDelay 250000]
+
+    -- wait for a key press
+    getChar
+
+    -- kill all worker threads before exit, if they're still running
+    forM_ (pids1 ++ pids2) killThread

Task/Checkpoint-synchronization/Java/checkpoint-synchronization-1.java

@@ -0,0 +1,89 @@
+import java.util.Scanner;
+import java.util.Random;
+
+public class CheckpointSync{
+	public static void main(String[] args){
+		System.out.print("Enter number of workers to use: ");
+		Scanner in = new Scanner(System.in);
+		Worker.nWorkers = in.nextInt();
+		System.out.print("Enter number of tasks to complete:");
+		runTasks(in.nextInt());
+	}
+	
+	/*
+	 * Informs that workers started working on the task and
+	 * starts running threads. Prior to proceeding with next
+	 * task syncs using static Worker.checkpoint() method.
+	 */
+	private static void runTasks(int nTasks){
+		for(int i = 0; i < nTasks; i++){
+			System.out.println("Starting task number " + (i+1) + ".");
+			runThreads();
+			Worker.checkpoint();
+		}
+	}
+	
+	/*
+	 * Creates a thread for each worker and runs it.
+	 */
+	private static void runThreads(){
+		for(int i = 0; i < Worker.nWorkers; i ++){
+			new Thread(new Worker(i+1)).start();
+		}
+	}
+	
+	/*
+	 * Worker inner static class.
+	 */
+	public static class Worker implements Runnable{
+		public Worker(int threadID){
+			this.threadID = threadID;
+		}
+		public void run(){
+			work();
+		}
+		
+		/*
+		 *  Notifies that thread started running for 100 to 1000 msec.
+		 *  Once finished increments static counter 'nFinished'
+		 *  that counts number of workers finished their work.
+		 */
+		private synchronized void work(){
+			try {
+				int workTime = rgen.nextInt(900) + 100;
+				System.out.println("Worker " + threadID + " will work for " + workTime + " msec.");
+				Thread.sleep(workTime); //work for 'workTime'
+				nFinished++; //increases work finished counter
+				System.out.println("Worker " + threadID + " is ready");
+			} catch (InterruptedException e) {
+				System.err.println("Error: thread execution interrupted");
+				e.printStackTrace();
+			}
+		}
+		
+		/*
+		 * Used to synchronize Worker threads using 'nFinished' static integer.
+		 * Waits (with step of 10 msec) until 'nFinished' equals to 'nWorkers'.
+		 * Once they are equal resets 'nFinished' counter.
+		 */
+		public static synchronized void checkpoint(){
+			while(nFinished != nWorkers){
+				try {
+					Thread.sleep(10);
+				} catch (InterruptedException e) {
+					System.err.println("Error: thread execution interrupted");
+					e.printStackTrace();
+				}
+			}
+			nFinished = 0;
+		}
+	
+		/* inner class instance variables */
+		private int threadID;
+		
+		/* static variables */
+		private static Random rgen = new Random();
+		private static int nFinished = 0;
+		public static int nWorkers = 0;
+	}
+}

Task/Checkpoint-synchronization/Java/checkpoint-synchronization-2.java

@@ -0,0 +1,48 @@
+import java.util.Random;
+import java.util.concurrent.CountDownLatch;
+
+public class Sync {
+	static class Worker implements Runnable {
+		private final CountDownLatch doneSignal;
+		private int threadID;
+
+		public Worker(int id, CountDownLatch doneSignal) {
+			this.doneSignal = doneSignal;
+			threadID = id;
+		}
+
+		public void run() {
+			doWork();
+			doneSignal.countDown();
+		}
+
+		void doWork() {
+			try {
+				int workTime = new Random().nextInt(900) + 100;
+				System.out.println("Worker " + threadID + " will work for " + workTime + " msec.");
+				Thread.sleep(workTime); //work for 'workTime'
+				System.out.println("Worker " + threadID + " is ready");
+			} catch (InterruptedException e) {
+				System.err.println("Error: thread execution interrupted");
+				e.printStackTrace();
+			}
+		}
+	}
+
+	public static void main(String[] args) {
+		int n = 3;//6 workers and 3 tasks
+		for(int task = 1; task <= n; task++) {
+			CountDownLatch latch = new CountDownLatch(n * 2);
+			System.out.println("Starting task " + task);
+			for(int worker = 0; worker < n * 2; worker++) {
+				new Thread(new Worker(worker, latch)).start();
+			}
+			try {
+				latch.await();//wait for n*2 threads to signal the latch
+			} catch (InterruptedException e) {
+				e.printStackTrace();
+			}
+			System.out.println("Task " + task + " complete");
+		}
+	}
+}

Task/Checkpoint-synchronization/Perl/checkpoint-synchronization.pl

@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use v5.10;
+
+use Socket;
+
+my $nr_items = 3;
+
+sub short_sleep($) {
+    (my $seconds) = @_;
+    select undef, undef, undef, $seconds;
+}
+
+# This is run in a worker thread.  It repeatedly waits for a character from
+# the main thread, and sends a value back to the main thread.  A short
+# sleep introduces random timing, just to keep us honest.
+
+sub be_worker($$) {
+    my ($socket, $value) = @_;
+    for (1 .. $nr_items) {
+        sysread $socket, my $dummy, 1;
+        short_sleep rand 0.5;
+        syswrite $socket, $value;
+        ++$value;
+    }
+
+    exit;
+}
+
+# This function forks a worker and sends it a socket on which to talk to
+# the main thread, as well as an initial value to work with.  It returns
+# (to the main thread) a socket on which to talk to the worker.
+
+sub fork_worker($) {
+    (my $value) = @_;
+    socketpair my $kidsock, my $dadsock, AF_UNIX, SOCK_STREAM, PF_UNSPEC
+        or die "socketpair: $!";
+
+    if (fork // die "fork: $!") {
+        # We're the parent
+        close $dadsock;
+        return $kidsock;
+    }
+    else {
+        # We're the child
+        close $kidsock;
+        be_worker $dadsock, $value;
+        # Never returns
+    }
+}
+
+# Fork two workers, send them start signals, retrieve the values they send
+# back, and print them
+
+my $alpha_sock = fork_worker 'A';
+my $digit_sock = fork_worker 1;
+
+for (1 .. $nr_items) {
+    syswrite $_, 'x'   for $alpha_sock, $digit_sock;
+    sysread $alpha_sock, my $alpha, 1;
+    sysread $digit_sock, my $digit, 1;
+    say $alpha, $digit;
+}
+
+# If the main thread were planning to run for a long time after the
+# workers had terminate, it would need to reap them to avoid zombies:
+
+wait; wait;

Task/Checkpoint-synchronization/PicoLisp/checkpoint-synchronization.l

@@ -0,0 +1,19 @@
+(de checkpoints (Projects Workers)
+   (for P Projects
+      (prinl "Starting project number " P ":")
+      (for
+         (Staff
+            (mapcar
+               '((I) (worker (format I) (rand 2 5)))  # Create staff of workers
+               (range 1 Workers) )
+            Staff                                     # While still busy
+            (filter worker Staff) ) )                 # Remove finished workers
+      (prinl "Project number " P " is done.") ) )
+
+(de worker (ID Steps)
+   (co ID
+      (prinl "Worker " ID " has " Steps " steps to do")
+      (for N Steps
+         (yield ID)
+         (prinl "Worker " ID " step " N) )
+      NIL ) )

Task/Checkpoint-synchronization/Ruby/checkpoint-synchronization.rb

@@ -0,0 +1,158 @@
+require 'socket'
+
+# A Workshop runs all of its workers, then collects their results. Use
+# Workshop#add to add workers and Workshop#work to run them.
+#
+# This implementation forks some processes to run the workers in
+# parallel. Ruby must provide Kernel#fork and 'socket' library must
+# provide UNIXSocket.
+#
+# Why processes and not threads? C Ruby still has a Global VM Lock,
+# where only one thread can hold the lock. One platform, OpenBSD, still
+# has userspace threads, with all threads on one cpu core. Multiple
+# processes will not compete for a single Global VM Lock and can run
+# on multiple cpu cores.
+class Workshop
+  # Creates a Workshop.
+  def initialize
+    @sockets = {}
+  end
+
+  # Adds a worker to this Workshop. Returns a worker id _wid_ for this
+  # worker. The worker is a block that takes some _args_ and returns
+  # some value. Workshop#work will run the block.
+  #
+  # This implementation forks a process for the worker. This process
+  # will use Marshal with UNIXSocket to receive the _args_ and to send
+  # the return value. The _wid_ is a process id. The worker also
+  # inherits _IO_ objects, which might be a problem if the worker holds
+  # open a pipe or socket, and the other end never reads EOF.
+  def add
+    child, parent = UNIXSocket.pair
+
+    wid = fork do
+      # I am the child.
+      child.close
+      @sockets.each_value { |sibling| sibling.close }
+
+      # Prevent that all the children print their backtraces (to a mess
+      # of mixed lines) when user presses Control-C.
+      Signal.trap("INT") { exit! }
+
+      loop do
+        # Wait for a command.
+        begin
+          command, args = Marshal.load(parent)
+        rescue EOFError
+          # Parent probably died.
+          break
+        end
+
+        case command
+        when :work
+          # Do work. Send result to parent.
+          result = yield *args
+          Marshal.dump(result, parent)
+        when :remove
+          break
+        else
+          fail "bad command from workshop"
+        end
+      end
+    end
+
+    # I am the parent.
+    parent.close
+    @sockets[wid] = child
+    wid
+  end
+
+  # Runs all of the workers, and collects the results in a Hash. Passes
+  # the same _args_ to each of the workers. Returns a Hash that pairs
+  # _wid_ => _result_, where _wid_ is the worker id and _result_ is the
+  # return value from the worker.
+  #
+  # This implementation runs the workers in parallel, and waits until
+  # _all_ of the workers finish their results. Workshop provides no way
+  # to start the work without waiting for the work to finish. If a
+  # worker dies (for example, by raising an Exception), then
+  # Workshop#work raises a RuntimeError.
+  def work(*args)
+    message = [:work, args]
+    @sockets.each_pair do |wid, child|
+      Marshal.dump(message, child)
+    end
+
+    # Checkpoint! Wait for all workers to finish.
+    result = {}
+    @sockets.each_pair do |wid, child|
+      begin
+        # This waits until the child finishes a result.
+        result[wid] = Marshal.load(child)
+      rescue EOFError
+        fail "Worker #{wid} died"
+      end
+    end
+    result
+  end
+
+  # Removes a worker from the Workshop, who has a worker id _wid_.
+  # If there is no such worker, raises ArgumentError.
+  #
+  # This implementation kills and reaps the process for the worker.
+  def remove(wid)
+    unless child = @sockets.delete(wid)
+      raise ArgumentError, "No worker #{wid}"
+    else
+      Marshal.dump([:remove, nil], child)
+      child.close
+      Process.wait(wid)
+    end
+  end
+end
+
+
+
+# First create a Workshop.
+require 'pp'
+shop = Workshop.new
+wids = []
+
+# Our workers must not use the same random numbers after the fork.
+@fixed_rand = false
+def fix_rand
+  unless @fixed_rand; srand; @fixed_rand = true; end
+end
+
+# Start with some workers.
+6.times do
+  wids << shop.add do |i|
+    # This worker slowly calculates a Fibonacci number.
+    fix_rand
+    f = proc { |n| if n < 2 then n else f[n - 1] + f[n - 2] end }
+    [i, f[25 + rand(10)]]
+  end
+end
+
+6.times do |i|
+  # Do one cycle of work, and print the result.
+  pp shop.work(i)
+
+  # Remove a worker.
+  victim = rand(wids.length)
+  shop.remove wids[victim]
+  wids.slice! victim
+
+  # Add another worker.
+  wids << shop.add do |j|
+    # This worker slowly calculates a number from
+    # the sequence 0, 1, 2, 3, 6, 11, 20, 37, 68, 125, ...
+    fix_rand
+    f = proc { |n| if n < 3 then n else f[n - 1] + f[n - 2] + f[n - 3] end }
+    [j, i, f[20 + rand(10)]]
+  end
+end
+
+# Remove all workers.
+wids.each { |wid| shop.remove wid }
+pp shop.work(6)

Task/Checkpoint-synchronization/Tcl/checkpoint-synchronization-1.tcl

@@ -0,0 +1,97 @@
+package require Tcl 8.5
+package require Thread
+
+namespace eval checkpoint {
+    namespace export {[a-z]*}
+    namespace ensemble create
+    variable members {}
+    variable waiting {}
+    variable event
+    # Back-end of join operation
+    proc Join {id} {
+	variable members
+	variable counter
+	if {$id ni $members} {
+	    lappend members $id
+	}
+	return $id
+    }
+    # Back-end of leave operation
+    proc Leave {id} {
+	variable members
+	set idx [lsearch -exact $members $id]
+	if {$idx > -1} {
+	    set members [lreplace $members $idx $idx]
+	    variable event
+	    if {![info exists event]} {
+		set event [after idle ::checkpoint::Release]
+	    }
+	}
+	return
+    }
+    # Back-end of deliver operation
+    proc Deliver {id} {
+	variable waiting
+	lappend waiting $id
+
+	variable event
+	if {![info exists event]} {
+	    set event [after idle ::checkpoint::Release]
+	}
+	return
+    }
+    # Releasing is done as an "idle" action to prevent deadlocks
+    proc Release {} {
+	variable members
+	variable waiting
+	variable event
+	unset event
+	if {[llength $members] != [llength $waiting]} return
+	set w $waiting
+	set waiting {}
+	foreach id $w {
+	    thread::send -async $id {incr ::checkpoint::Delivered}
+	}
+    }
+
+    # Make a thread and attach it to the public API of the checkpoint
+    proc makeThread {{script ""}} {
+	set id [thread::create thread::wait]
+	thread::send $id {
+	    namespace eval checkpoint {
+		namespace export {[a-z]*}
+		namespace ensemble create
+
+		# Call to actually join the checkpoint group
+		proc join {} {
+		    variable checkpoint
+		    thread::send $checkpoint [list \
+			    ::checkpoint::Join [thread::id]]
+		}
+		# Call to actually leave the checkpoint group
+		proc leave {} {
+		    variable checkpoint
+		    thread::send $checkpoint [list \
+			    ::checkpoint::Leave [thread::id]]
+		}
+		# Call to wait for checkpoint synchronization
+		proc deliver {} {
+		    variable checkpoint
+		    # Do this from within the [vwait] to ensure that we're already waiting
+		    after 0 [list thread::send $checkpoint [list \
+			    ::checkpoint::Deliver [thread::id]]]
+		    vwait ::checkpoint::Delivered
+		}
+	    }
+	}
+	thread::send $id [list set ::checkpoint::checkpoint [thread::id]]
+	thread::send $id $script
+	return $id
+    }
+
+    # Utility to help determine whether the checkpoint is in use
+    proc anyJoined {} {
+	variable members
+	expr {[llength $members] > 0}
+    }
+}

Task/Checkpoint-synchronization/Tcl/checkpoint-synchronization-2.tcl

@@ -0,0 +1,30 @@
+# Build the workers
+foreach worker {A B C D} {
+    dict set ids $worker [checkpoint makeThread {
+	proc task {name} {
+	    checkpoint join
+	    set deadline [expr {[clock seconds] + 2}]
+	    while {[clock seconds] <= $deadline} {
+		puts "$name is working"
+		after [expr {int(500 * rand())}]
+		puts "$name is ready"
+		checkpoint deliver
+	    }
+	    checkpoint leave
+	    thread::release; # Ask the thread to finish
+	}
+    }]
+}
+
+# Set them all processing in the background
+dict for {name id} $ids {
+    thread::send -async $id "task $name"
+}
+
+# Wait until all tasks are done (i.e., they have unregistered)
+while 1 {
+    after 100 set s 1; vwait s; # Process events for 100ms
+    if {![checkpoint anyJoined]} {
+	break
+    }
+}