mirror of https://github.com/mist64/msbasic.git
414 lines
9.3 KiB
ArmAsm
414 lines
9.3 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
|
|
|
|
.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
|
|
|