racket-dns-2012/os-example.rkt

61 lines
1.2 KiB
Racket

#lang racket/base
(require "os.rkt")
(require racket/pretty)
(define (yield k)
(kernel-mode-transition (subscription 'none (lambda (_) (k)) '() '())
'()
'()
'()))
(define (quit)
(kernel-mode-transition (subscription 'none #f '() '())
'()
'()
'()))
(define (print x k)
(kernel-mode-transition (subscription 'none (lambda (_) (k)) '() '())
'()
(list (lambda () (pretty-print x)))
'()))
(define (super-alarm msecs)
(wrap-evt (alarm-evt msecs) (lambda (_) (current-inexact-milliseconds))))
(define (sleep n k)
(kernel-mode-transition (subscription 'none
#f
'()
(list (message-handler
(super-alarm (+ (current-inexact-milliseconds) n))
(lambda (_message)
(lambda (_state)
(k))))))
'()
'()
'()))
(define (spawn thunk k)
(kernel-mode-transition (subscription 'none (lambda (_) (k)) '() '())
'()
'()
(list thunk)))
(define (example-process delay)
(print "SLEEPING"
(lambda ()
(sleep delay
(lambda ()
(yield
(lambda ()
(print "HELLO"
quit))))))))
(ground-vm (lambda ()
(spawn (lambda ()
(example-process 1000))
(lambda ()
(example-process 2000)))))