From 7262993f142c57ef6e2a79218ed040589dc5525d Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Thu, 21 Nov 2019 16:06:14 -0500 Subject: [PATCH] basic: add if --- apps/basic/glue.asm | 1 + apps/basic/main.asm | 19 ++++ apps/basic/parse.asm | 143 ++++++++++++++++++++++++++ apps/lib/expr.asm | 1 + kernel/str.asm | 5 +- tools/tests/unit/test_basic_parse.asm | 103 +++++++++++++++++++ 6 files changed, 269 insertions(+), 3 deletions(-) create mode 100644 apps/basic/parse.asm create mode 100644 tools/tests/unit/test_basic_parse.asm diff --git a/apps/basic/glue.asm b/apps/basic/glue.asm index dee6b50..b6df0dd 100644 --- a/apps/basic/glue.asm +++ b/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" diff --git a/apps/basic/main.asm b/apps/basic/main.asm index 3812101..a134efc 100644 --- a/apps/basic/main.asm +++ b/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 diff --git a/apps/basic/parse.asm b/apps/basic/parse.asm new file mode 100644 index 0000000..11703e9 --- /dev/null +++ b/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 diff --git a/apps/lib/expr.asm b/apps/lib/expr.asm index e04aeb6..ce8f1b5 100644 --- a/apps/lib/expr.asm +++ b/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: diff --git a/kernel/str.asm b/kernel/str.asm index 968497f..1ee829b 100644 --- a/kernel/str.asm +++ b/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, a + ld b, 0xff .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. diff --git a/tools/tests/unit/test_basic_parse.asm b/tools/tests/unit/test_basic_parse.asm new file mode 100644 index 0000000..5bf0dab --- /dev/null +++ b/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: