From 7946a78988064b7ec67e8d27763a962cebb29515 Mon Sep 17 00:00:00 2001 From: ken Date: Tue, 13 Mar 2018 20:50:10 -0700 Subject: [PATCH] working: real time system (event-driven), coroutines, asynch sockets --- forth.forth | 3 + forth.js | 174 +++++------ forth.wat | 669 ++++++++++++++++++++++++++++++---------- forth/test-watfor.forth | 16 + 4 files changed, 599 insertions(+), 263 deletions(-) create mode 100644 forth/test-watfor.forth diff --git a/forth.forth b/forth.forth index cb6090f..dce37c5 100644 --- 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 --- 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 --- 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 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 . + +: test-compilation " test-compilation _ok." .s ; + +test-compilation -- 2.18.0