Source

dcpu-16-forth / forth-core.dasm

Full commit
; FORTH core
; by Nick Meharry

include 'macros.dcpu.inc'
include 'macros.forth.inc'

LABEL DOCOL
	PUSHRSP I
	ADD A, 0x4
	SET I, A
	NEXT

LABEL START
	SET I, COLD_START
	NEXT

LABEL COLD_START

; Stack manipulation

	DEFCODE "DROP",4,,DROP
	ADD SP, 1	; Drop the top of the stack.
	NEXT

	DEFCODE "SWAP",4,,SWAP
	SET A, POP	; Swap top two elements on stack.
	SET B, POP
	SET PUSH, A
	SET PUSH, B
	NEXT

	DEFCODE "DUP",3,,DUP
	SET PUSH, PEEK	; Duplicate the top element of the stack.
	NEXT

	DEFCODE "OVER",4,,OVER
	SET A, POP	; Duplicate the second to top element to the top of the stack.
	SET B, PEEK
	SET PUSH, A
	SET PUSH, B
	NEXT

	DEFCODE "ROT",3,,ROT
	SET A, POP	; Moves the third from top to the top of the stack.
	SET B, POP	; Example:
	SET C, POP	; * Before:	1 2 3
	SET PUSH, B	; * After:	3 1 2
	SET PUSH, A
	SET PUSH, C
	NEXT

	DEFCODE "-ROT",4,,NROT
	SET A, POP	; Moves the top behind the next two on the stack.
	SET B, POP	; Example:
	SET C, POP	; * Before:	1 2 3
	SET PUSH, A	; * After:	2 3 1
	SET PUSH, C
	SET PUSH, B
	NEXT

	DEFCODE "2DROP",5,,TWODROP
	ADD SP, 2	; Drops the top two items on the stack.
	NEXT

	DEFCODE "2DUP",4,,TWODUP
	SET A, POP	; Duplicates the top two items on the stack.
	SET PUSH, PEEK
	SET PUSH, A
	NEXT

	DEFCODE "2SWAP",5,,TWOSWAP
	SET A, POP	; Swap the top two pairs of elements from the stack
	SET B, POP	; Example:
	SET X, POP	; * Before:	1 2 3 4
	SET Y, POP	; * After:	3 4 1 2
	SET PUSH, B
	SET PUSH, A
	SET PUSH, Y
	SET PUSH, X
	NEXT

	DEFCODE "?DUP",4,,QDUP
	IFN PEEK, 0	; Duplicate the top of the stack if it's not zero.
	SET PUSH, PEEK
	NEXT

; Math operators

	DEFCODE "1+",2,,INCR
	SET A, POP	; You might be able to do this in one instruction,
	ADD A, 1	; but I'm not sure about negative numbers, so I'm
	SET PUSH, A	; leaving all of these as stack ops.
	NEXT

	DEFCODE "1-",2,,DECR
	SET A, POP
	SUB A, 1
	SET PUSH, A
	NEXT

	DEFCODE "4+",2,,INCR4
	SET A, POP
	ADD A, 4
	SET PUSH, A
	NEXT

	DEFCODE "4-",2,,DECR4
	SET A, POP
	SUB A, 4
	SET PUSH, A
	NEXT

	DEFCODE "+",1,,ADD
	SET A, POP
	ADD PEEK, A
	NEXT

	DEFCODE "-",1,,SUB
	SET A, POP
	SUB PEEK, A
	NEXT

	DEFCODE "*",1,,MUL
	SET A, POP
	MUL PEEK, A	; Ignoring overflow
	NEXT

	; The guide I'm following implements / and MOD as derivatives of /MOD,
	; however, the DCPU-16 lacks a divmod operator, so I have to do
	; these seperately.
	DEFCODE "/",1,,DIV
	SET A, POP
	DIV PEEK, A
	NEXT

	DEFCODE "MOD",3,,MOD
	SET A, POP
	MOD PEEK, A
	NEXT

	DEFCODE "/MOD",4,,DIVMOD
	SET X, PEEK
	SET Y, POP
	SET A, POP
	DIV X, B
	MOD Y, B
	SET PUSH, Y
	SET PUSH, X
	NEXT

; Comparisons
TRUE = 0xFFFF
FALSE = 0x0000

	DEFCODE "=",1,,EQU
	SET A, FALSE
	IFE POP, POP
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE "<>",2,,NEQU
	SET A, FALSE
	IFN POP, POP
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE "<",1,,LT
	SET A, FALSE
	SET X, POP
	SET Y, POP
	IFG Y, X
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE ">",1,,GT
	SET A, FALSE
	IFG POP, POP
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE "<=",2,,LE
	SET A, FALSE
	SET X, POP
	SET Y, POP
	IFE X, Y
		SET A, TRUE
	IFG Y, X
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE ">=",2,,GE
	SET A, FALSE
	SET X, POP
	SET Y, POP
	IFE X, Y
		SET A, TRUE
	IFG X, Y
		SET A, TRUE
	SET PUSH, A
	NEXT

; Comparisons with Zero

	DEFCODE "0=",2,,ZEQU
	SET A, FALSE
	IFE 0, POP
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE "0<>",3,,ZNEQU
	SET A, FALSE
	IFN 0, POP
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE "0<",2,,ZLT
	SET A, FALSE
	IFG 0, POP
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE "0>",2,,ZGT
	SET A, FALSE
	IFG POP, 0
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE "0<=",3,,ZLE
	SET A, FALSE
	SET B, POP
	IFG 0, B
		SET A, TRUE
	IFE 0, B
		SET A, TRUE
	SET PUSH, A
	NEXT

	DEFCODE "0>=",3,,ZGE
	SET A, FALSE
	SET B, POP
	IFG B, 0
		SET A, TRUE
	IFE B, 0
		SET A, TRUE
	SET PUSH, A
	NEXT

; Bitwise ops

	DEFCODE "AND",3,,AND
	SET A, POP
	AND PEEK, A
	NEXT

	DEFCODE "OR",2,,OR
	SET A, POP
	BOR PEEK, A
	NEXT

	DEFCODE "XOR",3,,XOR
	SET A, POP
	XOR PEEK, A
	NEXT

	DEFCODE "INVERT",6,,INVERT
	XOR PEEK, TRUE	; I think xor'ing with all ones negates.
	NEXT

; The all important EXIT function

	DEFCODE "EXIT",4,,EXIT
	POPRSP I
	NEXT

; Dealing with literals

	DEFCODE "LIT",3,,LIT
	SET PUSH, [I]
	ADD I, 1
	NEXT

; Direct memory access

	DEFCODE "!",1,,STORE
	SET A, POP
	SET B, POP
	SET [A], B
	NEXT

	DEFCODE "@",1,,FETCH
	SET A, POP
	SET PUSH, [A]
	NEXT

	DEFCODE "+!",2,,ADDSTORE
	SET A, POP
	SET B, POP
	ADD [A], B
	NEXT

	DEFCODE "-!",2,,SUBSTORE
	SET A, POP
	SET B, POP
	SUB [A], B
	NEXT

; I'm skipping the byte-level memory manipulation, as the DCPU-16
; only addresses by word.

; Variables
; There are 5 built in variables:
; * STATE	Is the interpreter executing code (0), or compiling a word (non-zero)
; * LATEST	Pointer to the last defined word
; * HERE	Pointer to the next free word of memory
; * S0		Pointer to the top of the address stack
; * BASE	The current base for reading and printing numbers

	DEFVAR "STATE",5,,STATE
	DEFVAR "LATEST",6,,LATEST,name_BASE_
	DEFVAR "HERE",4,,HERE
	DEFVAR "S0",2,,SZ
	DEFVAR "BASE",4,,BASE,10