lambdanative and remote repl - Gambit-list

2 Sep 2013


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