* 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 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 SRCHDIR to expand the wildcard. If not, just * 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) PHX :L1 PLX 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 BRA :NEXT :WILD LDX #MFTEMP ; in the directory path MFTEMP JSR SRCHDIR BCS :NOMATCH ; Wildcard did not match anything JSR APPSEG ; Append modified SEGBUF to MFTEMP :NEXT LDA :LAST BEQ :L1 PLX JSR TMPtoMF ; Copy the path we built to MOSFILE CLC RTS :NOMATCH PLX SEC RTS :LAST DB $00 ; Flag for last segment * 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 * 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, 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 STY OPENPL+2 JSR OPENFILE BCS :NODIR LDA OPENPL+5 ; File ref num STA WILDFILE ; Stash for later STA READPL+1 :L1 JSR RDFILE ; Read->BLKBUF BCC :S1 CMP #$4C ; EOF BEQ :EOF BRA :BADDIR :S1 JSR SRCHBLK ; Handle one block BCS :MATCH BRA :L1 :MATCH CLC BRA :EXIT :BADDIR :EOF :NODIR SEC :EXIT 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 SRCHBLK LDA BLKBUF+4 ; Obtain storage type AND #$E0 ; Mask 3 MSBs CMP #$E0 BNE :NOTKEY 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 BNE :L1 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 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 INC A1L ; Inc ptr, skip length byte BNE :S2 INC A1H :S2 JSR MATCH ; Try wildcard match BCC :NOMATCH 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 TAY :L2 CPY #$00 BEQ :MATCH LDA (A1L),Y STA SEGBUF,Y DEY BRA :L2 :MATCH SEC RTS :NOMATCH 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 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 :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)