1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-03 00:40:57 +11:00

Compare commits

..

No commits in common. "0e79035d9cee0adae092657b95addfe8a5459939" and "f3992ed59855f3cfcfa0e785765b7055997d380e" have entirely different histories.

32 changed files with 84 additions and 125 deletions

View File

@ -49,11 +49,8 @@ for more information.
For a general discussion of Collapse OS and the ecosystem of technologies and ideas that may develop around it refer to [r/collapseos][discussion] For a general discussion of Collapse OS and the ecosystem of technologies and ideas that may develop around it refer to [r/collapseos][discussion]
A more traditional [mailing list][listserv] and IRC (#collapseos on freenode) channels are also maintained.
[libz80]: https://github.com/ggambetta/libz80 [libz80]: https://github.com/ggambetta/libz80
[web]: https://collapseos.org [web]: https://collapseos.org
[jsemul]: https://schierlm.github.io/CollapseOS-Web-Emulator/ [jsemul]: https://schierlm.github.io/CollapseOS-Web-Emulator/
[discussion]: https://www.reddit.com/r/collapseos [discussion]: https://www.reddit.com/r/collapseos
[listserv]: http://lists.sonic.net/mailman/listinfo/collapseos

View File

@ -12,7 +12,6 @@
jp basStart jp basStart
.inc "lib/util.asm"
.inc "lib/parse.asm" .inc "lib/parse.asm"
.equ BAS_RAMSTART USER_RAMSTART .equ BAS_RAMSTART USER_RAMSTART
.inc "basic/main.asm" .inc "basic/main.asm"

View File

@ -1,3 +1,6 @@
; *** Requirements ***
; None
;
; *** Code *** ; *** Code ***
; Parse the decimal char at A and extract it's 0-9 numerical value. Put the ; Parse the decimal char at A and extract it's 0-9 numerical value. Put the
@ -12,10 +15,6 @@
; 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 IX 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
; digits must form a number that fits in 16 bits. To end the number, both \0
; and whitespaces (0x20 and 0x09) are accepted. There must be at least one
; digit in the string.
parseDecimal: parseDecimal:
push hl push hl
@ -23,11 +22,11 @@ parseDecimal:
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
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
jr c, .error ; not a digit on first char? error
exx ; preserve bc, hl, de exx ; preserve bc, hl, de
ld h, 0 ld h, 0
ld l, a ; load first digit in without multiplying ld l, a ; load first digit in without multiplying
ld b, 3 ; Carries can only occur for decimals >=5 in length ld b, 3 ; Carries can only occur for decimals >=5 in length
jr c, .end
.loop: .loop:
exx exx
@ -38,6 +37,7 @@ parseDecimal:
; inline parseDecimalDigit ; inline parseDecimalDigit
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
jr c, .end jr c, .end
add hl, hl ; x2 add hl, hl ; x2
@ -74,9 +74,4 @@ parseDecimal:
push hl \ pop ix push hl \ pop ix
exx ; restore original de and bc exx ; restore original de and bc
pop hl pop hl
ret z ret
; A is not 0? Ok, but if it's a space, we're happy too.
jp isSep
.error:
pop hl
jp unsetZ

View File

@ -1,10 +1,3 @@
; Sets Z is A is ' ' or '\t'
isSep:
cp ' '
ret z
cp 0x09
ret
; Copy string from (HL) in (DE), that is, copy bytes until a null char is ; Copy string from (HL) in (DE), that is, copy bytes until a null char is
; encountered. The null char is also copied. ; encountered. The null char is also copied.
; HL and DE point to the char right after the null char. ; HL and DE point to the char right after the null char.

View File

@ -130,11 +130,6 @@ of programs.
offset. For example, if we want to place an instruction exactly at offset. For example, if we want to place an instruction exactly at
byte 0x38, we would precede it with `.fill 0x38-$`. byte 0x38, we would precede it with `.fill 0x38-$`.
The maximum value possible for `.fill` is `0xd000`. We do this to
avoid "overshoot" errors, that is, error where `$` is greater than
the offset you're trying to reach in an expression like `.fill X-$`
(such an expression overflows to `0xffff`).
**.org**: Sets the Program Counter to the value of the argument, an expression. **.org**: Sets the Program Counter to the value of the argument, an expression.
For example, a label being defined right after a `.org 0x400`, would For example, a label being defined right after a `.org 0x400`, would
have a value of `0x400`. Does not do any filling. You have to do that have a value of `0x400`. Does not do any filling. You have to do that

View File

@ -201,11 +201,8 @@ handleFIL:
jr nz, .badfmt jr nz, .badfmt
call parseExpr call parseExpr
jr nz, .badarg jr nz, .badarg
push bc ; --> lvl 1 push bc
push ix \ pop bc push ix \ pop bc
ld a, b
cp 0xd0
jr nc, .overflow
.loop: .loop:
ld a, b ld a, b
or c or c
@ -217,21 +214,19 @@ handleFIL:
jr .loop jr .loop
.loopend: .loopend:
cp a ; ensure Z cp a ; ensure Z
pop bc ; <-- lvl 1 pop bc
ret ret
.ioError: .ioError:
ld a, SHELL_ERR_IO_ERROR ld a, SHELL_ERR_IO_ERROR
jp unsetZ jr .error
.badfmt: .badfmt:
ld a, ERR_BAD_FMT ld a, ERR_BAD_FMT
jp unsetZ jr .error
.badarg: .badarg:
ld a, ERR_BAD_ARG ld a, ERR_BAD_ARG
jp unsetZ .error:
.overflow: call unsetZ
pop bc ; <-- lvl 1 ret
ld a, ERR_OVFL
jp unsetZ
handleOUT: handleOUT:
push hl push hl

View File

@ -68,7 +68,6 @@
; ****** ; ******
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.org USER_CODE .org USER_CODE
jp zasmMain jp zasmMain

View File

@ -195,9 +195,6 @@ parseNumberOrSymbol:
; 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
; values can have weird consequence (such as false overflow errors).
ld ix, 0
jp zasmIsFirstPass jp zasmIsFirstPass
.returnPC: .returnPC:

View File

@ -22,13 +22,20 @@ isLineEndOrComment:
isLineEnd: isLineEnd:
or a ; same as cp 0 or a ; same as cp 0
ret z ret z
cp CR cp 0x0d
ret z ret z
cp LF cp 0x0a
ret z ret z
cp '\' cp '\'
ret ret
; Sets Z is A is ' ' '\t' or ','
isSep:
cp ' '
ret z
cp 0x09
ret
; Sets Z is A is ' ', ',', ';', CR, LF, or null. ; Sets Z is A is ' ', ',', ';', CR, LF, or null.
isSepOrLineEnd: isSepOrLineEnd:
call isSep call isSep

View File

@ -19,7 +19,6 @@ look like:
jp aciaInt jp aciaInt
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.inc "parse.asm" .inc "parse.asm"
.equ ACIA_RAMSTART RAMSTART .equ ACIA_RAMSTART RAMSTART

View File

@ -1,4 +0,0 @@
.equ BS 0x08
.equ CR 0x0d
.equ LF 0x0a
.equ DEL 0x7f

View File

@ -3,6 +3,16 @@
; Routines used by pretty much all parts. You will want to include it first ; Routines used by pretty much all parts. You will want to include it first
; in your glue file. ; in your glue file.
; *** CONSTS ***
.equ ASCII_BS 0x08
.equ ASCII_CR 0x0d
.equ ASCII_LF 0x0a
.equ ASCII_DEL 0x7f
; *** DATA ***
; Useful data to point to, when a pointer is needed.
P_NULL: .db 0
; *** REGISTER FIDDLING *** ; *** REGISTER FIDDLING ***
; add the value of A into DE ; add the value of A into DE

View File

@ -66,7 +66,7 @@ shellInit:
jp printstr jp printstr
.welcome: .welcome:
.db "Collapse OS", CR, LF, "> ", 0 .db "Collapse OS", ASCII_CR, ASCII_LF, "> ", 0
; Inifite loop that processes input. Because it's infinite, you should jump ; Inifite loop that processes input. Because it's infinite, you should jump
; to it rather than call it. Saves two precious bytes in the stack. ; to it rather than call it. Saves two precious bytes in the stack.

View File

@ -185,7 +185,7 @@ padGetC:
call vdpSpitC call vdpSpitC
jp padGetC jp padGetC
.return: .return:
ld a, LF ld a, ASCII_LF
ld (PAD_NEXTCHR), a ld (PAD_NEXTCHR), a
; continue to .advance ; continue to .advance
.advance: .advance:
@ -193,7 +193,7 @@ padGetC:
; Z was already set from previous BIT instruction ; Z was already set from previous BIT instruction
ret ret
.backspace: .backspace:
ld a, BS ld a, ASCII_BS
; Z was already set from previous BIT instruction ; Z was already set from previous BIT instruction
ret ret
.nextchr: .nextchr:

View File

@ -119,11 +119,11 @@ vdpPutC:
; 6 low bits contain our row*2 (each tile is 2 bytes wide) and high ; 6 low bits contain our row*2 (each tile is 2 bytes wide) and high
; 2 bits are the two low bits of our line ; 2 bits are the two low bits of our line
; special case: line feed, carriage return, back space ; special case: line feed, carriage return, back space
cp LF cp ASCII_LF
jr z, vdpLF jr z, vdpLF
cp CR cp ASCII_CR
jr z, vdpCR jr z, vdpCR
cp BS cp ASCII_BS
jr z, vdpBS jr z, vdpBS
push af push af

View File

@ -81,9 +81,9 @@ printnstr:
printcrlf: printcrlf:
push af push af
ld a, CR ld a, ASCII_CR
call STDIO_PUTC call STDIO_PUTC
ld a, LF ld a, ASCII_LF
call STDIO_PUTC call STDIO_PUTC
pop af pop af
ret ret
@ -124,13 +124,13 @@ stdioReadLine:
; Let's wait until something is typed. ; Let's wait until something is typed.
call STDIO_GETC call STDIO_GETC
; got it. Now, is it a CR or LF? ; got it. Now, is it a CR or LF?
cp CR cp ASCII_CR
jr z, .complete ; char is CR? buffer complete! jr z, .complete ; char is CR? buffer complete!
cp LF cp ASCII_LF
jr z, .complete jr z, .complete
cp DEL cp ASCII_DEL
jr z, .delchr jr z, .delchr
cp BS cp ASCII_BS
jr z, .delchr jr z, .delchr
; Echo the received character right away so that we see what we type ; Echo the received character right away so that we see what we type
@ -161,10 +161,10 @@ stdioReadLine:
inc b inc b
; Char deleted in buffer, now send BS + space + BS for the terminal ; Char deleted in buffer, now send BS + space + BS for the terminal
; to clear its previous char ; to clear its previous char
ld a, BS ld a, ASCII_BS
call STDIO_PUTC call STDIO_PUTC
ld a, ' ' ld a, ' '
call STDIO_PUTC call STDIO_PUTC
ld a, BS ld a, ASCII_BS
call STDIO_PUTC call STDIO_PUTC
jr .loop jr .loop

View File

@ -329,9 +329,9 @@ lcdClrScr:
ret ret
lcdPutC: lcdPutC:
cp LF cp ASCII_LF
jp z, lcdLinefeed jp z, lcdLinefeed
cp BS cp ASCII_BS
jr z, .bs jr z, .bs
push hl push hl
call fntGet call fntGet

View File

@ -12,7 +12,6 @@ jp init
jp aciaInt jp aciaInt
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.inc "parse.asm" .inc "parse.asm"
.equ ACIA_RAMSTART RAMSTART .equ ACIA_RAMSTART RAMSTART

View File

@ -12,7 +12,6 @@ jp init
jp aciaInt jp aciaInt
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.inc "parse.asm" .inc "parse.asm"
.equ ACIA_RAMSTART RAMSTART .equ ACIA_RAMSTART RAMSTART

View File

@ -7,7 +7,6 @@
jp init jp init
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.inc "parse.asm" .inc "parse.asm"
.equ ACIA_RAMSTART RAMSTART .equ ACIA_RAMSTART RAMSTART

View File

@ -21,7 +21,6 @@ jp sdcSendRecv
jp aciaInt jp aciaInt
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.inc "parse.asm" .inc "parse.asm"
.equ ACIA_RAMSTART RAMSTART .equ ACIA_RAMSTART RAMSTART

View File

@ -47,7 +47,6 @@ jp aciaInt
jp blkGetB jp blkGetB
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.inc "parse.asm" .inc "parse.asm"
.equ ACIA_RAMSTART RAMSTART .equ ACIA_RAMSTART RAMSTART

View File

@ -9,7 +9,6 @@
retn retn
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.inc "parse.asm" .inc "parse.asm"

View File

@ -9,7 +9,6 @@
retn retn
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.inc "parse.asm" .inc "parse.asm"

View File

@ -40,7 +40,6 @@
retn retn
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.inc "parse.asm" .inc "parse.asm"

View File

@ -22,7 +22,6 @@
.fill 0x64-$ .fill 0x64-$
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "core.asm" .inc "core.asm"
.equ FNT_WIDTH 3 .equ FNT_WIDTH 3
.equ FNT_HEIGHT 5 .equ FNT_HEIGHT 5

View File

@ -42,7 +42,6 @@
.inc "core.asm" .inc "core.asm"
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "parse.asm" .inc "parse.asm"
.equ BLOCKDEV_RAMSTART RAMSTART .equ BLOCKDEV_RAMSTART RAMSTART

View File

@ -33,7 +33,6 @@ jp printstr
.inc "core.asm" .inc "core.asm"
.inc "err.h" .inc "err.h"
.inc "ascii.h"
.inc "parse.asm" .inc "parse.asm"
.equ BLOCKDEV_RAMSTART RAMSTART .equ BLOCKDEV_RAMSTART RAMSTART
.equ BLOCKDEV_COUNT 3 .equ BLOCKDEV_COUNT 3

Binary file not shown.

Binary file not shown.

View File

@ -100,11 +100,29 @@ testLiteral:
call nexttest call nexttest
ret ret
; 2b int, 6b str, null-padded
tblDecimalValid:
.dw 99
.db "99", 0, 0, 0, 0
.dw 65535
.db "65535", 0
; 7b strings, null-padded
tblDecimalInvalid:
; TODO: make a null string parse as an invalid decimal
; 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
testDecimal: testDecimal:
; test valid cases. We loop through tblDecimalValid for our cases ; test valid cases. We loop through tblDecimalValid for our cases
ld b, 5 ld b, 2
ld hl, .valid ld hl, tblDecimalValid
.loop1: .loop1:
push hl ; --> lvl 1 push hl ; --> lvl 1
@ -129,8 +147,8 @@ testDecimal:
call nexttest call nexttest
; test invalid cases. We loop through tblDecimalInvalid for our cases ; test invalid cases. We loop through tblDecimalInvalid for our cases
ld b, 4 ld b, 3
ld hl, .invalid ld hl, tblDecimalInvalid
.loop2: .loop2:
call parseDecimal call parseDecimal
@ -141,34 +159,6 @@ testDecimal:
call nexttest call nexttest
ret 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: nexttest:
ld a, (testNum) ld a, (testNum)
inc a inc a

View File

@ -54,8 +54,6 @@ chkerr ".inc" 19
chkerr ".inc foo" 19 chkerr ".inc foo" 19
chkerr "ld a, 0x100" 20 chkerr "ld a, 0x100" 20
chkerr ".db 0x100" 20 chkerr ".db 0x100" 20
# TODO: find out why this tests fails on Travis but not on my machine...
# chkerr $'nop \ nop \ nop\n.fill 2-$' 20
chkerr ".inc \"doesnotexist\"" 21 chkerr ".inc \"doesnotexist\"" 21
chkerr "foo:\\foo:" 22 chkerr "foo:\\foo:" 22
chkoom chkoom