[Port scsh placeholder
clinton@unknownlamer.org**20100330070932
 Ignore-this: e89d64206dc43142ac0bfed4c05095b5
 * Uses a condition variable rather than the scheme48 thread queue
   stuff
 * Should work, but maybe not (I'm not a thread wizard; there may be
   subtle race conditions or not so subtle me-being-stupid)
] hunk ./module/scsh/placeholder.scm 4
-(define-record-type placeholder :placeholder
-  (really-make-placeholder queue id)
+;;; Originally: scheme/placeholder.scm
+
+;;; Reimplemented from using manual thread queues to using a condition
+;;; variable to ensure that the value is only written to once. Might
+;;; not be entirely correct.
+
+(define-module (scsh placeholder)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 threads)
+  #:export (make-placeholder placeholder-value placeholder-set!))
+
+(define-record-type placeholder
+  (really-make-placeholder cvar id)
hunk ./module/scsh/placeholder.scm 18
-  (queue placeholder-queue set-placeholder-queue!) ; #f means VALUE has been set
+  (cvar placeholder-condition set-placeholder-condition!) ; #f means
+							  ; VALUE has
+							  ; been set
hunk ./module/scsh/placeholder.scm 24
-(define-record-discloser :placeholder
-  (lambda (placeholder)
-    (cons 'placeholder
-	  (if (placeholder-id placeholder)
-	      (list (placeholder-id placeholder))
-	      '()))))
+;; unsupported with srfi-9 (maybe add a guile extension?)
+;; (define-record-discloser :placeholder
+;;   (lambda (placeholder)
+;;     (cons 'placeholder
+;; 	  (if (placeholder-id placeholder)
+;; 	      (list (placeholder-id placeholder))
+;; 	      '()))))
+
+(define (monitor* closure)
+  (let ((monitor-lock (make-mutex)))
+    (lambda ()
+      (with-mutex monitor-lock
+	(closure monitor-lock)))))
hunk ./module/scsh/placeholder.scm 38
-(define (make-placeholder . id-option)
-  (really-make-placeholder (make-queue)
-			   (if (null? id-option) #f (car id-option))))
+(define* (make-placeholder #:optional id)
+  (really-make-placeholder (make-condition-variable) id))
hunk ./module/scsh/placeholder.scm 41
-(define (placeholder-value placeholder)
-  (with-interrupts-inhibited
-   (lambda ()
-     (if  (placeholder-queue placeholder)
-	  (block-on-queue (placeholder-queue placeholder)))
-     (placeholder-real-value placeholder))))
+(define placeholder-value
+  (let ((read-lock (make-mutex)))
+    (lambda (placeholder)
+      (with-mutex read-lock
+	(if (placeholder-condition placeholder)
+	    (wait-condition-variable (placeholder-condition placeholder)
+				     read-lock))
+	(placeholder-real-value placeholder)))))
hunk ./module/scsh/placeholder.scm 51
-  (let ((waiters (with-interrupts-inhibited
-		  (lambda ()
-		    (let ((queue (placeholder-queue placeholder)))
-		      (cond (queue
-			     (set-placeholder-value! placeholder value)
-			     (set-placeholder-queue! placeholder #f)
-			     (let loop ((waiters '()))
-			       (cond
-				((maybe-dequeue-thread! queue)
-				 => (lambda (thread)
-				      (loop (cons thread waiters))))
-				(else
-				 waiters))))
-			    (else #f)))))))
-    (if waiters
-	(for-each make-ready waiters)
-	(if (not (eq? value (placeholder-value placeholder)))
-	    (error "placeholder is already assigned"
-		   placeholder
-		   value)))))
+  (monitor
+   (let ((cvar (placeholder-condition placeholder)))
+     (cond ((condition-variable? cvar)
+	    (set-placeholder-value! placeholder value)
+	    (set-placeholder-condition! placeholder #f)
+	    (broadcast-condition-variable cvar))
+	   (else (if (not (eq? value (placeholder-value placeholder)))
+		     (error "placeholder is already assigned"
+			    placeholder
+			    value)))))))