1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-26 07:28:10 +11:00

Compare commits

..

No commits in common. "e3c885085d1603afece4e0d870d2ca775286c71f" and "289037a3dd939120d65a04f05132d12fe3366ed7" have entirely different histories.

12 changed files with 409 additions and 368 deletions

View File

@ -74,6 +74,8 @@ There are decimal, hexadecimal and binary literals. A "straight" number is
parsed as a decimal. Hexadecimal literals must be prefixed with `0x` (`0xf4`).
Binary must be prefixed with `0b` (`0b01100110`).
A decimal literal cannot start with `0`, with the exception of the `0` literal.
Decimals and hexadecimal are "flexible". Whether they're written in a byte or
a word, you don't need to prefix them with zeroes. Watch out for overflow,
however.

View File

@ -84,12 +84,15 @@ varAssign:
; Check if value at (HL) is a variable. If yes, returns its associated value.
; Otherwise, jump to parseLiteral.
parseLiteralOrVar:
call isLiteralPrefix
jp z, parseLiteral
; not a literal, try var
inc hl
ld a, (hl)
dec hl
or a
; if more than one in length, it can't be a variable
jp nz, parseLiteral
ld a, (hl)
call varChk
ret nz
jp nz, parseLiteral
; It's a variable, resolve!
add a, a ; * 2 because each element is a word
push hl ; --> lvl 1
@ -99,6 +102,5 @@ parseLiteralOrVar:
inc hl
ld d, (hl)
pop hl ; <-- lvl 1
inc hl ; point to char after variable
cp a ; ensure Z
ret

View File

@ -6,8 +6,6 @@
; EXPR_PARSE: routine to call to parse literals or symbols that are part of
; the expression. Routine's signature:
; String in (HL), returns its parsed value to DE. Z for success.
; HL is advanced to the character following the last successfully
; read char.
;
; *** Code ***
;
@ -260,8 +258,74 @@ _parseNumber:
ret
.skip1:
; End of special case 1
call EXPR_PARSE ; --> DE
ret nz
; Check if (HL) points to null or op
; 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

@ -135,30 +135,45 @@ parseHexadecimal:
; Parse string at (HL) as a binary value (010101) without the "0b" prefix and
; return value in E. D is always zero.
; HL is advanced to the character following the last successfully read char.
; Sets Z on success.
parseBinaryLiteral:
ld de, 0
push bc
push hl
call strlen
or a
jr z, .error ; empty, error
cp 9
jr nc, .error ; >= 9, too long
; We have a string of 8 or less chars. What we'll do is that for each
; char, we rotate left and set the LSB according to whether we have '0'
; or '1'. Error out on anything else. C is our stored result.
ld b, a ; we loop for "strlen" times
ld c, 0 ; our stored result
.loop:
rlc c
ld a, (hl)
add a, 0xff-'1'
sub 0xff-1
jr c, .end
rl e
add a, e
ld e, a
jp c, unsetZ ; overflow
inc hl
jr .loop
cp '0'
jr z, .nobit ; no bit to set
cp '1'
jr nz, .error ; not 0 or 1
; We have a bit to set
inc c
.nobit:
djnz .loop
ld e, c
cp a ; ensure Z
jr .end
.error:
call unsetZ
.end:
; HL is properly set
xor a ; ensure Z
pop hl
pop bc
ret
; 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
; literal ('X').
; HL is advanced to the character following the last successfully read char.
;
; As soon as the number doesn't fit 16-bit any more, parsing stops and the
; number is invalid. If the number is valid, Z is set, otherwise, unset.
@ -167,57 +182,58 @@ parseLiteral:
ld a, (hl)
cp 0x27 ; apostrophe
jr z, .char
call isDigit
ret nz
cp '0'
jp nz, parseDecimal
; maybe hex, maybe binary
inc hl
ld a, (hl)
inc hl ; already place it for hex or bin
cp 'x'
jr z, parseHexadecimal
cp 'b'
jr z, parseBinaryLiteral
; nope, just a regular decimal
dec hl \ dec hl
jp parseDecimal
jr z, .hexOrBin
push hl
call parseDecimalC
pop hl
ret
; Parse string at (HL) and, if it is a char literal, sets Z and return
; corresponding value in E. D is always zero.
; HL is advanced to the character following the last successfully read char.
;
; 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
; character.
.char:
push hl
inc hl
ld e, (hl) ; our result
inc hl
cp (hl)
jr nz, .charError ; not ending with an apostrophe
; good char, advance HL and return
jr nz, .charEnd ; not ending with an apostrophe
inc hl
; Z already set
ret
.charError:
; In all error conditions, HL is advanced by 2. Rewind.
dec hl \ dec hl
; NZ already set
ld a, (hl)
or a ; cp 0
jr nz, .charEnd ; string has to end there
; Valid char, good
dec hl
dec hl
ld e, (hl)
cp a ; ensure Z
.charEnd:
pop hl
ret
.hexOrBin:
inc hl
ld a, (hl)
inc hl ; already place it for hex or bin
cp 'x'
jr z, .hex
cp 'b'
jr z, .bin
; special case: single '0'. set Z if we hit have null terminating.
or a
.hexOrBinEnd:
dec hl \ dec hl ; replace HL
ret ; Z already set
; Returns whether A is a literal prefix, that is, a digit or an apostrophe.
isLiteralPrefix:
cp 0x27 ; apostrophe
ret z
; continue to isDigit
.hex:
push hl
call parseHexadecimal
pop hl
jr .hexOrBinEnd
; Returns whether A is a digit
isDigit:
cp '0'
jp c, unsetZ
cp '9'+1
jp nc, unsetZ
cp a ; ensure Z
ret
.bin:
call parseBinaryLiteral
jr .hexOrBinEnd

View File

@ -1,26 +1,27 @@
; Parse string in (HL) and return its numerical value whether its a number
; literal or a symbol. Returns value in DE.
; HL is advanced to the character following the last successfully read char.
; Sets Z if number or symbol is valid, unset otherwise.
parseNumberOrSymbol:
call isLiteralPrefix
jp z, parseLiteral
; Not a number. try symbol
call parseLiteral
ret z
; Not a number.
; Is str a single char? If yes, maybe it's a special symbol.
call strIs1L
jr nz, .symbol ; nope
ld a, (hl)
cp '$'
jr z, .PC
jr z, .returnPC
cp '@'
jr z, .lastVal
call symParse
ret nz
; HL at end of symbol name, DE at tmp null-terminated symname.
push hl ; --> lvl 1
ex de, hl
jr nz, .symbol
; last val
ld de, (DIREC_LASTVAL)
ret
.symbol:
call symFindVal ; --> DE
pop hl ; <-- lvl 1
ret z
; not found
; When not found, check if we're in first pass. If we are, it doesn't
jr nz, .notfound
ret
.notfound:
; 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.
; Otherwise return error. Z is already unset, so in fact, this is the
; same as jumping to zasmIsFirstPass
@ -29,17 +30,9 @@ parseNumberOrSymbol:
ld de, 0
jp zasmIsFirstPass
.PC:
ex de, hl
call zasmGetPC ; --> HL
.returnPC:
push hl
call zasmGetPC
ex de, hl ; result in DE
inc hl ; char after last read
; Z already set from cp '$'
ret
.lastVal:
; last val
ld de, (DIREC_LASTVAL)
inc hl ; char after last read
; Z already set from cp '@'
pop hl
ret

View File

@ -9,12 +9,6 @@
; first pass" whenever we encounter a new context. That is, we wipe the local
; registry, parse the code until the next global symbol (or EOF), then rewind
; and continue second pass as usual.
;
; What is a symbol name? The accepted characters for a symbol are A-Z, a-z, 0-9
; dot (.) and underscore (_).
; This unit doesn't disallow symbols starting with a digit, but in effect, they
; aren't going to work because parseLiteral is going to get that digit first.
; So, make your symbols start with a letter or dot or underscore.
; *** Constants ***
; Size of each record in registry
@ -24,9 +18,6 @@
.equ SYM_LOC_REGSIZE ZASM_LREG_BUFSZ+1+ZASM_LREG_MAXCNT*SYM_RECSIZE
; Maximum name length for a symbol
.equ SYM_NAME_MAXLEN 0x20
; *** Variables ***
; A registry has three parts: record count (byte) record list and names pool.
; A record is a 3 bytes structure:
@ -43,11 +34,9 @@
; Global labels registry
.equ SYM_GLOB_REG SYM_RAMSTART
.equ SYM_LOC_REG @+SYM_REGSIZE
.equ SYM_CONST_REG @+SYM_LOC_REGSIZE
; Area where we parse symbol names into
.equ SYM_TMPNAME @+SYM_REGSIZE
.equ SYM_RAMEND @+SYM_NAME_MAXLEN+1
.equ SYM_LOC_REG SYM_GLOB_REG+SYM_REGSIZE
.equ SYM_CONST_REG SYM_LOC_REG+SYM_LOC_REGSIZE
.equ SYM_RAMEND SYM_CONST_REG+SYM_REGSIZE
; *** Registries ***
; A symbol registry is a 5 bytes record with points to the name pool then the
@ -278,63 +267,3 @@ _symIsFull:
pop hl
ret
; Parse string (HL) as far as it can for a valid symbol name (see definition in
; comment at top) for a maximum of SYM_NAME_MAXLEN characters. Puts the parsed
; symbol, null-terminated, in SYM_TMPNAME. Make DE point to SYM_TMPNAME.
; HL is advanced to the character following the last successfully read char.
; Z for success.
; Error conditions:
; 1 - No character parsed.
; 2 - name too long.
symParse:
ld de, SYM_TMPNAME
push bc
; +1 because we want to loop one extra time to see if the char is good
; or bad. If it's bad, then fine, proceed as normal. If it's good, then
; its going to go through djnz and we can return an error then.
ld b, SYM_NAME_MAXLEN+1
.loop:
ld a, (hl)
; Set it directly, even if we don't know yet if it's good
ld (de), a
or a ; end of string?
jr z, .end ; easy ending, Z set, HL set
; Check special symbols first
cp '.'
jr z, .good
cp '_'
jr z, .good
; lowercase
or 0x20
cp '0'
jr c, .bad
cp '9'+1
jr c, .good
cp 'a'
jr c, .bad
cp 'z'+1
jr nc, .bad
.good:
; character is valid, continue!
inc hl
inc de
djnz .loop
; error: string too long
; NZ is already set from cp 'z'+1
; HL is one char too far
dec hl
jr .end
.bad:
; invalid char, stop where we are.
; In all cases, we want to null-terminate that string
xor a
ld (de), a
; HL is good. Now, did we succeed? to know, let's see where B is.
ld a, b
cp SYM_NAME_MAXLEN+1
; Our result is the invert of Z
call toggleZ
.end:
ld de, SYM_TMPNAME
pop bc
ret

View File

@ -30,6 +30,16 @@ toggleZ:
cp a
ret
; Sets Z if string at (HL) is one character long
strIs1L:
xor a
cp (hl)
jp z, unsetZ ; empty string
inc hl
cp (hl) ; Z has proper value
dec hl ; doesn't touch Z
ret
; Compares strings pointed to by HL and DE up to A count of characters in a
; case-insensitive manner.
; If equal, Z is set. If not equal, Z is reset.

View File

@ -28,6 +28,7 @@ int main()
return 1;
}
emul_loop();
if (m->cpu.R1.wr.HL)
return m->cpu.R1.br.A;
}

View File

@ -37,37 +37,6 @@ assertNZ:
.msg:
.db "Z set", CR, LF, 0
assertC:
ret c
ld hl, .msg
call printstr
jp fail
.msg:
.db "C not set", CR, LF, 0
assertNC:
ret nc
ld hl, .msg
call printstr
jp fail
.msg:
.db "C set", CR, LF, 0
; Assert that A == B
assertEQB:
cp b
ret z
call printHex
call printcrlf
ld a, b
call printHex
call printcrlf
ld hl, .msg
call printstr
jp fail
.msg:
.db "A != B", CR, LF, 0
; Assert that HL == DE
assertEQW:
ld a, h

View File

@ -128,19 +128,9 @@ testParseExpr:
.dw 0x4080
.db "FOO+BAR*4", 0
; "0" is a special case, let's test it
.t16:
.dw 0
.db "0", 0
; Another one that caused troubles
.t17:
.dw 123
.db "0+123", 0
.alltests:
.dw .t1, .t2, .t3, .t4, .t5, .t6, .t7, .t8, .t9, .t10, .t11, .t12
.dw .t13, .t14, .t15, .t16, .t17, 0
.dw .t13, .t14, .t15, 0
; Ensure that stack is balanced on failure
testSPOnFail:

View File

@ -1,195 +1,85 @@
jp test
.inc "ascii.h"
.inc "core.asm"
.equ STDIO_RAMSTART RAMSTART
.inc "stdio.asm"
.inc "common.asm"
.inc "lib/ari.asm"
.inc "lib/util.asm"
.inc "lib/fmt.asm"
.inc "lib/parse.asm"
zasmGetPC:
ret
testNum: .db 1
test:
ld sp, 0xffff
call testParseHex
call testParseHexadecimal
call testParseDecimal
call testParseLiteral
; success
xor a
halt
testParseHex:
ld hl, .allGood
ld ix, .testGood
call testList
ld hl, .allBad
ld ix, .testBad
jp testList
.testGood:
ld a, (hl)
ld a, '8'
call parseHex
call assertNC
inc hl
ld b, (hl)
jp assertEQB
jp c, fail
cp 8
jp nz, fail
call nexttest
.testBad:
ld a, (hl)
ld a, 'e'
call parseHex
jp assertC
jp c, fail
cp 0xe
jp nz, fail
call nexttest
.g1:
.db '8', 8
.g2:
.db 'e', 0xe
.allGood:
.dw .g1, .g2, 0
.b1:
.db 'x'
.allBad:
.dw .b1, 0
ld a, 'x'
call parseHex
jp nc, fail
call nexttest
ret
testParseHexadecimal:
ld hl, .allGood
ld ix, .testGood
jp testList
.testGood:
ld c, (hl)
inc hl
ld b, (hl)
inc hl
ld hl, .s99
call parseHexadecimal
call assertZ
ld l, c
ld h, b
jp assertEQW
jp nz, fail
ld a, e
cp 0x99
jp nz, fail
call nexttest
.g1:
.dw 0x99
.db "99", 0
.g2:
.dw 0xab
.db "aB", 0
; The string "Foo" will not cause a failure. We will parse up to "o" and then
; stop.
.g3:
.dw 0xf
.db "Foo", 0
ld hl, .saB
call parseHexadecimal
jp nz, fail
ld a, e
cp 0xab
jp nz, fail
call nexttest
.allGood:
.dw .g1, .g2, .g3, 0
; The string "Foo" will not cause a failure. We will parse up to "o"
; and then stop.
ld hl, .sFoo
call parseHexadecimal
jp nz, fail
ld a, e
cp 0xf
call nexttest
ret
testParseDecimal:
ld hl, .allGood
ld ix, .testGood
call testList
ld hl, .allBad
ld ix, .testBad
jp testList
.sFoo: .db "Foo", 0
.saB: .db "aB", 0
.s99: .db "99", 0
.testGood:
ld c, (hl)
inc hl
ld b, (hl)
inc hl
call parseDecimalC
call assertZ
ld l, c
ld h, b
jp assertEQW
nexttest:
ld a, (testNum)
inc a
ld (testNum), a
ret
.testBad:
call parseDecimalC
jp assertNZ
fail:
ld a, (testNum)
halt
.g1:
.dw 99
.db "99", 0
.g2:
.dw 65535
.db "65535", 0
; Space is also accepted as a number "ender"
.g3:
.dw 42
.db "42 x", 0
; Tab too
.g4:
.dw 42
.db "42", 0x09, 'x', 0
; A simple "0" works too!
.g5:
.dw 0
.db '0', 0
.allGood:
.dw .g1, .g2, .g3, .g4, .g5, 0
; null string is invalid
.b1:
.db 0
; too big, 5 chars
.b2:
.db "65536", 0
.b3:
.db "99999", 0
.b4:
; too big, 6 chars with rightmost chars being within bound
.db "111111", 0
.allBad:
.dw .b1, .b2, .b3, .b4, 0
testParseLiteral:
ld hl, .allGood
ld ix, .testGood
call testList
ld hl, .allBad
ld ix, .testBad
jp testList
.testGood:
ld c, (hl)
inc hl
ld b, (hl)
inc hl
call parseLiteral
call assertZ
ld l, c
ld h, b
jp assertEQW
.testBad:
call parseLiteral
jp assertNZ
.g1:
.dw 99
.db "99", 0
.g2:
.dw 0x100
.db "0x100", 0
.g3:
.dw 0b0101
.db "0b0101", 0
.g4:
.dw 0b01010101
.db "0b01010101", 0
.allGood:
.dw .g1, .g2, .g3, .g4, 0
.b1:
.db "Foo", 0
.allBad:
.dw .b1, 0
RAMSTART:
; used as RAM
sandbox:

View File

@ -0,0 +1,175 @@
jp test
.inc "core.asm"
.inc "str.asm"
.inc "lib/util.asm"
.inc "zasm/util.asm"
.inc "lib/parse.asm"
; mocks. aren't used in tests
zasmGetPC:
zasmIsFirstPass:
symSelect:
symFindVal:
jp fail
testNum: .db 1
s99: .db "99", 0
s0x99: .db "0x99", 0
s0x100: .db "0x100", 0
s0b0101: .db "0b0101", 0
s0b01010101: .db "0b01010101", 0
sFoo: .db "Foo", 0
test:
ld sp, 0xffff
call testLiteral
call testDecimal
; success
xor a
halt
testLiteral:
ld hl, s99
call parseLiteral
jp nz, fail
ld a, d
or a
jp nz, fail
ld a, e
cp 99
jp nz, fail
call nexttest
ld hl, s0x100
call parseLiteral
jp nz, fail
ld a, d
cp 1
jp nz, fail
ld a, e
or a
jp nz, fail
call nexttest
ld hl, sFoo
call parseLiteral
jp z, fail
call nexttest
ld hl, s0b0101
call parseLiteral
jp nz, fail
ld a, d
or a
jp nz, fail
ld a, e
cp 0b0101
jp nz, fail
call nexttest
ld hl, s0b01010101
call parseLiteral
jp nz, fail
ld a, d
or a
jp nz, fail
ld a, e
cp 0b01010101
jp nz, fail
call nexttest
.equ FOO 0x42
.equ BAR @+1
ld a, BAR
cp 0x43
jp nz, fail
call nexttest
ret
testDecimal:
; test valid cases. We loop through tblDecimalValid for our cases
ld b, 5
ld hl, .valid
.loop1:
push hl ; --> lvl 1
; put expected number in IX
ld e, (hl)
inc hl
ld d, (hl)
inc hl
push de \ pop ix
call parseDecimalC ; --> DE
jp nz, fail
push ix \ pop hl ; push expected number in HL
ld a, h
cp d
jp nz, fail
ld a, l
cp e
jp nz, fail
pop hl ; <-- lvl 1
ld de, 8 ; row size
add hl, de
djnz .loop1
call nexttest
; test invalid cases. We loop through tblDecimalInvalid for our cases
ld b, 4
ld hl, .invalid
.loop2:
push hl
call parseDecimalC
pop hl
jp z, fail
ld de, 7 ; row size
add hl, de
djnz .loop2
call nexttest
ret
; 2b int, 6b str, null-padded
.valid:
.dw 99
.db "99", 0, 0, 0, 0
.dw 65535
.db "65535", 0
; Space is also accepted as a number "ender"
.dw 42
.db "42 x", 0, 0
; Tab too
.dw 42
.db "42", 0x09, 'x', 0, 0
; A simple "0" works too!
.dw 0
.db '0', 0, 0, 0, 0, 0
; 7b strings, null-padded
.invalid:
; null string is invalid
.db 0, 0, 0, 0, 0, 0, 0
; too big, 5 chars
.db "65536", 0, 0
.db "99999", 0, 0
; too big, 6 chars with rightmost chars being within bound
.db "111111", 0
nexttest:
ld a, (testNum)
inc a
ld (testNum), a
ret
fail:
ld a, (testNum)
halt