forth85_01

;this is forth85_01. Just getting a few words in dictionary
.NOLIST
.include "tn85def.inc"
.LIST
.LISTMAC
.MACRO header
	.db high(@0), low(@0), @1, @2
.ENDMACRO
.def FOUND = r15
.DSEG
.ORG 0x60

;consts: .DB "jksdafhsdf",8, 255, 0b01010101, -128, 0xaa

buf1: .byte 64
buf2: .byte 64			;could have third buffer?
varSpace: .byte 64		;might need more than 32 variables
;.org 0x1E0
myStackStart: .byte 64

.cseg
.ORG 0x800 ;dictionary starts at 4K (2K  words) mark
;----------------------------------------------------
one_1:
.db 0,0,3, "one" ;code for one
one:
	rcall stackme
.db 01, 00
ret
;----------------------------------------------
stackme_1:
.db high(one_1),low(one_1),7, "stackme" ; sp points to number to be stacked
stackme:
	pop r17
	pop r16		;low byte in low register
	st y+,r16
	st y+,r17	;number now on mystack
	inc r16
	inc r16		;add 2 to SP return address
	brcc finsm
	inc r17		;if r16 overflowed
	push r17
	push r16	;now point past number
finsm:
ret			;with number on mystack and ret adr just past it.
;--------------------------------------------
two_1:
header stackme_1, 7, "two"
two:
	rcall stackme
	.db 02,00
ret
;------------------------------------------
dup_1:
header two_1,3,"dup"
dup:
	pop r16
	pop r17
	push r17
	push r16
	push r17
	push r16
ret
;-------------------------------------------
drop_1:
header dup_1,4,"drop"
drop:
	pop r16
	pop r17
ret
;----------------------------------
LATEST:			;shift this later
swapp_1:		;twp p's becasue assembler recognizes avr opcode swap
header drop_1,5, "swapp"
swapp:
	rcall drop
	pop r18
	pop r19
	push r17
	push r16
	push r19
	push r18
ret

;====================================================================================================

.ORG 0
	rjmp start
typein: .db " two one dup swap drop", 0x0d
start:
	ldi r16, low(RAMEND)
	out SPL, r16
	ldi r16,high(RAMEND)
	out SPH, r16

	ldi YL,low(myStackStart)
	ldi YH,high(myStackStart)
;	ldi xl, low(consts)
;	ldi xh, high(consts)
	ld r16, x+
;rjmp test_getline0
;rjmp test_word
rjmp test_compare

	rjmp start

getline0:	;force a line into buf1 via flash string. Simulates GETLINE
	ldi zl, low(typein<<1)
	ldi zh, high(typein<<1)
	ldi xl, low(buf1)
	ldi xh, high(buf1)
type0:
	lpm r16,Z+
	st x+,r16
	cpi r16,0x0d		;have we got to the end of the line?
	brne type0
ret
;--------------------------------------------
test_getline0:
	rcall getline0
heretgl:
	rjmp heretgl
;---------------------------------------
;WORD gets x to point to start of word (copy in w=r24,25) with the length in len = r20
;assume word points to somewhere in buf1. Should advance thru spaces=0x20 to first real char
word: 			;maybe give it a header later
	ld r16,x+	;get char
	cpi r16,0x20	;is it a space?
	breq word		;if so get next char
;if here we're point to word start. so save this adr in w
	mov r24,xl
	mov r25,xh		;wordstart now saved in w
nextchar:
	inc r20			;r20 = word length
	ld r16,x+		;get next char
	cpi r16,0x20
	brne nextchar
	dec r24			;adjust start of word
;if here we've found a word.Starting at w length in r20.x points to space just past word
ret
;----------------------------------------
test_word:
	rcall getline0
	ldi xl, low(buf1)
	ldi xh, high(buf1)
	rcall word
tw1:
	rjmp tw1
;-----------------------------------------
find:		;maybe do a header later.
;Give a word from buf1 starting at w=r24,25, length r20. Is there a match in the dictionary?
;Start with z pointing to LATEST, which is the lngth of the first word in the dictionary.

;find calls compare each tim it lands on a word.Exit with found = yes/no 1/0
;-------------
compare: 		;given a word in buf1 and a word in the dic are they the same? The word in the dic is pointed to by Z.
				; and the word in buf1 is pointed to by w=r24,25. len = r20
	lpm r16,Z+	;length of dictionary word, first entry now in r16
	cp r16,r20	;same lengths?
	brne outcom	;not = so bail out
;if here the words are the same length, what about the rest of the chars.First get x to point to word.
	mov xl,r24
	mov xh,r25	;x now point to start of buf1 word
	push r20	;save length
upcom:
	lpm r16,z+
	ld r17,x+	;get one corresponding char from each word
	cp r16,r17	;same word?
	brne outcom	;bail out if chars are different
	dec r20		;count chars
	brne upcom	;still matching and not finished so keep going
;if here r20 is 0 so match must have been perfect so FOUND = 1
	clr FOUND
	inc FOUND
outcom:
	pop r20		;get old lngth of buf1 word back
ret
;-------------------------------------------
test_compare:
	rcall getline0
	ldi xl, low(buf1)
	ldi xh, high(buf1)
	rcall word
	ldi zl, low(LATEST<<1)
	ldi zh, high(LATEST<<1)
	rcall compare
tc0: rjmp tc0