mirror of https://github.com/brouhaha/a2zip.git
6454 lines
77 KiB
NASM
6454 lines
77 KiB
NASM
; Infocom EZIP (Z-Machine architecture v4) interpreter for Apple II,
|
|
|
|
; The EZIP 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.
|
|
|
|
iver2a equ $0201 ; Has exactly four save positions per disk, will only
|
|
; work for games that have up to 32 KiB saves.
|
|
; Released with A Mind Forever Voyaging r77 850814
|
|
|
|
iver2b equ $0202 ; Allows disks to have three or four save positions,
|
|
; supporting games with up to 46 KiB saves.
|
|
; Forces CSWL to be COUT1 at start.
|
|
; Adds "be patient" message to verify.
|
|
; Radically changes implementation of get_prop_addr,
|
|
; purpose unknown.
|
|
; Changes random number generator, purpose unknown.
|
|
; Changes subroutine Seb96, purpose unknown.
|
|
; Changes some constants in save and restore,
|
|
; purpose unknown.
|
|
; Released with Trinity r11 860509
|
|
|
|
iver2c equ $0203 ; Changes deselecting output stream 3
|
|
; (table), to prevent table stream stack underflow.
|
|
; Changes data tables used by random number generator,
|
|
; purpose unknown.
|
|
; Released with Bureaucracy r86 870212
|
|
|
|
iver2d equ $0204 ; Changes spaces to tabs in save messages (probably
|
|
; by mistake).
|
|
; Changes a constant in scan_table, purpose unknown.
|
|
; Released with Bureaucracy r116 870602
|
|
|
|
; No Apple II games with EZIP versions 2E through 2G have been found
|
|
|
|
iver2h equ $0208 ; Removes several calls to HOME.
|
|
; Changes the tabs in messages back to spaces.
|
|
; Adds two extra carriage returns at the end of
|
|
; some messages.
|
|
; Released with Nord and Bert r19 870723
|
|
|
|
|
|
char_tab equ $09
|
|
char_cr equ $0d
|
|
|
|
|
|
ifndef iver
|
|
iver equ iver2a
|
|
endif
|
|
|
|
|
|
fillto macro addr, val
|
|
while * < addr
|
|
size set addr-*
|
|
if size > 256
|
|
size set 256
|
|
endif
|
|
fcb [size] val
|
|
endm
|
|
endm
|
|
|
|
if iver==iver2a
|
|
|
|
; EZIP 2A sets the high bit of interpreter message strings
|
|
; macro for text string
|
|
text_str macro arg
|
|
irpc char,arg
|
|
fcb 'char'+$80
|
|
endm
|
|
endm
|
|
else
|
|
|
|
; EZIP 2B and later do NOT set the high bit of interpreter message strings
|
|
; macro for text string
|
|
text_str macro arg
|
|
fcb arg
|
|
endm
|
|
|
|
endif
|
|
|
|
; 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
|
|
|
|
; macro to fetch one byte from the PC and increment the PC
|
|
; Post-condition:
|
|
; A = fetched byte
|
|
; Y = fetched byte
|
|
fetch_pc_byte_inline macro
|
|
ldy pc_phys_page+2
|
|
sta rd_main_ram,y ; indexed to get main or card RAM
|
|
ldy pc
|
|
lda (pc_phys_page),y
|
|
sta rd_main_ram ; set back to main RAM
|
|
inc pc
|
|
bne .no_page_cross
|
|
jsr advance_pc_page
|
|
.no_page_cross:
|
|
tay
|
|
endm
|
|
|
|
; macro to start a table of addresses, split into a high byte table and a low byte table
|
|
optab_start macro label,size
|
|
label_hi equ *
|
|
label_lo equ *+size
|
|
optab_org set *
|
|
optab_siz set size
|
|
optab_idx set 0
|
|
endm
|
|
|
|
; macro for an entry in a table of addresses, split into a high byte table and a low byte table
|
|
optab_ent macro addr
|
|
org optab_org+optab_idx
|
|
fcb addr>>8
|
|
org optab_org+optab_siz+optab_idx
|
|
fcb addr&$ff
|
|
optab_idx set optab_idx+1
|
|
endm
|
|
|
|
|
|
; disk zero page variables
|
|
org $00
|
|
|
|
Z00: rmb 1
|
|
Z01: rmb 1
|
|
Z02: rmb 1
|
|
Z03: rmb 1
|
|
rwts_sector: rmb 1
|
|
rwts_track: rmb 1
|
|
Z06: rmb 1
|
|
rwts_cmd: rmb 1
|
|
rwts_buf: rmb 2
|
|
Z0a: rmb 1
|
|
rwts_slotx16: rmb 1
|
|
Z0c: rmb 1
|
|
Z0d: rmb 1
|
|
Z0e: rmb 1
|
|
Z0f: rmb 1
|
|
Z10: rmb 1
|
|
rwts18_sector: rmb 1
|
|
rmb 1
|
|
Z13: rmb 1
|
|
Z14: rmb 1
|
|
Z15: rmb 1
|
|
rmb 1
|
|
rwts18_sector_temp: rmb 1
|
|
rmb 2
|
|
Z1a: rmb 1
|
|
|
|
|
|
; Apple II zero page locations
|
|
wndwdt equ $21
|
|
wndtop equ $22
|
|
wndbot equ $23
|
|
cursrh equ $24
|
|
cursrv equ $25
|
|
bas2l equ $2a
|
|
invflg equ $32
|
|
cswl equ $36
|
|
rndloc equ $4e
|
|
|
|
|
|
; interpreter zero page variables
|
|
interp_zp_origin equ $56
|
|
org interp_zp_origin
|
|
|
|
opcode: rmb 1
|
|
argcnt: rmb 1
|
|
|
|
arg1: rmb 2
|
|
arg2: rmb 2
|
|
arg3: rmb 2
|
|
arg4: rmb 2
|
|
arg5: rmb 2
|
|
arg6: rmb 2
|
|
arg7: rmb 2
|
|
arg8: rmb 2
|
|
|
|
Z68: rmb 1
|
|
Z69: rmb 1
|
|
Z6a: rmb 1
|
|
|
|
acc: rmb 2
|
|
|
|
Z6d: rmb 1
|
|
Z6e: rmb 1
|
|
Z6f: rmb 1
|
|
Z70: rmb 1
|
|
Z71: rmb 1
|
|
Z72: rmb 1
|
|
Z73: rmb 1
|
|
Z74: rmb 1
|
|
|
|
pc: rmb 3
|
|
pc_phys_page: rmb 3 ; physical address of page holding current PC
|
|
; third byte is 0/1 for page in main/aux RAM
|
|
|
|
aux_ptr: rmb 3
|
|
aux_phys_page: rmb 3 ; physical address of page holding current PC
|
|
; third byte is 0/1 for page in main/aux RAM
|
|
|
|
Z81: rmb 1
|
|
Z82: rmb 1
|
|
Z83: rmb 1
|
|
Z84: rmb 1
|
|
rmb 2
|
|
Z87: rmb 1
|
|
Z88: rmb 1
|
|
Z89: rmb 1
|
|
Z8a: rmb 1
|
|
Z8b: rmb 1
|
|
rmb 8
|
|
Z94: rmb 1
|
|
Z95: rmb 1
|
|
Z96: rmb 1
|
|
Z97: rmb 1
|
|
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 1
|
|
Za4: rmb 1
|
|
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
|
|
disk_block_num: rmb 2
|
|
|
|
Zb2: rmb 1
|
|
Zb3: rmb 1
|
|
rmb 2
|
|
Zb6: rmb 1
|
|
Zb7: rmb 1
|
|
Zb8: rmb 1
|
|
Zb9: rmb 1
|
|
Zba: rmb 1
|
|
rmb 2
|
|
Zbd: rmb 1
|
|
Zbe: rmb 1
|
|
Zbf: rmb 1
|
|
Zc0: rmb 2
|
|
Zc2: rmb 1
|
|
Zc3: rmb 1
|
|
Zc4: rmb 1
|
|
Zc5: rmb 1
|
|
Zc6: rmb 1
|
|
Zc7: rmb 2
|
|
Zc9: rmb 2
|
|
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 1
|
|
Zd4: rmb 1
|
|
Zd5: rmb 1
|
|
rmb 1
|
|
Zd7: rmb 1
|
|
rmb 1
|
|
Zd9: rmb 1
|
|
rmb 4
|
|
Zde: rmb 1
|
|
rmb 2
|
|
Ze1: rmb 1
|
|
Ze2: rmb 1
|
|
Ze3: rmb 1
|
|
Ze4: rmb 1
|
|
Ze5: rmb 1
|
|
rmb 1
|
|
Ze7: rmb 1
|
|
Ze8: rmb 2
|
|
rmb 1
|
|
stk_ptr: rmb 2 ; stack pointer
|
|
Zed: rmb 2
|
|
rmb 2
|
|
ostream_1_state: rmb 1
|
|
ostream_2_state: rmb 1
|
|
ostream_3_state: rmb 1
|
|
Zf4: rmb 1
|
|
Zf5: rmb 1
|
|
Zf6: rmb 1
|
|
Zf7: rmb 1
|
|
|
|
|
|
D0100 equ $0100
|
|
D01ff equ $01ff
|
|
|
|
D0200 equ $0200
|
|
|
|
D057b equ $057b
|
|
|
|
D086a equ $086a
|
|
S086b equ $086b
|
|
|
|
org $0900
|
|
rwts_sec_buf_size equ 86
|
|
|
|
rwts_data_buf rmb 256 ; user data
|
|
rwts_pri_buf: rmb 256 ; disk nibbles
|
|
rwts_sec_buf: rmb 86 ; disk nibbles
|
|
|
|
if iver>=iver2b
|
|
align $0100
|
|
endif
|
|
|
|
D0b56: rmb 128
|
|
D0bd6: rmb 128
|
|
D0c56: rmb 128
|
|
D0cd6: rmb 128
|
|
|
|
; data stack, 256 words, builds upward
|
|
D0d56: rmb $0100
|
|
D0e56: rmb $0100
|
|
D0f56: rmb $0100
|
|
D1056: rmb $0100
|
|
|
|
local_vars: rmb 30
|
|
|
|
rmb 2
|
|
|
|
D1176: rmb 2 ; save hdr_game_ver
|
|
D1178: rmb 2 ; save stk_ptr
|
|
D117a: rmb 2 ; save Zed
|
|
D117c: rmb 3 ; save PC
|
|
|
|
align $0100
|
|
|
|
max_main_ram_addr equ $c000
|
|
|
|
max_main_ram_pages equ (max_main_ram_addr-*)>>8
|
|
|
|
|
|
; 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 variable table
|
|
hdr_pure: rmb 2 ; base of pure (immutable) memory
|
|
hdr_flags2: rmb 2 ; flags 2
|
|
rmb 6 ; "serial" (usually game release date)
|
|
hdr_abbrev: rmb 2 ; abbreviation table
|
|
hdr_length: rmb 2 ; length of file (divided by 4 for v4 and v5)
|
|
hdr_checksum: rmb 2 ; checksum of file
|
|
hdr_interp_platform: rmb 1 ; interpreter platform number
|
|
hdr_interp_rev: rmb 1 ; interpreter revision
|
|
hdr_scr_height: rmb 1 ; screen height, lines of text
|
|
hdr_scr_width: rmb 1 ; screen width, characters
|
|
|
|
|
|
D1000 equ $1000 ; used for memory test at startup only, otherwise
|
|
; would overlap Z-Machine stack or other vars
|
|
|
|
|
|
|
|
; Apple IIe I/O
|
|
kbd equ $c000
|
|
rd_main_ram equ $c002
|
|
rd_card_ram equ $c003
|
|
wr_main_ram equ $c004
|
|
wr_card_ram equ $c005
|
|
kbd_strb equ $c010
|
|
spkr equ $c030
|
|
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
|
|
Sfca8 equ $fca8
|
|
rdkey equ $fd0c
|
|
cout equ $fded
|
|
cout1 equ $fdf0
|
|
bell equ $ff3a
|
|
|
|
org $d000
|
|
|
|
rwts:
|
|
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 Z0e
|
|
stx Dd474
|
|
sec
|
|
|
|
lda q6h,x ; check write protect
|
|
lda q7l,x
|
|
bmi .exit
|
|
|
|
lda rwts_sec_buf
|
|
sta Z0d
|
|
|
|
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 Z0e
|
|
sta q6h,x
|
|
lda q6l,x
|
|
dey
|
|
bne .loop2
|
|
|
|
; write primary buffer
|
|
lda Z0d
|
|
nop
|
|
.loop3: eor rwts_pri_buf,y
|
|
tax
|
|
lda nib_tab,x
|
|
ldx Dd474
|
|
sta q6h,x
|
|
lda q6l,x
|
|
lda rwts_pri_buf,y
|
|
iny
|
|
bne .loop3
|
|
|
|
tax ; write checksum
|
|
lda nib_tab,x
|
|
ldx Z0e
|
|
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
|
|
|
|
|
|
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 Z0d
|
|
bne .loop2
|
|
rts
|
|
|
|
|
|
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 Z0d
|
|
.loop7: ldy q6l,x
|
|
bpl .loop7
|
|
eor denib_tab,y
|
|
ldy Z0d
|
|
sta rwts_sec_buf,y
|
|
bne .loop6
|
|
|
|
; read primary buffer in forward order
|
|
.loop8: sty Z0d
|
|
.loop9: ldy q6l,x
|
|
bpl .loop9
|
|
eor denib_tab,y
|
|
ldy Z0d
|
|
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 Z0d
|
|
.loop1: iny
|
|
bne .loop2
|
|
inc Z0d
|
|
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 Z0e
|
|
.loop7: lda q6l,x
|
|
bpl .loop7
|
|
rol
|
|
sta Z0d
|
|
.loop8: lda q6l,x
|
|
bpl .loop8
|
|
and Z0d
|
|
sta Z0f,y
|
|
eor Z0e
|
|
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 Z0c
|
|
cmp Dd461
|
|
beq .rtn
|
|
lda #$00
|
|
sta Z0d
|
|
.loop1: lda Dd461
|
|
sta Z0e
|
|
sec
|
|
sbc Z0c
|
|
beq .fwd5
|
|
bcs .fwd1
|
|
eor #$ff
|
|
inc Dd461
|
|
bcc .fwd2
|
|
.fwd1: adc #$fe
|
|
dec Dd461
|
|
.fwd2: cmp Z0d
|
|
bcc .fwd3
|
|
lda Z0d
|
|
.fwd3: cmp #$0c
|
|
bcs .fwd4
|
|
tay
|
|
.fwd4: sec
|
|
jsr .subr1
|
|
lda motor_on_time_tab,y
|
|
jsr delay
|
|
lda Z0e
|
|
clc
|
|
jsr .subr2
|
|
lda motor_off_time_tab,y
|
|
jsr delay
|
|
inc Z0d
|
|
bne .loop1
|
|
.fwd5: jsr delay
|
|
clc
|
|
.subr1: lda Dd461
|
|
.subr2: and #$03
|
|
rol
|
|
ora rwts_slotx16
|
|
tax
|
|
lda ph_off,x
|
|
ldx rwts_slotx16
|
|
.rtn: rts
|
|
|
|
|
|
delay: ldx #$11
|
|
.loop1: dex
|
|
bne .loop1
|
|
inc Z13
|
|
bne .fwd1
|
|
inc Z14
|
|
.fwd1: sec
|
|
sbc #$01
|
|
bne delay
|
|
rts
|
|
|
|
|
|
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
|
|
|
|
|
|
; On entry:
|
|
; A = command
|
|
; $00 = read 16-sector
|
|
; $01 = write 16-sector
|
|
; $80 = read 18-sector
|
|
rwts_inner:
|
|
sta rwts_cmd
|
|
lda #$02
|
|
sta Dd475
|
|
asl
|
|
sta Dd471
|
|
ldx Z00
|
|
cpx Z01
|
|
beq .fwd1
|
|
ldx Z01
|
|
lda q7l,x
|
|
.loop1: ldy #$08
|
|
lda q6l,x
|
|
.loop2: cmp q6l,x
|
|
bne .loop1
|
|
dey
|
|
bne .loop2
|
|
ldx Z00
|
|
stx Z01
|
|
.fwd1: lda q7l,x
|
|
lda q6l,x
|
|
ldy #$08
|
|
.loop3: lda q6l,x
|
|
pha
|
|
pla
|
|
pha
|
|
pla
|
|
stx Dd473
|
|
cmp q6l,x
|
|
bne .fwd2
|
|
dey
|
|
bne .loop3
|
|
.fwd2: php
|
|
lda mtr_on,x
|
|
lda #$d8
|
|
sta Z14
|
|
lda Z02
|
|
cmp Z03
|
|
beq .fwd3
|
|
sta Z03
|
|
plp
|
|
ldy #$00
|
|
php
|
|
.fwd3: ror
|
|
bcc .fwd4
|
|
lda drv0_en,x
|
|
bcs .fwd5
|
|
.fwd4: lda drv1_en,x
|
|
.fwd5: ror Z0a
|
|
plp
|
|
php
|
|
bne .fwd6
|
|
ldy #$07
|
|
.loop4: jsr delay
|
|
dey
|
|
bne .loop4
|
|
ldx Dd473
|
|
.fwd6: lda rwts_track
|
|
jsr Sd417
|
|
plp
|
|
bne .fwd7
|
|
ldy Z14
|
|
bpl .fwd7
|
|
.loop5: ldy #$12
|
|
.loop6: dey
|
|
bne .loop6
|
|
inc Z13
|
|
bne .loop5
|
|
inc Z14
|
|
bne .loop5
|
|
|
|
.fwd7: lda rwts_cmd ; is command read or write?
|
|
ror
|
|
php
|
|
bcc .loop7 ; read
|
|
|
|
jsr pre_nibble ; write
|
|
|
|
.loop7: lda #48
|
|
sta addr_field_search_retry_counter
|
|
|
|
.loop8: ldx Dd473
|
|
|
|
lda rwts_cmd ; 16- or 18-sector?
|
|
bpl .fwd8 ; 16-sector
|
|
|
|
; 18-sector - read a data field instead of an address field
|
|
sta Z1a
|
|
jsr read_data_field_18
|
|
bcc .fwd9
|
|
bcs .loop9 ; always taken
|
|
|
|
; 16-sector - read an address field
|
|
.fwd8: jsr read_address_field
|
|
bcc .fwd9
|
|
|
|
; address field not found
|
|
.loop9: dec addr_field_search_retry_counter
|
|
bpl .loop8
|
|
|
|
; too many errors searching for address field
|
|
.loop10:
|
|
lda Dd461
|
|
pha
|
|
lda #$60
|
|
jsr Sd449
|
|
dec Dd475
|
|
beq .fwd10
|
|
lda #$04
|
|
sta Dd471
|
|
lda #$00
|
|
jsr Sd417
|
|
pla
|
|
.loop11:
|
|
jsr Sd417
|
|
jmp .loop7
|
|
|
|
.fwd9: ldy rwts18_sector
|
|
cpy Dd461
|
|
beq .fwd11
|
|
lda Dd461
|
|
pha
|
|
tya
|
|
jsr Sd449
|
|
pla
|
|
dec Dd471
|
|
bne .loop11
|
|
beq .loop10 ; always taken
|
|
|
|
.fwd10: pla
|
|
lda #$40
|
|
plp
|
|
jmp .fwd16
|
|
|
|
.fwd11: lda rwts_cmd
|
|
bmi .fwd12
|
|
|
|
ldy rwts_sector
|
|
lda interleave_tab,y
|
|
cmp Z10
|
|
bne .loop9
|
|
|
|
.fwd12: plp
|
|
bcs .fwd18
|
|
lda rwts_cmd
|
|
bpl .fwd13
|
|
|
|
ldy rwts_sector
|
|
sty Z1a
|
|
jsr read_data_field_18
|
|
bcc .fwd14 ; unnecessary
|
|
sec
|
|
bcs .fwd14
|
|
|
|
.fwd13: jsr read_data_field_16
|
|
.fwd14: bcc .fwd15
|
|
clc
|
|
php
|
|
bcc .loop9
|
|
.fwd15: ldx #$00
|
|
stx Z0d
|
|
jsr post_nibble
|
|
ldx Dd473
|
|
.rev1: lda #$00
|
|
clc
|
|
bcc .fwd17
|
|
.fwd16: sec
|
|
.fwd17: sta Z06
|
|
lda mtr_off,x
|
|
rts
|
|
|
|
.fwd18: jsr write_data_field
|
|
bcc .rev1
|
|
lda #$10
|
|
bne .fwd16 ; always taken
|
|
|
|
|
|
Sd417: asl
|
|
jsr Sd41f
|
|
lsr Dd461
|
|
rts
|
|
|
|
|
|
Sd41f: sta Z0c
|
|
jsr Sd442
|
|
lda Dd461,y
|
|
bit Z0a
|
|
bmi .fwd1
|
|
lda Dd469,y
|
|
.fwd1: sta Dd461
|
|
lda Z0c
|
|
bit Z0a
|
|
bmi .fwd2
|
|
sta Dd469,y
|
|
bpl .fwd3
|
|
.fwd2: sta Dd461,y
|
|
.fwd3: jmp seek_track
|
|
|
|
|
|
Sd442: txa
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
tay
|
|
rts
|
|
|
|
|
|
Sd449: pha
|
|
lda Z02
|
|
ror
|
|
ror Z0a
|
|
jsr Sd442
|
|
pla
|
|
asl
|
|
bit Z0a
|
|
bmi .fwd1
|
|
sta Dd469,y
|
|
bpl .rtn
|
|
.fwd1: sta Dd461,y
|
|
.rtn: rts
|
|
|
|
|
|
Dd461: fcb $00,$00,$00,$00,$00,$00,$00,$00
|
|
Dd469: fcb $00,$00,$00,$00,$00,$00,$00,$00
|
|
Dd471: fcb $00
|
|
|
|
addr_field_search_retry_counter:
|
|
fcb $00
|
|
|
|
Dd473: fcb $00
|
|
Dd474: fcb $00
|
|
Dd475: fcb $00
|
|
|
|
|
|
interleave_tab:
|
|
fcb $00,$04,$08,$0c,$01,$05,$09,$0d
|
|
fcb $02,$06,$0a,$0e,$03,$07,$0b,$0f
|
|
|
|
|
|
read_data_field_18:
|
|
lda #$20
|
|
sta Z15
|
|
tay
|
|
.loop1: lda #$84
|
|
dec Z15
|
|
beq .fwd3
|
|
.loop2: dey
|
|
beq .loop2
|
|
nop
|
|
nop
|
|
lda q6l,x
|
|
bpl .loop2
|
|
cmp #$d5 ; check for data field prologue 1st byte
|
|
bne .loop2
|
|
.loop3: lda q6l,x
|
|
bpl .loop3
|
|
cmp #$aa ; check for data field prologue 2nd byte
|
|
bne .loop1
|
|
.loop4: lda q6l,x
|
|
bpl .loop4
|
|
cmp #$ad ; check for data field prologue 3rd byte
|
|
bne .loop1
|
|
sec
|
|
|
|
.loop5: lda q6l,x
|
|
bpl .loop5
|
|
rol
|
|
sta rwts18_sector_temp
|
|
|
|
.loop6: lda q6l,x
|
|
bpl .loop6
|
|
and rwts18_sector_temp
|
|
sta rwts18_sector
|
|
lda Z1a
|
|
bmi .fwd1
|
|
|
|
; read 86 nibbles into secondary buffer, reverse order
|
|
.loop7: ldy #rwts_sec_buf_size
|
|
lda #$00
|
|
.loop8: dey
|
|
sty Z0d
|
|
.loop9: ldy q6l,x
|
|
bpl .loop9
|
|
eor denib_tab,y
|
|
ldy Z0d
|
|
sta rwts_sec_buf,y
|
|
bne .loop8
|
|
|
|
; read 256 nibbles into primary buffer, forward order
|
|
.loop10:
|
|
sty Z0d
|
|
.loop11:
|
|
ldy q6l,x
|
|
bpl .loop11
|
|
eor denib_tab,y
|
|
ldy Z0d
|
|
sta rwts_pri_buf,y
|
|
iny
|
|
bne .loop10
|
|
|
|
.loop12:
|
|
ldy q6l,x ; get checksum
|
|
bpl .loop12
|
|
dec Z1a
|
|
bpl .loop7
|
|
cmp denib_tab,y
|
|
bne .fwd2
|
|
.fwd1: clc
|
|
rts
|
|
|
|
.fwd2: lda #$85
|
|
.fwd3: sta Z06
|
|
sec
|
|
rts
|
|
|
|
|
|
; subroutine called by boot1
|
|
Sd505: 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 Z02
|
|
sta Z03
|
|
rts
|
|
|
|
|
|
; convert block number to track and sector
|
|
Sd51d: lda #$00
|
|
sta rwts_track
|
|
ldx disk_block_num+1
|
|
ldy disk_block_num
|
|
|
|
cpx #$01 ; is the block number greater than $100?
|
|
bcc .fwd5 ; under $100, 16-sector
|
|
|
|
bne .fwd1 ; $200 or over, 18-sector
|
|
|
|
cpy #$8a ; is the block number greater than $18a
|
|
bcc .fwd5 ; under $18a, 16-sector
|
|
|
|
; 18-sector
|
|
.fwd1: lda Ze7
|
|
cmp #$02
|
|
beq .fwd2
|
|
jsr Sd87e
|
|
|
|
ldx disk_block_num+1 ; subtract $18a to get side B relative block number
|
|
ldy disk_block_num
|
|
.fwd2: tya
|
|
sec
|
|
sbc #$8a
|
|
tay
|
|
txa
|
|
sbc #$01
|
|
tax
|
|
tya
|
|
|
|
;restoring divsion by 18 sectors/track for side B
|
|
sec
|
|
.loop1: sbc #18
|
|
bcs .fwd3
|
|
dex
|
|
bmi .fwd4
|
|
sec
|
|
.fwd3: inc rwts_track
|
|
bcs .loop1
|
|
.fwd4: clc
|
|
adc #18
|
|
sta rwts_sector
|
|
lda rwts_track
|
|
cmp #35 ; max track is 34
|
|
bcc .no_int_err_0c
|
|
jmp int_err_0c
|
|
|
|
.no_int_err_0c:
|
|
lda #$84
|
|
bne .fwd7 ; always taken
|
|
|
|
; 16-sector
|
|
.fwd5: lda Ze7
|
|
cmp #$01
|
|
beq .fwd6
|
|
jsr Sd856
|
|
|
|
; convert block number to track and sector, 16-sector (side A)
|
|
ldx disk_block_num+1
|
|
ldy disk_block_num
|
|
.fwd6: tya
|
|
and #$0f
|
|
sta rwts_sector
|
|
txa
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
sta rwts_track
|
|
tya
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
ora rwts_track
|
|
clc
|
|
adc #3 ; first track of side A image
|
|
cmp #35 ; max track is 34
|
|
bcs int_err_0c
|
|
sta rwts_track
|
|
lda #$00
|
|
|
|
; 16- and 18-sector paths rejoin here
|
|
.fwd7: sta rd_main_ram
|
|
jsr rwts
|
|
bcs int_err_0e
|
|
ldy Ded07
|
|
sta wr_main_ram,y ; indexed to get main or card
|
|
|
|
ldy #$00
|
|
.loop2: lda rwts_data_buf,y
|
|
sta (Zb2),y
|
|
iny
|
|
bne .loop2
|
|
|
|
sta wr_main_ram
|
|
inc disk_block_num
|
|
bne .fwd8
|
|
inc disk_block_num+1
|
|
.fwd8: inc Zb3
|
|
lda Zb3
|
|
cmp #$c0
|
|
bcc .rtn
|
|
lda #$08
|
|
sta Zb3
|
|
lda #$01
|
|
sta Ded07
|
|
.rtn: rts
|
|
|
|
|
|
; disk I/O error
|
|
int_err_0e:
|
|
lda #$0e
|
|
jmp int_error
|
|
|
|
|
|
Ld5c8: inc rwts_sector
|
|
lda rwts_sector
|
|
and #$0f
|
|
bne .fwd1
|
|
ldx rwts_track
|
|
inx
|
|
cpx #35 ; max track is 34
|
|
bcs Ld5f3
|
|
stx rwts_track
|
|
.fwd1: sta rwts_sector
|
|
inc Zb3
|
|
clc
|
|
rts
|
|
|
|
|
|
Sd5df: ldy #$00
|
|
sta rd_main_ram
|
|
.loop1: lda (Zb2),y
|
|
sta rwts_data_buf,y
|
|
iny
|
|
bne .loop1
|
|
lda #$01
|
|
jsr rwts
|
|
bcc Ld5c8
|
|
Ld5f3: rts
|
|
|
|
|
|
int_err_0c:
|
|
lda #$0c
|
|
jmp int_error
|
|
|
|
|
|
; disk I/O error
|
|
int_err_0e_alt:
|
|
lda #$0e
|
|
jmp int_error
|
|
|
|
|
|
read_sector:
|
|
lda #$00 ; read command
|
|
jsr rwts
|
|
bcs int_err_0e_alt
|
|
ldy #$00
|
|
sta rd_main_ram
|
|
|
|
.loop1: lda rwts_data_buf,y
|
|
sta (Zb2),y
|
|
iny
|
|
bne .loop1
|
|
|
|
inc disk_block_num
|
|
bne .noincblkhi
|
|
inc disk_block_num+1
|
|
.noincblkhi:
|
|
inc rwts_sector
|
|
lda rwts_sector
|
|
and #$0f
|
|
bne .noinctrk
|
|
ldx rwts_track
|
|
inx
|
|
cpx #35 ; max track is 34
|
|
bcs Ld5f3
|
|
stx rwts_track
|
|
.noinctrk:
|
|
sta rwts_sector
|
|
inc Zb3
|
|
clc
|
|
rts
|
|
|
|
; end of low-level disk routines
|
|
|
|
|
|
Sd62f: jsr op_new_line
|
|
lda #$00
|
|
sta Zd4
|
|
if iver<=iver2d
|
|
jmp home
|
|
else
|
|
rts
|
|
endif
|
|
|
|
|
|
msg_default_is:
|
|
text_str " (Default is "
|
|
Dd646: text_str "*) >"
|
|
msg_len_default_is equ *-msg_default_is
|
|
|
|
|
|
; On entry:
|
|
; A = default value - 1
|
|
Sd64a: clc
|
|
adc #'1'
|
|
sta Dd646
|
|
prt_msg_ret default_is
|
|
|
|
|
|
if iver>=iver2b
|
|
max_save_position:
|
|
fcb $00
|
|
endif
|
|
|
|
|
|
msg_position:
|
|
fcb char_cr
|
|
text_str "Position 1-"
|
|
if iver==iver2a
|
|
text_str "4"
|
|
else
|
|
msg_position_max_ascii: text_str "*"
|
|
endif
|
|
|
|
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
|
|
|
|
|
|
Dd67c: fcb $05
|
|
|
|
|
|
msg_pos_drive_slot_verify:
|
|
fcb char_cr,char_cr
|
|
text_str "Position "
|
|
Dd688: text_str "*; Drive #"
|
|
Dd692: text_str "*; Slot "
|
|
Dd69a: 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"
|
|
if iver==iver2d
|
|
fcb char_tab
|
|
else
|
|
text_str " "
|
|
endif
|
|
text_str "SAVE disk into Drive #"
|
|
Dd6d0: text_str "*."
|
|
msg_len_insert_save equ *-msg_insert_save
|
|
|
|
|
|
msg_yes:
|
|
text_str "YES"
|
|
fcb char_cr
|
|
msg_len_yes equ *-msg_yes
|
|
|
|
|
|
msg_no:
|
|
text_str "NO"
|
|
fcb char_cr
|
|
msg_len_no equ *-msg_no
|
|
|
|
|
|
Sd6d9: prt_msg position
|
|
lda Ze1
|
|
jsr Sd64a
|
|
.loop1: jsr Sda78
|
|
cmp #char_cr
|
|
beq .fwd1
|
|
sec
|
|
sbc #'1'
|
|
if iver==iver2a
|
|
cmp #4
|
|
else
|
|
cmp max_save_position
|
|
endif
|
|
bcc .fwd2
|
|
jsr Sdd39
|
|
jmp .loop1
|
|
|
|
.fwd1: lda Ze1
|
|
.fwd2: sta Ze3
|
|
clc
|
|
adc #'1'
|
|
sta Dd688
|
|
sta Dd8d1
|
|
sta Dd99d
|
|
ora #$80
|
|
jsr Sdaee
|
|
prt_msg drive
|
|
lda Ze2
|
|
jsr Sd64a
|
|
.loop2: jsr Sda78
|
|
cmp #char_cr
|
|
beq .fwd3
|
|
sec
|
|
sbc #'1'
|
|
cmp #2
|
|
bcc .fwd4
|
|
jsr Sdd39
|
|
jmp .loop2
|
|
|
|
.fwd3: lda Ze2
|
|
.fwd4: sta Ze4
|
|
clc
|
|
adc #'1'
|
|
sta Dd6d0
|
|
sta Dd692
|
|
ora #$80
|
|
jsr Sdaee
|
|
|
|
lda romid2_save ; IIc family?
|
|
bne .fwd5 ; no
|
|
lda #$05 ; yes, force slot 6
|
|
bne .fwd7
|
|
|
|
.fwd5: prt_msg slot
|
|
lda Dd67c
|
|
jsr Sd64a
|
|
.loop3: jsr Sda78
|
|
cmp #char_cr
|
|
beq .fwd6
|
|
sec
|
|
sbc #'1'
|
|
cmp #$07
|
|
bcc .fwd7
|
|
jsr Sdd39
|
|
jmp .loop3
|
|
.fwd6: lda Dd67c
|
|
.fwd7: sta Ze5
|
|
clc
|
|
adc #'1'
|
|
sta Dd69a
|
|
|
|
ldx romid2_save ; IIc family?
|
|
beq .fwd8 ; yes
|
|
ora #$80 ; no
|
|
jsr Sdaee
|
|
|
|
.fwd8: prt_msg pos_drive_slot_verify
|
|
.loop4: jsr Sda78
|
|
cmp #'y'
|
|
beq .fwd10
|
|
cmp #'Y'
|
|
beq .fwd10
|
|
cmp #char_cr
|
|
beq .fwd10
|
|
cmp #'n'
|
|
beq .fwd9
|
|
cmp #'N'
|
|
beq .fwd9
|
|
jsr Sdd39
|
|
jmp .loop4
|
|
|
|
.fwd9: prt_msg no
|
|
jmp Sd6d9
|
|
|
|
.fwd10: prt_msg yes
|
|
lda Ze4
|
|
sta Z02
|
|
inc Z02
|
|
ldx Ze5
|
|
inx
|
|
txa
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
sta Z00
|
|
lda Ze3
|
|
|
|
if iver==iver2a
|
|
|
|
; exactly four save locations, each eight tracks
|
|
asl
|
|
asl
|
|
asl
|
|
sta rwts_track
|
|
lda Ze3
|
|
lsr
|
|
php
|
|
clc
|
|
adc rwts_track
|
|
sta rwts_track
|
|
lda #$00
|
|
plp
|
|
bcc .fwd11
|
|
lda #$08
|
|
.fwd11: sta rwts_sector
|
|
|
|
else
|
|
|
|
ldx max_save_position
|
|
cpx #$03
|
|
beq .fwd12
|
|
clc
|
|
adc #$03
|
|
.fwd12: tax
|
|
lda save_start_track_tbl,X
|
|
sta rwts_track
|
|
lda save_start_sector_tbl,X
|
|
sta rwts_sector
|
|
|
|
endif
|
|
|
|
prt_msg insert_save
|
|
|
|
Sd7f2: prt_msg press_return
|
|
.loop5: jsr Sda78
|
|
cmp #char_cr
|
|
beq .fwd13
|
|
jsr Sdd39
|
|
jmp .loop5
|
|
.fwd13: rts
|
|
|
|
|
|
msg_press_return:
|
|
fcb char_cr
|
|
text_str "Press [RETURN] to continue."
|
|
fcb char_cr
|
|
if iver>=iver2h
|
|
fcb char_cr
|
|
fcb char_cr
|
|
endif
|
|
msg_len_press_return equ *-msg_press_return
|
|
|
|
|
|
if iver>=iver2b
|
|
save_start_track_tbl: fcb $00,$0b,$17 ; three save positions
|
|
fcb $00,$08,$11,$19 ; four save positions
|
|
save_start_sector_tbl: fcb $00,$08,$00 ; three save positions
|
|
fcb $00,$08,$00,$08 ; four save positions
|
|
endif
|
|
|
|
|
|
msg_insert_story:
|
|
fcb char_cr
|
|
text_str "Insert"
|
|
if iver==iver2d
|
|
fcb char_tab
|
|
else
|
|
text_str " "
|
|
endif
|
|
text_str "Side "
|
|
Dd833: text_str "* of the STORY disk into Drive #1."
|
|
fcb char_cr
|
|
if iver>=iver2h
|
|
fcb char_cr
|
|
fcb char_cr
|
|
endif
|
|
msg_len_insert_story equ *-msg_insert_story
|
|
|
|
|
|
Sd856: lda #'1'
|
|
sta Dd833
|
|
lda #$01
|
|
sta Ze7
|
|
.loop1: prt_msg insert_story
|
|
jsr Sd7f2
|
|
lda #$00
|
|
sta rwts_sector
|
|
sta rwts_track
|
|
lda #$01
|
|
sta Z02
|
|
lda #$00
|
|
jsr rwts
|
|
bcs .loop1
|
|
bcc Ld8ac ; always taken
|
|
|
|
|
|
Sd87e: lda #$32
|
|
sta Dd833
|
|
lda #$02
|
|
sta Ze7
|
|
lda Z02
|
|
pha
|
|
lda #$01
|
|
sta Z02
|
|
pla
|
|
cmp #$02
|
|
beq Ld8ac
|
|
.loop2: prt_msg insert_story
|
|
jsr Sd7f2
|
|
lda #$00
|
|
sta rwts_sector
|
|
sta rwts_track
|
|
lda #$84
|
|
jsr rwts
|
|
bcs .loop2
|
|
Ld8ac: lda #$ff
|
|
sta Zd4
|
|
rts
|
|
|
|
|
|
msg_save_position:
|
|
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"
|
|
if iver==iver2d
|
|
fcb char_tab
|
|
else
|
|
text_str " "
|
|
endif
|
|
text_str "position "
|
|
Dd8d1: text_str "* ..."
|
|
fcb char_cr
|
|
if iver>=iver2h
|
|
fcb char_cr
|
|
fcb char_cr
|
|
endif
|
|
msg_len_saving_position equ *-msg_saving_position
|
|
|
|
|
|
op_save:
|
|
jsr Sd62f
|
|
prt_msg save_position
|
|
jsr Sd6d9
|
|
prt_msg saving_position
|
|
lda hdr_game_ver
|
|
sta D1176
|
|
lda hdr_game_ver+1
|
|
sta D1176+1
|
|
lda stk_ptr
|
|
sta D1178
|
|
lda stk_ptr+1
|
|
sta D1178+1
|
|
lda Zed
|
|
sta D117a
|
|
lda Zed+1
|
|
sta D117a+1
|
|
|
|
ldx #$02
|
|
.loop1: lda pc,x
|
|
sta D117c,x
|
|
dex
|
|
bpl .loop1
|
|
|
|
lda #(hdr_arch>>8)-1
|
|
sta Zb3
|
|
jsr Sd5df
|
|
bcc .fwd1
|
|
|
|
.loop2: jsr Sd87e
|
|
|
|
if iver<=iver2d
|
|
jsr home
|
|
endif
|
|
|
|
lda #$16
|
|
sta cursrv
|
|
jsr vtab
|
|
jmp store_result_zero
|
|
|
|
.fwd1: lda #(hdr_arch>>8)-5
|
|
sta Zb3
|
|
lda #$04
|
|
sta Z73
|
|
.loop3: jsr Sd5df
|
|
bcs .loop2
|
|
dec Z73
|
|
bne .loop3
|
|
lda Z81
|
|
sta Zb3
|
|
ldx hdr_pure
|
|
inx
|
|
stx Z6d
|
|
.loop4: jsr Sd5df
|
|
bcs .loop2
|
|
dec Z6d
|
|
bne .loop4
|
|
|
|
jsr Sd87e
|
|
|
|
if iver<=iver2d
|
|
jsr home
|
|
endif
|
|
|
|
lda #$16
|
|
sta cursrv
|
|
jsr vtab
|
|
lda Ze4
|
|
sta Ze2
|
|
lda Ze5
|
|
sta Dd67c
|
|
lda Ze3
|
|
sta Ze1
|
|
lda #$01
|
|
ldx #$00
|
|
jmp store_result_xa
|
|
|
|
|
|
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 "
|
|
Dd99d: text_str "* ..."
|
|
fcb char_cr
|
|
if iver>=iver2h
|
|
fcb char_cr
|
|
fcb char_cr
|
|
endif
|
|
msg_len_restoring_position equ *-msg_restoring_position
|
|
|
|
|
|
op_restore:
|
|
jsr Sd62f
|
|
prt_msg restore_position
|
|
jsr Sd6d9
|
|
prt_msg restoring_position
|
|
|
|
ldx #$1f
|
|
.loop1: lda local_vars,x
|
|
sta D0100,x
|
|
dex
|
|
bpl .loop1
|
|
|
|
lda #(hdr_arch>>8)-1
|
|
sta Zb3
|
|
jsr read_sector
|
|
bcs .loop2
|
|
lda D1176
|
|
cmp hdr_game_ver
|
|
bne .loop2
|
|
lda D1176+1
|
|
cmp hdr_game_ver+1
|
|
beq .fwd1
|
|
|
|
.loop2: ldx #$1f
|
|
.loop3: lda D0100,x
|
|
sta local_vars,x
|
|
dex
|
|
bpl .loop3
|
|
jsr Sd87e
|
|
|
|
if iver<=iver2d
|
|
jsr home
|
|
endif
|
|
lda #$16
|
|
sta cursrv
|
|
jsr vtab
|
|
jmp store_result_zero
|
|
|
|
.fwd1: lda hdr_flags2
|
|
sta Z6d
|
|
lda hdr_flags2+1
|
|
sta Z6e
|
|
|
|
lda #(hdr_arch>>8)-5
|
|
sta Zb3
|
|
lda #$04
|
|
sta Z73
|
|
.loop4: jsr read_sector
|
|
bcs .loop2
|
|
dec Z73
|
|
bne .loop4
|
|
lda Z81
|
|
sta Zb3
|
|
jsr read_sector
|
|
bcs .loop2
|
|
lda Z6d
|
|
sta hdr_flags2
|
|
lda Z6e
|
|
sta hdr_flags2+1
|
|
lda hdr_pure
|
|
sta Z6d
|
|
.loop5: jsr read_sector
|
|
bcs .loop2
|
|
dec Z6d
|
|
bne .loop5
|
|
|
|
lda D1178
|
|
sta stk_ptr
|
|
lda D1178+1
|
|
sta stk_ptr+1
|
|
|
|
lda D117a
|
|
sta Zed
|
|
lda D117a+1
|
|
sta Zed+1
|
|
|
|
ldx #$02
|
|
.loop6: lda D117c,x
|
|
sta pc,x
|
|
dex
|
|
bpl .loop6
|
|
|
|
jsr find_pc_page
|
|
jsr Sd87e
|
|
|
|
if iver<=iver2d
|
|
jsr home
|
|
endif
|
|
|
|
lda #$16
|
|
sta cursrv
|
|
jsr vtab
|
|
lda Ze4
|
|
sta Ze2
|
|
lda Ze5
|
|
sta Dd67c
|
|
lda Ze3
|
|
sta Ze1
|
|
lda #$02
|
|
ldx #$00
|
|
jmp store_result_xa
|
|
|
|
|
|
Sda78: cld
|
|
txa
|
|
pha
|
|
tya
|
|
pha
|
|
.loop1: jsr rdkey
|
|
and #$7f
|
|
cmp #$0d
|
|
bne .fwd1
|
|
jmp .fwd6
|
|
|
|
.fwd1: cmp #$7f
|
|
bne .fwd2
|
|
jmp .fwd6
|
|
|
|
.fwd2: ldx #$0a
|
|
.loop2: cmp Ddad8,x
|
|
beq .fwd3
|
|
dex
|
|
bpl .loop2
|
|
bmi .fwd4 ; always taken
|
|
|
|
.fwd3: lda Ddae3,x
|
|
bne .fwd6
|
|
.fwd4: cmp #$20
|
|
bcc .fwd5
|
|
|
|
if iver<=iver2d
|
|
cmp #$2b
|
|
beq .fwd5
|
|
endif
|
|
|
|
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 Sdd39
|
|
jmp .loop1
|
|
.fwd6: sta Zd7
|
|
adc rndloc
|
|
sta rndloc
|
|
eor rndloc+1
|
|
sta rndloc+1
|
|
pla
|
|
tay
|
|
pla
|
|
tax
|
|
lda Zd7
|
|
rts
|
|
|
|
|
|
Ddad8: fcb $08,$15,$0b,$0a,$3c,$5f,$3e,$40
|
|
fcb $25
|
|
if iver<=iver2b
|
|
fcb $5e,$26
|
|
else
|
|
fcb $26,$5e
|
|
endif
|
|
|
|
Ddae3: fcb $0b,$07,$0e,$0d,$2c,$2d,$2e,$32
|
|
fcb $35
|
|
if iver<=iver2b
|
|
fcb $36,$37
|
|
else
|
|
fcb $37,$0e
|
|
endif
|
|
|
|
|
|
Sdaee: sta Zd7
|
|
txa
|
|
pha
|
|
tya
|
|
pha
|
|
lda Zd7
|
|
jsr cout
|
|
pla
|
|
tay
|
|
pla
|
|
tax
|
|
rts
|
|
|
|
|
|
Sdafe: jsr Sf446
|
|
lda #$00
|
|
sta Zd0
|
|
sta Zd1
|
|
ldy wndtop
|
|
sty Zd5
|
|
dec argcnt
|
|
dec argcnt
|
|
beq .fwd3
|
|
lda arg3
|
|
sta Z6e
|
|
lda #$00
|
|
sta Z70
|
|
sta Z6f
|
|
dec argcnt
|
|
beq .fwd1
|
|
lda arg4
|
|
sta Z6f
|
|
lda arg4+1
|
|
sta Z70
|
|
.fwd1: bit kbd_strb
|
|
.loop1: lda Z6e
|
|
sta Z6d
|
|
.loop2: ldx #$0a
|
|
.loop3: lda #$40
|
|
jsr Sfca8
|
|
dex
|
|
bne .loop3
|
|
bit kbd
|
|
bmi .fwd3
|
|
dec Z6d
|
|
bne .loop2
|
|
lda Z6f
|
|
ora Z70
|
|
bne .fwd2
|
|
jmp .fwd10
|
|
|
|
.fwd2: jsr Sf5f9
|
|
lda acc
|
|
beq .loop1
|
|
jmp .fwd10
|
|
|
|
.fwd3: ldy #$00
|
|
.loop4: jsr Sda78
|
|
cmp #$0e
|
|
beq .fwd7
|
|
cmp #$07
|
|
beq .fwd7
|
|
cmp #$0d
|
|
beq .fwd8
|
|
cmp #$7f
|
|
beq .fwd5
|
|
cmp #$0b
|
|
beq .fwd5
|
|
sta D0200,y
|
|
iny
|
|
.loop5: ldx invflg
|
|
bpl .fwd4
|
|
ora #$80
|
|
.fwd4: jsr Sdaee
|
|
|
|
if iver==iver2a
|
|
cpy Zbe
|
|
else
|
|
cpy #$4d
|
|
endif
|
|
|
|
bcc .loop4
|
|
.loop6: jsr Sda78
|
|
cmp #$0d
|
|
beq .fwd8
|
|
cmp #$7f
|
|
beq .fwd5
|
|
cmp #$0b
|
|
beq .fwd5
|
|
jsr Sdd39
|
|
jmp .loop6
|
|
|
|
.fwd5: dey
|
|
bmi .fwd6
|
|
lda #$08
|
|
jsr Sdaee
|
|
lda #$a0
|
|
jsr Sdaee
|
|
lda #$08
|
|
bne .loop5
|
|
.fwd6: ldy #$00
|
|
.fwd7: jsr Sdd39
|
|
jmp .loop4
|
|
|
|
.fwd8: lda #$8d
|
|
sta D0200,y
|
|
iny
|
|
sty Z9f
|
|
sty Zde
|
|
jsr Sdaee
|
|
.loop7: lda D01ff,y
|
|
cmp #$41
|
|
bcc .fwd9
|
|
cmp #$5b
|
|
bcs .fwd9
|
|
adc #$20
|
|
.fwd9: and #$7f
|
|
sta (Zc3),y
|
|
dey
|
|
bne .loop7
|
|
jsr Sdbf3
|
|
lda Z9f
|
|
rts
|
|
.fwd10: lda #$00
|
|
rts
|
|
|
|
|
|
; On entry:
|
|
; A:X message address
|
|
; Y message length
|
|
msg_out:
|
|
stx .lda+1
|
|
sta .lda+2
|
|
sty Z6f
|
|
ldx #$00
|
|
.loop1:
|
|
.lda fcb $bd,$00,$00 ; lda $0000,x ; self-modifying code, MUST be absolute,x
|
|
ldy invflg
|
|
bpl .fwd1
|
|
ora #$80
|
|
.fwd1: jsr Sdaee
|
|
inx
|
|
dec Z6f
|
|
bne .loop1
|
|
rts
|
|
|
|
|
|
Ldbf2: rts
|
|
|
|
Sdbf3: lda Zd4
|
|
beq Ldbf2
|
|
lda ostream_2_state
|
|
beq Ldbf2
|
|
lda cswl
|
|
pha
|
|
lda cswl+1
|
|
pha
|
|
lda cursrh
|
|
pha
|
|
lda D057b
|
|
pha
|
|
lda Ddc35
|
|
sta cswl
|
|
lda Ddc35+1
|
|
sta cswl+1
|
|
lda #$00
|
|
sta cursrh
|
|
sta D057b
|
|
ldy #$00
|
|
.loop1: lda D0200,y
|
|
jsr cout
|
|
iny
|
|
dec Zde
|
|
bne .loop1
|
|
pla
|
|
sta D057b
|
|
pla
|
|
sta cursrh
|
|
pla
|
|
sta cswl+1
|
|
pla
|
|
sta cswl
|
|
rts
|
|
|
|
|
|
Ddc34: fcb $00
|
|
Ddc35: fdb $0000
|
|
|
|
|
|
Sdc37: prt_msg printer_slot
|
|
lda #$00
|
|
jsr Sd64a
|
|
jsr Sda78
|
|
cmp #char_cr
|
|
beq .fwd1
|
|
sec
|
|
sbc #'0'
|
|
cmp #$08
|
|
bcs Sdc37
|
|
bcc .fwd2
|
|
.fwd1: lda #$01
|
|
.fwd2: clc
|
|
adc #$c0
|
|
sta Ddc35+1
|
|
jsr Sdd17
|
|
inc Ddc34
|
|
|
|
; send sequence <control-I>80N to convince printer firmware to use
|
|
; 80 columns
|
|
lda cswl
|
|
pha
|
|
lda cswl+1
|
|
pha
|
|
lda Ddc35
|
|
sta cswl
|
|
lda Ddc35+1
|
|
sta cswl+1
|
|
lda #$89
|
|
jsr cout
|
|
lda #$b8
|
|
jsr cout
|
|
lda #$b0
|
|
jsr cout
|
|
lda #$ce
|
|
jsr cout
|
|
lda cswl
|
|
sta Ddc35
|
|
lda cswl+1
|
|
sta Ddc35+1
|
|
pla
|
|
sta cswl+1
|
|
pla
|
|
sta cswl
|
|
rts
|
|
|
|
|
|
op_split_window:
|
|
lda hdr_flags_1
|
|
and #$20
|
|
beq Ldcd7
|
|
lda arg1
|
|
beq Sdcd8
|
|
if iver==iver2a
|
|
cmp #23
|
|
else
|
|
cmp #24
|
|
endif
|
|
bcs Ldcd7
|
|
ldx Zd9
|
|
beq .fwd1
|
|
lda wndtop
|
|
sec
|
|
sbc arg1
|
|
bcs .fwd2
|
|
.fwd1: lda arg1
|
|
if iver==iver2a
|
|
sta wndbot
|
|
endif
|
|
sta Zd9
|
|
if iver==iver2a
|
|
jsr home
|
|
endif
|
|
.fwd2: lda #24
|
|
sta wndbot
|
|
lda arg1
|
|
sta wndtop
|
|
cmp Zd5
|
|
bcc .fwd3
|
|
sta Zd5
|
|
.fwd3: lda #$00
|
|
sta cursrh
|
|
sta D057b
|
|
lda #23
|
|
sta cursrv
|
|
jsr vtab
|
|
Ldcd7: rts
|
|
|
|
|
|
Sdcd8: lda #$00
|
|
sta wndtop
|
|
sta Zd5
|
|
sta Zd9
|
|
rts
|
|
|
|
|
|
op_set_window:
|
|
lda hdr_flags_1
|
|
and #$01
|
|
beq Ldcd7
|
|
lda Zd9
|
|
beq Ldcd7
|
|
lda arg1
|
|
bne .fwd1
|
|
lda #$ff
|
|
sta Zd4
|
|
lda #$00
|
|
sta Zc2
|
|
|
|
if iver<=iver2d
|
|
sta cursrh
|
|
sta D057b
|
|
else
|
|
lda Zd0
|
|
sta D057b
|
|
sta cursrh
|
|
endif
|
|
|
|
lda #$17
|
|
sta cursrv
|
|
|
|
if iver<=iver2d
|
|
bne .fwd2
|
|
else
|
|
jmp .fwd2
|
|
endif
|
|
|
|
.fwd1: cmp #$01
|
|
bne Ldcd7
|
|
sta Zc2
|
|
lda #$00
|
|
sta Zd4
|
|
sta cursrh
|
|
sta D057b
|
|
sta cursrv
|
|
.fwd2: jmp vtab
|
|
|
|
|
|
Sdd17: lda #char_cr+$80
|
|
jmp cout
|
|
|
|
|
|
op_sound_effect:
|
|
lda hdr_flags_1
|
|
and #$20
|
|
beq .rtn
|
|
ldx arg1
|
|
dex
|
|
beq Sdd39
|
|
dex
|
|
bne .rtn
|
|
ldy #$ff
|
|
.loop1: lda #$10
|
|
jsr Sfca8
|
|
lda spkr
|
|
dey
|
|
bne .loop1
|
|
.rtn: rts
|
|
|
|
|
|
Sdd39: jmp bell
|
|
|
|
|
|
Sdd3c: lda #$00
|
|
sta Zf7
|
|
.loop1: ldy #$00
|
|
.loop2: sta D1000,y
|
|
iny
|
|
bne .loop2
|
|
inc Zf7
|
|
lda Zf7
|
|
sta wr_card_ram
|
|
.loop3: sta D1000,y
|
|
iny
|
|
bne .loop3
|
|
sta wr_main_ram
|
|
dec Zf7
|
|
.loop4: lda D1000,y
|
|
cmp Zf7
|
|
bne .fwd1
|
|
iny
|
|
bne .loop4
|
|
inc Zf7
|
|
sta rd_card_ram
|
|
.loop5: lda D1000,y
|
|
cmp Zf7
|
|
bne .fwd1
|
|
iny
|
|
bne .loop5
|
|
sta rd_main_ram
|
|
lda Zf7
|
|
bne .loop1
|
|
clc
|
|
rts
|
|
|
|
.fwd1: sta rd_main_ram
|
|
sec
|
|
rts
|
|
|
|
|
|
romid2_save:
|
|
fcb $00
|
|
Ddd82: fcb $00
|
|
Ddd83: fcb $00
|
|
|
|
|
|
; interpreter startup entry point jumped from boot1
|
|
interp_start:
|
|
lda bas2l+1
|
|
sta Z00
|
|
sta Z01
|
|
|
|
if iver>=iver2b
|
|
lda #cout1>>8
|
|
sta cswl+1
|
|
lda #cout1&$ff
|
|
sta cswl
|
|
endif
|
|
|
|
ldx #$00
|
|
stx rwts_sector
|
|
stx Zb2
|
|
|
|
inx ; read rest of interpreter starting with track 1
|
|
stx rwts_track
|
|
|
|
stx Z02
|
|
stx Z03
|
|
|
|
lda #$df ; starting at $df00
|
|
sta Zb3
|
|
|
|
lda #25 ; sector count
|
|
sta Z6d
|
|
|
|
.loop1: jsr read_sector
|
|
dec Z6d
|
|
bne .loop1
|
|
|
|
lda #$ff
|
|
sta invflg
|
|
|
|
lda romid
|
|
cmp #$06 ; is the computer an Apple IIe or later?
|
|
beq .fwd1 ; yes
|
|
jmp computer_inadequate
|
|
|
|
.fwd1: lda romid2
|
|
sta romid2_save
|
|
beq .fwd2
|
|
jsr Sdd3c
|
|
bcs computer_inadequate
|
|
.fwd2: jsr sl3fw
|
|
|
|
restart:
|
|
lda Z01
|
|
ldx Z03
|
|
sta Ddd82
|
|
stx Ddd83
|
|
jsr home
|
|
lda #$0a
|
|
sta cursrv
|
|
lda #$1b
|
|
sta cursrh
|
|
sta D057b
|
|
jsr vtab
|
|
prt_msg_alt story_loading
|
|
|
|
lda #$00 ; clear interp zero page vars
|
|
ldx #interp_zp_origin
|
|
.loop2: sta Z00,x
|
|
inx
|
|
bne .loop2
|
|
|
|
inc stk_ptr
|
|
inc Zed
|
|
inc Zd4
|
|
inc ostream_1_state
|
|
inc Ze7
|
|
|
|
lda #hdr_arch>>8
|
|
sta Z81
|
|
sta Zb3
|
|
|
|
lda #$00
|
|
sta Ded07
|
|
jsr Sd51d
|
|
|
|
lda hdr_arch ; check header architecture version version
|
|
cmp #$04
|
|
beq Lde21
|
|
|
|
lda #$0f
|
|
jmp int_error
|
|
|
|
computer_inadequate:
|
|
lda #$05
|
|
sta cursrv
|
|
jsr vtab
|
|
lda #$00
|
|
jmp int_error
|
|
|
|
Lde21:
|
|
if iver>=iver2b
|
|
lda hdr_pure ; heck header size of impure memory
|
|
cmp #$ad ; BUG - should be max_main_ram_pages, which differs ($ad or $ae) depending on interpreter revision
|
|
bcc .fwd1a
|
|
|
|
lda #$0d
|
|
jmp int_error
|
|
|
|
.fwd1a: cmp #$80
|
|
bcc .fwd1b
|
|
lda #$03
|
|
bne .fwd1c
|
|
.fwd1b: lda #$04
|
|
.fwd1c: sta max_save_position
|
|
clc
|
|
adc #$30
|
|
sta msg_position_max_ascii
|
|
endif
|
|
|
|
ldx hdr_high_mem ; base of high memory
|
|
inx
|
|
stx Z82
|
|
|
|
lda hdr_flags_1
|
|
ora #$33 ; bit 0: coulurs available (!)
|
|
; bit 1: picture display av (!)
|
|
; bit 4: fixed-space style av
|
|
; bit 5: sound effects av
|
|
sta hdr_flags_1
|
|
|
|
lda #iver>>8 ; set interpreter platform number
|
|
sta hdr_interp_platform
|
|
lda #$40+(iver&$ff) ; set interpreter revision
|
|
sta hdr_interp_rev
|
|
|
|
lda #24 ; set screen dimensiosn
|
|
sta hdr_scr_height
|
|
lda #80
|
|
sta hdr_scr_width
|
|
|
|
lda hdr_globals
|
|
clc
|
|
adc Z81
|
|
sta Z84
|
|
lda hdr_globals+1
|
|
sta Z83
|
|
|
|
lda hdr_abbrev
|
|
clc
|
|
adc Z81
|
|
sta Z88
|
|
lda hdr_abbrev+1
|
|
sta Z87
|
|
|
|
lda hdr_object
|
|
clc
|
|
adc Z81
|
|
sta Z8a
|
|
lda hdr_object+1
|
|
sta Z89
|
|
|
|
jsr Seeef
|
|
jsr home
|
|
|
|
lda hdr_init_pc
|
|
sta pc+1
|
|
lda hdr_init_pc+1
|
|
sta pc
|
|
|
|
jsr find_pc_page
|
|
ldx wndwdt
|
|
dex
|
|
stx Zbf
|
|
lda Ddc34
|
|
bpl .fwd3
|
|
lda #$01
|
|
sta Ddc34
|
|
sta ostream_2_state
|
|
ora hdr_flags2+1
|
|
sta hdr_flags2+1
|
|
.fwd3: jsr home
|
|
; fall into main loop
|
|
|
|
main_loop:
|
|
lda #$00
|
|
sta argcnt
|
|
|
|
fetch_pc_byte_inline
|
|
sta opcode
|
|
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:
|
|
cmp #$ec ; is it call_vs2 (up to 8 args)?
|
|
beq op_ec ; yes
|
|
|
|
jsr fetch_pc_byte
|
|
sta Z68
|
|
ldx #$00
|
|
stx Z6a
|
|
beq .fwd1 ; always taken
|
|
|
|
.loop1: lda Z68
|
|
asl
|
|
asl
|
|
sta Z68
|
|
.fwd1: and #$c0
|
|
bne .fwd2
|
|
jsr Se075
|
|
jmp .fwd4
|
|
|
|
.fwd2: cmp #$40
|
|
bne .fwd3
|
|
jsr Se071
|
|
jmp .fwd4
|
|
|
|
.fwd3: cmp #$80
|
|
bne Ldf08
|
|
jsr Se089
|
|
.fwd4: ldx Z6a
|
|
lda acc
|
|
sta arg1,x
|
|
lda acc+1
|
|
sta arg1+1,x
|
|
inc argcnt
|
|
inx
|
|
inx
|
|
stx Z6a
|
|
cpx #$08
|
|
bcc .loop1
|
|
Ldf08: lda opcode
|
|
cmp #$e0
|
|
bcs Ldf11
|
|
jmp dispatch_2op_tab
|
|
|
|
; dispatch through VAR op table
|
|
Ldf11: and #$1f
|
|
tay
|
|
lda tab_var_lo,y
|
|
sta Ldf20+1
|
|
lda tab_var_hi,y
|
|
sta Ldf20+2
|
|
Ldf20 jsr $ffff ; self-modifying code
|
|
jmp main_loop
|
|
|
|
|
|
int_err_01:
|
|
lda #$01
|
|
jmp int_error
|
|
|
|
|
|
; call_vf2, up to eight args
|
|
op_ec: jsr fetch_pc_byte
|
|
sta Z68
|
|
jsr fetch_pc_byte
|
|
sta Z69
|
|
lda Z68
|
|
ldx #$00
|
|
stx Z6a
|
|
beq .loop2
|
|
.loop1: lda Z68
|
|
asl
|
|
asl
|
|
sta Z68
|
|
.loop2: and #$c0
|
|
bne .fwd1
|
|
jsr Se075
|
|
jmp .fwd3
|
|
|
|
.fwd1: cmp #$40
|
|
bne .fwd2
|
|
jsr Se071
|
|
jmp .fwd3
|
|
|
|
.fwd2: cmp #$80
|
|
bne Ldf08
|
|
jsr Se089
|
|
|
|
.fwd3: ldx Z6a
|
|
lda acc
|
|
sta arg1,x
|
|
lda acc+1
|
|
sta arg1+1,x
|
|
inc argcnt
|
|
inx
|
|
inx
|
|
stx Z6a
|
|
cpx #$10
|
|
beq Ldf08
|
|
cpx #$08
|
|
bne .loop1
|
|
lda Z69
|
|
sta Z68
|
|
jmp .loop2
|
|
|
|
|
|
; 0OP instructions
|
|
op_b0_bf:
|
|
and #$0f
|
|
tay
|
|
lda tab_0op_lo,y
|
|
sta .jsr+1
|
|
lda tab_0op_hi,y
|
|
sta .jsr+2
|
|
.jsr: jsr $ffff ; self-modifying code
|
|
jmp main_loop
|
|
|
|
|
|
int_err_02:
|
|
lda #$02
|
|
jmp int_error
|
|
|
|
|
|
op_80_af:
|
|
and #$30
|
|
bne .fwd2
|
|
|
|
; 1OP
|
|
fetch_pc_byte_inline
|
|
jmp .fwd3
|
|
|
|
.fwd2: and #$20
|
|
bne .fwd5
|
|
.fwd3: sta arg1+1
|
|
|
|
fetch_pc_byte_inline
|
|
sta arg1
|
|
inc argcnt
|
|
jmp dispatch_1op
|
|
|
|
.fwd5: jsr Se089
|
|
jsr Se066
|
|
dispatch_1op:
|
|
lda opcode
|
|
and #$0f
|
|
tay
|
|
lda tab_1op_lo,y
|
|
sta Ldfea+1
|
|
lda tab_1op_hi,y
|
|
sta Ldfea+2
|
|
Ldfea: jsr $ffff ; self-modifying code
|
|
jmp main_loop
|
|
|
|
|
|
; unreferenced - was used in e.g. ZIP interpreter F
|
|
int_err_03:
|
|
lda #$03
|
|
jmp int_error
|
|
|
|
|
|
op_00_7f:
|
|
; check type of first arg
|
|
and #$40
|
|
bne .fwd1
|
|
|
|
; first arg is immediate byte
|
|
sta arg1+1 ; A contains zero
|
|
fetch_pc_byte_inline
|
|
sta arg1
|
|
inc argcnt
|
|
jmp .fwd2
|
|
|
|
.fwd1:
|
|
; first arg is a variable
|
|
jsr Se089
|
|
jsr Se066 ; store acc in arg1 and increment argcnt
|
|
|
|
.fwd2:
|
|
; check type of second arg
|
|
lda opcode
|
|
and #$20
|
|
bne .fwd3
|
|
|
|
; second arg is immediate byte
|
|
sta arg2+1 ; A contains zero
|
|
fetch_pc_byte_inline
|
|
sta arg2
|
|
jmp .fwd4
|
|
|
|
.fwd3:
|
|
; second arg is variable
|
|
jsr Se089
|
|
lda acc
|
|
sta arg2
|
|
lda acc+1
|
|
sta arg2+1
|
|
|
|
.fwd4: inc argcnt
|
|
|
|
dispatch_2op_tab:
|
|
lda opcode
|
|
and #$1f
|
|
tay
|
|
lda tab_2op_lo,y
|
|
sta .jsr+1
|
|
lda tab_2op_hi,y
|
|
sta .jsr+2
|
|
.jsr: jsr $ffff ; self-modifying code
|
|
jmp main_loop
|
|
|
|
|
|
int_err_04:
|
|
lda #$04
|
|
jmp int_error
|
|
|
|
|
|
Se066: lda acc
|
|
sta arg1
|
|
lda acc+1
|
|
sta arg1+1
|
|
inc argcnt
|
|
rts
|
|
|
|
|
|
Se071: lda #$00
|
|
beq Le078 ; always taken
|
|
|
|
Se075: jsr fetch_pc_byte
|
|
Le078: sta acc+1
|
|
jsr fetch_pc_byte
|
|
sta acc
|
|
rts
|
|
|
|
|
|
Se080: tax
|
|
bne Le08e
|
|
jsr pop_acc
|
|
jmp push_acc
|
|
|
|
Se089: jsr fetch_pc_byte
|
|
beq pop_acc
|
|
Le08e: cmp #$10
|
|
bcs Le09f
|
|
asl
|
|
tax
|
|
lda local_vars-2,x
|
|
sta acc
|
|
lda local_vars-1,x
|
|
sta acc+1
|
|
rts
|
|
|
|
Le09f: jsr Se14b
|
|
lda (Z6d),y
|
|
sta acc+1
|
|
iny
|
|
lda (Z6d),y
|
|
sta acc
|
|
rts
|
|
|
|
|
|
op_pop:
|
|
pop_acc:
|
|
lda stk_ptr
|
|
bne .fwd1
|
|
sta stk_ptr+1
|
|
.fwd1: dec stk_ptr
|
|
bne .fwd2
|
|
ora stk_ptr+1
|
|
beq int_err_05 ; data stack underflow
|
|
.fwd2: ldy stk_ptr
|
|
lda stk_ptr+1
|
|
beq .fwd3
|
|
lda D0e56,y
|
|
sta acc
|
|
tax
|
|
lda D1056,y
|
|
sta acc+1
|
|
rts
|
|
|
|
.fwd3: lda D0d56,y
|
|
sta acc
|
|
tax
|
|
lda D0f56,y
|
|
sta acc+1
|
|
rts
|
|
|
|
|
|
int_err_05:
|
|
lda #$05
|
|
jmp int_error
|
|
|
|
|
|
push_acc:
|
|
ldx acc
|
|
lda acc+1
|
|
|
|
; push word in A:X onto data stack
|
|
push_ax:
|
|
pha
|
|
ldy stk_ptr
|
|
lda stk_ptr+1
|
|
beq .fwd1
|
|
|
|
if iver==iver2a
|
|
tax ; wrong! how did this ever work at all?
|
|
else
|
|
txa
|
|
endif
|
|
sta D0e56,y
|
|
pla
|
|
sta D1056,y
|
|
jmp .fwd2
|
|
|
|
.fwd1: txa
|
|
sta D0d56,y
|
|
pla
|
|
sta D0f56,y
|
|
.fwd2: inc stk_ptr
|
|
bne .fwd3
|
|
lda stk_ptr
|
|
ora stk_ptr+1
|
|
bne int_err_06 ; data stack overflow
|
|
inc stk_ptr+1
|
|
.fwd3: rts
|
|
|
|
|
|
int_err_06:
|
|
lda #$06
|
|
jmp int_error
|
|
|
|
|
|
Le10d: tax
|
|
bne Le12d
|
|
lda stk_ptr
|
|
bne .fwd1
|
|
sta stk_ptr+1
|
|
.fwd1: dec stk_ptr
|
|
bne push_acc
|
|
ora stk_ptr+1
|
|
beq int_err_05
|
|
bne push_acc ; always taken
|
|
|
|
|
|
; store a zero result into variable (or stack) designated by next byte of program
|
|
store_result_zero:
|
|
lda #$00
|
|
ldx #$00
|
|
|
|
; store result in X:A into acc and variable (or stack) designated by next byte of program
|
|
store_result_xa:
|
|
sta acc
|
|
stx acc+1
|
|
|
|
; store result in acc into variable (or stack) designated by next byte of program
|
|
store_result:
|
|
jsr fetch_pc_byte
|
|
beq push_acc
|
|
Le12d: cmp #$10
|
|
bcs .fwd2
|
|
|
|
; store result in acc into local variable specified by A
|
|
asl
|
|
tax
|
|
lda acc
|
|
sta local_vars-2,x
|
|
lda acc+1
|
|
sta local_vars-1,x
|
|
rts
|
|
|
|
; store result in acc into global variable specified by A (offset by $10)
|
|
.fwd2: jsr Se14b
|
|
lda acc+1
|
|
sta (Z6d),y
|
|
iny
|
|
lda acc
|
|
sta (Z6d),y
|
|
rts
|
|
|
|
|
|
Se14b: sec
|
|
sbc #$10
|
|
ldy #$00
|
|
sty Z6e
|
|
asl
|
|
rol Z6e
|
|
clc
|
|
adc Z83
|
|
sta Z6d
|
|
lda Z6e
|
|
adc Z84
|
|
sta Z6e
|
|
Le160: rts
|
|
|
|
|
|
predicate_false:
|
|
jsr fetch_pc_byte
|
|
bpl Le172
|
|
Le166: and #$40
|
|
bne Le160
|
|
jmp fetch_pc_byte
|
|
|
|
|
|
predicate_true:
|
|
jsr fetch_pc_byte
|
|
bpl Le166
|
|
Le172: tax
|
|
and #$40
|
|
beq .fwd1
|
|
txa
|
|
and #$3f
|
|
sta acc
|
|
lda #$00
|
|
sta acc+1
|
|
beq .fwd3 ; always taken
|
|
|
|
.fwd1: txa
|
|
and #$3f
|
|
tax
|
|
and #$20
|
|
beq .fwd2
|
|
txa
|
|
ora #$e0
|
|
tax
|
|
.fwd2: stx acc+1
|
|
jsr fetch_pc_byte
|
|
sta acc
|
|
lda acc+1
|
|
bne Le1a7
|
|
.fwd3: lda acc
|
|
bne .fwd4
|
|
jmp op_rfalse
|
|
|
|
.fwd4: cmp #$01
|
|
bne Le1a7
|
|
jmp op_rtrue
|
|
|
|
Le1a7: lda acc
|
|
sec
|
|
sbc #$02
|
|
tax
|
|
lda acc+1
|
|
sbc #$00
|
|
sta Z6d
|
|
ldy #$00
|
|
sty Z6e
|
|
asl
|
|
rol Z6e
|
|
asl
|
|
rol Z6e
|
|
txa
|
|
adc pc
|
|
bcc .fwd5
|
|
inc Z6d
|
|
bne .fwd5
|
|
inc Z6e
|
|
.fwd5: sta pc
|
|
lda Z6d
|
|
ora Z6e
|
|
beq op_nop
|
|
lda Z6d
|
|
clc
|
|
adc pc+1
|
|
sta pc+1
|
|
lda Z6e
|
|
adc pc+2
|
|
and #$03
|
|
sta pc+2
|
|
jmp find_pc_page
|
|
|
|
|
|
op_nop: rts
|
|
|
|
|
|
Se1e3: lda arg1
|
|
sta acc
|
|
lda arg1+1
|
|
sta acc+1
|
|
rts
|
|
|
|
|
|
; unreferenced - see S1b1d in ZIP revision F
|
|
lda hdr_flags2+1
|
|
ora #$04
|
|
sta hdr_flags2+1
|
|
rts
|
|
|
|
|
|
; 0OP instructions (no operands), opcodes $b0..$bf
|
|
optab_start tab_0op,16
|
|
optab_ent op_rtrue
|
|
optab_ent op_rfalse
|
|
optab_ent op_print ; (literal string)
|
|
optab_ent op_print_ret ; (literal string)
|
|
optab_ent op_nop
|
|
optab_ent op_save
|
|
optab_ent op_restore
|
|
optab_ent op_restart
|
|
optab_ent op_ret_popped
|
|
optab_ent op_pop
|
|
optab_ent op_quit
|
|
optab_ent op_new_line
|
|
optab_ent op_show_status ; [nop, some games might mistakenly use]
|
|
optab_ent op_verify
|
|
optab_ent int_err_02 ; [illegal]
|
|
optab_ent int_err_02 ; [illegal]
|
|
|
|
|
|
; 1OP instructions (one operand), opcodes $80..$af
|
|
optab_start tab_1op,16
|
|
optab_ent op_jz
|
|
optab_ent op_get_sibling
|
|
optab_ent op_get_child
|
|
optab_ent op_get_parent
|
|
optab_ent op_get_prop_len ; get length of property (given addr)
|
|
optab_ent op_inc
|
|
optab_ent op_dec
|
|
optab_ent op_print_addr
|
|
optab_ent op_call_1s
|
|
optab_ent op_remove_obj
|
|
optab_ent op_print_obj
|
|
optab_ent op_ret ; with value
|
|
optab_ent op_jump
|
|
optab_ent op_print_paddr
|
|
optab_ent op_load
|
|
optab_ent op_not
|
|
|
|
|
|
; 2OP instructions (two operand), opcodes $20..$7f
|
|
; The 2OP table is also used for VAR instructions (0-4 operands),
|
|
; opcodes $c0..$df
|
|
optab_start tab_2op,32
|
|
optab_ent int_err_04 ; [illegal]
|
|
optab_ent op_je
|
|
optab_ent op_jl
|
|
optab_ent op_jg
|
|
optab_ent op_dec_chk
|
|
optab_ent op_inc_chk
|
|
optab_ent op_jin ; jump if object a is direct child of object b
|
|
optab_ent op_test ; (bitmap)
|
|
optab_ent op_or
|
|
optab_ent op_and
|
|
optab_ent op_test_attr
|
|
optab_ent op_set_attr
|
|
optab_ent op_clear_attr
|
|
optab_ent op_store
|
|
optab_ent op_insert_obj
|
|
optab_ent op_loadw
|
|
optab_ent op_loadb
|
|
optab_ent op_get_prop
|
|
optab_ent op_get_prop_addr
|
|
optab_ent op_get_next_prop
|
|
optab_ent op_add
|
|
optab_ent op_sub
|
|
optab_ent op_mul
|
|
optab_ent op_div
|
|
optab_ent op_mod
|
|
optab_ent op_call_2s
|
|
optab_ent int_err_04 ; [illegal]
|
|
optab_ent int_err_04 ; [illegal]
|
|
optab_ent int_err_04 ; [illegal]
|
|
optab_ent int_err_04 ; [illegal]
|
|
optab_ent int_err_04 ; [illegal]
|
|
optab_ent int_err_04 ; [illegal]
|
|
|
|
|
|
; VAR instructions (0-4 operands, 0-8 for call_vs2),
|
|
; opcodes $e0..$ff
|
|
optab_start tab_var,32
|
|
optab_ent op_call_vs ; (up to 3 args)
|
|
optab_ent op_storew
|
|
optab_ent op_storeb
|
|
optab_ent op_put_prop
|
|
optab_ent op_sread
|
|
optab_ent op_print_char
|
|
optab_ent op_print_num
|
|
optab_ent op_random
|
|
optab_ent op_push
|
|
optab_ent op_pull
|
|
optab_ent op_split_window
|
|
optab_ent op_set_window
|
|
optab_ent op_call_vs2 ; (up to 7 args)
|
|
optab_ent op_erase_window
|
|
optab_ent op_erase_line
|
|
optab_ent op_set_cursor
|
|
optab_ent op_get_cursor ; [nop]
|
|
optab_ent op_set_text_state
|
|
optab_ent op_buffer_mode
|
|
optab_ent op_output_stream
|
|
optab_ent op_input_stream ; [nop]
|
|
optab_ent op_sound_effect
|
|
optab_ent op_read_char
|
|
optab_ent op_scan_table
|
|
optab_ent int_err_01
|
|
optab_ent int_err_01
|
|
optab_ent int_err_01
|
|
optab_ent int_err_01
|
|
optab_ent int_err_01
|
|
optab_ent int_err_01
|
|
optab_ent int_err_01
|
|
optab_ent int_err_01
|
|
|
|
|
|
op_rtrue:
|
|
ldx #$01
|
|
Le2b7: lda #$00
|
|
Le2b9: stx arg1
|
|
sta arg1+1
|
|
jmp op_ret
|
|
|
|
op_rfalse:
|
|
ldx #$00
|
|
beq Le2b7
|
|
|
|
|
|
op_print:
|
|
ldx #$05
|
|
.loop1: lda pc,x
|
|
sta aux_ptr,x
|
|
dex
|
|
bpl .loop1
|
|
jsr Sef7e
|
|
ldx #$05
|
|
.loop2: lda aux_ptr,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 pop_acc
|
|
jmp Le2b9
|
|
|
|
|
|
op_verify:
|
|
jsr op_new_line
|
|
ldx #$03
|
|
lda #$00
|
|
if iver>=iver2b
|
|
sta Zd7
|
|
endif
|
|
.loop1: sta Z71,x
|
|
sta aux_ptr,x
|
|
dex
|
|
bpl .loop1
|
|
lda #$40
|
|
sta aux_ptr
|
|
lda hdr_length
|
|
sta Z6e
|
|
lda hdr_length+1
|
|
asl
|
|
rol Z6e
|
|
rol Z71
|
|
asl
|
|
sta Z6d
|
|
rol Z6e
|
|
rol Z71
|
|
lda #$00
|
|
sta disk_block_num
|
|
sta disk_block_num+1
|
|
jmp .fwd1
|
|
|
|
.loop2: lda aux_ptr
|
|
bne .fwd2
|
|
.fwd1: lda #$09
|
|
sta Zb3
|
|
lda #$00
|
|
sta Ded07
|
|
jsr Sd51d
|
|
|
|
if iver>=iver2b
|
|
lda Zd7
|
|
bne .fwd2
|
|
lda Ze7
|
|
cmp #$02
|
|
bne .fwd2
|
|
prt_msg_alt be_patient
|
|
inc Zd7
|
|
endif
|
|
|
|
.fwd2: ldy aux_ptr
|
|
lda rwts_data_buf,y
|
|
inc aux_ptr
|
|
bne .fwd3
|
|
inc aux_ptr+1
|
|
bne .fwd3
|
|
inc aux_ptr+2
|
|
.fwd3: clc
|
|
adc Z73
|
|
sta Z73
|
|
bcc .fwd4
|
|
inc Z74
|
|
.fwd4: lda aux_ptr
|
|
cmp Z6d
|
|
bne .loop2
|
|
lda aux_ptr+1
|
|
cmp Z6e
|
|
bne .loop2
|
|
lda aux_ptr+2
|
|
cmp Z71
|
|
bne .loop2
|
|
lda hdr_checksum+1
|
|
cmp Z73
|
|
bne .rtn_f
|
|
lda hdr_checksum
|
|
cmp Z74
|
|
bne .rtn_f
|
|
jmp predicate_true
|
|
|
|
.rtn_f: jmp predicate_false
|
|
|
|
|
|
if iver>=iver2b
|
|
msg_be_patient:
|
|
fcb char_cr
|
|
text_str "Please be patient, this takes a while"
|
|
fcb char_cr
|
|
msg_len_be_patient equ *-msg_be_patient
|
|
endif
|
|
|
|
|
|
op_jz: lda arg1
|
|
ora arg1+1
|
|
beq Le394
|
|
Le36c: jmp predicate_false
|
|
|
|
|
|
op_get_sibling:
|
|
lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
ldy #$08
|
|
bne Le383 ; always taken
|
|
|
|
|
|
op_get_child:
|
|
lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
ldy #$0a
|
|
Le383: lda (Z6d),y
|
|
tax
|
|
iny
|
|
lda (Z6d),y
|
|
jsr store_result_xa
|
|
lda acc
|
|
bne Le394
|
|
lda acc+1
|
|
beq Le36c
|
|
Le394: jmp predicate_true
|
|
|
|
|
|
op_get_parent:
|
|
lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
ldy #$06
|
|
lda (Z6d),y
|
|
tax
|
|
iny
|
|
lda (Z6d),y
|
|
jmp store_result_xa
|
|
|
|
|
|
op_get_prop_len:
|
|
lda arg1+1
|
|
clc
|
|
adc Z81
|
|
sta Z6e
|
|
lda arg1
|
|
sec
|
|
sbc #$01
|
|
sta Z6d
|
|
bcs .fwd1
|
|
dec Z6e
|
|
.fwd1: ldy #$00
|
|
lda (Z6d),y
|
|
bmi .fwd3
|
|
and #$40
|
|
beq .fwd2
|
|
lda #$02
|
|
bne .fwd4
|
|
.fwd2: lda #$01
|
|
bne .fwd4
|
|
.fwd3: and #$3f
|
|
.fwd4: ldx #$00
|
|
jmp store_result_xa
|
|
|
|
|
|
op_inc: lda arg1
|
|
jsr Se080
|
|
inc acc
|
|
bne .fwd1
|
|
inc acc+1
|
|
.fwd1: jmp Le3f4
|
|
|
|
|
|
op_dec: lda arg1
|
|
jsr Se080
|
|
lda acc
|
|
sec
|
|
sbc #$01
|
|
sta acc
|
|
lda acc+1
|
|
sbc #$00
|
|
sta acc+1
|
|
Le3f4: lda arg1
|
|
jmp Le10d
|
|
|
|
|
|
op_print_addr:
|
|
lda arg1
|
|
sta Z6d
|
|
lda arg1+1
|
|
sta Z6e
|
|
jsr Secf8
|
|
jmp Sef7e
|
|
|
|
|
|
op_remove_obj:
|
|
lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
lda Z6d
|
|
sta Z6f
|
|
lda Z6e
|
|
sta Z70
|
|
ldy #$07
|
|
lda (Z6d),y
|
|
sta Z71
|
|
dey
|
|
lda (Z6d),y
|
|
tax
|
|
lda Z71
|
|
ora (Z6d),y
|
|
beq .rtn
|
|
lda Z71
|
|
jsr setup_object
|
|
ldy #$0a
|
|
lda (Z6d),y
|
|
tax
|
|
iny
|
|
lda (Z6d),y
|
|
cmp arg1
|
|
bne .loop1
|
|
cpx arg1+1
|
|
bne .loop1
|
|
ldy #$08
|
|
lda (Z6f),y
|
|
iny
|
|
iny
|
|
sta (Z6d),y
|
|
dey
|
|
lda (Z6f),y
|
|
iny
|
|
iny
|
|
sta (Z6d),y
|
|
bne .fwd1
|
|
.loop1: jsr setup_object
|
|
ldy #$08
|
|
lda (Z6d),y
|
|
tax
|
|
iny
|
|
lda (Z6d),y
|
|
cmp arg1
|
|
bne .loop1
|
|
cpx arg1+1
|
|
bne .loop1
|
|
ldy #$08
|
|
lda (Z6f),y
|
|
sta (Z6d),y
|
|
iny
|
|
lda (Z6f),y
|
|
sta (Z6d),y
|
|
.fwd1: lda #$00
|
|
ldy #$06
|
|
sta (Z6f),y
|
|
iny
|
|
sta (Z6f),y
|
|
iny
|
|
sta (Z6f),y
|
|
iny
|
|
sta (Z6f),y
|
|
.rtn: rts
|
|
|
|
|
|
op_print_obj:
|
|
lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
ldy #$0c
|
|
lda (Z6d),y
|
|
tax
|
|
iny
|
|
lda (Z6d),y
|
|
sta Z6d
|
|
stx Z6e
|
|
inc Z6d
|
|
bne .fwd1
|
|
inc Z6e
|
|
.fwd1: jsr Secf8
|
|
jmp Sef7e
|
|
|
|
|
|
op_ret: lda Zed
|
|
sta stk_ptr
|
|
lda Zed+1
|
|
sta stk_ptr+1
|
|
jsr pop_acc
|
|
stx Z6e
|
|
txa
|
|
beq .fwd1
|
|
dex
|
|
txa
|
|
asl
|
|
sta Z6d
|
|
|
|
.loop1: jsr pop_acc
|
|
ldy Z6d
|
|
sta local_vars+1,y
|
|
txa
|
|
sta local_vars,y
|
|
dec Z6d
|
|
dec Z6d
|
|
dec Z6e
|
|
bne .loop1
|
|
|
|
.fwd1: jsr pop_acc
|
|
stx pc+1
|
|
sta pc+2
|
|
jsr pop_acc
|
|
sta pc
|
|
jsr pop_acc
|
|
stx Zed
|
|
sta Zed+1
|
|
jsr find_pc_page
|
|
jsr Se1e3
|
|
Le4db: jmp store_result ; self-modifying code - jmp target changed by code at Sf5f9 and Lf67c
|
|
|
|
|
|
op_jump:
|
|
jsr Se1e3
|
|
jmp Le1a7
|
|
|
|
|
|
op_print_paddr:
|
|
lda arg1
|
|
sta Z6d
|
|
lda arg1+1
|
|
sta Z6e
|
|
jsr Sef65
|
|
jmp Sef7e
|
|
|
|
|
|
op_load:
|
|
lda arg1
|
|
jsr Se080
|
|
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 acc
|
|
sta acc+1
|
|
jmp store_result
|
|
|
|
|
|
op_jl: jsr Se1e3
|
|
jmp Le513
|
|
|
|
|
|
op_dec_chk:
|
|
jsr op_dec
|
|
Le513: lda arg2
|
|
sta Z6d
|
|
lda arg2+1
|
|
sta Z6e
|
|
jmp Le53c
|
|
|
|
|
|
op_jg: lda arg1
|
|
sta Z6d
|
|
lda arg1+1
|
|
sta Z6e
|
|
jmp Le534
|
|
|
|
|
|
op_inc_chk:
|
|
jsr op_inc
|
|
lda acc
|
|
sta Z6d
|
|
lda acc+1
|
|
sta Z6e
|
|
Le534: lda arg2
|
|
sta acc
|
|
lda arg2+1
|
|
sta acc+1
|
|
Le53c: lda Z6e
|
|
eor acc+1
|
|
bpl .fwd1
|
|
lda Z6e
|
|
cmp acc+1
|
|
bcc Le583
|
|
jmp predicate_false
|
|
|
|
.fwd1: lda acc+1
|
|
cmp Z6e
|
|
bne .fwd2
|
|
lda acc
|
|
cmp Z6d
|
|
.fwd2: bcc Le583
|
|
jmp predicate_false
|
|
|
|
|
|
; is object ARG1 in (a direct child of) object ARG2?
|
|
op_jin: lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
ldy #$06
|
|
lda (Z6d),y
|
|
cmp arg2+1
|
|
bne Le570
|
|
iny
|
|
lda (Z6d),y
|
|
cmp arg2
|
|
beq Le583
|
|
Le570: jmp predicate_false
|
|
|
|
|
|
op_test:
|
|
lda arg2
|
|
and arg1
|
|
cmp arg2
|
|
bne Le570
|
|
lda arg2+1
|
|
and arg1+1
|
|
cmp arg2+1
|
|
bne Le570
|
|
Le583: 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
|
|
|
|
|
|
op_test_attr:
|
|
jsr setup_attribute
|
|
lda Z72
|
|
and Z70
|
|
sta Z72
|
|
lda Z71
|
|
and Z6f
|
|
ora Z72
|
|
bne Le583
|
|
jmp predicate_false
|
|
|
|
|
|
op_set_attr:
|
|
jsr setup_attribute
|
|
ldy #$00
|
|
lda Z72
|
|
ora Z70
|
|
sta (Z6d),y
|
|
iny
|
|
lda Z71
|
|
ora Z6f
|
|
sta (Z6d),y
|
|
rts
|
|
|
|
|
|
op_clear_attr:
|
|
jsr setup_attribute
|
|
ldy #$00
|
|
lda Z70
|
|
eor #$ff
|
|
and Z72
|
|
sta (Z6d),y
|
|
iny
|
|
lda Z6f
|
|
eor #$ff
|
|
and Z71
|
|
sta (Z6d),y
|
|
rts
|
|
|
|
|
|
op_store:
|
|
lda arg2
|
|
sta acc
|
|
lda arg2+1
|
|
sta acc+1
|
|
lda arg1
|
|
jmp Le10d
|
|
|
|
|
|
op_insert_obj:
|
|
jsr op_remove_obj
|
|
lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
lda Z6d
|
|
sta Z6f
|
|
lda Z6e
|
|
sta Z70
|
|
lda arg2+1
|
|
ldy #$06
|
|
sta (Z6d),y
|
|
tax
|
|
lda arg2
|
|
iny
|
|
sta (Z6d),y
|
|
jsr setup_object
|
|
ldy #$0a
|
|
lda (Z6d),y
|
|
sta Z72
|
|
lda arg1+1
|
|
sta (Z6d),y
|
|
iny
|
|
lda (Z6d),y
|
|
tax
|
|
lda arg1
|
|
sta (Z6d),y
|
|
txa
|
|
ora Z72
|
|
beq .rtn
|
|
txa
|
|
ldy #$09
|
|
sta (Z6f),y
|
|
dey
|
|
lda Z72
|
|
sta (Z6f),y
|
|
.rtn: rts
|
|
|
|
|
|
op_loadw:
|
|
jsr Se643
|
|
jsr fetch_aux_byte
|
|
Le632: sta acc+1
|
|
jsr fetch_aux_byte
|
|
sta acc
|
|
jmp store_result
|
|
|
|
|
|
op_loadb:
|
|
jsr Se647
|
|
lda #$00
|
|
beq Le632
|
|
|
|
|
|
Se643: asl arg2
|
|
rol arg2+1
|
|
|
|
Se647: lda arg2
|
|
clc
|
|
adc arg1
|
|
sta aux_ptr
|
|
lda arg2+1
|
|
adc arg1+1
|
|
sta aux_ptr+1
|
|
lda #$00
|
|
adc #$00
|
|
sta aux_ptr+2
|
|
jmp find_aux_page
|
|
|
|
|
|
op_get_prop:
|
|
jsr Sf1e3
|
|
.loop1: jsr Sf201
|
|
cmp arg2
|
|
beq .fwd2
|
|
bcc .fwd1
|
|
jsr Sf230
|
|
jmp .loop1
|
|
|
|
.fwd1: lda arg2
|
|
sec
|
|
sbc #$01
|
|
asl
|
|
tay
|
|
lda (Z89),y
|
|
sta acc+1
|
|
iny
|
|
lda (Z89),y
|
|
sta acc
|
|
jmp store_result
|
|
|
|
.fwd2: jsr Sf206
|
|
iny
|
|
cmp #$01
|
|
beq .fwd3
|
|
cmp #$02
|
|
beq .fwd4
|
|
|
|
lda #$07
|
|
jmp int_error
|
|
|
|
.fwd3: lda (Z6d),y
|
|
ldx #$00
|
|
beq .fwd5 ; always taken
|
|
|
|
.fwd4: lda (Z6d),y
|
|
tax
|
|
iny
|
|
lda (Z6d),y
|
|
.fwd5: sta acc
|
|
stx acc+1
|
|
jmp store_result
|
|
|
|
|
|
op_get_prop_addr:
|
|
if iver==iver2a
|
|
|
|
jsr Sf1e3
|
|
.loop1: jsr Sf201
|
|
cmp arg2
|
|
beq .fwd1
|
|
bcc Le6ce
|
|
jsr Sf230
|
|
jmp .loop1
|
|
|
|
.fwd1: jsr Sf206
|
|
|
|
else
|
|
|
|
lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
ldy #$0c
|
|
lda (Z6d),Y
|
|
clc
|
|
adc Z81
|
|
tax
|
|
iny
|
|
lda (Z6d),Y
|
|
sta Z6d
|
|
stx Z6e
|
|
ldy #$00
|
|
lda (Z6d),Y
|
|
asl
|
|
tay
|
|
iny
|
|
.loop2b:
|
|
lda (Z6d),Y
|
|
and #$3f
|
|
cmp arg2
|
|
beq .fwd8b
|
|
bcs .fwd2b
|
|
jmp Le6ce
|
|
|
|
.fwd2b: lda (Z6d),Y
|
|
and #$80
|
|
beq .fwd3b
|
|
iny
|
|
lda (Z6d),Y
|
|
and #$3f
|
|
jmp .fwd5b
|
|
|
|
.fwd3b: lda (Z6d),Y
|
|
and #$40
|
|
beq .fwd4b
|
|
lda #$02
|
|
jmp .fwd5b
|
|
|
|
.fwd4b: lda #$01
|
|
.fwd5b: tax
|
|
.loop3b:
|
|
iny
|
|
bne .fwd6b
|
|
inc Z6e
|
|
.fwd6b: dex
|
|
bne .loop3b
|
|
iny
|
|
tya
|
|
clc
|
|
adc Z6d
|
|
sta Z6d
|
|
bcc .fwd7b
|
|
inc Z6e
|
|
.fwd7b: ldy #$00
|
|
jmp .loop2b
|
|
|
|
.fwd8b: lda (Z6d),Y
|
|
and #$80
|
|
beq .fwd9b
|
|
iny
|
|
lda (Z6d),Y
|
|
and #$3f
|
|
jmp .fwd11b
|
|
|
|
.fwd9b: lda (Z6d),Y
|
|
and #$40
|
|
beq .fwd10b
|
|
lda #$02
|
|
jmp .fwd11b
|
|
|
|
.fwd10b:
|
|
lda #$01
|
|
.fwd11b:
|
|
|
|
endif
|
|
|
|
iny
|
|
tya
|
|
clc
|
|
adc Z6d
|
|
sta acc
|
|
lda Z6e
|
|
adc #$00
|
|
sec
|
|
sbc Z81
|
|
sta acc+1
|
|
jmp store_result
|
|
|
|
Le6ce: jmp store_result_zero
|
|
|
|
|
|
op_get_next_prop:
|
|
jsr Sf1e3
|
|
lda arg2
|
|
beq .fwd2
|
|
.loop1: jsr Sf201
|
|
cmp arg2
|
|
beq .fwd1
|
|
bcc Le6ce
|
|
jsr Sf230
|
|
jmp .loop1
|
|
|
|
.fwd1: jsr Sf21e
|
|
.fwd2: jsr Sf201
|
|
ldx #$00
|
|
jmp store_result_xa
|
|
|
|
|
|
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 Se7c6
|
|
.loop1: ror Zcc
|
|
ror Zcb
|
|
ror arg2+1
|
|
ror arg2
|
|
bcc .fwd1
|
|
lda arg1
|
|
clc
|
|
adc Zcb
|
|
sta Zcb
|
|
lda arg1+1
|
|
adc Zcc
|
|
sta Zcc
|
|
.fwd1: dex
|
|
bpl .loop1
|
|
ldx arg2
|
|
lda arg2+1
|
|
jmp store_result_ax
|
|
|
|
|
|
op_div:
|
|
jsr divide
|
|
ldx Zc7
|
|
lda Zc7+1
|
|
jmp store_result_ax
|
|
|
|
|
|
op_mod:
|
|
jsr divide
|
|
ldx Zc9
|
|
lda Zc9+1
|
|
jmp store_result_ax
|
|
|
|
|
|
; On exit
|
|
; quotient in Zc7
|
|
; remainder in Zc9
|
|
divide: lda arg1+1
|
|
sta Zce
|
|
eor arg2+1
|
|
sta Zcd
|
|
lda arg1
|
|
sta Zc7
|
|
lda arg1+1
|
|
sta Zc7+1
|
|
bpl .fwd1
|
|
jsr Se782
|
|
.fwd1: lda arg2
|
|
sta Zc9
|
|
lda arg2+1
|
|
sta Zc9+1
|
|
bpl .fwd2
|
|
jsr Se774
|
|
.fwd2: jsr Se790
|
|
lda Zcd
|
|
bpl .fwd3
|
|
jsr Se782
|
|
.fwd3: lda Zce
|
|
bpl Le781
|
|
|
|
|
|
Se774: lda #$00
|
|
sec
|
|
sbc Zc9
|
|
sta Zc9
|
|
lda #$00
|
|
sbc Zc9+1
|
|
sta Zc9+1
|
|
Le781: rts
|
|
|
|
|
|
Se782: lda #$00
|
|
sec
|
|
sbc Zc7
|
|
sta Zc7
|
|
lda #$00
|
|
sbc Zc7+1
|
|
sta Zc7+1
|
|
rts
|
|
|
|
|
|
Se790: lda Zc9
|
|
ora Zc9+1
|
|
beq int_err_08
|
|
jsr Se7c6
|
|
.loop1: rol Zc7
|
|
rol Zc7+1
|
|
rol Zcb
|
|
rol Zcc
|
|
lda Zcb
|
|
sec
|
|
sbc Zc9
|
|
tay
|
|
lda Zcc
|
|
sbc Zc9+1
|
|
bcc .fwd1
|
|
sty Zcb
|
|
sta Zcc
|
|
.fwd1: dex
|
|
bne .loop1
|
|
rol Zc7
|
|
rol Zc7+1
|
|
lda Zcb
|
|
sta Zc9
|
|
lda Zcc
|
|
sta Zc9+1
|
|
rts
|
|
|
|
|
|
int_err_08:
|
|
lda #$08
|
|
jmp int_error
|
|
|
|
|
|
Se7c6: ldx #$10
|
|
lda #$00
|
|
sta Zcb
|
|
sta Zcc
|
|
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
|
|
|
|
|
|
; call instructions that store a result
|
|
op_call_1s
|
|
op_call_2s:
|
|
op_call_vs:
|
|
op_call_vs2:
|
|
lda arg1
|
|
ora arg1+1
|
|
bne .fwd1
|
|
ldx #$00
|
|
jmp store_result_xa
|
|
|
|
.fwd1: ldx Zed
|
|
lda Zed+1
|
|
jsr push_ax
|
|
lda pc
|
|
jsr push_ax
|
|
ldx pc+1
|
|
lda pc+2
|
|
jsr push_ax
|
|
lda #$00
|
|
asl arg1
|
|
rol arg1+1
|
|
rol
|
|
sta pc+2
|
|
asl arg1
|
|
rol arg1+1
|
|
rol pc+2
|
|
lda arg1+1
|
|
sta pc+1
|
|
lda arg1
|
|
sta pc
|
|
jsr find_pc_page
|
|
jsr fetch_pc_byte
|
|
sta Z6f
|
|
sta Z70
|
|
beq .fwd2
|
|
lda #$00
|
|
sta Z6d
|
|
.loop1: ldy Z6d
|
|
ldx local_vars,y
|
|
lda local_vars+1,y
|
|
jsr push_ax
|
|
jsr fetch_pc_byte
|
|
sta Z6e
|
|
jsr fetch_pc_byte
|
|
ldy Z6d
|
|
sta local_vars,y
|
|
lda Z6e
|
|
sta local_vars+1,y
|
|
iny
|
|
iny
|
|
sty Z6d
|
|
dec Z6f
|
|
bne .loop1
|
|
|
|
; if present, copy arg2 through arg8 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
|
|
dec argcnt
|
|
beq .fwd3
|
|
|
|
lda arg5
|
|
sta local_vars+6
|
|
lda arg5+1
|
|
sta local_vars+7
|
|
dec argcnt
|
|
beq .fwd3
|
|
|
|
lda arg6
|
|
sta local_vars+8
|
|
lda arg6+1
|
|
sta local_vars+9
|
|
dec argcnt
|
|
beq .fwd3
|
|
|
|
lda arg7
|
|
sta local_vars+10
|
|
lda arg7+1
|
|
sta local_vars+11
|
|
dec argcnt
|
|
beq .fwd3
|
|
|
|
lda arg8
|
|
sta local_vars+12
|
|
lda arg8+1
|
|
sta local_vars+13
|
|
|
|
.fwd3: ldx Z70
|
|
txa
|
|
jsr push_ax
|
|
lda stk_ptr+1
|
|
sta Zed+1
|
|
lda stk_ptr
|
|
sta Zed
|
|
rts
|
|
|
|
|
|
op_storew:
|
|
asl arg2
|
|
rol arg2+1
|
|
jsr Se8f4
|
|
lda arg3+1
|
|
sta (Z6d),y
|
|
iny
|
|
bne Le8ef
|
|
|
|
op_storeb:
|
|
jsr Se8f4
|
|
Le8ef: lda arg3
|
|
sta (Z6d),y
|
|
rts
|
|
|
|
|
|
Se8f4: lda arg2
|
|
clc
|
|
adc arg1
|
|
sta Z6d
|
|
lda arg2+1
|
|
adc arg1+1
|
|
clc
|
|
adc Z81
|
|
sta Z6e
|
|
ldy #$00
|
|
rts
|
|
|
|
|
|
op_put_prop:
|
|
jsr Sf1e3
|
|
.loop1: jsr Sf201
|
|
cmp arg2
|
|
beq .fwd1
|
|
bcc int_err_0a
|
|
jsr Sf230
|
|
jmp .loop1
|
|
|
|
.fwd1: jsr Sf206
|
|
iny
|
|
cmp #$01
|
|
beq .fwd2
|
|
cmp #$02
|
|
bne int_err_0b
|
|
lda arg3+1
|
|
sta (Z6d),y
|
|
iny
|
|
.fwd2: lda arg3
|
|
sta (Z6d),y
|
|
rts
|
|
|
|
|
|
int_err_0a:
|
|
lda #$0a
|
|
jmp int_error
|
|
|
|
|
|
int_err_0b:
|
|
lda #$0b
|
|
jmp int_error
|
|
|
|
|
|
op_print_char:
|
|
lda arg1
|
|
jmp Sf311
|
|
|
|
|
|
op_print_num:
|
|
lda arg1
|
|
sta Zc7
|
|
lda arg1+1
|
|
sta Zc7+1
|
|
lda Zc7+1
|
|
bpl .fwd1
|
|
lda #$2d
|
|
jsr Sf311
|
|
jsr Se782
|
|
.fwd1: lda #$00
|
|
sta Zcf
|
|
.loop1: lda Zc7
|
|
ora Zc7+1
|
|
beq .fwd2
|
|
lda #$0a
|
|
sta Zc9
|
|
lda #$00
|
|
sta Zc9+1
|
|
jsr Se790
|
|
lda Zc9
|
|
pha
|
|
inc Zcf
|
|
bne .loop1
|
|
.fwd2: lda Zcf
|
|
bne .loop2
|
|
lda #$30
|
|
jmp Sf311
|
|
|
|
.loop2: pla
|
|
clc
|
|
adc #$30
|
|
jsr Sf311
|
|
dec Zcf
|
|
bne .loop2
|
|
rts
|
|
|
|
|
|
op_random:
|
|
lda arg1
|
|
ora arg1+1
|
|
bne .fwd1
|
|
sta Ze8
|
|
sta Ze8+1
|
|
jmp store_result_zero
|
|
|
|
.fwd1: lda Ze8
|
|
ora Ze8+1
|
|
bne .fwd3
|
|
lda arg1+1
|
|
bpl .fwd2
|
|
eor #$ff
|
|
sta Ze8+1
|
|
lda arg1
|
|
eor #$ff
|
|
sta Ze8
|
|
inc Ze8
|
|
lda #$00
|
|
sta Zc0
|
|
sta Zc0+1
|
|
beq .fwd3 ; always taken
|
|
|
|
.fwd2: lda arg1
|
|
sta arg2
|
|
lda arg1+1
|
|
sta arg2+1
|
|
jsr Sf2ff
|
|
stx arg1
|
|
and #$7f
|
|
sta arg1+1
|
|
jsr divide
|
|
lda Zc9
|
|
clc
|
|
adc #$01
|
|
sta acc
|
|
lda Zc9+1
|
|
adc #$00
|
|
sta acc+1
|
|
jmp store_result
|
|
|
|
.fwd3:
|
|
if iver>=iver2b
|
|
lda arg1
|
|
sta Ze8
|
|
lda arg1+1
|
|
sta Ze8+1
|
|
endif
|
|
|
|
lda Zc0+1
|
|
cmp Ze8+1
|
|
bcc .fwd4
|
|
lda Zc0
|
|
cmp Ze8
|
|
bcc .fwd4
|
|
beq .fwd4
|
|
lda #$01
|
|
sta Zc0
|
|
lda #$00
|
|
sta Zc0+1
|
|
.fwd4: lda Zc0
|
|
sta acc
|
|
lda Zc0+1
|
|
sta acc+1
|
|
inc Zc0
|
|
bne .fwd5
|
|
inc Zc0+1
|
|
.fwd5: jmp store_result
|
|
|
|
|
|
op_push:
|
|
ldx arg1
|
|
lda arg1+1
|
|
jmp push_ax
|
|
|
|
|
|
op_pull:
|
|
jsr pop_acc
|
|
lda arg1
|
|
jmp Le10d
|
|
|
|
|
|
op_scan_table:
|
|
lda arg2
|
|
sta aux_ptr
|
|
lda arg2+1
|
|
sta aux_ptr+1
|
|
lda #$00
|
|
sta aux_ptr+2
|
|
jsr find_aux_page
|
|
.loop1: jsr fetch_aux_byte
|
|
sta Z6e
|
|
jsr fetch_aux_byte
|
|
cmp arg1
|
|
bne .fwd1
|
|
lda Z6e
|
|
cmp arg1+1
|
|
beq .fwd2
|
|
.fwd1: dec arg3
|
|
bne .loop1
|
|
lda arg3+1
|
|
beq .fwd4
|
|
dec arg3+1
|
|
jmp .loop1
|
|
|
|
.fwd2: sec
|
|
lda aux_ptr
|
|
if iver<=iver2c
|
|
sbc #$01
|
|
else
|
|
sbc #$02
|
|
endif
|
|
sta aux_ptr
|
|
bcs .fwd3
|
|
dec aux_ptr+1
|
|
.fwd3: sta acc
|
|
lda aux_ptr+1
|
|
sta acc+1
|
|
jsr store_result
|
|
jmp predicate_true
|
|
|
|
.fwd4: lda #$00
|
|
sta acc
|
|
sta acc+1
|
|
jsr store_result
|
|
jmp predicate_false
|
|
|
|
|
|
op_sread:
|
|
lda arg1+1
|
|
clc
|
|
adc Z81
|
|
sta Zc4
|
|
lda arg1
|
|
sta Zc3
|
|
lda arg2+1
|
|
clc
|
|
adc Z81
|
|
sta Zc6
|
|
lda arg2
|
|
sta Zc5
|
|
ldy #$00
|
|
lda (Zc3),y
|
|
cmp #$4f
|
|
bcc .fwd1
|
|
lda #$4e
|
|
.fwd1: sta Zbe
|
|
jsr Sdafe
|
|
sta Z9f
|
|
lda #$00
|
|
sta Za0
|
|
ldy #$01
|
|
sta (Zc5),y
|
|
sty Z9d
|
|
iny
|
|
sty Z9e
|
|
.loop1: ldy #$00
|
|
lda (Zc5),y
|
|
beq .fwd2
|
|
|
|
if iver==iver2a
|
|
cmp #$3c
|
|
else
|
|
cmp #$3b
|
|
endif
|
|
|
|
bcc .fwd3
|
|
|
|
.fwd2:
|
|
if iver==iver2a
|
|
lda #$3b
|
|
else
|
|
lda #$3a
|
|
endif
|
|
|
|
sta (Zc5),y
|
|
.fwd3: iny
|
|
cmp (Zc5),y
|
|
bcc .rtn
|
|
lda Z9f
|
|
ora Za0
|
|
bne .fwd4
|
|
.rtn: rts
|
|
|
|
.fwd4: lda Za0
|
|
cmp #$09
|
|
bcc .fwd5
|
|
jsr Seb3e
|
|
.fwd5: lda Za0
|
|
bne .fwd6
|
|
ldx #$08
|
|
.loop2: sta Z8b,x
|
|
dex
|
|
bpl .loop2
|
|
jsr Seb30
|
|
lda Z9d
|
|
ldy #$03
|
|
sta (Za1),y
|
|
tay
|
|
lda (Zc3),y
|
|
jsr Seb6b
|
|
bcs .fwd7
|
|
jsr Seb5f
|
|
bcc .fwd6
|
|
inc Z9d
|
|
dec Z9f
|
|
jmp .loop1
|
|
|
|
.fwd6: lda Z9f
|
|
beq .fwd8
|
|
ldy Z9d
|
|
lda (Zc3),y
|
|
jsr Seb5a
|
|
bcs .fwd8
|
|
ldx Za0
|
|
sta Z8b,x
|
|
dec Z9f
|
|
inc Za0
|
|
inc Z9d
|
|
jmp .loop1
|
|
|
|
.fwd7: sta Z8b
|
|
dec Z9f
|
|
inc Za0
|
|
inc Z9d
|
|
.fwd8: lda Za0
|
|
beq .loop1
|
|
jsr Seb30
|
|
lda Za0
|
|
ldy #$02
|
|
sta (Za1),y
|
|
jsr Sf0ac
|
|
jsr Seb96
|
|
ldy #$01
|
|
lda (Zc5),y
|
|
clc
|
|
adc #$01
|
|
sta (Zc5),y
|
|
jsr Seb30
|
|
ldy #$00
|
|
sty Za0
|
|
lda acc+1
|
|
sta (Za1),y
|
|
iny
|
|
lda acc
|
|
sta (Za1),y
|
|
lda Z9e
|
|
clc
|
|
adc #$04
|
|
sta Z9e
|
|
jmp .loop1
|
|
|
|
|
|
Seb30: lda Zc5
|
|
clc
|
|
adc Z9e
|
|
sta Za1
|
|
lda Zc6
|
|
adc #$00
|
|
sta Za2
|
|
rts
|
|
|
|
|
|
Seb3e: lda Z9f
|
|
beq .rtn
|
|
ldy Z9d
|
|
lda (Zc3),y
|
|
jsr Seb5a
|
|
bcs .rtn
|
|
dec Z9f
|
|
inc Za0
|
|
inc Z9d
|
|
bne Seb3e
|
|
.rtn: rts
|
|
|
|
|
|
Deb54: fcb $21,$3f,$2c,$2e,$0d,$20 ; "!?,.. "
|
|
|
|
|
|
Seb5a: jsr Seb6b
|
|
bcs Leb94
|
|
|
|
Seb5f: ldx #$05
|
|
.loop1: cmp Deb54,x
|
|
beq Leb94
|
|
dex
|
|
bpl .loop1
|
|
clc
|
|
rts
|
|
|
|
|
|
Seb6b: sta Zd7
|
|
lda hdr_vocab
|
|
ldy hdr_vocab+1
|
|
sta aux_ptr+1
|
|
sty aux_ptr
|
|
lda #$00
|
|
sta aux_ptr+2
|
|
jsr find_aux_page
|
|
jsr fetch_aux_byte
|
|
sta Z6f
|
|
.loop1: jsr fetch_aux_byte
|
|
cmp Zd7
|
|
beq .fwd1
|
|
dec Z6f
|
|
bne .loop1
|
|
lda Zd7
|
|
clc
|
|
rts
|
|
|
|
.fwd1: lda Zd7
|
|
Leb94: sec
|
|
rts
|
|
|
|
|
|
Seb96: lda hdr_vocab
|
|
ldy hdr_vocab+1
|
|
sta aux_ptr+1
|
|
sty aux_ptr
|
|
lda #$00
|
|
sta aux_ptr+2
|
|
jsr find_aux_page
|
|
jsr fetch_aux_byte
|
|
clc
|
|
adc aux_ptr
|
|
sta aux_ptr
|
|
bcc .fwd1
|
|
inc aux_ptr+1
|
|
.fwd1: jsr find_aux_page
|
|
jsr fetch_aux_byte
|
|
sta Za5
|
|
sta Z6d
|
|
lda #$00
|
|
sta Z6e
|
|
sta Z6f
|
|
jsr fetch_aux_byte
|
|
sta Za4
|
|
jsr fetch_aux_byte
|
|
sta Za3
|
|
lda #$00
|
|
sta Zf4
|
|
sta Zf5
|
|
sta Zf6
|
|
ldx Za5
|
|
.loop1: clc
|
|
lda Zf4
|
|
adc Za3
|
|
sta Zf4
|
|
lda Zf5
|
|
adc Za4
|
|
sta Zf5
|
|
lda Zf6
|
|
adc #$00
|
|
sta Zf6
|
|
dex
|
|
bne .loop1
|
|
clc
|
|
lda Zf4
|
|
adc aux_ptr
|
|
sta Zf4
|
|
lda Zf5
|
|
adc aux_ptr+1
|
|
sta Zf5
|
|
lda Zf6
|
|
adc aux_ptr+2
|
|
sta Zf6
|
|
|
|
if iver>=iver2b
|
|
lda Zf4
|
|
sec
|
|
sbc Za5
|
|
sta Zf4
|
|
lda Zf5
|
|
sbc #$00
|
|
sta Zf5
|
|
endif
|
|
|
|
lsr Za4
|
|
ror Za3
|
|
.loop2: asl Z6d
|
|
rol Z6e
|
|
rol Z6f
|
|
lsr Za4
|
|
ror Za3
|
|
bne .loop2
|
|
clc
|
|
lda aux_ptr
|
|
adc Z6d
|
|
sta aux_ptr
|
|
lda aux_ptr+1
|
|
adc Z6e
|
|
sta aux_ptr+1
|
|
lda aux_ptr+2
|
|
adc Z6f
|
|
sta aux_ptr+2
|
|
sec
|
|
lda aux_ptr
|
|
sbc Za5
|
|
sta aux_ptr
|
|
bcs .loop3
|
|
lda aux_ptr+1
|
|
sec
|
|
sbc #$01
|
|
sta aux_ptr+1
|
|
bcs .loop3
|
|
lda aux_ptr+2
|
|
sbc #$00
|
|
sta aux_ptr+2
|
|
.loop3: lsr Z6f
|
|
ror Z6e
|
|
ror Z6d
|
|
lda aux_ptr
|
|
sta Z70
|
|
lda aux_ptr+1
|
|
sta Z71
|
|
lda aux_ptr+2
|
|
sta Z72
|
|
jsr find_aux_page
|
|
jsr fetch_aux_byte
|
|
cmp Z94
|
|
bcc .fwd2
|
|
bne .fwd6
|
|
jsr fetch_aux_byte
|
|
cmp Z95
|
|
bcc .fwd2
|
|
bne .fwd6
|
|
jsr fetch_aux_byte
|
|
cmp Z96
|
|
bcc .fwd2
|
|
bne .fwd6
|
|
jsr fetch_aux_byte
|
|
cmp Z97
|
|
bcc .fwd2
|
|
bne .fwd6
|
|
jsr fetch_aux_byte
|
|
cmp Z98
|
|
bcc .fwd2
|
|
bne .fwd6
|
|
jsr fetch_aux_byte
|
|
cmp Z99
|
|
beq .fwd10
|
|
bcs .fwd6
|
|
.fwd2: lda Z70
|
|
clc
|
|
adc Z6d
|
|
sta aux_ptr
|
|
lda Z71
|
|
adc Z6e
|
|
|
|
if iver==iver2a
|
|
sta aux_ptr+1
|
|
lda Z72
|
|
adc Z6f
|
|
sta aux_ptr+2
|
|
lda aux_ptr+2
|
|
cmp Zf6
|
|
else
|
|
bcs .fwd5
|
|
sta aux_ptr+1
|
|
lda #$00
|
|
sta aux_ptr+2
|
|
lda aux_ptr+1
|
|
cmp Zf5
|
|
endif
|
|
|
|
beq .fwd3
|
|
bcs .fwd5
|
|
bcc .fwd7 ; always taken
|
|
|
|
.fwd3:
|
|
if iver==iver2a
|
|
lda aux_ptr+1
|
|
cmp Zf5
|
|
beq .fwd4
|
|
bcs .fwd5
|
|
bcc .fwd7 ; always taken
|
|
endif
|
|
|
|
.fwd4: lda aux_ptr
|
|
cmp Zf4
|
|
bcc .fwd7
|
|
beq .fwd7
|
|
|
|
.fwd5: lda Zf4
|
|
sta aux_ptr
|
|
lda Zf5
|
|
sta aux_ptr+1
|
|
lda Zf6
|
|
sta aux_ptr+2
|
|
jmp .fwd7
|
|
|
|
.fwd6: lda Z70
|
|
sec
|
|
sbc Z6d
|
|
sta aux_ptr
|
|
lda Z71
|
|
sbc Z6e
|
|
sta aux_ptr+1
|
|
lda Z72
|
|
sbc Z6f
|
|
sta aux_ptr+2
|
|
.fwd7: lda Z6f
|
|
bne .fwd8
|
|
lda Z6e
|
|
bne .fwd8
|
|
lda Z6d
|
|
cmp Za5
|
|
bcc .fwd9
|
|
.fwd8: jmp .loop3
|
|
|
|
.fwd9: lda #$00
|
|
sta acc
|
|
sta acc+1
|
|
rts
|
|
|
|
.fwd10: lda Z70
|
|
sta acc
|
|
lda Z71
|
|
sta acc+1
|
|
rts
|
|
|
|
|
|
Secf8: lda Z6d
|
|
sta aux_ptr
|
|
lda Z6e
|
|
sta aux_ptr+1
|
|
lda #$00
|
|
sta aux_ptr+2
|
|
jmp find_aux_page
|
|
|
|
|
|
Ded07: fcb $00
|
|
Ded08: fcb $00
|
|
Ded09: fcb $00
|
|
Ded0a: fcb $00
|
|
Ded0b: fcb $00
|
|
Ded0c: fcb $00
|
|
Ded0d: fcb $00
|
|
Ded0e: fcb $00
|
|
Ded0f: fcb $00
|
|
Ded10: fcb $00
|
|
Ded11: fcb $00
|
|
Ded12: fcb $00
|
|
|
|
|
|
Led13: lda hdr_length+1
|
|
sta Z6f
|
|
lda hdr_length
|
|
ldy #$05
|
|
.loop1: lsr
|
|
ror Z6f
|
|
dey
|
|
bpl .loop1
|
|
sta Z70
|
|
.loop2: jsr Sed72
|
|
bcc .rtn
|
|
jsr Sd51d
|
|
lda Ded07
|
|
cmp #$01
|
|
bne .loop2
|
|
lda Zb3
|
|
|
|
if iver==iver2a
|
|
cmp #$95
|
|
else
|
|
cmp #$96
|
|
endif
|
|
|
|
bne .loop2
|
|
lda #$00
|
|
sta Ded07
|
|
lda #$00
|
|
sta Ded08
|
|
.loop3: lda #$09
|
|
sta Zb3
|
|
jsr Sed72
|
|
bcc .rtn
|
|
jsr Sd51d
|
|
ldy #$09
|
|
lda Ded08
|
|
ldx #$01
|
|
sta rd_main_ram
|
|
jsr S086b
|
|
inc Ded08
|
|
lda Ded08
|
|
cmp #$4f
|
|
bcc .loop3
|
|
jsr home
|
|
lda #$02
|
|
sta cursrv
|
|
jmp Sd87e
|
|
|
|
.rtn: rts
|
|
|
|
|
|
Sed72: lda Z6f
|
|
sec
|
|
sbc #$01
|
|
sta Z6f
|
|
lda Z70
|
|
sbc #$00
|
|
sta Z70
|
|
rts
|
|
|
|
|
|
find_aux_page:
|
|
lda aux_ptr+2
|
|
bne .fwd2
|
|
lda aux_ptr+1
|
|
cmp #max_main_ram_pages
|
|
bcs .fwd1
|
|
adc #hdr_arch>>8
|
|
ldy #$00
|
|
beq .fwd3
|
|
|
|
.fwd1:
|
|
; FIXME - not sure how the $a5/$a6 is determined
|
|
if iver==iver2a
|
|
sbc #$a6
|
|
else
|
|
sbc #$a5
|
|
endif
|
|
|
|
ldy #$01
|
|
bne .fwd3
|
|
.fwd2: cmp #$01
|
|
bne .fwd4
|
|
lda aux_ptr+1
|
|
cmp #$3b
|
|
bcs .fwd4
|
|
|
|
; FIXME - not sure how the $5a/$5b is determined
|
|
if iver==iver2a
|
|
adc #$5a
|
|
else
|
|
adc #$5b
|
|
endif
|
|
|
|
ldy #$01
|
|
.fwd3: sty aux_phys_page+2
|
|
sta aux_phys_page+1
|
|
.rtn: rts
|
|
|
|
.fwd4: lda aux_ptr+2
|
|
ldy aux_ptr+1
|
|
jsr find_page
|
|
clc
|
|
|
|
; FIXME - not sure how the $95/$96 is determined
|
|
if iver==iver2a
|
|
adc #$95
|
|
else
|
|
adc #$96
|
|
endif
|
|
|
|
sta aux_phys_page+1
|
|
ldy #$01
|
|
sty aux_phys_page+2
|
|
lda Dee02
|
|
beq .rtn
|
|
jmp find_pc_page ; unnecessary, could just fall through
|
|
|
|
|
|
find_pc_page:
|
|
lda pc+2
|
|
bne .fwd2
|
|
lda pc+1
|
|
cmp #max_main_ram_pages
|
|
bcs .fwd1
|
|
adc #hdr_arch>>8
|
|
ldy #$00
|
|
beq .fwd3 ; always taken
|
|
|
|
.fwd1:
|
|
; FIXME - not sure how the $a5/$a6 is determined
|
|
if iver==iver2a
|
|
sbc #$a6
|
|
else
|
|
sbc #$a5
|
|
endif
|
|
|
|
ldy #$01
|
|
bne .fwd3 ; always taken
|
|
|
|
.fwd2: cmp #$01
|
|
bne .fwd4
|
|
lda pc+1
|
|
cmp #$3b
|
|
bcs .fwd4
|
|
|
|
; FIXME - not sure how the $5a/$5b is determined
|
|
if iver==iver2a
|
|
adc #$5a
|
|
else
|
|
adc #$5b
|
|
endif
|
|
|
|
ldy #$01
|
|
.fwd3: sty pc_phys_page+2
|
|
sta pc_phys_page+1
|
|
.rtn: rts
|
|
|
|
.fwd4: lda pc+2
|
|
ldy pc+1
|
|
jsr find_page
|
|
clc
|
|
|
|
; FIXME - not sure how the $95/$96 is determined
|
|
if iver==iver2a
|
|
adc #$95
|
|
else
|
|
adc #$96
|
|
endif
|
|
|
|
sta pc_phys_page+1
|
|
ldy #$01
|
|
sty pc_phys_page+2
|
|
lda Dee02
|
|
beq .rtn
|
|
jmp find_aux_page
|
|
|
|
|
|
Dee02: fcb $00
|
|
|
|
|
|
find_page:
|
|
sta Ded0a
|
|
sty Ded09
|
|
ldx #$00
|
|
stx Dee02
|
|
jsr Seed7
|
|
bcc .fwd1
|
|
ldx Ded0b
|
|
lda D0b56,x
|
|
sta Ded0b
|
|
tax
|
|
lda Ded0a
|
|
sta D0c56,x
|
|
lda Ded09
|
|
sta D0cd6,x
|
|
tay
|
|
txa
|
|
pha
|
|
lda Ded0a
|
|
jsr fetch_page
|
|
dec Dee02
|
|
pla
|
|
rts
|
|
|
|
.fwd1: sta Ded0c
|
|
cmp Ded0b
|
|
bne .fwd2
|
|
rts
|
|
|
|
.fwd2: ldy Ded0b
|
|
lda D0b56,y
|
|
sta Ded0f
|
|
lda Ded0c
|
|
jsr Seeb9
|
|
ldy Ded0b
|
|
lda Ded0c
|
|
jsr See93
|
|
lda Ded0c
|
|
sta Ded0b
|
|
rts
|
|
|
|
|
|
fetch_page:
|
|
cmp #$01
|
|
bcc .fwd2
|
|
bne .fwd1
|
|
cpy #$8a
|
|
bcc .fwd2
|
|
.fwd1: sta disk_block_num+1
|
|
sty disk_block_num
|
|
txa
|
|
clc
|
|
|
|
; FIXME - not sure how the $95/$96 is determined
|
|
if iver==iver2a
|
|
adc #$95
|
|
else
|
|
adc #$96
|
|
endif
|
|
|
|
sta Zb3
|
|
ldx #$01
|
|
stx Ded07
|
|
jmp Sd51d
|
|
|
|
.fwd2: tya
|
|
sec
|
|
sbc #$3b
|
|
pha
|
|
txa
|
|
clc
|
|
|
|
if iver==iver2a
|
|
adc #$95
|
|
else
|
|
adc #$96
|
|
endif
|
|
|
|
tay
|
|
sta rd_main_ram
|
|
ldx #$01
|
|
stx D086a
|
|
ldx #$00
|
|
pla
|
|
jmp S086b
|
|
|
|
|
|
See93: sta Ded11
|
|
sty Ded10
|
|
tax
|
|
tya
|
|
sta D0bd6,x
|
|
lda D0b56,y
|
|
sta Ded12
|
|
txa
|
|
ldx Ded12
|
|
sta D0bd6,x
|
|
txa
|
|
ldx Ded11
|
|
sta D0b56,x
|
|
lda Ded11
|
|
sta D0b56,y
|
|
rts
|
|
|
|
|
|
Seeb9: tax
|
|
lda D0b56,x
|
|
sta Ded0d
|
|
lda D0bd6,x
|
|
sta Ded0e
|
|
tax
|
|
lda Ded0d
|
|
sta D0b56,x
|
|
lda Ded0e
|
|
ldx Ded0d
|
|
sta D0bd6,x
|
|
rts
|
|
|
|
|
|
Seed7:
|
|
; FIXME - not sure how the $2a/$29 is determined
|
|
if iver==iver2a
|
|
ldx #$2a
|
|
else
|
|
ldx #$29
|
|
endif
|
|
|
|
.loop1: lda Ded0a
|
|
cmp D0c56,x
|
|
beq .fwd1
|
|
.loop2: dex
|
|
bpl .loop1
|
|
sec
|
|
rts
|
|
|
|
.fwd1: tya
|
|
cmp D0cd6,x
|
|
bne .loop2
|
|
txa
|
|
clc
|
|
rts
|
|
|
|
|
|
Seeef:
|
|
; FIXME - not sure how the $2a/$29 is determined
|
|
if iver==iver2a
|
|
ldx #$2a
|
|
else
|
|
ldx #$29
|
|
endif
|
|
|
|
stx Ded0b
|
|
lda #$ff
|
|
.loop1: sta D0c56,x
|
|
dex
|
|
bpl .loop1
|
|
ldx #$00
|
|
ldy #$01
|
|
.loop2: tya
|
|
sta D0bd6,x
|
|
inx
|
|
iny
|
|
|
|
; FIXME - not sure how the $2b/$2a is determined
|
|
if iver==iver2a
|
|
cpx #$2b
|
|
else
|
|
cpx #$2a
|
|
endif
|
|
|
|
bcc .loop2
|
|
lda #$00
|
|
dex
|
|
sta D0bd6,x
|
|
ldx #$00
|
|
ldy #$ff
|
|
|
|
if iver==iver2a
|
|
lda #$2a
|
|
else
|
|
lda #$29
|
|
endif
|
|
|
|
.loop3: sta D0b56,x
|
|
inx
|
|
iny
|
|
tya
|
|
|
|
if iver==iver2a
|
|
cpx #$2b
|
|
else
|
|
cpx #$2a
|
|
endif
|
|
|
|
bcc .loop3
|
|
jmp Led13
|
|
|
|
|
|
Sef23: pha
|
|
inc aux_ptr+1
|
|
bne .fwd1
|
|
inc aux_ptr+2
|
|
.fwd1: jsr find_aux_page
|
|
pla
|
|
rts
|
|
|
|
|
|
advance_pc_page:
|
|
pha
|
|
inc pc+1
|
|
bne .fwd1
|
|
inc pc+2
|
|
.fwd1: jsr find_pc_page
|
|
pla
|
|
rts
|
|
|
|
|
|
; Fetch one byte from the aux ptr and increment the aux ptr
|
|
; On exit:
|
|
; A = fetched byte
|
|
; Y = fetched byte
|
|
fetch_aux_byte:
|
|
ldy aux_phys_page+2
|
|
sta rd_main_ram,y ; indexed to get main or card
|
|
ldy aux_ptr
|
|
lda (aux_phys_page),y
|
|
sta rd_main_ram
|
|
inc aux_ptr
|
|
bne .fwd1
|
|
jsr Sef23
|
|
.fwd1: tay
|
|
rts
|
|
|
|
|
|
; Fetch one byte from the PC and increment the PC
|
|
; On exit:
|
|
; A = fetched byte
|
|
; Y = fetched byte
|
|
fetch_pc_byte:
|
|
fetch_pc_byte_inline
|
|
rts
|
|
|
|
|
|
Sef65: lda Z6d
|
|
asl
|
|
sta aux_ptr
|
|
lda Z6e
|
|
rol
|
|
sta aux_ptr+1
|
|
lda #$00
|
|
rol
|
|
sta aux_ptr+2
|
|
asl aux_ptr
|
|
rol aux_ptr+1
|
|
rol aux_ptr+2
|
|
jmp find_aux_page
|
|
|
|
|
|
Lef7d: rts
|
|
|
|
Sef7e: ldx #$00
|
|
stx Za6
|
|
stx Zaa
|
|
dex
|
|
stx Za7
|
|
.loop1: jsr Sf064
|
|
bcs Lef7d
|
|
sta Za8
|
|
tax
|
|
beq .fwd4
|
|
cmp #$04
|
|
bcc .fwd7
|
|
cmp #$06
|
|
bcc .fwd5
|
|
jsr Sf046
|
|
tax
|
|
bne .fwd1
|
|
lda #$5b
|
|
.loop2: clc
|
|
adc Za8
|
|
.loop3: jsr Sf311
|
|
jmp .loop1
|
|
|
|
.fwd1: cmp #$01
|
|
bne .fwd2
|
|
lda #$3b
|
|
bne .loop2 ; always taken
|
|
|
|
.fwd2: lda Za8
|
|
sec
|
|
sbc #$06
|
|
beq .fwd3
|
|
tax
|
|
lda Df195,x
|
|
jmp .loop3
|
|
|
|
.fwd3: jsr Sf064
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
sta Za8
|
|
jsr Sf064
|
|
ora Za8
|
|
jmp .loop3
|
|
|
|
.fwd4: lda #$20
|
|
bne .loop3 ; always taken
|
|
|
|
.fwd5: sec
|
|
sbc #$03
|
|
tay
|
|
jsr Sf046
|
|
bne .fwd6
|
|
sty Za7
|
|
jmp .loop1
|
|
|
|
.fwd6: sty Za6
|
|
cmp Za6
|
|
beq .loop1
|
|
lda #$00
|
|
sta Za6
|
|
beq .loop1 ; always taken
|
|
|
|
.fwd7: sec
|
|
sbc #$01
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
sta Za9
|
|
jsr Sf064
|
|
asl
|
|
clc
|
|
adc Za9
|
|
tay
|
|
lda (Z87),y
|
|
sta Z6e
|
|
iny
|
|
lda (Z87),y
|
|
sta Z6d
|
|
lda aux_ptr+2
|
|
pha
|
|
lda aux_ptr+1
|
|
pha
|
|
lda aux_ptr
|
|
pha
|
|
lda Za6
|
|
pha
|
|
lda Zaa
|
|
pha
|
|
lda Zac
|
|
pha
|
|
lda Zab
|
|
pha
|
|
jsr Sf052
|
|
jsr Sef7e
|
|
pla
|
|
sta Zab
|
|
pla
|
|
sta Zac
|
|
pla
|
|
sta Zaa
|
|
pla
|
|
sta Za6
|
|
pla
|
|
sta aux_ptr
|
|
pla
|
|
sta aux_ptr+1
|
|
pla
|
|
sta aux_ptr+2
|
|
ldx #$ff
|
|
stx Za7
|
|
jsr find_aux_page
|
|
jmp .loop1
|
|
|
|
|
|
Sf046: lda Za7
|
|
bpl .fwd1
|
|
lda Za6
|
|
rts
|
|
|
|
.fwd1: ldy #$ff
|
|
sty Za7
|
|
rts
|
|
|
|
|
|
Sf052: lda Z6d
|
|
asl
|
|
sta aux_ptr
|
|
lda Z6e
|
|
rol
|
|
sta aux_ptr+1
|
|
lda #$00
|
|
rol
|
|
sta aux_ptr+2
|
|
jmp find_aux_page
|
|
|
|
|
|
Sf064: lda Zaa
|
|
bpl .fwd1
|
|
sec
|
|
rts
|
|
|
|
.fwd1: bne .fwd2
|
|
inc Zaa
|
|
jsr fetch_aux_byte
|
|
sta Zac
|
|
jsr fetch_aux_byte
|
|
sta Zab
|
|
lda Zac
|
|
lsr
|
|
lsr
|
|
jmp .fwd5
|
|
|
|
.fwd2: sec
|
|
sbc #$01
|
|
bne .fwd3
|
|
lda #$02
|
|
sta Zaa
|
|
lda Zab
|
|
sta Z6d
|
|
lda Zac
|
|
asl Z6d
|
|
rol
|
|
asl Z6d
|
|
rol
|
|
asl Z6d
|
|
rol
|
|
jmp .fwd5
|
|
|
|
.fwd3: lda #$00
|
|
sta Zaa
|
|
lda Zac
|
|
bpl .fwd4
|
|
lda #$ff
|
|
sta Zaa
|
|
.fwd4: lda Zab
|
|
.fwd5: and #$1f
|
|
clc
|
|
rts
|
|
|
|
|
|
Sf0ac: lda #$05
|
|
ldx #$08
|
|
.loop1: sta Z94,x
|
|
dex
|
|
bpl .loop1
|
|
lda #$09
|
|
sta Zad
|
|
lda #$00
|
|
sta Zae
|
|
sta Zaf
|
|
.loop2: ldx Zae
|
|
inc Zae
|
|
lda Z8b,x
|
|
sta Za8
|
|
bne .fwd1
|
|
lda #$05
|
|
bne .loop3 ; always taken
|
|
|
|
.fwd1: lda Za8
|
|
jsr get_letter_case
|
|
beq .fwd3
|
|
clc
|
|
adc #$03
|
|
ldx Zaf
|
|
sta Z94,x
|
|
inc Zaf
|
|
dec Zad
|
|
bne .fwd2
|
|
jmp Lf15c
|
|
|
|
.fwd2: lda Za8
|
|
jsr get_letter_case
|
|
cmp #$02
|
|
beq .fwd4
|
|
lda Za8
|
|
sec
|
|
sbc #$3b
|
|
bpl .loop3
|
|
.fwd3: lda Za8
|
|
sec
|
|
sbc #$5b
|
|
.loop3: ldx Zaf
|
|
sta Z94,x
|
|
inc Zaf
|
|
dec Zad
|
|
bne .loop2
|
|
jmp Lf15c
|
|
|
|
.fwd4: lda Za8
|
|
jsr Sf133
|
|
bne .loop3
|
|
lda #$06
|
|
ldx Zaf
|
|
sta Z94,x
|
|
inc Zaf
|
|
dec Zad
|
|
beq Lf15c
|
|
lda Za8
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
lsr
|
|
and #$03
|
|
ldx Zaf
|
|
sta Z94,x
|
|
inc Zaf
|
|
dec Zad
|
|
beq Lf15c
|
|
lda Za8
|
|
and #$1f
|
|
jmp .loop3
|
|
|
|
|
|
Sf133: ldx #$19
|
|
.loop1: cmp Df195,x
|
|
beq .fwd1
|
|
dex
|
|
bne .loop1
|
|
rts
|
|
|
|
.fwd1: txa
|
|
clc
|
|
adc #$06
|
|
rts
|
|
|
|
|
|
; On entry:
|
|
; A = charcter
|
|
; On return:
|
|
; A = $00 for lower case alpha
|
|
; $01 for upper case alpha
|
|
; $02 for non-alpha
|
|
get_letter_case:
|
|
cmp #'a'
|
|
bcc .fwd1
|
|
cmp #'z'+1
|
|
bcs .fwd1
|
|
lda #$00
|
|
rts
|
|
|
|
.fwd1: cmp #'A'
|
|
bcc .fwd2
|
|
cmp #'Z'+1
|
|
bcs .fwd2
|
|
lda #$01
|
|
rts
|
|
|
|
.fwd2: lda #$02
|
|
rts
|
|
|
|
|
|
Lf15c: lda Z95
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
rol Z94
|
|
asl
|
|
rol Z94
|
|
ora Z96
|
|
sta Z95
|
|
lda Z98
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
rol Z97
|
|
asl
|
|
rol Z97
|
|
ora Z99
|
|
tax
|
|
lda Z97
|
|
sta Z96
|
|
stx Z97
|
|
lda Z9b
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
rol Z9a
|
|
asl
|
|
rol Z9a
|
|
ora Z9c
|
|
sta Z99
|
|
lda Z9a
|
|
ora #$80
|
|
sta Z98
|
|
rts
|
|
|
|
|
|
Df195: fcb $00,char_cr
|
|
fcb "0123456789"
|
|
fcb ".,!?_#'"
|
|
fcb $22 ; double quote
|
|
fcb "/"
|
|
fcb $5c ; backslash
|
|
fcb "-:()"
|
|
|
|
|
|
setup_object:
|
|
stx Z6e
|
|
asl
|
|
sta Z6d
|
|
rol Z6e
|
|
ldx Z6e
|
|
asl
|
|
rol Z6e
|
|
asl
|
|
rol Z6e
|
|
asl
|
|
rol Z6e
|
|
sec
|
|
sbc Z6d
|
|
sta Z6d
|
|
lda Z6e
|
|
stx Z6e
|
|
sbc Z6e
|
|
sta Z6e
|
|
lda Z6d
|
|
clc
|
|
adc #$70
|
|
bcc .fwd1
|
|
inc Z6e
|
|
.fwd1: clc
|
|
adc Z89
|
|
sta Z6d
|
|
lda Z6e
|
|
adc Z8a
|
|
sta Z6e
|
|
rts
|
|
|
|
|
|
Sf1e3: lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
ldy #$0c
|
|
lda (Z6d),y
|
|
clc
|
|
adc Z81
|
|
tax
|
|
iny
|
|
lda (Z6d),y
|
|
sta Z6d
|
|
stx Z6e
|
|
ldy #$00
|
|
lda (Z6d),y
|
|
asl
|
|
tay
|
|
iny
|
|
rts
|
|
|
|
|
|
Sf201: lda (Z6d),y
|
|
and #$3f
|
|
rts
|
|
|
|
|
|
Sf206: lda (Z6d),y
|
|
and #$80
|
|
beq .fwd1
|
|
iny
|
|
lda (Z6d),y
|
|
and #$3f
|
|
rts
|
|
|
|
.fwd1: lda (Z6d),y
|
|
and #$40
|
|
beq .fwd2
|
|
lda #$02
|
|
rts
|
|
|
|
.fwd2: lda #$01
|
|
rts
|
|
|
|
|
|
Sf21e: jsr Sf206
|
|
tax
|
|
.loop1: iny
|
|
bne .fwd1
|
|
inc Z6d
|
|
bne .fwd1
|
|
inc Z6e
|
|
.fwd1: dex
|
|
bne .loop1
|
|
iny
|
|
rts
|
|
|
|
|
|
Sf230: jsr Sf21e
|
|
tya
|
|
clc
|
|
adc Z6d
|
|
sta Z6d
|
|
bcc .fwd1
|
|
inc Z6e
|
|
.fwd1: ldy #$00
|
|
rts
|
|
|
|
|
|
setup_attribute:
|
|
lda arg1
|
|
ldx arg1+1
|
|
jsr setup_object
|
|
lda arg2
|
|
cmp #$10
|
|
bcc .fwd3
|
|
sbc #$10
|
|
tax
|
|
cmp #$10
|
|
bcc .fwd1
|
|
sbc #$10
|
|
tax
|
|
lda Z6d
|
|
clc
|
|
adc #$04
|
|
sta Z6d
|
|
bcc .fwd2
|
|
inc Z6e
|
|
jmp .fwd2
|
|
|
|
.fwd1: lda Z6d
|
|
clc
|
|
adc #$02
|
|
sta Z6d
|
|
bcc .fwd2
|
|
inc Z6e
|
|
.fwd2: txa
|
|
.fwd3: sta Z71
|
|
ldx #$01
|
|
stx Z6f
|
|
dex
|
|
stx Z70
|
|
lda #$0f
|
|
sec
|
|
sbc Z71
|
|
tax
|
|
beq .fwd4
|
|
.loop1: asl Z6f
|
|
rol Z70
|
|
dex
|
|
bne .loop1
|
|
.fwd4: ldy #$00
|
|
lda (Z6d),y
|
|
sta Z72
|
|
iny
|
|
lda (Z6d),y
|
|
sta Z71
|
|
rts
|
|
|
|
|
|
msg_internal_error:
|
|
text_str "Internal error "
|
|
Df2a4: text_str "00. "
|
|
msg_len_internal_error equ *-msg_internal_error
|
|
|
|
|
|
; On entry:
|
|
; A = error number
|
|
; Does not return
|
|
int_error:
|
|
ldy #$01 ; divide by 10, storing into message
|
|
.loop1: ldx #0
|
|
.loop2: cmp #10
|
|
bcc .fwd1
|
|
sbc #10
|
|
inx
|
|
bne .loop2
|
|
.fwd1: ora #$30
|
|
sta Df2a4,y
|
|
txa
|
|
dey
|
|
bpl .loop1
|
|
prt_msg internal_error
|
|
jmp Lf2ce
|
|
|
|
|
|
; Does not return
|
|
op_quit:
|
|
jsr op_new_line
|
|
Lf2ce: prt_msg end_of_session
|
|
jmp * ; deliberately hang
|
|
|
|
|
|
msg_end_of_session:
|
|
text_str "End of session."
|
|
fcb char_cr
|
|
msg_len_end_of_session equ *-msg_end_of_session
|
|
|
|
|
|
op_restart:
|
|
ldx #$00
|
|
stx wndtop
|
|
lda ostream_2_state
|
|
beq .fwd1
|
|
dex
|
|
stx Ddc34
|
|
.fwd1: jsr Sd856
|
|
jmp restart
|
|
|
|
|
|
; Unreferenced? See S14dc in ZIP revision F
|
|
lda #$fb
|
|
rts
|
|
|
|
|
|
Sf2ff: inc rndloc
|
|
dec rndloc+1
|
|
lda rndloc
|
|
adc Zc0
|
|
tax
|
|
lda rndloc+1
|
|
sbc Zc0+1
|
|
sta Zc0
|
|
stx Zc0+1
|
|
rts
|
|
|
|
|
|
Sf311: sta Zd7
|
|
ldx ostream_3_state
|
|
beq .fwd1
|
|
|
|
if iver==iver2a
|
|
jsr Sf3b3
|
|
else
|
|
jmp Sf3b3
|
|
endif
|
|
|
|
.fwd1: ldx ostream_1_state
|
|
bne .fwd2
|
|
ldx ostream_2_state
|
|
bne .fwd2
|
|
rts
|
|
|
|
.fwd2: lda Zd7
|
|
ldx Zbd
|
|
bne .fwd6
|
|
cmp #char_cr
|
|
bne .fwd3
|
|
jmp op_new_line
|
|
|
|
.fwd3: cmp #' '
|
|
bcc .rtn
|
|
ldx invflg
|
|
bpl .fwd4
|
|
ora #$80
|
|
.fwd4: ldx Zd1
|
|
sta D0200,x
|
|
ldy Zd0
|
|
cpy Zbf
|
|
bcc .fwd5
|
|
jmp Lf3cd
|
|
|
|
.fwd5: inc Zd0
|
|
inc Zd1
|
|
.rtn: rts
|
|
|
|
.fwd6: sta Zd7
|
|
cmp #$20
|
|
bcc .rtn2
|
|
lda D057b
|
|
cmp #$50
|
|
bcs .rtn2
|
|
lda cursrh
|
|
cmp #$50
|
|
bcs .rtn2
|
|
lda Zc2
|
|
beq .fwd7
|
|
lda cursrv
|
|
cmp wndtop
|
|
bcs .rtn2
|
|
bcc .fwd8 ; always taken
|
|
|
|
.fwd7: lda cursrv
|
|
cmp wndtop
|
|
bcc .rtn2
|
|
.fwd8: lda ostream_1_state
|
|
beq .fwd9
|
|
lda Zd7
|
|
ora #$80
|
|
jsr cout
|
|
.fwd9: lda Zc2
|
|
bne .rtn2
|
|
lda Zd4
|
|
beq .rtn2
|
|
lda ostream_2_state
|
|
beq .rtn2
|
|
lda cswl
|
|
pha
|
|
lda cswl+1
|
|
pha
|
|
lda D057b
|
|
pha
|
|
lda cursrh
|
|
pha
|
|
lda Ddc35
|
|
sta cswl
|
|
lda Ddc35+1
|
|
sta cswl+1
|
|
lda Zd7
|
|
jsr cout
|
|
pla
|
|
sta cursrh
|
|
pla
|
|
sta D057b
|
|
pla
|
|
sta cswl+1
|
|
pla
|
|
sta cswl
|
|
.rtn2: rts
|
|
|
|
|
|
Sf3b3: tax
|
|
lda Zb9
|
|
clc
|
|
adc Zb7
|
|
sta Z6d
|
|
lda Zba
|
|
adc Zb8
|
|
sta Z6e
|
|
ldy #$00
|
|
txa
|
|
sta (Z6d),y
|
|
inc Zb9
|
|
bne .rtn
|
|
inc Zba
|
|
.rtn: rts
|
|
|
|
|
|
Lf3cd: lda #$a0
|
|
stx Zd3
|
|
.loop1: cmp D0200,x
|
|
beq .fwd1
|
|
dex
|
|
bne .loop1
|
|
ldx Zbf
|
|
.fwd1: stx Zd2
|
|
stx Zd1
|
|
jsr op_new_line
|
|
ldx Zd2
|
|
ldy #$00
|
|
.loop2: inx
|
|
cpx Zd3
|
|
bcc .fwd2
|
|
beq .fwd2
|
|
sty Zd0
|
|
sty Zd1
|
|
rts
|
|
|
|
.fwd2: lda D0200,x
|
|
sta D0200,y
|
|
iny
|
|
bne .loop2
|
|
|
|
|
|
op_new_line:
|
|
ldx Zd1
|
|
lda #$8d
|
|
sta D0200,x
|
|
inc Zd1
|
|
lda ostream_1_state
|
|
beq .fwd2
|
|
lda Zc2
|
|
bne .fwd1
|
|
inc Zd5
|
|
.fwd1: ldx Zd5
|
|
inx
|
|
cpx wndbot
|
|
bcc .fwd2
|
|
lda wndtop
|
|
sta Zd5
|
|
inc Zd5
|
|
bit kbd_strb
|
|
prt_msg_alt more
|
|
.loop1: bit kbd
|
|
bpl .loop1
|
|
bit kbd_strb
|
|
ldy #$06
|
|
.loop2: lda #$08
|
|
jsr cout
|
|
dey
|
|
bne .loop2
|
|
jsr clreol
|
|
.fwd2: jsr Sf446
|
|
lda #$00
|
|
sta Zd0
|
|
sta Zd1
|
|
rts
|
|
|
|
|
|
Sf446: ldy Zd1
|
|
beq .rtn
|
|
sty Zde
|
|
lda ostream_1_state
|
|
beq .fwd1
|
|
ldx #$00
|
|
.loop1: lda D0200,x
|
|
jsr Sdaee
|
|
inx
|
|
dey
|
|
bne .loop1
|
|
.fwd1: lda Zc2
|
|
bne .rtn
|
|
jsr Sdbf3
|
|
.rtn: rts
|
|
|
|
|
|
op_show_status:
|
|
rts
|
|
|
|
|
|
; Note that buffer mode only applies to the lower window,
|
|
; and buffering never happens for the upper window.
|
|
; (In Z-Machine v6, every window has its own buffer mode
|
|
; flag.)
|
|
op_buffer_mode:
|
|
ldx arg1
|
|
bne .fwd1
|
|
jsr Sf446
|
|
ldx #$00
|
|
stx Zd1
|
|
inx
|
|
stx Zbd
|
|
rts
|
|
|
|
.fwd1: dex
|
|
bne .rtn
|
|
stx Zbd
|
|
.rtn: rts
|
|
|
|
|
|
op_output_stream:
|
|
ldx arg1
|
|
bmi ostream_deselect
|
|
dex
|
|
beq ostream_select_1
|
|
dex
|
|
beq ostream_select_2
|
|
dex
|
|
beq ostream_select_3
|
|
dex
|
|
beq ostream_select_4
|
|
rts
|
|
|
|
ostream_deselect:
|
|
inx
|
|
beq ostream_deselect_1
|
|
inx
|
|
beq ostream_deselect_2
|
|
inx
|
|
beq ostream_deselect_3
|
|
inx
|
|
beq ostream_deselect_4
|
|
rts
|
|
|
|
|
|
; output stream 1 is the screen
|
|
ostream_select_1:
|
|
inx
|
|
stx ostream_1_state
|
|
rts
|
|
|
|
ostream_deselect_1:
|
|
stx ostream_1_state
|
|
rts
|
|
|
|
|
|
; output stream 2 is the transcript (printer)
|
|
ostream_select_2:
|
|
inx
|
|
stx ostream_2_state
|
|
lda hdr_flags2+1
|
|
ora #$01
|
|
sta hdr_flags2+1
|
|
lda Ddc34
|
|
bne .rtn
|
|
jsr Sdc37
|
|
.rtn: rts
|
|
|
|
ostream_deselect_2:
|
|
stx ostream_2_state
|
|
lda hdr_flags2+1
|
|
and #$fe
|
|
sta hdr_flags2+1
|
|
rts
|
|
|
|
|
|
; output stream 3 is a Z-machine table
|
|
; selecting stream 3 can be done recursively
|
|
ostream_select_3:
|
|
inx
|
|
stx ostream_3_state
|
|
lda arg2+1
|
|
clc
|
|
adc Z81
|
|
ldx arg2
|
|
stx Zb7
|
|
sta Zb8
|
|
lda #$02
|
|
sta Zb9
|
|
lda #$00
|
|
sta Zba
|
|
rts
|
|
|
|
ostream_deselect_3:
|
|
if iver>=iver2c
|
|
lda ostream_3_state ; if no output stream 3 was selected, do nothing.
|
|
beq .fwd2
|
|
; This above fix appears to introduce a new bug, in that the following
|
|
; "stx ostream_3_state" instruction (outside the conditional assembly)
|
|
; will always store 1, even if the ostream table stack is empty.
|
|
endif
|
|
stx ostream_3_state
|
|
lda Zb9
|
|
clc
|
|
adc Zb7
|
|
sta Z6d
|
|
lda Zba
|
|
adc Zb8
|
|
sta Z6e
|
|
lda #$00
|
|
tay
|
|
sta (Z6d),y
|
|
ldy #$01
|
|
lda Zb9
|
|
sec
|
|
sbc #$02
|
|
sta (Zb7),y
|
|
bcs .fwd1
|
|
dec Zba
|
|
.fwd1: lda Zba
|
|
dey
|
|
sta (Zb7),y
|
|
lda #$00
|
|
sta Zb6
|
|
.fwd2 rts
|
|
|
|
; output stream 4, if it existed, would be a script file of user input
|
|
ostream_select_4:
|
|
ostream_deselect_4:
|
|
rts
|
|
|
|
|
|
op_set_cursor:
|
|
if iver==iver2a
|
|
|
|
lda hdr_flags_1
|
|
and #$10
|
|
beq .rtn
|
|
lda Zc2
|
|
bne .fwd2
|
|
ldx arg1
|
|
dex
|
|
txa
|
|
clc
|
|
adc wndtop
|
|
sta cursrv
|
|
ldx Zbd
|
|
bne .fwd1
|
|
sta Zd5
|
|
|
|
.fwd1: ldx arg2
|
|
dex
|
|
stx D057b
|
|
stx cursrh
|
|
jmp vtab
|
|
|
|
.rtn: rts
|
|
|
|
.fwd2: ldx arg1
|
|
dex
|
|
stx cursrv
|
|
jmp .fwd1
|
|
|
|
else
|
|
|
|
lda hdr_flags_1
|
|
and #$10
|
|
beq .rtn
|
|
ldy Zbd
|
|
beq .rtn
|
|
ldy Zc2
|
|
beq .rtn
|
|
ldx arg1
|
|
dex
|
|
stx cursrv
|
|
|
|
ldx arg2
|
|
dex
|
|
stx D057b
|
|
stx cursrh
|
|
jmp vtab
|
|
|
|
.rtn: rts
|
|
|
|
endif
|
|
|
|
|
|
|
|
op_get_cursor:
|
|
op_input_stream:
|
|
rts
|
|
|
|
|
|
op_set_text_state:
|
|
lda arg1
|
|
bne .fwd1
|
|
lda #$ff
|
|
sta invflg
|
|
.rtn: rts
|
|
|
|
.fwd1: cmp #$01
|
|
bne .rtn
|
|
lda hdr_flags_1
|
|
and #$02
|
|
beq .rtn
|
|
lda #$3f
|
|
sta invflg
|
|
rts
|
|
|
|
|
|
op_erase_line:
|
|
lda hdr_flags_1
|
|
and #$10
|
|
beq Lf559
|
|
lda arg1
|
|
cmp #$01
|
|
bne Lf559
|
|
jmp clreol
|
|
|
|
Lf559: rts
|
|
|
|
|
|
op_erase_window:
|
|
lda hdr_flags_1
|
|
and #$01
|
|
beq Lf559
|
|
lda arg1
|
|
beq .fwd1
|
|
cmp #$01
|
|
beq .fwd2
|
|
cmp #$ff
|
|
bne Lf559
|
|
jsr Sdcd8
|
|
jmp home
|
|
|
|
.fwd1: lda wndtop
|
|
sta Zd5
|
|
jsr home
|
|
lda #$17
|
|
sta cursrv
|
|
jmp vtab
|
|
|
|
.fwd2: lda wndtop
|
|
pha
|
|
ldx #$00
|
|
stx wndtop
|
|
sta wndbot
|
|
jsr home
|
|
lda #$18
|
|
sta wndbot
|
|
pla
|
|
sta wndtop
|
|
sta cursrv
|
|
dec cursrv
|
|
jmp vtab
|
|
|
|
|
|
op_read_char:
|
|
lda arg1
|
|
cmp #$01
|
|
bne .fwd3
|
|
lda wndtop
|
|
sta Zd5
|
|
|
|
if iver<=iver2d
|
|
lda #$00
|
|
sta Zd0
|
|
else
|
|
inc Zd5
|
|
lda #$00
|
|
endif
|
|
|
|
sta Zd1
|
|
dec argcnt
|
|
beq .fwd2
|
|
lda arg2
|
|
sta Z6e
|
|
lda #$00
|
|
sta Z70
|
|
sta Z6f
|
|
dec argcnt
|
|
beq .fwd1
|
|
lda arg3
|
|
sta Z6f
|
|
lda arg3+1
|
|
sta Z70
|
|
.fwd1: bit kbd_strb
|
|
.loop1: lda Z6e
|
|
sta Z6d
|
|
.loop2: ldx #$0a
|
|
.loop3: lda #$40
|
|
jsr Sfca8
|
|
dex
|
|
bne .loop3
|
|
bit kbd
|
|
bmi .fwd2
|
|
dec Z6d
|
|
bne .loop2
|
|
lda Z6f
|
|
ora Z70
|
|
beq .fwd3
|
|
jsr Sf5f9
|
|
lda acc
|
|
bne .fwd3
|
|
beq .loop1 ; always taken
|
|
|
|
.fwd2: jsr Sda78
|
|
ldx #$00
|
|
jmp store_result_xa
|
|
|
|
.fwd3: jmp store_result_zero
|
|
|
|
|
|
Sf5f9: lda #Lf67c>>8
|
|
sta Le4db+2
|
|
lda #Lf67c&$ff
|
|
sta Le4db+1
|
|
lda Z6e
|
|
pha
|
|
lda Z70
|
|
pha
|
|
lda Z6f
|
|
pha
|
|
ldx Zed
|
|
lda Zed+1
|
|
jsr push_ax
|
|
lda pc
|
|
jsr push_ax
|
|
ldx pc+1
|
|
lda pc+2
|
|
jsr push_ax
|
|
lda #$00
|
|
asl Z6f
|
|
rol Z70
|
|
rol
|
|
sta pc+2
|
|
asl Z6f
|
|
rol Z70
|
|
rol pc+2
|
|
lda Z70
|
|
sta pc+1
|
|
lda Z6f
|
|
sta pc
|
|
jsr find_pc_page
|
|
jsr fetch_pc_byte
|
|
sta Z6f
|
|
sta Z70
|
|
beq .fwd1
|
|
lda #$00
|
|
sta Z6d
|
|
.loop1: ldy Z6d
|
|
ldx local_vars,y
|
|
lda local_vars+1,y
|
|
jsr push_ax
|
|
jsr fetch_pc_byte
|
|
sta Z6e
|
|
jsr fetch_pc_byte
|
|
ldy Z6d
|
|
sta local_vars,y
|
|
lda Z6e
|
|
sta local_vars+1,y
|
|
iny
|
|
iny
|
|
sty Z6d
|
|
dec Z6f
|
|
bne .loop1
|
|
.fwd1: ldx Z70
|
|
txa
|
|
jsr push_ax
|
|
lda stk_ptr
|
|
sta Zed
|
|
lda stk_ptr+1
|
|
sta Zed+1
|
|
jmp main_loop
|
|
|
|
|
|
Lf67c: lda #store_result>>8
|
|
sta Le4db+2
|
|
lda #store_result&$ff
|
|
sta Le4db+1
|
|
pla
|
|
pla
|
|
pla
|
|
sta Z6f
|
|
pla
|
|
sta Z70
|
|
pla
|
|
sta Z6e
|
|
rts
|
|
|
|
|
|
msg_more:
|
|
text_str "[MORE]"
|
|
msg_len_more equ *-msg_more
|
|
|
|
|
|
msg_printer_slot:
|
|
fcb char_cr
|
|
text_str "Printer Slot 1-7: "
|
|
msg_len_printer_slot equ *-msg_printer_slot
|
|
|
|
msg_story_loading:
|
|
text_str "The story is loading ..."
|
|
msg_len_story_loading equ *-msg_story_loading
|
|
|
|
|
|
if iver==iver2a
|
|
align $0100,$ff
|
|
else
|
|
align $0100,$00
|
|
endif
|