mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 20:20:55 +11:00
Compare commits
9 Commits
5d33d165a2
...
1b8b113536
Author | SHA1 | Date | |
---|---|---|---|
|
1b8b113536 | ||
|
948a06cb41 | ||
|
4f7a05e3b7 | ||
|
c002c69208 | ||
|
9ab292a6d5 | ||
|
43f4c5200e | ||
|
5b155a5c15 | ||
|
3db38b0d89 | ||
|
51c977f2ed |
@ -88,13 +88,22 @@ etc.) always to so in variable `A`.
|
|||||||
Another is that whenever a number is expected, expressions, including the ones
|
Another is that whenever a number is expected, expressions, including the ones
|
||||||
with variables in it, work fine.
|
with variables in it, work fine.
|
||||||
|
|
||||||
|
### One-liners
|
||||||
|
|
||||||
|
The `:` character, when not inside a `""` literal, allows you to cram more than
|
||||||
|
one instruction on the same line.
|
||||||
|
|
||||||
|
Things are special with `if`. All commands following a `if` are bound to that
|
||||||
|
`if`'s condition. `if 0 foo:bar` doesn't execute `bar`.
|
||||||
|
|
||||||
|
Another special thing is `goto`. A `goto` followed by `:` will have the commands
|
||||||
|
following the `:` before the goto occurs.
|
||||||
|
|
||||||
### Commands
|
### Commands
|
||||||
|
|
||||||
There are two types of commands: normal and direct-only. The latter can only
|
There are two types of commands: normal and direct-only. The latter can only
|
||||||
be invoked in direct mode, not through a code listing.
|
be invoked in direct mode, not through a code listing.
|
||||||
|
|
||||||
`bye`: Direct-only. Quits BASIC
|
|
||||||
|
|
||||||
`list`: Direct-only. Prints all lines in the code listing, prefixing them
|
`list`: Direct-only. Prints all lines in the code listing, prefixing them
|
||||||
with their associated line number.
|
with their associated line number.
|
||||||
|
|
||||||
@ -117,11 +126,14 @@ specified as an argument. Errors out if line doesn't exist. Argument can be
|
|||||||
an expression. If invoked in direct mode, `run` must be called to actually
|
an expression. If invoked in direct mode, `run` must be called to actually
|
||||||
run the line (followed by the next, and so on).
|
run the line (followed by the next, and so on).
|
||||||
|
|
||||||
`if <cond> <cmd>`: If specified condition is true, execute the rest of the
|
`if <cond> <cmds>`: If specified condition is true, execute the rest of the
|
||||||
line. Otherwise, do nothing. For example, `if 2>1 print 12` prints `12` and `if
|
line. Otherwise, do nothing. For example, `if 2>1 print 12` prints `12` and `if
|
||||||
2<1 print 12` does nothing. The argument for this command is a "thruth
|
2<1 print 12` does nothing. The argument for this command is a "thruth
|
||||||
expression".
|
expression".
|
||||||
|
|
||||||
|
`while <cond> <cmds>`: As long as specified condition is true, execute specified
|
||||||
|
commands repeatedly.
|
||||||
|
|
||||||
`input [<prompt>]`: Prompts the user for a numerical value and puts that
|
`input [<prompt>]`: Prompts the user for a numerical value and puts that
|
||||||
value in `A`. The prompted value is evaluated as an expression and then stored.
|
value in `A`. The prompted value is evaluated as an expression and then stored.
|
||||||
The command takes an optional string literal parameter. If present, that string
|
The command takes an optional string literal parameter. If present, that string
|
||||||
|
@ -46,7 +46,7 @@ basLDBAS:
|
|||||||
call parseDecimal
|
call parseDecimal
|
||||||
jr nz, .notANumber
|
jr nz, .notANumber
|
||||||
push ix \ pop de
|
push ix \ pop de
|
||||||
call toSep
|
call toSepOrEnd
|
||||||
call rdSep
|
call rdSep
|
||||||
call bufAdd
|
call bufAdd
|
||||||
pop hl ; <-- lvl 1
|
pop hl ; <-- lvl 1
|
||||||
|
@ -41,14 +41,14 @@ basLoop:
|
|||||||
call parseDecimal
|
call parseDecimal
|
||||||
jr z, .number
|
jr z, .number
|
||||||
ld de, basCmds1
|
ld de, basCmds1
|
||||||
call basCallCmd
|
call basCallCmds
|
||||||
jr z, basLoop
|
jr z, basLoop
|
||||||
; Error
|
; Error
|
||||||
call basERR
|
call basERR
|
||||||
jr basLoop
|
jr basLoop
|
||||||
.number:
|
.number:
|
||||||
push ix \ pop de
|
push ix \ pop de
|
||||||
call toSep
|
call toSepOrEnd
|
||||||
call rdSep
|
call rdSep
|
||||||
call bufAdd
|
call bufAdd
|
||||||
jp nz, basERR
|
jp nz, basERR
|
||||||
@ -110,6 +110,27 @@ basCallCmd:
|
|||||||
call rdSep
|
call rdSep
|
||||||
jp (ix)
|
jp (ix)
|
||||||
|
|
||||||
|
; Call a series of ':'-separated commands in (HL) using cmd table in (DE).
|
||||||
|
; Stop processing as soon as one command unsets Z.
|
||||||
|
basCallCmds:
|
||||||
|
; Commands are not guaranteed at all to preserve HL and DE, so we
|
||||||
|
; preserve them ourselves here.
|
||||||
|
push hl ; --> lvl 1
|
||||||
|
push de ; --> lvl 2
|
||||||
|
call basCallCmd
|
||||||
|
pop de ; <-- lvl 2
|
||||||
|
pop hl ; <-- lvl 1
|
||||||
|
ret nz
|
||||||
|
call toEnd
|
||||||
|
ret z ; no more cmds
|
||||||
|
; we met a ':', we have more cmds
|
||||||
|
inc hl
|
||||||
|
call basCallCmds
|
||||||
|
; move the the end of the string so that we don't run cmds following a
|
||||||
|
; ':' twice.
|
||||||
|
call strskip
|
||||||
|
ret
|
||||||
|
|
||||||
basERR:
|
basERR:
|
||||||
ld hl, .sErr
|
ld hl, .sErr
|
||||||
call printstr
|
call printstr
|
||||||
@ -154,7 +175,7 @@ basRUN:
|
|||||||
call bufStr
|
call bufStr
|
||||||
ld de, basCmds2
|
ld de, basCmds2
|
||||||
push ix ; --> lvl 1
|
push ix ; --> lvl 1
|
||||||
call basCallCmd
|
call basCallCmds
|
||||||
pop ix ; <-- lvl 1
|
pop ix ; <-- lvl 1
|
||||||
jp nz, .err
|
jp nz, .err
|
||||||
call .maybeGOTO
|
call .maybeGOTO
|
||||||
@ -246,22 +267,49 @@ basGOTO:
|
|||||||
ld (BAS_PNEXTLN), de
|
ld (BAS_PNEXTLN), de
|
||||||
ret
|
ret
|
||||||
|
|
||||||
basIF:
|
; evaluate truth condition at (HL) and set A to its value
|
||||||
|
; Z for success (but not truth!)
|
||||||
|
_basEvalCond:
|
||||||
push hl ; --> lvl 1. original arg
|
push hl ; --> lvl 1. original arg
|
||||||
ld de, SCRATCHPAD
|
ld de, SCRATCHPAD
|
||||||
call rdWord
|
call rdWord
|
||||||
ex de, hl
|
ex de, hl
|
||||||
call parseTruth
|
call parseTruth
|
||||||
pop hl ; <-- lvl 1. restore
|
pop hl ; <-- lvl 1. restore
|
||||||
ret nz
|
ret
|
||||||
|
|
||||||
|
basIF:
|
||||||
|
call _basEvalCond
|
||||||
|
ret nz ; error
|
||||||
or a
|
or a
|
||||||
ret z
|
ret z
|
||||||
; expr is true, execute next
|
; expr is true, execute next
|
||||||
; (HL) back to beginning of args, skip to next arg
|
; (HL) back to beginning of args, skip to next arg
|
||||||
call toSep
|
call toSepOrEnd
|
||||||
call rdSep
|
call rdSep
|
||||||
|
ret nz
|
||||||
ld de, basCmds2
|
ld de, basCmds2
|
||||||
jp basCallCmd
|
jp basCallCmds
|
||||||
|
|
||||||
|
basWHILE:
|
||||||
|
push hl ; --> lvl 1
|
||||||
|
call _basEvalCond
|
||||||
|
jr nz, .stop ; error
|
||||||
|
or a
|
||||||
|
jr z, .stop
|
||||||
|
ret z
|
||||||
|
; expr is true, execute next
|
||||||
|
; (HL) back to beginning of args, skip to next arg
|
||||||
|
call toSepOrEnd
|
||||||
|
call rdSep
|
||||||
|
ret nz
|
||||||
|
ld de, basCmds2
|
||||||
|
call basCallCmds
|
||||||
|
pop hl ; <-- lvl 1
|
||||||
|
jr basWHILE
|
||||||
|
.stop:
|
||||||
|
pop hl ; <-- lvl 1
|
||||||
|
ret
|
||||||
|
|
||||||
basINPUT:
|
basINPUT:
|
||||||
; If our first arg is a string literal, spit it
|
; If our first arg is a string literal, spit it
|
||||||
@ -456,6 +504,8 @@ basCmds2:
|
|||||||
.dw basGOTO
|
.dw basGOTO
|
||||||
.db "if", 0
|
.db "if", 0
|
||||||
.dw basIF
|
.dw basIF
|
||||||
|
.db "while", 0
|
||||||
|
.dw basWHILE
|
||||||
.db "input", 0
|
.db "input", 0
|
||||||
.dw basINPUT
|
.dw basINPUT
|
||||||
.db "peek", 0
|
.db "peek", 0
|
||||||
|
@ -1,10 +1,16 @@
|
|||||||
; Sets Z is A is ' ' or '\t' (whitespace), or ',' (arg sep)
|
; Whether A is a separator or end-of-string (null or ':')
|
||||||
|
isSepOrEnd:
|
||||||
|
or a
|
||||||
|
ret z
|
||||||
|
cp ':'
|
||||||
|
ret z
|
||||||
|
; continue to isSep
|
||||||
|
|
||||||
|
; Sets Z is A is ' ' or '\t' (whitespace)
|
||||||
isSep:
|
isSep:
|
||||||
cp ' '
|
cp ' '
|
||||||
ret z
|
ret z
|
||||||
cp 0x09
|
cp 0x09
|
||||||
ret z
|
|
||||||
cp ','
|
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Expect at least one whitespace (0x20, 0x09) at (HL), and then advance HL
|
; Expect at least one whitespace (0x20, 0x09) at (HL), and then advance HL
|
||||||
@ -23,8 +29,8 @@ rdSep:
|
|||||||
ld a, (hl)
|
ld a, (hl)
|
||||||
call isSep
|
call isSep
|
||||||
jr z, .loop
|
jr z, .loop
|
||||||
or a ; cp 0
|
call isSepOrEnd
|
||||||
jp z, .fail
|
jp z, .fail ; unexpected EOL. fail
|
||||||
cp a ; ensure Z
|
cp a ; ensure Z
|
||||||
ret
|
ret
|
||||||
.fail:
|
.fail:
|
||||||
@ -33,12 +39,28 @@ rdSep:
|
|||||||
ret
|
ret
|
||||||
|
|
||||||
; Advance HL to the next separator or to the end of string.
|
; Advance HL to the next separator or to the end of string.
|
||||||
toSep:
|
toSepOrEnd:
|
||||||
ld a, (hl)
|
ld a, (hl)
|
||||||
call isSep
|
call isSepOrEnd
|
||||||
ret z
|
ret z
|
||||||
inc hl
|
inc hl
|
||||||
jr toSep
|
jr toSepOrEnd
|
||||||
|
|
||||||
|
; Advance HL to the end of the line, that is, either a null terminating char
|
||||||
|
; or the ':'.
|
||||||
|
; Sets Z if we met a null char, unset if we met a ':'
|
||||||
|
toEnd:
|
||||||
|
ld a, (hl)
|
||||||
|
or a
|
||||||
|
ret z
|
||||||
|
cp ':'
|
||||||
|
jr z, .havesep
|
||||||
|
inc hl
|
||||||
|
call skipQuoted
|
||||||
|
jr toEnd
|
||||||
|
.havesep:
|
||||||
|
inc a ; unset Z
|
||||||
|
ret
|
||||||
|
|
||||||
; Read (HL) until the next separator and copy it in (DE)
|
; Read (HL) until the next separator and copy it in (DE)
|
||||||
; DE is preserved, but HL is advanced to the end of the read word.
|
; DE is preserved, but HL is advanced to the end of the read word.
|
||||||
@ -47,9 +69,7 @@ rdWord:
|
|||||||
push de
|
push de
|
||||||
.loop:
|
.loop:
|
||||||
ld a, (hl)
|
ld a, (hl)
|
||||||
call isSep
|
call isSepOrEnd
|
||||||
jr z, .stop
|
|
||||||
or a
|
|
||||||
jr z, .stop
|
jr z, .stop
|
||||||
ld (de), a
|
ld (de), a
|
||||||
inc hl
|
inc hl
|
||||||
|
@ -11,5 +11,22 @@ spitQuoted:
|
|||||||
inc hl
|
inc hl
|
||||||
cp '"'
|
cp '"'
|
||||||
ret z
|
ret z
|
||||||
|
or a
|
||||||
|
ret z
|
||||||
call stdioPutC
|
call stdioPutC
|
||||||
jr .loop
|
jr .loop
|
||||||
|
|
||||||
|
; Same as spitQuoted, but without the spitting
|
||||||
|
skipQuoted:
|
||||||
|
ld a, (hl)
|
||||||
|
cp '"'
|
||||||
|
ret nz
|
||||||
|
inc hl
|
||||||
|
.loop:
|
||||||
|
ld a, (hl)
|
||||||
|
inc hl
|
||||||
|
cp '"'
|
||||||
|
ret z
|
||||||
|
or a
|
||||||
|
ret z
|
||||||
|
jr .loop
|
||||||
|
@ -33,6 +33,7 @@
|
|||||||
.inc "core.asm"
|
.inc "core.asm"
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/parse.asm"
|
.inc "lib/parse.asm"
|
||||||
|
.inc "ed/util.asm"
|
||||||
.equ IO_RAMSTART USER_RAMSTART
|
.equ IO_RAMSTART USER_RAMSTART
|
||||||
.inc "ed/io.asm"
|
.inc "ed/io.asm"
|
||||||
.equ BUF_RAMSTART IO_RAMEND
|
.equ BUF_RAMSTART IO_RAMEND
|
||||||
|
8
apps/ed/util.asm
Normal file
8
apps/ed/util.asm
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
; Compare HL with DE and sets Z and C in the same way as a regular cp X where
|
||||||
|
; HL is A and DE is X.
|
||||||
|
cpHLDE:
|
||||||
|
push hl
|
||||||
|
or a ;reset carry flag
|
||||||
|
sbc hl, de ;There is no 'sub hl, de', so we must use sbc
|
||||||
|
pop hl
|
||||||
|
ret
|
@ -52,21 +52,12 @@ Let's try an example: You glue yourself a Collapse OS with a mmap starting at
|
|||||||
could do to copy memory around:
|
could do to copy memory around:
|
||||||
|
|
||||||
> m=0xe000
|
> m=0xe000
|
||||||
> 10 getc
|
> while m<0xe004 getc:poke m a:m=m+1
|
||||||
> 20 poke m a
|
|
||||||
> 30 m=m+1
|
|
||||||
> 40 if m<0xe004 goto 10
|
|
||||||
> run
|
|
||||||
[enter "abcd"]
|
[enter "abcd"]
|
||||||
> bsel 3
|
> bsel 3
|
||||||
> clear
|
> i=0
|
||||||
> 10 getb
|
> while i<4 getb:puth a:i=i+1
|
||||||
> 20 puth a
|
61626364> bseek 2
|
||||||
> run
|
> getb:puth a
|
||||||
61> run
|
63> getb:puth a
|
||||||
62> run
|
|
||||||
63> run
|
|
||||||
64> bseek 2
|
|
||||||
> run
|
|
||||||
63> run
|
|
||||||
64>
|
64>
|
||||||
|
@ -21,9 +21,7 @@ increase a number at memory address `0xa100`. First, compile it:
|
|||||||
Now, we'll send that code to address `0xa000`:
|
Now, we'll send that code to address `0xa000`:
|
||||||
|
|
||||||
> m=0xa000
|
> m=0xa000
|
||||||
> 10 getc
|
> while m<0xa008 getc:poke m a:m=m+1
|
||||||
> 20 poke m a
|
|
||||||
> 30 if m<0xa008 goto 10
|
|
||||||
(resulting binary is 8 bytes long)
|
(resulting binary is 8 bytes long)
|
||||||
|
|
||||||
Now, at this point, it's a bit delicate. To pipe your binary to your serial
|
Now, at this point, it's a bit delicate. To pipe your binary to your serial
|
||||||
|
@ -57,15 +57,6 @@ intoIX:
|
|||||||
pop ix
|
pop ix
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Compare HL with DE and sets Z and C in the same way as a regular cp X where
|
|
||||||
; HL is A and DE is X.
|
|
||||||
cpHLDE:
|
|
||||||
push hl
|
|
||||||
or a ;reset carry flag
|
|
||||||
sbc hl, de ;There is no 'sub hl, de', so we must use sbc
|
|
||||||
pop hl
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Write the contents of HL in (DE)
|
; Write the contents of HL in (DE)
|
||||||
; de and hl are preserved, so no pushing/popping necessary
|
; de and hl are preserved, so no pushing/popping necessary
|
||||||
writeHLinDE:
|
writeHLinDE:
|
||||||
|
@ -413,17 +413,17 @@ fsPlaceH:
|
|||||||
; Sets Z according to whether HL is within bounds for file handle at (IX), that
|
; Sets Z according to whether HL is within bounds for file handle at (IX), that
|
||||||
; is, if it is smaller than file size.
|
; is, if it is smaller than file size.
|
||||||
fsWithinBounds:
|
fsWithinBounds:
|
||||||
push de
|
ld a, h
|
||||||
; file size
|
cp (ix+5)
|
||||||
ld e, (ix+4)
|
jr c, .within ; H < (IX+5)
|
||||||
ld d, (ix+5)
|
jp nz, unsetZ ; H > (IX+5)
|
||||||
call cpHLDE
|
; H == (IX+5)
|
||||||
pop de
|
ld a, l
|
||||||
jr nc, .outOfBounds ; HL >= DE
|
cp (ix+4)
|
||||||
|
jp nc, unsetZ ; L >= (IX+4)
|
||||||
|
.within:
|
||||||
cp a ; ensure Z
|
cp a ; ensure Z
|
||||||
ret
|
ret
|
||||||
.outOfBounds:
|
|
||||||
jp unsetZ ; returns
|
|
||||||
|
|
||||||
; Set size of file handle (IX) to value in HL.
|
; Set size of file handle (IX) to value in HL.
|
||||||
; This writes directly in handle's metadata.
|
; This writes directly in handle's metadata.
|
||||||
|
@ -13,8 +13,10 @@
|
|||||||
_mmapAddr:
|
_mmapAddr:
|
||||||
push de
|
push de
|
||||||
ld de, MMAP_LEN
|
ld de, MMAP_LEN
|
||||||
call cpHLDE
|
or a ; reset carry flag
|
||||||
|
sbc hl, de
|
||||||
jr nc, .outOfBounds ; HL >= DE
|
jr nc, .outOfBounds ; HL >= DE
|
||||||
|
add hl, de ; old HL value
|
||||||
ld de, MMAP_START
|
ld de, MMAP_START
|
||||||
add hl, de
|
add hl, de
|
||||||
cp a ; ensure Z
|
cp a ; ensure Z
|
||||||
|
@ -27,7 +27,7 @@
|
|||||||
; *** Consts ***
|
; *** Consts ***
|
||||||
; Size of the readline buffer. If a typed line reaches this size, the line is
|
; Size of the readline buffer. If a typed line reaches this size, the line is
|
||||||
; flushed immediately (same as pressing return).
|
; flushed immediately (same as pressing return).
|
||||||
.equ STDIO_BUFSIZE 0x20
|
.equ STDIO_BUFSIZE 0x40
|
||||||
|
|
||||||
; *** Variables ***
|
; *** Variables ***
|
||||||
; Line buffer. We read types chars into this buffer until return is pressed
|
; Line buffer. We read types chars into this buffer until return is pressed
|
||||||
|
@ -40,7 +40,7 @@ jp aciaInt
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD AT28W_RAMEND
|
.equ SCRATCHPAD AT28W_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -25,7 +25,7 @@ jp aciaInt
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD STDIO_RAMEND
|
.equ SCRATCHPAD STDIO_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -24,7 +24,7 @@ jp init
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD STDIO_RAMEND
|
.equ SCRATCHPAD STDIO_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -48,7 +48,7 @@ jp aciaInt
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD FS_RAMEND
|
.equ SCRATCHPAD FS_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -1,10 +1,10 @@
|
|||||||
; classic RC2014 setup (8K ROM + 32K RAM) and a stock Serial I/O module
|
; classic RC2014 setup (8K ROM + 32K RAM) and a stock Serial I/O module
|
||||||
; The RAM module is selected on A15, so it has the range 0x8000-0xffff
|
; The RAM module is selected on A15, so it has the range 0x8000-0xffff
|
||||||
.equ RAMSTART 0x8000
|
.equ RAMSTART 0x8000
|
||||||
; Kernel RAMEND last check: 0x98f3
|
; Kernel RAMEND last check: 0x9933
|
||||||
; We allocate at least 0x100 bytes for the stack, which is why we have this
|
; We allocate at least 0x100 bytes for the stack, which is why we have this
|
||||||
; threshold.
|
; threshold.
|
||||||
.equ RAMEND 0x9a00
|
.equ RAMEND 0x9b00
|
||||||
.equ USER_CODE RAMEND ; in sync with user.h
|
.equ USER_CODE RAMEND ; in sync with user.h
|
||||||
.equ ACIA_CTL 0x80 ; Control and status. RS off.
|
.equ ACIA_CTL 0x80 ; Control and status. RS off.
|
||||||
.equ ACIA_IO 0x81 ; Transmit. RS on.
|
.equ ACIA_IO 0x81 ; Transmit. RS on.
|
||||||
@ -67,7 +67,7 @@ jp aciaInt
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD FS_RAMEND
|
.equ SCRATCHPAD FS_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
.org 0x9a00
|
.org 0x9b00
|
||||||
|
|
||||||
; *** JUMP TABLE ***
|
; *** JUMP TABLE ***
|
||||||
.equ strncmp 0x03
|
.equ strncmp 0x03
|
||||||
|
@ -27,7 +27,7 @@
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD STDIO_RAMEND
|
.equ SCRATCHPAD STDIO_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -29,7 +29,7 @@
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD STDIO_RAMEND
|
.equ SCRATCHPAD STDIO_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -77,7 +77,7 @@
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD FS_RAMEND
|
.equ SCRATCHPAD FS_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -40,7 +40,7 @@
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD STDIO_RAMEND
|
.equ SCRATCHPAD STDIO_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -21,17 +21,18 @@ int main(int argc, char **argv)
|
|||||||
}
|
}
|
||||||
|
|
||||||
int fd = open(argv[1], O_RDWR|O_NOCTTY);
|
int fd = open(argv[1], O_RDWR|O_NOCTTY);
|
||||||
char s[3];
|
char s[0x30];
|
||||||
|
sendcmdp(fd, "i=0");
|
||||||
|
sprintf(s, "while i<0x%04x getb:puth a:i=i+1", bytecount);
|
||||||
|
sendcmd(fd, s);
|
||||||
|
|
||||||
for (int i=0; i<bytecount; i++) {
|
for (int i=0; i<bytecount; i++) {
|
||||||
sendcmd(fd, "getb");
|
|
||||||
read(fd, s, 2); // read prompt
|
|
||||||
sendcmd(fd, "puth a");
|
|
||||||
read(fd, s, 2); // read hex pair
|
read(fd, s, 2); // read hex pair
|
||||||
s[2] = 0; // null terminate
|
s[2] = 0; // null terminate
|
||||||
unsigned char c = strtol(s, NULL, 16);
|
unsigned char c = strtol(s, NULL, 16);
|
||||||
putchar(c);
|
putchar(c);
|
||||||
read(fd, s, 2); // read prompt
|
|
||||||
}
|
}
|
||||||
|
read(fd, s, 2); // read prompt
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -25,6 +25,16 @@ We don't try to emulate real hardware to ease the development of device drivers
|
|||||||
because so far, I don't see the advantage of emulation versus running code on
|
because so far, I don't see the advantage of emulation versus running code on
|
||||||
the real thing.
|
the real thing.
|
||||||
|
|
||||||
|
By default, the shell initialized itself with a CFS device containing the
|
||||||
|
contents of `cfsin/` at launch (it's packed on the fly). You can specify an
|
||||||
|
alternate CFS device file (it has to be packaed already) through the `-f` flag.
|
||||||
|
|
||||||
|
By default, the shell runs interactively, but you can also pipe contents through
|
||||||
|
stdin instead. The contents will be interpreted exactly as if you had typed it
|
||||||
|
yourself and the result will be spit in stdout (it includes your typed in
|
||||||
|
contents because the Collapse OS console echoes back every character that is
|
||||||
|
sent to it.). This feature is useful for automated tests in `tools/tests/shell`.
|
||||||
|
|
||||||
## zasm
|
## zasm
|
||||||
|
|
||||||
`zasm/zasm` is `apps/zasm` wrapped in an emulator. It is quite central to the
|
`zasm/zasm` is `apps/zasm` wrapped in an emulator. It is quite central to the
|
||||||
|
@ -70,7 +70,7 @@
|
|||||||
; *** BASIC ***
|
; *** BASIC ***
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
.equ SCRATCHPAD_SIZE STDIO_BUFSIZE
|
||||||
.equ SCRATCHPAD FS_RAMEND
|
.equ SCRATCHPAD FS_RAMEND
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
#include <stdint.h>
|
#include <stdint.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
#include <unistd.h>
|
||||||
#include <termios.h>
|
#include <termios.h>
|
||||||
#include "../emul.h"
|
#include "../emul.h"
|
||||||
#include "shell-bin.h"
|
#include "shell-bin.h"
|
||||||
@ -40,7 +41,6 @@
|
|||||||
#define FS_ADDR_PORT 0x02
|
#define FS_ADDR_PORT 0x02
|
||||||
|
|
||||||
static uint8_t fsdev[MAX_FSDEV_SIZE] = {0};
|
static uint8_t fsdev[MAX_FSDEV_SIZE] = {0};
|
||||||
static uint32_t fsdev_size = 0;
|
|
||||||
static uint32_t fsdev_ptr = 0;
|
static uint32_t fsdev_ptr = 0;
|
||||||
// 0 = idle, 1 = received MSB (of 24bit addr), 2 = received middle addr
|
// 0 = idle, 1 = received MSB (of 24bit addr), 2 = received middle addr
|
||||||
static int fsdev_addr_lvl = 0;
|
static int fsdev_addr_lvl = 0;
|
||||||
@ -61,16 +61,13 @@ static uint8_t iord_fsdata()
|
|||||||
fprintf(stderr, "Reading FSDEV in the middle of an addr op (%d)\n", fsdev_ptr);
|
fprintf(stderr, "Reading FSDEV in the middle of an addr op (%d)\n", fsdev_ptr);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
if (fsdev_ptr < fsdev_size) {
|
if (fsdev_ptr < MAX_FSDEV_SIZE) {
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
fprintf(stderr, "Reading FSDEV at offset %d\n", fsdev_ptr);
|
fprintf(stderr, "Reading FSDEV at offset %d\n", fsdev_ptr);
|
||||||
#endif
|
#endif
|
||||||
return fsdev[fsdev_ptr];
|
return fsdev[fsdev_ptr];
|
||||||
} else {
|
} else {
|
||||||
// don't warn when ==, we're not out of bounds, just at the edge.
|
fprintf(stderr, "Out of bounds FSDEV read at %d\n", fsdev_ptr);
|
||||||
if (fsdev_ptr > fsdev_size) {
|
|
||||||
fprintf(stderr, "Out of bounds FSDEV read at %d\n", fsdev_ptr);
|
|
||||||
}
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -79,11 +76,9 @@ static uint8_t iord_fsaddr()
|
|||||||
{
|
{
|
||||||
if (fsdev_addr_lvl != 0) {
|
if (fsdev_addr_lvl != 0) {
|
||||||
return 3;
|
return 3;
|
||||||
} else if (fsdev_ptr > fsdev_size) {
|
} else if (fsdev_ptr >= MAX_FSDEV_SIZE) {
|
||||||
fprintf(stderr, "Out of bounds FSDEV addr request at %d / %d\n", fsdev_ptr, fsdev_size);
|
fprintf(stderr, "Out of bounds FSDEV addr request at %d / %d\n", fsdev_ptr, MAX_FSDEV_SIZE);
|
||||||
return 2;
|
return 2;
|
||||||
} else if (fsdev_ptr == fsdev_size) {
|
|
||||||
return 1;
|
|
||||||
} else {
|
} else {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@ -104,18 +99,11 @@ static void iowr_fsdata(uint8_t val)
|
|||||||
fprintf(stderr, "Writing to FSDEV in the middle of an addr op (%d)\n", fsdev_ptr);
|
fprintf(stderr, "Writing to FSDEV in the middle of an addr op (%d)\n", fsdev_ptr);
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
if (fsdev_ptr < fsdev_size) {
|
if (fsdev_ptr < MAX_FSDEV_SIZE) {
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
fprintf(stderr, "Writing to FSDEV (%d)\n", fsdev_ptr);
|
fprintf(stderr, "Writing to FSDEV (%d)\n", fsdev_ptr);
|
||||||
#endif
|
#endif
|
||||||
fsdev[fsdev_ptr] = val;
|
fsdev[fsdev_ptr] = val;
|
||||||
} else if ((fsdev_ptr == fsdev_size) && (fsdev_ptr < MAX_FSDEV_SIZE)) {
|
|
||||||
// We're at the end of fsdev, grow it
|
|
||||||
fsdev[fsdev_ptr] = val;
|
|
||||||
fsdev_size++;
|
|
||||||
#ifdef DEBUG
|
|
||||||
fprintf(stderr, "Growing FSDEV (%d)\n", fsdev_ptr);
|
|
||||||
#endif
|
|
||||||
} else {
|
} else {
|
||||||
fprintf(stderr, "Out of bounds FSDEV write at %d\n", fsdev_ptr);
|
fprintf(stderr, "Out of bounds FSDEV write at %d\n", fsdev_ptr);
|
||||||
}
|
}
|
||||||
@ -135,34 +123,60 @@ static void iowr_fsaddr(uint8_t val)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int main()
|
int main(int argc, char *argv[])
|
||||||
{
|
{
|
||||||
// Setup fs blockdev
|
FILE *fp = NULL;
|
||||||
FILE *fp = popen("../cfspack/cfspack cfsin", "r");
|
while (1) {
|
||||||
if (fp != NULL) {
|
int c = getopt(argc, argv, "f:");
|
||||||
printf("Initializing filesystem\n");
|
if (c < 0) {
|
||||||
int i = 0;
|
break;
|
||||||
int c = fgetc(fp);
|
}
|
||||||
while (c != EOF) {
|
switch (c) {
|
||||||
fsdev[i] = c & 0xff;
|
case 'f':
|
||||||
i++;
|
fp = fopen(optarg, "r");
|
||||||
c = fgetc(fp);
|
if (fp == NULL) {
|
||||||
|
fprintf(stderr, "Can't open %s\n", optarg);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
fprintf(stderr, "Usage: shell [-f fsdev]\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
// Setup fs blockdev
|
||||||
|
if (fp == NULL) {
|
||||||
|
fp = popen("../cfspack/cfspack cfsin", "r");
|
||||||
|
if (fp == NULL) {
|
||||||
|
fprintf(stderr, "Can't initialize filesystem. Leaving blank.\n");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (fp != NULL) {
|
||||||
|
fprintf(stderr, "Initializing filesystem\n");
|
||||||
|
int i = 0;
|
||||||
|
int c;
|
||||||
|
while ((c = fgetc(fp)) != EOF && i < MAX_FSDEV_SIZE) {
|
||||||
|
fsdev[i++] = c & 0xff;
|
||||||
|
}
|
||||||
|
if (i == MAX_FSDEV_SIZE) {
|
||||||
|
fprintf(stderr, "Filesytem image too large.\n");
|
||||||
|
return 1;
|
||||||
}
|
}
|
||||||
fsdev_size = i;
|
|
||||||
pclose(fp);
|
pclose(fp);
|
||||||
} else {
|
|
||||||
printf("Can't initialize filesystem. Leaving blank.\n");
|
|
||||||
}
|
}
|
||||||
|
|
||||||
// Turn echo off: the shell takes care of its own echoing.
|
bool tty = isatty(fileno(stdin));
|
||||||
struct termios termInfo;
|
struct termios termInfo;
|
||||||
if (tcgetattr(0, &termInfo) == -1) {
|
if (tty) {
|
||||||
printf("Can't setup terminal.\n");
|
// Turn echo off: the shell takes care of its own echoing.
|
||||||
return 1;
|
if (tcgetattr(0, &termInfo) == -1) {
|
||||||
|
printf("Can't setup terminal.\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
termInfo.c_lflag &= ~ECHO;
|
||||||
|
termInfo.c_lflag &= ~ICANON;
|
||||||
|
tcsetattr(0, TCSAFLUSH, &termInfo);
|
||||||
}
|
}
|
||||||
termInfo.c_lflag &= ~ECHO;
|
|
||||||
termInfo.c_lflag &= ~ICANON;
|
|
||||||
tcsetattr(0, TCSAFLUSH, &termInfo);
|
|
||||||
|
|
||||||
|
|
||||||
Machine *m = emul_init();
|
Machine *m = emul_init();
|
||||||
@ -182,10 +196,12 @@ int main()
|
|||||||
|
|
||||||
while (running && emul_step());
|
while (running && emul_step());
|
||||||
|
|
||||||
printf("Done!\n");
|
if (tty) {
|
||||||
termInfo.c_lflag |= ECHO;
|
printf("Done!\n");
|
||||||
termInfo.c_lflag |= ICANON;
|
termInfo.c_lflag |= ECHO;
|
||||||
tcsetattr(0, TCSAFLUSH, &termInfo);
|
termInfo.c_lflag |= ICANON;
|
||||||
emul_printdebug();
|
tcsetattr(0, TCSAFLUSH, &termInfo);
|
||||||
|
emul_printdebug();
|
||||||
|
}
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
@ -28,22 +28,18 @@ int main(int argc, char **argv)
|
|||||||
}
|
}
|
||||||
|
|
||||||
int fd = open(argv[1], O_RDWR|O_NOCTTY);
|
int fd = open(argv[1], O_RDWR|O_NOCTTY);
|
||||||
char s[0x20];
|
char s[0x30];
|
||||||
sprintf(s, "m=0x%04x", memptr);
|
sprintf(s, "m=0x%04x", memptr);
|
||||||
|
sendcmdp(fd, s);
|
||||||
|
sprintf(s, "while m<0x%04x peek m:puth a:m=m+1", memptr+bytecount);
|
||||||
sendcmd(fd, s);
|
sendcmd(fd, s);
|
||||||
read(fd, s, 2); // read prompt
|
|
||||||
|
|
||||||
for (int i=0; i<bytecount; i++) {
|
for (int i=0; i<bytecount; i++) {
|
||||||
sendcmd(fd, "peek m");
|
|
||||||
read(fd, s, 2); // read prompt
|
|
||||||
sendcmd(fd, "puth a");
|
|
||||||
read(fd, s, 2); // read hex pair
|
read(fd, s, 2); // read hex pair
|
||||||
s[2] = 0; // null terminate
|
s[2] = 0; // null terminate
|
||||||
unsigned char c = strtol(s, NULL, 16);
|
unsigned char c = strtol(s, NULL, 16);
|
||||||
putchar(c);
|
putchar(c);
|
||||||
read(fd, s, 2); // read prompt
|
|
||||||
sendcmd(fd, "m=m+1");
|
|
||||||
read(fd, s, 2); // read prompt
|
|
||||||
}
|
}
|
||||||
|
read(fd, s, 2); // read prompt
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
@ -1,7 +1,16 @@
|
|||||||
EMULDIR = ../emul
|
EMULDIR = ../emul
|
||||||
|
CFSPACK = ../cfspack/cfspack
|
||||||
|
|
||||||
.PHONY: run
|
.PHONY: run
|
||||||
run:
|
run:
|
||||||
$(MAKE) -C $(EMULDIR) zasm/zasm runbin/runbin
|
$(MAKE) -C $(EMULDIR) zasm/zasm runbin/runbin shell/shell
|
||||||
cd unit && ./runtests.sh
|
cd unit && ./runtests.sh
|
||||||
cd zasm && ./runtests.sh
|
cd zasm && ./runtests.sh
|
||||||
|
cd shell && ./runtests.sh
|
||||||
|
|
||||||
|
$(CFSPACK):
|
||||||
|
$(MAKE) -C ../cfspack
|
||||||
|
|
||||||
|
.PHONY: cfs
|
||||||
|
cfs: $(CFSPACK)
|
||||||
|
$(CFSPACK) shell/cfsin > shell/test.cfs
|
||||||
|
@ -40,3 +40,10 @@ However, there are tricks.
|
|||||||
1. Run `unit/runtests.sh <name of file to test>` to target a specific test unit.
|
1. Run `unit/runtests.sh <name of file to test>` to target a specific test unit.
|
||||||
2. Insert a `halt` to see the value of `A` at any given moment: it will be your
|
2. Insert a `halt` to see the value of `A` at any given moment: it will be your
|
||||||
reported error code (if 0, runbin will report a success).
|
reported error code (if 0, runbin will report a success).
|
||||||
|
|
||||||
|
## shell
|
||||||
|
|
||||||
|
Those tests are in the form of shell "replay" files. Every ".replay" file in
|
||||||
|
this folder contains the contents to type in the shell. That contents is piped
|
||||||
|
through the shell and the output is then compared with the corresponding
|
||||||
|
".expected" file. If they match exactly, the test passes.
|
||||||
|
1
tools/tests/shell/cfsin/bar
Normal file
1
tools/tests/shell/cfsin/bar
Normal file
@ -0,0 +1 @@
|
|||||||
|
Hello Bar!
|
1
tools/tests/shell/cfsin/foo
Normal file
1
tools/tests/shell/cfsin/foo
Normal file
@ -0,0 +1 @@
|
|||||||
|
Hello Foo!
|
5
tools/tests/shell/fls.expected
Normal file
5
tools/tests/shell/fls.expected
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
Collapse OS
|
||||||
|
> fls
|
||||||
|
bar
|
||||||
|
foo
|
||||||
|
>
|
1
tools/tests/shell/fls.replay
Normal file
1
tools/tests/shell/fls.replay
Normal file
@ -0,0 +1 @@
|
|||||||
|
fls
|
4
tools/tests/shell/print.expected
Normal file
4
tools/tests/shell/print.expected
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
Collapse OS
|
||||||
|
> print 42
|
||||||
|
42
|
||||||
|
>
|
1
tools/tests/shell/print.replay
Normal file
1
tools/tests/shell/print.replay
Normal file
@ -0,0 +1 @@
|
|||||||
|
print 42
|
28
tools/tests/shell/runtests.sh
Executable file
28
tools/tests/shell/runtests.sh
Executable file
@ -0,0 +1,28 @@
|
|||||||
|
#!/bin/sh -e
|
||||||
|
|
||||||
|
EMULDIR=../../emul
|
||||||
|
SHELL=../../emul/shell/shell
|
||||||
|
|
||||||
|
replay() {
|
||||||
|
fn=$1
|
||||||
|
replayfn=${fn%.*}.expected
|
||||||
|
ACTUAL=$("${SHELL}" -f test.cfs < "${fn}" 2> /dev/null)
|
||||||
|
EXPECTED=$(cat ${replayfn})
|
||||||
|
if [ "$ACTUAL" = "$EXPECTED" ]; then
|
||||||
|
echo ok
|
||||||
|
else
|
||||||
|
echo different. Whole output:
|
||||||
|
echo "${ACTUAL}"
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
}
|
||||||
|
|
||||||
|
if [ ! -z $1 ]; then
|
||||||
|
replay $1
|
||||||
|
exit 0
|
||||||
|
fi
|
||||||
|
|
||||||
|
for fn in *.replay; do
|
||||||
|
echo "Replaying ${fn}"
|
||||||
|
replay "${fn}"
|
||||||
|
done
|
BIN
tools/tests/shell/test.cfs
Normal file
BIN
tools/tests/shell/test.cfs
Normal file
Binary file not shown.
@ -5,8 +5,6 @@
|
|||||||
|
|
||||||
jp test
|
jp test
|
||||||
|
|
||||||
.inc "core.asm"
|
|
||||||
|
|
||||||
dummyLabel:
|
dummyLabel:
|
||||||
testNum: .db 1
|
testNum: .db 1
|
||||||
|
|
||||||
@ -48,30 +46,11 @@ test:
|
|||||||
; test that "@" is updated by a .org directive
|
; test that "@" is updated by a .org directive
|
||||||
ld hl, AFTER_ORG
|
ld hl, AFTER_ORG
|
||||||
ld de, 0x1234
|
ld de, 0x1234
|
||||||
call cpHLDE
|
or a ; clear carry
|
||||||
|
sbc hl, de
|
||||||
jp nz, fail
|
jp nz, fail
|
||||||
call nexttest
|
call nexttest
|
||||||
|
|
||||||
; *** cpHLDE ***
|
|
||||||
ld hl, 0x42
|
|
||||||
ld de, 0x42
|
|
||||||
call cpHLDE
|
|
||||||
jp nz, fail
|
|
||||||
jp c, fail
|
|
||||||
call nexttest
|
|
||||||
|
|
||||||
ld de, 0x4242
|
|
||||||
call cpHLDE
|
|
||||||
jp z, fail
|
|
||||||
jp nc, fail
|
|
||||||
call nexttest
|
|
||||||
|
|
||||||
ld hl, 0x4243
|
|
||||||
call cpHLDE
|
|
||||||
jp z, fail
|
|
||||||
jp c, fail
|
|
||||||
call nexttest
|
|
||||||
|
|
||||||
; success
|
; success
|
||||||
xor a
|
xor a
|
||||||
halt
|
halt
|
||||||
|
42
tools/tests/unit/test_ed_util.asm
Normal file
42
tools/tests/unit/test_ed_util.asm
Normal file
@ -0,0 +1,42 @@
|
|||||||
|
jp test
|
||||||
|
|
||||||
|
.inc "ed/util.asm"
|
||||||
|
|
||||||
|
test:
|
||||||
|
ld sp, 0xffff
|
||||||
|
|
||||||
|
; *** cpHLDE ***
|
||||||
|
ld hl, 0x42
|
||||||
|
ld de, 0x42
|
||||||
|
call cpHLDE
|
||||||
|
jp nz, fail
|
||||||
|
jp c, fail
|
||||||
|
call nexttest
|
||||||
|
|
||||||
|
ld de, 0x4242
|
||||||
|
call cpHLDE
|
||||||
|
jp z, fail
|
||||||
|
jp nc, fail
|
||||||
|
call nexttest
|
||||||
|
|
||||||
|
ld hl, 0x4243
|
||||||
|
call cpHLDE
|
||||||
|
jp z, fail
|
||||||
|
jp c, fail
|
||||||
|
call nexttest
|
||||||
|
|
||||||
|
; success
|
||||||
|
xor a
|
||||||
|
halt
|
||||||
|
|
||||||
|
testNum: .db 1
|
||||||
|
|
||||||
|
nexttest:
|
||||||
|
ld a, (testNum)
|
||||||
|
inc a
|
||||||
|
ld (testNum), a
|
||||||
|
ret
|
||||||
|
|
||||||
|
fail:
|
||||||
|
ld a, (testNum)
|
||||||
|
halt
|
@ -5,10 +5,8 @@
|
|||||||
|
|
||||||
#include "common.h"
|
#include "common.h"
|
||||||
|
|
||||||
/* Push specified file to specified device **running the BASIC shell** and verify
|
/* Push specified file to specified device running the BASIC shell and verify
|
||||||
* that the sent contents is correct.
|
* that the sent contents is correct.
|
||||||
*
|
|
||||||
* Note: running this will clear the current BASIC listing on the other side.
|
|
||||||
*/
|
*/
|
||||||
|
|
||||||
int main(int argc, char **argv)
|
int main(int argc, char **argv)
|
||||||
@ -38,20 +36,12 @@ int main(int argc, char **argv)
|
|||||||
}
|
}
|
||||||
rewind(fp);
|
rewind(fp);
|
||||||
int fd = open(argv[1], O_RDWR|O_NOCTTY);
|
int fd = open(argv[1], O_RDWR|O_NOCTTY);
|
||||||
char s[0x20];
|
char s[0x40];
|
||||||
sprintf(s, "m=0x%04x", memptr);
|
sprintf(s, "m=0x%04x", memptr);
|
||||||
sendcmdp(fd, s);
|
sendcmdp(fd, s);
|
||||||
|
sprintf(s, "while m<0x%04x getc:puth a:poke m a:m=m+1", memptr+bytecount);
|
||||||
|
sendcmd(fd, s);
|
||||||
|
|
||||||
// Send program
|
|
||||||
sendcmdp(fd, "clear");
|
|
||||||
sendcmdp(fd, "1 getc");
|
|
||||||
sendcmdp(fd, "2 puth a");
|
|
||||||
sendcmdp(fd, "3 poke m a");
|
|
||||||
sendcmdp(fd, "4 m=m+1");
|
|
||||||
sprintf(s, "5 if m<0x%04x goto 1", memptr+bytecount);
|
|
||||||
sendcmdp(fd, s);
|
|
||||||
|
|
||||||
sendcmd(fd, "run");
|
|
||||||
int returncode = 0;
|
int returncode = 0;
|
||||||
while (fread(s, 1, 1, fp)) {
|
while (fread(s, 1, 1, fp)) {
|
||||||
putchar('.');
|
putchar('.');
|
||||||
|
Loading…
Reference in New Issue
Block a user