// BFSWrite.Bcpl -- Routines to extend files.
// Copyright Xerox Corporation 1979, 1981
// Last modified October 27, 1981 3:53 PM by Boggs
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
BFSWritePages; BFSAssignDiskPage
// incoming procedures from BFSBase.bcpl
DefaultBfsErrorRtn
// incoming procedures from the OS
InitializeDiskCBZ; GetDiskCb; DoDiskCommand
ActOnDiskPages; AssignDiskPage
VirtualDiskDA; RealDiskDA
ReadDDPage; LockDD; UnlockDD
MoveBlock; Zero; SetBlock
DefaultArgs
// incoming statics From BfsMl.Asm
freePageFp; freePageFid; oneBits
]
//----------------------------------------------------------------------------
let BFSWritePages(disk, CAs, DAs, fp, firstPage, lastPage, lastAction,
lvNumChars, lastNumChars, fixedCA, nil, errorRtn, nil, hintLastPage;
numargs na) = valof
//----------------------------------------------------------------------------
// Note that DAs!(firstpage-1) will be referenced except when the
// label of firstPage doesn't need to be rewritten.
// The arguments following lastPage are optional, as for ActOnDiskPages
[
let numChars, firstNewPage = nil, nil
DefaultArgs(lv na, 6, 0, 0, BFSwordsPerPage*2, 0, nil,
lv DefaultBfsErrorRtn, nil, 0)
if lastAction eq 0 then lastAction = DCwriteD
if lvNumChars eq 0 then lvNumChars = lv numChars
if lastAction ne -1 then
[
// First proceed as for a read until there are no more
// preallocated pages to write into
test DAs!firstPage eq fillInDA
ifso firstNewPage = firstPage
ifnot
[
firstPage = ActOnDiskPages(disk, CAs, DAs, fp, firstPage,
lastPage, DCwriteD, lvNumChars, lastAction, fixedCA, 0, errorRtn,
false, hintLastPage)
if firstPage eq lastPage & (lastAction ne DCwriteD %
@lvNumChars eq lastNumChars) resultis lastPage
firstNewPage = firstPage +1
]
// code to assign more pages
[
let sink = vec 256
for i = firstNewPage to lastPage do
[
DAs!i = AssignDiskPage(disk, DAs!(i-1))
if DAs!i eq -1 then
[ (@errorRtn)(errorRtn, 0, ecDiskFull) ] repeat
]
ActOnDiskPages(disk, 0, DAs, freePageFp, firstNewPage,
lastPage, DCreadLD, 0, 0, sink, CheckFreePage, errorRtn)
for i = firstNewPage to lastPage do
[
DAs!firstNewPage = DAs!i
if DAs!i ne fillInDA then firstNewPage = firstNewPage +1
]
] repeatuntil firstNewPage gr lastPage
]
// BFSWritePages (cont'd)
// All the pages have been checked. Write labels and data.
// The CB zone resues the same stack space as the sink vector.
@lvNumChars = lastNumChars
let cbz = vec CBzoneLength
InitializeDiskCBZ(disk, cbz, firstPage, CBzoneLength, Wretry, errorRtn)
Wretry:
[
for i = cbz>>CBZ.currentPage to lastPage do
[
let cb = GetDiskCb(disk, cbz)
// Set up eofDA as the page after the end of the file
if ((i eq lastPage & lastNumChars ne BFSwordsPerPage*2) %
(DAs!(i+1) eq fillInDA)) then DAs!(i+1) = eofDA
// Set up label to be written on this page
RealDiskDA(disk, DAs!(i+1), lv cb>>CB.label.next)
RealDiskDA(disk, DAs!(i-1), lv cb>>CB.label.previous)
cb>>CB.label.numChars = i eq lastPage? lastNumChars, BFSwordsPerPage*2
DoDiskCommand(disk, cb, (fixedCA ne 0? fixedCA, CAs!i),
DAs!i, fp, i, DCwriteLD)
]
while cbz>>CBZ.head ne 0 do GetDiskCb(disk, cbz)
] //End of Wretry block
resultis lastPage
]
//----------------------------------------------------------------------------
and CheckFreePage(disk, cb, cbz) be
//----------------------------------------------------------------------------
[
let fid = lv cb>>CB.labelAddress>>DL.fileId
for i = 0 to lFID-1 do if fid!i ne freePageFid!i then //oop! bit table lied
(cbz>>CBZ.DAs)!(cb>>CB.truePageNumber) = fillInDA
]
//----------------------------------------------------------------------------
and BFSAssignDiskPage(disk, vda, nil; numargs na) = valof
//----------------------------------------------------------------------------
// Assigns in a sequential manner, in order of increasing
// virtual disk address. Second argument is the VDA previously
// assigned; the code tries to assign pages sequentially in this case.
// However, for a new file the VDA passed is eofDA; in this case
// the code resumes looking in the bit table where it last left off
// trying to allocate a file. The idea is to reduce bit table
// scanning time and also page in/outs.
// Returns -1 if the bit table is full; else the VDA of the page assigned.
// Special three-argument for does not really do an assignment.
// Returns false if VDA+1 is assigned; true if it is available.
[
let ddMgr = disk>>BFSDSK.ddMgr
LockDD(ddMgr, disk)
vda = vda eq eofDA? disk>>BFSDSK.lastPageAlloc, vda+1
// The first lKDHeader words of DD aren't bit table bits
vda = vda + bitTableBias
// May have to do as many as n+2 iterations,
// where n is the number of bit table pages.
let diskBTsize = disk>>BFSDSK.diskBTsize
for i = 1 to (diskBTsize+lKDHeader) rshift BFSlnWordsPerPage +3 do
[
// At top of loop: vda = VDA to be examined next.
if vda<<VDA.wordNum ge diskBTsize+lKDHeader then
vda = bitTableBias // Wrap around
let pa = vda<<VDA.pageNum
let diskBTaddr = ReadDDPage(ddMgr, disk, pa+1)
// Test the bit corresponding to "vda". If it fails, test the remainder
// of the word one bit at a time.
let wa = vda<<VDA.wordNumInPage
let bitMask = oneBits!(vda<<VDA.bitNum)
[
let free = ((diskBTaddr!wa) & bitMask) eq 0
if na eq 3 then [ UnlockDD(ddMgr, disk); resultis free ]
if free then
[
vda = vda - bitTableBias
diskBTaddr!wa = (diskBTaddr!wa) % bitMask
disk>>BFSDSK.freePages = disk>>BFSDSK.freePages-1
disk>>BFSDSK.lastPageAlloc = vda
UnlockDD(ddMgr, disk, true) //mark bt page dirty
resultis vda
]
bitMask = bitMask rshift 1
vda = vda+1
] repeatuntil bitMask eq 0
// Now search the rest of the page one word at a time.
// On the last page we may run past the end of real data, but that's ok
// because on the next pass vda will be wrapped around to zero.
wa = wa+1 repeatuntil wa ge BFSwordsPerPage % diskBTaddr!wa ne -1
// wa now addresses a word containing other than -1 if one was found.
// wa eq BFSwordsPerPage otherwise.
vda = (pa lshift BFSlnWordsPerPage + wa) lshift 4
]
UnlockDD(ddMgr, disk)
resultis -1 // Bit table full
]