X-Git-Url: https://git.kengrimes.com/?p=watForth.git;a=blobdiff_plain;f=forth.wat;h=0a16efc078c8f1efdac88172e37333ec0f3db125;hp=666cc818a562b4883e3d980ab85a9854c460967e;hb=fb7946e17777ee389e3eaf742e6ff87a5d832710;hpb=94d40c7e5521898acd394ca7a3e30cf20065ee5c

diff --git a/forth.wat b/forth.wat
index 666cc81..0a16efc 100644
--- a/forth.wat
+++ b/forth.wat
@@ -25,8 +25,8 @@
   (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 i32)))
   (import "env" "sys_echochar" (func $sys_echochar (param i32)))  
@@ -48,6 +48,16 @@
   (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 (16384) (Quit)
@@ -56,9 +66,15 @@
   (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)
@@ -161,47 +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
-    (; Load "start" into esi, then restore "start" to "quit" ;)
-    i32.const 14344
-    i32.load
-    set_local $esi
-    i32.const 14344
-    i32.const 16384
-    i32.store
-    (; "start" will be a normal quit, unless cirumvented in this run ;)
     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
@@ -218,18 +253,41 @@
       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 $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 $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
+        (;34;)$subtract $inchan (;36;)$sethere $eqbool (;38;)$echostring $strstart
         (;40;)$strput $strend (;42;)$fetchinc $setinc (;44;)$finddoes $definedoes
-        (;46;)$stacktrace $default
+        (;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
@@ -367,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
@@ -394,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
@@ -521,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
@@ -678,7 +736,7 @@
         br $next
       end ;; emit (.)
         call $pop
-        i32.const 14348
+        get_global $base_p
         i32.load
         call $sys_echo
         br $next
@@ -717,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
@@ -739,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
@@ -751,7 +813,23 @@
         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
@@ -767,23 +845,26 @@
     end ;; execloop
     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