; aaforth1.85
; 8085 Forth in Z80DT Assembler
; Autor: Andre Adrian
; Version 06feb2011

; 8085 Register Benutzung ist aehnlich zu CamelForth von Bradford Rodriguez:
; Forth	8085	Kommentar
; IP	DE	Interpreter Pointer
; PSP	SP	Parameter Stack Pointer
; RSP	Memory	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	Memory	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
	CALL	ENTERHL		; Eine Hochsprache Funktion anspringen
	DEFW	T03		; Aufruf Hochsprache Funktion T03
	DEFW	BYE		; Aufruf Primitive Funktion BYE

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

RSP:	DEFW	1F00H		; Init Return Stack Pointer

; : 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:
	LD	HL,(RSP)
	DEC	HL		; Push IP auf den Return Stack
        LD	(HL),D
        DEC	HL
        LD	(HL),E
	LD	(RSP),HL
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	HL,(RSP)
        LD	E,(HL) 		; Pop IP von dem Return Stack
        INC	HL
        LD	D,(HL)
	INC	HL
	LD	(RSP),HL
	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
	LD	A,L
	SUB	C
	LD	C,A
	LD	A,H
	SBC	A,B		; normale Syntax ist SBC B
	LD	B,A
	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