webpush hookup

diff --git a/.gitignore b/.gitignore
index 0fb9098..d7620d4 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,3 @@
 c/switch_split.*
 !c/switch_split.c
 *~
-forth.wasm

diff --git a/forth.forth b/forth.forth
index dce37c5..47224b9 100644 (file)
--- a/forth.forth
+++ b/forth.forth
@@ -57,6 +57,7 @@ word WS? 17 define
 word . 9 define
 word .S 38 define
 word @ 10 define
+word @8_u 53 define
 word @+ 42 define
 word ! 11 define
 word !+ 43 define
@@ -92,7 +93,7 @@ word ::> here define
 ' drop , ' lit , ' lit , ' , , ' execute-num , ' , , ' ; , 
 
 \ change interpreter semantics to "memorize-word"
-: memorizing ' lit , ' mode , ' lit , ' memorize-word , ' ! , ' ; ,
+::> MEMORIZING ' lit , ' mode , ' lit , ' memorize-word , ' ! , ' ; ,
 
 \ memorize the compiler
 \memorizing
@@ -139,15 +140,42 @@ here define-does then compiling ;
 \ Multi-line comments
 ::> ( key 41 =? swap -1 =? swap drop + if ;; then JMP: \' ( \, ;
 
-\ Set the number conversion base
-: BASE 14348 swap ! ;
-: BASE10 10 base ;
-
 (
   End of bootstrap process
   beyond this point, all hope is lost
 )
 
+\ Set the number conversion base
+: BASE 14348 swap ! ;
+: BASE10 10 base ;
+
+\ TICK compilation semantics
+:> ' lit lit , word find , ;
+\ "TICK DOES" (get compilation semantics execution token)
+: '> word find-does ;
+:> '> word find-does , ;
+
+\ CHAR 
+: CHAR: word drop @8_u ;
+:> CHAR: lit lit , ' char: execute , ;
+
+\ JSON Compiler
+: JSON-CTRL-CHAR char: { =? if ;; then
+                 char: } =? if ;; then
+                 char: [ =? if ;; then ;
+: JSON-PARSE-V ;
+: JSON-PARSE-" ;
+: JSON-PARSE-[ ;
+: JSON-PARSE-{ ;
+:> JSON-WORD wordstart key -1 =? if ;; then ws?   ;
+
+
+\ Include a remote file
+: REQUIRE" ' quit channel-open dup \' " \, fetch channel-await ;
+
+\ Let's try it
+REQUIRE" { \"url\": \"forth/test-watfor.forth\" }"
+
 \ Print intro string
 " watForth-32 Interactive CLI:
 " .s

diff --git a/forth.js b/forth.js
index 0844bd0..d3a2f83 100644 (file)
--- a/forth.js
+++ b/forth.js
@@ -141,7 +141,9 @@ const wasmImport = {
     does_get: (addr, u) => doesDictionary[wasmString(addr, u).toUpperCase()] || 0,
     does_set: (addr, u, v) => doesDictionary[wasmString(addr, u).toUpperCase()] = v,
     is_whitespace: (key) => /\s/.test(String.fromCharCode(key)),
-    sys_stack: () => console.log(`[${simstack}][${rstack}]`),
+    sys_stack: () => { console.log(`[${simstack}][${rstack}]`)
+                       console.log(new Uint32Array(wasmMem, 16900, 28))
+                     },
     sys_parsenum: (addr, u) => {
       const answer = Number.parseInt(wasmString(addr, u), wasmBase())
       if (Number.isNaN(answer))
@@ -222,7 +224,7 @@ window.onload = () => {
         txtinput.oninput()
       }
       else {
-        if (!/\s/.test(txtinput.value.slice(-1)))
+        if (txtinput.value.length && !/\s/.test(txtinput.value.slice(-1)))
           txtinput.value += " "
         event.preventDefault()
         event.stopPropagation()

diff --git a/forth.wasm b/forth.wasm
new file mode 100644 (file)
index 0000000..f04ed71
Binary files /dev/null and b/forth.wasm differ

diff --git a/forth.wat b/forth.wat
index 778681a..75c3009 100644 (file)
--- 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
   )