        TTL     > FS40 : DFS specific filing system commands

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

comp_d_star
enable_d_star
        CLC                     ; Finished processing
        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

drive_d_star ROUT

        LDAIY   cliptr
        JSR     chkdrive
        STA     dfsdrive
        CLC                     ; Finished processing
        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

chkdrive ROUT

        CMPIM   "0"
        BCC     qBadDrive
        CMPIM   "4"
        BCS     qBadDrive
        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

chkdot  CMPIM   "."
        BNE     qBadDrive
        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

qBadDrive
        GENAD   mBadDrive
        JMP     CauseBRK

mBadDrive
        =       &CD
        =       "Bad drive", 0


qBadEDrive
        GENAD   mBadEDrive
        JMP     CauseBRK

mBadEDrive
        =       &CD
        =       "Bad emulated DFS drive", 0

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

chkdir ROUT

        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

mBadDir GENAD   eBadDir
        JMP     CauseBRK

eBadDir
        =       &D6
        =       "Bad dir.", 0

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

dir_d_star ROUT

        LDA     dfsdrive
        STA     tmpdrive
        LDA     dfsdir
        STA     tmpdir

        LDAIY   cliptr
        CMPIM   space
        BCC     #FT60           ; [no arg]

        CMPIM   ":"
        BNE     #FT50           ; [no drive spec]

        INY
        LDAIY   cliptr
        JSR     chkdrive
        STA     tmpdrive

        INY
        LDAIY   cliptr
        CMPIM   space
        BCC     #FT99           ; [drive only]
        JSR     chkdot

        INY
        LDAIY   cliptr

50      JSR     chkdir
        STA     tmpdir


; Command correct, set up new drive and directory

        LDA     tmpdir
        STA     dfsdir

99      LDA     tmpdrive
98      STA     dfsdrive

        CLC                     ; Finished processing
        RTS


60      LDAIM   "0"             ; *Dir resets to drive 0
        BRA     #BT98

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

lib_d_star ROUT

        LDA     dfsldrive
        STA     tmpdrive
        LDA     dfslib
        STA     tmpdir

        LDAIY   cliptr
        CMPIM   space
        BCC     #FT60           ; [no arg]

        CMPIM   ":"
        BNE     #FT50           ; [no drive spec]

        INY
        LDAIY   cliptr
        JSR     chkdrive
        STA     tmpdrive

        INY
        LDAIY   cliptr
        CMPIM   space
        BCC     #FT99           ; [drive only]
        JSR     chkdot

        INY
        LDAIY   cliptr

50      JSR     chkdir
        STA     tmpdir


; Command correct, set up new drive and directory

        LDA     tmpdir
        STA     dfslib

99      LDA     tmpdrive
98      STA     dfsldrive

        CLC                     ; Finished processing
        RTS


60      LDAIM   "0"             ; *Lib resets to drive 0
        BRA     #BT98

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

acc_d_star ROUT

        JSR     AddYXCliPtrY

        STXY    cbptr

        LDYIM   0               ; Find argument (L)
10      LDAIY   cbptr           ; Skip non-spaces
        INY
        CMPIM   space+1
        BCS     #BT10

        DEY

20      LDAIY   cbptr
        INY
        CMPIM   space
        BEQ     #BT20

        DEY

wrattr  *       &33
lwrattr *       wrattr :OR: &08

        LDXIM   wrattr
        LDAIY   cbptr
        CMPIM   "L"
        BEQ     #FT30
        CMPIM   "l"
        BEQ     #FT30
        LDXIM   lwrattr

30      STX     fil_attr

        JSR     GetDFSName
        STXY    fil_name

        LDAIM   4               ; Set file attributes
        GENAD   fil_blk
        =       ar_file

        CLC                     ; Finished processing
        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

DFSDoStart ROUT

        LDAIM   FSC_Die         ; Tell current filing system to get stuffed
        JSR     JMI_FSC

        LDAIM   B_Service       ; Claim absolute workspace
        LDXIM   SV_UseStatic
        JSR     osbyte

        LDAIM   B_ExtVectors
        LDXIM   0
        LDYIM   255
        JSR     osbyte          ; YX -> base of extended vector table
        STXY    vstrptr

d_voffset *     filev-userv     ; Vector number * 2 of our first vector

        LDXIM   d_voffset
10      LDAIM   &FF             ; Make normal -> extended vector (&FF00 + n*3)
        STAAX   userv+1
        STX     fstmp           ; Make *3
        LSR     fstmp           ; Will give CClear, as X = n*2
        TXA
        ADC     fstmp
        STAAX   userv

        TAY                     ; Set extended vectors up. Y = n*3, X = n*2
        LDAAX   D_NewVectors-d_voffset
        STAIY   vstrptr
        INY
        LDAAX   D_NewVectors-d_voffset+1
        STAIY   vstrptr
        INY
        LDA     ROMid
        STAIY   vstrptr

        CPXIM   fscv-userv      ; Done the last one ?
        BEQ     #FT90
        INX
        INX
        BRA     #BT10

90      LDAIM   B_Service       ; Inform rest of world of vector change
        LDXIM   SV_Vectors
        JSR     osbyte

; Reinitialise our static ws from the dynamic copy

        LDX     ROMid
        LDAAX   RPrivTable
        CLR     pwptr
        STA     pwptr+1

        LDYIM   d_dfsdrive
        LDAIY   pwptr
        STA     dfsdrive
        CLR     dfsdrive+1      ; Ensure terminated
        CLR     tmpdrive+1      ; Ensure terminated

        LDYIM   d_dfsdir
        LDAIY   pwptr
        STA     dfsdir

        LDYIM   d_dfsldrive
        LDAIY   pwptr
        STA     dfsldrive
        CLR     dfsldrive+1     ; Ensure terminated

        LDYIM   d_dfslib
        LDAIY   pwptr
        STA     dfslib

        RTS


D_NewVectors
        &       dos_file
        &       dos_args
        &       dos_bget
        &       dos_bput
        &       dos_gbpb
        &       dos_find
        &       dos_fsc

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    A = reason code
;       X, Y parms

dos_fsc ROUT

        CMPIM   FSC_Enable +1   ; NOP unknown FSC calls
        BCS     #FT99

        STX     fstmp
        ASLA
        TAX
        LDAAX   d_fscrouts+1    ; MSB
        PHA
        LDAAX   d_fscrouts      ; LSB
        PHA
        LDX     fstmp

99      RTS

d_fscrouts
        &       DFSOpt - 1
        &       DFSEof - 1
        &       DFSRun - 1
        &       DFSCommand - 1
        &       DFSRun - 1
        &       DFSCat - 1
        &       DFSDie - 1
        &       DFSHanRange - 1
        &       DFSEnable - 1

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Curl up and die

DFSDie   JSR     GetPWptr

; Copy away useful information

        LDA     dfsdrive
        LDYIM   d_dfsdrive
        STAIY   pwptr

        LDA     dfsdir
        LDYIM   d_dfsdir
        STAIY   pwptr

        LDA     dfsldrive
        LDYIM   d_dfsldrive
        STAIY   pwptr

        LDA     dfslib
        LDYIM   d_dfslib
        STAIY   pwptr

        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Can't opt as yet

DFSOpt  RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

DFSEof  ROUT

        LDAIM   5               ; New Arthur op
        =       ar_args
        TXA
        BEQ     #FT99
        LDXIM   &FF             ; Ensure consistency
99      RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    YX -> command

DFSCommand ; NOROUT
 [ $debugfs
 JSR vstring
 = "fsc "
 NOP
 ]
        PHX
        LDX     currfs          ; From FSCommand/FileSystem n
        LDAAX   CallerBits
        PLX
        JSR     Decode
        BCC     #BT99           ; Exit if processed

        LDXY    cliptr

; .............................................................................
; In    YX -> command

DFSRun  ROUT
 [ $debugfs
 JSR vstring
 = "run"
 NOP
 ]
        JSR     GetDFSName
        STXY    fil_name

        JSR     TryRun          ; Run :D.d.name
        BEQ     #FT50

        LDA     dfsldrive       ; Assumes built name of form 'D.dname'
        STA     dfsname+0
        LDA     dfslib
        JSR     mkarfchar
        STA     dfsname+2

        JSR     TryRun          ; Run :L.l.name
        BEQ     #FT50

        JMP     qBadCommand

50      RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    fil_name -> DFS name to run

TryRun ROUT

        GENAD   fil_blk         ; Exists ?
        LDAIM   5
        =       ar_file
        DECA                    ; File ?
        BNE     #FT99           ; [exit, NE]

        LDX     fil_exec
        LDY     fil_exec+1
        TXA
        AND     fil_exec+1      ; Has it an exec address of &FFFFFFFF?
        AND     fil_exec+2
        AND     fil_exec+3
        CMPIM   &FF
        BEQ     #FT50           ; [yup, *Exec it]

        PHX                     ; Save exec address
        PHY

        LDAIM   &FF
        STA     fil_exec        ; Load at own
        GENAD   fil_blk
        JSR     mos_file        ; Can't use ar_file

        PLY                     ; Restore exec address
        PLX

        JSR     StartCodeXY     ; If that returns, need to set flags to caller
        BRA     #FT80


50      LDAIM   &40             ; Open for input
        LDXY    fil_name
        =       ar_find
        TAX
        BEQ     #FT99           ; [waargh! File wouldn't open]

        LDAIM   198             ; Read old EXEC handle/write new one
        LDYIM   0
        JSR     osbyte
        TXA
        BEQ     #FT80           ; [no old EXEC handle]

        TAY                     ; Close old EXEC file
        LDAIM   0
        =       ar_find

80      LDAIM   0               ; [exit, EQ -> have run a file]
        RTS


99      LDAIM   &FF             ; [exit, NE -> haven't run a file]
        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Handle range request. No translation done by arfs

DFSHanRange
        LDXIM   1
        LDYIM   255
        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Don't give a toss about ..

DFSEnable
        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    YX -> dir to cat (see also *ex code)

DFSCat ROUT

        LDA     dfsdir
        STA     tmpdir
        LDA     dfsdrive
        STA     tmpdrive

        STXY    fscptr
        LDYIM   0
        LDAIY   fscptr
        CMPIM   space
        BCC     #FT03           ; [no arg, use current drive and dir]

        CMPIM   ":"
        BNE     #FT02           ; [no drive spec]

        INY
        LDAIY   fscptr
        JSR     chkdrive
        STA     tmpdrive

        INY
        LDAIY   fscptr
        CMPIM   space
        BCC     #FT03           ; [just drive specified, use current dir]
        JSR     chkdot

        INY
        LDAIY   fscptr

02      JSR     chkdir
        STA     tmpdir

03      LDA     tmpdir          ; Build 'f*' to match
        JSR     mkarfchar
        STA     dfsname+0
        LDAIM   "*"
        STA     dfsname+1
        CLR     dfsname+2

        JSR     vstring
        =       "Drive "
        NOP
        LDA     tmpdrive
        JSR     oswrch
        JSR     osnewl

        JSR     vstring
        =       "Dir. :"
        NOP
        LDA     dfsdrive
        JSR     oswrch
        LDAIM   "."
        JSR     oswrch
        LDA     dfsdir
        JSR     oswrch

        JSR     vstring
        =       "            Lib. :"
        NOP
        LDA     dfsldrive
        JSR     oswrch
        LDAIM   "."
        JSR     oswrch
        LDA     dfslib
        JSR     oswrch

        JSR     osnewl          ; DFS gives lots of blank lines!

        GENAD   tmpdrive        ; Examine this directory for DFS files
        STXY    gbpb_dirname    ; Never updated

; ***^  GENAD   tmpdrive        ; Check the 'drive' exists first
        STXY    fil_name
        LDAIM   5               ; OSFile_ReadInfo
        GENAD   fil_blk
        =       ar_file
        CMPIM   2
        BEQ     #FA04

        JMP     qBadEDrive      ; 'Bad emulated drive'

04      GENAD   allwild         ; Always catalogue ALL the files!
        LDAIM   2               ; DFS catalogues are always 2 column

        STA     ncolumns
        STA     tcolumns

        STXY    gbpb_wildpat    ; Never updated

; gbpb_handle unused

        CLR     gbpb_seqptr     ; Start at entry 0
        CLR     gbpb_seqptr+1
        CLR     gbpb_seqptr+2
        CLR     gbpb_seqptr+3

        CLR     gbpb_nbytes+1   ; Never modified away from 0
        CLR     gbpb_nbytes+2
        CLR     gbpb_nbytes+3

        LDAIM   &FF             ; Pedantically set Host addresses
        STA     gbpb_dirname+2
        STA     gbpb_dirname+3
        STA     gbpb_wildpat+2
        STA     gbpb_wildpat+3

        JSR     osnewl
        JSR     osnewl


10 ; Loop till bored

        LDA     escflag
        BMI     #FT95

        GENAD   gbpb_catblk
        STXY    gbpb_addr
        LDAIM   &FF             ; Pedantically set Host addresses
        STA     gbpb_addr+2
        STA     gbpb_addr+3

        LDAIM   1
        STA     gbpb_nbytes

        LDAIM   10              ; OSGBPB_ReadDirEntriesInfo
        GENAD   gbpb_blk
        =       ar_gbpb

        LDA     gbpb_nbytes
        BEQ     #FT40           ; [no name matched]

        LDA     gbpb_objtype    ; Don't print out DFS directories
        DECA
        BNE     #FT40           ; [is a dir, don't count as object]

        JSR     CatPrintDFS
        BRA     #FT30

30      DEC     tcolumns
        BNE     #FT40           ; [more objects printable]

        LDX     ncolumns        ; Reset column count
        STX     tcolumns
        JSR     osnewl          ; and go newline

40      LDA     gbpb_seqptr+3
        BPL     #BT10           ; [not yet ended dir read]


90      LDX     ncolumns
        CPX     tcolumns
        BEQ     #FT99           ; [already at newline]

        JSR     osnewl

99      RTS


95      JMP     FSAckEscape

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

CatPrintDFS ROUT

        JSR     Do2Spaces

        LDA     gbpb_retname
        JSR     mkdfschar
        LDXIM   "."             ; Normally print 'a.'

        CMP     dfsdir          ; NB. NOT tmpdir!
        BNE     #FT20

        LDAIM   space           ; Same as current dir
        TAX

20      JSR     oswrch
        TXA
        JSR     oswrch

30      LDAIM   7               ; Field width
        GENAD   gbpb_retname+1
        JSR     XYfilename

        JSR     vstring
        =       "        "
        NOP
        RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    A = Arthur char to convert to DFS style dir char

mkdfschar ROUT

        CMPIM   128             ; Can't do anything with tbs
        BCS     #FT90

        PHX
        TAX
        LDAAX   atod
        PLX

90      RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    A = DFS sytle dir char to convert to Arthur char

mkarfchar ROUT

        CMPIM   128             ; Can't do anything with tbs
        BCS     #FT90

        PHX
        TAX
        LDAAX   dtoa
        PLX

90      RTS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; DFS -> RISC OS translation

none    *       &00

pling   *       "!"             ; To get ordering right on DFS
                                ; '$' on DFS -> RISC OS '!'
                                ; !!! This comment is incorrect !!!

pound   *       "`"             ; ' ' on DFS -> RISC OS '`'

dquote  *       """"            ; '"' on DFS -> RISC OS ']'
rsquare *       "]"

dollar  *       "$"             ; '!' on DFS -> RISC OS '['. See above
lsquare *       "["

percent *       "%"             ; '%' on DFS -> RISC OS '}'
rcurly  *       "}"

ampersand *     "&"             ; '&' on DFS -> RISC OS '{'
lcurly  *       "{"

hat     *       "^"             ; '^' on DFS -> RISC OS ')'
rround  *       ")"

bslash  *       "\"             ; '\' on DFS -> RISC OS '('
lround  *       "("

solidus *       "|"             ; '|' on DFS -> RISC OS '>'
rangle  *       ">"

at      *       "@"             ; '@' on DFS -> RISC OS '<'
langle  *       "<"

dtoa    =       &00, &01, &02, &03, &04, &05, &06, &07
        =       &08, &09, &0A, &0B, &0C, &0D, &0E, &0F
        =       &00, &01, &02, &03, &04, &05, &06, &07
        =       &08, &09, &0A, &0B, &0C, &0D, &0E, &0F
        =       pound, pling, rsquare, "#", lsquare, rcurly, lcurly, "'"
        =       lround, rround, "*", "+", ",", "-", ".", "/"
        =       "0123456789", none, ";", langle, "=", rangle, "?"
        =       langle, "ABCDEFGHIJKLMNO"
        =       "PQRSTUVWXYZ", lsquare, bslash, rsquare, rround, "_"
        =       pound, "abcdefghijklmno"
        =       "pqrstuvwxyz", lcurly, rangle, rcurly, "~", none

 ASSERT .-dtoa = 128

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; RISC OS -> DFS translation

atod    =       &00, &01, &02, &03, &04, &05, &06, &07
        =       &08, &09, &0A, &0B, &0C, &0D, &0E, &0F
        =       &00, &01, &02, &03, &04, &05, &06, &07
        =       &08, &09, &0A, &0B, &0C, &0D, &0E, &0F
        =       none, pling, none, "#", none, none, none, "'"
        =       bslash, hat, "*", "+", ",", "-", ".", "/"
        =       "0123456789", none, ";", at, "=", solidus, "?"
        =       none, "ABCDEFGHIJKLMNO"
        =       "PQRSTUVWXYZ", dollar, "\", dquote, none, "_"
        =       space, "abcdefghijklmno"
        =       "pqrstuvwxyz", ampersand, none, percent, "~", none

 ASSERT .-atod = 128

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        LNK     FS45
