Applecorn/mainmem.wild.s
2021-09-22 18:36:05 -04:00

393 lines
13 KiB
ArmAsm

* MAINMEM.WILD.S
* (c) Bobbi 2021 GPLv3
*
* Wildcard support
* Performs wildcard matching for operations that only require the
* first match. <*obj-spec*> in Acorn ADFS terminology.
WILDONE CLC
JSR WILDCARD
JSR CLSDIR
RTS
* Scan path in MOSFILE, break it into segments (ie: chunks delimited
* by '/'), and for each segment see if it contains wildcard chars.
* If so, pass it to SRCHBLK to expand the wildcard. If not, just
* append the segment as it is. Uses MFTEMP to build up the path.
* On entry: SEC to force leaf node lookup even if no wildcard,
* CLC otherwise
* Returns with carry set if wildcard match fails, clear otherwise
WILDCARD STZ :ALWAYS ; Set :ALWAYS if carry set
BCC :NORMAL
DEC :ALWAYS
:NORMAL STZ :LAST
LDX #$00 ; Start with first char
STX MFTEMP ; Clear MFTEMP (len=0)
PHX
:L1 PLX
JSR SEGMENT ; Extract segment of pathname
JSR CLSDIR ; Close open dir, if any
LDA #$F0 ; WILDIDX=$F0 denotes new search
STA WILDIDX
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
LDA :ALWAYS ; Always do leaf-node lookup?
BEQ :S2
LDA :LAST ; If it is the last segment do ..
BNE :WILD ; .. wildcard lookup anyhow (for *INFO)
:S2 JSR APPSEG ; Not wild: Append SEGBUF to MFTEMP
BRA :NEXT
:WILD LDX #<MFTEMP ; Invoke SRCHBLK to look for pattern
LDY #>MFTEMP ; in the directory path MFTEMP
:AGAIN JSR SRCHBLK
BCC :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
CLC
RTS
:NOMATCH LDA WILDIDX ; See if there are more blocks
CMP #$FF
BEQ :AGAIN ; Yes, go again
PLX
SEC
RTS
:LAST DB $00 ; Flag for last segment
:ALWAYS DB $00 ; Flag to always lookup leafnode
* Obtain subsequent wildcard matches
* WILDCARD must have been called first
* Returns with carry set if wildcard match fails, clear otherwise
* Caller should check WILDIDX and call again if value is $FF
WILDNEXT LDX MFTEMP ; Length of MFTEMP
:L1 CPX #$00 ; Find final segment (previous match)
BEQ :AGAIN
LDA MFTEMP,X
CMP #'/'
BNE :S2
DEX
STX MFTEMP ; Trim MFTEMP
BRA :AGAIN
:S2 DEX
BRA :L1
:AGAIN JSR SRCHBLK
BCC :NOMATCH
JSR APPMATCH ; Append MATCHBUF to MFTEMP
JSR TMPtoMF ; Copy back to MOSFILE
CLC
RTS
:NOMATCH LDA WILDIDX ; See if there are more blocks
CMP #$FF
BEQ :AGAIN ; Yes, go again
SEC
RTS
* Different version of WILDNEXT which is used by the *INFO handler
* Because it needs to intercept each block.
* TODO: Once this works, refactor/cleanup
WILDNEXT2 LDX MFTEMP ; Length of MFTEMP
:L1 CPX #$00 ; Find final segment (previous match)
BEQ :AGAIN
LDA MFTEMP,X
CMP #'/'
BNE :S2
DEX
STX MFTEMP ; Trim MFTEMP
BRA :AGAIN
:S2 DEX
BRA :L1
:AGAIN JSR SRCHBLK
BCC :NOMATCH
JSR APPMATCH ; Append MATCHBUF to MFTEMP
JSR TMPtoMF ; Copy back to MOSFILE
CLC
RTS
:NOMATCH SEC
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
BEQ :NOMORE
LDA MOSFILE+1,X
CMP #'/'
BEQ :DONE
STA SEGBUF+1,Y
INX
INY
BRA :L1
: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
RTS
:NOMORE STY SEGBUF ; Record the length
LDA #$00
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?
BEQ :NOTWILD
LDA SEGBUF+1,X
CMP #'*'
BEQ :WILD
CMP #'#'
BEQ :WILD
CMP #'?'
BEQ :WILD
INX
BRA :L1
:NOTWILD CLC
RTS
:WILD SEC
RTS
* Append SEGBUF to MFTEMP
APPSEG LDY MFTEMP ; Dest idx = length
LDA #'/' ; Add a '/' separator
STA MFTEMP+1,Y
INY
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
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
* Read directory block, apply wildcard match
* Inputs: directory name in XY (Pascal string)
* On exit: set carry if match, clear carry otherwise
* Leaves the directory open to allow resumption of search.
SRCHBLK LDA WILDIDX
CMP #$F0 ; Is it a new search?
BEQ :NEW
CMP #$FF ; Time to load another blk?
BEQ :READ ; Continue search in next blk
BRA :CONT ; Continue search in curr blk
:NEW STX OPENPL+1
STY OPENPL+2
JSR OPENFILE
BCS :NODIR
LDA OPENPL+5 ; File ref num
STA WILDFILE ; Stash for later
STA READPL+1
:READ JSR RDFILE ; Read->BLKBUF
BCC :CONT
CMP #$4C ; EOF
BNE :BADDIR
STZ WILDIDX ; So caller knows not to call again
:EOF
:BADDIR
:NODIR
CLC ; No match, caller checks WILDIDX ..
RTS ; .. to see if another block
:CONT JSR SRCHBLK2 ; Handle one block
RTS
* Close directory, if it was open
* Preserves flags
CLSDIR PHP
LDA WILDFILE ; File ref num for open dir
BEQ :ALREADY ; Already been closed
STA CLSPL+1
JSR CLSFILE
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
SRCHBLK2 LDX WILDIDX
CPX #$F0 ; 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 ; Not key block
LDX #$01 ; Skip dir name
BRA :L1
:NOTKEY LDX #$00
:L1 PHX
JSR MATCHENT
PLX
BCS :MATCH
:CONT INX
CPX #13 ; Number of dirents in blk
BNE :L1
LDX #$FF ; Reset index to -1 for nxt blk
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
STA A1L
LDA #>BLKBUF+4
STA A1H
:L1 CPX #$00
BEQ :S1
CLC
LDA #$27 ; Size of dirent
ADC A1L
STA A1L
LDA #$00
ADC A1H
STA A1H
DEX
BRA :L1
:S1 LDY #$00
LDA (A1L),Y ; Length byte
BEQ :NOMATCH ; Inactive entry
AND #$0F
TAY
INY
LDA #$00
STA (A1L),Y ; Null terminate filename for MATCH
INC A1L ; Inc ptr, skip length byte
BNE :S2
INC A1H
:S2 JSR MATCH ; Try wildcard match
PHP
LDA A1L ; Decrement ptr again
BNE :S3
DEC A1H
:S3 DEC A1L
PLP
BCC :NOMATCH
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 MATCHBUF,Y
DEY
BRA :L2
:MATCH SEC
RTS
:NOMATCH LDA #$00
LDY #$00
STA (A1L),Y ; Pretend entry is deleted
CLC
RTS
* From: http://6502.org/source/strings/patmatch.htm
* Input: A NUL-terminated, <255-length pattern at address PATTERN.
* A NUL-terminated, <255-length string pointed to by STR.
* 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
MATCH1A EQU '#' ; Matches exactly 1 character (alternate)
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?
BEQ :QUEST ; Yes
CMP #MATCH1A ; Alternate pattern char (hash)
BNE :REG ; No
:QUEST 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
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
RTS
SEGBUF DS 65 ; For storing path segments (Pascal str)
MATCHBUF DS 65 ; For storing match results (Pascal str)