Tiny 85, Forth85_04

;this is forth85_04 .Got simple lines like "one two $0d. interpreted OK. Now going to work on drop, swap and rot.
; Got slowed up by need to change z from and to word.byte addresses. Also stackme_2 was difficult.
; Needs tidy up in nomenclature and old testing subroutines.

						;this is forth85_01. Just getting a few words in dictionary
.NOLIST
.include "tn85def.inc"
.LIST
;.LISTMAC ;sometimes macro code gets in way of clarity in listing
.MACRO header
	.db high(@0), low(@0), @1, @2
.ENDMACRO
.def FOUND = r15	;if found=1 we have a match of Ram word on dictionary
.def BOTTOM = r14	;have hit the bottom of the dict and not found a match
.def STOP = r13		;stop interpreting line of words
.def STATE = r12
.def FOUNDCOUNTER = r11	;dealWithWord clicks this if found =1. Counts successful finds in dictionary.
.def SECONDLETTER =r10	;helpful for debugging
.def vl = r22
.def vh = r23		; u,v,w,x,y,z are all pointers
.DSEG
.ORG 0x60

;consts: .DB "jksdafhsdf",8, 255, 0b01010101, -128, 0xaa
.equ BUF1LENGTH = 64

buf1: .byte BUF1LENGTH
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
	rcall stackme_2
.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, 3, "two"
two:
	rcall stackme_2
	.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
;----------------------------------
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
;-------------------------------------------------
LATEST:			;shift this later

S_1:
;the EOL token that gets put into end of buf1 to stop parsing
header swapp_1,1,"S"
S:
	clr STOP
	inc STOP	;set time-to-quit flag
ret
;-------------------------------------------------
stackme_2:		;stacks on my stack next 16bit num. Address of 16bit number is on SP-stack
	; Used like this stackme_2 0034. Puts 0034 on myStack and increments past number on return stack.
	pop r17
	pop r16		; they now contain eg 0x0804 which contain the 16bit num
	movw zl,r16	;z now points to cell that cobtains the number
	clc
	rol zl
	rol zh		;double word address  for z. lpm coming up



	lpm r16,z+
	lpm r17,z+	;now have 16bit number in r16,17

	st y+,r16
	st y+, r17	;mystack now contains the number

	clc
	ror zh
	ror zl	;halve the z pointer to step past the number to return at the right place

	push zl
	push zh

ret



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

.ORG 0
	rjmp start
typein: .db " one two", 0x0d

;stackme dropx onex stackme 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+	;why?
;rjmp test_getline0
;rjmp test_word
;rjmp test_compare
;rjmp test_jmpNextWord
;rjmp test_doLatest
;rjmp test_find
rjmp test_interpretLine
;rjmp test_pasteEOL
;rjmp test_executeCode

	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
	ld SECONDLETTER, x	;for debugging

	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


	clr r20			;length initially 0
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. Z on entry points to the link. Needs +2 to
	lpm r23,z+
	lpm r22,z+	;store next link in v=r22,23. z now points to len byte

;	inc zl
;	inc zl		;step over link
;	brcc startc
;	inc zh		;only if zl overflows
startc:
	push r20	;save length
	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
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
;---------------------------------------
jmpNextWord:	;go to next word in the dictionary. Assume v=r22,23 contains next link word(not byte)
				; and w = r24,25 contains RAM word start with len in r20
				;exit with z pointing to next word ready for next COMPARE.
	clc
	rol r22
	rol r23		;above 3 instructions change word address into byte address by doubling
	movw r30,r22	;z now points to next word
ret
;-----------------------------------------
test_jmpNextWord:
		rcall getline0
	ldi xl, low(buf1)
	ldi xh, high(buf1)
	rcall word
	ldi zl, low(LATEST<<1)
	ldi zh, high(LATEST<<1)
	rcall compare
	rcall jmpNextWord	;next put COMPARE after this. Then use FOUND in a loop
	rcall compare
	rcall jmpNextWord
	rcall compare
	rcall jmpNextWord
	rcall compare
tjn:	rjmp tjn
;--------------------------------------------------
doLatest:	;set up so first jump in dictionary is to top=LATEST and other flags set up.
	ldi vl, low(LATEST)
	ldi vh, high(LATEST)
	clr FOUND
	clr BOTTOM		;not yet found the match, not yet at the bottom. Either will stop search.
	clr STOP		;keep parsing words til this goes to a 1
ret
;---------------------------------------------
test_doLatest:
	rcall getline0
	ldi xl, low(buf1)
	ldi xh, high(buf1)
	rcall word
	rcall doLatest
	rcall jmpNextWord	;
	rcall compare
	rcall jmpNextWord
	rcall compare
	rcall jmpNextWord
	rcall compare

tdl:
	rjmp tdl
;---------------------------------------------------
test_find:		;set up for find then exit with either BOTTOM or FOUND =1
	rcall getline0
	ldi xl, low(buf1)
	ldi xh, high(buf1)
	rcall word
	rcall doLatest
upjmp:
	rcall jmpNextWord
	rcall compare
	tst FOUND
	brne stopsearch		;if last compare got a match (FOUND=1) then stop searching
	tst vl
	brne upjmp			;if v=0000 then we've hit the bottom of the dictionary
	tst vh
	brne upjmp			;not found and not at bottom so keep going
;if here FOUND =0, ie no match yet and we've hit the bottom of the dictionary
	clr BOTTOM
	inc BOTTOM			;exit with FOUND=0 and BOTTOM =1
stopsearch: nop
	rjmp stopsearch		;emerges, if FOUND=1, with Z pointing first executable code (often rcall ...)
;-----------------------------------------------------------
interpretLine:		;given line of words in buf one, search for words one by one. Don't do code
					; or compile at this stage, just find and report that and go into next one.
	rcall getline0	;change later to real getline via terminal
	rcall pasteEOL
	ldi xl, low(buf1)
	ldi xh,high(buf1)	;last 3 statemnts are done onece. Now the main loop.
	clr FOUNDCOUNTER	;counts finds in line parsing.

nextWord:
	tst STOP
	brne stopLine
	rcall word
	rcall findWord			;not done yet
	rcall dealWithWord		;go and run code STATE=0, or compile (STATE =1).{ c0de, comp1le}
	rjmp nextWord
stopLine:
	ret
;-----------------------------------------------------------------
findWord:
	rcall doLatest
upjmpf:
	rcall jmpNextWord
	rcall compare
	tst FOUND
	brne stopsearchf		;if last compare got a match (FOUND=1) then stop searching
	tst vl
	brne upjmpf			;if v=0000 then we've hit the bottom of the dictionary
	tst vh
	brne upjmpf			;not found and not at bottom so keep going
;if here FOUND =0, ie no match yet and we've hit the bottom of the dictionary
	clr BOTTOM
	inc BOTTOM			;exit with FOUND=0 and BOTTOM =1
stopsearchf: nop
ret
;----------------------------
test_interpretLine:
	rcall interpretLine
til: rjmp til
;------------------------------
dealWithWord:			;come here when it's time to compile or run code
;Good dugging spot. Enter here with Z pointing to CFA of word found. Y points to myStack. X points to just
; past the word we are seeking (w-s). r10 is 2nd letter of w-s. w = start adr of w-s. v is a link
; to the next word in dic. Either just below the found word or 0000 if we get to the bottome with no match
;
	nop
	tst FOUND
	breq notfound
	inc FOUNDCOUNTER

;scary

;		clc
;	rol zl
;	rol zh
		clc
	ror zh
	ror zl		;put z back into word values


	rcall executeCode



	.MESSAGE "Word found"
	rjmp outdww
notfound:
	.MESSAGE "Word not found"
	clr STOP
	inc STOP		;stop parsing line
outdww:
ret
;------------------------------------------------------------------------
pasteEOL:		;when a line of text is TYPEd into buf1 it should end with CR=$0d. This gets replaced with ]}, a
	; special end of line word. When the word is invoked it casues a QUIT back to  the waiting for input stage.
	; Start at buf1 start and inspect each char for a $0D. When found replace with a "$20 S $20 "
	ldi xl, low(buf1)
	ldi xh, high(buf1)	;pnt to start of buffer
	clr r17
nxtChar:
	inc r17				;r17 is counter. Bail out when r17 > BUF1LENGTH
	cpi r17, BUF1LENGTH -4
	breq outProb
	ld r16, x+
	cpi r16, $0d
	brne nxtChar
;if here we've found a $0d in buf1 before the end, so replace with an EOL token. x points to just after it.
	ldi r16,$20
	st -x, r16		;back up. Then go forward.
;	ldi r16, ']'
	st x+, r16
	ldi r16,'S'
	st x+, r16
;	ldi r16, '}'
;	st x+, r16
	ldi r16, $20
	st x, r16
	rjmp outpel


outProb:
	nop
	.MESSAGE "Couldn't find $0d"
outpel:
ret
;-------------------------------------------
test_pasteEOL:
	rcall getline0
	rcall pasteEOL
teol:
	rjmp teol
;-------------------------------------
executeCode:		;with Z pointing to cfa. Not sure whether to jmp or call
;	ldi zh,$08		;point to "one"
;



	ijmp
	ret
;---------------------------------------
test_executeCode:			;seems to ok ok with LIT
	rcall executeCode
	nop
	nop

tec: rjmp tec