basic: add if

apps/basic/glue.asm

@@ -20,6 +20,7 @@
 .inc "lib/fmt.asm"
 .equ	EXPR_PARSE	parseLiteralOrVar
 .inc "lib/expr.asm"
+.inc "basic/parse.asm"
 .inc "basic/tok.asm"
 .equ	VAR_RAMSTART	SCRATCHPAD+SCRATCHPAD_SIZE
 .inc "basic/var.asm"

apps/basic/main.asm

@@ -218,6 +218,23 @@ basGOTO:
 	ld	(BAS_PNEXTLN), de
 	ret
 
+basIF:
+	push	hl	; --> lvl 1. original arg
+	ld	de, SCRATCHPAD
+	call	rdWord
+	ex	de, hl
+	call	parseTruth
+	pop	hl	; <-- lvl 1. restore
+	ret	nz
+	or	a
+	ret	z
+	; expr is true, execute next
+	; (HL) back to beginning of args, skip to next arg
+	call	toSep
+	call	rdSep
+	ld	de, basCmds2
+	jp	basCallCmd
+
 ; direct only
 basCmds1:
 	.dw	basBYE
@@ -232,4 +249,6 @@ basCmds2:
 	.db	"print", 0
 	.dw	basGOTO
 	.db	"goto", 0, 0
+	.dw	basIF
+	.db	"if", 0, 0, 0, 0
 	.db	0xff, 0xff, 0xff	; end of table

apps/basic/parse.asm

@@ -0,0 +1,143 @@
+; Parse an expression yielding a truth value from (HL) and set A accordingly.
+; 0 for False, nonzero for True.
+; How it evaluates truth is that it looks for =, <, >, >= or <= in (HL) and,
+; if it finds it, evaluate left and right expressions separately. Then it
+; compares both sides and set A accordingly.
+; If comparison operators aren't found, the whole string is sent to parseExpr
+; and zero means False, nonzero means True.
+; **This routine mutates (HL).**
+; Z for success.
+parseTruth:
+	push	ix
+	push	de
+	ld	a, '='
+	call	.maybeFind
+	jr	z, .foundEQ
+	ld	a, '<'
+	call	.maybeFind
+	jr	z, .foundLT
+	ld	a, '>'
+	call	.maybeFind
+	jr	z, .foundGT
+	jr	.simple
+.success:
+	cp	a	; ensure Z
+.end:
+	pop	de
+	pop	ix
+	ret
+
+.maybeFind:
+	push	hl	; --> lvl 1
+	call	findchar
+	jr	nz, .notFound
+	; found! We want to keep new HL around. Let's pop old HL in DE
+	pop	de	; <-- lvl 1
+	ret
+.notFound:
+	; not found, restore HL
+	pop	hl	; <-- lvl 1
+	ret
+
+.simple:
+	call	parseExpr
+	jr	nz, .end
+	push	ix \ pop de
+	ld	a, d
+	or	e
+	jr	.success
+
+.foundEQ:
+	; we found an '=' char and HL is pointing to it. DE is pointing to the
+	; beginning of our string. Let's separate those two strings.
+	; But before we do that, to we have a '<' or a '>' at the left of (HL)?
+	dec	hl
+	ld	a, (hl)
+	cp	'<'
+	jr	z, .foundLTE
+	cp	'>'
+	jr	z, .foundGTE
+	inc	hl
+	; Ok, we are a straight '='. Proceed.
+	call	.splitLR
+	; HL now point to right-hand, DE to left-hand
+	call	.parseLeftRight
+	jr	nz, .end	; error, stop
+	xor	a		; clear carry and prepare value for False
+	sbc	hl, de
+	jr	nz, .success	; NZ? equality not met. A already 0, return.
+	; Z? equality met, make A=1, set Z
+	inc	a
+	jr	.success
+
+.foundLTE:
+	; Almost the same as '<', but we have two sep chars
+	call	.splitLR
+	inc	hl	; skip the '=' char
+	call	.parseLeftRight
+	jr	nz, .end
+	ld	a, 1		; prepare for True
+	sbc	hl, de
+	jr	nc, .success	; Left <= Right, True
+	; Left > Right, False
+	dec	a
+	jr	.success
+
+.foundGTE:
+	; Almost the same as '<='
+	call	.splitLR
+	inc	hl	; skip the '=' char
+	call	.parseLeftRight
+	jr	nz, .end
+	ld	a, 1		; prepare for True
+	sbc	hl, de
+	jr	z, .success	; Left == Right, True
+	jr	c, .success	; Left > Right, True
+	; Left < Right, False
+	dec	a
+	jr	.success
+
+.foundLT:
+	; Same thing as EQ, but for '<'
+	call	.splitLR
+	call	.parseLeftRight
+	jr	nz, .end
+	xor	a
+	sbc	hl, de
+	jr	z, .success	; Left == Right, False
+	jr	c, .success	; Left > Right, False
+	; Left < Right, True
+	inc	a
+	jr	.success
+
+.foundGT:
+	; Same thing as EQ, but for '>'
+	call	.splitLR
+	call	.parseLeftRight
+	jr	nz, .end
+	xor	a
+	sbc	hl, de
+	jr	nc, .success	; Left <= Right, False
+	; Left > Right, True
+	inc	a
+	jr	.success
+
+.splitLR:
+	xor	a
+	ld	(hl), a
+	inc	hl
+	ret
+
+; Given string pointers in (HL) and (DE), evaluate those two expressions and
+; place their corresponding values in HL and DE.
+.parseLeftRight:
+	; let's start with HL
+	call	parseExpr
+	ret	nz
+	push	ix		; --> lvl 1. save (HL) value in stack.
+	ex	de, hl
+	call	parseExpr
+	ret	nz
+	push	ix \ pop de
+	pop	hl		; <-- lvl 1. restore.
+	ret

apps/lib/expr.asm

@@ -11,6 +11,7 @@
 ; *** Code ***
 ;
 ; Parse expression in string at (HL) and returns the result in IX.
+; **This routine mutates (HL).**
 ; We expect (HL) to be disposable: we mutate it to avoid having to make a copy.
 ; Sets Z on success, unset on error.
 parseExpr:

kernel/str.asm

@@ -19,8 +19,7 @@ fill:
 findchar:
 	push	bc
 	ld	c, a	; let's use C as our cp target
-	ld	a, 0xff
+	ld	b, 0xff
-	ld	b, a
 
 .loop:	ld	a, (hl)
 	cp	c
@@ -30,7 +29,7 @@ findchar:
 	inc	hl
 	djnz	.loop
 .nomatch:
-	call	unsetZ
+	inc	a		; unset Z
 	jr	.end
 .match:
 	; We ran 0xff-B loops. That's the result that goes in A.

tools/tests/unit/test_basic_parse.asm

@@ -0,0 +1,103 @@
+jp	test
+
+.inc "core.asm"
+.inc "str.asm"
+.inc "lib/util.asm"
+.inc "lib/parse.asm"
+.equ	EXPR_PARSE	parseLiteral
+.inc "lib/expr.asm"
+.inc "basic/parse.asm"
+
+test:
+	ld	sp, 0xffff
+
+	call	testParseThruth
+
+	; success
+	xor	a
+	halt
+
+testParseThruth:
+	ld	hl, .t1
+	call	.true
+	ld	hl, .t2
+	call	.true
+	ld	hl, .t3
+	call	.true
+	ld	hl, .t4
+	call	.true
+	ld	hl, .t5
+	call	.true
+	ld	hl, .t6
+	call	.true
+	ld	hl, .t7
+	call	.true
+	ld	hl, .t8
+	call	.true
+
+	ld	hl, .f1
+	call	.false
+	ld	hl, .f2
+	call	.false
+	ld	hl, .f3
+	call	.false
+	ld	hl, .f4
+	call	.false
+	ld	hl, .f5
+	call	.false
+	ld	hl, .f6
+	call	.false
+
+	ld	hl, .e1
+	call	.error
+	ret
+
+.true:
+	call	parseTruth
+	jp	nz, fail
+	or	a
+	jp	z, fail
+	jp	nexttest
+
+.false:
+	call	parseTruth
+	jp	nz, fail
+	or	a
+	jp	nz, fail
+	jp	nexttest
+
+.error:
+	call	parseTruth
+	jp	z, fail
+	jp	nexttest
+
+.t1:	.db	"42", 0
+.t2:	.db	"42+4=50-4", 0
+.t3:	.db	"1<2", 0
+.t4:	.db	"2>1", 0
+.t5:	.db	"2>=1", 0
+.t6:	.db	"2>=2", 0
+.t7:	.db	"1<=2", 0
+.t8:	.db	"2<=2", 0
+.f1:	.db	"42-42", 0
+.f2:	.db	"42+4=33+2", 0
+.f3:	.db	"2<2", 0
+.f4:	.db	"1>2", 0
+.f5:	.db	"1>=2", 0
+.f6:	.db	"2<=1", 0
+.e1:	.db	"foo", 0
+
+testNum:	.db 1
+
+nexttest:
+	ld	a, (testNum)
+	inc	a
+	ld	(testNum), a
+	ret
+
+fail:
+	ld	a, (testNum)
+	halt
+
+; used as RAM
+sandbox: