[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[plt-scheme] TCP/IP simple server in MZScheme - how to? (Plt 1.3p1 release)
Hello,
I'm not very familiar with MzScheme yet and tried to create a simple
server class to interface to a front end via TCP/IP. However, on Mac
OS 9 in DrScheme and when I connect via telnet, the code below does
display "connection" but only reads a few (5-6) list expressions and
then the IDE quits with a low on memory message. Something in the
methods start-listen-thread or data-available must be totally wrong.
Does anyone spot an obvious mistake in the code below? -- defclass*
is just a simple wrapper macro to some (define name (class* ...)) and
none of the other custom functions does anything unusual.
Is there some TCP/IP server sample for MZScheme?
Thanks in advance for any help and advices,
Erich
(define-struct client (in out))
(definterface wp:Interface<%> ()
received-command
send-command)
(defclass* wp:Interface% wp:Object% (wp:Interface<%>)()
(private
[listener]
[clients ()]
[start-listen-thread
(lambda ()
(thread
(let loop ()
(when (tcp-accept-ready? listener)
(begin
(set! clients
(cons (call-with-values
(lambda ()
(tcp-accept listener))
(lambda (in out)
(make-client in out)))
clients))
(display "connection")(newline))) ;debug
; second loop part read data from clients
(for-each
(lambda (client)
(data-available client (read (client-in client))))
clients)
(sleep 0.1)
(loop))
))]
[data-available
(lambda (client data)
(thread
(lambda ()
(cond ((list? data)
(display data) ;debug
(let ((cmd (make-object wp:Command%)))
(send cmd set-by-raw-data! data)
(received-command client cmd)))
(else (display "Unknown command: ")
(display data)
(newline))))))]
)
(public
[listen
(lambda ()
(set! listener (tcp-listen (get-pref 'default-port)))
(start-listen-thread))]
[received-command
(lambda (client cmd)
(display (text 'debug-received-command
(send cmd debug-string))))]
[send-command
(lambda () (display (text 'debug-send-command)))]
))
(define a (make-object wp:Interface%))
(send a listen)
--