X-Git-Url: https://git.kengrimes.com/?p=watForth.git;a=blobdiff_plain;f=forth.wat;h=0a16efc078c8f1efdac88172e37333ec0f3db125;hp=0c4b767e5706af4487112c17cd8ea279d22e4331;hb=fb7946e17777ee389e3eaf742e6ff87a5d832710;hpb=d30761f3974c9a6ccc543392c20060885ca91a36 diff --git a/forth.wat b/forth.wat index 0c4b767..0a16efc 100644 --- a/forth.wat +++ b/forth.wat @@ -15,22 +15,26 @@ (type $FUNCSIGii (func (param i32))) (type $FUNCSIGiii (func)) (type $FUNCSIGiv (func (param i32 i32) (result i32))) - (type $FUNCSIG$v (func (param i32) (result i32))) - (type $FUNCSIG$vi (func (param i32 i32 i32) (result i32))) + (type $FUNCSIGv (func (param i32) (result i32))) + (type $FUNCSIGvi (func (param i32 i32 i32) (result i32))) + (type $FUNCSIGvii (func (param i32 i32))) + (type $FUNCSIGviii (func (param i32 i32 i32))) (import "env" "pop" (func $pop (result i32))) (import "env" "push" (func $push (param i32))) (import "env" "rinit" (func $rinit)) (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_fetch" (func $sys_fetch (param i32 i32) (result i32))) - (import "env" "sys_listen" (func $sys_listen (param i32) (result 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))) + (import "env" "sys_echo" (func $sys_echo (param i32 i32))) (import "env" "sys_echochar" (func $sys_echochar (param 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) (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_stack" (func $sys_stack)) @@ -44,17 +48,33 @@ (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 + (global $mode_p i32 (i32.const 14336)) + (global $here_p i32 (i32.const 14340)) + (global $start_p i32 (i32.const 14344)) + (global $base_p i32 (i32.const 14348)) + (global $stringbelt_tail_p i32 (i32.const 14352)) + (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 14344) "\00\40\00\00") ;; START + (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 + (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 ;) - (data (i32.const 16384) "\03\00\00\00") ;; RINIT xt + (global $quit_p i32 (i32.const 16384)) + (data (i32.const 16384) "\01\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) @@ -108,13 +128,13 @@ (data (i32.const 16628) "\17\00\00\00") ;; WORDFINISH (data (i32.const 16632) "\01\00\00\00") ;; RET (; Exec Mode ;) - (data (i32.const 16680) "\1e\00\00\00") ;; DUP2 + (data (i32.const 16680) "\1e\00\00\00") ;; 2DUP (data (i32.const 16684) "\15\00\00\00") ;; DICT_GET (data (i32.const 16688) "\06\00\00\00") ;; DUP (data (i32.const 16692) "\0e\00\00\00") ;; JZ: (data (i32.const 16696) "\4c\41\00\00") ;; donum -1 (16716) (data (i32.const 16700) "\1f\00\00\00") ;; ROT - (data (i32.const 16704) "\20\00\00\00") ;; DROP2 + (data (i32.const 16704) "\20\00\00\00") ;; 2DROP (data (i32.const 16708) "\0c\00\00\00") ;; EXECUTE (data (i32.const 16712) "\01\00\00\00") ;; RET (data (i32.const 16716) "\10\00\00\00") ;; DROP (xt from dictionary) @@ -124,9 +144,17 @@ (data (i32.const 16732) "\68\41\00\00") ;; donum_err (16744) (data (i32.const 16736) "\10\00\00\00") ;; DROP (data (i32.const 16740) "\01\00\00\00") ;; RET - (data (i32.const 16744) "\10\00\00\00") ;; PARSE_ERR <-- donum_err - (data (i32.const 16748) "\10\00\00\00") ;; ( DROP DROP ) - (data (i32.const 16752) "\19\00\00\00") ;; BYE + (data (i32.const 16744) "\20\00\00\00") ;; 2DROP <-- donum_err + (data (i32.const 16748) "\02\00\00\00") ;; LIT + (data (i32.const 16752) "\04\30\00\00") ;; INBUFSIZE LOCATION + (data (i32.const 16756) "\02\00\00\00") ;; LIT + (data (i32.const 16760) "\00\00\00\00") ;; 0 + (data (i32.const 16764) "\0b\00\00\00") ;; ! + (data (i32.const 16768) "\19\00\00\00") ;; BYE + (data (i32.const 16772) "\00\00\00\00") ;; + (data (i32.const 16776) "\00\00\00\00") ;; + (data (i32.const 16780) "\00\00\00\00") ;; + (data (i32.const 16784) "\00\00\00\00") ;; (; Do Backslash ;) (data (i32.const 16788) "\05\00\00\00") ;; KEY (data (i32.const 16792) "\11\00\00\00") ;; WS? @@ -149,42 +177,66 @@ (export "memory" (memory $0)) (export "main" (func $main)) - (func $main (result i32) + (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 + 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 + i32.store + end + get_global $channel_listeners_p + get_local $event_channel + i32.const 2 + i32.shl + i32.add + i32.load call $interpret ) - (func $interpret (result i32) + (func $interpret (param $esi i32) (result i32) (local $here i32) (local $eax i32) - (local $esi i32) (local $inbuf_head i32) (local $stringbelt_tail i32) (local $stringbelt_head i32) (local $wordbelt_tail i32) (local $wordbelt_head i32) - (local $channel i32) - i32.const 14340 + (local $channel_in i32) + (local $channel_out i32) + get_global $here_p i32.load set_local $here - i32.const 14344 - i32.load - set_local $esi get_global $inbuf_data set_local $inbuf_head - i32.const 14352 + get_global $stringbelt_tail_p i32.load set_local $stringbelt_tail - i32.const 14356 + get_global $stringbelt_head_p i32.load set_local $stringbelt_head - i32.const 14360 + get_global $wordbelt_tail_p i32.load set_local $wordbelt_tail - i32.const 14364 + get_global $wordbelt_head_p i32.load set_local $wordbelt_head - i32.const 14368 + get_global $channel_in_p i32.load - set_local $channel + set_local $channel_in + get_global $channel_out_p + i32.load + set_local $channel_out + get_global $quit_p + set_local $esi block $bye loop $next get_local $esi @@ -201,16 +253,86 @@ block $drop block $wsbool block $jmp block $wordputc block $wordstart block $dictget block $parsenum block $wordfinish block $jneg1 block $swap block $words block $here block $dictset block $dup2 block $rot block $drop2 - block $comma block $subtract block $keychan block $sethere block $eqbool - block $echostring block $strstart block $strput block $strend + 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 get_local $eax br_table $op0 $ret (;2;)$lit $rinit (;4;)$word $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 $keychan (;36;)$sethere $eqbool (;38;)$echostring $strstart - (;40;)$strput $strend $default + (;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 + end ;; read + get_local $channel_in + call $pop ;; location to write + set_local $eax + call $pop + get_local $eax + call $sys_read + br $next + end ;; outchan + call $pop + set_local $channel_out + br $next + end ;; webfetch + call $pop + call $rpush + call $pop + set_local $eax + call $pop + get_local $eax + call $rpop + call $sys_fetch + br $next + end ;; stacktrace + call $sys_stack + get_local $esi + call $sys_reflect + br $next + end ;; definedoes + call $pop + call $rpush + call $pop + set_local $eax + call $pop + get_local $eax + call $rpop + call $does_set + br $next + end ;; finddoes + call $pop + set_local $eax + call $pop + get_local $eax + call $does_get + call $push + br $next + end ;; setinc + call $pop + call $rpush + call $pop + tee_local $eax + call $rpop + i32.store + get_local $eax + i32.const 4 + i32.add + call $push + br $next + end ;; fetchinc + call $pop + tee_local $eax + i32.const 4 + i32.add + call $push + get_local $eax + i32.load + call $push + br $next end ;; strend get_local $stringbelt_tail get_local $stringbelt_head @@ -303,7 +425,7 @@ set_local $stringbelt_head br $next end ;; echostring - get_local $channel + get_local $channel_out call $pop set_local $eax call $pop @@ -330,9 +452,9 @@ call $pop set_local $here br $next - end ;; keychan + end ;; inchan call $pop - set_local $channel + set_local $channel_in br $next end ;; subtract call $pop @@ -395,7 +517,6 @@ get_local $eax call $rpop call $vocab_set - drop br $next end ;; here get_local $here @@ -458,7 +579,7 @@ call $pop tee_local $eax call $rpop - i32.const 14348 (; load BASE ;) + get_global $base_p i32.load call $sys_parsenum get_local $eax @@ -615,6 +736,8 @@ br $next end ;; emit (.) call $pop + get_global $base_p + i32.load call $sys_echo br $next end ;; noop2 @@ -652,7 +775,7 @@ br $next end ;; key_read get_global $inbuf_size - get_local $channel + i32.const 0 (; stdin hardcode ;) get_global $inbuf_data get_global $inbuf i32.load @@ -674,7 +797,11 @@ end ;; word br $next end ;; rinit + call $rpop + call $rinit + i32.const 0 + set_local $channel_in br $next end ;; lit get_local $esi @@ -686,12 +813,28 @@ call $push br $next end ;; ret - call $rpop + 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 set_local $esi br $next end ;; op0 get_local $esi - call $sys_reflect + call $rpush br $bye end ;; default get_local $esi @@ -700,26 +843,30 @@ set_local $esi br $next end ;; execloop - end ;; nextl + end ;; next loop end ;; bye - i32.const 14340 + get_global $here_p get_local $here i32.store - i32.const 14352 + get_global $stringbelt_tail_p get_local $stringbelt_tail i32.store - i32.const 14356 + get_global $stringbelt_head_p get_local $stringbelt_head i32.store - i32.const 14360 + get_global $wordbelt_tail_p get_local $wordbelt_tail i32.store - i32.const 14364 + get_global $wordbelt_head_p get_local $wordbelt_head i32.store - i32.const 14368 - get_local $channel + get_global $channel_in_p + get_local $channel_in + i32.store + get_global $channel_out_p + get_local $channel_out i32.store i32.const 0 + return ) )