;; 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
       call $push
       call $next)

 (func $neq
       call $pop
       call $pop
       i32.ne
       call $push
       call $next)

 (func $lt (local $tmp i32)
       call $pop
       local.set $tmp
       call $pop
       local.get $tmp
       i32.lt_s
       call $push
       call $next)

 (func $gt (local $tmp i32)
       call $pop
       local.set $tmp
       call $pop
       local.get $tmp
       i32.gt_s
       call $push
       call $next)

 (func $lte (local $tmp i32)
       call $pop
       local.set $tmp
       call $pop
       local.get $tmp
       i32.le_s
       call $push
       call $next)

 (func $gte (local $tmp i32)
       call $pop
       local.set $tmp
       call $pop
       local.get $tmp
       i32.ge_s
       call $push
       call $next)

 (func $zeq
       call $pop
       i32.eqz
       call $push
       call $next)

 (func $zneq
       call $pop
       i32.const 0
       i32.ne
       call $push
       call $next)

 (func $zlt
       call $pop
       i32.const 0
       i32.lt_s
       call $push
       call $next)

 (func $zgt
       call $pop
       i32.const 0
       i32.gt_s
       call $push
       call $next)

 (func $zlte
       call $pop
       i32.const 0
       i32.le_s
       call $push
       call $next)

 (func $zgte
       call $pop
       i32.const 0
       i32.ge_s
       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)
	   global.get $ip
	   i32.load
	   else
	   i32.const 4
	   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 0x????)
 ;;       "\??\??\??\??"
 ;;       "\05DOCOL\00\00"
 ;;       "\01\00\00\00"
 ;;       "\00\00\00\00")

 ;; (data (i32.const 0x????)
 ;;       "\??\??\??\??"
 ;;       "\07DOCONST"
 ;;       "\01\00\00\00"
 ;;       "\01\00\00\00")

 ;; (data (i32.const 0x????)
 ;;       "\??\??\??\??"
 ;;       "\05DOVAR\00\00"
 ;;       "\01\00\00\00"
 ;;       "\02\00\00\00")

 ;; (data (i32.const 0x????)
 ;;       "\??\??\??\??"
 ;;       "\02R0\00"
 ;;       "\01\00\00\00"
 ;;       "\00\00\01\00")

 ;; (data (i32.const 0x????)
 ;;       "\??\??\??\??"
 ;;       "\02S0\00"
 ;;       "\01\00\00\00"
 ;;       "\00\f0\00\00")

 ;; (data (i32.const 0x????)
 ;;       "\??\??\??\??"
 ;;       "\05STATE\00\00"
 ;;       "\02\00\00\00"
 ;;       "\00\00\00\00")

 ;; (data (i32.const 0x????)
 ;;       "\??\??\??\??"
 ;;       "\04BASE\00\00\00"
 ;;       "\02\00\00\00"
 ;;       "\0a\00\00\00")

 ;; (data (i32.const 0x????)
 ;;       "\??\??\??\??"
 ;;       "\04HERE\00\00\00"
 ;;       "\02\00\00\00"
 ;;       "\??\??\??\??")

 ;; (data (i32.const 0x????)
 ;;       "\??\??\??\??"
 ;;       "\06LATEST\00"
 ;;       "\02\00\00\00"
 ;;       "\??\??\??\??")

 ;; Outer interpreter

 ;; The trampoline is the workaround for WebAssembly's lack of
 ;; indirect jumps, and lack of addresses for code.  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
       ))