mario rpc

client.scm

(use tcp srfi-18 channel)

(define port 4321)

(print "connecting to " port)

(define (signal? msg)
  (eq? (car msg) 'signal))

(define procedures
  '(cluck peck))

(define responses
  (make-channel))

(define results
  (filter-channel
   responses
   (lambda (m)
     (not (signal? m)))))

(define signals
  (filter-channel responses signal?))

(on-channel-receive
 signals
 (lambda (msg)
   (print "we get signal: " (cdr msg))))

(define (make-result-channel id)
  (filter-channel results
                  (lambda (x) 
                    (eq? id (car x)))))

(define start-caller
  (let ((id 0)
        (mutex (make-mutex)))
    (lambda (out)
      (thread-start!
       (lambda ()
         (let loop ()
           (thread-sleep! (random 5))
           (mutex-lock! mutex)
           (let ((id* (+ id 1)))
             (set! id id*)
             (let ((rpc (list-ref procedures (random (length procedures))))
                   (result (make-result-channel id*)))
               (write (cons id* rpc) out)
               (flush-output out)
               (mutex-unlock! mutex)
               (print "result: " (channel-receive result)))
             (loop))))))))

(receive (in out) (tcp-connect "localhost" port)
  (thread-start!
   (lambda ()
     (let ((read-next-message (siphon-input-port in read responses)))
       (let loop ()
         (when (read-next-message)
           (thread-yield!)
           (loop))))))
  (start-caller out)
  (start-caller out)
  (thread-join! (start-caller out)))

server.scm

(use tcp srfi-18)

(define port 4321)

(define listener
  (tcp-listen port 100))

(print "listening on port " port)

(let loop ((count 0))
  (receive (in out) (tcp-accept listener)
    (let ((no count))
      (print "new client " no)
      (thread-start!
       (lambda ()
         (let loop ()
           (let ((rpc (read in))
                 (result (current-seconds)))
             (print "client " no " called " rpc ", responding with " result)
             (write (list (car rpc) (cdr rpc) result) out)
             (flush-output out)
             (loop)))))
      (thread-start!
       (lambda ()
         (let loop ()
           (thread-sleep! (random 5))
           (print "sending signal to client " no)
           (write '(signal . bwak!) out)
           (flush-output out)
           (loop)))))
    (loop (+ count 1))))