From: ken <ken@mihrtec.com>
Date: Sun, 18 Mar 2018 12:43:44 +0000 (-0700)
Subject: channels working
X-Git-Url: https://git.kengrimes.com/?p=watForth.git;a=commitdiff_plain

channels working
---

diff --git a/forth.forth b/forth.forth
index 8f609d7..2f9ff87 100644
--- a/forth.forth
+++ b/forth.forth
@@ -57,7 +57,7 @@ word WS? 17 define
 word . 9 define
 word .S 38 define
 word @ 10 define
-word @8_u 53 define
+word @8u 53 define
 word @+ 42 define
 word ! 11 define
 word !+ 43 define
@@ -68,6 +68,7 @@ word DROP 16 define
 word 2DROP 32 define
 word SWAP 26 define
 word ROT 31 define
+word -ROT 54 define
 
 \ ' "TICK" returns address of word's execution semantics
 word ' here define
@@ -93,18 +94,18 @@ word ::> here define
 ' drop , ' lit , ' lit , ' , , ' execute-num , ' , , ' ; , 
 
 \ change interpreter semantics to "memorize-word"
-::> MEMORIZING ' lit , ' mode , ' lit , ' memorize-word , ' ! , ' ; ,
+::> MEMORIZING ' lit , ' memorize-word , ' lit , ' mode , ' ! , ' ; ,
 
 \ memorize the compiler
 \memorizing
-\: executing lit mode lit execute-word ! ;
+\: executing lit execute-word lit mode ! ;
 \: FINISH-" drop string-end ;
 \: BSLASH-" drop key string-put JMP: \here \8 \+ \,
 \: " string-start \: KLOOP key 92 =? JNZ: bslash-" 34 =? JNZ: finish-" string-put JMP: KLOOP
 \: DO"    \:> " " swap lit lit , , lit lit , , ;
 \: DOIF   \:> IF lit JZ: , here dup , ;
-\: DOELSE \:> ELSE lit JMP: , here dup , swap here ! ;
-\: DOTHEN \:> THEN here ! ;
+\: DOELSE \:> ELSE lit JMP: , here dup , here -rot ! ;
+\: DOTHEN \:> THEN here swap ! ;
 \: COMPILE-WORD dup
 \doif 2dup find-does dup
   \doif rot 2drop execute ;
@@ -112,7 +113,7 @@ word ::> here define
   \doif , 2drop ;
   \dothen drop lit lit , execute-num , ;
 \dothen 2drop \do" Compilation Error: null word" .s bye
-\: compiling lit mode lit compile-word ! ;
+\: compiling lit compile-word lit mode ! ;
 
 \ compile the rest of the compiler
 \compiling
@@ -146,7 +147,7 @@ here define-does then compiling ;
 )
 
 \ Set the number conversion base
-: BASE 14348 swap ! ;
+: BASE 14348 ! ;
 : BASE10 10 base ;
 
 \ TICK compilation semantics
@@ -155,24 +156,6 @@ here define-does then compiling ;
 : '> word find-does ;
 :> '> word find-does , ;
 
-\ CHAR 
-: CHAR: word drop @8_u ;
-:> CHAR: lit lit , ' char: execute , ;
-
-\ JSON Compiler
-: JSON-CTRL-CHAR? char: { =? if 1 ;; then
-                  char: } =? if 1 ;; then
-                  char: [ =? if 1 ;; then
-                  char: ] =? if 1 ;; then
-                  0 ;
-: JSON-PARSE-V ;
-: JSON-PARSE-" ;
-: JSON-PARSE-[ ;
-: JSON-PARSE-{ ;
-: JSON-WORD word-start key JSON-CTRL-CHAR? if word-end ;; then ws?   ;
-
-: JSON{ key ; 
-
 \ Include a remote file
 : REQUIRE" ' quit channel-open dup \' " \, fetch channel-await ;
 
diff --git a/forth.wasm b/forth.wasm
index f04ed71..7724ac9 100644
Binary files a/forth.wasm and b/forth.wasm differ
diff --git a/forth.wat b/forth.wat
index 75c3009..d524060 100644
--- a/forth.wat
+++ b/forth.wat
@@ -145,9 +145,9 @@
   (data (i32.const 16740) "\01\00\00\00") ;; RET
   (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 16752) "\00\00\00\00") ;; 0
   (data (i32.const 16756) "\02\00\00\00") ;; LIT
-  (data (i32.const 16760) "\00\00\00\00") ;; 0
+  (data (i32.const 16760) "\04\30\00\00") ;; INBUFSIZE LOCATION
   (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") ;; 
@@ -454,6 +454,7 @@
       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 $fetch8_u
+      block $negrot
         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
@@ -463,7 +464,19 @@
         (;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 $fetch8_u $default
+        (;52;)$rpush_op $fetch8_u (;54;)$negrot $default
+      end ;; negrot
+        call $pop
+        call $pop
+        set_local $eax
+        call $pop
+        get_local $eax
+        call $push
+        set_local $eax
+        call $push
+        get_local $eax
+        call $push
+        br $next
       end ;; fetch8_u
         call $pop
         i32.load8_u
@@ -588,11 +601,9 @@
         call $push
         br $next
       end ;; setinc
-        call $pop
-        call $rpush
         call $pop
         tee_local $eax
-        call $rpop
+        call $pop
         i32.store
         get_local $eax
         i32.const 4
@@ -975,9 +986,7 @@
         br $next
       end ;; set
         call $pop
-        set_local $eax
         call $pop
-        get_local $eax
         i32.store
         br $next
       end ;; fetch