working: real time system (event-driven), coroutines, asynch sockets

diff --git a/forth.forth b/forth.forth
index cb6090f..dce37c5 100644 (file)
--- a/forth.forth
+++ b/forth.forth
@@ -36,6 +36,8 @@ word BYE 25 define
 word WORDS 27 define
 word CHANNEL-IN 35 define
 word CHANNEL-OUT 48 define
+word CHANNEL-OPEN 51 define
+word CHANNEL-AWAIT 50 define
 word !HERE 36 define
 word HERE 28 define
 
@@ -139,6 +141,7 @@ here define-does then compiling ;
 
 \ Set the number conversion base
 : BASE 14348 swap ! ;
+: BASE10 10 base ;
 
 (
   End of bootstrap process

diff --git a/forth.js b/forth.js
index 3dbfc2b..0844bd0 100644 (file)
--- a/forth.js
+++ b/forth.js
@@ -17,44 +17,19 @@ const output = {
   print: (string) => {},
   updateViews: () => {}
 }
-const channels = []
-let wasmMem, forth
-
-/* Init */
-Promise.all([
-  fetch('forth.forth', {credentials: 'include', headers:{'content-type':'text/plain'}}).then((re) => re.text()),
-  fetch('forth.wasm', {credentials: 'include', headers:{'content-type':'application/wasm'}}).then(re => re.arrayBuffer())
-]).then((results) => {
-  WebAssembly.instantiate(results[1], wasmImport).then((module) => {
-    wasmMem = module.instance.exports.memory.buffer
-    forth = (chno, data) => {
-      if (typeof chno !== "number") {
-        data = chno
-        chno = 0
-      }
-      channels[chno].writeEnv(data)
-      if (chno === 0)
-        output.print(data)
-      module.instance.exports.main(chno)
-      output.updateViews()
-    }
-    console.log('wasm loaded')
-    forth(results[0])
-  })
-})
+let wasmMem, wasmMain
 
 /* Environment functions */
-const wasmString = (addr, u) =>
-  String.fromCharCode.apply(
-    null,
-    new Uint16Array(wasmMem, addr, u >> 1)
-  )
+const bufString = (arrayBuf, addr, u) =>
+      String.fromCharCode.apply(null, new Uint16Array(arrayBuf, addr, u >> 1))
+const wasmString = (addr, u) => bufString(wasmMem, addr, u)
+const wasmBase = () => new DataView(wasmMem, 14348, 4).getUint32(0,true)
 const strToArrayBuffer = (str) => {
-  const buf = new ArrayBuffer(str.length << 1);
-  const bufView = new Uint16Array(buf);
+  const buf = new ArrayBuffer(str.length << 1)
+  const bufView = new Uint16Array(buf)
   for (let i = 0, strLen = str.length; i < strLen; i++)
-    bufView[i] = str.charCodeAt(i);
-  return buf;
+    bufView[i] = str.charCodeAt(i)
+  return buf
 }
 const bufJoin = (buf1, buf2) => {
   const newBuf = new Uint8Array(buf1.byteLength + buf2.byteLength)
@@ -64,8 +39,16 @@ const bufJoin = (buf1, buf2) => {
 }
 
 /* I/O Channel Drivers */
+const channels = []
+const getChannel = (chno) => {
+  const channel = channels[chno]
+  if (!channel)
+    throw new Error(`invalid channel access ${chno}`)
+  return channel
+}
 class Channel {
   constructor(opt) {
+    opt = opt || Object.create(null)
     opt.chno = channels.indexOf(undefined)
     if (opt.chno === -1)
       opt.chno = channels.length
@@ -75,57 +58,21 @@ class Channel {
     channels[this.chno] = this
     return this
   }
-  read(writeAddr, maxBytes) {
-    const wasmView = new Uint8Array(wasmMem, writeAddr, maxBytes)
-    const bufBytes = Math.min(maxBytes, this.buffer.byteLength)
-    const bufView = new Uint8Array(this.buffer, 0, bufBytes)
-    wasmView.set(bufView, 0)
+  read(writeArray, writeAddr, writeMax) {
+    const bufBytes = Math.min(writeMax, this.buffer.byteLength)
+    new Uint8Array(writeArray).set(new Uint8Array(this.buffer, 0, bufBytes), writeAddr)
     this.buffer = this.buffer.slice(bufBytes)
     return bufBytes
   }
-  write(readAddr, maxBytes) {
-      const newBuf = new Uint8Array(this.buffer.byteLength + maxBytes)
-      newBuf.set(new Uint8Array(this.buffer), 0)
-      newBuf.set(new Uint8Array(wasmMem, readAddr, maxBytes), this.buffer.byteLength)
-      this.buffer = newBuf
+  write(readArray, readAddr, readSize) {
+    this.buffer = bufJoin(this.buffer, new Uint8Array(readArray, readAddr, readSize))
+    wasmMain(this.chno)
+    output.updateViews()
   }
-  writeEnv(data) {
-    switch (typeof data) {
-    case "string":
-      this.buffer = bufJoin(this.buffer, strToArrayBuffer(data))
-      break
-    case "object" :
-      if (data instanceof ArrayBuffer)
-        this.buffer = bufJoin(this.buffer, data)
-      else
-        this.buffer = bufJoin(this.buffer, strToArrayBuffer(JSON.stringify(data)))
-      break
-    case "number" :
-      const buf = new ArrayBuffer(4)
-      new DataView(buf, 0, 4).setInt32(data)
-      this.buffer = bufJoin(this.buffer, buf)
-      break
-    default :
-      console.error(`environment wrote unhandled object: ${data}`)
-      return
-    }
+  send(readArray, readAddr, readSize) {
+    this.write(readArray, readAddr, readSize)
   }
 }
-/* 0 STDIN, 1 STDOUT, 2 STDERR */
-new Channel({
-  write(readAddr, maxBytes) {
-    super.write(readAddr, maxBytes)
-    output.print(wasmString(readAddr, maxBytes))
-  }
-})
-new Channel({
-  read(writeAddr, maxBytes) { return 0 },
-  write(readAddr, maxBytes) { output.print(`\\\ => ${wasmString(readAddr, maxBytes)}\n`) }
-})
-new Channel({
-  read(writeAddr, maxBytes) { return 0 },
-  write(readAddr, maxBytes) { console.error(wasmString(readAddr, maxBytes)) }
-})
 
 /* System runtime */
 const simstack = []
@@ -137,11 +84,12 @@ const wasmImport = {
     pop: () => simstack.pop(),
     push: (val) => simstack.push(val),
     rinit: () => rstack.length = 0,
-    rpop: () => rstack.length ? rstack.pop() : 16388,
+    rpop: () => rstack.pop(),
     rpush: (val) => rstack.push(val),
-    sys_write: (chno, addr, u) => channels[chno] === undefined ? 0 : channels[chno].write(addr, u),
-    sys_read: (chno, addr, u) => channels[chno] === undefined ? 0 : channels[chno].read(addr, u),
-    sys_listen: (chno, cbAddr, addr, u) => { //sys_connect?
+    sys_write: (chno, addr, u) => getChannel(chno).write(wasmMem, addr, u),
+    sys_read: (chno, addr, u) => getChannel(chno).read(wasmMem, addr, u),
+    sys_send: (chno, addr, u) => getChannel(chno).send(wasmMem, addr, u),
+    sys_connect: (addr, u) => {
       //TODO: call into the module to wasm fn "event" to push an event
       //to forth, which pushes esi to the return stack and queues the
       //callback function provided from listen. reqaddr could be
@@ -153,33 +101,35 @@ const wasmImport = {
       //other listen types: mouse, keyboard, touch, main_loop (10ms interval), wrtc, etc
       //fetch is different because it offers no "write" interface, doesn't repeat
     },
-    sys_fetch: (cbAddr, addr, u) => {
+    sys_fetch: (chno, addr, u) => {
       const str = wasmString(addr, u)
-      console.log(`fetching: ${str}`)
+      console.log(`fetching: ${str} || ${addr} ${u}`)
       const args = JSON.parse(wasmString(addr, u))
       console.log(args)
       const url = args.url
       delete args.url
-      const channel = new Channel()
+      const channel = channels[chno]
+      if (!channel) {
+        console.error(`invalid channel fetch: ${chno}`)
+        return -1
+      }
       fetch(url, args).then((re) => {
         if (args.headers === undefined ||
             args.headers['content-type'] === undefined ||
             args.headers['content-type'].toLowerCase().indexOf('text/plain') === 0 )
-          re.text().then((txt) => forth(channel.chno, txt))
+          re.text().then((txt) => channel.write(strToArrayBuffer(txt), 0, txt.length << 1))
         else {
           const reader = new FileReader()
-          reader.onload = (evt) => forth(channel.chno, evt.target.result)
+          reader.onload = (evt) => channel.write(evt.target.result, 0, evt.target.result.byteLength)
           re.blob().then((blob) => reader.readAsArrayBuffer(blob))
         }
       }).catch(console.error)
-      //TODO: map to fetch promise, write to channel buffer,
-      //javascript "fetch" as fallback, explicit handles for
-      //"textEntry" or any third party protocols like activitypub
-      return channel.chno
+      return 0
     },
-    sys_close: (chno) => delete channels[chno],
-    sys_echo: (val, base) => output.print(`\\\ => ${val.toString(base)} `),
-    sys_echochar: (val) => output.print(String.fromCharCode(val)),
+    sys_open: () => new Channel().chno,
+    sys_close: (chno) => chno < 3 ? 0 : delete channels[chno],
+    sys_echo: (val) => output.print(`\\\ => ${val.toString(wasmBase())}\n`),
+    sys_log: (addr, u) => console.log(`=> ${wasmString(addr, u)}`),
     sys_reflect: (addr) => {
       console.log(`reflect: ${addr}: ${
         new DataView(wasmMem, addr, 4)
@@ -192,8 +142,8 @@ const wasmImport = {
     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_parsenum: (addr, u, base) => {
-      const answer = Number.parseInt(wasmString(addr, u), base)
+    sys_parsenum: (addr, u) => {
+      const answer = Number.parseInt(wasmString(addr, u), wasmBase())
       if (Number.isNaN(answer))
         return -1
       new DataView(wasmMem, addr, 4).setUint32(0,answer,true)
@@ -205,6 +155,32 @@ const wasmImport = {
   }
 }
 
+/* Initialization */
+/* 0 STDIN, 1 STDOUT, 2 STDERR */
+new Channel({
+  send(readArray, readAddr, readSize) { output.print(bufString(readArray, readAddr, readSize)) }
+})
+new Channel({
+  write(readArray, readAddr, readSize) { output.print(bufString(readArray, readAddr, readSize)) },
+  send(readArray, readAddr, readSize) { output.print(`\n\\\ => ${bufString(readArray, readAddr, readSize)}\n`) }
+})
+new Channel({
+  write(readArray, readAddr, readSize) { console.error(bufString(readArray, readAddr, readSize)) }
+})
+
+/* Fetch wasm file, and initial forth file */
+Promise.all([
+  fetch('forth.forth', {credentials: 'include', headers:{'content-type':'text/plain'}}).then((re) => re.text()),
+  fetch('forth.wasm', {credentials: 'include', headers:{'content-type':'application/wasm'}}).then(re => re.arrayBuffer())
+]).then((results) => {
+  WebAssembly.instantiate(results[1], wasmImport).then((module) => {
+    wasmMem = module.instance.exports.memory.buffer
+    wasmMain = module.instance.exports.main
+    console.log('wasm loaded')
+    getChannel(0).write(strToArrayBuffer(results[0]))
+  })
+})
+
 /* View Logic */
 window.onload = () => {
   let forthdiv = document.getElementById("forth")
@@ -250,7 +226,7 @@ window.onload = () => {
           txtinput.value += " "
         event.preventDefault()
         event.stopPropagation()
-        forth(txtinput.value)
+        getChannel(0).write(strToArrayBuffer(txtinput.value))
         txtinput.value = ""
       }
       break
@@ -265,7 +241,7 @@ window.onload = () => {
   /* Set up output functions */
   output.print = (string) => txtoutput.textContent += string,
   output.updateViews = () => {
-    const base = new DataView(wasmMem, 14348 /* base */, 4).getUint32(0,true)
+    const base = wasmBase()
     stackview.textContent = simstack.map((v) => v.toString(base)).join('\n')
     // rstackview.textContent = rstack.join('\n')
     let cnt = 0;

diff --git a/forth.wat b/forth.wat
index 0a16efc..778681a 100644 (file)
--- a/forth.wat
+++ b/forth.wat
@@ -25,29 +25,30 @@
   (import "env" "rpop" (func $rpop (result i32)))
   (import "env" "rpush" (func $rpush (param i32)))
   (import "env" "sys_read" (func $sys_read (param i32 i32 i32) (result i32)))
+  (import "env" "sys_write" (func $sys_write (param i32 i32 i32)))
+  (import "env" "sys_send" (func $sys_send (param i32 i32 i32)))
+  (import "env" "sys_open" (func $sys_open (result i32)))
+  (import "env" "sys_close" (func $sys_close (param i32)))
   (import "env" "sys_fetch" (func $sys_fetch (param i32 i32 i32) (result i32)))
-  (import "env" "sys_listen" (func $sys_listen (param i32 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 i32)))
-  (import "env" "sys_echochar" (func $sys_echochar (param i32)))  
+  (import "env" "sys_connect" (func $sys_connect (param i32 i32) (result i32)))  
+  (import "env" "sys_echo" (func $sys_echo (param i32)))
+  (import "env" "sys_log" (func $sys_log (param i32 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)))
   (import "env" "does_get" (func $does_get (param i32 i32) (result i32)))
   (import "env" "does_set" (func $does_set (param i32 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_parsenum" (func $sys_parsenum (param i32 i32) (result i32)))
   (import "env" "sys_stack" (func $sys_stack))
   (import "env" "sys_words" (func $sys_words))
   (table (;0;) 0 anyfunc)
   (memory $0 1)
-  (; String Belt                       ;) ;; 0x0000 Size: 8192
-  (global $wordbelt i32 (i32.const 8192)) ;; 0x2000 Size: 4096
-  (global $inbuf i32 (i32.const 12288))   ;; 0x3000 Size: 2048
-  (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) "\f8\07\00\00") ;; 2040 len
+  (; String Belt                                 ;) ;; 0x0000 Size: 8192
+  (global $wordbelt_base i32     (i32.const 8192) ) ;; 0x2000 Size: 4096
+  (global $wordbelt_bound i32    (i32.const 12288)) ;; 0x3000
+  (global $stdin_base i32        (i32.const 12288)) ;; 0x3000 Size: 2048
+  (global $kvars i32             (i32.const 14336)) ;; 0x3800 Size: 2048
   (global $mode_p i32            (i32.const 14336))
   (global $here_p i32            (i32.const 14340))
   (global $start_p i32           (i32.const 14344))
@@ -56,42 +57,39 @@
   (global $stringbelt_head_p i32 (i32.const 14356))
   (global $wordbelt_tail_p i32   (i32.const 14360))
   (global $wordbelt_head_p i32   (i32.const 14364))
-  (global $channel_in_p i32      (i32.const 14368))
-  (global $channel_out_p i32     (i32.const 14372))
   (data (i32.const 14336) "\28\41\00\00") ;; MODE
-  (data (i32.const 14340) "\04\42\00\00") ;; HERE
+  (data (i32.const 14340) "\04\5e\00\00") ;; HERE
   (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
   (data (i32.const 14360) "\00\20\00\00") ;; WORDBELT_TAIL
   (data (i32.const 14364) "\00\20\00\00") ;; WORDBELT_HEAD
-  (data (i32.const 14368) "\00\00\00\00") ;; CHANNEL-IN
-  (data (i32.const 14372) "\01\00\00\00") ;; CHANNEL-OUT
-  (; channel listeners  0x3c00 ;)
-  (global $channel_listeners_p i32 (i32.const 15360))
-  (data (i32.const 15360) "\00\40\00\00") ;; CHANNEL LISTENER 0 (quit)
   (; Quit ;)
-  (global $quit_p i32 (i32.const 16384))
-  (data (i32.const 16384) "\01\00\00\00") ;; RINIT xt
+  (global $quit_p i32 (i32.const 16384))  ;; 0x4000
+  (data (i32.const 16384) "\03\00\00\00") ;; RINIT xt
   (global $quit_ret_p i32 (i32.const 16388))
   (data (i32.const 16388) "\10\40\00\00") ;; INTERPRET xt
   (data (i32.const 16392) "\12\00\00\00") ;; JMP xt
   (data (i32.const 16396) "\00\40\00\00") ;; quit location (16384)
   (; Interpret ;)
   (data (i32.const 16400) "\74\40\00\00") ;; WORD xt (16500)
-  (data (i32.const 16404) "\06\00\00\00") ;; DUP
-  (data (i32.const 16408) "\0e\00\00\00") ;; JZ:
-  (data (i32.const 16412) "\38\40\00\00") ;; INTERP-END addr (16444)
-  (data (i32.const 16416) "\02\00\00\00") ;; LIT xt
-  (data (i32.const 16420) "\00\38\00\00") ;; MODE addr (14336)
-  (data (i32.const 16424) "\0a\00\00\00") ;; @ (fetch) xt
-  (data (i32.const 16428) "\0c\00\00\00") ;; EXECUTE xt
-  (data (i32.const 16432) "\0d\00\00\00") ;; NOOP xt
-  (data (i32.const 16436) "\01\00\00\00") ;; RET
-  (data (i32.const 16440) "\10\00\00\00") ;; DROP  <-- INTERP-END
-  (data (i32.const 16444) "\10\00\00\00") ;; DROP
-  (data (i32.const 16448) "\19\00\00\00") ;; BYE
+  (data (i32.const 16404) "\0d\00\00\00") ;; (data (i32.const 16404) "\1e\00\00\00") ;; 2DUP
+  (data (i32.const 16408) "\0d\00\00\00") ;; (data (i32.const 16408) "\04\00\00\00") ;; SYS-LOG
+  (data (i32.const 16412) "\06\00\00\00") ;; DUP
+  (data (i32.const 16416) "\0e\00\00\00") ;; JZ:
+  (data (i32.const 16420) "\40\40\00\00") ;; INTERP-END addr (16444)
+  (data (i32.const 16424) "\02\00\00\00") ;; LIT xt
+  (data (i32.const 16428) "\00\38\00\00") ;; MODE addr (14336)
+  (data (i32.const 16432) "\0a\00\00\00") ;; @ (fetch) xt
+  (data (i32.const 16436) "\0c\00\00\00") ;; EXECUTE xt
+  (data (i32.const 16440) "\0d\00\00\00") ;; NOOP xt
+  (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 ;)
   (data (i32.const 16500) "\14\00\00\00") ;; WORDSTART
   (data (i32.const 16504) "\05\00\00\00") ;; KEY  <-- KEYLOOP
@@ -126,7 +124,9 @@
   (data (i32.const 16620) "\c8\40\00\00") ;; addr of WORDLOOP
   (data (i32.const 16624) "\10\00\00\00") ;; DROP <-- WORDEND
   (data (i32.const 16628) "\17\00\00\00") ;; WORDFINISH
-  (data (i32.const 16632) "\01\00\00\00") ;; RET
+  (data (i32.const 16632) "\01\00\00\00") ;; 2DUP //RET
+  (data (i32.const 16636) "\04\00\00\00") ;; .S
+  (data (i32.const 16640) "\01\00\00\00") ;; RET
   (; Exec Mode ;)
   (data (i32.const 16680) "\1e\00\00\00") ;; 2DUP
   (data (i32.const 16684) "\15\00\00\00") ;; DICT_GET
@@ -174,49 +174,228 @@
   (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
-  
+  (; Channel Table ;)
+  (; 1 FLAGS: AWAITER | RUNNING ]LSB ;)
+  (; 1 reserved ;)
+  (; 1 AWAITER CHANNEL ;)
+  (; 1 OUT CHANNEL ;)
+  (; 8 START | START-DEFAULT ;)
+  (; 16 BUFFER ADDRESSES: BASE, TAIL, HEAD, BOUND ;)
+  (global $channel_table_p i32 (i32.const 16900))
+  (global $channel_entry_size i32 (i32.const 28))
+  (global $channel_max i32 (i32.const 255))
+  (data (i32.const 16900) "\00\00\00\01") ;; STDIN (COUT: 1)
+  (data (i32.const 16904) "\00\40\00\00") ;; STDIN-START (QUIT)
+  (data (i32.const 16908) "\00\40\00\00") ;; STDIN-START-DEFAULT
+  (data (i32.const 16912) "\00\30\00\00") ;; STDIN-BUFFER-BASE
+  (data (i32.const 16916) "\00\30\00\00") ;; STDIN-BUFFER-TAIL
+  (data (i32.const 16920) "\00\30\00\00") ;; STDIN-BUFFER-HEAD
+  (data (i32.const 16924) "\00\38\00\00") ;; STDIN-BUFFER-BOUND
+  (data (i32.const 16928) "\00\00\00\00") ;; STDOUT 
+  (data (i32.const 16932) "\00\00\00\00") ;; STDOUT (TODO: error handler)
+  (data (i32.const 16936) "\00\00\00\00") ;; STDOUT 
+  (data (i32.const 16940) "\00\00\00\00") ;; STDOUT 
+  (data (i32.const 16944) "\00\00\00\00") ;; STDOUT 
+  (data (i32.const 16948) "\00\00\00\00") ;; STDOUT 
+  (data (i32.const 16952) "\00\00\00\00") ;; STDOUT
+  (data (i32.const 16956) "\00\00\00\00") ;; STDERR (null)
+  (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))
-  (export "main" (func $main))
-  (func $main (param $event_channel i32) (result i32)
-    block $use_current_channel
-      (; rstack contains channel barriers (numbers lower than 256)
-         which will reset channel to 0 when returning to the quit loop.
-         if an interrupt event is happening, load its handler and set
-         the input channel. ;)
-      get_local $event_channel
+  (func $lit_rstack (param $here i32) (param $start i32) (result i32)
+    (local $eax i32) (local $ecx i32)
+    i32.const 0
+    set_local $ecx
+    block $backup_loop
+      call $rpop
+      tee_local $eax
+      get_global $holy_bye
+      i32.eq
+      br_if $backup_loop
+      get_local $eax
+      call $push
+      get_local $ecx
+      i32.const 1
+      i32.add
+      set_local $ecx
+    end
+    block $output_done
+    block $output_loop
+      get_local $ecx
       i32.eqz
-      br_if $use_current_channel
-      get_local $event_channel
-      i32.const 255
-      i32.gt_u
-      br_if $use_current_channel
-      get_global $channel_in_p
-      get_local $event_channel
+      br_if $output_done
+      get_local $ecx
+      i32.const -1
+      i32.add
+      set_local $ecx
+      get_local $here
+      i32.const 2 ;; lit
       i32.store
+      get_local $here
+      i32.const 4
+      i32.add
+      tee_local $here
+      call $pop
+      i32.store
+      get_local $here
+      i32.const 4
+      i32.add
+      tee_local $here
+      i32.const 52  ;; rpush_op
+      i32.store
+      get_local $here
+      i32.const 4
+      i32.add
+      set_local $here
+      br $output_loop
     end
-    get_global $channel_listeners_p
-    get_local $event_channel
-    i32.const 2
-    i32.shl
+    end
+    get_local $here
+    i32.const 18 ;; jmp
+    i32.store
+    get_local $here
+    i32.const 4
+    i32.add
+    tee_local $here
+    get_local $start
+    i32.store
+    get_local $here
+    i32.const 4
+    i32.add
+    return
+  )
+  (func $close_channel (param $channel_p i32)
+    block $no_close
+      get_local $channel_p
+      i32.const 3
+      i32.le_u
+      br_if $no_close
+      get_local $channel_p
+      call $sys_close
+    end
+    get_global $channel_table_p
+    get_global $channel_entry_size
+    get_local $channel_p
+    i32.mul
+    i32.add
+    tee_local $channel_p
+    i32.const 4
+    i32.add
+    get_local $channel_p
+    i32.const 8
     i32.add
     i32.load
+    i32.store ;; restore awaiter's "start" to original
+    get_local $channel_p
+    i32.const 0
+    i32.store8 ;; clear target thread's flags
+  )
+  (func $forth_min (param $i1 i32) (param $i2 i32) (result i32)
+    block $is_greater
+      get_local $i1
+      get_local $i2
+      i32.lt_u
+      br_if $is_greater
+      get_local $i2
+      return
+    end
+    get_local $i1
+    return
+  )
+  (export "main" (func $main))
+  (func $main (param $event_channel i32) (result i32)
+    get_local $event_channel
+    call $rinit
+    get_global $holy_bye
+    call $rpush
     call $interpret
+    return
   )
-  (func $interpret (param $esi i32) (result i32)
+  (func $interpret (param $channel_in i32) (result i32)
     (local $here i32)
     (local $eax i32)
+    (local $esi i32)
+    (local $inbuf_base i32)
+    (local $inbuf_tail i32)
     (local $inbuf_head i32)
+    (local $inbuf_bound i32)
     (local $stringbelt_tail i32)
     (local $stringbelt_head i32)
     (local $wordbelt_tail i32)
     (local $wordbelt_head i32)
-    (local $channel_in 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
+    get_global $channel_max
+    get_local $channel_in
+    call $forth_min
+    i32.mul
+    i32.add
+    set_local $eax
+    block $check_run
+      get_local $eax
+      i32.load8_u
+      i32.const 1
+      i32.and
+      i32.eqz ;; (FLAGS & 1) => running, return 0
+      br_if $check_run
+      i32.const 0
+      return
+    end
+    get_local $eax
+    get_local $eax
+    i32.load8_u
+    i32.const 1
+    i32.or
+    i32.store8         ;; set running flag
+    get_local $eax
+    i32.const 3
+    i32.add
+    i32.load8_u
+    set_local $channel_out
+
+    get_local $eax    
+    i32.const 4
+    i32.add
+    i32.load
+    set_local $esi
+    get_local $eax
+    i32.const 12
+    i32.add
+    i32.load
+    set_local $inbuf_base
+    get_local $eax
+    i32.const 16
+    i32.add
+    i32.load
+    set_local $inbuf_tail
+    get_local $eax
+    i32.const 20
+    i32.add
+    i32.load
+    set_local $inbuf_head
+    get_local $eax
+    i32.const 24
+    i32.add
+    i32.load
+    set_local $inbuf_bound
+    (; /channel in setup ;)
     get_global $here_p
     i32.load
     set_local $here
-    get_global $inbuf_data
-    set_local $inbuf_head
     get_global $stringbelt_tail_p
     i32.load
     set_local $stringbelt_tail
@@ -229,15 +408,8 @@
     get_global $wordbelt_head_p
     i32.load
     set_local $wordbelt_head
-    get_global $channel_in_p
-    i32.load
-    set_local $channel_in
-    get_global $channel_out_p
-    i32.load
-    set_local $channel_out
-    get_global $quit_p
-    set_local $esi
     block $bye
+    block $awaiting
     loop $next
       get_local $esi
       get_local $esi
@@ -246,9 +418,10 @@
       set_local $esi
       i32.load
       set_local $eax
+
       loop $execloop
       block $default block $op0 block $ret block $lit block $rinit
-      block $word block $key block $dup block $plus block $noop2 block $emit
+      block $logword block $key block $dup block $plus block $noop2 block $emit
       block $fetch block $set block $execute block $noop block $jz block $jnz
       block $drop block $wsbool block $jmp block $wordputc block $wordstart
       block $dictget block $parsenum block $wordfinish block $jneg1 block $swap
@@ -256,16 +429,85 @@
       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 $outchan block $read block $openchannel block $rpush_op
         get_local $eax
-        br_table $op0 $ret (;2;)$lit $rinit (;4;)$word $key (;6;)$dup $plus
+        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
         (;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 $inchan (;36;)$sethere $eqbool (;38;)$echostring $strstart
         (;40;)$strput $strend (;42;)$fetchinc $setinc (;44;)$finddoes $definedoes
-        (;46;)$stacktrace $webfetch (;48;)$outchan $read (;50;)$default
+        (;46;)$stacktrace $webfetch (;48;)$outchan $read (;50;)$awaiting $openchannel
+        (;52;)$rpush_op $default
+      end ;; rpush_op
+        call $pop
+        call $rpush
+        br $next
+      end ;; openchannel
+        (; Get addr of channel block ;)
+        get_global $channel_table_p
+        get_global $channel_entry_size
+        call $sys_open
+        tee_local $eax
+        call $rpush    ;;save to rstack
+        get_local $eax
+        i32.mul
+        i32.add
+        (; Set Out-Channel to 1 by default ;)
+        tee_local $eax
+        i32.const 3 
+        i32.add ;; out channel
+        i32.const 1
+        i32.store8
+        (; leave a copy of channel_p on stack ;)
+        get_local $eax
+        (; Get addr of ch-start and ch-default-start ;)
+        get_local $eax
+        i32.const 4
+        i32.add ;; addr of channel start
+        tee_local $eax
+        get_local $eax
+        i32.const 4
+        i32.add ;; addr of channel default start
+        (; Store the user-provided address in both ;)
+        call $pop
+        tee_local $eax
+        i32.store
+        get_local $eax
+        i32.store
+        (; go bo buf-base (channel_p + 12), put HERE in it ;)
+        tee_local $eax
+        i32.const 12
+        i32.add
+        get_local $here
+        i32.store
+        (; set buf-tail ;)
+        get_local $eax
+        i32.const 16
+        i32.add
+        get_local $here
+        i32.store
+        (; set buf-head ;)
+        get_local $eax
+        i32.const 20
+        i32.add
+        get_local $here
+        i32.store
+        (; set buf-bound ;)
+        get_local $eax
+        i32.const 24
+        i32.add
+        (; set buf-bound = here += 512 ;)
+        get_local $here
+        i32.const 512
+        i32.add
+        tee_local $here
+        i32.store
+        (; return channel number ;)
+        call $rpop
+        call $push
+        br $next
       end ;; read
         get_local $channel_in
         call $pop ;; location to write
@@ -279,19 +521,24 @@
         set_local $channel_out
         br $next
       end ;; webfetch
-        call $pop
+        call $pop ;; u
         call $rpush
-        call $pop
+        call $pop ;; addr
         set_local $eax
-        call $pop
+        call $pop ;; callback
         get_local $eax
         call $rpop
         call $sys_fetch
+        i32.const -1
+        i32.eq
+        br_if $bye
         br $next
       end ;; stacktrace
-        call $sys_stack
         get_local $esi
-        call $sys_reflect
+        call $rpush
+        call $sys_stack
+        call $rpop
+        drop
         br $next
       end ;; definedoes
         call $pop
@@ -360,7 +607,7 @@
       end ;; strput
         block $sbhasspace2
           get_local $stringbelt_head
-          get_global $wordbelt
+          get_global $wordbelt_base
           i32.lt_u
           br_if $sbhasspace2
           i32.const 0
@@ -389,7 +636,7 @@
             i32.const 2
             i32.add
             tee_local $stringbelt_tail
-            get_global $wordbelt
+            get_global $wordbelt_base
             i32.le_u
             br_if $copystringtostart
           end
@@ -407,7 +654,7 @@
       end ;; strstart
         block $sbhasspace
           get_local $stringbelt_head
-          get_global $wordbelt
+          get_global $wordbelt_base
           i32.const 8
           i32.sub
           i32.le_u
@@ -430,7 +677,7 @@
         set_local $eax
         call $pop
         get_local $eax
-        call $sys_write
+        call $sys_send
         br $next
       end ;; eqbool
         block $equiv
@@ -550,14 +797,10 @@
         set_local $esi
         br $next
       end ;; wordfinish
-        get_local $wordbelt_tail
        get_local $wordbelt_head
         get_local $wordbelt_tail
-       i32.const 4
-       i32.add
         i32.sub
-        tee_local $eax (; n bytes ;)
-        i32.store
+        set_local $eax (; n bytes ;)
         (; align to 32-bit ;)
         get_local $wordbelt_head
         i32.const 3
@@ -567,8 +810,6 @@
         set_local $wordbelt_head
         (; /align ;)
         get_local $wordbelt_tail
-        i32.const 4
-        i32.add
         call $push
         get_local $eax
         call $push
@@ -579,8 +820,6 @@
         call $pop
         tee_local $eax
         call $rpop
-        get_global $base_p
-        i32.load
         call $sys_parsenum
         get_local $eax
         i32.load
@@ -598,42 +837,25 @@
       end ;; wordstart
         block $wbhasspace
           get_local $wordbelt_head
-          get_global $inbuf
-          i32.const 8
+          get_global $wordbelt_bound
+          i32.const 4
           i32.sub
           i32.le_u
           br_if $wbhasspace
-          get_global $wordbelt
+          get_global $wordbelt_base
           set_local $wordbelt_head
         end
         get_local $wordbelt_head
-        get_local $wordbelt_head
-        tee_local $wordbelt_tail
-        i32.const 0
-        i32.store
-        i32.const 4
-        i32.add
-        set_local $wordbelt_head
+        set_local $wordbelt_tail
         br $next
       end ;; wordputc
         block $wbhasspace2
           get_local $wordbelt_head
-          get_global $inbuf
+          get_global $wordbelt_bound
           i32.lt_u
           br_if $wbhasspace2
-          get_global $wordbelt
-          tee_local $wordbelt_head
-          get_local $wordbelt_tail
-          i32.load
-          i32.store
-          get_local $wordbelt_head
-          i32.const 4
-          i32.add
+          get_global $wordbelt_base
           set_local $wordbelt_head
-          get_local $wordbelt_tail
-          i32.const 4
-          i32.add
-          set_local $wordbelt_tail
           loop $copywordtostart
             get_local $wordbelt_head
             get_local $wordbelt_tail
@@ -647,11 +869,11 @@
             i32.const 2
             i32.add
             tee_local $wordbelt_tail
-            get_global $inbuf
-            i32.le_u
+            get_global $wordbelt_bound
+            i32.lt_u
             br_if $copywordtostart
           end
-          get_global $wordbelt
+          get_global $wordbelt_base
           set_local $wordbelt_tail
         end
        get_local $wordbelt_head
@@ -736,8 +958,6 @@
         br $next
       end ;; emit (.)
         call $pop
-        get_global $base_p
-        i32.load
         call $sys_echo
         br $next
       end ;; noop2
@@ -758,13 +978,32 @@
       end ;; key
         loop $key_loop
           block $key_read
-            get_global $inbuf_size
-            i32.load
             get_local $inbuf_head
-            get_global $inbuf_data
-            i32.sub
-            i32.le_u
+            get_local $inbuf_tail
+            i32.ge_u
             br_if $key_read
+            block $key_echo
+              get_local $channel_out
+              i32.const -1
+              i32.add
+              br_if $key_echo
+              (; if current channel's default start is QUIT ;)
+              get_global $channel_table_p
+              get_global $channel_entry_size
+              get_local $channel_in
+              i32.mul
+              i32.add
+              i32.const 4
+              i32.add
+              i32.load
+              get_global $quit_p
+              i32.ne
+              br_if $key_echo
+              i32.const 1
+              get_local $inbuf_head
+              i32.const 2
+              call $sys_write
+            end
             get_local $inbuf_head
             i32.load16_u
             call $push
@@ -774,34 +1013,47 @@
             set_local $inbuf_head
             br $next
           end ;; key_read
-          get_global $inbuf_size
-          i32.const 0 (; stdin hardcode ;)
-          get_global $inbuf_data
-          get_global $inbuf
-          i32.load
+          get_local $channel_in
+          get_local $inbuf_base
+          get_local $inbuf_bound
+          get_local $inbuf_base
+          i32.sub
           call $sys_read
-          i32.store
+          tee_local $eax
+          get_local $inbuf_base
+          i32.add
+          set_local $inbuf_tail
+          get_local $inbuf_base
+          set_local $inbuf_head
           block $nullread
-            get_global $inbuf_size
-            i32.load
+            get_local $eax
             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
-          call $push
-          br $next
+          block $pendingword
+            get_local $wordbelt_head
+            get_local $wordbelt_tail
+            i32.sub
+            i32.eqz
+            br_if $pendingword
+            i32.const 32
+            call $push
+            br $next
+          end ;; pendingword
+          br $bye
         end ;; key_loop
-      end ;; word
+      end ;; logword
+        call $pop
+        tee_local $eax
+        call $pop
+        get_local $eax
+        call $sys_log
         br $next
-      end ;; rinit
-        call $rpop
-        
+      end ;; rinit (unused)
         call $rinit
-        i32.const 0
-        set_local $channel_in
+        get_global $holy_bye
+        call $rpush
         br $next
       end ;; lit
         get_local $esi
@@ -813,26 +1065,10 @@
         call $push
         br $next
       end ;; ret
-        block $gotonext
-        (; cannot jump lower than 256 because it is reserved for
-           opcodes, so overload popping that kind of retval with
-           a channel selector, for when an event handler yields and
-           is interrupted by another event handler.  there are also
-           a max of 255 channels, which is the same as the opcode space ;)
-          call $rpop
-          tee_local $eax
-          i32.const 255
-          i32.gt_u
-          br_if $gotonext
-          get_local $eax
-          set_local $channel_in
-          call $rpop
-          set_local $eax
-        end ;; gotonext
-        get_local $eax
+        call $rpop
        set_local $esi
         br $next
-      end ;; op0
+      end ;; op0 (yield?)
         get_local $esi
         call $rpush
         br $bye
@@ -844,7 +1080,94 @@
         br $next
     end ;; execloop
     end ;; next loop
+    end ;; awaiting
+
+    (; set provided channel's waiter to this channel ;)
+    get_global $channel_table_p
+    get_global $channel_entry_size
+    call $pop
+    i32.mul
+    i32.add
+    tee_local $eax
+    i32.const 2
+    i32.add
+    get_local $channel_in
+    i32.store8
+    (; set awaiter flag ;)
+    get_local $eax
+    get_local $eax
+    i32.load8_u
+    i32.const 2
+    i32.or
+    i32.store8
+
+    (; channel status save ;)
+    get_global $channel_table_p
+    get_global $channel_entry_size
+    get_local $channel_in
+    i32.mul
+    i32.add
+    tee_local $eax
+    (; set buffer base ;)
+    i32.const 12
+    i32.add
+    get_local $inbuf_base
+    i32.store
+    (; set buffer tail ;)
+    get_local $eax
+    i32.const 16
+    i32.add
+    get_local $inbuf_tail
+    i32.store
+    (; set buffer head ;)
+    get_local $eax
+    i32.const 20
+    i32.add
+    get_local $inbuf_head
+    i32.store
+    (; set buffer bound ;)
+    get_local $eax
+    i32.const 24
+    i32.add
+    get_local $inbuf_bound
+    i32.store
+
+    (; set buffer buffer start ;)
+    get_local $eax
+    i32.const 4
+    i32.add
+    get_local $here
+    i32.store
+    (; backup return stack here, returning to esi ;)
+    get_local $here
+    get_local $esi
+    call $lit_rstack
+    set_local $here
+    
+    i32.const -1
+    set_local $inbuf_base ;; temporary bool "await-exit"
+
+    (; /awaiting ;)
     end ;; bye
+
+    get_global $channel_table_p
+    get_global $channel_entry_size
+    get_local $channel_in
+    i32.mul
+    i32.add
+    tee_local $eax
+    i32.const 3
+    i32.add
+    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
@@ -860,12 +1183,30 @@
     get_global $wordbelt_head_p
     get_local $wordbelt_head
     i32.store
-    get_global $channel_in_p
+
+    block $check_awaiter
+      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
+      get_local $channel_in
+      set_local $eax
+      set_local $channel_in
+      br $recurse_loop
+    end
+    end ;; recurse_loop
     get_local $channel_in
-    i32.store
-    get_global $channel_out_p
-    get_local $channel_out
-    i32.store
+    call $close_channel
     i32.const 0
     return
   )

diff --git a/forth/test-watfor.forth b/forth/test-watfor.forth
new file mode 100644 (file)
index 0000000..c84154b
--- /dev/null
+++ b/forth/test-watfor.forth
@@ -0,0 +1,16 @@
+\ This program is free software: you can redistribute it and/or modify
+\ it under the terms of the GNU General Public License as published by
+\ the Free Software Foundation, either version 3 of the License, or
+\ (at your option) any later version.
+\
+\ This program is distributed in the hope that it will be useful,
+\ but WITHOUT ANY WARRANTY; without even the implied warranty of
+\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+\ GNU General Public License for more details.
+\
+\ You should have received a copy of the GNU General Public License
+\ along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+: test-compilation " test-compilation _ok." .s ;
+
+test-compilation