101 lines
4.1 KiB
Racket
101 lines
4.1 KiB
Racket
#lang racket/base
|
|
|
|
;; Virtualized operating system.
|
|
|
|
(require racket/match)
|
|
(require "functional-queue.rkt")
|
|
|
|
(provide ...)
|
|
|
|
;; Each VM hosts 0 or more *multiplexed* processes. Each process has
|
|
;; its own state record. In between schedulings, a process consists of
|
|
;; 1 or more event handlers. An event handler is a pair of an event
|
|
;; recogniser and a procedure taking an event and a process state to a
|
|
;; new process state.
|
|
;;
|
|
;; Each VM provides a *communication bus* for its processes to
|
|
;; use. The communication bus is the only form of IPC the VM provides.
|
|
;;
|
|
;; Some processes *relay* messages out from the VM to other
|
|
;; VMs. Because the "tree" of VMs so formed has to be a tree - See
|
|
;; Shivers & Might 2006 for a discussion of this - we gather together
|
|
;; all the interactions between the supervenient VM and its support VM
|
|
;; into a single channel of communication. The relaying processes are,
|
|
;; in effect, device-drivers, providing application-specific
|
|
;; communication services to other processes in the VM.
|
|
;;
|
|
;; We split processes into "user" processes, permitted only to spawn
|
|
;; other user processes and send messages on the VM's bus, and
|
|
;; "kernel" processes, permitted also to spawn other kernel processes
|
|
;; and send messages to the VM's container.
|
|
;;
|
|
;; Time plays an interesting role in a distributed system: if the
|
|
;; medium messages are sent through isn't cooperative enough to let us
|
|
;; know of a failed conversational participant, our only recourse is
|
|
;; /timeout/. Therefore, we require every level of the machine to
|
|
;; support timeouts, though we do not require such timeouts to be tied
|
|
;; to real, wall-clock time: simulated time is just fine. This helps
|
|
;; with testability.
|
|
;;
|
|
;; Racket's alarm-evt is almost the right design for timeouts: its
|
|
;; synchronisation value should be the (or some) value of the clock
|
|
;; after the asked-for time. That way it serves as timeout and
|
|
;; clock-reader in one.
|
|
|
|
;; VMs are parameterised over:
|
|
;; - the type of messages carried on the bus, Message
|
|
;; - the type of patterns over Messages, MessageEvent
|
|
;; - the type of messages to other VMs, MetaMessage
|
|
;; - the type of patterns over MetaMessages, MetaMessageEvent
|
|
|
|
;; A VM is a (vm Map<Pid,Process>
|
|
;; QueueOf<Message>
|
|
;; QueueOf<InterruptK>).
|
|
(struct vm (process-table pending-messages runnable) #:transparent)
|
|
|
|
;; A Pid is some eq?-comparable object, guaranteed to be unique within
|
|
;; the scope of a single VM. It IDentifies a Process.
|
|
|
|
;; A Sid is some eq?-comparable object, guaranteed to be unique within
|
|
;; the scope of a single VM's process. It IDentifies a Subscription.
|
|
|
|
;; A Subscription is a (subscription Sid (Message -> Boolean) TrapK).
|
|
(struct subscription (sid predicate handler) #:transparent)
|
|
|
|
;; An Action is one of
|
|
;; -- (send-message Message), a message to emit onto the bus
|
|
;; -- (spawn-process InterruptK), a new sibling process to start
|
|
;; -- (subscribe sid
|
|
|
|
;; A TrapK is a Message -> InterruptK, representing a suspended
|
|
;; process waiting for some information from the VM before it can
|
|
;; continue.
|
|
|
|
;; An InterruptK is a
|
|
;; ProcessState SetOf<Subscription>
|
|
;; -> ListOf<Message> ProcessState SetOf<Subscription> ListOf<InterruptK>
|
|
;;
|
|
;; representing a suspended process that can run instantly without
|
|
;; waiting for more information from the VM. The inputs are the state
|
|
;; of the process and its current set of subscriptions, and the
|
|
;; outputs are a list of messages to emit into the VM's communication
|
|
;; bus, as well as possibly-updated process state and subscription
|
|
;; list, and a list of new processes to spawn.
|
|
|
|
(define (make-vm boot)
|
|
(vm (hash)
|
|
(make-queue)
|
|
(enqueue (make-queue) boot)))
|
|
|
|
;; VM SetOf<MetaSubscription> -> ListOf<MetaMessage> VM SetOf<MetaSubscription>
|
|
;; (A kind of Meta-InterruptK)
|
|
(define (run-vm state meta-subscriptions)
|
|
(define state-after-dispatch
|
|
(foldl dispatch-message
|
|
(struct-copy vm state [pending-messages (make-queue)])
|
|
(vm-pending-messages state)))
|
|
(define state-after-run
|
|
(foldl run-process
|
|
(struct-copy vm state [runnable (make-queue)])
|
|
(vm-runnable state)))
|