; aaforth1.z80
; Z80 Forth in Z80DT Assembler
; Autor: Andre Adrian
; Version 23jan2011

; Z80 Register Benutzung ist wie bei CamelForth von Bradford Rodriguez:
; Forth	Z80	Kommentar
; IP	DE	Interpreter Pointer
; PSP	SP	Parameter Stack Pointer
; RSP	IX	Return Stack Pointer
; TOS	BC	Top of Stack, der oberste Parameter Stack Wert
; W	HL	Working Register, ist in einer Forth Funktion frei benutzbar
; UP	IY	User Pointer, Task User Area Pointer, noch nicht benutzt

; =============================================================
; Initialisierung
	ORG	1800H		; Z80DT simuliert Micro Professor 
				; mit seinem Speicherlayout
INIT:
	LD	SP,1E80H	; Init Parameter Stack Pointer
	LD	IX,1F00H	; Init Return Stack Pointer
	CALL	ENTERHL		; Eine Hochsprache Funktion anspringen
	DEFW	T03		; Aufruf Hochsprache Funktion T03
	DEFW	BYE		; Aufruf Primitive Funktion BYE

; =============================================================
; Beginn des Forth Lexikon

; : ENTER ( -- ) ;		\ Forth Hochsprache Funktion Aufruf
ENTER1:
	DEFM	'ENTE'
	DEFB	'R'+80h		; Das letzte Zeichen im Name hat High Bit gesetzt
	DEFW	0		; Ende des Lexikons
ENTER:
	DEC	IX		; Push IP auf den Return Stack
        LD	(IX+0),D
        DEC	IX
        LD	(IX+0),E
ENTERHL:
        POP	HL      	; Hole Adresse der Threaded Code Liste
	JP	NEXTHL
	
; : EXIT ( -- ) ;		\ Forth Hochsprache Funktion Return
EXIT1:
	DEFM	'EXI'	
	DEFB	'T'+80h
	DEFW	ENTER1
EXIT:
        LD	E,(IX+0) 	; Pop IP von dem Return Stack
        INC	IX
        LD	D,(IX+0)
	INC	IX
	JP	NEXT
	
; : NEXT ( -- ) ;		\ Forth Primitive Return
NEXT1:	
	DEFM	'NEX'	
	DEFB	'T'+80h
	DEFW	EXIT1	
NEXT:	
	EX 	DE,HL		; IP -> W
NEXTHL:
	LD	E,(HL)		; Lade Threaded Code Adresse nach DE
	INC	HL    		; bewege IP zu folgenden Befehl
	LD	D,(HL)
        INC	HL
        EX	DE,HL  		; W -> IP
        JP	(HL)		; Forth-Funktion Aufruf

; : BYE ( -- ) ;		\ Forth verlassen
BYE1:
	DEFM	'BY'	
	DEFB	'E'+80h
	DEFW	NEXT1
BYE:
	HALT			; Simulator anhalten

; : - ( n1 n2 -- diff ) ;	\ diff ist NOS-TOS
MINUS1:
	DEFB	'-'+80h
	DEFW	BYE1		; Lexikon Link
MINUS:
	POP	HL		; in Forth-Funktion ist HL frei benutzbar
	AND	A		; hat Seiteneffekt Reset Carry Flag
	SBC	HL,BC
	LD	C,L		; Ergebnis nach BC (TOS)
	LD	B,H
	JP      NEXT		; Primitive Return

; : LIT ( -- n ) ;		\ lege Konstante auf Stack	
LIT1:
	DEFM	'LI'
	DEFB	'T'+80h	
	DEFW	MINUS1
LIT:
	PUSH	BC		; alter TOS wird NOS
	EX	DE,HL		; IP -> W
	LD	C,(HL)		; Konstante nach TOS
	INC	HL
	LD	B,(HL)
	INC	HL
	EX	DE,HL		; W -> IP
	JP	NEXT

; =============================================================
; Beginn der Test-Funktionen

; : T01 7000 2000 1000 ;	\ lege 3 Konstanten auf den Parameter-Stack
T011:
	DEFM	'T0'
	DEFB	'1'+80h
	DEFW	LIT1
T01:
	CALL	ENTER		; CALL legt Adresse von Threaded Code Liste
				; auf Parameter Stack
	DEFW	LIT,7000
	DEFW	LIT,2000
	DEFW	LIT,1000
	DEFW	EXIT		; Hochsprache Return
	
; : T02 - - ;			\ subtrahiere drei Zahlen 
T021:
	DEFM	'T0'
	DEFB	'2'+80h
	DEFW	T011
T02:
	CALL	ENTER
	DEFW	MINUS
	DEFW	MINUS
	DEFW	EXIT

; : T03 T01 T02 ;		\ Berechne 7000-2000-1000 = 4000
T031:
	DEFM	'T0'
	DEFB	'3'+80h
	DEFW	T021
T03:
	CALL	ENTER
	DEFW	T01
	DEFW	T02
	DEFW	EXIT

	END