From: ken <ken@mihrtec.com>
Date: Mon, 5 Mar 2018 10:06:15 +0000 (-0800)
Subject: compiler-mode implemented
X-Git-Url: https://git.kengrimes.com/?p=watForth.git;a=commitdiff_plain;h=63e17ddc993a5a04cc6ae55bad8420b61c37d1bf

compiler-mode implemented
---

diff --git a/forth.forth b/forth.forth
index e7dc229..63da4a7 100644
--- a/forth.forth
+++ b/forth.forth
@@ -10,19 +10,93 @@
 \
 \ You should have received a copy of the GNU General Public License
 \ along with this program.  If not, see <http://www.gnu.org/licenses/>.
+16500 execute WORD 16500 29 execute
+word DEFINE 29 29 execute
+\ word EXECUTE 12 define
+word RINIT 3 define
+word NOOP 13 define
+word MODE 14336 define
+word EXECUTE-MODE 16680 define
+word EXECUTE-NUM 16720 define
+word INTERPRET 16400 define
+word KEY 5 define
+word WORD-START 20 define
+word WORD-PUT 19 define
+word WORD-END 23 define
+word STRING-START 39 define
+word STRING-PUT 40 define
+word STRING-END 41 define
+word NUMBER 22 define
+word FIND 21 define
+word FIND-DOES 44 define
+word DEFINE-DOES 45 define
+word QUIT 16384 define
+word BYE 25 define
+word WORDS 27 define
+word !CHANNEL 35 define
+word !HERE 36 define
+word HERE 28 define
+
+word ; 1 define
+word JZ: 14 define
+word JNZ: 15 define
+word J-1: 24 define
+word JMP: 18 define
+word , 33 define
+word + 7 define
+word - 34 define
+word =? 37 define
+word WS? 17 define
+word . 9 define
+word .S 38 define
+word @ 10 define
+word @+ 42 define
+word ! 11 define
+word !+ 43 define
+word LIT 2 define
+word DUP 6 define
+word 2DUP 30 define
+word DROP 16 define
+word 2DROP 32 define
+word SWAP 26 define
+word ROT 31 define
+
 word ' here define
 word word find , word find find , word ; find ,
+
 word : here define
 ' word , ' here , ' define , ' ; ,
+' : dup define-does
+
 : IWRITE-MODE ' dup , ' JNZ: , here 12 + , ' 2drop , ' ; ,
 ' 2dup , ' find , ' dup , ' JZ: , here 16 + , ' , , ' 2drop , ' ; ,
-' drop , ' LIT , ' LIT , ' , , 16720 , ' , , ' ; ,
+' drop , ' LIT , ' LIT , ' , , ' EXECUTE-NUM , ' , , ' ; ,
+
 : i ' LIT , ' MODE , ' LIT , ' IWRITE-MODE , ' ! , ' ; ,
-: e ' LIT , ' MODE , ' LIT , ' EXECUTE-MODE , ' ! , ' ; ,
+
 \i
-\: FINISH-STRING DROP STRING-END ;
-\: " STRING-START
-\: KEYPUMP KEY 34 =? JNZ: FINISH-STRING STRING-PUT JMP: KEYPUMP
+\: e LIT MODE LIT EXECUTE-MODE ! ;
+\: :> word find here define-does ;
+\' :> \dup \define-does
+\: FINISH-" DROP STRING-END ;
+\: " STRING-START \: KLOOP KEY 34 =? JNZ: FINISH-" STRING-PUT JMP: KLOOP
+\:> " " swap lit lit , , lit lit , , ;
+\: IF JZ: \here \8 \+ \, ; word 2drop ;
+\:> IF \: DOIF LIT JZ: , HERE DUP , ;
+\: ELSE ;
+\:> ELSE \: DOELSE LIT JMP: , HERE DUP , SWAP HERE ! ;
+\: THEN ;
+\:> THEN \: DOTHEN HERE ! ;
+\: COMPILE-MODE dup
+\doif 2dup find dup
+  \doif dup find-does dup
+    \doif swap drop rot 2drop execute ;
+    \dothen drop , 2drop ;
+  \dothen drop lit lit , execute-num , ;
+\dothen 2drop ;
+\: c LIT MODE LIT COMPILE-MODE ! ;
+\: DO" 
 \e
+
 " watForth-32 Interactive CLI:
 " .s
diff --git a/forth.js b/forth.js
index eb25ced..57aac39 100644
--- a/forth.js
+++ b/forth.js
@@ -118,53 +118,9 @@ window.onload = () => {
       ))
   }]
   const dictionary = {
-    ';': 1,
-    'LIT': 2,
-    RINIT: 3,
-    WORD: 16500,
-    KEY: 5,
-    DUP: 6,
-    '+': 7,
-    'NOOP2': 8,
-    '.': 9,
-    '@': 10,
-    '!': 11,
-    EXECUTE: 12,
-    NOOP: 13,
-    'JZ:': 14,
-    'JNZ:': 15,
-    DROP: 16,
-    'WS?': 17,
-    'JMP:': 18,
-    'WPUTC': 19,
-    'WB0': 20,
-    'FIND': 21,
-    'NUMBER': 22,
-    'W!LEN': 23,
-    'J-1:': 24,
-    'BYE': 25,
-    'SWAP': 26,
-    'WORDS': 27,
-    'HERE': 28,
-    'DEFINE': 29,
-    '2DUP': 30,
-    'ROT': 31,
-    '2DROP': 32,
-    ',': 33,
-    '-': 34,
-    'CHANNEL!': 35,
-    'HERE!': 36,
-    '=?': 37,
-    '.S': 38,
-    'STRING-START': 39,
-    'STRING-PUT': 40,
-    'STRING-END': 41,
-    ':': 16800,
-    'MODE': 14336,
-    'EXECUTE-MODE': 16680,
-    'QUIT': 16384,
-    'INTERPRET': 16400
+    EXECUTE: 12
   }
+  const doesDictionary = {}
   const wasmImport = {
     env: {
       pop: () => simstack.pop(),
@@ -213,6 +169,8 @@ window.onload = () => {
         dictionary[word.toUpperCase()] = num
         return 0
       },
+      does_get: (u) => doesDictionary[u] || 0,
+      does_set: (u, v) => doesDictionary[u] = v,
       is_whitespace: (key) => /\s/.test(String.fromCharCode(key)),
       sys_stack: () => console.log(`[${simstack}]`),
       sys_parsenum: (addr, u, base) => {
diff --git a/forth.wat b/forth.wat
index 0c4b767..61cbb22 100644
--- a/forth.wat
+++ b/forth.wat
@@ -15,8 +15,10 @@
   (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 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))
@@ -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))
@@ -46,7 +50,7 @@
   (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,9 +128,17 @@
   (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) "\11\00\00\00") ;; WS?
@@ -202,7 +214,8 @@
       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 $strstart block $strput block $strend
+      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
@@ -210,7 +223,42 @@
 	(;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
-        (;40;)$strput $strend $default
+        (;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
@@ -395,7 +443,6 @@
         get_local $eax
         call $rpop
         call $vocab_set
-        drop
         br $next
       end ;; here
         get_local $here
@@ -691,7 +738,7 @@
         br $next
       end ;; op0
         get_local $esi
-        call $sys_reflect
+        call $rpush
         br $bye
       end ;; default
         get_local $esi
@@ -700,7 +747,7 @@
         set_local $esi
         br $next
     end ;; execloop
-    end ;; nextl
+    end ;; next loop
     end ;; bye
     i32.const 14340
     get_local $here
@@ -721,5 +768,6 @@
     get_local $channel
     i32.store
     i32.const 0
+    return
   )
 )