// TfsCreate.bcpl -- procedures to create and delete files
// Copyright Xerox Corporation 1979

//	Last modified November 8, 1979  6:28 PM by Taft

get "Altofilesys.d"
get "Disks.d"
get "Tfs.d"

external
[
//outgoing procedures
TFSCreateFile
TFSDeletePages
TFSReleaseDiskPage

//incoming procedures
ActOnDiskPages
WriteDiskPages
DeleteDiskPages
ReleaseDiskPage
TFSIncrement
ReadDDPage
LockDD
UnlockDD
MoveBlock
SetBlock
Zero
DefaultArgs
ReadCalendar
Dvec

// statics defined elsewhere
freePageFp
oneBits
]

//----------------------------------------------------------------------------
let TFSCreateFile(disk, name, filePtr, dirFp, word1, useOldFp, pageBuf;
    numargs na) be
//----------------------------------------------------------------------------
// See CreateDiskFile description in BFS section of O.S. manual.
// Create a file by writing a leader page and page 1.
// If useOldFp, there was an existing file; re-use it, but change the FP.
// If pageBuf supplied, it is used as a page buffer and the initial contents
// of the last 3/4 of the page are written onto the leader page.
[
DefaultArgs(lv na, -3, 0, 0, false, 0)
if pageBuf eq 0 then
   [ pageBuf = TFSwordsPerPage; Dvec(TFSCreateFile, lv pageBuf) ]
let oldFp = vec lFP
MoveBlock(oldFp, filePtr, lFP)

// Generate a new FP:
Zero(filePtr, lFP)
filePtr>>FP.version = 1
TFSIncrement(lv disk>>TFSDSK.lastSn)
MoveBlock(lv filePtr>>FP.serialNumber, lv disk>>TFSDSK.lastSn, lSN)
filePtr>>FP.serialNumber.word1 = filePtr>>FP.serialNumber.word1 % word1

let DAs = vec 4
MoveBlock(DAs, table [ eofDA; fillInDA; fillInDA; eofDA ], 4)
DAs = DAs+1

// If there was an existing file, "rename" it:
if useOldFp then
   [
   let da = oldFp>>FP.leaderVirtualDa
   DeleteDiskPages(disk, pageBuf, da, oldFp, 0, filePtr)
   DAs!0 = da
   ]

// Set up the leader page
Zero(pageBuf, 256)
ReadCalendar(lv pageBuf>>LD.created)
MoveBlock(lv pageBuf>>LD.name, name, size LD.name/16)
if dirFp ne 0 then MoveBlock(lv pageBuf>>LD.dirFp, dirFp, lFP)
pageBuf>>LD.propertyBegin = offset LD.leaderProps/16
pageBuf>>LD.propertyLength = size LD.leaderProps/16

// Actually write out the leader page and the first data page
(useOldFp? ActOnDiskPages, WriteDiskPages)(disk, 0, DAs, filePtr, 0, 1,
 DCwriteD, 0, 0, pageBuf)
filePtr>>FP.leaderVirtualDa = DAs!0
]

//----------------------------------------------------------------------------
and TFSDeletePages(disk, CA, firstDA, fp, firstPage, newFp, hintLastPage;
    numargs na) be
//----------------------------------------------------------------------------
// See DeleteDiskPages description in BFS section of O.S. manual.
// Delete pages starting at firstDA and continuing to the end of
// the file.  CA is a page-size buffer which is clobbered.
// Optional 6th argument is the "new" FP to install (used by TFSCreateFile).
[
DefaultArgs(lv na, -5, freePageFp, 0)
manifest biteSize = 100
while firstDA ne eofDA do
   [ 
   let DAs = vec biteSize+1
   SetBlock(DAs, fillInDA, biteSize+2)

   // Reason for extra 1 is that DAs!(firstpage-1) is referenced by 
   // the default cleanup routine.
   DAs = DAs+1-firstPage
   DAs!firstPage = firstDA

   // Collect disk addresses of pages in file
   let lastNumChars = nil
   let lastPageFound = ActOnDiskPages(disk, 0, DAs, fp, firstPage,
     firstPage+biteSize-1, DCreadnD, lv lastNumChars, 0, CA,
     0, 0, 0, hintLastPage)

   // Write newFp in all the labels.
   // The data must be zeroed in the case that we are 'renaming'
   // an existing file.
   Zero(CA, TFSwordsPerPage)
   WriteDiskPages(disk, 0, DAs, newFp, firstPage,
     lastPageFound, -1, 0, lastNumChars, CA)

   // If deleting (rather than renaming), mark pages free in bit table
   if newFp eq freePageFp then
      for i = firstPage to lastPageFound do ReleaseDiskPage(disk, DAs!i)

   firstPage = lastPageFound+1
   firstDA = DAs!firstPage
   ]
]

//----------------------------------------------------------------------------
and TFSReleaseDiskPage(disk, vda) be
//----------------------------------------------------------------------------
// See ReleaseDiskPage description in BFS section of O.S. manual.
[
let ddMgr = disk>>TFSDSK.ddMgr
LockDD(ddMgr, disk)

// Make sure appropriate BT page is in mem
let buf = ReadDDPage(ddMgr, disk, vda<<VDA.pageNum + lengthTFSDDpreamble)

// Reset correct bit of page in mem
let wa = vda<<VDA.wordNumInPage
let mask = oneBits!(vda<<VDA.bitNum)
test (buf!wa & mask) ne 0
   ifso
      [
      buf!wa = buf!wa & not mask
      disk>>TFSDSK.freePages = disk>>TFSDSK.freePages+1
      ]
   ifnot TFSIncrement(lv disk>>TFSDSK.nBTErrors)

// Note dirty BT
UnlockDD(ddMgr, disk, true)
]