From 18b72639839461c074eb18fc2b58aa2a326485a1 Mon Sep 17 00:00:00 2001
From: ken <ken@mihrtec.com>
Date: Fri, 16 Mar 2018 13:19:47 -0700
Subject: [PATCH] webpush hookup

---
 .gitignore  |   1 -
 forth.forth |  38 ++++++++++++--
 forth.js    |   6 ++-
 forth.wasm  | Bin 0 -> 3909 bytes
 forth.wat   | 144 +++++++++++++++++++++++++++++++++-------------------
 5 files changed, 129 insertions(+), 60 deletions(-)
 create mode 100644 forth.wasm

diff --git a/.gitignore b/.gitignore
index 0fb9098..d7620d4 100644
--- 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
--- 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
--- 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
index 0000000000000000000000000000000000000000..f04ed7101fe0f10104c22c8427f0f4e25fc69189
GIT binary patch
literal 3909
zcmchaJ#QSx8OLXK_l|eBbG#)*i4-MEb9a^{Io6A1#W9j1+`<YB#K;#2Y%$c?<niUG
zJKBkn0LLUOR1g6R7A#n(P{D$Q3Kc3CgoO$sP@zJF3ISoE!i5VJDpUw@{{QFM<0|<8
zk${`uJoC)+Iy<{G)4fG&jIkF>H;wJzw0(2an43YrFBANPePKw9unC?A<6&#*+i<zF
zYz!${{-!r;EV0m?Tbf%jfrz_D8ij7IQtExz`?A}bzGVv3Ds%e#?%Ybt3~?^Yz1GsL
zx2B!t){?ps?U{v6uciKE{#9#bW>&4mv^LXOT58R#nDEG6Yi72i8-}Q`(D~XFxhU%0
z)>jKumjue+c4nr3_vP2EY<o8EVXoob>a=?Ka!IB~tJOK=GK*Y#%hNM06VZpG$K~lR
za{6XbW0I(QE7LRcS}CnTr+cf1d9hHiVT6Ac<t>EP*y5i?`zBr8H!+99{~BKEOoufc
z?&z?t!-fu<I&A5%t;6c7rOh=R4zk&r2v2k6M;i}~1jWVHVyF9EV4}t8xg|4M`A4nr
zH*14_YU)uim4uD3IeepPe3)1trM6v<VsCu#abUbjqjuc{Q^AyvKCN=Ok7bCDRvRWU
z1I>m>uMfCxoQYv4y_`!h8y(CV#@hkc;?J$^!-q-3&k=}8%5k&SOuSiW!)DaRLaBWr
z$Q+rU8%CB;JjNf#wT77EPdti<J?wu5TegNEYH`&hL321k=*g*C{P(JLeR^n)KyY%Q
zT@SD$xMWOfZ+}`fDR%fE6Lje=NW(Uk>kbsrT|ESeW7H!+Fq9QQV?ssHgwRm4z$M!(
zaVRy*9LmiKhe|W%5VOGHln;H#dWVz+A!Prr|2`Q0_@iqdUcGYp(g*eTFJ3tR-nn<1
zjk-U3=AF~0KAAi@F@ECs*s;-(q&8f2aiv@uDi)&fXMr`><HVpYiFH2(C6T)>ol8oM
z0L2c_KUOZaQbW`vf<T7EG~^8N2Rg2;$AOg`5PB;;WhK2$SFxA#1n1O!gsvv2Qi9eb
z1$Pb3>&|^BF&xRmq>}b;RIj<KF%EZ>98bbYcjbR|M%`uZR#PLeeJRsG3L%duqlWkc
zh!H8-2WSyQKZ$+GmwgGsc}=IxY~TFyc3q`Zh2Hz<urD_a4rFQ?Si*K%E@NY+Suf!L
zVC9N6zpz{hbR}pvN=<{OBF5udihVhGYu#PU45y`es6e9(4PS1QQrZ{m?n3O{QGP@2
zJhq@yNaY4&<1R#aK29x$_gD$*&T%mAT@F&0d8{>KZ}nNXG;Cc1%ZZtsbaer0qR5v0
zk*vK|T}(7Gp<FU>n}qeyo#no0-~;;-cZN=^dnZm#xYGl(YVMQ-&W7TuVg#W(1rK~!
zLN^)1TV=i;_*gpdFLS#NK^Do$%n>`9jAh+}n+eFX#@8?%XEoy{(qlE7cranLUU4Tf
zIod}d8U@o?qhdA+Qw)ttlUGg*oeDN;qjcRJKZ<k=3y9+wO9Y?CFr9Rxk{fQGK|Z6<
z*BnRkrGa3el*Fzk*3#ABvuc%R+y^MeFoc>G4uPv;rpMKR66fOBRY-=Xx(wnYDZ!MG
z8%j|0h2K;Sz~Q<_&e>J0cW~4F3TMXpVj3jH*cVX;R2j2&y$EaG_{b0WXg(>xEV@+i
zQN0LT0kU&eD(NfeVd}*@LXimML9V)DtoO7lpaA)G2-PT-GZR9NYX+~VLAExI_0Hkj
zB0wBoUJ%*!9q{@dWS|#Kqz^SNnt~E8nxYaenjs~;bo7OSFapgy8L!*4kGJDn=EAmj
zbWjlOX33YZy@^MVL&aA(;4EN33Gntr;;aSVGy&f<upRKlf)ioItX!F@@Nat?rqQTL
z+;tOtk0leh1!{5p&&nV1ErG9q=t62>ik}Wq^aYWh50RN7t`jRDlkzhnBAJw*5*hMy
zBEqW_Qhrio$j^!>6x}sqGDU?u#8Hv16V=5AaYYn1iB(b9%5j@m6zN^!u;4x7lx*7}
z1|r=hnoq##eWHf`fapZwAyHlI5v@q~iHYE&9QipEofPRS;+WuTVnOf?Q6pRZGjKwr
zYs8mR;Pei0M5OD)n&1X;PZTzZ8u}LTx1z93JSTXUm}N|SA=`F{8t*P~Q(AbRsJT5L
zYN;O*wZ3~q-L{`AJR<%<>>dy`x5q>c{RvS+e@fKco)I<q=R{5ZFjsg%JSJIuPt<UJ
zARdUfmqZQc6>(g2UlX-0Z-{cx($&8lNq2~6M0b~XT<|_o!+Ai|nmr``TB@^0JS)2U
zL@)S=s7K>~sE!{KHL@qf6QcW+s4kunwIt7pv*O~AsM}r;)!6q$_4Wf%+x?OlU4`NF
zRW5x^q%)JgA;yBMe+BA6TqCN&ogCM5+{kg0sNLKmYB#ru8v0%0frNgK_;`wrcZhl^
z>=HGLJ)-t_pLi(S9ud{W0a0^%Ow>p33Gtj{@sy}-c}Cn53(tvKvqPeKTf?6qOw-~S
t5|qf+bKDS=@@?k0mE*Rc+yr+8C5C%B?&P?e<NX{T<oGbhy&U%k_#bQhMI`_L

literal 0
HcmV?d00001

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
   )
-- 
2.18.0