collapseos/apps/basic/main.asm

532 lines
9.5 KiB
NASM
Raw Normal View History

; *** Variables ***
; Value of `SP` when basic was first invoked. This is where SP is going back to
; on restarts.
.equ BAS_INITSP BAS_RAMSTART
; Pointer to next line to run. If nonzero, it means that the next line is
; the first of the list. This is used by GOTO to indicate where to jump next.
; 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.
.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
2019-11-20 20:58:26 -05:00
.equ BAS_RAMEND @+2
; *** Code ***
basInit:
ld (BAS_INITSP), sp
call varInit
call bufInit
xor a
2019-11-20 20:58:26 -05:00
ld (BAS_PNEXTLN), a
ld (BAS_PNEXTLN+1), a
ld hl, unsetZ
ld (BAS_FINDHOOK), hl
ret
basStart:
ld hl, .welcome
call printstr
call printcrlf
2019-11-20 10:49:23 -05:00
jr basLoop
.welcome:
.db "Collapse OS", 0
2019-11-20 10:49:23 -05:00
basLoop:
ld hl, .sPrompt
call printstr
call stdioReadLine
2019-11-20 10:49:23 -05:00
call printcrlf
call parseDecimalC
jr z, .number
2019-11-20 10:49:23 -05:00
ld de, basCmds1
call basCallCmds
2019-11-20 10:49:23 -05:00
jr z, basLoop
; Error
call basERR
jr basLoop
.number:
2019-11-20 20:58:26 -05:00
call rdSep
call bufAdd
jp nz, basERR
2019-11-20 10:49:23 -05:00
jr basLoop
.sPrompt:
.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:
.loop:
call strcmp
call strskip
inc hl ; point to routine
jr z, .found ; Z from strcmp
inc hl \ inc hl ; skip routine
ld a, (hl)
inc a ; was it 0xff?
jr nz, .loop ; no
dec a ; unset Z
ret
.found:
call intoHL
push hl \ pop ix
ret
; 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,
; unset Z. We expect commands to set Z on success. Therefore, when calling
; basCallCmd results in NZ, we're not sure where the error come from, but
; well...
basCallCmd:
; let's see if it's a variable assignment.
call varTryAssign
ret z ; Done!
push de ; --> lvl 1.
ld de, SCRATCHPAD
call rdWord
; cmdname to find in (DE)
; How lucky, we have a legitimate use of "ex (sp), hl"! We have the
; 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!
ex (sp), hl
call basFindCmd
jr z, .skip
; not found, try BAS_FINDHOOK
ld ix, (BAS_FINDHOOK)
call callIX
.skip:
; regardless of the result, we need to balance the stack.
; Bring back rest of the command string from the stack
pop hl ; <-- lvl 1
ret nz
; cmd found, skip whitespace and then jump!
2019-11-20 20:58:26 -05:00
call rdSep
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:
ld hl, .sErr
2019-11-20 20:58:26 -05:00
call printstr
jp printcrlf
.sErr:
.db "ERR", 0
; *** Commands ***
; A command receives its argument through (HL), which is already placed to
; either:
; 1 - the end of the string if the command has no arg.
; 2 - the beginning of the arg, with whitespace properly skipped.
2019-11-20 10:49:23 -05:00
;
; Commands are expected to set Z on success.
basLIST:
call bufFirst
2019-11-24 14:26:32 -05:00
jr nz, .end
.loop:
ld e, (ix)
ld d, (ix+1)
2019-11-20 20:58:26 -05:00
ld hl, SCRATCHPAD
call fmtDecimal
call printstr
ld a, ' '
call stdioPutC
2019-11-19 20:43:01 -05:00
call bufStr
call printstr
call printcrlf
call bufNext
jr z, .loop
2019-11-24 14:26:32 -05:00
.end:
2019-11-20 10:49:23 -05:00
cp a ; ensure Z
ret
basRUN:
call .maybeGOTO
jr nz, .loop ; IX already set
2019-11-20 10:49:23 -05:00
call bufFirst
ret nz
.loop:
call bufStr
ld de, basCmds2
push ix ; --> lvl 1
call basCallCmds
2019-11-20 10:49:23 -05:00
pop ix ; <-- lvl 1
jp nz, .err
call .maybeGOTO
jr nz, .loop ; IX already set
2019-11-20 10:49:23 -05:00
call bufNext
jr z, .loop
cp a ; ensure Z
ret
2019-11-20 10:49:23 -05:00
.err:
; Print line number, then return NZ (which will print ERR)
ld e, (ix)
ld d, (ix+1)
2019-11-20 20:58:26 -05:00
ld hl, SCRATCHPAD
2019-11-20 10:49:23 -05:00
call fmtDecimal
call printstr
ld a, ' '
call stdioPutC
jp unsetZ
; This returns the opposite Z result as the one we usually see: Z is set if
; we **don't** goto, unset if we do. If we do, IX is properly set.
.maybeGOTO:
ld de, (BAS_PNEXTLN)
ld a, d
or e
ret z
; we goto
push de \ pop ix
; we need to reset our goto marker
ld de, 0
ld (BAS_PNEXTLN), de
ret
basPRINT:
; Do we have arguments at all? if not, it's not an error, just print
; crlf
ld a, (hl)
or a
jr z, .end
; Is our arg a string literal?
call spitQuoted
jr z, .chkAnother ; string printed, skip to chkAnother
2019-11-20 20:58:26 -05:00
ld de, SCRATCHPAD
call rdWord
push hl ; --> lvl 1
ex de, hl
2019-12-23 19:13:44 -05:00
call parseExpr
jr nz, .parseError
2019-11-20 20:58:26 -05:00
ld hl, SCRATCHPAD
2019-11-23 14:56:23 -05:00
call fmtDecimalS
2019-11-20 20:58:26 -05:00
call printstr
pop hl ; <-- lvl 1
.chkAnother:
2019-11-20 20:58:26 -05:00
; Do we have another arg?
call rdSep
jr z, .another
; no, we can stop here
.end:
2019-11-20 10:49:23 -05:00
cp a ; ensure Z
2019-11-20 20:58:26 -05:00
jp printcrlf
.another:
; Before we jump to basPRINT, let's print a space
ld a, ' '
call stdioPutC
jr basPRINT
.parseError:
; unwind the stack before returning
pop hl ; <-- lvl 1
ret
basGOTO:
2019-11-20 20:58:26 -05:00
ld de, SCRATCHPAD
call rdWord
ex de, hl
2019-12-23 19:13:44 -05:00
call parseExpr
ret nz
call bufFind
jr nz, .notFound
push ix \ pop de
; Z already set
jr .end
.notFound:
ld de, 0
; Z already unset
.end:
ld (BAS_PNEXTLN), de
ret
2019-12-12 11:17:10 -05:00
; evaluate truth condition at (HL) and set A to its value
; Z for success (but not truth!)
_basEvalCond:
2019-11-21 16:06:14 -05:00
push hl ; --> lvl 1. original arg
ld de, SCRATCHPAD
call rdWord
ex de, hl
call parseTruth
pop hl ; <-- lvl 1. restore
2019-12-12 11:17:10 -05:00
ret
basIF:
call _basEvalCond
ret nz ; error
2019-11-21 16:06:14 -05:00
or a
ret z
; expr is true, execute next
; (HL) back to beginning of args, skip to next arg
call toSepOrEnd
2019-11-21 16:06:14 -05:00
call rdSep
ret nz
2019-11-21 16:06:14 -05:00
ld de, basCmds2
jp basCallCmds
2019-11-21 16:06:14 -05:00
2019-12-12 11:17:10 -05:00
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
2019-11-21 20:17:55 -05:00
basINPUT:
; If our first arg is a string literal, spit it
call spitQuoted
call rdSep
call stdioReadLine
2019-12-23 19:13:44 -05:00
call parseExpr
ld (VAR_TBL), de
2019-11-21 20:17:55 -05:00
call printcrlf
cp a ; ensure Z
ret
basPEEK:
call basDEEK
ret nz
; set MSB to 0
xor a ; sets Z
ld (VAR_TBL+1), a
ret
basPOKE:
call rdExpr
ret nz
; peek address in IX. Save it for later
push ix ; --> lvl 1
call rdSep
call rdExpr
push ix \ pop hl
pop ix ; <-- lvl 1
ret nz
; Poke!
ld (ix), l
ret
basDEEK:
call rdExpr
ret nz
; peek address in IX. Let's peek and put result in DE
ld e, (ix)
ld d, (ix+1)
ld (VAR_TBL), de
cp a ; ensure Z
ret
basDOKE:
call basPOKE
ld (ix+1), h
ret
basOUT:
call rdExpr
ret nz
; out address in IX. Save it for later
push ix ; --> lvl 1
call rdSep
call rdExpr
push ix \ pop hl
pop bc ; <-- lvl 1
ret nz
; Out!
out (c), l
cp a ; ensure Z
ret
basIN:
call rdExpr
ret nz
push ix \ pop bc
ld d, 0
in e, (c)
ld (VAR_TBL), de
; Z set from rdExpr
ret
2019-11-30 21:13:44 -05:00
basGETC:
call stdioGetC
ld (VAR_TBL), a
xor a
ld (VAR_TBL+1), a
ret
basPUTC:
call rdExpr
ret nz
push ix \ pop hl
ld a, l
call stdioPutC
xor a ; set Z
ret
2019-12-09 14:15:43 -05:00
basPUTH:
call rdExpr
ret nz
push ix \ pop hl
ld a, l
call printHex
xor a ; set Z
ret
basSLEEP:
call rdExpr
ret nz
push ix \ pop hl
.loop:
ld a, h ; 4T
or l ; 4T
ret z ; 5T
dec hl ; 6T
jr .loop ; 12T
2019-11-24 15:39:36 -05:00
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
2019-11-24 21:07:03 -05:00
basUSR:
call rdExpr
ret nz
push ix \ pop iy
; We have our address to call. Now, let's set up our registers.
; HL comes from variable H. H's index is 7*2.
ld hl, (VAR_TBL+14)
; DE comes from variable D. D's index is 3*2
ld de, (VAR_TBL+6)
; BC comes from variable B. B's index is 1*2
ld bc, (VAR_TBL+2)
; IX comes from variable X. X's index is 23*2
ld ix, (VAR_TBL+46)
; and finally, A
ld a, (VAR_TBL)
call callIY
basR2Var: ; Just send reg to vars. Used in basPgmHook
2019-11-24 21:07:03 -05:00
; Same dance, opposite way
ld (VAR_TBL), a
ld (VAR_TBL+46), ix
ld (VAR_TBL+2), bc
ld (VAR_TBL+6), de
ld (VAR_TBL+14), hl
cp a ; USR never errors out
ret
; Command table format: Null-terminated string followed by a 2-byte routine
; pointer.
; direct only
basCmds1:
.db "list", 0
.dw basLIST
.db "run", 0
2019-11-20 10:49:23 -05:00
.dw basRUN
2019-11-24 14:26:32 -05:00
.db "clear", 0
.dw bufInit
; statements
basCmds2:
.db "print", 0
.dw basPRINT
.db "goto", 0
.dw basGOTO
.db "if", 0
2019-11-21 16:06:14 -05:00
.dw basIF
2019-12-12 11:17:10 -05:00
.db "while", 0
.dw basWHILE
2019-11-21 20:17:55 -05:00
.db "input", 0
.dw basINPUT
.db "peek", 0
.dw basPEEK
.db "poke", 0
.dw basPOKE
.db "deek", 0
.dw basDEEK
.db "doke", 0
.dw basDOKE
.db "out", 0
.dw basOUT
.db "in", 0
.dw basIN
.db "getc", 0
2019-11-30 21:13:44 -05:00
.dw basGETC
.db "putc", 0
2019-11-30 21:13:44 -05:00
.dw basPUTC
2019-12-09 14:15:43 -05:00
.db "puth", 0
.dw basPUTH
.db "sleep", 0
.dw basSLEEP
.db "addr", 0
2019-11-24 15:39:36 -05:00
.dw basADDR
.db "usr", 0
2019-11-24 21:07:03 -05:00
.dw basUSR
.db 0xff ; end of table