// OldDirs.Bcpl -- directory stuff -- includes version number code
// Copyright Xerox Corporation 1979
// Last modified September 18, 1979 2:27 PM by Taft
get "AltoFileSys.d"
get "Disks.d"
get "Streams.d"
external
[
// outgoing procedures
FindFdEntry; MakeNewFdEntry; DeleteFdEntry
StripVersion; AppendVersion; ParseFileName
DeleteFile; OpenFile; OpenFileFromFp; SetWorkingDir
// incoming procedures
// from stream stuff
Gets; Puts; Resets; Endofs; Errors; Closes
ReadBlock; WriteBlock; SetFilePos; GetCompleteFa
CreateDiskStream; KsGetDisk
//Alloc
Allocate; Free
// from bfs
CreateDiskFile; DeleteDiskPages; ActOnDiskPages
// from OS
SysErr
// miscellaneous
MoveBlock; Zero; SetBlock; Noop
Dvec; DefaultArgs; ReadCalendar
// outgoing static
dirVersions
// incoming statics
sysZone; sysDisk
]
static [ dirVersions = true ]
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
// version control masks (see definitions of verxxx in streams.d)
verNewMask = #140000 //For testing eq verNew
verNewAMask = #170000 //For testing eq verNewAlways
verOlMask = #100000 //if non-zero, verNew % verOldest
verCrMask = #40000 //if non-zero, create file ok
verKeepMask = #77 //Only look at this many bits of version #
]
// hd: hole descriptor
//---------------------------------------------------------------------------
structure HD:[ maxSize word; neededSize word; pos word ]
//---------------------------------------------------------------------------
// FindFdEntry returns the position, or -1 if the name is not found.
// The name is not parsed (except to find the version number),
// so this should have already been done (see ParseFileName).
// 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.
//
// Version stuff works as follows:
// If there is a version in the "name," then it takes precedence
// over any other strategy.
// Otherwise, look at versionControl:
// = verLatest(default) => take highest version number
// = verLatestCreate => ditto
// = verOldest => take lowest version number
// = verNew+nToKeep => we are making a new version, (1+highest
// version found during scan of directory) = newV.
// if nToKeep eq 0 then nToKeep = defaultVersionsKept
// if we find a file with version ls newV-nToKeep, it can
// be re-used bodily; return it in dv, with pos ne -1.
// Always appends to the "name" the version needed.
//---------------------------------------------------------------------------
let FindFdEntry(dirS, name, compareFn, dv, hd, versionControl, extraSpace,
defaultVersionsKept; numargs na) = valof
//---------------------------------------------------------------------------
[
// ignores difference between upper and lower case
manifest fnMask = not (#40*(#400+1)) //137,,137 in case you didn't guess...
compileif lHD ne size HD/16 then [ foo = nil ]
let v = vec lDV; let h = vec lHD
let disk = KsGetDisk(dirS)
DefaultArgs(lv na, -2, 0, v, h, verLatest, 0,
disk>>DSK.diskKd>>KDH.defaultVersionsKept)
Zero(hd, lHD); hd>>HD.neededSize = extraSpace
let lNameInWords = 0
let givenVersion = 0
let givenVersionFlag = false;
if compareFn eq 0 then
[
givenVersion = StripVersion(name, lv givenVersionFlag)
// 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
// the 2 here is for the version number (!12) -- takes 2 words max
hd>>HD.neededSize = t rshift 1+2+lDV+extraSpace
if hd>>HD.neededSize gr maxDeSize then
hd>>HD.neededSize = maxDeSize
]
let thisDv = vec lDV
// "best" means largest version # if versionControl = verLatest else oldest
let verNewFlag = (versionControl & verNewMask) eq verNew
let bestVersion = -1
let bestPos = -1
let highestVersion = 0
let thisName = vec maxDeSize-lDV
Resets(dirS); let pos = 0
until Endofs(dirS) do
[
for i = 0 to lDV-1 do thisDv!i = Gets(dirS)
let l = 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 hd>>HD.maxSize ls hd>>HD.neededSize then
hd>>HD.maxSize = hd>>HD.maxSize+l
SetFilePos(dirS, 0, 2*(pos+l))
endcase
]
case dvTypeFile:
[
if hd>>HD.maxSize ls hd>>HD.neededSize then
[ hd>>HD.maxSize = 0; hd>>HD.pos = pos+l ]
// keep a malformed directory entry from overflowing thisName
if l gr maxDeSize then SysErr(dirS, ecDeTooBig, pos)
for i = 0 to l-(lDV+1) do thisName!i = Gets(dirS)
test compareFn eq 0
ifso
[ //default system compareFn
let thisVersion = StripVersion(thisName)
// the name, without version number, must match
for i = 0 to lNameInWords-1 do
if ((thisName!i xor name!i) & fnMask) ne 0 endcase
// if it does and we want a specific version, then check for
// it also, if version stuff is disabled completely, get out
// early....
if givenVersionFlag ne 0 % defaultVersionsKept le 0 then
test givenVersion eq thisVersion
ifso
[
MoveBlock(dv, thisDv, lDV)
bestPos = pos
break
]
ifnot endcase
// we want the highest (or lowest) version
if thisVersion gr highestVersion then
highestVersion = thisVersion
if (bestVersion eq -1) % ((versionControl&verOlMask) eq 0 ?
thisVersion gr bestVersion, thisVersion ls bestVersion) then
[
MoveBlock(dv, thisDv, lDV)
bestPos = pos
bestVersion = thisVersion
]
// passing over a file while creating a new one means we need
// to mark the "name" -> FP map invalid:
if verNewFlag then BumpLeaderVersion(disk, lv thisDv>>DV.fp)
endcase
]
ifnot if compareFn(name, thisName, thisDv) eq 0 resultis pos
endcase
]
default: // unknown type of directory entry
[
Errors(dirS, ecBadDeType, pos)
SetFilePos(dirS, 0, 2*(pos +l)) //skip it.
endcase
]
]
pos = pos +l
]
// if we didn't get any match, bestPos will still be -1, indicating failure
if compareFn eq 0 then
[
test givenVersionFlag ne 0
ifso bestVersion = givenVersion
ifnot if verNewFlag then
[
let keep = defaultVersionsKept
let okeep = versionControl & verKeepMask
if okeep then keep = okeep
if defaultVersionsKept le 0 then keep = 1
// make a "new" file (vn = vn+1) only if there is a previous version
// and it had a vn or if verNewAlways:
if defaultVersionsKept gr 0 & (highestVersion gr 0 %
(versionControl & verNewAMask) eq verNewAlways) then
[
// if found file, but can't delete, return pos = -1
// (never happens if versions are disabled):
if highestVersion - keep +1 ls bestVersion then bestPos = -1
bestVersion = highestVersion +1
]
]
// append the version -- by convention, no version means version 1
if bestVersion gr 0 then AppendVersion(name, bestVersion)
// now revise the space estimate to be exact
hd>>HD.neededSize = (name>>STRING.length +2) rshift 1 + lDV + extraSpace
]
resultis bestPos
]
//---------------------------------------------------------------------------
and BumpLeaderVersion(disk, fp) be
//---------------------------------------------------------------------------
[
let ld = 1 lshift (disk>>DSK.lnPageSize)
Dvec(BumpLeaderVersion, lv ld)
let DAs = vec 3; SetBlock(DAs, fillInDA, 3)
DAs!1 = fp>>FP.leaderVirtualDa
ActOnDiskPages(disk, lv ld, DAs+1, fp, 0, 0, DCreadD)
ld>>LD.changeSerial = ld>>LD.changeSerial +1
ActOnDiskPages(disk, lv ld, DAs+1, fp, 0, 0, DCwriteD)
]
//---------------------------------------------------------------------------
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 nadFreeDeSize; 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+2) rshift 1
if lNameInWords ge 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
[
let h = 0; 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, and a directory stream
// in which to look for the name.
// list!0 = errRtn; list!1 = zone; list!3 = disk
let L = n>>STRING.length; let sep = 0
for i = 1 to L 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, L)
// 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
let errRtn = list!0
if dirFn!0 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 ]
]
let s = OpenFile(dirFn, 0, 0, versionControl, fp, errRtn, list!1,
0, disk, 0, #100000)
// if s eq 0 then errRtn(dirFn, ecBadDirName)
resultis s
]
//---------------------------------------------------------------------------
and ExtractLegalFileName(srcS, destS, firstMinus1, last) be
//---------------------------------------------------------------------------
[
let L = last-firstMinus1
if L ls 0 then L = 0
Zero(destS, (L+3) rshift 1)
if L eq 0 then return
let char = nil
for i = 1 to L do //make sure each character is legal
[
char = srcS>>STRING.char↑(firstMinus1+i)
unless (char ge $A & char le $Z) % (char ge $a & char le $z) %
(char ge $0 & char le $9) % (char eq $-) % (char eq $$) %
(char eq $!) % (char eq $?) % (char eq $+) % (char eq $.) %
(char eq $<) % (char eq $>) do
char = $- // <--------===
destS>>STRING.char↑i = char
]
if char ne $. then [ L = L+1 ; destS>>STRING.char↑L = $. ]
destS>>STRING.length = L
]
//---------------------------------------------------------------------------
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 StripVersion(fn, lvVersionExists; numargs na) = valof
//---------------------------------------------------------------------------
// adjusts the length of fn to remove the version number and attaches a
// final $., and returns the version, or 0 if there wasn't one.
[
if na eq 1 then lvVersionExists = lv na
@lvVersionExists = false
let lFn = fn>>STRING.length
let version = 0
let multiplier = 1
for i = 0 to lFn-1 do
[
let c = fn>>STRING.char↑(lFn-i)
switchon c into
[
case $0 to $9:
[
version = version+(c-$0)*multiplier
multiplier = multiplier*10
loop
]
case $!:
[
lFn = lFn-i-1
@lvVersionExists = true
break
]
case $.: loop
default: [ version = 0; break ]
]
]
if fn>>STRING.char↑lFn ne $. then
[
lFn = lFn+1
fn>>STRING.char↑lFn = $.
]
fn>>STRING.length = lFn
resultis version
]
//---------------------------------------------------------------------------
and AppendVersion(fileName, version) be
//---------------------------------------------------------------------------
[
let l = fileName>>STRING.length
if fileName>>STRING.char↑l eq $. then fileName>>STRING.length = l-1
if version gr 0 then AppendChar(fileName, $!)
if version ge 100 then AppendChar(fileName, (version/100) rem 10 + $0)
if version ge 10 then AppendChar(fileName, (version/10) rem 10 + $0)
if version ge 1 then AppendChar(fileName, version rem 10 + $0)
AppendChar(fileName, $.)
]
//---------------------------------------------------------------------------
and AppendChar(string, char) be
//---------------------------------------------------------------------------
[
let l = string>>STRING.length+1
string>>STRING.char↑l = char
string>>STRING.length = l
]
//---------------------------------------------------------------------------
and OpenFile(name, ksType, itemSize, versionControl, hintFp, errRtn,
zone, nil, disk, CreateStream, SNword; numargs na) = valof
//---------------------------------------------------------------------------
//Note: if a file is re-used without changing its fp, its creation date
// is still changed. This isn't quite right, but then not much about
// this module is.
[
DefaultArgs(lv na, -1, ksTypeReadWrite, wordItem, 0, 0, SysErr,
sysZone, 0, sysDisk, CreateDiskStream, 0)
if versionControl eq 0 then
versionControl = (ksType eq ksTypeReadOnly)? verLatest,
((ksType eq ksTypeWriteOnly)? verNew, verLatestCreate)
let s = 0
// following check attempts to decide whether hint is really filled in
// with anything. It may be that user just wants it filled in.
if hintFp ne 0 & hintFp>>FP.version ne 0 then
s = CreateStream(hintFp, ksType, itemSize, Noop, errRtn, zone,
nil, disk)
if s eq 0 then //hint failed, or wasn't supplied
[
//blunder check
if name eq 0 % name>>STRING.length eq 0 then 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 false //bad directory name
// go look in the directory for the file. Return with the name having
// the appropriate version number slapped on the end.
let pos = FindFdEntry(currentDirS, fixedName, 0, dv, hd, versionControl)
let makeit = false
test pos eq -1
ifso
[
// Either virgin file name or unable to delete older
// version of same name
if (versionControl & verCrMask) eq 0 then
[ Closes(currentDirS); resultis 0 ]
makeit = true // make afresh
]
ifnot if (versionControl & verNewMask) eq verNew &
disk>>DSK.diskKd>>KDH.defaultVersionsKept gr 0 then
[
// Found an old version that could be re-used. It is in dv.
// Note that if there is no versioning going on,
// we should not re-make the file.
DeleteFdEntry(currentDirS, pos)
makeit = 1 // but re-use file alloc'ed
]
if makeit ne 0 then
[
let dirCfa = vec lCFA; GetCompleteFa(currentDirS, dirCfa)
CreateDiskFile(disk, fixedName, lv dv>>DV.fp, lv dirCfa>>CFA.fp,
SNword, makeit eq 1)
MakeNewFdEntry(currentDirS, fixedName, dv, hd)
]
Closes(currentDirS)
if hintFp then MoveBlock(hintFp, lv dv>>DV.fp, lFP)
s = CreateStream(lv dv>>DV.fp, ksType, itemSize, Noop, errRtn,
zone, nil, disk)
if s eq 0 then errRtn(s, ecCantOpenFile)
]
resultis s
]
//---------------------------------------------------------------------------
and OpenFileFromFp(fp) = OpenFile(0, 0, 0, 0, fp)
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
and DeleteFile(name, versionControl, errRtn, zone, nil,
disk; numargs n) = valof
//---------------------------------------------------------------------------
// returns false if it couldn't find the file
[
DefaultArgs(lv n, -1, verOldest, SysErr, sysZone, 0, 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, 0, versionControl)
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
]