mirror of
https://github.com/mist64/msbasic.git
synced 2024-12-22 23:31:32 +00:00
412 lines
9.1 KiB
ArmAsm
412 lines
9.1 KiB
ArmAsm
|
.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
|
||
|
|
|
||
|
|
; ----------------------------------------------------------------------------
|
||
|
|
; EVALUATE NUMERIC FORMULA AT TXTPTR
|
||
|
|
; CONVERTING RESULT TO INTEGER 0 <= X <= 32767
|
||
|
|
; IN FAC+3,4
|
||
|
|
; ----------------------------------------------------------------------------
|
||
|
|
MAKINT:
|
||
|
|
jsr CHRGET
|
||
|
|
.ifdef CBM2_KBD
|
||
|
|
jsr FRMEVL
|
||
|
|
.else
|
||
|
|
jsr FRMNUM
|
||
|
|
.endif
|
||
|
|
|
||
|
|
; ----------------------------------------------------------------------------
|
||
|
|
; CONVERT FAC TO INTEGER
|
||
|
|
; MUST BE POSITIVE AND LESS THAN 32768
|
||
|
|
; ----------------------------------------------------------------------------
|
||
|
|
MKINT:
|
||
|
|
.ifdef CBM2_KBD
|
||
|
|
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
|
||
|
|
.ifdef OSI
|
||
|
|
stx STRNG2
|
||
|
|
.endif
|
||
|
|
lda VARNAM
|
||
|
|
sta (LOWTR),y
|
||
|
|
.ifndef CONFIG_SMALL
|
||
|
|
bpl L3078
|
||
|
|
dex
|
||
|
|
L3078:
|
||
|
|
.endif
|
||
|
|
iny
|
||
|
|
lda VARNAM+1
|
||
|
|
sta (LOWTR),y
|
||
|
|
.ifndef OSI
|
||
|
|
bpl L3081
|
||
|
|
dex
|
||
|
|
.ifndef KBD
|
||
|
|
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
|
||
|
|
.ifdef OSI
|
||
|
|
asl STRNG2
|
||
|
|
rol a
|
||
|
|
bcs GSE
|
||
|
|
asl STRNG2
|
||
|
|
rol a
|
||
|
|
bcs GSE
|
||
|
|
tay
|
||
|
|
lda STRNG2
|
||
|
|
.else
|
||
|
|
.ifndef CBM1_APPLE
|
||
|
|
sta STRNG2+1
|
||
|
|
.endif
|
||
|
|
ldx #BYTES_FP
|
||
|
|
.ifdef KBD
|
||
|
|
lda VARNAM+1
|
||
|
|
.else
|
||
|
|
lda VARNAM
|
||
|
|
.endif
|
||
|
|
bpl L3135
|
||
|
|
dex
|
||
|
|
L3135:
|
||
|
|
.ifndef KBD
|
||
|
|
lda VARNAM+1
|
||
|
|
bpl L313B
|
||
|
|
dex
|
||
|
|
dex
|
||
|
|
L313B:
|
||
|
|
.endif
|
||
|
|
.ifdef KBD
|
||
|
|
stx RESULT+1
|
||
|
|
.else
|
||
|
|
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
|
||
|
|
|