// DiskStreams.Bcpl -- Disk stream routines
// Copyright Xerox Corporation 1979
// Last modified February 9, 1980 12:29 AM by Boggs
// This module contains code which is called when opening and
// closing a stream, plus routines to get and set stream state.
// It only calls DiskStreamsMain - and not DiskStreamsAux
get "DiskStreams.decl"
external
[
// outgoing procedures
CreateDiskStream; CloseDiskStream; TruncateDiskStream
ResetDiskStream; ResetKsState; ReleaseKs
ReadLeaderPage; WriteLeaderPage
LnPageSize; KsHintLastPageFa; KsGetDisk
KsBufferAddress; KsSetBufferAddress
AccessError; KsHandleBfsError
// incoming procedures from:
// DiskStreamsMain.bcpl
FixupDiskStream; CleanupDiskStream
TransferPages; PosPtr; SetLengthHint
// DiskStreamAux.bcpl
FileLength
// FastStreamsB.bcpl
InitializeFstream; SetupFstream; SetDirty
SetEof; StreamError; CurrentPos
// BfsBase.bcpl
ActOnDiskPages; DeleteDiskPages
// BfsMl.asm
MoveBlock; SetBlock; Zero; RetryCall; Noop
// miscellaneous
ReadCalendar; DefaultArgs; SysErr; Endofs; Errors
// Alloc.bcpl
Allocate; Free
// incoming statics
sysZone; sysDisk
]
//----------------------------------------------------------------------------
let CreateDiskStream(fp, type, itemSize, Cleanup, ErrRtn,
zone, nil, disk; numargs na) = valof
//----------------------------------------------------------------------------
// Returns a stream or zero. In particular, it returns zero if a
// check error occurs (presumably a hint failed).
[
compileif lKS ne size KS/16 then [ Error("Change lKS in Streams.d") ]
DefaultArgs(lv na, -1, ksTypeReadWrite, wordItem, Noop, SysErr,
sysZone, nil, sysDisk)
let Words = 1 lshift disk>>DSK.lnPageSize
let buf, ks = nil, nil
[
ks = Allocate(zone, lKS, -1)
if ks ne 0 then
[
buf = Allocate(zone, Words, -1)
if buf ne 0 break
Free(zone, ks)
]
ErrRtn(nil, ecNoDiskStreamSpace)
] repeat
Zero(ks, lKS)
InitializeFstream(ks, itemSize, FixupDiskStream, FixupDiskStream)
ks>>KS.bufferAddress = buf
MoveBlock(lv ks>>KS.fp, fp, lFP)
ks>>KS.fs.type = stTypeDisk
ks>>KS.type = type
ks>>KS.disk = disk
ks>>KS.charsPerPage = Words lshift 1
ks>>KS.lnCharsPerPage = disk>>DSK.lnPageSize +1
ks>>KS.fs.reset = ResetDiskStream
ks>>KS.fs.close = CloseDiskStream
ks>>KS.fs.error = ErrRtn
ks>>KS.bfsErrorRtn = KsHandleBfsError
ks>>KS.zone = zone
ks>>KS.cleanup = Cleanup
ResetKsState(ks)
// Read the leader page into the stream buffer.
// If we get a check error, destroy the stream and return false.
if TransferPages(ks, 0, 0, ActOnDiskPages, true) ne 0 then
[ ReleaseKs(ks); resultis 0 ]
// Leader (page 0) is now in buffer
MoveBlock(lv ks>>KS.hintLastPageFa, lv buf>>LD.hintLastPageFa, lFA)
test type eq ksTypeReadOnly
ifso ks>>KS.fs.puts = AccessError
ifnot
[
// If this is a directory file, we should avoid putting the old
// write and create dates back even if we don't modify the file,
// since this is very costly. (See comment in CloseDiskStream.)
if ks>>KS.fp.serialNumber.directory eq 0 then
[
MoveBlock(lv ks>>KS.oldWriteDate, lv buf>>LD.written, lTIME)
MoveBlock(lv ks>>KS.oldCreateDate, lv buf>>LD.created, lTIME)
]
ReadCalendar(lv buf>>LD.written)
ReadCalendar(lv buf>>LD.created)
]
test type eq ksTypeWriteOnly
ifso ks>>KS.fs.gets = AccessError
ifnot ReadCalendar(lv buf>>LD.read)
// Rewrite the leader page and get first data page
// (file page 1) in the buffer.
TransferPages(ks)
resultis ks
]
//----------------------------------------------------------------------------
and CloseDiskStream(ks) = valof
//----------------------------------------------------------------------------
[
CleanupDiskStream(ks)
if ks>>KS.type eq ksTypeWriteOnly &
(ks>>KS.pageNumber ne 1 % CurrentPos(ks) ne 0) then
TruncateDiskStream(ks)
if ks>>KS.lengthChanged % ks>>KS.oldWriteDate.h ne 0 then
[
Rewind(ks, 0) //get leader page into stream buffer
let buf = ks>>KS.bufferAddress
MoveBlock(lv buf>>LD.hintLastPageFa, lv ks>>KS.hintLastPageFa, lFA)
// If TransferPages ever writes a file page, it sets oldWriteDate.h to 0.
// If it is non-zero, we never wrote the file, even if it was opened
// writeOnly or readWrite -- so put back the old write date.
// On the other hand, if the file was newly created, it will have a write
// date of zero, and opening the stream with writing specified will set
// the write date to the time it was opened, and since oldWriteDate.h
// will be zero, we will not change it back here.
// That means that a stream opened for writing on a newly created file
// will always set the write date even if nothing is written to it.
if ks>>KS.oldWriteDate.h ne 0 then // put back old dates
[
MoveBlock(lv buf>>LD.written, lv ks>>KS.oldWriteDate, lTIME)
MoveBlock(lv buf>>LD.created, lv ks>>KS.oldCreateDate, lTIME)
]
TransferPages(ks) //this can't extend the file since page 1 must exist
]
resultis ReleaseKs(ks)
]
//----------------------------------------------------------------------------
and ResetDiskStream(ks) be Rewind(ks, 1)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and TruncateDiskStream(ks) be
//----------------------------------------------------------------------------
[
if Endofs(ks) then [ CleanupDiskStream(ks); return ]
let firstLeftoverDA = ks>>KS.DAs.next
ks>>KS.DAs.next = eofDA
let pn = ks>>KS.pageNumber
let hintLastPage = ks>>KS.hintLastPageFa.pageNumber
ks>>KS.numChars = CurrentPos(ks)
SetDirty(ks, true)
CleanupDiskStream(ks)
SetLengthHint(ks)
if firstLeftoverDA ne eofDA do
[
// This clobbers the buffer
DeleteDiskPages(ks>>KS.disk, ks>>KS.bufferAddress, firstLeftoverDA,
lv ks>>KS.fp, pn+1, 0, hintLastPage)
Rewind(ks, 0) //Guaranteed to re-read leader
FileLength(ks) // and move to the end.
]
]
//----------------------------------------------------------------------------
and Rewind(ks, pageNumber) be
//----------------------------------------------------------------------------
[
CleanupDiskStream(ks)
test ks>>KS.pageNumber eq pageNumber
ifso PosPtr(ks)
ifnot
[
ResetKsState(ks)
TransferPages(ks, 0, pageNumber, ActOnDiskPages)
]
]
//----------------------------------------------------------------------------
and ResetKsState(ks) be
//----------------------------------------------------------------------------
[
ks>>KS.DAs.last = fillInDA
ks>>KS.DAs.current = ks>>KS.fp.leaderVirtualDa
ks>>KS.DAs.next = fillInDA
ks>>KS.pageNumber = 0
]
//----------------------------------------------------------------------------
and ReleaseKs(ks) = valof
//----------------------------------------------------------------------------
[
// Call stream cleanup procedure
ks>>KS.cleanup(ks, ks>>KS.bufferAddress)
// Release storage
SetBlock(ks, StreamError, lST)
ks>>KS.fs.error = SysErr
Free(ks>>KS.zone, ks>>KS.bufferAddress) //Release buffer
Free(ks>>KS.zone, ks) //Release stream
resultis 0
]
// Leader page stuff
//----------------------------------------------------------------------------
and ReadLeaderPage(ks, buf) be
//----------------------------------------------------------------------------
[
// Get leader page in stream buffer
Rewind(ks, 0)
// BLT a copy into user-supplied buffer
MoveBlock(buf, ks>>KS.bufferAddress, ks>>KS.charsPerPage rshift 1)
// Positon stream to beginning of file, being careful not to write
TransferPages(ks, 0, 1, ActOnDiskPages)
]
//----------------------------------------------------------------------------
and WriteLeaderPage(ks, buf) be
//----------------------------------------------------------------------------
[
// Get leader page in stream buffer
Rewind(ks, 0)
// BLT user-supplied leader page into stream buffer
MoveBlock(ks>>KS.bufferAddress, buf, ks>>KS.charsPerPage rshift 1)
// Position stream to beginning of file, flushing leader page to disk
TransferPages(ks)
]
// Get/Set various stream parameters
//----------------------------------------------------------------------------
and LnPageSize(ks) = ks>>KS.lnCharsPerPage -1
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and KsGetDisk(ks) = ks>>KS.disk
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and KsHintLastPageFa(ks) = lv ks>>KS.hintLastPageFa
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and KsBufferAddress(ks) = ks>>KS.bufferAddress
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and KsSetBufferAddress(ks, buf) be
//----------------------------------------------------------------------------
[ ks>>KS.bufferAddress = buf; PosPtr(ks, CurrentPos(ks)) ]
// Error handling stuff
//----------------------------------------------------------------------------
and AccessError(ks) be Errors(ks, ecAccess)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and KsHandleBfsError(a, param, errNo) be
//----------------------------------------------------------------------------
Errors(a-offset KS.bfsErrorRtn/16, errNo, param)