mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-03 00:30:55 +11:00
Compare commits
No commits in common. "8f1d942e5f8bd38eff3e0e4e7b0fd7ece3fdf7b8" and "aad8efeff7262177172f03b1deadfc01c8667a9d" have entirely different histories.
8f1d942e5f
...
aad8efeff7
@ -25,22 +25,6 @@ Because the goal is not to provide a foundation for complex programs, I'm
|
|||||||
planning on intentionally crippling this BASIC dialect for the sake of
|
planning on intentionally crippling this BASIC dialect for the sake of
|
||||||
simplicity.
|
simplicity.
|
||||||
|
|
||||||
The idea here is that the system administrator would build herself many little
|
|
||||||
tools in assembler and BASIC would be the interactive glue to those tools.
|
|
||||||
|
|
||||||
If you find yourself writing complex programs in Collapse OS BASIC, you're on a
|
|
||||||
wrong path. Back off, that program should be in assembler.
|
|
||||||
|
|
||||||
## Glueing
|
|
||||||
|
|
||||||
The `glue.asm` file in this folder represents the minimal basic system. There
|
|
||||||
are additional modules that can be added that aren't added by default, such
|
|
||||||
as `fs.asm` because they require kernel options that might not be available.
|
|
||||||
|
|
||||||
To include these modules, you'll need to write your own glue file and to hook
|
|
||||||
extra commands through `BAS_FINDHOOK`. Look for examples in `tools/emul` and
|
|
||||||
in recipes.
|
|
||||||
|
|
||||||
## Usage
|
## Usage
|
||||||
|
|
||||||
Upon launch, a prompt is presented, waiting for a command. There are two types
|
Upon launch, a prompt is presented, waiting for a command. There are two types
|
||||||
@ -83,32 +67,20 @@ integer to them. You assign a value to a variable with `=`. For example,
|
|||||||
be used in expressions. For example, `print a-6` will print `40`. All variables
|
be used in expressions. For example, `print a-6` will print `40`. All variables
|
||||||
are initialized to zero on launch.
|
are initialized to zero on launch.
|
||||||
|
|
||||||
### Arguments
|
|
||||||
|
|
||||||
Some commands take arguments and there are some common patterns regarding them.
|
|
||||||
|
|
||||||
One of them is that all commands that "return" something (`input`, `peek`,
|
|
||||||
etc.) always to so in variable `A`.
|
|
||||||
|
|
||||||
Another is that whenever a number is expected, expressions, including the ones
|
|
||||||
with variables in it, work fine.
|
|
||||||
|
|
||||||
### 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
|
**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.
|
||||||
|
|
||||||
**run**: Direct-only. Runs code from the listing, starting with the first one.
|
**run**. Direct-only. Runs code from the listing, starting with the first one.
|
||||||
If `goto` was previously called in direct mode, we start from that line instead.
|
If `goto` was previously called in direct mode, we start from that line instead.
|
||||||
|
|
||||||
**clear**: Direct-only. Clears the current code listing.
|
**print**. Prints the result of the specified expression, then CR/LF. Can be
|
||||||
|
|
||||||
**print**: Prints the result of the specified expression, then CR/LF. Can be
|
|
||||||
given multiple arguments. In that case, all arguments are printed separately
|
given multiple arguments. In that case, all arguments are printed separately
|
||||||
with a space in between. For example, `print 12 13` prints `12 13<cr><lf>`
|
with a space in between. For example, `print 12 13` prints `12 13<cr><lf>`
|
||||||
|
|
||||||
@ -116,61 +88,38 @@ Unlike anywhere else, the `print` command can take a string inside a double
|
|||||||
quote. That string will be printed as-is. For example, `print "foo" 40+2` will
|
quote. That string will be printed as-is. For example, `print "foo" 40+2` will
|
||||||
print `foo 42`.
|
print `foo 42`.
|
||||||
|
|
||||||
**goto**: Make the next line to be executed the line number specified as an
|
**goto**. Make the next line to be executed the line number specified as an
|
||||||
argument. Errors out if line doesn't exist. Argument can be an expression. If
|
argument. Errors out if line doesn't exist. Argument can be an expression. If
|
||||||
invoked in direct mode, `run` must be called to actually run the line (followed
|
invoked in direct mode, `run` must be called to actually run the line (followed
|
||||||
by the next, and so on).
|
by the next, and so on).
|
||||||
|
|
||||||
**if**: If specified condition is true, execute the rest of the line. Otherwise,
|
**if**. 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 2<1 print 12`
|
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 expression".
|
does nothing. The argument for this command is a "thruth expression".
|
||||||
|
|
||||||
**input**: Prompts the user for a numerical value and puts that value in `A`.
|
**input**. Prompts the user for a numerical value and puts that value in the
|
||||||
The prompted value is evaluated as an expression and then stored. The command
|
specified variable. The prompted value is evaluated as an expression and then
|
||||||
takes an optional string literal parameter. If present, that string will be
|
stored where specified. For example, `input x` stores the result of the
|
||||||
printed before asking for input. Unlike a `print` call, there is no CR/LF after
|
evaluation in variable `x`. Before the variable name, a quoted string literal
|
||||||
that print.
|
can be specified. In that case, that string will be printed as-is just before
|
||||||
|
the prompt.
|
||||||
|
|
||||||
**peek/deek**: Put the value at specified memory address into `A`. peek is for
|
**peek/deek**: Put the value at specified memory address into specified
|
||||||
a single byte, deek is for a word (little endian). For example, `peek 42` puts
|
variable. peek is for a single byte, deek is for a word (little endian). For
|
||||||
the byte value contained in memory address 0x002a into variable `A`. `deek 42`
|
example, `peek 42 a` puts the byte value contained in memory address 0x002a
|
||||||
does the same as peek, but also puts the value of 0x002b into `A`'s MSB.
|
into variable `a`. `deek 42 a` does the same as peek, but also puts the value
|
||||||
|
of 0x002b into `a`'s MSB.
|
||||||
|
|
||||||
**poke/doke**: Put the value of specified expression into specified memory
|
**poke/doke**: Put the value of specified expression into specified memory
|
||||||
address. For example, `poke 42 0x102+0x40` puts `0x42` in memory address
|
address. For example, `poke 42 0x102+0x40` puts `0x42` in memory address
|
||||||
0x2a (MSB is ignored) and `doke 42 0x102+0x40` does the same as poke, but also
|
0x2a (MSB is ignored) and `doke 42 0x102+0x40` does the same as poke, but also
|
||||||
puts `0x01` in memory address 0x2b.
|
puts `0x01` in memory address 0x2b.
|
||||||
|
|
||||||
**in**: Same thing as `peek`, but for a I/O port. `in 42` generates an input
|
**in**: Same thing as `peek`, but for a I/O port. `in 42 a` generates an input
|
||||||
I/O on port 42 and stores the byte result in `A`.
|
I/O on port 42 and stores the byte result in `a`.
|
||||||
|
|
||||||
**out**: Same thing as `poke`, but for a I/O port. `out 42 1+2` generates an
|
**out**: Same thing as `poke`, but for a I/O port. `out 42 1+2` generates an
|
||||||
output I/O on port 42 with value 3.
|
output I/O on port 42 with value 3.
|
||||||
|
|
||||||
**sleep**: Sleep a number of "units" specified by the supplied expression. A
|
**sleep**: Sleep a number of "units" specified by the supplied expression. A
|
||||||
"unit" depends on the CPU clock speed. At 4MHz, it is roughly 8 microseconds.
|
"unit" depends on the CPU clock speed. At 4MHz, it is roughly 8 microseconds.
|
||||||
|
|
||||||
**addr**: This very handy returns (in `A`), the address you query for. You can
|
|
||||||
query for two types of things: commands or special stuff.
|
|
||||||
|
|
||||||
If you query for a command, type the name of the command as an argument. The
|
|
||||||
address of the associated routine will be returned.
|
|
||||||
|
|
||||||
Then, there's the *special stuff*. This is the list of things you can query for:
|
|
||||||
|
|
||||||
* `$`: the scratchpad.
|
|
||||||
|
|
||||||
## Optional modules
|
|
||||||
|
|
||||||
As explained in "glueing" section abolve, this folder contains optional modules.
|
|
||||||
Here's the documentation for them.
|
|
||||||
|
|
||||||
### fs
|
|
||||||
|
|
||||||
`fs.asm` provides those commands:
|
|
||||||
|
|
||||||
**fls**: prints the list of files contained in the active filesystem.
|
|
||||||
|
|
||||||
**ldbas**: loads the content of the file specified in the argument (as an
|
|
||||||
unquoted filename) and replace the current code listing with this contents. Any
|
|
||||||
line not starting with a number is ignored (not an error).
|
|
||||||
|
@ -22,7 +22,6 @@ bufInit:
|
|||||||
ld (BUF_LFREE), hl
|
ld (BUF_LFREE), hl
|
||||||
ld hl, BUF_POOL
|
ld hl, BUF_POOL
|
||||||
ld (BUF_PFREE), hl
|
ld (BUF_PFREE), hl
|
||||||
cp a ; ensure Z
|
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Add line at (HL) with line number DE to the buffer. The string at (HL) should
|
; Add line at (HL) with line number DE to the buffer. The string at (HL) should
|
||||||
|
@ -1,69 +0,0 @@
|
|||||||
; FS-related basic commands
|
|
||||||
; *** Variables ***
|
|
||||||
; Handle of the target file
|
|
||||||
.equ BFS_FILE_HDL BFS_RAMSTART
|
|
||||||
.equ BFS_RAMEND @+FS_HANDLE_SIZE
|
|
||||||
|
|
||||||
basFLS:
|
|
||||||
ld iy, .iter
|
|
||||||
jp fsIter
|
|
||||||
.iter:
|
|
||||||
ld a, FS_META_FNAME_OFFSET
|
|
||||||
call addHL
|
|
||||||
call printstr
|
|
||||||
jp printcrlf
|
|
||||||
|
|
||||||
|
|
||||||
basLDBAS:
|
|
||||||
call fsFindFN
|
|
||||||
ret nz
|
|
||||||
call bufInit
|
|
||||||
ld ix, BFS_FILE_HDL
|
|
||||||
call fsOpen
|
|
||||||
ld hl, 0
|
|
||||||
ld de, SCRATCHPAD
|
|
||||||
.loop:
|
|
||||||
ld ix, BFS_FILE_HDL
|
|
||||||
call fsGetB
|
|
||||||
jr nz, .loopend
|
|
||||||
inc hl
|
|
||||||
or a ; null? hum, weird. same as LF
|
|
||||||
jr z, .lineend
|
|
||||||
cp LF
|
|
||||||
jr z, .lineend
|
|
||||||
ld (de), a
|
|
||||||
inc de
|
|
||||||
jr .loop
|
|
||||||
.lineend:
|
|
||||||
; We've just finished reading a line, writing each char in the pad.
|
|
||||||
; Null terminate it.
|
|
||||||
xor a
|
|
||||||
ld (de), a
|
|
||||||
; Ok, line ready
|
|
||||||
push hl ; --> lvl 1. current file position
|
|
||||||
ld hl, SCRATCHPAD
|
|
||||||
call parseDecimal
|
|
||||||
jr nz, .notANumber
|
|
||||||
push ix \ pop de
|
|
||||||
call toSep
|
|
||||||
call rdSep
|
|
||||||
call bufAdd
|
|
||||||
pop hl ; <-- lvl 1
|
|
||||||
ret nz
|
|
||||||
ld de, SCRATCHPAD
|
|
||||||
jr .loop
|
|
||||||
.notANumber:
|
|
||||||
pop hl ; <-- lvl 1
|
|
||||||
ld de, SCRATCHPAD
|
|
||||||
jr .loop
|
|
||||||
.loopend:
|
|
||||||
cp a
|
|
||||||
ret
|
|
||||||
|
|
||||||
|
|
||||||
basFSCmds:
|
|
||||||
.dw basFLS
|
|
||||||
.db "fls", 0, 0, 0
|
|
||||||
.dw basLDBAS
|
|
||||||
.db "ldbas", 0
|
|
||||||
.db 0xff, 0xff, 0xff ; end of table
|
|
@ -7,7 +7,6 @@
|
|||||||
.inc "user.h"
|
.inc "user.h"
|
||||||
.inc "err.h"
|
.inc "err.h"
|
||||||
|
|
||||||
call basInit
|
|
||||||
jp basStart
|
jp basStart
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
; RAM space used in different routines for short term processing.
|
||||||
|
@ -7,24 +7,16 @@
|
|||||||
; Important note: this is **not** a line number, it's a pointer to a line index
|
; Important note: this is **not** a line number, it's a pointer to a line index
|
||||||
; in buffer. If it's not zero, its a valid pointer.
|
; in buffer. If it's not zero, its a valid pointer.
|
||||||
.equ BAS_PNEXTLN @+2
|
.equ BAS_PNEXTLN @+2
|
||||||
; Points to a routine to call when a command isn't found in the "core" cmd
|
|
||||||
; table. This gives the opportunity to glue code to configure extra commands.
|
|
||||||
.equ BAS_FINDHOOK @+2
|
|
||||||
.equ BAS_RAMEND @+2
|
.equ BAS_RAMEND @+2
|
||||||
|
|
||||||
; *** Code ***
|
; *** Code ***
|
||||||
basInit:
|
basStart:
|
||||||
ld (BAS_INITSP), sp
|
ld (BAS_INITSP), sp
|
||||||
call varInit
|
call varInit
|
||||||
call bufInit
|
call bufInit
|
||||||
xor a
|
xor a
|
||||||
ld (BAS_PNEXTLN), a
|
ld (BAS_PNEXTLN), a
|
||||||
ld (BAS_PNEXTLN+1), a
|
ld (BAS_PNEXTLN+1), a
|
||||||
ld hl, unsetZ
|
|
||||||
ld (BAS_FINDHOOK), hl
|
|
||||||
ret
|
|
||||||
|
|
||||||
basStart:
|
|
||||||
ld hl, .welcome
|
ld hl, .welcome
|
||||||
call printstr
|
call printstr
|
||||||
call printcrlf
|
call printcrlf
|
||||||
@ -56,35 +48,10 @@ basLoop:
|
|||||||
.sPrompt:
|
.sPrompt:
|
||||||
.db "> ", 0
|
.db "> ", 0
|
||||||
|
|
||||||
; Tries to find command specified in (DE) (must be null-terminated) in cmd
|
|
||||||
; table in (HL). If found, sets IX to point to the associated routine. If
|
|
||||||
; not found, calls BAS_FINDHOOK so that we look through extra commands
|
|
||||||
; configured by glue code.
|
|
||||||
; Destroys HL.
|
|
||||||
; Z is set if found, unset otherwise.
|
|
||||||
basFindCmd:
|
|
||||||
; cmd table starts with routine pointer, skip
|
|
||||||
inc hl \ inc hl
|
|
||||||
.loop:
|
|
||||||
call strcmp
|
|
||||||
jr z, .found
|
|
||||||
ld a, 8
|
|
||||||
call addHL
|
|
||||||
ld a, (hl)
|
|
||||||
cp 0xff
|
|
||||||
jr nz, .loop
|
|
||||||
jp unsetZ
|
|
||||||
.found:
|
|
||||||
dec hl \ dec hl
|
|
||||||
call intoHL
|
|
||||||
push hl \ pop ix
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Call command in (HL) after having looked for it in cmd table in (DE).
|
; Call command in (HL) after having looked for it in cmd table in (DE).
|
||||||
; If found, jump to it. If not found, try (BAS_FINDHOOK). If still not found,
|
; If found, jump to it. If not found, unset Z. We expect commands to set Z
|
||||||
; unset Z. We expect commands to set Z on success. Therefore, when calling
|
; on success. Therefore, when calling basCallCmd results in NZ, we're not sure
|
||||||
; basCallCmd results in NZ, we're not sure where the error come from, but
|
; where the error come from, but well...
|
||||||
; well...
|
|
||||||
basCallCmd:
|
basCallCmd:
|
||||||
; let's see if it's a variable assignment.
|
; let's see if it's a variable assignment.
|
||||||
call varTryAssign
|
call varTryAssign
|
||||||
@ -97,17 +64,24 @@ basCallCmd:
|
|||||||
; cmd table in the stack, which we want in HL and we have the rest of
|
; cmd table in the stack, which we want in HL and we have the rest of
|
||||||
; the cmdline in (HL), which we want in the stack!
|
; the cmdline in (HL), which we want in the stack!
|
||||||
ex (sp), hl
|
ex (sp), hl
|
||||||
call basFindCmd
|
inc hl \ inc hl
|
||||||
jr z, .skip
|
.loop:
|
||||||
; not found, try BAS_FINDHOOK
|
call strcmp
|
||||||
ld ix, (BAS_FINDHOOK)
|
jr z, .found
|
||||||
call callIX
|
ld a, 8
|
||||||
.skip:
|
call addHL
|
||||||
; regardless of the result, we need to balance the stack.
|
ld a, (hl)
|
||||||
|
cp 0xff
|
||||||
|
jr nz, .loop
|
||||||
|
; not found
|
||||||
|
pop hl ; <-- lvl 1
|
||||||
|
jp unsetZ
|
||||||
|
.found:
|
||||||
|
dec hl \ dec hl
|
||||||
|
call intoHL
|
||||||
|
push hl \ pop ix
|
||||||
; Bring back rest of the command string from the stack
|
; Bring back rest of the command string from the stack
|
||||||
pop hl ; <-- lvl 1
|
pop hl ; <-- lvl 1
|
||||||
ret nz
|
|
||||||
; cmd found, skip whitespace and then jump!
|
|
||||||
call rdSep
|
call rdSep
|
||||||
jp (ix)
|
jp (ix)
|
||||||
|
|
||||||
@ -139,7 +113,7 @@ basBYE:
|
|||||||
|
|
||||||
basLIST:
|
basLIST:
|
||||||
call bufFirst
|
call bufFirst
|
||||||
jr nz, .end
|
ret nz
|
||||||
.loop:
|
.loop:
|
||||||
ld e, (ix)
|
ld e, (ix)
|
||||||
ld d, (ix+1)
|
ld d, (ix+1)
|
||||||
@ -153,7 +127,6 @@ basLIST:
|
|||||||
call printcrlf
|
call printcrlf
|
||||||
call bufNext
|
call bufNext
|
||||||
jr z, .loop
|
jr z, .loop
|
||||||
.end:
|
|
||||||
cp a ; ensure Z
|
cp a ; ensure Z
|
||||||
ret
|
ret
|
||||||
|
|
||||||
@ -280,9 +253,15 @@ basINPUT:
|
|||||||
; If our first arg is a string literal, spit it
|
; If our first arg is a string literal, spit it
|
||||||
call spitQuoted
|
call spitQuoted
|
||||||
call rdSep
|
call rdSep
|
||||||
|
ld a, (hl)
|
||||||
|
call varChk
|
||||||
|
ret nz ; not in variable range
|
||||||
|
push af ; --> lvl 1. remember var index
|
||||||
call stdioReadLine
|
call stdioReadLine
|
||||||
call parseExpr
|
call parseExpr
|
||||||
ld (VAR_TBL), ix
|
push ix \ pop de
|
||||||
|
pop af ; <-- lvl 1. restore var index
|
||||||
|
call varAssign
|
||||||
call printcrlf
|
call printcrlf
|
||||||
cp a ; ensure Z
|
cp a ; ensure Z
|
||||||
ret
|
ret
|
||||||
@ -290,9 +269,9 @@ basINPUT:
|
|||||||
basPEEK:
|
basPEEK:
|
||||||
call basDEEK
|
call basDEEK
|
||||||
ret nz
|
ret nz
|
||||||
; set MSB to 0
|
ld d, 0
|
||||||
xor a ; sets Z
|
call varAssign
|
||||||
ld (VAR_TBL+1), a
|
cp a ; ensure Z
|
||||||
ret
|
ret
|
||||||
|
|
||||||
basPOKE:
|
basPOKE:
|
||||||
@ -315,7 +294,12 @@ basDEEK:
|
|||||||
; peek address in IX. Let's peek and put result in DE
|
; peek address in IX. Let's peek and put result in DE
|
||||||
ld e, (ix)
|
ld e, (ix)
|
||||||
ld d, (ix+1)
|
ld d, (ix+1)
|
||||||
ld (VAR_TBL), de
|
call rdSep
|
||||||
|
ld a, (hl)
|
||||||
|
call varChk
|
||||||
|
ret nz ; not in variable range
|
||||||
|
; All good assign
|
||||||
|
call varAssign
|
||||||
cp a ; ensure Z
|
cp a ; ensure Z
|
||||||
ret
|
ret
|
||||||
|
|
||||||
@ -345,8 +329,13 @@ basIN:
|
|||||||
push ix \ pop bc
|
push ix \ pop bc
|
||||||
ld d, 0
|
ld d, 0
|
||||||
in e, (c)
|
in e, (c)
|
||||||
ld (VAR_TBL), de
|
call rdSep
|
||||||
; Z set from rdExpr
|
ld a, (hl)
|
||||||
|
call varChk
|
||||||
|
ret nz ; not in variable range
|
||||||
|
; All good assign
|
||||||
|
call varAssign
|
||||||
|
cp a ; ensure Z
|
||||||
ret
|
ret
|
||||||
|
|
||||||
basSLEEP:
|
basSLEEP:
|
||||||
@ -360,45 +349,6 @@ basSLEEP:
|
|||||||
dec hl ; 6T
|
dec hl ; 6T
|
||||||
jr .loop ; 12T
|
jr .loop ; 12T
|
||||||
|
|
||||||
basADDR:
|
|
||||||
call rdWord
|
|
||||||
ex de, hl
|
|
||||||
ld de, .specialTbl
|
|
||||||
.loop:
|
|
||||||
ld a, (de)
|
|
||||||
or a
|
|
||||||
jr z, .notSpecial
|
|
||||||
cp (hl)
|
|
||||||
jr z, .found
|
|
||||||
inc de \ inc de \ inc de
|
|
||||||
jr .loop
|
|
||||||
.notSpecial:
|
|
||||||
; not found, find cmd. needle in (HL)
|
|
||||||
ex de, hl ; now in (DE)
|
|
||||||
ld hl, basCmds1
|
|
||||||
call basFindCmd
|
|
||||||
jr z, .foundCmd
|
|
||||||
; no core command? let's try the find hook.
|
|
||||||
ld ix, (BAS_FINDHOOK)
|
|
||||||
call callIX
|
|
||||||
ret nz
|
|
||||||
.foundCmd:
|
|
||||||
; We have routine addr in IX
|
|
||||||
ld (VAR_TBL), ix
|
|
||||||
cp a ; ensure Z
|
|
||||||
ret
|
|
||||||
.found:
|
|
||||||
; found special thing. Put in "A".
|
|
||||||
inc de
|
|
||||||
call intoDE
|
|
||||||
ld (VAR_TBL), de
|
|
||||||
ret ; Z set from .found jump.
|
|
||||||
|
|
||||||
.specialTbl:
|
|
||||||
.db '$'
|
|
||||||
.dw SCRATCHPAD
|
|
||||||
.db 0
|
|
||||||
|
|
||||||
; direct only
|
; direct only
|
||||||
basCmds1:
|
basCmds1:
|
||||||
.dw basBYE
|
.dw basBYE
|
||||||
@ -407,8 +357,6 @@ basCmds1:
|
|||||||
.db "list", 0, 0
|
.db "list", 0, 0
|
||||||
.dw basRUN
|
.dw basRUN
|
||||||
.db "run", 0, 0, 0
|
.db "run", 0, 0, 0
|
||||||
.dw bufInit
|
|
||||||
.db "clear", 0
|
|
||||||
; statements
|
; statements
|
||||||
basCmds2:
|
basCmds2:
|
||||||
.dw basPRINT
|
.dw basPRINT
|
||||||
@ -433,6 +381,4 @@ basCmds2:
|
|||||||
.db "in", 0, 0, 0, 0
|
.db "in", 0, 0, 0, 0
|
||||||
.dw basSLEEP
|
.dw basSLEEP
|
||||||
.db "sleep", 0
|
.db "sleep", 0
|
||||||
.dw basADDR
|
|
||||||
.db "addr", 0, 0
|
|
||||||
.db 0xff, 0xff, 0xff ; end of table
|
.db 0xff, 0xff, 0xff ; end of table
|
||||||
|
1
tools/emul/.gitignore
vendored
1
tools/emul/.gitignore
vendored
@ -1,5 +1,4 @@
|
|||||||
/shell/shell
|
/shell/shell
|
||||||
/bshell/shell
|
|
||||||
/zasm/zasm
|
/zasm/zasm
|
||||||
/runbin/runbin
|
/runbin/runbin
|
||||||
/*/*-bin.h
|
/*/*-bin.h
|
||||||
|
@ -1,10 +1,10 @@
|
|||||||
CFSPACK = ../cfspack/cfspack
|
CFSPACK = ../cfspack/cfspack
|
||||||
TARGETS = shell/shell bshell/shell zasm/zasm runbin/runbin
|
TARGETS = shell/shell zasm/zasm runbin/runbin
|
||||||
KERNEL = ../../kernel
|
KERNEL = ../../kernel
|
||||||
APPS = ../../apps
|
APPS = ../../apps
|
||||||
ZASMBIN = zasm/zasm
|
ZASMBIN = zasm/zasm
|
||||||
ZASMSH = ../zasm.sh
|
ZASMSH = ../zasm.sh
|
||||||
SHELLAPPS = $(addprefix cfsin/, zasm ed)
|
SHELLAPPS = $(addprefix cfsin/, zasm ed basic)
|
||||||
CFSIN_CONTENTS = $(SHELLAPPS) cfsin/user.h
|
CFSIN_CONTENTS = $(SHELLAPPS) cfsin/user.h
|
||||||
|
|
||||||
.PHONY: all
|
.PHONY: all
|
||||||
@ -17,12 +17,6 @@ shell/shell.bin: $(APPS)/shell/glue.asm $(ZASMBIN)
|
|||||||
shell/kernel-bin.h: shell/glue.asm shell/shell.bin $(ZASMBIN)
|
shell/kernel-bin.h: shell/glue.asm shell/shell.bin $(ZASMBIN)
|
||||||
$(ZASMSH) $(KERNEL) shell/shell.bin < $< | ./bin2c.sh KERNEL | tee $@ > /dev/null
|
$(ZASMSH) $(KERNEL) shell/shell.bin < $< | ./bin2c.sh KERNEL | tee $@ > /dev/null
|
||||||
|
|
||||||
bshell/shell.bin: bshell/glue.asm $(ZASMBIN)
|
|
||||||
$(ZASMSH) $(KERNEL) bshell/user.h $(APPS) < $< | tee $@ > /dev/null
|
|
||||||
|
|
||||||
bshell/shell-bin.h: bshell/shell.bin
|
|
||||||
./bin2c.sh KERNEL < $< | tee $@ > /dev/null
|
|
||||||
|
|
||||||
zasm/kernel-bin.h: zasm/kernel.bin
|
zasm/kernel-bin.h: zasm/kernel.bin
|
||||||
./bin2c.sh KERNEL < $< | tee $@ > /dev/null
|
./bin2c.sh KERNEL < $< | tee $@ > /dev/null
|
||||||
|
|
||||||
@ -30,7 +24,6 @@ zasm/zasm-bin.h: zasm/zasm.bin
|
|||||||
./bin2c.sh USERSPACE < $< | tee $@ > /dev/null
|
./bin2c.sh USERSPACE < $< | tee $@ > /dev/null
|
||||||
|
|
||||||
shell/shell: shell/shell.c libz80/libz80.o shell/kernel-bin.h
|
shell/shell: shell/shell.c libz80/libz80.o shell/kernel-bin.h
|
||||||
bshell/shell: bshell/shell.c libz80/libz80.o bshell/shell-bin.h
|
|
||||||
$(ZASMBIN): zasm/zasm.c libz80/libz80.o zasm/kernel-bin.h zasm/zasm-bin.h $(CFSPACK)
|
$(ZASMBIN): zasm/zasm.c libz80/libz80.o zasm/kernel-bin.h zasm/zasm-bin.h $(CFSPACK)
|
||||||
runbin/runbin: runbin/runbin.c libz80/libz80.o
|
runbin/runbin: runbin/runbin.c libz80/libz80.o
|
||||||
$(TARGETS):
|
$(TARGETS):
|
||||||
@ -57,4 +50,4 @@ updatebootstrap: $(ZASMBIN) $(INCCFS)
|
|||||||
|
|
||||||
.PHONY: clean
|
.PHONY: clean
|
||||||
clean:
|
clean:
|
||||||
rm -f $(TARGETS) $(SHELLAPPS) zasm/*-bin.h shell/*-bin.h
|
rm -f $(TARGETS) $(SHELLAPPS) {zasm,shell}/*-bin.h
|
||||||
|
@ -25,11 +25,6 @@ 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.
|
||||||
|
|
||||||
## bshell
|
|
||||||
|
|
||||||
The `basic` app is on its way to replace the shell. It is wrapped in the z80
|
|
||||||
emulator in the same way that the shell is and interacts with `cfsin` similarly.
|
|
||||||
|
|
||||||
## 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
|
||||||
|
@ -1,171 +0,0 @@
|
|||||||
.inc "blkdev.h"
|
|
||||||
.inc "fs.h"
|
|
||||||
.inc "err.h"
|
|
||||||
.inc "ascii.h"
|
|
||||||
.equ RAMSTART 0x4000
|
|
||||||
.equ STDIO_PORT 0x00
|
|
||||||
.equ FS_DATA_PORT 0x01
|
|
||||||
.equ FS_ADDR_PORT 0x02
|
|
||||||
|
|
||||||
jp init
|
|
||||||
|
|
||||||
; *** JUMP TABLE ***
|
|
||||||
jp strncmp
|
|
||||||
jp upcase
|
|
||||||
jp findchar
|
|
||||||
jp blkSelPtr
|
|
||||||
jp blkSel
|
|
||||||
jp blkSet
|
|
||||||
jp blkSeek
|
|
||||||
jp blkTell
|
|
||||||
jp blkGetB
|
|
||||||
jp blkPutB
|
|
||||||
jp fsFindFN
|
|
||||||
jp fsOpen
|
|
||||||
jp fsGetB
|
|
||||||
jp fsPutB
|
|
||||||
jp fsSetSize
|
|
||||||
jp fsOn
|
|
||||||
jp fsIter
|
|
||||||
jp fsAlloc
|
|
||||||
jp fsDel
|
|
||||||
jp fsHandle
|
|
||||||
jp printstr
|
|
||||||
jp printnstr
|
|
||||||
jp _blkGetB
|
|
||||||
jp _blkPutB
|
|
||||||
jp _blkSeek
|
|
||||||
jp _blkTell
|
|
||||||
jp printcrlf
|
|
||||||
jp stdioGetC
|
|
||||||
jp stdioPutC
|
|
||||||
jp stdioReadLine
|
|
||||||
|
|
||||||
.inc "core.asm"
|
|
||||||
.inc "str.asm"
|
|
||||||
|
|
||||||
.equ BLOCKDEV_RAMSTART RAMSTART
|
|
||||||
.equ BLOCKDEV_COUNT 4
|
|
||||||
.inc "blockdev.asm"
|
|
||||||
; List of devices
|
|
||||||
.dw fsdevGetB, fsdevPutB
|
|
||||||
.dw stdoutGetB, stdoutPutB
|
|
||||||
.dw stdinGetB, stdinPutB
|
|
||||||
.dw mmapGetB, mmapPutB
|
|
||||||
|
|
||||||
|
|
||||||
.equ MMAP_START 0xe000
|
|
||||||
.inc "mmap.asm"
|
|
||||||
|
|
||||||
.equ STDIO_RAMSTART BLOCKDEV_RAMEND
|
|
||||||
.equ STDIO_GETC emulGetC
|
|
||||||
.equ STDIO_PUTC emulPutC
|
|
||||||
.inc "stdio.asm"
|
|
||||||
|
|
||||||
.equ FS_RAMSTART STDIO_RAMEND
|
|
||||||
.equ FS_HANDLE_COUNT 2
|
|
||||||
.inc "fs.asm"
|
|
||||||
|
|
||||||
; *** BASIC ***
|
|
||||||
|
|
||||||
; RAM space used in different routines for short term processing.
|
|
||||||
.equ SCRATCHPAD_SIZE 0x20
|
|
||||||
.equ SCRATCHPAD FS_RAMEND
|
|
||||||
.inc "lib/util.asm"
|
|
||||||
.inc "lib/ari.asm"
|
|
||||||
.inc "lib/parse.asm"
|
|
||||||
.inc "lib/fmt.asm"
|
|
||||||
.equ EXPR_PARSE parseLiteralOrVar
|
|
||||||
.inc "lib/expr.asm"
|
|
||||||
.inc "basic/util.asm"
|
|
||||||
.inc "basic/parse.asm"
|
|
||||||
.inc "basic/tok.asm"
|
|
||||||
.equ VAR_RAMSTART SCRATCHPAD+SCRATCHPAD_SIZE
|
|
||||||
.inc "basic/var.asm"
|
|
||||||
.equ BUF_RAMSTART VAR_RAMEND
|
|
||||||
.inc "basic/buf.asm"
|
|
||||||
.equ BFS_RAMSTART BUF_RAMEND
|
|
||||||
.inc "basic/fs.asm"
|
|
||||||
.equ BAS_RAMSTART BFS_RAMEND
|
|
||||||
.inc "basic/main.asm"
|
|
||||||
|
|
||||||
init:
|
|
||||||
di
|
|
||||||
; setup stack
|
|
||||||
ld sp, 0xffff
|
|
||||||
call fsInit
|
|
||||||
ld a, 0 ; select fsdev
|
|
||||||
ld de, BLOCKDEV_SEL
|
|
||||||
call blkSel
|
|
||||||
call fsOn
|
|
||||||
call basInit
|
|
||||||
ld hl, basFindCmdExtra
|
|
||||||
ld (BAS_FINDHOOK), hl
|
|
||||||
jp basStart
|
|
||||||
|
|
||||||
basFindCmdExtra:
|
|
||||||
ld hl, basFSCmds
|
|
||||||
jp basFindCmd
|
|
||||||
|
|
||||||
emulGetC:
|
|
||||||
; Blocks until a char is returned
|
|
||||||
in a, (STDIO_PORT)
|
|
||||||
cp a ; ensure Z
|
|
||||||
ret
|
|
||||||
|
|
||||||
emulPutC:
|
|
||||||
out (STDIO_PORT), a
|
|
||||||
ret
|
|
||||||
|
|
||||||
fsdevGetB:
|
|
||||||
ld a, e
|
|
||||||
out (FS_ADDR_PORT), a
|
|
||||||
ld a, h
|
|
||||||
out (FS_ADDR_PORT), a
|
|
||||||
ld a, l
|
|
||||||
out (FS_ADDR_PORT), a
|
|
||||||
in a, (FS_ADDR_PORT)
|
|
||||||
or a
|
|
||||||
ret nz
|
|
||||||
in a, (FS_DATA_PORT)
|
|
||||||
cp a ; ensure Z
|
|
||||||
ret
|
|
||||||
|
|
||||||
fsdevPutB:
|
|
||||||
push af
|
|
||||||
ld a, e
|
|
||||||
out (FS_ADDR_PORT), a
|
|
||||||
ld a, h
|
|
||||||
out (FS_ADDR_PORT), a
|
|
||||||
ld a, l
|
|
||||||
out (FS_ADDR_PORT), a
|
|
||||||
in a, (FS_ADDR_PORT)
|
|
||||||
cp 2 ; only A > 1 means error
|
|
||||||
jr nc, .error ; A >= 2
|
|
||||||
pop af
|
|
||||||
out (FS_DATA_PORT), a
|
|
||||||
cp a ; ensure Z
|
|
||||||
ret
|
|
||||||
.error:
|
|
||||||
pop af
|
|
||||||
jp unsetZ ; returns
|
|
||||||
|
|
||||||
.equ STDOUT_HANDLE FS_HANDLES
|
|
||||||
|
|
||||||
stdoutGetB:
|
|
||||||
ld ix, STDOUT_HANDLE
|
|
||||||
jp fsGetB
|
|
||||||
|
|
||||||
stdoutPutB:
|
|
||||||
ld ix, STDOUT_HANDLE
|
|
||||||
jp fsPutB
|
|
||||||
|
|
||||||
.equ STDIN_HANDLE FS_HANDLES+FS_HANDLE_SIZE
|
|
||||||
|
|
||||||
stdinGetB:
|
|
||||||
ld ix, STDIN_HANDLE
|
|
||||||
jp fsGetB
|
|
||||||
|
|
||||||
stdinPutB:
|
|
||||||
ld ix, STDIN_HANDLE
|
|
||||||
jp fsPutB
|
|
@ -1,203 +0,0 @@
|
|||||||
#include <stdint.h>
|
|
||||||
#include <stdio.h>
|
|
||||||
#include <termios.h>
|
|
||||||
#include "../libz80/z80.h"
|
|
||||||
#include "shell-bin.h"
|
|
||||||
|
|
||||||
/* Collapse OS shell with filesystem
|
|
||||||
*
|
|
||||||
* On startup, if "cfsin" directory exists, it packs it as a afke block device
|
|
||||||
* and loads it in. Upon halting, unpcks the contents of that block device in
|
|
||||||
* "cfsout" directory.
|
|
||||||
*
|
|
||||||
* Memory layout:
|
|
||||||
*
|
|
||||||
* 0x0000 - 0x3fff: ROM code from shell.asm
|
|
||||||
* 0x4000 - 0x4fff: Kernel memory
|
|
||||||
* 0x5000 - 0xffff: Userspace
|
|
||||||
*
|
|
||||||
* I/O Ports:
|
|
||||||
*
|
|
||||||
* 0 - stdin / stdout
|
|
||||||
* 1 - Filesystem blockdev data read/write. Reads and write data to the address
|
|
||||||
* previously selected through port 2
|
|
||||||
*/
|
|
||||||
|
|
||||||
//#define DEBUG
|
|
||||||
#define MAX_FSDEV_SIZE 0x20000
|
|
||||||
|
|
||||||
// in sync with shell.asm
|
|
||||||
#define RAMSTART 0x4000
|
|
||||||
#define STDIO_PORT 0x00
|
|
||||||
#define FS_DATA_PORT 0x01
|
|
||||||
// Controls what address (24bit) the data port returns. To select an address,
|
|
||||||
// this port has to be written to 3 times, starting with the MSB.
|
|
||||||
// Reading this port returns an out-of-bounds indicator. Meaning:
|
|
||||||
// 0 means addr is within bounds
|
|
||||||
// 1 means that we're equal to fsdev size (error for reading, ok for writing)
|
|
||||||
// 2 means more than fsdev size (always invalid)
|
|
||||||
// 3 means incomplete addr setting
|
|
||||||
#define FS_ADDR_PORT 0x02
|
|
||||||
|
|
||||||
static Z80Context cpu;
|
|
||||||
static uint8_t mem[0x10000] = {0};
|
|
||||||
static uint8_t fsdev[MAX_FSDEV_SIZE] = {0};
|
|
||||||
static uint32_t fsdev_size = 0;
|
|
||||||
static uint32_t fsdev_ptr = 0;
|
|
||||||
// 0 = idle, 1 = received MSB (of 24bit addr), 2 = received middle addr
|
|
||||||
static int fsdev_addr_lvl = 0;
|
|
||||||
static int running;
|
|
||||||
|
|
||||||
static uint8_t io_read(int unused, uint16_t addr)
|
|
||||||
{
|
|
||||||
addr &= 0xff;
|
|
||||||
if (addr == STDIO_PORT) {
|
|
||||||
int c = getchar();
|
|
||||||
if (c == EOF) {
|
|
||||||
running = 0;
|
|
||||||
}
|
|
||||||
return (uint8_t)c;
|
|
||||||
} else if (addr == FS_DATA_PORT) {
|
|
||||||
if (fsdev_addr_lvl != 0) {
|
|
||||||
fprintf(stderr, "Reading FSDEV in the middle of an addr op (%d)\n", fsdev_ptr);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
if (fsdev_ptr < fsdev_size) {
|
|
||||||
#ifdef DEBUG
|
|
||||||
fprintf(stderr, "Reading FSDEV at offset %d\n", fsdev_ptr);
|
|
||||||
#endif
|
|
||||||
return fsdev[fsdev_ptr];
|
|
||||||
} else {
|
|
||||||
// don't warn when ==, we're not out of bounds, just at the edge.
|
|
||||||
if (fsdev_ptr > fsdev_size) {
|
|
||||||
fprintf(stderr, "Out of bounds FSDEV read at %d\n", fsdev_ptr);
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
} else if (addr == FS_ADDR_PORT) {
|
|
||||||
if (fsdev_addr_lvl != 0) {
|
|
||||||
return 3;
|
|
||||||
} else if (fsdev_ptr > fsdev_size) {
|
|
||||||
fprintf(stderr, "Out of bounds FSDEV addr request at %d / %d\n", fsdev_ptr, fsdev_size);
|
|
||||||
return 2;
|
|
||||||
} else if (fsdev_ptr == fsdev_size) {
|
|
||||||
return 1;
|
|
||||||
} else {
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
fprintf(stderr, "Out of bounds I/O read: %d\n", addr);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static void io_write(int unused, uint16_t addr, uint8_t val)
|
|
||||||
{
|
|
||||||
addr &= 0xff;
|
|
||||||
if (addr == STDIO_PORT) {
|
|
||||||
if (val == 0x04) { // CTRL+D
|
|
||||||
running = 0;
|
|
||||||
} else {
|
|
||||||
putchar(val);
|
|
||||||
}
|
|
||||||
} else if (addr == FS_DATA_PORT) {
|
|
||||||
if (fsdev_addr_lvl != 0) {
|
|
||||||
fprintf(stderr, "Writing to FSDEV in the middle of an addr op (%d)\n", fsdev_ptr);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
if (fsdev_ptr < fsdev_size) {
|
|
||||||
#ifdef DEBUG
|
|
||||||
fprintf(stderr, "Writing to FSDEV (%d)\n", fsdev_ptr);
|
|
||||||
#endif
|
|
||||||
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 {
|
|
||||||
fprintf(stderr, "Out of bounds FSDEV write at %d\n", fsdev_ptr);
|
|
||||||
}
|
|
||||||
} else if (addr == FS_ADDR_PORT) {
|
|
||||||
if (fsdev_addr_lvl == 0) {
|
|
||||||
fsdev_ptr = val << 16;
|
|
||||||
fsdev_addr_lvl = 1;
|
|
||||||
} else if (fsdev_addr_lvl == 1) {
|
|
||||||
fsdev_ptr |= val << 8;
|
|
||||||
fsdev_addr_lvl = 2;
|
|
||||||
} else {
|
|
||||||
fsdev_ptr |= val;
|
|
||||||
fsdev_addr_lvl = 0;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
fprintf(stderr, "Out of bounds I/O write: %d / %d (0x%x)\n", addr, val, val);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static uint8_t mem_read(int unused, uint16_t addr)
|
|
||||||
{
|
|
||||||
return mem[addr];
|
|
||||||
}
|
|
||||||
|
|
||||||
static void mem_write(int unused, uint16_t addr, uint8_t val)
|
|
||||||
{
|
|
||||||
if (addr < RAMSTART) {
|
|
||||||
fprintf(stderr, "Writing to ROM (%d)!\n", addr);
|
|
||||||
}
|
|
||||||
mem[addr] = val;
|
|
||||||
}
|
|
||||||
|
|
||||||
int main()
|
|
||||||
{
|
|
||||||
// Setup fs blockdev
|
|
||||||
FILE *fp = popen("../cfspack/cfspack cfsin", "r");
|
|
||||||
if (fp != NULL) {
|
|
||||||
printf("Initializing filesystem\n");
|
|
||||||
int i = 0;
|
|
||||||
int c = fgetc(fp);
|
|
||||||
while (c != EOF) {
|
|
||||||
fsdev[i] = c & 0xff;
|
|
||||||
i++;
|
|
||||||
c = fgetc(fp);
|
|
||||||
}
|
|
||||||
fsdev_size = i;
|
|
||||||
pclose(fp);
|
|
||||||
} else {
|
|
||||||
printf("Can't initialize filesystem. Leaving blank.\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
// Turn echo off: the shell takes care of its own echoing.
|
|
||||||
struct termios termInfo;
|
|
||||||
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);
|
|
||||||
|
|
||||||
|
|
||||||
// initialize memory
|
|
||||||
for (int i=0; i<sizeof(KERNEL); i++) {
|
|
||||||
mem[i] = KERNEL[i];
|
|
||||||
}
|
|
||||||
// Run!
|
|
||||||
running = 1;
|
|
||||||
Z80RESET(&cpu);
|
|
||||||
cpu.ioRead = io_read;
|
|
||||||
cpu.ioWrite = io_write;
|
|
||||||
cpu.memRead = mem_read;
|
|
||||||
cpu.memWrite = mem_write;
|
|
||||||
|
|
||||||
while (running && !cpu.halted) {
|
|
||||||
Z80Execute(&cpu);
|
|
||||||
}
|
|
||||||
|
|
||||||
printf("Done!\n");
|
|
||||||
termInfo.c_lflag |= ECHO;
|
|
||||||
termInfo.c_lflag |= ICANON;
|
|
||||||
tcsetattr(0, TCSAFLUSH, &termInfo);
|
|
||||||
return 0;
|
|
||||||
}
|
|
@ -1,35 +0,0 @@
|
|||||||
.equ SHELL_RAMSTART 0x4100
|
|
||||||
.equ USER_CODE 0x4200
|
|
||||||
|
|
||||||
; *** JUMP TABLE ***
|
|
||||||
.equ strncmp 0x03
|
|
||||||
.equ upcase @+3
|
|
||||||
.equ findchar @+3
|
|
||||||
.equ blkSelPtr @+3
|
|
||||||
.equ blkSel @+3
|
|
||||||
.equ blkSet @+3
|
|
||||||
.equ blkSeek @+3
|
|
||||||
.equ blkTell @+3
|
|
||||||
.equ blkGetB @+3
|
|
||||||
.equ blkPutB @+3
|
|
||||||
.equ fsFindFN @+3
|
|
||||||
.equ fsOpen @+3
|
|
||||||
.equ fsGetB @+3
|
|
||||||
.equ fsPutB @+3
|
|
||||||
.equ fsSetSize @+3
|
|
||||||
.equ fsOn @+3
|
|
||||||
.equ fsIter @+3
|
|
||||||
.equ fsAlloc @+3
|
|
||||||
.equ fsDel @+3
|
|
||||||
.equ fsHandle @+3
|
|
||||||
.equ printstr @+3
|
|
||||||
.equ printnstr @+3
|
|
||||||
.equ _blkGetB @+3
|
|
||||||
.equ _blkPutB @+3
|
|
||||||
.equ _blkSeek @+3
|
|
||||||
.equ _blkTell @+3
|
|
||||||
.equ printcrlf @+3
|
|
||||||
.equ stdioGetC @+3
|
|
||||||
.equ stdioPutC @+3
|
|
||||||
.equ stdioReadLine @+3
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
|||||||
10 print "Count to 10"
|
|
||||||
20 a=0
|
|
||||||
30 a=a+1
|
|
||||||
40 print a
|
|
||||||
50 if a<10 goto 30
|
|
Loading…
Reference in New Issue
Block a user