Kilian/6502PC
1
0 Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Restructure ROM

Browse Source 
Include WOZMON
This commit is contained in:
Kilian committed 2026-09-27 19:34:27 +02:00
1 parent a5e30a7b28
commit 385de7a111
83 files changed
+180 -2754
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

rom/.gitignore
+1
View File
@@ -0,0 +1 @@
tmp/
rom/array.s
+413
View File
@@ -0,0 +1,413 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; COMPUTE ADDRESS OF FIRST VALUE IN ARRAY
; ARYPNT = (LOWTR) + #DIMS*2 + 5
; ----------------------------------------------------------------------------
GETARY:
lda EOLPNTR
asl a
adc #$05
adc LOWTR
ldy LOWTR+1
bcc L2FAF
iny
L2FAF:
sta HIGHDS
sty HIGHDS+1
rts
; ----------------------------------------------------------------------------
NEG32768:
.byte $90,$80,$00,$00
.ifdef CONFIG_2C
.byte $00; bugfix: short number
.endif
; ----------------------------------------------------------------------------
; EVALUATE NUMERIC FORMULA AT TXTPTR
; CONVERTING RESULT TO INTEGER 0 <= X <= 32767
; IN FAC+3,4
; ----------------------------------------------------------------------------
MAKINT:
jsr CHRGET
.ifdef CONFIG_2
jsr FRMEVL
.else
jsr FRMNUM
.endif
; ----------------------------------------------------------------------------
; CONVERT FAC TO INTEGER
; MUST BE POSITIVE AND LESS THAN 32768
; ----------------------------------------------------------------------------
MKINT:
.ifdef CONFIG_2
jsr CHKNUM
.endif
lda FACSIGN
bmi MI1
; ----------------------------------------------------------------------------
; CONVERT FAC TO INTEGER
; MUST BE -32767 <= FAC <= 32767
; ----------------------------------------------------------------------------
AYINT:
lda FAC
cmp #$90
bcc MI2
lda #<NEG32768
ldy #>NEG32768
jsr FCOMP
MI1:
bne IQERR
MI2:
jmp QINT
; ----------------------------------------------------------------------------
; LOCATE ARRAY ELEMENT OR CREATE AN ARRAY
; ----------------------------------------------------------------------------
ARRAY:
lda DIMFLG
.ifndef CONFIG_SMALL
ora VALTYP+1
.endif
pha
lda VALTYP
pha
ldy #$00
L2FDE:
tya
pha
lda VARNAM+1
pha
lda VARNAM
pha
jsr MAKINT
pla
sta VARNAM
pla
sta VARNAM+1
pla
tay
tsx
lda STACK+2,x
pha
lda STACK+1,x
pha
lda FAC_LAST-1
sta STACK+2,x
lda FAC_LAST
sta STACK+1,x
iny
jsr CHRGOT
cmp #$2C
beq L2FDE
sty EOLPNTR
jsr CHKCLS
pla
sta VALTYP
pla
.ifndef CONFIG_SMALL
sta VALTYP+1
and #$7F
.endif
sta DIMFLG
; ----------------------------------------------------------------------------
; SEARCH ARRAY TABLE FOR THIS ARRAY NAME
; ----------------------------------------------------------------------------
ldx ARYTAB
lda ARYTAB+1
L301F:
stx LOWTR
sta LOWTR+1
cmp STREND+1
bne L302B
cpx STREND
beq MAKE_NEW_ARRAY
L302B:
ldy #$00
lda (LOWTR),y
iny
cmp VARNAM
bne L303A
lda VARNAM+1
cmp (LOWTR),y
beq USE_OLD_ARRAY
L303A:
iny
lda (LOWTR),y
clc
adc LOWTR
tax
iny
lda (LOWTR),y
adc LOWTR+1
bcc L301F
; ----------------------------------------------------------------------------
; ERROR: BAD SUBSCRIPTS
; ----------------------------------------------------------------------------
SUBERR:
ldx #ERR_BADSUBS
.byte $2C
; ----------------------------------------------------------------------------
; ERROR: ILLEGAL QUANTITY
; ----------------------------------------------------------------------------
IQERR:
ldx #ERR_ILLQTY
JER:
jmp ERROR
; ----------------------------------------------------------------------------
; FOUND THE ARRAY
; ----------------------------------------------------------------------------
USE_OLD_ARRAY:
ldx #ERR_REDIMD
lda DIMFLG
bne JER
jsr GETARY
lda EOLPNTR
ldy #$04
cmp (LOWTR),y
bne SUBERR
jmp FIND_ARRAY_ELEMENT
; ----------------------------------------------------------------------------
; CREATE A NEW ARRAY, UNLESS CALLED FROM GETARYPT
; ----------------------------------------------------------------------------
MAKE_NEW_ARRAY:
jsr GETARY
jsr REASON
lda #$00
tay
sta STRNG2+1
ldx #BYTES_PER_ELEMENT
.if .def(CONFIG_SMALL) && (!.def(CONFIG_2))
stx STRNG2
.endif
lda VARNAM
sta (LOWTR),y
.ifndef CONFIG_SMALL
bpl L3078
dex
L3078:
.endif
iny
lda VARNAM+1
sta (LOWTR),y
.if (!.def(CONFIG_SMALL)) || .def(CONFIG_2)
bpl L3081
dex
.if !(.def(CONFIG_SMALL) && .def(CONFIG_2))
dex
.endif
L3081:
stx STRNG2
.endif
lda EOLPNTR
iny
iny
iny
sta (LOWTR),y
L308A:
ldx #$0B
lda #$00
bit DIMFLG
bvc L309A
pla
clc
adc #$01
tax
pla
adc #$00
L309A:
iny
sta (LOWTR),y
iny
txa
sta (LOWTR),y
jsr MULTIPLY_SUBSCRIPT
stx STRNG2
sta STRNG2+1
ldy INDEX
dec EOLPNTR
bne L308A
adc HIGHDS+1
bcs GME
sta HIGHDS+1
tay
txa
adc HIGHDS
bcc L30BD
iny
beq GME
L30BD:
jsr REASON
sta STREND
sty STREND+1
lda #$00
inc STRNG2+1
ldy STRNG2
beq L30D1
L30CC:
dey
sta (HIGHDS),y
bne L30CC
L30D1:
dec HIGHDS+1
dec STRNG2+1
bne L30CC
inc HIGHDS+1
sec
lda STREND
sbc LOWTR
ldy #$02
sta (LOWTR),y
lda STREND+1
iny
sbc LOWTR+1
sta (LOWTR),y
lda DIMFLG
bne RTS9
iny
; ----------------------------------------------------------------------------
; FIND SPECIFIED ARRAY ELEMENT
;
; (LOWTR),Y POINTS AT # OF DIMS IN ARRAY DESCRIPTOR
; THE SUBSCRIPTS ARE ALL ON THE STACK AS INTEGERS
; ----------------------------------------------------------------------------
FIND_ARRAY_ELEMENT:
lda (LOWTR),y
sta EOLPNTR
lda #$00
sta STRNG2
L30F6:
sta STRNG2+1
iny
pla
tax
sta FAC_LAST-1
pla
sta FAC_LAST
cmp (LOWTR),y
bcc FAE2
bne GSE
iny
txa
cmp (LOWTR),y
bcc FAE3
; ----------------------------------------------------------------------------
GSE:
jmp SUBERR
GME:
jmp MEMERR
; ----------------------------------------------------------------------------
FAE2:
iny
FAE3:
lda STRNG2+1
ora STRNG2
clc
beq L3124
jsr MULTIPLY_SUBSCRIPT
txa
adc FAC_LAST-1
tax
tya
ldy INDEX
L3124:
adc FAC_LAST
stx STRNG2
dec EOLPNTR
bne L30F6
.if .def(CONFIG_SMALL) && (!.def(CONFIG_2))
asl STRNG2
rol a
bcs GSE
asl STRNG2
rol a
bcs GSE
tay
lda STRNG2
.else
.ifdef CONFIG_11A
sta STRNG2+1
.endif
ldx #BYTES_FP
.ifdef CONFIG_SMALL
lda VARNAM+1
.else
lda VARNAM
.endif
bpl L3135
dex
L3135:
.ifdef CONFIG_SMALL
stx RESULT+1
.else
lda VARNAM+1
bpl L313B
dex
dex
L313B:
stx RESULT+2
.endif
lda #$00
jsr MULTIPLY_SUBS1
txa
.endif
adc HIGHDS
sta VARPNT
tya
adc HIGHDS+1
sta VARPNT+1
tay
lda VARPNT
RTS9:
rts
; ----------------------------------------------------------------------------
; MULTIPLY (STRNG2) BY ((LOWTR),Y)
; LEAVING PRODUCT IN A,X. (HI-BYTE ALSO IN Y.)
; USED ONLY BY ARRAY SUBSCRIPT ROUTINES
; ----------------------------------------------------------------------------
MULTIPLY_SUBSCRIPT:
sty INDEX
lda (LOWTR),y
sta RESULT_LAST-2
dey
lda (LOWTR),y
MULTIPLY_SUBS1:
sta RESULT_LAST-1
lda #$10
sta INDX
ldx #$00
ldy #$00
L3163:
txa
asl a
tax
tya
rol a
tay
bcs GME
asl STRNG2
rol STRNG2+1
bcc L317C
clc
txa
adc RESULT_LAST-2
tax
tya
adc RESULT_LAST-1
tay
bcs GME
L317C:
dec INDX
bne L3163
rts
rom/build.sh
+6
View File
@@ -0,0 +1,6 @@
if [ ! -d tmp ]; then
mkdir tmp
fi
ca65 -D kilian msbasic.s -o tmp/kilian.o
ld65 -C kilian.cfg tmp/kilian.o -o tmp/kilian.bin -Ln tmp/kilian.lbl
rom/chrget.s
+23
View File
@@ -0,0 +1,23 @@
.segment "CHRGET"
RAMSTART1:
GENERIC_CHRGET:
inc TXTPTR
bne GENERIC_CHRGOT
inc TXTPTR+1
GENERIC_CHRGOT:
GENERIC_TXTPTR = GENERIC_CHRGOT + 1
lda $EA60
.ifdef KBD
jsr LF430
.endif
cmp #$3A
bcs L4058
GENERIC_CHRGOT2:
cmp #$20
beq GENERIC_CHRGET
sec
sbc #$30
sec
sbc #$D0
L4058:
rts
rom/defines.s
+99
View File
@@ -0,0 +1,99 @@
.if .def(cbmbasic1)
CBM1 := 1
.include "defines_cbm1.s"
.elseif .def(osi)
OSI := 1
.include "defines_osi.s"
.elseif .def(applesoft)
APPLE := 1
.include "defines_apple.s"
.elseif .def(kb9)
KIM := 1
.include "defines_kim.s"
.elseif .def(cbmbasic2)
CBM2 := 1
.include "defines_cbm2.s"
.elseif .def(kbdbasic)
KBD := 1
.include "defines_kbd.s"
.elseif .def(microtan)
MICROTAN := 1
.include "defines_microtan.s"
.elseif .def(aim65)
AIM65 := 1
.include "defines_aim65.s"
.elseif .def(sym1)
SYM1 := 1
.include "defines_sym1.s"
.elseif .def(w65c816sxb)
W65C816SXB := 1
.include "defines_w65c816sxb.s"
.elseif .def(kilian)
KILIAN := 1
.include "defines_kilian.s"
.endif
.ifdef CONFIG_2C
CONFIG_2B := 1
.endif
.ifdef CONFIG_2B
CONFIG_2A := 1
.endif
.ifdef CONFIG_2A
CONFIG_2 := 1
.endif
.ifdef CONFIG_2
CONFIG_11A := 1
.endif
.ifdef CONFIG_11A
CONFIG_11 := 1
.endif
.ifdef CONFIG_11
CONFIG_10A := 1
.endif
.ifdef CONFIG_SMALL
BYTES_FP := 4
CONFIG_SMALL_ERROR := 1
.else
BYTES_FP := 5
.endif
.ifndef BYTES_PER_ELEMENT
BYTES_PER_ELEMENT := BYTES_FP
.endif
BYTES_PER_VARIABLE := BYTES_FP+2
MANTISSA_BYTES := BYTES_FP-1
BYTES_PER_FRAME := 2*BYTES_FP+8
FOR_STACK1 := 2*BYTES_FP+5
FOR_STACK2 := BYTES_FP+4
.ifndef MAX_EXPON
MAX_EXPON = 10
.endif
STACK := $0100
.ifndef STACK2
STACK2 := STACK
.endif
.ifdef INPUTBUFFER
.if INPUTBUFFER >= $0100
CONFIG_NO_INPUTBUFFER_ZP := 1
.endif
.if INPUTBUFFER = $0200
CONFIG_INPUTBUFFER_0200 := 1
.endif
.endif
INPUTBUFFERX = INPUTBUFFER & $FF00
CR=13
LF=10
.ifndef CRLF_1
CRLF_1 := CR
CRLF_2 := LF
.endif
rom/defines_kilian.s
+27
View File
@@ -0,0 +1,27 @@
; configuration
CONFIG_2A := 1
CONFIG_DATAFLG := 1
CONFIG_EASTER_EGG := 1
CONFIG_NO_READ_Y_IS_ZERO_HACK := 1
CONFIG_PEEK_SAVE_LINNUM := 1
CONFIG_SCRTCH_ORDER := 2
; zero page -- CBM BASIC V2 layout
ZP_START1 = $02
ZP_START2 = $0C
ZP_START3 = $12
ZP_START4 = $1D
; input buffer
INPUTBUFFER := $0200
; extra/override ZP variables
USR := GORESTART ; XXX
; constants
SPACE_FOR_GOSUB := $3E
STACK_TOP := $FA
WIDTH := 80
WIDTH2 := 30
RAMSTART2 := $0400
rom/error.s
+49
View File
@@ -0,0 +1,49 @@
init_error_table
.ifdef CONFIG_SMALL_ERROR
define_error ERR_NOFOR, "NF"
define_error ERR_SYNTAX, "SN"
define_error ERR_NOGOSUB, "RG"
define_error ERR_NODATA, "OD"
define_error ERR_ILLQTY, "FC"
define_error ERR_OVERFLOW, "OV"
define_error ERR_MEMFULL, "OM"
define_error ERR_UNDEFSTAT, "US"
define_error ERR_BADSUBS, "BS"
define_error ERR_REDIMD, "DD"
define_error ERR_ZERODIV, "/0"
define_error ERR_ILLDIR, "ID"
define_error ERR_BADTYPE, "TM"
define_error ERR_STRLONG, "LS"
define_error ERR_FRMCPX, "ST"
define_error ERR_CANTCONT, "CN"
define_error ERR_UNDEFFN, "UF"
.else
define_error ERR_NOFOR, "NEXT WITHOUT FOR"
define_error ERR_SYNTAX, "SYNTAX"
define_error ERR_NOGOSUB, "RETURN WITHOUT GOSUB"
define_error ERR_NODATA, "OUT OF DATA"
define_error ERR_ILLQTY, "ILLEGAL QUANTITY"
.ifdef CBM1
.byte 0,0,0,0,0
.endif
define_error ERR_OVERFLOW, "OVERFLOW"
define_error ERR_MEMFULL, "OUT OF MEMORY"
define_error ERR_UNDEFSTAT, "UNDEF'D STATEMENT"
define_error ERR_BADSUBS, "BAD SUBSCRIPT"
define_error ERR_REDIMD, "REDIM'D ARRAY"
define_error ERR_ZERODIV, "DIVISION BY ZERO"
define_error ERR_ILLDIR, "ILLEGAL DIRECT"
define_error ERR_BADTYPE, "TYPE MISMATCH"
define_error ERR_STRLONG, "STRING TOO LONG"
.ifdef CONFIG_FILE
.ifdef CBM1
define_error ERR_BADDATA, "BAD DATA"
.else
define_error ERR_BADDATA, "FILE DATA"
.endif
.endif
define_error ERR_FRMCPX, "FORMULA TOO COMPLEX"
define_error ERR_CANTCONT, "CAN'T CONTINUE"
define_error ERR_UNDEFFN, "UNDEF'D FUNCTION"
.endif
rom/eval.s
+788
View File
@@ -0,0 +1,788 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "NEXT" STATEMENT
; ----------------------------------------------------------------------------
NEXT:
bne NEXT1
ldy #$00
beq NEXT2
NEXT1:
jsr PTRGET
NEXT2:
sta FORPNT
sty FORPNT+1
jsr GTFORPNT
beq NEXT3
ldx #$00
GERR:
beq JERROR
NEXT3:
txs
.ifndef CONFIG_2
inx
inx
inx
inx
.endif
txa
.ifdef CONFIG_2
clc
adc #$04
pha
adc #BYTES_FP+1
sta DEST
pla
.else
inx
inx
inx
inx
inx
.ifndef CONFIG_SMALL
inx
.endif
stx DEST
.endif
ldy #>STACK
jsr LOAD_FAC_FROM_YA
tsx
lda STACK+BYTES_FP+4,x
sta FACSIGN
lda FORPNT
ldy FORPNT+1
jsr FADD
jsr SETFOR
ldy #>STACK
jsr FCOMP2
tsx
sec
sbc STACK+BYTES_FP+4,x
beq L2C22
lda STACK+2*BYTES_FP+5,x
sta CURLIN
lda STACK+2*BYTES_FP+6,x
sta CURLIN+1
lda STACK+2*BYTES_FP+8,x
sta TXTPTR
lda STACK+2*BYTES_FP+7,x
sta TXTPTR+1
L2C1F:
jmp NEWSTT
L2C22:
txa
adc #2*BYTES_FP+7
tax
txs
jsr CHRGOT
cmp #$2C
bne L2C1F
jsr CHRGET
jsr NEXT1
; ----------------------------------------------------------------------------
; EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC
; ----------------------------------------------------------------------------
FRMNUM:
jsr FRMEVL
; ----------------------------------------------------------------------------
; MAKE SURE (FAC) IS NUMERIC
; ----------------------------------------------------------------------------
CHKNUM:
clc
.byte $24
; ----------------------------------------------------------------------------
; MAKE SURE (FAC) IS STRING
; ----------------------------------------------------------------------------
CHKSTR:
sec
; ----------------------------------------------------------------------------
; MAKE SURE (FAC) IS CORRECT TYPE
; IF C=0, TYPE MUST BE NUMERIC
; IF C=1, TYPE MUST BE STRING
; ----------------------------------------------------------------------------
CHKVAL:
bit VALTYP
bmi L2C41
bcs L2C43
L2C40:
rts
L2C41:
bcs L2C40
L2C43:
ldx #ERR_BADTYPE
JERROR:
jmp ERROR
; ----------------------------------------------------------------------------
; EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE
; RESULT IN FAC. WORKS FOR BOTH STRING AND NUMERIC
; EXPRESSIONS.
; ----------------------------------------------------------------------------
FRMEVL:
ldx TXTPTR
bne L2C4E
dec TXTPTR+1
L2C4E:
dec TXTPTR
ldx #$00
.byte $24
FRMEVL1:
pha
txa
pha
lda #$01
jsr CHKMEM
jsr FRM_ELEMENT
lda #$00
sta CPRTYP
FRMEVL2:
jsr CHRGOT
L2C65:
sec
sbc #TOKEN_GREATER
bcc L2C81
cmp #$03
bcs L2C81
cmp #$01
rol a
eor #$01
eor CPRTYP
cmp CPRTYP
bcc SNTXERR
sta CPRTYP
jsr CHRGET
jmp L2C65
L2C81:
ldx CPRTYP
bne FRM_RELATIONAL
bcs L2D02
adc #$07
bcc L2D02
adc VALTYP
bne L2C92
jmp CAT
L2C92:
adc #$FF
sta INDEX
asl a
adc INDEX
tay
FRM_PRECEDENCE_TEST:
pla
cmp MATHTBL,y
bcs FRM_PERFORM1
jsr CHKNUM
L2CA3:
pha
L2CA4:
jsr FRM_RECURSE
pla
ldy LASTOP
bpl PREFNC
tax
beq GOEX
bne FRM_PERFORM2
; ----------------------------------------------------------------------------
; FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
; ----------------------------------------------------------------------------
FRM_RELATIONAL:
lsr VALTYP
txa
rol a
ldx TXTPTR
bne L2CBB
dec TXTPTR+1
L2CBB:
dec TXTPTR
ldy #$1B
sta CPRTYP
bne FRM_PRECEDENCE_TEST
PREFNC:
cmp MATHTBL,y
bcs FRM_PERFORM2
bcc L2CA3
; ----------------------------------------------------------------------------
; STACK THIS OPERATION AND CALL FRMEVL FOR
; ANOTHER ONE
; ----------------------------------------------------------------------------
FRM_RECURSE:
lda MATHTBL+2,y
pha
lda MATHTBL+1,y
pha
jsr FRM_STACK1
lda CPRTYP
jmp FRMEVL1
SNTXERR:
jmp SYNERR
; ----------------------------------------------------------------------------
; STACK (FAC)
; THREE ENTRY POINTS:
; 1, FROM FRMEVL
; 2, FROM "STEP"
; 3, FROM "FOR"
; ----------------------------------------------------------------------------
FRM_STACK1:
lda FACSIGN
ldx MATHTBL,y
; ----------------------------------------------------------------------------
; ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE
; ----------------------------------------------------------------------------
FRM_STACK2:
tay
pla
sta INDEX
.ifndef CONFIG_2B
inc INDEX ; bug: assumes not on page boundary
; bug exists on AppleSoft II
.endif
pla
sta INDEX+1
.ifdef CONFIG_2B
inc INDEX
bne LEB69
inc INDEX+1
LEB69:
.endif
tya
pha
; ----------------------------------------------------------------------------
; ENTER HERE FROM "FOR", WITH (INDEX) = STEP,
; TO PUSH INITIAL VALUE OF "FOR" VARIABLE
; ----------------------------------------------------------------------------
FRM_STACK3:
jsr ROUND_FAC
.ifndef CONFIG_SMALL
lda FAC+4
pha
.endif
lda FAC+3
pha
lda FAC+2
pha
lda FAC+1
pha
lda FAC
pha
jmp (INDEX)
L2D02:
ldy #$FF
pla
GOEX:
beq EXIT
; ----------------------------------------------------------------------------
; PERFORM STACKED OPERATION
;
; (A) = PRECEDENCE BYTE
; STACK: 1 -- CPRMASK
; 5 -- (ARG)
; 2 -- ADDR OF PERFORMER
; ----------------------------------------------------------------------------
FRM_PERFORM1:
cmp #$64
beq L2D0E
jsr CHKNUM
L2D0E:
sty LASTOP
FRM_PERFORM2:
pla
lsr a
sta CPRMASK
pla
sta ARG
pla
sta ARG+1
pla
sta ARG+2
pla
sta ARG+3
pla
.ifndef CONFIG_SMALL
sta ARG+4
pla
.endif
sta ARGSIGN
eor FACSIGN
sta SGNCPR
EXIT:
lda FAC
rts
; ----------------------------------------------------------------------------
; GET ELEMENT IN EXPRESSION
;
; GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT
; TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC.
; ----------------------------------------------------------------------------
FRM_ELEMENT:
lda #$00
sta VALTYP
L2D31:
jsr CHRGET
bcs L2D39
L2D36:
jmp FIN
L2D39:
jsr ISLETC
bcs FRM_VARIABLE
.ifdef CONFIG_CBM_ALL
cmp #$FF
bne LCDC1
lda #<CON_PI
ldy #>CON_PI
jsr LOAD_FAC_FROM_YA
jmp CHRGET
CON_PI:
.byte $82,$49,$0f,$DA,$A1
LCDC1:
.endif
cmp #$2E
beq L2D36
cmp #TOKEN_MINUS
beq MIN
cmp #TOKEN_PLUS
beq L2D31
cmp #$22
bne NOT_
; ----------------------------------------------------------------------------
; STRING CONSTANT ELEMENT
;
; SET Y,A = (TXTPTR)+CARRY
; ----------------------------------------------------------------------------
STRTXT:
lda TXTPTR
ldy TXTPTR+1
adc #$00
bcc L2D57
iny
L2D57:
jsr STRLIT
jmp POINT
; ----------------------------------------------------------------------------
; "NOT" FUNCTION
; IF FAC=0, RETURN FAC=1
; IF FAC<>0, RETURN FAC=0
; ----------------------------------------------------------------------------
NOT_:
cmp #TOKEN_NOT
bne L2D74
ldy #$18
bne EQUL
; ----------------------------------------------------------------------------
; COMPARISON FOR EQUALITY (= OPERATOR)
; ALSO USED TO EVALUATE "NOT" FUNCTION
; ----------------------------------------------------------------------------
EQUOP:
jsr AYINT
lda FAC_LAST
eor #$FF
tay
lda FAC_LAST-1
eor #$FF
jmp GIVAYF
L2D74:
.ifdef SYM1
cmp #TOKEN_USR
bne LCC8A
jmp LCDBD
LCC8A:
cmp #$26
bne LCC91
jmp LCDFE
LCC91:
.endif
cmp #TOKEN_FN
bne L2D7B
jmp L31F3
L2D7B:
cmp #TOKEN_SGN
bcc PARCHK
jmp UNARY
; ----------------------------------------------------------------------------
; EVALUATE "(EXPRESSION)"
; ----------------------------------------------------------------------------
PARCHK:
jsr CHKOPN
jsr FRMEVL
CHKCLS:
lda #$29
.byte $2C
CHKOPN:
lda #$28
.byte $2C
CHKCOM:
lda #$2C
; ----------------------------------------------------------------------------
; UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR
; ----------------------------------------------------------------------------
SYNCHR: ; XXX all CBM code calls SYNCHR instead of CHKCOM
ldy #$00
cmp (TXTPTR),y
bne SYNERR
jmp CHRGET
; ----------------------------------------------------------------------------
SYNERR:
ldx #ERR_SYNTAX
jmp ERROR
; ----------------------------------------------------------------------------
MIN:
ldy #$15
EQUL:
pla
pla
jmp L2CA4
; ----------------------------------------------------------------------------
FRM_VARIABLE:
jsr PTRGET
FRM_VARIABLE_CALL = *-1
sta FAC_LAST-1
sty FAC_LAST
.ifdef CONFIG_CBM_ALL
lda VARNAM
ldy VARNAM+1
.endif
ldx VALTYP
beq L2DB1
.ifdef CONFIG_CBM_ALL
.ifdef CONFIG_CBM1_PATCHES
jmp PATCH2
clc
LCE3B:
.else
ldx #$00
stx STRNG1+1
bit FAC+4
bpl LCE53
cmp #$54 ; T
bne LCE53
.endif
cpy #$C9 ; I$
bne LCE53
jsr LCE76
sty EXPON
dey
sty STRNG2
ldy #$06
sty INDX
ldy #$24
jsr LDD3A
jmp LD353
LCE53:
.endif
.ifdef CONFIG_2
.ifndef CBM2
; bugfix?
; fixed on AppleSoft II, not on any CBM
ldx #$00
stx STRNG1+1
.endif
.endif
rts
L2DB1:
.ifndef CONFIG_SMALL
ldx VALTYP+1
bpl L2DC2
ldy #$00
lda (FAC+3),y
tax
iny
lda (FAC+3),y
tay
txa
jmp GIVAYF
L2DC2:
.endif
.ifdef CONFIG_CBM1_PATCHES
jmp PATCH3
.byte $19
.endif
.ifdef CBM2
bit FAC+4
bpl LCE90
cmp #$54
bne LCE82
.endif
.ifndef CONFIG_CBM_ALL
jmp LOAD_FAC_FROM_YA
.endif
.ifdef CONFIG_CBM_ALL
LCE69:
cpy #$49
.ifdef CBM1
bne LCE82
.else
bne LCE90
.endif
jsr LCE76
tya
ldx #$A0
jmp LDB21
LCE76:
.ifdef CBM1
lda #$FE
ldy #$01
.else
lda #$8B
ldy #$00
.endif
sei
jsr LOAD_FAC_FROM_YA
cli
sty FAC+1
rts
LCE82:
cmp #$53
bne LCE90
cpy #$54
bne LCE90
lda Z96
jmp FLOAT
LCE90:
lda FAC+3
ldy FAC+4
jmp LOAD_FAC_FROM_YA
.endif
; ----------------------------------------------------------------------------
UNARY:
asl a
pha
tax
jsr CHRGET
cpx #<(TOKEN_LEFTSTR*2-1)
bcc L2DEF
jsr CHKOPN
jsr FRMEVL
jsr CHKCOM
jsr CHKSTR
pla
tax
lda FAC_LAST
pha
lda FAC_LAST-1
pha
txa
pha
jsr GETBYT
pla
tay
txa
pha
jmp L2DF4
L2DEF:
jsr PARCHK
pla
tay
L2DF4:
lda UNFNC-TOKEN_SGN-TOKEN_SGN+$100,y
sta JMPADRS+1
lda UNFNC-TOKEN_SGN-TOKEN_SGN+$101,y
sta JMPADRS+2
.ifdef KBD
jsr LF47D
.else
jsr JMPADRS
.endif
jmp CHKNUM
; ----------------------------------------------------------------------------
OR:
ldy #$FF
.byte $2C
; ----------------------------------------------------------------------------
TAND:
ldy #$00
sty EOLPNTR
jsr AYINT
lda FAC_LAST-1
eor EOLPNTR
sta CHARAC
lda FAC_LAST
eor EOLPNTR
sta ENDCHR
jsr COPY_ARG_TO_FAC
jsr AYINT
lda FAC_LAST
eor EOLPNTR
and ENDCHR
eor EOLPNTR
tay
lda FAC_LAST-1
eor EOLPNTR
and CHARAC
eor EOLPNTR
jmp GIVAYF
; ----------------------------------------------------------------------------
; PERFORM RELATIONAL OPERATIONS
; ----------------------------------------------------------------------------
RELOPS:
jsr CHKVAL
bcs STRCMP
lda ARGSIGN
ora #$7F
and ARG+1
sta ARG+1
lda #<ARG
ldy #$00
jsr FCOMP
tax
jmp NUMCMP
; ----------------------------------------------------------------------------
; STRING COMPARISON
; ----------------------------------------------------------------------------
STRCMP:
lda #$00
sta VALTYP
dec CPRTYP
jsr FREFAC
sta FAC
stx FAC+1
sty FAC+2
lda ARG_LAST-1
ldy ARG_LAST
jsr FRETMP
stx ARG_LAST-1
sty ARG_LAST
tax
sec
sbc FAC
beq L2E74
lda #$01
bcc L2E74
ldx FAC
lda #$FF
L2E74:
sta FACSIGN
ldy #$FF
inx
STRCMP1:
iny
dex
bne L2E84
ldx FACSIGN
NUMCMP:
bmi CMPDONE
clc
bcc CMPDONE
L2E84:
lda (ARG_LAST-1),y
cmp (FAC+1),y
beq STRCMP1
ldx #$FF
bcs CMPDONE
ldx #$01
CMPDONE:
inx
txa
rol a
and CPRMASK
beq L2E99
lda #$FF
L2E99:
jmp FLOAT
.ifdef SYM1
LCDBD:
jsr CHRGET
jsr CHKOPN
jsr FRMEVL
jsr CHRGOT
cmp #$29
beq LCDF1
jsr AYINT
lda FAC+4
ldy FAC+3
sta USR+1
sty USR+2
LCDD8:
jsr CHKCOM
jsr FRMEVL
jsr CHRGOT
cmp #$29
beq LCDF1
jsr AYINT
lda FAC+3
pha
lda FAC+4
pha
jmp LCDD8
LCDF1:
jsr CHRGET
jsr AYINT
lda FAC+3
ldy FAC+4
jmp USR
LCDFE:
lda ZD4
pha
lda ZD3
pha
jsr CHRGET
cmp #$22
bne LCE49
jsr CHRGET
jsr LCE2B
tax
jsr CHRGOT
jsr LCE2B
pha
jsr CHRGOT
cmp #$22
bne LCE48
jsr CHRGET
pla
tay
pla
pla
txa
jmp GIVAYF
LCE2B:
jsr ASCNIB
bcs LCE47
pha
jsr CHRGET
jsr ASCNIB
sta FAC+4
bcs LCE46
jsr CHRGET
pla
asl a
asl a
asl a
asl a
ora FAC+4
rts
LCE46:
pla
LCE47:
pla
LCE48:
pla
LCE49:
pla
sta ZD3
pla
sta ZD4
jmp ZERO_FAC
.endif
rom/extra.s
+38
View File
@@ -0,0 +1,38 @@
.segment "EXTRA"
.ifdef KIM
.include "kim_extra.s"
.endif
.ifdef CONFIG_CBM1_PATCHES
.include "cbm1_patches.s"
.endif
.ifdef KBD
.include "kbd_extra.s"
.endif
.ifdef APPLE
.include "apple_extra.s"
.endif
.ifdef MICROTAN
.include "microtan_extra.s"
.endif
.ifdef AIM65
.include "aim65_extra.s"
.endif
.ifdef SYM1
.byte 0,0,0
.endif
.ifdef W65C816SXB
.include "w65c816sxb_extra.s"
.endif
.ifdef KILIAN
.include "kilian_extra.s"
.include "wozmon.s"
.endif
rom/float.s
+1890
View File
File diff suppressed because it is too large. Load diff
rom/flow1.s
+324
View File
@@ -0,0 +1,324 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "FOR" STATEMENT
;
; FOR PUSHES 18 BYTES ON THE STACK:
; 2 -- TXTPTR
; 2 -- LINE NUMBER
; 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
; 1 -- STEP SIGN
; 5 -- STEP VALUE
; 2 -- ADDRESS OF FOR VARIABLE IN VARTAB
; 1 -- FOR TOKEN ($81)
; ----------------------------------------------------------------------------
FOR:
lda #$80
sta SUBFLG
jsr LET
jsr GTFORPNT
bne L2619
txa
adc #FOR_STACK1
tax
txs
L2619:
pla
pla
lda #FOR_STACK2
jsr CHKMEM
jsr DATAN
clc
tya
adc TXTPTR
pha
lda TXTPTR+1
adc #$00
pha
lda CURLIN+1
pha
lda CURLIN
pha
lda #TOKEN_TO
jsr SYNCHR
jsr CHKNUM
jsr FRMNUM
lda FACSIGN
ora #$7F
and FAC+1
sta FAC+1
lda #<STEP
ldy #>STEP
sta INDEX
sty INDEX+1
jmp FRM_STACK3
; ----------------------------------------------------------------------------
; "STEP" PHRASE OF "FOR" STATEMENT
; ----------------------------------------------------------------------------
STEP:
lda #<CON_ONE
ldy #>CON_ONE
jsr LOAD_FAC_FROM_YA
jsr CHRGOT
cmp #TOKEN_STEP
bne L2665
jsr CHRGET
jsr FRMNUM
L2665:
jsr SIGN
jsr FRM_STACK2
lda FORPNT+1
pha
lda FORPNT
pha
lda #$81
pha
; ----------------------------------------------------------------------------
; PERFORM NEXT STATEMENT
; ----------------------------------------------------------------------------
NEWSTT:
jsr ISCNTC
lda TXTPTR
ldy TXTPTR+1
.if .def(CONFIG_NO_INPUTBUFFER_ZP) && .def(CONFIG_2)
cpy #>INPUTBUFFER
.ifdef CBM2
nop
.endif
beq LC6D4
.else
; BUG on AppleSoft I,
; fixed differently on AppleSoft II (ldx/inx)
beq L2683
.endif
sta OLDTEXT
sty OLDTEXT+1
LC6D4:
ldy #$00
L2683:
lda (TXTPTR),y
.ifndef CONFIG_11
beq LA5DC ; old: 1 cycle more on generic case
cmp #$3A
beq NEWSTT2
SYNERR1:
jmp SYNERR
LA5DC:
.else
bne COLON; new: 1 cycle more on ":" case
.endif
ldy #$02
lda (TXTPTR),y
clc
.ifdef CONFIG_2
jeq L2701
.else
beq L2701
.endif
iny
lda (TXTPTR),y
sta CURLIN
iny
lda (TXTPTR),y
sta CURLIN+1
tya
adc TXTPTR
sta TXTPTR
bcc NEWSTT2
inc TXTPTR+1
NEWSTT2:
jsr CHRGET
jsr EXECUTE_STATEMENT
jmp NEWSTT
; ----------------------------------------------------------------------------
; EXECUTE A STATEMENT
;
; (A) IS FIRST CHAR OF STATEMENT
; CARRY IS SET
; ----------------------------------------------------------------------------
EXECUTE_STATEMENT:
.ifndef CONFIG_11A
beq RET1
.else
beq RET2
.endif
.ifndef CONFIG_11
sec
.endif
EXECUTE_STATEMENT1:
sbc #$80
.ifndef CONFIG_11
jcc LET ; old: 1 cycle more on instr.
.else
bcc LET1; new: 1 cycle more on assignment
.endif
cmp #NUM_TOKENS
.ifdef CONFIG_2
bcs LC721
.else
bcs SYNERR1
.endif
asl a
tay
lda TOKEN_ADDRESS_TABLE+1,y
pha
lda TOKEN_ADDRESS_TABLE,y
pha
jmp CHRGET
.ifdef CONFIG_11
LET1:
jmp LET
COLON:
cmp #$3A
beq NEWSTT2
SYNERR1:
jmp SYNERR
.endif
.ifdef CONFIG_2; GO TO
LC721:
cmp #TOKEN_GO-$80
bne SYNERR1
jsr CHRGET
lda #TOKEN_TO
jsr SYNCHR
jmp GOTO
.endif
; ----------------------------------------------------------------------------
; "RESTORE" STATEMENT
; ----------------------------------------------------------------------------
RESTORE:
sec
lda TXTTAB
sbc #$01
ldy TXTTAB+1
bcs SETDA
dey
SETDA:
sta DATPTR
sty DATPTR+1
RET2:
rts
.include "iscntc.s"
;!!! runs into "STOP"
; ----------------------------------------------------------------------------
; "STOP" STATEMENT
; ----------------------------------------------------------------------------
STOP:
bcs END2
; ----------------------------------------------------------------------------
; "END" STATEMENT
; ----------------------------------------------------------------------------
END:
clc
END2:
bne RET1
lda TXTPTR
ldy TXTPTR+1
.if .def(CONFIG_NO_INPUTBUFFER_ZP) && .def(CONFIG_2)
; BUG on AppleSoft I
; fix exists on AppleSoft II
; TXTPTR+1 will always be > 0
ldx CURLIN+1
inx
.endif
beq END4
sta OLDTEXT
sty OLDTEXT+1
CONTROL_C_TYPED:
lda CURLIN
ldy CURLIN+1
sta OLDLIN
sty OLDLIN+1
END4:
pla
pla
L2701:
lda #<QT_BREAK
ldy #>QT_BREAK
.ifndef KBD
ldx #$00
stx Z14
.endif
bcc L270E
jmp PRINT_ERROR_LINNUM
L270E:
jmp RESTART
.ifdef KBD
LE664:
tay
jmp SNGFLT
.endif
; ----------------------------------------------------------------------------
; "CONT" COMMAND
; ----------------------------------------------------------------------------
CONT:
bne RET1
ldx #ERR_CANTCONT
ldy OLDTEXT+1
bne L271C
jmp ERROR
L271C:
lda OLDTEXT
sta TXTPTR
sty TXTPTR+1
lda OLDLIN
ldy OLDLIN+1
sta CURLIN
sty CURLIN+1
RET1:
rts
.ifdef KBD
PRT:
jsr GETBYT
txa
; not ROR bug safe
ror a
ror a
ror a
sta $8F
rts
LE68C:
ldy #$12
LE68E:
lda LEA30,y
sta $03A2,y
dey
bpl LE68E
rts
.endif
.ifndef AIM65
.if .def(CONFIG_NULL) || .def(CONFIG_PRINTNULLS)
; CBM1 has the keyword removed,
; but the code is still here
NULL:
jsr GETBYT
bne RET1
inx
cpx #NULL_MAX
bcs L2739
dex
stx Z15
L2738:
rts
L2739:
jmp IQERR
.endif
.ifndef CONFIG_11A
CLEAR:
bne RET1
jmp CLEARC
.endif
.endif
rom/flow2.s
+215
View File
@@ -0,0 +1,215 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "RUN" COMMAND
; ----------------------------------------------------------------------------
RUN:
bne L27CF
jmp SETPTRS
L27CF:
jsr CLEARC
jmp L27E9
; ----------------------------------------------------------------------------
; "GOSUB" STATEMENT
;
; LEAVES 7 BYTES ON STACK:
; 2 -- RETURN ADDRESS (NEWSTT)
; 2 -- TXTPTR
; 2 -- LINE #
; 1 -- GOSUB TOKEN
; ----------------------------------------------------------------------------
GOSUB:
lda #$03
jsr CHKMEM
lda TXTPTR+1
pha
lda TXTPTR
pha
lda CURLIN+1
pha
lda CURLIN
pha
lda #TOKEN_GOSUB
pha
L27E9:
jsr CHRGOT
jsr GOTO
jmp NEWSTT
; ----------------------------------------------------------------------------
; "GOTO" STATEMENT
; ALSO USED BY "RUN" AND "GOSUB"
; ----------------------------------------------------------------------------
GOTO:
jsr LINGET
jsr REMN
lda CURLIN+1
cmp LINNUM+1
bcs L2809
tya
sec
adc TXTPTR
ldx TXTPTR+1
bcc L280D
inx
bcs L280D
L2809:
lda TXTTAB
ldx TXTTAB+1
L280D:
.ifdef KBD
jsr LF457
bne UNDERR
.else
jsr FL1
bcc UNDERR
.endif
lda LOWTRX
sbc #$01
sta TXTPTR
lda LOWTRX+1
sbc #$00
sta TXTPTR+1
L281E:
rts
; ----------------------------------------------------------------------------
; "POP" AND "RETURN" STATEMENTS
; ----------------------------------------------------------------------------
POP:
bne L281E
lda #$FF
.ifdef CONFIG_2A
sta FORPNT+1 ; bugfix, wrong in AppleSoft II
.else
sta FORPNT
.endif
jsr GTFORPNT
txs
cmp #TOKEN_GOSUB
beq RETURN
ldx #ERR_NOGOSUB
.byte $2C
UNDERR:
ldx #ERR_UNDEFSTAT
jmp ERROR
; ----------------------------------------------------------------------------
SYNERR2:
jmp SYNERR
; ----------------------------------------------------------------------------
RETURN:
pla
pla
sta CURLIN
pla
sta CURLIN+1
pla
sta TXTPTR
pla
sta TXTPTR+1
; ----------------------------------------------------------------------------
; "DATA" STATEMENT
; EXECUTED BY SKIPPING TO NEXT COLON OR EOL
; ----------------------------------------------------------------------------
DATA:
jsr DATAN
; ----------------------------------------------------------------------------
; ADD (Y) TO TXTPTR
; ----------------------------------------------------------------------------
ADDON:
tya
clc
adc TXTPTR
sta TXTPTR
bcc L2852
inc TXTPTR+1
L2852:
rts
; ----------------------------------------------------------------------------
; SCAN AHEAD TO NEXT ":" OR EOL
; ----------------------------------------------------------------------------
DATAN:
ldx #$3A
.byte $2C
REMN:
ldx #$00
stx CHARAC
ldy #$00
sty ENDCHR
L285E:
lda ENDCHR
ldx CHARAC
sta CHARAC
stx ENDCHR
L2866:
lda (TXTPTR),y
beq L2852
cmp ENDCHR
beq L2852
iny
cmp #$22
.ifndef CONFIG_11
beq L285E; old: swap & cont is faster
bne L2866
.else
bne L2866; new: cont is faster
beq L285E
.endif
; ----------------------------------------------------------------------------
; "IF" STATEMENT
; ----------------------------------------------------------------------------
IF:
jsr FRMEVL
jsr CHRGOT
cmp #TOKEN_GOTO
beq L2884
lda #TOKEN_THEN
jsr SYNCHR
L2884:
lda FAC
bne L288D
; ----------------------------------------------------------------------------
; "REM" STATEMENT, OR FALSE "IF" STATEMENT
; ----------------------------------------------------------------------------
REM:
jsr REMN
beq ADDON
L288D:
jsr CHRGOT
bcs L2895
jmp GOTO
L2895:
jmp EXECUTE_STATEMENT
; ----------------------------------------------------------------------------
; "ON" STATEMENT
;
; ON <EXP> GOTO <LIST>
; ON <EXP> GOSUB <LIST>
; ----------------------------------------------------------------------------
ON:
jsr GETBYT
pha
cmp #TOKEN_GOSUB
beq L28A4
L28A0:
cmp #TOKEN_GOTO
bne SYNERR2
L28A4:
dec FAC_LAST
bne L28AC
pla
jmp EXECUTE_STATEMENT1
L28AC:
jsr CHRGET
jsr LINGET
cmp #$2C
beq L28A4
pla
L28B7:
rts
rom/header.s
+33
View File
@@ -0,0 +1,33 @@
.segment "HEADER"
.ifdef W65C816SXB
; Disable emulation mode (is left on from the monitor)
.setcpu "65816"
SEC ;set carry for emulation mode
XCE ;go into emulation mode
.setcpu "65C02"
jsr INITUSBSERIAL
; Add a small delay to allow monitor to connect the terminal after
; starting execution
ldy #0
ldx #0
@loop:
dex
bne @loop
dey
bne @loop
jmp COLD_START
.endif
.ifdef KBD
jmp LE68C
.byte $00,$13,$56
.endif
.ifdef AIM65
jmp COLD_START
jmp RESTART
.word AYINT,GIVAYF
.endif
.ifdef SYM1
jmp PR_WRITTEN_BY
.endif
rom/init.s
+548
View File
@@ -0,0 +1,548 @@
.segment "INIT"
.ifdef KBD
FNDLIN2:
php
jmp FNDLIN
.endif
; ----------------------------------------------------------------------------
PR_WRITTEN_BY:
.ifndef KBD
.ifndef CONFIG_CBM_ALL
.ifndef AIM65
.ifndef SYM1
lda #<QT_WRITTEN_BY
ldy #>QT_WRITTEN_BY
jsr STROUT
.endif
.endif
.endif
.endif
COLD_START:
.ifdef SYM1
jsr ACCESS
.endif
.ifdef KBD
lda #<LFD81
sta $03A0
lda #>LFD81
sta $03A1
lda #$20
sta $0480
lda $0352
sta $04
lda $0353
sta $05
.else
.ifndef CBM2
ldx #$FF
stx CURLIN+1
.endif
.ifdef CONFIG_NO_INPUTBUFFER_ZP
ldx #$FB
.elseif .def(AIM65)
ldx #$FE
.endif
txs
.ifndef CONFIG_CBM_ALL
lda #<COLD_START
ldy #>COLD_START
sta GORESTART+1
sty GORESTART+2
.ifndef AIM65
sta GOSTROUT+1
sty GOSTROUT+2
lda #<AYINT
ldy #>AYINT
sta GOAYINT
sty GOAYINT+1
lda #<GIVAYF
ldy #>GIVAYF
sta GOGIVEAYF
sty GOGIVEAYF+1
.endif
.endif
lda #$4C
.ifdef CONFIG_CBM_ALL
sta JMPADRS
.endif
sta GORESTART
.ifdef AIM65
sta JMPADRS
sta ATN
sta GOSTROUT
.else
.ifndef CONFIG_CBM_ALL
sta GOSTROUT
sta JMPADRS
.endif
.ifdef SYM1
sta USR1
sta USR3
sta USR2
.endif
.if (!.def(CONFIG_RAM)) && (!.def(CONFIG_CBM_ALL))
sta USR
.endif
.endif
.ifndef CONFIG_RAM
.ifdef APPLE
lda #<USR_FUNC
ldy #>USR_FUNC
.else
lda #<IQERR
ldy #>IQERR
.endif
.ifdef AIM65
sta ATN+1
sty ATN+2
sta GOSTROUT+1
sty GOSTROUT+2
.else
sta USR+1
sty USR+2
.ifdef SYM1
sta USR1+1
sty USR1+2
lda #<DUMPT
ldy #>DUMPT
sta USR2+1
sty USR2+2
lda #<L8C78
ldy #>L8C78
sta USR3+1
sty USR3+2
.endif
.endif
.endif
.ifndef CBM1
lda #WIDTH
sta Z17
lda #WIDTH2
sta Z18
.endif
.endif
; All non-CONFIG_SMALL versions of BASIC have
; the same bug here: While the number of bytes
; to be copied is correct for CONFIG_SMALL,
; it is one byte short on non-CONFIG_SMALL:
; It seems the "ldx" value below has been
; hardcoded. So on these configurations,
; the last byte of GENERIC_RNDSEED, which
; is 5 bytes instead of 4, does not get copied -
; which is nothing major, because it is just
; the least significant 8 bits of the mantissa
; of the random number seed.
; KBD added three bytes to CHRGET and removed
; the random number seed, but only adjusted
; the number of bytes by adding 3 - this
; copies four bytes too many, which is no
; problem.
.ifdef CONFIG_SMALL
.ifdef KBD
ldx #GENERIC_CHRGET_END-GENERIC_CHRGET+4
.else
ldx #GENERIC_CHRGET_END-GENERIC_CHRGET
.endif
.else
ldx #GENERIC_CHRGET_END-GENERIC_CHRGET-1 ; XXX
.endif
L4098:
lda GENERIC_CHRGET-1,x
sta CHRGET-1,x
dex
bne L4098
.ifdef CONFIG_2
lda #$03
sta DSCLEN
.endif
.ifndef KBD
txa
sta SHIFTSIGNEXT
.ifdef CONFIG_CBM_ALL
sta CURDVC
.endif
sta LASTPT+1
.ifndef AIM65
.if .defined(CONFIG_NULL) || .defined(CONFIG_PRINTNULLS)
sta Z15
.endif
.endif
.ifndef CONFIG_11
sta POSX
.endif
pha
sta Z14
.ifndef CBM2
.ifndef AIM65
.ifndef SYM1
.ifndef MICROTAN
lda #$03
sta DSCLEN
.endif
.endif
.endif
.ifndef CONFIG_11
lda #$2C
sta LINNUM+1
.endif
jsr CRDO
.endif
.ifdef CBM2
inx
stx INPUTBUFFER-3
stx INPUTBUFFER-4
.endif
.ifdef APPLE
lda #$01
sta INPUTBUFFER-3
sta INPUTBUFFER-4
.endif
.ifdef CONFIG_INPUTBUFFER_0200
lda #$01
sta INPUTBUFFER-3
sta INPUTBUFFER-4
.endif
ldx #TEMPST
stx TEMPPT
.ifndef CONFIG_CBM_ALL
.ifdef KILIAN
lda #<$BC00
sta MEMSIZ
lda #>$BC00
sta MEMSIZ+1
jmp L4106
.else
lda #<QT_MEMORY_SIZE
ldy #>QT_MEMORY_SIZE
jsr STROUT
.endif
.ifdef APPLE
jsr INLINX
.else
jsr NXIN
.endif
stx TXTPTR
sty TXTPTR+1
jsr CHRGET
.ifndef AIM65
.ifndef SYM1
cmp #$41
bne SKIPPED
jmp PR_WRITTEN_BY
SKIPPED:
.endif
.endif
tay
bne L40EE
.endif
.ifndef CBM2
lda #<RAMSTART2
.endif
ldy #>RAMSTART2
.ifdef CONFIG_2
sta TXTTAB
sty TXTTAB+1
.endif
sta LINNUM
sty LINNUM+1
.ifdef CBM2
tay
.else
ldy #$00
.endif
L40D7:
inc LINNUM
bne L40DD
inc LINNUM+1
.ifdef CBM1
; CBM: hard RAM top limit is $8000
lda LINNUM+1
cmp #$80
beq L40FA
.endif
.ifdef CBM2
; optimized version of the CBM1 code
bmi L40FA
.endif
.if .def(AIM65)
; AIM65: hard RAM top limit is $A000
lda LINNUM+1
cmp #$A0
beq L40FA
.endif
L40DD:
.ifdef CONFIG_2
lda #$55 ; 01010101 / 10101010
.else
lda #$92 ; 10010010 / 00100100
.endif
sta (LINNUM),y
cmp (LINNUM),y
bne L40FA
asl a
sta (LINNUM),y
cmp (LINNUM),y
.ifdef CONFIG_CBM_ALL
beq L40D7
.else
.ifndef CONFIG_11
beq L40D7; old: faster
bne L40FA
.else
bne L40FA; new: slower
beq L40D7
.endif
L40EE:
jsr CHRGOT
jsr LINGET
tay
beq L40FA
jmp SYNERR
.endif
L40FA:
lda LINNUM
ldy LINNUM+1
sta MEMSIZ
sty MEMSIZ+1
.if !(.def(MICROTAN) || .def(AIM65) || .def(SYM1))
sta FRETOP
sty FRETOP+1
.endif
L4106:
.ifndef CONFIG_CBM_ALL
.ifdef APPLE
lda #$FF
jmp L2829
.word STROUT ; PATCH!
jsr NXIN
.else
lda #<QT_TERMINAL_WIDTH
ldy #>QT_TERMINAL_WIDTH
jsr STROUT
jsr NXIN
.endif
stx TXTPTR
sty TXTPTR+1
jsr CHRGET
tay
beq L4136
jsr LINGET
lda LINNUM+1
bne L4106
lda LINNUM
cmp #$10
bcc L4106
L2829:
sta Z17
L4129:
.ifdef AIM65
sbc #$0A
.else
sbc #$0E
.endif
bcs L4129
eor #$FF
.ifdef AIM65
sbc #$08
.else
sbc #$0C
.endif
clc
adc Z17
sta Z18
.endif
L4136:
.ifdef CONFIG_RAM
lda #<QT_WANT
ldy #>QT_WANT
jsr STROUT
jsr NXIN
stx TXTPTR
sty TXTPTR+1
jsr CHRGET
ldx #<RAMSTART1
ldy #>RAMSTART1
cmp #'Y'
beq L4183
cmp #'A'
beq L4157
cmp #'N'
bne L4136
L4157:
ldx #<IQERR
ldy #>IQERR
stx UNFNC_ATN
sty UNFNC_ATN+1
ldx #<ATN ; overwrite starting
ldy #>ATN ; with ATN
cmp #'A'
beq L4183
ldx #<IQERR
ldy #>IQERR
stx UNFNC_COS
sty UNFNC_COS+1
stx UNFNC_TAN
sty UNFNC_TAN+1
stx UNFNC_SIN
sty UNFNC_SIN+1
ldx #<SIN_COS_TAN_ATN ; overwrite
ldy #>SIN_COS_TAN_ATN ; all of trig.s
L4183:
.else
ldx #<RAMSTART2
ldy #>RAMSTART2
.endif
stx TXTTAB
sty TXTTAB+1
ldy #$00
tya
sta (TXTTAB),y
inc TXTTAB
.ifndef CBM2
bne L4192
inc TXTTAB+1
L4192:
.endif
.if CONFIG_SCRTCH_ORDER = 1
jsr SCRTCH
.endif
lda TXTTAB
ldy TXTTAB+1
jsr REASON
.ifdef CBM2
lda #<QT_BASIC
ldy #>QT_BASIC
jsr STROUT
.else
jsr CRDO
.endif
lda MEMSIZ
sec
sbc TXTTAB
tax
lda MEMSIZ+1
sbc TXTTAB+1
jsr LINPRT
lda #<QT_BYTES_FREE
ldy #>QT_BYTES_FREE
jsr STROUT
.if CONFIG_SCRTCH_ORDER = 2
jsr SCRTCH
.endif
.ifdef CONFIG_CBM_ALL
jmp RESTART
.elseif .def(AIM65)
lda #<CRDO
ldy #>CRDO
sta GORESTART+1
sty GORESTART+2
jmp RESTART
.else
lda #<STROUT
ldy #>STROUT
sta GOSTROUT+1
sty GOSTROUT+2
.if CONFIG_SCRTCH_ORDER = 3
jsr SCRTCH
.endif
lda #<RESTART
ldy #>RESTART
sta GORESTART+1
sty GORESTART+2
jmp (GORESTART+1)
.endif
.if .def(CONFIG_RAM) || .def(OSI)
; OSI is compiled for ROM, but includes
; this unused string
QT_WANT:
.byte "WANT SIN-COS-TAN-ATN"
.byte 0
.endif
QT_WRITTEN_BY:
.ifndef CONFIG_CBM_ALL
.if !(.def(AIM65) || .def(SYM1))
.ifdef APPLE
asc80 "COPYRIGHT 1977 BY MICROSOFT CO"
.byte CR,0
.else
.byte CR,LF,$0C ; FORM FEED
.ifndef CONFIG_11
.byte "WRITTEN BY RICHARD W. WEILAND."
.else
.byte "WRITTEN BY WEILAND & GATES"
.endif
.byte CR,LF,0
.endif
.endif
QT_MEMORY_SIZE:
.byte "MEMORY SIZE"
.byte 0
QT_TERMINAL_WIDTH:
.if !(.def(AIM65) || .def(SYM1))
.byte "TERMINAL "
.endif
.byte "WIDTH"
.byte 0
.endif
QT_BYTES_FREE:
.byte " BYTES FREE"
.ifdef CBM1
.elseif .def(CBM2)
.byte CR,0
.elseif .def(APPLE)
.byte 0
.else
.byte CR,LF,CR,LF
.endif
QT_BASIC:
.ifdef OSI
.byte "OSI 6502 BASIC VERSION 1.0 REV 3.2"
.endif
.ifdef KIM
.byte "MOS TECH 6502 BASIC V1.1"
.endif
.ifdef MICROTAN
.byte "MICROTAN BASIC"
.endif
.ifdef AIM65
.byte " AIM 65 BASIC V1.1"
.endif
.ifdef SYM1
.byte "BASIC V1.1"
.endif
.ifdef CBM1
.byte $13 ; HOME
.byte "*** COMMODORE BASIC ***"
.byte $11,$11,$11,0 ; DOWN/DOWN/DOWN
.endif
.ifdef CBM2
.byte "### COMMODORE BASIC ###"
.byte CR,CR,0
.endif
.ifdef APPLE
.byte LF,CR,LF
.byte "APPLE BASIC V1.1"
.endif
.ifndef CONFIG_CBM_ALL
.byte CR,LF
.ifdef MICROTAN
.byte "(C) 1980 MICROSOFT"
.elseif .def(AIM65)
.byte 0
.byte "(C) 1978 MICROSOFT"
.elseif .def(SYM1)
.byte "COPYRIGHT 1978 SYNERTEK SYSTEMS CORP."
.else
.byte "COPYRIGHT 1977 BY MICROSOFT CO."
.endif
.byte CR,LF
.ifndef AIM65
.byte 0
.endif
.endif
.endif
rom/inline.s
+165
View File
@@ -0,0 +1,165 @@
.segment "CODE"
.ifndef CONFIG_NO_LINE_EDITING
L2420:
.ifdef OSI
jsr OUTDO
.endif
dex
.ifdef AIM65
bmi L2423
jsr PSLS
jmp INLIN2
LB35F:
jsr OUTDO
.else
bpl INLIN2
.endif
L2423:
.ifdef OSI
jsr OUTDO
.endif
jsr CRDO
.endif
; ----------------------------------------------------------------------------
; READ A LINE, AND STRIP OFF SIGN BITS
; ----------------------------------------------------------------------------
.ifndef KBD
INLIN:
.ifdef APPLE
ldx #$DD
INLIN1:
stx $33
jsr L2900
cpx #$EF
bcs L0C32
ldx #$EF
L0C32:
lda #$00
sta INPUTBUFFER,x
ldx #<(INPUTBUFFER-1)
ldy #>(INPUTBUFFER-1)
rts
.endif
.ifndef APPLE
ldx #$00
INLIN2:
jsr GETLN
.ifdef AIM65
cmp #$1A
bne INLINAIM
jsr DU13
jmp INLIN
INLINAIM:
.endif
.ifndef CONFIG_NO_LINE_EDITING
cmp #$07
beq L2443
.endif
cmp #$0D
beq L2453
.ifndef CONFIG_NO_LINE_EDITING
cmp #$20
.ifdef AIM65
bcc L244E
.else
bcc INLIN2
.endif
.ifdef MICROTAN
cmp #$80
.else
.ifdef AIM65
cmp #$7F
beq L2420
.endif
cmp #$7D
.endif
bcs INLIN2
cmp #$40 ; @
.ifdef AIM65
beq LB35F
.else
beq L2423
.ifdef MICROTAN
cmp #$7F ; DEL
.else
cmp #$5F ; _
.endif
beq L2420
.endif
L2443:
.ifdef MICROTAN
cpx #$4F
.else
cpx #$47
.endif
bcs L244C
.endif
sta INPUTBUFFER,x
inx
.if .def(OSI) || .def(AIM65)
.byte $2C
.else
bne INLIN2
.endif
L244C:
.ifndef CONFIG_NO_LINE_EDITING
lda #$07 ; BEL
L244E:
jsr OUTDO
bne INLIN2
.endif
L2453:
jmp L29B9
.endif
.endif
.ifndef KBD
.ifndef APPLE
GETLN:
.ifdef CONFIG_FILE
jsr CHRIN
ldy CURDVC
bne L2465
.else
jsr MONRDKEY
.endif
.ifdef OSI
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
and #$7F
.endif
.endif
.ifdef APPLE
RDKEY:
jsr LFD0C
and #$7F
.endif
.ifdef SYM1
cmp #$14
.else
cmp #$0F
.endif
bne L2465
pha
lda Z14
eor #$FF
sta Z14
pla
L2465:
rts
.endif
rom/input.s
+459
View File
@@ -0,0 +1,459 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; INPUT CONVERSION ERROR: ILLEGAL CHARACTER
; IN NUMERIC FIELD. MUST DISTINGUISH
; BETWEEN INPUT, READ, AND GET
; ----------------------------------------------------------------------------
INPUTERR:
lda INPUTFLG
beq RESPERR ; INPUT
.ifndef SYM1
.ifndef CONFIG_SMALL
.ifdef CONFIG_10A
; without this, it treats GET errors
; like READ errors
bmi L2A63 ; READ
ldy #$FF ; GET
bne L2A67
L2A63:
.endif
.endif
.endif
.ifdef CONFIG_CBM1_PATCHES
jsr PATCH5
nop
.else
lda Z8C
ldy Z8C+1
.endif
L2A67:
sta CURLIN
sty CURLIN+1
SYNERR4:
jmp SYNERR
RESPERR:
.ifdef CONFIG_FILE
lda CURDVC
beq LCA8F
ldx #ERR_BADDATA
jmp ERROR
LCA8F:
.endif
lda #<ERRREENTRY
ldy #>ERRREENTRY
jsr STROUT
lda OLDTEXT
ldy OLDTEXT+1
sta TXTPTR
sty TXTPTR+1
RTS20:
rts
; ----------------------------------------------------------------------------
; "GET" STATEMENT
; ----------------------------------------------------------------------------
.ifndef CONFIG_SMALL
.ifndef SYM1
GET:
jsr ERRDIR
; CBM: if GET#, then switch input
.ifdef CONFIG_FILE
cmp #'#'
bne LCAB6
jsr CHRGET
jsr GETBYT
lda #','
jsr SYNCHR
jsr CHKIN
stx CURDVC
LCAB6:
.endif
ldx #<(INPUTBUFFER+1)
ldy #>(INPUTBUFFER+1)
.ifdef CONFIG_NO_INPUTBUFFER_ZP
lda #$00
sta INPUTBUFFER+1
.else
sty INPUTBUFFER+1
.endif
lda #$40
jsr PROCESS_INPUT_LIST
; CBM: if GET#, then switch input back
.ifdef CONFIG_FILE
ldx CURDVC
bne LCAD8
.endif
rts
.endif
.endif
; ----------------------------------------------------------------------------
; "INPUT#" STATEMENT
; ----------------------------------------------------------------------------
.ifdef CONFIG_FILE
INPUTH:
jsr GETBYT
lda #$2C
jsr SYNCHR
jsr CHKIN
stx CURDVC
jsr L2A9E
LCAD6:
lda CURDVC
LCAD8:
jsr CLRCH
ldx #$00
stx CURDVC
rts
LCAE0:
.endif
.ifdef SYM1
LC9B0:
jsr OUTQUES ; '?'
jsr OUTSP
jmp L2A9E
.endif
; ----------------------------------------------------------------------------
; "INPUT" STATEMENT
; ----------------------------------------------------------------------------
INPUT:
.ifndef KBD
lsr Z14
.endif
.ifdef AIM65
lda PRIFLG
sta ZBE
jsr LCFFA
.endif
cmp #$22
.ifdef SYM1
bne LC9B0
.else
bne L2A9E
.endif
jsr STRTXT
lda #$3B
jsr SYNCHR
jsr STRPRT
L2A9E:
jsr ERRDIR
lda #$2C
sta INPUTBUFFER-1
LCAF8:
.ifdef APPLE
jsr INLINX
.elseif .def(SYM1)
jsr INLIN
.else
jsr NXIN
.endif
.ifdef KBD
bmi L2ABE
.else
.ifdef CONFIG_FILE
lda CURDVC
beq LCB0C
lda Z96
and #$02
beq LCB0C
jsr LCAD6
jmp DATA
LCB0C:
.endif
lda INPUTBUFFER
bne L2ABE
.ifdef CONFIG_FILE
lda CURDVC
bne LCAF8
.endif
.ifdef CONFIG_CBM1_PATCHES
jmp PATCH1
.else
clc
jmp CONTROL_C_TYPED
.endif
.endif
NXIN:
.ifdef KBD
jsr INLIN
bmi RTS20
pla
jmp LE86C
.else
.ifdef CONFIG_FILE
lda CURDVC
bne LCB21
.endif
jsr OUTQUES ; '?'
jsr OUTSP
LCB21:
jmp INLIN
.endif
; ----------------------------------------------------------------------------
; "GETC" STATEMENT
; ----------------------------------------------------------------------------
.ifdef KBD
GETC:
jsr CONINT
jsr LF43D
jmp LE664
.endif
; ----------------------------------------------------------------------------
; "READ" STATEMENT
; ----------------------------------------------------------------------------
READ:
ldx DATPTR
ldy DATPTR+1
.ifdef CONFIG_NO_READ_Y_IS_ZERO_HACK
; AppleSoft II, too
lda #$98 ; READ
.byte $2C
L2ABE:
lda #$00 ; INPUT
.else
.byte $A9 ; LDA #$98
L2ABE:
tya
.endif
; ----------------------------------------------------------------------------
; PROCESS INPUT LIST
;
; (Y,X) IS ADDRESS OF INPUT DATA STRING
; (A) = VALUE FOR INPUTFLG: $00 FOR INPUT
; $40 FOR GET
; $98 FOR READ
; ----------------------------------------------------------------------------
PROCESS_INPUT_LIST:
sta INPUTFLG
stx INPTR
sty INPTR+1
PROCESS_INPUT_ITEM:
jsr PTRGET
sta FORPNT
sty FORPNT+1
lda TXTPTR
ldy TXTPTR+1
sta TXPSV
sty TXPSV+1
ldx INPTR
ldy INPTR+1
stx TXTPTR
sty TXTPTR+1
jsr CHRGOT
bne INSTART
bit INPUTFLG
.ifndef CONFIG_SMALL ; GET
.ifndef SYM1
bvc L2AF0
.ifdef MICROTAN
jsr MONRDKEY2
.elseif .def(AIM65)
jsr MONRDKEY2
.else
jsr MONRDKEY
.endif
.ifdef CONFIG_IO_MSB
and #$7F
.endif
sta INPUTBUFFER
; BUG: The beq/bne L2AF8 below is supposed
; to be always taken. For this to happen,
; the last load must be a 0 for beq
; and != 0 for bne. The original Microsoft
; code had ldx/ldy/bne here, which was only
; correct for a non-ZP INPUTBUFFER. Commodore
; fixed it in CBMBASIC V1 by swapping the
; ldx and the ldy. It was broken on KIM,
; but okay on APPLE and CBM2, because
; these used a non-ZP INPUTBUFFER.
; Microsoft fixed this somewhere after KIM
; and before MICROTAN, by using beq instead
; of bne in the ZP case.
.ifdef CBM1
ldy #>(INPUTBUFFER-1)
ldx #<(INPUTBUFFER-1)
.else
ldx #<(INPUTBUFFER-1)
ldy #>(INPUTBUFFER-1)
.endif
.if .def(CONFIG_2) && (!.def(CONFIG_NO_INPUTBUFFER_ZP))
beq L2AF8 ; always
.else
bne L2AF8 ; always
.endif
L2AF0:
.endif
.endif
bmi FINDATA
.ifdef CONFIG_FILE
lda CURDVC
bne LCB64
.endif
.ifdef KBD
jsr OUTQUESSP
.else
jsr OUTQUES
.endif
LCB64:
jsr NXIN
L2AF8:
stx TXTPTR
sty TXTPTR+1
; ----------------------------------------------------------------------------
INSTART:
jsr CHRGET
bit VALTYP
bpl L2B34
.ifndef CONFIG_SMALL ; GET
.ifndef SYM1
bit INPUTFLG
bvc L2B10
.ifdef CONFIG_CBM1_PATCHES
lda #$00
jsr PATCH4
nop
.else
inx
stx TXTPTR
lda #$00
sta CHARAC
beq L2B1C
.endif
L2B10:
.endif
.endif
sta CHARAC
cmp #$22
beq L2B1D
lda #$3A
sta CHARAC
lda #$2C
L2B1C:
clc
L2B1D:
sta ENDCHR
lda TXTPTR
ldy TXTPTR+1
adc #$00
bcc L2B28
iny
L2B28:
jsr STRLT2
jsr POINT
.ifdef CONFIG_SMALL
jsr LETSTRING
.else
jsr PUTSTR
.endif
jmp INPUT_MORE
; ----------------------------------------------------------------------------
L2B34:
jsr FIN
.ifdef CONFIG_SMALL
jsr SETFOR
.else
lda VALTYP+1
jsr LET2
.endif
; ----------------------------------------------------------------------------
INPUT_MORE:
jsr CHRGOT
beq L2B48
cmp #$2C
beq L2B48
jmp INPUTERR
L2B48:
lda TXTPTR
ldy TXTPTR+1
sta INPTR
sty INPTR+1
lda TXPSV
ldy TXPSV+1
sta TXTPTR
sty TXTPTR+1
jsr CHRGOT
beq INPDONE
jsr CHKCOM
jmp PROCESS_INPUT_ITEM
; ----------------------------------------------------------------------------
FINDATA:
jsr DATAN
iny
tax
bne L2B7C
ldx #ERR_NODATA
iny
lda (TXTPTR),y
beq GERR
iny
lda (TXTPTR),y
sta Z8C
iny
lda (TXTPTR),y
iny
sta Z8C+1
L2B7C:
lda (TXTPTR),y
tax
jsr ADDON
cpx #$83
bne FINDATA
jmp INSTART
; ---NO MORE INPUT REQUESTED------
INPDONE:
lda INPTR
ldy INPTR+1
ldx INPUTFLG
.if .def(CONFIG_SMALL) && (!.def(CONFIG_11))
beq L2B94 ; INPUT
.else
bpl L2B94; INPUT or GET
.endif
jmp SETDA
L2B94:
ldy #$00
.ifdef AIM65
jsr LB8B1
.endif
lda (INPTR),y
beq L2BA1
.ifdef CONFIG_FILE
lda CURDVC
bne L2BA1
.endif
lda #<ERREXTRA
ldy #>ERREXTRA
jmp STROUT
L2BA1:
rts
; ----------------------------------------------------------------------------
ERREXTRA:
.ifdef KBD
.byte "?Extra"
.else
.byte "?EXTRA IGNORED"
.endif
.byte $0D,$0A,$00
ERRREENTRY:
.ifdef KBD
.byte "What?"
.else
.byte "?REDO FROM START"
.endif
.byte $0D,$0A,$00
.ifdef KBD
LEA30:
.byte "B"
.byte $FD
.byte "GsBASIC"
.byte $00,$1B,$0D,$13
.byte " BASIC"
.endif
rom/iscntc.s
+1
View File
@@ -0,0 +1 @@
;!!! runs into "STOP"
rom/kilian.cfg
+24
View File
@@ -0,0 +1,24 @@
MEMORY {
ZP: start = $0000, size = $0100, type = rw;
BASROM: start = $C000, size = $3F00, fill = yes, file = %O;
WOZMON: start = $FDAA, size = $FA, fill = yes, file = %O;
RESETVEC: start = $FFFA, size = $6, fill = yes, file = %O;
DUMMY: start = $0000, size = $00FF, file = "";
}
SEGMENTS {
ZEROPAGE: load = ZP, type = zp;
HEADER: load = BASROM, type = ro;
VECTORS: load = BASROM, type = ro;
KEYWORDS: load = BASROM, type = ro;
ERROR: load = BASROM, type = ro;
CODE: load = BASROM, type = ro;
CHRGET: load = BASROM, type = ro;
INIT: load = BASROM, type = ro;
EXTRA: load = BASROM, type = ro;
WOZMON: load = WOZMON, type = ro;
RESETVEC: load = RESETVEC, type = ro;
DUMMY: load = DUMMY; # don't include
}
rom/kilian_extra.s
+33
View File
@@ -0,0 +1,33 @@
.segment "EXTRA"
.export MONRDKEY, MONCOUT, LOAD; SAVE; ISCNTC
LOAD:
rts
SAVE:
rts
ISCNTC:
lda $BC01
cmp #$03
beq @break
rts
@break:
jmp STOP
MONRDKEY:
lda $BC01
bmi @skipped
sta $BC00 ; echo
@skipped:
rts
MONCOUT:
sta $BC00
rts
.segment "RESETVEC"
.word $0000 ; NMI vector
.word RESET ; RESET vector
.word $0000 ; IRQ vector
rom/loadsave.s
+17
View File
@@ -0,0 +1,17 @@
.segment "CODE"
.ifdef APPLE
.include "apple_loadsave.s"
.endif
.ifdef KIM
.include "kim_loadsave.s"
.endif
.ifdef MICROTAN
.include "microtan_loadsave.s"
.endif
.ifdef AIM65
.include "aim65_loadsave.s"
.endif
.ifdef SYM1
.include "sym1_loadsave.s"
.endif
rom/macros.s
+78
View File
@@ -0,0 +1,78 @@
; htasc - set the hi bit on the last byte of a string for termination
; (by Tom Greene)
.macro htasc str
.repeat .strlen(str)-1,I
.byte .strat(str,I)
.endrep
.byte .strat(str,.strlen(str)-1) | $80
.endmacro
; For every token, a byte gets put into segment "DUMMY".
; This way, we count up with every token. The DUMMY segment
; doesn't get linked into the binary.
.macro init_token_tables
.segment "VECTORS"
TOKEN_ADDRESS_TABLE:
.segment "KEYWORDS"
TOKEN_NAME_TABLE:
.segment "DUMMY"
DUMMY_START:
.endmacro
; optionally define token symbol
; count up token number
.macro define_token token
.segment "DUMMY"
.ifnblank token
token := <(*-DUMMY_START)+$80
.endif
.res 1; count up in any case
.endmacro
; lay down a keyword, optionally define a token symbol
.macro keyword key, token
.segment "KEYWORDS"
htasc key
define_token token
.endmacro
; lay down a keyword and an address (RTS style),
; optionally define a token symbol
.macro keyword_rts key, vec, token
.segment "VECTORS"
.word vec-1
keyword key, token
.endmacro
; lay down a keyword and an address,
; optionally define a token symbol
.macro keyword_addr key, vec, token
.segment "VECTORS"
.addr vec
keyword key, token
.endmacro
.macro count_tokens
.segment "DUMMY"
NUM_TOKENS := <(*-DUMMY_START)
.endmacro
.macro init_error_table
.segment "ERROR"
ERROR_MESSAGES:
.endmacro
.macro define_error error, msg
.segment "ERROR"
error := <(*-ERROR_MESSAGES)
htasc msg
.endmacro
;---------------------------------------------
; set the MSB of every byte of a string
.macro asc80 str
.repeat .strlen(str),I
.byte .strat(str,I)+$80
.endrep
.endmacro
rom/memory.s
+154
View File
@@ -0,0 +1,154 @@
; generic stack and memory management code
; this code is identical across all versions of
; BASIC
.segment "CODE"
; ----------------------------------------------------------------------------
; CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH
; THE STACK FOR A FRAME WITH THE SAME VARIABLE.
;
; (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
; = $XXFF IF CALLED FROM "RETURN"
; <<< BUG: SHOULD BE $FFXX >>>
;
; RETURNS .NE. IF VARIABLE NOT FOUND,
; (X) = STACK PNTR AFTER SKIPPING ALL FRAMES
;
; .EQ. IF FOUND
; (X) = STACK PNTR OF FRAME FOUND
; ----------------------------------------------------------------------------
GTFORPNT:
tsx
inx
inx
inx
inx
L2279:
lda STACK+1,x
cmp #$81
bne L22A1
lda FORPNT+1
bne L228E
lda STACK+2,x
sta FORPNT
lda STACK+3,x
sta FORPNT+1
L228E:
cmp STACK+3,x
bne L229A
lda FORPNT
cmp STACK+2,x
beq L22A1
L229A:
txa
clc
adc #BYTES_PER_FRAME
tax
bne L2279
L22A1:
rts
; ----------------------------------------------------------------------------
; MOVE BLOCK OF MEMORY UP
;
; ON ENTRY:
; (Y,A) = (HIGHDS) = DESTINATION END+1
; (LOWTR) = LOWEST ADDRESS OF SOURCE
; (HIGHTR) = HIGHEST SOURCE ADDRESS+1
; ----------------------------------------------------------------------------
BLTU:
jsr REASON
sta STREND
sty STREND+1
BLTU2:
sec
lda HIGHTR
sbc LOWTR
sta INDEX
tay
lda HIGHTR+1
sbc LOWTR+1
tax
inx
tya
beq L22DD
lda HIGHTR
sec
sbc INDEX
sta HIGHTR
bcs L22C6
dec HIGHTR+1
sec
L22C6:
lda HIGHDS
sbc INDEX
sta HIGHDS
bcs L22D6
dec HIGHDS+1
bcc L22D6
L22D2:
lda (HIGHTR),y
sta (HIGHDS),y
L22D6:
dey
bne L22D2
lda (HIGHTR),y
sta (HIGHDS),y
L22DD:
dec HIGHTR+1
dec HIGHDS+1
dex
bne L22D6
rts
; ----------------------------------------------------------------------------
; CHECK IF ENOUGH ROOM LEFT ON STACK
; FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION
; ----------------------------------------------------------------------------
CHKMEM:
asl a
adc #SPACE_FOR_GOSUB
bcs MEMERR
sta INDEX
tsx
cpx INDEX
bcc MEMERR
rts
; ----------------------------------------------------------------------------
; CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS
; (Y,A) = ADDR ARRAYS NEED TO GROW TO
; ----------------------------------------------------------------------------
REASON:
cpy FRETOP+1
bcc L231E
bne L22FC
cmp FRETOP
bcc L231E
L22FC:
pha
ldx #FAC-TEMP1-1
tya
L2300:
pha
lda TEMP1,x
dex
bpl L2300
jsr GARBAG
ldx #<(TEMP1-FAC+1)
L230B:
pla
sta FAC,x
inx
bmi L230B
pla
tay
pla
cpy FRETOP+1
bcc L231E
bne MEMERR
cmp FRETOP
bcs MEMERR
L231E:
rts
rom/message.s
+60
View File
@@ -0,0 +1,60 @@
; global messages: "error", "in", "ready", "break"
.segment "CODE"
QT_ERROR:
.ifdef KBD
.byte " err"
.else
.ifdef APPLE
.byte " ERR"
.byte $07,$07
.else
.byte " ERROR"
.endif
.endif
.byte 0
.ifndef KBD
QT_IN:
.byte " IN "
.byte $00
.endif
.ifdef KBD
.byte $54,$D2 ; ???
OKPRT:
jsr PRIMM
.byte CR,CR,">>",CR,LF
.byte 0
rts
nop
.else
.ifndef AIM65
QT_OK:
.ifdef CONFIG_CBM_ALL
.byte CR,LF,"READY.",CR,LF
.else
.ifdef APPLE
; binary patch!
.byte CR,0,0,"K",CR,LF
.else
.byte CR,LF,"OK",CR,LF
.endif
.endif
.byte 0
.endif
.endif
QT_BREAK:
.ifdef KBD
.byte CR,LF," Brk"
.byte 0
.byte $54,$D0 ; ???
.elseif .def(MICROTAN) || .def(AIM65)
.byte CR,LF," BREAK"
.byte 0
.else
.byte CR,LF,"BREAK"
.byte 0
.endif
rom/misc1.s
+233
View File
@@ -0,0 +1,233 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; CONVERT LINE NUMBER
; ----------------------------------------------------------------------------
LINGET:
ldx #$00
stx LINNUM
stx LINNUM+1
L28BE:
bcs L28B7
sbc #$2F
sta CHARAC
lda LINNUM+1
sta INDEX
cmp #$19
bcs L28A0
; <<<<<DANGEROUS CODE>>>>>
; NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
; ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
; JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
; FOR OTHER CALLS TO LINGET.
;
; YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
; THEN TYPE "GO TO 437761".
;
; ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
; THE PROBLEM. ($AB00 - $ABFF)
; <<<<<DANGEROUS CODE>>>>>
lda LINNUM
asl a
rol INDEX
asl a
rol INDEX
adc LINNUM
sta LINNUM
lda INDEX
adc LINNUM+1
sta LINNUM+1
asl LINNUM
rol LINNUM+1
lda LINNUM
adc CHARAC
sta LINNUM
bcc L28EC
inc LINNUM+1
L28EC:
jsr CHRGET
jmp L28BE
; ----------------------------------------------------------------------------
; "LET" STATEMENT
;
; LET <VAR> = <EXP>
; <VAR> = <EXP>
; ----------------------------------------------------------------------------
LET:
jsr PTRGET
sta FORPNT
sty FORPNT+1
lda #TOKEN_EQUAL
jsr SYNCHR
.ifndef CONFIG_SMALL
lda VALTYP+1
pha
.endif
lda VALTYP
pha
jsr FRMEVL
pla
rol a
jsr CHKVAL
bne LETSTRING
.ifndef CONFIG_SMALL
pla
LET2:
bpl L2923
jsr ROUND_FAC
jsr AYINT
ldy #$00
lda FAC+3
sta (FORPNT),y
iny
lda FAC+4
sta (FORPNT),y
rts
L2923:
.endif
; ----------------------------------------------------------------------------
; REAL VARIABLE = EXPRESSION
; ----------------------------------------------------------------------------
jmp SETFOR
LETSTRING:
.ifndef CONFIG_SMALL
pla
.endif
; ----------------------------------------------------------------------------
; INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4
; ----------------------------------------------------------------------------
PUTSTR:
.ifdef CONFIG_CBM_ALL
ldy FORPNT+1
.ifdef CBM1
cpy #$D0 ; TI$
.else
cpy #$DE
.endif
bne LC92B
jsr FREFAC
cmp #$06
.ifdef CBM2
bne IQERR1
.else
jne IQERR
.endif
ldy #$00
sty FAC
sty FACSIGN
LC8E8:
sty STRNG2
jsr LC91C
jsr MUL10
inc STRNG2
ldy STRNG2
jsr LC91C
jsr COPY_FAC_TO_ARG_ROUNDED
tax
beq LC902
inx
txa
jsr LD9BF
LC902:
ldy STRNG2
iny
cpy #$06
bne LC8E8
jsr MUL10
jsr QINT
ldx #$02
sei
LC912:
lda FAC+2,x
sta TISTR,x
dex
bpl LC912
cli
rts
LC91C:
lda (INDEX),y
jsr CHRGOT2
bcc LC926
IQERR1:
jmp IQERR
LC926:
sbc #$2F
jmp ADDACC
LC92B:
.endif
ldy #$02
lda (FAC_LAST-1),y
cmp FRETOP+1
bcc L2946
bne L2938
dey
lda (FAC_LAST-1),y
cmp FRETOP
bcc L2946
L2938:
ldy FAC_LAST
cpy VARTAB+1
bcc L2946
bne L294D
lda FAC_LAST-1
cmp VARTAB
bcs L294D
L2946:
lda FAC_LAST-1
ldy FAC_LAST
jmp L2963
L294D:
ldy #$00
lda (FAC_LAST-1),y
jsr STRINI
lda DSCPTR
ldy DSCPTR+1
sta STRNG1
sty STRNG1+1
jsr MOVINS
lda #FAC
ldy #$00
L2963:
sta DSCPTR
sty DSCPTR+1
jsr FRETMS
ldy #$00
lda (DSCPTR),y
sta (FORPNT),y
iny
lda (DSCPTR),y
sta (FORPNT),y
iny
lda (DSCPTR),y
sta (FORPNT),y
RET5:
rts
.ifdef AIM65
LB89D:
cmp #$21
bne RET5
lda #$80
sta PRIFLG
jmp CHRGET
.endif
.ifdef CONFIG_FILE
PRINTH:
jsr CMD
jmp LCAD6
CMD:
jsr GETBYT
beq LC98F
lda #$2C
jsr SYNCHR
LC98F:
php
jsr CHKOUT
stx CURDVC
plp
jmp PRINT
.endif
rom/misc2.s
+174
View File
@@ -0,0 +1,174 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "FRE" FUNCTION
;
; COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT
; ----------------------------------------------------------------------------
FRE:
lda VALTYP
beq L3188
jsr FREFAC
L3188:
jsr GARBAG
sec
lda FRETOP
sbc STREND
tay
lda FRETOP+1
sbc STREND+1
; FALL INTO GIVAYF TO FLOAT THE VALUE
; NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE
; ----------------------------------------------------------------------------
; FLOAT THE SIGNED INTEGER IN A,Y
; ----------------------------------------------------------------------------
GIVAYF:
ldx #$00
stx VALTYP
sta FAC+1
sty FAC+2
ldx #$90
jmp FLOAT1
POS:
ldy POSX
; ----------------------------------------------------------------------------
; FLOAT (Y) INTO FAC, GIVING VALUE 0-255
; ----------------------------------------------------------------------------
SNGFLT:
lda #$00
beq GIVAYF
; ----------------------------------------------------------------------------
; CHECK FOR DIRECT OR RUNNING MODE
; GIVING ERROR IF DIRECT MODE
; ----------------------------------------------------------------------------
ERRDIR:
ldx CURLIN+1
inx
bne RTS9
ldx #ERR_ILLDIR
.ifdef CONFIG_2
.byte $2C
LD288:
ldx #ERR_UNDEFFN
.endif
L31AF:
jmp ERROR
DEF:
jsr FNC
jsr ERRDIR
jsr CHKOPN
lda #$80
sta SUBFLG
jsr PTRGET
jsr CHKNUM
jsr CHKCLS
lda #TOKEN_EQUAL
jsr SYNCHR
.ifndef CONFIG_SMALL
pha
.endif
lda VARPNT+1
pha
lda VARPNT
pha
lda TXTPTR+1
pha
lda TXTPTR
pha
jsr DATA
jmp L3250
FNC:
lda #TOKEN_FN
jsr SYNCHR
ora #$80
sta SUBFLG
jsr PTRGET3
sta FNCNAM
sty FNCNAM+1
jmp CHKNUM
L31F3:
jsr FNC
lda FNCNAM+1
pha
lda FNCNAM
pha
jsr PARCHK
jsr CHKNUM
pla
sta FNCNAM
pla
sta FNCNAM+1
ldy #$02
.ifndef CONFIG_2
ldx #ERR_UNDEFFN
.endif
lda (FNCNAM),y
.ifndef CONFIG_2
beq L31AF
.endif
sta VARPNT
tax
iny
lda (FNCNAM),y
.ifdef CONFIG_2
beq LD288
.endif
sta VARPNT+1
.ifndef CONFIG_SMALL
iny
.endif
L3219:
lda (VARPNT),y
pha
dey
bpl L3219
ldy VARPNT+1
jsr STORE_FAC_AT_YX_ROUNDED
lda TXTPTR+1
pha
lda TXTPTR
pha
lda (FNCNAM),y
sta TXTPTR
iny
lda (FNCNAM),y
sta TXTPTR+1
lda VARPNT+1
pha
lda VARPNT
pha
jsr FRMNUM
pla
sta FNCNAM
pla
sta FNCNAM+1
jsr CHRGOT
beq L324A
jmp SYNERR
L324A:
pla
sta TXTPTR
pla
sta TXTPTR+1
L3250:
ldy #$00
pla
sta (FNCNAM),y
pla
iny
sta (FNCNAM),y
pla
iny
sta (FNCNAM),y
pla
iny
sta (FNCNAM),y
.ifndef CONFIG_SMALL
pla
iny
sta (FNCNAM),y
.endif
rts
rom/misc3.s
+76
View File
@@ -0,0 +1,76 @@
; KBD specific patches
.segment "CODE"
.ifdef KBD
VARTAB_MINUS_2_TO_AY:
lda VARTAB
sec
sbc #$02
ldy VARTAB+1
bcs LF42C
dey
LF42C:
rts
; ----------------------------------------------------------------------------
GET_UPPER:
lda INPUTBUFFERX,x
LF430:
cmp #'a'
bcc LF43A
cmp #'z'+1
bcs LF43A
LF438:
sbc #$1F
LF43A:
rts
; ----------------------------------------------------------------------------
GETLN:
ldx #$5D
LF43D:
txa
and #$7F
cmp $0340
beq LF44D
sta $0340
lda #$03
jsr LDE48
LF44D:
jsr LDE7F
bne RTS4
cpx #$80
bcc LF44D
RTS4:
rts
; ----------------------------------------------------------------------------
LF457:
lda TXTTAB
ldx TXTTAB+1
LF45B:
sta JMPADRS+1
stx JMPADRS+2
ldy #$01
lda (JMPADRS+1),y
beq LF438
iny
iny
lda (JMPADRS+1),y
dey
cmp LINNUM+1
bne LF472
lda (JMPADRS+1),y
cmp LINNUM
LF472:
bcs LF43A
dey
lda (JMPADRS+1),y
tax
dey
lda (JMPADRS+1),y
bcc LF45B
LF47D:
jmp (JMPADRS+1)
.endif
rom/msbasic.s
+34
View File
@@ -0,0 +1,34 @@
.debuginfo +
.setcpu "6502"
.macpack longbranch
.include "defines.s"
.include "macros.s"
.include "zeropage.s"
.include "header.s"
.include "token.s"
.include "error.s"
.include "message.s"
.include "memory.s"
.include "program.s"
.include "flow1.s"
.include "loadsave.s"
.include "flow2.s"
.include "misc1.s"
.include "print.s"
.include "input.s"
.include "eval.s"
.include "var.s"
.include "array.s"
.include "misc2.s"
.include "string.s"
.include "misc3.s"
.include "poke.s"
.include "float.s"
.include "chrget.s"
.include "rnd.s"
.include "trig.s"
.include "init.s"
.include "extra.s"
rom/poke.s
+118
View File
@@ -0,0 +1,118 @@
.segment "CODE"
.ifndef CONFIG_NO_POKE
; ----------------------------------------------------------------------------
; EVALUATE "EXP1,EXP2"
;
; CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM
; CONVERT EXP2 TO 8-BIT NUMBER IN X-REG
; ----------------------------------------------------------------------------
GTNUM:
jsr FRMNUM
jsr GETADR
; ----------------------------------------------------------------------------
; EVALUATE ",EXPRESSION"
; CONVERT EXPRESSION TO SINGLE BYTE IN X-REG
; ----------------------------------------------------------------------------
COMBYTE:
jsr CHKCOM
jmp GETBYT
; ----------------------------------------------------------------------------
; CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM
; ----------------------------------------------------------------------------
GETADR:
lda FACSIGN
.ifdef APPLE
nop ; PATCH
nop
.else
bmi GOIQ
.endif
lda FAC
cmp #$91
bcs GOIQ
jsr QINT
lda FAC_LAST-1
ldy FAC_LAST
sty LINNUM
sta LINNUM+1
rts
; ----------------------------------------------------------------------------
; "PEEK" FUNCTION
; ----------------------------------------------------------------------------
PEEK:
.ifdef CONFIG_PEEK_SAVE_LINNUM
lda LINNUM+1
pha
lda LINNUM
pha
.endif
jsr GETADR
ldy #$00
.ifdef CBM1
; disallow PEEK between $C000 and $DFFF
cmp #$C0
bcc LD6F3
cmp #$E1
bcc LD6F6
LD6F3:
.endif
.ifdef CBM2
nop ; patch that disables the compares above
nop
nop
nop
nop
nop
nop
nop
.endif
lda (LINNUM),y
tay
.ifdef CONFIG_PEEK_SAVE_LINNUM
pla
sta LINNUM
pla
sta LINNUM+1
.endif
LD6F6:
jmp SNGFLT
; ----------------------------------------------------------------------------
; "POKE" STATEMENT
; ----------------------------------------------------------------------------
POKE:
jsr GTNUM
txa
ldy #$00
sta (LINNUM),y
rts
; ----------------------------------------------------------------------------
; "WAIT" STATEMENT
; ----------------------------------------------------------------------------
WAIT:
jsr GTNUM
stx FORPNT
ldx #$00
jsr CHRGOT
.ifdef CONFIG_EASTER_EGG
beq EASTER_EGG
.else
beq L3628
.endif
jsr COMBYTE
L3628:
stx FORPNT+1
ldy #$00
L362C:
lda (LINNUM),y
eor FORPNT+1
and FORPNT
beq L362C
RTS3:
rts
.endif
rom/print.s
+410
View File
@@ -0,0 +1,410 @@
.segment "CODE"
.ifdef AIM65
PRINT:
lda PRIFLG
sta ZBE
jsr L297E
LB8B1:
lda ZBE
sta PRIFLG
rts
.endif
PRSTRING:
jsr STRPRT
L297E:
jsr CHRGOT
; ----------------------------------------------------------------------------
; "PRINT" STATEMENT
; ----------------------------------------------------------------------------
.ifndef AIM65
PRINT:
.endif
beq CRDO
PRINT2:
beq L29DD
.ifdef AIM65
jsr LB89D
beq L29DD
.endif
cmp #TOKEN_TAB
beq L29F5
cmp #TOKEN_SPC
.ifdef CONFIG_2
clc ; also AppleSoft II
.endif
beq L29F5
cmp #','
; Pre-KIM had no CLC. KIM added the CLC
; here. Post-KIM moved the CLC up...
; (makes no sense on KIM, liveness = 0)
.if .def(CONFIG_11A) && (!.def(CONFIG_2))
clc
.endif
beq L29DE
cmp #$3B
beq L2A0D
jsr FRMEVL
bit VALTYP
bmi PRSTRING
jsr FOUT
jsr STRLIT
.ifndef CONFIG_NO_CR
ldy #$00
lda (FAC_LAST-1),y
clc
adc POSX
.ifdef KBD
cmp #$28
.else
cmp Z17
.endif
bcc L29B1
jsr CRDO
L29B1:
.endif
jsr STRPRT
.ifdef KBD
jmp L297E
.else
jsr OUTSP
bne L297E ; branch always
.endif
.ifdef KBD
; PATCHES
LE86C:
pla
jmp CONTROL_C_TYPED
LE870:
jsr GETBYT
txa
LE874:
beq LE878
bpl LE8F2
LE878:
jmp IQERR
; PATCHES
.endif
.ifndef KBD
L29B9:
.ifdef CONFIG_INPUTBUFFER_0200
lda #$00
sta INPUTBUFFER,x
ldx #<(INPUTBUFFER-1)
ldy #>(INPUTBUFFER-1)
.else
.ifndef APPLE
ldy #$00
sty INPUTBUFFER,x
ldx #LINNUM+1
.endif
.if .def(MICROTAN) || .def(SYM1)
bne CRDO2
.endif
.endif
.ifdef CONFIG_FILE
lda CURDVC
bne L29DD
.endif
.endif
CRDO:
.if .def(CONFIG_PRINTNULLS) && .def(CONFIG_FILE)
lda CURDVC
bne LC9D8
sta POSX
LC9D8:
.endif
lda #CRLF_1
.ifndef CONFIG_CBM_ALL
sta POSX
.endif
jsr OUTDO
CRDO2:
lda #CRLF_2
jsr OUTDO
PRINTNULLS:
.if .def(KBD) || .def(AIM65)
lda #$00
sta POSX
eor #$FF
.else
.if .def(CONFIG_NULL) || .def(CONFIG_PRINTNULLS)
.ifdef CONFIG_FILE
; Although there is no statement for it,
; CBM1 had NULL support and ignores
; it when not targeting the screen,
; CBM2 dropped it completely.
lda CURDVC
bne L29DD
.endif
txa
pha
ldx Z15
beq L29D9
.ifdef SYM1
lda #$FF
.else
lda #$00
.endif
L29D3:
jsr OUTDO
dex
bne L29D3
L29D9:
stx POSX
pla
tax
.else
.ifndef CONFIG_2
lda #$00
sta POSX
.endif
eor #$FF
.endif
.endif
L29DD:
rts
L29DE:
lda POSX
.ifndef CONFIG_NO_CR
.ifdef KBD
cmp #$1A
.else
cmp Z18
.endif
bcc L29EA
jsr CRDO
jmp L2A0D
L29EA:
.endif
sec
L29EB:
.if .def(CONFIG_CBM_ALL) || .def(AIM65)
sbc #$0A
.else
.ifdef KBD
sbc #$0D
.else
sbc #$0E
.endif
.endif
bcs L29EB
eor #$FF
adc #$01
bne L2A08
L29F5:
.ifdef CONFIG_11A
php
.else
pha
.endif
jsr GTBYTC
cmp #')'
.ifdef CONFIG_11A
.ifdef CONFIG_2
bne SYNERR4
.else
jne SYNERR
.endif
plp
bcc L2A09
.else
.ifdef CONFIG_11
jne SYNERR
.else
bne SYNERR4
.endif
pla
cmp #TOKEN_TAB
.ifdef CONFIG_11
bne L2A09
.else
bne L2A0A
.endif
.endif
txa
sbc POSX
bcc L2A0D
.ifndef CONFIG_11
beq L2A0D
.endif
L2A08:
tax
.ifdef CONFIG_11
L2A09:
inx
.endif
L2A0A:
.ifndef CONFIG_11
jsr OUTSP
.endif
dex
.ifndef CONFIG_11
bne L2A0A
.else
bne L2A13
.endif
L2A0D:
jsr CHRGET
jmp PRINT2
.ifdef CONFIG_11
L2A13:
jsr OUTSP
bne L2A0A
.endif
; ----------------------------------------------------------------------------
; PRINT STRING AT (Y,A)
; ----------------------------------------------------------------------------
STROUT:
jsr STRLIT
; ----------------------------------------------------------------------------
; PRINT STRING AT (FACMO,FACLO)
; ----------------------------------------------------------------------------
STRPRT:
jsr FREFAC
tax
ldy #$00
inx
L2A22:
dex
beq L29DD
lda (INDEX),y
jsr OUTDO
iny
cmp #$0D
bne L2A22
jsr PRINTNULLS
jmp L2A22
; ----------------------------------------------------------------------------
OUTSP:
.ifdef CONFIG_FILE
.ifndef CBM1
; on non-screen devices, print SPACE
; instead of CRSR RIGHT
lda CURDVC
beq LCA40
lda #$20
.byte $2C
LCA40:
.endif
lda #$1D ; CRSR RIGHT
.else
lda #$20
.endif
.byte $2C
OUTQUES:
lda #$3F
; ----------------------------------------------------------------------------
; PRINT CHAR FROM (A)
; ----------------------------------------------------------------------------
OUTDO:
.ifndef KBD
bit Z14
bmi L2A56
.endif
.if .def(CONFIG_PRINT_CR) || .def(CBM1)
; Commodore forgot to remove this in CBM1
pha
.endif
.ifdef CBM1
cmp #$1D ; CRSR RIGHT
beq LCA6A
cmp #$9D ; CRSR LEFT
beq LCA5A
cmp #$14 ; DEL
bne LCA64
LCA5A:
lda POSX
beq L2A4E
lda CURDVC
bne L2A4E
dec POSX
LCA64:
and #$7F
.endif
.ifndef CBM2
cmp #$20
bcc L2A4E
.endif
LCA6A:
.ifdef CONFIG_CBM1_PATCHES
lda CURDVC
jsr PATCH6
nop
.endif
.ifdef CONFIG_PRINT_CR
lda POSX
cmp Z17
bne L2A4C
.ifdef AIM65
lda #$00
sta POSX
.elseif .def(APPLE)
nop ; PATCH!
nop ; don't print CR
nop
.else
jsr CRDO
.endif
L2A4C:
.endif
.ifndef CONFIG_CBM_ALL
inc POSX
.endif
L2A4E:
.if .def(CONFIG_PRINT_CR) || .def(CBM1)
; Commodore forgot to remove this in CBM1
pla
.endif
.ifdef CONFIG_MONCOUT_DESTROYS_Y
sty DIMFLG
.endif
.ifdef CONFIG_IO_MSB
ora #$80
.endif
jsr MONCOUT
.ifdef CONFIG_IO_MSB
and #$7F
.endif
.ifdef CONFIG_MONCOUT_DESTROYS_Y
ldy DIMFLG
.endif
.ifdef OSI
nop
nop
nop
nop
.endif
L2A56:
and #$FF
LE8F2:
rts
; ----------------------------------------------------------------------------
; ???
; ----------------------------------------------------------------------------
.ifdef KBD
LE8F3:
pha
lda $047F
clc
beq LE900
lda #$00
sta $047F
sec
LE900:
pla
rts
.endif
rom/program.s
+811
View File
@@ -0,0 +1,811 @@
; error
; line input, line editing
; tokenize
; detokenize
; BASIC program memory management
; MICROTAN has some nonstandard extension to LIST here
.segment "CODE"
MEMERR:
ldx #ERR_MEMFULL
; ----------------------------------------------------------------------------
; HANDLE AN ERROR
;
; (X)=OFFSET IN ERROR MESSAGE TABLE
; (ERRFLG) > 128 IF "ON ERR" TURNED ON
; (CURLIN+1) = $FF IF IN DIRECT MODE
; ----------------------------------------------------------------------------
ERROR:
lsr Z14
.ifdef CONFIG_FILE
lda CURDVC ; output
beq LC366 ; is screen
jsr CLRCH ; otherwise redirect output back to screen
lda #$00
sta CURDVC
LC366:
.endif
jsr CRDO
jsr OUTQUES
L2329:
lda ERROR_MESSAGES,x
.ifndef CONFIG_SMALL_ERROR
pha
and #$7F
.endif
jsr OUTDO
.ifdef CONFIG_SMALL_ERROR
lda ERROR_MESSAGES+1,x
.ifdef KBD
and #$7F
.endif
jsr OUTDO
.else
inx
pla
bpl L2329
.endif
jsr STKINI
lda #<QT_ERROR
ldy #>QT_ERROR
; ----------------------------------------------------------------------------
; PRINT STRING AT (Y,A)
; PRINT CURRENT LINE # UNLESS IN DIRECT MODE
; FALL INTO WARM RESTART
; ----------------------------------------------------------------------------
PRINT_ERROR_LINNUM:
jsr STROUT
ldy CURLIN+1
iny
beq RESTART
jsr INPRT
; ----------------------------------------------------------------------------
; WARM RESTART ENTRY
; ----------------------------------------------------------------------------
RESTART:
.ifdef KBD
jsr CRDO
nop
L2351X:
jsr OKPRT
L2351:
jsr INLIN
LE28E:
bpl RESTART
.else
lsr Z14
.ifndef AIM65
lda #<QT_OK
ldy #>QT_OK
.ifdef CONFIG_CBM_ALL
jsr STROUT
.else
jsr GOSTROUT
.endif
.else
jsr GORESTART
.endif
L2351:
jsr INLIN
.endif
stx TXTPTR
sty TXTPTR+1
jsr CHRGET
.ifdef CONFIG_11
; bug in pre-1.1: CHRGET sets Z on '\0'
; and ':' - a line starting with ':' in
; direct mode gets ignored
tax
.endif
.ifdef KBD
beq L2351X
.else
beq L2351
.endif
ldx #$FF
stx CURLIN+1
bcc NUMBERED_LINE
jsr PARSE_INPUT_LINE
jmp NEWSTT2
; ----------------------------------------------------------------------------
; HANDLE NUMBERED LINE
; ----------------------------------------------------------------------------
NUMBERED_LINE:
jsr LINGET
jsr PARSE_INPUT_LINE
sty EOLPNTR
.ifdef KBD
jsr FNDLIN2
lda JMPADRS+1
sta LOWTR
sta Z96
lda JMPADRS+2
sta LOWTR+1
sta Z96+1
lda LINNUM
sta L06FE
lda LINNUM+1
sta L06FE+1
inc LINNUM
bne LE2D2
inc LINNUM+1
bne LE2D2
jmp SYNERR
LE2D2:
jsr LF457
ldx #Z96
jsr CMPJMPADRS
bcs LE2FD
LE2DC:
ldx #$00
lda (JMPADRS+1,x)
sta (Z96,x)
inc JMPADRS+1
bne LE2E8
inc JMPADRS+2
LE2E8:
inc Z96
bne LE2EE
inc Z96+1
LE2EE:
ldx #VARTAB
jsr CMPJMPADRS
bne LE2DC
lda Z96
sta VARTAB
lda Z96+1
sta VARTAB+1
LE2FD:
jsr SETPTRS
jsr LE33D
lda INPUTBUFFER
LE306:
beq LE28E
cmp #$A5
beq LE306
clc
.else
jsr FNDLIN
bcc PUT_NEW_LINE
ldy #$01
lda (LOWTR),y
sta INDEX+1
lda VARTAB
sta INDEX
lda LOWTR+1
sta DEST+1
lda LOWTR
dey
sbc (LOWTR),y
clc
adc VARTAB
sta VARTAB
sta DEST
lda VARTAB+1
adc #$FF
sta VARTAB+1
sbc LOWTR+1
tax
sec
lda LOWTR
sbc VARTAB
tay
bcs L23A5
inx
dec DEST+1
L23A5:
clc
adc INDEX
bcc L23AD
dec INDEX+1
clc
L23AD:
lda (INDEX),y
sta (DEST),y
iny
bne L23AD
inc INDEX+1
inc DEST+1
dex
bne L23AD
.endif
; ----------------------------------------------------------------------------
PUT_NEW_LINE:
.ifndef KBD
.ifdef CONFIG_2
jsr SETPTRS
jsr LE33D
lda INPUTBUFFER
beq L2351
clc
.else
lda INPUTBUFFER
beq FIX_LINKS
lda MEMSIZ
ldy MEMSIZ+1
sta FRETOP
sty FRETOP+1
.endif
.endif
lda VARTAB
sta HIGHTR
adc EOLPNTR
sta HIGHDS
ldy VARTAB+1
sty HIGHTR+1
bcc L23D6
iny
L23D6:
sty HIGHDS+1
jsr BLTU
.ifdef CONFIG_INPUTBUFFER_0200
lda LINNUM
ldy LINNUM+1
sta INPUTBUFFER-2
sty INPUTBUFFER-1
.endif
lda STREND
ldy STREND+1
sta VARTAB
sty VARTAB+1
ldy EOLPNTR
dey
; ---COPY LINE INTO PROGRAM-------
L23E6:
lda INPUTBUFFER-4,y
sta (LOWTR),y
dey
bpl L23E6
; ----------------------------------------------------------------------------
; CLEAR ALL VARIABLES
; RE-ESTABLISH ALL FORWARD LINKS
; ----------------------------------------------------------------------------
FIX_LINKS:
jsr SETPTRS
.ifdef CONFIG_2
jsr LE33D
jmp L2351
LE33D:
.endif
lda TXTTAB
ldy TXTTAB+1
sta INDEX
sty INDEX+1
clc
L23FA:
ldy #$01
lda (INDEX),y
.ifdef CONFIG_2
beq RET3
.else
jeq L2351
.endif
ldy #$04
L2405:
iny
lda (INDEX),y
bne L2405
iny
tya
adc INDEX
tax
ldy #$00
sta (INDEX),y
lda INDEX+1
adc #$00
iny
sta (INDEX),y
stx INDEX
sta INDEX+1
bcc L23FA ; always
; ----------------------------------------------------------------------------
.ifdef KBD
.include "kbd_loadsave.s"
.endif
.ifdef CONFIG_2
; !!! kbd_loadsave.s requires an RTS here!
RET3:
rts
.endif
.include "inline.s"
; ----------------------------------------------------------------------------
; TOKENIZE THE INPUT LINE
; ----------------------------------------------------------------------------
PARSE_INPUT_LINE:
ldx TXTPTR
ldy #$04
sty DATAFLG
L246C:
lda INPUTBUFFERX,x
.ifdef CONFIG_CBM_ALL
bpl LC49E
cmp #$FF
beq L24AC
inx
bne L246C
LC49E:
.endif
cmp #$20
beq L24AC
sta ENDCHR
cmp #$22
beq L24D0
bit DATAFLG
bvs L24AC
cmp #$3F
bne L2484
lda #TOKEN_PRINT
bne L24AC
L2484:
cmp #$30
bcc L248C
cmp #$3C
bcc L24AC
; ----------------------------------------------------------------------------
; SEARCH TOKEN NAME TABLE FOR MATCH STARTING
; WITH CURRENT CHAR FROM INPUT LINE
; ----------------------------------------------------------------------------
L248C:
sty STRNG2
ldy #$00
sty EOLPNTR
dey
stx TXTPTR
dex
L2496:
iny
L2497:
inx
L2498:
.ifdef KBD
jsr GET_UPPER
.else
lda INPUTBUFFERX,x
.ifndef CONFIG_2
cmp #$20
beq L2497
.endif
.endif
sec
sbc TOKEN_NAME_TABLE,y
beq L2496
cmp #$80
bne L24D7
ora EOLPNTR
; ----------------------------------------------------------------------------
; STORE CHARACTER OR TOKEN IN OUTPUT LINE
; ----------------------------------------------------------------------------
L24AA:
ldy STRNG2
L24AC:
inx
iny
sta INPUTBUFFER-5,y
lda INPUTBUFFER-5,y
beq L24EA
sec
sbc #$3A
beq L24BF
cmp #$49
bne L24C1
L24BF:
sta DATAFLG
L24C1:
sec
sbc #TOKEN_REM-':'
bne L246C
sta ENDCHR
; ----------------------------------------------------------------------------
; HANDLE LITERAL (BETWEEN QUOTES) OR REMARK,
; BY COPYING CHARS UP TO ENDCHR.
; ----------------------------------------------------------------------------
L24C8:
lda INPUTBUFFERX,x
beq L24AC
cmp ENDCHR
beq L24AC
L24D0:
iny
sta INPUTBUFFER-5,y
inx
bne L24C8
; ----------------------------------------------------------------------------
; ADVANCE POINTER TO NEXT TOKEN NAME
; ----------------------------------------------------------------------------
L24D7:
ldx TXTPTR
inc EOLPNTR
L24DB:
iny
lda MATHTBL+28+1,y
bpl L24DB
lda TOKEN_NAME_TABLE,y
bne L2498
lda INPUTBUFFERX,x
bpl L24AA
; ---END OF LINE------------------
L24EA:
sta INPUTBUFFER-3,y
.ifdef CONFIG_NO_INPUTBUFFER_ZP
dec TXTPTR+1
.endif
lda #<(INPUTBUFFER-1)
sta TXTPTR
rts
; ----------------------------------------------------------------------------
; SEARCH FOR LINE
;
; (LINNUM) = LINE # TO FIND
; IF NOT FOUND: CARRY = 0
; LOWTR POINTS AT NEXT LINE
; IF FOUND: CARRY = 1
; LOWTR POINTS AT LINE
; ----------------------------------------------------------------------------
FNDLIN:
.ifdef KBD
jsr CHRGET
jmp LE444
LE440:
php
jsr LINGET
LE444:
jsr LF457
ldx #$FF
plp
beq LE464
jsr CHRGOT
beq L2520
cmp #$A5
bne L2520
jsr CHRGET
beq LE464
bcs LE461
jsr LINGET
beq L2520
LE461:
jmp SYNERR
LE464:
stx LINNUM
stx LINNUM+1
.else
lda TXTTAB
ldx TXTTAB+1
FL1:
ldy #$01
sta LOWTR
stx LOWTR+1
lda (LOWTR),y
beq L251F
iny
iny
lda LINNUM+1
cmp (LOWTR),y
bcc L2520
beq L250D
dey
bne L2516
L250D:
lda LINNUM
dey
cmp (LOWTR),y
bcc L2520
beq L2520
L2516:
dey
lda (LOWTR),y
tax
dey
lda (LOWTR),y
bcs FL1
L251F:
clc
.endif
L2520:
rts
; ----------------------------------------------------------------------------
; "NEW" STATEMENT
; ----------------------------------------------------------------------------
NEW:
bne L2520
SCRTCH:
lda #$00
tay
sta (TXTTAB),y
iny
sta (TXTTAB),y
lda TXTTAB
.ifdef CONFIG_2
clc
.endif
adc #$02
sta VARTAB
lda TXTTAB+1
adc #$00
sta VARTAB+1
; ----------------------------------------------------------------------------
SETPTRS:
jsr STXTPT
.ifdef CONFIG_11A
lda #$00
; ----------------------------------------------------------------------------
; "CLEAR" STATEMENT
; ----------------------------------------------------------------------------
CLEAR:
bne L256A
.endif
CLEARC:
.ifdef KBD
lda #<CONST_MEMSIZ
ldy #>CONST_MEMSIZ
.else
lda MEMSIZ
ldy MEMSIZ+1
.endif
sta FRETOP
sty FRETOP+1
.ifdef CONFIG_CBM_ALL
jsr CLALL
.endif
lda VARTAB
ldy VARTAB+1
sta ARYTAB
sty ARYTAB+1
sta STREND
sty STREND+1
jsr RESTORE
; ----------------------------------------------------------------------------
STKINI:
ldx #TEMPST
stx TEMPPT
pla
.ifdef CONFIG_2
tay
.else
sta STACK+STACK_TOP+1
.endif
pla
.ifndef CONFIG_2
sta STACK+STACK_TOP+2
.endif
ldx #STACK_TOP
txs
.ifdef CONFIG_2
pha
tya
pha
.endif
lda #$00
sta OLDTEXT+1
sta SUBFLG
L256A:
rts
; ----------------------------------------------------------------------------
; SET TXTPTR TO BEGINNING OF PROGRAM
; ----------------------------------------------------------------------------
STXTPT:
clc
lda TXTTAB
adc #$FF
sta TXTPTR
lda TXTTAB+1
adc #$FF
sta TXTPTR+1
rts
; ----------------------------------------------------------------------------
.ifdef KBD
LE4C0:
ldy #<LE444
ldx #>LE444
LE4C4:
jsr LFFD6
jsr LFFED
lda $0504
clc
adc #$08
sta $0504
rts
CMPJMPADRS:
lda 1,x
cmp JMPADRS+2
bne LE4DE
lda 0,x
cmp JMPADRS+1
LE4DE:
rts
.endif
; ----------------------------------------------------------------------------
; "LIST" STATEMENT
; ----------------------------------------------------------------------------
LIST:
.ifdef KBD
jsr LE440
bne LE4DE
pla
pla
L25A6:
jsr CRDO
.else
.ifdef AIM65
pha
lda #$00
LB4BF:
sta INPUTFLG
pla
.endif
.ifdef MICROTAN
php
jmp LE21C ; patch
LC57E:
.elseif .def(AIM65) || .def(SYM1)
php
jsr LINGET
LC57E:
.else
bcc L2581
beq L2581
cmp #TOKEN_MINUS
bne L256A
L2581:
jsr LINGET
.endif
jsr FNDLIN
.if .def(MICROTAN) || .def(AIM65) || .def(SYM1)
plp
beq L2598
.endif
jsr CHRGOT
.if .def(MICROTAN) || .def(AIM65) || .def(SYM1)
beq L25A6
.else
beq L2598
.endif
cmp #TOKEN_MINUS
bne L2520
jsr CHRGET
.if .def(MICROTAN) || .def(AIM65) || .def(SYM1)
beq L2598
jsr LINGET
beq L25A6
rts
.else
jsr LINGET
bne L2520
.endif
L2598:
.if !(.def(MICROTAN) || .def(AIM65) || .def(SYM1))
pla
pla
lda LINNUM
ora LINNUM+1
bne L25A6
.endif
lda #$FF
sta LINNUM
sta LINNUM+1
L25A6:
.if .def(MICROTAN) || .def(AIM65) || .def(SYM1)
pla
pla
.endif
L25A6X:
.endif
ldy #$01
.ifdef CONFIG_DATAFLG
sty DATAFLG
.endif
lda (LOWTRX),y
beq L25E5
.ifdef MICROTAN
jmp LE21F
LC5A9:
.else
jsr ISCNTC
.endif
.ifndef KBD
jsr CRDO
.endif
iny
lda (LOWTRX),y
tax
iny
lda (LOWTRX),y
cmp LINNUM+1
bne L25C1
cpx LINNUM
beq L25C3
L25C1:
bcs L25E5
; ---LIST ONE LINE----------------
L25C3:
sty FORPNT
jsr LINPRT
lda #$20
L25CA:
ldy FORPNT
and #$7F
L25CE:
jsr OUTDO
.ifdef CONFIG_DATAFLG
cmp #$22
bne LA519
lda DATAFLG
eor #$FF
sta DATAFLG
LA519:
.endif
iny
.ifdef CONFIG_11
beq L25E5
.endif
lda (LOWTRX),y
bne L25E8
tay
lda (LOWTRX),y
tax
iny
lda (LOWTRX),y
stx LOWTRX
sta LOWTRX+1
.if .def(MICROTAN) || .def(AIM65) || .def(SYM1)
bne L25A6X
.else
bne L25A6
.endif
L25E5:
.ifdef AIM65
lda INPUTFLG
beq L25E5a
jsr CRDO
jsr CRDO
lda #$1a
jsr OUTDO
jsr $e50a
L25E5a:
.endif
jmp RESTART
L25E8:
bpl L25CE
.ifdef CONFIG_DATAFLG
cmp #$FF
beq L25CE
bit DATAFLG
bmi L25CE
.endif
sec
sbc #$7F
tax
sty FORPNT
ldy #$FF
L25F2:
dex
beq L25FD
L25F5:
iny
lda TOKEN_NAME_TABLE,y
bpl L25F5
bmi L25F2
L25FD:
iny
lda TOKEN_NAME_TABLE,y
bmi L25CA
jsr OUTDO
bne L25FD ; always
rom/rnd.s
+135
View File
@@ -0,0 +1,135 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "RND" FUNCTION
; ----------------------------------------------------------------------------
.ifdef KBD
RND:
ldx #$10
jsr SIGN
beq LFC26
bmi LFC10
lda RNDSEED
ldy RNDSEED+1
LFBFA:
sta FAC+2
sty FAC+1
LFBFE:
asl a
asl a
eor FAC+2
asl a
eor FAC+1
asl a
asl a
asl a
asl a
eor FAC+1
asl a
rol FAC+2
rol FAC+1
LFC10:
lda FAC+2
dex
bne LFBFE
sta RNDSEED
sta FAC+3
lda FAC+1
sta RNDSEED+1
lda #$80
sta FAC
stx FACSIGN
jmp NORMALIZE_FAC2
LFC26:
ldy $03CA
lda $03C7
ora #$01
GOMOVMF:
bne LFBFA
.byte $F0
.else
; <<< THESE ARE MISSING ONE BYTE FOR FP VALUES >>>
; (non CONFIG_SMALL)
CONRND1:
.byte $98,$35,$44,$7A
CONRND2:
.byte $68,$28,$B1,$46
RND:
jsr SIGN
.ifdef CONFIG_CBM_ALL
bmi L3F01
bne LDF63
lda ENTROPY
sta FAC+1
lda ENTROPY+4
sta FAC+2
lda ENTROPY+1
sta FAC+3
lda ENTROPY+5
sta FAC+4
jmp LDF88
LDF63:
.else
tax
bmi L3F01
.endif
lda #<RNDSEED
ldy #>RNDSEED
jsr LOAD_FAC_FROM_YA
.ifndef CONFIG_CBM_ALL
txa
beq RTS19
.endif
lda #<CONRND1
ldy #>CONRND1
jsr FMULT
lda #<CONRND2
ldy #>CONRND2
jsr FADD
L3F01:
ldx FAC_LAST
lda FAC+1
sta FAC_LAST
stx FAC+1
.ifdef CONFIG_CBM_ALL
ldx FAC+2
lda FAC+3
sta FAC+2
stx FAC+3
LDF88:
.endif
lda #$00
sta FACSIGN
lda FAC
sta FACEXTENSION
lda #$80
sta FAC
jsr NORMALIZE_FAC2
ldx #<RNDSEED
ldy #>RNDSEED
GOMOVMF:
jmp STORE_FAC_AT_YX_ROUNDED
.endif
.segment "CHRGET"
; ----------------------------------------------------------------------------
; INITIAL VALUE FOR RANDOM NUMBER, ALSO COPIED
; IN ALONG WITH CHRGET, BUT ERRONEOUSLY:
; <<< THE LAST BYTE IS NOT COPIED >>>
; (on all non-CONFIG_SMALL)
; ----------------------------------------------------------------------------
GENERIC_RNDSEED:
.ifndef KBD
; random number seed
.ifdef CONFIG_SMALL
.byte $80,$4F,$C7,$52
.else
.ifdef CONFIG_11
.byte $80,$4F,$C7,$52,$58
.else
.byte $80,$4F,$C7,$52,$59
.endif
.endif
.endif
GENERIC_CHRGET_END:
rom/string.s
+786
View File
@@ -0,0 +1,786 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "STR$" FUNCTION
; ----------------------------------------------------------------------------
STR:
jsr CHKNUM
ldy #$00
jsr FOUT1
pla
pla
LD353:
lda #<(STACK2-1)
ldy #>(STACK2-1)
.if STACK2 > $0100
bne STRLIT
.else
beq STRLIT
.endif
; ----------------------------------------------------------------------------
; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
; ADDRESS IS IN FAC+3,4 AND WHOSE LENGTH IS IN A-REG
; ----------------------------------------------------------------------------
STRINI:
ldx FAC_LAST-1
ldy FAC_LAST
stx DSCPTR
sty DSCPTR+1
; ----------------------------------------------------------------------------
; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
; ADDRESS IS IN Y,X AND WHOSE LENGTH IS IN A-REG
; ----------------------------------------------------------------------------
STRSPA:
jsr GETSPA
stx FAC+1
sty FAC+2
sta FAC
rts
; ----------------------------------------------------------------------------
; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
; AND TERMINATED BY $00 OR QUOTATION MARK
; RETURN WITH DESCRIPTOR IN A TEMPORARY
; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
; ----------------------------------------------------------------------------
STRLIT:
ldx #$22
stx CHARAC
stx ENDCHR
; ----------------------------------------------------------------------------
; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
; AND TERMINATED BY $00, (CHARAC), OR (ENDCHR)
;
; RETURN WITH DESCRIPTOR IN A TEMPORARY
; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
; ----------------------------------------------------------------------------
STRLT2:
sta STRNG1
sty STRNG1+1
sta FAC+1
sty FAC+2
ldy #$FF
L3298:
iny
lda (STRNG1),y
beq L32A9
cmp CHARAC
beq L32A5
cmp ENDCHR
bne L3298
L32A5:
cmp #$22
beq L32AA
L32A9:
clc
L32AA:
sty FAC
tya
adc STRNG1
sta STRNG2
ldx STRNG1+1
bcc L32B6
inx
L32B6:
stx STRNG2+1
lda STRNG1+1
.ifdef CONFIG_NO_INPUTBUFFER_ZP
beq LD399
cmp #>INPUTBUFFER
.elseif .def(AIM65)
beq LD399
cmp #$01
.endif
bne PUTNEW
LD399:
tya
jsr STRINI
ldx STRNG1
ldy STRNG1+1
jsr MOVSTR
; ----------------------------------------------------------------------------
; STORE DESCRIPTOR IN TEMPORARY DESCRIPTOR STACK
;
; THE DESCRIPTOR IS NOW IN FAC, FAC+1, FAC+2
; PUT ADDRESS OF TEMP DESCRIPTOR IN FAC+3,4
; ----------------------------------------------------------------------------
PUTNEW:
ldx TEMPPT
cpx #TEMPST+9
bne PUTEMP
ldx #ERR_FRMCPX
JERR:
jmp ERROR
PUTEMP:
lda FAC
sta 0,x
lda FAC+1
sta 1,x
lda FAC+2
sta 2,x
ldy #$00
stx FAC_LAST-1
sty FAC_LAST
.ifdef CONFIG_2
sty FACEXTENSION
.endif
dey
sty VALTYP
stx LASTPT
inx
inx
inx
stx TEMPPT
rts
; ----------------------------------------------------------------------------
; MAKE SPACE FOR STRING AT BOTTOM OF STRING SPACE
; (A)=# BYTES SPACE TO MAKE
;
; RETURN WITH (A) SAME,
; AND Y,X = ADDRESS OF SPACE ALLOCATED
; ----------------------------------------------------------------------------
GETSPA:
lsr DATAFLG
L32F1:
pha
eor #$FF
sec
adc FRETOP
ldy FRETOP+1
bcs L32FC
dey
L32FC:
cpy STREND+1
bcc L3311
bne L3306
cmp STREND
bcc L3311
L3306:
sta FRETOP
sty FRETOP+1
sta FRESPC
sty FRESPC+1
tax
pla
rts
L3311:
ldx #ERR_MEMFULL
lda DATAFLG
bmi JERR
jsr GARBAG
lda #$80
sta DATAFLG
pla
bne L32F1
; ----------------------------------------------------------------------------
; SHOVE ALL REFERENCED STRINGS AS HIGH AS POSSIBLE
; IN MEMORY (AGAINST HIMEM), FREEING UP SPACE
; BELOW STRING AREA DOWN TO STREND.
; ----------------------------------------------------------------------------
GARBAG:
.ifdef CONST_MEMSIZ
ldx #<CONST_MEMSIZ
lda #>CONST_MEMSIZ
.else
ldx MEMSIZ
lda MEMSIZ+1
.endif
FINDHIGHESTSTRING:
stx FRETOP
sta FRETOP+1
ldy #$00
sty FNCNAM+1
.ifdef CONFIG_2
sty FNCNAM ; GC bugfix!
.endif
lda STREND
ldx STREND+1
sta LOWTR
stx LOWTR+1
lda #TEMPST
ldx #$00
sta INDEX
stx INDEX+1
L333D:
cmp TEMPPT
beq L3346
jsr CHECK_VARIABLE
beq L333D
L3346:
lda #BYTES_PER_VARIABLE
sta DSCLEN
lda VARTAB
ldx VARTAB+1
sta INDEX
stx INDEX+1
L3352:
cpx ARYTAB+1
bne L335A
cmp ARYTAB
beq L335F
L335A:
jsr CHECK_SIMPLE_VARIABLE
beq L3352
L335F:
sta HIGHDS
stx HIGHDS+1
lda #$03 ; OSI GC bugfix -> $04 ???
sta DSCLEN
L3367:
lda HIGHDS
ldx HIGHDS+1
L336B:
cpx STREND+1
bne L3376
cmp STREND
bne L3376
jmp MOVE_HIGHEST_STRING_TO_TOP
L3376:
sta INDEX
stx INDEX+1
.ifdef CONFIG_SMALL
ldy #$01
.else
ldy #$00
lda (INDEX),y
tax
iny
.endif
lda (INDEX),y
php
iny
lda (INDEX),y
adc HIGHDS
sta HIGHDS
iny
lda (INDEX),y
adc HIGHDS+1
sta HIGHDS+1
plp
bpl L3367
.ifndef CONFIG_SMALL
txa
bmi L3367
.endif
iny
lda (INDEX),y
.ifdef CONFIG_CBM1_PATCHES
jsr LE7F3 ; XXX patch, call into screen editor
.else
.ifdef CONFIG_11
ldy #$00 ; GC bugfix
.endif
asl a
adc #$05
.endif
adc INDEX
sta INDEX
bcc L33A7
inc INDEX+1
L33A7:
ldx INDEX+1
L33A9:
cpx HIGHDS+1
bne L33B1
cmp HIGHDS
beq L336B
L33B1:
jsr CHECK_VARIABLE
beq L33A9
; ----------------------------------------------------------------------------
; PROCESS A SIMPLE VARIABLE
; ----------------------------------------------------------------------------
CHECK_SIMPLE_VARIABLE:
.ifndef CONFIG_SMALL
lda (INDEX),y
bmi CHECK_BUMP
.endif
iny
lda (INDEX),y
bpl CHECK_BUMP
iny
; ----------------------------------------------------------------------------
; IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST
; ----------------------------------------------------------------------------
CHECK_VARIABLE:
lda (INDEX),y
beq CHECK_BUMP
iny
lda (INDEX),y
tax
iny
lda (INDEX),y
cmp FRETOP+1
bcc L33D5
bne CHECK_BUMP
cpx FRETOP
bcs CHECK_BUMP
L33D5:
cmp LOWTR+1
bcc CHECK_BUMP
bne L33DF
cpx LOWTR
bcc CHECK_BUMP
L33DF:
stx LOWTR
sta LOWTR+1
lda INDEX
ldx INDEX+1
sta FNCNAM
stx FNCNAM+1
lda DSCLEN
sta Z52
; ----------------------------------------------------------------------------
; ADD (DSCLEN) TO PNTR IN INDEX
; RETURN WITH Y=0, PNTR ALSO IN X,A
; ----------------------------------------------------------------------------
CHECK_BUMP:
lda DSCLEN
clc
adc INDEX
sta INDEX
bcc L33FA
inc INDEX+1
L33FA:
ldx INDEX+1
ldy #$00
rts
; ----------------------------------------------------------------------------
; FOUND HIGHEST NON-EMPTY STRING, SO MOVE IT
; TO TOP AND GO BACK FOR ANOTHER
; ----------------------------------------------------------------------------
MOVE_HIGHEST_STRING_TO_TOP:
.ifdef CONFIG_2
lda FNCNAM+1 ; GC bugfix
ora FNCNAM
.else
ldx FNCNAM+1
.endif
beq L33FA
lda Z52
.ifndef CONFIG_10A
sbc #$03
.else
and #$04
.endif
lsr a
tay
sta Z52
lda (FNCNAM),y
adc LOWTR
sta HIGHTR
lda LOWTR+1
adc #$00
sta HIGHTR+1
lda FRETOP
ldx FRETOP+1
sta HIGHDS
stx HIGHDS+1
jsr BLTU2
ldy Z52
iny
lda HIGHDS
sta (FNCNAM),y
tax
inc HIGHDS+1
lda HIGHDS+1
iny
sta (FNCNAM),y
jmp FINDHIGHESTSTRING
; ----------------------------------------------------------------------------
; CONCATENATE TWO STRINGS
; ----------------------------------------------------------------------------
CAT:
lda FAC_LAST
pha
lda FAC_LAST-1
pha
jsr FRM_ELEMENT
jsr CHKSTR
pla
sta STRNG1
pla
sta STRNG1+1
ldy #$00
lda (STRNG1),y
clc
adc (FAC_LAST-1),y
bcc L3454
ldx #ERR_STRLONG
jmp ERROR
L3454:
jsr STRINI
jsr MOVINS
lda DSCPTR
ldy DSCPTR+1
jsr FRETMP
jsr MOVSTR1
lda STRNG1
ldy STRNG1+1
jsr FRETMP
jsr PUTNEW
jmp FRMEVL2
; ----------------------------------------------------------------------------
; GET STRING DESCRIPTOR POINTED AT BY (STRNG1)
; AND MOVE DESCRIBED STRING TO (FRESPC)
; ----------------------------------------------------------------------------
MOVINS:
ldy #$00
lda (STRNG1),y
pha
iny
lda (STRNG1),y
tax
iny
lda (STRNG1),y
tay
pla
; ----------------------------------------------------------------------------
; MOVE STRING AT (Y,X) WITH LENGTH (A)
; TO DESTINATION WHOSE ADDRESS IS IN FRESPC,FRESPC+1
; ----------------------------------------------------------------------------
MOVSTR:
stx INDEX
sty INDEX+1
MOVSTR1:
tay
beq L3490
pha
L3487:
dey
lda (INDEX),y
sta (FRESPC),y
tya
bne L3487
pla
L3490:
clc
adc FRESPC
sta FRESPC
bcc L3499
inc FRESPC+1
L3499:
rts
; ----------------------------------------------------------------------------
; IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR
; ----------------------------------------------------------------------------
FRESTR:
jsr CHKSTR
; ----------------------------------------------------------------------------
; IF STRING DESCRIPTOR POINTED TO BY FAC+3,4 IS
; A TEMPORARY STRING, RELEASE IT.
; ----------------------------------------------------------------------------
FREFAC:
lda FAC_LAST-1
ldy FAC_LAST
; ----------------------------------------------------------------------------
; IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS
; A TEMPORARY STRING, RELEASE IT.
; ----------------------------------------------------------------------------
FRETMP:
sta INDEX
sty INDEX+1
jsr FRETMS
php
ldy #$00
lda (INDEX),y
pha
iny
lda (INDEX),y
tax
iny
lda (INDEX),y
tay
pla
plp
bne L34CD
cpy FRETOP+1
bne L34CD
cpx FRETOP
bne L34CD
pha
clc
adc FRETOP
sta FRETOP
bcc L34CC
inc FRETOP+1
L34CC:
pla
L34CD:
stx INDEX
sty INDEX+1
rts
; ----------------------------------------------------------------------------
; RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT
; ----------------------------------------------------------------------------
FRETMS:
.ifdef KBD
cpy #$00
.else
cpy LASTPT+1
.endif
bne L34E2
cmp LASTPT
bne L34E2
sta TEMPPT
sbc #$03
sta LASTPT
ldy #$00
L34E2:
rts
; ----------------------------------------------------------------------------
; "CHR$" FUNCTION
; ----------------------------------------------------------------------------
CHRSTR:
jsr CONINT
txa
pha
lda #$01
jsr STRSPA
pla
ldy #$00
sta (FAC+1),y
pla
pla
jmp PUTNEW
; ----------------------------------------------------------------------------
; "LEFT$" FUNCTION
; ----------------------------------------------------------------------------
LEFTSTR:
jsr SUBSTRING_SETUP
cmp (DSCPTR),y
tya
SUBSTRING1:
bcc L3503
lda (DSCPTR),y
tax
tya
L3503:
pha
SUBSTRING2:
txa
SUBSTRING3:
pha
jsr STRSPA
lda DSCPTR
ldy DSCPTR+1
jsr FRETMP
pla
tay
pla
clc
adc INDEX
sta INDEX
bcc L351C
inc INDEX+1
L351C:
tya
jsr MOVSTR1
jmp PUTNEW
; ----------------------------------------------------------------------------
; "RIGHT$" FUNCTION
; ----------------------------------------------------------------------------
RIGHTSTR:
jsr SUBSTRING_SETUP
clc
sbc (DSCPTR),y
eor #$FF
jmp SUBSTRING1
; ----------------------------------------------------------------------------
; "MID$" FUNCTION
; ----------------------------------------------------------------------------
MIDSTR:
lda #$FF
sta FAC_LAST
jsr CHRGOT
cmp #$29
beq L353F
jsr CHKCOM
jsr GETBYT
L353F:
jsr SUBSTRING_SETUP
.ifdef CONFIG_2
beq GOIQ
.endif
dex
txa
pha
clc
ldx #$00
sbc (DSCPTR),y
bcs SUBSTRING2
eor #$FF
cmp FAC_LAST
bcc SUBSTRING3
lda FAC_LAST
bcs SUBSTRING3
; ----------------------------------------------------------------------------
; COMMON SETUP ROUTINE FOR LEFT$, RIGHT$, MID$:
; REQUIRE ")"; POP RETURN ADRS, GET DESCRIPTOR
; ADDRESS, GET 1ST PARAMETER OF COMMAND
; ----------------------------------------------------------------------------
SUBSTRING_SETUP:
jsr CHKCLS
pla
.ifndef CONFIG_11
sta JMPADRS+1
pla
sta JMPADRS+2
.else
tay
pla
sta Z52
.endif
pla
pla
pla
tax
pla
sta DSCPTR
pla
sta DSCPTR+1
.ifdef CONFIG_11
lda Z52
pha
tya
pha
.endif
ldy #$00
txa
.ifndef CONFIG_2
beq GOIQ
.endif
.ifndef CONFIG_11
inc JMPADRS+1
jmp (JMPADRS+1)
.else
rts
.endif
; ----------------------------------------------------------------------------
; "LEN" FUNCTION
; ----------------------------------------------------------------------------
LEN:
jsr GETSTR
SNGFLT1:
jmp SNGFLT
; ----------------------------------------------------------------------------
; IF LAST RESULT IS A TEMPORARY STRING, FREE IT
; MAKE VALTYP NUMERIC, RETURN LENGTH IN Y-REG
; ----------------------------------------------------------------------------
GETSTR:
jsr FRESTR
ldx #$00
stx VALTYP
tay
rts
; ----------------------------------------------------------------------------
; "ASC" FUNCTION
; ----------------------------------------------------------------------------
ASC:
jsr GETSTR
beq GOIQ
ldy #$00
lda (INDEX),y
tay
.ifndef CONFIG_11A
jmp SNGFLT1
.else
jmp SNGFLT
.endif
; ----------------------------------------------------------------------------
GOIQ:
jmp IQERR
; ----------------------------------------------------------------------------
; SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION
; TO SINGLE BYTE IN X-REG
; ----------------------------------------------------------------------------
GTBYTC:
jsr CHRGET
; ----------------------------------------------------------------------------
; EVALUATE EXPRESSION AT TXTPTR, AND
; CONVERT IT TO SINGLE BYTE IN X-REG
; ----------------------------------------------------------------------------
GETBYT:
jsr FRMNUM
; ----------------------------------------------------------------------------
; CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG
; ----------------------------------------------------------------------------
CONINT:
jsr MKINT
ldx FAC_LAST-1
bne GOIQ
ldx FAC_LAST
jmp CHRGOT
; ----------------------------------------------------------------------------
; "VAL" FUNCTION
; ----------------------------------------------------------------------------
VAL:
jsr GETSTR
bne L35AC
jmp ZERO_FAC
L35AC:
ldx TXTPTR
ldy TXTPTR+1
stx STRNG2
sty STRNG2+1
ldx INDEX
stx TXTPTR
clc
adc INDEX
sta DEST
ldx INDEX+1
stx TXTPTR+1
bcc L35C4
inx
L35C4:
stx DEST+1
ldy #$00
lda (DEST),y
pha
lda #$00
sta (DEST),y
jsr CHRGOT
jsr FIN
pla
ldy #$00
sta (DEST),y
; ----------------------------------------------------------------------------
; COPY STRNG2 INTO TXTPTR
; ----------------------------------------------------------------------------
POINT:
ldx STRNG2
ldy STRNG2+1
stx TXTPTR
sty TXTPTR+1
rts
rom/token.s
+181
View File
@@ -0,0 +1,181 @@
init_token_tables
keyword_rts "END", END
keyword_rts "FOR", FOR
keyword_rts "NEXT", NEXT
keyword_rts "DATA", DATA
.ifdef CONFIG_FILE
keyword_rts "INPUT#", INPUTH
.endif
keyword_rts "INPUT", INPUT
keyword_rts "DIM", DIM
keyword_rts "READ", READ
.ifdef APPLE
keyword_rts "PLT", PLT
.else
keyword_rts "LET", LET
.endif
keyword_rts "GOTO", GOTO, TOKEN_GOTO
keyword_rts "RUN", RUN
keyword_rts "IF", IF
keyword_rts "RESTORE", RESTORE
keyword_rts "GOSUB", GOSUB, TOKEN_GOSUB
keyword_rts "RETURN", POP
.ifdef APPLE
keyword_rts "TEX", TEX, TOKEN_REM
.else
keyword_rts "REM", REM, TOKEN_REM
.endif
keyword_rts "STOP", STOP
keyword_rts "ON", ON
.ifdef CONFIG_NULL
keyword_rts "NULL", NULL
.endif
.ifdef KBD
keyword_rts "PLOD", PLOD
keyword_rts "PSAV", PSAV
keyword_rts "VLOD", VLOD
keyword_rts "VSAV", VSAV
.endif
.ifndef CONFIG_NO_POKE
keyword_rts "WAIT", WAIT
.endif
.ifndef KBD
keyword_rts "LOAD", LOAD
keyword_rts "SAVE", SAVE
.endif
.ifdef CONFIG_CBM_ALL
keyword_rts "VERIFY", VERIFY
.endif
keyword_rts "DEF", DEF
.ifdef KBD
keyword_rts "SLOD", SLOD
.endif
.ifndef CONFIG_NO_POKE
keyword_rts "POKE", POKE
.endif
.ifdef CONFIG_FILE
keyword_rts "PRINT#", PRINTH
.endif
keyword_rts "PRINT", PRINT, TOKEN_PRINT
keyword_rts "CONT", CONT
keyword_rts "LIST", LIST
.ifdef CONFIG_CBM_ALL
keyword_rts "CLR", CLEAR
.else
keyword_rts "CLEAR", CLEAR
.endif
.ifdef CONFIG_FILE
keyword_rts "CMD", CMD
keyword_rts "SYS", SYS
keyword_rts "OPEN", OPEN
keyword_rts "CLOSE", CLOSE
.endif
.ifndef CONFIG_SMALL
keyword_rts "GET", GET
.endif
.ifdef KBD
keyword_rts "PRT", PRT
.endif
keyword_rts "NEW", NEW
count_tokens
keyword "TAB(", TOKEN_TAB
keyword "TO", TOKEN_TO
keyword "FN", TOKEN_FN
keyword "SPC(", TOKEN_SPC
keyword "THEN", TOKEN_THEN
keyword "NOT", TOKEN_NOT
keyword "STEP", TOKEN_STEP
keyword "+", TOKEN_PLUS
keyword "-", TOKEN_MINUS
keyword "*"
keyword "/"
.ifdef KBD
keyword "#"
.else
keyword "^"
.endif
keyword "AND"
keyword "OR"
keyword ">", TOKEN_GREATER
keyword "=", TOKEN_EQUAL
keyword "<"
.segment "VECTORS"
UNFNC:
keyword_addr "SGN", SGN, TOKEN_SGN
keyword_addr "INT", INT
keyword_addr "ABS", ABS
.ifdef KBD
keyword_addr "VER", VER
.endif
.ifndef CONFIG_NO_POKE
.ifdef CONFIG_RAM
keyword_addr "USR", IQERR
.else
keyword_addr "USR", USR, TOKEN_USR
.endif
.endif
keyword_addr "FRE", FRE
keyword_addr "POS", POS
keyword_addr "SQR", SQR
keyword_addr "RND", RND
keyword_addr "LOG", LOG
keyword_addr "EXP", EXP
.segment "VECTORS"
UNFNC_COS:
keyword_addr "COS", COS
.segment "VECTORS"
UNFNC_SIN:
keyword_addr "SIN", SIN
.segment "VECTORS"
UNFNC_TAN:
keyword_addr "TAN", TAN
.segment "VECTORS"
UNFNC_ATN:
keyword_addr "ATN", ATN
.ifdef KBD
keyword_addr "GETC", GETC
.endif
.ifndef CONFIG_NO_POKE
keyword_addr "PEEK", PEEK
.endif
keyword_addr "LEN", LEN
keyword_addr "STR$", STR
keyword_addr "VAL", VAL
keyword_addr "ASC", ASC
keyword_addr "CHR$", CHRSTR
keyword_addr "LEFT$", LEFTSTR, TOKEN_LEFTSTR
keyword_addr "RIGHT$", RIGHTSTR
keyword_addr "MID$", MIDSTR
.ifdef CONFIG_2
keyword "GO", TOKEN_GO
.endif
.segment "KEYWORDS"
.byte 0
.segment "VECTORS"
MATHTBL:
.byte $79
.word FADDT-1
.byte $79
.word FSUBT-1
.byte $7B
.word FMULTT-1
.byte $7B
.word FDIVT-1
.byte $7F
.word FPWRT-1
.byte $50
.word TAND-1
.byte $46
.word OR-1
.byte $7D
.word NEGOP-1
.byte $5A
.word EQUOP-1
.byte $64
.word RELOPS-1
rom/trig.s
+205
View File
@@ -0,0 +1,205 @@
.segment "CODE"
.ifndef SYM1
SIN_COS_TAN_ATN:
; ----------------------------------------------------------------------------
; "COS" FUNCTION
; ----------------------------------------------------------------------------
COS:
lda #<CON_PI_HALF
ldy #>CON_PI_HALF
jsr FADD
; ----------------------------------------------------------------------------
; "SIN" FUNCTION
; ----------------------------------------------------------------------------
SIN:
jsr COPY_FAC_TO_ARG_ROUNDED
lda #<CON_PI_DOUB
ldy #>CON_PI_DOUB
ldx ARGSIGN
jsr DIV
jsr COPY_FAC_TO_ARG_ROUNDED
jsr INT
lda #$00
sta STRNG1
jsr FSUBT
; ----------------------------------------------------------------------------
; (FAC) = ANGLE AS A FRACTION OF A FULL CIRCLE
;
; NOW FOLD THE RANGE INTO A QUARTER CIRCLE
;
; <<< THERE ARE MUCH SIMPLER WAYS TO DO THIS >>>
; ----------------------------------------------------------------------------
lda #<QUARTER
ldy #>QUARTER
jsr FSUB
lda FACSIGN
pha
bpl SIN1
jsr FADDH
lda FACSIGN
bmi L3F5B
lda CPRMASK
eor #$FF
sta CPRMASK
; ----------------------------------------------------------------------------
; IF FALL THRU, RANGE IS 0...1/2
; IF BRANCH HERE, RANGE IS 0...1/4
; ----------------------------------------------------------------------------
SIN1:
jsr NEGOP
; ----------------------------------------------------------------------------
; IF FALL THRU, RANGE IS -1/2...0
; IF BRANCH HERE, RANGE IS -1/4...0
; ----------------------------------------------------------------------------
L3F5B:
lda #<QUARTER
ldy #>QUARTER
jsr FADD
pla
bpl L3F68
jsr NEGOP
L3F68:
lda #<POLY_SIN
ldy #>POLY_SIN
jmp POLYNOMIAL_ODD
; ----------------------------------------------------------------------------
; "TAN" FUNCTION
;
; COMPUTE TAN(X) = SIN(X) / COS(X)
; ----------------------------------------------------------------------------
TAN:
jsr STORE_FAC_IN_TEMP1_ROUNDED
lda #$00
sta CPRMASK
jsr SIN
ldx #TEMP3
ldy #$00
jsr GOMOVMF
lda #TEMP1+(5-BYTES_FP)
ldy #$00
jsr LOAD_FAC_FROM_YA
lda #$00
sta FACSIGN
lda CPRMASK
jsr TAN1
lda #TEMP3
ldy #$00
jmp FDIV
TAN1:
pha
jmp SIN1
; ----------------------------------------------------------------------------
.ifdef CONFIG_SMALL
CON_PI_HALF:
.byte $81,$49,$0F,$DB
CON_PI_DOUB:
.byte $83,$49,$0F,$DB
QUARTER:
.byte $7F,$00,$00,$00
POLY_SIN:
.byte $04,$86,$1E,$D7,$FB,$87,$99,$26
.byte $65,$87,$23,$34,$58,$86,$A5,$5D
.byte $E1,$83,$49,$0F,$DB
.else
CON_PI_HALF:
.byte $81,$49,$0F,$DA,$A2
CON_PI_DOUB:
.byte $83,$49,$0F,$DA,$A2
QUARTER:
.byte $7F,$00,$00,$00,$00
POLY_SIN:
.byte $05,$84,$E6,$1A,$2D,$1B,$86,$28
.byte $07,$FB,$F8,$87,$99,$68,$89,$01
.byte $87,$23,$35,$DF,$E1,$86,$A5,$5D
.byte $E7,$28,$83,$49,$0F,$DA,$A2
.ifndef CONFIG_11
; no easter egg text before BASIC 1.1
.elseif !.def(CONFIG_2A)
; ASCII encoded easter egg
MICROSOFT:
.byte $A6,$D3,$C1,$C8,$D4,$C8,$D5,$C4
.byte $CE,$CA
.else
; PET encoded easter egg text since CBM2
MICROSOFT:
.byte $A1,$54,$46,$8F,$13,$8F,$52,$43
.byte $89,$CD
.endif
.endif
.ifndef AIM65
; ----------------------------------------------------------------------------
; "ATN" FUNCTION
; ----------------------------------------------------------------------------
ATN:
lda FACSIGN
pha
bpl L3FDB
jsr NEGOP
L3FDB:
lda FAC
pha
cmp #$81
bcc L3FE9
lda #<CON_ONE
ldy #>CON_ONE
jsr FDIV
; ----------------------------------------------------------------------------
; 0 <= X <= 1
; 0 <= ATN(X) <= PI/8
; ----------------------------------------------------------------------------
L3FE9:
lda #<POLY_ATN
ldy #>POLY_ATN
jsr POLYNOMIAL_ODD
pla
cmp #$81
bcc L3FFC
lda #<CON_PI_HALF
ldy #>CON_PI_HALF
jsr FSUB
L3FFC:
pla
bpl L4002
jmp NEGOP
L4002:
rts
; ----------------------------------------------------------------------------
POLY_ATN:
.ifdef CONFIG_SMALL
.byte $08
.byte $78,$3A,$C5,$37
.byte $7B,$83,$A2,$5C
.byte $7C,$2E,$DD,$4D
.byte $7D,$99,$B0,$1E
.byte $7D,$59,$ED,$24
.byte $7E,$91,$72,$00
.byte $7E,$4C,$B9,$73
.byte $7F,$AA,$AA,$53
.byte $81,$00,$00,$00
.else
.byte $0B
.byte $76,$B3,$83,$BD,$D3
.byte $79,$1E,$F4,$A6,$F5
.byte $7B,$83,$FC,$B0,$10
.byte $7C,$0C,$1F,$67,$CA
.byte $7C,$DE,$53,$CB,$C1
.byte $7D,$14,$64,$70,$4C
.byte $7D,$B7,$EA,$51,$7A
.byte $7D,$63,$30,$88,$7E
.byte $7E,$92,$44,$99,$3A
.byte $7E,$4C,$CC,$91,$C7
.byte $7F,$AA,$AA,$AA,$13
.byte $81,$00,$00,$00,$00
.endif
.if .def(CONFIG_11A) && (!.def(CONFIG_2))
.byte $00 ; XXX
.endif
.endif
.endif
rom/var.s
+242
View File
@@ -0,0 +1,242 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "DIM" STATEMENT
; ----------------------------------------------------------------------------
NXDIM:
jsr CHKCOM
DIM:
tax
jsr PTRGET2
jsr CHRGOT
bne NXDIM
rts
; ----------------------------------------------------------------------------
; PTRGET -- GENERAL VARIABLE SCAN
;
; SCANS VARIABLE NAME AT TXTPTR, AND SEARCHES THE
; VARTAB AND ARYTAB FOR THE NAME.
; IF NOT FOUND, CREATE VARIABLE OF APPROPRIATE TYPE.
; RETURN WITH ADDRESS IN VARPNT AND Y,A
;
; ACTUAL ACTIVITY CONTROLLED SOMEWHAT BY TWO FLAGS:
; DIMFLG -- NONZERO IF CALLED FROM "DIM"
; ELSE = 0
;
; SUBFLG -- = $00
; = $40 IF CALLED FROM "GETARYPT"
; ----------------------------------------------------------------------------
PTRGET:
ldx #$00
jsr CHRGOT
PTRGET2:
stx DIMFLG
PTRGET3:
sta VARNAM
jsr CHRGOT
jsr ISLETC
bcs NAMOK
SYNERR3:
jmp SYNERR
NAMOK:
ldx #$00
stx VALTYP
.ifndef CONFIG_SMALL
stx VALTYP+1
.endif
jsr CHRGET
bcc L2ECD
jsr ISLETC
bcc L2ED8
L2ECD:
tax
L2ECE:
jsr CHRGET
bcc L2ECE
jsr ISLETC
bcs L2ECE
L2ED8:
cmp #$24
.ifdef CONFIG_SMALL
bne L2EF9
.else
bne L2EE2
.endif
lda #$FF
sta VALTYP
.ifndef CONFIG_SMALL
bne L2EF2
L2EE2:
cmp #$25
bne L2EF9
lda SUBFLG
bne SYNERR3
lda #$80
sta VALTYP+1
ora VARNAM
sta VARNAM
L2EF2:
.endif
txa
ora #$80
tax
jsr CHRGET
L2EF9:
stx VARNAM+1
sec
ora SUBFLG
sbc #$28
bne L2F05
jmp ARRAY
L2F05:
lda #$00
sta SUBFLG
lda VARTAB
ldx VARTAB+1
ldy #$00
L2F0F:
stx LOWTR+1
L2F11:
sta LOWTR
cpx ARYTAB+1
bne L2F1B
cmp ARYTAB
beq NAMENOTFOUND
L2F1B:
lda VARNAM
cmp (LOWTR),y
bne L2F29
lda VARNAM+1
iny
cmp (LOWTR),y
beq SET_VARPNT_AND_YA
dey
L2F29:
clc
lda LOWTR
adc #BYTES_PER_VARIABLE
bcc L2F11
inx
bne L2F0F
; ----------------------------------------------------------------------------
; CHECK IF (A) IS ASCII LETTER A-Z
;
; RETURN CARRY = 1 IF A-Z
; = 0 IF NOT
; ----------------------------------------------------------------------------
ISLETC:
cmp #$41
bcc L2F3C
sbc #$5B
sec
sbc #$A5
L2F3C:
rts
; ----------------------------------------------------------------------------
; VARIABLE NOT FOUND, SO MAKE ONE
; ----------------------------------------------------------------------------
NAMENOTFOUND:
pla
pha
cmp #<FRM_VARIABLE_CALL
bne MAKENEWVARIABLE
.ifdef CONFIG_SAFE_NAMENOTFOUND
tsx
lda STACK+2,x
cmp #>FRM_VARIABLE_CALL
bne MAKENEWVARIABLE
.endif
LD015:
lda #<C_ZERO
ldy #>C_ZERO
rts
; ----------------------------------------------------------------------------
.ifndef CONFIG_2
C_ZERO:
.byte $00,$00
.endif
; ----------------------------------------------------------------------------
; MAKE A NEW SIMPLE VARIABLE
;
; MOVE ARRAYS UP 7 BYTES TO MAKE ROOM FOR NEW VARIABLE
; ENTER 7-BYTE VARIABLE DATA IN THE HOLE
; ----------------------------------------------------------------------------
MAKENEWVARIABLE:
.ifdef CONFIG_CBM_ALL
lda VARNAM
ldy VARNAM+1
cmp #$54
bne LD02F
cpy #$C9
beq LD015
cpy #$49
bne LD02F
LD02C:
jmp SYNERR
LD02F:
cmp #$53
bne LD037
cpy #$54
beq LD02C
LD037:
.endif
lda ARYTAB
ldy ARYTAB+1
sta LOWTR
sty LOWTR+1
lda STREND
ldy STREND+1
sta HIGHTR
sty HIGHTR+1
clc
adc #BYTES_PER_VARIABLE
bcc L2F68
iny
L2F68:
sta HIGHDS
sty HIGHDS+1
jsr BLTU
lda HIGHDS
ldy HIGHDS+1
iny
sta ARYTAB
sty ARYTAB+1
ldy #$00
lda VARNAM
sta (LOWTR),y
iny
lda VARNAM+1
sta (LOWTR),y
lda #$00
iny
sta (LOWTR),y
iny
sta (LOWTR),y
iny
sta (LOWTR),y
iny
sta (LOWTR),y
.ifndef CONFIG_SMALL
iny
sta (LOWTR),y
.endif
; ----------------------------------------------------------------------------
; PUT ADDRESS OF VALUE OF VARIABLE IN VARPNT AND Y,A
; ----------------------------------------------------------------------------
SET_VARPNT_AND_YA:
lda LOWTR
clc
adc #$02
ldy LOWTR+1
bcc L2F9E
iny
L2F9E:
sta VARPNT
sty VARPNT+1
rts
rom/wozmon.s
+171
View File
@@ -0,0 +1,171 @@
.segment "WOZMON"
XAML = $24 ; Last "opened" location Low
XAMH = $25 ; Last "opened" location High
STL = $26 ; Store address Low
STH = $27 ; Store address High
L = $28 ; Hex value parsing Low
H = $29 ; Hex value parsing High
YSAV = $2A ; Used to see if hex value is given
MODE = $2B ; $00=XAM, $7F=STOR, $AE=BLOCK XAM
IN = $0200 ; Input buffer
RESET:
LDA #$1B ; Begin with escape.
NOTCR:
CMP #$08 ; Backspace key?
BEQ BACKSPACE ; Yes.
CMP #$1B ; ESC?
BEQ ESCAPE ; Yes.
INY ; Advance text index.
BPL NEXTCHAR ; Auto ESC if line longer than 127.
ESCAPE:
LDA #$5C ; "\".
JSR ECHO ; Output it.
GETLINE:
LDA #$0D ; Send CR
JSR ECHO
LDY #$01 ; Initialize text index.
BACKSPACE: DEY ; Back up text index.
BMI GETLINE ; Beyond start of line, reinitialize.
NEXTCHAR:
LDA $BC01 ; Check status.
BMI NEXTCHAR ; Loop until ready.
STA IN,Y ; Add to text buffer.
JSR ECHO ; Display character.
CMP #$0D ; CR?
BNE NOTCR ; No.
LDY #$FF ; Reset text index.
LDA #$00 ; For XAM mode.
TAX ; X=0.
SETBLOCK:
ASL
SETSTOR:
ASL ; Leaves $7B if setting STOR mode.
STA MODE ; $00 = XAM, $74 = STOR, $B8 = BLOK XAM.
BLSKIP:
INY ; Advance text index.
NEXTITEM:
LDA IN,Y ; Get character.
CMP #$0D ; CR?
BEQ GETLINE ; Yes, done this line.
CMP #$2E ; "."?
BCC BLSKIP ; Skip delimiter.
BEQ SETBLOCK ; Set BLOCK XAM mode.
CMP #$3A ; ":"?
BEQ SETSTOR ; Yes, set STOR mode.
CMP #$52 ; "R"?
BEQ RUNWOZ ; Yes, run user program.
STX L ; $00 -> L.
STX H ; and H.
STY YSAV ; Save Y for comparison
NEXTHEX:
LDA IN,Y ; Get character for hex test.
EOR #$30 ; Map digits to $0-9.
CMP #$0A ; Digit?
BCC DIG ; Yes.
ADC #$88 ; Map letter "A"-"F" to $FA-FF.
CMP #$FA ; Hex letter?
BCC NOTHEX ; No, character not hex.
DIG:
ASL
ASL ; Hex digit to MSD of A.
ASL
ASL
LDX #$04 ; Shift count.
HEXSHIFT:
ASL ; Hex digit left, MSB to carry.
ROL L ; Rotate into LSD.
ROL H ; Rotate into MSD's.
DEX ; Done 4 shifts?
BNE HEXSHIFT ; No, loop.
INY ; Advance text index.
BNE NEXTHEX ; Always taken. Check next character for hex.
NOTHEX:
CPY YSAV ; Check if L, H empty (no hex digits).
BEQ ESCAPE ; Yes, generate ESC sequence.
BIT MODE ; Test MODE byte.
BVC NOTSTOR ; B6=0 is STOR, 1 is XAM and BLOCK XAM.
LDA L ; LSD's of hex data.
STA (STL,X) ; Store current 'store index'.
INC STL ; Increment store index.
BNE NEXTITEM ; Get next item (no carry).
INC STH ; Add carry to 'store index' high order.
TONEXTITEM: JMP NEXTITEM ; Get next command item.
RUNWOZ:
JMP (XAML) ; Run at current XAM index.
NOTSTOR:
BMI XAMNEXT ; B7 = 0 for XAM, 1 for BLOCK XAM.
LDX #$02 ; Byte count.
SETADR: LDA L-1,X ; Copy hex data to
STA STL-1,X ; 'store index'.
STA XAML-1,X ; And to 'XAM index'.
DEX ; Next of 2 bytes.
BNE SETADR ; Loop unless X = 0.
NXTPRNT:
BNE PRDATA ; NE means no address to print.
LDA #$0D ; CR.
JSR ECHO ; Output it.
LDA XAMH ; 'Examine index' high-order byte.
JSR PRBYTE ; Output it in hex format.
LDA XAML ; Low-order 'examine index' byte.
JSR PRBYTE ; Output it in hex format.
LDA #$3A ; ":".
JSR ECHO ; Output it.
PRDATA:
LDA #$20 ; Blank.
JSR ECHO ; Output it.
LDA (XAML,X) ; Get data byte at 'examine index'.
JSR PRBYTE ; Output it in hex format.
XAMNEXT: STX MODE ; 0 -> MODE (XAM mode).
LDA XAML
CMP L ; Compare 'examine index' to hex data.
LDA XAMH
SBC H
BCS TONEXTITEM ; Not less, so no more data to output.
INC XAML
BNE MOD8CHK ; Increment 'examine index'.
INC XAMH
MOD8CHK:
LDA XAML ; Check low-order 'examine index' byte
AND #$07 ; For MOD 8 = 0
BPL NXTPRNT ; Always taken.
PRBYTE:
PHA ; Save A for LSD.
LSR
LSR
LSR ; MSD to LSD position.
LSR
JSR PRHEX ; Output hex digit.
PLA ; Restore A.
PRHEX:
AND #$0F ; Mask LSD for hex print.
ORA #$30 ; Add "0".
CMP #$3A ; Digit?
BCC ECHO ; Yes, output it.
ADC #$06 ; Add offset for letter.
ECHO:
STA $BC00 ; Output character.
RTS ; Return.
rom/zeropage.s
+203
View File
@@ -0,0 +1,203 @@
.feature org_per_seg
.zeropage
.org ZP_START1
GORESTART:
.res 3
GOSTROUT:
.res 3
GOAYINT:
.res 2
GOGIVEAYF:
.res 2
.org ZP_START2
Z15:
.res 1
.ifndef POSX; allow override
POSX:
.endif
.res 1
.ifndef Z17; allow override
Z17:
.endif
.res 1
.ifndef Z18; allow override
Z18:
.endif
.res 1
LINNUM:
.ifndef TXPSV; allow override
TXPSV:
.endif
.res 2
.ifndef INPUTBUFFER; allow override
INPUTBUFFER:
.endif
.org ZP_START3
CHARAC:
.res 1
ENDCHR:
.res 1
EOLPNTR:
.res 1
DIMFLG:
.res 1
VALTYP:
.ifdef CONFIG_SMALL
.res 1
.else
.res 2
.endif
DATAFLG:
.res 1
SUBFLG:
.res 1
INPUTFLG:
.res 1
CPRMASK:
.res 1
Z14:
.res 1
.org ZP_START4
TEMPPT:
.res 1
LASTPT:
.res 2
TEMPST:
.res 9
INDEX:
.res 2
DEST:
.res 2
RESULT:
.res BYTES_FP
RESULT_LAST = RESULT + BYTES_FP-1
TXTTAB:
.res 2
VARTAB:
.res 2
ARYTAB:
.res 2
STREND:
.res 2
FRETOP:
.res 2
FRESPC:
.res 2
MEMSIZ:
.res 2
CURLIN:
.res 2
OLDLIN:
.res 2
OLDTEXT:
.res 2
Z8C:
.res 2
DATPTR:
.res 2
INPTR:
.res 2
VARNAM:
.res 2
VARPNT:
.res 2
FORPNT:
.res 2
LASTOP:
.res 2
CPRTYP:
.res 1
FNCNAM:
TEMP3:
.res 2
DSCPTR:
.ifdef CONFIG_SMALL
.res 2
.else
.res 3
.endif
DSCLEN:
.res 2
.ifndef JMPADRS ; allow override
JMPADRS := DSCLEN + 1
.endif
Z52:
.res 1
ARGEXTENSION:
.ifndef CONFIG_SMALL
.res 1
.endif
TEMP1:
.res 1
HIGHDS:
.res 2
HIGHTR:
.res 2
.ifndef CONFIG_SMALL
TEMP2:
.res 1
.endif
INDX:
TMPEXP:
.ifdef CONFIG_SMALL
TEMP2:
.endif
.res 1
EXPON:
.res 1
LOWTR:
.ifndef LOWTRX ; allow override
LOWTRX:
.endif
.res 1
EXPSGN:
.res 1
FAC:
.res BYTES_FP
FAC_LAST = FAC + BYTES_FP-1
FACSIGN:
.res 1
SERLEN:
.res 1
SHIFTSIGNEXT:
.res 1
ARG:
.res BYTES_FP
ARG_LAST = ARG + BYTES_FP-1
ARGSIGN:
.res 1
STRNG1:
.res 2
SGNCPR = STRNG1
FACEXTENSION = STRNG1+1
STRNG2:
.res 2
.ifdef AIM65
ATN:
.res 3
ZBE:
.res 1
.endif
.ifdef SYM1
USR1:
.res 3
USR2:
.res 3
USR3:
.res 3
.endif
CHRGET:
TXTPTR = <(GENERIC_TXTPTR-GENERIC_CHRGET + CHRGET)
CHRGOT = <(GENERIC_CHRGOT-GENERIC_CHRGET + CHRGET)
CHRGOT2 = <(GENERIC_CHRGOT2-GENERIC_CHRGET + CHRGET)
RNDSEED = <(GENERIC_RNDSEED-GENERIC_CHRGET + CHRGET)