nb

Non-blocking I/O for picoLisp
git clone https://logand.com/git/nb.git/
Log | Files | Refs | README

chat.l (1254B)

      1 # non-blocking chat server
      2 #
      3 # server: picolisp$ (chat 4444)
      4 # clients: $ telnet localhost 4444
      5 
      6 (load "nb.l")
      7 
      8 (off *H) # handlers
      9 
     10 (class +Handler)
     11 # s [w]
     12 
     13 (dm T (S)
     14    (=: s S)
     15    (=: w (new))
     16    (push '*H (cons S This)) )
     17 
     18 (dm rm> ()
     19    (prinl "q " (: s))
     20    (task (: s))
     21    (close (: s))
     22    (setq *H (delq (assoc (: s) *H) *H)) )
     23 
     24 (dm wr> (Who Msg)
     25    (fifo (: w) (cons Who Msg)) )
     26    
     27 (setq *N 1024 *B (need *N)) # read buffer
     28 
     29 (dm cb> ()
     30    (block (: s) NIL)
     31    (let N (in (: s) (rdx *B *N))
     32       (prinl "r " (: s) " " N)
     33       (cond
     34          ((gt0 N) (for H *H (wr> (cdr H) S (head N *B))))
     35          ((= N (eagain)))
     36          (T (rm> This)) ) )
     37    (for H *H (fl> (cdr H))) )
     38 
     39 (dm fl> ()
     40    (use X
     41       (while
     42          (and (setq X (cadr (val (: w)))) # peek head
     43               (let (S (cdr X)
     44                     M (length S)
     45                     N (out (: s) (wrx S M)))
     46                  (prinl "w " (: s) " " N "/" M)
     47                  (when (gt0 N)
     48                     (if (<= M N)
     49                        (fifo (: w))
     50                        (set (cdr (val (: w))) (tail (- M N) S)) ) ) ) ) ) ) )
     51 
     52 (de chat (Port)
     53    (task (port Port)
     54       (when (accept @)
     55          (task @
     56             This (new '(+Handler) @)
     57             (cb> This) ) ) ) )