X-Git-Url: https://git.kengrimes.com/?p=watForth.git;a=blobdiff_plain;f=forth.wat;fp=forth.wat;h=778681ade933bcc92f3f4f90c89e0a8394a7d140;hp=0a16efc078c8f1efdac88172e37333ec0f3db125;hb=7946a78988064b7ec67e8d27763a962cebb29515;hpb=fb7946e17777ee389e3eaf742e6ff87a5d832710 diff --git a/forth.wat b/forth.wat index 0a16efc..778681a 100644 --- a/forth.wat +++ b/forth.wat @@ -25,29 +25,30 @@ (import "env" "rpop" (func $rpop (result i32))) (import "env" "rpush" (func $rpush (param i32))) (import "env" "sys_read" (func $sys_read (param i32 i32 i32) (result i32))) + (import "env" "sys_write" (func $sys_write (param i32 i32 i32))) + (import "env" "sys_send" (func $sys_send (param i32 i32 i32))) + (import "env" "sys_open" (func $sys_open (result i32))) + (import "env" "sys_close" (func $sys_close (param i32))) (import "env" "sys_fetch" (func $sys_fetch (param i32 i32 i32) (result i32))) - (import "env" "sys_listen" (func $sys_listen (param i32 i32 i32) (result i32))) - (import "env" "sys_write" (func $sys_write (param i32 i32 i32) (result i32))) - (import "env" "sys_echo" (func $sys_echo (param i32 i32))) - (import "env" "sys_echochar" (func $sys_echochar (param i32))) + (import "env" "sys_connect" (func $sys_connect (param i32 i32) (result i32))) + (import "env" "sys_echo" (func $sys_echo (param i32))) + (import "env" "sys_log" (func $sys_log (param i32 i32))) (import "env" "sys_reflect" (func $sys_reflect (param i32))) (import "env" "vocab_get" (func $vocab_get (param i32 i32) (result i32))) (import "env" "vocab_set" (func $vocab_set (param i32 i32 i32))) (import "env" "does_get" (func $does_get (param i32 i32) (result i32))) (import "env" "does_set" (func $does_set (param i32 i32 i32))) (import "env" "is_whitespace" (func $is_whitespace (param i32) (result i32))) - (import "env" "sys_parsenum" (func $sys_parsenum (param i32 i32 i32) (result i32))) + (import "env" "sys_parsenum" (func $sys_parsenum (param i32 i32) (result i32))) (import "env" "sys_stack" (func $sys_stack)) (import "env" "sys_words" (func $sys_words)) (table (;0;) 0 anyfunc) (memory $0 1) - (; String Belt ;) ;; 0x0000 Size: 8192 - (global $wordbelt i32 (i32.const 8192)) ;; 0x2000 Size: 4096 - (global $inbuf i32 (i32.const 12288)) ;; 0x3000 Size: 2048 - (global $inbuf_size i32 (i32.const 12292)) - (global $inbuf_data i32 (i32.const 12296)) - (global $kvars i32 (i32.const 14336)) ;; 0x3800 Size: 2048 - (data (i32.const 12288) "\f8\07\00\00") ;; 2040 len + (; String Belt ;) ;; 0x0000 Size: 8192 + (global $wordbelt_base i32 (i32.const 8192) ) ;; 0x2000 Size: 4096 + (global $wordbelt_bound i32 (i32.const 12288)) ;; 0x3000 + (global $stdin_base i32 (i32.const 12288)) ;; 0x3000 Size: 2048 + (global $kvars i32 (i32.const 14336)) ;; 0x3800 Size: 2048 (global $mode_p i32 (i32.const 14336)) (global $here_p i32 (i32.const 14340)) (global $start_p i32 (i32.const 14344)) @@ -56,42 +57,39 @@ (global $stringbelt_head_p i32 (i32.const 14356)) (global $wordbelt_tail_p i32 (i32.const 14360)) (global $wordbelt_head_p i32 (i32.const 14364)) - (global $channel_in_p i32 (i32.const 14368)) - (global $channel_out_p i32 (i32.const 14372)) (data (i32.const 14336) "\28\41\00\00") ;; MODE - (data (i32.const 14340) "\04\42\00\00") ;; HERE + (data (i32.const 14340) "\04\5e\00\00") ;; HERE (data (i32.const 14344) "\00\40\00\00") ;; START (16384) (Quit) (data (i32.const 14348) "\0a\00\00\00") ;; BASE (data (i32.const 14352) "\00\00\00\00") ;; STRINGBELT_TAIL (data (i32.const 14356) "\00\00\00\00") ;; STRINGBELT_HEAD (data (i32.const 14360) "\00\20\00\00") ;; WORDBELT_TAIL (data (i32.const 14364) "\00\20\00\00") ;; WORDBELT_HEAD - (data (i32.const 14368) "\00\00\00\00") ;; CHANNEL-IN - (data (i32.const 14372) "\01\00\00\00") ;; CHANNEL-OUT - (; channel listeners 0x3c00 ;) - (global $channel_listeners_p i32 (i32.const 15360)) - (data (i32.const 15360) "\00\40\00\00") ;; CHANNEL LISTENER 0 (quit) (; Quit ;) - (global $quit_p i32 (i32.const 16384)) - (data (i32.const 16384) "\01\00\00\00") ;; RINIT xt + (global $quit_p i32 (i32.const 16384)) ;; 0x4000 + (data (i32.const 16384) "\03\00\00\00") ;; RINIT xt (global $quit_ret_p i32 (i32.const 16388)) (data (i32.const 16388) "\10\40\00\00") ;; INTERPRET xt (data (i32.const 16392) "\12\00\00\00") ;; JMP xt (data (i32.const 16396) "\00\40\00\00") ;; quit location (16384) (; Interpret ;) (data (i32.const 16400) "\74\40\00\00") ;; WORD xt (16500) - (data (i32.const 16404) "\06\00\00\00") ;; DUP - (data (i32.const 16408) "\0e\00\00\00") ;; JZ: - (data (i32.const 16412) "\38\40\00\00") ;; INTERP-END addr (16444) - (data (i32.const 16416) "\02\00\00\00") ;; LIT xt - (data (i32.const 16420) "\00\38\00\00") ;; MODE addr (14336) - (data (i32.const 16424) "\0a\00\00\00") ;; @ (fetch) xt - (data (i32.const 16428) "\0c\00\00\00") ;; EXECUTE xt - (data (i32.const 16432) "\0d\00\00\00") ;; NOOP xt - (data (i32.const 16436) "\01\00\00\00") ;; RET - (data (i32.const 16440) "\10\00\00\00") ;; DROP <-- INTERP-END - (data (i32.const 16444) "\10\00\00\00") ;; DROP - (data (i32.const 16448) "\19\00\00\00") ;; BYE + (data (i32.const 16404) "\0d\00\00\00") ;; (data (i32.const 16404) "\1e\00\00\00") ;; 2DUP + (data (i32.const 16408) "\0d\00\00\00") ;; (data (i32.const 16408) "\04\00\00\00") ;; SYS-LOG + (data (i32.const 16412) "\06\00\00\00") ;; DUP + (data (i32.const 16416) "\0e\00\00\00") ;; JZ: + (data (i32.const 16420) "\40\40\00\00") ;; INTERP-END addr (16444) + (data (i32.const 16424) "\02\00\00\00") ;; LIT xt + (data (i32.const 16428) "\00\38\00\00") ;; MODE addr (14336) + (data (i32.const 16432) "\0a\00\00\00") ;; @ (fetch) xt + (data (i32.const 16436) "\0c\00\00\00") ;; EXECUTE xt + (data (i32.const 16440) "\0d\00\00\00") ;; NOOP xt + (data (i32.const 16444) "\01\00\00\00") ;; RET + (data (i32.const 16448) "\10\00\00\00") ;; DROP <-- INTERP-END + (data (i32.const 16452) "\10\00\00\00") ;; DROP + ;; (data (i32.const 16456) "\01\00\00\00") ;; RET + (global $holy_bye i32 (i32.const 16456)) + (data (i32.const 16456) "\19\00\00\00") ;; BYE <-- the Holy BYE (; Word ;) (data (i32.const 16500) "\14\00\00\00") ;; WORDSTART (data (i32.const 16504) "\05\00\00\00") ;; KEY <-- KEYLOOP @@ -126,7 +124,9 @@ (data (i32.const 16620) "\c8\40\00\00") ;; addr of WORDLOOP (data (i32.const 16624) "\10\00\00\00") ;; DROP <-- WORDEND (data (i32.const 16628) "\17\00\00\00") ;; WORDFINISH - (data (i32.const 16632) "\01\00\00\00") ;; RET + (data (i32.const 16632) "\01\00\00\00") ;; 2DUP //RET + (data (i32.const 16636) "\04\00\00\00") ;; .S + (data (i32.const 16640) "\01\00\00\00") ;; RET (; Exec Mode ;) (data (i32.const 16680) "\1e\00\00\00") ;; 2DUP (data (i32.const 16684) "\15\00\00\00") ;; DICT_GET @@ -174,49 +174,228 @@ (data (i32.const 16856) "\bc\41\00\00") ;; addr of keypump (data (i32.const 16860) "\10\00\00\00") ;; DROP (data (i32.const 16864) "\01\00\00\00") ;; RET - + (; Channel Table ;) + (; 1 FLAGS: AWAITER | RUNNING ]LSB ;) + (; 1 reserved ;) + (; 1 AWAITER CHANNEL ;) + (; 1 OUT CHANNEL ;) + (; 8 START | START-DEFAULT ;) + (; 16 BUFFER ADDRESSES: BASE, TAIL, HEAD, BOUND ;) + (global $channel_table_p i32 (i32.const 16900)) + (global $channel_entry_size i32 (i32.const 28)) + (global $channel_max i32 (i32.const 255)) + (data (i32.const 16900) "\00\00\00\01") ;; STDIN (COUT: 1) + (data (i32.const 16904) "\00\40\00\00") ;; STDIN-START (QUIT) + (data (i32.const 16908) "\00\40\00\00") ;; STDIN-START-DEFAULT + (data (i32.const 16912) "\00\30\00\00") ;; STDIN-BUFFER-BASE + (data (i32.const 16916) "\00\30\00\00") ;; STDIN-BUFFER-TAIL + (data (i32.const 16920) "\00\30\00\00") ;; STDIN-BUFFER-HEAD + (data (i32.const 16924) "\00\38\00\00") ;; STDIN-BUFFER-BOUND + (data (i32.const 16928) "\00\00\00\00") ;; STDOUT + (data (i32.const 16932) "\00\00\00\00") ;; STDOUT (TODO: error handler) + (data (i32.const 16936) "\00\00\00\00") ;; STDOUT + (data (i32.const 16940) "\00\00\00\00") ;; STDOUT + (data (i32.const 16944) "\00\00\00\00") ;; STDOUT + (data (i32.const 16948) "\00\00\00\00") ;; STDOUT + (data (i32.const 16952) "\00\00\00\00") ;; STDOUT + (data (i32.const 16956) "\00\00\00\00") ;; STDERR (null) + (data (i32.const 16960) "\00\00\00\00") ;; STDERR (TODO: error handler) + (; 16900 + ((4 * 7)=>28 * 256)=>7168 = 24068 | 0x5e04 === HERE ;) (export "memory" (memory $0)) - (export "main" (func $main)) - (func $main (param $event_channel i32) (result i32) - block $use_current_channel - (; rstack contains channel barriers (numbers lower than 256) - which will reset channel to 0 when returning to the quit loop. - if an interrupt event is happening, load its handler and set - the input channel. ;) - get_local $event_channel + (func $lit_rstack (param $here i32) (param $start i32) (result i32) + (local $eax i32) (local $ecx i32) + i32.const 0 + set_local $ecx + block $backup_loop + call $rpop + tee_local $eax + get_global $holy_bye + i32.eq + br_if $backup_loop + get_local $eax + call $push + get_local $ecx + i32.const 1 + i32.add + set_local $ecx + end + block $output_done + block $output_loop + get_local $ecx i32.eqz - br_if $use_current_channel - get_local $event_channel - i32.const 255 - i32.gt_u - br_if $use_current_channel - get_global $channel_in_p - get_local $event_channel + br_if $output_done + get_local $ecx + i32.const -1 + i32.add + set_local $ecx + get_local $here + i32.const 2 ;; lit i32.store + get_local $here + i32.const 4 + i32.add + tee_local $here + call $pop + i32.store + get_local $here + i32.const 4 + i32.add + tee_local $here + i32.const 52 ;; rpush_op + i32.store + get_local $here + i32.const 4 + i32.add + set_local $here + br $output_loop end - get_global $channel_listeners_p - get_local $event_channel - i32.const 2 - i32.shl + end + get_local $here + i32.const 18 ;; jmp + i32.store + get_local $here + i32.const 4 + i32.add + tee_local $here + get_local $start + i32.store + get_local $here + i32.const 4 + i32.add + return + ) + (func $close_channel (param $channel_p i32) + block $no_close + get_local $channel_p + i32.const 3 + i32.le_u + br_if $no_close + get_local $channel_p + call $sys_close + end + get_global $channel_table_p + get_global $channel_entry_size + get_local $channel_p + i32.mul + i32.add + tee_local $channel_p + i32.const 4 + i32.add + get_local $channel_p + i32.const 8 i32.add i32.load + i32.store ;; restore awaiter's "start" to original + get_local $channel_p + i32.const 0 + i32.store8 ;; clear target thread's flags + ) + (func $forth_min (param $i1 i32) (param $i2 i32) (result i32) + block $is_greater + get_local $i1 + get_local $i2 + i32.lt_u + br_if $is_greater + get_local $i2 + return + end + get_local $i1 + return + ) + (export "main" (func $main)) + (func $main (param $event_channel i32) (result i32) + get_local $event_channel + call $rinit + get_global $holy_bye + call $rpush call $interpret + return ) - (func $interpret (param $esi i32) (result i32) + (func $interpret (param $channel_in i32) (result i32) (local $here i32) (local $eax i32) + (local $esi i32) + (local $inbuf_base i32) + (local $inbuf_tail i32) (local $inbuf_head i32) + (local $inbuf_bound i32) (local $stringbelt_tail i32) (local $stringbelt_head i32) (local $wordbelt_tail i32) (local $wordbelt_head i32) - (local $channel_in i32) (local $channel_out i32) + + i32.const 0 + set_local $eax + + loop $recurse_loop + block $close_yield_channel + get_local $eax + i32.eqz + br_if $close_yield_channel + get_local $eax + call $close_channel + end + (; channel in setup ;) + get_global $channel_table_p + get_global $channel_entry_size + get_global $channel_max + get_local $channel_in + call $forth_min + i32.mul + i32.add + set_local $eax + block $check_run + get_local $eax + i32.load8_u + i32.const 1 + i32.and + i32.eqz ;; (FLAGS & 1) => running, return 0 + br_if $check_run + i32.const 0 + return + end + get_local $eax + get_local $eax + i32.load8_u + i32.const 1 + i32.or + i32.store8 ;; set running flag + get_local $eax + i32.const 3 + i32.add + i32.load8_u + set_local $channel_out + + get_local $eax + i32.const 4 + i32.add + i32.load + set_local $esi + get_local $eax + i32.const 12 + i32.add + i32.load + set_local $inbuf_base + get_local $eax + i32.const 16 + i32.add + i32.load + set_local $inbuf_tail + get_local $eax + i32.const 20 + i32.add + i32.load + set_local $inbuf_head + get_local $eax + i32.const 24 + i32.add + i32.load + set_local $inbuf_bound + (; /channel in setup ;) get_global $here_p i32.load set_local $here - get_global $inbuf_data - set_local $inbuf_head get_global $stringbelt_tail_p i32.load set_local $stringbelt_tail @@ -229,15 +408,8 @@ get_global $wordbelt_head_p i32.load set_local $wordbelt_head - get_global $channel_in_p - i32.load - set_local $channel_in - get_global $channel_out_p - i32.load - set_local $channel_out - get_global $quit_p - set_local $esi block $bye + block $awaiting loop $next get_local $esi get_local $esi @@ -246,9 +418,10 @@ set_local $esi i32.load set_local $eax + loop $execloop block $default block $op0 block $ret block $lit block $rinit - block $word block $key block $dup block $plus block $noop2 block $emit + block $logword block $key block $dup block $plus block $noop2 block $emit block $fetch block $set block $execute block $noop block $jz block $jnz block $drop block $wsbool block $jmp block $wordputc block $wordstart block $dictget block $parsenum block $wordfinish block $jneg1 block $swap @@ -256,16 +429,85 @@ block $comma block $subtract block $inchan block $sethere block $eqbool block $echostring block $strstart block $strput block $strend block $fetchinc block $setinc block $finddoes block $definedoes block $stacktrace block $webfetch - block $outchan block $read + block $outchan block $read block $openchannel block $rpush_op get_local $eax - br_table $op0 $ret (;2;)$lit $rinit (;4;)$word $key (;6;)$dup $plus + br_table $op0 $ret (;2;)$lit $rinit (;4;)$logword $key (;6;)$dup $plus (;8;)$jmp $emit (;10;)$fetch $set (;12;)$execute $noop (;14;)$jz $jnz (;16;)$drop $wsbool (;18;)$jmp $wordputc (;20;)$wordstart $dictget (;22;)$parsenum $wordfinish (;24;)$jneg1 $bye (;26;)$swap $words (;28;)$here $dictset (;30;)$dup2 $rot (;32;)$drop2 $comma (;34;)$subtract $inchan (;36;)$sethere $eqbool (;38;)$echostring $strstart (;40;)$strput $strend (;42;)$fetchinc $setinc (;44;)$finddoes $definedoes - (;46;)$stacktrace $webfetch (;48;)$outchan $read (;50;)$default + (;46;)$stacktrace $webfetch (;48;)$outchan $read (;50;)$awaiting $openchannel + (;52;)$rpush_op $default + end ;; rpush_op + call $pop + call $rpush + br $next + end ;; openchannel + (; Get addr of channel block ;) + get_global $channel_table_p + get_global $channel_entry_size + call $sys_open + tee_local $eax + call $rpush ;;save to rstack + get_local $eax + i32.mul + i32.add + (; Set Out-Channel to 1 by default ;) + tee_local $eax + i32.const 3 + i32.add ;; out channel + i32.const 1 + i32.store8 + (; leave a copy of channel_p on stack ;) + get_local $eax + (; Get addr of ch-start and ch-default-start ;) + get_local $eax + i32.const 4 + i32.add ;; addr of channel start + tee_local $eax + get_local $eax + i32.const 4 + i32.add ;; addr of channel default start + (; Store the user-provided address in both ;) + call $pop + tee_local $eax + i32.store + get_local $eax + i32.store + (; go bo buf-base (channel_p + 12), put HERE in it ;) + tee_local $eax + i32.const 12 + i32.add + get_local $here + i32.store + (; set buf-tail ;) + get_local $eax + i32.const 16 + i32.add + get_local $here + i32.store + (; set buf-head ;) + get_local $eax + i32.const 20 + i32.add + get_local $here + i32.store + (; set buf-bound ;) + get_local $eax + i32.const 24 + i32.add + (; set buf-bound = here += 512 ;) + get_local $here + i32.const 512 + i32.add + tee_local $here + i32.store + (; return channel number ;) + call $rpop + call $push + br $next end ;; read get_local $channel_in call $pop ;; location to write @@ -279,19 +521,24 @@ set_local $channel_out br $next end ;; webfetch - call $pop + call $pop ;; u call $rpush - call $pop + call $pop ;; addr set_local $eax - call $pop + call $pop ;; callback get_local $eax call $rpop call $sys_fetch + i32.const -1 + i32.eq + br_if $bye br $next end ;; stacktrace - call $sys_stack get_local $esi - call $sys_reflect + call $rpush + call $sys_stack + call $rpop + drop br $next end ;; definedoes call $pop @@ -360,7 +607,7 @@ end ;; strput block $sbhasspace2 get_local $stringbelt_head - get_global $wordbelt + get_global $wordbelt_base i32.lt_u br_if $sbhasspace2 i32.const 0 @@ -389,7 +636,7 @@ i32.const 2 i32.add tee_local $stringbelt_tail - get_global $wordbelt + get_global $wordbelt_base i32.le_u br_if $copystringtostart end @@ -407,7 +654,7 @@ end ;; strstart block $sbhasspace get_local $stringbelt_head - get_global $wordbelt + get_global $wordbelt_base i32.const 8 i32.sub i32.le_u @@ -430,7 +677,7 @@ set_local $eax call $pop get_local $eax - call $sys_write + call $sys_send br $next end ;; eqbool block $equiv @@ -550,14 +797,10 @@ set_local $esi br $next end ;; wordfinish - get_local $wordbelt_tail get_local $wordbelt_head get_local $wordbelt_tail - i32.const 4 - i32.add i32.sub - tee_local $eax (; n bytes ;) - i32.store + set_local $eax (; n bytes ;) (; align to 32-bit ;) get_local $wordbelt_head i32.const 3 @@ -567,8 +810,6 @@ set_local $wordbelt_head (; /align ;) get_local $wordbelt_tail - i32.const 4 - i32.add call $push get_local $eax call $push @@ -579,8 +820,6 @@ call $pop tee_local $eax call $rpop - get_global $base_p - i32.load call $sys_parsenum get_local $eax i32.load @@ -598,42 +837,25 @@ end ;; wordstart block $wbhasspace get_local $wordbelt_head - get_global $inbuf - i32.const 8 + get_global $wordbelt_bound + i32.const 4 i32.sub i32.le_u br_if $wbhasspace - get_global $wordbelt + get_global $wordbelt_base set_local $wordbelt_head end get_local $wordbelt_head - get_local $wordbelt_head - tee_local $wordbelt_tail - i32.const 0 - i32.store - i32.const 4 - i32.add - set_local $wordbelt_head + set_local $wordbelt_tail br $next end ;; wordputc block $wbhasspace2 get_local $wordbelt_head - get_global $inbuf + get_global $wordbelt_bound i32.lt_u br_if $wbhasspace2 - get_global $wordbelt - tee_local $wordbelt_head - get_local $wordbelt_tail - i32.load - i32.store - get_local $wordbelt_head - i32.const 4 - i32.add + get_global $wordbelt_base set_local $wordbelt_head - get_local $wordbelt_tail - i32.const 4 - i32.add - set_local $wordbelt_tail loop $copywordtostart get_local $wordbelt_head get_local $wordbelt_tail @@ -647,11 +869,11 @@ i32.const 2 i32.add tee_local $wordbelt_tail - get_global $inbuf - i32.le_u + get_global $wordbelt_bound + i32.lt_u br_if $copywordtostart end - get_global $wordbelt + get_global $wordbelt_base set_local $wordbelt_tail end get_local $wordbelt_head @@ -736,8 +958,6 @@ br $next end ;; emit (.) call $pop - get_global $base_p - i32.load call $sys_echo br $next end ;; noop2 @@ -758,13 +978,32 @@ end ;; key loop $key_loop block $key_read - get_global $inbuf_size - i32.load get_local $inbuf_head - get_global $inbuf_data - i32.sub - i32.le_u + get_local $inbuf_tail + i32.ge_u br_if $key_read + block $key_echo + get_local $channel_out + i32.const -1 + i32.add + br_if $key_echo + (; if current channel's default start is QUIT ;) + get_global $channel_table_p + get_global $channel_entry_size + get_local $channel_in + i32.mul + i32.add + i32.const 4 + i32.add + i32.load + get_global $quit_p + i32.ne + br_if $key_echo + i32.const 1 + get_local $inbuf_head + i32.const 2 + call $sys_write + end get_local $inbuf_head i32.load16_u call $push @@ -774,34 +1013,47 @@ set_local $inbuf_head br $next end ;; key_read - get_global $inbuf_size - i32.const 0 (; stdin hardcode ;) - get_global $inbuf_data - get_global $inbuf - i32.load + get_local $channel_in + get_local $inbuf_base + get_local $inbuf_bound + get_local $inbuf_base + i32.sub call $sys_read - i32.store + tee_local $eax + get_local $inbuf_base + i32.add + set_local $inbuf_tail + get_local $inbuf_base + set_local $inbuf_head block $nullread - get_global $inbuf_size - i32.load + get_local $eax i32.eqz br_if $nullread - get_global $inbuf_data - set_local $inbuf_head br $key_loop end ;; nullread - i32.const -1 ;; <- keyval sent if sz == 0 - call $push - br $next + block $pendingword + get_local $wordbelt_head + get_local $wordbelt_tail + i32.sub + i32.eqz + br_if $pendingword + i32.const 32 + call $push + br $next + end ;; pendingword + br $bye end ;; key_loop - end ;; word + end ;; logword + call $pop + tee_local $eax + call $pop + get_local $eax + call $sys_log br $next - end ;; rinit - call $rpop - + end ;; rinit (unused) call $rinit - i32.const 0 - set_local $channel_in + get_global $holy_bye + call $rpush br $next end ;; lit get_local $esi @@ -813,26 +1065,10 @@ call $push br $next end ;; ret - block $gotonext - (; cannot jump lower than 256 because it is reserved for - opcodes, so overload popping that kind of retval with - a channel selector, for when an event handler yields and - is interrupted by another event handler. there are also - a max of 255 channels, which is the same as the opcode space ;) - call $rpop - tee_local $eax - i32.const 255 - i32.gt_u - br_if $gotonext - get_local $eax - set_local $channel_in - call $rpop - set_local $eax - end ;; gotonext - get_local $eax + call $rpop set_local $esi br $next - end ;; op0 + end ;; op0 (yield?) get_local $esi call $rpush br $bye @@ -844,7 +1080,94 @@ br $next end ;; execloop end ;; next loop + end ;; awaiting + + (; set provided channel's waiter to this channel ;) + get_global $channel_table_p + get_global $channel_entry_size + call $pop + i32.mul + i32.add + tee_local $eax + i32.const 2 + i32.add + get_local $channel_in + i32.store8 + (; set awaiter flag ;) + get_local $eax + get_local $eax + i32.load8_u + i32.const 2 + i32.or + i32.store8 + + (; channel status save ;) + get_global $channel_table_p + get_global $channel_entry_size + get_local $channel_in + i32.mul + i32.add + tee_local $eax + (; set buffer base ;) + i32.const 12 + i32.add + get_local $inbuf_base + i32.store + (; set buffer tail ;) + get_local $eax + i32.const 16 + i32.add + get_local $inbuf_tail + i32.store + (; set buffer head ;) + get_local $eax + i32.const 20 + i32.add + get_local $inbuf_head + i32.store + (; set buffer bound ;) + get_local $eax + i32.const 24 + i32.add + get_local $inbuf_bound + i32.store + + (; set buffer buffer start ;) + get_local $eax + i32.const 4 + i32.add + get_local $here + i32.store + (; backup return stack here, returning to esi ;) + get_local $here + get_local $esi + call $lit_rstack + set_local $here + + i32.const -1 + set_local $inbuf_base ;; temporary bool "await-exit" + + (; /awaiting ;) end ;; bye + + get_global $channel_table_p + get_global $channel_entry_size + get_local $channel_in + i32.mul + i32.add + tee_local $eax + i32.const 3 + i32.add + get_local $channel_out + i32.store8 + + get_local $eax + get_local $eax + i32.load8_u + i32.const -1 + i32.and + i32.store8 (; toggle off running ;) + get_global $here_p get_local $here i32.store @@ -860,12 +1183,30 @@ get_global $wordbelt_head_p get_local $wordbelt_head i32.store - get_global $channel_in_p + + block $check_awaiter + get_local $inbuf_base + i32.const -1 + i32.eq ;; don't check if "await-exit" is true + br_if $check_awaiter + get_local $eax + i32.load8_u + i32.const 2 + i32.and + i32.eqz ;; (FLAGS & 2) => awaiter, run it + br_if $check_awaiter + get_local $eax + i32.const 2 + i32.add + i32.load8_u + get_local $channel_in + set_local $eax + set_local $channel_in + br $recurse_loop + end + end ;; recurse_loop get_local $channel_in - i32.store - get_global $channel_out_p - get_local $channel_out - i32.store + call $close_channel i32.const 0 return )