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)
}
/* 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
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 = []
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
//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)
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)
}
}
+/* 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")
txtinput.value += " "
event.preventDefault()
event.stopPropagation()
- forth(txtinput.value)
+ getChannel(0).write(strToArrayBuffer(txtinput.value))
txtinput.value = ""
}
break
/* 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;
(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))
(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
(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
(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
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
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
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
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
end ;; strput
block $sbhasspace2
get_local $stringbelt_head
- get_global $wordbelt
+ get_global $wordbelt_base
i32.lt_u
br_if $sbhasspace2
i32.const 0
i32.const 2
i32.add
tee_local $stringbelt_tail
- get_global $wordbelt
+ get_global $wordbelt_base
i32.le_u
br_if $copystringtostart
end
end ;; strstart
block $sbhasspace
get_local $stringbelt_head
- get_global $wordbelt
+ get_global $wordbelt_base
i32.const 8
i32.sub
i32.le_u
set_local $eax
call $pop
get_local $eax
- call $sys_write
+ call $sys_send
br $next
end ;; eqbool
block $equiv
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
set_local $wordbelt_head
(; /align ;)
get_local $wordbelt_tail
- i32.const 4
- i32.add
call $push
get_local $eax
call $push
call $pop
tee_local $eax
call $rpop
- get_global $base_p
- i32.load
call $sys_parsenum
get_local $eax
i32.load
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
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
br $next
end ;; emit (.)
call $pop
- get_global $base_p
- i32.load
call $sys_echo
br $next
end ;; noop2
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
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
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
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
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
)