|
- ; *** 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
- .equ BAS_RAMEND @+2
-
- ; *** Code ***
- basInit:
- ld (BAS_INITSP), sp
- call varInit
- call bufInit
- xor a
- 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
- jr basLoop
-
- .welcome:
- .db "Collapse OS", 0
-
- basLoop:
- ld hl, .sPrompt
- call printstr
- call stdioReadLine
- call printcrlf
- call parseDecimalC
- jr z, .number
- ld de, basCmds1
- call basCallCmds
- jr z, basLoop
- ; Error
- call basERR
- jr basLoop
- .number:
- call rdSep
- call bufAdd
- jp nz, basERR
- 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!
- 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
- 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.
- ;
- ; Commands are expected to set Z on success.
- basLIST:
- call bufFirst
- jr nz, .end
- .loop:
- ld e, (ix)
- ld d, (ix+1)
- ld hl, SCRATCHPAD
- call fmtDecimal
- call printstr
- ld a, ' '
- call stdioPutC
- call bufStr
- call printstr
- call printcrlf
- call bufNext
- jr z, .loop
- .end:
- cp a ; ensure Z
- ret
-
-
- basRUN:
- call .maybeGOTO
- jr nz, .loop ; IX already set
- call bufFirst
- ret nz
- .loop:
- call bufStr
- ld de, basCmds2
- push ix ; --> lvl 1
- call basCallCmds
- pop ix ; <-- lvl 1
- jp nz, .err
- call .maybeGOTO
- jr nz, .loop ; IX already set
- call bufNext
- jr z, .loop
- cp a ; ensure Z
- ret
- .err:
- ; Print line number, then return NZ (which will print ERR)
- ld e, (ix)
- ld d, (ix+1)
- ld hl, SCRATCHPAD
- 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
- ld de, SCRATCHPAD
- call rdWord
- push hl ; --> lvl 1
- ex de, hl
- call parseExpr
- jr nz, .parseError
- ld hl, SCRATCHPAD
- call fmtDecimalS
- call printstr
- pop hl ; <-- lvl 1
- .chkAnother:
- ; Do we have another arg?
- call rdSep
- jr z, .another
- ; no, we can stop here
- .end:
- cp a ; ensure Z
- 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:
- ld de, SCRATCHPAD
- call rdWord
- ex de, hl
- 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
-
- ; evaluate truth condition at (HL) and set A to its value
- ; Z for success (but not truth!)
- _basEvalCond:
- push hl ; --> lvl 1. original arg
- ld de, SCRATCHPAD
- call rdWord
- ex de, hl
- call parseTruth
- pop hl ; <-- lvl 1. restore
- ret
-
- basIF:
- call _basEvalCond
- ret nz ; error
- or a
- 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
- 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:
- ; If our first arg is a string literal, spit it
- call spitQuoted
- call rdSep
- call stdioReadLine
- call parseExpr
- ld (VAR_TBL), de
- 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
-
- 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
-
- 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
-
- 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
-
- 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
- ; 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
- .dw basRUN
- .db "clear", 0
- .dw bufInit
- ; statements
- basCmds2:
- .db "print", 0
- .dw basPRINT
- .db "goto", 0
- .dw basGOTO
- .db "if", 0
- .dw basIF
- .db "while", 0
- .dw basWHILE
- .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
- .dw basGETC
- .db "putc", 0
- .dw basPUTC
- .db "puth", 0
- .dw basPUTH
- .db "sleep", 0
- .dw basSLEEP
- .db "addr", 0
- .dw basADDR
- .db "usr", 0
- .dw basUSR
- .db 0xff ; end of table
|