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