;; Lock-Server mit bedingtem RPC

(define-record-type :lock
  (really-make-lock id)
  lock?
  (id lock-id))

(define make-lock
  (let ((id 0))
    (lambda ()
      (set! id (+ 1 id))
      (really-make-lock id))))

(define (make-lock-server)
  (let ((obtain-rpc-op
	 (make-conditional-rpc
	  (lambda (locks lock)
	    (not (member (lock-id lock) locks)))
	  (lambda (locks lock)
	    (values (cons (lock-id lock) locks)
		    #f))))
	(release-rpc-op
	 (make-rpc (lambda (locks lock)
		     (values (delete (lambda (id)
				       (= id (lock-id lock)))
				     locks)
			     #f)))))
  (make-rpc-server '()
		   (list (rpc-op-entry-proc obtain-rpc-op)
			 (rpc-op-entry-proc release-rpc-op)))
  (values (rpc-op-call obtain-rpc-op)
	  (rpc-op-call release-rpc-op))))

(define obtain-lock #f)
(define release-lock #f)
(call-with-values
 make-lock-server
 (lambda (obtain release)
   (set! obtain-lock obtain)
   (set! release-lock release)))