66 lines
1.4 KiB
Racket
66 lines
1.4 KiB
Racket
#lang racket/base
|
|
;; Trivial demonstration of a raw os.rkt virtual machine.
|
|
|
|
(require "os.rkt")
|
|
(require racket/pretty)
|
|
|
|
(define (yield k)
|
|
(kernel-mode-transition (suspension 'none (lambda (_) (k)) '() '())
|
|
'()
|
|
'()
|
|
'()))
|
|
|
|
(define (quit)
|
|
(kernel-mode-transition (suspension 'none #f '() '())
|
|
'()
|
|
'()
|
|
'()))
|
|
|
|
(define (print x k)
|
|
(kernel-mode-transition (suspension '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 (suspension 'none
|
|
#f
|
|
'()
|
|
(list (message-handler
|
|
(let ((wakeup-time
|
|
(+ (current-inexact-milliseconds) n)))
|
|
(ground-event-pattern
|
|
(list 'alarm wakeup-time)
|
|
(super-alarm wakeup-time)))
|
|
(lambda (_message)
|
|
(lambda (_state)
|
|
(k))))))
|
|
'()
|
|
'()
|
|
'()))
|
|
|
|
(define (spawn thunk k)
|
|
(kernel-mode-transition (suspension '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)))))
|