;; 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 0x0041)) (global $RXHEAD i32 (i32.const 0x0042)) (global $RXTAIL i32 (i32.const 0x0043)) ;; 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)) ;; 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 $doconst 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.const 4 i32.add i32.load global.get $sp 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) ;; 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) ;; 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) ;; Wait for RXBUF to be non-empty loop $wait global.get $RXHEAD i32.atomic.load8_u local.tee $head global.get $RXTAIL i32.atomic.load8_u i32.eq br_if $wait 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, DOCONST ;; 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) $doconst) (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 constants 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" "\07DOCONST" "\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" "\10\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" "\c0\0b\00\00") (data (i32.const 0x058c) "\78\05\00\00" "\06LATEST\00" "\02\00\00\00" "\b0\0b\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" "\05ERROR\00\00" "\02\00\00\00" "\00\00\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 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 "\70\07\00\00" ;; 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 ;; 45 - \ 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 "\2d\00\00\00" ;; 45 "\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 "\dc\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 and also not a number. Ideally we'd print the ;; \ word that wasn't found here but I haven't implemented such things ;; \ yet so for now we'll just discard the word's length, set ERROR to ;; \ 1 and exit. ;; DROP 1 ERROR ! ;; ; (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 "\18\02\00\00" ;; DROP "\18\04\00\00" ;; LIT "\01\00\00\00" ;; 1 "\dc\05\00\00" ;; ERROR "\c0\03\00\00" ;; ! "\0c\04\00\00") ;; EXIT ;; => 0xc4 bytes ;; : 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") ;; 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) br $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 call $trampoline))