From 6a62ed1a6a50c46ad3997d382cfac157ce360a2d Mon Sep 17 00:00:00 2001 From: Sam Lindley Date: Thu, 3 Feb 2022 14:24:02 +0000 Subject: [PATCH] Revert "MVar implementation" (#17) --- test/core/cont.wast | 495 -------------------------------------------- 1 file changed, 495 deletions(-) diff --git a/test/core/cont.wast b/test/core/cont.wast index c32b30add..22c30dc59 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -538,498 +538,3 @@ (i32.const 0) (i32.const 1) (i32.const 2) (i32.const 3) (i32.const 4) (i32.const 5) (i32.const 6) ) - -;; MVar implementation -;; Scheduler - -(module $scheduler2 - (type $proc (func)) - (type $cont (cont $proc)) - (type $susp_fn (func (param (ref null $cont)))) - - (event $yield (export "yield")) - (event $spawn (export "spawn") (param (ref $proc))) - (event $suspend (export "suspend") (param (ref $susp_fn))) - (event $resume (export "resume") (param (ref null $cont))) - - ;; Table as simple queue (keeping it simple, no ring buffer) - (table $queue 0 (ref null $cont)) - - ;; Holds the continuation which will be resumed next - (table $curr_proc 0 (ref null $cont)) - - ;; Queue variables - (global $qdelta i32 (i32.const 10)) ;; Threshold for allocating more space in the queue table - ;; If front > threshold, entries are moved instead - (global $qback (mut i32) (i32.const 0)) ;; Index of front of queue - (global $qfront (mut i32) (i32.const 0)) ;; Index of back of queue - - ;; Holds the status of curr_proc (1 -> Set, 0 -> Not set) - (global $curr_status (mut i32) (i32.const 0)) - - (func $queue-empty (result i32) - (i32.eq (global.get $qfront) (global.get $qback)) - ) - - (func $dequeue (result (ref null $cont)) - (local $i i32) - (if (call $queue-empty) - (then (return (ref.null $cont))) - ) - (local.set $i (global.get $qfront)) - (global.set $qfront (i32.add (local.get $i) (i32.const 1))) - (table.get $queue (local.get $i)) - ) - - (func $enqueue (param $k (ref null $cont)) - ;; Check if queue is full - (if (i32.eq (global.get $qback) (table.size $queue)) - (then - ;; Check if there is enough space in the front to compact - (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) - (then - ;; Space is below threshold, grow table instead - (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) - ) - (else - ;; Enough space, move entries up to head of table - (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) - (table.copy $queue $queue - (i32.const 0) ;; dest = new front = 0 - (global.get $qfront) ;; src = old front - (global.get $qback) ;; len = new back = old back - old front - ) - (table.fill $queue ;; null out old entries to avoid leaks - (global.get $qback) ;; start = new back - (ref.null $cont) ;; init value - (global.get $qfront) ;; len = old front = old front - new front - ) - (global.set $qfront (i32.const 0)) - ) - ) - ) - ) - (table.set $queue (global.get $qback) (local.get $k)) - (global.set $qback (i32.add (global.get $qback) (i32.const 1))) - ) - - ;; Check if curr_proc is set or not. Return 1 if not set. - (func $curr-empty (result i32) - (i32.eqz (global.get $curr_status)) - ) - - (func $curr_set (param $k (ref null $cont)) - (global.set $curr_status (i32.const 1)) - (table.set $curr_proc (i32.const 0) (local.get $k)) - ) - - (func $curr_get (result (ref null $cont)) - (global.set $curr_status (i32.const 0)) - (table.get $curr_proc (i32.const 0)) - ) - - (func $exec_susp_fn (param $f (ref $susp_fn)) (param $k (ref $cont)) - ;; Bind k to f and make it the next thread to be executed - (cont.new (type $cont) (func.bind (type $proc) (local.get $k) (local.get $f))) - (call $curr_set) - ) - - (func $scheduler (export "scheduler") (param $main (ref $proc)) - ;; Allocate space for curr_proc - (drop (table.grow $curr_proc (ref.null $cont) (i32.const 1))) - - ;; Add the function to process queue - (call $curr_set (cont.new (type $cont) (local.get $main))) - - (loop $l - (if (call $curr-empty) - (then - ;; curr_proc not set - ;; If process queue is empty, no more processes to execute - ;; Else set curr_proc to the front of the queue - (if (call $queue-empty) - (then (return)) - (else - (call $curr_set (call $dequeue)) - ) - ) - ) - ) - (block $on_yield (result (ref $cont)) - (block $on_spawn (result (ref $proc) (ref $cont)) - (block $on_suspend (result (ref $susp_fn) (ref $cont)) - (block $on_resume (result (ref null $cont) (ref $cont)) - (resume (event $yield $on_yield) (event $spawn $on_spawn) - (event $suspend $on_suspend) (event $resume $on_resume) - (call $curr_get) - ) - (br $l) ;; thread terminated - ) - ;; on resume, cont (resumption) and cont (curr) on stack - (call $curr_set) ;; continuation of old thread - (call $enqueue) ;; thread to be resumed - (br $l) - ) - ;; on suspend, susp_fn and cont on stack - (call $exec_susp_fn) - (br $l) - ) - ;; on $spawn, proc and cont on stack - (call $enqueue) ;; continuation of old thread - (cont.new (type $cont)) - (call $enqueue) ;; new thread - (br $l) - ) - ;; on $yield, cont on stack - (call $enqueue) - (br $l) - ) - ) -) - -(register "scheduler2") - -;; Producer queue - -(module $producer_queue - (type $proc (func)) - (type $cont (cont $proc)) - - ;; Table as simple queue (keeping it simple, no ring buffer) - (table $queue 0 (ref null $cont)) - - ;; Queue variables - (global $qdelta i32 (i32.const 10)) ;; Threshold for allocating more space in the queue table - ;; If front > threshold, entries are moved instead - (global $qback (mut i32) (i32.const 0)) ;; Index of front of queue - (global $qfront (mut i32) (i32.const 0)) ;; Index of back of queue - - (func $queue-empty (export "queue-empty") (result i32) - (i32.eq (global.get $qfront) (global.get $qback)) - ) - - (func $dequeue (export "dequeue") (result (ref null $cont)) - (local $i i32) - (if (call $queue-empty) - (then (return (ref.null $cont))) - ) - (local.set $i (global.get $qfront)) - (global.set $qfront (i32.add (local.get $i) (i32.const 1))) - (table.get $queue (local.get $i)) - ) - - (func $enqueue (export "enqueue") (param $k (ref null $cont)) - ;; Check if queue is full - (if (i32.eq (global.get $qback) (table.size $queue)) - (then - ;; Check if there is enough space in the front to compact - (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) - (then - ;; Space is below threshold, grow table instead - (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) - ) - (else - ;; Enough space, move entries up to head of table - (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) - (table.copy $queue $queue - (i32.const 0) ;; dest = new front = 0 - (global.get $qfront) ;; src = old front - (global.get $qback) ;; len = new back = old back - old front - ) - (table.fill $queue ;; null out old entries to avoid leaks - (global.get $qback) ;; start = new back - (ref.null $cont) ;; init value - (global.get $qfront) ;; len = old front = old front - new front - ) - (global.set $qfront (i32.const 0)) - ) - ) - ) - ) - (table.set $queue (global.get $qback) (local.get $k)) - (global.set $qback (i32.add (global.get $qback) (i32.const 1))) - ) -) - -(register "producer_queue") - -;; Consumer queue - -(module $consumer_queue - (type $proc (func)) - (type $cont (cont $proc)) - - ;; Table as simple queue (keeping it simple, no ring buffer) - (table $queue 0 (ref null $cont)) - - ;; Queue variables - (global $qdelta i32 (i32.const 10)) ;; Threshold for allocating more space in the queue table - ;; If front > threshold, entries are moved instead - (global $qback (mut i32) (i32.const 0)) ;; Index of front of queue - (global $qfront (mut i32) (i32.const 0)) ;; Index of back of queue - - (func $queue-empty (export "queue-empty") (result i32) - (i32.eq (global.get $qfront) (global.get $qback)) - ) - - (func $dequeue (export "dequeue") (result (ref null $cont)) - (local $i i32) - (if (call $queue-empty) - (then (return (ref.null $cont))) - ) - (local.set $i (global.get $qfront)) - (global.set $qfront (i32.add (local.get $i) (i32.const 1))) - (table.get $queue (local.get $i)) - ) - - (func $enqueue (export "enqueue") (param $k (ref null $cont)) - ;; Check if queue is full - (if (i32.eq (global.get $qback) (table.size $queue)) - (then - ;; Check if there is enough space in the front to compact - (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) - (then - ;; Space is below threshold, grow table instead - (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) - ) - (else - ;; Enough space, move entries up to head of table - (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) - (table.copy $queue $queue - (i32.const 0) ;; dest = new front = 0 - (global.get $qfront) ;; src = old front - (global.get $qback) ;; len = new back = old back - old front - ) - (table.fill $queue ;; null out old entries to avoid leaks - (global.get $qback) ;; start = new back - (ref.null $cont) ;; init value - (global.get $qfront) ;; len = old front = old front - new front - ) - (global.set $qfront (i32.const 0)) - ) - ) - ) - ) - (table.set $queue (global.get $qback) (local.get $k)) - (global.set $qback (i32.add (global.get $qback) (i32.const 1))) - ) -) - -(register "consumer_queue") - -;; MVar - -(module $mvar - (type $proc (func)) - (type $cont (cont $proc)) - (type $susp_fn (func (param (ref null $cont)))) - - (event $yield (import "scheduler2" "yield")) - (event $spawn (import "scheduler2" "spawn") (param (ref $proc))) - (event $suspend (import "scheduler2" "suspend") (param (ref $susp_fn))) - (event $resume (import "scheduler2" "resume") (param (ref null $cont))) - - (func $scheduler (import "scheduler2" "scheduler") (param $main (ref $proc))) - - (func $pq-empty (import "producer_queue" "queue-empty") (result i32)) - (func $pq-dequeue (import "producer_queue" "dequeue") (result (ref null $cont))) - (func $pq-enqueue (import "producer_queue" "enqueue") (param (ref null $cont))) - - (func $cq-empty (import "consumer_queue" "queue-empty") (result i32)) - (func $cq-dequeue (import "consumer_queue" "dequeue") (result (ref null $cont))) - (func $cq-enqueue (import "consumer_queue" "enqueue") (param (ref null $cont))) - - (func $log (import "spectest" "print_i32") (param i32)) - - (global $data (mut i32) (i32.const 0)) - (global $state (mut i32) (i32.const 0)) - ;; States - ;; 0 - Empty (can write) - ;; 1 - Blocked (some other write/read operation is pending) - ;; 2 - Full (can read) - - (elem declare func $prod_susp_fn $cons_susp_fn) - - ;; Producer suspension function - (func $prod_susp_fn (param $k (ref null $cont)) - (call $pq-enqueue (local.get $k)) - ) - - ;; Consumer suspension function - (func $cons_susp_fn (param $k (ref null $cont)) - (call $cq-enqueue (local.get $k)) - ) - - (func (export "fork") (param $f (ref $proc)) - (suspend $spawn (local.get $f)) - ) - - (func (export "put") (param $value i32) - (if (i32.gt_s (global.get $state) (i32.const 0)) - (then - (suspend $suspend (ref.func $prod_susp_fn)) - ;; Added to queue; Resumed only when it is its turn - ) - ) - - ;; Set the value - (global.set $data (local.get $value)) - (global.set $state (i32.const 2)) - - (if (i32.ne (call $cq-empty) (i32.const 1)) - (then - ;; Block all operations for new threads and resume the next consumer - (global.set $state (i32.const 1)) - (suspend $resume (call $cq-dequeue)) - ) - ) - ) - - (func (export "take") (result i32) - (local $read i32) - - (if (i32.lt_s (global.get $state) (i32.const 2)) - (then - (suspend $suspend (ref.func $cons_susp_fn)) - ;; Added to queue; Resumed only when it is its turn - ) - ) - - ;; Read the value - (global.set $state (i32.const 0)) - (local.set $read (global.get $data)) - - (if (i32.ne (call $pq-empty) (i32.const 1)) - (then - ;; Block all operations for new threads and resume the next producer - (global.set $state (i32.const 1)) - (suspend $resume (call $pq-dequeue)) - ) - ) - - (local.get $read) - ) - - (func (export "run") (param $f (ref $proc)) - (call $scheduler (local.get $f)) - ) -) - -(register "mvar") - - -(module - (type $proc (func)) - (func $fork (import "mvar" "fork") (param (ref $proc))) - (func $put (import "mvar" "put") (param i32)) - (func $take (import "mvar" "take") (result i32)) - (func $run (import "mvar" "run") (param (ref $proc))) - - (func $log (import "spectest" "print_i32") (param i32)) - - (exception $error) - - (elem declare func $producer $consumer $prod3 $cons3 $test1 $test2 $test3 $test4 $test5 $test6) - - (func $producer (param $v i32) - (call $put (local.get $v)) - ) - - (func $consumer (param $v i32) - (if (i32.ne (call $take) (local.get $v)) - (then (throw $error)) - ) - ) - - (func $prod3 - (call $producer (i32.const 1)) - (call $producer (i32.const 2)) - (call $producer (i32.const 3)) - ) - - (func $cons3 - (call $consumer (i32.const 1)) - (call $consumer (i32.const 2)) - (call $consumer (i32.const 3)) - ) - - (func $test1 - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) - ) - - (func $test2 - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) - ) - - (func $test3 - (call $fork (ref.func $prod3)) - (call $fork (ref.func $cons3)) - ) - - (func $test4 - (call $fork (ref.func $cons3)) - (call $fork (ref.func $prod3)) - ) - - (func $test5 - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $consumer))) - ) - - (func $test6 - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $producer))) - ) - - (func $runtest (export "run") (param $f (ref $proc)) - (call $run (local.get $f)) - ) - - (func (export "test1") - (call $log (i32.const 1)) - (call $runtest (ref.func $test1)) - ) - - (func (export "test2") - (call $log (i32.const 2)) - (call $runtest (ref.func $test2)) - ) - - (func (export "test3") - (call $log (i32.const 3)) - (call $runtest (ref.func $test3)) - ) - - (func (export "test4") - (call $log (i32.const 4)) - (call $runtest (ref.func $test4)) - ) - - (func (export "test5") - (call $log (i32.const 5)) - (call $runtest (ref.func $test5)) - ) - - (func (export "test6") - (call $log (i32.const 6)) - (call $runtest (ref.func $test6)) - ) -) - -(assert_return (invoke "test1")) -(assert_return (invoke "test2")) -(assert_return (invoke "test3")) -(assert_return (invoke "test4")) -(assert_return (invoke "test5")) -(assert_return (invoke "test6")) -