new files

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
+    }
+}