AppleIIAsm-Collection/source/disk3_arrays/T.APUT81.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

104 lines
2.2 KiB
Plaintext

APUT81
PLA
STA RETADR ; LOCAL RETURN ADDRESS STORAGE
PLA ; BECAUSE OF CALLING AGET81
STA RETADR+1
PLA
STA :AIDX
STA :IDX
DEC :AIDX
DEC :IDX
PLA
STA ADDR4 ; ARRAY ADDRESS; USES ADDR4
; ADDR1
PLA
STA ADDR4+1
PLA
STA ADDR3 ; ADDRESS OF DATA TO BE
PLA
STA ADDR3+1
LDY #0
LDA (ADDR4),Y
STA :ASIZE
LDY #1
LDA (ADDR4),Y
STA :ESIZE
STA :ESIZEBAK
LDA ERRCTRL
CMP #1
BEQ :CHKERR
JMP :ERREND
:CHKERR
LDA :IDX ; IF IDX > ARRAY LENGTH
CLC
ADC #1
CMP :ASIZE
BCS :OVF
JMP :ERREND
:OVF
_ERR :E_SID;:E_OVF1;:E_DUMP;:ESIZE;#9
:ERREND
LDY #0
LDA #0
STY SCRATCH
STY SCRATCH+1
BEQ :ENTLPA
:DOADD
CLC
ADC :AIDX
TAX
TYA
ADC SCRATCH
TAY
TXA
:LPA
ASL :AIDX
ROL SCRATCH
:ENTLPA
LSR :ESIZE
BCS :DOADD
BNE :LPA
STX :IDX
STY :IDX+1
CLC
LDA #2
ADC :IDX
STA :RES
LDA #0
ADC :IDX+1
STA :RES+1
CLC
LDA :RES
ADC ADDR4
STA :RES
LDA :RES+1
ADC ADDR4+1
STA :RES+1
STA ADDR2+1
LDA :RES
STA ADDR2
:LP
LDA (ADDR3),Y
STA (ADDR2),Y
INY
CPY :ESIZEBAK
BNE :LP
LDA RETADR+1
PHA
LDA RETADR
PHA
LDX ADDR2+1
LDY ADDR2
LDA :ESIZE
RTS
:ESIZE DS 1
:ESIZEBAK DS 1
:ASIZE DS 1
:AIDX DS 2
:IDX DS 2
:RES DS 2
:E_SID ASC "APUT81 (PUT81 MACRO)",00
:E_DUMP ASC "DUMPING :ESIZE(1) :ESIZEBAK(1) :ASIZE(1)"
ASC ":AIDX(2) :IDX(2) :RES(2)",00
:E_OVF1 ASC "OUT OF BOUNDS! INDEX > ARRAY LENGTH",00