TriOS-alt/zubehör/sphinx/spinx100225-ori/sphinx1/del.spn

246 lines
6.2 KiB
Plaintext

' 2009-08-08 fixed off-by-one error in try
SXTVRENDEZVOUS = $8000 - 4
SXKBRENDEZVOUS = SXTVRENDEZVOUS - 4
SDSPIRENDEZVOUS = SXKBRENDEZVOUS - 3 * 4
SXFS2RENDEZVOUS = SDSPIRENDEZVOUS - 4 * 4 ' four rendezvous variables
SXFSRENDEZVOUS = SXFS2RENDEZVOUS - 4 * 4 ' four rendezvous variables
METADATABUFFER = SXFSRENDEZVOUS - 512
_free = ($8000 - METADATABUFFER) / 4
obj
term: "isxtv"
kb: "isxkb"
f: "sxfile"
pub main | err
err := \try
if err > 0
term.str( err )
term.out( 13 )
elseif err < 0
term.str( string("error ") )
term.dec( err )
term.out( 13 )
f.Close
f.Open( string("sphinx.bin"), "R" )
f.Execute( 0 )
con
ARGSTRINGLENGTH = 12 ' 8 + . + 3
DIRSTRINGLENGTH = 11 ' 8 + 3
var
byte argstring[ARGSTRINGLENGTH + 1] ' + null
byte dirstring[DIRSTRINGLENGTH + 1] ' + null (terminator not strictly necessary, but convenient for debug printing)
byte optionstring[3]
byte needConfirmation
pri try | nArgs
needConfirmation~~
f.Open( string("args.d8a"), "R" )
if nArgs := f.ReadByte
f.ReadString( @argstring, ARGSTRINGLENGTH )
if nArgs > 1
f.ReadStringUpperCase( @optionstring, 2 )
if strcomp( @optionstring, string("/Y") )
needConfirmation~
else
abort string("No files specified")
f.Close
ExpandWildcards
MyMount
Delete
FlushMetadata
pri ExpandWildcards | i, j
i~
j~
bytefill( @dirstring, " ", DIRSTRINGLENGTH )
dirstring[DIRSTRINGLENGTH]~
repeat while argstring[j]
if argstring[j] == "*"
if i < 8
repeat
dirstring[i++] := "?"
until i == 8
elseif i < 11
repeat
dirstring[i++] := "?"
until i == 11
else
abort string("bad wildcard")
elseif argstring[j] == "."
if i =< 8
i := 8
else
abort string("filename too long")
else
if i < DIRSTRINGLENGTH
dirstring[i++] := argstring[j]
else
abort string("filename too long")
++j
con
pCommand = SDSPIRENDEZVOUS
pParam = pCommand + 4
pBlockno = pCommand + 8
pri readblock(n, b)
'
' Read a single block. The "n" passed in is the
' block number (blocks are 512 bytes); the b passed
' in is the address of 512 blocks to fill with the
' data.
'
long[pParam] := b
long[pBlockno] := n
long[pCommand] := "R"
repeat while long[pCommand]
if long[pParam]
abort long[pParam]
return 0
pub writeblock(n, b)
'
' Write a single block. Mirrors the read above.
'
long[pParam] := b
long[pBlockno] := n
long[pCommand] := "W"
repeat while long[pCommand]
if long[pParam]
abort long[pParam]
return 0
con
SECTORSIZE = 512
SECTORSHIFT = 9
DIRSIZE = 32
DIRSHIFT = 5
con
{ long } _length = 0
{ long } _leftInFile = 4
{ long } _sopDir = 8 ' sector/offset "pointer" to directory entry
{ long } _sopTail = 12 ' sector/offset "pointer" to last cluster# in FAT chain
{ word } _cluster = 16
{ word } _sector = 18 ' sector# within cluster; ranges from 0 to sectorsPerCluster-1
{ word } _bp = 20 ' byte pointer (actually an index into the sector buffer); range [0..511]
_buffer = 24
SIZEOFIOBLOCK = SECTORSIZE + 24
dat
long
myMetadataBuffer byte 0[512]
myMetadataSector word -1
dirty byte 0
clusterShift byte 0
pri FlushMetadata
if dirty~
writeblock( myMetadataSector, @myMetadataBuffer )
pri ReadMetadataSector( s )
if myMetadataSector == s
return
FlushMetadata
readblock( myMetadataSector := s, @myMetadataBuffer )
var
word bytesPerSector
byte sectorsPerCluster
word reservedSectors
byte numberOfFats
word sectorsPerFat
word numberOfRootDirectoryEntries
long fat1[0]
long fatSector0
long dirSector0
long dataregion[0]
long dataSector0
pri Delete | s, p, ch
s := dirSector0
repeat numberOfRootDirectoryEntries >> 4
p := @myMetadataBuffer
repeat 16
ReadMetadataSector( s )
ifnot byte[p]
return
if byte[p] == $e5 ' already deleted?
p += 32
next
if byte[p][$0b] & $0f == 0 and Match( p, @dirstring, 11 )
ifnot needConfirmation
term.str( string("Deleting ") )
repeat 11
term.out( byte[p++] )
p -= 11
term.out( " " )
term.dec( PeekL( p + $1c ) )
if needConfirmation
term.str( string(" -- delete? ") )
ch := kb.getkey
term.out( ch )
else
ch := "y"
if ch == "y" or ch == "Y"
byte[p] := $e5 ' mark as deleted
dirty~~
term.out( 13 )
p += 32
++s
FlushMetadata
pri Match( p, q, n ) | c1, c2
repeat n
c1 := byte[p++]
c2 := byte[q++]
if "a" =< c1 and c1 =< "z"
c1 += "A" - "a"
if "a" =< c2 and c2 =< "z"
c2 += "A" - "a"
if c2 == "?"
next
if c1 <> c2
return false
return true
pri MyMount | pbrSector ,i
pbrSector~
repeat
ReadMetadataSector( pbrSector )
if bytecomp( @myMetadataBuffer+$36, string("FAT16"), 5 )
quit
if pbrSector
abort -20 ' not FAT16
pbrSector := PeekL( @myMetadataBuffer + $1c6 )
bytesPerSector := PeekW( @myMetadataBuffer + $0b )
sectorsPerCluster := myMetadataBuffer[$0d]
clusterShift := >| sectorsPerCluster - 1
reservedSectors := PeekW( @myMetadataBuffer + $0e )
numberOfFats := myMetadataBuffer[$10]
sectorsPerFat := PeekW( @myMetadataBuffer + $16 )
numberOfRootDirectoryEntries := PeekW( @myMetadataBuffer + $11 )
fatSector0 := pbrSector + reservedSectors
dirSector0 := fatSector0 + numberOfFats * sectorsPerFat
dataSector0 := dirSector0 + numberOfRootDirectoryEntries >> 4
pri bytecomp( p, q, n )
repeat n
if byte[p++] <> byte[q++]
return
return true
pri PeekW( a )
return byte[a++] + byte[a] << 8
pri PeekL( a )
return byte[a++] + byte[a++] << 8 + byte[a++] << 16 + byte[a] << 24