[gambit-list] lambdanative and remote repl

Steve Graham jsgrahamus at yahoo.com
Tue Sep 3 17:58:16 EDT 2013

Why did you choose to port it to OpenBSD?

 From: "Petersen, Chris" <CPetersen at cw.bc.ca>
To: tcl super dude <tcleval at gmail.com>; "gambit-list at iro.umontreal.ca" <gambit-list at iro.umontreal.ca> 
Sent: Monday, September 2, 2013 8:54 AM
Subject: Re: [gambit-list] lambdanative and remote repl

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.


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


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


(include "repl.scm")

(define gui #f)

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


;;; $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
        (if (char=? c #\xff) ;; telnet IAC (interpret as command) code?
        (loop c)
        (mutex-lock! m)
        (if (char=? c #\x04) ;; ctrl-d ?
        (close-output-port out-port)
        (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?
        (thread-group->thread-list tgroup))
        (loop 'normal))
        ((#\xfb #\xfc #\xfd #\xfe) ;; telnet WILL/WONT/DO/DONT command?
        (loop c))
        (loop 'normal))))
        (loop 'normal)))))))

        (define (process-output)
        (let loop ()
        (let ((c (read-char in-port)))
        (if (not (eof-object? c))
        (mutex-lock! m)
        (write-char c ide-repl-connection)
        (force-output ide-repl-connection)
        (mutex-unlock! m)

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

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

        (define repl-server-address "*:7000")

        (define (repl-server)
        (let ((server
        (list server-address: repl-server-address
        reuse-address: #t))))
        (let loop ()
        (let* ((ide-repl-connection
        (read server))
        (make-thread-group 'repl-service #f))
        (lambda ()
        (setup-ide-repl-channel ide-repl-connection tgroup)
        (thread-start! thread)

        (define (start-repl-server)
        (thread-start! (make-thread (lambda () (repl-server)))))


Gambit-list mailing list
Gambit-list at iro.umontreal.ca
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mailman.iro.umontreal.ca/pipermail/gambit-list/attachments/20130903/58f5818c/attachment.htm>

More information about the Gambit-list mailing list