syndicate-lang
/
racket-dns-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Make userland spawn raw by default, for better interop between it and big-bang

This commit is contained in:
Tony Garnock-Jones 2012-01-16 17:38:00 -05:00
parent c6f9545817
commit af4cb50104
6 changed files with 79 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
os-udp-test-big-bang.rkt
View File

@ -38,8 +38,8 @@
(ground-vm
(os-big-bang 'none
(spawn spy)
(spawn (lambda () (userland udp-driver)))
(spawn udp-driver)
(spawn echoer))))
;;(main)
(provide main)
(main)
;;(provide main)

27
os-udp-test-userland.rkt
View File

@ -4,16 +4,17 @@
(require "os-userland-stdlib.rkt")
(require "os-udp.rkt")
(ground-vm/userland/stdlib
(lambda ()
(spawn display-driver)
(spawn read-line-driver)
(spawn udp-driver)
(poll)
(define s (rpc `(udp new 5555 65536)))
(let loop ()
(wait (message-handlers
[(udp-packet source (and sink (== s)) body)
(write `(udp (source ,source) (sink ,sink))) (newline)
(send (udp-packet sink source body))
(loop)])))))
(ground-vm/stdlib
(userland
(lambda ()
(spawn display-driver)
(spawn read-line-driver)
(spawn udp-driver)
(poll)
(define s (rpc `(udp new 5555 65536)))
(let loop ()
(wait (message-handlers
[(udp-packet source (and sink (== s)) body)
(write `(udp (source ,source) (sink ,sink))) (newline)
(send (udp-packet sink source body))
(loop)]))))))

24
os-udp.rkt
View File

@ -24,17 +24,19 @@
;; TODO: BUG?: Routing packets between two local sockets won't work
;; because the patterns aren't set up to recognise that situation.
(define (udp-driver)
(rpc-service
[`(udp new ,port-number ,buffer-size)
(define s (udp-open-socket #f #f))
(when port-number
(udp-bind! s #f port-number))
(define sname (udp-address #f port-number))
(spawn (udp-sender sname s))
(spawn (udp-receiver sname s buffer-size))
(spawn (udp-closer sname s))
sname]))
(define udp-driver
(userland
(lambda ()
(rpc-service
[`(udp new ,port-number ,buffer-size)
(define s (udp-open-socket #f #f))
(when port-number
(udp-bind! s #f port-number))
(define sname (udp-address #f port-number))
(spawn (userland (udp-sender sname s)))
(spawn (userland (udp-receiver sname s buffer-size)))
(spawn (userland (udp-closer sname s)))
sname]))))
(define ((udp-sender sname s))
(let loop ()

10
os-userland-example.rkt
View File

@ -6,10 +6,10 @@
(spawn display-driver)
(spawn read-line-driver)
(spawn sleep-driver)
(spawn (lambda ()
(display "HI\n")
(sleep 1000)
(display "THERE\n")))
(spawn (userland (lambda ()
(display "HI\n")
(sleep 1000)
(display "THERE\n"))))
(poll) ;; Wait for drivers to become ready (!)
;; The Right Way to do this is to have presence integrated with subscription
(display "Hello! Enter your name:\n")
@ -20,4 +20,4 @@
(sleep 1000)
(display "Goodbye\n"))
(ground-vm/userland/stdlib main)
(ground-vm/stdlib (userland main))

57
os-userland-stdlib.rkt
View File

@ -8,7 +8,7 @@
(provide (all-from-out "os-userland.rkt")
ground-vm/userland/stdlib
ground-vm/stdlib
message-handlers
meta-message-handlers
@ -29,8 +29,8 @@
receive
receive/timeout)
(define (ground-vm/userland/stdlib boot)
(ground-vm/userland boot #:pattern-predicate (lambda (p m) (p m))))
(define (ground-vm/stdlib boot)
(ground-vm boot #:pattern-predicate (lambda (p m) (p m))))
(define-syntax message-handlers
(syntax-rules ()
@ -59,28 +59,33 @@
(let loop ()
(wait (message-handlers
[`(request ,reply-addr ,pattern)
(spawn (lambda ()
(define answer (let () body ...))
(send `(reply ,reply-addr ,answer))))]
(spawn (userland (lambda ()
(define answer (let () body ...))
(send `(reply ,reply-addr ,answer)))))]
...))
(loop))]))
(define (display-driver)
(define message (wait (message-handlers [`(display ,message) message])))
(meta-send (lambda ()
(base:display message)
(flush-output)))
(display-driver))
(define display-driver
(userland
(lambda ()
(let loop ()
(define message (wait (message-handlers [`(display ,message) message])))
(meta-send (lambda ()
(base:display message)
(flush-output)))
(loop)))))
(define (display x)
(send `(display ,x)))
(define (read-line-driver)
(rpc-service
[`read-line (wait (message-handlers)
(meta-message-handlers
[((read-line-evt (current-input-port) 'any) => line)
line]))]))
(define read-line-driver
(userland
(lambda ()
(rpc-service
[`read-line (wait (message-handlers)
(meta-message-handlers
[((read-line-evt (current-input-port) 'any) => line)
line]))]))))
(define (read-line)
(rpc 'read-line))
@ -100,13 +105,15 @@
(define (current-time)
(wait-until-time 0))
(define (sleep-driver)
(rpc-service
[`(sleep ,msecs)
(send `(display (Sleeping ,msecs)))
(define now (wait-until-time (+ (current-time) msecs)))
(send `(display "\n"))
now]))
(define sleep-driver
(userland
(lambda ()
(rpc-service
[`(sleep ,msecs)
(send `(display (Sleeping ,msecs)))
(define now (wait-until-time (+ (current-time) msecs)))
(send `(display "\n"))
now]))))
(define (sleep msecs)
(rpc `(sleep ,msecs)))

25
os-userland.rkt
View File

@ -8,8 +8,9 @@
(provide (struct-out wait-clause)
ground-vm ;; convenience re-export
userland
ground-vm/userland
send
meta-send
@ -18,21 +19,22 @@
wait
poll
spawn
spawn-raw)
spawn)
(struct wait-clause (pattern handler-proc) #:transparent)
(define prompt (make-continuation-prompt-tag 'os-userland))
;; ( -> Void) -> BootK
;; Wraps a thunk that uses the userland continuation-based approach to
;; simulating side effects so that it can be used as a BootK with a
;; KernelModeTransition.
(define (userland main)
(start-transaction ((reply-to (lambda (_)
(main)
'finish))
void)))
(define (ground-vm/userland boot #:pattern-predicate [pattern-predicate default-pattern-predicate])
(ground-vm (lambda () (userland boot)) #:pattern-predicate pattern-predicate))
(lambda ()
(start-transaction ((reply-to (lambda (_)
(main)
'finish))
void))))
(define ((reply-to k) v)
(call-with-continuation-prompt (lambda () (k (v))) prompt))
@ -93,7 +95,4 @@
(call-in-kernel-context (lambda (k) `(wait #t ,mhs ,mmhs ,k))))
(define (spawn thunk)
(spawn-raw (lambda () (userland thunk))))
(define (spawn-raw thunk)
(actions '() '() (list thunk)))