X-Git-Url: https://git.kengrimes.com/?p=watForth.git;a=blobdiff_plain;f=forth.wat;h=75c30099e730b466b92ade16f4996bf68d94aafd;hp=778681ade933bcc92f3f4f90c89e0a8394a7d140;hb=18b72639839461c074eb18fc2b58aa2a326485a1;hpb=7946a78988064b7ec67e8d27763a962cebb29515 diff --git a/forth.wat b/forth.wat index 778681a..75c3009 100644 --- a/forth.wat +++ b/forth.wat @@ -87,7 +87,6 @@ (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 ;) @@ -113,7 +112,7 @@ (data (i32.const 16576) "\12\00\00\00") ;; JMP: (data (i32.const 16580) "\78\40\00\00") ;; addr of KEYLOOP (data (i32.const 16584) "\05\00\00\00") ;; KEY <-- WORDLOOP - (data (i32.const 16588) "\11\00\00\00") ;; WS? + (data (i32.const 16588) "\11\00\00\00") ;; WS? <-- WORDLOOP_REENTRY (data (i32.const 16592) "\0f\00\00\00") ;; JNZ: (data (i32.const 16596) "\f0\40\00\00") ;; addr of WORDEND (data (i32.const 16600) "\06\00\00\00") ;; DUP @@ -159,21 +158,21 @@ (data (i32.const 16788) "\05\00\00\00") ;; KEY (data (i32.const 16792) "\11\00\00\00") ;; WS? (data (i32.const 16796) "\0f\00\00\00") ;; JNZ: - (data (i32.const 16800) "\c8\41\00\00") ;; addr of keypump + 3 - (data (i32.const 16804) "\cc\40\00\00") ;; WORDLOOP + 1 + (data (i32.const 16800) "\c8\41\00\00") ;; addr of DO_COMMENT_REENTRY + (data (i32.const 16804) "\cc\40\00\00") ;; WORDLOOP_REENTRY (call) (data (i32.const 16808) "\28\41\00\00") ;; EXECUTE-MODE (data (i32.const 16812) "\01\00\00\00") ;; RET (; Do Comment ;) (data (i32.const 16828) "\18\00\00\00") ;; j-1: <-- keypump - (data (i32.const 16832) "\e0\41\00\00") ;; addr of end - (data (i32.const 16836) "\05\00\00\00") ;; KEY - (data (i32.const 16840) "\02\00\00\00") ;; LIT + (data (i32.const 16832) "\e0\41\00\00") ;; addr of DC_END + (data (i32.const 16836) "\05\00\00\00") ;; KEY <-- DO_COMMENT + (data (i32.const 16840) "\02\00\00\00") ;; LIT <-- DO_COMMENT_REENTRY (data (i32.const 16844) "\0a\00\00\00") ;; 10 (line feed) (data (i32.const 16848) "\25\00\00\00") ;; =? (data (i32.const 16852) "\0e\00\00\00") ;; JZ: (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 + (data (i32.const 16864) "\01\00\00\00") ;; RET <-- DC_END (; Channel Table ;) (; 1 FLAGS: AWAITER | RUNNING ]LSB ;) (; 1 reserved ;) @@ -202,7 +201,7 @@ (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)) - (func $lit_rstack (param $here i32) (param $start i32) (result i32) + (func $lit_rstack (param $here i32) (param $start i32) (param $dstart i32) (result i32) (local $eax i32) (local $ecx i32) i32.const 0 set_local $ecx @@ -219,6 +218,14 @@ i32.add set_local $ecx end + (; push channel default start ;) + get_local $here + get_local $dstart + i32.store + get_local $here + i32.const 4 + i32.add + set_local $here block $output_done block $output_loop get_local $ecx @@ -250,6 +257,14 @@ br $output_loop end end + get_local $here + i32.const 46 + i32.store + get_local $here + i32.const 4 + i32.add + set_local $here + get_local $here i32.const 18 ;; jmp i32.store @@ -265,6 +280,7 @@ return ) (func $close_channel (param $channel_p i32) + (local $eax i32) block $no_close get_local $channel_p i32.const 3 @@ -289,6 +305,21 @@ get_local $channel_p i32.const 0 i32.store8 ;; clear target thread's flags + (; set stdin tail and head to base ;) + get_local $channel_p + i32.const 16 + i32.add + get_local $channel_p + i32.const 20 + i32.add + get_local $channel_p + i32.const 12 + i32.add + i32.load + tee_local $eax + i32.store + get_local $eax + i32.store ) (func $forth_min (param $i1 i32) (param $i2 i32) (result i32) block $is_greater @@ -304,10 +335,10 @@ ) (export "main" (func $main)) (func $main (param $event_channel i32) (result i32) - get_local $event_channel call $rinit get_global $holy_bye call $rpush + get_local $event_channel call $interpret return ) @@ -325,17 +356,6 @@ (local $wordbelt_head 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 @@ -345,6 +365,8 @@ i32.mul i32.add set_local $eax + + (; exit if the event is for a channel that is already running ;) block $check_run get_local $eax i32.load8_u @@ -355,6 +377,7 @@ i32.const 0 return end + get_local $eax get_local $eax i32.load8_u @@ -372,6 +395,7 @@ i32.add i32.load set_local $esi + get_local $eax i32.const 12 i32.add @@ -429,7 +453,7 @@ 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 $openchannel block $rpush_op + block $outchan block $read block $openchannel block $rpush_op block $fetch8_u get_local $eax 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 @@ -439,7 +463,12 @@ (;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;)$awaiting $openchannel - (;52;)$rpush_op $default + (;52;)$rpush_op $fetch8_u $default + end ;; fetch8_u + call $pop + i32.load8_u + call $push + br $next end ;; rpush_op call $pop call $rpush @@ -993,7 +1022,7 @@ get_local $channel_in i32.mul i32.add - i32.const 4 + i32.const 8 i32.add i32.load get_global $quit_p @@ -1034,8 +1063,7 @@ block $pendingword get_local $wordbelt_head get_local $wordbelt_tail - i32.sub - i32.eqz + i32.eq br_if $pendingword i32.const 32 call $push @@ -1141,6 +1169,10 @@ (; backup return stack here, returning to esi ;) get_local $here get_local $esi + get_local $eax + i32.const 8 + i32.add + i32.load call $lit_rstack set_local $here @@ -1161,13 +1193,6 @@ 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 @@ -1184,29 +1209,44 @@ get_local $wordbelt_head i32.store - block $check_awaiter + block $await_exit 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 + i32.eq ;; halt if awaiting + br_if $await_exit + block $no_awaiter + get_local $eax + i32.load8_u + i32.const 2 + i32.and + i32.eqz ;; (FLAGS & 2) => awaiter, run it + br_if $no_awaiter + get_local $eax + i32.const 2 + i32.add + i32.load8_u + tee_local $eax + call $push + get_global $channel_table_p + get_global $channel_entry_size + get_local $eax + i32.mul + i32.add + tee_local $eax + get_local $eax + i32.load8_u + i32.const 254 + i32.and + i32.store8 ;; toggle off runflag + call $pop + call $main + get_local $channel_in + call $close_channel + return + end get_local $channel_in - set_local $eax - set_local $channel_in - br $recurse_loop + call $close_channel end - end ;; recurse_loop - get_local $channel_in - call $close_channel i32.const 0 return )