diff --git a/README.md b/README.md index 7b79c65..a13cb54 100644 --- a/README.md +++ b/README.md @@ -1,31 +1,24 @@ # Wipforth -Wipforth is a simple Forth implementation that runs in the WebAssembly -virtual machine. It does I/O via memory-mapped peripherals, which are -emulated in JavaScript. +Wipforth is a Forth implementation that runs in the WebAssembly +virtual machine. The system is bootstrapped from source on page load: +the only non-text file is the favicon :) -- For the Forth kernel, see [wipforth.wat](./wipforth.wat) -- For the JavaScript emulator, see [emu.js](./emu.js) -- For the Forth prelude, which is loaded at start-up, see - [prelude.f](./prelude.f) +I/O is done via memory-mapped peripherals, which are emulated in +JavaScript. + +- For the Forth kernel, see [wipforth.ws](./wipforth.ws) +- For the emulator, see [emu.js](./emu.js) +- For the assembler, see [asm.js](./asm.js) +- For the prelude (Forth code loaded right after the kernel boots), + see [prelude.f](./prelude.f) - For a description of the peripherals, see the [Peripherals](#peripherals) section below. ## Building and Running Locally -You'll need: - -- [WABT](https://github.com/WebAssembly/wabt) -- [Guile](https://www.gnu.org/software/guile/) (or bring your own HTTP - server -- see note below) - -To run, first compile the WebAssembly module: - -``` -wat2wasm --enable-threads wipforth.wat -``` - -Then run the development server: +There's a [Guile](https://www.gnu.org/software/guile/) script in the +repo you can use for this: ``` guile server.scm @@ -34,14 +27,20 @@ guile server.scm You should then be able to open in a browser and use the system from there. -**NOTE**: The server is very simple and just serves the files with the -cross-origin isolation headers required for `SharedMemoryBuffer` use. -You could use any HTTP server that sets these headers. +However, since everything is bootstrapped on the client, basically any +HTTP server will do as long as it sets the appropriate response +headers for `SharedMemoryBuffer` use: -You should **definitely not** use the development server to serve the -application on the open internet; I just hacked it together for -testing on localhost during development and it's probably hilariously -insecure. +- `Cross-Origin-Opener-Policy: same-origin` +- `Cross-Origin-Embedder-Policy: require-corp` + +So, if you don't have Guile on your system you can use something else +like Python's `http.server`. + +**NOTE**: You should **definitely not** use `server.scm` to serve the +application on the open internet or anything like that; I just hacked +it together for testing on localhost during development and it's +probably hilariously insecure. ## End-to-End Tests @@ -62,16 +61,13 @@ Given that's all sorted, you should be able to run: guile tests.scm ``` -It will print a JUnit XML report to standard out, you can pretty-print -it with: +It will print a JUnit XML report to standard out. You can +pretty-print it with `xmllint` if you have it installed: ``` guile tests.scm | xmllint --format - ``` -Though, of course, this will require that you have `xmllint` on your -system. - ## Peripherals ### Terminal diff --git a/asm.js b/asm.js new file mode 100644 index 0000000..604b750 --- /dev/null +++ b/asm.js @@ -0,0 +1,1440 @@ +const HEADER = [ + 0x00, 0x61, 0x73, 0x6d, + 0x01, 0x00, 0x00, 0x00 +]; + +const LINE_END = "\n" + +class Tokenizer { + constructor() { + this.delims = new Set([" ", "\r", "\n", "\t"]); + this.skips = new Set([" ", "\r", "\t"]); + this.comment_start = ";"; + this.string_quote = '"'; + this.buffer = []; + this.comment = false; + this.string = false; + } + + skip() { + const idx = this.buffer.findIndex((cp) => !this.skips.has(cp)); + this.buffer = idx == -1 ? [] : this.buffer.slice(idx); + } + + next_string() { + const idx = this.buffer.findIndex((cp) => cp == this.string_quote); + if (idx == -1) { + this.string = true; + } else { + const string = this.buffer.slice(0, idx).join(""); + this.buffer = this.buffer.slice(idx + 1); + this.string = false; + return { string: string }; + } + } + + next() { + if (this.string) + return this.next_string(); + + this.skip(); + if (this.buffer[0] == LINE_END) + return this.buffer.shift(); + + if (this.buffer[0] == this.string_quote) { + this.buffer.shift(); + return this.next_string(); + } + + const idx = this.buffer.findIndex((cp) => this.delims.has(cp)); + if (idx != -1) { + const token = this.buffer.slice(0, idx).join(""); + this.buffer = this.buffer.slice(idx); + return token; + } + } + + *handle(src) { + this.buffer.push(...src); + let token; + while (token = this.next()) { + if (token.string == undefined + && token.startsWith(this.comment_start)) { + this.comment = true; + } else if (this.comment && token == LINE_END) { + this.comment = false; + yield token; + } else if (!this.comment) { + yield token; + } + } + } +} + +const State = Object.freeze({ + TOP: 0, + EXPORT: 1, + FUNC: 2, + RESULT: 3, + PARAM_NAME: 4, + PARAM_TYPE: 5, + LOCAL_NAME: 6, + LOCAL_TYPE: 7, + MEM_NAME: 8, + MEM_INIT: 9, + MEM_MAX: 10, + MEM_FLAGS: 11, + IMPORT_NAME: 12, + IMPORT_MOD: 13, + IMPORT_FIELD: 14, + GLOBAL_NAME: 15, + GLOBAL_TYPE: 16, + GLOBAL_INIT: 17, + AT_MEM: 18, + AT_ADDR: 19, + BYTE: 20, + WORD: 21, + UTF8: 22, + ALIGN: 23, + DEF_NAME: 24, + DEF_VALUE: 25, + BLOCK_NAME: 26, + BLOCK_TYPE: 27, + TYPE_NAME: 28, + TYPE_PARAM: 29, + TYPE_RESULT: 30, + TABLE_NAME: 31, + TABLE_SIZE: 32, + ELEM_TABLE: 33, + ELEM_ELEM: 34, + ELEM_LABEL: 35, + ZERO: 36, +}); + +const Action = Object.freeze({ + APPEND: 0, + EXPORT: 1, + FUNC: 2, + RESULT: 3, + PARAM: 4, + SYMBOL: 5, + LOCAL: 6, + MEM: 7, + IMPORT: 8, + GLOBAL: 9, + AT: 10, + DATA: 11, + ALIGN: 12, + DEF: 13, + LABEL: 14, + ENTER: 16, + EXIT: 17, + ELSE: 18, + TYPE: 19, + TABLE: 20, + ELEM: 21, +}); + +const types = { + "void": 0x40, + "func": 0x60, + "funcref": 0x70, + "f32": 0x7d, + "i32": 0x7f, +}; + +const opcodes = { + "block": 0x02, + "loop": 0x03, + "if": 0x04, + "else": 0x05, + "end": 0x0b, + "br": 0x0c, + "br_if": 0x0d, + "call": 0x10, + "call_indirect": 0x11, + "drop": 0x0a, + "local.get": 0x20, + "local.set": 0x21, + "local.tee": 0x22, + "global.get": 0x23, + "global.set": 0x24, + "i32.load": 0x28, + "i32.load8_u": 0x2d, + "i32.store": 0x36, + "i32.store8": 0x3a, + "i32.const": 0x41, + "i64.const": 0x42, + "i32.eqz": 0x45, + "i32.eq": 0x46, + "i32.ne": 0x47, + "i32.lt_s": 0x48, + "i32.lt_u": 0x49, + "i32.gt_s": 0x4a, + "i32.gt_u": 0x4b, + "i32.le_s": 0x4c, + "i32.le_u": 0x4d, + "i32.ge_s": 0x4e, + "i32.ge_u": 0x4f, + "i32.add": 0x6a, + "i32.sub": 0x6b, + "i32.mul": 0x6c, + "i32.div_s": 0x6d, + "i32.rem_s": 0x6f, + "i32.and": 0x71, + "i32.or": 0x72, + "i32.xor": 0x73, + "i32.shl": 0x74, + "i32.shr_s": 0x75, + "i32.shr_u": 0x76, + + // Threads instructions + "memory.atomic.notify": [ 0xfe, 0x00 ], + "memory.atomic.wait32": [ 0xfe, 0x01 ], + "i32.atomic.load": [ 0xfe, 0x10 ], + "i32.atomic.load8_u": [ 0xfe, 0x12 ], + "i32.atomic.store": [ 0xfe, 0x17 ], + "i32.atomic.store8": [ 0xfe, 0x19 ], +}; + +const mem_flags = { + "max": 1, + "shared": 2, + "64": 4, +}; + +const const_opcodes = { + [types["i32"]]: opcodes["i32.const"], +}; + +class Parser { + constructor(encoder) { + this.encoder = encoder; + this.tokens = []; + this.tokenizer = new Tokenizer(); + this.state = State.TOP; + this.directives = { + ".export": State.EXPORT, + ".func": State.FUNC, + ".result": State.RESULT, + ".param": State.PARAM_NAME, + ".local": State.LOCAL_NAME, + ".mem": State.MEM_NAME, + ".import": State.IMPORT_NAME, + ".global": State.GLOBAL_NAME, + ".at": State.AT_MEM, + ".byte": State.BYTE, + ".word": State.WORD, + ".utf8": State.UTF8, + ".align": State.ALIGN, + ".def": State.DEF_NAME, + ".type": State.TYPE_NAME, + ".table": State.TABLE_NAME, + ".elem": State.ELEM_TABLE, + ".zero": State.ZERO, + }; + this.blocks = new Set(["block", "loop", "if"]); + this.handlers = { + [State.TOP]: (token) => this.token_top(token), + [State.EXPORT]: (token) => this.token_export(token), + [State.FUNC]: (token) => this.token_func(token), + [State.RESULT]: (token) => this.token_result(token), + [State.PARAM_NAME]: (token) => this.token_param_name(token), + [State.PARAM_TYPE]: (token) => this.token_param_type(token), + [State.LOCAL_NAME]: (token) => this.token_local_name(token), + [State.LOCAL_TYPE]: (token) => this.token_local_type(token), + [State.MEM_NAME]: (token) => this.token_mem_name(token), + [State.MEM_INIT]: (token) => this.token_mem_init(token), + [State.MEM_MAX]: (token) => this.token_mem_max(token), + [State.MEM_FLAGS]: (token) => this.token_mem_flags(token), + [State.IMPORT_NAME]: (token) => this.token_import_name(token), + [State.IMPORT_MOD]: (token) => this.token_import_mod(token), + [State.IMPORT_FIELD]: (token) => this.token_import_field(token), + [State.GLOBAL_NAME]: (token) => this.token_global_name(token), + [State.GLOBAL_TYPE]: (token) => this.token_global_type(token), + [State.GLOBAL_INIT]: (token) => this.token_global_init(token), + [State.AT_MEM]: (token) => this.token_at_mem(token), + [State.AT_ADDR]: (token) => this.token_at_addr(token), + [State.BYTE]: (token) => this.token_byte(token), + [State.WORD]: (token) => this.token_word(token), + [State.UTF8]: (token) => this.token_utf8(token), + [State.ALIGN]: (token) => this.token_align(token), + [State.DEF_NAME]: (token) => this.token_def_name(token), + [State.DEF_VALUE]: (token) => this.token_def_value(token), + [State.BLOCK_NAME]: (token) => this.token_block_name(token), + [State.BLOCK_TYPE]: (token) => this.token_block_type(token), + [State.TYPE_NAME]: (token) => this.token_type_name(token), + [State.TYPE_PARAM]: (token) => this.token_type_param(token), + [State.TYPE_RESULT]: (token) => this.token_type_result(token), + [State.TABLE_NAME]: (token) => this.token_table_name(token), + [State.TABLE_SIZE]: (token) => this.token_table_size(token), + [State.ELEM_TABLE]: (token) => this.token_elem_table(token), + [State.ELEM_ELEM]: (token) => this.token_elem_elem(token), + [State.ELEM_LABEL]: (token) => this.token_elem_label(token), + [State.ZERO]: (token) => this.token_zero(token), + }; + + this.results = []; + this.params = {}; + this.locals = {}; + } + + integer(token) { + let base, regex; + switch (token.slice(-1)) { + case "b": base = 2; regex = /^-?[01]+b$/; break; + case "o": base = 8; regex = /^-?[0-7]+o$/; break; + case "h": base = 16; regex = /^-?[0-9A-F]+h$/; break; + default: base = 10; regex = /^-?[0-9]+d?$/; break; + } + return regex.test(token) ? parseInt(token, base) : null; + } + + translate_code(token) { + return opcodes[token] ?? this.integer(token); + } + + translate_type(token) { + return types[token]; + } + + token_top(token) { + if (token == LINE_END) + return; + const state = this.directives[token]; + if (state) { + this.state = state; + return; + } + + if (token.endsWith(":")) + return { type: Action.LABEL, name: token.slice(0, -1) }; + + const opcode = opcodes[token]; + + if (this.blocks.has(token)) { + this.state = State.BLOCK_NAME; + this.block = { code: opcode }; + return; + } + if (token == "else") + return { type: Action.ELSE } + if (token == "end") + return { type: Action.EXIT }; + + if (opcode) + return { type: Action.APPEND, opcode }; + const literal = this.integer(token); + if (literal != null) + return { type: Action.APPEND, literal }; + + return { type: Action.SYMBOL, symbol: token }; + } + + token_export(token) { + this.state = State.TOP; + return { type: Action.EXPORT, name: token }; + } + + token_func(token) { + this.state = State.TOP; + return { type: Action.FUNC, name: token }; + } + + token_result(token) { + if (token == LINE_END) { + const action = { type: Action.RESULT, results: this.results }; + this.state = State.TOP; + this.results = []; + return action; + } else { + this.results.push(this.translate_type(token)); + } + } + + token_param_name(token) { + if (token == LINE_END) { + const action = { type: Action.PARAM, params: this.params }; + this.state = State.TOP; + this.params = {}; + return action; + } else { + this.current_param = token; + this.state = State.PARAM_TYPE; + } + } + + token_param_type(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected newline in .param: expected type"); + this.state = State.TOP; + this.params = {}; + } else { + this.params[this.current_param] = types[token]; + this.current_param = undefined; + this.state = State.PARAM_NAME; + } + } + + token_local_name(token) { + if (token == LINE_END) { + const action = { type: Action.LOCAL, locals: this.locals }; + this.state = State.TOP; + this.locals = {}; + return action; + } else { + this.current_local = token; + this.state = State.LOCAL_TYPE; + } + } + + token_local_type(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected newline in .local: expected type"); + this.state = State.TOP; + this.locals = {}; + } else { + this.locals[this.current_local] = types[token]; + this.current_local = undefined; + this.state = State.LOCAL_NAME; + } + } + + token_mem_name(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected newline in .mem: expected name"); + this.state = State.TOP; + } else { + this.mem = { flags: 0 }; + this.mem_name = token; + this.state = State.MEM_INIT; + } + } + + token_mem_init(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected newline in .mem: expected initial size"); + this.mem = undefined; + this.mem_name = undefined; + this.state = State.TOP; + } else { + this.mem.init = this.integer(token) ?? console.error( + `ERROR: Invalid initial size ${token} in .mem`); + this.state = State.MEM_MAX; + } + } + + token_mem_max(token) { + if (token == LINE_END) { + return this.mem_action(); + } else { + this.mem.max = this.integer(token) ?? console.error( + `ERROR: Invalid maximum size ${token} in .mem`); + this.mem.flags |= mem_flags.max; + this.state = State.MEM_FLAGS; + } + } + + token_mem_flags(token) { + if (token == LINE_END) { + return this.mem_action(); + } else { + for (const flag of token.split(",")) { + this.mem.flags |= mem_flags[flag] ?? console.error( + `ERROR: Invalid flag ${flag} in .mem`); + } + this.state = State.TOP; + return this.mem_action(); + } + } + + token_import_name(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .import: expected name"); + this.state = State.TOP; + } else { + this.import = { name: token }; + this.state = State.IMPORT_MOD; + } + } + + token_import_mod(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .import: expected name"); + this.import = undefined; + this.state = State.TOP; + } else if (token.string == undefined) { + console.error( + `ERROR: Unexpected token ${token} in .import: expected` + + " module string"); + this.import = undefined; + this.state = State.TOP; + } else { + this.import.mod = token.string; + this.state = State.IMPORT_FIELD; + } + } + + token_import_field(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .import: expected name"); + this.import = undefined; + this.state = State.TOP; + } else if (token.string == undefined) { + console.error( + "ERROR: Unexpected token in .import: expected field string"); + this.import = undefined; + this.state = State.TOP; + } else { + this.import.field = token.string; + const action = { type: Action.IMPORT, import: this.import }; + this.import = undefined; + this.state = State.TOP; + return action; + } + } + + token_global_name(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .global: expected name"); + this.state = State.TOP; + } else { + this.global = {}; + this.global_name = token; + this.state = State.GLOBAL_TYPE; + } + } + + token_global_type(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected newline in .global: expected type"); + this.global = undefined; + this.global_name = undefined; + this.state = State.TOP; + } else { + this.global.type = types[token] ?? console.error( + `ERROR: Unexpected token ${token} in .global: ` + + "expected type"); + this.state = State.GLOBAL_INIT; + } + } + + token_global_init(token) { + if (token == LINE_END) { + this.global.init = 0; + } else { + const value = this.integer(token) ?? console.error( + `ERROR: Unexpected token ${token} in .global: expected` + + " initial value"); + this.global.init = value; + } + const action = { + type: Action.GLOBAL, + global: { [this.global_name]: this.global } + }; + this.global = undefined; + this.global_name = undefined; + this.state = State.TOP; + return action; + } + + token_at_mem(token) { + this.at = { mem: token }; + this.state = State.AT_ADDR; + } + + token_at_addr(token) { + const value = this.integer(token); + if (value != null) + this.at.addr = value; + else + this.at.addr_symbol = token; + const action = { type: Action.AT, at: this.at }; + this.at = undefined; + this.state = State.TOP; + return action; + } + + token_byte(token) { + if (token == LINE_END) { + this.state = State.TOP; + return; + } + const action = { type: Action.DATA, size: 1 }; + const value = this.integer(token); + if (value == null) { + action.symbol = token; + } else { + if (value > 0xff) + console.error(`WARNING: Value ${token} is truncated`); + action.value = value; + } + return action; + } + + token_word(token) { + if (token == LINE_END) { + this.state = State.TOP; + return; + } + const action = { type: Action.DATA, size: 4 }; + const value = this.integer(token); + if (value == null) { + action.symbol = token; + } else { + if (value > 0xffffffff) + console.error(`WARNING: Value ${token} is truncated`); + action.value = value; + } + return action; + } + + token_utf8(token) { + if (token == LINE_END) { + this.state = State.TOP; + return; + } else if (token.string == undefined) { + console.error( + `ERROR: Unexpected token ${token}, expected string`); + return; + } + const bytes = this.encoder.encode(token.string); + const action = { type: Action.DATA, size: bytes.length, bytes }; + return action; + } + + token_align(token) { + const action = { type: Action.ALIGN }; + if (token == LINE_END) { + action.alignment = 4; + } else { + action.alignment = this.integer(token); + if (action.alignment == null) { + console.error( + `ERROR: Unexpected token ${token}, expected alignment`); + this.state = State.TOP; + return action; + } + } + this.state = State.TOP + return action; + } + + token_def_name(token) { + if (token == LINE_END) { + console.error("ERROR: Unexpected end of line, expected name"); + this.state = State.TOP; + return; + } + this.def_name = token; + this.state = State.DEF_VALUE; + } + + token_def_value(token) { + if (token == LINE_END) { + console.error("ERROR: Unexpected end of line, expected value"); + this.def_name = undefined; + this.state = State.TOP; + return; + } + const action = { + type: Action.DEF, + def: { name: this.def_name }, + }; + const value = this.integer(token); + if (value != null) + action.def.value = value; + else + action.def.symbol = token; + this.def_name = undefined; + this.state = State.TOP; + return action; + } + + token_block_name(token) { + if (token == LINE_END) { + this.block.type = types["void"]; + const action = { type: Action.ENTER, block: this.block }; + this.state = State.TOP; + this.block = undefined; + return action; + } else { + this.block.label = token; + this.state = State.BLOCK_TYPE; + return; + } + } + + token_block_type(token) { + if (token == LINE_END) { + this.block.type = types["void"]; + } else { + this.block.type = types[token]; + if (this.block.type == undefined) { + console.error( + `ERROR: Unexpected token ${token}, expected type`); + } + } + const action = { type: Action.ENTER, block: this.block }; + this.state = State.TOP; + this.block = undefined; + return action; + } + + token_type_name(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .type, expected name"); + this.state = State.TOP; + return; + } + + this.type = { name: token, params: [] }; + this.state = State.TYPE_PARAM; + } + + token_type_param(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .type, expected " + + "parameter type"); + this.type = undefined; + this.state = State.TOP; + return; + } + + if (token == "result") { + this.type.results = []; + this.state = State.TYPE_RESULT; + return; + } + + const type = types[token]; + if (type == undefined) { + console.error( + `ERROR: Unexpected token ${token} in .type, expected ` + + "parameter type"); + this.type = undefined; + this.state = State.TOP; + return; + } + + this.type.params.push(type); + } + + token_type_result(token) { + if (token == LINE_END) { + const action = { type: Action.TYPE, the_type: this.type }; + this.type = undefined; + this.state = State.TOP; + return action; + } + + const type = types[token]; + if (type == undefined) { + console.error( + `ERROR: Unexpected token ${token} in .type, expected ` + + "result type"); + this.type = undefined; + this.state = State.TOP; + return; + } + + this.type.results.push(type); + } + + token_table_name(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .table, expected name"); + this.state = State.TOP; + return; + } + + this.table = { name: token }; + this.state = State.TABLE_SIZE; + } + + token_table_size(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .table, expected size"); + this.table = undefined; + this.state = State.TOP; + return; + } + + const size = this.integer(token); + if (size == null) { + console.error( + `ERROR: Unexpected token ${token} in .table, expected size`); + this.table = undefined; + this.state = State.TOP; + return; + } + + this.table.size = size; + const action = { type: Action.TABLE, table: this.table }; + this.table = undefined; + this.state = State.TOP; + return action; + } + + token_elem_table(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .elem, expected " + + "table name"); + this.state = State.TOP; + return; + } + + this.elem = { table: token }; + this.state = State.ELEM_ELEM; + } + + token_elem_elem(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected end of line in .elem, expected " + + "element name"); + this.state = State.TOP; + this.elem = undefined; + return; + } + + this.elem.elem = token; + this.state = State.ELEM_LABEL; + } + + token_elem_label(token) { + if (token != LINE_END) + this.elem.label = token; + const action = { type: Action.ELEM, elem: this.elem }; + this.elem = undefined + this.state = State.TOP; + return action; + } + + token_zero(token) { + if (token == LINE_END) { + console.error( + "ERROR: Unexpected newline in .zero, expected count") + this.state = State.TOP; + return; + } + + const count = this.integer(token); + if (count == null) { + console.error( + `ERROR: Unexpected token ${token} in .zero, expected count`); + this.state = State.TOP; + return; + } + + this.state = State.TOP; + return { type: Action.DATA, size: count, value: 0 } + } + + mem_action() { + const action = { + type: Action.MEM, + mem: { [this.mem_name]: { ...this.mem } } + }; + this.mem = undefined; + this.mem_name = undefined; + this.state = State.TOP; + return action; + } + + *handle(src) { + let action; + for (const token of this.tokenizer.handle(src)) { + const handler = this.handlers[this.state]; + if (handler == undefined) { + console.error(`ERROR: Unhandled state ${this.state}`); + this.state = State.TOP; + continue; + } + + if (action = handler(token)) + yield action; + } + } +} + +const Section = Object.freeze({ + TYPE: 0x01, + IMPORT: 0x02, + FUNC: 0x03, + TABLE: 0x04, + MEM: 0x05, + GLOBAL: 0x06, + EXPORT: 0x07, + ELEM: 0x09, + CODE: 0x0a, + DATA: 0x0b, +}); + +const Kind = Object.freeze({ + FUNC: 0x00, + MEM: 0x02, +}); + +export class Assembler { + constructor() { + this.encoder = new TextEncoder("utf-8"); + this.decoder = new TextDecoder("utf-8"); + this.parser = new Parser(this.encoder); + this.handlers = { + [Action.APPEND]: (action) => this.action_append(action), + [Action.EXPORT]: (action) => this.action_export(action), + [Action.FUNC]: (action) => this.action_func(action), + [Action.RESULT]: (action) => this.action_result(action), + [Action.PARAM]: (action) => this.action_param(action), + [Action.SYMBOL]: (action) => this.action_symbol(action), + [Action.LOCAL]: (action) => this.action_local(action), + [Action.MEM]: (action) => this.action_mem(action), + [Action.IMPORT]: (action) => this.action_import(action), + [Action.GLOBAL]: (action) => this.action_global(action), + [Action.AT]: (action) => this.action_at(action), + [Action.DATA]: (action) => this.action_data(action), + [Action.ALIGN]: (action) => this.action_align(action), + [Action.DEF]: (action) => this.action_def(action), + [Action.LABEL]: (action) => this.action_label(action), + [Action.ENTER]: (action) => this.action_enter(action), + [Action.EXIT]: (action) => this.action_exit(action), + [Action.ELSE]: (action) => this.action_else(action), + [Action.TYPE]: (action) => this.action_type(action), + [Action.TABLE]: (action) => this.action_table(action), + [Action.ELEM]: (action) => this.action_elem(action), + }; + + this.exports = []; + this.funcs = {}; + this.mems = {}; + this.imports = []; + this.globals = {}; + this.pos = { mem: 0, addr: 0 }; + this.data = []; + this.defs = {}; + this.blocks = []; + this.types = []; + this.type_bindings = {}; + this.tables = {}; + this.unresolved = []; + } + + action_append(action) { + const code = action.opcode != undefined + ? [ action.opcode ].flat() + : this.leb128(action.literal); + this.funcs[this.current_func].body.push(...code); + } + + action_export(action) { + const index = Object.keys(this.funcs).indexOf(action.name); + this.exports[action.name] = { kind: Kind.FUNC, index }; + } + + action_func(action) { + this.funcs[action.name] = { + params: {}, + results: [], + locals: {}, + body: [], + } + this.current_func = action.name; + } + + action_result(action) { + this.funcs[this.current_func].results.push(...action.results); + } + + action_param(action) { + Object.assign(this.funcs[this.current_func].params, action.params); + } + + action_local(action) { + Object.assign(this.funcs[this.current_func].locals, action.locals); + } + + action_symbol(action) { + const func = this.funcs[this.current_func]; + const value = this.lookup_block(action.symbol) + ?? this.lookup_param(func, action.symbol) + ?? this.lookup_local(func, action.symbol) + ?? this.lookup_global(action.symbol) + ?? this.lookup_table(action.symbol) + ?? this.lookup_type(action.symbol) + ?? this.lookup_func(action.symbol); + if (value == null) { + const def_value = this.lookup_def(action.symbol); + if (def_value == null) { + console.error( + `ERROR: Unable to resolve symbol ${action.symbol}`); + return; + } + func.body.push(...this.leb128(def_value)); + } else { + func.body.push(...this.uleb128(value)); + } + } + + action_mem(action) { + Object.assign(this.mems, action.mem); + } + + action_import(action) { + const mem = this.mems[action.import.name]; + mem.imported = true; + this.imports.push({ + mod: action.import.mod, + field: action.import.field, + kind: Kind.MEM, + flags: mem.flags, + init: mem.init, + max: mem.max, + }) + } + + action_global(action) { + Object.assign(this.globals, action.global); + } + + action_at(action) { + const mem = Object.keys(this.mems).indexOf(action.at.mem); + if (mem == -1) { + console.error(`ERROR: No memory named ${action.at.mem}`); + return; + } + this.pos.mem = mem; + this.pos.addr = action.at.addr + ?? this.lookup_def(action.at.addr_symbol); + this.data.push({ loc: { ...this.pos }, data: [] }) + } + + action_data(action) { + const data = this.data.at(-1).data; + let bytes; + if (action.bytes != undefined) { + bytes = action.bytes; + } else { + let value = action.value; + if (value == undefined) { + if (action.symbol == undefined) { + console.error("ERROR: Invalid data action", action); + return; + } + value = this.lookup_def(action.symbol); + if (value == undefined) { + this.unresolved.push({ + type: "data", + size: action.size, + symbol: action.symbol, + target: data, + offset: data.length, + }); + value = 0; + } + } + bytes = this.le(value, action.size); + } + data.push(...bytes); + this.pos.addr += action.size; + } + + action_align(action) { + const alignment = action.alignment; + const data = this.data.at(-1).data; + while (this.pos.addr % alignment != 0) { + data.push(0); + ++this.pos.addr; + } + } + + action_def(action) { + const value = action.def.value + ?? this.lookup_def(action.def.symbol); + this.defs[action.def.name] = value; + } + + action_label(action) { + this.defs[action.name] = this.pos.addr; + } + + action_enter(action) { + this.funcs[this.current_func].body.push(action.block.code); + this.funcs[this.current_func].body.push(action.block.type); + this.blocks.push(action.block.label); + } + + action_exit(action) { + this.funcs[this.current_func].body.push(opcodes.end); + this.blocks.pop(); + } + + action_else(action) { + this.blocks.pop(); + this.funcs[this.current_func].body.push(opcodes.else); + this.blocks.push(undefined); + } + + action_type(action) { + const type = this.func_type(action.the_type); + const index = this.ensure_type(type); + this.type_bindings[action.the_type.name] = index; + } + + action_table(action) { + this.tables[action.table.name] = { + size: action.table.size, + elems: [], + }; + } + + action_elem(action) { + const table = this.tables[action.elem.table]; + const fn = Object.keys(this.funcs).indexOf(action.elem.elem); + if (fn == -1) { + console.error(`ERROR: ${action.elem.elem}: no such function`); + return; + } + const index = table.elems.push(fn) - 1; + if (action.elem.label) + this.defs[action.elem.label] = index; + } + + push(chunk) { + const text = this.decoder.decode(chunk, { stream: true }); + for (const action of this.parser.handle(text)) { + const handler = this.handlers[action.type]; + if (handler == undefined) + console.error("ERROR: Unhandled action", action); + else + handler(action); + } + } + + lookup_block(symbol) { + const index = this.blocks.toReversed().indexOf(symbol); + return index == -1 ? null : index; + } + + lookup_param(func, symbol) { + const index = Object.keys(func.params).indexOf(symbol); + return index == -1 ? null : index; + } + + lookup_local(func, symbol) { + const param_count = Object.entries(func.params).length; + const index = Object.keys(func.locals).indexOf(symbol); + return index == -1 ? null : param_count + index; + } + + lookup_global(symbol) { + const index = Object.keys(this.globals).indexOf(symbol); + return index == -1 ? null : index; + } + + lookup_table(symbol) { + const index = Object.keys(this.tables).indexOf(symbol); + return index == -1 ? null : index; + } + + lookup_type(symbol) { + return this.type_bindings[symbol]; + } + + lookup_func(symbol) { + const index = Object.keys(this.funcs).indexOf(symbol); + return index == -1 ? null : index; + } + + lookup_def(symbol) { + return this.defs[symbol]; + } + + le(value, count) { + const bytes = [] + while (value != 0) { + bytes.push(value & 0xff); + value >>>= 8; + } + if (count != undefined) { + while (bytes.length < count) + bytes.push(0); + } + return bytes; + } + + leb128(x) { + const bytes = []; + while (true) { + const b = x & 0x7f; + x >>= 7; + if (x == 0 && (b & 0x40) == 0 || x == -1 && (b & 0x40) != 0) { + bytes.push(b); + return bytes; + } + bytes.push(b | 0x80); + } + } + + uleb128(x) { + const bytes = []; + while (true) { + const b = x & 0x7f; + x >>>= 7; + if (x == 0) { + bytes.push(b); + return bytes; + } + bytes.push(b | 0x80); + } + return bytes; + } + + wasm_section_type() { + if (this.types.length == 0) return null; + return [ this.types.length ].concat(...this.types); + } + + wasm_section_import() { + if (this.imports.length == 0) + return null; + const contents = this.imports.map((imp) => { + const mod_utf8 = this.encoder.encode(imp.mod); + const field_utf8 = this.encoder.encode(imp.field); + return [ + mod_utf8.length, + ...mod_utf8, + field_utf8.length, + ...field_utf8, + imp.kind, + ...this.mem_wasm(imp), + ]; + }); + return [ this.imports.length ].concat(...contents); + } + + wasm_section_func() { + const types = Object.values(this.funcs).map(({type}) => type); + const count = types.length; + if (count == 0) return null; + return [ count, ...types ]; + } + + wasm_section_table() { + const sizes = Object.values(this.tables).map(({size}) => size); + if (sizes.length == 0) return null; + const contents = sizes.map((size) => [ + types.funcref, + 0x00, + this.uleb128(size), + ]); + return [ sizes.length, contents ].flat(Infinity) + } + + wasm_section_mem() { + const mems = Object.values(this.mems).filter( + ({imported}) => !imported); + if (mems.length == 0) + return null; + const contents = mems.map((mem) => this.mem_wasm(mem)); + return [ mems.length ].concat(...contents); + } + + wasm_section_global() { + const globals = Object.values(this.globals); + if (globals.length == 0) + return null; + const contents = globals.map(({ type, init }) => [ + type, + 1, + const_opcodes[type], + ...this.leb128(init), + opcodes["end"], + ]); + return [ globals.length ].concat(...contents); + } + + wasm_section_export() { + const exports = Object.entries(this.exports); + if (exports.length == 0) return null; + const contents = exports.map(([ name, { kind, index }]) => { + const name_utf8 = this.encoder.encode(name); + return [ + name_utf8.length, + ...name_utf8, + kind, + index, + ]; + }); + return [ exports.length ].concat(...contents); + } + + wasm_section_elem() { + const table_elems = Object.values(this.tables).map( + ({elems}) => elems); + const count = table_elems.flat().length; + if (count == 0) return null; + const contents = table_elems.flatMap((elems, table) => + elems.flatMap((fn, index) => [ + table == 0 ? 0 : [ 2, table ], + opcodes["i32.const"], + index, + opcodes["end"], + 1, + fn, + ]) + ); + return [ count, contents ].flat(); + } + + wasm_section_code() { + const funcs = Object.values(this.funcs); + if (funcs.length == 0) return null; + const contents = funcs.map(({ body, locals }) => { + const local_types = Object.values(locals); + const local_count = local_types.length; + if (local_count == 0) { + const full_body = [ 0, body, opcodes.end ].flat() + return [ full_body.length, full_body ].flat(); + } else { + const groups = this.group(local_types); + const full_body = [ + groups.length, + ...groups.flat(), + body, + opcodes.end, + ].flat(); + return [ full_body.length, full_body ].flat(); + } + }); + return [ contents.length, contents ].flat(Infinity); + } + + wasm_section_data() { + if (this.data.length == 0) return null; + const contents = this.data.map(({ loc, data }) => { + return [ + ...(loc.mem == 0 ? [ 0 ] : [ 2, loc.mem ]), + opcodes["i32.const"], + ...this.leb128(loc.addr), + opcodes["end"], + ...this.uleb128(data.length), + ...data, + ] + }); + return [ contents.length, contents ].flat(Infinity); + } + + wasm() { + this.resolve_refs(); + this.resolve_func_types(); + + const template = [ + [ Section.TYPE, () => this.wasm_section_type() ], + [ Section.IMPORT, () => this.wasm_section_import() ], + [ Section.FUNC, () => this.wasm_section_func() ], + [ Section.TABLE, () => this.wasm_section_table() ], + [ Section.MEM, () => this.wasm_section_mem() ], + [ Section.GLOBAL, () => this.wasm_section_global() ], + [ Section.EXPORT, () => this.wasm_section_export() ], + [ Section.ELEM, () => this.wasm_section_elem() ], + [ Section.CODE, () => this.wasm_section_code() ], + [ Section.DATA, () => this.wasm_section_data() ], + ]; + const sections = template.map(([ code, generator ]) => { + const body = generator(); + if (body == null) + return []; + return [ code, this.uleb128(body.length), body ]; + }); + + return new Uint8Array([ HEADER, sections ].flat(Infinity)); + } + + mem_wasm({ flags, init, max }) { + if (flags & mem_flags.max) + return [ flags, init, max ]; + else + return [ flags, init ]; + } + + func_type({ params, results }) { + const param_types = params.length == undefined + ? Object.values(params) + : params; + return [ + types["func"], + param_types.length, + ...param_types, + results.length, + ...results, + ]; + } + + array_eq(a, b) { + return a.length == b.length && a.every((x, i) => x == b[i]); + } + + ensure_type(type) { + const index = this.types.findIndex((t) => this.array_eq(type, t)); + return index != -1 ? index : this.types.push(type) - 1; + } + + resolve_func_types() { + for (const func of Object.values(this.funcs)) + func.type = this.ensure_type(this.func_type(func)); + } + + group(array) { + return array.reduce((acc, val) => { + const last = acc.at(-1); + if (last != undefined && last[1] == val) + ++last[0] + else + acc.push([1, val]); + return acc; + }, []); + } + + resolve_refs() { + const failed = []; + for (const ref of this.unresolved) { + if (ref.type != "data") { + console.error( + `ERROR: Unsupported ref type ${ref.type} for ` + + `symbol ${ref.symbol}` + ); + failed.push(ref.symbol); + continue; + } + + const value = this.defs[ref.symbol]; + if (value == undefined) { + failed.push(ref.symbol); + continue; + } + + const bytes = this.le(value, ref.size); + ref.target.splice(ref.offset, ref.size, ...bytes); + } + + if (failed.length != 0) { + const failed_str = failed.join(" "); + console.error(`ERROR: Unable to resolve refs: ${failed_str}`); + } + } +} diff --git a/boot.js b/boot.js index 263b8f9..96bc257 100644 --- a/boot.js +++ b/boot.js @@ -1,7 +1,26 @@ +import { Assembler } from './asm.js'; + +const assemble = (async () => { + const asm = new Assembler(); + const resp = await fetch('wipforth.ws'); + for await (const chunk of resp.body) { + asm.push(chunk); + } + return asm.wasm(); +})(); + self.onmessage = async (e) => { - const exports = { emu: { mem: e.data } }; - const mod = await WebAssembly.instantiateStreaming( - fetch('wipforth.wasm'), exports) - mod.instance.exports.reset(); - console.log('System halt'); + switch (e.data.type) { + case "load": + const exports = { emu: { mem: e.data.mem } }; + const wasm = await assemble; + self.mod = await WebAssembly.instantiate(wasm, exports); + await self.postMessage('ready'); + break; + + case "boot": + self.mod.instance.exports.reset(); + console.log('System halt'); + break; + } }; diff --git a/deploy-manifest.conf b/deploy-manifest.conf index 188566b..3511156 100644 --- a/deploy-manifest.conf +++ b/deploy-manifest.conf @@ -3,4 +3,4 @@ emu.js index.html prelude.f styles.css -wipforth.wasm +wipforth.ws diff --git a/emu.js b/emu.js index 03e6477..ad4488a 100644 --- a/emu.js +++ b/emu.js @@ -11,6 +11,7 @@ const RXBUF_SIZE = 32; const PERIPHS_SIZE = 81; const POLL_INTERVAL_MS = 20; +const DOT_INTERVAL_MS = 120; const COLS = 80; const TAB_WIDTH = 8; @@ -50,8 +51,15 @@ class Emulator { document.addEventListener('keydown', (e) => this.handle_keydown(e)); window.addEventListener('resize', () => this.handle_resize()); - this.worker = new Worker('boot.js'); - this.worker.postMessage(this.mem); + this.print("Assembling kernel "); + const dots = setInterval(() => this.print("."), DOT_INTERVAL_MS); + this.worker = new Worker('boot.js', { type: 'module' }); + this.worker.postMessage({ type: "load", mem: this.mem }); + this.worker.onmessage = (e) => { + clearInterval(dots); + this.print(" done\n"); + this.worker.postMessage({ type: "boot" }); + }; fetch('prelude.f') .then(res => res.text()) diff --git a/prelude.f b/prelude.f index 7a711e3..379b181 100644 --- a/prelude.f +++ b/prelude.f @@ -249,8 +249,8 @@ CHAR . EMIT \ Version number 0 CONSTANT VERSION-MAJOR -1 CONSTANT VERSION-MINOR -0 CONSTANT VERSION-PATCH +2 CONSTANT VERSION-MINOR +1 CONSTANT VERSION-PATCH : PRINT-VERSION CHAR v EMIT VERSION-MAJOR . diff --git a/server.scm b/server.scm index f2a3db4..361d32a 100644 --- a/server.scm +++ b/server.scm @@ -16,9 +16,8 @@ '(("html" . (text/html)) ("css" . (text/css)) ("js" . (application/javascript)) - ("wasm" . (application/wasm)) ("f" . (text/plain)) - ("wat" . (text/plain)) + ("ws" . (text/plain)) ("png" . (image/png)))) (define (mime-type path) diff --git a/tests.scm b/tests.scm index 064e048..3f4c9e1 100644 --- a/tests.scm +++ b/tests.scm @@ -21,11 +21,17 @@ (navigate client "http://localhost:8080") (sleep 5) +(define-test kernel-assembles-successfully + (let* ((display (get-display client)) + (line (first (lines display)))) + (assert (string-match "Assembling kernel \\.+ done" line) + (format #f "Kernel assemble line: ~s" line)))) + (define-test prelude-loads-successfully (let* ((display (get-display client)) - (first-line (first (lines display)))) - (assert (string-match "Loading prelude \\.+ done" first-line) - (format #f "Prelude load line: ~s" first-line)))) + (line (second (lines display)))) + (assert (string-match "Loading prelude \\.+ done" line) + (format #f "Prelude load line: ~s" line)))) (define-test six-seven-times-dot-cr-yields-42 (input-line client "6 7 * . CR") diff --git a/wipforth.wat b/wipforth.wat deleted file mode 100644 index ede59f4..0000000 --- a/wipforth.wat +++ /dev/null @@ -1,2018 +0,0 @@ -;; Don't panic! WAT's just like assembly, really -- if you're missing -;; macros, labels and jumps. - -(module - (import "emu" "mem" (memory 1 1 shared)) - - ;; Peripheral registers - (global $TXBUF i32 (i32.const 0x0000)) - (global $RXBUF i32 (i32.const 0x0020)) - (global $TXHEAD i32 (i32.const 0x0040)) - (global $TXTAIL i32 (i32.const 0x0044)) - (global $RXHEAD i32 (i32.const 0x0048)) - (global $RXTAIL i32 (i32.const 0x004c)) - - ;; Forth registers - (global $rsp (mut i32) (i32.const 0)) - (global $sp (mut i32) (i32.const 0)) - (global $ip (mut i32) (i32.const 0)) - (global $cfa (mut i32) (i32.const 0)) - (global $fn (mut i32) (i32.const 0)) - - ;; Trampoline control flag - (global $run (mut i32) (i32.const 0)) - - ;; Some little helper functions - - (func $push (param $x i32) - global.get $sp - i32.const 4 - i32.sub - global.set $sp - - global.get $sp - local.get $x - i32.store) - - (func $pop (result i32) - global.get $sp - i32.load - - global.get $sp - i32.const 4 - i32.add - global.set $sp) - - (func $pushrsp (param $x i32) - global.get $rsp - i32.const 4 - i32.sub - global.set $rsp - - global.get $rsp - local.get $x - i32.store) - - (func $poprsp (result i32) - global.get $rsp - i32.load - - global.get $rsp - i32.const 4 - i32.add - global.set $rsp) - - ;; The rather bizzare nature of WebAssembly means that we can't - ;; actually jump to code, which makes this NEXT implemenation - ;; somewhat strange. Instead of doing the jump here, we store the - ;; function index (seemingly the closest you can get to a code - ;; address in WebAssembly) in the $fn global and return. It's then - ;; down to the $trampoline loop to actually run the codeword. - - (func $next - global.get $ip - global.get $ip - - i32.const 4 - i32.add - global.set $ip - - i32.load - global.set $cfa - global.get $cfa - i32.load - global.set $fn) - - ;; Our special inner interpreters <3 - - (func $docol - global.get $ip - call $pushrsp - - global.get $cfa - i32.const 4 - i32.add - global.set $ip - - call $next) - - (func $doval - global.get $cfa - i32.const 4 - i32.add - i32.load - call $push - call $next) - - (func $dovar - global.get $cfa - i32.const 4 - i32.add - call $push - call $next) - - ;; Codewords! - ;; - ;; Most of these are implemented here (as opposed to in the forth - ;; itself) for performance rather than necessity. - - ;; Stack manipulation - - (func $dup - global.get $sp - i32.load - call $push - call $next) - - (func $drop - global.get $sp - i32.const 4 - i32.add - global.set $sp - call $next) - - (func $swap - global.get $sp - i32.const 4 - i32.add - global.get $sp - i32.load - - global.get $sp - global.get $sp - i32.const 4 - i32.add - i32.load - - i32.store - i32.store - - call $next) - - (func $rot - global.get $sp - i32.const 4 - i32.add - global.get $sp - i32.load - - global.get $sp - i32.const 8 - i32.add - global.get $sp - i32.const 4 - i32.add - i32.load - - global.get $sp - global.get $sp - i32.const 8 - i32.add - i32.load - - i32.store - i32.store - i32.store - - call $next) - - (func $nrot - global.get $sp - i32.const 8 - i32.add - global.get $sp - i32.load - - global.get $sp - global.get $sp - i32.const 4 - i32.add - i32.load - - global.get $sp - i32.const 4 - i32.add - global.get $sp - i32.const 8 - i32.add - i32.load - - i32.store - i32.store - i32.store - - call $next) - - (func $over - global.get $sp - i32.const 4 - i32.add - i32.load - call $push - call $next) - - (func $twodup - global.get $sp i32.load - global.get $sp i32.const 4 i32.add i32.load - call $push - call $push - call $next) - - (func $twodrop - global.get $sp - i32.const 8 - i32.add - global.set $sp - call $next) - - (func $twoswap - global.get $sp - i32.const 8 - i32.add - global.get $sp - i32.load - - global.get $sp - i32.const 12 - i32.add - global.get $sp - i32.const 4 - i32.add - i32.load - - global.get $sp - global.get $sp - i32.const 8 - i32.add - i32.load - - global.get $sp - i32.const 4 - i32.add - global.get $sp - i32.const 12 - i32.add - i32.load - - i32.store - i32.store - i32.store - i32.store - - call $next) - - ;; Arithmetic and logic - - (func $inc - global.get $sp - global.get $sp - i32.load - i32.const 1 - i32.add - i32.store - call $next) - - (func $dec - global.get $sp - global.get $sp - i32.load - i32.const 1 - i32.sub - i32.store - call $next) - - (func $inc4 - global.get $sp - global.get $sp - i32.load - i32.const 4 - i32.add - i32.store - call $next) - - (func $dec4 - global.get $sp - global.get $sp - i32.load - i32.const 4 - i32.sub - i32.store - call $next) - - (func $add - call $pop - call $pop - i32.add - call $push - call $next) - - (func $sub (local $tmp i32) - call $pop - local.set $tmp - call $pop - local.get $tmp - i32.sub - call $push - call $next) - - (func $mul - call $pop - call $pop - i32.mul - call $push - call $next) - - (func $div (local $tmp i32) - call $pop - local.set $tmp - call $pop - local.get $tmp - i32.div_s - call $push - call $next) - - (func $mod (local $tmp i32) - call $pop - local.set $tmp - call $pop - local.get $tmp - i32.rem_s - call $push - call $next) - - (func $eq - call $pop - call $pop - i32.eq - i32.const 0 i32.sub - call $push - call $next) - - (func $neq - call $pop - call $pop - i32.ne - i32.const 0 i32.sub - call $push - call $next) - - (func $lt (local $tmp i32) - call $pop - local.set $tmp - call $pop - local.get $tmp - i32.lt_s - i32.const 0 i32.sub - call $push - call $next) - - (func $gt (local $tmp i32) - call $pop - local.set $tmp - call $pop - local.get $tmp - i32.gt_s - i32.const 0 i32.sub - call $push - call $next) - - (func $lte (local $tmp i32) - call $pop - local.set $tmp - call $pop - local.get $tmp - i32.le_s - i32.const 0 i32.sub - call $push - call $next) - - (func $gte (local $tmp i32) - call $pop - local.set $tmp - call $pop - local.get $tmp - i32.ge_s - i32.const 0 i32.sub - call $push - call $next) - - (func $zeq - call $pop - i32.eqz - i32.const 0 i32.sub - call $push - call $next) - - (func $zneq - call $pop - i32.const 0 - i32.ne - i32.const 0 i32.sub - call $push - call $next) - - (func $zlt - call $pop - i32.const 0 - i32.lt_s - i32.const 0 i32.sub - call $push - call $next) - - (func $zgt - call $pop - i32.const 0 - i32.gt_s - i32.const 0 i32.sub - call $push - call $next) - - (func $zlte - call $pop - i32.const 0 - i32.le_s - i32.const 0 i32.sub - call $push - call $next) - - (func $zgte - call $pop - i32.const 0 - i32.ge_s - i32.const 0 i32.sub - call $push - call $next) - - (func $and - call $pop - call $pop - i32.and - call $push - call $next) - - (func $or - call $pop - call $pop - i32.or - call $push - call $next) - - (func $xor - call $pop - call $pop - i32.xor - call $push - call $next) - - (func $invert - call $pop - i32.const 0xffffffff - i32.xor - call $push - call $next) - - ;; Memory - - (func $store - call $pop - call $pop - i32.store - call $next) - - (func $fetch - call $pop - i32.load - call $push - call $next) - - (func $addstore (local $tmp i32) - call $pop - local.tee $tmp - local.get $tmp - i32.load - call $pop - i32.add - i32.store - call $next) - - (func $substore (local $tmp i32) - call $pop - local.tee $tmp - local.get $tmp - i32.load - call $pop - i32.sub - i32.store - call $next) - - (func $storebyte - call $pop - call $pop - i32.store8 - call $next) - - (func $fetchbyte - call $pop - i32.load8_u - call $push - call $next) - - (func $atomic-store - call $pop - call $pop - i32.atomic.store - call $next) - - (func $atomic-fetch - call $pop - i32.atomic.load - call $push - call $next) - - (func $atomic-storebyte - call $pop - call $pop - i32.atomic.store8 - call $next) - - (func $atomic-fetchbyte - call $pop - i32.atomic.load8_u - call $push - call $next) - - (func $copy (local $src i32) (local $dst i32) (local $n i32) - call $pop local.tee $dst - call $pop local.tee $src - call $pop local.tee $n - - block $done (param i32 i32 i32) - loop $loop (param i32 i32 i32) (result i32 i32 i32) - i32.eqz br_if $done - i32.load8_u i32.store8 - local.get $dst i32.const 1 i32.add local.tee $dst - local.get $src i32.const 1 i32.add local.tee $src - local.get $n i32.const 1 i32.sub local.tee $n - br $loop - end - drop drop drop - end - - call $next) - - ;; Core utility words - - (func $exit - call $poprsp - global.set $ip - call $next) - - (func $lit - global.get $ip - i32.load - call $push - global.get $ip - i32.const 4 - i32.add - global.set $ip - call $next) - - (func $execute - call $pop - global.set $cfa - global.get $cfa - i32.load - global.set $fn) - - (func $halt i32.const 0 global.set $run) - - ;; Return and parameter stack primitives - - (func $tor - call $pop - call $pushrsp - call $next) - - (func $fromr - call $poprsp - call $push - call $next) - - (func $rspfetch - global.get $rsp - call $push - call $next) - - (func $rspstore - call $pop - global.set $rsp - call $next) - - (func $rdrop - global.get $rsp - i32.const 4 - i32.add - global.set $rsp - call $next) - - (func $spfetch - global.get $sp - call $push - call $next) - - (func $spstore - call $pop - global.set $sp - call $next) - - ;; Serial I/O - - (func $key (local $head i32) - global.get $RXHEAD - i32.atomic.load8_u - local.tee $head - - ;; Wait for RXBUF to be non-empty - loop $wait (param i32) - global.get $RXTAIL - i32.atomic.load8_u - i32.eq - if - global.get $RXTAIL - local.get $head - i64.const -1 - memory.atomic.wait32 - - local.get $head - br $wait - end - end - - ;; Read byte at head position - global.get $RXBUF - local.get $head - i32.add - i32.load8_u - call $push - - ;; Advance RXHEAD - global.get $RXHEAD - local.get $head - i32.const 1 - i32.add - i32.const 0x1f - i32.and - i32.atomic.store8 - - call $next) - - (func $emit (local $tail i32) (local $next i32) - ;; Wait for TXBUF to be non-full - loop $wait - global.get $TXTAIL - i32.atomic.load8_u - local.tee $tail - i32.const 1 - i32.add - i32.const 0x1f - i32.and - local.tee $next - global.get $TXHEAD - i32.atomic.load8_u - i32.eq - br_if $wait - end - - ;; Write byte at tail position - global.get $TXBUF - local.get $tail - i32.add - call $pop - i32.store8 - - ;; Advance TXTAIL - global.get $TXTAIL - local.get $next - i32.atomic.store8 - - call $next) - - ;; Branching - - (func $branch - global.get $ip - i32.load - global.get $ip - i32.add - global.set $ip - call $next) - - (func $zbranch - call $pop - if (result i32) - i32.const 4 - else - global.get $ip - i32.load - end - global.get $ip - i32.add - global.set $ip - call $next) - - ;; The codewords function table must contain every codeword we want - ;; to be able to run, as it's indices into this table that can be ran - ;; with call_indirect in the $trampoline loop. Fantastically, there - ;; doesn't seem to be a way to sensibly give symbolic names to the - ;; indices the functions are inserted at so, instead of having all - ;; the entries here, most of them are defined in-line with the - ;; dictionary entries so that the definition of the index isn't too - ;; far from its use. - ;; - ;; The exceptions are the special inner interpreters, DOCOL, DOVAL - ;; and DOVAR, which I've put here in indices 0, 1 and 2 for - ;; convenience. - - (type $codeword (func)) - (table $codewords 100 funcref) - - (elem (i32.const 0x00) $docol) - (elem (i32.const 0x01) $doval) - (elem (i32.const 0x02) $dovar) - - ;; Dictionary time D: - ;; - ;; I <3 writing dictionary entries by hand! - - (elem (i32.const 0x03) $dup) - (data (i32.const 0x0200) - "\00\00\00\00" - "\03DUP" - "\03\00\00\00") - - (elem (i32.const 0x04) $drop) - (data (i32.const 0x020c) - "\00\02\00\00" - "\04DROP\00\00\00" - "\04\00\00\00") - - (elem (i32.const 0x05) $swap) - (data (i32.const 0x021c) - "\0c\02\00\00" - "\04SWAP\00\00\00" - "\05\00\00\00") - - (elem (i32.const 0x06) $rot) - (data (i32.const 0x022c) - "\1c\02\00\00" - "\03ROT" - "\06\00\00\00") - - (elem (i32.const 0x07) $nrot) - (data (i32.const 0x0238) - "\2c\02\00\00" - "\04-ROT\00\00\00" - "\07\00\00\00") - - (elem (i32.const 0x08) $over) - (data (i32.const 0x0248) - "\38\02\00\00" - "\04OVER\00\00\00" - "\08\00\00\00") - - (elem (i32.const 0x09) $twodup) - (data (i32.const 0x0258) - "\48\02\00\00" - "\042DUP\00\00\00" - "\09\00\00\00") - - (elem (i32.const 0x0a) $twodrop) - (data (i32.const 0x0268) - "\58\02\00\00" - "\052DROP\00\00" - "\0a\00\00\00") - - (elem (i32.const 0x0b) $twoswap) - (data (i32.const 0x0278) - "\68\02\00\00" - "\052SWAP\00\00" - "\0b\00\00\00") - - (elem (i32.const 0x0c) $inc) - (data (i32.const 0x0288) - "\78\02\00\00" - "\021+\00" - "\0c\00\00\00") - - (elem (i32.const 0x0d) $dec) - (data (i32.const 0x0294) - "\88\02\00\00" - "\021-\00" - "\0d\00\00\00") - - (elem (i32.const 0x0e) $inc4) - (data (i32.const 0x02a0) - "\94\02\00\00" - "\024+\00" - "\0e\00\00\00") - - (elem (i32.const 0x0f) $dec4) - (data (i32.const 0x02ac) - "\a0\02\00\00" - "\024-\00" - "\0f\00\00\00") - - (elem (i32.const 0x10) $add) - (data (i32.const 0x02b8) - "\ac\02\00\00" - "\01+\00\00" - "\10\00\00\00") - - (elem (i32.const 0x11) $sub) - (data (i32.const 0x02c4) - "\b8\02\00\00" - "\01-\00\00" - "\11\00\00\00") - - (elem (i32.const 0x12) $mul) - (data (i32.const 0x02d0) - "\c4\02\00\00" - "\01*\00\00" - "\12\00\00\00") - - (elem (i32.const 0x13) $div) - (data (i32.const 0x02dc) - "\d0\02\00\00" - "\01/\00\00" - "\13\00\00\00") - - (elem (i32.const 0x14) $mod) - (data (i32.const 0x02e8) - "\dc\02\00\00" - "\03MOD" - "\14\00\00\00") - - (elem (i32.const 0x15) $eq) - (data (i32.const 0x02f4) - "\e8\02\00\00" - "\01=\00\00" - "\15\00\00\00") - - (elem (i32.const 0x16) $neq) - (data (i32.const 0x0300) - "\f4\02\00\00" - "\02<>\00" - "\16\00\00\00") - - (elem (i32.const 0x17) $lt) - (data (i32.const 0x030c) - "\00\03\00\00" - "\01<\00\00" - "\17\00\00\00") - - (elem (i32.const 0x18) $gt) - (data (i32.const 0x0318) - "\0c\03\00\00" - "\01>\00\00" - "\18\00\00\00") - - (elem (i32.const 0x19) $lte) - (data (i32.const 0x0324) - "\18\03\00\00" - "\02<=\00" - "\19\00\00\00") - - (elem (i32.const 0x1a) $gte) - (data (i32.const 0x0330) - "\24\03\00\00" - "\02>=\00" - "\1a\00\00\00") - - (elem (i32.const 0x1b) $zeq) - (data (i32.const 0x033c) - "\30\03\00\00" - "\020=\00" - "\1b\00\00\00") - - (elem (i32.const 0x1c) $zneq) - (data (i32.const 0x0348) - "\3c\03\00\00" - "\030<>" - "\1c\00\00\00") - - (elem (i32.const 0x1d) $zlt) - (data (i32.const 0x0354) - "\48\03\00\00" - "\020<\00" - "\1d\00\00\00") - - (elem (i32.const 0x1e) $zgt) - (data (i32.const 0x0360) - "\54\03\00\00" - "\020>\00" - "\1e\00\00\00") - - (elem (i32.const 0x1f) $zlte) - (data (i32.const 0x036c) - "\60\03\00\00" - "\030<=" - "\1f\00\00\00") - - (elem (i32.const 0x20) $zgte) - (data (i32.const 0x0378) - "\6c\03\00\00" - "\030>=" - "\20\00\00\00") - - (elem (i32.const 0x21) $and) - (data (i32.const 0x0384) - "\78\03\00\00" - "\03AND" - "\21\00\00\00") - - (elem (i32.const 0x22) $or) - (data (i32.const 0x0390) - "\84\03\00\00" - "\02OR\00" - "\22\00\00\00") - - (elem (i32.const 0x23) $xor) - (data (i32.const 0x039c) - "\90\03\00\00" - "\03XOR" - "\23\00\00\00") - - (elem (i32.const 0x24) $invert) - (data (i32.const 0x03a8) - "\9c\03\00\00" - "\06INVERT\00" - "\24\00\00\00") - - (elem (i32.const 0x25) $store) - (data (i32.const 0x03b8) - "\a8\03\00\00" - "\01!\00\00" - "\25\00\00\00") - - (elem (i32.const 0x26) $fetch) - (data (i32.const 0x03c4) - "\b8\03\00\00" - "\01@\00\00" - "\26\00\00\00") - - (elem (i32.const 0x27) $addstore) - (data (i32.const 0x03d0) - "\c4\03\00\00" - "\02+!\00" - "\27\00\00\00") - - (elem (i32.const 0x28) $substore) - (data (i32.const 0x03dc) - "\d0\03\00\00" - "\02-!\00" - "\28\00\00\00") - - (elem (i32.const 0x29) $storebyte) - (data (i32.const 0x03e8) - "\dc\03\00\00" - "\02C!\00" - "\29\00\00\00") - - (elem (i32.const 0x2a) $fetchbyte) - (data (i32.const 0x03f4) - "\e8\03\00\00" - "\02C@\00" - "\2a\00\00\00") - - (elem (i32.const 0x2b) $exit) - (data (i32.const 0x0400) - "\f4\03\00\00" - "\04EXIT\00\00\00" - "\2b\00\00\00") - - (elem (i32.const 0x2c) $lit) - (data (i32.const 0x0410) - "\00\04\00\00" - "\03LIT" - "\2c\00\00\00") - - (elem (i32.const 0x2d) $tor) - (data (i32.const 0x041c) - "\10\04\00\00" - "\02>R\00" - "\2d\00\00\00") - - (elem (i32.const 0x2e) $fromr) - (data (i32.const 0x0428) - "\1c\04\00\00" - "\02R>\00" - "\2e\00\00\00") - - (elem (i32.const 0x2f) $rspfetch) - (data (i32.const 0x434) - "\28\04\00\00" - "\04RSP@\00\00\00" - "\2f\00\00\00") - - (elem (i32.const 0x30) $rspstore) - (data (i32.const 0x0444) - "\34\04\00\00" - "\04RSP!\00\00\00" - "\30\00\00\00") - - (elem (i32.const 0x31) $rdrop) - (data (i32.const 0x0454) - "\44\04\00\00" - "\05RDROP\00\00" - "\31\00\00\00") - - (elem (i32.const 0x32) $spfetch) - (data (i32.const 0x0464) - "\54\04\00\00" - "\03SP@" - "\32\00\00\00") - - (elem (i32.const 0x33) $spstore) - (data (i32.const 0x0470) - "\64\04\00\00" - "\03SP!" - "\33\00\00\00") - - (elem (i32.const 0x34) $key) - (data (i32.const 0x047c) - "\70\04\00\00" - "\03KEY" - "\34\00\00\00") - - (elem (i32.const 0x35) $emit) - (data (i32.const 0x0488) - "\7c\04\00\00" - "\04EMIT\00\00\00" - "\35\00\00\00") - - (elem (i32.const 0x36) $branch) - (data (i32.const 0x0498) - "\88\04\00\00" - "\06BRANCH\00" - "\36\00\00\00") - - (elem (i32.const 0x37) $zbranch) - (data (i32.const 0x04a8) - "\98\04\00\00" - "\070BRANCH" - "\37\00\00\00") - - ;; Built-in values and variables - - (data (i32.const 0x04b8) - "\a8\04\00\00" - "\05DOCOL\00\00" - "\01\00\00\00" - "\00\00\00\00") - - (data (i32.const 0x04cc) - "\b8\04\00\00" - "\05DOVAL\00\00" - "\01\00\00\00" - "\01\00\00\00") - - (data (i32.const 0x04e0) - "\cc\04\00\00" - "\05DOVAR\00\00" - "\01\00\00\00" - "\02\00\00\00") - - (data (i32.const 0x04f4) - "\e0\04\00\00" - "\07LIT-CFA" - "\01\00\00\00" - "\18\04\00\00") - - (data (i32.const 0x0508) - "\f4\04\00\00" - "\02R0\00" - "\01\00\00\00" - "\00\00\01\00") - - (data (i32.const 0x0518) - "\08\05\00\00" - "\02S0\00" - "\01\00\00\00" - "\00\f0\00\00") - - (data (i32.const 0x0528) - "\18\05\00\00" - "\04TRUE\00\00\00" - "\01\00\00\00" - "\ff\ff\ff\ff") - - (data (i32.const 0x053c) - "\28\05\00\00" - "\05FALSE\00\00" - "\01\00\00\00" - "\00\00\00\00") - - (data (i32.const 0x0550) - "\3c\05\00\00" - "\05STATE\00\00" - "\02\00\00\00" - "\00\00\00\00") - - (data (i32.const 0x0564) - "\50\05\00\00" - "\04BASE\00\00\00" - "\02\00\00\00" - "\0a\00\00\00") - - (data (i32.const 0x0578) - "\64\05\00\00" - "\04HERE\00\00\00" - "\02\00\00\00" - "\60\0e\00\00") - - (data (i32.const 0x058c) - "\78\05\00\00" - "\06LATEST\00" - "\02\00\00\00" - "\30\0e\00\00") - - (data (i32.const 0x05a0) - "\8c\05\00\00" - "\07WORDBUF" - "\02\00\00\00") - - ;; Skip 0x20 bytes for the word buffer - - (data (i32.const 0x05d0) - "\a0\05\00\00" - "\07WNFHOOK" - "\01\00\00\00" - "\f0\0d\00\00") - - ;; And now, it's time for some hand-compiled colon words. It - ;; probably would have made more sense to write most of these - ;; directly in WAT, but I think this is way cooler. - - ;; : TUCK DUP -ROT ; - - (data (i32.const 0x05e4) - "\d0\05\00\00" - "\04TUCK\00\00\00" - "\00\00\00\00" - "\08\02\00\00" ;; DUP - "\44\02\00\00" ;; -ROT - "\0c\04\00\00") ;; EXIT - - ;; => 0x1c bytes - - ;; : NSPACE ( byte -- bool ) - ;; DUP 9 <> SWAP \ Compare to horizontal tab - ;; DUP 10 <> SWAP \ Compare to line-feed - ;; DUP 13 <> SWAP \ Compare to carriage return - ;; 32 <> \ Compare to space - ;; AND AND AND \ And all results together - ;; ; - - (data (i32.const 0x0600) - "\e4\05\00\00" - "\06NSPACE\00" - "\00\00\00\00" - "\08\02\00\00" ;; DUP - "\18\04\00\00" ;; LIT - "\09\00\00\00" ;; 9 - "\08\03\00\00" ;; <> - "\28\02\00\00" ;; SWAP - "\08\02\00\00" ;; DUP - "\18\04\00\00" ;; LIT - "\0a\00\00\00" ;; 10 - "\08\03\00\00" ;; <> - "\28\02\00\00" ;; SWAP - "\08\02\00\00" ;; DUP - "\18\04\00\00" ;; LIT - "\0d\00\00\00" ;; 13 - "\08\03\00\00" ;; <> - "\28\02\00\00" ;; SWAP - "\18\04\00\00" ;; LIT - "\20\00\00\00" ;; 32 - "\08\03\00\00" ;; <> - "\8c\03\00\00" ;; AND - "\8c\03\00\00" ;; AND - "\8c\03\00\00" ;; AND - "\0c\04\00\00") ;; EXIT - - ;; => 0x68 bytes - - ;; : WORD ( -- len ) - ;; 0 \ Initial length - ;; - ;; KEY \ Get byte from input - ;; TUCK NSPACE 0BRANCH [60] \ Check if whitespace - ;; TUCK WORDBUF + C! \ Append byte to WORDBUF - ;; 1+ \ Increment length - ;; DUP 32 >= 0BRANCH [8] EXIT \ Exit if at max length - ;; BRANCH [-72] \ Loop back to KEY - ;; - ;; \ Byte is whitespace - ;; SWAP DROP - ;; DUP 0<> 0BRANCH [-96] \ Loop back to KEY if zero length - ;; ; - - (data (i32.const 0x0668) - "\00\06\00\00" - "\04WORD\00\00\00" - "\00\00\00\00" - "\18\04\00\00" ;; LIT - "\00\00\00\00" ;; 0 - "\84\04\00\00" ;; KEY - "\f0\05\00\00" ;; TUCK - "\0c\06\00\00" ;; NSPACE - "\b4\04\00\00" ;; 0BRANCH - "\3c\00\00\00" ;; 60 - "\f0\05\00\00" ;; TUCK - "\ac\05\00\00" ;; WORDBUF - "\c0\02\00\00" ;; + - "\f0\03\00\00" ;; C! - "\90\02\00\00" ;; 1+ - "\08\02\00\00" ;; DUP - "\18\04\00\00" ;; LIT - "\20\00\00\00" ;; 32 - "\38\03\00\00" ;; >= - "\b4\04\00\00" ;; 0BRANCH - "\08\00\00\00" ;; 8 - "\0c\04\00\00" ;; EXIT - "\a4\04\00\00" ;; BRANCH - "\b8\ff\ff\ff" ;; -72 - "\28\02\00\00" ;; SWAP - "\18\02\00\00" ;; DROP - "\08\02\00\00" ;; DUP - "\50\03\00\00" ;; 0<> - "\b4\04\00\00" ;; 0BRANCH - "\a0\ff\ff\ff" ;; -96 - "\0c\04\00\00") ;; EXIT - - ;; => 0x80 bytes - - ;; : STRING= ( len str1 str2 -- bool ) - ;; 2DUP C@ SWAP C@ \ Load a byte from each address - ;; = 0BRANCH [48] \ Check for byte mismatch - ;; 1+ -ROT 1+ -ROT 1- \ Increment addresses, decrement length - ;; DUP 0BRANCH [32] \ Check for zero remaining bytes - ;; -ROT BRANCH [-68] \ Loop - ;; - ;; 2DROP DROP FALSE EXIT \ Strings not equal - ;; 2DROP DROP TRUE \ Strings equal - ;; ; - - (data (i32.const 0x06e8) - "\68\06\00\00" - "\07STRING=" - "\00\00\00\00" - "\64\02\00\00" ;; 2DUP - "\fc\03\00\00" ;; C@ - "\28\02\00\00" ;; SWAP - "\fc\03\00\00" ;; C@ - "\fc\02\00\00" ;; = - "\b4\04\00\00" ;; 0BRANCH - "\30\00\00\00" ;; 48 - "\90\02\00\00" ;; 1+ - "\44\02\00\00" ;; -ROT - "\90\02\00\00" ;; 1+ - "\44\02\00\00" ;; -ROT - "\9c\02\00\00" ;; 1- - "\08\02\00\00" ;; DUP - "\b4\04\00\00" ;; 0BRANCH - "\20\00\00\00" ;; 32 - "\44\02\00\00" ;; -ROT - "\a4\04\00\00" ;; BRANCH - "\bc\ff\ff\ff" ;; -68 - "\74\02\00\00" ;; 2DROP - "\18\02\00\00" ;; DROP - "\48\05\00\00" ;; FALSE - "\0c\04\00\00" ;; EXIT - "\74\02\00\00" ;; 2DROP - "\18\02\00\00" ;; DROP - "\34\05\00\00" ;; TRUE - "\0c\04\00\00") ;; EXIT - - ;; => 0x78 bytes - - ;; : NAME-LEN 4+ C@ 31 AND ; - - (data (i32.const 0x0760) - "\e8\06\00\00" - "\08NAME-LEN\00\00\00" - "\00\00\00\00" - "\a8\02\00\00" ;; 4+ - "\fc\03\00\00" ;; C@ - "\18\04\00\00" ;; LIT - "\1f\00\00\00" ;; 31 - "\8c\03\00\00" ;; AND - "\0c\04\00\00") ;; EXIT - - ;; => 0x2c bytes - - ;; : FIND ( len -- entry ) - ;; LATEST @ \ Initial entry - ;; - ;; TUCK FIND-NAME-LEN \ Get name length - ;; OVER = 0BRANCH [52] \ Check for length mismatch - ;; OVER 5 + \ Get name address - ;; OVER SWAP WORDBUF STRING= \ Check if name matches - ;; 0BRANCH [12] - ;; DROP EXIT - ;; - ;; \ Name doesn't match - ;; OVER @ 0<> 0BRANCH [20] \ Check for nil link - ;; SWAP @ BRANCH [-104] \ Follow link and loop - ;; 2DROP FALSE \ Return false - ;; ; - - (data (i32.const 0x078c) - "\60\07\00\00" - "\04FIND\00\00\00" - "\00\00\00\00" - "\98\05\00\00" ;; LATEST - "\cc\03\00\00" ;; @ - "\f0\05\00\00" ;; TUCK - "\44\0e\00\00" ;; FIND-NAME-LEN - "\54\02\00\00" ;; OVER - "\fc\02\00\00" ;; = - "\b4\04\00\00" ;; 0BRANCH - "\34\00\00\00" ;; 52 - "\54\02\00\00" ;; OVER - "\18\04\00\00" ;; LIT - "\05\00\00\00" ;; 5 - "\c0\02\00\00" ;; + - "\54\02\00\00" ;; OVER - "\28\02\00\00" ;; SWAP - "\ac\05\00\00" ;; WORDBUF - "\f4\06\00\00" ;; STRING= - "\b4\04\00\00" ;; 0BRANCH - "\0c\00\00\00" ;; 12 - "\18\02\00\00" ;; DROP - "\0c\04\00\00" ;; EXIT - "\54\02\00\00" ;; OVER - "\cc\03\00\00" ;; @ - "\50\03\00\00" ;; 0<> - "\b4\04\00\00" ;; 0BRANCH - "\14\00\00\00" ;; 20 - "\28\02\00\00" ;; SWAP - "\cc\03\00\00" ;; @ - "\a4\04\00\00" ;; BRANCH - "\98\ff\ff\ff" ;; -104 - "\74\02\00\00" ;; 2DROP - "\48\05\00\00" ;; FALSE - "\0c\04\00\00") ;; EXIT - - ;; => 0x90 bytes - - ;; : >CFA ( entry -- cfa ) - ;; DUP NAME-LEN \ Get name length - ;; 5 + + \ Increment address to end of name - ;; DUP 3 AND 0BRANCH [16] \ Check if aligned - ;; 1+ BRANCH [-32] \ Increment address, loop to alignment check - ;; ; - - (data (i32.const 0x081c) - "\8c\07\00\00" - "\04>CFA\00\00\00" - "\00\00\00\00" - "\08\02\00\00" ;; DUP - "\70\07\00\00" ;; NAME-LEN - "\18\04\00\00" ;; LIT - "\05\00\00\00" ;; 5 - "\c0\02\00\00" ;; + - "\c0\02\00\00" ;; + - "\08\02\00\00" ;; DUP - "\18\04\00\00" ;; LIT - "\03\00\00\00" ;; 3 - "\8c\03\00\00" ;; AND - "\b4\04\00\00" ;; 0BRANCH - "\10\00\00\00" ;; 16 - "\90\02\00\00" ;; 1+ - "\a4\04\00\00" ;; BRANCH - "\e0\ff\ff\ff" ;; -32 - "\0c\04\00\00") ;; EXIT - - ;; => 0x50 bytes - - ;; : DIGIT ( byte -- value ) - ;; DUP DUP 48 >= SWAP 57 <= AND \ Test if 0-9 - ;; 0BRANCH [24] \ Jump to A-Z test if not - ;; 48 - \ Get digit value - ;; BRANCH [64] \ Go to range check - ;; - ;; DUP DUP 65 >= SWAP 90 <= AND \ Test if A-Z - ;; 0BRANCH [60] \ Jump to invalid digit if not - ;; 55 - \ Get digit value - ;; - ;; DUP DUP 0>= SWAP BASE @ < AND \ Test if 0 <= value < BASE - ;; 0BRANCH [8] \ Jump to invalid digit if not - ;; EXIT - ;; - ;; DROP TRUE \ Return -1 for an invalid digit - ;; ; - - (data (i32.const 0x086c) - "\1c\08\00\00" - "\05DIGIT\00\00" - "\00\00\00\00" - "\08\02\00\00" ;; DUP - "\08\02\00\00" ;; DUP - "\18\04\00\00" ;; LIT - "\30\00\00\00" ;; 48 - "\38\03\00\00" ;; >= - "\28\02\00\00" ;; SWAP - "\18\04\00\00" ;; LIT - "\39\00\00\00" ;; 57 - "\2c\03\00\00" ;; <= - "\8c\03\00\00" ;; AND - "\b4\04\00\00" ;; 0BRANCH - "\18\00\00\00" ;; 24 - "\18\04\00\00" ;; LIT - "\30\00\00\00" ;; 48 - "\cc\02\00\00" ;; - - "\a4\04\00\00" ;; BRANCH - "\40\00\00\00" ;; 64 - "\08\02\00\00" ;; DUP - "\08\02\00\00" ;; DUP - "\18\04\00\00" ;; LIT - "\41\00\00\00" ;; 65 - "\38\03\00\00" ;; >= - "\28\02\00\00" ;; SWAP - "\18\04\00\00" ;; LIT - "\5a\00\00\00" ;; 90 - "\2c\03\00\00" ;; <= - "\8c\03\00\00" ;; AND - "\b4\04\00\00" ;; 0BRANCH - "\3c\00\00\00" ;; 60 - "\18\04\00\00" ;; LIT - "\37\00\00\00" ;; 55 - "\cc\02\00\00" ;; - - "\08\02\00\00" ;; DUP - "\08\02\00\00" ;; DUP - "\80\03\00\00" ;; 0>= - "\28\02\00\00" ;; SWAP - "\70\05\00\00" ;; BASE - "\cc\03\00\00" ;; @ - "\14\03\00\00" ;; < - "\8c\03\00\00" ;; AND - "\b4\04\00\00" ;; 0BRANCH - "\08\00\00\00" ;; 8 - "\0c\04\00\00" ;; EXIT - "\18\02\00\00" ;; DROP - "\34\05\00\00" ;; TRUE - "\0c\04\00\00") ;; EXIT - - ;; => 0xc8 bytes - - ;; : NEGATE INVERT 1+ ; - - (data (i32.const 0x0934) - "\6c\08\00\00" - "\06NEGATE\00" - "\00\00\00\00" - "\b4\03\00\00" ;; INVERT - "\90\02\00\00" ;; 1+ - "\0c\04\00\00") ;; EXIT - - ;; => 0x1c bytes - - ;; : NUMBER? ( len -- value TRUE | FALSE ) - ;; WORDBUF \ Initial address - ;; - ;; DUP C@ 45 = 0BRANCH [60] \ Check for minus sign - ;; 1+ \ Increment address - ;; SWAP 1- \ Decrement length - ;; DUP 0BRANCH [24] \ Check if any characters remain - ;; TRUE -ROT \ Set negate flag true - ;; SWAP BRANCH [24] \ Jump to setting initial value - ;; - ;; \ No characters after minus, exit with failure - ;; 2DROP FALSE EXIT - ;; - ;; \ No leading minus, set negate flag false - ;; FALSE -ROT - ;; - ;; \ Set initial value - ;; 0 - ;; - ;; \ Main loop - ;; OVER C@ DIGIT \ Get byte's digit value - ;; DUP 0>= 0BRANCH [68] \ Check if digit valid - ;; - ;; SWAP BASE @ * + \ Incorporate digit - ;; SWAP 1+ \ Increment address - ;; ROT 1- \ Decrement length - ;; DUP 0BRANCH [40] \ Go to end if length zero - ;; -ROT SWAP BRANCH [-88] \ Loop if characters remain - ;; - ;; \ Invalid digit - ;; 2DROP 2DROP DROP FALSE EXIT \ Exit with failure - ;; - ;; \ Reached end of word - ;; 2DROP \ Discard pointer and length - ;; SWAP 0BRANCH [8] NEGATE \ Negate if -ve flag set - ;; TRUE \ Exit with success - ;; ; - - (data (i32.const 0x0950) - "\34\09\00\00" - "\07NUMBER?" - "\00\00\00\00" - "\ac\05\00\00" ;; WORDBUF - "\08\02\00\00" ;; DUP - "\fc\03\00\00" ;; C@ - "\18\04\00\00" ;; LIT - "\2d\00\00\00" ;; 45 - "\fc\02\00\00" ;; = - "\b4\04\00\00" ;; 0BRANCH - "\3c\00\00\00" ;; 60 - "\90\02\00\00" ;; 1+ - "\28\02\00\00" ;; SWAP - "\9c\02\00\00" ;; 1- - "\08\02\00\00" ;; DUP - "\b4\04\00\00" ;; 0BRANCH - "\18\00\00\00" ;; 24 - "\34\05\00\00" ;; TRUE - "\44\02\00\00" ;; -ROT - "\28\02\00\00" ;; SWAP - "\a4\04\00\00" ;; BRANCH - "\18\00\00\00" ;; 24 - "\74\02\00\00" ;; 2DROP - "\48\05\00\00" ;; FALSE - "\0c\04\00\00" ;; EXIT - "\48\05\00\00" ;; FALSE - "\44\02\00\00" ;; -ROT - "\18\04\00\00" ;; LIT - "\00\00\00\00" ;; 0 - "\54\02\00\00" ;; OVER - "\fc\03\00\00" ;; C@ - "\78\08\00\00" ;; DIGIT - "\08\02\00\00" ;; DUP - "\80\03\00\00" ;; 0>= - "\b4\04\00\00" ;; 0BRANCH - "\44\00\00\00" ;; 68 - "\28\02\00\00" ;; SWAP - "\70\05\00\00" ;; BASE - "\cc\03\00\00" ;; @ - "\d8\02\00\00" ;; * - "\c0\02\00\00" ;; + - "\28\02\00\00" ;; SWAP - "\90\02\00\00" ;; 1+ - "\34\02\00\00" ;; ROT - "\9c\02\00\00" ;; 1- - "\08\02\00\00" ;; DUP - "\b4\04\00\00" ;; 0BRANCH - "\28\00\00\00" ;; 40 - "\44\02\00\00" ;; -ROT - "\28\02\00\00" ;; SWAP - "\a4\04\00\00" ;; BRANCH - "\a8\ff\ff\ff" ;; -88 - "\74\02\00\00" ;; 2DROP - "\74\02\00\00" ;; 2DROP - "\18\02\00\00" ;; DROP - "\48\05\00\00" ;; FALSE - "\0c\04\00\00" ;; EXIT - "\74\02\00\00" ;; 2DROP - "\28\02\00\00" ;; SWAP - "\b4\04\00\00" ;; 0BRANCH - "\08\00\00\00" ;; 8 - "\40\09\00\00" ;; NEGATE - "\34\05\00\00" ;; TRUE - "\0c\04\00\00") ;; EXIT - - ;; => 0x104 bytes - - ;; : , HERE @ ! 4 HERE +! ; - - (data (i32.const 0x0a54) - "\50\09\00\00" - "\01,\00\00" - "\00\00\00\00" - "\84\05\00\00" ;; HERE - "\cc\03\00\00" ;; @ - "\c0\03\00\00" ;; ! - "\18\04\00\00" ;; LIT - "\04\00\00\00" ;; 4 - "\84\05\00\00" ;; HERE - "\d8\03\00\00" ;; +! - "\0c\04\00\00") ;; EXIT - - ;; => 0x2c bytes - - ;; : IMMEDIATE? 4+ @ 128 AND 0BRANCH [12] TRUE EXIT FALSE ; - - (data (i32.const 0x0a80) - "\54\0a\00\00" - "\0aIMMEDIATE?\00" - "\00\00\00\00" - "\a8\02\00\00" ;; 4+ - "\cc\03\00\00" ;; @ - "\18\04\00\00" ;; LIT - "\80\00\00\00" ;; 128 - "\8c\03\00\00" ;; AND - "\b4\04\00\00" ;; 0BRANCH - "\0c\00\00\00" ;; 12 - "\34\05\00\00" ;; TRUE - "\0c\04\00\00" ;; EXIT - "\48\05\00\00" ;; FALSE - "\0c\04\00\00") ;; EXIT - - ;; => 0x40 bytes - - ;; : INTERPRET - ;; WORD \ Read a word - ;; DUP FIND \ Look it up - ;; DUP 0BRANCH [72] \ Branch to number handling if not found - ;; SWAP DROP \ Discard word length - ;; - ;; \ Handle word - ;; DUP IMMEDIATE? \ Check if the word is immediate - ;; INVERT 0BRANCH [32] \ Jump straight to executing if so - ;; STATE @ 0BRANCH [16] \ Check state - ;; >CFA , EXIT \ Compile word - ;; >CFA EXECUTE EXIT \ Execute word - ;; - ;; \ Handle number - ;; DROP \ Discard nil entry - ;; DUP NUMBER? 0BRANCH [44] \ Convert to number - ;; SWAP DROP \ Discard word length - ;; STATE @ 0BRANCH [16] \ Check state - ;; LIT-CFA , , \ If compiling, append LIT and the value - ;; EXIT - ;; - ;; \ Word was not found - ;; WNFHOOK EXECUTE - ;; ; - - (data (i32.const 0x0ac0) - "\80\0a\00\00" - "\09INTERPRET\00\00" - "\00\00\00\00" - "\74\06\00\00" ;; WORD - "\08\02\00\00" ;; DUP - "\98\07\00\00" ;; FIND - "\08\02\00\00" ;; DUP - "\b4\04\00\00" ;; 0BRANCH - "\48\00\00\00" ;; 72 - "\28\02\00\00" ;; SWAP - "\18\02\00\00" ;; DROP - "\08\02\00\00" ;; DUP - "\90\0a\00\00" ;; IMMEDIATE? - "\b4\03\00\00" ;; INVERT - "\b4\04\00\00" ;; 0BRANCH - "\20\00\00\00" ;; 32 - "\5c\05\00\00" ;; STATE - "\cc\03\00\00" ;; @ - "\b4\04\00\00" ;; 0BRANCH - "\10\00\00\00" ;; 16 - "\28\08\00\00" ;; >CFA - "\5c\0a\00\00" ;; , - "\0c\04\00\00" ;; EXIT - "\28\08\00\00" ;; >CFA - "\bc\0b\00\00" ;; EXECUTE - "\0c\04\00\00" ;; EXIT - "\18\02\00\00" ;; DROP - "\08\02\00\00" ;; DUP - "\5c\09\00\00" ;; NUMBER? - "\b4\04\00\00" ;; 0BRANCH - "\2c\00\00\00" ;; 44 - "\28\02\00\00" ;; SWAP - "\18\02\00\00" ;; DROP - "\5c\05\00\00" ;; STATE - "\cc\03\00\00" ;; @ - "\b4\04\00\00" ;; 0BRANCH - "\10\00\00\00" ;; 16 - "\00\05\00\00" ;; LIT-CFA - "\5c\0a\00\00" ;; , - "\5c\0a\00\00" ;; , - "\0c\04\00\00" ;; EXIT - "\dc\05\00\00" ;; WNFHOOK - "\bc\0b\00\00" ;; EXECUTE - "\0c\04\00\00") ;; EXIT - - ;; => 0xb8 bytes - - ;; The previous version of INTERPRET was 0xc4 bytes, so we have 12 - ;; unused bytes here. Could fit an extra codeword definition in - ;; here, if the name is less than 4 bytes long. - - ;; : QUIT R0 RSP! INTERPRET BRANCH [-8] ; - - (data (i32.const 0x0b84) - "\c0\0a\00\00" - "\04QUIT\00\00\00" - "\00\00\00\00" - "\10\05\00\00" ;; R0 - "\50\04\00\00" ;; RSP! - "\d0\0a\00\00" ;; INTERPRET - "\a4\04\00\00" ;; BRANCH - "\f8\ff\ff\ff" ;; -8 - "\0c\04\00\00") ;; EXIT - - ;; => 0x28 bytes - - ;; Cold start - - (data (i32.const 0x0bac) "\90\0b\00\00") ;; QUIT - - ;; Bro thought she didn't need EXECUTE - - (elem (i32.const 0x38) $execute) - (data (i32.const 0x0bb0) - "\84\0b\00\00" - "\07EXECUTE" - "\38\00\00\00") - - ;; Some extra codewords I forgot to define earlier - - (elem (i32.const 0x39) $atomic-store) - (data (i32.const 0x0bc0) - "\b0\0b\00\00" - "\02A!\00" - "\39\00\00\00") - - (elem (i32.const 0x3a) $atomic-fetch) - (data (i32.const 0x0bcc) - "\c0\0b\00\00" - "\02A@\00" - "\3a\00\00\00") - - (elem (i32.const 0x3b) $atomic-storebyte) - (data (i32.const 0x0bd8) - "\c0\0b\00\00" - "\03AC!" - "\3b\00\00\00") - - (elem (i32.const 0x3c) $atomic-fetchbyte) - (data (i32.const 0x0be4) - "\d8\0b\00\00" - "\03AC@" - "\3c\00\00\00") - - (elem (i32.const 0x3d) $copy) - (data (i32.const 0x0bf0) - "\e4\0b\00\00" - "\04COPY\00\00\00" - "\3d\00\00\00") - - (elem (i32.const 0x3e) $halt) - (data (i32.const 0x0c00) - "\f0\0b\00\00" - "\04HALT\00\00\00" - "\3e\00\00\00") - - ;; And now to make myself obsolete as the compiler (finally) - - ;; : [ 0 STATE ! ; IMMEDIATE - - (data (i32.const 0x0c10) - "\00\0c\00\00" - "\81[\00\00" - "\00\00\00\00" - "\18\04\00\00" ;; LIT - "\00\00\00\00" ;; 0 - "\5c\05\00\00" ;; STATE - "\c0\03\00\00" ;; ! - "\0c\04\00\00") ;; EXIT - - ;; => 0x20 bytes - - ;; : ] 1 STATE ! ; - - (data (i32.const 0x0c30) - "\10\0c\00\00" - "\01]\00\00" - "\00\00\00\00" - "\18\04\00\00" ;; LIT - "\01\00\00\00" ;; 1 - "\5c\05\00\00" ;; STATE - "\c0\03\00\00" ;; ! - "\0c\04\00\00") ;; EXIT - - ;; => 0x20 bytes - - ;; : ALIGN - ;; DUP 3 AND 0BRANCH [32] - ;; 0 OVER C! 1+ BRANCH [-48] - ;; ; - - (data (i32.const 0x0c50) - "\30\0c\00\00" - "\05ALIGN\00\00" - "\00\00\00\00" - "\08\02\00\00" ;; DUP - "\18\04\00\00" ;; LIT - "\03\00\00\00" ;; 3 - "\8c\03\00\00" ;; AND - "\b4\04\00\00" ;; 0BRANCH - "\20\00\00\00" ;; 32 - "\18\04\00\00" ;; LIT - "\00\00\00\00" ;; 0 - "\54\02\00\00" ;; OVER - "\f0\03\00\00" ;; C! - "\90\02\00\00" ;; 1+ - "\a4\04\00\00" ;; BRANCH - "\d0\ff\ff\ff" ;; -48 - "\0c\04\00\00") ;; EXIT - - ;; => 0x48 bytes - - ;; : HIDDEN 4+ DUP C@ 32 XOR SWAP C! ; - - (data (i32.const 0x0c98) - "\50\0c\00\00" - "\06HIDDEN\00" - "\00\00\00\00" - "\a8\02\00\00" ;; 4+ - "\08\02\00\00" ;; DUP - "\fc\03\00\00" ;; C@ - "\18\04\00\00" ;; LIT - "\20\00\00\00" ;; 32 - "\a4\03\00\00" ;; XOR - "\28\02\00\00" ;; SWAP - "\f0\03\00\00" ;; C! - "\0c\04\00\00") ;; EXIT - - ;; => 0x34 bytes - - ;; : IMMEDIATE - ;; LATEST @ - ;; 4+ DUP C@ 128 XOR SWAP C! - ;; ; IMMEDIATE - - (data (i32.const 0x0ccc) - "\98\0c\00\00" - "\89IMMEDIATE\00\00" - "\00\00\00\00" - "\98\05\00\00" ;; LATEST - "\cc\03\00\00" ;; @ - "\a8\02\00\00" ;; 4+ - "\08\02\00\00" ;; DUP - "\fc\03\00\00" ;; C@ - "\18\04\00\00" ;; LIT - "\80\00\00\00" ;; 128 - "\a4\03\00\00" ;; XOR - "\28\02\00\00" ;; SWAP - "\f0\03\00\00" ;; C! - "\0c\04\00\00") ;; EXIT - - ;; => 0x40 bytes - - ;; : CREATE - ;; HERE @ \ Get initial address - ;; LATEST @ OVER ! 4+ \ Write link - ;; 2DUP C! 1+ \ Write length - ;; 2DUP WORDBUF SWAP COPY + \ Write name - ;; ALIGN \ Pad to alignment - ;; - ;; HERE @ LATEST ! \ Update LATEST - ;; HERE ! \ Update HERE - ;; ; - - (data (i32.const 0x0d0c) - "\cc\0c\00\00" - "\06CREATE\00" - "\00\00\00\00" - "\84\05\00\00" ;; HERE - "\cc\03\00\00" ;; @ - "\98\05\00\00" ;; LATEST - "\cc\03\00\00" ;; @ - "\54\02\00\00" ;; OVER - "\c0\03\00\00" ;; ! - "\a8\02\00\00" ;; 4+ - "\64\02\00\00" ;; 2DUP - "\f0\03\00\00" ;; C! - "\90\02\00\00" ;; 1+ - "\64\02\00\00" ;; 2DUP - "\ac\05\00\00" ;; WORDBUF - "\28\02\00\00" ;; SWAP - "\fc\0b\00\00" ;; COPY - "\c0\02\00\00" ;; + - "\5c\0c\00\00" ;; ALIGN - "\84\05\00\00" ;; HERE - "\cc\03\00\00" ;; @ - "\98\05\00\00" ;; LATEST - "\c0\03\00\00" ;; ! - "\84\05\00\00" ;; HERE - "\c0\03\00\00" ;; ! - "\0c\04\00\00") ;; EXIT - - ;; => 0x6c bytes - - ;; : : - ;; WORD - ;; CREATE - ;; DOCOL , - ;; LATEST @ HIDDEN - ;; ] - ;; ; - - (data (i32.const 0x0d78) - "\0c\0d\00\00" - "\01:\00\00" - "\00\00\00\00" - "\74\06\00\00" ;; WORD - "\18\0d\00\00" ;; CREATE - "\c4\04\00\00" ;; DOCOL - "\5c\0a\00\00" ;; , - "\98\05\00\00" ;; LATEST - "\cc\03\00\00" ;; @ - "\a4\0c\00\00" ;; HIDDEN - "\38\0c\00\00" ;; ] - "\0c\04\00\00") ;; EXIT - - ;; => 0x30 bytes - - ;; : ; - ;; LIT EXIT , - ;; LATEST @ HIDDEN - ;; [ - ;; ; IMMEDIATE - - (data (i32.const 0x0db4) - "\78\0d\00\00" - "\81;\00\00" - "\00\00\00\00" - "\18\04\00\00" ;; LIT - "\0c\04\00\00" ;; EXIT - "\5c\0a\00\00" ;; , - "\98\05\00\00" ;; LATEST - "\cc\03\00\00" ;; @ - "\a4\0c\00\00" ;; HIDDEN - "\18\0c\00\00" ;; [ - "\0c\04\00\00") ;; EXIT - - ;; => 0x2c bytes - - ;; : WNF-HANDLER - ;; DROP \ Discard word length - ;; 87 EMIT 78 EMIT 70 EMIT 10 EMIT \ Print WNF - ;; QUIT \ Reset return stack - ;; ; - - (data (i32.const 0x0de0) - "\b4\0d\00\00" - "\0bWNF-HANDLER" - "\00\00\00\00" - "\18\02\00\00" ;; DROP - "\18\04\00\00" ;; LIT - "\57\00\00\00" ;; 87 - "\94\04\00\00" ;; EMIT - "\18\04\00\00" ;; LIT - "\4e\00\00\00" ;; 78 - "\94\04\00\00" ;; EMIT - "\18\04\00\00" ;; LIT - "\46\00\00\00" ;; 70 - "\94\04\00\00" ;; EMIT - "\18\04\00\00" ;; LIT - "\0a\00\00\00" ;; 10 - "\94\04\00\00" ;; EMIT - "\90\0b\00\00" ;; QUIT - "\0c\04\00\00") ;; EXIT - - ;; => 0x50 bytes - - ;; : FIND-NAME-LEN 4+ C@ 63 AND ; - - ;; The 0x3f mask we use here includes the hidden flag, so that FIND - ;; never matches a hidden entry as its length will appear to be - ;; greater than the maximum length returned by WORD. - - (data (i32.const 0x0e30) - "\e0\0d\00\00" - "\0dFIND-NAME-LEN\00\00" - "\00\00\00\00" - "\a8\02\00\00" ;; 4+ - "\fc\03\00\00" ;; C@ - "\18\04\00\00" ;; LIT - "\3f\00\00\00" ;; 63 - "\8c\03\00\00" ;; AND - "\0c\04\00\00") ;; EXIT - - ;; => 0x30 bytes - - ;; The trampoline is a workaround for WebAssembly's lack of indirect - ;; jumps and code addresses. Instead of jumping into the next - ;; codeword, NEXT sets the $fn global to the function index of the - ;; next codeword and returns to the trampoline. - ;; - ;; This way, we can simulate jumping to the code within WebAssembly's - ;; restrictions without the WebAssembly call stack growing unbounded - ;; as would happen if we used call_indirect inside NEXT. - - (func $trampoline - loop $loop - global.get $fn call_indirect (type $codeword) - global.get $run br_if $loop - end) - - (func (export "reset") - i32.const 0x10000 global.set $rsp ;; Set the return stack pointer - i32.const 0xf000 global.set $sp ;; Set the stack pointer - i32.const 0x0bac global.set $ip ;; Set the IP to the cold start - call $next - - i32.const 1 global.set $run - call $trampoline)) diff --git a/wipforth.ws b/wipforth.ws new file mode 100644 index 0000000..2e84e8b --- /dev/null +++ b/wipforth.ws @@ -0,0 +1,2088 @@ +.mem main 1 1 shared +.import main "emu" "mem" + +;; Peripheral registers +.def TXBUF 00h +.def RXBUF 20h +.def TXHEAD 40h +.def TXTAIL 44h +.def RXHEAD 48h +.def RXTAIL 4Ch + +.def DICT_START 0200h + +.def RSP_INIT 10000h +.def SP_INIT F000h + +;; Forth registers +.global rsp i32 +.global sp i32 +.global ip i32 +.global cfa i32 +.global fn i32 + +;; Trampoline control flag +.global run i32 0 + +;; Some little helper functions + +.func push +.param x i32 + global.get sp + i32.const 4 + i32.sub + global.set sp + + global.get sp + local.get x + i32.store 2 0 + +.func pop +.result i32 + global.get sp + i32.load 2 0 + + global.get sp + i32.const 4 + i32.add + global.set sp + +.func pushrsp +.param x i32 + global.get rsp + i32.const 4 + i32.sub + global.set rsp + + global.get rsp + local.get x + i32.store 2 0 + +.func poprsp +.result i32 + global.get rsp + i32.load 2 0 + + global.get rsp + i32.const 4 + i32.add + global.set rsp + +;; The rather bizzare nature of WebAssembly means that we can't +;; actually jump to code, which makes this NEXT implemenation somewhat +;; strange. Instead of doing the jump here, we store the function +;; index (seemingly the closest you can get to a code address in +;; WebAssembly) in the fn global and return. It's then down to the +;; trampoline loop to actually run the codeword. + +.func next + global.get ip + global.get ip + + i32.const 4 + i32.add + global.set ip + + i32.load 2 0 + global.set cfa + global.get cfa + i32.load 2 0 + global.set fn + +;; The codewords function table must contain every codeword we want to +;; be able to run, as it's indices into this table that can be ran +;; with call_indirect in the $trampoline loop. + +.type codeword result +.table codewords 100 + +;; Our special inner interpreters <3 + +.func docol +.elem codewords docol DOCOL_CODEWORD + global.get ip + call pushrsp + + global.get cfa + i32.const 4 + i32.add + global.set ip + + call next + +.func doval +.elem codewords doval DOVAL_CODEWORD + global.get cfa + i32.const 4 + i32.add + i32.load 2 0 + call push + call next + +.func dovar +.elem codewords dovar DOVAR_CODEWORD + global.get cfa + i32.const 4 + i32.add + call push + call next + +;; Codewords! +;; +;; Most of these are implemented here (as opposed to in the forth +;; itself) for performance rather than necessity. + +;; Stack manipulation + +.func dup +.elem codewords dup DUP_CODEWORD + global.get sp + i32.load 2 0 + call push + call next + +.func drop +.elem codewords drop DROP_CODEWORD + global.get sp + i32.const 4 + i32.add + global.set sp + call next + +.func swap +.elem codewords swap SWAP_CODEWORD + global.get sp + i32.const 4 + i32.add + global.get sp + i32.load 2 0 + + global.get sp + global.get sp + i32.const 4 + i32.add + i32.load 2 0 + + i32.store 2 0 + i32.store 2 0 + + call next + +.func rot +.elem codewords rot ROT_CODEWORD + global.get sp + i32.const 4 + i32.add + global.get sp + i32.load 2 0 + + global.get sp + i32.const 8 + i32.add + global.get sp + i32.const 4 + i32.add + i32.load 2 0 + + global.get sp + global.get sp + i32.const 8 + i32.add + i32.load 2 0 + + i32.store 2 0 + i32.store 2 0 + i32.store 2 0 + + call next + +.func nrot +.elem codewords nrot NROT_CODEWORD + global.get sp + i32.const 8 + i32.add + global.get sp + i32.load 2 0 + + global.get sp + global.get sp + i32.const 4 + i32.add + i32.load 2 0 + + global.get sp + i32.const 4 + i32.add + global.get sp + i32.const 8 + i32.add + i32.load 2 0 + + i32.store 2 0 + i32.store 2 0 + i32.store 2 0 + + call next + +.func over +.elem codewords over OVER_CODEWORD + global.get sp + i32.const 4 + i32.add + i32.load 2 0 + call push + call next + +.func twodup +.elem codewords twodup TWODUP_CODEWORD + global.get sp i32.load 2 0 + global.get sp i32.const 4 i32.add i32.load 2 0 + call push + call push + call next + +.func twodrop +.elem codewords twodrop TWODROP_CODEWORD + global.get sp + i32.const 8 + i32.add + global.set sp + call next + +.func twoswap +.elem codewords twoswap TWOSWAP_CODEWORD + global.get sp + i32.const 8 + i32.add + global.get sp + i32.load 2 0 + + global.get sp + i32.const 12 + i32.add + global.get sp + i32.const 4 + i32.add + i32.load 2 0 + + global.get sp + global.get sp + i32.const 8 + i32.add + i32.load 2 0 + + global.get sp + i32.const 4 + i32.add + global.get sp + i32.const 12 + i32.add + i32.load 2 0 + + i32.store 2 0 + i32.store 2 0 + i32.store 2 0 + i32.store 2 0 + + call next + +;; Arithmetic and logic + +.func inc +.elem codewords inc INC_CODEWORD + global.get sp + global.get sp + i32.load 2 0 + i32.const 1 + i32.add + i32.store 2 0 + call next + +.func dec +.elem codewords dec DEC_CODEWORD + global.get sp + global.get sp + i32.load 2 0 + i32.const 1 + i32.sub + i32.store 2 0 + call next + +.func inc4 +.elem codewords inc4 INC4_CODEWORD + global.get sp + global.get sp + i32.load 2 0 + i32.const 4 + i32.add + i32.store 2 0 + call next + +.func dec4 +.elem codewords dec4 DEC4_CODEWORD + global.get sp + global.get sp + i32.load 2 0 + i32.const 4 + i32.sub + i32.store 2 0 + call next + +.func add +.elem codewords add ADD_CODEWORD + call pop + call pop + i32.add + call push + call next + +.func sub +.elem codewords sub SUB_CODEWORD +.local tmp i32 + call pop + local.set tmp + call pop + local.get tmp + i32.sub + call push + call next + +.func mul +.elem codewords mul MUL_CODEWORD + call pop + call pop + i32.mul + call push + call next + +.func div +.elem codewords div DIV_CODEWORD +.local tmp i32 + call pop + local.set tmp + call pop + local.get tmp + i32.div_s + call push + call next + +.func mod +.elem codewords mod MOD_CODEWORD +.local tmp i32 + call pop + local.set tmp + call pop + local.get tmp + i32.rem_s + call push + call next + +.func eq +.elem codewords eq EQ_CODEWORD + call pop + call pop + i32.eq + i32.const 0 i32.sub + call push + call next + +.func neq +.elem codewords neq NEQ_CODEWORD + call pop + call pop + i32.ne + i32.const 0 i32.sub + call push + call next + +.func lt +.elem codewords lt LT_CODEWORD +.local tmp i32 + call pop + local.set tmp + call pop + local.get tmp + i32.lt_s + i32.const 0 i32.sub + call push + call next + +.func gt +.elem codewords gt GT_CODEWORD +.local tmp i32 + call pop + local.set tmp + call pop + local.get tmp + i32.gt_s + i32.const 0 i32.sub + call push + call next + +.func lte +.elem codewords lte LTE_CODEWORD +.local tmp i32 + call pop + local.set tmp + call pop + local.get tmp + i32.le_s + i32.const 0 i32.sub + call push + call next + +.func gte +.elem codewords gte GTE_CODEWORD +.local tmp i32 + call pop + local.set tmp + call pop + local.get tmp + i32.ge_s + i32.const 0 i32.sub + call push + call next + +.func zeq +.elem codewords zeq ZEQ_CODEWORD + call pop + i32.eqz + i32.const 0 i32.sub + call push + call next + +.func zneq +.elem codewords zneq ZNEQ_CODEWORD + call pop + i32.const 0 + i32.ne + i32.const 0 i32.sub + call push + call next + +.func zlt +.elem codewords zlt ZLT_CODEWORD + call pop + i32.const 0 + i32.lt_s + i32.const 0 i32.sub + call push + call next + +.func zgt +.elem codewords zgt ZGT_CODEWORD + call pop + i32.const 0 + i32.gt_s + i32.const 0 i32.sub + call push + call next + +.func zlte +.elem codewords zlte ZLTE_CODEWORD + call pop + i32.const 0 + i32.le_s + i32.const 0 i32.sub + call push + call next + +.func zgte +.elem codewords zgte ZGTE_CODEWORD + call pop + i32.const 0 + i32.ge_s + i32.const 0 i32.sub + call push + call next + +.func and +.elem codewords and AND_CODEWORD + call pop + call pop + i32.and + call push + call next + +.func or +.elem codewords or OR_CODEWORD + call pop + call pop + i32.or + call push + call next + +.func xor +.elem codewords xor XOR_CODEWORD + call pop + call pop + i32.xor + call push + call next + +.func invert +.elem codewords invert INVERT_CODEWORD + call pop + i32.const FFFFFFFFh + i32.xor + call push + call next + +;; Memory + +.func store +.elem codewords store STORE_CODEWORD + call pop + call pop + i32.store 2 0 + call next + +.func fetch +.elem codewords fetch FETCH_CODEWORD + call pop + i32.load 2 0 + call push + call next + +.func addstore +.elem codewords addstore ADDSTORE_CODEWORD +.local tmp i32 + call pop + local.tee tmp + local.get tmp + i32.load 2 0 + call pop + i32.add + i32.store 2 0 + call next + +.func substore +.elem codewords substore SUBSTORE_CODEWORD +.local tmp i32 + call pop + local.tee tmp + local.get tmp + i32.load 2 0 + call pop + i32.sub + i32.store 2 0 + call next + +.func storebyte +.elem codewords storebyte STOREBYTE_CODEWORD + call pop + call pop + i32.store8 0 0 + call next + +.func fetchbyte +.elem codewords fetchbyte FETCHBYTE_CODEWORD + call pop + i32.load8_u 0 0 + call push + call next + +.func atomic-store +.elem codewords atomic-store ATOMIC_STORE_CODEWORD + call pop + call pop + i32.atomic.store 2 0 + call next + +.func atomic-fetch +.elem codewords atomic-fetch ATOMIC_FETCH_CODEWORD + call pop + i32.atomic.load 2 0 + call push + call next + +.func atomic-storebyte +.elem codewords atomic-storebyte ATOMIC_STOREBYTE_CODEWORD + call pop + call pop + i32.atomic.store8 0 0 + call next + +.func atomic-fetchbyte +.elem codewords atomic-fetchbyte ATOMIC_FETCHBYTE_CODEWORD + call pop + i32.atomic.load8_u 0 0 + call push + call next + +.func copy +.elem codewords copy COPY_CODEWORD +.local src i32 dst i32 n i32 + call pop local.set dst + call pop local.set src + call pop local.set n + block done + loop iter + local.get n + i32.eqz br_if done + + local.get dst + local.get src + i32.load8_u 0 0 + i32.store8 0 0 + + local.get dst i32.const 1 i32.add local.set dst + local.get src i32.const 1 i32.add local.set src + local.get n i32.const 1 i32.sub local.set n + + br iter + end + end + call next + +;; Core utility words + +.func exit +.elem codewords exit EXIT_CODEWORD + call poprsp + global.set ip + call next + +.func lit +.elem codewords lit LIT_CODEWORD + global.get ip + i32.load 2 0 + call push + global.get ip + i32.const 4 + i32.add + global.set ip + call next + +.func execute +.elem codewords execute EXECUTE_CODEWORD + call pop + global.set cfa + global.get cfa + i32.load 2 0 + global.set fn + +.func halt +.elem codewords halt HALT_CODEWORD + i32.const 0 + global.set run + +;; Return and parameter stack primitives + +.func tor +.elem codewords tor TOR_CODEWORD + call pop + call pushrsp + call next + +.func fromr +.elem codewords fromr FROMR_CODEWORD + call poprsp + call push + call next + +.func rspfetch +.elem codewords rspfetch RSPFETCH_CODEWORD + + global.get rsp + call push + call next + +.func rspstore +.elem codewords rspstore RSPSTORE_CODEWORD + call pop + global.set rsp + call next + +.func rdrop +.elem codewords rdrop RDROP_CODEWORD + global.get rsp + i32.const 4 + i32.add + global.set rsp + call next + +.func spfetch +.elem codewords spfetch SPFETCH_CODEWORD + global.get sp + call push + call next + +.func spstore +.elem codewords spstore SPSTORE_CODEWORD + call pop + global.set sp + call next + +;; Serial I/O + +.func key +.elem codewords key KEY_CODEWORD +.local head i32 + i32.const RXHEAD + i32.atomic.load8_u 0 0 + local.set head + + ;; Wait for RXBUF to be non-empty + loop wait + local.get head + + i32.const RXTAIL + i32.atomic.load8_u 0 0 + i32.eq + if + i32.const RXTAIL + local.get head + i64.const -1 + memory.atomic.wait32 2 0 + + br wait + end + end + + ;; Read byte at head position + i32.const RXBUF + local.get head + i32.add + i32.load8_u 0 0 + call push + + ;; Advance RXHEAD + i32.const RXHEAD + local.get head + i32.const 1 + i32.add + i32.const 1Fh + i32.and + i32.atomic.store8 0 0 + + call next + +.func emit +.elem codewords emit EMIT_CODEWORD +.local tail i32 n i32 + ;; Wait for TXBUF to be non-full + loop wait + i32.const TXTAIL + i32.atomic.load8_u 0 0 + local.tee tail + i32.const 1 + i32.add + i32.const 1Fh + i32.and + local.tee n + i32.const TXHEAD + i32.atomic.load8_u 0 0 + i32.eq + br_if wait + end + + ;; Write byte at tail position + i32.const TXBUF + local.get tail + i32.add + call pop + i32.store8 0 0 + + ;; Advance TXTAIL + i32.const TXTAIL + local.get n + i32.atomic.store8 0 0 + + call next + +;; Branching + +.func branch +.elem codewords branch BRANCH_CODEWORD + global.get ip + i32.load 2 0 + global.get ip + i32.add + global.set ip + call next + +.func zbranch +.elem codewords zbranch ZBRANCH_CODEWORD + call pop + if _ i32 + i32.const 4 + else + global.get ip + i32.load 2 0 + end + global.get ip + i32.add + global.set ip + call next + +;; Dictionary time :D + +.at main DICT_START +.def PREV 0 + +_DUP: + .word PREV + .byte 3 + .utf8 "DUP" + .align +DUP: + .word DUP_CODEWORD +.def PREV _DUP + +_DROP: + .word PREV + .byte 4 + .utf8 "DROP" + .align +DROP: + .word DROP_CODEWORD +.def PREV _DROP + +_SWAP: + .word PREV + .byte 4 + .utf8 "SWAP" + .align +SWAP: + .word SWAP_CODEWORD +.def PREV _SWAP + +_ROT: + .word PREV + .byte 3 + .utf8 "ROT" + .align +ROT: + .word ROT_CODEWORD +.def PREV _ROT + +_NROT: + .word PREV + .byte 4 + .utf8 "-ROT" + .align +NROT: + .word NROT_CODEWORD +.def PREV _NROT + +_OVER: + .word PREV + .byte 4 + .utf8 "OVER" + .align +OVER: + .word OVER_CODEWORD +.def PREV _OVER + +_TWODUP: + .word PREV + .byte 4 + .utf8 "2DUP" + .align +TWODUP: + .word TWODUP_CODEWORD +.def PREV _TWODUP + +_TWODROP: + .word PREV + .byte 5 + .utf8 "2DROP" + .align +TWODROP: + .word TWODROP_CODEWORD +.def PREV _TWODROP + +_TWOSWAP: + .word PREV + .byte 5 + .utf8 "2SWAP" + .align +TWOSWAP: + .word TWOSWAP_CODEWORD +.def PREV _TWOSWAP + +_INC: + .word PREV + .byte 2 + .utf8 "1+" + .align +INC: + .word INC_CODEWORD +.def PREV _INC + +_DEC: + .word PREV + .byte 2 + .utf8 "1-" + .align +DEC: + .word DEC_CODEWORD +.def PREV _DEC + +_INC4: + .word PREV + .byte 2 + .utf8 "4+" + .align +INC4: + .word INC4_CODEWORD +.def PREV _INC4 + +_DEC4: + .word PREV + .byte 2 + .utf8 "4-" + .align +DEC4: + .word DEC4_CODEWORD +.def PREV _DEC4 + +_ADD: + .word PREV + .byte 1 + .utf8 "+" + .align +ADD: + .word ADD_CODEWORD +.def PREV _ADD + +_SUB: + .word PREV + .byte 1 + .utf8 "-" + .align +SUB: + .word SUB_CODEWORD +.def PREV _SUB + +_MUL: + .word PREV + .byte 1 + .utf8 "*" + .align +MUL: + .word MUL_CODEWORD +.def PREV _MUL + +_DIV: + .word PREV + .byte 1 + .utf8 "/" + .align +DIV: + .word DIV_CODEWORD +.def PREV _DIV + +_MOD: + .word PREV + .byte 3 + .utf8 "MOD" + .align +MOD: + .word MOD_CODEWORD +.def PREV _MOD + +_EQ: + .word PREV + .byte 1 + .utf8 "=" + .align +EQ: + .word EQ_CODEWORD +.def PREV _EQ + +_NEQ: + .word PREV + .byte 2 + .utf8 "<>" + .align +NEQ: + .word NEQ_CODEWORD +.def PREV _NEQ + +_LT: + .word PREV + .byte 1 + .utf8 "<" + .align +LT: + .word LT_CODEWORD +.def PREV _LT + +_GT: + .word PREV + .byte 1 + .utf8 ">" + .align +GT: + .word GT_CODEWORD +.def PREV _GT + +_LTE: + .word PREV + .byte 2 + .utf8 "<=" + .align +LTE: + .word LTE_CODEWORD +.def PREV _LTE + +_GTE: + .word PREV + .byte 2 + .utf8 ">=" + .align +GTE: + .word GTE_CODEWORD +.def PREV _GTE + +_ZEQ: + .word PREV + .byte 2 + .utf8 "0=" + .align +ZEQ: + .word ZEQ_CODEWORD +.def PREV _ZEQ + +_ZNEQ: + .word PREV + .byte 3 + .utf8 "0<>" + .align +ZNEQ: + .word ZNEQ_CODEWORD +.def PREV _ZNEQ + +_ZLT: + .word PREV + .byte 2 + .utf8 "0<" + .align +ZLT: + .word ZLT_CODEWORD +.def PREV _ZLT + +_ZGT: + .word PREV + .byte 2 + .utf8 "0>" + .align +ZGT: + .word ZGT_CODEWORD +.def PREV _ZGT + +_ZLTE: + .word PREV + .byte 3 + .utf8 "0<=" + .align +ZLTE: + .word ZLTE_CODEWORD +.def PREV _ZLTE + +_ZGTE: + .word PREV + .byte 3 + .utf8 "0>=" + .align +ZGTE: + .word ZGTE_CODEWORD +.def PREV _ZGTE + +_AND: + .word PREV + .byte 3 + .utf8 "AND" + .align +AND: + .word AND_CODEWORD +.def PREV _AND + +_OR: + .word PREV + .byte 2 + .utf8 "OR" + .align +OR: + .word OR_CODEWORD +.def PREV _OR + +_XOR: + .word PREV + .byte 3 + .utf8 "XOR" + .align +XOR: + .word XOR_CODEWORD +.def PREV _XOR + +_INVERT: + .word PREV + .byte 6 + .utf8 "INVERT" + .align +INVERT: + .word INVERT_CODEWORD +.def PREV _INVERT + +_STORE: + .word PREV + .byte 1 + .utf8 "!" + .align +STORE: + .word STORE_CODEWORD +.def PREV _STORE + +_FETCH: + .word PREV + .byte 1 + .utf8 "@" + .align +FETCH: + .word FETCH_CODEWORD +.def PREV _FETCH + +_ADDSTORE: + .word PREV + .byte 2 + .utf8 "+!" + .align +ADDSTORE: + .word ADDSTORE_CODEWORD +.def PREV _ADDSTORE + +_SUBSTORE: + .word PREV + .byte 2 + .utf8 "-!" + .align +SUBSTORE: + .word SUBSTORE_CODEWORD +.def PREV _SUBSTORE + +_STOREBYTE: + .word PREV + .byte 2 + .utf8 "C!" + .align +STOREBYTE: + .word STOREBYTE_CODEWORD +.def PREV _STOREBYTE + +_FETCHBYTE: + .word PREV + .byte 2 + .utf8 "C@" + .align +FETCHBYTE: + .word FETCHBYTE_CODEWORD +.def PREV _FETCHBYTE + +_ATOMIC_STORE: + .word PREV + .byte 2 + .utf8 "A!" + .align +ATOMIC_STORE: + .word ATOMIC_STORE_CODEWORD +.def PREV _ATOMIC_STORE + +_ATOMIC_FETCH: + .word PREV + .byte 2 + .utf8 "A@" + .align +ATOMIC_FETCH: + .word ATOMIC_FETCH_CODEWORD +.def PREV _ATOMIC_FETCH + +_ATOMIC_STOREBYTE: + .word PREV + .byte 3 + .utf8 "AC!" + .align +ATOMIC_STOREBYTE: + .word ATOMIC_STOREBYTE_CODEWORD +.def PREV _ATOMIC_STOREBYTE + +_ATOMIC_FETCHBYTE: + .word PREV + .byte 3 + .utf8 "AC@" + .align +ATOMIC_FETCHBYTE: + .word ATOMIC_FETCHBYTE_CODEWORD +.def PREV _ATOMIC_FETCHBYTE + +_COPY: + .word PREV + .byte 4 + .utf8 "COPY" + .align +COPY: + .word COPY_CODEWORD +.def PREV _COPY + +_EXIT: + .word PREV + .byte 4 + .utf8 "EXIT" + .align +EXIT: + .word EXIT_CODEWORD +.def PREV _EXIT + +_LIT: + .word PREV + .byte 3 + .utf8 "LIT" + .align +LIT: + .word LIT_CODEWORD +.def PREV _LIT + +_EXECUTE: + .word PREV + .byte 7 + .utf8 "EXECUTE" + .align +EXECUTE: + .word EXECUTE_CODEWORD +.def PREV _EXECUTE + +_HALT: + .word PREV + .byte 4 + .utf8 "HALT" + .align +HALT: + .word HALT_CODEWORD +.def PREV _HALT + +_TOR: + .word PREV + .byte 2 + .utf8 ">R" + .align +TOR: + .word TOR_CODEWORD +.def PREV _TOR + +_FROMR: + .word PREV + .byte 2 + .utf8 "R>" + .align +FROMR: + .word FROMR_CODEWORD +.def PREV _FROMR + +_RSPFETCH: + .word PREV + .byte 4 + .utf8 "RSP@" + .align +RSPFETCH: + .word RSPFETCH_CODEWORD +.def PREV _RSPFETCH + +_RSPSTORE: + .word PREV + .byte 4 + .utf8 "RSP!" + .align +RSPSTORE: + .word RSPSTORE_CODEWORD +.def PREV _RSPSTORE + +_RDROP: + .word PREV + .byte 5 + .utf8 "RDROP" + .align +RDROP: + .word RDROP_CODEWORD +.def PREV _RDROP + +_SPFETCH: + .word PREV + .byte 3 + .utf8 "SP@" + .align +SPFETCH: + .word SPFETCH_CODEWORD +.def PREV _SPFETCH + +_SPSTORE: + .word PREV + .byte 3 + .utf8 "SP!" + .align +SPSTORE: + .word SPSTORE_CODEWORD +.def PREV _SPSTORE + +_KEY: + .word PREV + .byte 3 + .utf8 "KEY" + .align +KEY: + .word KEY_CODEWORD +.def PREV _KEY + +_EMIT: + .word PREV + .byte 4 + .utf8 "EMIT" + .align +EMIT: + .word EMIT_CODEWORD +.def PREV _EMIT + +_BRANCH: + .word PREV + .byte 6 + .utf8 "BRANCH" + .align +BRANCH: + .word BRANCH_CODEWORD +.def PREV _BRANCH + +_ZBRANCH: + .word PREV + .byte 7 + .utf8 "0BRANCH" + .align +ZBRANCH: + .word ZBRANCH_CODEWORD +.def PREV _ZBRANCH + +;; Built-in values and variables + +_DOCOL: + .word PREV + .byte 5 + .utf8 "DOCOL" + .align +DOCOL: + .word DOVAL_CODEWORD + .word DOCOL_CODEWORD +.def PREV _DOCOL + +_DOVAL: + .word PREV + .byte 5 + .utf8 "DOVAL" + .align +DOVAL: + .word DOVAL_CODEWORD + .word DOVAL_CODEWORD +.def PREV _DOVAL + +_DOVAR: + .word PREV + .byte 5 + .utf8 "DOVAR" + .align +DOVAR: + .word DOVAL_CODEWORD + .word DOVAR_CODEWORD +.def PREV _DOVAR + +_R0: + .word PREV + .byte 2 + .utf8 "R0" + .align +R0: + .word DOVAL_CODEWORD + .word RSP_INIT +.def PREV _R0 + +_S0: + .word PREV + .byte 2 + .utf8 "S0" + .align +S0: + .word DOVAL_CODEWORD + .word SP_INIT +.def PREV _S0 + +_FALSE: + .word PREV + .byte 5 + .utf8 "FALSE" + .align +FALSE: + .word DOVAL_CODEWORD + .word 0 +.def PREV _FALSE + +_TRUE: + .word PREV + .byte 4 + .utf8 "TRUE" + .align +TRUE: + .word DOVAL_CODEWORD + .word FFFFFFFFh +.def PREV _TRUE + +_STATE: + .word PREV + .byte 5 + .utf8 "STATE" + .align +STATE: + .word DOVAR_CODEWORD + .word 0 +.def PREV _STATE + +_BASE: + .word PREV + .byte 4 + .utf8 "BASE" + .align +BASE: + .word DOVAR_CODEWORD + .word 10 +.def PREV _BASE + +_HERE: + .word PREV + .byte 4 + .utf8 "HERE" + .align +HERE: + .word DOVAR_CODEWORD + .word KERNEL_DEFS_END +.def PREV _HERE + +_LATEST: + .word PREV + .byte 6 + .utf8 "LATEST" + .align +LATEST: + .word DOVAR_CODEWORD + .word KERNEL_DEFS_LAST +.def PREV _LATEST + +_WORDBUF: + .word PREV + .byte 7 + .utf8 "WORDBUF" + .align +WORDBUF: + .word DOVAR_CODEWORD + .zero 20h +.def PREV _WORDBUF + +_WNFHOOK: + .word PREV + .byte 7 + .utf8 "WNFHOOK" + .align +WNFHOOK: + .word DOVAL_CODEWORD + .word WNF_HANDLER +.def PREV _WNFHOOK + +;; And now, it's time for some colon words! + +;; : TUCK DUP -ROT ; + +_TUCK: + .word PREV + .byte 4 + .utf8 "TUCK" + .align +TUCK: + .word DOCOL_CODEWORD + .word DUP NROT + .word EXIT +.def PREV _TUCK + +;; : NSPACE ( byte -- bool ) +;; DUP 9 <> SWAP \ Compare to horizontal tab +;; DUP 10 <> SWAP \ Compare to line-feed +;; DUP 13 <> SWAP \ Compare to carriage return +;; 32 <> \ Compare to space +;; AND AND AND \ And all results together +;; ; + +_NSPACE: + .word PREV + .byte 6 + .utf8 "NSPACE" + .align +NSPACE: + .word DOCOL_CODEWORD + .word DUP LIT 9 NEQ SWAP + .word DUP LIT 10 NEQ SWAP + .word DUP LIT 13 NEQ SWAP + .word LIT 32 NEQ + .word AND AND AND + .word EXIT +.def PREV _NSPACE + +;; : WORD ( -- len ) +;; 0 \ Initial length +;; +;; KEY \ Get byte from input +;; TUCK NSPACE 0BRANCH [60] \ Check if whitespace +;; TUCK WORDBUF + C! \ Append byte to WORDBUF +;; 1+ \ Increment length +;; DUP 32 >= 0BRANCH [8] EXIT \ Exit if at max length +;; BRANCH [-72] \ Loop back to KEY +;; +;; \ Byte is whitespace +;; SWAP DROP +;; DUP 0<> 0BRANCH [-96] \ Loop back to KEY if zero length +;; ; + +_WORD: + .word PREV + .byte 4 + .utf8 "WORD" + .align +WORD: + .word DOCOL_CODEWORD + .word LIT 0 + .word KEY + .word TUCK NSPACE ZBRANCH 60 + .word TUCK WORDBUF ADD STOREBYTE + .word INC + .word DUP LIT 32 GTE ZBRANCH 8 EXIT + .word BRANCH -72 + .word SWAP DROP + .word DUP ZNEQ ZBRANCH -96 + .word EXIT +.def PREV _WORD + +;; : STRING= ( len str1 str2 -- bool ) +;; 2DUP C@ SWAP C@ \ Load a byte from each address +;; = 0BRANCH [48] \ Check for byte mismatch +;; 1+ -ROT 1+ -ROT 1- \ Increment addresses, decrement length +;; DUP 0BRANCH [32] \ Check for zero remaining bytes +;; -ROT BRANCH [-68] \ Loop +;; +;; 2DROP DROP FALSE EXIT \ Strings not equal +;; 2DROP DROP TRUE \ Strings equal +;; ; + +_STRINGEQ: + .word PREV + .byte 7 + .utf8 "STRING=" + .align +STRINGEQ: + .word DOCOL_CODEWORD + .word TWODUP FETCHBYTE SWAP FETCHBYTE + .word EQ ZBRANCH 48 + .word INC NROT INC NROT DEC + .word DUP ZBRANCH 32 + .word NROT BRANCH -68 + .word TWODROP DROP FALSE EXIT + .word TWODROP DROP TRUE + .word EXIT +.def PREV _STRINGEQ + +;; : FIND-NAME-LEN 4+ C@ 63 AND ; + +;; The 3Fh mask we use here includes the hidden flag, so that FIND +;; never matches a hidden entry as its length will appear to be +;; greater than the maximum length returned by WORD. + +_FIND_NAME_LEN: + .word PREV + .byte 13 + .utf8 "FIND-NAME-LEN" + .align +FIND_NAME_LEN: + .word DOCOL_CODEWORD + .word INC4 FETCHBYTE LIT 3Fh AND + .word EXIT +.def PREV _FIND_NAME_LEN + +;; : FIND ( len -- entry ) +;; LATEST @ \ Initial entry +;; +;; TUCK FIND-NAME-LEN \ Get name length +;; OVER = 0BRANCH [52] \ Check for length mismatch +;; OVER 5 + \ Get name address +;; OVER SWAP WORDBUF STRING= \ Check if name matches +;; 0BRANCH [12] +;; DROP EXIT +;; +;; \ Name doesn't match +;; OVER @ 0<> 0BRANCH [20] \ Check for nil link +;; SWAP @ BRANCH [-104] \ Follow link and loop +;; 2DROP FALSE \ Return false +;; ; + +_FIND: + .word PREV + .byte 4 + .utf8 "FIND" + .align +FIND: + .word DOCOL_CODEWORD + .word LATEST FETCH + .word TUCK FIND_NAME_LEN + .word OVER EQ ZBRANCH 52 + .word OVER LIT 5 ADD + .word OVER SWAP WORDBUF STRINGEQ + .word ZBRANCH 12 + .word DROP EXIT + .word OVER FETCH ZNEQ ZBRANCH 20 + .word SWAP FETCH BRANCH -104 + .word TWODROP FALSE + .word EXIT +.def PREV _FIND + +;; : NAME-LEN 4+ C@ 31 AND ; + +_NAME_LEN: + .word PREV + .byte 8 + .utf8 "NAME-LEN" + .align +NAME_LEN: + .word DOCOL_CODEWORD + .word INC4 FETCHBYTE LIT 31 AND + .word EXIT +.def PREV _NAME_LEN + +;; : >CFA ( entry -- cfa ) +;; DUP NAME-LEN \ Get name length +;; 5 + + \ Increment address to end of name +;; DUP 3 AND 0BRANCH [16] \ Check if aligned +;; 1+ BRANCH [-32] \ Increment address, loop to align check +;; ; + +_TOCFA: + .word PREV + .byte 4 + .utf8 ">CFA" + .align +TOCFA: + .word DOCOL_CODEWORD + .word DUP NAME_LEN + .word LIT 5 ADD ADD + .word DUP LIT 3 AND ZBRANCH 16 + .word INC BRANCH -32 + .word EXIT +.def PREV _TOCFA + +;; : DIGIT ( byte -- value ) +;; DUP DUP 48 >= SWAP 57 <= AND \ Test if 0-9 +;; 0BRANCH [24] \ Jump to A-Z test if not +;; 48 - \ Get digit value +;; BRANCH [64] \ Go to range check +;; +;; DUP DUP 65 >= SWAP 90 <= AND \ Test if A-Z +;; 0BRANCH [60] \ Jump to invalid digit if not +;; 55 - \ Get digit value +;; +;; DUP DUP 0>= SWAP BASE @ < AND \ Test if 0 <= value < BASE +;; 0BRANCH [8] \ Jump to invalid digit if not +;; EXIT +;; +;; DROP TRUE \ Return -1 for an invalid digit +;; ; + +_DIGIT: + .word PREV + .byte 5 + .utf8 "DIGIT" + .align +DIGIT: + .word DOCOL_CODEWORD + .word DUP DUP LIT 48 GTE SWAP LIT 57 LTE AND + .word ZBRANCH 24 + .word LIT 48 SUB + .word BRANCH 64 + .word DUP DUP LIT 65 GTE SWAP LIT 90 LTE AND + .word ZBRANCH 60 + .word LIT 55 SUB + .word DUP DUP ZGTE SWAP BASE FETCH LT AND + .word ZBRANCH 8 + .word EXIT + .word DROP TRUE + .word EXIT +.def PREV _DIGIT + +;; : NEGATE INVERT 1+ ; + +_NEGATE: + .word PREV + .byte 6 + .utf8 "NEGATE" + .align +NEGATE: + .word DOCOL_CODEWORD + .word INVERT INC + .word EXIT +.def PREV _NEGATE + +;; : NUMBER? ( len -- value TRUE | FALSE ) +;; WORDBUF \ Initial address +;; +;; DUP C@ 45 = 0BRANCH [60] \ Check for minus sign +;; 1+ \ Increment address +;; SWAP 1- \ Decrement length +;; DUP 0BRANCH [24] \ Check if any characters remain +;; TRUE -ROT \ Set negate flag true +;; SWAP BRANCH [24] \ Jump to setting initial value +;; +;; \ No characters after minus, exit with failure +;; 2DROP FALSE EXIT +;; +;; \ No leading minus, set negate flag false +;; FALSE -ROT +;; +;; \ Set initial value +;; 0 +;; +;; \ Main loop +;; OVER C@ DIGIT \ Get byte's digit value +;; DUP 0>= 0BRANCH [68] \ Check if digit valid +;; +;; SWAP BASE @ * + \ Incorporate digit +;; SWAP 1+ \ Increment address +;; ROT 1- \ Decrement length +;; DUP 0BRANCH [40] \ Go to end if length zero +;; -ROT SWAP BRANCH [-88] \ Loop if characters remain +;; +;; \ Invalid digit +;; 2DROP 2DROP DROP FALSE EXIT \ Exit with failure +;; +;; \ Reached end of word +;; 2DROP \ Discard pointer and length +;; SWAP 0BRANCH [8] NEGATE \ Negate if -ve flag set +;; TRUE \ Exit with success +;; ; + +_NUMBER: + .word PREV + .byte 7 + .utf8 "NUMBER?" + .align +NUMBER: + .word DOCOL_CODEWORD + .word WORDBUF + .word DUP FETCHBYTE LIT 45 EQ ZBRANCH 60 + .word INC + .word SWAP DEC + .word DUP ZBRANCH 24 + .word TRUE NROT + .word SWAP BRANCH 24 + .word TWODROP FALSE EXIT + .word FALSE NROT + .word LIT 0 + .word OVER FETCHBYTE DIGIT + .word DUP ZGTE ZBRANCH 68 + .word SWAP BASE FETCH MUL ADD + .word SWAP INC + .word ROT DEC + .word DUP ZBRANCH 40 + .word NROT SWAP BRANCH -88 + .word TWODROP TWODROP DROP FALSE EXIT + .word TWODROP + .word SWAP ZBRANCH 8 NEGATE + .word TRUE + .word EXIT +.def PREV _NUMBER + +;; : , HERE @ ! 4 HERE +! ; + +_COMMA: + .word PREV + .byte 1 + .utf8 "," + .align +COMMA: + .word DOCOL_CODEWORD + .word HERE FETCH STORE LIT 4 HERE ADDSTORE + .word EXIT +.def PREV _COMMA + +;; : IMMEDIATE? 4+ @ 128 AND 0BRANCH [12] TRUE EXIT FALSE ; + +_IS_IMMEDIATE: + .word PREV + .byte 10 + .utf8 "IMMEDIATE?" + .align +IS_IMMEDIATE: + .word DOCOL_CODEWORD + .word INC4 FETCH LIT 128 AND ZBRANCH 12 TRUE EXIT FALSE + .word EXIT +.def PREV _IS_IMMEDIATE + +;; : INTERPRET +;; WORD \ Read a word +;; DUP FIND \ Look it up +;; DUP 0BRANCH [72] \ Branch to number handling if not found +;; SWAP DROP \ Discard word length +;; +;; \ Handle word +;; DUP IMMEDIATE? \ Check if the word is immediate +;; INVERT 0BRANCH [32] \ Jump straight to executing if so +;; STATE @ 0BRANCH [16] \ Check state +;; >CFA , EXIT \ Compile word +;; >CFA EXECUTE EXIT \ Execute word +;; +;; \ Handle number +;; DROP \ Discard nil entry +;; DUP NUMBER? 0BRANCH [48] \ Convert to number +;; SWAP DROP \ Discard word length +;; STATE @ 0BRANCH [20] \ Check state +;; LIT LIT , , \ If compiling, append LIT and the value +;; EXIT +;; +;; \ Word was not found +;; WNFHOOK EXECUTE +;; ; + +_INTERPRET: + .word PREV + .byte 9 + .utf8 "INTERPRET" + .align +INTERPRET: + .word DOCOL_CODEWORD + .word WORD + .word DUP FIND + .word DUP ZBRANCH 72 + .word SWAP DROP + .word DUP IS_IMMEDIATE + .word INVERT ZBRANCH 32 + .word STATE FETCH ZBRANCH 16 + .word TOCFA COMMA EXIT + .word TOCFA EXECUTE EXIT + .word DROP + .word DUP NUMBER ZBRANCH 48 + .word SWAP DROP + .word STATE FETCH ZBRANCH 20 + .word LIT LIT COMMA COMMA + .word EXIT + .word WNFHOOK EXECUTE + .word EXIT +.def PREV _INTERPRET + +;; : QUIT R0 RSP! INTERPRET BRANCH [-8] ; + +_QUIT: + .word PREV + .byte 4 + .utf8 "QUIT" + .align +QUIT: + .word DOCOL_CODEWORD + .word R0 RSPSTORE + .word INTERPRET BRANCH -8 + .word EXIT +.def PREV _QUIT + +;; And now to make myself obsolete as the compiler (finally) + +;; : [ 0 STATE ! ; IMMEDIATE + +_LBRAC: + .word PREV + .byte 81h + .utf8 "[" + .align +LBRAC: + .word DOCOL_CODEWORD + .word LIT 0 STATE STORE + .word EXIT +.def PREV _LBRAC + +;; : ] 1 STATE ! ; + +_RBRAC: + .word PREV + .byte 1 + .utf8 "]" + .align +RBRAC: + .word DOCOL_CODEWORD + .word LIT 1 STATE STORE + .word EXIT +.def PREV _RBRAC + +;; : ALIGN +;; DUP 3 AND 0BRANCH [32] +;; 0 OVER C! 1+ BRANCH [-48] +;; ; + +_ALIGN: + .word PREV + .byte 5 + .utf8 "ALIGN" + .align +ALIGN: + .word DOCOL_CODEWORD + .word DUP LIT 3 AND ZBRANCH 32 + .word LIT 0 OVER STOREBYTE INC BRANCH -48 + .word EXIT +.def PREV _ALIGN + +;; : HIDDEN 4+ DUP C@ 32 XOR SWAP C! ; + +_HIDDEN: + .word PREV + .byte 6 + .utf8 "HIDDEN" + .align +HIDDEN: + .word DOCOL_CODEWORD + .word INC4 DUP FETCHBYTE LIT 32 XOR SWAP STOREBYTE + .word EXIT +.def PREV _HIDDEN + +;; : IMMEDIATE +;; LATEST @ +;; 4+ DUP C@ 128 XOR SWAP C! +;; ; IMMEDIATE + +_IMMEDIATE: + .word PREV + .byte 89h + .utf8 "IMMEDIATE" + .align +IMMEDIATE: + .word DOCOL_CODEWORD + .word LATEST FETCH + .word INC4 DUP FETCHBYTE LIT 128 XOR SWAP STOREBYTE + .word EXIT +.def PREV _IMMEDIATE + +;; : CREATE +;; HERE @ \ Get initial address +;; LATEST @ OVER ! 4+ \ Write link +;; 2DUP C! 1+ \ Write length +;; 2DUP WORDBUF SWAP COPY + \ Write name +;; ALIGN \ Pad to alignment +;; +;; HERE @ LATEST ! \ Update LATEST +;; HERE ! \ Update HERE +;; ; + +_CREATE: + .word PREV + .byte 6 + .utf8 "CREATE" + .align +CREATE: + .word DOCOL_CODEWORD + .word HERE FETCH + .word LATEST FETCH OVER STORE INC4 + .word TWODUP STOREBYTE INC + .word TWODUP WORDBUF SWAP COPY ADD + .word ALIGN + .word HERE FETCH LATEST STORE + .word HERE STORE + .word EXIT +.def PREV _CREATE + +;; : : +;; WORD +;; CREATE +;; DOCOL , +;; LATEST @ HIDDEN +;; ] +;; ; + +_COLON: + .word PREV + .byte 1 + .utf8 ":" + .align +COLON: + .word DOCOL_CODEWORD + .word WORD + .word CREATE + .word DOCOL COMMA + .word LATEST FETCH HIDDEN + .word RBRAC + .word EXIT +.def PREV _COLON + +;; : ; +;; LIT EXIT , +;; LATEST @ HIDDEN +;; [ +;; ; IMMEDIATE + +_SEMICOLON: + .word PREV + .byte 81h + .utf8 ";" + .align +SEMICOLON: + .word DOCOL_CODEWORD + .word LIT EXIT COMMA + .word LATEST FETCH HIDDEN + .word LBRAC + .word EXIT +.def PREV _SEMICOLON + +;; : WNF-HANDLER +;; DROP \ Discard word length +;; 87 EMIT 78 EMIT 70 EMIT 10 EMIT \ Print WNF +;; QUIT \ Reset return stack +;; ; + +_WNF_HANDLER: + .word PREV + .byte 11 + .utf8 "WNF-HANDLER" + .align +WNF_HANDLER: + .word DOCOL_CODEWORD + .word DROP + .word LIT 87 EMIT LIT 78 EMIT LIT 70 EMIT LIT 10 EMIT + .word QUIT + .word EXIT +.def PREV _WNF_HANDLER + +COLD_START: + .word QUIT + +.def KERNEL_DEFS_LAST PREV +KERNEL_DEFS_END: + +;; The trampoline is a workaround for WebAssembly's lack of indirect +;; jumps and code addresses. Instead of jumping into the next +;; codeword, NEXT sets the fn global to the function index of the next +;; codeword and returns to the trampoline. +;; +;; This way, we can simulate jumping to the code within WebAssembly's +;; restrictions without the WebAssembly call stack growing unbounded +;; as would happen if we used call_indirect inside NEXT. + +.func trampoline + loop iter + global.get fn call_indirect codeword codewords + global.get run br_if iter + end + +.func reset + i32.const RSP_INIT global.set rsp ;; Set the return stack pointer + i32.const SP_INIT global.set sp ;; Set the stack pointer + i32.const COLD_START global.set ip ;; Set the IP to the cold start + call next + + i32.const 1 global.set run + call trampoline + +.export reset