// IfsNameInstall.bcpl - Name lookup server -- directory installation
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified December 5, 1981  2:47 PM by Taft

get Port, lenPort from "Pup0.decl"
get "Ifs.decl"
get "IfsFiles.decl"
get "IfsNameServ.decl"
get "IFSDirs.decl"
get wordItem from "Streams.d"
get jobTypeNameUpdate from "IfsRs.decl"
get "BTree.decl"

external
[
// outgoing procedures
InstallNetworkDirectory

// incoming procedures
NetDirEntryLength; NameCompareKey; AddressCompareKey
HeapSort; CheckNetDirChecksum
IFSOpenFile; LookupIFSFile; IFSDeleteFile; IFSDeleteOldVersions; DestroyFD
GetBufferForFD; StreamsFD; EmptiestFreePages; PositionPage
ReadBlock; Gets; SetFilePos; Closes; ReadLeaderPage; WriteLeaderPage
OpenIFSTree; CloseBTree; UpdateRecord; ReadBTreePage; WriteBTreePage
Lock; Unlock; Min; IFSError; Yield; Dismiss; JobOK; PurgeVMem
SysErr; SysAllocate; SysFree; MoveBlock; Usc

// incoming statics
@ns; primaryIFS; haltFlag; numOvXMPages
]

manifest
[
lenNameTable = 50	// number of names processed per pass
]

structure NB:		// Name buffer (pointed to from nameTable)
[
pointer word		// File pointer to entry or address block
namePointer word	// File pointer to name block
			// 0 => not primary name for entry
string @String
]

structure NameTS:	// Extension to TS (Tree State) structure
[
blank word lTS
blank word 128-lTS
version word		// Net dir version of this tree
]

//----------------------------------------------------------------------------
let InstallNetworkDirectory() = valof
//----------------------------------------------------------------------------
// Rebuilds the network directory B-tree from the highest version of
// the file <System>Pup-network.directory.  Returns true iff successful.
// Does not rebuild the tree if the one that is there is the correct
// version already.

// Converting the standard Pup network directory structure, with its rat's
// nest of pointers, into a collection of self-contained B-tree entries
// is hairy if you don't have enough buffer space to hold the entire
// network directory, which we don't.  Doing it in the obvious way, using
// disk streams, would require on the order of 2*n random positioning
// operations, where n is the number of names in the directory.  (The factor
// of 2 comes from the fact that you have to indirect through the entry block
// to reach the address block).  Also, the cost of each positioning operation
// itself would be related to n, since the length of the file is dependent
// on n, so the process would in fact be order n squared.
// A virtually-accessed file would make things linear in n, but that wouldn't
// be much better since the references don't have any locality.

// Instead what we do is to use a process that approaches being n squared,
// but with a much smaller multiplier on n (and, in particular, with 
// linear dependence on n for number of disk transfers, with small fractional
// multiplier).  We process the network directory
// by making multiple passes over the file and building part of the
// B-tree on each pass, using an auxiliary table and a limited amount
// of allocated storage.

// 1. Read through the name block portion of the directory.  For each name,
// allocate a block in core with room for the name plus two overhead words,
// and add a pointer to this block in the table.  In the extra words,
// put the entry block file pointer gotten from the name block, and also the
// file pointer to this name block (needed in step 3).
// Continue until you run out of storage or table space.

// 2. Sort the table by entry block file pointer value.

// 3. Read all the entry blocks in the order in which the corresponding
// name blocks now appear in the table (i.e., sequentially through the file)
// and replace the entry block pointers by address block pointers gotten
// from the entry blocks.  (Also remember whether or not the name block
// was the head of the entry's name block chain, i.e., the primary name.)

// 4. Sort the table by address block file pointer value.

// 5. Read all the address blocks in the order in which the corresponding
// name blocks now appear in the table (i.e., sequentially through the file),
// and create and insert a name entry and an address entry into the B-tree
// for each one.  (Complication: some entries point to a chain consisting of
// more than one address.  Since there are relatively few of these, however,
// it doesn't cost much to simply follow the pointers on the fly.  Second
// complication: we must only insert address entries for primary names.)

// 6. Go back to step 1 if there are more names to do.

[
// If not already open, open existing tree if there is one.
let treeName = "Pup-Network.tree"
let treeFP = vec lFP
let fd = LookupIFSFile(treeName, lcVHighest)
if fd ne 0 then
   [
   MoveBlock(treeFP, lv fd>>FD.dr>>DR.fp, lFP)
   if ns>>NS.tree eq 0 then
      [
      Lock(lv ns>>NS.treeLock, true)  // write lock
      ns>>NS.tree = OpenIFSTree(treeFP, primaryIFS, SysErr,
       NetDirEntryLength, false, nameTreePages)
      ns>>NS.version = ReadBTreePage(ns>>NS.tree, 0)>>NameTS.version
      if ns>>NS.version eq 0 then ns>>NS.tree = CloseBTree(ns>>NS.tree)
      Unlock(lv ns>>NS.treeLock)
      ]
   DestroyFD(fd)
   ]

// Open network directory file and process header
let stream = IFSOpenFile("Pup-Network.directory", 0, modeRead, wordItem)
if stream eq 0 resultis false
let hdr = vec lenHdr
ReadBlock(stream, hdr, lenHdr)

// Check the file's checksum before installing it.
unless CheckNetDirChecksum(stream) do
   [ Closes(stream); resultis false ]

// See if tree is same version as directory file
if ns>>NS.version eq hdr>>Hdr.version then
   [ Closes(stream); resultis true ]

// Versions do not match; prepare to rebuild tree.
// If this is a non-XM IFS or the file system is too full, close the
// existing tree and rebuild it in place; otherwise create a new tree file,
// build the tree in that file, switch the pointers, and destroy the old tree.
// The latter strategy permits the name server to continue to operate using
// the old tree while the new tree is being built.
test ns>>NS.tree ne 0 &
 (numOvXMPages eq 0 % EmptiestFreePages(primaryIFS) uls nameTreePages+100)
   ifso
      [  // prepare to rebuild tree in place
      Lock(lv ns>>NS.treeLock, true)
      WriteBTreePage(ns>>NS.tree, 0)>>NameTS.version = 0  // invalidate version
      ns>>NS.tree = CloseBTree(ns>>NS.tree)
      Unlock(lv ns>>NS.treeLock)
      ]
   ifnot unless fd ne 0 & ns>>NS.tree eq 0 do
      [  // make new tree file (unless tree file exists but is not open)
      let treeStream = IFSOpenFile(treeName, 0, modeWrite)
      if treeStream eq 0 then IFSError(ecCreateEssentialFile)
      let ld = GetBufferForFD(StreamsFD(treeStream))
      ReadLeaderPage(treeStream, ld)
      ld>>ILD.type = ftBinary
      ld>>ILD.byteSize = 8
      ld>>ILD.noBackup = true
      ld>>ILD.undeletable = true
      WriteLeaderPage(treeStream, ld)
      SysFree(ld)
      PositionPage(treeStream, nameTreePages)
      MoveBlock(treeFP, lv StreamsFD(treeStream)>>FD.dr>>DR.fp, lFP)
      Closes(treeStream)
      ]

let newTree = OpenIFSTree(treeFP, primaryIFS, SysErr,
 NetDirEntryLength, true, nameTreePages)

// InstallNetworkDirectory (cont'd)

let nameTable = SysAllocate(lenNameTable)
let curNameIndex = 0
while curNameIndex ls hdr>>Hdr.numNames do
   [
   if haltFlag break  // stop if system is shutting down

   // Don't proceed if the system is too busy, else we risk getting
   // into deadlocks
   unless JobOK(jobTypeNameUpdate) do [ Dismiss(100); loop ]

   // First, fill name table with file pointers of next batch of names
   let numNamesInTable = Min(lenNameTable, hdr>>Hdr.numNames-curNameIndex)
   SetDirPos(stream, hdr>>Hdr.firstName+curNameIndex)
   ReadBlock(stream, nameTable, numNamesInTable)

   // Read the names and build name table
   for i = 0 to numNamesInTable-1 do
      [
      SetDirPos(stream, nameTable!i + offset Name.entry/16)
      let entry = Gets(stream)  // file pointer to entry
      let string0 = Gets(stream)  // first word of name string
      let lenString = (string0<<String.length rshift 1)+1
      let nb = SysAllocate(offset NB.string/16 + lenString)
      nb>>NB.pointer = entry
      nb>>NB.namePointer = nameTable!i
      let string = lv nb>>NB.string
      string!0 = string0
      for j = 1 to lenString-1 do string!j = Gets(stream)
      nameTable!i = nb
      ]

   // Sort table by entry block file pointer value
   HeapSort(nameTable, numNamesInTable, PointerCompare)

   // Read pointers to address blocks from the entry blocks
   for i = 0 to numNamesInTable-1 do
      [
      let nb = nameTable!i
      SetDirPos(stream, nb>>NB.pointer)
      // Remember whether the entry points back to the name we came from
      if Gets(stream) ne nb>>NB.namePointer then nb>>NB.namePointer = 0
      nb>>NB.pointer = Gets(stream)  // file pointer to address block
      ]

   // Sort table by address block file pointer value
   HeapSort(nameTable, numNamesInTable, PointerCompare)

// InstallNetworkDirectory (cont'd)

   // Now read address blocks and do B-tree insertions
   for i = 0 to numNamesInTable-1 do
      [
      // Chase down address block chain (usually only one block)
      // and build up array of ports
      let portVec = vec maxNPorts*lenPort
      let lenPorts = 0
      let nb = nameTable!i
      let pAddr = nb>>NB.pointer
         [ // repeat
         SetDirPos(stream, pAddr)
         pAddr = Gets(stream)
         Gets(stream)
         for j = 0 to lenPort-1 do (portVec+lenPorts)!j = Gets(stream)
         lenPorts = lenPorts+lenPort
         ] repeatwhile pAddr ne 0 & lenPorts ls maxNPorts*lenPort

      // Wait here if the system is too busy...
      until JobOK(jobTypeNameUpdate) % haltFlag do Dismiss(100)

      // Insert NDTE for name
      let lenString = (nb>>NB.string.length rshift 1)+1
      let lenNDTE = offset NDTE.name.string/16+lenString+lenPorts
      let ndte = SysAllocate(lenNDTE)
      ndte>>NDTE.type = ndteTypeName
      ndte>>NDTE.length = lenNDTE
      let string = lv ndte>>NDTE.name.string
      MoveBlock(string, lv nb>>NB.string, lenString)
      MoveBlock(string+lenString, portVec, lenPorts)
      UpdateRecord(newTree, string, RecordGenerator, ndte, NameCompareKey)

      // If name is primary, insert NDTE for each address
      if nb>>NB.namePointer ne 0 then
         [
         let iPort = 0
         lenNDTE = offset NDTE.address.string/16 + lenString
            [ // repeat
            ndte = SysAllocate(lenNDTE)
            ndte>>NDTE.type = ndteTypeAddress
            ndte>>NDTE.length = lenNDTE
            MoveBlock(lv ndte>>NDTE.address.string, lv nb>>NB.string, lenString)
            MoveBlock(lv ndte>>NDTE.address.port, portVec+iPort, lenPort)
            UpdateRecord(newTree, portVec+iPort, RecordGenerator, ndte,
             AddressCompareKey)
            iPort = iPort+lenPort
            ] repeatwhile iPort ls lenPorts
         ]

      SysFree(nb)
      ]

   curNameIndex = curNameIndex+numNamesInTable
   ]

// InstallNetworkDirectory (cont'd)

// Done building the tree
SysFree(nameTable)
Closes(stream)

if haltFlag then
   [  // Stopped before new tree was completely built.
   CloseBTree(newTree)
   IFSDeleteFile(treeName, 0, lcVHighest, 0, true)
   resultis false
   ]

// Force the tree out to the disk, then put the version number into the
// tree state, and finally make this tree known to the name server.
PurgeVMem(newTree>>TREE.vmd)
WriteBTreePage(newTree, 0)>>NameTS.version = hdr>>Hdr.version
Lock(lv ns>>NS.treeLock, true)
if ns>>NS.tree ne 0 then CloseBTree(ns>>NS.tree)
ns>>NS.tree = newTree
ns>>NS.version = hdr>>Hdr.version
Unlock(lv ns>>NS.treeLock)
IFSDeleteOldVersions(treeName, 0, 0, 0, true)  // deleteUndeletable
resultis true
]

//----------------------------------------------------------------------------
and SetDirPos(stream, wordPointer) be
//----------------------------------------------------------------------------
[
Yield()
SetFilePos(stream, wordPointer rshift 15, wordPointer lshift 1)
]

//----------------------------------------------------------------------------
and PointerCompare(nb1, nb2) = Usc(nb1>>NB.pointer, nb2>>NB.pointer)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and RecordGenerator(oldRecord, newRecord) = valof
//----------------------------------------------------------------------------
[
if oldRecord ne 0 then IFSError(ecNameDuplicateRecord)
resultis newRecord
]