// 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<>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 ]