[gambit-list] lambdanative and remote repl

Petersen, Chris CPetersen at cw.bc.ca
Mon Sep 2 10:54:06 EDT 2013


Thanks for reporting this. The gui eventloop was preempting gambit threads on linux and openbsd. I could not reproduce the problem on other platforms. Fixed in lambdanative commit 0db18463.

In general, if you want to implement a multi-threaded server, you'd be better off working from a non-gui application like DemoConsole, to avoid the rendering overhead. This would essentially be equivalent to generating an executable directly with gsc.

btw please use the lambdanative issue reporting tool on github for bugs/issues specific to lambdanative, as that will help us track and coordinate fixes better.

Chris 
 

________________________________________
From: gambit-list-bounces at iro.umontreal.ca [gambit-list-bounces at iro.umontreal.ca] On Behalf Of tcl super dude [tcleval at gmail.com]
Sent: Sunday, September 01, 2013 9:44 PM
To: gambit-list at iro.umontreal.ca
Subject: [gambit-list] lambdanative and remote repl

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


        ;-----------------------------------------------------------------------------------------------------------------







More information about the Gambit-list mailing list