a2d/desk.acc/sort.directory.s
2018-12-28 15:46:09 -08:00

808 lines
17 KiB
ArmAsm

.setcpu "6502"
.include "apple2.inc"
.include "../inc/apple2.inc"
.include "../inc/prodos.inc"
.include "../mgtk.inc"
.include "../desktop.inc"
.include "../macros.inc"
;;; ============================================================
.org $800
dir_data_buffer := $0E00
dir_data_buffer_len = $0E00
;;; ============================================================
cli
jmp start
;; unit_num for active window, for block operations
unit_num: .byte 0
save_stack:
.byte 0
;;; ============================================================
start: tsx
stx save_stack
jmp start2
.proc exit
ldx save_stack
txs
lda a:$0A
bne :+
rts
: lda #$40
pha
lda #$0B
pha
lda a:$0A
rts
.endproc
;;; ============================================================
;;; ProDOS Relays
.proc open
sta ALTZPOFF
MLI_CALL OPEN, open_params
sta ALTZPON
rts
.endproc
.proc read
sta ALTZPOFF
MLI_CALL READ, read_params
sta ALTZPON
rts
.endproc
.proc write_block
sta ALTZPOFF
MLI_CALL WRITE_BLOCK, block_params
sta ALTZPON
rts
.endproc
.proc read_block
sta ALTZPOFF
MLI_CALL READ_BLOCK, block_params
sta ALTZPON
rts
.endproc
.proc on_line
sta ALTZPOFF
MLI_CALL ON_LINE, on_line_params
sta ALTZPON
rts
.endproc
.byte 0
;;; unused ???
.proc write
sta ALTZPOFF
MLI_CALL WRITE, write_params
sta ALTZPON
rts
.endproc
;;; unused ???
.proc set_mark
sta ALTZPOFF
MLI_CALL SET_MARK, set_mark_params
sta ALTZPON
rts
.endproc
;;; unused ???
.proc get_file_info
sta ALTZPOFF
MLI_CALL GET_FILE_INFO, file_info_params
sta ALTZPON
rts
.endproc
;;; unused ???
.proc set_file_info
sta ALTZPOFF
MLI_CALL SET_FILE_INFO, file_info_params
sta ALTZPON
rts
.endproc
.proc close
sta ALTZPOFF
MLI_CALL CLOSE, close_params
sta ALTZPON
rts
.endproc
;;; ============================================================
;;; ProDOS call parameter blocks
DEFINE_ON_LINE_PARAMS on_line_params,, on_line_buffer
on_line_buffer:
.res 16, 0
DEFINE_SET_MARK_PARAMS set_mark_params, $2B
DEFINE_READ_BLOCK_PARAMS block_params, 0, 0
.byte 0
io_buf := $1C00
buffer := dir_data_buffer
buffer_len = dir_data_buffer_len
DEFINE_OPEN_PARAMS open_params, path_buf, io_buf
DEFINE_READ_PARAMS read_params, buffer, buffer_len
DEFINE_WRITE_PARAMS write_params, buffer, buffer_len
DEFINE_CLOSE_PARAMS close_params
DEFINE_GET_FILE_INFO_PARAMS file_info_params, path_buf
.res 3 ; for SET_FILE_INFO ???
path_buf:
.res 65, 0
;;; ============================================================
;;; Main DA logic
.proc start2
sta ALTZPON
lda LCBANK1
lda LCBANK1
ptr := $0A
yax_call JUMP_TABLE_MGTK_RELAY, MGTK::FrontWindow, ptr
lda ptr ; any window open?
beq bail ; nope, bail
cmp #9 ; DeskTop windows are 1-8
bcc has_window
bail: jmp exit
.endproc
has_window:
.scope
;; Copy window path to buffer
asl a ; window index * 2
tay
copy16 path_table,y, $06
ldy #0
sty $10 ; ???
lda ($06),y
sta len
sta path_buf
loop: iny
lda ($06),y
and #CHAR_MASK
cmp #'a' ; lower case?
bcc :+
and #CASE_MASK ; restore to upper-case
: sta path_buf,y
len := *+1
cpy #0
bne loop
.endscope
.scope
;; Enumerate devices to find unit_num matching path.
ldy DEVCNT
sty dev_num
loop: ldy dev_num
lda DEVLST,y
and #$F0 ; mask off drive/slot
sta on_line_params::unit_num
jsr on_line
bne next
jsr compare_paths_for_unit_num
beq found_unit_num
next: dec dev_num
bpl loop
.endscope
exit1: jmp exit
found_unit_num:
lda on_line_params::unit_num
sta unit_num
jsr open
bne exit1
lda open_params::ref_num
sta read_params::ref_num
sta close_params::ref_num
;; Read a chunk of the directory
jsr read
jsr close
bne exit1
ldx #$02
L09BC := *+2
L09BA: lda buffer + 2
sta L0A95,x
L09C2 := *+2
lda buffer + 3
sta L0A95+1,x
ora L0A95,x
beq L09DD
inc L09BC
inc L09BC
inc L09C2
inc L09C2
inx
inx
cpx #$0E
bne L09BA
L09DD: txa
clc
adc #$0E
sta L0A93
jsr L0B40
L09E7: jsr L0B16
bcs L0A3B
ldy #0
lda ($06),y
and #STORAGE_TYPE_MASK
beq L09E7
ldy #SubdirectoryHeader::file_count
copy16in ($06),y, L0A95
jsr L0AE8
lda unit_num
sta block_params::unit_num
lda #$00
sta L0A94
L0A0F: lda L0A94
asl a
tay
copy16 L0A95,y, block_params::block_num
ora block_params::block_num
beq L0A3E
tya
clc
adc #$0E
sta block_params::data_buffer+1
lda #$00
sta block_params::data_buffer
jsr write_block
bne L0A3B
inc L0A94
bne L0A0F
L0A3B: jmp exit
L0A3E: copy16 #$1C00, block_params::data_buffer
jsr L0B40
L0A4B: jsr L0B16
bcs L0A8E
ldy #0
lda ($06),y
and #STORAGE_TYPE_MASK
beq L0A4B
cmp #(ST_LINKED_DIRECTORY << 4)
bne L0A4B
ldy #$11
copy16in ($06),y, block_params::block_num
jsr read_block
bne L0A8F
lda $07
sec
sbc #$0E
and #$FE
tay
copy16 L0A95,y, $1C27
copy L0AAF, $1C29
jsr write_block
jmp L0A4B
L0A8E: pla
L0A8F: jmp exit
dev_num:
.byte 0
L0A93: .byte 0
L0A94: .byte 0
L0A95: .res 26, 0
L0AAF: .byte 0
;;; ============================================================
;;; Compare path from ON_LINE vs. path from window, since we
;;; need unit_num for block operations.
.proc compare_paths_for_unit_num
lda on_line_buffer
and #$0F
sta on_line_buffer
ldy #0
loop: iny
lda on_line_buffer,y
and #CHAR_MASK
cmp #'a'
bcc :+
and #CASE_MASK ; make upper-case
: cmp path_buf+1,y
bne fail
cpy on_line_buffer
bne loop
lda on_line_buffer
clc
adc #$01
cmp path_buf
beq success
lda path_buf+2,y
cmp #'/'
bne fail
success:
return #$00
fail: return #$FF
.endproc
;;; ============================================================
.proc L0AE8
lda #0
sta L0B15
jsr L0B40
jsr L0B16
loop: copy16 $06, $08
jsr L0B16
bcs done
jsr compare_file_entries
bcc loop
jsr swap_entries
lda #$FF
sta L0B15
bne loop
done: lda L0B15
bne L0AE8
rts
L0B15: .byte 0
.endproc
;;; ============================================================
.proc L0B16
ptr := $06
inc L0AAF
lda ptr
clc
adc #.sizeof(FileEntry)
sta ptr
bcc :+
inc ptr+1
: lda ptr
cmp #$FF
bne rtcc
inc ptr+1
lda #1
sta L0AAF
lda #$04 ; skip over block header ???
sta ptr
lda ptr+1
cmp L0A93
bcs rtcs
rtcc: clc
rts
rtcs: sec
rts
.endproc
;;; ============================================================
L0B40: lda #1
sta L0AAF
copy16 #dir_data_buffer + 4, $06
rts
;;; ============================================================
;;; Swap file entries
.proc swap_entries
ptr1 := $06
ptr2 := $08
ldy #.sizeof(FileEntry) - 1
loop: lda (ptr1),y
pha
lda (ptr2),y
sta (ptr1),y
pla
sta (ptr2),y
dey
bpl loop
rts
.endproc
;;; ============================================================
;;; Compare file entries ($06, $08); order returned in carry.
;;; Uses compare_selection_orders, compare_file_entry_names,
;;; and compare_entry_types_and_names as appropriate.
.proc compare_file_entries
ptr1 := $06
ptr2 := $08
ldy #0
lda (ptr1),y
and #STORAGE_TYPE_MASK ; Active file entry?
bne :+
jmp rtcc
: lda (ptr2),y
and #STORAGE_TYPE_MASK ; Active file entry?
bne :+
jmp rtcs
: lda selected_file_count
beq :+
lda path_index
beq :+
jmp compare_selection_orders
: ldax ptr2
jsr check_system_file
bcc rtcc
ldax ptr1
jsr check_system_file
bcc rtcs
ldy #0
lda (ptr2),y
and #STORAGE_TYPE_MASK
sta storage_type2
ldy #0
lda (ptr1),y
and #STORAGE_TYPE_MASK
sta storage_type1
;; Why does this dir-first comparison not just use FT_DIRECTORY ???
;; Is #2 a dir?
lda storage_type2
cmp #(ST_LINKED_DIRECTORY << 4)
beq dirs ; yep, check #1
;; Is #1 a dir?
lda storage_type1
cmp #(ST_LINKED_DIRECTORY << 4)
beq rtcs ; yep, but 2 wasn't, so order
bne check_types ; neither are dirs - check types
;; #2 was a dir - is #1?
dirs: lda storage_type1
cmp #(ST_LINKED_DIRECTORY << 4)
bne rtcc
;; Both are dirs, order by name
jsr compare_file_entry_names
bcc rtcc
bcs rtcs
;; TXT files first
check_types:
lda #FT_TEXT
jsr compare_entry_types_and_names
bne :+
bcc rtcc
bcs rtcs
;; SYS files next
: lda #FT_SYSTEM
jsr compare_entry_types_and_names
bne :+
bcc rtcc
bcs rtcs
;; Then order by type from $FD down
: lda #$FD
sta type
loop: dec type
lda type
beq rtcc
jsr compare_entry_types_and_names
bne loop
bcs rtcs
jmp rtcc
rtcs: sec
rts
rtcc: clc
rts
storage_type2:
.byte 0
storage_type1:
.byte 0
type: .byte 0
.endproc
;;; ============================================================
;;; Compare selection order of icons; order returned in carry.
;;; Handles either icon being not selected.
.proc compare_selection_orders
entry_ptr := $10
filename := $06
filename2 := $08
ldx selected_file_count
loop: dex
bmi done1
;; Look up next icon, compare length.
lda selected_file_list,x
asl a
tay
add16 file_table,y, #IconEntry::len, entry_ptr
ldy #0
lda (entry_ptr),y
sec
sbc #2 ; remove leading/trailing space
sta cmp_len
inc16 entry_ptr ; points at start of name
lda (filename),y
and #NAME_LENGTH_MASK
cmp_len := *+1
cmp #0
bne loop ; lengths don't match, so not a match
;; Bytewise compare names.
sta cpy_len
next: iny ; skip leading space
lda (entry_ptr),y
and #CHAR_MASK
cmp #'a'
bcc :+
and #CASE_MASK ; make upper-case
: sta cmp_char
lda (filename),y
and #CHAR_MASK
cmp #'a'
bcc :+
and #CASE_MASK ; make upper-case
cmp_char := *+1
: cmp #0
bne loop ; no match - try next icon
cpy_len := *+1
cpy #0
bne next
done1: stx match ; match, or $FF if none
ldx selected_file_count
loop2: dex
bmi done2
;; Look up next icon, compare length.
lda selected_file_list,x
asl a
tay
add16 file_table,y, #IconEntry::len, entry_ptr
ldy #0
lda (entry_ptr),y ; len
sec
sbc #2 ; remove leading/trailing space
sta cmp_len2
inc16 entry_ptr ; points at start of name
lda (filename2),y
and #NAME_LENGTH_MASK
cmp_len2 := *+1
cmp #0
bne loop2 ; lengths don't match, so not a match
;; Bytewise compare names.
sta cpy_len2
next2: iny
lda (entry_ptr),y
and #CHAR_MASK
cmp #'a'
bcc :+
and #CASE_MASK ; make upper-case
: sta cmp_char2
lda (filename2),y
and #CHAR_MASK
cmp #'a'
bcc :+
and #CASE_MASK ; make upper-case
cmp_char2 := *+1
: cmp #0
bne loop2 ; no match - try next icon
cpy_len2 := *+1
cpy #0
bne next2
done2: stx match2 ; match, or $FF if none
lda match
and match2
cmp #$FF ; if either didn't match
beq clear
lda match2
cmp match
beq clear ; if they're the same
rts ; otherwise carry is order
;; No match
sec
rts
clear: clc
rts
match: .byte 0
match2: .byte 0
.endproc
;;; ============================================================
;;; Compare file types/names ($06, $08 = ptrs, A=type)
;;;
;;; Output: A=$FF if neither matches type; A=$00 and carry is order
.proc compare_entry_types_and_names
ptr1 := $06
ptr2 := $08
max_length := 16
sta type0
ldy #max_length
lda (ptr2),y
sta type2
lda (ptr1),y
sta type1
lda type2
cmp type0
beq :+
lda type1
cmp type0
beq rtcs
bne neither
: lda type1
cmp type0
bne rtcc
jsr compare_file_entry_names
bcc rtcc
bcs rtcs
neither:
return #$FF
type2: .byte 0
type1: .byte 0
rtcc: lda #0
clc
rts
rtcs: lda #0
sec
rts
type0: .byte 0
.endproc
;;; ============================================================
;;; Is the file entry a SYS file with .SYSTEM suffix?
;;; Returns carry clear if true, set if false.
.proc check_system_file
ptr := $00
;; Check for SYS
stax ptr
ldy #FileEntry::file_type
lda (ptr),y
cmp #$FF ; type=SYS
bne fail
;; Could name end in .SYSTEM?
ldy #FileEntry::storage_type_name_length
lda (ptr),y
and #NAME_LENGTH_MASK
sec
sbc #.strlen(".SYSTEM")-1
bcc fail ; too short
tay
;; Check name suffix
ldx #0
dey
loop: iny
inx
lda (ptr),y
and #CHAR_MASK
cmp str_system,x
bne fail
cpx str_system
bne loop
clc
rts
fail: sec
rts
str_system:
PASCAL_STRING ".SYSTEM"
.endproc
;;; ============================================================
;;; Compare file entry names; carry indicates order
.proc compare_file_entry_names
ptr1 := $06
ptr2 := $08
ldy #0
lda (ptr2),y
and #NAME_LENGTH_MASK
sta len2
sta len
lda (ptr1),y
and #NAME_LENGTH_MASK
sta len1
cmp len
bcs :+
sta len
: ldy #0
loop: iny
lda (ptr2),y
cmp (ptr1),y
beq next
bcc rtcc
rtcs: sec
rts
len := *+1
next: cpy #0
bne loop
lda len2
cmp len1
beq rtcc
bcs rtcs
rtcc: clc
rts
len2: .byte 0
len1: .byte 0
.endproc