nb-server.l (1644B)
1 (cd (pack (sys "HOME") "/picolisp")) 2 (load (pack (sys "HOME") "/src/picolisp/nb.l")) 3 4 # (out "/tmp/a" (wrx '(1 2 3 4) 4)) 5 # (out "/tmp/a" (wrx '(1 2 3 4) 3 1)) 6 7 # (setq *B (need 5)) 8 # (in "/tmp/a" (rdx *B 3)) 9 # (in "/tmp/a" (rdx *B 2 3)) 10 # *B 11 12 # non-blocking echo server 13 14 (setq *N 5) # try bigger buffer;-) 15 (setq *B (need *N)) 16 (setq *I 0) 17 (setq *J 0) 18 19 (set 'EAGAIN (eagain)) 20 21 (de _rdx (Sock) 22 (in Sock 23 (let? N (rdx *B (- *N *I) *I) 24 (when (gt0 N) 25 (inc '*I N)) 26 N))) 27 28 (de _wrx (Sock) 29 (out Sock 30 (let? N (wrx *B (- *I *J) *J) 31 (when (gt0 N) 32 (inc '*J N)) 33 N))) 34 35 (de callback (Sock) 36 (let End NIL 37 (prinl "callback " Sock " J=" *J " I=" *I " N=" *N) 38 (block Sock NIL) # first time would be enough 39 (unless End 40 (let N (_rdx Sock) 41 (prinl " read " N) 42 (unless (or (gt0 N) (= N 'EAGAIN)) 43 (setq End (cons rd N))))) 44 (unless End 45 (let N (_wrx Sock) 46 (prinl " written " N) 47 (unless (or (gt0 N) (= N 'EAGAIN)) 48 (setq End (cons wr N))))) 49 (when End 50 (prinl " finish") 51 (task Sock) 52 (close Sock)) 53 (when (<= *I *J) 54 (prinl " rotate J=" *J " I=" *I " N=" *N) 55 (setq *I 0) 56 (setq *J 0)) 57 (prinl "end " Sock " J=" *J " I=" *I " N=" *N))) 58 59 (task (port 4444) # Listen on port 4444 60 (when (accept @) # A connect arrived 61 (task @ # Install another task on this socket 62 Sock @ # Keep the socket in the task's env 63 (callback Sock) ) ) )