pitch-dark/src/onbeyond/z3/z3.s

675 lines
12 KiB
ArmAsm

;license:MIT
;(c) 2017-2018 by qkumba
!cpu 6502
!to "build/ONBEYONDZ3",plain
*=$3000
!macro version {!scrxor $80, "2/191025"}
;user-defined options
verbose_info = 0 ;set to 1 to enable display of memory usage
gamename=$307
savename=$350
scrpname=$390
;unpacker variables, no need to change these
src = $0
dst = $2
ecx = $4
last = $6
tmp = $8
ldy $2006
lda #'3'
sta gamename,y
lda #'Z'
sta gamename-1,y
lda #'V'
sta savename+1,y
lda #'A'
sta savename,y
lda #'S'
sta savename-1,y
lda #'G'
sta scrpname+1,y
lda #'O'
sta scrpname,y
lda #'L'
sta scrpname-1,y
dey
dey
- lda $2006,y
sta gamename,y
sta savename,y
sta scrpname,y
dey
bpl -
inc savename
inc scrpname
lda #>pakoff
sta src + 1
lda #<pakoff
sta src
lda #$0d
sta dst + 1
lda #$7d
sta dst
jsr unpack
;init interpreter
jsr $d7d
;copy new RWTS and interpreter support routines
ldy #0
- lda unrelochdd, y
sta $c11, y
iny
bne -
ldy #<(hddcodeend - $c11)
- lda unrelochdd + $ff, y
sta $d10, y
dey
bne -
lda $bf30
sta c5_parms+1
lda $306
eor $305
eor $304
eor $303
eor $302
eor $301
eor $300
eor #$a5
beq +
lda #$D9
sta $300 ;80-cols
ldx #1
stx $301 ;lowercase
dex
stx $303 ;no script
dex
stx $302 ;no load
+
jsr $fe93
ldx $300
cpx #$ce
beq skip80
lda $bf98
and #2
bne okay80
ldx #$ce
skip80
lda #$df
sta mapmask+1
okay80
stx $1793
lda $301
beq +
lda $bf98
bpl +
inc $17ba
bne ++
+
lda #0
sta $1267
++
lda $303
beq +
lda #<print
sta $18ba
lda #>print
sta $18bb
lda #<printer
sta $1364
lda #>printer
sta $1365
lda $304
beq +
lda #<callbackprn1
sta $11de
lda #>callbackprn1
sta $11df
+
ldx $302
inx
beq +
lda $11de
sta loadcall1+1
lda $11df
sta loadcall2+1
lda #<callback1
sta $11de
lda #>callback1
sta $11df
+
lda #<brand
sta $17eb
lda #>brand
sta $17ec
lda #<savefile
sta $d7d+$340
lda #>savefile
sta $d7d+$341
lda #<loadfile
sta $d7d+$3d2
lda #>loadfile
sta $d7d+$3d3
lda #<closefile
sta $d7d+$36c
sta $d7d+$449
lda #>closefile
sta $d7d+$36d
sta $d7d+$44a
lda #$20
sta $d7d+$76b
lda #<casemap
sta $d7d+$76c
lda #>casemap
sta $d7d+$76d
lda #<quit
sta $d7d+$709
lda #>quit
sta $d7d+$70a
lda #<waitkey
sta $d7d+$6fa
lda #>waitkey
sta $d7d+$6fb
jsr closefile
jmp $173d
brand
jsr $12f8
lda #$f8
sta $17eb
lda #$12
sta $17ec
lda #$17
sta $25
lda #0
sta $24
sta $57b
jsr $fc22
lda #>brandtext
ldx #<brandtext
ldy #(brandtext_e-brandtext)
jmp $12f8
brandtext
!text "On Beyond Z-Machine! revision "
+version
brandtext_e
unrelochdd
!pseudopc $c11 {
ora #$ca
sta pro_op
lda #0
sta ce_parms+2
sta ce_parms+4
sec
lda $65
adjust
sbc #0
asl
asl
asl
rol ce_parms+4
asl
rol ce_parms+4
ora $64
sta ce_parms+3
- jsr $bf00
!byte $ce ;seek
!word ce_parms
bcc +
jsr $bf00
!byte $d0 ;set EOF
!word ce_parms
bcc -
+
jsr $bf00
pro_op
!byte $ca ;read file
!word ca_parms
bcs jmpquit
- rts
printer
cmp #$8d
bne -
iny
sty cb_parms+4
dey
lda #<scrpname
sta c8_parms+1
ldx #(<gamename xor <scrpname)
jsr closefile1
jsr $bf00
!byte $d1
!word ce_parms
jsr $bf00
!byte $ce
!word ce_parms
jsr $bf00
!byte $cb
!word cb_parms
bcc closefile
jmpquit
jmp $dfe
savefile
jsr $bf00
!byte $c0
!word c0_parms
lda $e5a
sta c0_parms+5
jsr $bf00
!byte $c3
!word c0_parms
ldx #$e6
!byte $2c
loadfile
ldx #$b8
lda #$0d
pha
txa
pha
closefile
ldx #(<gamename xor <savename)
closefile1
jsr xclose
jsr xopen
lda adjust+1
eor #3
sta adjust+1
txa
eor c8_parms+1
sta c8_parms+1
rts
callback1
lda xrestore,y
cmp #$8d
bne +
ldx #<callback2
stx $11de
;!if #>callback1 != #>callback2 {
; ldx #>callback2
; stx $11df
;}
+ rts
callback2
lda $302
ora #$b0
ldx #<callback3
stx $11de
;!if #>callback2 != #>callback3 {
; ldx #>callback3
; stx $11df
;}
+ rts
callback3
lda #$D9
loadcall1
ldx #$0c
stx $11de
loadcall2
ldx #$fd
stx $11df
rts
xrestore
!byte $d2,$c5,$d3,$d4,$cf,$d2,$c5,$8d
callbackprn1
lda xscript,y
cmp #$8d
bne +
ldx #$0c
stx $11de
ldx #$fd
stx $11df
+ rts
xscript
!byte $d3,$c3,$d2,$c9,$d0,$d4,$8d
print
jsr $bf00
!byte $c1
!word c1_parms
lda #<scrpname
sta c0_parms+1
jsr $bf00
!byte $c0
!word c0_parms
inc $1363
lda #<savename
sta c0_parms+1
rts
xclose
jsr $bf00
!byte $cc
!word cc_parms
rts
xopen
jsr $bf00
!byte $c8
!word c8_parms
lda c8_parms+5
sta ce_parms+1
sta ca_parms+1
sta cb_parms+1
rts
casemap
ldy $32
bmi +
cmp #$61
bcc +
cmp #$7b
bcs +
mapmask
and #$ff
+ sta $200,x
- rts
waitkey
jsr $12f8
lda $c010
- lda $c000
bpl -
quit
jsr xclose
jsr $bf00
!byte $c5
!word c5_parms
ldx $201
inx
txa
and #$0f
sta $200
lda #$2f
sta $201
jsr $bf00
!byte $c6
!word c6_parms
jsr $bf00
!byte $65
!word quit_parms
c8_parms
!byte 3
!word gamename
!word $800
!byte 0
c0_parms
!byte 7
!word savename
!byte %11000011
!byte 04
!word 0
cc_parms
!byte 1
!word 0
!word 0
ce_parms
!byte 2
!byte 0
!byte 0
!byte 0
!byte 0
ca_parms
!byte 4
!byte $ff
!word $2900
!word $100
!word $ffff
c1_parms
c6_parms
!byte 1
!word scrpname
c5_parms
!byte 2
!byte 0
!word scrpname+1
!byte $d1
cb_parms
quit_parms
!byte 4
!byte $ff
!word $200
!word $00ff
!word $ffff
hddcodeend
}
unpack ;unpacker entrypoint
lda #0
sta last
sta ecx+1
literal
jsr getput
ldy #2
nexttag
jsr getbit
bcc literal
jsr getbit
bcc codepair
jsr getbit
bcs onebyte
jsr getsrc
lsr
beq donedepacking
ldx #0
stx ecx
rol ecx
stx last+1
tax
bne domatch_with_2inc
getbit
asl last
bne .stillbitsleft
jsr getsrc
sec
rol
sta last
.stillbitsleft
donedepacking
rts
onebyte
ldy #0
sty tmp+1
iny
sty ecx
iny
lda #$10
.getmorebits
pha
jsr getbit
pla
rol
bcc .getmorebits
bne domatch
jsr putdst
linktag
bne nexttag
codepair
jsr getgamma
- jsr dececx
dey
bne -
tay
beq +
normalcodepair
dey
sty last+1
jsr getsrc
tax
!byte $a9
+ iny
jsr getgamma
cpy #$7d
bcs domatch_with_2inc
cpy #5
bcs domatch_with_inc
txa
bmi domatch_new_lastpos
tya
bne domatch_new_lastpos
domatch_with_2inc
clc
!byte $24
set_carry
sec
domatch_with_inc
inc ecx
bne test_carry
inc ecx+1
test_carry
bcc set_carry
domatch_new_lastpos
domatch_lastpos
ldy #1
lda last+1
sta tmp+1
txa
domatch
sta tmp
lda src+1
pha
lda src
pha
lda dst
sec
sbc tmp
sta src
lda dst+1
sbc tmp+1
sta src+1
;;access1
;; sta $c003
- jsr getput
jsr dececx
ora ecx+1
bne -
;; sta $c002
pla
sta src
pla
sta src+1
bne linktag
getgamma
lda #1
sta ecx
.getgammaloop
jsr getbit
rol ecx
rol ecx+1
jsr getbit
bcs .getgammaloop
rts
dececx
lda ecx
bne +
dec ecx+1
+ dec ecx
lda ecx
rts
getput
jsr getsrc
putdst
sty tmp
ldy #0
sta (dst), y
inc dst
bne +
inc dst+1
bne +
getsrc
sty tmp
ldy #0
lda (src), y
inc src
bne +
inc src+1
+ ldy tmp
rts
!ifdef PASS2 {
!if >callback1 != >callback2 {
!if verbose_info = 1 {
!warn "callbacks=", >callback1, >callback2
} ;verbose_info
}
!if >callback2 != >callback3 {
!if verbose_info = 1 {
!warn "callbacks=", >callback2, >callback3
} ;verbose_info
}
} else {
!set PASS2=1
}
pakoff
!bin "src/onbeyond/z3/0d7d-2739.pak"
!byte $D3,$C1,$CE,$A0,$C9,$CE,$C3,$AE