// BFSCreate.Bcpl -- Routines to create and delete files. 
// Copyright Xerox Corporation 1979
// Last modified September 18, 1979  4:25 PM by Taft

get "AltoFileSys.d"	// Definitions for structures in the file system
get "Disks.d"		// Definitions for the disk object
get "Bfs.d"		// Definitions for the Diablo 31/44 disk

external
[
// outgoing procedures
BFSCreateFile; BFSDeletePages; BFSReleaseDiskPage

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

// incoming statics
freePageFp; oneBits
]

manifest biteSize = 128

//----------------------------------------------------------------------------
let BFSCreateFile(disk, name, fp, dirFp, word1, useOldFp, pageBuf;
    numargs na) be
//----------------------------------------------------------------------------
// 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 rather than DVecing.
[
DefaultArgs(lv na, 3, 0, 0, false, 0)
if pageBuf eq 0 then
   [
   pageBuf = BFSwordsPerPage
   Dvec(BFSCreateFile, lv pageBuf)
   ]
let oldFp = vec lFP; MoveBlock(oldFp, fp, lFP)

// generate a new FP:
Zero(fp, lFP)
fp>>FP.version = 1
let lastSn = lv disk>>BFSDSK.lastSn
let t = lastSn>>SN.part2+1; lastSn>>SN.part2 = t
if t eq 0 then lastSn>>SN.word1 = lastSn>>SN.word1+1
MoveBlock(lv fp>>FP.serialNumber, lastSn, lSN)
fp>>FP.serialNumber.word1 = fp>>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, fp)
   DAs!0 = da
   ]

// Set up the leader page
Zero(pageBuf, BFSwordsPerPage)
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, fp, 0, 1,
 DCwriteD, 0, 0, pageBuf)
fp>>FP.leaderVirtualDa = DAs!0
]

//----------------------------------------------------------------------------
and BFSDeletePages(disk, CA, firstDA, fp, firstPage, newFp, hintLastPage;
    numargs na) be
//----------------------------------------------------------------------------
// Delete pages starting at firstDA and continuing to the end of
// the file.  CA is a page-size buffer which is zeroed
// Optional 6th argument is the "new" FP to install:
[
DefaultArgs(lv na, -5, freePageFp, 0)
while firstDA ne eofDA do
   [ 
   let DAs = vec biteSize +1
   SetBlock(DAs, fillInDA, biteSize+2)

   // The 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, DCreadD, 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, BFSwordsPerPage)
   WriteDiskPages(disk, 0, DAs, newFp, firstPage,
      lastPageFound, -1, 0, lastNumChars, CA)

   // Deleting a file is really just renaming it to 'free' and
   // marking its pages free in the bit table.
   if newFp eq freePageFp then
      for i = firstPage to lastPageFound do ReleaseDiskPage(disk, DAs!i)

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

//----------------------------------------------------------------------------
and BFSReleaseDiskPage(disk, vda) be
//----------------------------------------------------------------------------
[
let ddMgr = disk>>BFSDSK.ddMgr
LockDD(ddMgr, disk)

// The first lKDHeader words of DiskDescriptor aren't bit table bits
vda = vda + bitTableBias

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

let wa = vda<<VDA.wordNumInPage
let mask = oneBits!(vda<<VDA.bitNum)
if (buf!wa & mask) ne 0 then
   [
   // Reset correct bit of page
   buf!wa = buf!wa & not mask
   disk>>BFSDSK.freePages = disk>>BFSDSK.freePages+1
   ]

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