<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>