// Dirs.Bcpl -- versionless directory code
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified October 27, 1981 2:55 PM by Boggs
get "AltoFileSys.d"
get "Disks.d"
get "Streams.d"
external
[
// outgoing procedures
FindFdEntry; MakeNewFdEntry; DeleteFdEntry; ParseFileName
DeleteFile; OpenFile; OpenFileFromFp; SetWorkingDir
StripVersion; AppendVersion
// incoming procedures
ScanDirBuffer; InitScanStream; GetScanStreamBuffer; FinishScanStream
Gets; Puts; Resets; Errors; Closes
WriteBlock; SetFilePos
CreateDiskStream; GetCompleteFa; LnPageSize; JumpToFa
Allocate; Free; SysErr
CreateDiskFile; DeleteDiskPages; ActOnDiskPages
MoveBlock; Zero; Noop; DefaultArgs; Dvec; Min
// outgoing static
dirVersions
// incoming statics
sysZone; sysDisk
]
static [ dirVersions = false ]
manifest
[
// error codes
ecDeTooBig = 1501
ecBadDeType = 1502
ecBadDirName = 1503
ecFnTooLong = 1504
ecCantOpenFile = 1505
maxExtraSpace = lSTRING
maxDeSize = lDV+maxLengthFnInWords+maxExtraSpace
maxFreeDeSize = (1 lshift size DV.length)-1
fnMask = not (40b*(400b+1)) //137,,137 in case you didn't guess...
// version control masks (see definitions of verxxx in streams.d)
verCrMask = 40000B // if non-zero, create file ok
]
structure HD: // Hole Descriptor
[
maxSize word
neededSize word
pos word
]
compileif size HD/16 ne 3 then [ Error("Change lHD in Streams.d") ]
structure SDB: // ScanDirBuffer state -- must agree with DirScanA.asm
[
name word // -> name being looked up (all upper-case)
length word // number of words to check in name
ignoreFree word // true to skip over free entries, false to stop on each one
scratch word 5 // scratch region used by ScanDirBuffer procedure
]
manifest lenSDB = size SDB/16
structure FSS: // File Scan State
[
buffer word // -> current buffer (0 => hit end-of-file)
pos word // word position in buffer of current directory entry
endPos word // word position of first word not in buffer
basePos word // file word position of first word of buffer
ssd word // -> Scan Stream Descriptor
]
//---------------------------------------------------------------------------
let FindFdEntry(dirS, name, compareFn, dv, hd, nil,
extraSpace; numargs na) = valof
//---------------------------------------------------------------------------
// FindFdEntry returns the position, or -1 if the name is not found.
// The name is not parsed so this should have already been done.
// If dv is supplied, the dv of the name we find is returned in it.
// If hd is supplied, it is filled in with a hole descriptor for a hole big
// enough to hold an entry for name with extraSpace extra words of space.
// If compareFn is supplied, it should return 0 if the entry should be
// accepted.
[
let extraBuf = 1 lshift LnPageSize(dirS)
Dvec(FindFdEntry, lv extraBuf)
let d, h = vec lDV, vec lHD
DefaultArgs(lv na, -2, 0, d, h, nil, 0)
Zero(hd, lHD)
hd>>HD.neededSize = extraSpace
let lNameInWords = nil
let sdb = vec lenSDB
sdb>>SDB.ignoreFree = false
let capName = vec maxLengthFnInWords
if compareFn eq 0 then
[
// the +2 adds the length byte and rounds up
let t = name>>STRING.length + 2
// the -1 takes off the trailing $.
lNameInWords = (t-1) rshift 1
hd>>HD.neededSize = Min(t rshift 1 + lDV + extraSpace, maxDeSize)
// Set up ScanDirBuffer state and generate capitalized version of name
sdb>>SDB.name = capName
sdb>>SDB.length = lNameInWords
capName!0 = name!0 & 177737B
for i = 1 to lNameInWords-1 do capName!i = name!i & fnMask
]
let tempDV = vec maxDeSize
let bestPos = -1
let holeFA = vec lFA; holeFA>>FA.charPos = 0
// The following must be declared in the order defined in the FSS structure
let buffer, pos, endPos, basePos, ssd = 0, 0, 0, 0, nil
let fss = lv buffer
Resets(dirS)
ssd = InitScanStream(dirS, lv extraBuf, 1)
AdvanceBuffer(fss)
while buffer ne 0 & pos ls endPos do
[
// Advance the pointer to the first "interesting" directory entry.
// The call to ScanDirBuffer accelerates the search, but if the call is
// omitted the search still works, only more slowly.
if compareFn eq 0 then
pos = ScanDirBuffer(buffer+pos, buffer+endPos, sdb) - buffer
// Now inspect the entry carefully.
let filePos = basePos + pos
let thisDV = buffer + pos
let len = thisDV>>DV.length
switchon thisDV>>DV.type into
[
case dvTypeFree:
[
// note that we never accumulate a sequence of free blocks longer
// than neededSize+(size of biggest free block)
if sdb>>SDB.ignoreFree then endcase // already found hole
if hd>>HD.pos+hd>>HD.maxSize ne filePos then
[ // Not adjacent to previous hole; record beginning of new one
hd>>HD.maxSize = 0
hd>>HD.pos = filePos
holeFA>>FA.da = ssd>>SSD.da
holeFA>>FA.pageNumber = ssd>>SSD.pageNumber
]
hd>>HD.maxSize = hd>>HD.maxSize+len
sdb>>SDB.ignoreFree = hd>>HD.maxSize ge hd>>HD.neededSize
endcase
]
case dvTypeFile:
[
// keep a malformed directory entry from overflowing thisName
if len gr maxDeSize then Errors(dirS, ecDeTooBig, filePos)
MoveBlock(tempDV, thisDV, len)
pos = pos+len
if pos ge endPos then
[ AdvanceBuffer(fss); MoveBlock(tempDV+len-pos, buffer, pos) ]
test compareFn eq 0
ifso
[ //default system compareFn
tempDV!len = 1 // fake next block of length 1 to stop scan
unless ScanDirBuffer(tempDV, tempDV+len+1, sdb) eq tempDV loop
]
ifnot unless compareFn(name, tempDV+lDV, tempDV) eq 0 loop
// If we get here, the desired entry was found
MoveBlock(dv, tempDV, lDV)
bestPos = filePos
break
]
default: // unknown type of directory entry
[
Errors(dirS, ecBadDeType, filePos)
endcase
]
]
pos = pos+len
while pos ge endPos & buffer ne 0 do AdvanceBuffer(fss)
]
FinishScanStream(ssd)
// If we found a hole and did not find a matching directory entry, position
// the stream to the page containing the hole.
// If we did not find a hole, set the HD.pos to end-of-file.
test sdb>>SDB.ignoreFree
ifso if bestPos eq -1 & hd ne h then JumpToFa(dirS, holeFA)
ifnot hd>>HD.pos = basePos+pos
resultis bestPos
]
//---------------------------------------------------------------------------
and AdvanceBuffer(fss) be
//---------------------------------------------------------------------------
[
fss>>FSS.buffer = GetScanStreamBuffer(fss>>FSS.ssd)
fss>>FSS.basePos = fss>>FSS.basePos + fss>>FSS.endPos
fss>>FSS.pos = fss>>FSS.pos - fss>>FSS.endPos
fss>>FSS.endPos = fss>>FSS.ssd>>SSD.numChars rshift 1
]
//---------------------------------------------------------------------------
and MakeNewFdEntry(dirS, name, dv, hd, extraStuff) be
//---------------------------------------------------------------------------
// Make an entry (name, dv) of size hd>>HD.neededSize in dirS at the hole
// specified by hd. This hole is of size hd>>HD.maxSize, which is either
// bigger than hd>>HD.neededSize or at the end of dirS. The hd's
// maxSize-neededSize must not be greater than maxFreeDeSize; hd's
// produced by FindFdEntry have this property, since they are obtained by
// concatenating free de's until a big enough hole is obtained.
// The name should be parsed by the caller.
[
let lNameInWords = name>>STRING.length rshift 1 +1
if lNameInWords gr maxLengthFnInWords then Errors(dirS, ecFnTooLong, name)
dv>>DV.type = dvTypeFile
dv>>DV.length = hd>>HD.neededSize
SetFilePos(dirS, 0, 2*(hd>>HD.pos))
WriteBlock(dirS, dv, lDV)
WriteBlock(dirS, name, lNameInWords)
WriteBlock(dirS, extraStuff, hd>>HD.neededSize-lDV-lNameInWords)
let extra = hd>>HD.maxSize-hd>>HD.neededSize
if extra gr 0 then //make remaining words into a free block
[
let h = nil
h<<DV.type = dvTypeFree
h<<DV.length = extra
Puts(dirS, h)
]
]
//---------------------------------------------------------------------------
and DeleteFdEntry(dirS, pos) be
//---------------------------------------------------------------------------
[
SetFilePos(dirS, 0, 2*pos)
let h = Gets(dirS)
h<<DV.type = dvTypeFree
SetFilePos(dirS, 0, 2*pos)
Puts(dirS, h)
]
//---------------------------------------------------------------------------
and ParseFileName(fn, n, list, versionControl) = valof
//---------------------------------------------------------------------------
// Parses n into fn, appending a $. if necessary
// Returns a directory stream in which to look for the name.
// list!0 = errRtn; list!1 = zone; list!3 = disk
[
let length = n>>STRING.length; let sep = 0
for i = 1 to length do
[
let c = n>>STRING.char↑i
if c eq $< % c eq $> then sep = i
]
let dirFn = vec maxLengthFnInWords
ExtractLegalFileName(n, dirFn, 0, sep-1)
ExtractLegalFileName(n, fn, sep, length)
// Now need to check to see if dirFn is null (in which case use WorkingDir)
// or <, in which case use SysDir
let fp = 0
let disk = list!3
if dirFn>>STRING.length eq 0 then
[
// Assume working directory:
fp = disk>>DSK.fpWorkingDir
dirFn = disk>>DSK.nameWorkingDir
if n>>STRING.char↑sep eq $< then [ fp = disk>>DSK.fpSysDir; dirFn = 0 ]
]
resultis OpenFile(dirFn, 0, 0, versionControl, fp, list!0, list!1,
nil, disk, 0, 100000b)
]
//---------------------------------------------------------------------------
and ExtractLegalFileName(srcS, destS, firstMinus1, last) be
//---------------------------------------------------------------------------
[
let length = last - firstMinus1
Zero(destS, (length+3) rshift 1) // in particular, zero length & garbage byte
if length gr 0 then
[
for i = 1 to length do //make sure each character is legal
[
let char = srcS>>STRING.char↑(firstMinus1+i)
switchon char into
[
default:
unless ((char&137B) ge $A & (char&137B) le $Z) %
(char ge $0 & char le $9) do char = $-
case $-: case $$: case $!:
case $+: case $.: case $<: case $>:
]
destS>>STRING.char↑i = char
]
destS>>STRING.length = length
StripVersion(destS) // append $. if necessary
]
]
//---------------------------------------------------------------------------
and SetWorkingDir(name, fp, disk; numargs na) be
//---------------------------------------------------------------------------
[
if na ls 3 then disk = sysDisk
MoveBlock(disk>>DSK.fpWorkingDir, fp, lFP)
MoveBlock(disk>>DSK.nameWorkingDir, name, maxLengthFnInWords)
]
//---------------------------------------------------------------------------
and OpenFile(name, ksType, itemSize, versionControl, hintFp, errRtn,
zone, nil, disk, CreateStream, SNword; numargs na) = valof
//---------------------------------------------------------------------------
[
let defaultFp = vec lFP
DefaultArgs(lv na, -1, ksTypeReadWrite, wordItem, 0, defaultFp, SysErr,
sysZone, nil, sysDisk, CreateDiskStream, 0)
if versionControl eq 0 then
versionControl = ksType eq ksTypeReadOnly? verLatest, verLatestCreate
[ // repeat
// Following check tries to decide whether the hint is filled in.
// It may be that user just wants it filled in.
// On the second iteration it will always call CreateStream.
if hintFp ne defaultFp & hintFp>>FP.version ne 0 then
[
let s = CreateStream(hintFp, ksType, itemSize, Noop, errRtn,
zone, nil, disk)
if s ne 0 resultis s
]
if defaultFp eq 0 resultis errRtn(nil, ecCantOpenFile)
defaultFp = 0 // Force CreateStream to be done on next iteration
// blunder check
if name eq 0 % name>>STRING.length eq 0 resultis 0
let fixedName, dv, hd = vec maxLengthFnInWords, vec lDV, vec lHD
// strip off the directory info, return a name body and dir stream
let currentDirS = ParseFileName(fixedName, name, lv errRtn, versionControl)
if currentDirS eq 0 resultis 0 //no such directory
// go look in the directory for the file.
if FindFdEntry(currentDirS, fixedName, 0, dv, hd) eq -1 then
[ // Not there; allowed to create?
if (versionControl & verCrMask) eq 0 then
[ Closes(currentDirS); resultis 0 ]
let dirCfa = vec lCFA; GetCompleteFa(currentDirS, dirCfa)
CreateDiskFile(disk, fixedName, lv dv>>DV.fp, lv dirCfa>>CFA.fp, SNword)
MakeNewFdEntry(currentDirS, fixedName, dv, hd)
]
Closes(currentDirS)
MoveBlock(hintFp, lv dv>>DV.fp, lFP)
] repeat
]
//---------------------------------------------------------------------------
and OpenFileFromFp(fp) = OpenFile(0, 0, 0, 0, fp)
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
and DeleteFile(name, nil, errRtn, zone, nil, disk; numargs n) = valof
//---------------------------------------------------------------------------
// returns false if it couldn't find the file
[
DefaultArgs(lv n, -1, verOldest, SysErr, sysZone, nil, sysDisk)
let fixedName = vec maxLengthFnInWords
let dv = vec lDV
let currentDirS = ParseFileName(fixedName, name, lv errRtn, verLatest)
if currentDirS eq 0 resultis false //bad directory name
let pos = FindFdEntry(currentDirS, fixedName, 0, dv)
if pos eq -1 then [ Closes(currentDirS); resultis false ]
DeleteFdEntry(currentDirS, pos)
Closes(currentDirS)
let buf = Allocate(zone, 1 lshift (disk>>DSK.lnPageSize))
// Need to read the leader page in order to get the last page hint.
// This costs an extra revolution, but will usually be much less costly
// than letting the disk seek to cylinder 0 when it reaches end-of-file
// during the delete.
ActOnDiskPages(disk, lv buf, lv dv>>DV.fp.leaderVirtualDa, lv dv>>DV.fp,
0, 0, DCreadD)
// Delete all pages of the file, starting with page 0
DeleteDiskPages(disk, buf, dv>>DV.fp.leaderVirtualDa, lv dv>>DV.fp,
0, 0, buf>>LD.hintLastPageFa.pageNumber)
Free(zone, buf)
resultis true
]
//---------------------------------------------------------------------------
and StripVersion(fn, lvVersionExists; numargs na) = valof
//---------------------------------------------------------------------------
[
if na gr 1 then @lvVersionExists = false
let len = fn>>STRING.length
if fn>>STRING.char↑len ne $. then
[
fn>>STRING.length = len +1
fn>>STRING.char↑(len+1) = $.
]
resultis 0
]
//---------------------------------------------------------------------------
and AppendVersion(nil, nil) be [ ]
//---------------------------------------------------------------------------