AppleIIAsm-Collection/source/disk20_minidisk_A/T.AGET81.SUB.MIN
nathanriggs 82d0e74c1a 0.3.1 updates
some minor bugfixes, directory shuffling, added demo and utility disks
2019-01-26 21:02:17 -05:00

97 lines
2.0 KiB
Plaintext

AGET81
PLA
STA RETADR
PLA
STA RETADR+1
PLA
STA :IDX
DEC :IDX
PLA
STA ADDR1
PLA
STA ADDR1+1
LDA #0
STA :IDX+1
LDY #1 ; ELEMENT SIZE LOC
LDA (ADDR1),Y
STA :ESIZE
STA RETLEN ; LENGTH OF RETURN VALUE
DEY
LDA (ADDR1),Y
STA :ALEN
LDA ERRCTRL
CMP #1
BEQ :CHKERR
JMP :ERREND
:CHKERR
LDA :IDX ; IF IDX > ARRAY LENGTH
CMP :ALEN
BCS :OVF
JMP :ERREND
:OVF
_ERR :E_SID;:E_OVF1;:E_DUMP;:RES;#6
:ERREND
LDY #0
LDA #0
TAY
STY SCRATCH
BEQ :ENTLP
:DOADD
CLC
ADC :IDX
TAX
TYA
ADC SCRATCH
TAY
TXA
:LP
ASL :IDX
ROL SCRATCH
:ENTLP
LSR :ESIZE
BCS :DOADD
BNE :LP
STX :IDX
STY :IDX+1
CLC
LDA #2
ADC :IDX
STA :RES
LDA #0
ADC :IDX+1
STA :RES+1
CLC
LDA :RES
ADC ADDR1 ; LOW OF ARRAY ADDRESS
STA :RES
LDA :RES+1
ADC ADDR1+1
STA :RES+1
LDY #0
LDA :RES
STA ADDR1
LDA :RES+1
STA ADDR1+1
:LDLOOP
LDA (ADDR1),Y
STA RETURN,Y
INY
CPY RETLEN
BCC :LDLOOP ; IF .Y <= RETLEN
BEQ :LDLOOP ; KEEP LOOPING
LDA RETADR+1
PHA
LDA RETADR
PHA
LDY :RES
LDX :RES+1
LDA RETLEN
RTS
:RES DS 2
:IDX DS 2
:ESIZE DS 1
:ALEN DS 1
:E_SID ASC "AGET81 (GET81 MACRO)",00
:E_DUMP ASC "DUMPING RES(2) IDX(2) ESIZE(1) ALEN(1)",00
:E_OVF1 ASC "OUT OF BOUNDS! INDEX > ARRAY LENGTH",00