Loadstar Extras 3/Ex3side1.d64/rle.s

Text File | 1990-01-01 | 5.7 KB | 528 lines

open =$ffc0
readst =$ffb7
setlfs =$ffba
setnam =$ffbd
load =$ffd5
getin =$ffe4
clrchn =$ffcc
close =$ffc3   ;a
chrin =$ffcf
chkout =$ffc9  ;x
chkin =$ffc6   ;x
plot =$fff0
chrout =$ffd2
color'pointer =243
screen'line'pointer =209
print'number =$bdcd ;x,a
clear'line =59903
background =53281
border =53280
unlisten =$ffae
clall =$ffe7

buffer =251
output'buffer =253
start'of'literal =$14

.org $c000
.mem

.obj "@0:rle c000"

jmp rleload       ;sysadr,file$,dev,location (0 to respect load address)
jmp encode        ;sysadr,file$,dev,buffer,out$,dev,load address
jmp pack'mem      ;sysad,begin,end,dest
jmp unpack'mem    ;sysadr,location,dest
jmp range'decode  ;253 source, 174 dest
jmp range'pack    ;251 source,174 end,253 dest


rleload lda #0
sta mode
jsr get'string
jsr setnam
jsr get'number
sty device
tya
tax
lda #2
ldy #2
jsr setlfs
jsr open
jsr clrchn
ldx #2
jsr chkin

jsr get'number

get'load'address jsr getin
sta 174
jsr getin
sta 175

lda $15
beq decode

sta 175
lda $14
sta 174

decode ldy #0
jsr getin
beq done'decoding
sta 251
cmp #129
bcs dispatch'literal

dispatch'packed cmp #128
bne +
dec 251
+ jsr getin
- sta (174),y
inc 174
bne +
inc 175
+ dec 251
bne -
jsr readst
and #66
bne done'decoding
jmp decode

dispatch'literal and #127
sta 251
- jsr getin
sta (174),y
inc 174
bne +
inc 175
+ dec 251
bne -
jsr readst
and #66
bne done'decoding
jmp decode

done'decoding jsr clrchn
lda #2
jmp close


unpack'mem jsr get'number
sty 253
sta 254
jsr get'number
sty 174
sta 175
sei

range'decode ldy #0
ldx #$74
stx 1
lda (253),y
pha
lda #1
clc
adc 253
sta 253
lda #0
adc 254
sta 254
ldx #$77
stx 1
pla
beq rdone'decoding
sta 251
cmp #129
bcs rdispatch'literal

rdispatch'packed cmp #128
bne +
dec 251
+ ldx #$74
stx 1
lda (253),y
pha
lda #1
clc
adc 253
sta 253
lda #0
adc 254
sta 254
ldx #$77
stx 1
pla

- sta (174),y
inc 174
bne +
inc 175
+ dec 251
bne -
jmp range'decode

rdispatch'literal and #127
sta 251
- ldx #$74
stx 1
lda (253),y
pha
lda #1
clc
adc 253
sta 253
lda #0
adc 254
sta 254
ldx #$77
stx 1
pla
sta (174),y
inc 174
bne +
inc 175
+ dec 251
bne -
jmp range'decode

rdone'decoding rts

encode lda #0
sta mode
jsr get'string
jsr setnam
jsr get'number
sty device
tya
tax
lda #1
ldy #0
jsr setlfs
jsr get'number
sty buffer
sta buffer+1

ldx $14
ldy $15
lda #0
jsr load
stx eof
sty eof+1

encode'setup lda #0

sta e'variable
sta d'variable


lda <$d000
sta output'buffer
lda >$d000
sta output'buffer+1
sei
lda #$74
sta 1

encode'loop ldy #0
lda (buffer),y
sta n'variable
iny
lda (buffer),y
sta q'variable
dey

cmp n'variable
bne +
jsr the'same
jmp next
+ jsr not'same

next inc buffer
bne +
inc buffer+1

+ lda buffer+1
cmp eof+1
bcc encode'loop
lda buffer
cmp eof
bcc encode'loop

lda d'variable
beq +
jsr wrap'up'd
jmp wrap'up
+ lda e'variable
beq wrap'up
jsr wrap'up'e

wrap'up lda #0
tay
sta (output'buffer),y

jmp write'output

the'same lda e'variable
beq +
jsr wrap'up'e
+ inc d'variable
lda d'variable
cmp #127
bne +
jmp write'rle
+ rts

write'rle ldy #0
inc d'variable
lda d'variable
sta (output'buffer),y
jsr bump'output'buffer
lda n'variable
sta (output'buffer),y
jsr bump'output'buffer
lda #0
sta d'variable
rts

not'same lda d'variable
beq +
jmp wrap'up'd
+ inc e'variable
lda e'variable
cmp #1
bne +
ldx buffer
stx $14
ldx buffer+1
stx $15
+ cmp #127
bne +
jmp write'literal
+ rts

write'literal ldy #0
lda e'variable
ora #128
sta (output'buffer),y
jsr bump'output'buffer

literal'loop ldy #0
- lda (start'of'literal),y
sta (output'buffer),y
jsr bump'output'buffer
inc start'of'literal
bne +
inc start'of'literal+1
+ lda start'of'literal+1
cmp buffer+1
bcc -
lda start'of'literal
cmp buffer
bcc -
beq -

lda #0
sta e'variable
sta d'variable
rts

wrap'up'd inc d'variable
ldy #0
lda d'variable
sta (output'buffer),y
jsr bump'output'buffer
lda n'variable
sta (output'buffer),y
jsr bump'output'buffer
lda #0
sta d'variable
rts


wrap'up'e ldy #0
lda e'variable
ora #128
sta (output'buffer),y
jsr bump'output'buffer

literal'loop2 ldy #0
- lda (start'of'literal),y
sta (output'buffer),y
jsr bump'output'buffer
inc start'of'literal
bne +
inc start'of'literal+1
+ lda start'of'literal+1
cmp buffer+1
bcc -
lda start'of'literal
cmp buffer
bcc -

lda #0
sta e'variable
sta d'variable
rts

bump'output'buffer inc output'buffer
bne +
inc output'buffer+1
+ rts

write'output lda #$77
sta 1
cli
lda mode
beq open'output'file
rts; end of pack at 253,254

open'output'file jsr get'string
jsr setnam
jsr get'number
sty device
tya
tax
lda #1
ldy #1
jsr setlfs
jsr open
jsr get'number
sty start'address
sta start'address+1
jsr clrchn
ldx #1
jsr chkout
lda start'address
jsr chrout
lda start'address+1
jsr chrout

lda <$d000
sta $14
lda >$d000
sta $15

output'loop ldy #0
- ldx #$74
sei
stx 1
lda ($14),y
ldx #$77
stx 1
cli
jsr chrout
inc $14
bne +
inc $15

+ lda $15
cmp output'buffer+1
bcc -
lda $14
cmp output'buffer
bcc -
beq -

jsr clrchn
lda #1
jmp close

range'pack lda #1
sta mode
lda 174
sta eof
lda 175
sta eof+1
lda #0
sta e'variable
sta d'variable
jmp set

pack'mem lda #1
sta mode
jsr get'number
sty buffer
sta buffer+1

jsr get'number
sty eof
sty 174
sta eof+1
sta 175

lda #0

sta e'variable
sta d'variable

jsr get'number

sty output'buffer
sta output'buffer+1
set sei
lda #$74
sta 1
jsr encode'loop
jmp make'variable


;***** get string from BASIC ****

get'string jsr $aefd
jsr $ad9e
jsr $b6a3

ldx $22
ldy $23
rts

;**** get number from BASIC ****

get'number jsr $aefd
jsr $ad8a
jmp $b7f7

;store lsb in 253
;store msb in 254
;makes varible, f%

make'variable lda "f"
sta 251
lda "%"
sta 252

lda $7a
pha
lda $7b
pha

lda <251
sta $7a
lda >251
sta $7b
jsr $b08b
ldy #0
lda 254 ;high byte
sta ($47),y
iny
lda 253 ;low byte
sta ($47),y
pla
sta $7b
pla
sta $7a
rts


device .byt 0

start'address .word 0
d'variable .byt 0
e'variable .byt 0
n'variable .byt 0
q'variable .byt 0
eof .word 0
mode .byt 0