1579 lines
35 KiB
Plaintext
1579 lines
35 KiB
Plaintext
;; 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)
|
|
|
|
;; 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) $branch)
|
|
(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)
|
|
"\82\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"
|
|
;; "\??\??\??\??")
|
|
|
|
;; (data (i32.const 0x058c)
|
|
;; "\78\05\00\00"
|
|
;; "\06LATEST\00"
|
|
;; "\02\00\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
|
|
|
|
;; : SPACE? ( 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
|
|
;; OR OR OR \ Or all results together
|
|
;; ;
|
|
|
|
(data (i32.const 0x0600)
|
|
"\e4\05\00\00"
|
|
"\06SPACE?\00"
|
|
"\00\00\00\00"
|
|
"\08\02\00\00" ;; DUP
|
|
"\18\04\00\00" ;; LIT
|
|
"\09\00\00\00" ;; 9
|
|
"\fc\02\00\00" ;; =
|
|
"\28\02\00\00" ;; SWAP
|
|
"\08\02\00\00" ;; DUP
|
|
"\18\04\00\00" ;; LIT
|
|
"\0a\00\00\00" ;; 10
|
|
"\fc\02\00\00" ;; =
|
|
"\28\02\00\00" ;; SWAP
|
|
"\08\02\00\00" ;; DUP
|
|
"\18\04\00\00" ;; LIT
|
|
"\0d\00\00\00" ;; 13
|
|
"\fc\02\00\00" ;; =
|
|
"\28\02\00\00" ;; SWAP
|
|
"\18\04\00\00" ;; LIT
|
|
"\20\00\00\00" ;; 32
|
|
"\fc\02\00\00" ;; =
|
|
"\98\03\00\00" ;; OR
|
|
"\98\03\00\00" ;; OR
|
|
"\98\03\00\00" ;; OR
|
|
"\0c\04\00\00") ;; EXIT
|
|
|
|
;; => 0x68 bytes
|
|
|
|
;; : WORD ( -- len )
|
|
;; 0 \ Initial length
|
|
;;
|
|
;; KEY \ Get byte from input
|
|
;; TUCK SPACE? 0BRANCH [56] \ Check if whitespace
|
|
;; TUCK WORDBUF + C! \ Append byte to WORDBUF
|
|
;; 1+ \ Increment length
|
|
;; DUP 32 >= 0BRANCH [8] EXIT \ Exit if at max length
|
|
;; BRANCH [-68] \ Loop back to KEY
|
|
;;
|
|
;; \ Byte is whitespace
|
|
;; SWAP DROP
|
|
;; DUP 0<> 0BRANCH [-92] \ Loop back to KEY if zero length
|
|
;; ;
|
|
|
|
(data (i32.const 0x0668)
|
|
"\00\60\00\00"
|
|
"\04WORD\00\00\00"
|
|
"\00\00\00\00"
|
|
"\18\04\00\00" ;; LIT
|
|
"\00\00\00\00" ;; 0
|
|
"\84\07\00\00" ;; KEY
|
|
"\f0\05\00\00" ;; TUCK
|
|
"\0c\06\00\00" ;; SPACE?
|
|
"\b4\04\00\00" ;; 0BRANCH
|
|
"\38\00\00\00" ;; 56
|
|
"\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" ;; 56
|
|
"\0c\04\00\00" ;; EXIT
|
|
"\a4\04\00\00" ;; BRANCH
|
|
"\bc\ff\ff\ff" ;; -68
|
|
"\28\02\00\00" ;; SWAP
|
|
"\18\02\00\00" ;; DROP
|
|
"\08\02\00\00" ;; DUP
|
|
"\5c\03\00\00" ;; 0<>
|
|
"\b4\04\00\00" ;; 0BRANCH
|
|
"\a4\ff\ff\ff" ;; -92
|
|
"\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 [48] \ 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 [12] \ Check for nil link
|
|
;; DROP EXIT
|
|
;; SWAP @ BRANCH [-108] \ Follow link and loop
|
|
;; ;
|
|
|
|
(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
|
|
"\08\03\00\00" ;; <>
|
|
"\b4\04\00\00" ;; 0BRANCH
|
|
"\30\00\00\00" ;; 48
|
|
"\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" ;; @
|
|
"\44\03\00\00" ;; 0=
|
|
"\b4\04\00\00" ;; 0BRANCH
|
|
"\0c\00\00\00" ;; 12
|
|
"\18\02\00\00" ;; DROP
|
|
"\0c\04\00\00" ;; EXIT
|
|
"\28\02\00\00" ;; SWAP
|
|
"\cc\03\00\00" ;; @
|
|
"\a4\04\00\00" ;; BRANCH
|
|
"\94\ff\ff\ff" ;; -108
|
|
"\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 [-28] \ 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
|
|
"\e4\ff\ff\ff" ;; -28
|
|
"\0c\04\00\00") ;; EXIT
|
|
|
|
;; => 0x50 bytes
|
|
|
|
;; : DIGIT ( byte -- value )
|
|
;; DUP DUP 48 >= SWAP 57 <= AND \ Test if 0-9
|
|
;; 0BRANCH [20] \ Jump to A-Z test if not
|
|
;; 48 - \ Get digit value
|
|
;; BRANCH [52] \ Go to range check
|
|
;;
|
|
;; DUP DUP 65 >= SWAP 90 <= AND \ Test if A-Z
|
|
;; 0BRANCH [56] \ 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 -1 \ 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
|
|
"\14\00\00\00" ;; 20
|
|
"\18\04\00\00" ;; LIT
|
|
"\30\00\00\00" ;; 48
|
|
"\cc\02\00\00" ;; -
|
|
"\a4\04\00\00" ;; BRANCH
|
|
"\34\00\00\00" ;; 52
|
|
"\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
|
|
"\5a\00\00\00" ;; 90
|
|
"\2c\03\00\00" ;; <=
|
|
"\8c\03\00\00" ;; AND
|
|
"\b4\04\00\00" ;; 0BRANCH
|
|
"\38\00\00\00" ;; 56
|
|
"\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
|
|
"\ff\ff\ff\ff" ;; -1
|
|
"\0c\04\00\00") ;; EXIT
|
|
|
|
;; => 0xc4 bytes
|
|
|
|
;; : NEGATE INVERT 1+ ;
|
|
|
|
(data (i32.const 0x0930)
|
|
"\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
|
|
;;
|
|
;; C@ 45 = 0BRANCH [56] \ Check for minus sign
|
|
;; 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 0x094c)
|
|
"\30\09\00\00"
|
|
"\07NUMBER?"
|
|
"\00\00\00\00"
|
|
"\ac\05\00\00" ;; WORDBUF
|
|
"\fc\03\00\00" ;; C@
|
|
"\18\04\00\00" ;; LIT
|
|
"\2d\00\00\00" ;; 45
|
|
"\fc\02\00\00" ;; =
|
|
"\b4\04\00\00" ;; 0BRANCH
|
|
"\38\00\00\00" ;; 56
|
|
"\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
|
|
"\3c\09\00\00" ;; NEGATE
|
|
"\34\05\00\00" ;; TRUE
|
|
"\0c\04\00\00") ;; EXIT
|
|
|
|
;; => 0xfc bytes
|
|
|
|
;; : , HERE @ ! 4 HERE +! ;
|
|
|
|
;; : IMMEDIATE? 4+ @ 128 AND 0BRANCH [12] TRUE EXIT FALSE ;
|
|
|
|
;; : 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 >R 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 !
|
|
;; ;
|
|
|
|
;; : QUIT R0 RSP! INTERPRET BRANCH [-8] ;
|
|
|
|
;; 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 0xf000 global.set $sp ;; Set the stack pointer
|
|
;; i32.const 0x???? global.set $ip ;; Set the IP to point at QUIT
|
|
;; call $next
|
|
;; call $trampoline
|
|
))
|