From 44de0079e5a5a3c46370fd70af790beb886c052e Mon Sep 17 00:00:00 2001 From: "Kartik K. Agaram" Date: Sun, 9 Nov 2014 18:23:05 -0800 Subject: 266 - update html --- mu.arc.t.html | 624 +++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 558 insertions(+), 66 deletions(-) (limited to 'mu.arc.t.html') diff --git a/mu.arc.t.html b/mu.arc.t.html index 8d8575c7..33da2302 100644 --- a/mu.arc.t.html +++ b/mu.arc.t.html @@ -14,15 +14,16 @@ pre { white-space: pre-wrap; font-family: monospace; color: #aaaaaa; background- body { font-family: monospace; color: #aaaaaa; background-color: #000000; } a { color:#4444ff; } * { font-size: 1em; } -.Constant, .MuConstant { color: #008080; } -.Comment { color: #8080ff; } -.Delimiter { color: #600060; } -.Normal { color: #aaaaaa; } -.Identifier { color: #008080; } .Global { color: #00af87; } +.SalientComment { color: #00ffff; } .CommentedCode { color: #666666; } .Mu, .Mu .Normal, .Mu .Constant { color: #eeeeee; } .Op { color: #ff8888; } +.Delimiter { color: #600060; } +.Normal { color: #aaaaaa; } +.Comment { color: #8080ff; } +.Constant, .MuConstant { color: #008080; } +.Identifier { color: #008080; } --> @@ -39,6 +40,8 @@ a { color:#4444ff; } ; "Is it a language, or an operating system, or a virtual machine? Mu." ; (with apologies to Robert Pirsig: http://en.wikipedia.org/wiki/Mu_%28negative%29#In_popular_culture) ; +;; Motivation +; ; I want to live in a world where I can have an itch to tweak a program, clone ; its open-source repository, orient myself on how it's organized, and make ; the simple change I envisioned, all in an afternoon. This codebase tries to @@ -92,7 +95,7 @@ a { color:#4444ff; } ; allocation, or write to disk? It requires better, more observable primitives ; than we currently have. Modern operating systems have their roots in the ; 70s. Their interfaces were not designed to be testable. They provide no way -; to simulate a full disk, or a specific sequence of writes from different +; to simulate a full disk, or a specific sequence of writes from different ; threads. We need something better. ; ; This project tries to move, groping, towards that 'something better', a @@ -136,6 +139,8 @@ a { color:#4444ff; } ; --- +;; Getting started +; ; Mu is currently built atop Racket and Arc, but this is temporary and ; contingent. We want to keep our options open, whether to port to a different ; host language, and easy to rewrite to native code for any platform. So we'll @@ -151,7 +156,7 @@ a { color:#4444ff; } ; statements, and statements consist of an operation and its arguments (input ; and output). ; -; oarg1, oarg2, ... <- op arg1, arg2, ... +; oarg1, oarg2, ... <- op arg1, arg2, ... ; ; Args must be atomic, like an integer or a memory address, they can't be ; expressions doing arithmetic or function calls. But we can have any number @@ -161,7 +166,7 @@ a { color:#4444ff; } ; idealized syntax above. For now they will be lists of lists: ; ; (function-name -; ((oarg1 oarg2 ... <- op arg1 arg2 ...) +; ((oarg1 oarg2 ... <- op arg1 arg2 ...) ; ... ; ...)) ; @@ -179,6 +184,7 @@ a { color:#4444ff; } ; look for it. Everything outside 'add-fns' is just test-harness details. (reset) +;? (set dump-trace*) (new-trace "literal") (add-fns '((main @@ -252,6 +258,17 @@ a { color:#4444ff; } (if (~iso memory* (obj 1 3 2 5)) (prn "F - 'idiv' performs integer division, returning quotient and remainder")) +(reset) +(new-trace "dummy-oarg") +;? (set dump-trace*) +(add-fns + '((main + (_ (2 integer) <- idiv (23 literal) (6 literal))))) +(run 'main) +(if (~iso memory* (obj 2 5)) + (prn "F - '_' oarg can ignore some results")) +;? (quit) + ; Basic boolean operations: and, or, not ; There are easy ways to encode booleans in binary, but we'll skip past those ; details for now. @@ -434,6 +451,8 @@ a { color:#4444ff; } (if (~iso memory* (obj 1 2 2 36)) (prn "F - instructions can perform indirect addressing on output arg")) +;; Compound data types +; ; Until now we've dealt with scalar types like integers and booleans and ; addresses, where mu looks like other assembly languages. In addition, mu ; provides first-class support for compound types: arrays and records. @@ -446,6 +465,14 @@ a { color:#4444ff; } ; (see types* in mu.arc for the complete list of types; we'll add to it over ; time). +; first a sanity check that the table of types is consistent +(reset) +(each (typ typeinfo) types* + (when typeinfo!record + (assert (is typeinfo!size (len typeinfo!elems))) + (when typeinfo!fields + (assert (is typeinfo!size (len typeinfo!fields)))))) + (reset) (new-trace "get-record") (add-fns @@ -841,6 +868,8 @@ a { color:#4444ff; } (~is (memory* (+ third 2) nil))))))) (prn "F - 'new-list' can construct a list of integers"))) +;; Functions +; ; Just like the table of types is centralized, functions are conceptualized as ; a centralized table of operations just like the "primitives" we've seen so ; far. If you create a function you can call it like any other op. @@ -867,8 +896,10 @@ a { color:#4444ff; } ((1 integer) <- copy (1 literal))) (main (test1)))) -(if (~is 2 (run 'main)) - (prn "F - calling a user-defined function runs its instructions exactly once")) +;? (= dump-trace* (obj whitelist '("run"))) +(run 'main) +(if (~is 2 curr-cycle*) + (prn "F - calling a user-defined function runs its instructions exactly once " curr-cycle*)) ;? (quit) ; User-defined functions communicate with their callers through two @@ -897,7 +928,7 @@ a { color:#4444ff; } (reset) (new-trace "new-fn-reply-nested") (add-fns - `((test1 + '((test1 ((3 integer) <- test2)) (test2 (reply (2 integer))) @@ -921,8 +952,10 @@ a { color:#4444ff; } ((1 integer) <- copy (1 literal)) ((2 integer) <- copy (3 literal)) (test1)))) -(if (~is 4 (run 'main)) ; last reply sometimes not counted. worth fixing? - (prn "F - 'reply' executes instructions exactly once")) +;? (= dump-trace* (obj whitelist '("run"))) +(run 'main) +(if (~is 5 curr-cycle*) + (prn "F - 'reply' executes instructions exactly once " curr-cycle*)) ;? (quit) (reset) @@ -1037,10 +1070,10 @@ a { color:#4444ff; } ; if given two args, adds them; if given one arg, increments ((4 integer) <- arg) ((5 integer) (6 boolean) <- arg) - { begin + { begin (break-if (6 boolean)) ((5 integer) <- copy (1 literal)) - } + } ((7 integer) <- add (4 integer) (5 integer))) (main (test1 (34 literal)) @@ -1126,6 +1159,8 @@ a { color:#4444ff; } 4 1 5 3 6 4)) (prn "F - without args, 'reply' returns values from previous 'prepare-reply'.")) +;; Structured programming +; ; Our control operators are quite inconvenient to use, so mu provides a ; lightweight tool called 'convert-braces' to work in a slightly more ; convenient format with nested braces: @@ -1151,11 +1186,11 @@ a { color:#4444ff; } '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) ((3 integer) <- add (2 integer) (2 integer)) - { begin ; 'begin' is just a hack because racket turns curlies into parens + { begin ; 'begin' is just a hack because racket turns curlies into parens ((4 boolean) <- neq (1 integer) (3 integer)) (break-if (4 boolean)) ((5 integer) <- copy (34 literal)) - } + } (reply))) '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) @@ -1172,9 +1207,9 @@ a { color:#4444ff; } '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) ((3 integer) <- add (2 integer) (2 integer)) - { begin + { begin (break) - } + } (reply))) '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) @@ -1189,13 +1224,13 @@ a { color:#4444ff; } '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) ((3 integer) <- add (2 integer) (2 integer)) - { begin + { begin ((4 boolean) <- neq (1 integer) (3 integer)) (break-if (4 boolean)) - { begin + { begin ((5 integer) <- copy (34 literal)) - } - } + } + } (reply))) '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) @@ -1211,14 +1246,14 @@ a { color:#4444ff; } (if (~iso (convert-braces '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) - { begin + { begin ((3 integer) <- add (2 integer) (2 integer)) - { begin + { begin ((4 boolean) <- neq (1 integer) (3 integer)) - } + } (continue-if (4 boolean)) ((5 integer) <- copy (34 literal)) - } + } (reply))) '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) @@ -1236,12 +1271,12 @@ a { color:#4444ff; } '((main ((1 integer) <- copy (4 literal)) ((2 integer) <- copy (1 literal)) - { begin + { begin ((2 integer) <- add (2 integer) (2 integer)) ((3 boolean) <- neq (1 integer) (2 integer)) (continue-if (3 boolean)) ((4 integer) <- copy (34 literal)) - } + } (reply)))) ;? (each stmt function*!main ;? (prn stmt)) @@ -1260,14 +1295,14 @@ a { color:#4444ff; } '((main ((1 integer) <- copy (4 literal)) ((2 integer) <- copy (1 literal)) - { begin + { begin ((2 integer) <- add (2 integer) (2 integer)) - { begin + { begin ((3 boolean) <- neq (1 integer) (2 integer)) - } + } (continue-if (3 boolean)) ((4 integer) <- copy (34 literal)) - } + } (reply)))) ;? (each stmt function*!main ;? (prn stmt)) @@ -1282,26 +1317,28 @@ a { color:#4444ff; } '((main ((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) - { begin + { begin ((2 integer) <- add (2 integer) (2 integer)) - { begin + { begin ((3 boolean) <- neq (1 integer) (2 integer)) - } + } (continue-if (3 boolean)) ((4 integer) <- copy (34 literal)) - } + } (reply)))) (run 'main) ;? (prn memory*) (if (~iso memory* (obj 1 4 2 4 3 nil 4 34)) (prn "F - continue might never trigger")) +;; Variables +; ; A big convenience high-level languages provide is the ability to name memory ; locations. In mu, a lightweight tool called 'convert-names' provides this ; convenience. (reset) -(new-trace "convert-names") +;? (new-trace "convert-names") (if (~iso (convert-names '(((x integer) <- copy (4 literal)) ((y integer) <- copy (2 literal)) @@ -1312,7 +1349,16 @@ a { color:#4444ff; } (prn "F - convert-names renames symbolic names to integer locations")) (reset) -(new-trace "convert-names-nil") +;? (new-trace "convert-names-compound") +(if (~iso (convert-names + '(((x integer-boolean-pair) <- copy (4 literal)) + ((y integer) <- copy (2 literal)))) + '(((1 integer-boolean-pair) <- copy (4 literal)) + ((3 integer) <- copy (2 literal)))) + (prn "F - convert-names increments integer locations by the size of the type of the previous var")) + +(reset) +;? (new-trace "convert-names-nil") (if (~iso (convert-names '(((x integer) <- copy (4 literal)) ((y integer) <- copy (2 literal)) @@ -1322,6 +1368,67 @@ a { color:#4444ff; } ((nil integer) <- add (1 integer) (2 integer)))) (prn "F - convert-names never renames nil")) +(reset) +;? (new-trace "convert-names-global") +(if (~iso (convert-names + '(((x integer) <- copy (4 literal)) + ((y integer global) <- copy (2 literal)) + ((default-scope integer) <- add (x integer) (y integer global)))) + '(((1 integer) <- copy (4 literal)) + ((y integer global) <- copy (2 literal)) + ((default-scope integer) <- add (1 integer) (y integer global)))) + (prn "F - convert-names never renames global operands")) + +; kludgy support for 'fork' below +(reset) +;? (new-trace "convert-names-functions") +(if (~iso (convert-names + '(((x integer) <- copy (4 literal)) + ((y integer) <- copy (2 literal)) + ((z fn) <- add (x integer) (y integer)))) + '(((1 integer) <- copy (4 literal)) + ((2 integer) <- copy (2 literal)) + ((z fn) <- add (1 integer) (2 integer)))) + (prn "F - convert-names never renames nil")) + +(reset) +;? (new-trace "convert-names-record-fields") +(if (~iso (convert-names + '(((x integer) <- get (34 integer-boolean-pair) (bool offset)))) + '(((1 integer) <- get (34 integer-boolean-pair) (1 offset)))) + (prn "F - convert-names replaces record field offsets")) + +(reset) +;? (new-trace "convert-names-record-fields-ambiguous") +(if (errsafe (convert-names + '(((bool boolean) <- copy (t literal)) + ((x integer) <- get (34 integer-boolean-pair) (bool offset))))) + (prn "F - convert-names doesn't allow offsets and variables with the same name in a function")) + +(reset) +;? (new-trace "convert-names-record-fields-ambiguous-2") +(if (errsafe (convert-names + '(((x integer) <- get (34 integer-boolean-pair) (bool offset)) + ((bool boolean) <- copy (t literal))))) + (prn "F - convert-names doesn't allow offsets and variables with the same name in a function - 2")) + +(reset) +;? (new-trace "convert-names-record-fields-indirect") +(if (~iso (convert-names + '(((x integer) <- get (34 integer-boolean-pair-address deref) (bool offset)))) + '(((1 integer) <- get (34 integer-boolean-pair-address deref) (1 offset)))) + (prn "F - convert-names replaces field offsets for record addresses")) + +(reset) +;? (new-trace "convert-names-record-fields-multiple") +(if (~iso (convert-names + '(((2 boolean) <- get (1 integer-boolean-pair) (bool offset)) + ((3 boolean) <- get (1 integer-boolean-pair) (bool offset)))) + '(((2 boolean) <- get (1 integer-boolean-pair) (1 offset)) + ((3 boolean) <- get (1 integer-boolean-pair) (1 offset)))) + (prn "F - convert-names replaces field offsets with multiple mentions")) +;? (quit) + ; A rudimentary memory allocator. Eventually we want to write this in mu. ; ; No deallocation yet; let's see how much code we can build in mu before we @@ -1460,7 +1567,7 @@ a { color:#4444ff; } ;? (quit) (reset) -(new-trace "convert-names-default-scope") +;? (new-trace "convert-names-default-scope") (if (~iso (convert-names '(((x integer) <- copy (4 literal)) ((y integer) <- copy (2 literal)) @@ -1485,17 +1592,8 @@ a { color:#4444ff; } (~is 23 (memory* (+ before 1)))) (prn "F - default-scope skipped for locations with metadata 'global'"))) -(reset) -(new-trace "convert-names-global") -(if (~iso (convert-names - '(((x integer) <- copy (4 literal)) - ((y integer global) <- copy (2 literal)) - ((default-scope integer) <- add (x integer) (y integer global)))) - '(((1 integer) <- copy (4 literal)) - ((y integer global) <- copy (2 literal)) - ((default-scope integer) <- add (1 integer) (y integer global)))) - (prn "F - convert-names never renames global operands")) - +;; Dynamic dispatch +; ; Putting it all together, here's how you define generic functions that run ; different code based on the types of their args. @@ -1504,17 +1602,20 @@ a { color:#4444ff; } ;? (set dump-trace*) (add-fns '((test1 + ; doesn't matter too much how many locals you allocate space for (here 20) + ; if it's slightly too many -- memory is plentiful + ; if it's too few -- mu will raise an error ((default-scope scope-address) <- new (scope literal) (20 literal)) ((first-arg-box tagged-value-address) <- arg) ; if given integers, add them - { begin + { begin ((first-arg integer) (match? boolean) <- maybe-coerce (first-arg-box tagged-value-address deref) (integer literal)) (break-unless (match? boolean)) ((second-arg-box tagged-value-address) <- arg) ((second-arg integer) <- maybe-coerce (second-arg-box tagged-value-address deref) (integer literal)) ((result integer) <- add (first-arg integer) (second-arg integer)) (reply (result integer)) - } + } (reply (t literal))) (main ((1 tagged-value-address) <- new-tagged-value (integer literal) (34 literal)) @@ -1536,23 +1637,23 @@ a { color:#4444ff; } ((default-scope scope-address) <- new (scope literal) (20 literal)) ((first-arg-box tagged-value-address) <- arg) ; if given integers, add them - { begin + { begin ((first-arg integer) (match? boolean) <- maybe-coerce (first-arg-box tagged-value-address deref) (integer literal)) (break-unless (match? boolean)) ((second-arg-box tagged-value-address) <- arg) ((second-arg integer) <- maybe-coerce (second-arg-box tagged-value-address deref) (integer literal)) ((result integer) <- add (first-arg integer) (second-arg integer)) (reply (result integer)) - } + } ; if given booleans, or them (it's a silly kind of generic function) - { begin + { begin ((first-arg boolean) (match? boolean) <- maybe-coerce (first-arg-box tagged-value-address deref) (boolean literal)) (break-unless (match? boolean)) ((second-arg-box tagged-value-address) <- arg) ((second-arg boolean) <- maybe-coerce (second-arg-box tagged-value-address deref) (boolean literal)) ((result boolean) <- or (first-arg boolean) (second-arg boolean)) (reply (result integer)) - } + } (reply (t literal))) (main ((1 tagged-value-address) <- new-tagged-value (boolean literal) (t literal)) @@ -1574,23 +1675,23 @@ a { color:#4444ff; } ((default-scope scope-address) <- new (scope literal) (20 literal)) ((first-arg-box tagged-value-address) <- arg) ; if given integers, add them - { begin + { begin ((first-arg integer) (match? boolean) <- maybe-coerce (first-arg-box tagged-value-address deref) (integer literal)) (break-unless (match? boolean)) ((second-arg-box tagged-value-address) <- arg) ((second-arg integer) <- maybe-coerce (second-arg-box tagged-value-address deref) (integer literal)) ((result integer) <- add (first-arg integer) (second-arg integer)) (reply (result integer)) - } + } ; if given booleans, or them (it's a silly kind of generic function) - { begin + { begin ((first-arg boolean) (match? boolean) <- maybe-coerce (first-arg-box tagged-value-address deref) (boolean literal)) (break-unless (match? boolean)) ((second-arg-box tagged-value-address) <- arg) ((second-arg boolean) <- maybe-coerce (second-arg-box tagged-value-address deref) (boolean literal)) ((result boolean) <- or (first-arg boolean) (second-arg boolean)) (reply (result integer)) - } + } (reply (t literal))) (main ((1 tagged-value-address) <- new-tagged-value (boolean literal) (t literal)) @@ -1604,6 +1705,8 @@ a { color:#4444ff; } (if (~and (is memory*.3 t) (is memory*.12 37)) (prn "F - different calls can exercise different clauses of the same function")) +;; Concurrency +; ; A rudimentary process scheduler. You can 'run' multiple functions at once, ; and they share the virtual processor. ; @@ -1620,9 +1723,9 @@ a { color:#4444ff; } ((1 integer) <- copy (3 literal))) (f2 ((2 integer) <- copy (4 literal))))) -(let ninsts (run 'f1 'f2) - (when (~iso 2 ninsts) - (prn "F - scheduler didn't run the right number of instructions: " ninsts))) +(run 'f1 'f2) +(when (~iso 2 curr-cycle*) + (prn "F - scheduler didn't run the right number of instructions: " curr-cycle*)) (if (~iso memory* (obj 1 3 2 4)) (prn "F - scheduler runs multiple functions: " memory*)) (check-trace-contents "scheduler orders functions correctly" @@ -1636,6 +1739,94 @@ a { color:#4444ff; } ("run" "f2 0") )) +(reset) +(new-trace "scheduler-alternate") +(add-fns + '((f1 + ((1 integer) <- copy (3 literal)) + ((1 integer) <- copy (3 literal))) + (f2 + ((2 integer) <- copy (4 literal)) + ((2 integer) <- copy (4 literal))))) +(= scheduling-interval* 1) +(run 'f1 'f2) +(check-trace-contents "scheduler alternates between routines" + '(("run" "f1 0") + ("run" "f2 0") + ("run" "f1 1") + ("run" "f2 1") + )) + +(reset) +(new-trace "sleep") +(add-fns + '((f1 + (sleep (1 literal)) + ((1 integer) <- copy (3 literal)) + ((1 integer) <- copy (3 literal))) + (f2 + ((2 integer) <- copy (4 literal)) + ((2 integer) <- copy (4 literal))))) +;? (= dump-trace* (obj whitelist '("run" "schedule"))) +(= scheduling-interval* 1) +(run 'f1 'f2) +(check-trace-contents "scheduler handles sleeping routines" + '(("run" "f1 0") + ("run" "sleeping until 2") + ("schedule" "pushing f1 to sleep queue") + ("run" "f2 0") + ("run" "f2 1") + ("schedule" "waking up f1") + ("run" "f1 1") + ("run" "f1 2") + )) + +(reset) +(new-trace "sleep-long") +(add-fns + '((f1 + (sleep (20 literal)) + ((1 integer) <- copy (3 literal)) + ((1 integer) <- copy (3 literal))) + (f2 + ((2 integer) <- copy (4 literal)) + ((2 integer) <- copy (4 literal))))) +;? (= dump-trace* (obj whitelist '("run" "schedule"))) +(= scheduling-interval* 1) +(run 'f1 'f2) +(check-trace-contents "scheduler progresses sleeping routines when there are no routines left to run" + '(("run" "f1 0") + ("run" "sleeping until 21") + ("schedule" "pushing f1 to sleep queue") + ("run" "f2 0") + ("run" "f2 1") + ("schedule" "waking up f1") + ("run" "f1 1") + ("run" "f1 2") + )) + +(reset) +(new-trace "sleep-location") +(add-fns + '((f1 + ; waits for memory location 1 to be set, before computing its successor + ((1 integer) <- copy (0 literal)) + (sleep (1 integer)) + ((2 integer) <- add (1 integer) (1 literal))) + (f2 + (sleep (30 literal)) + ((1 integer) <- copy (3 literal))))) ; set to value +;? (= dump-trace* (obj whitelist '("run" "schedule"))) +;? (set dump-trace*) +(= scheduling-interval* 1) +(run 'f1 'f2) +;? (prn canon.memory*) +(let last-routine (deq completed-routines*) + (aif rep.last-routine!error (prn "error - " it))) +(if (~is memory*.2 4) ; successor of value + (prn "F - scheduler handles routines blocking on a memory location")) +;? (quit) + ; The scheduler needs to keep track of the call stack for each routine. ; Eventually we'll want to save this information in mu's address space itself, ; along with the types array, the magic buffers for args and oargs, and so on. @@ -1659,20 +1850,321 @@ a { color:#4444ff; } (if (no rep.last-routine!error) (prn "F - 'index' throws an error if out of bounds"))) +;; Synchronization +; +; Mu synchronizes using channels rather than locks, like Erlang and Go. +; +; The two ends of a channel will usually belong to different routines, but +; each end should only be used by a single one. Don't try to read from or +; write to it from multiple routines at once. +; +; To avoid locking, writer and reader will never write to the same location. +; So channels will include fields in pairs, one for the writer and one for the +; reader. + +; The core circular buffer contains values at index 'first-full' up to (but +; not including) index 'first-empty'. The reader always modifies it at +; first-full, while the writer always modifies it at first-empty. +(reset) +(new-trace "channel-new") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ((2 integer) <- get (1 channel-address deref) (first-full offset)) + ((3 integer) <- get (1 channel-address deref) (first-free offset))))) +;? (set dump-trace*) +(run 'main) +;? (prn memory*) +(if (or (~is 0 memory*.2) + (~is 0 memory*.3)) + (prn "F - 'new-channel' initializes 'first-full and 'first-free to 0")) + +(reset) +(new-trace "channel-write") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ((4 integer) <- get (1 channel-address deref) (first-full offset)) + ((5 integer) <- get (1 channel-address deref) (first-free offset))))) +;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +;? (= dump-trace* (obj whitelist '("jump"))) +(run 'main) +;? (prn canon.memory*) +(if (or (~is 0 memory*.4) + (~is 1 memory*.5)) + (prn "F - 'write' enqueues item to channel")) +;? (quit) + +(reset) +(new-trace "channel-read") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ((4 tagged-value) (1 channel-address deref) <- read (1 channel-address deref)) + ((6 integer-address) <- maybe-coerce (4 tagged-value) (integer-address literal)) + ((7 integer) <- get (1 channel-address deref) (first-full offset)) + ((8 integer) <- get (1 channel-address deref) (first-free offset))))) +;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +(run 'main) +;? (prn int-canon.memory*) +(if (~is memory*.6 memory*.2) + (prn "F - 'read' returns written value")) +(if (or (~is 1 memory*.7) + (~is 1 memory*.8)) + (prn "F - 'read' dequeues item from channel")) + +(reset) +(new-trace "channel-write-wrap") +(add-fns + '((main + ; channel with 2 slots (capacity 1 since we waste a slot) + ((1 channel-address) <- new-channel (2 literal)) + ; write a value + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ; first-free will now be 1 + ((4 integer) <- get (1 channel-address deref) (first-free offset)) + ; read one value + (_ (1 channel-address deref) <- read (1 channel-address deref)) + ; write a second value; verify that first-free wraps around to 0. + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ((5 integer) <- get (1 channel-address deref) (first-free offset))))) +;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +(run 'main) +;? (prn canon.memory*) +(if (or (~is 1 memory*.4) + (~is 0 memory*.5)) + (prn "F - 'write' can wrap pointer back to start")) + +(reset) +(new-trace "channel-read-wrap") +(add-fns + '((main + ; channel with 2 slots (capacity 1 since we waste a slot) + ((1 channel-address) <- new-channel (2 literal)) + ; write a value + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ; read one value + (_ (1 channel-address deref) <- read (1 channel-address deref)) + ; first-full will now be 1 + ((4 integer) <- get (1 channel-address deref) (first-full offset)) + ; write a second value + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ; read second value; verify that first-full wraps around to 0. + (_ (1 channel-address deref) <- read (1 channel-address deref)) + ((5 integer) <- get (1 channel-address deref) (first-full offset))))) +;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "array-len" "cvt0" "cvt1"))) +(run 'main) +;? (prn canon.memory*) +(if (or (~is 1 memory*.4) + (~is 0 memory*.5)) + (prn "F - 'read' can wrap pointer back to start")) + +(reset) +(new-trace "channel-new-empty-not-full") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ((2 boolean) <- empty? (1 channel-address deref)) + ((3 boolean) <- full? (1 channel-address deref))))) +;? (set dump-trace*) +(run 'main) +;? (prn memory*) +(if (or (~is t memory*.2) + (~is nil memory*.3)) + (prn "F - a new channel is always empty, never full")) + +(reset) +(new-trace "channel-write-not-empty") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ((4 boolean) <- empty? (1 channel-address deref)) + ((5 boolean) <- full? (1 channel-address deref))))) +;? (set dump-trace*) +(run 'main) +;? (prn memory*) +(if (or (~is nil memory*.4) + (~is nil memory*.5)) + (prn "F - a channel after writing is never empty")) + +(reset) +(new-trace "channel-write-full") +(add-fns + '((main + ((1 channel-address) <- new-channel (2 literal)) + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ((4 boolean) <- empty? (1 channel-address deref)) + ((5 boolean) <- full? (1 channel-address deref))))) +;? (set dump-trace*) +(run 'main) +;? (prn memory*) +(if (or (~is nil memory*.4) + (~is t memory*.5)) + (prn "F - a channel after writing may be full")) + +(reset) +(new-trace "channel-read-not-full") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + (_ (1 channel-address deref) <- read (1 channel-address deref)) + ((4 boolean) <- empty? (1 channel-address deref)) + ((5 boolean) <- full? (1 channel-address deref))))) +;? (set dump-trace*) +(run 'main) +;? (prn memory*) +(if (or (~is nil memory*.4) + (~is nil memory*.5)) + (prn "F - a channel after reading is never full")) + +(reset) +(new-trace "channel-read-empty") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + (_ (1 channel-address deref) <- read (1 channel-address deref)) + ((4 boolean) <- empty? (1 channel-address deref)) + ((5 boolean) <- full? (1 channel-address deref))))) +;? (set dump-trace*) +(run 'main) +;? (prn memory*) +(if (or (~is t memory*.4) + (~is nil memory*.5)) + (prn "F - a channel after reading may be empty")) + +; The key property of channels; writing to a full channel blocks the current +; routine until it creates space. Ditto reading from an empty channel. + +(reset) +(new-trace "channel-read-block") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ; channel is empty, but receives a read + ((2 tagged-value) (1 channel-address deref) <- read (1 channel-address deref))))) +;? (set dump-trace*) +;? (= dump-trace* (obj whitelist '("run"))) +(run 'main) +;? (prn int-canon.memory*) +;? (prn sleeping-routines*) +; read should cause the routine to sleep, and +; the sole sleeping routine should trigger the deadlock detector +(let last-routine (deq completed-routines*) + (when (or (no rep.last-routine!error) + (~posmatch "deadlock" rep.last-routine!error)) + (prn "F - 'read' on empty channel blocks (puts the routine to sleep until the channel gets data)"))) +;? (quit) + +(reset) +(new-trace "channel-write-block") +(add-fns + '((main + ((1 channel-address) <- new-channel (1 literal)) + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ; channel has capacity 1, but receives a second write + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref))))) +;? (set dump-trace*) +;? (= dump-trace* (obj whitelist '("run"))) +(run 'main) +;? (prn int-canon.memory*) +; second write should cause the routine to sleep, and +; the sole sleeping routine should trigger the deadlock detector +(let last-routine (deq completed-routines*) + (when (or (no rep.last-routine!error) + (~posmatch "deadlock" rep.last-routine!error)) + (prn "F - 'write' on full channel blocks (puts the routine to sleep until the channel gets data)"))) + +; But how will the sleeping routines wake up? Our scheduler can't watch for +; changes to arbitrary values, just tell us if a specific raw location becomes +; non-zero (see the sleep-location test above). So both reader and writer set +; 'read-watch' and 'write-watch' respectively at the end of a successful call. + +(reset) +(new-trace "channel-write-watch") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((4 boolean) <- get (1 channel-address deref) (read-watch offset)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ((5 boolean) <- get (1 channel-address deref) (write-watch offset))))) +(run 'main) +(if (or (~is nil memory*.4) + (~is t memory*.5)) + (prn "F - 'write' sets channel watch")) + +(reset) +(new-trace "channel-read-watch") +(add-fns + '((main + ((1 channel-address) <- new-channel (3 literal)) + ((2 integer-address) <- new (integer literal)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 tagged-value-address) <- new-tagged-value (integer-address literal) (2 integer-address)) + ((1 channel-address deref) <- write (1 channel-address deref) (3 tagged-value-address deref)) + ((4 boolean) <- get (1 channel-address deref) (read-watch offset)) + (_ (1 channel-address deref) <- read (1 channel-address deref)) + ((5 integer) <- get (1 channel-address deref) (read-watch offset))))) +(run 'main) +(if (or (~is nil memory*.4) + (~is t memory*.5)) + (prn "F - 'read' sets channel watch")) + +;; Separating concerns +; ; Lightweight tools can also operate on quoted lists of statements surrounded ; by square brackets. In the example below, we mimic Go's 'defer' keyword ; using 'convert-quotes'. It lets us write code anywhere in a function, but ; have it run just before the function exits. Great for keeping code to ; reclaim memory or other resources close to the code to allocate it. (C++ ; programmers know this as RAII.) We'll use 'defer' when we build a memory -; deallocation routine like C's 'free'. +; deallocation routine like C's 'free'. ; ; More powerful reorderings are also possible like in Literate Programming or ; Aspect-Oriented Programming; one advantage of prohibiting arbitrarily nested ; code is that we can naturally name 'join points' wherever we want. (reset) -(new-trace "convert-quotes-defer") +;? (new-trace "convert-quotes-defer") (if (~iso (convert-quotes '(((1 integer) <- copy (4 literal)) (defer [ -- cgit 1.4.1-2-gfad0