disk.fs

code clrchn
w stx,
$ffcc jsr,
w ldx,
;code

code chrin
w stx,
$ffcf jsr,
w ldx, dex,
lsb sta,x
0 lda,#
msb sta,x
;code

variable oe
0 oe !

code open ( caddr u lfn )
w stx,
lsb lda,x
tay, 
8 ldx,#
$ffba jsr, \ setlfs
w ldx, 
inx,
lsb lda,x
w 1+ sta, 
inx,
w stx,
msb ldy,x
lsb lda,x
tax,
w 1+ lda,
$ffbd jsr, \ setnam
$ffc0 jsr, \ open
+branch bcc,
oe sta,
:+
w ldx, inx,
;code

: open 0 oe ! open oe @ abort" open" ;

code close ( lfn )
w stx,
lsb lda,x
$ffc3 jsr, \ close
w ldx, inx,
;code

code chkin ( lfn )
w stx,
lsb lda,x
tax,
$ffc6 jsr, \ chkin
w ldx, inx,
;code

code chkout ( lfn )
w stx,
lsb lda,x
tax,
$ffc9 jsr, \ chkout
w ldx, inx,
;code

code readst ( -- n )
w stx,
$ffb7 jsr,
w ldx, 
dex,
lsb sta,x
0 lda,#
msb sta,x
;code

variable st

: readst readst dup st ! ;

: open-cmd 0 0 $f open
 readst abort" open-cmd" ;
: close-cmd $f close ;
: open-data s" #" 8 open
 readst abort" open-data" ;
: close-data 8 close ;

: send-cmd $f chkout 
pad count type clrchn ;
: one-cmd pad count $f open 
readst $f close abort" one-cmd" ;

: set-cmd ( caddr u )
dup pad c! pad 1+ swap move ;

: +cmd ( u )
base @ decimal swap
0 <# #s $20 hold #> dup >r 
pad count + swap move r>
pad c@ + pad c! base ! ;

code readstr ( caddr -- size )
lsb lda,x w sta,
msb lda,x w 1+ sta,
w2 stx,
0 ldy,#
here swap
$ffcf jsr,
w3 sta,
$ffb7 jsr,
+branch bne,
w3 lda,
w sta,(y)
iny,
2 pick jmp,
:+ drop
w2 ldx,
lsb sty,x
0 lda,#
msb sta,x
;code

: print-error
open-cmd $f chkin
pad dup readstr type cr  
clrchn close-cmd ;

: readblockpart ( addr track sector start size )
>r >r open-data open-cmd
s" u1 8 0" set-cmd swap
+cmd +cmd send-cmd
s" b-p 8" set-cmd
r> +cmd send-cmd
8 chkin
r> 0 do chrin over i + c! loop drop
clrchn close-data close-cmd ;

: readblock 0 256 readblockpart ;

: writeblockpart ( addr track sector start size )
>r >r open-data open-cmd
s" u2 8 0" set-cmd swap
+cmd +cmd send-cmd
s" b-p 8" set-cmd
r> +cmd send-cmd
8 chkout
r> 0 do dup i + c@ emit loop drop
clrchn close-data close-cmd ;

: writeblock 0 256 writeblockpart ;

: .2d 0 <# $20 hold # # #> type ;

: readbam $a000 18 0 4 $8c readblockpart ;

: sector ( addr n -- n )
8 /mod ( r q )
1+ rot + ( r baddr )
c@ swap 1 swap 0 ?do [ lsb asl,x ] loop
and 0<> ;

: track ( n )
1- 2* 2* $a000 + ;

: showbam 
readbam
24 0 do cr i .2d 35 1 do
i track j sector if 'F' else '.'
then emit loop loop ;

: block-allocate
s" b-a 0" set-cmd
swap +cmd +cmd one-cmd ;

: block-free
s" b-f 0" set-cmd
swap +cmd +cmd one-cmd ;

: showblock
$a000 -rot readblock base @ hex
$a000 begin dup $a100 < while
dup $ff and 0 <# # # #> type
$10 0 do dup c@ 0 <# # # #> type
1+ loop cr repeat drop base ! ;

Very cool stuff, especially your approach with low-level commands for LS.
But I can't seem to get it to work. I'm hoping it's my ignorance showing.

Huh, I thought I left this file working. Something's up opening the data channel to read the buffer and I don't know why....

Okay, fixed. I guess (???) I can't use either LFN 5 or secondary address 5 for a data channel. Don't know when I put that in and didn't test it?!?!?

Also, the LS was never functional IIRC, so I stripped it here. Also I made error detection and storage a bit better for debugging but it's probably not necessary.

It's all good! I was enjoying the possibility of a read on the fly LS. There are lots of assembly examples out there to do such a thing. I've not seen it using TALK/UNTALK, etc. That's some Butterfield level coding knowledge.

LS on the fly w/ sys call overhead.

: irk 0 8 3 ;
: ksetname
parse-name ar c! xr ! setnam sys ;
: ksetlfs ( sa dv fn -- )
ar c! xr c! yr c! setlfs sys ;
: kopen open sys ;
: kchkin ( fn -- ) xr c! chkin sys ;
: kchrin ( -- a ) chrin sys ar c@ ;
: kreadst readst sys ar c@ 0= ;
: kchrout ar c! chrout sys ;
: kclose ar c! close sys ;
: kclrchn clrchn sys ;

: dir ksetname irk ksetlfs kopen
irk kchkin 2drop kchrin kchrin
drop drop
begin kchrin drop kchrin 0<>
while kchrin kchrin 8 lshift + .
begin kchrin ?dup while kchrout
repeat cr more repeat
irk kclose 2drop kclrchn ;