control keys, dobackslash

diff --git a/forth.forth b/forth.forth
index 0ffbc9c..db765e0 100644 (file)
--- a/forth.forth
+++ b/forth.forth
@@ -1,12 +1,12 @@
-5 . 
 word ' here define
 word word find , word find find , word ; find ,
 word : here define
 ' word , ' here , ' define , ' ; ,
 : IWRITE-MODE ' dup , ' JNZ: , here 12 + , ' 2drop , ' ; ,
-' find , ' dup , ' JZ: , here 12 + , ' , , ' ; ,
-: i ' LIT , ' MODE , ' LIT , ' IWRITE-MODE , ' ! , ' ; ,
-: e ' LIT , ' MODE , ' LIT , ' EXECUTE-MODE , ' ! , ' ; ,
-: TEST \i DUP + DUP + . ; \e
-5 TEST
-2 . 
\ No newline at end of file
+' 2dup , ' find , ' dup , ' JZ: , here 16 + , ' , , ' 2drop , ' ; ,
+' drop , ' LIT , ' LIT , ' , , 16720 , ' , , ' ; ,
+: ^i ' LIT , ' MODE , ' LIT , ' IWRITE-MODE , ' ! , ' ; ,
+: ^e ' LIT , ' MODE , ' LIT , ' EXECUTE-MODE , ' ! , ' ; ,
+: test \^i 20 20 + ; \^e
+test .
+5 . 

diff --git a/forth.js b/forth.js
index ffe8044..a392095 100644 (file)
--- a/forth.js
+++ b/forth.js
@@ -50,7 +50,7 @@ const channels = [{
   write: (readAddr, maxBytes) =>
     output.print(String.fromCharCode.apply(
       null,
-      new Uint16Array(wasmMem.buffer, readAddr, maxBytes)
+      new Uint16Array(wasmMem.buffer, readAddr, maxBytes >> 1)
     ))
 }]
 const simstack = []
@@ -93,6 +93,7 @@ const dictionary = {
   'CHANNEL!': 35,
   'HERE!': 36,
   '=?': 37,
+  '.s': 38,
   ':': 16800,
   'MODE': 14336,
   'EXECUTE-MODE': 16680,
@@ -106,16 +107,11 @@ const wasmImport = {
     rinit: () => rstack.length = 0,
     rpop: () => rstack.pop(),
     rpush: (val) => rstack.push(val),
-    sys_write: (channel, fromBuffer) => {
+    sys_write: (channel, addr, u) => {
       if (channels[channel] === undefined)
        return
-      const maxBytes = new DataView(
-       wasmMem.buffer,
-       fromBuffer,
-       4
-      ).getUint32(0,true)
-      console.log(`write ch:${channel} addr:${fromBuffer} len:${maxBytes}`)
-      channels[channel].write(fromBuffer + 4, maxBytes)
+      console.log(`write ch:${channel} addr:${addr} len:${u}`)
+      channels[channel].write(addr, u)
     },
     sys_read: (channel, toBuffer) => {
       console.log(`read ch:${channel} buf:${toBuffer} current: ${stdin}`)

diff --git a/forth.wat b/forth.wat
index a2498a3..989b85d 100644 (file)
--- a/forth.wat
+++ b/forth.wat
@@ -13,7 +13,7 @@
   (import "env" "sys_read" (func $sys_read (param 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) (result i32)))
+  (import "env" "sys_write" (func $sys_write (param i32 i32 i32) (result i32)))
   (import "env" "sys_echo" (func $sys_echo (param i32)))
   (import "env" "sys_echochar" (func $sys_echochar (param i32)))  
   (import "env" "sys_reflect" (func $sys_reflect (param i32)))
@@ -75,8 +75,8 @@
   (data (i32.const 16544) "\0e\00\00\00") ;; JZ:
   (data (i32.const 16548) "\e4\40\00\00") ;; addr of DOCHAR
   (data (i32.const 16552) "\10\00\00\00") ;; DROP
-  (data (i32.const 16556) "\c8\40\00\00") ;; WORDLOOP (continue using this wbuf we started)
-  (data (i32.const 16560) "\28\41\00\00") ;; EXECUTE-MODE
+  (data (i32.const 16556) "\94\41\00\00") ;; DO-BACKSLASH (continue using this wbuf we started)
+  (data (i32.const 16560) "\0d\00\00\00") ;; NOOP
   (data (i32.const 16564) "\12\00\00\00") ;; JMP:
   (data (i32.const 16568) "\74\40\00\00") ;; addr of KEYLOOP-1 (get a new wbuf, call to wbuf+1 ate ours)
   (data (i32.const 16572) "\10\00\00\00") ;; DROP <-- KEYDROP
@@ -115,11 +115,27 @@
   (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
-  (; : definition ;)
-  (data (i32.const 16800) "\74\40\00\00") ;; WORD
-  (data (i32.const 16804) "\1c\00\00\00") ;; HERE
-  (data (i32.const 16808) "\1d\00\00\00") ;; VOCAB_SET
-  (data (i32.const 16812) "\01\00\00\00") ;; RET
+  (; 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 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 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
+  
   (export "memory" (memory $0))
   (export "main" (func $main))
   (func $main (result i32)
@@ -178,13 +194,22 @@
       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
         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 $default
+        (;34;)$subtract $keychan (;36;)$sethere $eqbool (;38;)$echostring $default
+      end ;; echostring
+        get_local $channel
+        call $pop
+        set_local $eax
+        call $pop
+        get_local $eax
+        call $sys_write
+        br $next
       end ;; eqbool
         block $equiv
           call $pop