// 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)