basic.asm

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

	STY	Sarryh		; save var mem end high byte
	STA	Earryl		; save array mem end low byte
	STY	Earryh		; save array mem end high byte
	JSR	LAB_161A		; perform RESTORE command

; flush stack & clear continue flag

LAB_1491
	LDX	#des_sk		; set descriptor stack pointer
	STX	next_s		; save descriptor stack pointer
	PLA				; pull return address low byte
	TAX				; copy return address low byte
	PLA				; pull return address high byte
	STX	LAB_01FE		; save to cleared stack
	STA	LAB_01FF		; save to cleared stack
	LDX	#$FD			; new stack pointer
	TXS				; reset stack
	LDA	#$00			; clear byte
	STA	Cpntrh		; clear continue pointer high byte
	STA	Sufnxf		; clear subscript/FNX flag
LAB_14A6
	RTS				;

; perform CLEAR

LAB_CLEAR
	BEQ	LAB_147A		; if no following token go do "CLEAR"

	RTS				; was following token (go do syntax error)

; perform LIST [n][-m]
; bigger, faster version (a _lot_ faster)

LAB_LIST
	BCC	LAB_14BD		; branch if next character numeric (LIST n...)

	BEQ	LAB_14BD		; branch if next character [NULL] (LIST)

	CMP	#TK_MINUS		; compare with token for -
	BNE	LAB_14A6		; exit if not - (LIST -m)

					; LIST [[n][-m]]
					; this bit sets the n , if present, as the start & end
LAB_14BD
	JSR	LAB_GFPN		; get fixed-point number into temp integer
	JSR	LAB_SSLN		; search BASIC for temp integer line number
					; (pointer in Baslnl/Baslnh)
	JSR	LAB_GBYT		; scan memory
	BEQ	LAB_14D4		; branch if no more characters

					; this bit checks the - is present
	CMP	#TK_MINUS		; compare with token for -
	BNE	LAB_1460		; return if not "-" (will be Syntax error)

					; LIST [n]-m
					; the - was there so set m as the end value
	JSR	LAB_IGBY		; increment & scan memory
	JSR	LAB_GFPN		; get fixed-point number into temp integer
	BNE	LAB_1460		; exit if not ok

LAB_14D4
	LDA	Itempl		; get temporary integer low byte
	ORA	Itemph		; OR temporary integer high byte
	BNE	LAB_14E2		; branch if start set

	LDA	#$FF			; set for -1
	STA	Itempl		; set temporary integer low byte
	STA	Itemph		; set temporary integer high byte
LAB_14E2
	LDY	#$01			; set index for line
	STY	Oquote		; clear open quote flag
	JSR	LAB_CRLF		; print CR/LF
	LDA	(Baslnl),Y		; get next line pointer high byte
					; pointer initially set by search at LAB_14BD
	BEQ	LAB_152B		; if null all done so exit
	JSR	LAB_1629		; do CRTL-C check vector

	INY				; increment index for line
	LDA	(Baslnl),Y		; get line # low byte
	TAX				; copy to X
	INY				; increment index
	LDA	(Baslnl),Y		; get line # high byte
	CMP	Itemph		; compare with temporary integer high byte
	BNE	LAB_14FF		; branch if no high byte match

	CPX	Itempl		; compare with temporary integer low byte
	BEQ	LAB_1501		; branch if = last line to do (< will pass next branch)

LAB_14FF				; else ...
	BCS	LAB_152B		; if greater all done so exit

LAB_1501
	STY	Tidx1			; save index for line
	JSR	LAB_295E		; print XA as unsigned integer
	LDA	#$20			; space is the next character
LAB_1508
	LDY	Tidx1			; get index for line
	AND	#$7F			; mask top out bit of character
LAB_150C
	JSR	LAB_PRNA		; go print the character
	CMP	#$22			; was it " character
	BNE	LAB_1519		; branch if not

					; we are either entering or leaving a pair of quotes
	LDA	Oquote		; get open quote flag
	EOR	#$FF			; toggle it
	STA	Oquote		; save it back
LAB_1519
	INY				; increment index
	LDA	(Baslnl),Y		; get next byte
	BNE	LAB_152E		; branch if not [EOL] (go print character)
	TAY				; else clear index
	LDA	(Baslnl),Y		; get next line pointer low byte
	TAX				; copy to X
	INY				; increment index
	LDA	(Baslnl),Y		; get next line pointer high byte
	STX	Baslnl		; set pointer to line low byte
	STA	Baslnh		; set pointer to line high byte
	BNE	LAB_14E2		; go do next line if not [EOT]
					; else ...
LAB_152B
	RTS

LAB_152E
	BPL	LAB_150C		; just go print it if not token byte

					; else was token byte so uncrunch it (maybe)
	BIT	Oquote		; test the open quote flag
	BMI	LAB_150C		; just go print character if open quote set

	LDX	#>LAB_KEYT		; get table address high byte
	ASL				; *2
	ASL				; *4
	BCC	LAB_152F		; branch if no carry

	INX				; else increment high byte
	CLC				; clear carry for add
LAB_152F
	ADC	#<LAB_KEYT		; add low byte
	BCC	LAB_1530		; branch if no carry

	INX				; else increment high byte
LAB_1530
	STA	ut2_pl		; save table pointer low byte
	STX	ut2_ph		; save table pointer high byte
	STY	Tidx1			; save index for line
	LDY	#$00			; clear index
	LDA	(ut2_pl),Y		; get length
	TAX				; copy length
	INY				; increment index
	LDA	(ut2_pl),Y		; get 1st character
	DEX				; decrement length
	BEQ	LAB_1508		; if no more characters exit & print

	JSR	LAB_PRNA		; go print the character
	INY				; increment index
	LDA	(ut2_pl),Y		; get keyword address low byte
	PHA				; save it for now
	INY				; increment index
	LDA	(ut2_pl),Y		; get keyword address high byte
	LDY	#$00
	STA	ut2_ph		; save keyword pointer high byte
	PLA				; pull low byte
	STA	ut2_pl		; save keyword pointer low byte
LAB_1540
	LDA	(ut2_pl),Y		; get character
	DEX				; decrement character count
	BEQ	LAB_1508		; if last character exit & print

	JSR	LAB_PRNA		; go print the character
	INY				; increment index
	BNE	LAB_1540		; loop for next character

; perform FOR

LAB_FOR
	LDA	#$80			; set FNX
	STA	Sufnxf		; set subscript/FNX flag
	JSR	LAB_LET		; go do LET
	PLA				; pull return address
	PLA				; pull return address
	LDA	#$10			; we need 16d bytes !
	JSR	LAB_1212		; check room on stack for A bytes
	JSR	LAB_SNBS		; scan for next BASIC statement ([:] or [EOL])
	CLC				; clear carry for add
	TYA				; copy index to A
	ADC	Bpntrl		; add BASIC execute pointer low byte
	PHA				; push onto stack
	LDA	Bpntrh		; get BASIC execute pointer high byte
	ADC	#$00			; add carry
	PHA				; push onto stack
	LDA	Clineh		; get current line high byte
	PHA				; push onto stack
	LDA	Clinel		; get current line low byte
	PHA				; push onto stack
	LDA	#TK_TO		; get "TO" token
	JSR	LAB_SCCA		; scan for CHR$(A) , else do syntax error then warm start
	JSR	LAB_CTNM		; check if source is numeric, else do type mismatch
	JSR	LAB_EVNM		; evaluate expression & check is numeric,
					; else do type mismatch
	LDA	FAC1_s		; get FAC1 sign (b7)
	ORA	#$7F			; set all non sign bits
	AND	FAC1_1		; and FAC1 mantissa1
	STA	FAC1_1		; save FAC1 mantissa1
	LDA	#<LAB_159F		; set return address low byte
	LDY	#>LAB_159F		; set return address high byte
	STA	ut1_pl		; save return address low byte
	STY	ut1_ph		; save return address high byte
	JMP	LAB_1B66		; round FAC1 & put on stack (returns to next instruction)

LAB_159F
	LDA	#<LAB_259C		; set 1 pointer low addr (default step size)
	LDY	#>LAB_259C		; set 1 pointer high addr
	JSR	LAB_UFAC		; unpack memory (AY) into FAC1
	JSR	LAB_GBYT		; scan memory
	CMP	#TK_STEP		; compare with STEP token
	BNE	LAB_15B3		; jump if not "STEP"

					;.was step so ....
	JSR	LAB_IGBY		; increment & scan memory
	JSR	LAB_EVNM		; evaluate expression & check is numeric,
					; else do type mismatch
LAB_15B3
	JSR	LAB_27CA		; return A=FF,C=1/-ve A=01,C=0/+ve
	STA	FAC1_s		; set FAC1 sign (b7)
					; this is +1 for +ve step and -1 for -ve step, in NEXT we
					; compare the FOR value and the TO value and return +1 if
					; FOR > TO, 0 if FOR = TO and -1 if FOR < TO. the value
					; here (+/-1) is then compared to that result and if they
					; are the same (+ve and FOR > TO or -ve and FOR < TO) then
					; the loop is done
	JSR	LAB_1B5B		; push sign, round FAC1 & put on stack
	LDA	Frnxth		; get var pointer for FOR/NEXT high byte
	PHA				; push on stack
	LDA	Frnxtl		; get var pointer for FOR/NEXT low byte
	PHA				; push on stack
	LDA	#TK_FOR		; get FOR token
	PHA				; push on stack

; interpreter inner loop

LAB_15C2
	JSR	LAB_1629		; do CRTL-C check vector
	LDA	Bpntrl		; get BASIC execute pointer low byte
	LDY	Bpntrh		; get BASIC execute pointer high byte

	LDX	Clineh		; continue line is $FFxx for immediate mode
					; ($00xx for RUN from immediate mode)
	INX				; increment it (now $00 if immediate mode)
	BEQ	LAB_15D1		; branch if null (immediate mode)

	STA	Cpntrl		; save continue pointer low byte
	STY	Cpntrh		; save continue pointer high byte
LAB_15D1
	LDY	#$00			; clear index
	LDA	(Bpntrl),Y		; get next byte
	BEQ	LAB_15DC		; branch if null [EOL]

	CMP	#$3A			; compare with ":"
	BEQ	LAB_15F6		; branch if = (statement separator)

LAB_15D9
	JMP	LAB_SNER		; else syntax error then warm start

					; have reached [EOL]
LAB_15DC
	LDY	#$02			; set index
	LDA	(Bpntrl),Y		; get next line pointer high byte
	CLC				; clear carry for no "BREAK" message
	BEQ	LAB_1651		; if null go to immediate mode (was immediate or [EOT]
					; marker)

	INY				; increment index
	LDA	(Bpntrl),Y		; get line # low byte
	STA	Clinel		; save current line low byte
	INY				; increment index
	LDA	(Bpntrl),Y		; get line # high byte
	STA	Clineh		; save current line high byte
	TYA				; A now = 4
	ADC	Bpntrl		; add BASIC execute pointer low byte
	STA	Bpntrl		; save BASIC execute pointer low byte
	BCC	LAB_15F6		; branch if no overflow

	INC	Bpntrh		; else increment BASIC execute pointer high byte
LAB_15F6
	JSR	LAB_IGBY		; increment & scan memory

LAB_15F9
	JSR	LAB_15FF		; go interpret BASIC code from (Bpntrl)

LAB_15FC
	JMP	LAB_15C2		; loop

; interpret BASIC code from (Bpntrl)

LAB_15FF
	BEQ	LAB_1628		; exit if zero [EOL]

LAB_1602
	ASL				; *2 bytes per vector & normalise token
	BCS	LAB_1609		; branch if was token

	JMP	LAB_LET		; else go do implied LET

LAB_1609
	CMP	#[TK_TAB-$80]*2	; compare normalised token * 2 with TAB
	BCS	LAB_15D9		; branch if A>=TAB (do syntax error then warm start)
					; only tokens before TAB can start a line
	TAY				; copy to index
	LDA	LAB_CTBL+1,Y	; get vector high byte
	PHA				; onto stack
	LDA	LAB_CTBL,Y		; get vector low byte
	PHA				; onto stack
	JMP	LAB_IGBY		; jump to increment & scan memory
					; then "return" to vector

; CTRL-C check jump. this is called as a subroutine but exits back via a jump if a
; key press is detected.

LAB_1629
	JMP	(VEC_CC)		; ctrl c check vector

; if there was a key press it gets back here .....

LAB_1636
	CMP	#$03			; compare with CTRL-C

; perform STOP

LAB_STOP
	BCS	LAB_163B		; branch if token follows STOP
					; else just END
; END

LAB_END
	CLC				; clear carry (indicate program end)
LAB_163B
	BNE	LAB_167A		; return if wasn't CTRL-C

	LDA	Bpntrh		; get BASIC execute pointer high byte
	EOR	#>Ibuffs		; compare with buffer address high byte (Cb unchanged)
	BEQ	LAB_164F		; branch if BASIC pointer is in buffer
					; (can't continue in immediate mode)

					; else...
	EOR	#>Ibuffs		; correct the bits
	LDY	Bpntrl		; get BASIC execute pointer low byte
	STY	Cpntrl		; save continue pointer low byte
	STA	Cpntrh		; save continue pointer high byte
LAB_1647
	LDA	Clinel		; get current line low byte
	LDY	Clineh		; get current line high byte
	STA	Blinel		; save break line low byte
	STY	Blineh		; save break line high byte
LAB_164F
	PLA				; pull return address low
	PLA				; pull return address high
LAB_1651
	BCC	LAB_165E		; jump if was program end

	LDA	#<LAB_BMSG		; point to "Break" (low byte)
	LDY	#>LAB_BMSG		; point to "Break" (high byte)
	JMP	LAB_1269		; print "Break" and do warm start

LAB_165E
	JMP	LAB_1274		; go do warm start

; perform RESTORE

LAB_RESTORE
	BNE	LAB_RESTOREn	; branch if next character not null (RESTORE n)

LAB_161A
	SEC				; set carry for subtract
	LDA	Smeml			; get start of mem low byte
	SBC	#$01			; -1
	LDY	Smemh			; get start of mem high byte
	BCS	LAB_1624		; branch if no underflow

LAB_uflow
	DEY				; else decrement high byte
LAB_1624
	STA	Dptrl			; save DATA pointer low byte
	STY	Dptrh			; save DATA pointer high byte
LAB_1628
	RTS				;

					; is RESTORE n
LAB_RESTOREn
	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_reset_search	; 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_go_search	; branch if no overflow to high byte

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

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

LAB_reset_search
	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_go_search