forth: a little housekeeping

emul/forth/glue0.asm

@@ -9,24 +9,13 @@
 .equ	HERE		0xe700		; override, in sync with stage1.c
 .equ	CURRENT		0xe702		; override, in sync with stage1.c
 .equ	HERE_INITIAL	CODE_END	; override
-
-.inc "ascii.h"
 .equ	STDIO_PORT	0x00
 
 	jp	init
 
-
-.equ	STDIO_RAMSTART	RAMSTART
-.equ	STDIO_GETC	emulGetC
-.equ	STDIO_PUTC	emulPutC
-.inc "stdio.asm"
-
-.equ FORTH_RAMSTART STDIO_RAMEND
-.inc "main.asm"
-.inc "util.asm"
-.inc "stack.asm"
-.inc "dict.asm"
-
+.equ	GETC	emulGetC
+.equ	PUTC	emulPutC
+.inc "forth.asm"
 
 init:
 	di

emul/forth/glue1.asm

@@ -1,22 +1,13 @@
 ; Warning: The offsets of native dict entries must be exactly the same between
 ;          glue0.asm and glue1.asm
 .equ	LATEST		CODE_END	; override
-.inc "ascii.h"
 .equ	STDIO_PORT	0x00
 
 	jp	init
 
-.equ	STDIO_RAMSTART	RAMSTART
-.equ	STDIO_GETC	emulGetC
-.equ	STDIO_PUTC	emulPutC
-.inc "stdio.asm"
-
-.equ FORTH_RAMSTART STDIO_RAMEND
-.inc "main.asm"
-.inc "util.asm"
-.inc "stack.asm"
-.inc "dict.asm"
-
+.equ	GETC	emulGetC
+.equ	PUTC	emulPutC
+.inc "forth.asm"
 
 init:
 	di

forth/dict.asm

@@ -1,996 +0,0 @@
-; A dictionary entry has this structure:
-; - 7b name (zero-padded)
-; - 2b prev pointer
-; - 1b flags (bit 0: IMMEDIATE. bit 1: UNWORD)
-; - 2b code pointer
-; - Parameter field (PF)
-;
-; The code pointer point to "word routines". These routines expect to be called
-; with IY pointing to the PF. They themselves are expected to end by jumping
-; to the address at (IP). They will usually do so with "jp next".
-;
-; That's for "regular" words (words that are part of the dict chain). There are
-; also "special words", for example NUMBER, LIT, FBR, that have a slightly
-; different structure. They're also a pointer to an executable, but as for the
-; other fields, the only one they have is the "flags" field.
-
-; This routine is jumped to at the end of every word. In it, we jump to current
-; IP, but we also take care of increasing it my 2 before jumping
-next:
-	; Before we continue: are stacks within bounds?
-	call	chkPS
-	call	chkRS
-	ld	de, (IP)
-	ld	h, d
-	ld	l, e
-	inc	de \ inc de
-	ld	(IP), de
-	; HL is an atom list pointer. We need to go into it to have a wordref
-	ld	e, (hl)
-	inc	hl
-	ld	d, (hl)
-	push	de
-	jp	EXECUTE+2
-
-
-; Execute a word containing native code at its PF address (PFA)
-nativeWord:
-	jp	(iy)
-
-; Execute a list of atoms, which always end with EXIT.
-; IY points to that list. What do we do:
-; 1. Push current IP to RS
-; 2. Set new IP to the second atom of the list
-; 3. Execute the first atom of the list.
-compiledWord:
-	ld	hl, (IP)
-	call	pushRS
-	push	iy \ pop hl
-	inc	hl
-	inc	hl
-	ld	(IP), hl
-	; IY still is our atom reference...
-	ld	l, (iy)
-	ld	h, (iy+1)
-	push	hl	; argument for EXECUTE
-	jp	EXECUTE+2
-
-; Pushes the PFA directly
-cellWord:
-	push	iy
-	jp	next
-
-; Pushes the address in the first word of the PF
-sysvarWord:
-	ld	l, (iy)
-	ld	h, (iy+1)
-	push	hl
-	jp	next
-
-; The word was spawned from a definition word that has a DOES>. PFA+2 (right
-; after the actual cell) is a link to the slot right after that DOES>.
-; Therefore, what we need to do push the cell addr like a regular cell, then
-; follow the link from the PFA, and then continue as a regular compiledWord.
-doesWord:
-	push	iy	; like a regular cell
-	ld	l, (iy+2)
-	ld	h, (iy+3)
-	push	hl \ pop iy
-	jr	compiledWord
-
-; This is not a word, but a number literal. This works a bit differently than
-; others: PF means nothing and the actual number is placed next to the
-; numberWord reference in the compiled word list. What we need to do to fetch
-; that number is to play with the IP.
-numberWord:
-	ld	hl, (IP)	; (HL) is out number
-	ld	e, (hl)
-	inc	hl
-	ld	d, (hl)
-	inc	hl
-	ld	(IP), hl	; advance IP by 2
-	push	de
-	jp	next
-
-	.db	0b10		; Flags
-NUMBER:
-	.dw	numberWord
-
-; Similarly to numberWord, this is not a real word, but a string literal.
-; Instead of being followed by a 2 bytes number, it's followed by a
-; null-terminated string. When called, puts the string's address on PS
-litWord:
-	ld	hl, (IP)
-	push	hl
-	call	strskip
-	inc	hl		; after null termination
-	ld	(IP), hl
-	jp	next
-
-	.db	0b10		; Flags
-LIT:
-	.dw	litWord
-
-; Pop previous IP from Return stack and execute it.
-; ( R:I -- )
-	.db	"EXIT"
-	.fill	3
-	.dw	0
-	.db	0
-EXIT:
-	.dw nativeWord
-	call	popRSIP
-	jp	next
-
-; ( R:I -- )
-	.db "QUIT"
-	.fill 3
-	.dw EXIT
-	.db 0
-QUIT:
-	.dw nativeWord
-	jp	forthRdLine
-
-	.db "ABORT"
-	.fill 2
-	.dw QUIT
-	.db 0
-ABORT:
-	.dw nativeWord
-abort:
-	; flush rest of input
-	ld	hl, (INPUTPOS)
-	xor	a
-	ld	(hl), a
-	; Reinitialize PS (RS is reinitialized in forthInterpret)
-	ld	sp, (INITIAL_SP)
-	jp	forthRdLineNoOk
-
-; prints msg in (HL) then aborts
-abortMsg:
-	call	printstr
-	jr	abort
-
-abortUnknownWord:
-	ld	hl, .msg
-	jr	abortMsg
-.msg:
-	.db	"unknown word", 0
-
-abortUnderflow:
-	ld	hl, .msg
-	jr	abortMsg
-.msg:
-	.db	"stack underflow", 0
-
-	.db	"ABORT", '"'
-	.fill	1
-	.dw	ABORT
-	.db	1		; IMMEDIATE
-ABORTI:
-	.dw	compiledWord
-	.dw	PRINTI
-	.dw	.private
-	.dw	EXIT
-
-	.db	0b10		; UNWORD
-.private:
-	.dw	nativeWord
-	ld	hl, (HERE)
-	ld	de, ABORT
-	call	DEinHL
-	ld	(HERE), hl
-	jp	next
-
-	.db "BYE"
-	.fill 4
-	.dw ABORTI
-	.db 0
-BYE:
-	.dw nativeWord
-	; Goodbye Forth! Before we go, let's restore the stack
-	ld	sp, (INITIAL_SP)
-	; unwind stack underflow buffer
-	pop	af \ pop af \ pop af
-	; success
-	xor	a
-	ret
-
-; ( c -- )
-	.db "EMIT"
-	.fill 3
-	.dw BYE
-	.db 0
-EMIT:
-	.dw nativeWord
-	pop	hl
-	call	chkPS
-	ld	a, l
-	call	stdioPutC
-	jp	next
-
-	.db	"(print)"
-	.dw	EMIT
-	.db	0
-PRINT:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	call	printstr
-	jp	next
-
-
-	.db	'.', '"'
-	.fill	5
-	.dw	PRINT
-	.db	1		; IMMEDIATE
-PRINTI:
-	.dw	nativeWord
-	ld	hl, (HERE)
-	ld	de, LIT
-	call	DEinHL
-	ex	de, hl		; (HERE) now in DE
-	ld	hl, (INPUTPOS)
-.loop:
-	ld	a, (hl)
-	or	a		; null? not cool
-	jp	z, abort
-	cp	'"'
-	jr	z, .loopend
-	ld	(de), a
-	inc	hl
-	inc	de
-	jr	.loop
-.loopend:
-	inc	hl		; inputpos to char afterwards
-	ld	(INPUTPOS), hl
-	; null-terminate LIT
-	inc	de
-	xor	a
-	ld	(de), a
-	ex	de, hl		; (HERE) in HL
-	ld	de, PRINT
-	call	DEinHL
-	ld	(HERE), hl
-	jp	next
-
-; ( c port -- )
-	.db "PC!"
-	.fill 4
-	.dw PRINTI
-	.db 0
-PSTORE:
-	.dw nativeWord
-	pop	bc
-	pop	hl
-	call	chkPS
-	out	(c), l
-	jp	next
-
-; ( port -- c )
-	.db "PC@"
-	.fill 4
-	.dw PSTORE
-	.db 0
-PFETCH:
-	.dw nativeWord
-	pop	bc
-	call	chkPS
-	ld	h, 0
-	in	l, (c)
-	push	hl
-	jp	next
-
-	.db	","
-	.fill	6
-	.dw	PFETCH
-	.db	0
-WR:
-	.dw	nativeWord
-	pop	de
-	call	chkPS
-	ld	hl, (HERE)
-	call	DEinHL
-	ld	(HERE), hl
-	jp	next
-
-
-; ( addr -- )
-	.db "EXECUTE"
-	.dw WR
-	.db 0
-EXECUTE:
-	.dw nativeWord
-	pop	iy	; is a wordref
-	call	chkPS
-	ld	l, (iy)
-	ld	h, (iy+1)
-	; HL points to code pointer
-	inc	iy
-	inc	iy
-	; IY points to PFA
-	jp	(hl)	; go!
-
-
-	.db	"[COMPIL"
-	.dw	EXECUTE
-	.db	1		; IMMEDIATE
-COMPILE:
-	.dw	compiledWord
-	.dw	FIND_
-	.dw	CSKIP
-	.dw	.maybeNum
-	.dw	DUP
-	.dw	ISIMMED
-	.dw	CSKIP
-	.dw	.word
-	; is immediate. just execute.
-	.dw	EXECUTE
-	.dw	EXIT
-
-	.db	0b10		; UNWORD
-.word:
-	.dw	compiledWord
-	.dw	WR
-	.dw	R2P		; exit COMPILE
-	.dw	DROP
-	.dw	EXIT
-
-	.db	0b10		; UNWORD
-.maybeNum:
-	.dw	compiledWord
-	.dw	PARSEI
-	.dw	LITN
-	.dw	R2P		; exit COMPILE
-	.dw	DROP
-	.dw	EXIT
-
-
-	.db	":"
-	.fill	6
-	.dw	COMPILE
-	.db	1		; IMMEDIATE
-DEFINE:
-	.dw nativeWord
-	call	entryhead
-	ld	de, compiledWord
-	call	DEinHL
-	ld	(HERE), hl
-.loop:
-	; did we reach ";"?
-	call	toword
-	ld	a, (hl)
-	cp	';'
-	jr	nz, .compile
-	inc	hl
-	ld	a, (hl)
-	cp	' '+1
-	jr	c, .loopend	; whitespace, we have semicol. end
-.compile:
-	ld	hl, (IP)
-	call	pushRS
-	ld	hl, .retRef
-	ld	(IP), hl
-	ld	hl, COMPILE
-	push	hl
-	jp	EXECUTE+2
-.loopend:
-	; Advance (INPUTPOS) to after semicol. HL is already there.
-	ld	(INPUTPOS), hl
-	; write EXIT and return
-	ld	hl, (HERE)
-	ld	de, EXIT
-	call	DEinHL
-	ld	(HERE), hl
-	jp	next
-.retRef:
-	.dw	$+2
-	.dw	$+2
-	call	popRSIP
-	jr	.loop
-
-
-	.db "DOES>"
-	.fill 2
-	.dw DEFINE
-	.db 0
-DOES:
-	.dw nativeWord
-	; We run this when we're in an entry creation context. Many things we
-	; need to do.
-	; 1. Change the code link to doesWord
-	; 2. Leave 2 bytes for regular cell variable.
-	; 3. Write down IP+2 to entry.
-	; 3. exit. we're done here.
-	ld	iy, (CURRENT)
-	ld	hl, doesWord
-	call	wrCompHL
-	inc	iy \ inc iy		; cell variable space
-	ld	hl, (IP)
-	call	wrCompHL
-	ld	(HERE), iy
-	jp	EXIT+2
-
-
-	.db "IMMEDIA"
-	.dw DOES
-	.db 0
-IMMEDIATE:
-	.dw nativeWord
-	ld	hl, (CURRENT)
-	dec	hl
-	set	FLAG_IMMED, (hl)
-	jp	next
-
-
-	.db	"IMMED?"
-	.fill	1
-	.dw	IMMEDIATE
-	.db	0
-ISIMMED:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	dec	hl
-	ld	de, 0
-	bit	FLAG_IMMED, (hl)
-	jr	z, .notset
-	inc	de
-.notset:
-	push	de
-	jp	next
-
-; ( n -- )
-	.db	"LITN"
-	.fill	3
-	.dw	ISIMMED
-	.db	0
-LITN:
-	.dw nativeWord
-	ld	hl, (HERE)
-	ld	de, NUMBER
-	call	DEinHL
-	pop	de		; number from stack
-	call	chkPS
-	call	DEinHL
-	ld	(HERE), hl
-	jp	next
-
-	.db	"LITS"
-	.fill	3
-	.dw	LITN
-	.db	1		; IMMEDIATE
-LITS:
-	.dw nativeWord
-	ld	hl, (HERE)
-	ld	de, LIT
-	call	DEinHL
-	ex	de, hl		; (HERE) in DE
-	call	readword
-	call	strcpyM
-	ld	(HERE), de
-	jp	next
-
-	.db	"(find)"
-	.fill	1
-	.dw	LITS
-	.db	0
-FIND_:
-	.dw	nativeWord
-	call	readword
-	call	find
-	jr	z, .found
-	; not found
-	push	hl
-	ld	de, 0
-	push	de
-	jp	next
-.found:
-	push	de
-	ld	de, 1
-	push	de
-	jp	next
-
-	.db	"'"
-	.fill	6
-	.dw	FIND_
-	.db	0
-FIND:
-	.dw	compiledWord
-	.dw	FIND_
-	.dw	CSKIP
-	.dw	FINDERR
-	.dw	EXIT
-
-	.db	"[']"
-	.fill	4
-	.dw	FIND
-	.db	0b01		; IMMEDIATE
-FINDI:
-	.dw	compiledWord
-	.dw	FIND_
-	.dw	CSKIP
-	.dw	FINDERR
-	.dw	LITN
-	.dw	EXIT
-
-	.db	0b10		; UNWORD
-FINDERR:
-	.dw	compiledWord
-	.dw	DROP		; Drop str addr, we don't use it
-	.dw	LIT
-	.db	"word not found", 0
-	.dw	PRINT
-	.dw	ABORT
-
-; ( -- c )
-	.db "KEY"
-	.fill 4
-	.dw FINDI
-	.db 0
-KEY:
-	.dw nativeWord
-	call	stdioGetC
-	ld	h, 0
-	ld	l, a
-	push	hl
-	jp	next
-
-	.db "WORD"
-	.fill 3
-	.dw KEY
-	.db 0
-WORD:
-	.dw nativeWord
-	call	readword
-	push	hl
-	jp	next
-
-
-	.db	"(parsed"
-	.dw	WORD
-	.db	0
-PARSED:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	call	parseDecimal
-	jr	z, .success
-	; error
-	ld	de, 0
-	push	de	; dummy
-	push	de	; flag
-	jp	next
-.success:
-	push	de
-	ld	de, 1		; flag
-	push	de
-	jp	next
-
-
-	.db	"(parse)"
-	.dw	PARSED
-	.db	0
-PARSE:
-	.dw	compiledWord
-	.dw	PARSED
-	.dw	CSKIP
-	.dw	.error
-	; success, stack is already good, we can exit
-	.dw	EXIT
-
-	.db	0b10		; UNWORD
-.error:
-	.dw	compiledWord
-	.dw	LIT
-	.db	"unknown word", 0
-	.dw	PRINT
-	.dw	ABORT
-
-
-; Indirect parse caller. Reads PARSEPTR and calls
-	.db	0b10		; UNWORD
-PARSEI:
-	.dw	compiledWord
-	.dw	PARSEPTR_
-	.dw	FETCH
-	.dw	EXECUTE
-	.dw	EXIT
-
-
-	.db "CREATE"
-	.fill 1
-	.dw PARSE
-	.db 0
-CREATE:
-	.dw nativeWord
-	call	entryhead
-	ld	de, cellWord
-	ld	(hl), e
-	inc	hl
-	ld	(hl), d
-	inc	hl
-	ld	(HERE), hl
-	jp	next
-
-	.db "HERE"
-	.fill 3
-	.dw CREATE
-	.db 0
-HERE_:	; Caution: conflicts with actual variable name
-	.dw sysvarWord
-	.dw HERE
-
-	.db "CURRENT"
-	.dw HERE_
-	.db 0
-CURRENT_:
-	.dw sysvarWord
-	.dw CURRENT
-
-	.db "(parse*"
-	.dw CURRENT_
-	.db 0
-PARSEPTR_:
-	.dw sysvarWord
-	.dw PARSEPTR
-
-	.db	"IN>"
-	.fill	4
-	.dw	PARSEPTR_
-	.db	0
-INP:
-	.dw	sysvarWord
-	.dw	INPUTPOS
-
-; ( n a -- )
-	.db "!"
-	.fill 6
-	.dw INP
-	.db 0
-STORE:
-	.dw nativeWord
-	pop	iy
-	pop	hl
-	call	chkPS
-	ld	(iy), l
-	ld	(iy+1), h
-	jp	next
-
-; ( n a -- )
-	.db "C!"
-	.fill 5
-	.dw STORE
-	.db 0
-CSTORE:
-	.dw nativeWord
-	pop	hl
-	pop	de
-	call	chkPS
-	ld	(hl), e
-	jp	next
-
-; ( a -- n )
-	.db "@"
-	.fill 6
-	.dw CSTORE
-	.db 0
-FETCH:
-	.dw nativeWord
-	pop	hl
-	call	chkPS
-	call	intoHL
-	push	hl
-	jp	next
-
-; ( a -- c )
-	.db "C@"
-	.fill 5
-	.dw FETCH
-	.db 0
-CFETCH:
-	.dw nativeWord
-	pop	hl
-	call	chkPS
-	ld	l, (hl)
-	ld	h, 0
-	push	hl
-	jp	next
-
-; ( a -- )
-	.db "DROP"
-	.fill 3
-	.dw CFETCH
-	.db 0
-DROP:
-	.dw nativeWord
-	pop	hl
-	jp	next
-
-; ( a b -- b a )
-	.db "SWAP"
-	.fill 3
-	.dw DROP
-	.db 0
-SWAP:
-	.dw nativeWord
-	pop	hl
-	call	chkPS
-	ex	(sp), hl
-	push	hl
-	jp	next
-
-; ( a b c d -- c d a b )
-	.db "2SWAP"
-	.fill 2
-	.dw SWAP
-	.db 0
-SWAP2:
-	.dw nativeWord
-	pop	de		; D
-	pop	hl		; C
-	pop	bc		; B
-	call	chkPS
-
-	ex	(sp), hl	; A in HL
-	push	de		; D
-	push	hl		; A
-	push	bc		; B
-	jp	next
-
-; ( a -- a a )
-	.db "DUP"
-	.fill 4
-	.dw SWAP2
-	.db 0
-DUP:
-	.dw nativeWord
-	pop	hl
-	call	chkPS
-	push	hl
-	push	hl
-	jp	next
-
-; ( a b -- a b a b )
-	.db "2DUP"
-	.fill 3
-	.dw DUP
-	.db 0
-DUP2:
-	.dw nativeWord
-	pop	hl	; B
-	pop	de	; A
-	call	chkPS
-	push	de
-	push	hl
-	push	de
-	push	hl
-	jp	next
-
-; ( a b -- a b a )
-	.db "OVER"
-	.fill 3
-	.dw DUP2
-	.db 0
-OVER:
-	.dw nativeWord
-	pop	hl	; B
-	pop	de	; A
-	call	chkPS
-	push	de
-	push	hl
-	push	de
-	jp	next
-
-; ( a b c d -- a b c d a b )
-	.db "2OVER"
-	.fill 2
-	.dw OVER
-	.db 0
-OVER2:
-	.dw nativeWord
-	pop	hl	; D
-	pop	de	; C
-	pop	bc	; B
-	pop	iy	; A
-	call	chkPS
-	push	iy	; A
-	push	bc	; B
-	push	de	; C
-	push	hl	; D
-	push	iy	; A
-	push	bc	; B
-	jp	next
-
-	.db	">R"
-	.fill	5
-	.dw	OVER2
-	.db	0
-P2R:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	call	pushRS
-	jp	next
-
-	.db	"R>"
-	.fill	5
-	.dw	P2R
-	.db	0
-R2P:
-	.dw	nativeWord
-	call	popRS
-	push	hl
-	jp	next
-
-	.db	"I"
-	.fill	6
-	.dw	R2P
-	.db	0
-I:
-	.dw	nativeWord
-	ld	l, (ix)
-	ld	h, (ix+1)
-	push	hl
-	jp	next
-
-	.db	"I'"
-	.fill	5
-	.dw	I
-	.db	0
-IPRIME:
-	.dw	nativeWord
-	ld	l, (ix-2)
-	ld	h, (ix-1)
-	push	hl
-	jp	next
-
-	.db	"J"
-	.fill	6
-	.dw	IPRIME
-	.db	0
-J:
-	.dw	nativeWord
-	ld	l, (ix-4)
-	ld	h, (ix-3)
-	push	hl
-	jp	next
-
-; ( a b -- c ) A + B
-	.db "+"
-	.fill 6
-	.dw J
-	.db 0
-PLUS:
-	.dw nativeWord
-	pop	hl
-	pop	de
-	call	chkPS
-	add	hl, de
-	push	hl
-	jp	next
-
-; ( a b -- c ) A - B
-	.db "-"
-	.fill 6
-	.dw PLUS
-	.db 0
-MINUS:
-	.dw nativeWord
-	pop	de		; B
-	pop	hl		; A
-	call	chkPS
-	or	a		; reset carry
-	sbc	hl, de
-	push	hl
-	jp	next
-
-; ( a b -- c ) A * B
-	.db "*"
-	.fill 6
-	.dw MINUS
-	.db 0
-MULT:
-	.dw nativeWord
-	pop	de
-	pop	bc
-	call	chkPS
-	call	multDEBC
-	push	hl
-	jp	next
-
-
-	.db	"/MOD"
-	.fill	3
-	.dw MULT
-	.db 0
-DIVMOD:
-	.dw nativeWord
-	pop	de
-	pop	hl
-	call	chkPS
-	call	divide
-	push	hl
-	push	bc
-	jp	next
-
-; ( a1 a2 -- b )
-	.db "SCMP"
-	.fill 3
-	.dw DIVMOD
-	.db 0
-SCMP:
-	.dw nativeWord
-	pop	de
-	pop	hl
-	call	chkPS
-	call	strcmp
-	call	flagsToBC
-	push	bc
-	jp	next
-
-; ( n1 n2 -- f )
-	.db "CMP"
-	.fill 4
-	.dw SCMP
-	.db 0
-CMP:
-	.dw nativeWord
-	pop	hl
-	pop	de
-	call	chkPS
-	or	a	; clear carry
-	sbc	hl, de
-	call	flagsToBC
-	push	bc
-	jp	next
-
-	.db	"SKIP?"
-	.fill	2
-	.dw	CMP
-	.db	0
-CSKIP:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	ld	a, h
-	or	l
-	jp	z, next		; False, do nothing.
-	ld	hl, (IP)
-	call	compSkip
-	ld	(IP), hl
-	jp	next
-
-; This word's atom is followed by 1b *relative* offset (to the cell's addr) to
-; where to branch to. For example, The branching cell of "IF THEN" would
-; contain 3. Add this value to RS.
-	.db	"(fbr)"
-	.fill	2
-	.dw	CSKIP
-	.db	0
-FBR:
-	.dw	nativeWord
-	push	de
-	ld	hl, (IP)
-	ld	a, (hl)
-	call	addHL
-	ld	(IP), hl
-	pop	de
-	jp	next
-
-	.db	"(bbr)"
-	.fill	2
-	.dw	FBR
-	.db	0
-BBR:
-	.dw	nativeWord
-	ld	hl, (IP)
-	ld	d, 0
-	ld	e, (hl)
-	or	a		; clear carry
-	sbc	hl, de
-	ld	(IP), hl
-	jp	next
-
-LATEST:
-	.dw BBR

forth/main.asm

@@ -1,134 +0,0 @@
-; *** Const ***
-; Base of the Return Stack
-.equ	RS_ADDR		0xf000
-; Number of bytes we keep as a padding between HERE and the scratchpad
-.equ	PADDING		0x20
-; Max length of dict entry names
-.equ	NAMELEN		7
-; Offset of the code link relative to the beginning of the word
-.equ	CODELINK_OFFSET	NAMELEN+3
-
-; Flags for the "flag field" of the word structure
-; IMMEDIATE word
-.equ	FLAG_IMMED	0
-; This wordref is not a regular word (it's not preceeded by a name). It's one
-; of the NUMBER, LIT, BRANCH etc. entities.
-.equ	FLAG_UNWORD	1
-
-; *** Variables ***
-.equ	INITIAL_SP	FORTH_RAMSTART
-; wordref of the last entry of the dict.
-.equ	CURRENT		@+2
-; Pointer to the next free byte in dict.
-.equ	HERE		@+2
-; Interpreter pointer. See Execution model comment below.
-.equ	IP		@+2
-; Pointer to where we currently are in the interpretation of the current line.
-.equ	INPUTPOS	@+2
-; Pointer to the system's number parsing function. It points to then entry that
-; had the "(parse)" name at startup. During stage0, it's out builtin PARSE,
-; but at stage1, it becomes "(parse)" from core.fs. It can also be changed at
-; runtime.
-.equ	PARSEPTR	@+2
-.equ	FORTH_RAMEND	@+2
-
-; (HERE) usually starts at RAMEND, but in certain situations, such as in stage0,
-; (HERE) will begin at a strategic place.
-.equ	HERE_INITIAL	FORTH_RAMEND
-
-; EXECUTION MODEL
-; After having read a line through stdioReadLine, we want to interpret it. As
-; a general rule, we go like this:
-;
-; 1. read single word from line
-; 2. Can we find the word in dict?
-; 3. If yes, execute that word, goto 1
-; 4. Is it a number?
-; 5. If yes, push that number to PS, goto 1
-; 6. Error: undefined word.
-;
-; EXECUTING A WORD
-;
-; At it's core, executing a word is having the wordref in IY and call
-; EXECUTE. Then, we let the word do its things. Some words are special,
-; but most of them are of the compiledWord type, and that's their execution that
-; we describe here.
-;
-; First of all, at all time during execution, the Interpreter Pointer (IP)
-; points to the wordref we're executing next.
-;
-; When we execute a compiledWord, the first thing we do is push IP to the Return
-; Stack (RS). Therefore, RS' top of stack will contain a wordref to execute
-; next, after we EXIT.
-;
-; At the end of every compiledWord is an EXIT. This pops RS, sets IP to it, and
-; continues.
-
-; *** Code ***
-forthMain:
-	; STACK OVERFLOW PROTECTION:
-	; To avoid having to check for stack underflow after each pop operation
-	; (which can end up being prohibitive in terms of costs), we give
-	; ourselves a nice 6 bytes buffer. 6 bytes because we seldom have words
-	; requiring more than 3 items from the stack. Then, at each "exit" call
-	; we check for stack underflow.
-	push	af \ push af \ push af
-	ld	(INITIAL_SP), sp
-	; LATEST is a *indirect* label to the latest entry of the dict. See
-	; default at the bottom of dict.asm. This indirection allows us to
-	; override latest to a value set in a binary dict compiled separately,
-	; for example by the stage0 bin.
-	ld	hl, LATEST
-	call	intoHL
-	ld	(CURRENT), hl
-	ld	hl, HERE_INITIAL
-	ld	(HERE), hl
-	; Set (INPUTPOS) to somewhere where there's a NULL so we consider
-	; ourselves EOL.
-	ld	(INPUTPOS), hl
-	xor	a
-	ld	(hl), a
-	; Set up PARSEPTR
-	ld	hl, PARSE-CODELINK_OFFSET
-	call	find
-	ld	(PARSEPTR), de
-forthRdLine:
-	ld	hl, msgOk
-	call	printstr
-forthRdLineNoOk:
-	; Setup return stack. After INTERPRET, we run forthExecLine
-	ld	ix, RS_ADDR
-	ld	hl, MAINLOOP
-	push	hl
-	jp	EXECUTE+2
-
-	.db	0b10		; UNWORD
-INTERPRET:
-	.dw	compiledWord
-	.dw	FIND_
-	.dw	CSKIP
-	.dw	.maybeNum
-	; It's a word, execute it
-	.dw	EXECUTE
-	.dw	EXIT
-
-.maybeNum:
-	.dw	compiledWord
-	.dw	PARSEI
-	.dw	R2P		; exit INTERPRET
-	.dw	DROP
-	.dw	EXIT
-
-	.db	0b10		; UNWORD
-MAINLOOP:
-	.dw	compiledWord
-	.dw	INTERPRET
-	.dw	INP
-	.dw	FETCH
-	.dw	CFETCH
-	.dw	CSKIP
-	.dw	QUIT
-	.dw	MAINLOOP
-
-msgOk:
-	.db	" ok", 0

forth/stack.asm

@@ -1,66 +0,0 @@
-; The Parameter stack (PS) is maintained by SP and the Return stack (RS) is
-; maintained by IX. This allows us to generally use push and pop freely because
-; PS is the most frequently used. However, this causes a problem with routine
-; calls: because in Forth, the stack isn't balanced within each call, our return
-; offset, when placed by a CALL, messes everything up. This is one of the
-; reasons why we need stack management routines below. IX always points to RS'
-; Top Of Stack (TOS)
-;
-; This return stack contain "Interpreter pointers", that is a pointer to the
-; address of a word, as seen in a compiled list of words.
-
-; Push value HL to RS
-pushRS:
-	inc	ix
-	inc	ix
-	ld	(ix), l
-	ld	(ix+1), h
-	ret
-
-; Pop RS' TOS to HL
-popRS:
-	ld	l, (ix)
-	ld	h, (ix+1)
-	dec ix
-	dec ix
-	ret
-
-popRSIP:
-	call	popRS
-	ld	(IP), hl
-	ret
-
-; Skip the next two bytes in RS' TOS
-skipRS:
-	push	hl
-	ld	l, (ix)
-	ld	h, (ix+1)
-	inc	hl \ inc hl
-	ld	(ix), l
-	ld	(ix+1), h
-	pop	hl
-	ret
-
-; Verifies that SP and RS are within bounds. If it's not, call ABORT
-chkRS:
-	push	ix \ pop hl
-	push	de		; --> lvl 1
-	ld	de, RS_ADDR
-	or	a		; clear carry
-	sbc	hl, de
-	pop	de		; <-- lvl 1
-	jp	c, abortUnderflow
-	ret
-
-chkPS:
-	push	hl
-	ld	hl, (INITIAL_SP)
-	; We have the return address for this very call on the stack and
-	; protected registers. Let's compensate
-	dec	hl \ dec hl
-	dec	hl \ dec hl
-	or	a		; clear carry
-	sbc	hl, sp
-	pop	hl
-	ret	nc		; (INITIAL_SP) >= SP? good
-	jp	abortUnderflow

forth/util.asm

@@ -1,486 +0,0 @@
-; *** Collapse OS lib copy ***
-; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
-; Forth and the concept of ASM libs will become obsolete. To facilitate this
-; transition, I make, right now, a copy of the routines actually used by Forth's
-; native core. This also has the effect of reducing binary size right now and
-; give us an idea of Forth's compactness.
-; These routines below are copy/paste from apps/lib.
-
-; Ensures that Z is unset (more complicated than it sounds...)
-; There are often better inline alternatives, either replacing rets with
-; appropriate jmps, or if an 8 bit register is known to not be 0, an inc
-; then a dec. If a is nonzero, 'or a' is optimal.
-unsetZ:
-	or 	a	;if a nonzero, Z reset
-	ret	nz
-	cp 	1	;if a is zero, Z reset
-	ret
-
-; copy (HL) into DE, then exchange the two, utilising the optimised HL instructions.
-; ld must be done little endian, so least significant byte first.
-intoHL:
-	push 	de
-	ld 	e, (hl)
-	inc 	hl
-	ld 	d, (hl)
-	ex 	de, hl
-	pop 	de
-	ret
-
-intoDE:
-	ex 	de, hl
-	call 	intoHL
-	ex 	de, hl		; de preserved by intoHL, so no push/pop needed
-	ret
-
-; add the value of A into HL
-; affects carry flag according to the 16-bit addition, Z, S and P untouched.
-addHL:
-	push	de
-	ld 	d, 0
-	ld	e, a
-	add	hl, de
-	pop	de
-	ret
-
-; make Z the opposite of what it is now
-toggleZ:
-	jp	z, unsetZ
-	cp	a
-	ret
-
-; Copy string from (HL) in (DE), that is, copy bytes until a null char is
-; encountered. The null char is also copied.
-; HL and DE point to the char right after the null char.
-strcpyM:
-	ld	a, (hl)
-	ld	(de), a
-	inc	hl
-	inc	de
-	or	a
-	jr	nz, strcpyM
-	ret
-
-; Like strcpyM, but preserve HL and DE
-strcpy:
-	push	hl
-	push	de
-	call	strcpyM
-	pop	de
-	pop	hl
-	ret
-
-; Compares strings pointed to by HL and DE until one of them hits its null char.
-; If equal, Z is set. If not equal, Z is reset. C is set if HL > DE
-strcmp:
-	push	hl
-	push	de
-
-.loop:
-	ld	a, (de)
-	cp	(hl)
-	jr	nz, .end	; not equal? break early. NZ is carried out
-				; to the caller
-	or	a		; If our chars are null, stop the cmp
-	inc	hl
-	inc	de
-	jr	nz, .loop	; Z is carried through
-
-.end:
-	pop	de
-	pop	hl
-	; Because we don't call anything else than CP that modify the Z flag,
-	; our Z value will be that of the last cp (reset if we broke the loop
-	; early, set otherwise)
-	ret
-
-; Compares strings pointed to by HL and DE up to A count of characters. If
-; equal, Z is set. If not equal, Z is reset.
-strncmp:
-	push	bc
-	push	hl
-	push	de
-
-	ld	b, a
-.loop:
-	ld	a, (de)
-	cp	(hl)
-	jr	nz, .end	; not equal? break early. NZ is carried out
-				; to the called
-	cp	0		; If our chars are null, stop the cmp
-	jr	z, .end		; The positive result will be carried to the
-	                        ; caller
-	inc	hl
-	inc	de
-	djnz	.loop
-	; We went through all chars with success, but our current Z flag is
-	; unset because of the cp 0. Let's do a dummy CP to set the Z flag.
-	cp	a
-
-.end:
-	pop	de
-	pop	hl
-	pop	bc
-	; Because we don't call anything else than CP that modify the Z flag,
-	; our Z value will be that of the last cp (reset if we broke the loop
-	; early, set otherwise)
-	ret
-
-; Given a string at (HL), move HL until it points to the end of that string.
-strskip:
-	push	bc
-	ex	af, af'
-	xor	a	; look for null char
-	ld	b, a
-	ld	c, a
-	cpir	; advances HL regardless of comparison, so goes one too far
-	dec	hl
-	ex	af, af'
-	pop	bc
-	ret
-
-; Borrowed from Tasty Basic by Dimitri Theulings (GPL).
-; Divide HL by DE, placing the result in BC and the remainder in HL.
-divide:
-	push hl		; --> lvl 1
-	ld l, h		; divide h by de
-	ld h, 0
-	call .dv1
-	ld b, c		; save result in b
-	ld a, l		; (remainder + l) / de
-	pop hl		; <-- lvl 1
-	ld h, a
-.dv1:
-	ld c, 0xff	; result in c
-.dv2:
-	inc c		; dumb routine
-	call .subde	; divide using subtract and count
-	jr nc, .dv2
-	add hl, de
-	ret
-.subde:
-	ld a, l
-	sub e		; subtract de from hl
-	ld l, a
-	ld a, h
-	sbc a, d
-	ld h, a
-	ret
-
-; DE * BC -> DE (high) and HL (low)
-multDEBC:
-	ld	hl, 0
-	ld	a, 0x10
-.loop:
-	add	hl, hl
-	rl	e
-	rl	d
-	jr	nc, .noinc
-	add	hl, bc
-	jr	nc, .noinc
-	inc	de
-.noinc:
-	dec a
-	jr	nz, .loop
-	ret
-
-; Parse string at (HL) as a decimal value and return value in DE.
-; Reads as many digits as it can and stop when:
-; 1 - A non-digit character is read
-; 2 - The number overflows from 16-bit
-; HL is advanced to the character following the last successfully read char.
-; Error conditions are:
-; 1 - There wasn't at least one character that could be read.
-; 2 - Overflow.
-; Sets Z on success, unset on error.
-
-parseDecimal:
-	; First char is special: it has to succeed.
-	ld	a, (hl)
-	; Parse the decimal char at A and extract it's 0-9 numerical value. Put the
-	; result in A.
-	; On success, the carry flag is reset. On error, it is set.
-	add	a, 0xff-'9'	; maps '0'-'9' onto 0xf6-0xff
-	sub	0xff-9		; maps to 0-9 and carries if not a digit
-	ret	c		; Error. If it's C, it's also going to be NZ
-	; During this routine, we switch between HL and its shadow. On one side,
-	; we have HL the string pointer, and on the other side, we have HL the
-	; numerical result. We also use EXX to preserve BC, saving us a push.
-	exx		; HL as a result
-	ld	h, 0
-	ld	l, a	; load first digit in without multiplying
-
-.loop:
-	exx		; HL as a string pointer
-	inc hl
-	ld a, (hl)
-	exx		; HL as a numerical result
-
-	; same as other above
-	add	a, 0xff-'9'
-	sub	0xff-9
-	jr	c, .end
-
-	ld	b, a	; we can now use a for overflow checking
-	add	hl, hl	; x2
-	sbc	a, a	; a=0 if no overflow, a=0xFF otherwise
-	ld	d, h
-	ld	e, l		; de is x2
-	add	hl, hl	; x4
-	rla
-	add	hl, hl	; x8
-	rla
-	add	hl, de	; x10
-	rla
-	ld	d, a	; a is zero unless there's an overflow
-	ld	e, b
-	add	hl, de
-	adc	a, a	; same as rla except affects Z
-	; Did we oveflow?
-	jr	z, .loop	; No? continue
-	; error, NZ already set
-	exx		; HL is now string pointer, restore BC
-	; HL points to the char following the last success.
-	ret
-
-.end:
-	push	hl	; --> lvl 1, result
-	exx		; HL as a string pointer, restore BC
-	pop	de	; <-- lvl 1, result
-	cp	a	; ensure Z
-	ret
-
-; *** Forth-specific part ***
-; Return address of scratchpad in HL
-pad:
-	ld	hl, (HERE)
-	ld	a, PADDING
-	jp	addHL
-
-; Advance (INPUTPOS) until a non-whitespace is met. If needed,
-; call fetchline.
-; Set HL to newly set (INPUTPOS)
-toword:
-	ld	hl, (INPUTPOS)
-	; skip leading whitespace
-	dec	hl	; offset leading "inc hl"
-.loop:
-	inc	hl
-	ld	a, (hl)
-	or	a
-	; When at EOL, fetch a new line directly
-	jr	z, .empty
-	cp	' '+1
-	jr	c, .loop
-	ret
-.empty:
-	call	fetchline
-	jr	toword
-
-; Read word from (INPUTPOS) and return, in HL, a null-terminated word.
-; Advance (INPUTPOS) to the character following the whitespace ending the
-; word.
-; When we're at EOL, we call fetchline directly, so this call always returns
-; a word.
-readword:
-	call	toword
-	push	hl		; --> lvl 1. that's our result
-.loop:
-	inc	hl
-	ld	a, (hl)
-	; special case: is A null? If yes, we will *not* inc A so that we don't
-	; go over the bounds of our input string.
-	or	a
-	jr	z, .noinc
-	cp	' '+1
-	jr	nc, .loop
-	; we've just read a whitespace, HL is pointing to it. Let's transform
-	; it into a null-termination, inc HL, then set (INPUTPOS).
-	xor	a
-	ld	(hl), a
-	inc	hl
-.noinc:
-	ld	(INPUTPOS), hl
-	pop	hl		; <-- lvl 1. our result
-	ret	; Z set from XOR A
-
-; Sets Z if (HL) == E and (HL+1) == D
-HLPointsDE:
-	ld	a, (hl)
-	cp	e
-	ret	nz		; no
-	inc	hl
-	ld	a, (hl)
-	dec	hl
-	cp	d		; Z has our answer
-	ret
-
-
-HLPointsNUMBER:
-	push	de
-	ld	de, NUMBER
-	call	HLPointsDE
-	pop	de
-	ret
-
-HLPointsLIT:
-	push	de
-	ld	de, LIT
-	call	HLPointsDE
-	pop	de
-	ret
-
-HLPointsBR:
-	push	de
-	ld	de, FBR
-	call	HLPointsDE
-	jr	z, .end
-	ld	de, BBR
-	call	HLPointsDE
-.end:
-	pop	de
-	ret
-
-; Skip the compword where HL is currently pointing. If it's a regular word,
-; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
-; to after null-termination.
-compSkip:
-	call	HLPointsNUMBER
-	jr	z, .isNum
-	call	HLPointsBR
-	jr	z, .isBranch
-	call	HLPointsLIT
-	jr	nz, .isWord
-	; We have a literal
-	inc	hl \ inc hl
-	call	strskip
-	inc	hl		; byte after word termination
-	ret
-.isNum:
-	; skip by 4
-	inc	hl
-	; continue to isBranch
-.isBranch:
-	; skip by 3
-	inc	hl
-	; continue to isWord
-.isWord:
-	; skip by 2
-	inc	hl \ inc hl
-	ret
-
-; Find the entry corresponding to word where (HL) points to and sets DE to
-; point to that entry.
-; Z if found, NZ if not.
-find:
-	push	hl
-	push	bc
-	ld	de, (CURRENT)
-	ld	bc, CODELINK_OFFSET
-.inner:
-	; DE is a wordref, let's go to beginning of struct
-	push	de		; --> lvl 1
-	or	a		; clear carry
-	ex	de, hl
-	sbc	hl, bc
-	ex	de, hl		; We're good, DE points to word name
-	ld	a, NAMELEN
-	call	strncmp
-	pop	de		; <-- lvl 1, return to wordref
-	jr	z, .end		; found
-	call	.prev
-	jr	nz, .inner
-	; Z set? end of dict unset Z
-	inc	a
-.end:
-	pop	bc
-	pop	hl
-	ret
-
-; For DE being a wordref, move DE to the previous wordref.
-; Z is set if DE point to 0 (no entry). NZ if not.
-.prev:
-	dec	de \ dec de \ dec de	; prev field
-	call	intoDE
-	; DE points to prev. Is it zero?
-	xor	a
-	or	d
-	or	e
-	; Z will be set if DE is zero
-	ret
-
-; Write compiled data from HL into IY, advancing IY at the same time.
-wrCompHL:
-	ld	(iy), l
-	inc	iy
-	ld	(iy), h
-	inc	iy
-	ret
-
-; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
-; HL points to new (HERE)
-entryhead:
-	call	readword
-	ld	de, (HERE)
-	call	strcpy
-	ex	de, hl		; (HERE) now in HL
-	ld	de, (CURRENT)
-	ld	a, NAMELEN
-	call	addHL
-	call	DEinHL
-	; Set word flags: not IMMED, not UNWORD, so it's 0
-	xor	a
-	ld	(hl), a
-	inc	hl
-	ld	(CURRENT), hl
-	ld	(HERE), hl
-	ret
-
-; Sets Z if wordref at HL is of the IMMEDIATE type
-HLisIMMED:
-	dec	hl
-	bit	FLAG_IMMED, (hl)
-	inc	hl
-	; We need an invert flag. We want to Z to be set when flag is non-zero.
-	jp	toggleZ
-
-; Sets Z if wordref at HL is of the UNWORD type
-HLisUNWORD:
-	dec	hl
-	bit	FLAG_UNWORD, (hl)
-	inc	hl
-	; We need an invert flag. We want to Z to be set when flag is non-zero.
-	jp	toggleZ
-
-; Sets Z if wordref at (HL) is of the IMMEDIATE type
-HLPointsUNWORD:
-	push	hl
-	call	intoHL
-	call	HLisUNWORD
-	pop	hl
-	ret
-
-; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise
-flagsToBC:
-	ld	bc, 0
-	ret	z	; equal
-	inc	bc
-	ret	m	; >
-	; <
-	dec	bc
-	dec	bc
-	ret
-
-; Write DE in (HL), advancing HL by 2.
-DEinHL:
-	ld	(hl), e
-	inc	hl
-	ld	(hl), d
-	inc	hl
-	ret
-
-fetchline:
-	call	printcrlf
-	call	stdioReadLine
-	ld	(INPUTPOS), hl
-	ret