Apple-2-SW/Applecorn
1
0
Fork 0
mirror of https://github.com/bobbimanners/Applecorn.git synced 2024-06-15 19:29:32 +00:00
Code Issues Projects Releases Wiki Activity

More progress on multi-file wildcards. Still bugs!

Browse Source
This commit is contained in:
Bobbi Webber-Manners 2021-09-09 22:52:22 -04:00
parent b14b8ee71a
commit 9765af94c6
1 changed files with 140 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

236
mainmem.wild.s
View File

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