From a65fbc8bf91d6cbe7d1d96980c2c0e7c3f6d3713 Mon Sep 17 00:00:00 2001 From: "Kartik K. Agaram" Date: Sat, 1 Nov 2014 15:55:42 -0700 Subject: 211 - update html for reading --- mu.arc.t.html | 881 +++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 600 insertions(+), 281 deletions(-) (limited to 'mu.arc.t.html') diff --git a/mu.arc.t.html b/mu.arc.t.html index 352419a2..2883aaca 100644 --- a/mu.arc.t.html +++ b/mu.arc.t.html @@ -18,9 +18,11 @@ a { color:#4444ff; } .Comment { color: #8080ff; } .Delimiter { color: #600060; } .Normal { color: #aaaaaa; } +.Identifier { color: #008080; } +.Global { color: #00af87; } +.CommentedCode { color: #666666; } .Mu, .Mu .Normal, .Mu .Constant { color: #eeeeee; } .Op { color: #ff8888; } -.CommentedCode { color: #666666; } --> @@ -143,46 +145,7 @@ a { color:#4444ff; } ; Other than that, we'll say no more about the code, and focus in the rest of ; this file on the scenarios the code cares about. - -(load "mu.arc") - -; Every test below is conceptually a run right after our virtual machine -; starts up. When it starts up we assume it knows about the following types. - -(on-init - (= types* (obj - ; Each type must be scalar or array, sum or product or primitive - type (obj size 1) ; implicitly scalar and primitive - type-address (obj size 1 address t elem 'type) - type-array (obj array t elem 'type) - type-array-address (obj size 1 address t elem 'type-array) - location (obj size 1 address t elem 'location) ; assume it points to an atom - integer (obj size 1) - boolean (obj size 1) - boolean-address (obj size 1 address t) - byte (obj size 1) -;? string (obj array t elem 'byte) ; inspired by Go - character (obj size 1) ; int32 like a Go rune - character-address (obj size 1 address t elem 'character) - string (obj size 1) ; temporary hack - ; arrays consist of an integer length followed by the right number of elems - integer-array (obj array t elem 'integer) - integer-address (obj size 1 address t elem 'integer) ; pointer to int - ; records consist of a series of elems, corresponding to a list of types - integer-boolean-pair (obj size 2 record t elems '(integer boolean)) - integer-boolean-pair-address (obj size 1 address t elem 'integer-boolean-pair) - integer-boolean-pair-array (obj array t elem 'integer-boolean-pair) - integer-integer-pair (obj size 2 record t elems '(integer integer)) - integer-point-pair (obj size 2 record t elems '(integer integer-integer-pair)) - ; tagged-values are the foundation of dynamic types - tagged-value (obj size 2 record t elems '(type location)) - tagged-value-address (obj size 1 address t elem 'tagged-value) - ; heterogeneous lists - list (obj size 2 record t elems '(tagged-value list-address)) - list-address (obj size 1 address t elem 'list) - list-address-address (obj size 1 address t elem 'list-address) - ))) - +(load "mu.arc") ; Our language is assembly-like in that functions consist of series of ; statements, and statements consist of an operation and its arguments (input @@ -212,8 +175,8 @@ a { color:#4444ff; } ; lightweight tools that can be combined in various ways, say for using ; different typecheckers in different subsystems. ; -; In the rest of this file we'll highlight lines of the assembly language -; and deemphasize the (ugly) test harness. +; In our tests we'll define such mu functions using a call to 'add-fns', so +; look for it. Everything outside 'add-fns' is just test-harness details. (reset) (new-trace "literal") @@ -222,7 +185,7 @@ a { color:#4444ff; } ((1 integer) <- copy (23 literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 23) +(if (~is memory*.1 23) (prn "F - 'copy' writes its lone 'arg' after the instruction name to its lone 'oarg' or output arg before the arrow. After this test, the value 23 is stored in memory address 1.")) ;? (quit) @@ -237,7 +200,7 @@ a { color:#4444ff; } ((2 integer) <- copy (3 literal)) ((3 integer) <- add (1 integer) (2 integer))))) (run 'main) -(if (~iso memory* (obj 1 1 2 3 3 4)) +(if (~iso memory* (obj 1 1 2 3 3 4)) (prn "F - 'add' operates on two addresses")) (reset) @@ -246,7 +209,7 @@ a { color:#4444ff; } '((main ((1 integer) <- add (2 literal) (3 literal))))) (run 'main) -(if (~is memory*.1 5) +(if (~is memory*.1 5) (prn "F - ops can take 'literal' operands (but not return them)")) (reset) @@ -256,7 +219,7 @@ a { color:#4444ff; } ((1 integer) <- sub (1 literal) (3 literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 -2) +(if (~is memory*.1 -2) (prn "F - 'sub' subtracts the second arg from the first")) (reset) @@ -266,7 +229,7 @@ a { color:#4444ff; } ((1 integer) <- mul (2 literal) (3 literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 6) +(if (~is memory*.1 6) (prn "F - 'mul' multiplies like 'add' adds")) (reset) @@ -276,22 +239,22 @@ a { color:#4444ff; } ((1 integer) <- div (8 literal) (3 literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 (/ real.8 3)) +(if (~is memory*.1 (/ real.8 3)) (prn "F - 'div' divides like 'sub' subtracts")) (reset) (new-trace "idiv-literal") (add-fns '((main - ((1 integer) (2 integer) <- idiv (8 literal) (3 literal))))) + ((1 integer) (2 integer) <- idiv (23 literal) (6 literal))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 2 2 2)) +(if (~iso memory* (obj 1 3 2 5)) (prn "F - 'idiv' performs integer division, returning quotient and remainder")) ; Basic boolean operations: and, or, not ; There are easy ways to encode booleans in binary, but we'll skip past those -; details. +; details for now. (reset) (new-trace "and-literal") @@ -300,7 +263,7 @@ a { color:#4444ff; } ((1 boolean) <- and (t literal) (t literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 nil) +(if (~is memory*.1 nil) (prn "F - logical 'and' for booleans")) ; Basic comparison operations: lt, le, gt, ge, eq, neq @@ -312,7 +275,7 @@ a { color:#4444ff; } ((1 boolean) <- lt (4 literal) (3 literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 nil) +(if (~is memory*.1 nil) (prn "F - 'lt' is the less-than inequality operator")) (reset) @@ -322,7 +285,7 @@ a { color:#4444ff; } ((1 boolean) <- le (4 literal) (3 literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 nil) +(if (~is memory*.1 nil) (prn "F - 'le' is the <= inequality operator")) (reset) @@ -332,7 +295,7 @@ a { color:#4444ff; } ((1 boolean) <- le (4 literal) (4 literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 t) +(if (~is memory*.1 t) (prn "F - 'le' returns true for equal operands")) (reset) @@ -342,10 +305,10 @@ a { color:#4444ff; } ((1 boolean) <- le (4 literal) (5 literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 t) +(if (~is memory*.1 t) (prn "F - le is the <= inequality operator - 2")) -; Control flow operations: jump, jump-if +; Control flow operations: jump, jump-if, jump-unless ; These introduce a new type -- 'offset' -- for literals that refer to memory ; locations relative to the current location. @@ -354,12 +317,12 @@ a { color:#4444ff; } (add-fns '((main ((1 integer) <- copy (8 literal)) - (jump (1 offset)) + (jump (1 offset)) ((2 integer) <- copy (3 literal)) ; should be skipped - (reply)))) + (reply)))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 8)) +(if (~iso memory* (obj 1 8)) (prn "F - 'jump' skips some instructions")) (reset) @@ -367,13 +330,13 @@ a { color:#4444ff; } (add-fns '((main ((1 integer) <- copy (8 literal)) - (jump (1 offset)) + (jump (1 offset)) ((2 integer) <- copy (3 literal)) ; should be skipped - (reply) + (reply) ((3 integer) <- copy (34 literal))))) ; never reached (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 8)) +(if (~iso memory* (obj 1 8)) (prn "F - 'jump' doesn't skip too many instructions")) ;? (quit) @@ -383,13 +346,13 @@ a { color:#4444ff; } '((main ((2 integer) <- copy (1 literal)) ((1 boolean) <- eq (1 literal) (2 integer)) - (jump-if (1 boolean) (1 offset)) + (jump-if (1 boolean) (1 offset)) ((2 integer) <- copy (3 literal)) - (reply) + (reply) ((3 integer) <- copy (34 literal))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 t 2 1)) +(if (~iso memory* (obj 1 t 2 1)) (prn "F - 'jump-if' is a conditional 'jump'")) (reset) @@ -397,13 +360,13 @@ a { color:#4444ff; } (add-fns '((main ((1 boolean) <- eq (1 literal) (2 literal)) - (jump-if (3 boolean) (1 offset)) + (jump-if (3 boolean) (1 offset)) ((2 integer) <- copy (3 literal)) - (reply) + (reply) ((3 integer) <- copy (34 literal))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 nil 2 3)) +(if (~iso memory* (obj 1 nil 2 3)) (prn "F - if 'jump-if's first arg is false, it doesn't skip any instructions")) (reset) @@ -415,13 +378,13 @@ a { color:#4444ff; } ; loop ((2 integer) <- add (2 integer) (2 integer)) ((3 boolean) <- eq (1 integer) (2 integer)) - (jump-if (3 boolean) (-3 offset)) ; to loop + (jump-if (3 boolean) (-3 offset)) ; to loop ((4 integer) <- copy (3 literal)) - (reply) + (reply) ((3 integer) <- copy (34 literal))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 2 2 4 3 nil 4 3)) +(if (~iso memory* (obj 1 2 2 4 3 nil 4 3)) (prn "F - 'jump-if' can take a negative offset to make backward jumps")) ; Data movement relies on addressing modes: @@ -436,7 +399,7 @@ a { color:#4444ff; } ((2 integer) <- copy (1 integer))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 34 2 34)) +(if (~iso memory* (obj 1 34 2 34)) (prn "F - 'copy' performs direct addressing")) ; 'Indirect' addressing refers to an address stored in a memory location. @@ -448,12 +411,12 @@ a { color:#4444ff; } (new-trace "indirect-addressing") (add-fns '((main - ((1 integer-address) <- copy (2 literal)) + ((1 integer-address) <- copy (2 literal)) ; unsafe; can't do this in general ((2 integer) <- copy (34 literal)) ((3 integer) <- copy (1 integer-address deref))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 2 2 34 3 34)) +(if (~iso memory* (obj 1 2 2 34 3 34)) (prn "F - 'copy' performs indirect addressing")) ; Output args can use indirect addressing. In the test below the value is @@ -468,14 +431,20 @@ a { color:#4444ff; } ((1 integer-address deref) <- add (2 integer) (2 literal))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 2 2 36)) +(if (~iso memory* (obj 1 2 2 36)) (prn "F - instructions can perform indirect addressing on output arg")) ; Until now we've dealt with scalar types like integers and booleans and -; addresses. We can also have compound types: arrays and records. +; addresses, where mu looks like other assembly languages. In addition, mu +; provides first-class support for compound types: arrays and records. ; ; 'get' accesses fields in records ; 'index' accesses indices in arrays +; +; Both operations require knowledge about the types being worked on, so all +; types used in mu programs are defined in a single global system-wide table +; (see types* in mu.arc for the complete list of types; we'll add to it over +; time). (reset) (new-trace "get-record") @@ -485,9 +454,10 @@ a { color:#4444ff; } ((2 boolean) <- copy (t literal)) ((3 boolean) <- get (1 integer-boolean-pair) (1 offset)) ((4 integer) <- get (1 integer-boolean-pair) (0 offset))))) +;? (set dump-trace*) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 34 2 nil 3 nil 4 34)) +(if (~iso memory* (obj 1 34 2 nil 3 nil 4 34)) (prn "F - 'get' accesses fields of records")) (reset) @@ -499,9 +469,10 @@ a { color:#4444ff; } ((3 integer-boolean-pair-address) <- copy (1 literal)) ((4 boolean) <- get (3 integer-boolean-pair-address deref) (1 offset)) ((5 integer) <- get (3 integer-boolean-pair-address deref) (0 offset))))) +;? (set dump-trace*) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 34 2 nil 3 1 4 nil 5 34)) +(if (~iso memory* (obj 1 34 2 nil 3 1 4 nil 5 34)) (prn "F - 'get' accesses fields of record address")) (reset) @@ -514,7 +485,7 @@ a { color:#4444ff; } ((4 integer-integer-pair) <- get (1 integer-point-pair) (1 offset))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 34 2 35 3 36 4 35 5 36)) +(if (~iso memory* (obj 1 34 2 35 3 36 4 35 5 36)) (prn "F - 'get' accesses fields spanning multiple locations")) (reset) @@ -522,11 +493,11 @@ a { color:#4444ff; } (add-fns '((main ((1 integer) <- copy (34 literal)) - ((2 integer) <- copy (t literal)) + ((2 boolean) <- copy (t literal)) ((3 boolean-address) <- get-address (1 integer-boolean-pair) (1 offset))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 34 2 t 3 2)) +(if (~iso memory* (obj 1 34 2 t 3 2)) (prn "F - 'get-address' returns address of fields of records")) (reset) @@ -534,16 +505,16 @@ a { color:#4444ff; } (add-fns '((main ((1 integer) <- copy (34 literal)) - ((2 integer) <- copy (t literal)) + ((2 boolean) <- copy (t literal)) ((3 integer-boolean-pair-address) <- copy (1 literal)) ((4 boolean-address) <- get-address (3 integer-boolean-pair-address deref) (1 offset))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 34 2 t 3 1 4 2)) +(if (~iso memory* (obj 1 34 2 t 3 1 4 2)) (prn "F - 'get-address' accesses fields of record address")) (reset) -(new-trace "index-array-literal") +(new-trace "index-literal") (add-fns '((main ((1 integer) <- copy (2 literal)) @@ -554,11 +525,12 @@ a { color:#4444ff; } ((6 integer-boolean-pair) <- index (1 integer-boolean-pair-array) (1 literal))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 24 7 t)) +(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 24 7 t)) (prn "F - 'index' accesses indices of arrays")) +;? (quit) (reset) -(new-trace "index-array-direct") +(new-trace "index-direct") (add-fns '((main ((1 integer) <- copy (2 literal)) @@ -570,8 +542,29 @@ a { color:#4444ff; } ((7 integer-boolean-pair) <- index (1 integer-boolean-pair-array) (6 integer))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 1 7 24 8 t)) +(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 1 7 24 8 t)) (prn "F - 'index' accesses indices of arrays")) +;? (quit) + +(reset) +(new-trace "index-indirect") +(add-fns + '((main + ((1 integer) <- copy (2 literal)) + ((2 integer) <- copy (23 literal)) + ((3 boolean) <- copy (t literal)) + ((4 integer) <- copy (24 literal)) + ((5 boolean) <- copy (t literal)) + ((6 integer) <- copy (1 literal)) + ((7 integer-boolean-pair-array-address) <- copy (1 literal)) + ((8 integer-boolean-pair) <- index (7 integer-boolean-pair-array-address deref) (6 integer))))) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) +;? (set dump-trace*) +(run 'main) +;? (prn memory*) +(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 1 7 1 8 24 9 t)) + (prn "F - 'index' accesses indices of array address")) +;? (quit) (reset) (new-trace "index-address") @@ -586,10 +579,25 @@ a { color:#4444ff; } ((7 integer-boolean-pair-address) <- index-address (1 integer-boolean-pair-array) (6 integer))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 1 7 4)) +(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 1 7 4)) (prn "F - 'index-address' returns addresses of indices of arrays")) -; todo: test that out-of-bounds access throws an error +(reset) +(new-trace "index-address-indirect") +(add-fns + '((main + ((1 integer) <- copy (2 literal)) + ((2 integer) <- copy (23 literal)) + ((3 boolean) <- copy (t literal)) + ((4 integer) <- copy (24 literal)) + ((5 boolean) <- copy (t literal)) + ((6 integer) <- copy (1 literal)) + ((7 integer-boolean-pair-array-address) <- copy (1 literal)) + ((8 integer-boolean-pair-address) <- index-address (7 integer-boolean-pair-array-address deref) (6 integer))))) +(run 'main) +;? (prn memory*) +(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 1 7 1 8 4)) + (prn "F - 'index-address' returns addresses of indices of array addresses")) ; Array values know their length. Record lengths are saved in the types table. @@ -605,9 +613,27 @@ a { color:#4444ff; } ((6 integer) <- len (1 integer-boolean-pair-array))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 2)) +(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 2)) (prn "F - 'len' accesses length of array")) +(reset) +(new-trace "len-array-indirect") +(add-fns + '((main + ((1 integer) <- copy (2 literal)) + ((2 integer) <- copy (23 literal)) + ((3 boolean) <- copy (t literal)) + ((4 integer) <- copy (24 literal)) + ((5 boolean) <- copy (t literal)) + ((6 integer-address) <- copy (1 literal)) + ((7 integer) <- len (6 integer-boolean-pair-array-address deref))))) +;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) +(run 'main) +;? (prn memory*) +(if (~iso memory* (obj 1 2 2 23 3 nil 4 24 5 t 6 1 7 2)) + (prn "F - 'len' accesses length of array address")) + ; 'sizeof' is a helper to determine the amount of memory required by a type. (reset) @@ -617,7 +643,7 @@ a { color:#4444ff; } ((1 integer) <- sizeof (integer-boolean-pair literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 2) +(if (~is memory*.1 2) (prn "F - 'sizeof' returns space required by arg")) (reset) @@ -627,7 +653,7 @@ a { color:#4444ff; } ((1 integer) <- sizeof (integer-point-pair literal))))) (run 'main) ;? (prn memory*) -(if (~is memory*.1 3) +(if (~is memory*.1 3) (prn "F - 'sizeof' is different from number of elems")) ; Regardless of a type's length, you can move it around just like a primitive. @@ -642,28 +668,28 @@ a { color:#4444ff; } ((3 integer-boolean-pair) <- copy (1 integer-boolean-pair))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 34 2 nil 3 34 4 nil)) +(if (~iso memory* (obj 1 34 2 nil 3 34 4 nil)) (prn "F - ops can operate on records spanning multiple locations")) (reset) (new-trace "compound-arg") (add-fns '((test1 - ((4 integer-boolean-pair) <- arg)) + ((4 integer-boolean-pair) <- arg)) (main ((1 integer) <- copy (34 literal)) ((2 boolean) <- copy (t literal)) (test1 (1 integer-boolean-pair))))) (run 'main) -(if (~iso memory* (obj 1 34 2 nil 4 34 5 nil)) +(if (~iso memory* (obj 1 34 2 nil 4 34 5 nil)) (prn "F - 'arg' can copy records spanning multiple locations")) (reset) -(new-trace "compound-arg") +(new-trace "compound-arg-indirect") ;? (set dump-trace*) (add-fns '((test1 - ((4 integer-boolean-pair) <- arg)) + ((4 integer-boolean-pair) <- arg)) (main ((1 integer) <- copy (34 literal)) ((2 boolean) <- copy (t literal)) @@ -671,17 +697,21 @@ a { color:#4444ff; } (test1 (3 integer-boolean-pair-address deref))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 34 2 nil 3 1 4 34 5 nil)) +(if (~iso memory* (obj 1 34 2 nil 3 1 4 34 5 nil)) (prn "F - 'arg' can copy records spanning multiple locations in indirect mode")) ; A special kind of record is the 'tagged type'. It lets us represent ; dynamically typed values, which save type information in memory rather than ; in the code to use them. This will let us do things like create heterogenous -; lists containing both integers and strings. +; lists containing both integers and strings. Tagged values admit two +; operations: +; +; 'save-type' - turns a regular value into a tagged-value of the appropriate type +; 'maybe-coerce' - turns a tagged value into a regular value if the type matches (reset) (new-trace "tagged-value") -;? (set dump-trace*) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) (add-fns '((main ((1 type) <- copy (integer-address literal)) @@ -689,8 +719,12 @@ a { color:#4444ff; } ((3 integer-address) (4 boolean) <- maybe-coerce (1 tagged-value) (integer-address literal))))) (run 'main) ;? (prn memory*) -(if (or (~is memory*.3 34) (~is memory*.4 t)) +;? (prn completed-routines*) +(let last-routine (deq completed-routines*) + (aif rep.last-routine!error (prn "error - " it))) +(if (or (~is memory*.3 34) (~is memory*.4 t)) (prn "F - 'maybe-coerce' copies value only if type tag matches")) +;? (quit) (reset) (new-trace "tagged-value-2") @@ -702,21 +736,33 @@ a { color:#4444ff; } ((3 integer-address) (4 boolean) <- maybe-coerce (1 tagged-value) (boolean-address literal))))) (run 'main) ;? (prn memory*) -(if (or (~is memory*.3 0) (~is memory*.4 nil)) +(if (or (~is memory*.3 0) (~is memory*.4 nil)) (prn "F - 'maybe-coerce' doesn't copy value when type tag doesn't match")) +(reset) +(new-trace "save-type") +(add-fns + '((main + ((1 integer-address) <- copy (34 literal)) ; pointer to nowhere + ((2 tagged-value) <- save-type (1 integer-address))))) +(run 'main) +;? (prn memory*) +(if (~iso memory* (obj 1 34 2 'integer-address 3 34)) + (prn "F - 'save-type' saves the type of a value at runtime, turning it into a tagged-value")) + (reset) (new-trace "new-tagged-value") -;? (set dump-trace*) (add-fns '((main ((1 integer-address) <- copy (34 literal)) ; pointer to nowhere ((2 tagged-value-address) <- new-tagged-value (integer-address literal) (1 integer-address)) ((3 integer-address) (4 boolean) <- maybe-coerce (2 tagged-value-address deref) (integer-address literal))))) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1" "sizeof"))) (run 'main) ;? (prn memory*) -(if (or (~is memory*.3 34) (~is memory*.4 t)) +(if (or (~is memory*.3 34) (~is memory*.4 t)) (prn "F - 'new-tagged-value' is the converse of 'maybe-coerce'")) +;? (quit) ; Now that we can record types for values we can construct a dynamically typed ; list. @@ -727,46 +773,76 @@ a { color:#4444ff; } (add-fns '((test1 ; 1 points at first node: tagged-value (int 34) - ((1 list-address) <- new (list type)) + ((1 list-address) <- new (list literal)) ((2 tagged-value-address) <- list-value-address (1 list-address)) ((3 type-address) <- get-address (2 tagged-value-address deref) (0 offset)) ((3 type-address deref) <- copy (integer literal)) ((4 location) <- get-address (2 tagged-value-address deref) (1 offset)) ((4 location deref) <- copy (34 literal)) ((5 list-address-address) <- get-address (1 list-address deref) (1 offset)) - ((5 list-address-address deref) <- new (list type)) + ((5 list-address-address deref) <- new (list literal)) ; 6 points at second node: tagged-value (boolean t) ((6 list-address) <- copy (5 list-address-address deref)) ((7 tagged-value-address) <- list-value-address (6 list-address)) ((8 type-address) <- get-address (7 tagged-value-address deref) (0 offset)) ((8 type-address deref) <- copy (boolean literal)) ((9 location) <- get-address (7 tagged-value-address deref) (1 offset)) - ((9 location deref) <- copy (t literal))))) + ((9 location deref) <- copy (t literal)) + ((10 list-address) <- get (6 list-address deref) (1 offset)) + ))) (let first Memory-in-use-until (run 'test1) ;? (prn memory*) - (if (or (~all first (map memory* '(1 2 3))) - (~is memory*.first 'integer) - (~is memory*.4 (+ first 1)) - (~is (memory* (+ first 1)) 34) - (~is memory*.5 (+ first 2)) - (let second memory*.6 - (~is (memory* (+ first 2)) second) - (~all second (map memory* '(6 7 8))) - (~is memory*.second 'boolean) - (~is memory*.9 (+ second 1)) - (~is (memory* (+ second 1)) t))) - (prn "F - 'list' constructs a heterogeneous list, which can contain elements of different types"))) + (if (or (~all first (map memory* '(1 2 3))) + (~is memory*.first 'integer) + (~is memory*.4 (+ first 1)) + (~is (memory* (+ first 1)) 34) + (~is memory*.5 (+ first 2)) + (let second memory*.6 + (or + (~is (memory* (+ first 2)) second) + (~all second (map memory* '(6 7 8))) + (~is memory*.second 'boolean) + (~is memory*.9 (+ second 1)) + (~is (memory* (+ second 1)) t) + (~is memory*.10 nil)))) + (prn "F - lists can contain elements of different types"))) (add-fns '((test2 ((10 list-address) <- list-next (1 list-address))))) (run 'test2) ;? (prn memory*) -(if (~is memory*.10 memory*.6) +(if (~is memory*.10 memory*.6) (prn "F - 'list-next can move a list pointer to the next node")) +; 'new-list' takes a variable number of args and constructs a list containing +; them. + +(reset) +(new-trace "new-list") +(add-fns + '((main + ((1 integer) <- new-list (3 literal) (4 literal) (5 literal))))) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1" "sizeof"))) +(run 'main) +;? (prn memory*) +(let first memory*.1 +;? (prn first) + (if (or (~is memory*.first 'integer) + (~is (memory* (+ first 1)) 3) + (let second (memory* (+ first 2)) +;? (prn second) + (or (~is memory*.second 'integer) + (~is (memory* (+ second 1)) 4) + (let third (memory* (+ second 2)) +;? (prn third) + (or (~is memory*.third 'integer) + (~is (memory* (+ third 1)) 5) + (~is (memory* (+ third 2) nil))))))) + (prn "F - 'new-list' can construct a list of integers"))) + ; 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 +; 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. (reset) @@ -780,7 +856,7 @@ a { color:#4444ff; } (test1)))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 1 2 3 3 4)) +(if (~iso memory* (obj 1 1 2 3 3 4)) (prn "F - calling a user-defined function runs its instructions")) ;? (quit) @@ -806,7 +882,7 @@ a { color:#4444ff; } (add-fns '((test1 ((3 integer) <- add (1 integer) (2 integer)) - (reply) + (reply) ((4 integer) <- copy (34 literal))) (main ((1 integer) <- copy (1 literal)) @@ -814,7 +890,7 @@ a { color:#4444ff; } (test1)))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 1 2 3 3 4)) +(if (~iso memory* (obj 1 1 2 3 3 4)) (prn "F - 'reply' stops executing the current function")) ;? (quit) @@ -824,13 +900,13 @@ a { color:#4444ff; } `((test1 ((3 integer) <- test2)) (test2 - (reply (2 integer))) + (reply (2 integer))) (main ((2 integer) <- copy (34 literal)) (test1)))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 2 34 3 34)) +(if (~iso memory* (obj 2 34 3 34)) (prn "F - 'reply' stops executing any callers as necessary")) ;? (quit) @@ -839,7 +915,7 @@ a { color:#4444ff; } (add-fns '((test1 ((3 integer) <- add (1 integer) (2 integer)) - (reply) + (reply) ((4 integer) <- copy (34 literal))) (main ((1 integer) <- copy (1 literal)) @@ -853,10 +929,10 @@ a { color:#4444ff; } (new-trace "new-fn-arg-sequential") (add-fns '((test1 - ((4 integer) <- arg) - ((5 integer) <- arg) + ((4 integer) <- arg) + ((5 integer) <- arg) ((3 integer) <- add (4 integer) (5 integer)) - (reply) + (reply) ((4 integer) <- copy (34 literal))) (main ((1 integer) <- copy (1 literal)) @@ -865,7 +941,7 @@ a { color:#4444ff; } ))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 1 2 3 3 4 +(if (~iso memory* (obj 1 1 2 3 3 4 ; add-fn's temporaries 4 1 5 3)) (prn "F - 'arg' accesses in order the operands of the most recent function call (the caller)")) @@ -873,12 +949,13 @@ a { color:#4444ff; } (reset) (new-trace "new-fn-arg-random-access") +;? (set dump-trace*) (add-fns '((test1 - ((5 integer) <- arg 1) - ((4 integer) <- arg 0) + ((5 integer) <- arg (1 literal)) + ((4 integer) <- arg (0 literal)) ((3 integer) <- add (4 integer) (5 integer)) - (reply) + (reply) ((4 integer) <- copy (34 literal))) ; should never run (main ((1 integer) <- copy (1 literal)) @@ -887,7 +964,7 @@ a { color:#4444ff; } ))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 1 2 3 3 4 +(if (~iso memory* (obj 1 1 2 3 3 4 ; add-fn's temporaries 4 1 5 3)) (prn "F - 'arg' with index can access function call arguments out of order")) @@ -897,13 +974,13 @@ a { color:#4444ff; } (new-trace "new-fn-arg-status") (add-fns '((test1 - ((4 integer) (5 boolean) <- arg)) + ((4 integer) (5 boolean) <- arg)) (main (test1 (1 literal)) ))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 4 1 5 t)) +(if (~iso memory* (obj 4 1 5 t)) (prn "F - 'arg' sets a second oarg when arg exists")) ;? (quit) @@ -911,14 +988,14 @@ a { color:#4444ff; } (new-trace "new-fn-arg-missing") (add-fns '((test1 - ((4 integer) <- arg) - ((5 integer) <- arg)) + ((4 integer) <- arg) + ((5 integer) <- arg)) (main (test1 (1 literal)) ))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 4 1)) +(if (~iso memory* (obj 4 1)) (prn "F - missing 'arg' doesn't cause error")) ;? (quit) @@ -926,14 +1003,14 @@ a { color:#4444ff; } (new-trace "new-fn-arg-missing-2") (add-fns '((test1 - ((4 integer) <- arg) - ((5 integer) (6 boolean) <- arg)) + ((4 integer) <- arg) + ((5 integer) (6 boolean) <- arg)) (main (test1 (1 literal)) ))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 4 1 6 nil)) +(if (~iso memory* (obj 4 1 6 nil)) (prn "F - missing 'arg' wipes second oarg when provided")) ;? (quit) @@ -941,49 +1018,61 @@ a { color:#4444ff; } (new-trace "new-fn-arg-missing-3") (add-fns '((test1 - ((4 integer) <- arg) + ((4 integer) <- arg) ((5 integer) <- copy (34 literal)) - ((5 integer) (6 boolean) <- arg)) + ((5 integer) (6 boolean) <- arg)) (main (test1 (1 literal)) ))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 4 1 6 nil)) +(if (~iso memory* (obj 4 1 6 nil)) (prn "F - missing 'arg' consistently wipes its oarg")) ;? (quit) (reset) -(new-trace "new-fn-arg-missing-3") +(new-trace "new-fn-arg-missing-4") (add-fns '((test1 ; if given two args, adds them; if given one arg, increments - ((4 integer) <- arg) - ((5 integer) (6 boolean) <- arg) + ((4 integer) <- arg) + ((5 integer) (6 boolean) <- arg) { begin - (break-if (6 boolean)) + (break-if (6 boolean)) ((5 integer) <- copy (1 literal)) - } + } ((7 integer) <- add (4 integer) (5 integer))) (main (test1 (34 literal)) ))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 4 34 5 1 6 nil 7 35)) +(if (~iso memory* (obj 4 34 5 1 6 nil 7 35)) (prn "F - function with optional second arg")) ;? (quit) -; how should errors be handled? will be unclear until we support concurrency and routine trees. +(reset) +(new-trace "new-fn-arg-by-value") +(add-fns + '((test1 + ((1 integer) <- copy (0 literal)) ; overwrite caller memory + ((2 integer) <- arg)) ; arg not clobbered + (main + ((1 integer) <- copy (34 literal)) + (test1 (1 integer))))) +(run 'main) +;? (prn memory*) +(if (~iso memory* (obj 1 0 2 34)) + (prn "F - 'arg' passes by value")) (reset) (new-trace "new-fn-reply-oarg") (add-fns '((test1 - ((4 integer) <- arg) - ((5 integer) <- arg) + ((4 integer) <- arg) + ((5 integer) <- arg) ((6 integer) <- add (4 integer) (5 integer)) - (reply (6 integer)) + (reply (6 integer)) ((4 integer) <- copy (34 literal))) (main ((1 integer) <- copy (1 literal)) @@ -991,7 +1080,7 @@ a { color:#4444ff; } ((3 integer) <- test1 (1 integer) (2 integer))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 1 2 3 3 4 +(if (~iso memory* (obj 1 1 2 3 3 4 ; add-fn's temporaries 4 1 5 3 6 4)) (prn "F - 'reply' can take aguments that are returned, or written back into output args of caller")) @@ -1000,10 +1089,10 @@ a { color:#4444ff; } (new-trace "new-fn-reply-oarg-multiple") (add-fns '((test1 - ((4 integer) <- arg) - ((5 integer) <- arg) + ((4 integer) <- arg) + ((5 integer) <- arg) ((6 integer) <- add (4 integer) (5 integer)) - (reply (6 integer) (5 integer)) + (reply (6 integer) (5 integer)) ((4 integer) <- copy (34 literal))) (main ((1 integer) <- copy (1 literal)) @@ -1011,11 +1100,32 @@ a { color:#4444ff; } ((3 integer) (7 integer) <- test1 (1 integer) (2 integer))))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 1 2 3 3 4 7 3 +(if (~iso memory* (obj 1 1 2 3 3 4 7 3 ; add-fn's temporaries 4 1 5 3 6 4)) (prn "F - 'reply' permits a function to return multiple values at once")) +(reset) +(new-trace "new-fn-prepare-reply") +(add-fns + '((test1 + ((4 integer) <- arg) + ((5 integer) <- arg) + ((6 integer) <- add (4 integer) (5 integer)) + (prepare-reply (6 integer) (5 integer)) + (reply) + ((4 integer) <- copy (34 literal))) + (main + ((1 integer) <- copy (1 literal)) + ((2 integer) <- copy (3 literal)) + ((3 integer) (7 integer) <- test1 (1 integer) (2 integer))))) +(run 'main) +;? (prn memory*) +(if (~iso memory* (obj 1 1 2 3 3 4 7 3 + ; add-fn's temporaries + 4 1 5 3 6 4)) + (prn "F - without args, 'reply' returns values from previous 'prepare-reply'.")) + ; 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: @@ -1042,19 +1152,19 @@ a { color:#4444ff; } ((2 integer) <- copy (2 literal)) ((3 integer) <- add (2 integer) (2 integer)) { 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))) + ((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)) ((3 integer) <- add (2 integer) (2 integer)) ((4 boolean) <- neq (1 integer) (3 integer)) - (jump-if (4 boolean) (1 offset)) + (jump-if (4 boolean) (1 offset)) ((5 integer) <- copy (34 literal)) - (reply))) - (prn "F - convert-braces replaces break-if with a jump-if to after the next close curly")) + (reply))) + (prn "F - convert-braces replaces break-if with a jump-if to after the next close-curly")) (reset) (new-trace "convert-braces-empty-block") @@ -1063,14 +1173,14 @@ a { color:#4444ff; } ((2 integer) <- copy (2 literal)) ((3 integer) <- add (2 integer) (2 integer)) { begin - (break) + (break) } - (reply))) + (reply))) '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) ((3 integer) <- add (2 integer) (2 integer)) - (jump (0 offset)) - (reply))) + (jump (0 offset)) + (reply))) (prn "F - convert-braces works for degenerate blocks")) (reset) @@ -1079,21 +1189,21 @@ 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)) + (break-if (4 boolean)) { begin ((5 integer) <- copy (34 literal)) } } - (reply))) + (reply))) '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) ((3 integer) <- add (2 integer) (2 integer)) ((4 boolean) <- neq (1 integer) (3 integer)) - (jump-if (4 boolean) (1 offset)) + (jump-if (4 boolean) (1 offset)) ((5 integer) <- copy (34 literal)) - (reply))) + (reply))) (prn "F - convert-braces balances curlies when converting break")) (reset) @@ -1106,17 +1216,17 @@ a { color:#4444ff; } { begin ((4 boolean) <- neq (1 integer) (3 integer)) } - (continue-if (4 boolean)) + (continue-if (4 boolean)) ((5 integer) <- copy (34 literal)) } - (reply))) + (reply))) '(((1 integer) <- copy (4 literal)) ((2 integer) <- copy (2 literal)) ((3 integer) <- add (2 integer) (2 integer)) ((4 boolean) <- neq (1 integer) (3 integer)) - (jump-if (4 boolean) (-3 offset)) + (jump-if (4 boolean) (-3 offset)) ((5 integer) <- copy (34 literal)) - (reply))) + (reply))) (prn "F - convert-braces balances curlies when converting continue")) (reset) @@ -1129,15 +1239,15 @@ a { color:#4444ff; } { begin ((2 integer) <- add (2 integer) (2 integer)) ((3 boolean) <- neq (1 integer) (2 integer)) - (continue-if (3 boolean)) + (continue-if (3 boolean)) ((4 integer) <- copy (34 literal)) } - (reply)))) + (reply)))) ;? (each stmt function*!main ;? (prn stmt)) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 4 2 4 3 nil 4 34)) +(if (~iso memory* (obj 1 4 2 4 3 nil 4 34)) (prn "F - continue correctly loops")) ; todo: fuzz-test invariant: convert-braces offsets should be robust to any @@ -1155,15 +1265,15 @@ a { color:#4444ff; } { begin ((3 boolean) <- neq (1 integer) (2 integer)) } - (continue-if (3 boolean)) + (continue-if (3 boolean)) ((4 integer) <- copy (34 literal)) } - (reply)))) + (reply)))) ;? (each stmt function*!main ;? (prn stmt)) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 4 2 4 3 nil 4 34)) +(if (~iso memory* (obj 1 4 2 4 3 nil 4 34)) (prn "F - continue correctly loops")) (reset) @@ -1177,40 +1287,242 @@ a { color:#4444ff; } { begin ((3 boolean) <- neq (1 integer) (2 integer)) } - (continue-if (3 boolean)) + (continue-if (3 boolean)) ((4 integer) <- copy (34 literal)) } - (reply)))) + (reply)))) (run 'main) ;? (prn memory*) -(if (~iso memory* (obj 1 4 2 4 3 nil 4 34)) +(if (~iso memory* (obj 1 4 2 4 3 nil 4 34)) (prn "F - continue might never trigger")) -; using tagged-values you can define generic functions that run different code -; based on the types of their args. +; 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") +(if (~iso (convert-names + '(((x integer) <- copy (4 literal)) + ((y integer) <- copy (2 literal)) + ((z integer) <- add (x integer) (y integer)))) + '(((1 integer) <- copy (4 literal)) + ((2 integer) <- copy (2 literal)) + ((3 integer) <- add (1 integer) (2 integer)))) + (prn "F - convert-names renames symbolic names to integer locations")) + +(reset) +(new-trace "convert-names-nil") +(if (~iso (convert-names + '(((x integer) <- copy (4 literal)) + ((y integer) <- copy (2 literal)) + ((nil integer) <- add (x integer) (y integer)))) + '(((1 integer) <- copy (4 literal)) + ((2 integer) <- copy (2 literal)) + ((nil integer) <- add (1 integer) (2 integer)))) + (prn "F - convert-names never renames nil")) + +; 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 +; feel the need for it. + +(reset) +(new-trace "new-primitive") +(add-fns + '((main + ((1 integer-address) <- new (integer literal))))) +(let before Memory-in-use-until + (run 'main) +;? (prn memory*) + (if (~iso memory*.1 before) + (prn "F - 'new' returns current high-water mark")) + (if (~iso Memory-in-use-until (+ before 1)) + (prn "F - 'new' on primitive types increments high-water mark by their size"))) + +(reset) +(new-trace "new-array-literal") +(add-fns + '((main + ((1 type-array-address) <- new (type-array literal) (5 literal))))) +(let before Memory-in-use-until + (run 'main) +;? (prn memory*) + (if (~iso memory*.1 before) + (prn "F - 'new' on array with literal size returns current high-water mark")) + (if (~iso Memory-in-use-until (+ before 6)) + (prn "F - 'new' on primitive arrays increments high-water mark by their size"))) + +(reset) +(new-trace "new-array-direct") +(add-fns + '((main + ((1 integer) <- copy (5 literal)) + ((2 type-array-address) <- new (type-array literal) (1 integer))))) +(let before Memory-in-use-until + (run 'main) +;? (prn memory*) + (if (~iso memory*.2 before) + (prn "F - 'new' on array with variable size returns current high-water mark")) + (if (~iso Memory-in-use-until (+ before 6)) + (prn "F - 'new' on primitive arrays increments high-water mark by their (variable) size"))) + +; Even though our memory locations can now have names, the names are all +; globals, accessible from any function. To isolate functions from their +; callers we need local variables, and mu provides them using a special +; variable called default-scope. When you initialize such a variable (likely +; with a call to our just-defined memory allocator) mu interprets memory +; locations as offsets from its value. If default-scope is set to 1000, for +; example, reads and writes to memory location 1 will really go to 1001. +; +; 'default-scope' is itself hard-coded to be function-local; it's nil in a new +; function, and it's restored when functions return to their callers. But the +; actual scope allocation is independent. So you can define closures, or do +; even more funky things like share locals between two coroutines. + +(reset) +(new-trace "set-default-scope") +(add-fns + '((main + ((default-scope scope-address) <- new (scope literal) (2 literal)) + ((1 integer) <- copy (23 literal))))) +(let before Memory-in-use-until +;? (set dump-trace*) + (run 'main) +;? (prn memory*) + (if (~and (~is 23 memory*.1) + (is 23 (memory* (+ before 1)))) + (prn "F - default-scope implicitly modifies variable locations"))) + +(reset) +(new-trace "set-default-scope-skips-offset") +(add-fns + '((main + ((default-scope scope-address) <- new (scope literal) (2 literal)) + ((1 integer) <- copy (23 offset))))) +(let before Memory-in-use-until +;? (set dump-trace*) + (run 'main) +;? (prn memory*) + (if (~and (~is 23 memory*.1) + (is 23 (memory* (+ before 1)))) + (prn "F - default-scope skips 'offset' types just like literals"))) + +(reset) +(new-trace "default-scope-bounds-check") +(add-fns + '((main + ((default-scope scope-address) <- new (scope literal) (2 literal)) + ((2 integer) <- copy (23 literal))))) +;? (set dump-trace*) +(run 'main) +;? (prn memory*) +(let last-routine (deq completed-routines*) + (if (no rep.last-routine!error) + (prn "F - default-scope checks bounds"))) + +(reset) +(new-trace "default-scope-and-get-indirect") +(add-fns + '((main + ((default-scope scope-address) <- new (scope literal) (5 literal)) + ((1 integer-boolean-pair-address) <- new (integer-boolean-pair literal)) + ((2 integer-address) <- get-address (1 integer-boolean-pair-address deref) (0 offset)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 integer global) <- get (1 integer-boolean-pair-address deref) (0 offset))))) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) +(run 'main) +;? (prn memory*) +;? (prn (as cons completed-routines*)) +(let last-routine (deq completed-routines*) + (aif rep.last-routine!error (prn "error - " it))) +(if (~is 34 memory*.3) + (prn "F - indirect 'get' works in the presence of default-scope")) +;? (quit) + +(reset) +(new-trace "default-scope-and-index-indirect") +(add-fns + '((main + ((default-scope scope-address) <- new (scope literal) (5 literal)) + ((1 integer-array-address) <- new (integer-array literal) (4 literal)) + ((2 integer-address) <- index-address (1 integer-array-address deref) (2 offset)) + ((2 integer-address deref) <- copy (34 literal)) + ((3 integer global) <- index (1 integer-array-address deref) (2 offset))))) +;? (= dump-trace* (obj blacklist '("sz" "m" "setm" "addr" "cvt0" "cvt1"))) +(run 'main) +;? (prn memory*) +;? (prn (as cons completed-routines*)) +(let last-routine (deq completed-routines*) + (aif rep.last-routine!error (prn "error - " it))) +(if (~is 34 memory*.3) + (prn "F - indirect 'index' works in the presence of default-scope")) +;? (quit) + +(reset) +(new-trace "convert-names-default-scope") +(if (~iso (convert-names + '(((x integer) <- copy (4 literal)) + ((y integer) <- copy (2 literal)) + ; unsafe in general; don't write random values to 'default-scope' + ((default-scope integer) <- add (x integer) (y integer)))) + '(((1 integer) <- copy (4 literal)) + ((2 integer) <- copy (2 literal)) + ((default-scope integer) <- add (1 integer) (2 integer)))) + (prn "F - convert-names never renames default-scope")) + +(reset) +(new-trace "suppress-default-scope") +(add-fns + '((main + ((default-scope scope-address) <- new (scope literal) (2 literal)) + ((1 integer global) <- copy (23 literal))))) +(let before Memory-in-use-until +;? (set dump-trace*) + (run 'main) +;? (prn memory*) + (if (~and (is 23 memory*.1) + (~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")) + +; Putting it all together, here's how you define generic functions that run +; different code based on the types of their args. (reset) (new-trace "dispatch-clause") ;? (set dump-trace*) (add-fns - '((test1 - ((4 tagged-value-address) <- arg) + '((test1 + ((default-scope scope-address) <- new (scope literal) (20 literal)) + ((first-arg-box tagged-value-address) <- arg) + ; if given integers, add them { begin - ((5 integer) (6 boolean) <- maybe-coerce (4 tagged-value-address deref) (integer literal)) - (break-unless (6 boolean)) - ((7 tagged-value-address) <- arg) - ((8 integer) (9 boolean) <- maybe-coerce (7 tagged-value-address deref) (integer literal)) - ((9 integer) <- add (5 integer) (8 integer)) - (reply (9 integer)) + ((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))) + (reply (t literal))) (main ((1 tagged-value-address) <- new-tagged-value (integer literal) (34 literal)) ((2 tagged-value-address) <- new-tagged-value (integer literal) (3 literal)) ((3 integer) <- test1 (1 tagged-value-address) (2 tagged-value-address))))) (run 'main) ;? (prn memory*) -(if (~is memory*.3 37) +(if (~is memory*.3 37) (prn "F - an example function that checks that its oarg is an integer")) ;? (quit) @@ -1221,24 +1533,27 @@ a { color:#4444ff; } ;? (set dump-trace*) (add-fns '((test1 - ((4 tagged-value-address) <- arg) + ((default-scope scope-address) <- new (scope literal) (20 literal)) + ((first-arg-box tagged-value-address) <- arg) + ; if given integers, add them { begin - ((5 integer) (6 boolean) <- maybe-coerce (4 tagged-value-address deref) (integer literal)) - (break-unless (6 boolean)) - ((7 tagged-value-address) <- arg) - ((8 integer) (9 boolean) <- maybe-coerce (7 tagged-value-address deref) (integer literal)) - ((9 integer) <- add (5 integer) (8 integer)) - (reply (9 integer)) + ((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 - ((5 boolean) (6 boolean) <- maybe-coerce (4 tagged-value-address deref) (boolean literal)) - (break-unless (6 boolean)) - ((7 tagged-value-address) <- arg) - ((8 boolean) (9 boolean) <- maybe-coerce (7 tagged-value-address deref) (boolean literal)) - ((9 boolean) <- or (5 boolean) (8 boolean)) - (reply (9 boolean)) + ((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))) + (reply (t literal))) (main ((1 tagged-value-address) <- new-tagged-value (boolean literal) (t literal)) ((2 tagged-value-address) <- new-tagged-value (boolean literal) (t literal)) @@ -1248,7 +1563,7 @@ a { color:#4444ff; } (run 'main) ;? (wipe dump-trace*) ;? (prn memory*) -(if (~is memory*.3 t) +(if (~is memory*.3 t) (prn "F - an example function that can do different things (dispatch) based on the type of its args or oargs")) ;? (quit) @@ -1256,24 +1571,27 @@ a { color:#4444ff; } (new-trace "dispatch-multiple-calls") (add-fns '((test1 - ((4 tagged-value-address) <- arg) + ((default-scope scope-address) <- new (scope literal) (20 literal)) + ((first-arg-box tagged-value-address) <- arg) + ; if given integers, add them { begin - ((5 integer) (6 boolean) <- maybe-coerce (4 tagged-value-address deref) (integer literal)) - (break-unless (6 boolean)) - ((7 tagged-value-address) <- arg) - ((8 integer) (9 boolean) <- maybe-coerce (7 tagged-value-address deref) (integer literal)) - ((9 integer) <- add (5 integer) (8 integer)) - (reply (9 integer)) + ((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 - ((5 boolean) (6 boolean) <- maybe-coerce (4 tagged-value-address deref) (boolean literal)) - (break-unless (6 boolean)) - ((7 tagged-value-address) <- arg) - ((8 boolean) (9 boolean) <- maybe-coerce (7 tagged-value-address deref) (boolean literal)) - ((9 boolean) <- or (5 boolean) (8 boolean)) - (reply (9 boolean)) + ((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))) + (reply (t literal))) (main ((1 tagged-value-address) <- new-tagged-value (boolean literal) (t literal)) ((2 tagged-value-address) <- new-tagged-value (boolean literal) (t literal)) @@ -1283,55 +1601,15 @@ a { color:#4444ff; } ((12 integer) <- test1 (10 tagged-value-address) (11 tagged-value-address))))) (run 'main) ;? (prn memory*) -(if (~and (is memory*.3 t) (is memory*.12 37)) +(if (~and (is memory*.3 t) (is memory*.12 37)) (prn "F - different calls can exercise different clauses of the same function")) -; A rudimentary memory allocator. Eventually we want to write this in mu. - -(reset) -(new-trace "new-primitive") -(let before Memory-in-use-until - (add-fns - '((main - ((1 integer-address) <- new (integer type))))) - (run 'main) - ;? (prn memory*) - (if (~iso memory*.1 before) - (prn "F - 'new' returns current high-water mark")) - (if (~iso Memory-in-use-until (+ before 1)) - (prn "F - 'new' on primitive types increments high-water mark by their size"))) - -(reset) -(new-trace "new-array-literal") -(let before Memory-in-use-until - (add-fns - '((main - ((1 type-array-address) <- new (type-array type) (5 literal))))) - (run 'main) - ;? (prn memory*) - (if (~iso memory*.1 before) - (prn "F - 'new' on array with literal size returns current high-water mark")) - (if (~iso Memory-in-use-until (+ before 6)) - (prn "F - 'new' on primitive arrays increments high-water mark by their size"))) - -(reset) -(new-trace "new-array-direct") -(let before Memory-in-use-until - (add-fns - '((main - ((1 integer) <- copy (5 literal)) - ((2 type-array-address) <- new (type-array type) (1 integer))))) - (run 'main) - ;? (prn memory*) - (if (~iso memory*.2 before) - (prn "F - 'new' on array with variable size returns current high-water mark")) - (if (~iso Memory-in-use-until (+ before 6)) - (prn "F - 'new' on primitive arrays increments high-water mark by their (variable) size"))) - ; A rudimentary process scheduler. You can 'run' multiple functions at once, ; and they share the virtual processor. +; ; There's also a 'fork' primitive to let functions create new threads of -; execution. +; execution (we call them routines). +; ; Eventually we want to allow callers to influence how much of their CPU they ; give to their 'children', or to rescind a child's running privileges. @@ -1345,8 +1623,8 @@ a { color:#4444ff; } (let ninsts (run 'f1 'f2) (when (~iso 2 ninsts) (prn "F - scheduler didn't run the right number of instructions: " ninsts))) -(if (~iso memory* (obj 1 3 2 4)) - (prn "F - scheduler runs multiple functions: " memory*)) +(if (~iso memory* (obj 1 3 2 4)) + (prn "F - scheduler runs multiple functions: " memory*)) (check-trace-contents "scheduler orders functions correctly" '(("schedule" "f1") ("schedule" "f2") @@ -1358,13 +1636,54 @@ a { color:#4444ff; } ("run" "f2 0") )) -; The scheduler needs to keep track of the call stack for each thread. +; 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. ; ; Eventually we want the right stack-management primitives to build delimited ; continuations in mu. +; Routines can throw errors. +(reset) +(new-trace "array-bounds-check") +(add-fns + '((main + ((1 integer) <- copy (2 literal)) + ((2 integer) <- copy (23 literal)) + ((3 integer) <- copy (24 literal)) + ((4 integer) <- index (1 integer-array) (2 literal))))) +;? (set dump-trace*) +(run 'main) +;? (prn memory*) +(let last-routine (deq completed-routines*) + (if (no rep.last-routine!error) + (prn "F - 'index' throws an error if out of bounds"))) + +; 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'. +; +; 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") +(if (~iso (convert-quotes + '(((1 integer) <- copy (4 literal)) + (defer [ + ((3 integer) <- copy (6 literal)) + ]) + ((2 integer) <- copy (5 literal)))) + '(((1 integer) <- copy (4 literal)) + ((2 integer) <- copy (5 literal)) + ((3 integer) <- copy (6 literal)))) + (prn "F - convert-quotes can handle 'defer'")) + (reset) ; end file with this to persist the trace for the final test -- cgit 1.4.1-2-gfad0