Merge remote-tracking branch 'bbb/master'

This commit is contained in:
Joshua Bell 2019-10-03 21:15:22 -07:00
commit ec94293ec9
13 changed files with 2791 additions and 0 deletions

3
.gitignore vendored Normal file
View File

@ -0,0 +1,3 @@
# Generated files
*.list
*.SYS

11
.travis.yml Normal file
View File

@ -0,0 +1,11 @@
sudo: enabled
os: osx
language: c
install:
- git clone https://github.com/cc65/cc65 /tmp/cc65 &&
sudo make -C /tmp/cc65 ca65 ld65 avail &&
ca65 --version
script:
- make

27
Makefile Normal file
View File

@ -0,0 +1,27 @@
CAFLAGS = --target apple2enh --list-bytes 0
LDFLAGS = --config apple2-asm.cfg
TARGETS = bye.system.SYS buhbye.system.SYS quit.system.SYS
# For timestamps
MM = $(shell date "+%-m")
DD = $(shell date "+%-d")
YY = $(shell date "+%-y")
DEFINES = -D DD=$(DD) -D MM=$(MM) -D YY=$(YY)
.PHONY: clean all
all: $(TARGETS)
HEADERS = $(wildcard *.inc)
clean:
rm -f *.o
rm -f $(TARGETS)
%.o: %.s $(HEADERS)
ca65 $(CAFLAGS) $(DEFINES) --listing $(basename $@).list -o $@ $<
%.SYS: %.o
ld65 $(LDFLAGS) -o $@ $<
xattr -wx prodos.AuxType '00 20' $@

69
README.md Normal file
View File

@ -0,0 +1,69 @@
# Bird's Better Bye - Disassembly (and improvements)
[![Build Status](https://travis-ci.org/a2stuff/bbb.svg?branch=master)](https://travis-ci.org/a2stuff/bbb)
The ProDOS operating system for the Apple II personal computer line
supported a quit routine (invoked from BASIC with the `BYE` command)
allowing the user to type the name of a system file to invoke once
the previous system file had exited.
[Alan Bird](https://alanlbird.wordpress.com/products/) wrote a
replacement called **Bird's Better Bye** that would patch itself into
ProDOS, fitting into a tight 768 bytes. It provides a menu system,
allowing selection of system files (with the arrow keys), directories
(with the return key to enter and escape key to exit), and devices
(with the tab key), with a minimal and stylish 80-column display using
MouseText folder glyphs.
Later official versions of ProDOS replaced the previous quit routine
with _Bird's Better Bye_.
## ProDOS 2.4 / Bitsy Bye
The new (unofficial) releases of
[ProDOS 2.4](http://www.callapple.org/uncategorized/announcing-prodos-2-4-for-all-apple-ii-computers/)
by John Brooks include a replacement quit routine called Bitsy Bye,
a collaboration with Peter Ferrie. This new quit routine is far more
powerful, allowing access to BASIC and binary files (and more), drive
selection, type-down, more entries, and so on. It runs on older
hardware than _Bird's Better Bye_ so uses only 40 columns, and does
not require a 65C02 processor.
Impressed though I am with the power of Bitsy Bye, I am not a fan of
its aesthetics - the display is "cluttered" to my eye.
## BYE.SYSTEM
Aeons ago, Dave Cotter created BYE.SYSTEM which would patch _Bird's
Better Bye_ back into ProDOS if it had been replaced. It can be found
at:
http://www.lazilong.com/apple_ii/bye.sys/bye.html
Since I really liked the look of _Bird's Better Bye_ I used this as
the boot system for my virtual hard drive (occuring after some [clock
drivers](https://github.com/a2stuff/cricket)).
## Buh-Bye
But... I really wanted a way to quickly scroll through my games list.
So I set out to improve _Bird's Better Bye_ by disassembling it (and
the `BYE.SYSTEM` installer), thus ending up with "Bell's Better Bird's
Better Bye" or "Buh-Bye" for short.
The changes are so far pretty minimal since my 6502 skills are not,
in fact, mad, and there are only 768 bytes to play with.
I replaced the directory enumeration logic with tighter code as
outlined in the ProDOS Technical Reference Manual, and along with
other optimizations I made enough room to add seeking if an
alphabetical key is typed (hit 'C' and the list will scroll to the
next file starting with 'C').
There are a few spare bytes to play with and more can be squeezed
out, so perhaps further improvements can be made.
## QUIT.SYSTEM
This just invokes the ProDOS quit handler immediately. It can
be used as the last in a chain of "driver" installers.

706
buhbye.system.s Normal file
View File

@ -0,0 +1,706 @@
;;; Disassembly of BYE.SYSTEM (Bird's Better Bye)
;;; Modifications by Joshua Bell inexorabletash@gmail.com
;;; (so this is Bell's Better Bird's Better Bye - Buh-Bye)
;;; * alpha key advances to next matching filename
;;; * replaced directory enumeration (smaller, per PDTRM)
;;; * installs, then chains to next .SYSTEM file
.setcpu "65C02"
.linecont +
.feature string_escapes
.include "apple2.inc"
.include "apple2.mac"
.include "inc/apple2.inc"
.include "inc/macros.inc"
.include "inc/prodos.inc"
;;; Miscellaneous
COL80HPOS := $57B
;;; I/O Soft Switches / Firmware
ROMINNW := $C082 ; Read ROM; no write
ROMINWB1 := $C089 ; Read ROM; write RAM bank 1
SLOT3 := $C300
;;; Monitor
SETTXT := $FB39
TABV := $FB5B
SETPWRC := $FB6F
BELL1 := $FBDD
SETINV := $FE80
;;; ASCII/Key codes
ASCII_TAB := $9
ASCII_DOWN := $A ; down arrow
ASCII_UP := $B ; up arrow
ASCII_CR := $D
ASCII_RIGHT := $15 ; right arrow
ASCII_SYN := $16 ; scroll text window up
ASCII_ETB := $17 ; scroll text window down
ASCII_EM := $19 ; move cursor to upper left
ASCII_ESCAPE := $1B
;;; ************************************************************
.include "driver_preamble.inc"
;;; ************************************************************
;;; ------------------------------------------------------------
;;; ProDOS Technical Reference Manual, 5.1.5.2:
;;;
;;; ProDOS MLI call $65, the QUIT call, moves addresses $D100 through
;;; $D3FF from the second 4K bank of RAM of the language card to
;;; $1000, and executes a JMP to $1000. What initially resides in that
;;; area is Apple's dispatcher code.
;;; ------------------------------------------------------------
;;; Installer
;;; ------------------------------------------------------------
install_size := $300 ; must fit in $D100...$D3FF = $300
.proc maybe_install_driver
src := install_src
end := install_src + install_size
dst := $D100 ; Install location in ProDOS (bank 2)
src_ptr := $19
dst_ptr := $1B
sta ALTZPOFF
lda ROMIN ; write bank 2
lda ROMIN
lda #<src ; src_ptr = src
sta src_ptr
lda #>src
sta src_ptr+1
lda #<dst ; dst_ptr = dst
sta dst_ptr
lda #>dst
sta dst_ptr+1
loop: lda (src_ptr) ; *src_ptr = *dst_ptr
sta (dst_ptr)
inc src_ptr ; src_ptr++
bne :+
inc src_ptr+1
: inc dst_ptr ; dst_ptr++
bne :+
inc dst_ptr+1
: lda src_ptr+1 ; src_ptr == end ?
cmp #>end
bne loop
lda src_ptr
cmp #<end
bne loop
sta ALTZPOFF
sta ROMINWB1
sta ROMINWB1
rts
.endproc
;;; ------------------------------------------------------------
;;; Selector
;;; ------------------------------------------------------------
install_src := *
pushorg $1000
.proc selector
prefix := $280 ; length-prefixed
filenames := $1400 ; each is length + 15 bytes
read_buffer := $2000 ; Also, start location for launched SYS files
;; Device/Prefix enumeration
next_device_num := $65 ; next device number to try
prefix_depth := $6B ; 0 = root
;; Directory enumeration
entry_pointer := $60 ; 2 bytes
block_entries := $62
active_entries := $63 ; 2 bytes
entry_length := $6E
entries_per_block := $6F
file_count := $70 ; 2 bytes
;; Found entries
current_entry := $67 ; index of current entry
num_entries := $68 ; length of |filenames| (max 128)
curr_len := $69 ; length of current entry name
curr_ptr := $6C ; address of current entry name (in |filenames|)
types_table := $74 ; high bit clear = dir, set = sys
;; Entry display
page_start := $73 ; index of first entry shown on screen
row_count := $6A ; number of rows in this page
top_row := 2 ; first row used on screen
bottom_row := 21 ; last row used on screen
;;; ------------------------------------------------------------
cld ; ProDOS protocol for QUIT routine
lda ROMINNW ; Page in ROM for reads, writes ignored
lda #$A0
jsr SLOT3 ; Activate 80-Column Firmware
;; Update system bitmap
ldx #BITMAP_SIZE-1 ; zero it all out
: stz BITMAP,x
dex
bpl :-
inc BITMAP+BITMAP_SIZE-1 ; protect ProDOS global page
lda #%11001111 ; protect zp, stack, text page 1
sta BITMAP
;; Find device
lda DEVCNT ; max device num
sta next_device_num
lda DEVNUM
bne check_device
next_device:
ldx next_device_num
lda DEVLST,x
cpx #1
bcs :+
ldx DEVCNT
inx
: dex
stx next_device_num
check_device:
sta on_line_params_unit
MLI_CALL ON_LINE, on_line_params
bcs next_device
stz prefix_depth
lda prefix+1
and #$0F
beq next_device
adc #2
tax
;; Resize prefix to length x and open the directory for reading
.proc resize_prefix_and_open
stx prefix
lda #'/'
sta prefix+1 ; ensure prefix is at least '/'
sta prefix,x ; and ends with '/'
stz prefix+1,x ; and is null terminated
stz num_entries
;;; Enumerate directory
;;; Algorithm from ProDOS Technical Reference Manual B.2.5
;; Open the directory
jsr do_open
bcc :+
;; Open failed
fail: lda prefix_depth ; root?
beq next_device
jsr pop_prefix ; and go up a level
bra resize_prefix_and_open
;; Open succeeded
: inc prefix_depth
;; Read a block (512 bytes) into buffer
stz read_params_request
lda #2
sta read_params_request+1
jsr do_read
bcs fail
;; Store entry_length (byte), entries_per_block (byte), file_count (word)
ldx #3
: lda read_buffer + SubdirectoryHeader::entry_length,x
sta entry_length,x
dex
bpl :-
;; Any entries?
lda file_count
ora file_count+1
beq close_dir
;; Skip header entry
clc
lda #<(read_buffer+4) ; 4 bytes for prev/next pointers
adc entry_length
sta entry_pointer
lda #>(read_buffer+4)
adc #0 ; TODO: Can skip this if entry_length << 256
sta entry_pointer+1
;; Prepare to process entry two (first "entry" is header)
lda #2
sta block_entries
while_loop:
;; Check if entry is active
lda (entry_pointer)
beq done_entry
;; Check file type
ldy #FileEntry::file_type
lda (entry_pointer),y
cmp #FT_DIRECTORY
beq store_entry
cmp #FT_SYSTEM
bne done_active_entry
store_entry:
;; Store type
ldx num_entries
sta types_table,x
;; Copy name into |filenames|
jsr update_curr_ptr ; current entry in X
ldy #15 ; max name length (length byte copied too)
: lda (entry_pointer),y
sta (curr_ptr),y
dey
bpl :-
iny ; Y = 0; storage_type/name_length in A
and #%00001111 ; mask off name_length (remove storage_type)
sta (curr_ptr),y ; store length
inc num_entries
done_active_entry:
dec file_count
bpl :+
dec file_count+1
:
done_entry:
;; Seen all active entries?
lda file_count
ora file_count+1
beq close_dir
;; Seen all entries in this block?
lda block_entries
cmp entries_per_block
bne next_in_block
;; Grab next block
next_block:
jsr do_read ; read another block
bcs fail
lda #1 ; first entry in non-key block
sta block_entries
lda #<(read_buffer+4) ; 4 bytes for prev/next pointers
sta entry_pointer
lda #>(read_buffer+4)
sta entry_pointer+1
bra end_while
;; Next entry in current block
next_in_block:
clc
lda entry_pointer
adc entry_length
sta entry_pointer
lda entry_pointer+1
adc #0
sta entry_pointer+1
inc block_entries
end_while:
;; Check to see if we have room
bit num_entries ; max is 128
bpl while_loop
close_dir:
MLI_CALL CLOSE, close_params
;; fall through
.endproc
;;; ------------------------------------------------------------
.proc draw_screen
jsr SETTXT ; TEXT
jsr HOME ; HOME
lda #23 ; VTAB 23
jsr TABV
;; Print help text
lda #20 ; HTAB 20
sta CH
ldy #(help_string - text_resources)
jsr cout_string
;; Draw prefix
jsr home
ldx #0
: lda prefix+1,x
beq :+
jsr ascii_cout
inx
bne :-
: stz current_entry
stz page_start
lda num_entries
beq selection_loop_keyboard_loop ; no entries (empty directory)
;; Draw entries
cmp #bottom_row ; more entries than fit?
bcc :+
lda #(bottom_row - top_row + 1)
: sta row_count
lda #top_row
sta WNDTOP
sta WNDLFT
lda #bottom_row+1
sta WNDWDTH
sta WNDBTM
loop: jsr draw_current_line
inc current_entry
dec row_count
bne loop
stz current_entry
beq selection_loop
.endproc
;;; ------------------------------------------------------------
;; Remove level from prefix; returns new length in X
.proc pop_prefix
ldx prefix
loop: dex
lda prefix,x
cmp #'/'
bne loop
cpx #1
bne done
ldx prefix
done:
;; Fall through...
.endproc
handy_rts:
rts
;;; ------------------------------------------------------------
.proc on_down
jsr down_common
bra selection_loop
.endproc
;;; ------------------------------------------------------------
.proc on_up
ldx current_entry ; first one?
beq selection_loop
dec current_entry ; go to previous
lda CV
cmp #top_row ; at the top?
bne selection_loop
dec page_start ; yes, adjust page and
lda #ASCII_SYN ; scroll screen up
jsr COUT
;; fall through
.endproc
;;; ------------------------------------------------------------
.proc selection_loop
jsr SETINV
jsr draw_current_line
keyboard_loop:
lda KBD
bpl keyboard_loop
sta KBDSTRB
jsr SETNORM
cmp #HI(ASCII_TAB)
beq next_drive
cmp #HI(ASCII_ESCAPE)
beq on_escape
ldx num_entries
beq keyboard_loop ; if empty, no navigation
pha
jsr draw_current_line
pla
cmp #HI(ASCII_CR)
beq on_return
cmp #HI(ASCII_DOWN)
beq on_down
cmp #HI(ASCII_UP)
beq on_up
;; fall through
.endproc
selection_loop_keyboard_loop := selection_loop::keyboard_loop
;;; ------------------------------------------------------------
.proc on_alpha
loop: jsr down_common
jsr draw_current_line
lda KBD
and #$5F ; make ASCII and uppercase
ldy #1
cmp (curr_ptr),y ; key = first char ?
beq selection_loop
bra loop
.endproc
;;; ------------------------------------------------------------
.proc on_escape
jsr pop_prefix ; leaves length in X
dec prefix_depth
bra resize_prefix_and_open_jmp
.endproc
;;; ------------------------------------------------------------
.proc down_common
lda current_entry
inc a
cmp num_entries ; past the limit?
bcc :+
pla ; yes - abort subroutine
pla
bra selection_loop
: sta current_entry ; go to next
lda CV
cmp #bottom_row ; at the bottom?
bne handy_rts
inc page_start ; yes, adjust page and
lda #ASCII_ETB ; scroll screen down
jmp COUT ; implicit rts
.endproc
;;; ------------------------------------------------------------
next_drive: ; relay for branches
jmp next_device
inc_resize_prefix_and_open:
inx
resize_prefix_and_open_jmp:
jmp resize_prefix_and_open
;;; ------------------------------------------------------------
.proc on_return
MLI_CALL SET_PREFIX, set_prefix_params
bcs next_drive
ldx current_entry
jsr update_curr_ptr
ldx prefix
: iny
lda (curr_ptr),y
inx
sta prefix,x
cpy curr_len
bcc :-
stx prefix
ldy current_entry
lda types_table,y
bpl inc_resize_prefix_and_open ; is directory???
;; nope, system file, so...
;; fall through
.endproc
;;; ------------------------------------------------------------
.proc launch_sys_file
jsr SETTXT
jsr HOME
lda #HI(ASCII_RIGHT) ; Right arrow ???
jsr COUT
jsr do_open
bcs next_drive
lda #$FF ; Load up to $FFFF bytes
sta read_params_request
sta read_params_request+1
jsr do_read
php
MLI_CALL CLOSE, close_params
plp
bcs next_drive
jmp read_buffer ; Invoke the loaded code
.endproc
;;; ------------------------------------------------------------
.proc cout_string
loop: lda help_string,y
beq handy_rts2
jsr COUT
iny
bra loop
.endproc
;;; ------------------------------------------------------------
;; Compute address/length of curr_ptr/curr_len
;; Call with entry index in X. Returns with Y = 0
.proc update_curr_ptr
stz curr_ptr+1
txa
asl a
rol curr_ptr+1
asl a
rol curr_ptr+1
asl a
rol curr_ptr+1
asl a
rol curr_ptr+1
sta curr_ptr
lda #>filenames
clc
adc curr_ptr+1
sta curr_ptr+1
ldy #0
lda (curr_ptr),y
sta curr_len
;; fall through
.endproc
handy_rts2:
rts
;;; ------------------------------------------------------------
.proc draw_current_line
lda #2 ; hpos = 2
sta COL80HPOS
ldx current_entry ; vpos = entry - page_start + 2
txa
sec
sbc page_start
inc a
inc a
jsr TABV
lda types_table,x
bmi name ; is sys file?
;; Draw folder glyph
stz COL80HPOS
lda INVFLG
pha
ldy #(folder_string - text_resources) ; Draw folder glyphs
jsr cout_string
pla
sta INVFLG
;; Draw the name
name: jsr space
jsr update_curr_ptr
loop: iny
lda (curr_ptr),y
jsr ascii_cout
cpy curr_len
bcc loop
space: lda #HI(' ')
bne cout ; implicit RTS
.endproc
home: lda #HI(ASCII_EM) ; move cursor to top left
;; Sets high bit before calling COUT
ascii_cout:
ora #$80
cout: jmp COUT
;;; ------------------------------------------------------------
.proc do_open
MLI_CALL OPEN, open_params
lda open_params_ref_num
sta read_params_ref_num
rts
.endproc
.proc do_read
MLI_CALL READ, read_params
rts
.endproc
;;; ------------------------------------------------------------
text_resources := *
.proc help_string
scrcode "RETURN: Select | TAB: Chg Vol | ESC: Back"
.byte 0
.endproc
;; Mousetext sequence: Enable, folder left, folder right, disable
.proc folder_string
.byte $0F,$1B,$D8,$D9,$18,$0E
.byte 0 ; null terminated
.endproc
;;; ------------------------------------------------------------
DEFINE_OPEN_PARAMS open_params, prefix, $1C00
open_params_ref_num := open_params::ref_num
DEFINE_CLOSE_PARAMS close_params
DEFINE_ON_LINE_PARAMS on_line_params, $60, prefix+1
on_line_params_unit := on_line_params::unit_num
DEFINE_SET_PREFIX_PARAMS set_prefix_params, prefix
DEFINE_READ_PARAMS read_params, read_buffer, 0
read_params_ref_num := read_params::ref_num
read_params_request := read_params::request_count
;;; ------------------------------------------------------------
.endproc
.assert .sizeof(selector) <= install_size, error, "Must fit in $300 bytes"
poporg
;;; ************************************************************
.include "driver_postamble.inc"
;;; ************************************************************

723
bye.system.s Normal file
View File

@ -0,0 +1,723 @@
;;; Disassembly of BYE.SYSTEM (Bird's Better Bye)
.setcpu "65C02"
.include "apple2.inc"
.include "prodos.inc"
;;; Miscellaneous
RESETVEC := $3F2
COL80HPOS := $57B
;;; I/O Soft Switches / Firmware
RAMRDOFF := $C002 ; If 80STORE Off: Read Main Mem $0200-$BFFF
RAMRDON := $C003 ; If 80STORE Off: Read Aux Mem $0200-$BFFF
RAMWRTOFF := $C004 ; If 80STORE Off: Write Main Mem $0200-$BFFF
RAMWRTON := $C005 ; If 80STORE Off: Write Aux Mem $0200-$BFFF
ALTZPOFF := $C008 ; Main Stack and Zero Page
ALTZPON := $C009 ; Aux Stack and Zero Page
ROMINNW := $C082 ; Read ROM; no write
ROMINWB1 := $C089 ; Read ROM; write RAM bank 1
SLOT3 := $C300
;;; Monitor
SETTXT := $FB39
TABV := $FB5B
SETPWRC := $FB6F
BELL1 := $FBDD
HOME := $FC58
COUT := $FDED
SETINV := $FE80
SETNORM := $FE84
;;; ASCII/Key codes
ASCII_TAB := $9
ASCII_DOWN := $A ; down arrow
ASCII_UP := $B ; up arrow
ASCII_CR := $D
ASCII_RIGHT := $15 ; right arrow
ASCII_SYN := $16 ; scroll text window up
ASCII_ETB := $17 ; scroll text window down
ASCII_EM := $19 ; move cursor to upper left
ASCII_ESCAPE := $1B
;;; ------------------------------------------------------------
.define HI(char) (char|$80)
.macro HIASCII arg
.repeat .strlen(arg), i
.byte .strat(arg, i) | $80
.endrep
.endmacro
.macro HIASCIIZ arg
HIASCII arg
.byte 0
.endmacro
;;; ------------------------------------------------------------
;;; ProDOS Technical Reference Manual, 5.1.5.2:
;;;
;;; ProDOS MLI call $65, the QUIT call, moves addresses $D100 through
;;; $D3FF from the second 4K bank of RAM of the language card to
;;; $1000, and executes a JMP to $1000. What initially resides in that
;;; area is Apple's dispatcher code.
;;; ------------------------------------------------------------
;;; Entry point
;;; ------------------------------------------------------------
;; Loads at $2000 but executed at $1000.
.org $2000
jmp install_and_quit
install_src := *
;;; ------------------------------------------------------------
;;; Selector
;;; ------------------------------------------------------------
.org $1000
.proc bbb
prefix := $280 ; length-prefixed
filenames := $1400 ; each is length + 15 bytes
read_buffer := $2000 ; Also, start location for launched SYS files
mark_params := $60
mark_ref_num := $61
mark_position := $62 ; 3-bytes
next_device_num := $65 ; next device number to try
current_entry := $67 ; index of current entry
num_entries := $68 ; length of |filenames|
curr_len := $69 ; length of current entry name
curr_ptr := $6C ; address of current entry name (in |filenames|)
prefix_depth := $6B ; 0 = root
entry_length := $6E
entries_per_block := $6F
file_count := $70 ; 2 bytes
entry_num := $72
page_start := $73 ; index of first entry shown on screen
max_entries := 128 ; max # of entries; more are ignored
types_table := $74 ; high bit clear = dir, set = sys
top_row := 2 ; first row used on screen
bottom_row := 21 ; last row used on screen
;;; ------------------------------------------------------------
cld ; ProDOS protocol for QUIT routine
lda ROMINNW ; Page in ROM for reads, writes ignored
;; Point reset vector at this routine
stz RESETVEC
lda #>bbb
sta RESETVEC+1
jsr SETPWRC ; update validity check byte
lda #$A0
jsr SLOT3 ; Activate 80-Column Firmware
;; Update system bitmap
ldx #BITMAP_SIZE-1 ; zero it all out
: stz BITMAP,x
dex
bpl :-
inc BITMAP+BITMAP_SIZE-1 ; protect ProDOS global page
lda #%11001111 ; protect zp, stack, text page 1
sta BITMAP
;; Find device
lda #2
sta mark_params
ldx DEVCNT ; max device num
stx next_device_num
lda DEVNUM
bne check_device
next_device:
ldx next_device_num
lda DEVLST,x
cpx #1
bcs :+
ldx DEVCNT
inx
: dex
stx next_device_num
check_device:
sta on_line_params_unit
MLI_CALL ON_LINE, on_line_params
bcs next_device
stz prefix_depth
lda prefix+1
and #$0F
beq next_device
adc #2
tax
;; Resize prefix to length x and open the directory for reading
.proc resize_prefix_and_open
stx prefix
lda #'/'
sta prefix+1
sta prefix,x
stz prefix+1,x
MLI_CALL OPEN, open_params
bcc :+
;; Open failed
lda prefix_depth ; root?
beq next_device
jsr BELL1 ; no, but failed; beep
jsr pop_prefix ; and go up a level
stx prefix
jmp keyboard_loop
;; Open succeeded
: inc prefix_depth
stz num_entries
lda open_params_ref_num
sta read_params_ref_num
sta mark_ref_num
lda #DirectoryHeader::size
sta read_params_request
stz read_params_request+1
jsr do_read
bcs finish_read2
;; Store entry_length/entries_per_block/file_count
ldx #3
: lda read_buffer + DirectoryHeader::entry_length,x
sta entry_length,x
dex
bpl :-
sta read_params_request
lda #1
sta entry_num
stz mark_position+1
stz mark_position+2
lda file_count
ora file_count+1
bne next_file_entry ; any files?
finish_read2:
bra finish_read
next_file_entry:
bit file_count+1 ; wrap around?
bmi finish_read2
;; TODO: The math here is mysterious; understand and document
floop: lda mark_position+1
and #$FE
sta mark_position+1
ldy entry_num
lda #0
cpy entries_per_block
bcc :+
tay
sty entry_num
inc mark_position+1
carry: inc mark_position+1
: dey
clc
bmi :+
adc entry_length
bcc :-
bcs carry
: adc #4
sta mark_position
MLI_CALL SET_MARK, mark_params
bcs finish_read2
jsr do_read
bcs finish_read2
inc entry_num
lda read_buffer + FileEntry::storage_type
and #$F0 ; mask off storage_type
beq floop ; inactive file entry
dec file_count
bne :+
dec file_count+1
;; Check read access
: ror read_buffer + FileEntry::access
bcc next_file_entry
;; Check file type
lda read_buffer + FileEntry::file_type
cmp #FileType::Directory
beq :+
cmp #FileType::System
bne next_file_entry
;; Check to see if we have room
: ldx num_entries
cpx #max_entries
bcs finish_read
;; Store type
sta types_table,x
;; Copy name
jsr update_curr_ptr
ldy #$0F ; name length + 1 (includes length byte)
: lda read_buffer,y
sta (curr_ptr),y
dey
bpl :-
iny ; Y = 0
and #$0F ; mask off name length (remove storage_type)
sta (curr_ptr),y ; store length
;; Next
inc num_entries
bne next_file_entry
next: jmp next_device
finish_read:
MLI_CALL CLOSE, close_params
bcs next
;; fall through
.endproc
;;; ------------------------------------------------------------
.proc draw_screen
jsr SETTXT ; TEXT
jsr HOME ; HOME
lda #23 ; VTAB 23
jsr TABV
;; Print help text
ldy #0
lda #20 ; HTAB 20
jsr cout_string_hpos
;; Draw prefix
jsr home
ldx #0
: lda prefix+1,x
beq :+
jsr ascii_cout
inx
bne :-
: stz current_entry
stz page_start
lda num_entries
beq keyboard_loop ; no entries (empty directory)
row_count := $6A
cmp #bottom_row ; more entries than fit?
bcc :+
lda #(bottom_row - top_row + 1)
: sta row_count
lda #2
sta WNDTOP
sta WNDLFT
lda #22
sta WNDWDTH
sta WNDBTM
loop: jsr draw_current_line
inc current_entry
dec row_count
bne loop
stz current_entry
beq draw_current_line_inv
.endproc
;;; ------------------------------------------------------------
.proc on_up
jsr draw_current_line ; clear inverse selection
ldx current_entry
beq draw_current_line_inv ; first one? just redraw
dec current_entry ; go to previous
lda CV
cmp #top_row ; at the top?
bne draw_current_line_inv ; if not, just draw
dec page_start ; yes, adjust page and
lda #ASCII_SYN ; scroll screen up
bne draw_current_line_with_char
.endproc
;;; ------------------------------------------------------------
.proc on_down
jsr draw_current_line ; clear inverse selection
ldx current_entry
inx
cpx num_entries ; past the limit?
bcs draw_current_line_inv ; yes, just redraw
stx current_entry ; go to next
lda CV
cmp #bottom_row ; at the bottom?
bne draw_current_line_inv ; if not, just draw
inc page_start ; yes, adjust page and
lda #ASCII_ETB ; scroll screen down
;; fall through
.endproc
;;; ------------------------------------------------------------
draw_current_line_with_char:
jsr COUT
draw_current_line_inv:
jsr SETINV
jsr draw_current_line
;; fall through
;;; ------------------------------------------------------------
.proc keyboard_loop
lda KBD
bpl keyboard_loop
sta KBDSTRB
jsr SETNORM
ldx num_entries
beq :+ ; no up/down/return if empty
cmp #HI(ASCII_CR)
beq on_return
cmp #HI(ASCII_DOWN)
beq on_down
cmp #HI(ASCII_UP)
beq on_up
: cmp #HI(ASCII_TAB)
beq next_drive
cmp #HI(ASCII_ESCAPE)
bne keyboard_loop
;; fall through
.endproc
;;; ------------------------------------------------------------
.proc on_escape
jsr pop_prefix ; leaves length in X
dec prefix_depth
bra resize_prefix_and_open_jmp
.endproc
;;; ------------------------------------------------------------
;; Remove level from prefix; returns new length in X
.proc pop_prefix
ldx prefix
loop: dex
lda prefix,x
cmp #'/'
bne loop
cpx #1
bne done
ldx prefix
done: rts
.endproc
;;; ------------------------------------------------------------
next_drive:
jmp next_device
inc_resize_prefix_and_open:
inx
resize_prefix_and_open_jmp:
jmp resize_prefix_and_open
;;; ------------------------------------------------------------
.proc on_return
MLI_CALL SET_PREFIX, set_prefix_params
bcs next_drive
ldx current_entry
jsr update_curr_ptr
ldx prefix
: iny
lda (curr_ptr),y
inx
sta prefix,x
cpy curr_len
bcc :-
stx prefix
ldy current_entry
lda types_table,y
bpl inc_resize_prefix_and_open ; is directory???
;; nope, system file, so...
;; fall through
.endproc
;;; ------------------------------------------------------------
.proc launch_sys_file
jsr SETTXT
jsr HOME
lda #HI(ASCII_RIGHT) ; Right arrow
jsr COUT
MLI_CALL OPEN, open_params
bcs next_drive
lda open_params_ref_num
sta read_params_ref_num
lda #$FF ; Load up to $FFFF bytes
sta read_params_request
sta read_params_request+1
jsr do_read
php
MLI_CALL CLOSE, close_params
plp
bcs next_drive
jmp read_buffer ; Invoke the loaded code
.endproc
;;; ------------------------------------------------------------
cout_string_hpos:
sta CH
.proc cout_string
loop: lda help_string,y
beq done
jsr COUT
iny
bne loop
done: rts
.endproc
;;; ------------------------------------------------------------
;; Compute address/length of curr_ptr/curr_len
;; Call with entry index in X.
.proc update_curr_ptr
stz curr_ptr+1
txa
asl a
rol curr_ptr+1
asl a
rol curr_ptr+1
asl a
rol curr_ptr+1
asl a
rol curr_ptr+1
sta curr_ptr
lda #>filenames
clc
adc curr_ptr+1
sta curr_ptr+1
ldy #0
lda (curr_ptr),y
sta curr_len
rts
.endproc
;;; ------------------------------------------------------------
.proc draw_current_line
lda #2 ; hpos = 2
sta COL80HPOS
ldx current_entry ; vpos = entry - page_start + 2
txa
sec
sbc page_start
inc a
inc a
jsr TABV
lda types_table,x
bmi name ; is sys file?
;; Draw folder glyph
stz COL80HPOS
lda INVFLG
pha
ldy #(folder_string - string_start) ; Draw folder glyphs
jsr cout_string
pla
sta INVFLG
;; Draw the name
name: jsr space
jsr update_curr_ptr
loop: iny
lda (curr_ptr),y
jsr ascii_cout
cpy curr_len
bcc loop
space: lda #HI(' ')
bne cout ; implicit RTS
;; fall through
.endproc
home: lda #HI(ASCII_EM) ; move cursor to top left
;; Sets high bit before calling COUT
ascii_cout:
ora #$80
cout: jmp COUT
;;; ------------------------------------------------------------
.proc do_read
MLI_CALL READ, read_params
rts
.endproc
;;; ------------------------------------------------------------
string_start := *
.proc help_string
HIASCIIZ "RETURN: Select | TAB: Chg Vol | ESC: Back"
.endproc
;; Mousetext sequence: Enable, folder left, folder right, disable
.proc folder_string
.byte $0F,$1B,$D8,$D9,$18,$0E
.byte 0 ; null terminated
.endproc
;;; ------------------------------------------------------------
.proc open_params
params: .byte 3
path: .addr prefix
buffer: .addr $1C00
ref_num:.byte 0
.endproc
open_params_ref_num := open_params::ref_num
.proc close_params
params: .byte 1
ref_num:.byte 0
.endproc
.proc on_line_params
params: .byte 2
unit: .byte $60
buffer: .addr prefix+1
.endproc
on_line_params_unit := on_line_params::unit
.proc set_prefix_params
params: .byte 1
path: .addr prefix
.endproc
.proc read_params
params: .byte 4
ref_num:.byte 1
buffer: .word read_buffer
request:.word 0
trans: .word 0
.endproc
read_params_ref_num := read_params::ref_num
read_params_request := read_params::request
.assert read_params::request - bbb <= $300, error, "Must fit in $300 bytes"
;;; ------------------------------------------------------------
.res $13FF-*-2, 0
.byte $48,$AD ; 72, 173 ???
.endproc
.assert .sizeof(bbb) = $3FF, error, "Expected size is $3FF"
;;; ------------------------------------------------------------
;;; Installer
;;; ------------------------------------------------------------
.org $2402
.proc install_and_quit
jsr install
MLI_CALL QUIT, params
.proc params
params: .byte 4
type: .byte 0
res1: .word 0
res2: .byte 0
res3: .addr 0
.endproc
.endproc
;;; ------------------------------------------------------------
.proc install
src := install_src
end := install_src + .sizeof(bbb)
dst := $D100 ; Install location in ProDOS (bank 2)
src_ptr := $19
dst_ptr := $1B
sta ALTZPOFF
lda ROMIN
lda ROMIN
lda #>src
sta src_ptr+1
lda #<src
sta src_ptr
lda #>dst
sta dst_ptr+1
lda #<dst
sta dst_ptr
loop: lda (src_ptr)
sta (dst_ptr)
inc src_ptr
bne :+
inc src_ptr+1
: inc dst_ptr
bne :+
inc dst_ptr+1
: lda src_ptr+1
cmp #>end
bne loop
lda src_ptr
cmp #<end
bne loop
lda (src_ptr) ; WTF??
sta (dst_ptr)
sta ALTZPOFF
sta ROMINWB1
sta ROMINWB1
rts
.endproc

3
driver_postamble.inc Normal file
View File

@ -0,0 +1,3 @@
poporg
reloc_end := *

458
driver_preamble.inc Normal file
View File

@ -0,0 +1,458 @@
;;; ------------------------------------------------------------
;; SYS files load at $2000; relocates self to $1000
.org SYS_ADDR
dst_addr := $1000
;;; ------------------------------------------------------------
jmp relocate
.byte MM, DD, YY ; version date stamp
;;; ------------------------------------------------------------
;;; Relocate this code from $2000 (.SYSTEM start location) to $1000
;;; and start executing there. This is done so that the next .SYSTEM
;;; file can be loaded/run at $2000.
.proc relocate
src := reloc_start
dst := dst_addr
ldx #(reloc_end - reloc_start + $FF) / $100 ; pages
ldy #0
load: lda src,y ; self-modified
load_hi := *-1
sta dst,y ; self-modified
store_hi := *-1
iny
bne load
inc load_hi
inc store_hi
dex
bne load
jmp main
.endproc
;;; ============================================================
;;; Start of relocated code
reloc_start := *
pushorg dst_addr
;;; ============================================================
;;; Main routine
;;; ============================================================
.proc main
jsr save_chain_info
jsr init_system
jsr maybe_install_driver
jmp launch_next
.endproc
;;; ============================================================
;;; Preserve state needed to chain to next file
;;; ============================================================
.proc save_chain_info
;; --------------------------------------------------
;; Save most recent device for later, when chaining
;; to next .SYSTEM file.
lda DEVNUM
sta devnum
;; --------------------------------------------------
;; Identify the name of this SYS file, which should be present at
;; $280 with or without a path prefix. Search pathname buffer
;; backwards for '/', then copy name into |self_name|.
;; Find '/' (which may not be present, prefix is optional)
ldx PATHNAME
beq no_name
ldy #0 ; Y = length
: lda PATHNAME,x
and #$7f ; ignore high bit
cmp #'/'
beq copy_name
iny
dex
bne :-
;; Copy name into |self_name| buffer
copy_name:
cpy #0
beq no_name
sty self_name
ldx PATHNAME
: lda PATHNAME,x
sta self_name,y
dex
dey
bne :-
;; Done
rts
no_name:
lda #0
sta self_name
rts
.endproc
devnum: .byte 0
self_name: .res 16
;;; ============================================================
;;; Init system state
;;; ============================================================
;;; Before installing, get the system to a known state.
.proc init_system
cld
bit ROMIN2
;; Update reset vector - ProDOS QUIT
lda #<quit
sta $03F2
lda #>quit
sta $03F3
eor #$A5
sta $03F4
;; Quit 80-column firmware
lda #$95 ; Ctrl+U (quit 80 col firmware)
jsr COUT
;; Reset I/O
sta CLR80VID
sta CLRALTCHAR
jsr SETVID
jsr SETKBD
jsr SETNORM
jsr INIT
jsr HOME
;; Update System Bit Map
ldx #BITMAP_SIZE-1
lda #%00000001 ; protect page $BF
: sta BITMAP,x
lda #%00000000 ; nothing else protected until...
dex
bne :-
lda #%11001111 ; ZP ($00), stack ($01), text page 1 ($04-$07)
sta BITMAP
;; Determine lowercase support
lda MACHID
and #$88 ; IIe or IIc (or IIgs) ?
bne :+
lda #$DF
sta lowercase_mask ; lower case to upper case
: rts
.endproc
;;; ============================================================
;;; Find and invoke the next .SYSTEM file
;;; ============================================================
online_buf := $1C00
io_buf := $1C00
dir_buf := $2000
block_len = $200
DEFINE_ON_LINE_PARAMS on_line_params,,online_buf
DEFINE_OPEN_PARAMS open_params, PATHNAME, io_buf
DEFINE_READ_PARAMS read_params, SYS_ADDR, SYS_LEN
DEFINE_READ_PARAMS read_block_params, dir_buf, block_len
DEFINE_CLOSE_PARAMS close_params
.proc launch_next
;; Read directory and look for .SYSTEM files; find this
;; one, and invoke the following one.
ptr := $A5
num := $A7
len := $A8
;; --------------------------------------------------
;; Own name found? If not, just quit
lda self_name
bne :+
jmp quit
;; --------------------------------------------------
;; Find name of boot device, copy into PATHNAME
: lda devnum
sta on_line_params::unit_num
MLI_CALL ON_LINE, on_line_params
bcc :+
jmp on_error
: lda #'/' ; Prefix by '/'
sta PATHNAME+1
lda online_buf
and #$0F ; Mask off length
sta PATHNAME
ldx #0 ; Copy name
: lda online_buf+1,x
sta PATHNAME+2,x
inx
cpx PATHNAME
bne :-
inx ; One more for '/' prefix
stx PATHNAME
;; Open directory
MLI_CALL OPEN, open_params
bcc :+
jmp on_error
: lda open_params::ref_num
sta read_block_params::ref_num
sta close_params::ref_num
;; Read first "block"
MLI_CALL READ, read_block_params
bcc :+
jmp on_error
;; Get sizes out of header
: lda dir_buf + VolumeDirectoryHeader::entry_length
sta entry_length_mod
lda dir_buf + VolumeDirectoryHeader::entries_per_block
sta entries_per_block_mod
lda #1
sta num
;; Set up pointers to entry
lda #<(dir_buf + .sizeof(VolumeDirectoryHeader))
sta ptr
lda #>(dir_buf + .sizeof(VolumeDirectoryHeader))
sta ptr+1
;; Process directory entry
entry: ldy #FileEntry::file_type ; file_type
lda (ptr),y
cmp #$FF ; type=SYS
bne next
ldy #FileEntry::storage_type_name_length
lda (ptr),y
and #$30 ; regular file (not directory, pascal)
beq next
lda (ptr),y
and #$0F ; name_length
sta len
tay
;; Compare suffix - is it .SYSTEM?
ldx suffix
: lda (ptr),y
cmp suffix,x
bne next
dey
dex
bne :-
;; Yes; is it *this* .SYSTEM file?
ldy self_name
cpy len
bne handle_sys_file
: lda (ptr),y
cmp self_name,y
bne handle_sys_file
dey
bne :-
sec
ror found_self_flag
;; Move to the next entry
next: lda ptr
clc
adc #$27 ; self-modified: entry_length
entry_length_mod := *-1
sta ptr
bcc :+
inc ptr+1
: inc num
lda num
cmp #$0D ; self-modified: entries_per_block
entries_per_block_mod := *-1
bcc entry
;; Read next "block"
MLI_CALL READ, read_block_params
bcs not_found
;; Set up pointers to entry
lda #0
sta num
lda #<(dir_buf + $04)
sta ptr
lda #>(dir_buf + $04)
sta ptr+1
jmp entry
;; --------------------------------------------------
;; Found a .SYSTEM file which is not this one; invoke
;; it if follows this one.
handle_sys_file:
bit found_self_flag
bpl next
MLI_CALL CLOSE, close_params
;; Compose the path to invoke.
ldx PATHNAME
inx
lda #'/'
sta PATHNAME,x
ldy #0
: iny
inx
lda (ptr),y
sta PATHNAME,x
cpy len
bcc :-
stx PATHNAME
jmp invoke_system_file
not_found:
jsr zstrout
scrcode "\r\r* Unable to find next '.SYSTEM' file *\r"
.byte 0
bit KBDSTRB
: lda KBD
bpl :-
bit KBDSTRB
jmp quit
.endproc
;;; ------------------------------------------------------------
;;; Load/execute the system file in PATHNAME
.proc invoke_system_file
MLI_CALL OPEN, open_params
bcs on_error
lda open_params::ref_num
sta read_params::ref_num
sta close_params::ref_num
MLI_CALL READ, read_params
bcs on_error
MLI_CALL CLOSE, close_params
bcs on_error
jmp SYS_ADDR ; Invoke loaded SYSTEM file
.endproc
;;; ------------------------------------------------------------
;;; Error handler - invoked if any ProDOS error occurs.
.proc on_error
pha
jsr zstrout
scrcode "\r\r* Disk Error $"
.byte 0
pla
jsr PRBYTE
jsr zstrout
scrcode " *\r"
.byte 0
bit KBDSTRB
: lda KBD
bpl :-
bit KBDSTRB
jmp quit
.endproc
.proc quit
MLI_CALL QUIT, quit_params
brk ; crash if QUIT fails
DEFINE_QUIT_PARAMS quit_params
.endproc
;;; ============================================================
;;; Data
suffix:
PASCAL_STRING ".SYSTEM"
found_self_flag:
.byte 0
;;; ============================================================
;;; Common Routines
;;; ============================================================
;;; ------------------------------------------------------------
;;; Output a high-ascii, null-terminated string.
;;; String immediately follows the JSR.
.proc zstrout
ptr := $A5
pla ; read address from stack
sta ptr
pla
sta ptr+1
bne skip ; always (since data not on ZP)
next: cmp #HI('a') ; lower-case?
bcc :+
and lowercase_mask ; make upper-case if needed
: jsr COUT
skip: inc ptr
bne :+
inc ptr+1
: ldy #0
lda (ptr),y
bne next
lda ptr+1 ; restore address to stack
pha
lda ptr
pha
rts
.endproc
lowercase_mask:
.byte $FF ; Set to $DF on systems w/o lower-case
;;; ------------------------------------------------------------
;;; COUT a 2-digit number in A
.proc cout_number
ldx #HI('0')
cmp #10 ; >= 10?
bcc tens
;; divide by 10, dividend(+'0') in x remainder in a
: sbc #10
inx
cmp #10
bcs :-
tens: pha
cpx #HI('0')
beq units
txa
jsr COUT
units: pla
ora #HI('0')
jsr COUT
rts
.endproc

54
inc/apple2.inc Normal file
View File

@ -0,0 +1,54 @@
;;; ============================================================
;;;
;;; More Apple II Symbols
;;;
;;; ============================================================
;;; ============================================================
;;; Soft Switches
;;; ============================================================
RAMRDOFF := $C002
RAMRDON := $C003
RAMWRTOFF := $C004
RAMWRTON := $C005
ALTZPOFF := $C008
ALTZPON := $C009
CLR80VID := $C00C
SET80VID := $C00D
RDALTZP := $C016
RD80STORE := $C018
RDPAGE2 := $C01C
BANKSEL := $C073 ; Select RamWorks bank
ROMIN2 := $C082 ; Read ROM; no write
RWRAM1 := $C08B ; Read/write RAM bank 1
;;; ============================================================
;;; I/O Registers (for Slot 2)
;;; ============================================================
TDREG := $C088 + $20 ; ACIA Transmit Register (write)
RDREG := $C088 + $20 ; ACIA Receive Register (read)
STATUS := $C089 + $20 ; ACIA Status/Reset Register
COMMAND := $C08A + $20 ; ACIA Command Register (read/write)
CONTROL := $C08B + $20 ; ACIA Control Register (read/write)
;;; ============================================================
;;; Monitor ROM routines
;;; ============================================================
INIT := $FB2F
HOME := $FC58
GETLN := $FD6A ; with prompt character
GETLN2 := $FD6F ; no prompt character
CROUT := $FD8E
PRBYTE := $FDDA
COUT := $FDED
SETNORM := $FE84
SETKBD := $FE89
SETVID := $FE93
INPUT_BUFFER := $200

123
inc/macros.inc Normal file
View File

@ -0,0 +1,123 @@
;;; ============================================================
;;; Generic Macros
;;; ============================================================
.define _is_immediate(arg) (.match (.mid (0, 1, {arg}), #))
.define _is_register(arg) (.match ({arg}, x) .or .match ({arg}, y))
.define _is_y_register(arg) (.match ({arg}, y))
.define _immediate_value(arg) (.right (.tcount ({arg})-1, {arg}))
.macro _op_lo op, arg
.if _is_immediate {arg}
op #<_immediate_value {arg}
.else
op arg
.endif
.endmacro
.macro _op_hi op, arg
.if _is_immediate {arg}
op #>_immediate_value {arg}
.else
op arg+1
.endif
.endmacro
;;; ============================================================
;;; Temporary org change, for relocated routines
__pushorg_depth__ .set 0
.macro pushorg addr
::__pushorg_depth__ .set ::__pushorg_depth__ + 1
.ident(.sprintf("__pushorg_saved__%d", ::__pushorg_depth__)) := *
.org addr
.ident(.sprintf("__pushorg_start__%d", ::__pushorg_depth__)) := *
.endmacro
.macro poporg
.org .ident(.sprintf("__pushorg_saved__%d", ::__pushorg_depth__)) + (* - .ident(.sprintf("__pushorg_start__%d", ::__pushorg_depth__)))
::__pushorg_depth__ .set ::__pushorg_depth__ - 1
.endmacro
;;; ============================================================
;;; Length-prefixed string
;;;
;;; Can include control chars by using:
;;;
;;; PASCAL_STRING {"abc",$0D,"def"}
.macro PASCAL_STRING str,res
.local data
.local end
.byte end - data
data: .byte str
end:
.if .paramcount > 1
.res res - (end - data), 0
.endif
.endmacro
;;; ============================================================
;;; Common patterns
.macro copy arg1, arg2, arg3, arg4
.if _is_register {arg2} && _is_register {arg4}
;; indexed load/indexed store
lda arg1,arg2
sta arg3,arg4
.elseif _is_register {arg2}
;; indexed load variant (arg2 is x or y)
lda arg1,arg2
sta arg3
.elseif _is_register {arg3}
;; indexed store variant (arg3 is x or y)
lda arg1
sta arg2,arg3
.else
lda arg1
sta arg2
.endif
.endmacro
;;; Copy 16-bit value
;;; copy16 #$1111, $2222 ; immediate, absolute
;;; copy16 $1111, $2222 ; absolute, absolute
;;; copy16 $1111,x, $2222 ; indirect load, absolute store
;;; copy16 $1111, $2222,x ; absolute load, indirect store
;;; copy16 $1111,x $2222,x ; indirect load, indirect store
;;; copy16 #$1111, $2222,x ; immediate load, indirect store
.macro copy16 arg1, arg2, arg3, arg4
.if _is_register {arg2} && _is_register {arg4}
;; indexed load/indexed store
lda arg1,arg2
sta arg3,arg4
lda arg1+1,arg2
sta arg3+1,arg4
.elseif _is_register {arg2}
;; indexed load variant (arg2 is x or y)
lda arg1,arg2
sta arg3
lda arg1+1,arg2
sta arg3+1
.elseif _is_register {arg3}
;; indexed store variant (arg3 is x or y)
_op_lo lda, {arg1}
sta arg2,arg3
_op_hi lda, {arg1}
sta arg2+1,arg3
.else
_op_lo lda, {arg1}
sta arg2
_op_hi lda, {arg1}
sta arg2+1
.endif
.endmacro
;;; ============================================================
;;; Set the high bit on the passed byte
.define HI(c) ((c)|$80)

477
inc/prodos.inc Normal file
View File

@ -0,0 +1,477 @@
;;; ============================================================
;;;
;;; ProDOS MLI
;;;
;;; ============================================================
;;; Entry point / Global Page
MLI := $BF00 ; Entry point
DATETIME := $BF06 ; JMP to clock routine
DEVADR := $BF10 ; Device driver addresses ($BF10-$BF2F)
NODEV := $BF10 ; "No Device Connected" entry (slot 0)
DEVNUM := $BF30 ; Most recent accessed device
DEVCNT := $BF31 ; Number of on-line devices minus 1
DEVLST := $BF32 ; Up to 14 units ($BF32-$BF3F)
BITMAP := $BF58 ; System memory bitmap
BITMAP_SIZE = $18 ; Bits for pages $00 to $BF
DATELO := $BF90 ; Date lo
DATEHI := $BF91 ; Date hi
TIMELO := $BF92 ; Time lo
TIMEHI := $BF93 ; Time hi
LEVEL := $BF94 ; File level
MACHID := $BF98 ; Machine ID
SLTBYT := $BF99 ; '1' bits indicate rom in slot (bit#)
IVERSION := $BFFD ; Interpreter Version
KVERSION := $BFFF ; ProDOS Kernel Version
;;; Patch Locations
SELECTOR := $D100
BLOCK_SIZE = $200
PATHNAME := $280
SYS_ADDR := $2000 ; Load address for SYS files
SYS_LEN = $BF00 - SYS_ADDR ; Maximum SYS file length
;;; ============================================================
;;; MLI Calls
;;; ============================================================
;;; Housekeeping Calls
CREATE = $C0
DESTROY = $C1
RENAME = $C2
SET_FILE_INFO = $C3
GET_FILE_INFO = $C4
ON_LINE = $C5
SET_PREFIX = $C6
GET_PREFIX = $C7
;;; Filing Calls
OPEN = $C8
NEWLINE = $C9
READ = $CA
WRITE = $CB
CLOSE = $CC
FLUSH = $CD
SET_MARK = $CE
GET_MARK = $CF
SET_EOF = $D0
GET_EOF = $D1
SET_BUF = $D2
GET_BUF = $D3
;;; System Calls
GET_TIME = $82
ALLOC_INTERRUPT = $40
DEALLOC_INTERRUPT = $41
QUIT = $65
;;; Direct Disk Access Commands
READ_BLOCK = $80
WRITE_BLOCK = $81
;;; ============================================================
;;; File Types
;;; ============================================================
FT_TYPELESS = $00
FT_BAD = $01
FT_TEXT = $04 ; ASCII Text File *
FT_BINARY = $06 ; Generic Binary File *
FT_GRAPHICS = $08 ; Graphics File
FT_DIRECTORY = $0F ; Directory *
FT_ADB = $19 ; AppleWorks Database *
FT_AWP = $1A ; AppleWorks Word Processing *
FT_ASP = $1B ; AppleWorks Spreadsheet *
FT_SRC = $B0 ; IIgs system type; re-used?
FT_S16 = $B3 ; IIgs Application Program
FT_PAS = $EF ; Pascal Area *
FT_CMD = $F0 ; ProDOS Command File *
FT_INT = $FA ; Integer BASIC Program *
FT_IVR = $FB ; Integer BASIC Variable File *
FT_BASIC = $FC ; Applesoft BASIC Program *
FT_VAR = $FD ; Applesoft BASIC Variable File *
FT_REL = $FE ; EDASM/Contiki Relocatable File *
FT_SYSTEM = $FF ; ProDOS System File *
;;; Types marked with * are known to BASIC.SYSTEM and have an
;;; associated three-letter abbreviation.
;;; ============================================================
;;; Access
;;; ============================================================
ACCESS_DEFAULT = %11000011
ACCESS_LOCKED = %00100001
;;; ============================================================
;;; Storage Types
;;; ============================================================
ST_STANDARD_FILE = $01
ST_LINKED_DIRECTORY = $0D
ST_VOLUME_DIRECTORY = $0F
;;; ============================================================
;;; Errors
;;; ============================================================
ERR_DEVICE_NOT_CONNECTED = $28
ERR_WRITE_PROTECTED = $2B
ERR_INVALID_PATHNAME = $40
ERR_INVALID_REFERENCE = $43
ERR_PATH_NOT_FOUND = $44
ERR_VOL_NOT_FOUND = $45
ERR_FILE_NOT_FOUND = $46
ERR_DUPLICATE_FILENAME= $47
ERR_OVERRUN_ERROR = $48
ERR_VOLUME_DIR_FULL = $49
ERR_END_OF_FILE = $4C
ERR_ACCESS_ERROR = $4E
ERR_DUPLICATE_VOLUME = $57
ERR_NETWORK_ERROR = $88
;;; ============================================================
;;; Directory Structures
;;; ============================================================
STORAGE_TYPE_MASK = $F0
NAME_LENGTH_MASK = $0F
;;; Volume Directory Header structure
.struct VolumeDirectoryHeader
prev_block .word
next_block .word
storage_type_name_length .byte
file_name .byte 15
reserved .byte 8
creation_date .word
creation_time .word
version .byte
min_version .byte
access .byte
entry_length .byte
entries_per_block .byte
file_count .word
;; same through here ---------
bit_map_pointer .word
total_blocks .word
.endstruct
.assert .sizeof(VolumeDirectoryHeader) = $2B, error, "incorrect struct size"
;;; Subdirectory Header structure
.struct SubdirectoryHeader
prev_block .word
next_block .word
storage_type_name_length .byte
file_name .byte 15
reserved .byte 8
creation_date .word
creation_time .word
version .byte
min_version .byte
access .byte
entry_length .byte
entries_per_block .byte
file_count .word
;; same through here ---------
parent_pointer .word
parent_entry_number .byte
parent_entry_length .byte
.endstruct
.assert .sizeof(SubdirectoryHeader) = $2B, error, "incorrect struct size"
;; File Entry structure
.struct FileEntry
storage_type_name_length .byte
file_name .byte 15
file_type .byte
key_pointer .word
blocks_used .word
eof .faraddr
creation_date .word
creation_time .word
version .byte
min_version .byte
access .byte
aux_type .word
mod_date .word
mod_time .word
header_pointer .word
.endstruct
.assert .sizeof(FileEntry) = $27, error, "incorrect struct size"
;;; ============================================================
;;; ProDOS Driver Protocol
;;; ============================================================
;;; Addresses for command parameters
DRIVER_COMMAND := $42
DRIVER_UNIT_NUMBER := $43
DRIVER_BUFFER := $44
DRIVER_BLOCK_NUMBER := $46
;;; Commands
DRIVER_COMMAND_STATUS = 0
DRIVER_COMMAND_READ = 1
DRIVER_COMMAND_WRITE = 2
DRIVER_COMMAND_FORMAT = 3
;;; ============================================================
;;; Macros
;;; ============================================================
.macro MLI_CALL op, addr
jsr MLI
.byte op
.addr addr
.endmacro
.macro DEFINE_OPEN_PARAMS name, pn, io, rn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.if .xmatch(.string(io), "io_buffer")
.error "Can't pass 'io_buffer' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 3
pathname: .addr pn
io_buffer: .addr io
.ifnblank rn
ref_num: .byte rn
.else
ref_num: .byte 0
.endif
.endproc
.endmacro
.macro DEFINE_READ_PARAMS name, db, rc
.proc name
param_count: .byte 4
ref_num: .byte 0
data_buffer: .addr db
request_count: .word rc
trans_count: .word 0
.endproc
.endmacro
.macro DEFINE_WRITE_PARAMS name, db, rc
.proc name
param_count: .byte 4
ref_num: .byte 0
data_buffer: .addr db
request_count: .word rc
trans_count: .word 0
.endproc
.endmacro
.macro DEFINE_CLOSE_PARAMS name
.proc name
param_count: .byte 1
ref_num: .byte 0
.endproc
.endmacro
.macro DEFINE_FLUSH_PARAMS name
.proc name
param_count: .byte 1
ref_num: .byte 0
.endproc
.endmacro
.macro DEFINE_GET_FILE_INFO_PARAMS name, pn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte $A
pathname: .addr pn
access: .byte 0
file_type: .byte 0
aux_type: .word 0
storage_type: .byte 0
blocks_used: .word 0
mod_date: .word 0
mod_time: .word 0
create_date: .word 0
create_time: .word 0
.endproc
.endmacro
.macro DEFINE_SET_MARK_PARAMS name, pos
.proc name
param_count: .byte 2
ref_num: .byte 0
position: .faraddr pos
.endproc
.endmacro
.macro DEFINE_ON_LINE_PARAMS name, un, db
.proc name
param_count: .byte 2
.ifnblank un
unit_num: .byte un
.else
unit_num: .byte 0
.endif
data_buffer: .addr db
.endproc
.endmacro
.macro DEFINE_READ_BLOCK_PARAMS name, db, bn
.proc name
param_count: .byte 3
unit_num: .byte 0
data_buffer: .addr db
block_num: .word bn
.endproc
.endmacro
.macro DEFINE_WRITE_BLOCK_PARAMS name, db, bn
.proc name
param_count: .byte 3
unit_num: .byte 0
data_buffer: .addr db
block_num: .word bn
.endproc
.endmacro
.macro DEFINE_ALLOC_INTERRUPT_PARAMS name, ic
.proc alloc_interrupt_params
param_count: .byte 2
int_num: .byte 0
int_code: .addr ic
.endproc
.endmacro
.macro DEFINE_DEALLOC_INTERRUPT_PARAMS name
.proc dealloc_interrupt_params
param_count: .byte 1
int_num: .byte 0
.endproc
.endmacro
.macro DEFINE_QUIT_PARAMS name, ext, pathname
.proc name
param_count: .byte 4
.ifnblank ext
.byte ext
.else
.byte 0
.endif
.ifnblank pathname
.word pathname
.else
.word 0
.endif
.byte 0
.word 0
.endproc
.endmacro
.macro DEFINE_SET_PREFIX_PARAMS name, pn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 1
pathname: .addr pn
.endproc
.endmacro
.macro DEFINE_GET_PREFIX_PARAMS name, pn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 1
pathname: .addr pn
.endproc
.endmacro
.macro DEFINE_DESTROY_PARAMS name, pn
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 1
pathname: .addr pn
.endproc
.endmacro
.macro DEFINE_CREATE_PARAMS name, pn, ac, ft, at, st
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 7
pathname: .addr pn
.ifnblank ac
access: .byte ac
.else
access: .byte 0
.endif
.ifnblank ft
file_type: .byte ft
.else
file_type: .byte 0
.endif
.ifnblank at
aux_type: .word at
.else
aux_type: .word 0
.endif
.ifnblank st
storage_type: .byte st
.else
storage_type: .byte 0
.endif
create_date: .word 0
create_time: .word 0
.endproc
.endmacro
.macro DEFINE_SET_EOF_PARAMS name, eo
.proc name
param_count: .byte 2
ref_num: .byte 0
eof: .faraddr eo
.endproc
.endmacro
.macro DEFINE_GET_EOF_PARAMS name
.proc name
param_count: .byte 2
ref_num: .byte 0
eof: .faraddr 0
.endproc
.endmacro
.macro DEFINE_RENAME_PARAMS name, pn, np
.if .xmatch(.string(pn), "pathname")
;; If 'pathname' is passed then expansion yields a circular reference.
.error "Can't pass 'pathname' label to DEFINE_*_PARAMS"
.endif
.proc name
param_count: .byte 2
pathname: .addr pn
new_pathname: .addr np
.endproc
.endmacro

102
prodos.inc Normal file
View File

@ -0,0 +1,102 @@
;;; ------------------------------------------------------------
;;; ProDOS MLI
;;; ------------------------------------------------------------
;;; ------------------------------------------------------------
;;; ProDOS Global Page
MLI := $BF00 ; Entry point
DEVNUM := $BF30 ; Most recent accessed device
DEVCNT := $BF31 ; Number of on-line devices minus 1
DEVLST := $BF32 ; Up to 14 units
BITMAP := $BF58
BITMAP_SIZE := $18 ; Bits for pages $00 to $BF
DATELO := $BF90 ; Date lo
DATEHI := $BF91 ; Date hi
TIMELO := $BF92 ; Time lo
TIMEHI := $BF93 ; Time hi
;;; ------------------------------------------------------------
;;; MLI Calls
;;; Housekeeping Calls
CREATE := $C0
DESTROY := $C1
RENAME := $C2
SET_FILE_INFO := $C3
GET_FILE_INFO := $C4
ON_LINE := $C5
SET_PREFIX := $C6
GET_PREFIX := $C7
;;; Filing Calls
OPEN := $C8
NEWLINE := $C9
READ := $CA
WRITE := $CB
CLOSE := $CC
FLUSH := $CD
SET_MARK := $CE
GET_MARK := $CF
SET_EOF := $D0
GET_EOF := $D1
SET_BUF := $D2
GET_BUF := $D3
;;; System Calls
GET_TIME := $82
ALLOC_INTERRUPT := $40
DEALLOC_INTERRUPT := $41
QUIT := $65
;;; Direct Disk Access Commands
READ_BLOCK := $80
WRITE_BLOCK := $71
;;; ------------------------------------------------------------
;;; File Types
FT_TYPELESS := $00
FT_BAD := $01
FT_TEXT := $04
FT_BINARY := $06
FT_DIRECTORY := $0F
FT_SRC := $B0 ; IIgs system type; re-used?
FT_BASIC := $FC
FT_SYSTEM := $FF
;;; ------------------------------------------------------------
;;; Macros
.macro MLI_CALL op, addr
jsr MLI
.byte op
.addr addr
.endmacro
;;; ------------------------------------------------------------
;;; Structures
.scope DirectoryHeader
entry_length := $23
entries_per_block := $24
file_count := $25
size := $2B
.endscope
.scope FileEntry
storage_type := $00 ; high nibble
name_length := $00 ; low nibble
file_name := $01
file_type := $10
access := $1E
.endscope
.scope FileType
Directory := $0F
System := $FF
.endscope

35
quit.system.s Normal file
View File

@ -0,0 +1,35 @@
.setcpu "6502"
.include "apple2.inc"
.include "prodos.inc"
.org $2000
CLR80VID := $C00C
ROMIN2 := $C082
SETVID := $FE93
SETKBD := $FE89
INIT := $FB2F
HOME := $FC58
SETNORM := $FE84
cld
bit ROMIN2
sta CLR80VID
sta CLRALTCHAR
sta CLR80COL
jsr SETVID
jsr SETKBD
jsr SETNORM
jsr INIT
jsr HOME
MLI_CALL QUIT, quit_params
brk
quit_params:
.byte 4
.byte 0
.word 0
.byte 0
.word 0