Apple-2-SW
/
a2zip
mirror of https://github.com/brouhaha/a2zip.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
a2zip/zip-late.asm

4897 lines
54 KiB
NASM
Raw Permalink Blame History

; Infocom ZIP (Z-Machine architecture v3) interpreter for Apple II,
; The ZIP interpreter is copyrighted by Infocom, Inc.
; This partially reverse-engineered source code is
; Ccopyright 2023 Eric Smith <spacewar@gmail.com>
cpu 6502
; The differences between revisions stated here is not comprehensizve.
iver3f equ $0306 ; Substantially rearranged compared to B.
; Incorporates RWTS-equivalent routines.
iver3h equ $0308 ; Sends 80-col sequence to printer firmware.
; Accepts backspace character.
; Quit says end of session rather than end of story.
; Doesn't use self-modifying code for verify.
iver3k equ $030b ; Disk routines rearranged.
; Forces CSWL to be COUT at start.
iver3m equ $030d ; Eliminated some manipulation of the screen window
; in save and restore.
; Fixed a bug in upper/lower case conversion.
ifndef iver
iver equ iver3f
endif
char_bs equ $08
char_tab equ $09
char_cr equ $0d
char_del equ $7f
fillto macro addr, val
while * < addr
size set addr-*
if size > 256
size set 256
endif
fcb [size] val
endm
endm
text_str macro arg
fcb arg
endm
; macro to print a message
prt_msg macro name
ldx #msg_name&$ff
lda #msg_name>>8
ldy #msg_len_name
jsr msg_out
endm
; macro to print a message and return
prt_msg_ret macro name
ldx #msg_name&$ff
lda #msg_name>>8
ldy #msg_len_name
jmp msg_out
endm
; macro to print a message, loads in alternate order (sigh)
prt_msg_alt macro name
lda #msg_name>>8
ldx #msg_name&$ff
ldy #msg_len_name
jsr msg_out
endm
; Apple II zero page locations
wndwdt equ $21
wndtop equ $22
wndbot equ $23
cursrh equ $24
cursrv equ $25
Z2b equ $2b
invflg equ $32
cswl equ $36
rndloc equ $4e
; disk zero page variables:
org $60
Z60: rmb 1
Z61: rmb 1
Z62: rmb 1
Z63: rmb 1
rwts_sector: rmb 1
rwts_track: rmb 1
Z66: rmb 1
rwts_cmd: rmb 1
rwts_buf: rmb 2
Z6a: rmb 1
rwts_slotx16: rmb 1
Z6c: rmb 1
Z6d: rmb 1
Z6e: rmb 1
Z6f: rmb 1
Z70: rmb 1
Z71: rmb 1
rmb 1
Z73: rmb 1
Z74: rmb 1
; interpreter zero page variables
org $80
opcode: rmb 1
argcnt: rmb 1
arg1: rmb 2
arg2: rmb 2
arg3: rmb 2
arg4: rmb 2
Z8a: rmb 1
Z8b: rmb 1
Z8c: rmb 2
Z8e: rmb 2
Z90: rmb 2
acb: rmb 2
Z94: rmb 2
pc: rmb 2
Z98: rmb 1
Z99: rmb 1
Z9a: rmb 1
Z9b: rmb 1
Z9c: rmb 1
Z9d: rmb 1
Z9e: rmb 1
Z9f: rmb 1
Za0: rmb 1
Za1: rmb 1
Za2: rmb 1
Za3: rmb 2
Za5: rmb 1
Za6: rmb 1
Za7: rmb 1
Za8: rmb 1
Za9: rmb 1
Zaa: rmb 1
Zab: rmb 1
Zac: rmb 1
Zad: rmb 1
Zae: rmb 1
Zaf: rmb 1
Zb0: rmb 1
Zb1: rmb 1
Zb2: rmb 1
Zb3: rmb 1
Zb4: rmb 1
rmb 5
Zba: rmb 1
Zbb: rmb 1
Zbc: rmb 1
Zbd: rmb 1
Zbe: rmb 1
Zbf: rmb 1
Zc0: rmb 1
Zc1: rmb 1
Zc2: rmb 1
Zc3: rmb 1
Zc4: rmb 1
Zc5: rmb 1
Zc6: rmb 1
Zc7: rmb 1
Zc8: rmb 1
Zc9: rmb 1
Zca: rmb 1
Zcb: rmb 1
Zcc: rmb 1
Zcd: rmb 1
Zce: rmb 1
Zcf: rmb 1
Zd0: rmb 1
Zd1: rmb 1
Zd2: rmb 1
Zd3: rmb 2
Zd5: rmb 1
Zd6: rmb 1
Zd7: rmb 1
Zd8: rmb 1
Zd9: rmb 1
Zda: rmb 1
Zdb: rmb 1
Zdc: rmb 1
Zdd: rmb 1
Zde: rmb 1
Zdf: rmb 1
Ze0: rmb 1
rmb 1
Ze2: rmb 1
rmb 1
Ze4: rmb 1
rmb 4
Ze9: rmb 1
Zea: rmb 1
Zeb: rmb 1
Zec: rmb 1
Zed: rmb 1
rmb 2
Zf0: rmb 1
Zf1: rmb 1
Zf2: rmb 1
Zf3: rmb 1
Zf4: rmb 1
rmb 1
Zf6: rmb 1
Zf7: rmb 1
Zf8: rmb 1
rmb 2
Zfb rmb 1
D0100 equ $0100
D01ff equ $01ff
D0200 equ $0200
cur80h equ $057b
D0835 equ $0835
org $2900
rwts_sec_buf_size equ 86
rwts_data_buf: rmb 256
rwts_pri_buf: rmb 256
rwts_sec_buf: rmb rwts_sec_buf_size
align $0100
D2c00: rmb 256
D2d00: rmb 256
if iver>=iver3h
D2e00:
endif
rmb 256
stk_low_bytes: rmb 256 ; stack, low bytes
stk_high_bytes: rmb 256 ; stack, high bytes
local_vars: rmb 30
rmb 2
D3120: rmb 2 ; save hdr_game_ver
D3122: rmb 2 ; save Z94
D3124: rmb 3 ; save PC
align $0100
; game header
hdr_arch rmb 1 ; Z-machine architecture version
hdr_flags_1 rmb 1 ; flags 1
hdr_game_ver rmb 2 ; game version
hdr_high_mem rmb 2 ; base of high memory
hdr_init_pc rmb 2 ; initial value of program counter (byte address)
hdr_vocab rmb 2 ; location of dictionary
hdr_object rmb 2 ; object table
hdr_globals rmb 2 ; global variables
hdr_pure rmb 2 ; base of pure (immutable) memory
hdr_flags2 rmb 2
rmb 6 ; "serial" (usually game release date)
hdr_abbrev rmb 2 ; abbreviation table
hdr_length rmb 2
hdr_checksum rmb 2
; Apple II I/O
kbd equ $c000
kbd_strb equ $c010
rdc3rom equ $c017 ; IIe and newer
text_on equ $c051
mixed_off equ $c052
txt_page_1 equ $c054
; Disk II I/O (indexed by slot x 16)
ph_off equ $c080
mtr_off equ $c088
mtr_on equ $c089
drv0_en equ $c08a
drv1_en equ $c08b
q6l equ $c08c
q6h equ $c08d
q7l equ $c08e
q7h equ $c08f
; Apple slot 3 firmware (80-column)
sl3fw equ $c300
; Apple II monitor ROM locations
; IIe IIe IIc IIc IIc
; IIe enh opt IIc 3.5 mem1 mem2 IIc+ IIgs
romid equ $fbb3 ; $06 $06 $06 $06 $06 $06 $06 $06 $06f
romid2 equ $fbc0 ; $ea $e0 $e0 $00 $00 $00 $00 $00 $ea
vtab equ $fc22
home equ $fc58
clreol equ $fc9c
rdkey equ $fd0c
cout equ $fded
cout1 equ $fdf0
bell equ $ff3a
org $0900
; RWTS caller - unused?
nop
nop
nop
php
sei
jsr rwts_inner
bcs .fail
plp
clc
rts
.fail: plp
sec
rts
pre_nibble:
ldx #$00
ldy #$02
.loop1: dey
lda (rwts_buf),y
lsr
rol rwts_sec_buf,x
lsr
rol rwts_sec_buf,x
sta rwts_pri_buf,y
inx
cpx #rwts_sec_buf_size
bcc .loop1
ldx #$00
tya
bne .loop1
ldx #rwts_sec_buf_size-1
.loop2: lda rwts_sec_buf,x
and #$3f
sta rwts_sec_buf,x
dex
bpl .loop2
rts
write_data_field:
stx Z6e
stx D0d51
sec
lda q6h,x ; check write protect
lda q7l,x
bmi .exit
lda rwts_sec_buf
sta Z6d
lda #$ff ; write a sync pattern
sta q7h,x
ora q6l,x
pha
pla
nop
ldy #$04 ; write four more sync patterns
.loop1: pha
pla
jsr write_28
dey
bne .loop1
lda #$d5 ; write data field prologue
jsr write_30
lda #$aa
jsr write_30
lda #$ad
jsr write_30
; write secondary buffer (reverse order)
tya
ldy #rwts_sec_buf_size
bne .lp2a
.loop2: lda rwts_sec_buf,y
.lp2a: eor rwts_sec_buf-1,y
tax
lda nib_tab,x
ldx Z6e
sta q6h,x
lda q6l,x
dey
bne .loop2
; write primary buffer
lda Z6d
nop
.loop3: eor rwts_pri_buf,y
tax
lda nib_tab,x
ldx D0d51
sta q6h,x
lda q6l,x
lda rwts_pri_buf,y
iny
bne .loop3
tax ; write checksum
lda nib_tab,x
ldx Z6e
jsr write_21
lda #$de ; write data field epilogue
jsr write_30
lda #$aa
jsr write_30
lda #$eb
jsr write_30
lda #$ff ; dummy write to get third byte of data field epilogue out
jsr write_30
lda q7l,x ; turn off writing
.exit: lda q6l,x
rts
write_30:
clc ; 2
write_28:
pha ; 3
pla ; 4
write_21:
sta q6h,x ; 5
ora q6l,x ; 4
rts ; 6
; +6 jsr
if iver<=iver3h
post_nibble:
ldy #$00
.loop1: ldx #rwts_sec_buf_size
.loop2: dex
bmi .loop1
lda rwts_pri_buf,y
lsr rwts_sec_buf,x
rol
lsr rwts_sec_buf,x
rol
sta (rwts_buf),y
iny
cpy Z6d
bne .loop2
rts
endif
read_data_field_16:
ldy #$20
.loop1: dey
beq read_data_field_16_fail
.loop2: lda q6l,x
bpl .loop2
.loop3: eor #$d5 ; check for data field prologue 1st byte
bne .loop1
nop
.loop4: lda q6l,x
bpl .loop4
cmp #$aa ; check for data field prologue 2nd byte
bne .loop3
ldy #rwts_sec_buf_size
.loop5: lda q6l,x
bpl .loop5
cmp #$ad ; check for data field prologue 3rd byte
bne .loop3
; read secondary buffer in reverse order (high to low)
lda #$00
.loop6: dey
sty Z6d
.loop7: ldy q6l,x
bpl .loop7
eor denib_tab,y
ldy Z6d
sta rwts_sec_buf,y
bne .loop6
; read primary buffer in forward order
.loop8: sty Z6d
.loop9: ldy q6l,x
bpl .loop9
eor denib_tab,y
ldy Z6d
sta rwts_pri_buf,y
iny
bne .loop8
.loop10:
ldy q6l,x
bpl .loop10
cmp denib_tab,y ; verify checksum
bne read_data_field_16_fail
.loop11:
lda q6l,x
bpl .loop11
cmp #$de ; check for data field epilogue 1st byte
bne read_data_field_16_fail
nop
.loop12:
lda q6l,x
bpl .loop12
cmp #$aa ; check for data field epilogue 2nd byte
beq read_address_field_success
read_data_field_16_fail:
sec
rts
; search for and read address field
read_address_field:
ldy #$fc
sty Z6d
.loop1: iny
bne .loop2
inc Z6d
beq read_data_field_16_fail
.loop2: lda q6l,x
bpl .loop2
.loop3: cmp #$d5 ; check for address field prologue 1st byte
bne .loop1
nop
.loop4: lda q6l,x
bpl .loop4
cmp #$aa ; check for address field prologue 2nd byte
bne .loop3
ldy #$03
.loop5: lda q6l,x
bpl .loop5
cmp #$96 ; check for address field prologue 3rd byte
bne .loop3
lda #$00
.loop6: sta Z6e
.loop7: lda q6l,x
bpl .loop7
rol
sta Z6d
.loop8: lda q6l,x
bpl .loop8
and Z6d
sta Z6f,y
eor Z6e
dey
bpl .loop6
tay
bne read_data_field_16_fail
.loop9: lda q6l,x
bpl .loop9
cmp #$de ; check for address field epilogue 1st byte
bne read_data_field_16_fail
nop
.loop10:
lda q6l,x
bpl .loop10
cmp #$aa ; check for address field epilogue 2nd byte
bne read_data_field_16_fail
read_address_field_success:
clc
rts
seek_track:
stx rwts_slotx16
sta Z6c
cmp D0d3e
beq .rtn
lda #$00
sta Z6d
.loop1: lda D0d3e
sta Z6e
sec
sbc Z6c
beq .fwd5
bcs .fwd1
eor #$ff
inc D0d3e
bcc .fwd2
.fwd1: adc #$fe
dec D0d3e
.fwd2: cmp Z6d
bcc .fwd3
lda Z6d
.fwd3: cmp #$0c
bcs .fwd4
tay
.fwd4: sec
jsr .subr1
lda motor_on_time_tab,y
jsr delay
lda Z6e
clc
jsr .subr2
lda motor_off_time_tab,y
jsr delay
inc Z6d
bne .loop1
.fwd5: jsr delay
clc
.subr1: lda D0d3e
.subr2: and #$03
rol
ora rwts_slotx16
tax
lda ph_off,x
ldx rwts_slotx16
.rtn: rts
if iver>=iver3k
align $0100,$00
endif
if iver<=iver3h
delay: ldx #$11
.loop1: dex
bne .loop1
inc Z73
bne .fwd1
inc Z74
.fwd1: sec
sbc #$01
bne delay
rts
endif
if iver>=iver3k
S0cfc: sta Z6c
jsr S0d1f
lda D0d3e,y
bit Z6a
bmi L0d0b
lda D0d46,y
L0d0b: sta D0d3e
lda Z6c
bit Z6a
bmi L0d19
sta D0d46,y
bpl L0d1c
L0d19: sta D0d3e,y
L0d1c: jmp seek_track
endif
motor_on_time_tab:
fcb $01,$30,$28,$24,$20,$1e,$1d,$1c
fcb $1c,$1c,$1c,$1c
motor_off_time_tab:
fcb $70,$2c,$26,$22,$1f,$1e,$1d,$1c
fcb $1c,$1c,$1c,$1c
nib_tab:
fcb $96,$97,$9a,$9b,$9d,$9e,$9f,$a6
fcb $a7,$ab,$ac,$ad,$ae,$af,$b2,$b3
fcb $b4,$b5,$b6,$b7,$b9,$ba,$bb,$bc
fcb $bd,$be,$bf,$cb,$cd,$ce,$cf,$d3
fcb $d6,$d7,$d9,$da,$db,$dc,$dd,$de
fcb $df,$e5,$e6,$e7,$e9,$ea,$eb,$ec
fcb $ed,$ee,$ef,$f2,$f3,$f4,$f5,$f6
fcb $f7,$f9,$fa,$fb,$fc,$fd,$fe,$ff
denib_tab equ *-$96
fcb $00,$01,$98,$99,$02,$03,$9c,$04
fcb $05,$06,$a0,$a1,$a2,$a3,$a4,$a5
fcb $07,$08,$a8,$a9,$aa,$09,$0a,$0b
fcb $0c,$0d,$b0,$b1,$0e,$0f,$10,$11
fcb $12,$13,$b8,$14,$15,$16,$17,$18
fcb $19,$1a,$c0,$c1,$c2,$c3,$c4,$c5
fcb $c6,$c7,$c8,$c9,$ca,$1b,$cc,$1c
fcb $1d,$1e,$d0,$d1,$d2,$1f,$d4,$d5
fcb $20,$21,$d8,$22,$23,$24,$25,$26
fcb $27,$28,$e0,$e1,$e2,$e3,$e4,$29
fcb $2a,$2b,$e8,$2c,$2d,$2e,$2f,$30
fcb $31,$32,$f0,$f1,$33,$34,$35,$36
fcb $37,$38,$f8,$39,$3a,$3b,$3c,$3d
fcb $3e,$3f
if iver>=iver3k
align $0100,$00
delay: ldx #$11
.loop1: dex
bne .loop1
inc Z73
bne .fwd1
inc Z74
.fwd1: sec
sbc #$01
bne delay
rts
endif
; On entry:
; A = command
; $00 = read 16-sector
; $01 = write 16-sector
rwts_inner:
sta rwts_cmd
lda #$02
sta D0d52
asl
sta D0d4e
ldx Z60
cpx Z61
beq .fwd1
ldx Z61
lda q7l,x
.loop1: ldy #$08
lda q6l,x
.loop2: cmp q6l,x
bne .loop1
dey
bne .loop2
ldx Z60
stx Z61
.fwd1: lda q7l,x
lda q6l,x
ldy #$08
.loop3: lda q6l,x
pha
pla
pha
pla
stx D0d50
cmp q6l,x
bne .fwd2
dey
bne .loop3
.fwd2: php
lda mtr_on,x
lda #$d8
sta Z74
lda Z62
cmp Z63
beq .fwd3
sta Z63
plp
ldy #$00
php
.fwd3: ror
bcc .fwd4
lda drv0_en,x
bcs .fwd5
.fwd4: lda drv1_en,x
.fwd5: ror Z6a
plp
php
bne .fwd6
ldy #$07
.loop4: jsr delay
dey
bne .loop4
ldx D0d50
.fwd6: lda rwts_track
jsr S0cf4
plp
bne .fwd7
ldy Z74
bpl .fwd7
.loop5: ldy #$12
.loop6: dey
bne .loop6
inc Z73
bne .loop5
inc Z74
bne .loop5
.fwd7: lda rwts_cmd ; is command read or write?
ror
php
bcc L0c73 ; read
jsr pre_nibble ; write
L0c73: lda #48
sta addr_field_search_retry_counter
L0c78: ldx D0d50
jsr read_address_field
bcc L0ca4
; address field not found
L0c80: dec addr_field_search_retry_counter
bpl L0c78
; too many errors searching for address field
L0c85: lda D0d3e
pha
lda #$60
jsr S0d26
dec D0d52
beq L0cbb
lda #$04
sta D0d4e
lda #$00
jsr S0cf4
pla
L0c9e: jsr S0cf4
jmp L0c73
L0ca4: ldy Z71
cpy D0d3e
beq L0cc2
lda D0d3e
pha
tya
jsr S0d26
pla
dec D0d4e
bne L0c9e
beq L0c85 ; always taken
L0cbb: pla
lda #$40
plp
jmp L0ce4
L0cc2: ldy rwts_sector ; logical sector number
lda D0835,y ; map to physical sector number via interleave table in boot1
cmp Z70 ; does it match physical sector number?
bne L0c80 ; no
plp
bcs L0ceb
jsr read_data_field_16
if iver<=iver3h
php
bcs L0c80
plp
else
bcc L0d08
clc
php
bcc L0c80
L0d08:
endif
ldx #$00
stx Z6d
jsr post_nibble
ldx D0d50
L0cdf: lda #$00
clc
bcc L0ce5
L0ce4: sec
L0ce5: sta Z66
lda mtr_off,x
rts
L0ceb: jsr write_data_field
bcc L0cdf
lda #$10
bne L0ce4 ; always taken
S0cf4: asl
jsr S0cfc
lsr D0d3e
rts
if iver<=iver3h
S0cfc: sta Z6c
jsr S0d1f
lda D0d3e,y
bit Z6a
bmi L0d0b
lda D0d46,y
L0d0b: sta D0d3e
lda Z6c
bit Z6a
bmi L0d19
sta D0d46,y
bpl L0d1c
L0d19: sta D0d3e,y
L0d1c: jmp seek_track
endif
S0d1f: txa
lsr
lsr
lsr
lsr
tay
rts
S0d26: pha
lda Z62
ror
ror Z6a
jsr S0d1f
pla
asl
bit Z6a
bmi .fwd1
sta D0d46,y
bpl .rtn
.fwd1: sta D0d3e,y
.rtn: rts
if iver>=iver3k
post_nibble:
ldy #$00
.loop1: ldx #rwts_sec_buf_size
.loop2: dex
bmi .loop1
lda rwts_pri_buf,y
lsr rwts_sec_buf,x
rol
lsr rwts_sec_buf,x
rol
sta (rwts_buf),y
iny
cpy Z6d
bne .loop2
rts
endif
D0d3e: fcb $00,$00,$00,$00,$00,$00,$00,$00
D0d46: fcb $00,$00,$00,$00,$00,$00,$00,$00
D0d4e: fcb $00
addr_field_search_retry_counter:
fcb $00
D0d50: fcb $00
D0d51: fcb $00
D0d52: fcb $00
; subroutine called by boot1
e_0d53: lda text_on
lda mixed_off
lda txt_page_1
lda #rwts_data_buf>>8
sta rwts_buf+1
lda #rwts_data_buf&$ff
sta rwts_buf
lda #$01
sta Z62
sta Z63
rts
; convert block number to track and sector
S0d6b: lda Zea
and #$0f
sta rwts_sector
lda Zeb
and #$0f
asl
asl
asl
asl
sta rwts_track
lda Zea
and #$f0
lsr
lsr
lsr
lsr
ora rwts_track
clc
cld
adc #$03
cmp #$24
bcs int_err_0c
sta rwts_track
read_sector:
lda #$00
jsr rwts_inner
bcs int_err_0e_alt
ldy #$00
L0d98: lda rwts_data_buf,y
sta (Zec),y
iny
bne L0d98
inc Zea
bne L0da6
inc Zeb
L0da6: inc rwts_sector
lda rwts_sector
and #$0f
bne L0db7
ldx rwts_track
inx
cpx #$24
bcs L0dce
stx rwts_track
L0db7: sta rwts_sector
inc Zed
clc
rts
e_0dbd: ldy #$00
L0dbf: lda (Zec),y
sta rwts_data_buf,y
iny
bne L0dbf
lda #$01
jsr rwts_inner
bcc L0da6
L0dce: rts
int_err_0c:
lda #$0c
jmp int_error
int_err_0e_alt:
lda #$0e
jmp int_error
e_0dd9: jsr op_new_line
if iver<=iver3k
lda #$00
sta wndtop
jsr home
lda #$00
sta Zdf
sta cursrh
sta cur80h
sta cursrv
jmp S144e
else
lda #$00
sta Zdf
rts
endif
msg_default_is: text_str " (Default is "
D0dfe: text_str "*) >"
msg_len_default_is equ *-msg_default_is
S0e02: clc
adc #'1'
sta D0dfe
prt_msg_ret default_is
msg_position:
fcb char_cr
text_str "Position 0-7"
msg_len_position equ *-msg_position
msg_drive:
fcb char_cr
text_str "Drive 1 or 2"
msg_len_drive equ *-msg_drive
msg_slot:
fcb char_cr
text_str "Slot 1-7"
msg_len_slot equ *-msg_slot
D0e34: fcb $05
msg_pos_drive_slot_verify:
fcb char_cr,char_cr
text_str "Position "
D0e40: text_str "*; Drive #"
D0e4a text_str "*; Slot "
D0e52: text_str "*."
fcb char_cr
text_str "Are you sure? (Y/N) >"
msg_len_pos_drive_slot_verify equ *-msg_pos_drive_slot_verify
msg_insert_save:
fcb char_cr
text_str "Insert SAVE disk into Drive #"
D0e88: text_str "*."
msg_len_insert_save equ *-msg_insert_save
msg_yes:
D0e8a: text_str "YES"
fcb char_cr
msg_len_yes equ *-msg_yes
msg_no:
D0e8e: text_str "NO"
fcb char_cr
msg_len_no equ *-msg_no
S0e91: prt_msg position
ldx Zf0
dex
txa
jsr S0e02
.loop1: jsr S11c5
cmp #char_cr
beq .fwd1
sec
sbc #'0'
cmp #8
bcc .fwd2
jsr bell
jmp .loop1
.fwd1: lda Zf0
.fwd2: sta Zf2
clc
adc #$30
sta D0e40
sta D1063
sta D110c
jsr S1275
prt_msg drive
lda Zf1
jsr S0e02
.loop2: jsr S11c5
cmp #char_cr
beq .fwd3
sec
sbc #'1'
cmp #2
bcc .fwd4
jsr bell
jmp .loop2
.fwd3: lda Zf1
.fwd4: sta Zf3
clc
adc #'1'
sta D0e88
sta D0e4a
jsr S1275
lda romid2_save ; IIc family?
bne .fwd5 ; no
lda #$05 ; yes, force slot 5
bne .fwd7
.fwd5: prt_msg slot
lda D0e34
jsr S0e02
.loop3: jsr S11c5
cmp #char_cr
beq .fwd6
sec
sbc #'1'
cmp #$07
bcc .fwd7
jsr bell
jmp .loop3
.fwd6: lda D0e34
.fwd7: sta Zf4
clc
adc #'1'
sta D0e52
ldx romid2_save ; IIc family?
beq .fwd8 ; yes
jsr S1275
.fwd8: prt_msg pos_drive_slot_verify
.loop4: jsr S11c5
cmp #'y'
beq .fwd10
cmp #'Y'
beq .fwd10
cmp #char_cr
beq .fwd10
cmp #'n'
beq .fwd9
cmp #'N'
beq .fwd9
jsr bell
jmp .loop4
.fwd9: prt_msg no
jmp S0e91
.fwd10: prt_msg yes
lda Zf3
if iver==iver3f
sta Zf1
endif
sta Z62
inc Z62
ldx Zf4
if iver==iver3f
stx D0e34
endif
inx
txa
asl
asl
asl
asl
sta Z60
lda Zf2
if iver==iver3f
sta Zf0
endif
asl
asl
sta rwts_track
lda #$00
sta rwts_sector
prt_msg insert_save
S0f9e: prt_msg press_return
.loop5: jsr S11c5
cmp #char_cr
beq .fwd13
jsr bell
jmp .loop5
.fwd13: rts
msg_press_return:
fcb char_cr
text_str "Press [RETURN] to continue."
fcb char_cr
text_str ">"
msg_len_press_return equ *-msg_press_return
msg_insert_story:
fcb char_cr
text_str "Insert the STORY disk into Drive #1."
msg_len_insert_story equ *-msg_insert_story
S0ff8:
if iver>=iver3h
lda Z62
pha
endif
lda D172e
ldx D172d
sta Z62
stx Z60
if iver==iver3f
lda Zf1
bne .fwd2
else
pla
cmp #$02
beq .fwd2
endif
.loop1: prt_msg insert_story
jsr S0f9e
ldx #$01
stx rwts_sector
dex
stx rwts_track
txa
jsr rwts_inner
bcc .fwd1
jmp int_err_0e_alt
.fwd1: lda #$29
sta Z8e+1
lda #$00
sta Z8e
ldx #$08
inx
stx Z90+1
lda #$00
sta Z90
ldy #$00
.loop2: lda (Z8e),y
cmp (Z90),y
bne .loop1
iny
bne .loop2
.fwd2: lda #$ff
sta Zdf
rts
msg_save_position:
D1043: text_str "Save Position"
fcb char_cr
msg_len_save_position equ *-msg_save_position
msg_saving_position:
fcb char_cr,char_cr
text_str "Saving position "
D1063: text_str "* ..."
fcb char_cr
msg_len_saving_position equ *-msg_saving_position
op_save:
if iver<=iver3k
lda wndtop
pha
endif
jsr e_0dd9
prt_msg save_position
jsr S0e91
prt_msg saving_position
lda hdr_game_ver
sta D3120
lda hdr_game_ver+1
sta D3120+1
lda Z94
sta D3122
lda Z94+1
sta D3122+1
ldx #$02
.loop1: lda pc,x
sta D3124,x
dex
bpl .loop1
lda #(hdr_arch>>8)-1
sta Zed
jsr e_0dbd
bcc .fwd1
.loop2: jsr S0ff8
if iver<=iver3k
pla
sta wndtop
jsr home
endif
jmp predicate_false
.fwd1: lda #(hdr_arch>>8)-3
sta Zed
jsr e_0dbd
bcs .loop2
jsr e_0dbd
bcs .loop2
lda Za3
sta Zed
ldx hdr_pure
inx
stx Z8e
.loop4: jsr e_0dbd
bcs .loop2
dec Z8e
bne .loop4
jsr S0ff8
if iver>=iver3h
lda Zf3
sta Zf1
lda Zf4
sta D0e34
lda Zf2
sta Zf0
endif
if iver<=iver3k
pla
sta wndtop
jsr home
endif
jmp predicate_true
msg_restore_position:
text_str "Restore Position"
fcb char_cr
msg_len_restore_position equ *-msg_restore_position
msg_restoring_position:
fcb char_cr,char_cr
text_str "Restoring position "
D110c: text_str "* ..."
fcb char_cr
msg_len_restoring_position equ *-msg_restoring_position
op_restore:
if iver<=iver3k
lda wndtop
pha
endif
jsr e_0dd9
prt_msg restore_position
jsr S0e91
prt_msg restoring_position
ldx #$1f
.loop1: lda local_vars,x
sta D0100,x
dex
bpl .loop1
lda #(hdr_arch>>8)-1
sta Zed
jsr read_sector
bcs .loop2
lda D3120
cmp hdr_game_ver
bne .loop2
lda D3120+1
cmp hdr_game_ver+1
beq .fwd1
.loop2: ldx #$1f
.loop3: lda D0100,x
sta local_vars,x
dex
bpl .loop3
jsr S0ff8
if iver<=iver3k
pla
sta wndtop
jsr home
endif
jmp predicate_false
.fwd1: lda hdr_flags2
sta Z8e
lda hdr_flags2+1
sta Z8e+1
lda #(hdr_arch>>8)-3
sta Zed
jsr read_sector
bcs .loop2
jsr read_sector
bcs .loop2
lda Za3
sta Zed
jsr read_sector
bcs .loop2
lda Z8e
sta hdr_flags2
lda Z8e+1
sta hdr_flags2+1
lda hdr_pure
sta Z8e
.loop5: jsr read_sector
bcs .loop2
dec Z8e
bne .loop5
lda D3122
sta Z94
lda D3122+1
sta Z94+1
ldx #$02
.loop6: lda D3124,x
sta pc,x
dex
bpl .loop6
lda #$00
sta Z99
jsr S0ff8
if iver>=iver3h
lda Zf3
sta Zf1
lda Zf4
sta D0e34
lda Zf2
sta Zf0
endif
if iver<=iver3k
pla
sta wndtop
jsr home
endif
jmp predicate_true
S11c5: cld
txa
pha
tya
pha
.loop1:
if iver==iver3f
lda D172b
beq .fwd0
lda cur80h
sta cursrh
endif
.fwd0: jsr rdkey
and #$7f
cmp #$0d
bne .fwd1
jmp .fwd6
.fwd1: cmp #$7f
bne .fwd2
jmp .fwd6
.fwd2: cmp #$08
bne .fwd3
jmp .fwd6
.fwd3:
if iver>=iver3h
ldx #D1243_len-1
.loop1a:
cmp D1243,x
beq .fwd3a
dex
bpl .loop1a
bmi .fwd3b ; always taken
.fwd3a: lda D124d,x
bne .fwd6 ; always taken
.fwd3b:
endif
cmp #$20
bcc .fwd5
cmp #$2b
beq .fwd5
if iver==iver3f
cmp #$3c
bne .fwd4
lda #$2c
bne .fwd6 ; always taken
.fwd4: cmp #$5f
bne .fwd4a
lda #$2d
bne .fwd6 ; always taken
.fwd4a: cmp #$3e
bne .fwd4b
lda #$2e
bne .fwd6 ; always taken
.fwd4b: cmp #$29
bne .fwd4c
lda #$30
bne .fwd6 ; always taken
.fwd4c: cmp #$40
bne .fwd4d
lda #$32
bne .fwd6 ; always taken
.fwd4d: cmp #$25
bne .fwd4e
lda #$35
bne .fwd6 ; always taken
.fwd4e: cmp #$5e
bne .fwd4f
lda #$36
bne .fwd6 ; always taken
.fwd4f: cmp #$26
bne .fwd4g
lda #$37
bne .fwd6 ; always taken
.fwd4g: cmp #$2a
bne .fwd4h
lda #$38
bne .fwd6 ; always taken
.fwd4h: cmp #$28
bne .fwd4i
lda #$39
bne .fwd6 ; always taken
endif
.fwd4i: cmp #$3c
bcc .fwd6
cmp #$3f
beq .fwd6
cmp #$7b
bcs .fwd5
cmp #$61
bcs .fwd6
cmp #$41
bcc .fwd5
cmp #$5b
bcc .fwd6
.fwd5: jsr bell
jmp .loop1
.fwd6: sta Ze2
adc rndloc
sta rndloc
eor rndloc+1
sta rndloc+1
pla
tay
pla
tax
lda Ze2
rts
if iver>=iver3h
D1243: fcb "<_>)@%^&*("
D1243_len equ *-D1243
D124d: fcb ",-.0256789"
endif
S1275: sta Ze2
txa
pha
tya
pha
lda Ze2
if iver<=iver3k
cmp #$60
else
cmp #$61
endif
bcc .fwd1
if iver<=iver3k
cmp #$80
else
cmp #$7b
endif
bcs .fwd1
ldx D172b
bne .fwd1
and #$df
.fwd1: ora #$80
jsr cout
pla
tay
pla
tax
rts
e_1296: jsr S156f
ldy wndtop
sty Ze0
inc Ze0
ldy #$00
.loop1: jsr S11c5
cmp #$0d
beq .fwd3
cmp #$7f
beq .fwd1
cmp #$08
beq .fwd1
sta D0200,y
iny
.loop2: jsr S1275
cpy #$4d
bcc .loop1
.loop3: jsr S11c5
cmp #char_cr
beq .fwd3
cmp #char_del
beq .fwd1
if iver>=iver3h
cmp #char_bs
beq .fwd1
endif
jsr bell
jmp .loop3
.fwd1: dey
bmi .fwd2
lda #$08
jsr S1275
lda #$20
jsr S1275
lda #$08
bne .loop2 ; always taken
.fwd2: jsr bell
ldy #$00
beq .loop1 ; always taken
.fwd3: lda #$8d
sta D0200,y
iny
sty Zc2
sty Ze9
jsr S1275
.loop4: lda D01ff,y
cmp #$41
bcc .fwd4
cmp #$5b
bcs .fwd4
adc #$20
.fwd4:
if iver>=iver3h
and #$7f
endif
sta (arg1),y
dey
if iver==iver3f
bpl .loop4
else
bne .loop4
endif
jsr S1328
lda Zc2
ldx D172b
bne .rtn
cmp #$28
bcc .rtn
inc Ze0
.rtn: rts
; On entry:
; A:X message address
; Y message length
msg_out:
stx .lda+1
sta .lda+2
ldx #$00
.loop1:
.lda: fcb $bd,$00,$00 ; lda $0000,x ; self-modifying code, MUST be absolute, X
jsr S1275
inx
dey
bne .loop1
rts
L1327: rts
S1328: lda Zdf
beq L1327
lda hdr_flags2+1
and #$01
beq L1327
lda cswl
pha
lda cswl+1
pha
lda cursrh
pha
lda cur80h
pha
lda D13ad
sta cswl
lda D13ad+1
sta cswl+1
lda #$00
sta cursrh
sta cur80h
if iver==iver3f
lda D13ac
cmp #$01
bne .fwd1
inc D13ac
lda #$89
jsr cout
lda cswl+1
sta D13ad+1
lda cswl
sta D13ad
lda #$b8
jsr cout
lda #$b0
jsr cout
lda #$ce
jsr cout
lda #char_cr+$80
jsr cout
endif
.fwd1: ldy #$00
.loop1: lda D0200,y
jsr cout
iny
dec Ze9
bne .loop1
pla
sta cur80h
pla
sta cursrh
pla
sta cswl+1
pla
sta cswl
rts
msg_printer_slot
fcb char_cr
text_str "Printer Slot 1-7: "
msg_len_printer_slot equ *-msg_printer_slot
D13ac: fcb $00
D13ad: fdb $0000
S13af: prt_msg printer_slot
lda #$00
jsr S0e02
jsr S11c5
cmp #$0d
beq .fwd1
sec
sbc #$30
cmp #$08
bcs S13af
bcc .fwd2
.fwd1: lda #$01
.fwd2: clc
adc #$c0
sta D13ad+1
jsr S144e
inc D13ac
if iver>=iver3h
; send sequence <Control-I>80N to convince printer firmware to use
; 80 columns
lda cswl
pha
lda cswl+1
pha
lda D13ad
sta cswl
lda D13ad+1
sta cswl+1
lda #char_tab+$80
jsr cout
lda #'8'+$80
jsr cout
lda #'0'+$80
jsr cout
lda #'N'+$80
jsr cout
lda cswl
sta D13ad
lda cswl+1
sta D13ad+1
pla
sta cswl+1
pla
sta cswl
endif
rts
op_split_window:
lda hdr_flags_1
and #$20
beq L1412
lda arg1
beq L1413
ldx Ze4
bne L1412
cmp #$14
bcs L1412
pha
clc
adc #$01
sta wndbot
sta Ze4
jsr home
lda #$18
sta wndbot
pla
clc
adc #$01
sta wndtop
lda #$01
sta cursrh
sta cur80h
lda #$16
sta cursrv
jmp S144e
L1412: rts
L1413: lda #$01
sta wndtop
lda #$00
sta Ze0
sta Ze4
rts
op_set_window:
lda hdr_flags_1
and #$20
beq L1412
lda Ze4
beq L1412
lda arg1
bne .fwd1
sta Zfb
lda #$01
sta cursrh
sta cur80h
lda #$16
sta cursrv
bne .fwd2 ; alway taken
.fwd1: cmp #$01
bne L1412
sta Zfb
lda #$00
sta cursrh
sta cur80h
sta cursrv
.fwd2: jmp S144e
S144e: lda D172b
beq .fwd1
lda #char_cr
bne .fwd2
.fwd1: lda #char_cr+$80
.fwd2: jmp cout
msg_internal_error:
text_str "Internal error "
D146b: text_str "00."
msg_len_internal_error equ *-msg_internal_error
; On entry:
; A = error number
int_error:
cld
ldy #$01 ; divide error number by 10, storing into message
.loop1: ldx #0
.loop2: cmp #10
bcc .fwd1
sbc #10
inx
bne .loop2
.fwd1: ora #$30
sta D146b,y
txa
dey
bpl .loop1
prt_msg internal_error
; fall into op_quit
op_quit:
jsr op_new_line
prt_msg end_of_session
jmp * ; deliberate hang
msg_end_of_session:
if iver==iver3f
text_str "End of story."
else
text_str "End of session."
endif
fcb char_cr
msg_len_end_of_session equ *-msg_end_of_session
op_restart:
ldx #$00
stx wndtop
lda hdr_flags2+1
and #$01
beq .fwd1
dex
stx D13ac
.fwd1: jmp restart
msg_interpreter_version:
text_str "Apple II Version "
fcb $40+(iver&$ff)
fcb char_cr
msg_len_interpreter_version equ *-msg_interpreter_version
print_interpreter_version:
jsr op_new_line
prt_msg_ret interpreter_version
S14dc: lda #$bf
rts
S14df: inc rndloc
dec rndloc+1
lda rndloc
adc Zf7
tax
lda rndloc+1
sbc Zf8
sta Zf7
stx Zf8
rts
S14f1: cmp #char_cr
beq op_new_line
cmp #' '
bcc .rrn
ldx Zdd
sta D0200,x
cpx Zf6
bcs .fwd1
inc Zdd
.rrn: rts
.fwd1: lda #$20
.loop1: cmp D0200,x
beq .fwd2
dex
bne .loop1
ldx Zf6
.fwd2: stx Zde
stx Zdd
jsr op_new_line
ldx Zde
ldy #$00
.loop2: inx
cpx Zf6
bcc .fwd3
beq .fwd3
sty Zdd
rts
.fwd3: lda D0200,x
sta D0200,y
iny
bne .loop2 ; always taken?
op_new_line:
lda Zfb
bne .fwd1
inc Ze0
.fwd1: ldx Zdd
lda #$8d
sta D0200,x
inc Zdd
ldx Ze0
inx
cpx wndbot
bcc S156f
jsr op_show_status
ldx wndtop
inx
stx Ze0
bit kbd_strb
prt_msg_alt more
.loop1: bit kbd
bpl .loop1
bit kbd_strb
lda #$00
sta cursrh
sta cur80h
jsr clreol
ldx Zdd
beq L1588
; fall into S156f
S156f: ldy Zdd
beq L1588
sty Ze9
ldx #$00
.loop1: lda D0200,x
jsr S1275
inx
dey
bne .loop1
jsr S1328
lda #$00
sta Zdd
L1588: rts
msg_more:
text_str "[MORE]"
msg_len_more equ *-msg_more
op_show_status:
jsr S156f
lda cur80h
pha
lda cursrh
pha
lda cursrv
pha
lda Zdd
pha
lda Z9e
pha
lda Z9d
pha
lda Z9c
pha
lda Zca
pha
lda Zc9
pha
lda Zcf
pha
lda Zce
pha
lda Zcd
pha
lda Zdb
pha
lda wndtop
pha
ldx Zf6
.loop1: lda D0200,x
sta D3120,x
lda #$20
sta D0200,x
dex
bpl .loop1
lda #$00
sta Zdd
sta Zdf
sta wndtop
sta cursrh
sta cur80h
sta cursrv
jsr vtab
lda #$3f
sta invflg
lda #$10
jsr S1a03
lda Z8c
jsr S1cfc
lda D172b
beq .fwd1
lda #$3c
bne .fwd2
.fwd1: lda #$17
.fwd2: sta Zdd
lda #$20
jsr S14f1
lda #$11
jsr S1a03
lda Zdc
bne .fwd3
lda #'S'
jsr S14f1
lda #'c'
jsr S14f1
lda #'o'
jsr S14f1
lda #'r'
jsr S14f1
lda #'e'
jsr S14f1
lda #':'
jsr S14f1
lda #' '
jsr S14f1
lda Z8c
sta Zd3
lda Z8c+1
sta Zd3+1
jsr print_num
lda #$2f
bne .fwd6 ; always taken
.fwd3: lda #'T'
jsr S14f1
lda #'i'
jsr S14f1
lda #'m'
jsr S14f1
lda #'e'
jsr S14f1
lda #':'
jsr S14f1
lda #' '
jsr S14f1
lda Z8c
bne .fwd4
lda #$18
.fwd4: cmp #char_cr
bcc .fwd5
sbc #$0c
.fwd5: sta Zd3
lda #$00
sta Zd3+1
jsr print_num
lda #$3a
.fwd6: jsr S14f1
lda #$12
jsr S1a03
lda Z8c
sta Zd3
lda Z8c+1
sta Zd3+1
lda Zdc
bne .fwd7
jsr print_num
jmp .fwd11
.fwd7: lda Z8c
cmp #$0a
bcs .fwd8
lda #$30
jsr S14f1
.fwd8: jsr print_num
lda #' '
jsr S14f1
lda #$11
jsr S1a03
lda Z8c ; print AM or PM
cmp #$0c
bcs .fwd9
lda #'a'
bne .fwd10
.fwd9: lda #'p'
.fwd10:
jsr S14f1
lda #'m'
jsr S14f1
.fwd11: ldx #$00
.loop2: lda D0200,x
jsr S1275
inx
cpx Zdd
bcc .loop2
.loop3: cpx wndwdt
bcs .fwd12
lda #' '+$80
jsr cout
inx
bne .loop3
.fwd12: lda #$ff
sta invflg
ldx Zf6
.loop4: lda D3120,x
sta D0200,x
dex
bpl .loop4
pla
sta wndtop
pla
sta Zdb
pla
sta Zcd
pla
sta Zce
pla
sta Zcf
pla
sta Zc9
pla
sta Zca
pla
sta Z9c
pla
sta Z9d
pla
sta Z9e
pla
sta Zdd
pla
sta cursrv
pla
sta cursrh
pla
sta cur80h
if iver>=iver3k
ldx D172b
beq .fwd13
sta cursrh
.fwd13:
endif
jsr vtab
ldx #$ff
stx Zdf
inx
stx Z9f
rts
msg_story_loading:
text_str "The story is loading ..."
msg_len_story_loading equ *-msg_story_loading
D172b: fcb $00
romid2_save: fcb $00
D172d: fcb $00
D172e: fcb $00
msg_80_col:
text_str "80-COLUMN DISPLAY? (Y/N) >"
msg_len_80_col equ *-msg_80_col
; interpreter startup entry point jumped from boot1
interp_start:
lda Z2b
sta Z60
sta Z61
if iver>=iver3k
lda #cout1>>8
sta cswl+1
lda #cout1&$ff
sta cswl
endif
ldx #$00
stx rwts_sector
stx Zec
inx ; read rest of interpreter starting with track 1
stx rwts_track
stx Z62
stx Z63
lda #$18 ; starting at $1800
sta Zed
lda #17 ; sector count
sta Z8e
.loop1: jsr read_sector
dec Z8e
bne .loop1
lda #$ff
sta invflg
lda romid ; is the computer an Apple IIe or later?
sta romid2_save
cmp #$06
bne .fwd3 ; no
lda romid2
bne .fwd1
sta romid2_save
.fwd1: lda rdc3rom
bmi .fwd3
jsr home
lda #$0a
sta cursrv
lda #$05
sta cursrh
jsr vtab
prt_msg 80_col
.loop2: jsr rdkey
cmp #'n'+$80
beq .fwd3
cmp #'N'+$80
beq .fwd3
cmp #'y'+$80
beq .fwd2
cmp #'Y'+$80
beq .fwd2
jsr bell
jmp .loop2
.fwd2: jsr sl3fw
lda #$ff
bne .fwd4 ; always taken
.fwd3: lda #$00
.fwd4: sta D172b
restart:
lda Z61
ldx Z63
sta D172d
stx D172e
jsr home
lda #$0a
sta cursrv
lda D172b
bne .fwd5
lda #$08
sta cursrh
bne .fwd6
.fwd5: lda #$1b
sta cursrh
sta cur80h
.fwd6: jsr vtab
prt_msg_alt story_loading
lda #$00 ; clear interp zero page vars
ldx #$80
.loop3: sta $00,x
inx
bne .loop3
tax
lda #$ff
.loop4: sta D2c00,x
sta D2d00,x
inx
bne .loop4
txa
.loop5: sta D2e00,x
inx
bne .loop5
inc Z94
inc Z94+1
inc Zdf
inc Zaa
lda #$32
sta Za3
sta Zed
jsr S0d6b
ldx hdr_high_mem
inx
stx Za3+1
txa
clc
adc Za3
sta Za5
jsr S14dc
sec
sbc Za5
beq int_err_00
bcs L1839
int_err_00:
lda #$00
jmp int_error
L1839: sta Za6
lda hdr_flags_1
ora #$20
sta hdr_flags_1
and #$02
sta Zdc
lda hdr_globals
clc
adc Za3
sta Zad
lda hdr_globals+1
sta Zac
lda hdr_abbrev
clc
adc Za3
sta Zb1
lda hdr_abbrev+1
sta Zb0
lda hdr_vocab
clc
adc Za3
sta Zaf
lda hdr_vocab+1
sta Zae
lda hdr_object
clc
adc Za3
sta Zb3
lda hdr_object+1
sta Zb2
.loop6: lda Zea
cmp Za3+1
bcs .fwd7
jsr S0d6b
jmp .loop6
.fwd7: lda hdr_init_pc
sta pc+1
lda hdr_init_pc+1
sta pc
lda #$01
sta wndtop
sta Ze0
ldx wndwdt
dex
stx Zf6
lda D13ac
bpl .fwd8
lda hdr_flags2+1
ora #$01
sta hdr_flags2+1
lda #$02
sta D13ac
.fwd8: jsr home
; fall into main loop
main_loop:
lda D13ac
bne .fwd9
lda hdr_flags2+1
and #$01
beq .fwd9
jsr S13af
.fwd9: lda #$00
sta argcnt
jsr S2336
sta opcode
tax
bmi op_80_ff
jmp op_00_7f
op_80_ff:
cmp #$b0
bcs op_b0_ff
jmp op_80_af
op_b0_ff:
cmp #$c0
bcs op_c0_ff
jmp op_b0_bf
; opcode $c0..$ff: VAR format
op_c0_ff:
jsr S2336
sta Z8a
ldx #$00
stx Z8b
beq .fwd1
.loop1: lda Z8a
asl
asl
sta Z8a
.fwd1: and #$c0
bne .fwd2
jsr S19d6
jmp .fwd4
.fwd2: cmp #$40
bne .fwd3
jsr S19d2
jmp .fwd4
.fwd3: cmp #$80
bne .fwd5
jsr S19ea
.fwd4: ldx Z8b
lda Z8c
sta arg1,x
lda Z8c+1
sta arg1+1,x
inc argcnt
inx
inx
stx Z8b
cpx #$08
bcc .loop1
.fwd5: lda opcode
cmp #$e0
bcs .fwd6
jmp L19b3
.fwd6: ldx #D1b94&$ff
ldy #D1b94>>8
and #$1f
cmp #$0c
bcc L1935
lda #$01
jmp int_error
L1935: stx Z8e
sty Z8e+1
asl
tay
lda (Z8e),y
sta L1946+1
iny
lda (Z8e),y
sta L1946+2
L1946: jsr $0000
jmp main_loop
op_b0_bf:
ldx #D1b26&$ff
ldy #D1b26>>8
and #$0f
cmp #$0e
bcc L1935
lda #$02
jmp int_error
op_80_af:
and #$30
bne .fwd1
jsr S19d6
jmp .fwd3
.fwd1: cmp #$10
bne .fwd2
jsr S19d2
jmp .fwd3
.fwd2: cmp #$20
bne int_err_03
jsr S19ea
.fwd3: jsr S19c7
ldx #D1b42&$ff
ldy #D1b42>>8
lda opcode
and #$0f
cmp #$10
bcc L1935
int_err_03:
lda #$03
jmp int_error
op_00_7f:
and #$40
bne .fwd1
jsr S19d2
jmp .fwd2
.fwd1: jsr S19ea
.fwd2: jsr S19c7
lda opcode
and #$20
bne .fwd3
jsr S19d2
jmp .fwd4
.fwd3: jsr S19ea
.fwd4: lda Z8c
sta arg2
lda Z8c+1
sta arg2+1
inc argcnt
L19b3: ldx #D1b62&$ff
ldy #D1b62>>8
lda opcode
and #$1f
cmp #$19
bcs int_err_04
jmp L1935
int_err_04:
lda #$04
jmp int_error
S19c7: lda Z8c
sta arg1
lda Z8c+1
sta arg1+1
inc argcnt
rts
S19d2: lda #$00
beq L19d9 ; always taken
S19d6: jsr S2336
L19d9: sta Z8c+1
jsr S2336
sta Z8c
rts
S19e1: tax
bne L19ef
jsr op_pop
jmp push_Z8c
S19ea: jsr S2336
beq op_pop
L19ef: cmp #$10
bcs S1a03
sec
sbc #$01
asl
tax
lda local_vars,x
sta Z8c
lda local_vars+1,x
sta Z8c+1
rts
S1a03: jsr S1a74
lda (Z8e),y
sta Z8c+1
iny
lda (Z8e),y
sta Z8c
rts
op_pop: dec Z94
beq int_err_05
ldy Z94
ldx stk_low_bytes,y
stx Z8c
lda stk_high_bytes,y
sta Z8c+1
rts
int_err_05:
lda #$05
jmp int_error
; push word in Z8c onto data stack
push_Z8c:
ldx Z8c
lda Z8c+1
; push word in A:X onto data stack
push_ax:
ldy Z94
sta stk_high_bytes,y
txa
sta stk_low_bytes,y
inc Z94
beq int_err_06 ; data stack overflow
rts
int_err_06:
lda #$06
jmp int_error
S1a3d: tax
bne L1a53
dec Z94
bne push_Z8c
beq int_err_05 ; always taken
; store a zero result into variable (or stack) designated by next byte of program
store_result_zero:
lda #$00
; store byte result in Z8c low into variable (or stack) designated by next byte of program
store_result_byte:
sta Z8c
lda #$00
sta Z8c+1
; store result in Z8c into variable (or stack) designated by next byte of program
store_result:
jsr S2336
beq push_Z8c ; var 0? if yes, push stack
L1a53: cmp #$10 ; local variable?
bcs .fwd2 ; no
; store result in Z8c into local variable specified by A (offset by 1)
sec
sbc #$01
asl
tax
lda Z8c
sta local_vars,x
lda Z8c+1
sta local_vars+1,x
rts
; store result in Z8c into global variable specified by A (offset by $10)
.fwd2: jsr S1a74
lda Z8c+1
sta (Z8e),y
iny
lda Z8c
sta (Z8e),y
rts
S1a74: sec
sbc #$10
ldy #$00
sty Z8e+1
asl
rol Z8e+1
clc
adc Zac
sta Z8e
lda Z8e+1
adc Zad
sta Z8e+1
L1a89: rts
predicate_false:
jsr S2336
bpl L1a9b
L1a8f: and #$40
bne L1a89
jmp S2336
predicate_true:
jsr S2336
bpl L1a8f
L1a9b: tax
and #$40
beq .fwd1
txa
and #$3f
sta Z8c
lda #$00
sta Z8c+1
beq .fwd3 ; always taken
.fwd1: txa
and #$3f
tax
and #$20
beq .fwd2
txa
ora #$e0
tax
.fwd2: stx Z8c+1
jsr S2336
sta Z8c
.fwd3: lda Z8c+1
bne L1ad0
lda Z8c
bne .fwd4
jmp op_rfalse
.fwd4: cmp #$01
bne L1ad0
jmp op_rtrue
L1ad0: jsr S1b0a
jsr S1b0a
lda #$00
sta Z8e+1
lda Z8c+1
sta Z8e
asl
rol Z8e+1
lda Z8c
clc
adc pc
bcc .fwd5
inc Z8e
bne .fwd5
inc Z8e+1
.fwd5: sta pc
lda Z8e
ora Z8e+1
beq op_nop
lda Z8e
clc
adc pc+1
sta pc+1
lda Z8e+1
adc Z98
and #$01
sta Z98
lda #$00
sta Z99
op_nop: rts
S1b0a: lda Z8c
sec
sbc #$01
sta Z8c
bcs .rtn
dec Z8c+1
.rtn: rts
S1b16: inc Z8c
bne .rtn
inc Z8c+1
.rtn: rts
S1b1d: lda arg1
sta Z8c
lda arg1+1
sta Z8c+1
rts
; 0OP instructions (no operands), opcodes $b0..$bf
D1b26: fdb op_rtrue
fdb op_rfalse
fdb op_print ; (literal string)
fdb op_print_ret ; (literal string)
fdb op_nop ; no-op
fdb op_save
fdb op_restore
fdb op_restart
fdb op_ret_popped
fdb op_pop
fdb op_quit
fdb op_new_line
fdb op_show_status
fdb op_verify
; 1OP instructions (one operand), opcodes $80..$af
D1b42: fdb op_jz
fdb op_get_sibling
fdb op_get_child
fdb op_get_parent
fdb op_get_prop_len ; get length of prperty (given addr)
fdb op_inc
fdb op_dec
fdb op_print_addr
fdb int_err_03
fdb op_remove_obj
fdb op_print_obj
fdb op_ret
fdb op_jump
fdb op_print_paddr ; print string at word address
fdb op_load
fdb op_not
; 2OP instructions (two operand), opcodes $20..$7f
; The 2OP table is also used for VAR instructions (0-4 operands), opcodes $c0..$df
D1b62: fdb int_err_04 ; [illegal]
fdb op_je
fdb op_jl
fdb op_jg
fdb op_dec_chk
fdb op_inc_chk
fdb op_jin ; jump if object a is direct child of object b
fdb op_test ; (bitmap)
fdb op_or
fdb op_and
fdb op_test_attr
fdb op_set_attr
fdb op_clear_attr
fdb op_store
fdb op_insert_obj
fdb op_loadw
fdb op_loadb
fdb op_get_prop
fdb op_get_prop_addr
fdb op_get_next_prop
fdb op_add
fdb op_sub
fdb op_mul
fdb op_div
fdb op_mod
; z-machine version 1 has an addtional instruction here, which
; prints a string at the byte address that is the sum of ARG1
; and ARG2. z-machine version 4 reuses the opcode for call_2s.
; VAR instructions (0-4 operands), opcodes $e0..$ff
D1b94: fdb op_call
fdb op_storew
fdb op_storeb
fdb op_put_prop
fdb op_sread
fdb op_print_char
fdb op_print_num
fdb op_random
fdb op_push
fdb op_pull
fdb op_split_window
fdb op_set_window
op_rtrue:
ldx #$01
L1bae: lda #$00
L1bb0: stx arg1
sta arg1+1
jmp op_ret
op_rfalse:
ldx #$00
beq L1bae
op_print:
lda Z98
sta Z9e
lda pc+1
sta Z9d
lda pc
sta Z9c
lda #$00
sta Z9f
jsr S2554
ldx #$05
.loop2: lda Z9c,x
sta pc,x
dex
bpl .loop2
rts
op_print_ret:
jsr op_print
jsr op_new_line
jmp op_rtrue
op_ret_popped:
jsr op_pop
jmp L1bb0
op_verify:
jsr print_interpreter_version
ldx #$03
lda #$00
.loop1: sta Z90,x
sta Z9c,x
dex
bpl .loop1
lda #$40
sta Z9c
lda hdr_length
sta Z8e+1
lda hdr_length+1
asl
sta Z8e
rol Z8e+1
rol acb
if iver==iver3f
lda #acb+1 ; modify code in S236c subroutine
sta L2376+1
.loop2: jsr S236c
else
lda #$00
sta Zea
sta Zeb
jmp .fwd0a
.loop2: lda Z9c
bne .fwd0b
.fwd0a lda #$29
sta Zed
jsr S0d6b
.fwd0b: ldy Z9c
lda rwts_data_buf,y
inc Z9c
bne .fwd0c
inc Z9d
bne .fwd0c
inc Z9e
.fwd0c:
endif
clc
adc Z90
sta Z90
bcc .fwd1
inc Z90+1
.fwd1: lda Z9c
cmp Z8e
bne .loop2
lda Z9d
cmp Z8e+1
bne .loop2
lda Z9e
cmp acb
bne .loop2
if iver==iver3f
lda #Za3+1
sta L2376+1 ; modify code in S236c subroutine
endif
lda hdr_checksum+1
cmp Z90
bne L1c41
lda hdr_checksum
cmp Z90+1
bne L1c41
jmp predicate_true
L1c41: jmp predicate_false
op_jz: lda arg1
ora arg1+1
beq L1c66
L1c4a: jmp predicate_false
op_get_sibling:
lda arg1
jsr setup_object
ldy #$05
bne L1c5d ; always taken
op_get_child:
lda arg1
jsr setup_object
ldy #$06
L1c5d: lda (Z8e),y
jsr store_result_byte
lda Z8c
beq L1c4a
L1c66: jmp predicate_true
op_get_parent:
lda arg1
jsr setup_object
ldy #$04
lda (Z8e),y
jmp store_result_byte
op_get_prop_len:
lda arg1+1
clc
adc Za3
sta Z8e+1
lda arg1
sec
sbc #$01
sta Z8e
bcs .fwd1
dec Z8e+1
.fwd1: ldy #$00
jsr S27a9
clc
adc #$01
jmp store_result_byte
op_inc: lda arg1
jsr S19e1
jsr S1b16
jmp L1ca5
op_dec: lda arg1
jsr S19e1
jsr S1b0a
L1ca5: lda arg1
jmp S1a3d
op_print_addr:
lda arg1
sta Z8e
lda arg1+1
sta Z8e+1
jsr S2433
jmp S2554
op_remove_obj:
lda arg1
jsr setup_object
lda Z8e
sta Z90
lda Z8e+1
sta Z90+1
ldy #$04
lda (Z8e),y
beq .rtn
jsr setup_object
ldy #$06
lda (Z8e),y
cmp arg1
bne .loop1
ldy #$05
lda (Z90),y
iny
sta (Z8e),y
bne .fwd1
.loop1: jsr setup_object
ldy #$05
lda (Z8e),y
cmp arg1
bne .loop1
ldy #$05
lda (Z90),y
sta (Z8e),y
.fwd1: lda #$00
ldy #$04
sta (Z90),y
iny
sta (Z90),y
.rtn: rts
op_print_obj:
lda arg1
S1cfc: jsr setup_object
ldy #$07
lda (Z8e),y
tax
iny
lda (Z8e),y
sta Z8e
stx Z8e+1
inc Z8e
bne .fwd1
inc Z8e+1
.fwd1: jsr S2433
jmp S2554
op_ret: lda Z94+1
sta Z94
jsr op_pop
stx Z8e+1
txa
beq .fwd1
dex
txa
asl
sta Z8e
.loop1: jsr op_pop
ldy Z8e
sta local_vars+1,y
txa
sta local_vars,y
dec Z8e
dec Z8e
dec Z8e+1
bne .loop1
.fwd1: jsr op_pop
stx pc+1
sta Z98
jsr op_pop
stx Z94+1
sta pc
lda #$00
sta Z99
jsr S1b1d
jmp store_result
op_jump:
jsr S1b1d
jmp L1ad0
op_print_paddr:
lda arg1
sta Z8e
lda arg1+1
sta Z8e+1
jsr S2542
jmp S2554
op_load:
lda arg1
jsr S19e1
jmp store_result
op_not: lda arg1
eor #$ff
tax
lda arg1+1
eor #$ff
; fall into store_result_ax
; store result in A:X into variable (or stack) designated by next byte of program
store_result_ax:
stx Z8c
sta Z8c+1
jmp store_result
op_jl: jsr S1b1d
jmp L1d89
op_dec_chk:
jsr op_dec
L1d89: lda arg2
sta Z8e
lda arg2+1
sta Z8e+1
jmp L1db2
op_jg: lda arg1
sta Z8e
lda arg1+1
sta Z8e+1
jmp L1daa
op_inc_chk:
jsr op_inc
lda Z8c
sta Z8e
lda Z8c+1
sta Z8e+1
L1daa: lda arg2
sta Z8c
lda arg2+1
sta Z8c+1
L1db2: jsr S1db9
bcc L1def
bcs L1ddc
S1db9: lda Z8e+1
eor Z8c+1
bpl L1dc4
lda Z8e+1
cmp Z8c+1
rts
L1dc4: lda Z8c+1
cmp Z8e+1
bne L1dce
lda Z8c
cmp Z8e
L1dce: rts
; isobject ARG1 in thing ARG2?
op_jin: lda arg1
jsr setup_object
ldy #$04
lda (Z8e),y
cmp arg2
beq L1def
L1ddc: jmp predicate_false
op_test:
lda arg2
and arg1
cmp arg2
bne L1ddc
lda arg2+1
and arg1+1
cmp arg2+1
bne L1ddc
L1def: jmp predicate_true
op_or: lda arg1
ora arg2
tax
lda arg1+1
ora arg2+1
jmp store_result_ax
op_and: lda arg1
and arg2
tax
lda arg1+1
and arg2+1
jmp store_result_ax
; test thing attribute
op_test_attr:
jsr setup_attribute
lda acb+1
and Z90+1
sta acb+1
lda acb
and Z90
ora acb+1
bne L1def
jmp predicate_false
op_set_attr:
jsr setup_attribute
ldy #$00
lda acb+1
ora Z90+1
sta (Z8e),y
iny
lda acb
ora Z90
sta (Z8e),y
rts
op_clear_attr:
jsr setup_attribute
ldy #$00
lda Z90+1
eor #$ff
and acb+1
sta (Z8e),y
iny
lda Z90
eor #$ff
and acb
sta (Z8e),y
rts
op_store:
lda arg2
sta Z8c
lda arg2+1
sta Z8c+1
lda arg1
jmp S1a3d
op_insert_obj:
jsr op_remove_obj
lda arg1
jsr setup_object
lda Z8e
sta Z90
lda Z8e+1
sta Z90+1
lda arg2
ldy #$04
sta (Z8e),y
jsr setup_object
ldy #$06
lda (Z8e),y
tax
lda arg1
sta (Z8e),y
txa
beq .rtn
ldy #$05
sta (Z90),y
.rtn: rts
op_loadw:
jsr S1e94
jsr S236c
L1e85: sta Z8c+1
jsr S236c
sta Z8c
jmp store_result
op_loadb:
jsr S1e98
beq L1e85
S1e94: asl arg2
rol arg2+1
S1e98: lda arg2
clc
adc arg1
sta Z9c
lda arg2+1
adc arg1+1
sta Z9d
lda #$00
sta Z9e
sta Z9f
rts
op_get_prop:
jsr S2788
.loop1: jsr S27a4
cmp arg2
beq .fwd2
bcc .fwd1
jsr S27b1
jmp .loop1
.fwd1: lda arg2
sec
sbc #$01
asl
tay
lda (Zb2),y
sta Z8c+1
iny
lda (Zb2),y
sta Z8c
jmp store_result
.fwd2: jsr S27a9
iny
tax
beq .fwd3
cmp #$01
beq .fwd4
lda #$07
jmp int_error
.fwd3: lda (Z8e),y
ldx #$00
beq .fwd5 ; always taken
.fwd4: lda (Z8e),y
tax
iny
lda (Z8e),y
.fwd5: sta Z8c
stx Z8c+1
jmp store_result
op_get_prop_addr:
jsr S2788
.loop1: jsr S27a4
cmp arg2
beq .fwd1
bcc L1f1e
jsr S27b1
jmp .loop1
.fwd1: inc Z8e
bne .fwd2
inc Z8e+1
.fwd2: tya
clc
adc Z8e
sta Z8c
lda Z8e+1
adc #$00
sec
sbc Za3
sta Z8c+1
jmp store_result
L1f1e: jmp store_result_zero
op_get_next_prop:
jsr S2788
lda arg2
beq .fwd2
.loop1: jsr S27a4
cmp arg2
beq .fwd1
bcc L1f1e
jsr S27b1
jmp .loop1
.fwd1: jsr S27b1
.fwd2: jsr S27a4
jmp store_result_byte
op_add:
lda arg1
clc
adc arg2
tax
lda arg1+1
adc arg2+1
jmp store_result_ax
op_sub:
lda arg1
sec
sbc arg2
tax
lda arg1+1
sbc arg2+1
jmp store_result_ax
op_mul: jsr S2014
.loop1: ror Zd8
ror Zd7
ror arg2+1
ror arg2
bcc .fwd1
lda arg1
clc
adc Zd7
sta Zd7
lda arg1+1
adc Zd8
sta Zd8
.fwd1: dex
bpl .loop1
ldx arg2
lda arg2+1
jmp store_result_ax
op_div:
jsr divide
ldx Zd3
lda Zd3+1
jmp store_result_ax
op_mod:
jsr divide
ldx Zd5
lda Zd6
jmp store_result_ax
divide: lda arg1+1
sta Zda
eor arg2+1
sta Zd9
lda arg1
sta Zd3
lda arg1+1
sta Zd3+1
bpl .fwd1
jsr S1fd0
.fwd1: lda arg2
sta Zd5
lda arg2+1
sta Zd6
bpl .fwd2
jsr S1fc2
.fwd2: jsr S1fde
lda Zd9
bpl .fwd3
jsr S1fd0
.fwd3: lda Zda
bpl L1fcf
S1fc2: lda #$00
sec
sbc Zd5
sta Zd5
lda #$00
sbc Zd6
sta Zd6
L1fcf: rts
S1fd0: lda #$00
sec
sbc Zd3
sta Zd3
lda #$00
sbc Zd3+1
sta Zd3+1
rts
S1fde: lda Zd5
ora Zd6
beq int_err_08
jsr S2014
.loop1: rol Zd3
rol Zd3+1
rol Zd7
rol Zd8
lda Zd7
sec
sbc Zd5
tay
lda Zd8
sbc Zd6
bcc .fwd1
sty Zd7
sta Zd8
.fwd1: dex
bne .loop1
rol Zd3
rol Zd3+1
lda Zd7
sta Zd5
lda Zd8
sta Zd6
rts
int_err_08:
lda #$08
jmp int_error
S2014: ldx #$10
lda #$00
sta Zd7
sta Zd8
clc
rts
op_je: dec argcnt
bne .fwd1
lda #$09
jmp int_error
.fwd1: lda arg1
ldx arg1+1
cmp arg2
bne .fwd2
cpx arg2+1
beq .rtn_t
.fwd2: dec argcnt
beq .rtn_f
cmp arg3
bne .fwd3
cpx arg3+1
beq .rtn_t
.fwd3: dec argcnt
beq .rtn_f
cmp arg4
bne .rtn_f
cpx arg4+1
bne .rtn_f
.rtn_t: jmp predicate_true
.rtn_f: jmp predicate_false
op_call:
lda arg1
ora arg1+1
bne .fwd1
jmp store_result_byte
.fwd1: ldx Z94+1
lda pc
jsr push_ax
ldx pc+1
lda Z98
jsr push_ax
lda #$00
sta Z99
asl arg1
rol arg1+1
rol
sta Z98
lda arg1+1
sta pc+1
lda arg1
sta pc
jsr S2336
sta Z90
sta Z90+1
beq .fwd2
lda #$00
sta Z8e
.loop1: ldy Z8e
ldx local_vars,y
lda local_vars+1,y
sty Z8e
jsr push_ax
jsr S2336
sta Z8e+1
jsr S2336
ldy Z8e
sta local_vars,y
lda Z8e+1
sta local_vars+1,y
iny
iny
sty Z8e
dec Z90
bne .loop1
; if present, copy arg2 through arg4 to the first local variables
.fwd2: dec argcnt
beq .fwd3
lda arg2
sta local_vars
lda arg2+1
sta local_vars+1
dec argcnt
beq .fwd3
lda arg3
sta local_vars+2
lda arg3+1
sta local_vars+3
dec argcnt
beq .fwd3
lda arg4
sta local_vars+4
lda arg4+1
sta local_vars+5
.fwd3: ldx Z90+1
txa
jsr push_ax
lda Z94
sta Z94+1
rts
op_storew:
asl arg2
rol arg2+1
jsr S20fa
lda arg3+1
sta (Z8e),y
iny
bne L20f5
op_storeb:
jsr S20fa
L20f5: lda arg3
sta (Z8e),y
rts
S20fa: lda arg2
clc
adc arg1
sta Z8e
lda arg2+1
adc arg1+1
clc
adc Za3
sta Z8e+1
ldy #$00
rts
op_put_prop:
jsr S2788
.loop1: jsr S27a4
cmp arg2
beq .fwd1
bcc int_err_0a
jsr S27b1
jmp .loop1
.fwd1: jsr S27a9
iny
tax
beq .fwd2
cmp #$01
bne int_err_0b
lda arg3+1
sta (Z8e),y
iny
.fwd2: lda arg3
sta (Z8e),y
rts
int_err_0a:
lda #$0a
jmp int_error
int_err_0b:
lda #$0b
jmp int_error
op_print_char:
lda arg1
jmp S14f1
op_print_num:
lda arg1
sta Zd3
lda arg1+1
sta Zd3+1
print_num:
lda Zd3+1
bpl .fwd1
lda #$2d
jsr S14f1
jsr S1fd0
.fwd1: lda #$00
sta Zdb
.loop1: lda Zd3
ora Zd3+1
beq .fwd2
lda #$0a
sta Zd5
lda #$00
sta Zd6
jsr S1fde
lda Zd5
pha
inc Zdb
bne .loop1
.fwd2: lda Zdb
bne .loop2
lda #$30
jmp S14f1
.loop2: pla
clc
adc #$30
jsr S14f1
dec Zdb
bne .loop2
rts
op_random:
lda arg1
sta arg2
lda arg1+1
sta arg2+1
jsr S14df
stx arg1
and #$7f
sta arg1+1
jsr divide
lda Zd5
sta Z8c
lda Zd6
sta Z8c+1
jsr S1b16
jmp store_result
op_push:
ldx arg1
lda arg1+1
jmp push_ax
op_pull:
jsr op_pop
lda arg1
jmp S1a3d
op_sread:
jsr op_show_status
lda arg1+1
clc
adc Za3
sta arg1+1
lda arg2+1
clc
adc Za3
sta arg2+1
jsr e_1296
sta Zc2
lda #$00
sta Zc3
ldy #$01
sta (arg2),y
sty Zc0
iny
sty Zc1
.loop1: ldy #$00
lda (arg2),y
beq .fwd1
cmp #$3c
bcc .fwd2
.fwd1: lda #$3b
sta (arg2),y
.fwd2: iny
cmp (arg2),y
bcc .rtn
lda Zc2
ora Zc3
bne .fwd3
.rtn: rts
.fwd3: lda Zc3
cmp #$06
bcc .fwd4
jsr S228d
.fwd4: lda Zc3
bne .fwd6
ldx #$05
.loop2: sta Zb4,x
dex
bpl .loop2
jsr S227f
lda Zc0
ldy #$03
sta (Zc4),y
tay
lda (arg1),y
jsr S22ba
bcs .fwd7
jsr S22a8
bcc .fwd6
inc Zc0
dec Zc2
jmp .loop1
.fwd6: lda Zc2
beq .fwd8
ldy Zc0
lda (arg1),y
jsr S22a3
bcs .fwd8
ldx Zc3
sta Zb4,x
dec Zc2
inc Zc3
inc Zc0
jmp .loop1
.fwd7: sta Zb4
dec Zc2
inc Zc3
inc Zc0
.fwd8: lda Zc3
beq .loop1
jsr S227f
lda Zc3
ldy #$02
sta (Zc4),y
jsr S2670
jsr S22cc
ldy #$01
lda (arg2),y
clc
adc #$01
sta (arg2),y
jsr S227f
ldy #$00
sty Zc3
lda Z8c+1
sta (Zc4),y
iny
lda Z8c
sta (Zc4),y
lda Zc1
clc
adc #$04
sta Zc1
jmp .loop1
S227f: lda arg2
clc
adc Zc1
sta Zc4
lda arg2+1
adc #$00
sta Zc5
rts
S228d: lda Zc2
beq .rtn
ldy Zc0
lda (arg1),y
jsr S22a3
bcs .rtn
dec Zc2
inc Zc3
inc Zc0
bne S228d
.rtn: rts
S22a3: jsr S22ba
bcs L22ca
S22a8: ldx #$05
L22aa: cmp D22b4,x
beq L22ca
dex
bpl L22aa
clc
rts
D22b4: fcb "!?,."
if iver==iver3f
fcb char_cr+$80
else
fcb char_cr
endif
fcb " "
S22ba: tax
ldy #$00
lda (Zae),y
tay
txa
.loop1: cmp (Zae),y
beq L22ca
dey
bne .loop1
clc
rts
L22ca: sec
rts
S22cc: ldy #$00
lda (Zae),y
clc
adc #$01
adc Zae
sta Z8c
lda Zaf
adc #$00
sta Z8c+1
lda (Z8c),y
sta Zc8
jsr S1b16
lda (Z8c),y
sta Zc7
jsr S1b16
lda (Z8c),y
sta Zc6
jsr S1b16
.loop1: ldy #$00
lda (Z8c),y
cmp Zba
bne .fwd1
iny
lda (Z8c),y
cmp Zbb
bne .fwd1
iny
lda (Z8c),y
cmp Zbc
bne .fwd1
iny
lda (Z8c),y
cmp Zbd
beq .fwd4
.fwd1: lda Zc8
clc
adc Z8c
sta Z8c
bcc .fwd2
inc Z8c+1
.fwd2: lda Zc6
sec
sbc #$01
sta Zc6
bcs .fwd3
dec Zc7
.fwd3: ora Zc7
bne .loop1
sta Z8c
sta Z8c+1
rts
.fwd4: lda Z8c+1
sec
sbc Za3
sta Z8c+1
rts
S2336: lda Z99
bne .fwd3
lda pc+1
ldy Z98
bne .fwd1
cmp Za3+1
bcs .fwd1
adc Za3
bne .fwd2
.fwd1: ldx #$00
stx Z9f
jsr S23a2
.fwd2: sta Z9b
ldx #$ff
stx Z99
inx
stx Z9a
.fwd3: ldy pc
lda (Z9a),y
inc pc
bne .fwd4
ldy #$00
sty Z99
inc pc+1
bne .fwd4
inc Z98
.fwd4: tay
rts
S236c: lda Z9f
bne L238e
lda Z9d
ldy Z9e
bne L237e
L2376: cmp Za3+1 ; self-modifying code, operand modified
bcs L237e
adc Za3
bne L2385
L237e: ldx #$00
stx Z99
jsr S23a2
L2385: sta Za1
ldx #$ff
stx Z9f
inx
stx Za0
L238e: ldy Z9c
lda (Za0),y
inc Z9c
bne .fwd4
ldy #$00
sty Z9f
inc Z9d
bne .fwd4
inc Z9e
.fwd4: tay
rts
S23a2: sta Za8
sty Za9
ldx #$00
stx Za7
.loop1: cmp D2c00,x
bne .loop2
tya
cmp D2d00,x
beq .fwd1
lda Za8
.loop2: inc Za7
inx
cpx Za6
bcc .loop1
jsr S2419
ldx Zab
stx Za7
lda Za8
sta D2c00,x
sta Zea
lda Za9
and #$01
sta D2d00,x
sta Zeb
txa
clc
adc Za5
sta Zed
jsr S0d6b
bcs int_err_0e
.fwd1: ldy Za7
lda D2e00,y
cmp Zaa
beq .fwd4
inc Zaa
bne .fwd3
if iver==iver3f
jsr S2419
else
jsr S243b
endif
ldx #$00
.loop3: lda D2e00,x
beq .fwd2
sec
sbc Za2
sta D2e00,x
.fwd2: inx
cpx Za6
bcc .loop3
lda #$00
sec
sbc Za2
sta Zaa
.fwd3: lda Zaa
sta D2e00,y
.fwd4: lda Za7
clc
adc Za5
rts
int_err_0e:
lda #$0e
jmp int_error
S2419: ldx #$00
stx Zab
lda D2e00
inx
.loop1: cmp D2e00,x
bcc .fwd1
lda D2e00,x
stx Zab
.fwd1: inx
cpx Za6
bcc .loop1
sta Za2
rts
if iver>=iver3h
D243a: fcb $00
S243b: ldx #$00
stx Zab
sty D243a
.loop1: lda D2e00,x
cmp #$00
bne .fwd1
inx
cpx Za6
bcc .loop1
bcs .fwd3
.fwd1: inx
.loop2: cmp D2e00,x
bcc .fwd2
ldy D2e00,x
beq .fwd2
tya
stx Zab
.fwd2: inx
cpx Za6
bcc .loop2
.fwd3: sta Za2
ldy D243a
rts
endif
S2433: lda Z8e
sta Z9c
lda Z8e+1
sta Z9d
lda #$00
sta Z9e
sta Z9f
rts
if iver==iver3f
; A buffer was allocated at $2e00, but in revision F, instead
; of that buffer being used, another one is allocated here.
D2e00: fcb [256]$00
endif
S2542: lda Z8e
asl
sta Z9c
lda Z8e+1
rol
sta Z9d
lda #$00
sta Z9f
rol
sta Z9e
L2553: rts
S2554: ldx #$00
stx Zc9
stx Zcd
dex
stx Zca
.loop1: jsr S2628
bcs L2553
sta Zcb
tax
beq .fwd4
cmp #$04
bcc .fwd7
cmp #$06
bcc .fwd5
jsr S261c
tax
bne .fwd1
lda #$5b
.loop2: clc
adc Zcb
.loop3: jsr S14f1
jmp .loop1
.fwd1: cmp #$01
bne .fwd2
lda #$3b
bne .loop2
.fwd2: lda Zcb
sec
sbc #$06
beq .fwd3
tax
lda D2745,x
jmp .loop3
.fwd3: jsr S2628
asl
asl
asl
asl
asl
sta Zcb
jsr S2628
ora Zcb
jmp .loop3
.fwd4: lda #$20
bne .loop3 ; always taken
.fwd5: sec
sbc #$03
tay
jsr S261c
bne .fwd6
sty Zca
jmp .loop1
.fwd6: sty Zc9
cmp Zc9
beq .loop1
lda #$00
sta Zc9
beq .loop1 ; alway taken
.fwd7: sec
sbc #$01
asl
asl
asl
asl
asl
asl
sta Zcc
jsr S2628
asl
clc
adc Zcc
tay
lda (Zb0),y
sta Z8e+1
iny
lda (Zb0),y
sta Z8e
lda Z9e
pha
lda Z9d
pha
lda Z9c
pha
lda Zc9
pha
lda Zcd
pha
lda Zcf
pha
lda Zce
pha
jsr S2542
jsr S2554
pla
sta Zce
pla
sta Zcf
pla
sta Zcd
pla
sta Zc9
pla
sta Z9c
pla
sta Z9d
pla
sta Z9e
ldx #$ff
stx Zca
inx
stx Z9f
jmp .loop1
S261c: lda Zca
bpl .fwd1
lda Zc9
rts
.fwd1: ldy #$ff
sty Zca
rts
S2628: lda Zcd
bpl .fwd1
sec
rts
.fwd1: bne .fwd2
inc Zcd
jsr S236c
sta Zcf
jsr S236c
sta Zce
lda Zcf
lsr
lsr
jmp .fwd5
.fwd2: sec
sbc #$01
bne .fwd3
lda #$02
sta Zcd
lda Zce
sta Z8e
lda Zcf
asl Z8e
rol
asl Z8e
rol
asl Z8e
rol
jmp .fwd5
.fwd3: lda #$00
sta Zcd
lda Zcf
bpl .fwd4
lda #$ff
sta Zcd
.fwd4: lda Zce
.fwd5: and #$1f
clc
rts
S2670: lda #$05
tax
.loop1: sta Zba,x
dex
bpl .loop1
lda #$06
sta Zd0
lda #$00
sta Zd1
sta Zd2
.loop2: ldx Zd1
inc Zd1
lda Zb4,x
sta Zcb
bne .fwd1
lda #$05
bne .loop3 ; alway taken
.fwd1: lda Zcb
jsr S2706
beq .fwd3
clc
adc #$03
ldx Zd2
sta Zba,x
inc Zd2
dec Zd0
bne .fwd2
jmp L271f
.fwd2: lda Zcb
jsr S2706
cmp #$02
beq .fwd4
lda Zcb
sec
sbc #$3b
bpl .loop3
.fwd3: lda Zcb
sec
sbc #$5b
.loop3: ldx Zd2
sta Zba,x
inc Zd2
dec Zd0
bne .loop2
jmp L271f
.fwd4: lda Zcb
jsr S26f6
bne .loop3
lda #$06
ldx Zd2
sta Zba,x
inc Zd2
dec Zd0
beq L271f
lda Zcb
lsr
lsr
lsr
lsr
lsr
and #$03
ldx Zd2
sta Zba,x
inc Zd2
dec Zd0
beq L271f
lda Zcb
and #$1f
jmp .loop3
S26f6: ldx #$19
.loop1: cmp D2745,x
beq .fwd1
dex
bne .loop1
rts
.fwd1: txa
clc
adc #$06
rts
S2706: cmp #$61
bcc .fwd1
cmp #$7b
bcs .fwd1
lda #$00
rts
.fwd1: cmp #$41
bcc .fwd2
cmp #$5b
bcs .fwd2
lda #$01
rts
.fwd2: lda #$02
rts
L271f: lda Zbb
asl
asl
asl
asl
rol Zba
asl
rol Zba
ora Zbc
sta Zbb
lda Zbe
asl
asl
asl
asl
rol Zbd
asl
rol Zbd
ora Zbf
tax
lda Zbd
ora #$80
sta Zbc
stx Zbd
rts
D2745: fcb $00,char_cr
fcb "0123456789"
fcb ".,!?_#'"
fcb $22 ; double quote
fcb "/"
fcb "\\" ; this is a single backslash, escaped
fcb "-:()"
setup_object:
sta Z8e
ldx #$00
stx Z8e+1
asl
rol Z8e+1
asl
rol Z8e+1
asl
rol Z8e+1
clc
adc Z8e
bcc .fwd1
inc Z8e+1
.fwd1: clc
adc #$35
bcc .fwd2
inc Z8e+1
.fwd2: clc
adc Zb2
sta Z8e
lda Z8e+1
adc Zb3
sta Z8e+1
rts
S2788: lda arg1
jsr setup_object
ldy #$07
lda (Z8e),y
clc
adc Za3
tax
iny
lda (Z8e),y
sta Z8e
stx Z8e+1
ldy #$00
lda (Z8e),y
asl
tay
iny
rts
S27a4: lda (Z8e),y
and #$1f
rts
S27a9: lda (Z8e),y
lsr
lsr
lsr
lsr
lsr
rts
S27b1: jsr S27a9
tax
.loop1: iny
dex
bpl .loop1
iny
rts
; set up for attribute operations on object ARG1
setup_attribute:
lda arg1
jsr setup_object
lda arg2
cmp #$10
bcc .fwd2
sbc #$10
tax
lda Z8e
clc
adc #$02
sta Z8e
bcc .fwd1
inc Z8e+1
.fwd1: txa
.fwd2: sta acb
ldx #$01
stx Z90
dex
stx Z90+1
lda #$0f
sec
sbc acb
tax
beq .fwd3
.loop1: asl Z90
rol Z90+1
dex
bne .loop1
.fwd3: ldy #$00
lda (Z8e),y
sta acb+1
iny
lda (Z8e),y
sta acb
rts
fillto $2800,$00
Reference in New Issue View Git Blame Copy Permalink