topicchi/SyncHome
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

daily_automated

Browse Source
This commit is contained in:
paolo.iocco
2023-03-13 08:36:51 +00:00
parent 5347889cd2
commit f29dcc4188
5439 changed files with 1065799 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

413
trunk/workspace/AVR-Computer/msbasic/array.s Normal file
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