collapseos/apps/basic/main.asm

; *** 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