More progress on multi-file wildcards. Still bugs!
This commit is contained in:
parent
b14b8ee71a
commit
9765af94c6
236
mainmem.wild.s
236
mainmem.wild.s
|
@ -15,50 +15,67 @@ WILDONE JSR WILDCARD
|
|||
* append the segment as it is. Uses MFTEMP to build up the path.
|
||||
* Returns with carry set if wildcard match fails, clear otherwise
|
||||
WILDCARD STZ :LAST
|
||||
LDX #$00 ; Start with first char
|
||||
STX MFTEMP ; Clear MFTEMP (len=0)
|
||||
LDA #$FF ; WILDIDX=$FF denotes new search
|
||||
STA WILDIDX
|
||||
LDX #$00 ; Start with first char
|
||||
STX MFTEMP ; Clear MFTEMP (len=0)
|
||||
PHX
|
||||
:L1 PLX
|
||||
JSR SEGMENT ; Extract segment of pathname
|
||||
JSR SEGMENT ; Extract segment of pathname
|
||||
BCC :NOTLST
|
||||
DEC :LAST
|
||||
:NOTLST PHX
|
||||
LDA SEGBUF ; Length of segment
|
||||
BNE :S1 ; Check for zero length segments
|
||||
LDA :LAST ; If not the last segment ...
|
||||
BEQ :L1 ; ... go again
|
||||
:S1 JSR HASWILD ; See if it has '*'/'#'/'?'
|
||||
BCS :WILD ; It does
|
||||
JSR APPSEG ; Not wild: Append SEGBUF to MFTEMP
|
||||
LDA SEGBUF ; Length of segment
|
||||
BNE :S1 ; Check for zero length segments
|
||||
LDA :LAST ; If not the last segment ...
|
||||
BEQ :L1 ; ... go again
|
||||
:S1 JSR HASWILD ; See if it has '*'/'#'/'?'
|
||||
BCS :WILD ; It does
|
||||
JSR APPSEG ; Not wild: Append SEGBUF to MFTEMP
|
||||
BRA :NEXT
|
||||
:WILD LDX #<MFTEMP ; Invoke SRCHDIR to look for pattern
|
||||
LDY #>MFTEMP ; in the directory path MFTEMP
|
||||
:WILD LDX #<MFTEMP ; Invoke SRCHDIR to look for pattern
|
||||
LDY #>MFTEMP ; in the directory path MFTEMP
|
||||
JSR SRCHDIR
|
||||
BCS :NOMATCH ; Wildcard did not match anything
|
||||
JSR APPSEG ; Append modified SEGBUF to MFTEMP
|
||||
BCS :NOMATCH ; Wildcard did not match anything
|
||||
JSR APPMATCH ; Append MATCHBUF to MFTEMP
|
||||
:NEXT LDA :LAST
|
||||
BEQ :L1
|
||||
PLX
|
||||
JSR TMPtoMF ; Copy the path we built to MOSFILE
|
||||
JSR TMPtoMF ; Copy the path we built to MOSFILE
|
||||
CLC
|
||||
RTS
|
||||
:NOMATCH PLX
|
||||
SEC
|
||||
RTS
|
||||
:LAST DB $00 ; Flag for last segment
|
||||
:LAST DB $00 ; Flag for last segment
|
||||
|
||||
* Obtain subsequent wildcard matches
|
||||
* WILDCARD must have been called first
|
||||
* Returns with carry set if wildcard match fails, clear otherwise
|
||||
WILDNEXT SEC ; Just say 'no match' for now
|
||||
RTS
|
||||
WILDNEXT LDX MFTEMP ; Length of MFTEMP
|
||||
:L1 CPX #$00 ; Find final segment (previous match)
|
||||
BEQ :S1
|
||||
LDA MFTEMP,X
|
||||
CMP #'/'
|
||||
BNE :S2
|
||||
DEX
|
||||
STX MFTEMP ; Trim MFTEMP
|
||||
BRA :S1
|
||||
:S2 DEX
|
||||
BRA :L1
|
||||
:S1 JSR SRCHDIR
|
||||
BCS :NOMATCH
|
||||
JSR APPMATCH ; Append MATCHBUF to MFTEMP
|
||||
JSR TMPtoMF ; Copy back to MOSFILE
|
||||
CLC
|
||||
:NOMATCH RTS
|
||||
|
||||
* Copy a segment of the path into SEGBUF
|
||||
* PREPATH makes all paths absolute, so always begins with '/'
|
||||
* On entry: X contains index of first char in MOSFILE to process
|
||||
* Set carry if no more segments, clear otherwise
|
||||
SEGMENT LDY #$00
|
||||
:L1 CPX MOSFILE ; See if we are done
|
||||
:L1 CPX MOSFILE ; See if we are done
|
||||
BEQ :NOMORE
|
||||
LDA MOSFILE+1,X
|
||||
CMP #'/'
|
||||
|
@ -67,22 +84,22 @@ SEGMENT LDY #$00
|
|||
INX
|
||||
INY
|
||||
BRA :L1
|
||||
:DONE STY SEGBUF ; Record the length
|
||||
:DONE STY SEGBUF ; Record the length
|
||||
LDA #$00
|
||||
STA SEGBUF+1,Y ; Null terminate for MATCH
|
||||
INX ; Skip the slash
|
||||
CLC ; Not the last one
|
||||
STA SEGBUF+1,Y ; Null terminate for MATCH
|
||||
INX ; Skip the slash
|
||||
CLC ; Not the last one
|
||||
RTS
|
||||
:NOMORE STY SEGBUF ; Record the length
|
||||
:NOMORE STY SEGBUF ; Record the length
|
||||
LDA #$00
|
||||
STA SEGBUF+1,Y ; Null terminate for MATCH
|
||||
SEC ; Last segment
|
||||
STA SEGBUF+1,Y ; Null terminate for MATCH
|
||||
SEC ; Last segment
|
||||
RTS
|
||||
|
||||
* See if SEGBUF contains any of '*', '#', '?'
|
||||
* Set carry if wild, clear otherwise
|
||||
HASWILD LDX #$00
|
||||
:L1 CPX SEGBUF ; At end?
|
||||
:L1 CPX SEGBUF ; At end?
|
||||
BEQ :NOTWILD
|
||||
LDA SEGBUF+1,X
|
||||
CMP #'*'
|
||||
|
@ -99,44 +116,64 @@ HASWILD LDX #$00
|
|||
RTS
|
||||
|
||||
* Append SEGBUF to MFTEMP
|
||||
APPSEG LDY MFTEMP ; Dest idx = length
|
||||
LDA #'/' ; Add a '/' separator
|
||||
APPSEG LDY MFTEMP ; Dest idx = length
|
||||
LDA #'/' ; Add a '/' separator
|
||||
STA MFTEMP+1,Y
|
||||
INY
|
||||
LDX #$00 ; Source idx
|
||||
:L1 CPX SEGBUF ; At end?
|
||||
LDX #$00 ; Source idx
|
||||
:L1 CPX SEGBUF ; At end?
|
||||
BEQ :DONE
|
||||
LDA SEGBUF+1,X
|
||||
STA MFTEMP+1,Y
|
||||
INX
|
||||
INY
|
||||
BRA :L1
|
||||
:DONE STY MFTEMP ; Update length
|
||||
:DONE STY MFTEMP ; Update length
|
||||
RTS
|
||||
|
||||
* Append MATCHBUF to MFTEMP
|
||||
APPMATCH LDY MFTEMP ; Dest idx = length
|
||||
LDA #'/' ; Add a '/' separator
|
||||
STA MFTEMP+1,Y
|
||||
INY
|
||||
LDX #$00 ; Source idx
|
||||
:L1 CPX MATCHBUF ; At end?
|
||||
BEQ :DONE
|
||||
LDA MATCHBUF+1,X
|
||||
STA MFTEMP+1,Y
|
||||
INX
|
||||
INY
|
||||
BRA :L1
|
||||
:DONE STY MFTEMP ; Update length
|
||||
RTS
|
||||
|
||||
* The following is required in order to be able to resume
|
||||
* a directory search
|
||||
WILDFILE DB $00 ; File ref num for open dir
|
||||
WILDIDX DB $00 ; Dirent idx in current block
|
||||
WILDFILE DB $00 ; File ref num for open dir
|
||||
WILDIDX DB $00 ; Dirent idx in current block
|
||||
|
||||
* Read directory, apply wildcard match
|
||||
* Inputs: directory name in XY (Pascal string)
|
||||
* If there is a match, replaces SEGBUF with the first match and CLC
|
||||
* If no match, or any other error, returns with carry set
|
||||
* Leaves the directory open to allow resumption of search.
|
||||
SRCHDIR STX OPENPL+1
|
||||
SRCHDIR LDA WILDIDX
|
||||
CMP #$FF ; Is it a new search?
|
||||
BEQ :NEW
|
||||
BRA :S1 ; Continue search
|
||||
:NEW STX OPENPL+1
|
||||
STY OPENPL+2
|
||||
JSR OPENFILE
|
||||
BCS :NODIR
|
||||
LDA OPENPL+5 ; File ref num
|
||||
STA WILDFILE ; Stash for later
|
||||
LDA OPENPL+5 ; File ref num
|
||||
STA WILDFILE ; Stash for later
|
||||
STA READPL+1
|
||||
:L1 JSR RDFILE ; Read->BLKBUF
|
||||
:L1 JSR RDFILE ; Read->BLKBUF
|
||||
BCC :S1
|
||||
CMP #$4C ; EOF
|
||||
CMP #$4C ; EOF
|
||||
BEQ :EOF
|
||||
BRA :BADDIR
|
||||
:S1 JSR SRCHBLK ; Handle one block
|
||||
:S1 JSR SRCHBLK ; Handle one block
|
||||
BCS :MATCH
|
||||
BRA :L1
|
||||
:MATCH CLC
|
||||
|
@ -149,46 +186,50 @@ SRCHDIR STX OPENPL+1
|
|||
* Close directory, if it was open
|
||||
* Preserves flags
|
||||
CLSDIR PHP
|
||||
LDA WILDFILE ; File ref num for open dir
|
||||
BEQ :ALREADY ; Already been closed
|
||||
LDA WILDFILE ; File ref num for open dir
|
||||
BEQ :ALREADY ; Already been closed
|
||||
STA CLSPL+1
|
||||
JSR CLSFILE
|
||||
STZ WILDFILE ; Not strictly necessary
|
||||
STZ WILDFILE ; Not strictly necessary
|
||||
:ALREADY PLP
|
||||
RTS
|
||||
|
||||
* Apply wildcard match to a directory block
|
||||
* Directory block is in BLKBUF
|
||||
* On exit: set carry if match, clear carry otherwise
|
||||
SRCHBLK LDA BLKBUF+4 ; Obtain storage type
|
||||
AND #$E0 ; Mask 3 MSBs
|
||||
SRCHBLK LDX WILDIDX
|
||||
CPX #$FF ; Is it a new search?
|
||||
BEQ :NEW
|
||||
BRA :CONT
|
||||
:NEW LDA BLKBUF+4 ; Obtain storage type
|
||||
AND #$E0 ; Mask 3 MSBs
|
||||
CMP #$E0
|
||||
BNE :NOTKEY
|
||||
LDX #$01 ; Skip dir name
|
||||
LDX #$01 ; Skip dir name
|
||||
BRA :L1
|
||||
:NOTKEY LDX #$00
|
||||
:L1 PHX
|
||||
JSR MATCHENT
|
||||
PLX
|
||||
BCS :MATCH
|
||||
INX
|
||||
CPX #13 ; Number of dirents in block
|
||||
:CONT INX
|
||||
CPX #13 ; Number of dirents in block
|
||||
BNE :L1
|
||||
CLC ; Fell off end, no match
|
||||
:MATCH STX WILDIDX ; Record dirent idx for resume
|
||||
CLC ; Fell off end, no match
|
||||
:MATCH STX WILDIDX ; Record dirent idx for resume
|
||||
RTS
|
||||
|
||||
* Apply wildcard match to a directory entry
|
||||
* On entry: X = dirent index in BLKBUF
|
||||
* On exit: set carry if match, clear carry otherwise
|
||||
MATCHENT LDA #<BLKBUF+4 ; Skip pointers
|
||||
MATCHENT LDA #<BLKBUF+4 ; Skip pointers
|
||||
STA A1L
|
||||
LDA #>BLKBUF+4
|
||||
STA A1H
|
||||
:L1 CPX #$00
|
||||
BEQ :S1
|
||||
CLC
|
||||
LDA #$27 ; Size of dirent
|
||||
LDA #$27 ; Size of dirent
|
||||
ADC A1L
|
||||
STA A1L
|
||||
LDA #$00
|
||||
|
@ -197,26 +238,26 @@ MATCHENT LDA #<BLKBUF+4 ; Skip pointers
|
|||
DEX
|
||||
BRA :L1
|
||||
:S1 LDY #$00
|
||||
LDA (A1L),Y ; Length byte
|
||||
BEQ :NOMATCH ; Inactive entry
|
||||
INC A1L ; Inc ptr, skip length byte
|
||||
LDA (A1L),Y ; Length byte
|
||||
BEQ :NOMATCH ; Inactive entry
|
||||
INC A1L ; Inc ptr, skip length byte
|
||||
BNE :S2
|
||||
INC A1H
|
||||
:S2 JSR MATCH ; Try wildcard match
|
||||
:S2 JSR MATCH ; Try wildcard match
|
||||
BCC :NOMATCH
|
||||
LDA A1L ; Decrement ptr again
|
||||
LDA A1L ; Decrement ptr again
|
||||
BNE :S3
|
||||
DEC A1H
|
||||
:S3 DEC A1L
|
||||
LDY #$00 ; If matches, copy matching filename
|
||||
LDA (A1L),Y ; Length of filename
|
||||
AND #$0F ; Mask out other ProDOS stuff
|
||||
STA SEGBUF
|
||||
LDY #$00 ; If matches, copy matching filename
|
||||
LDA (A1L),Y ; Length of filename
|
||||
AND #$0F ; Mask out other ProDOS stuff
|
||||
STA MATCHBUF
|
||||
TAY
|
||||
:L2 CPY #$00
|
||||
BEQ :MATCH
|
||||
LDA (A1L),Y
|
||||
STA SEGBUF,Y
|
||||
STA MATCHBUF,Y
|
||||
DEY
|
||||
BRA :L2
|
||||
:MATCH SEC
|
||||
|
@ -230,45 +271,48 @@ MATCHENT LDA #<BLKBUF+4 ; Skip pointers
|
|||
* Output: Carry bit = 1 if the string matches the pattern, = 0 if not.
|
||||
* Notes: Clobbers A, X, Y. Each * in the pattern uses 4 bytes of stack.
|
||||
|
||||
MATCH1 EQU '?' ; Matches exactly 1 character
|
||||
MATCHN EQU '*' ; Matches any string (including "")
|
||||
STR EQU A1L ; Pointer to string to match
|
||||
MATCH1 EQU '?' ; Matches exactly 1 character
|
||||
MATCHN EQU '*' ; Matches any string (including "")
|
||||
STR EQU A1L ; Pointer to string to match
|
||||
|
||||
MATCH LDX #$00 ; X is an index in the pattern
|
||||
LDY #$FF ; Y is an index in the string
|
||||
:NEXT LDA SEGBUF+1,X ; Look at next pattern character
|
||||
CMP #MATCHN ; Is it a star?
|
||||
BEQ :STAR ; Yes, do the complicated stuff
|
||||
INY ; No, let's look at the string
|
||||
CMP #MATCH1 ; Is the pattern caracter a ques?
|
||||
BNE :REG ; No, it's a regular character
|
||||
LDA (STR),Y ; Yes, so it will match anything
|
||||
BEQ :FAIL ; except the end of string
|
||||
:REG CMP (STR),Y ; Are both characters the same?
|
||||
BNE :FAIL ; No, so no match
|
||||
INX ; Yes, keep checking
|
||||
CMP #0 ; Are we at end of string?
|
||||
BNE :NEXT ; Not yet, loop
|
||||
:FOUND RTS ; Success, return with C=1
|
||||
MATCH LDX #$00 ; X is an index in the pattern
|
||||
LDY #$FF ; Y is an index in the string
|
||||
:NEXT LDA SEGBUF+1,X ; Look at next pattern character
|
||||
CMP #MATCHN ; Is it a star?
|
||||
BEQ :STAR ; Yes, do the complicated stuff
|
||||
INY ; No, let's look at the string
|
||||
CMP #MATCH1 ; Is the pattern caracter a ques?
|
||||
BNE :REG ; No, it's a regular character
|
||||
LDA (STR),Y ; Yes, so it will match anything
|
||||
BEQ :FAIL ; except the end of string
|
||||
:REG CMP (STR),Y ; Are both characters the same?
|
||||
BNE :FAIL ; No, so no match
|
||||
INX ; Yes, keep checking
|
||||
CMP #0 ; Are we at end of string?
|
||||
BNE :NEXT ; Not yet, loop
|
||||
:FOUND RTS ; Success, return with C=1
|
||||
|
||||
:STAR INX ; Skip star in pattern
|
||||
CMP SEGBUF+1,X ; String of stars equals one star
|
||||
BEQ :STAR ; so skip them also
|
||||
:STLOOP TXA ; We first try to match with * = ""
|
||||
PHA ; and grow it by 1 character every
|
||||
TYA ; time we loop
|
||||
PHA ; Save X and Y on stack
|
||||
JSR :NEXT ; Recursive call
|
||||
PLA ; Restore X and Y
|
||||
:STAR INX ; Skip star in pattern
|
||||
CMP SEGBUF+1,X ; String of stars equals one star
|
||||
BEQ :STAR ; so skip them also
|
||||
:STLOOP TXA ; We first try to match with * = ""
|
||||
PHA ; and grow it by 1 character every
|
||||
TYA ; time we loop
|
||||
PHA ; Save X and Y on stack
|
||||
JSR :NEXT ; Recursive call
|
||||
PLA ; Restore X and Y
|
||||
TAY
|
||||
PLA
|
||||
TAX
|
||||
BCS :FOUND ; We found a match, return with C=1
|
||||
INY ; No match yet, try to grow * string
|
||||
LDA (STR),Y ; Are we at the end of string?
|
||||
BNE :STLOOP ; Not yet, add a character
|
||||
:FAIL CLC ; Yes, no match found, return with C=0
|
||||
BCS :FOUND ; We found a match, return with C=1
|
||||
INY ; No match yet, try to grow * string
|
||||
LDA (STR),Y ; Are we at the end of string?
|
||||
BNE :STLOOP ; Not yet, add a character
|
||||
:FAIL CLC ; Yes, no match found, return with C=0
|
||||
RTS
|
||||
|
||||
SEGBUF DS 65 ; For storing path segments (Pascal str)
|
||||
SEGBUF DS 65 ; For storing path segments (Pascal str)
|
||||
MATCHBUF DS 65 ; For storing match results (Pascal str)
|
||||
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue