See also ../protohackers-cl for more info.

So, after the simple thread-per-request version I put together last time, I wanted to see if I could handle multiple clients in an event-based way, on a single thread.

insights from reading code

usocket:wait-for-input function is basically our select(2); it takes a list of sockets and blocks until some subset are ready for reading.
I’ve played around some with cl-cont and cl-coroutine (both on quicklisp);
- cl-cont provides a bunch of sweet macros to transform some code into cps, and then manage running that code such that we can use call/cc.
- cl-coroutine is a really simple macro on top, which I’m not going to use, but which was instrumental in helping me get my head around how we can provide a DSL of sorts with macrolet getting a body form in a macro.

With “select amongst ready sockets” and “coroutines” in my head from reading code this last couple of weeks, I’ve figured out a plan:

sketch of the plan

In pseudocode, we’re doing something like this:

socket-registry = make-hash-table
server-socket   = socket-listen *host* *port*

loop:
  usocket:wait-for-input (hash-keys socket-registry)
  for each ready-socket:
    continuation      = socket-registry[ready-socket]
    command, nextcont = funcall continuation ready-socket
    case command:
      wait: 
        socket-registry[socket] = nextcont
      fork:
        socket-registry[socket] = client-handler socket
        socket-registry[server] = nextcont
      close:
        delete socket-registry[socket]
        close socket

the socket-registry stores continuations from previous work against the socket
assume the server-socket got into the hash table at some point, so socket-accept is part of the server’s coroutine loop

accept loop

I like to write code where I just use the name of a function or macro that I haven’t written yet, to see what it feels like, so let’s start with this definition of the accept-loop coroutine. This is the one that’s performing the accept loop, accepting connections and forking them off into the registery for processing.

(cl-cont:defun/cc server-accept (socket handlerfn)    ; 1.
  (loop do
    (wait-for-input socket)                           ; 2.
    (let ((client (usocket:socket-accept socket)))
      (fork-socket socket client handlerfn))))        ; 3.

Immediately confusing is cl-cont:defun/cc; this is just a macro from the cl-cont system which builds a function definition in such a way that it’s usable with the cps transforms stuff that cl-cont uses. macroexpand can be a very healthy excercise¹.

Anyway, assuming we come back and implement wait-for-input and fork-socket as cl-cont based non-local returns, this will do exactly what we want (sans error handling) — loop on the server socket, trying to accept connections.

fork-socket is a little different than wait-for-input, in that it will actually run the other code immediately (this function’s continuation and handlerfn), collecting their results for updating the registry.

Essentially it gives us a fork at the point of call — in one continuation, we’re the server, and continue running after the fork, landing on wait-for-input after finishing the loop. In the other continuation, we’re running whatever code was handed to us as handlerfn, with server-accept up the callstack,

client handler

Similarly, we’ll just define the client handler assuming the code that we’ll need;

(defun client-handler (socket)
  (loop do
    (wait-for-input socket)                           ; 1.
    (let* ((stream (usocket:socket-stream socket))
           (input  (read-line stream)))
      (if (equal input "quit")
          (close-and-finish socket)                   ; 2.
          (progn 
            (format stream "echo: ~a~%" input)
            (finish-output stream))))))

Same thing here; assuming that wait-for-input and close-and-finish are non-local returns via whatever continuation based runtime we’ve got, this shouldn’t ever block, and we should be able to handle mulitple clients.

the actual runtime

Here it is, I’ll break it down after:

(defmacro wait-for-input (s)
  (alexandria:with-gensyms (cc)
    `(cl-cont:let/cc ,cc
       (list :wait ,s ,cc))))

(defmacro close-and-finish (s)
  `(cl-cont:let/cc _
     (declare (ignorable _))
     (list :close ,s)))

(defmacro fork-socket (server client handler)
  (alexandria:with-gensyms (cc)
    `(cl-cont:let/cc ,cc
         (list :fork ,server ,cc ,client ,handler))))

(defun socket-handler-case (registry result)
  (alexandria:destructuring-case result
    ((:wait socket continue)
     (format t "waiting on ~A from ~A ~%" socket continue)
     (setf (gethash socket registry) continue))

    ((:close socket)
     (format t "finished on ~A ~%" socket)
     (remhash socket registry)
     (usocket:socket-close socket))

    ((:fork server-socket server-cont client-socket client-handler)
     (format t "forking from ~A to ~A ~A ~%" server-socket client-socket client-handler)
     (socket-handler-case registry (funcall server-cont server-socket))
     (format t "...running client... ~%")
     (socket-handler-case registry (funcall client-handler client-socket)))))

(defun make-server ()
  (cl-cont:with-call/cc
    (let* ((registry      (make-hash-table))
           (server-socket (usocket:socket-listen "0.0.0.0" 6000 :reuseaddress t))
           (server-result (server-listen server-socket #'client-handler)))

      ;; let the server get started, and register the server socket
      (socket-handler-case registry server-result)

      ;; now, we basically just loop over ready sockets, handling forks
      (loop do
        (format t "waiting for a ready socket ~%")
        (let* ((sockets (alexandria:hash-table-keys registry))
               (ready   (usocket:wait-for-input sockets :ready-only t)))
          (format t "ready sockets! ~%")
          (dolist (socket ready)
            (let* ((continue (gethash socket registry))
                   (command  (funcall continue socket)))
              (format t "handled socket ~A ~%" socket)
              (socket-handler-case registry command))))))))

Despite being nearly impossible to actually read, thanks to copious gensym, it’s obvious that the code has been transformed from something that runs linearly, to some stack of funcall and lambda.

(cl-cont:defun/cc example-defun (name)
  (format t "name ~a~%" name))

;; macroexpands to:
;; (with a bunch of declare ignorable and storing to the symbol properties removed)

(cl-cont::make-funcallable
(lambda (#:g365 name)
  (funcall
    (lambda (&optional #:g366 &rest #:g367)
      (let ((#:g368 #:g365))
        (funcall
        (lambda (&optional #:g369 &rest #:g370)
          (funcall
            (lambda (&optional #:g371 &rest #:g372)
              (funcall
              (lambda (&optional #:g373 &rest #:g374)
                (funcall
                  (lambda (&optional #:g375 &rest #:g376)
                    (funcall (cl-cont::fdesignator-to-function/cc #:g369) #:g368 #:g371 #:g373 #:g375))
                  name))
              "name: ~a~%"))
            t))
        #'format)))
    nil)))

Seeing this, I’m not sure if it’s a great idea memory wise, but it’s cool, so we’ll keep going for now. ↩

insights from reading code

sketch of the plan

accept loop

client handler

the actual runtime

Footnotes