1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 20:30:56 +11:00

Compare commits

..

3 Commits

Author SHA1 Message Date
Virgil Dupras
3f3dd9141e basic: allow multiple args in print 2019-11-20 21:02:11 -05:00
Virgil Dupras
9c400ca642 basic: add goto
Things are getting super cereal...
2019-11-20 15:45:53 -05:00
Virgil Dupras
9d6cbe577c basic: add variables
Things are getting cereal...
2019-11-20 15:10:00 -05:00
7 changed files with 227 additions and 36 deletions

View File

@ -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"

View File

@ -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

View File

@ -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
View 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

View File

@ -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

View File

@ -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

View File

@ -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