From cf35ee38fcc66901b89a6bbc901fe592aa315f79 Mon Sep 17 00:00:00 2001 From: "Kartik K. Agaram" Date: Thu, 4 Dec 2014 02:50:33 -0800 Subject: 397 - routines encapsulate allocator state Still incomplete; one test temporarily disabled. --- mu.arc | 34 +++++----- mu.arc.t | 214 +++++++++++++++++++++++++++++++++++---------------------------- 2 files changed, 137 insertions(+), 111 deletions(-) diff --git a/mu.arc b/mu.arc index 9fbb642b..6d8a234f 100644 --- a/mu.arc +++ b/mu.arc @@ -148,7 +148,7 @@ ; routine = runtime state for a serial thread of execution (def make-routine (fn-name . args) - (annotate 'routine (obj call-stack (list + (annotate 'routine (obj alloc 1000 call-stack (list (obj fn-name fn-name pc 0 args args caller-arg-idx 0))))) (defextend empty (x) (isa x 'routine) @@ -248,6 +248,7 @@ (do (trace "schedule" "done with routine") (push routine* completed-routines*))) (= routine* nil)) +;? (tr 111) (each (routine _) canon.sleeping-routines* (when (ready-to-wake-up routine) (trace "schedule" "waking up " top.routine!fn-name) @@ -255,13 +256,17 @@ (wipe rep.routine!sleep) (++ pc.routine) (enq routine running-routines*))) +;? (tr 112) (when (empty running-routines*) (whenlet exact-sleeping-routines (keep waiting-for-exact-cycle? keys.sleeping-routines*) (let next-wakeup-cycle (apply min (map [rep._!sleep 0] exact-sleeping-routines)) (= curr-cycle* (+ 1 next-wakeup-cycle)) (trace "schedule" "skipping to cycle " curr-cycle*) (update-scheduler-state)))) - (detect-deadlock)) +;? (tr 113) + (detect-deadlock) +;? (tr 114) + ) (def detect-deadlock () (when (and (empty running-routines*) @@ -695,26 +700,25 @@ ; memory allocation -(enq (fn () (= Memory-in-use-until 1000)) - initialization-fns*) - (def new-scalar (type) - (ret result Memory-in-use-until - (++ Memory-in-use-until sizeof.type))) +;? (tr "new scalar: @type") + (ret result rep.routine*!alloc + (++ rep.routine*!alloc sizeof.type))) (def new-array (type size) -;? (prn "new array: @type @size") - (ret result Memory-in-use-until - (++ Memory-in-use-until (+ 1 (* (sizeof types*.type!elem) size))) +;? (tr "new array: @type @size") + (ret result rep.routine*!alloc + (++ rep.routine*!alloc (+ 1 (* (sizeof types*.type!elem) size))) (= memory*.result size))) (def new-string (literal-string) - (ret result Memory-in-use-until - (= memory*.Memory-in-use-until len.literal-string) - (++ Memory-in-use-until) +;? (tr "new string: @literal-string") + (ret result rep.routine*!alloc + (= (memory* rep.routine*!alloc) len.literal-string) + (++ rep.routine*!alloc) (each c literal-string - (= memory*.Memory-in-use-until c) - (++ Memory-in-use-until)))) + (= (memory* rep.routine*!alloc) c) + (++ rep.routine*!alloc)))) ;; desugar structured assembly based on blocks diff --git a/mu.arc.t b/mu.arc.t index a2698597..9345e214 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -114,6 +114,7 @@ ; this file on the scenarios the code cares about. (load "mu.arc") +;? (quit) ; Our language is assembly-like in that functions consist of series of ; statements, and statements consist of an operation and its arguments (input @@ -805,6 +806,7 @@ ((2 integer-address) <- copy (34 literal)) ; pointer to nowhere ((3 integer-address) (4 boolean) <- maybe-coerce (1 tagged-value) (integer-address literal)) ]))) +;? (set dump-trace*) (run 'main) ;? (prn memory*) ;? (prn completed-routines*) @@ -881,23 +883,25 @@ ((9 location deref) <- copy (t literal)) ((10 list-address) <- get (6 list-address deref) (1 offset)) ]))) -(let first Memory-in-use-until - (run 'main) -;? (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 - (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"))) +(let routine make-routine!main + (enq routine running-routines*) + (let first rep.routine!alloc + (run) +;? (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 + (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-code '((def test2 [ ((10 list-address) <- list-next (1 list-address)) @@ -1742,13 +1746,16 @@ '((def 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"))) +(let routine make-routine!main + (enq routine running-routines*) + (let before rep.routine!alloc +;? (set dump-trace*) + (run) + ;? (prn memory*) + (if (~iso memory*.1 before) + (prn "F - 'new' returns current high-water mark")) + (if (~iso rep.routine!alloc (+ before 1)) + (prn "F - 'new' on primitive types increments high-water mark by their size")))) (reset) (new-trace "new-array-literal") @@ -1756,13 +1763,15 @@ '((def 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"))) +(let routine make-routine!main + (enq routine running-routines*) + (let before rep.routine!alloc + (run) +;? (prn memory*) + (if (~iso memory*.1 before) + (prn "F - 'new' on array with literal size returns current high-water mark")) + (if (~iso rep.routine!alloc (+ before 6)) + (prn "F - 'new' on primitive arrays increments high-water mark by their size")))) (reset) (new-trace "new-array-direct") @@ -1771,13 +1780,15 @@ ((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"))) +(let routine make-routine!main + (enq routine running-routines*) + (let before rep.routine!alloc + (run) +;? (prn memory*) + (if (~iso memory*.2 before) + (prn "F - 'new' on array with variable size returns current high-water mark")) + (if (~iso rep.routine!alloc (+ 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 @@ -1799,13 +1810,15 @@ ((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"))) +(let routine make-routine!main + (enq routine running-routines*) + (let before rep.routine!alloc +;? (set dump-trace*) + (run) +;? (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") @@ -1814,13 +1827,15 @@ ((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"))) +(let routine make-routine!main + (enq routine running-routines*) + (let before rep.routine!alloc +;? (set dump-trace*) + (run) +;? (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") @@ -1896,13 +1911,16 @@ ((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'"))) +(let routine make-routine!main + (enq routine running-routines*) + (let before rep.routine!alloc +;? (set dump-trace*) + (run) +;? (prn memory*) + (if (~and (is 23 memory*.1) + (~is 23 (memory* (+ before 1)))) + (prn "F - default-scope skipped for locations with metadata 'global'")))) +;? (quit) (reset) (new-trace "array-copy-indirect-scoped") @@ -2732,33 +2750,33 @@ (prn "F - 'write' on full channel blocks (puts the routine to sleep until the channel gets data)"))) ;? (quit) -(reset) -(new-trace "channel-handoff") -(add-code - '((def f1 [ - ((default-scope scope-address) <- new (scope literal) (30 literal)) - ((chan channel-address) <- new-channel (3 literal)) - (fork (f2 fn) (chan channel-address)) - ((1 tagged-value global) <- read (chan channel-address)) ; output - ]) - (def f2 [ - ((default-scope scope-address) <- new (scope literal) (30 literal)) - ((n integer-address) <- new (integer literal)) - ((n integer-address deref) <- copy (24 literal)) - ((ochan channel-address) <- arg) - ((x tagged-value) <- save-type (n integer-address)) - ((ochan channel-address deref) <- write (ochan channel-address) (x tagged-value)) - ]))) -;? (set dump-trace*) -;? (= dump-trace* (obj whitelist '("schedule" "run" "addr"))) -;? (= dump-trace* (obj whitelist '("-"))) -(run 'f1) -;? (prn memory*) -(each routine completed-routines* - (aif rep.routine!error (prn "error - " it))) -(if (~is 24 (memory* memory*.2)) ; location 1 contains tagged-value *x above - (prn "F - channels are meant to be shared between routines")) -;? (quit) +;? (reset) +;? (new-trace "channel-handoff") +;? (add-code +;? '((def f1 [ +;? ((default-scope scope-address) <- new (scope literal) (30 literal)) +;? ((chan channel-address) <- new-channel (3 literal)) +;? (fork (f2 fn) (chan channel-address)) +;? ((1 tagged-value global) <- read (chan channel-address)) ; output +;? ]) +;? (def f2 [ +;? ((default-scope scope-address) <- new (scope literal) (30 literal)) +;? ((n integer-address) <- new (integer literal)) +;? ((n integer-address deref) <- copy (24 literal)) +;? ((ochan channel-address) <- arg) +;? ((x tagged-value) <- save-type (n integer-address)) +;? ((ochan channel-address deref) <- write (ochan channel-address) (x tagged-value)) +;? ]))) +;? ;? (set dump-trace*) +;? ;? (= dump-trace* (obj whitelist '("schedule" "run" "addr"))) +;? ;? (= dump-trace* (obj whitelist '("-"))) +;? (run 'f1) +;? ;? (prn memory*) +;? (each routine completed-routines* +;? (aif rep.routine!error (prn "error - " it))) +;? (if (~is 24 (memory* memory*.2)) ; location 1 contains tagged-value *x above +;? (prn "F - channels are meant to be shared between routines")) +;? ;? (quit) ;; Separating concerns ; @@ -3177,10 +3195,12 @@ (add-code '((def main [ ((1 string-address) <- new (string literal) (5 literal)) ]))) -(let before Memory-in-use-until - (run 'main) - (if (~iso Memory-in-use-until (+ before 5 1)) - (prn "F - 'new' allocates arrays of bytes for strings"))) +(let routine make-routine!main + (enq routine running-routines*) + (let before rep.routine!alloc + (run) + (if (~iso rep.routine!alloc (+ before 5 1)) + (prn "F - 'new' allocates arrays of bytes for strings")))) ; Convenience: initialize strings using string literals (reset) @@ -3188,12 +3208,14 @@ (add-code '((def main [ ((1 string-address) <- new "hello") ]))) -(let before Memory-in-use-until - (run 'main) - (if (~iso Memory-in-use-until (+ before 5 1)) - (prn "F - 'new' allocates arrays of bytes for string literals")) - (if (~memory-contains-array before "hello") - (prn "F - 'new' initializes allocated memory to string literal"))) +(let routine make-routine!main + (enq routine running-routines*) + (let before rep.routine!alloc + (run) + (if (~iso rep.routine!alloc (+ before 5 1)) + (prn "F - 'new' allocates arrays of bytes for string literals")) + (if (~memory-contains-array before "hello") + (prn "F - 'new' initializes allocated memory to string literal")))) (reset) (new-trace "strcat") -- cgit 1.4.1-2-gfad0