// IFSDirUtil.bcpl -- utility procedures for IFS directory lookup
// Copyright Xerox Corporation 1979, 1981

// Last modified December 5, 1981  12:45 PM by Taft

get "Ifs.decl"
get "IfsFiles.decl"
get "Streams.d"
get "IfsDirs.decl"
get "IfsRs.decl"
get "Disks.d"


external
[
// outgoing procedures
NamesMatch; GetDIFRec; UpdateDIFRec; DIFRecFromDR
TransferLeaderPage; LockTransferLeaderPage
EmptiestUnit; EmptiestFreePages; GetDiskFromFD; GetBufferForFD
LockFile; UnlockFile; CreateOFT; DestroyOFT

// incoming procedures -- IFSDirs
CreateFD; LookupFD; DestroyFD; IFSParseVersion; ModifyDirFD
LockDirFD; UnlockDirFD

// incoming procedures -- B-Tree
UpdateRecord

// incoming procedures -- rest of IFS
IFSError; ExtractSubstring; ConcatenateStrings
DoubleUsc; FreePointer

// incoming procedures -- operating system
ActOnDiskPages
DefaultArgs; MoveBlock; Zero; SysAllocate; SysAllocateZero; SysFree

// incoming statics
]


// Open File Table Definitions

//----------------------------------------------------------------------------
structure OFDA:		// Open File Disk Address -- similar to IDA
//----------------------------------------------------------------------------
[
blank bit 11
unit bit 5		// logical unit number
page word		// virtual page number on unit; 0 => OFE is vacant
]

//----------------------------------------------------------------------------
structure OFE:		// Open File Table Entry
//----------------------------------------------------------------------------
[
da @OFDA =
   [
   count byte		// open count
   mode bit 3		// prevailing OpenFile mode
   ]
]
manifest lenOFE = size OFE/16

//----------------------------------------------------------------------------
structure OFT:		// open file table
//----------------------------------------------------------------------------
[
numOFEminus1 word	// number of entries-1 -- must be a power of 2 -1
ofe↑0,0 @OFE
]
manifest lenOFTheader = offset OFT.ofe/16

//----------------------------------------------------------------------------
let NamesMatch(fd, record, lvVersion; numargs na) = valof
//----------------------------------------------------------------------------
// Compares the name string in the key "fd" with the
// pathname in the directory entry "record".  Returns a code
// describing the degree of match:
//  0 names don't match at all
//  1 names match through "<dir>"
//  2 names match through "<dir>name!" (only versions differ)
//  3 names match entirely
// If lvVersion is supplied, then the actual version number in
// the directory entry is returned in @lvVersion in case 2 or 3.
[
if (record>>DR.header & drHeaderMask) ne 0 then IFSError(ecBadDR)

let recStrLen = record>>DR.pathName.length
let dr = fd>>FD.dr
for i = 1 to fd>>FD.lenBodyString do
   [
   let keyChar = dr>>DR.pathName.char↑i
   if keyChar ge $a & keyChar le $z then keyChar = keyChar-($a-$A)
   let recChar = (i le recStrLen? record>>DR.pathName.char↑i, 0)
   if recChar ge $a & recChar le $z then recChar = recChar-($a-$A)
   if keyChar ne recChar resultis (i le fd>>FD.lenDirString? 0, 1)
   ]
let version = nil
if IFSParseVersion(lv record>>DR.pathName,
 fd>>FD.lenBodyString+1, recStrLen, lv version) ne 0 then
   resultis 1  // if can't parse version, names don't really match
if na ge 3 then @lvVersion = version
resultis (version eq fd>>FD.version? 3, 2)
]

// Procedures for manipulating DIFRec's

//----------------------------------------------------------------------------
and GetDIFRec(fd) = valof
//----------------------------------------------------------------------------
// Returns an FD structure containing the directory entry
// record for the DIF appropriate to the filename given by fd.
// Returns zero if no such DIF exists.
// Assumes the directory is unlocked and returns with it unlocked.
[
let difFD = BuildDIFFD(fd)
resultis (LookupFD(difFD) eq 0? difFD, DestroyFD(difFD))
]

//----------------------------------------------------------------------------
and UpdateDIFRec(fd, UpdateProc, arg) be
//----------------------------------------------------------------------------
// Updates the DIF directory entry record for the file described
// by fd.  UpdateProc(record, arg) is called to do the
// actual modification.  It should return the record it was passed.
// Assumes the directory is unlocked and returns with it unlocked;
// at the time UpdateProc is called, the directory is write-locked.
[
let difFD = BuildDIFFD(fd)
LockDirFD(difFD, true)
ModifyDirFD(difFD)  // mark directory as having been changed
UpdateRecord(fd>>FD.fs>>IFS.dirBTree, difFD, UpdateProc, arg)
UnlockDirFD(fd)
DestroyFD(difFD)
]

//----------------------------------------------------------------------------
and BuildDIFFD(fd) = valof
//----------------------------------------------------------------------------
// Given a file designated by fd, returns an fd for the DIF for
// that file's directory
[
let difName = ConcatenateStrings(ExtractSubstring(
 lv fd>>FD.dr>>DR.pathName, 1, fd>>FD.lenDirString), "!1", true)
let difFD = CreateFD(difName, 0, 0, fd>>FD.fs)
if difFD eq 0 then IFSError(ecIllegalExistingName)
SysFree(difName)
resultis difFD
]

//----------------------------------------------------------------------------
and DIFRecFromDR(dr) = valof
//----------------------------------------------------------------------------
// Returns pointer to the DIFRec portion of a directory entry
[
if dr>>DR.type ne drTypeDIF then IFSError(ecNotDIFRec)
resultis dr + dr>>DR.length - lenDIFRec
]

// TFS interface procedures

//----------------------------------------------------------------------------
and TransferLeaderPage(fd, buffer, write; numargs na) be
//----------------------------------------------------------------------------
// Transfers the leader page of the file designated by fd
// to or from the specified buffer.  If "write"
// is true then writes the page, otherwise reads it.
// Either the file or the entire directory must be locked by the caller;
// and in the latter case fd must have been validated by LookupFD.
[
let DAs = vec 2
DAs!1 = fd>>FD.dr>>DR.fp.page
ActOnDiskPages(GetDiskFromFD(fd), lv buffer, DAs+1, lv fd>>FD.dr>>DR.fp, 0, 0,
 (na ge 3 & write? DCwriteD, DCreadD))
]

//----------------------------------------------------------------------------
and LockTransferLeaderPage(fd, buffer, write; numargs na) = valof
//----------------------------------------------------------------------------
// Attempts to transfer the leader page designated by fd.
// Returns zero if successful and an error code if unsuccessful.
// Assumes the directory is unlocked and returns with it unlocked.
[
let ec = LookupFD(fd, lockRead, true)  // requireExists
if ec eq 0 then TransferLeaderPage(fd, buffer, na ge 3 & write)
UnlockDirFD(fd)
resultis ec
]

//----------------------------------------------------------------------------
and EmptiestUnit(fs) = valof
//----------------------------------------------------------------------------
// Returns the virtual unit number of the emptiest unit in fs,
// or -1 if the fs is full.
[
let eUnit = -1
let ePages = 25  //consider fs full if less than this
for unit = 0 to fs>>IFS.numUnits-1 do
   [
   let pages = fs>>IFS.lpdt↑unit>>DSK.diskKd>>KDH.freePages
   if pages ugr ePages then
      [ ePages = pages; eUnit = unit ]
   ]
resultis eUnit
]

//---------------------------------------------------------------------------
and EmptiestFreePages(fs) = valof
//---------------------------------------------------------------------------
// Returns the number of free pages in the emptiest unit of fs.
[
let unit = EmptiestUnit(fs)
resultis unit ls 0? 0, fs>>IFS.lpdt↑unit>>DSK.diskKd>>KDH.freePages
]

//----------------------------------------------------------------------------
and GetDiskFromFD(fd) = fd>>FD.fs>>IFS.lpdt↑(fd>>FD.dr>>DR.fp.unit)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and GetBufferForFD(fd) = SysAllocate(fd>>FD.fs>>IFS.pageLength)
//----------------------------------------------------------------------------
// Allocates and returns a page-size buffer appropriate for accessing
// the file designated by fd.

// Primitives implementing mutual exclusion on files.

//----------------------------------------------------------------------------
and LockFile(fd, mode) = valof
//----------------------------------------------------------------------------
// Attempts to lock the file designated by fd in the specified mode.
// Returns true iff successful.
[
let ofe = OFTInsert(fd>>FD.fs>>IFS.oft, lv fd>>FD.dr>>DR.fp.da)
let count = ofe>>OFE.count
if count ne 0 then
   // If already open, must be open in same mode, and mode must permit sharing
   unless mode eq ofe>>OFE.mode &
    (mode eq modeRead % mode eq modeReadWriteShared) resultis false
ofe>>OFE.count = count+1
ofe>>OFE.mode = mode
resultis true
]

//----------------------------------------------------------------------------
and UnlockFile(fd) be
//----------------------------------------------------------------------------
// Unlocks a file locked by this process.
[
let fs = fd>>FD.fs
let ofe = OFTLookup(fs>>IFS.oft, lv fd>>FD.dr>>DR.fp.da)
let count = ofe>>OFE.count-1
if ofe eq 0 % count ls 0 then IFSError(ecOFTUnlockError, fs)
ofe>>OFE.count = count
if count eq 0 then OFTDelete(fs>>IFS.oft, ofe)
]

//----------------------------------------------------------------------------
and CreateOFT(fs, numOFE) be
//----------------------------------------------------------------------------
// Creates an oft for fs and puts it in the structure.
// numOFE is the maximum number of open files and must be a power of 2.
[
let lenOFT = lenOFE*numOFE + lenOFTheader
let oft = SysAllocateZero(lenOFT)
oft>>OFT.numOFEminus1 = numOFE-1
fs>>IFS.oft = oft
]

//----------------------------------------------------------------------------
and DestroyOFT(fs) = valof
//----------------------------------------------------------------------------
// Attempts to destroy the oft for fs, returning true if successful
// and false if there are still open files.
[
for i = 0 to fs>>IFS.oft>>OFT.numOFEminus1 do
   if fs>>IFS.oft>>OFT.ofe↑i.da.page ne 0 resultis false
FreePointer(lv fs>>IFS.oft)
resultis true
]

//----------------------------------------------------------------------------
and OFTLookup(oft, da, findFree; numargs na) = valof
//----------------------------------------------------------------------------
// Returns pointer to open file entry matching disk address da,
// or zero if not found.  If findFree is true, then upon failure
// returns pointer to first available entry (zero if none).
[
let iProbe = (da>>OFDA.unit+da>>OFDA.page) & oft>>OFT.numOFEminus1
let probe = iProbe
   [ // repeat
   let ofe = lv oft>>OFT.ofe↑probe
   if da>>OFDA.page eq ofe>>OFE.da.page &
    da>>OFDA.unit eq ofe>>OFE.da.unit then
      resultis ofe  //found matching entry
   if ofe>>OFE.da.page eq 0 resultis na ge 3 & findFree? ofe, 0
   probe = (probe+1) & oft>>OFT.numOFEminus1  // linear reprobe
   ] repeatuntil probe eq iProbe
resultis 0  // no matching entry and hash table is full
]

//----------------------------------------------------------------------------
and OFTInsert(oft, da) = valof
//----------------------------------------------------------------------------
// Looks up da in oft, creating a new entry if none is found.
[
let ofe = OFTLookup(oft, da, true)
if ofe eq 0 then IFSError(ecOFTFull, oft)
ofe>>OFE.da.unit = da>>OFDA.unit
ofe>>OFE.da.page = da>>OFDA.page
resultis ofe
]

//----------------------------------------------------------------------------
and OFTDelete(oft, ofe) be
//----------------------------------------------------------------------------
// Deletes entry ofe from open file table oft
[
Zero(ofe, lenOFE)
let probe = (ofe - lv oft>>OFT.ofe)/lenOFE
let nofe = nil
   [ // repeat
   probe = (probe+1) & oft>>OFT.numOFEminus1
   nofe = lv oft>>OFT.ofe↑probe
   if nofe>>OFE.da.page eq 0 return
   if OFTLookup(oft, lv nofe>>OFE.da) eq 0 break
   ] repeat
MoveBlock(ofe, nofe, lenOFE)  // rehash inaccessible entry
ofe = nofe
] repeat

// Include this if ever needed
//----------------------------------------------------------------------------
// and OFTEnumerate(oft, Proc, arg) be
//----------------------------------------------------------------------------
// Calls Proc(ofe, arg) for every active entry in oft
// for i = 0 to oft>>OFT.numOFEminus1 do
//    if oft>>OFT.ofe↑i.da.page ne 0 then
//       Proc(lv oft>>OFT.ofe↑i, arg)