1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-25 04:48:06 +11:00

basic: add if

This commit is contained in:
Virgil Dupras 2019-11-21 16:06:14 -05:00
parent 3f3dd9141e
commit 7262993f14
6 changed files with 269 additions and 3 deletions

View File

@ -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"

View File

@ -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

143
apps/basic/parse.asm Normal file
View File

@ -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

View File

@ -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:

View File

@ -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.

View File

@ -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: