Apple-2-SW/prodos-drivers
1
0
Fork 0
mirror of https://github.com/a2stuff/prodos-drivers.git synced 2025-02-06 09:30:18 +00:00
Code Issues Projects Releases Wiki Activity

Extract common logic for setup/chaining

Browse Source
This commit is contained in:
Joshua Bell 2019-09-29 18:27:00 -07:00
parent fbddc217a6
commit 64c8ff73e3
6 changed files with 484 additions and 945 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -25,7 +25,7 @@ all: $(OUTDIR) $(TARGETS)
$(OUTDIR): $(OUTDIR):
mkdir -p $(OUTDIR) mkdir -p $(OUTDIR)
HEADERS = $(wildcard *.inc) HEADERS = $(wildcard *.inc) $(wildcard inc/*.inc)
clean: clean:
rm -f $(OUTDIR)/*.o rm -f $(OUTDIR)/*.o

6
README.md
View File

@ -1,4 +1,4 @@
# _The Cricket!_ — ProDOS Clock Driver # _The Cricket!_ — ProDOS Clock Driver
[![Build Status](https://travis-ci.org/a2stuff/cricket.svg?branch=master)](https://travis-ci.org/a2stuff/cricket) [![Build Status](https://travis-ci.org/a2stuff/cricket.svg?branch=master)](https://travis-ci.org/a2stuff/cricket)
@ -48,8 +48,8 @@ Also, an updated [NS.CLOCK.SYSTEM](ns.clock.system.s) is included that fixes a t
## Resources ## Resources
Cricket disks on Asimov: Cricket disks on Asimov:
* ftp://ftp.apple.asimov.net/pub/apple_II/images/hardware/sound/cricket_disk1.po * ftp://ftp.apple.asimov.net/pub/apple_II/images/hardware/sound/cricket_disk1.po
* ftp://ftp.apple.asimov.net/pub/apple_II/images/hardware/sound/cricket_disk2.po * ftp://ftp.apple.asimov.net/pub/apple_II/images/hardware/sound/cricket_disk2.po
Cricket Manual on Asimov: Cricket Manual on Asimov:

482
cricket.system.s
View File

@ -18,472 +18,9 @@
.include "inc/macros.inc" .include "inc/macros.inc"
.include "inc/prodos.inc" .include "inc/prodos.inc"
;;; ------------------------------------------------------------ ;;; ************************************************************
.include "driver_preamble.inc"
read_delay_hi = $3 * 3 ; ($300 iterations is normal * 3.6MHz) ;;; ************************************************************
.define PRODUCT "Cricket Clock"
;;; ------------------------------------------------------------
;; 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
jsr launch_next
brk
.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
;;; ============================================================ ;;; ============================================================
;;; ;;;
@ -491,6 +28,10 @@ units: pla
;;; ;;;
;;; ============================================================ ;;; ============================================================
read_delay_hi = $3 * 3 ; ($300 iterations is normal * 3.6MHz)
.define PRODUCT "Cricket Clock"
;;; ============================================================ ;;; ============================================================
;;; Ensure there is not a previous clock driver installed. ;;; Ensure there is not a previous clock driver installed.
@ -788,10 +329,7 @@ done: pla ; restore saved command state
.endproc .endproc
sizeof_driver := .sizeof(driver) sizeof_driver := .sizeof(driver)
.assert sizeof_driver <= 125, error, "Clock code must be <= 125 bytes" .assert sizeof_driver <= 125, error, "Clock code must be <= 125 bytes"
;;; ------------------------------------------------------------
;;; ============================================================ ;;; ************************************************************
;;; End of relocated code .include "driver_postamble.inc"
;;; ************************************************************
poporg
reloc_end := *

3
driver_postamble.inc Normal file
View File

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

459
driver_preamble.inc Normal file
View File

@ -0,0 +1,459 @@
;;; ------------------------------------------------------------
;; 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
jsr launch_next
brk
.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

477
ns.clock.system.s
View File

@ -17,470 +17,9 @@
.include "inc/macros.inc" .include "inc/macros.inc"
.include "inc/prodos.inc" .include "inc/prodos.inc"
;;; ------------------------------------------------------------ ;;; ************************************************************
.include "driver_preamble.inc"
.define PRODUCT "No-Slot Clock" ;;; ************************************************************
;;; ------------------------------------------------------------
;; 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
jsr launch_next
brk
.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
;;; ============================================================ ;;; ============================================================
;;; ;;;
@ -488,6 +27,8 @@ units: pla
;;; ;;;
;;; ============================================================ ;;; ============================================================
.define PRODUCT "No-Slot Clock"
;;; ============================================================ ;;; ============================================================
;;; Ensure there is not a previous clock driver installed. ;;; Ensure there is not a previous clock driver installed.
@ -763,10 +304,8 @@ unlock:
sizeof_driver := * - driver sizeof_driver := * - driver
.assert sizeof_driver <= 125, error, "Clock code must be <= 125 bytes" .assert sizeof_driver <= 125, error, "Clock code must be <= 125 bytes"
;;; ------------------------------------------------------------
;;; ============================================================
;;; End of relocated code
poporg ;;; ************************************************************
reloc_end := * .include "driver_postamble.inc"
;;; ************************************************************