mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 20:30:56 +11:00
Compare commits
3 Commits
9c9484fb88
...
3f3dd9141e
Author | SHA1 | Date | |
---|---|---|---|
|
3f3dd9141e | ||
|
9c400ca642 | ||
|
9d6cbe577c |
@ -9,15 +9,21 @@
|
|||||||
|
|
||||||
jp basStart
|
jp basStart
|
||||||
|
|
||||||
|
; RAM space used in different routines for short term processing.
|
||||||
|
.equ SCRATCHPAD_SIZE 0x20
|
||||||
|
.equ SCRATCHPAD USER_RAMSTART
|
||||||
|
|
||||||
.inc "core.asm"
|
.inc "core.asm"
|
||||||
.inc "lib/util.asm"
|
.inc "lib/util.asm"
|
||||||
.inc "lib/ari.asm"
|
.inc "lib/ari.asm"
|
||||||
.inc "lib/parse.asm"
|
.inc "lib/parse.asm"
|
||||||
.inc "lib/fmt.asm"
|
.inc "lib/fmt.asm"
|
||||||
.equ EXPR_PARSE parseLiteral
|
.equ EXPR_PARSE parseLiteralOrVar
|
||||||
.inc "lib/expr.asm"
|
.inc "lib/expr.asm"
|
||||||
.inc "basic/tok.asm"
|
.inc "basic/tok.asm"
|
||||||
.equ BUF_RAMSTART USER_RAMSTART
|
.equ VAR_RAMSTART SCRATCHPAD+SCRATCHPAD_SIZE
|
||||||
|
.inc "basic/var.asm"
|
||||||
|
.equ BUF_RAMSTART VAR_RAMEND
|
||||||
.inc "basic/buf.asm"
|
.inc "basic/buf.asm"
|
||||||
.equ BAS_RAMSTART BUF_RAMEND
|
.equ BAS_RAMSTART BUF_RAMEND
|
||||||
.inc "basic/main.asm"
|
.inc "basic/main.asm"
|
||||||
|
@ -1,28 +1,29 @@
|
|||||||
; *** Constants ***
|
|
||||||
.equ BAS_SCRATCHPAD_SIZE 0x20
|
|
||||||
; *** Variables ***
|
; *** Variables ***
|
||||||
; Value of `SP` when basic was first invoked. This is where SP is going back to
|
; Value of `SP` when basic was first invoked. This is where SP is going back to
|
||||||
; on restarts.
|
; on restarts.
|
||||||
.equ BAS_INITSP BAS_RAMSTART
|
.equ BAS_INITSP BAS_RAMSTART
|
||||||
; **Pointer** to current line number
|
; Pointer to next line to run. If nonzero, it means that the next line is
|
||||||
.equ BAS_PCURLN @+2
|
; the first of the list. This is used by GOTO to indicate where to jump next.
|
||||||
.equ BAS_SCRATCHPAD @+2
|
; Important note: this is **not** a line number, it's a pointer to a line index
|
||||||
.equ BAS_RAMEND @+BAS_SCRATCHPAD_SIZE
|
; in buffer. If it's not zero, its a valid pointer.
|
||||||
|
.equ BAS_PNEXTLN @+2
|
||||||
|
.equ BAS_RAMEND @+2
|
||||||
|
|
||||||
; *** Code ***
|
; *** Code ***
|
||||||
basStart:
|
basStart:
|
||||||
ld (BAS_INITSP), sp
|
ld (BAS_INITSP), sp
|
||||||
|
call varInit
|
||||||
call bufInit
|
call bufInit
|
||||||
xor a
|
xor a
|
||||||
|
ld (BAS_PNEXTLN), a
|
||||||
|
ld (BAS_PNEXTLN+1), a
|
||||||
ld hl, .welcome
|
ld hl, .welcome
|
||||||
call printstr
|
call printstr
|
||||||
call printcrlf
|
call printcrlf
|
||||||
ld hl, .welcome+2 ; points to a zero word
|
|
||||||
ld (BAS_PCURLN), hl
|
|
||||||
jr basLoop
|
jr basLoop
|
||||||
|
|
||||||
.welcome:
|
.welcome:
|
||||||
.db "OK", 0, 0
|
.db "OK", 0
|
||||||
|
|
||||||
basLoop:
|
basLoop:
|
||||||
ld hl, .sPrompt
|
ld hl, .sPrompt
|
||||||
@ -39,8 +40,8 @@ basLoop:
|
|||||||
jr basLoop
|
jr basLoop
|
||||||
.number:
|
.number:
|
||||||
push ix \ pop de
|
push ix \ pop de
|
||||||
call toWS
|
call toSep
|
||||||
call rdWS
|
call rdSep
|
||||||
call bufAdd
|
call bufAdd
|
||||||
jp nz, basERR
|
jp nz, basERR
|
||||||
jr basLoop
|
jr basLoop
|
||||||
@ -52,7 +53,10 @@ basLoop:
|
|||||||
; on success. Therefore, when calling basCallCmd results in NZ, we're not sure
|
; on success. Therefore, when calling basCallCmd results in NZ, we're not sure
|
||||||
; where the error come from, but well...
|
; where the error come from, but well...
|
||||||
basCallCmd:
|
basCallCmd:
|
||||||
; First, get cmd length
|
; let's see if it's a variable assignment.
|
||||||
|
call varTryAssign
|
||||||
|
ret z ; Done!
|
||||||
|
; Second, get cmd length
|
||||||
call fnWSIdx
|
call fnWSIdx
|
||||||
cp 7
|
cp 7
|
||||||
jp nc, unsetZ ; Too long, can't possibly fit anything.
|
jp nc, unsetZ ; Too long, can't possibly fit anything.
|
||||||
@ -79,17 +83,13 @@ basCallCmd:
|
|||||||
ex de, hl
|
ex de, hl
|
||||||
ld a, b ; cmd's length
|
ld a, b ; cmd's length
|
||||||
call addHL
|
call addHL
|
||||||
call rdWS
|
call rdSep
|
||||||
jp (ix)
|
jp (ix)
|
||||||
|
|
||||||
|
|
||||||
basPrintLn:
|
|
||||||
call printstr
|
|
||||||
jp printcrlf
|
|
||||||
|
|
||||||
basERR:
|
basERR:
|
||||||
ld hl, .sErr
|
ld hl, .sErr
|
||||||
jr basPrintLn
|
call printstr
|
||||||
|
jp printcrlf
|
||||||
.sErr:
|
.sErr:
|
||||||
.db "ERR", 0
|
.db "ERR", 0
|
||||||
|
|
||||||
@ -102,7 +102,8 @@ basERR:
|
|||||||
; Commands are expected to set Z on success.
|
; Commands are expected to set Z on success.
|
||||||
basBYE:
|
basBYE:
|
||||||
ld hl, .sBye
|
ld hl, .sBye
|
||||||
call basPrintLn
|
call printstr
|
||||||
|
call printcrlf
|
||||||
; To quit the loop, let's return the stack to its initial value and
|
; To quit the loop, let's return the stack to its initial value and
|
||||||
; then return.
|
; then return.
|
||||||
xor a
|
xor a
|
||||||
@ -117,7 +118,7 @@ basLIST:
|
|||||||
.loop:
|
.loop:
|
||||||
ld e, (ix)
|
ld e, (ix)
|
||||||
ld d, (ix+1)
|
ld d, (ix+1)
|
||||||
ld hl, BAS_SCRATCHPAD
|
ld hl, SCRATCHPAD
|
||||||
call fmtDecimal
|
call fmtDecimal
|
||||||
call printstr
|
call printstr
|
||||||
ld a, ' '
|
ld a, ' '
|
||||||
@ -132,6 +133,8 @@ basLIST:
|
|||||||
|
|
||||||
|
|
||||||
basRUN:
|
basRUN:
|
||||||
|
call .maybeGOTO
|
||||||
|
jr nz, .loop ; IX already set
|
||||||
call bufFirst
|
call bufFirst
|
||||||
ret nz
|
ret nz
|
||||||
.loop:
|
.loop:
|
||||||
@ -141,6 +144,8 @@ basRUN:
|
|||||||
call basCallCmd
|
call basCallCmd
|
||||||
pop ix ; <-- lvl 1
|
pop ix ; <-- lvl 1
|
||||||
jp nz, .err
|
jp nz, .err
|
||||||
|
call .maybeGOTO
|
||||||
|
jr nz, .loop ; IX already set
|
||||||
call bufNext
|
call bufNext
|
||||||
jr z, .loop
|
jr z, .loop
|
||||||
cp a ; ensure Z
|
cp a ; ensure Z
|
||||||
@ -149,23 +154,69 @@ basRUN:
|
|||||||
; Print line number, then return NZ (which will print ERR)
|
; Print line number, then return NZ (which will print ERR)
|
||||||
ld e, (ix)
|
ld e, (ix)
|
||||||
ld d, (ix+1)
|
ld d, (ix+1)
|
||||||
ld hl, BAS_SCRATCHPAD
|
ld hl, SCRATCHPAD
|
||||||
call fmtDecimal
|
call fmtDecimal
|
||||||
call printstr
|
call printstr
|
||||||
ld a, ' '
|
ld a, ' '
|
||||||
call stdioPutC
|
call stdioPutC
|
||||||
jp unsetZ
|
jp unsetZ
|
||||||
|
|
||||||
.runline:
|
; 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:
|
basPRINT:
|
||||||
|
ld de, SCRATCHPAD
|
||||||
|
call rdWord
|
||||||
|
push hl ; --> lvl 1
|
||||||
|
ex de, hl
|
||||||
call parseExpr
|
call parseExpr
|
||||||
ret nz
|
ret nz
|
||||||
push ix \ pop de
|
push ix \ pop de
|
||||||
ld hl, BAS_SCRATCHPAD
|
ld hl, SCRATCHPAD
|
||||||
call fmtDecimal
|
call fmtDecimal
|
||||||
|
call printstr
|
||||||
|
pop hl ; <-- lvl 1
|
||||||
|
; Do we have another arg?
|
||||||
|
call rdSep
|
||||||
|
jr z, .another
|
||||||
|
; no, we can stop here
|
||||||
cp a ; ensure Z
|
cp a ; ensure Z
|
||||||
jp basPrintLn
|
jp printcrlf
|
||||||
|
.another:
|
||||||
|
; Before we jump to basPRINT, let's print a space
|
||||||
|
ld a, ' '
|
||||||
|
call stdioPutC
|
||||||
|
jr basPRINT
|
||||||
|
|
||||||
|
basGOTO:
|
||||||
|
ld de, SCRATCHPAD
|
||||||
|
call rdWord
|
||||||
|
ex de, hl
|
||||||
|
call parseExpr
|
||||||
|
ret nz
|
||||||
|
push ix \ pop de
|
||||||
|
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
|
||||||
|
|
||||||
; direct only
|
; direct only
|
||||||
basCmds1:
|
basCmds1:
|
||||||
@ -179,4 +230,6 @@ basCmds1:
|
|||||||
basCmds2:
|
basCmds2:
|
||||||
.dw basPRINT
|
.dw basPRINT
|
||||||
.db "print", 0
|
.db "print", 0
|
||||||
|
.dw basGOTO
|
||||||
|
.db "goto", 0, 0
|
||||||
.db 0xff, 0xff, 0xff ; end of table
|
.db 0xff, 0xff, 0xff ; end of table
|
||||||
|
@ -1,3 +1,12 @@
|
|||||||
|
; Sets Z is A is ' ' or '\t' (whitespace), or ',' (arg sep)
|
||||||
|
isSep:
|
||||||
|
cp ' '
|
||||||
|
ret z
|
||||||
|
cp 0x09
|
||||||
|
ret z
|
||||||
|
cp ','
|
||||||
|
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
|
||||||
; until a non-whitespace character is met.
|
; until a non-whitespace character is met.
|
||||||
; HL is advanced to the first non-whitespace char.
|
; HL is advanced to the first non-whitespace char.
|
||||||
@ -5,7 +14,7 @@
|
|||||||
; Failure is either not having a first whitespace or reaching the end of the
|
; Failure is either not having a first whitespace or reaching the end of the
|
||||||
; string.
|
; string.
|
||||||
; Sets Z if we found a non-whitespace char, unset if we found the end of string.
|
; Sets Z if we found a non-whitespace char, unset if we found the end of string.
|
||||||
rdWS:
|
rdSep:
|
||||||
ld a, (hl)
|
ld a, (hl)
|
||||||
call isSep
|
call isSep
|
||||||
ret nz ; failure
|
ret nz ; failure
|
||||||
@ -47,10 +56,32 @@ fnWSIdx:
|
|||||||
pop hl
|
pop hl
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Advance HL to the next whitespace or to the end of string.
|
; Advance HL to the next separator or to the end of string.
|
||||||
toWS:
|
toSep:
|
||||||
ld a, (hl)
|
ld a, (hl)
|
||||||
call isSep
|
call isSep
|
||||||
ret z
|
ret z
|
||||||
inc hl
|
inc hl
|
||||||
jr toWS
|
jr toSep
|
||||||
|
|
||||||
|
; 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.
|
||||||
|
rdWord:
|
||||||
|
push af
|
||||||
|
push de
|
||||||
|
.loop:
|
||||||
|
ld a, (hl)
|
||||||
|
call isSep
|
||||||
|
jr z, .stop
|
||||||
|
or a
|
||||||
|
jr z, .stop
|
||||||
|
ld (de), a
|
||||||
|
inc hl
|
||||||
|
inc de
|
||||||
|
jr .loop
|
||||||
|
.stop:
|
||||||
|
xor a
|
||||||
|
ld (de), a
|
||||||
|
pop de
|
||||||
|
pop af
|
||||||
|
ret
|
||||||
|
101
apps/basic/var.asm
Normal file
101
apps/basic/var.asm
Normal file
@ -0,0 +1,101 @@
|
|||||||
|
; *** Variables ***
|
||||||
|
; A list of words for each member of the A-Z range.
|
||||||
|
.equ VAR_TBL VAR_RAMSTART
|
||||||
|
.equ VAR_RAMEND @+52
|
||||||
|
|
||||||
|
; *** Code ***
|
||||||
|
|
||||||
|
varInit:
|
||||||
|
ld b, VAR_RAMEND-VAR_RAMSTART
|
||||||
|
ld hl, VAR_RAMSTART
|
||||||
|
xor a
|
||||||
|
.loop:
|
||||||
|
ld (hl), a
|
||||||
|
inc hl
|
||||||
|
djnz .loop
|
||||||
|
ret
|
||||||
|
|
||||||
|
; Check if A is a valid variable letter (a-z or A-Z). If it is, set A to a
|
||||||
|
; valid VAR_TBL index and set Z. Otherwise, unset Z (and A is destroyed)
|
||||||
|
varChk:
|
||||||
|
call upcase
|
||||||
|
sub 'A'
|
||||||
|
ret c ; Z unset
|
||||||
|
cp 27 ; 'Z' + 1
|
||||||
|
jr c, .isVar
|
||||||
|
; A > 'Z'
|
||||||
|
dec a ; unset Z
|
||||||
|
ret
|
||||||
|
.isVar:
|
||||||
|
cp a ; set Z
|
||||||
|
ret
|
||||||
|
|
||||||
|
; Try to interpret line at (HL) and see if it's a variable assignment. If it
|
||||||
|
; is, proceed with the assignment and set Z. Otherwise, NZ.
|
||||||
|
varTryAssign:
|
||||||
|
inc hl
|
||||||
|
ld a, (hl)
|
||||||
|
dec hl
|
||||||
|
cp '='
|
||||||
|
ret nz
|
||||||
|
ld a, (hl)
|
||||||
|
call varChk
|
||||||
|
ret nz
|
||||||
|
; We have a variable! Its table index is currently in A.
|
||||||
|
push ix ; --> lvl 1
|
||||||
|
push hl ; --> lvl 2
|
||||||
|
push de ; --> lvl 3
|
||||||
|
push af ; --> lvl 4. save for later
|
||||||
|
; Let's put that expression to read in scratchpad
|
||||||
|
inc hl \ inc hl
|
||||||
|
ld de, SCRATCHPAD
|
||||||
|
call rdWord
|
||||||
|
ex de, hl
|
||||||
|
; Now, evaluate that expression now in (HL)
|
||||||
|
call parseExpr ; --> number in IX
|
||||||
|
jr nz, .exprErr
|
||||||
|
pop af ; <-- lvl 4
|
||||||
|
add a, a ; * 2 because each element is a word
|
||||||
|
ld hl, VAR_TBL
|
||||||
|
call addHL
|
||||||
|
; HL placed, write number
|
||||||
|
push ix \ pop de
|
||||||
|
ld (hl), e
|
||||||
|
inc hl
|
||||||
|
ld (hl), d
|
||||||
|
xor a ; ensure Z
|
||||||
|
.end:
|
||||||
|
pop de ; <-- lvl 3
|
||||||
|
pop hl ; <-- lvl 2
|
||||||
|
pop ix ; <-- lvl 1
|
||||||
|
ret
|
||||||
|
.exprErr:
|
||||||
|
pop af ; <-- lvl 4
|
||||||
|
jr .end
|
||||||
|
|
||||||
|
; Check if value at (HL) is a variable. If yes, returns its associated value.
|
||||||
|
; Otherwise, jump to parseLiteral.
|
||||||
|
parseLiteralOrVar:
|
||||||
|
inc hl
|
||||||
|
ld a, (hl)
|
||||||
|
dec hl
|
||||||
|
or a
|
||||||
|
; if more than one in length, it can't be a variable
|
||||||
|
jp nz, parseLiteral
|
||||||
|
ld a, (hl)
|
||||||
|
call varChk
|
||||||
|
jp nz, parseLiteral
|
||||||
|
; It's a variable, resolve!
|
||||||
|
add a, a ; * 2 because each element is a word
|
||||||
|
push hl ; --> lvl 1
|
||||||
|
ld hl, VAR_TBL
|
||||||
|
call addHL
|
||||||
|
push de ; --> lvl 2
|
||||||
|
ld e, (hl)
|
||||||
|
inc hl
|
||||||
|
ld d, (hl)
|
||||||
|
push de \ pop ix
|
||||||
|
pop de ; <-- lvl 2
|
||||||
|
pop hl ; <-- lvl 1
|
||||||
|
cp a ; ensure Z
|
||||||
|
ret
|
@ -132,7 +132,7 @@ parseDecimal:
|
|||||||
pop hl
|
pop hl
|
||||||
ret z
|
ret z
|
||||||
; A is not 0? Ok, but if it's a space, we're happy too.
|
; A is not 0? Ok, but if it's a space, we're happy too.
|
||||||
jp isSep
|
jp isWS
|
||||||
.error:
|
.error:
|
||||||
pop hl
|
pop hl
|
||||||
jp unsetZ
|
jp unsetZ
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
; Sets Z is A is ' ' or '\t'
|
; Sets Z is A is ' ' or '\t' (whitespace)
|
||||||
isSep:
|
isWS:
|
||||||
cp ' '
|
cp ' '
|
||||||
ret z
|
ret z
|
||||||
cp 0x09
|
cp 0x09
|
||||||
|
@ -31,7 +31,7 @@ isLineEnd:
|
|||||||
|
|
||||||
; Sets Z is A is ' ', ',', ';', CR, LF, or null.
|
; Sets Z is A is ' ', ',', ';', CR, LF, or null.
|
||||||
isSepOrLineEnd:
|
isSepOrLineEnd:
|
||||||
call isSep
|
call isWS
|
||||||
ret z
|
ret z
|
||||||
jr isLineEndOrComment
|
jr isLineEndOrComment
|
||||||
|
|
||||||
@ -68,7 +68,7 @@ isLabel:
|
|||||||
; read char in A
|
; read char in A
|
||||||
_eatWhitespace:
|
_eatWhitespace:
|
||||||
call ioGetB
|
call ioGetB
|
||||||
call isSep
|
call isWS
|
||||||
ret nz
|
ret nz
|
||||||
jr _eatWhitespace
|
jr _eatWhitespace
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user