Apple-2-SW
/
Applecorn
mirror of https://github.com/bobbimanners/Applecorn.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Wildcards implemented for *DIR only at present.

This commit is contained in:
Bobbi Webber-Manners 2021-09-09 13:38:27 -04:00
parent ee25c7b25c
commit 2ceebae7c1
20 changed files with 241 additions and 210 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
applecorn.po
View File

Binary file not shown.

2
applecorn.s
View File

@ -186,3 +186,5 @@ MAINZP MAC

2
auxmem.bytwrd.s
View File

@ -541,3 +541,5 @@ OSBM2 ASC ').'

2
auxmem.chario.s
View File

@ -445,3 +445,5 @@ KBDDONE RTS

2
auxmem.hostfs.s
View File

@ -901,3 +901,5 @@ ERROR2E DW $C800

2
auxmem.init.s
View File

@ -158,3 +158,5 @@ HELLO ASC 'Applecorn MOS 2021-09-06 snapshot'

2
auxmem.misc.s
View File

@ -472,3 +472,5 @@ AUXBLK ASC '**ENDOFCODE**'

2
auxmem.mosequ.s
View File

@ -74,3 +74,5 @@ OSFILECB EQU $2EE ; OSFILE control block

2
auxmem.oscli.s
View File

@ -574,3 +574,5 @@ ECHO3 PHP

2
auxmem.vdu.s
View File

@ -503,3 +503,5 @@ BYTEA0 LDY #79 ; Read VDU variable $09,$0A

4
extract
View File

@ -1,10 +1,10 @@
#!/bin/sh
for file in APPLECORN AUXMEM.BYTWRD AUXMEM.CHARIO AUXMEM.HOSTFS AUXMEM.INIT AUXMEM.MISC AUXMEM.MOSEQU AUXMEM.OSCLI AUXMEM.VDU MAINMEM.FSEQU MAINMEM.INIT MAINMEM.LDR MAINMEM.LISTS MAINMEM.MENU MAINMEM.MISC MAINMEM.PATH MAINMEM.SVC; do
for file in APPLECORN AUXMEM.BYTWRD AUXMEM.CHARIO AUXMEM.HOSTFS AUXMEM.INIT AUXMEM.MISC AUXMEM.MOSEQU AUXMEM.OSCLI AUXMEM.VDU MAINMEM.FSEQU MAINMEM.INIT MAINMEM.LDR MAINMEM.LISTS MAINMEM.MENU MAINMEM.MISC MAINMEM.PATH MAINMEM.SVC MAINMEM.WILD; do
cadius extractfile applecorn.po /APPLECORN/${file}.S .
rm _FileInformation.txt
cadius clearhighbit ${file}.S\#040000
cadius indentfile ${file}.S\#040000
FNAME=`echo ${file}.s | tr [:upper:] [:lower:]`
FNAME=`echo ${file}.S | tr [:upper:] [:lower:]`
mv -v ${file}.S\#040000 $FNAME
done
git diff

2
mainmem.fsequ.s
View File

@ -50,3 +50,5 @@ GEOFCMD EQU $D1

2
mainmem.init.s
View File

@ -96,3 +96,5 @@ RESET TSX

2
mainmem.ldr.s
View File

@ -125,3 +125,5 @@ CANTOPEN ASC "Unable to open ROM file"

2
mainmem.lists.s
View File

@ -100,3 +100,5 @@ QUITPL HEX 04 ; Number of parameters

2
mainmem.menu.s
View File

@ -131,3 +131,5 @@ ROM8 STR "USERROM2.ROM"

2
mainmem.misc.s
View File

@ -149,3 +149,5 @@ FILEREFS DB $00,$00,$00,$00

2
mainmem.path.s
View File

@ -276,3 +276,5 @@ PREFIX DS 65 ; Buffer for ProDOS prefix

2
mainmem.svc.s
View File

@ -801,3 +801,5 @@ MAINRDEXIT >>> XF2AUX,NULLRTS ; Back to an RTS

413
mainmem.wild.s
View File

@ -9,197 +9,197 @@
* 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 ; 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
: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
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 ; 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
: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
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
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
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
* 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
SRCHDIR STX OPENPL+1
STY OPENPL+2
JSR OPENFILE
BCS :NODIR
LDA OPENPL+5 ; File ref num
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
PHP
BRA :CLOSE
SRCHDIR STX OPENPL+1
STY OPENPL+2
JSR OPENFILE
BCS :NODIR
LDA OPENPL+5 ; File ref num
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
PHP
BRA :CLOSE
:BADDIR
:EOF SEC
PHP
:CLOSE LDA OPENPL+5
STA CLSPL+1
JSR CLSFILE
PLP
RTS
:NODIR SEC
RTS
:EOF SEC
PHP
:CLOSE LDA OPENPL+5
STA CLSPL+1
JSR CLSFILE
PLP
RTS
:NODIR SEC
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 RTS
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 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
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
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
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.
@ -207,48 +207,45 @@ 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 "")
PATTERN EQU SEGBUF+1 ; Address of pattern
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 PATTERN,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 PATTERN,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
: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)
; Length needs to be >= 15
; TODO: No overflow check
SEGBUF DS 65 ; For storing path segments (Pascal str)