X-Git-Url: https://git.kengrimes.com/?p=watForth.git;a=blobdiff_plain;f=forth.wat;h=61cbb2238a83b51ed204844b6302a1d782a55e92;hp=43dc195d1c71c44b5b0058577c16a8df32b8a22e;hb=63e17ddc993a5a04cc6ae55bad8420b61c37d1bf;hpb=a83e7e42d457eb562902eea8090c3f2b51351686

diff --git a/forth.wat b/forth.wat
index 43dc195..61cbb22 100644
--- a/forth.wat
+++ b/forth.wat
@@ -15,14 +15,16 @@
   (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) (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) (result 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_write" (func $sys_write (param i32 i32 i32) (result i32)))
@@ -30,7 +32,9 @@
   (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) (result i32)))
+  (import "env" "does_set" (func $does_set (param 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))
@@ -43,10 +47,10 @@
   (global $inbuf_size i32 (i32.const 12292))
   (global $inbuf_data i32 (i32.const 12296))
   (global $kvars i32 (i32.const 14336))   ;; 0x3800 Size: 2048
-  (data (i32.const 12288) "\fc\07\00\00") ;; 2044 len
+  (data (i32.const 12288) "\f8\07\00\00") ;; 2040 len
   (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
@@ -108,13 +112,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,19 +128,26 @@
   (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) "\02\00\00\00") ;; LIT
-  (data (i32.const 16796) "\20\00\00\00") ;; 32 (space)
-  (data (i32.const 16800) "\25\00\00\00") ;; =?
-  (data (i32.const 16804) "\0f\00\00\00") ;; JNZ:
-  (data (i32.const 16808) "\bc\41\00\00") ;; addr of keypump
-  (data (i32.const 16812) "\cc\40\00\00") ;; WORDLOOP + 1
-  (data (i32.const 16816) "\28\41\00\00") ;; EXECUTE-MODE
-  (data (i32.const 16820) "\01\00\00\00") ;; RET
+  (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 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
@@ -188,9 +199,6 @@
     set_local $channel
     block $bye
     loop $next
-        call $sys_stack
-      get_local $esi
-      call $sys_reflect
       get_local $esi
       get_local $esi
       i32.const 4
@@ -206,14 +214,142 @@
       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 $echostring block $strstart block $strput block $strend block $fetchinc
+      block $setinc block $finddoes block $definedoes
         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 $default
+        (;34;)$subtract $keychan (;36;)$sethere $eqbool (;38;)$echostring $strstart
+        (;40;)$strput $strend (;42;)$fetchinc $setinc (;44;)$finddoes $definedoes
+        (;46;)$default
+      end ;; definedoes
+        call $pop
+        set_local $eax
+        call $pop
+        get_local $eax
+        call $does_set
+        br $next
+      end ;; finddoes
+        call $pop
+        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
+        get_local $stringbelt_tail
+	i32.const 4
+	i32.add
+        i32.sub
+        tee_local $eax (; n bytes ;)
+        i32.store
+        (; align to 32-bit ;)
+        get_local $stringbelt_head
+        i32.const 3
+        i32.add
+        i32.const 8188
+        i32.and
+        set_local $stringbelt_head
+        (; /align ;)
+        get_local $stringbelt_tail
+        i32.const 4
+        i32.add
+        call $push
+        get_local $eax
+        call $push
+        br $next
+      end ;; strput
+        block $sbhasspace2
+          get_local $stringbelt_head
+          get_global $wordbelt
+          i32.lt_u
+          br_if $sbhasspace2
+          i32.const 0
+          tee_local $stringbelt_head
+          get_local $stringbelt_tail
+          i32.load
+          i32.store
+          get_local $stringbelt_head
+          i32.const 4
+          i32.add
+          set_local $stringbelt_head
+          get_local $stringbelt_tail
+          i32.const 4
+          i32.add
+          set_local $stringbelt_tail
+          loop $copystringtostart
+            get_local $stringbelt_head
+            get_local $stringbelt_tail
+            i32.load16_u
+            i32.store16
+            get_local $stringbelt_head
+            i32.const 2
+            i32.add
+            set_local $stringbelt_head
+            get_local $stringbelt_tail
+            i32.const 2
+            i32.add
+            tee_local $stringbelt_tail
+            get_global $wordbelt
+            i32.le_u
+            br_if $copystringtostart
+          end
+          i32.const 0
+          set_local $stringbelt_tail
+        end
+	get_local $stringbelt_head
+        call $pop
+	i32.store16
+	get_local $stringbelt_head
+	i32.const 2
+	i32.add
+        set_local $stringbelt_head
+	br $next
+      end ;; strstart
+        block $sbhasspace
+          get_local $stringbelt_head
+          get_global $wordbelt
+          i32.const 8
+          i32.sub
+          i32.le_u
+          br_if $sbhasspace
+          i32.const 0
+          set_local $stringbelt_head
+        end
+        get_local $stringbelt_head
+        get_local $stringbelt_head
+        tee_local $stringbelt_tail
+        i32.const 0
+        i32.store
+        i32.const 4
+        i32.add
+        set_local $stringbelt_head
+        br $next
       end ;; echostring
         get_local $channel
         call $pop
@@ -271,12 +407,14 @@
         br $next
       end ;; rot
         call $pop
-        set_local $eax
         call $pop
+        set_local $eax
         call $pop
-        get_local $eax
+        call $rpush
         call $push
+        call $rpop
         call $push
+        get_local $eax
         call $push
         br $next
       end ;; dup2
@@ -305,7 +443,6 @@
         get_local $eax
         call $rpop
         call $vocab_set
-        drop
         br $next
       end ;; here
         get_local $here
@@ -463,7 +600,6 @@
         get_local $eax
 	call $push
 	call $push
-        call $sys_stack
         br $next
       end ;; drop
         call $pop
@@ -562,14 +698,20 @@
             set_local $inbuf_head
             br $next
           end ;; key_read
+          get_global $inbuf_size
           get_local $channel
+          get_global $inbuf_data
           get_global $inbuf
+          i32.load
           call $sys_read
+          i32.store
           block $nullread
             get_global $inbuf_size
             i32.load
             i32.eqz
             br_if $nullread
+            get_global $inbuf_data
+            set_local $inbuf_head
             br $key_loop
           end ;; nullread
           i32.const -1 ;; <- keyval sent if sz == 0
@@ -596,7 +738,7 @@
         br $next
       end ;; op0
         get_local $esi
-        call $sys_reflect
+        call $rpush
         br $bye
       end ;; default
         get_local $esi
@@ -605,7 +747,7 @@
         set_local $esi
         br $next
     end ;; execloop
-    end ;; nextl
+    end ;; next loop
     end ;; bye
     i32.const 14340
     get_local $here
@@ -626,5 +768,6 @@
     get_local $channel
     i32.store
     i32.const 0
+    return
   )
 )