basic.asm

6502 enhanced basic 的示範程式, 但是和applesoft又不一樣,給各位參考參考

	JSR	LAB_SHLN		; search Basic for temp integer line number from AX
	BCS	LAB_line_found	; if carry set go set pointer

	JMP	LAB_16F7		; else go do "Undefined statement" error

LAB_line_found
					; carry already set for subtract
	LDA	Baslnl		; get pointer low byte
	SBC	#$01			; -1
	LDY	Baslnh		; get pointer high byte
	BCS	LAB_1624		; branch if no underflow (save DATA pointer & return)

	BCC	LAB_uflow		; else decrement high byte then save DATA pointer &
					; return (branch always)

; perform NULL

LAB_NULL
	JSR	LAB_GTBY		; get byte parameter
	STX	Nullct		; save new NULL count
LAB_167A
	RTS				;

; perform CONT

LAB_CONT
	BNE	LAB_167A		; if following byte exit to do syntax error

	LDY	Cpntrh		; get continue pointer high byte
	BNE	LAB_166C		; go do continue if we can

	LDX	#$1E			; error code $1E ("Can't continue" error)
	JMP	LAB_XERR		; do error #X, then warm start

					; we can continue so ...
LAB_166C
	LDA	#TK_ON		; set token for ON
	JSR	LAB_IRQ		; set IRQ flags
	LDA	#TK_ON		; set token for ON
	JSR	LAB_NMI		; set NMI flags

	STY	Bpntrh		; save BASIC execute pointer high byte
	LDA	Cpntrl		; get continue pointer low byte
	STA	Bpntrl		; save BASIC execute pointer low byte
	LDA	Blinel		; get break line low byte
	LDY	Blineh		; get break line high byte
	STA	Clinel		; set current line low byte
	STY	Clineh		; set current line high byte
	RTS				;

; perform RUN

LAB_RUN
	BNE	LAB_1696		; branch if RUN n
	JMP	LAB_1477		; reset execution to start, clear vars, flush stack & RET

; does RUN n

LAB_1696
	JSR	LAB_147A		; go do "CLEAR"
	BEQ	LAB_16B0		; get n and do GOTO n (branch always as CLEAR sets Z=1)

; perform DO

LAB_DO
	LDA	#$05			; need 5 bytes for DO
	JSR	LAB_1212		; check room on stack for A bytes
	LDA	Bpntrh		; get BASIC execute pointer high byte
	PHA				; push on stack
	LDA	Bpntrl		; get BASIC execute pointer low byte
	PHA				; push on stack
	LDA	Clineh		; get current line high byte
	PHA				; push on stack
	LDA	Clinel		; get current line low byte
	PHA				; push on stack
	LDA	#TK_DO		; token for DO
	PHA				; push on stack
	JSR	LAB_GBYT		; scan memory
	JMP	LAB_15C2		; go do interpreter inner loop

; perform GOSUB

LAB_GOSUB
	LDA	#$05			; need 5 bytes for GOSUB
	JSR	LAB_1212		; check room on stack for A bytes
	LDA	Bpntrh		; get BASIC execute pointer high byte
	PHA				; push on stack
	LDA	Bpntrl		; get BASIC execute pointer low byte
	PHA				; push on stack
	LDA	Clineh		; get current line high byte
	PHA				; push on stack
	LDA	Clinel		; get current line low byte
	PHA				; push on stack
	LDA	#TK_GOSUB		; token for GOSUB
	PHA				; push on stack
LAB_16B0
	JSR	LAB_GBYT		; scan memory
	JSR	LAB_GOTO		; perform GOTO n
	JMP	LAB_15C2		; go do interpreter inner loop
					; (can't RTS, we used the stack!)

; perform GOTO

LAB_GOTO
	JSR	LAB_GFPN		; get fixed-point number into temp integer
	JSR	LAB_SNBL		; scan for next BASIC line
	LDA	Clineh		; get current line high byte
	CMP	Itemph		; compare with temporary integer high byte
	BCS	LAB_16D0		; branch if >= (start search from beginning)

	TYA				; else copy line index to A
	SEC				; set carry (+1)
	ADC	Bpntrl		; add BASIC execute pointer low byte
	LDX	Bpntrh		; get BASIC execute pointer high byte
	BCC	LAB_16D4		; branch if no overflow to high byte

	INX				; increment high byte
	BCS	LAB_16D4		; branch always (can never be carry)

; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml)

LAB_16D0
	LDA	Smeml			; get start of mem low byte
	LDX	Smemh			; get start of mem high byte

; search for line # in temp (Itempl/Itemph) from (AX)

LAB_16D4
	JSR	LAB_SHLN		; search Basic for temp integer line number from AX
	BCC	LAB_16F7		; if carry clear go do "Undefined statement" error
					; (unspecified statement)

					; carry already set for subtract
	LDA	Baslnl		; get pointer low byte
	SBC	#$01			; -1
	STA	Bpntrl		; save BASIC execute pointer low byte
	LDA	Baslnh		; get pointer high byte
	SBC	#$00			; subtract carry
	STA	Bpntrh		; save BASIC execute pointer high byte
LAB_16E5
	RTS				;

LAB_DONOK
	LDX	#$22			; error code $22 ("LOOP without DO" error)
	JMP	LAB_XERR		; do error #X, then warm start

; perform LOOP

LAB_LOOP
	TAY				; save following token
	TSX				; copy stack pointer
	LDA	LAB_STAK+3,X	; get token byte from stack
	CMP	#TK_DO		; compare with DO token
	BNE	LAB_DONOK		; branch if no matching DO

	INX				; dump calling routine return address
	INX				; dump calling routine return address
	TXS				; correct stack
	TYA				; get saved following token back
	BEQ	LoopAlways		; if no following token loop forever
					; (stack pointer in X)

	CMP	#$3A			; could be ':'
	BEQ	LoopAlways		; if :... loop forever

	SBC	#TK_UNTIL		; subtract token for UNTIL, we know carry is set here
	TAX				; copy to X (if it was UNTIL then Y will be correct)
	BEQ	DoRest		; branch if was UNTIL

	DEX				; decrement result
	BNE	LAB_16FC		; if not WHILE go do syntax error & warm start
					; only if the token was WHILE will this fail

	DEX				; set invert result byte
DoRest
	STX	Frnxth		; save invert result byte
	JSR	LAB_IGBY		; increment & scan memory
	JSR	LAB_EVEX		; evaluate expression
	LDA	FAC1_e		; get FAC1 exponent
	BEQ	DoCmp			; if =0 go do straight compare

	LDA	#$FF			; else set all bits
DoCmp
	TSX				; copy stack pointer
	EOR	Frnxth		; EOR with invert byte
	BNE	LoopDone		; if <> 0 clear stack & back to interpreter loop

					; loop condition wasn't met so do it again
LoopAlways
	LDA	LAB_STAK+2,X	; get current line low byte
	STA	Clinel		; save current line low byte
	LDA	LAB_STAK+3,X	; get current line high byte
	STA	Clineh		; save current line high byte
	LDA	LAB_STAK+4,X	; get BASIC execute pointer low byte
	STA	Bpntrl		; save BASIC execute pointer low byte
	LDA	LAB_STAK+5,X	; get BASIC execute pointer high byte
	STA	Bpntrh		; save BASIC execute pointer high byte
	JSR	LAB_GBYT		; scan memory
	JMP	LAB_15C2		; go do interpreter inner loop

					; clear stack & back to interpreter loop
LoopDone
	INX				; dump DO token
	INX				; dump current line low byte
	INX				; dump current line high byte
	INX				; dump BASIC execute pointer low byte
	INX				; dump BASIC execute pointer high byte
	TXS				; correct stack
	JMP	LAB_DATA		; go perform DATA (find : or [EOL])

; do the return without gosub error

LAB_16F4
	LDX	#$04			; error code $04 ("RETURN without GOSUB" error)
	.byte	$2C			; makes next line BIT LAB_0EA2

LAB_16F7				; do undefined statement error
	LDX	#$0E			; error code $0E ("Undefined statement" error)
	JMP	LAB_XERR		; do error #X, then warm start

; perform RETURN

LAB_RETURN
	BNE	LAB_16E5		; exit if following token (to allow syntax error)

LAB_16E8
	PLA				; dump calling routine return address
	PLA				; dump calling routine return address
	PLA				; pull token
	CMP	#TK_GOSUB		; compare with GOSUB token
	BNE	LAB_16F4		; branch if no matching GOSUB

LAB_16FF
	PLA				; pull current line low byte
	STA	Clinel		; save current line low byte
	PLA				; pull current line high byte
	STA	Clineh		; save current line high byte
	PLA				; pull BASIC execute pointer low byte
	STA	Bpntrl		; save BASIC execute pointer low byte
	PLA				; pull BASIC execute pointer high byte
	STA	Bpntrh		; save BASIC execute pointer high byte

					; now do the DATA statement as we could be returning into
					; the middle of an ON <var> GOSUB n,m,p,q line
					; (the return address used by the DATA statement is the one
					; pushed before the GOSUB was executed!)

; perform DATA

LAB_DATA
	JSR	LAB_SNBS		; scan for next BASIC statement ([:] or [EOL])

					; set BASIC execute pointer
LAB_170F
	TYA				; copy index to A
	CLC				; clear carry for add
	ADC	Bpntrl		; add BASIC execute pointer low byte
	STA	Bpntrl		; save BASIC execute pointer low byte
	BCC	LAB_1719		; skip next if no carry

	INC	Bpntrh		; else increment BASIC execute pointer high byte
LAB_1719
	RTS				;

LAB_16FC
	JMP	LAB_SNER		; do syntax error then warm start

; scan for next BASIC statement ([:] or [EOL])
; returns Y as index to [:] or [EOL]

LAB_SNBS
	LDX	#$3A			; set look for character = ":"
	.byte	$2C			; makes next line BIT $00A2

; scan for next BASIC line
; returns Y as index to [EOL]

LAB_SNBL
	LDX	#$00			; set alt search character = [EOL]
	LDY	#$00			; set search character = [EOL]
	STY	Asrch			; store search character
LAB_1725
	TXA				; get alt search character
	EOR	Asrch			; toggle search character, effectively swap with $00
	STA	Asrch			; save swapped search character
LAB_172D
	LDA	(Bpntrl),Y		; get next byte
	BEQ	LAB_1719		; exit if null [EOL]

	CMP	Asrch			; compare with search character
	BEQ	LAB_1719		; exit if found

	INY				; increment index
	CMP	#$22			; compare current character with open quote
	BNE	LAB_172D		; if not open quote go get next character

	BEQ	LAB_1725		; if found go swap search character for alt search character

; perform IF

LAB_IF
	JSR	LAB_EVEX		; evaluate expression
	JSR	LAB_GBYT		; scan memory
	CMP	#TK_GOTO		; compare with "GOTO" token
	BEQ	LAB_174B		; jump if was "GOTO"

					; wasn't IF ... GOTO so must be IF ... THEN
	LDA	#TK_THEN		; get THEN token
	JSR	LAB_SCCA		; scan for CHR$(A) , else do syntax error then warm start
LAB_174B
	LDA	FAC1_e		; get FAC1 exponent
	BNE	LAB_1754		; branch if result was non zero
					; else ....

; perform REM, skip (rest of) line

LAB_REM
	JSR	LAB_SNBL		; scan for next BASIC line
	BEQ	LAB_170F		; go set BASIC execute pointer & RET (always)

					; result was non zero so do rest of line
LAB_1754
	JSR	LAB_GBYT		; scan memory
	BCS	LAB_175C		; branch if not numeric character (is var or keyword)

	JMP	LAB_GOTO		; else do GOTO n (was numeric)

					; is var or keyword
LAB_175C
	JMP	LAB_15FF		; interpret BASIC code from (Bpntrl)

; perform ON

LAB_ON
	CMP	#TK_IRQ		; was it IRQ token ?
	BNE	LAB_NOIN		; if not go check NMI

	JMP	LAB_SIRQ		; else go set-up IRQ

LAB_NOIN
	CMP	#TK_NMI		; was it NMI token ?
	BNE	LAB_NONM		; if not go do normal ON command

	JMP	LAB_SNMI		; else go set-up NMI

LAB_NONM
	JSR	LAB_GTBY		; get byte parameter
	PHA				; push GOTO/GOSUB token
	CMP	#TK_GOSUB		; compare with GOSUB token
	BEQ	LAB_176B		; branch if GOSUB

	CMP	#TK_GOTO		; compare with GOTO token
LAB_1767
	BNE	LAB_16FC		; if not GOTO do syntax error then warm start


; next character was GOTO or GOSUB

LAB_176B
	DEC	FAC1_3		; decrement index (byte value)
	BNE	LAB_1773		; branch if not zero

	PLA				; pull GOTO/GOSUB token
	JMP	LAB_1602		; go execute it

LAB_1773
	JSR	LAB_IGBY		; increment & scan memory
	JSR	LAB_GFPN		; get fixed-point number into temp integer (skip this n)
					; (we could LDX #',' and JSR LAB_SNBL+2, then we
					; just BNE LAB_176B for the loop. should be quicker ...
					; no we can't, what if we meet a colon or [EOL]?)
	CMP	#$2C			; compare next character with ","
	BEQ	LAB_176B		; loop if ","

LAB_177E
	PLA				; else pull keyword token (run out of options)
					; also dump +/-1 pointer low byte
LAB_177F
	RTS				; and exit

; takes n * 106 + 11 cycles where n is the number of digits

; get fixed-point number into temp integer

LAB_GFPN
	LDX	#$00			; clear reg
	STX	Itempl		; clear temporary integer low byte
LAB_1785
	STX	Itemph		; save temporary integer high byte
	BCS	LAB_177F		; return if carry set, end of scan, character was
					; not 0-9

	CPX	#$19			; compare high byte with $19
	TAY				; ensure Zb = 0 if the branch is taken
	BCS	LAB_1767		; branch if >=, makes max line # 63999 because next
					; bit does *$0A, = 64000, compare at target will fail
					; and do syntax error

	SBC	#$2F			; subtract $30, $2F+carry, from byte
	TAY				; copy binary digit
	LDA	Itempl		; get temporary integer low byte
	ASL				; *2 low byte
	ROL	Itemph		; *2 high byte
	ASL				; *2 low byte
	ROL	Itemph		; *2 high byte, *4
	ADC	Itempl		; + low byte, *5
	STA	Itempl		; save it
	TXA				; get high byte copy to A
	ADC	Itemph		; + high byte, *5
	ASL	Itempl		; *2 low byte, *10d
	ROL				; *2 high byte, *10d
	TAX				; copy high byte back to X
	TYA