1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 18:10:55 +11:00

Compare commits

...

4 Commits

Author SHA1 Message Date
Virgil Dupras
15628da7de lib/expr: make EXPR_PARSE put result in DE instead of IX
Finally getting rid of this bad mistake of using IX for this.
2019-12-29 17:37:04 -05:00
Virgil Dupras
981c93bfd4 lib/expr: fix stack imbalance on failure 2019-12-29 16:15:48 -05:00
Virgil Dupras
4760d044c0 test_expr: simplify 2019-12-29 15:39:39 -05:00
Virgil Dupras
213614af33 lib/expr: make recursion process a bit more orderly
Instead of going left and right, finding operators chars and replacing them
with nulls, we parse expressions in a more orderly manner, one chunk at a
time. I think it qualifies as "recursive descent", but I'm not sure.

This allows us to preserve the string we parse and should also make the
implementation of parens much easier.
2019-12-29 11:42:18 -05:00
8 changed files with 340 additions and 250 deletions

View File

@ -98,12 +98,9 @@ parseLiteralOrVar:
push hl ; --> lvl 1 push hl ; --> lvl 1
ld hl, VAR_TBL ld hl, VAR_TBL
call addHL call addHL
push de ; --> lvl 2
ld e, (hl) ld e, (hl)
inc hl inc hl
ld d, (hl) ld d, (hl)
push de \ pop ix
pop de ; <-- lvl 2
pop hl ; <-- lvl 1 pop hl ; <-- lvl 1
cp a ; ensure Z cp a ; ensure Z
ret ret

View File

@ -1,177 +1,141 @@
; *** Requirements *** ; *** Requirements ***
; findchar ; ari
; multDEBC
; callIXI
; ;
; *** Defines *** ; *** Defines ***
; ;
; EXPR_PARSE: routine to call to parse literals or symbols that are part of ; EXPR_PARSE: routine to call to parse literals or symbols that are part of
; the expression. Routine's signature: ; the expression. Routine's signature:
; String in (HL), returns its parsed value to IX. Z for success. ; String in (HL), returns its parsed value to DE. Z for success.
; ;
; *** Code *** ; *** Code ***
; ;
; Parse expression in string at (HL) and returns the result in DE. ; Parse expression in string at (HL) and returns the result in DE.
; **This routine mutates (HL).** ; This routine needs to be able to mutate (HL), but it takes care of restoring
; We expect (HL) to be disposable: we mutate it to avoid having to make a copy. ; the string to its original value before returning.
; Sets Z on success, unset on error. ; Sets Z on success, unset on error.
parseExpr: parseExpr:
push iy
push ix push ix
push hl push hl
call _parseExpr call _parseAddSubst
push ix \ pop de
pop hl pop hl
pop ix pop ix
pop iy
ret ret
_parseExpr: ; *** Op signature ***
ld de, exprTbl ; The signature of "operators routines" (.plus, .mult, etc) below is this:
.loop: ; Combine HL and DE with an operator (+, -, *, etc) and put the result in DE.
ld a, (de) ; Destroys HL and A. Never fails. Yes, that's a problem for division by zero.
or a ; Don't divide by zero. All other registers are protected.
jp z, EXPR_PARSE ; no operator, just parse the literal
push de ; --> lvl 1. save operator row
call _findAndSplit
jr z, .found
pop de ; <-- lvl 1
inc de \ inc de \ inc de
jr .loop
.found:
; Operator found, string splitted. Left in (HL), right in (DE)
call _resolveLeftAndRight
; Whether _resolveLeftAndRight was a success, we pop our lvl 1 stack
; out, which contains our operator row. We pop it in IX.
; L-R numbers are parsed in HL (left) and DE (right).
pop ix ; <-- lvl 1
ret nz
; Resolving left and right succeeded, proceed!
inc ix ; point to routine pointer
call callIXI
push de \ pop ix
cp a ; ensure Z
ret
; Given a string in (HL) and a separator char in A, return a splitted string, ; Given a running result in DE, a rest-of-expression in (HL), a parse routine
; that is, the same (HL) string but with the found A char replaced by a null ; in IY and an apply "operator routine" in IX, (HL/DE --> DE)
; char. DE points to the second part of the split. ; With that, parse the rest of (HL) and apply the operation on it, then place
; Sets Z if found, unset if not found. ; HL at the end of the parsed string, with A containing the last char of it,
_findAndSplit: ; which can be either an operator or a null char.
push hl ; Z for success.
call .skipCharLiteral ;
call findchar _parseApply:
jr nz, .end ; nothing found push de ; --> lvl 1, left result
; Alright, we have our char and we're pointing at it. Let's replace it push ix ; --> lvl 2, routine to apply
; with a null char. inc hl ; after op char
xor a call callIY ; --> DE
ld (hl), a ; + changed to \0 pop ix ; <-- lvl 2, routine to apply
inc hl ; Here we do some stack kung fu. We have, in HL, a string pointer we
ex de, hl ; DE now points to the second part of the split ; want to keep. We have, in (SP), our left result we want to use.
cp a ; ensure Z ex (sp), hl ; <-> lvl 1
jr nz, .end
push af ; --> lvl 2, save ending operator
call callIX
pop af ; <-- lvl 2, restore operator.
.end: .end:
pop hl ; HL is back to the start pop hl ; <-- lvl 1, restore str pointer
ret ret
.skipCharLiteral: ; Unless there's an error, this routine completely resolves any valid expression
; special case: if our first char is ', skip the first 3 characters ; from (HL) and puts the result in DE.
; so that we don't mistake a literal for an iterator ; Destroys HL
push af ; Z for success.
ld a, (hl) _parseAddSubst:
cp 0x27 ; ' call _parseMultDiv
jr nz, .skipCharLiteralEnd ; not a ' ret nz
xor a ; check for null char during skipping .loop:
; skip 3 ; do we have an operator?
inc hl
cp (hl)
jr z, .skipCharLiteralEnd
inc hl
cp (hl)
jr z, .skipCharLiteralEnd
inc hl
.skipCharLiteralEnd:
pop af
ret
.find:
; parse expression on the left (HL) and the right (DE) and put the results in
; HL (left) and DE (right)
_resolveLeftAndRight:
ld a, (hl)
or a or a
jr z, .noleft ret z ; null char, we're done
; Parse left operand in (HL) ; We have an operator. Resolve the rest of the expr then apply it.
push de ; --> lvl 1 ld ix, .plus
call parseExpr cp '+'
pop hl ; <-- lvl 1, orig DE jr z, .found
ret nz ; return immediately if error ld ix, .minus
.parseright: cp '-'
; Now we have parsed everything to the left and we have its result in ret nz ; unknown char, error
; DE. What we need to do now is the same thing on (DE) and then apply .found:
; the + operator. Let's save DE somewhere and parse this. ld iy, _parseMultDiv
push de ; --> lvl 1 call _parseApply
; right expr in (HL) ret nz
call parseExpr ; DE is set jr .loop
pop hl ; <-- lvl 1. left value
ret ; Z is parseExpr's result
.noleft:
; special case: is (HL) zero? If yes, it means that our left operand
; is empty. consider it as 0
ex de, hl ; (DE) goes in (HL) for .parseright
ld de, 0
jr .parseright
; Routines in here all have the same signature: they take two numbers, DE (left)
; and IX (right), apply the operator and put the resulting number in DE.
; The table has 3 bytes per row: 1 byte for operator and 2 bytes for routine
; pointer.
exprTbl:
.db '+'
.dw .plus
.db '-'
.dw .minus
.db '*'
.dw .mult
.db '/'
.dw .div
.db '%'
.dw .mod
.db '&'
.dw .and
.db 0x7c ; '|'
.dw .or
.db '^'
.dw .xor
.db '}'
.dw .rshift
.db '{'
.dw .lshift
.db 0 ; end of table
.plus: .plus:
add hl, de add hl, de
ex de, hl ex de, hl
ret ret
.minus: .minus:
or a ; clear carry or a ; clear carry
sbc hl, de sbc hl, de
ex de, hl ex de, hl
ret ret
; Parse (HL) as far as it can, that is, resolving expressions at its level or
; lower (anything but + and -).
; A is set to the last op it encountered. Unless there's an error, this can only
; be +, - or null. Null if we're done parsing, + and - if there's still work to
; do.
; (HL) points to last op encountered.
; DE is set to the numerical value of everything that was parsed left of (HL).
_parseMultDiv:
call _parseBitShift
ret nz
.loop:
; do we have an operator?
or a
ret z ; null char, we're done
; We have an operator. Resolve the rest of the expr then apply it.
ld ix, .mult
cp '*'
jr z, .found
ld ix, .div
cp '/'
jr z, .found
ld ix, .mod
cp '%'
jr z, .found
; might not be an error, return success
cp a
ret
.found:
ld iy, _parseBitShift
call _parseApply
ret nz
jr .loop
.mult: .mult:
push bc ; --> lvl 1
ld b, h ld b, h
ld c, l ld c, l
call multDEBC ; --> HL call multDEBC ; --> HL
pop bc ; <-- lvl 1
ex de, hl ex de, hl
ret ret
.div: .div:
; divide takes HL/DE ; divide takes HL/DE
push bc ld a, l
push bc ; --> lvl 1
call divide call divide
ld e, c ld e, c
ld d, b ld d, b
pop bc pop bc ; <-- lvl 1
ret ret
.mod: .mod:
@ -179,6 +143,39 @@ exprTbl:
ex de, hl ex de, hl
ret ret
; Same as _parseMultDiv, but a layer lower.
_parseBitShift:
call _parseNumber
ret nz
.loop:
; do we have an operator?
or a
ret z ; null char, we're done
; We have an operator. Resolve the rest of the expr then apply it.
ld ix, .and
cp '&'
jr z, .found
ld ix, .or
cp 0x7c ; '|'
jr z, .found
ld ix, .xor
cp '^'
jr z, .found
ld ix, .rshift
cp '}'
jr z, .found
ld ix, .lshift
cp '{'
jr z, .found
; might not be an error, return success
cp a
ret
.found:
ld iy, _parseNumber
call _parseApply
ret nz
jr .loop
.and: .and:
ld a, h ld a, h
and d and d
@ -209,26 +206,126 @@ exprTbl:
ld a, e ld a, e
and 0xf and 0xf
ret z ret z
push bc push bc ; --> lvl 1
ld b, a ld b, a
.rshiftLoop: .rshiftLoop:
srl h srl h
rr l rr l
djnz .rshiftLoop djnz .rshiftLoop
ex de, hl ex de, hl
pop bc pop bc ; <-- lvl 1
ret ret
.lshift: .lshift:
ld a, e ld a, e
and 0xf and 0xf
ret z ret z
push bc push bc ; --> lvl 1
ld b, a ld b, a
.lshiftLoop: .lshiftLoop:
sla l sla l
rl h rl h
djnz .lshiftLoop djnz .lshiftLoop
ex de, hl ex de, hl
pop bc pop bc ; <-- lvl 1
ret ret
; Parse first number of expression at (HL). A valid number is anything that can
; be parsed by EXPR_PARSE and is followed either by a null char or by any of the
; operator chars. This routines takes care of replacing an operator char with
; the null char before calling EXPR_PARSE and then replace the operator back
; afterwards.
; HL is moved to the char following the number having been parsed.
; DE contains the numerical result.
; A contains the operator char following the number (or null). Only on success.
; Z for success.
_parseNumber:
; Special case 1: number starts with '-'
ld a, (hl)
cp '-'
jr nz, .skip1
; We have a negative number. Parse normally, then subst from zero
inc hl
call _parseNumber
push hl ; --> lvl 1
ex af, af' ; preserve flags
or a ; clear carry
ld hl, 0
sbc hl, de
ex de, hl
ex af, af' ; restore flags
pop hl ; <-- lvl 1
ret
.skip1:
; End of special case 1
; Copy beginning of string to DE, we'll need it later
ld d, h
ld e, l
; Special case 2: we have a char literal. If we have a char literal, we
; don't want to go through the "_isOp" loop below because if that char
; is one of our operators, we're messing up our processing. So, set
; ourselves 3 chars further and continue from there. EXPR_PARSE will
; take care of validating those 3 chars.
cp 0x27 ; apostrophe (') char
jr nz, .skip2
; "'". advance HL by 3
inc hl \ inc hl \ inc hl
; End of special case 2
.skip2:
dec hl ; offset "inc-hl-before" in loop
.loop:
inc hl
ld a, (hl)
call _isOp
jr nz, .loop
; (HL) and A is an op or a null
push af ; --> lvl 1 save op
push hl ; --> lvl 2 save end of string
; temporarily put a null char instead of the op
xor a
ld (hl), a
ex de, hl ; rewind to beginning of number
call EXPR_PARSE ; --> DE
ex af, af' ; keep result flags away while we restore (HL)
pop hl ; <-- lvl 2, end of string
pop af ; <-- lvl 1, saved op
ld (hl), a
ex af, af' ; restore Z from EXPR_PARSE
ret nz
; HL is currently at the end of the number's string
; On success, have A be the operator char following the number
ex af, af'
ret
; Sets Z if A contains a valid operator char or a null char.
_isOp:
or a
ret z
push hl ; --> lvl 1
; Set A' to zero for quick end-of-table checks
ex af, af'
xor a
ex af, af'
ld hl, .exprChars
.loop:
cp (hl)
jr z, .found
ex af, af'
cp (hl)
jr z, .notFound ; end of table
ex af, af'
inc hl ; next char
jr .loop
.notFound:
ex af, af' ; restore orig A
inc a ; unset Z
.found:
; Z already set
pop hl ; <-- lvl 1
ret
.exprChars:
.db "+-*/%&|^{}", 0

View File

@ -67,7 +67,7 @@ parseHexPair:
; add a, 0xff-'9' ; maps '0'-'9' onto 0xf6-0xff ; add a, 0xff-'9' ; maps '0'-'9' onto 0xf6-0xff
; sub 0xff-9 ; maps to 0-9 and carries if not a digit ; sub 0xff-9 ; maps to 0-9 and carries if not a digit
; Parse string at (HL) as a decimal value and return value in IX under the ; Parse string at (HL) as a decimal value and return value in DE under the
; same conditions as parseLiteral. ; same conditions as parseLiteral.
; Sets Z on success, unset on error. ; Sets Z on success, unset on error.
; To parse successfully, all characters following HL must be digits and those ; To parse successfully, all characters following HL must be digits and those
@ -76,7 +76,7 @@ parseHexPair:
; digit in the string. ; digit in the string.
parseDecimal: parseDecimal:
push hl push hl ; --> lvl 1
ld a, (hl) ld a, (hl)
add a, 0xff-'9' ; maps '0'-'9' onto 0xf6-0xff add a, 0xff-'9' ; maps '0'-'9' onto 0xf6-0xff
@ -129,23 +129,23 @@ parseDecimal:
; to 0x00+(0xff-'9')-(0xff-9)=-0x30=0xd0 ; to 0x00+(0xff-'9')-(0xff-9)=-0x30=0xd0
sub 0xd0 ; if a is null, set Z sub 0xd0 ; if a is null, set Z
; a is checked for null before any errors ; a is checked for null before any errors
push hl \ pop ix push hl ; --> lvl 2, result
exx ; restore original de and bc exx ; restore original bc
pop hl pop de ; <-- lvl 2, result
pop hl ; <-- lvl 1, orig
ret z ret z
; A is not 0? Ok, but if it's a space, we're happy too. ; A is not 0? Ok, but if it's a space, we're happy too.
jp isWS jp isWS
.error: .error:
pop hl pop hl ; <-- lvl 1, orig
jp unsetZ jp unsetZ
; Parse string at (HL) as a hexadecimal value and return value in IX under the ; Parse string at (HL) as a hexadecimal value and return value in DE under the
; same conditions as parseLiteral. ; same conditions as parseLiteral.
parseHexadecimal: parseHexadecimal:
call hasHexPrefix call hasHexPrefix
ret nz ret nz
push hl push hl
push de
ld d, 0 ld d, 0
inc hl ; get rid of "0x" inc hl ; get rid of "0x"
inc hl inc hl
@ -179,8 +179,6 @@ parseHexadecimal:
.error: .error:
call unsetZ call unsetZ
.end: .end:
push de \ pop ix
pop de
pop hl pop hl
ret ret
@ -196,15 +194,14 @@ hasHexPrefix:
pop hl pop hl
ret ret
; Parse string at (HL) as a binary value (0b010101) and return value in IX. ; Parse string at (HL) as a binary value (0b010101) and return value in E.
; High IX byte is always clear. ; D is always zero.
; Sets Z on success. ; Sets Z on success.
parseBinaryLiteral: parseBinaryLiteral:
call hasBinPrefix call hasBinPrefix
ret nz ret nz
push bc push bc
push hl push hl
push de
ld d, 0 ld d, 0
inc hl ; get rid of "0b" inc hl ; get rid of "0b"
inc hl inc hl
@ -236,8 +233,6 @@ parseBinaryLiteral:
.error: .error:
call unsetZ call unsetZ
.end: .end:
push de \ pop ix
pop de
pop hl pop hl
pop bc pop bc
ret ret
@ -255,7 +250,7 @@ hasBinPrefix:
ret ret
; Parse string at (HL) and, if it is a char literal, sets Z and return ; Parse string at (HL) and, if it is a char literal, sets Z and return
; corresponding value in IX. High IX byte is always clear. ; corresponding value in E. D is always zero.
; ;
; A valid char literal starts with ', ends with ' and has one character in the ; A valid char literal starts with ', ends with ' and has one character in the
; middle. No escape sequence are accepted, but ''' will return the apostrophe ; middle. No escape sequence are accepted, but ''' will return the apostrophe
@ -266,7 +261,6 @@ parseCharLiteral:
ret nz ret nz
push hl push hl
push de
inc hl inc hl
inc hl inc hl
cp (hl) cp (hl)
@ -283,12 +277,10 @@ parseCharLiteral:
ld e, a ld e, a
cp a ; ensure Z cp a ; ensure Z
.end: .end:
push de \ pop ix
pop de
pop hl pop hl
ret ret
; Parses the string at (HL) and returns the 16-bit value in IX. The string ; Parses the string at (HL) and returns the 16-bit value in DE. The string
; can be a decimal literal (1234), a hexadecimal literal (0x1234) or a char ; can be a decimal literal (1234), a hexadecimal literal (0x1234) or a char
; literal ('X'). ; literal ('X').
; ;

View File

@ -657,7 +657,6 @@ _readDouble:
_readk7: _readk7:
push hl push hl
push de push de
push ix
call parseExpr call parseExpr
jr nz, .end jr nz, .end
; If we're in first pass, stop now. The value of HL doesn't matter and ; If we're in first pass, stop now. The value of HL doesn't matter and
@ -686,7 +685,6 @@ _readk7:
ld a, l ld a, l
cp a ; ensure Z cp a ; ensure Z
.end: .end:
pop ix
pop de pop de
pop hl pop hl
ret ret
@ -707,7 +705,6 @@ _readR4:
; Set Z for success. ; Set Z for success.
_readR5: _readR5:
push de push de
push ix
ld a, (hl) ld a, (hl)
call upcase call upcase
cp 'R' cp 'R'
@ -715,11 +712,9 @@ _readR5:
inc hl inc hl
call parseDecimal call parseDecimal
jr nz, .end jr nz, .end
push ix \ pop de
ld a, 31 ld a, 31
call _DE2A call _DE2A
.end: .end:
pop ix
pop de pop de
ret ret

View File

@ -1,5 +1,5 @@
; Parse string in (HL) and return its numerical value whether its a number ; Parse string in (HL) and return its numerical value whether its a number
; literal or a symbol. Returns value in IX. ; literal or a symbol. Returns value in DE.
; Sets Z if number or symbol is valid, unset otherwise. ; Sets Z if number or symbol is valid, unset otherwise.
parseNumberOrSymbol: parseNumberOrSymbol:
call parseLiteral call parseLiteral
@ -14,31 +14,25 @@ parseNumberOrSymbol:
cp '@' cp '@'
jr nz, .symbol jr nz, .symbol
; last val ; last val
ld ix, (DIREC_LASTVAL) ld de, (DIREC_LASTVAL)
ret ret
.symbol: .symbol:
push de ; --> lvl 1
call symFindVal ; --> DE call symFindVal ; --> DE
jr nz, .notfound jr nz, .notfound
; value in DE. We need it in IX
push de \ pop ix
pop de ; <-- lvl 1
cp a ; ensure Z
ret ret
.notfound: .notfound:
pop de ; <-- lvl 1
; If not found, check if we're in first pass. If we are, it doesn't ; If not found, check if we're in first pass. If we are, it doesn't
; matter that we didn't find our symbol. Return success anyhow. ; matter that we didn't find our symbol. Return success anyhow.
; Otherwise return error. Z is already unset, so in fact, this is the ; Otherwise return error. Z is already unset, so in fact, this is the
; same as jumping to zasmIsFirstPass ; same as jumping to zasmIsFirstPass
; however, before we do, load IX with zero. Returning dummy non-zero ; however, before we do, load DE with zero. Returning dummy non-zero
; values can have weird consequence (such as false overflow errors). ; values can have weird consequence (such as false overflow errors).
ld ix, 0 ld de, 0
jp zasmIsFirstPass jp zasmIsFirstPass
.returnPC: .returnPC:
push hl push hl
call zasmGetPC call zasmGetPC
push hl \ pop ix ex de, hl ; result in DE
pop hl pop hl
ret ret

View File

@ -6,6 +6,12 @@
; lib/fmt ; lib/fmt
testNum: .db 1 testNum: .db 1
; Each time we call assertSP, we verify that our stack isn't imbalanced by
; comparing SP to its saved value. Whenever your "base" SP value change,
; generally at the beginning of a test routine, run "ld (testSP), sp" to have
; proper value saved to heap.
testSP: .dw 0xffff
STDIO_PUTC: STDIO_PUTC:
out (0), a out (0), a
@ -51,6 +57,38 @@ assertEQW:
.msg: .msg:
.db "HL != DE", CR, LF, 0 .db "HL != DE", CR, LF, 0
; Given a list of pointer to test data structures in HL and a pointer to a test
; routine in IX, call (IX) with HL pointing to the test structure until the list
; points to a zero. See testParseExpr in test_expr for an example usage.
testList:
push hl ; --> lvl 1
call intoHL
ld a, h
or l
jr z, .end
call callIX
call nexttest
pop hl ; <-- lvl 1
inc hl \ inc hl
jr testList
.end:
pop hl ; <-- lvl 1
ret
; test that SP == testSP
assertSP:
ld hl, (testSP)
; offset the fact that we call assertSP
dec hl \ dec hl
or a ; reset carry
sbc hl, sp
ret z
ld hl, .msg
call printstr
jr fail
.msg:
.db "Wrong SP", CR, LF, 0
nexttest: nexttest:
ld a, (testNum) ld a, (testNum)
inc a inc a

View File

@ -34,12 +34,6 @@ zasmIsFirstPass:
zasmGetPC: zasmGetPC:
ret ret
s1: .db "2+2", 0
s2: .db "0x4001+0x22", 0
s3: .db "FOO+BAR", 0
s4: .db "BAR*3", 0
s5: .db "FOO-3", 0
s6: .db "FOO+BAR*4", 0
sFOO: .db "FOO", 0 sFOO: .db "FOO", 0
sBAR: .db "BAR", 0 sBAR: .db "BAR", 0
@ -47,25 +41,7 @@ sBAR: .db "BAR", 0
test: test:
ld sp, 0xffff ld sp, 0xffff
; New-style tests ; before testing begins, let's set up FOO and BAR symbols
call testParseExpr
; Old-style tests, not touching them now.
ld hl, s1
call parseExpr
call assertZ
ld hl, 4
call assertEQW
call nexttest
ld hl, s2
call parseExpr
call assertZ
ld hl, 0x4023
call assertEQW
call nexttest
; before the next test, let's set up FOO and BAR symbols
call symInit call symInit
ld hl, sFOO ld hl, sFOO
ld de, 0x4000 ld de, 0x4000
@ -76,68 +52,26 @@ test:
call symRegisterGlobal call symRegisterGlobal
jp nz, fail jp nz, fail
ld hl, s3 call testParseExpr
call parseExpr call testSPOnFail
call assertZ
ld hl, 0x4020
call assertEQW
call nexttest
ld hl, s4
call parseExpr
call assertZ
ld hl, 0x60
call assertEQW
call nexttest
ld hl, s5
call parseExpr
call assertZ
ld hl, 0x3ffd
call assertEQW
call nexttest
ld hl, s6
call parseExpr
call assertZ
ld hl, 0x4080
call assertEQW
call nexttest
; success ; success
xor a xor a
halt halt
testParseExpr: testParseExpr:
ld iy, .t1 ld hl, .alltests
call .testEQ ld ix, .test
ld iy, .t2 jp testList
call .testEQ
ld iy, .t3
call .testEQ
ld iy, .t4
call .testEQ
ld iy, .t5
call .testEQ
ld iy, .t6
call .testEQ
ld iy, .t7
call .testEQ
ld iy, .t8
call .testEQ
ld iy, .t9
call .testEQ
ret
.testEQ: .test:
push iy \ pop hl push hl \ pop iy
inc hl \ inc hl inc hl \ inc hl
call parseExpr call parseExpr
call assertZ call assertZ
ld l, (iy) ld l, (iy)
ld h, (iy+1) ld h, (iy+1)
call assertEQW jp assertEQW
jp nexttest
.t1: .t1:
.dw 7 .dw 7
@ -166,3 +100,46 @@ testParseExpr:
.t9: .t9:
.dw 10 .dw 10
.db "2*3+4", 0 .db "2*3+4", 0
; There was this untested regression during the replacement of find-and-subst
; parseExpr to the recursive descent one. It was time consuming to find. Here
; it goes, here it stays.
.t10:
.dw '-'+1
.db "'-'+1", 0
.t11:
.dw 0x4023
.db "0x4001+0x22", 0
.t12:
.dw 0x4020
.db "FOO+BAR", 0
.t13:
.dw 0x60
.db "BAR*3", 0
.t14:
.dw 0x3ffd
.db "FOO-3", 0
.t15:
.dw 0x4080
.db "FOO+BAR*4", 0
.alltests:
.dw .t1, .t2, .t3, .t4, .t5, .t6, .t7, .t8, .t9, .t10, .t11, .t12
.dw .t13, .t14, .t15, 0
; Ensure that stack is balanced on failure
testSPOnFail:
ld (testSP), sp
ld hl, .sFail
call parseExpr
call assertNZ
call assertSP
jp nexttest
.sFail: .db "1+abc123", 0

View File

@ -13,9 +13,9 @@ cmpas() {
echo ok echo ok
else else
echo actual echo actual
echo $ACTUAL echo "$ACTUAL"
echo expected echo expected
echo $EXPECTED echo "$EXPECTED"
exit 1 exit 1
fi fi
} }