assoc(`negate',    `NEGATE  ')
assoc(`nip',       `NIP     ')
assoc(`nsrc',      `#SRC    ')
assoc(`obey',      `OBEY    ')
assoc(`over',      `OVER    ')
assoc(`rdrop',     `RDROP   ')
assoc(`rot',       `ROT     ')
assoc(`tuck',      `TUCK    ')
assoc(`rtosrc',    `R>SRC   ')
assoc(`source_id', `SOURCE-I')
assoc(`source',    `SOURCE  ')
assoc(`space',     `SPACE   ')
assoc(`srcid',     `SRCID   ')
assoc(`src',       `SRC     ')
assoc(`srctor',    `SRC>R   ')
assoc(`swap',      `SWAP    ')
assoc(`toin',      `>IN     ')
assoc(`tor',       `>R      ')
assoc(`twodup',    `2DUP    ')
assoc(`tworfrom',  `2R>     ')
assoc(`twotor',    `2>R     ')
assoc(`type',      `TYPE    ')
assoc(`_u2slash',  `U2/     ')
assoc(`within',    `WITHIN  ')
assoc(`off',       `OFF     ')
assoc(`on',        `ON      ')
assoc(`_and',      `AND     ')
assoc(`_bic',      `BIC     ')
assoc(`_or',       `OR      ')
assoc(`_xor',      `XOR     ')
assoc(`cr',        `CR      ')
assoc(`_1minus',   `1-      ')
assoc(`_1plus',    `1+      ')
assoc(`_2slash',   `2/      ')
assoc(`_2star',    `2*      ')
assoc(`cells',     `CELLS   ')
assoc(`chars',     `CHARS   ')
assoc(`rfrom',     `R>      ')
assoc(`zeq',       `0=      ')
assoc(`zlt',       `0<      ')
assoc(`is_lt',     `<       ')
assoc(`is_eq',     `=       ')
assoc(`is_ge',     `>=      ')
assoc(`is_geu',    `U>=     ')

assoc(`abs',       `ABS     ')
assoc(`hex',       `HEX     ')
assoc(`decimal',   `DECIMAL ')
assoc(`binary',    `BINARY  ')
assoc(`dots',      `.S      ')
assoc(`depth',     `DEPTH   ')
assoc(`pick',      `PICK    ')
assoc(`first',     `FIRST   ')
assoc(`flags',     `FLAGS   ')
assoc(`bns',       `BNS     ')
assoc(`last1',     `LAST    ')
assoc(`used',      `USED    ')
assoc(`empty_bufs',`EMPTY-BU')
assoc(`fbic',      `find-blo')
assoc(`ba',        `block-ad')
assoc(`bclr',      `BCLR    ')
assoc(`bset',      `BSET    ')
assoc(`snb',       `select-n')
assoc(`wb',        `write-bl')
assoc(`fb',        `flush-bl')
assoc(`cb',        `configur')
assoc(`lob',       `load-blo')
assoc(`block',     `BLOCK   ')
assoc(`update',    `UPDATE  ')
assoc(`buffer',    `BUFFER  ')
assoc(`flush',     `FLUSH   ')

; DX-Forth is intended to be loaded at address $14200, and not
; exceed $17FFF.  The dictionary space is intended to occupy
; from $18000-$1BFFF.  Somewhere in this space must also exist
; things like the Forth stacks and block buffers.
;
; The following memory map crudely represents the memory layout
; so far:
;
; $13E80 - $13FFF	Return Stack (aka BIOS stack)
; $14000 - $141FF	BIOS State (opaque; do not touch!)
; $14200 - $17FFF	DX-Forth Image and state
; $18000 - $1ADFF	User programs and state
; $1AE00 - $1BDFF	Block I/O buffers
; $1BE00 - $1BFFF	Data Stack
;
; Note that the exact boundary between DX-Forth and the user
; dictionary space is fluid.  The above memory map assumes the
; worst-case scenario where DX-Forth occupies a solid 16KiB.

	align	4

	align	4
_rot:	ld	a1,0(S)	;T=c A1=b A2=a
	ld	a2,8(S)
	sd	a1,8(S)
	sd	T,0(S)
	addi	T,a2,0
	jal	x0,next

; Tuck a datum away.  ( a b -- b a b )

	align	4
_tuck:	jal	W,_docol
	hword	dup, rot, rot, exit

; Return stack manipulations.

	align	4
_rdrop:
	addi	R,R,8
	jal	x0,next

	align	4
__and:
	ld	W,0(S)
	addi	S,S,8
	and	T,T,W
	jal	x0,next

	align	4
__bic:	ld	W,0(S)
	addi	S,S,8
	xori	W,W,-1
	and	T,T,W
	jal	x0,next

	align	4
__or:	ld	W,0(S)
	addi	S,S,8
	or	T,T,W
	jal	x0,next

	align	4

	jal	x0,next

	align	4
__2slash:
	srai	T,T,1
	jal	x0,next

	align	4
_cells:	slli	T,T,3
_chars:	jal	x0,next

	align	4
__u2slash:
	srli	T,T,1
	jal	x0,next

	align	4
__1plus:

	hword	drop, exit

	align	4
_dots:	jal	W,_docol
	hword	dotdepth, dotvals, space, space, exit

; END PICTURED NUMERIC OUTPUT

; BEGIN BLOCK I/O ============================================
;
; 4KiB of block I/O buffers sits at $1AE00 in this version.
; This base address is answered by the word FIRST.
;
; Each buffer has a corresponding flag byte which indicates
; whether the buffer has been assigned to a block, and/or
; whether the buffer has been modified since it was assigned
; last.  The private word FLAGS gives the address of the first
; byte.
;
; Finally, each buffer has a corresponding block mapping.
; The word BNS returns the address of the 4-vector of Block
; Numbers.
;
; To help implement a crude approximation of a least-recently-
; used algorithm, we need two additional variables.
;
; LAST refers to the last referenced buffer entry (0 <= LAST
; < 4).  This is so UPDATE knows which buffer to mark as dirty.
;
; USED just cycles from buffer to buffer.  This round-robin
; selection of buffers is not a true LRU, but for 99% of the
; use-cases for using blocks, it gives a good enough facsimile.
;
; EMPTY-BUFFERS ( -- ) resets the block I/O system to its
; power-on default state.  All buffers are marked unused.
; Any data which has been modified is lost.
;
; NOTE: in this version of Forth, due to word length
; limitations, you can get away with just EMPTY-BU.  Please
; don't -- use the full name.  You'll thank me later when
; more characters becomes significant in the future.
;
; BUFFER is identical to BLOCK in every way, except that it
; does not fill the buffer from secondary storage.  The
; assumption is that you'll just copy over the entire contents
; of the buffer anyway (e.g., as when copying blocks around),
; so why waste time filling the buffer contents when it's not
; going to be used?
;
; FLUSH will flush all dirty buffers back to storage, and
; mark them clean again.  However, it will not affect the
; state of the cache as a whole (vs. EMPTY-BUFFERS).


	align	4
_first:	jal	W,_docon
	align	8
	dword	$1AE00		; First of four 1KiB blocks

	; We use only four bytes of the space reserved for
	; the flags "variable".  Each byte has the following
	; bit meanings:
	;
	; .... ...1	Buffer has been assigned to a block.
	; .... ..1.	Buffer has been modified since filled.
	; 0000 00..	Must be zero.

	align	4
_flags:	jal	W,_dovar
	align	8
	dword	0

	align	4
_bns:	jal	W,_dovar
	align	8
	dword	0,0,0,0

	align	4
_last1:	jal	W,_dovar
	align	8
	dword	3

	align	4
_used:	jal	W,_dovar
	align	8
	dword	0

	align	4
_empty_bufs:
	jal	W,_docol
	hword	lit16, 0, flags, store
	hword	bns, lit16, 4, cells, lit16, 0, fill
	hword	lit16, 3, last1, store, exit

	align	4
_fbic:	jal	W,_docol
	hword	lit16, 0
_fbic_0:
	hword	dup, lit16, 4, is_ge, zgo, _fbic_1
	hword	drop, lit16, 0, exit
_fbic_1:
	hword	dup, flags, plus, cfetch, zgo, _fbic_2
	hword	twodup, cells, bns, plus, fetch, is_eq
	hword	zgo, _fbic_3
	hword	nip, lit16, -1, exit
_fbic_3:
_fbic_2:
	hword	_1plus, go, _fbic_0

	align	4
_ba:	jal	W,_docol
	hword	lit16, 1024, mult, first, plus, exit

	align	4
_bclr:	jal	W,_docol
	hword	tuck, cfetch, _bic, swap, cstore, exit

	align	4
_bset:	jal	W,_docol
	hword	tuck, cfetch, _or, swap, cstore, exit

	align	4
_snb:	jal	W,_docol
	hword	used, fetch, _1plus, lit16, 3, _and
	hword	used, store, exit

	align	4
_wb:	jal	W,_docol
	hword	used, fetch, cells, bns, plus, fetch
	hword	squote
	byte	19, "WRITING BACK BLOCK "
	align	2
	hword	type, dot, cr, exit

	align	4
_fb:	jal	W,_docol
	hword	used, fetch, flags, plus, cfetch
	hword	lit16, 2, _and, zgo, _fb_1
	hword	wb, lit16, 2, used, fetch, flags, plus, bclr
_fb_1:	hword	exit

	align	4
_cb:	jal	W,_docol
	hword	lit16, 1, used, fetch, flags, plus, cstore
	hword	used, fetch, cells, bns, plus, store, exit

	align	4
_lob:	jal	W,_docol
	hword	squote
	byte	14, "READING BLOCK "
	align	2
	hword	type
	hword	used, fetch, cells, bns, plus, fetch, dot
	hword	squote
	byte	13, " INTO BUFFER "
	align	2
	hword	type
	hword	used, fetch, ba, hex, udot, decimal, cr, exit

	align	4
_block:	jal	W,_docol
	hword	fbic, zgo, _block_1
	hword	dup, last1, store, ba, exit
_block_1:
	hword	snb, fb, cb, lob
	hword	used, fetch, dup, last1, store, ba, exit

	align	4
_buffer:
	jal	W,_docol
	hword	fbic, zgo, _buffer_1
	hword	dup, last1, store, ba, exit
_buffer_1:
	hword	snb, fb, cb
	hword	used, fetch, dup, last1, store, ba, exit

	align	4
_update:
	jal	W,_docol
	hword	lit16, 2, last1, fetch, flags, plus, bset, exit

	align	4
_flush:	jal	W,_docol
	hword	lit16, 0, used, store
	hword	snb, fb, snb, fb, snb, fb, snb, fb, snb, fb, exit

; END BLOCK I/O

; ==== Look stuff up in the dictionary.
;
; The dictionary is a mapping of word name to code field
; address (CFA).  The dictionary is expressed as a relational
; table with the following schema:
;