<div dir="ltr">Hi,<div><br></div><div>I started a remote repl with the demoredsquare app but the repl get too slow, somehow the app takes forever to process the repl events</div><div><br></div><div>main.scm:</div><div><br>
</div><div><div>(include "repl.scm")</div><div><br></div><div>(define gui #f)</div><div><br></div><div>(start-repl-server)</div><div>(main</div><div>;; initialization</div><div> (lambda (w h)</div><div> (make-window 320 480)</div>
<div> (glgui-orientation-set! GUI_PORTRAIT)</div><div> (set! gui (make-glgui))</div><div> (let* ((w (glgui-width-get))</div><div> (h (glgui-height-get))</div><div> (dim (min (/ w 2) (/ h 2))))</div>
<div> (glgui-box gui (/ (- w dim) 2) (/ (- h dim) 2) dim dim Red))</div><div> )</div><div>;; events</div><div> (lambda (t x y) </div><div> (if (= t EVENT_KEYPRESS) (begin </div><div> (if (= x EVENT_KEYESCAPE) (terminate))))</div>
<div> (glgui-event gui t x y))</div><div>;; termination</div><div> (lambda () #t)</div><div>;; suspend</div><div> (lambda () (glgui-suspend))</div><div>;; resume</div><div> (lambda () (glgui-resume))</div><div>)</div>
<div><br></div><div>;; eof</div></div><div><br></div><div><br></div><div>repl.scm:</div><div><br></div><div><br></div><div><table><tbody><tr></tr><tr><td class="">;;; $Id: repl.scm,v 1.1 2013/03/10 16:24:54 daniel Exp daniel $</td>
</tr><tr><td class=""></td><td class="">;;; $Name: $</td></tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class="">;; ------------------remote REPL -------------------------------------------------------------</td>
</tr><tr><td class=""></td><td class="">(define (ide-repl-pump ide-repl-connection in-port out-port tgroup)</td></tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class=""> (define m (make-mutex))</td>
</tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class=""> (define (process-input)</td></tr><tr><td class=""></td><td class=""> (let loop ((state 'normal))</td></tr><tr><td class="">
</td><td class=""> (let ((c (read-char ide-repl-connection)))</td></tr><tr><td class=""></td><td class=""> (if (not (eof-object? c))</td></tr><tr><td class=""></td><td class=""> (case state</td></tr>
<tr><td class=""></td><td class=""> ((normal)</td></tr><tr><td class=""></td><td class=""> (if (char=? c #\xff) ;; telnet IAC (interpret as command) code?</td></tr><tr><td class=""></td><td class="">
(loop c)</td></tr><tr><td class=""></td><td class=""> (begin</td></tr><tr><td class=""></td><td class=""> (mutex-lock! m)</td></tr><tr><td class=""></td><td class="">
(if (char=? c #\x04) ;; ctrl-d ?</td></tr><tr><td class=""></td><td class=""> (close-output-port out-port)</td></tr><tr><td class=""></td><td class=""> (begin</td>
</tr><tr><td class=""></td><td class=""> (write-char c out-port)</td></tr><tr><td class=""></td><td class=""> (force-output out-port)))</td></tr><tr><td class=""></td><td class="">
(mutex-unlock! m)</td></tr><tr><td class=""></td><td class=""> (loop state))))</td></tr><tr><td class=""></td><td class=""> ((#\xfb) ;; after WILL command?</td></tr><tr>
<td class=""></td><td class=""> (loop 'normal))</td></tr><tr><td class=""></td><td class=""> ((#\xfc) ;; after WONT command?</td></tr><tr><td class=""></td><td class=""> (loop 'normal))</td>
</tr><tr><td class=""></td><td class=""> ((#\xfd) ;; after DO command?</td></tr><tr><td class=""></td><td class=""> (if (char=? c #\x06) ;; timing-mark option?</td></tr><tr><td class=""></td><td class="">
(begin ;; send back WILL timing-mark</td></tr><tr><td class=""></td><td class=""> (mutex-lock! m)</td></tr><tr><td class=""></td><td class=""> (write-char #\xff ide-repl-connection)</td>
</tr><tr><td class=""></td><td class=""> (write-char #\xfb ide-repl-connection)</td></tr><tr><td class=""></td><td class=""> (write-char #\x06 ide-repl-connection)</td></tr><tr><td class="">
</td><td class=""> (force-output ide-repl-connection)</td></tr><tr><td class=""></td><td class=""> (mutex-unlock! m)))</td></tr><tr><td class=""></td><td class=""> (loop 'normal))</td>
</tr><tr><td class=""></td><td class=""> ((#\xfe) ;; after DONT command?</td></tr><tr><td class=""></td><td class=""> (loop 'normal))</td></tr><tr><td class=""></td><td class=""> ((#\xff) ;; after IAC command?</td>
</tr><tr><td class=""></td><td class=""> (case c</td></tr><tr><td class=""></td><td class=""> ((#\xf4) ;; telnet IP (interrupt process) command?</td></tr><tr><td class=""></td><td class=""> (for-each</td>
</tr><tr><td class=""></td><td class=""> ##thread-interrupt!</td></tr><tr><td class=""></td><td class=""> (thread-group->thread-list tgroup))</td></tr><tr><td class=""></td><td class="">
(loop 'normal))</td></tr><tr><td class=""></td><td class=""> ((#\xfb #\xfc #\xfd #\xfe) ;; telnet WILL/WONT/DO/DONT command?</td></tr><tr><td class=""></td><td class=""> (loop c))</td>
</tr><tr><td class=""></td><td class=""> (else</td></tr><tr><td class=""></td><td class=""> (loop 'normal))))</td></tr><tr><td class=""></td><td class=""> (else</td></tr><tr>
<td class=""></td><td class=""> (loop 'normal)))))))</td></tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class=""> (define (process-output)</td></tr><tr><td class=""></td>
<td class=""> (let loop ()</td></tr><tr><td class=""></td><td class=""> (let ((c (read-char in-port)))</td></tr><tr><td class=""></td><td class=""> (if (not (eof-object? c))</td></tr><tr><td class=""></td><td class="">
(begin</td></tr><tr><td class=""></td><td class=""> (mutex-lock! m)</td></tr><tr><td class=""></td><td class=""> (write-char c ide-repl-connection)</td></tr><tr><td class=""></td><td class="">
(force-output ide-repl-connection)</td></tr><tr><td class=""></td><td class=""> (mutex-unlock! m)</td></tr><tr><td class=""></td><td class=""> (loop))))))</td></tr><tr><td class="">
</td><td class=""><br></td></tr><tr><td class=""></td><td class=""> (let ((tgroup (make-thread-group 'repl-pump #f)))</td></tr><tr><td class=""></td><td class=""> (thread-start! (make-thread process-input #f tgroup))</td>
</tr><tr><td class=""></td><td class=""> (thread-start! (make-thread process-output #f tgroup))))</td></tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class="">(define (make-ide-repl-ports ide-repl-connection tgroup)</td>
</tr><tr><td class=""></td><td class=""> (receive (in-rd-port in-wr-port) (open-string-pipe '(direction: input permanent-close: #f))</td></tr><tr><td class=""></td><td class=""> (receive (out-wr-port out-rd-port) (open-string-pipe '(direction: output))</td>
</tr><tr><td class=""></td><td class=""> (begin</td></tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class=""> ;; Hack... set the names of the ports for usage with gambit.el</td>
</tr><tr><td class=""></td><td class=""> (##vector-set! in-rd-port 4 (lambda (port) '(stdin)))</td></tr><tr><td class=""></td><td class=""> (##vector-set! out-wr-port 4 (lambda (port) '(stdout)))</td>
</tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class=""> (ide-repl-pump ide-repl-connection out-rd-port in-wr-port tgroup)</td></tr><tr><td class=""></td><td class=""> (values in-rd-port out-wr-port)))))</td>
</tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class="">(define repl-channel-table (make-table test: eq?))</td></tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class="">
(set! ##thread-make-repl-channel</td></tr><tr><td class=""></td><td class=""> (lambda (thread)</td></tr><tr><td class=""></td><td class=""> (let ((tgroup (thread-thread-group thread)))</td></tr><tr><td class="">
</td><td class=""> (or (table-ref repl-channel-table tgroup #f)</td></tr><tr><td class=""></td><td class=""> (##default-thread-make-repl-channel thread)))))</td></tr><tr><td class=""></td><td class="">
<br></td></tr><tr><td class=""></td><td class="">(define (setup-ide-repl-channel ide-repl-connection tgroup)</td></tr><tr><td class=""></td><td class=""> (receive (in-port out-port) (make-ide-repl-ports ide-repl-connection tgroup)</td>
</tr><tr><td class=""></td><td class=""> (let ((repl-channel (##make-repl-channel-ports in-port out-port)))</td></tr><tr><td class=""></td><td class=""> (table-set! repl-channel-table tgroup repl-channel))))</td></tr>
<tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class="">(define (start-ide-repl)</td></tr><tr><td class=""></td><td class=""> (##repl-debug-main))</td></tr><tr><td class=""></td><td class=""><br>
</td></tr><tr><td class=""></td><td class="">(define repl-server-address "*:7000")</td></tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td><td class="">(define (repl-server)</td></tr><tr>
<td class=""></td><td class=""> (let ((server</td></tr><tr><td class=""></td><td class=""> (open-tcp-server</td></tr><tr><td class=""></td><td class=""> (list server-address: repl-server-address</td></tr>
<tr><td class=""></td><td class=""> reuse-address: #t))))</td></tr><tr><td class=""></td><td class=""> (let loop ()</td></tr><tr><td class=""></td><td class=""> (let* ((ide-repl-connection</td></tr>
<tr><td class=""></td><td class=""> (read server))</td></tr><tr><td class=""></td><td class=""> (tgroup</td></tr><tr><td class=""></td><td class=""> (make-thread-group 'repl-service #f))</td>
</tr><tr><td class=""></td><td class=""> (thread</td></tr><tr><td class=""></td><td class=""> (make-thread</td></tr><tr><td class=""></td><td class=""> (lambda ()</td></tr><tr><td class="">
</td><td class=""> (setup-ide-repl-channel ide-repl-connection tgroup)</td></tr><tr><td class=""></td><td class=""> (start-ide-repl))</td></tr><tr><td class=""></td><td class=""> 'repl</td>
</tr><tr><td class=""></td><td class=""> tgroup)))</td></tr><tr><td class=""></td><td class=""> (thread-start! thread)</td></tr><tr><td class=""></td><td class=""> (loop)))))</td></tr><tr><td class="">
</td><td class=""><br></td></tr><tr><td class=""></td><td class="">(define (start-repl-server)</td></tr><tr><td class=""></td><td class=""> (thread-start! (make-thread (lambda () (repl-server)))))</td></tr><tr><td class="">
</td><td class=""><br></td></tr><tr><td class=""></td><td class="">;-----------------------------------------------------------------------------------------------------------------</td></tr><tr><td class=""></td><td class="">
<br></td></tr><tr><td class=""></td><td class=""><br></td></tr><tr><td class=""></td></tr></tbody></table></div></div>