// IfsFtpXfer.bcpl - Block IO routines
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified November 22, 1981 12:22 PM by Taft
get "Pup.decl"
get "IfsFtpProt.decl"
get ecFileSystemFull, ecDiskError from "IfsDirs.decl"
get KDH, freePages, lFA from "AltoFileSys.d"
get DSK, diskKd from "Disks.d"
external
[
// outgoing procedures
DiskToDisk; NetToDisk; DiskToNet
FileType; FlipCursor
// incoming procedures
FTPM
LnPageSize; KsBufferAddress; KsGetDisk; FilePos; SetFilePos
SetDirty; CleanupDiskStream; CurrentPos; GetCurrentFa; JumpToFa
Endofs; Resets; PositionPtr
BSPWriteBlock; BSPReadBlock
DataIsBinary; Min; DoubleAdd; DoubleIncrement; ByteBlt
ReturnFrom; SysErr; MoveBlock
// incoming statics
offsetBSPStr; CtxRunning
]
manifest
[
ecDiskFull = 2413 // copied from Tfs.d, for Trident disks only
ecUnRecovDiskError = 2412
]
//----------------------------------------------------------------------------
let DiskToDisk(dStream, sStream, lvBytes; numargs na) = valof
//----------------------------------------------------------------------------
// Copies data from disk stream sStream to another disk stream dStream.
// lvBytes, if supplied, points to a 32-bit maximum byte count.
// Returns true normally, false if the source stream ran out before
// the requested number of bytes were tranferred.
// Leaves the byte count equal to the number of bytes left to transfer.
[
let defBytes = vec 1; defBytes!0 = -1
if na ls 3 then lvBytes = defBytes
let dPageBytes = 2 lshift LnPageSize(dStream)
let sPageBytes = 2 lshift LnPageSize(sStream)
let dKsBuffer = KsBufferAddress(dStream)
let sKsBuffer = KsBufferAddress(sStream)
while lvBytes!0 ne 0 % lvBytes!1 ne 0 do
[
if Endofs(sStream) resultis false
let dPos, sPos = CurrentPos(dStream), CurrentPos(sStream)
let count = Min(dPageBytes-dPos, sPageBytes-sPos)
if lvBytes!0 eq 0 & lvBytes!1 ge 0 then count = Min(count, lvBytes!1)
PositionPtr(sStream, sPos+count, false)
count = CurrentPos(sStream)-sPos
PositionPtr(dStream, dPos+count)
ByteBlt(dKsBuffer, dPos, sKsBuffer, sPos, count)
if dPos+count eq dPageBytes then CleanupDiskStream(dStream)
if sPos+count eq sPageBytes then CleanupDiskStream(sStream)
DoubleIncrement(lvBytes, -count)
]
resultis true
]
//---------------------------------------------------------------------------
and NetToDisk(diskStream, bspStream, lvExpectedBytes; numargs na) = valof
//---------------------------------------------------------------------------
// Copies data from bspStream to diskStream.
// Returns IFS error code, or zero if OK.
// lvExpectedBytes, if supplied, is a pointer to a 32-bit count of the
// number of bytes expected; this is used as a hint to extend the file
// to the proper length (to speed data transfer) and need not be correct.
[
diskStream>>ST.error = NetToDiskError
let lnCharsPerPage = LnPageSize(diskStream)+1
let charsPerPage = 1 lshift lnCharsPerPage
let ksBuffer = KsBufferAddress(diskStream)
if na ge 3 & lvExpectedBytes ne 0 then
[
// extend file to the proper length if the expected amount of data
// is worth our while and is not so great that we would risk
// exhausting the file system.
let expectedPages = lvExpectedBytes!0 lshift (16-lnCharsPerPage) +
lvExpectedBytes!1 rshift lnCharsPerPage
if expectedPages uge 3 & expectedPages uls 1000 & expectedPages+250 uls
KsGetDisk(diskStream)>>DSK.diskKd>>KDH.freePages then
[
let filePos = vec 1; FilePos(diskStream, filePos)
DoubleAdd(filePos, lvExpectedBytes)
let currentFA = vec lFA; GetCurrentFa(diskStream, currentFA)
SetFilePos(diskStream, filePos)
JumpToFa(diskStream, currentFA)
]
]
[ // repeat
let pos = CurrentPos(diskStream)
let netBytes = BSPReadBlock(bspStream, ksBuffer, pos, charsPerPage-pos)
FlipCursor()
if netBytes ne 0 then SetDirty(diskStream, true)
PositionPtr(diskStream, pos+netBytes)
if pos+netBytes ne charsPerPage break
CleanupDiskStream(diskStream)
] repeat
diskStream>>ST.error = SysErr
resultis (bspStream-offsetBSPStr)>>BSPSoc.markPending? 0, ecNetToDisk
]
//---------------------------------------------------------------------------
and NetToDiskError(s, ec, par) be
//---------------------------------------------------------------------------
// If disk becomes full then just abort the transfer.
// Note that NetToDisk isn't the only context in which the disk can
// overflow, but it is by far the most likely one and is therefore worth
// protecting. (In other cases, IFS will just go into Swat.)
[
if ec eq ecDiskFull then
[ // Flush the stream up to the next mark
let ksBuffer = KsBufferAddress(s)
let charsPerPage = 2 lshift LnPageSize(s)
while BSPReadBlock(CtxRunning>>FtpCtx.bspStream, ksBuffer, 0, charsPerPage) loop
s>>ST.error = SysErr
SetDirty(s, false)
ReturnFrom(NetToDisk, ecFileSystemFull)
]
SysErr(s, ec, par)
]
//---------------------------------------------------------------------------
and DiskToNet(bspStream, diskStream, lvBytes; numargs na) = valof
//---------------------------------------------------------------------------
// Copies data from diskStream to bspStream.
// Returns IFS error code, or zero if OK.
// lvBytes, if supplied points to a 32-bit maximum byte count.
// Leaves the byte count equal to the number of bytes left to transfer.
[
let defBytes = vec 1; defBytes!0 = -1
if na ls 3 then lvBytes = defBytes
diskStream>>ST.error = DiskToNetError
let charsPerPage = 2 lshift LnPageSize(diskStream)
let ksBuffer = KsBufferAddress(diskStream)
FTPM(markHereIsFile)
while lvBytes!0 ne 0 % lvBytes!1 ne 0 do
[
let pos = CurrentPos(diskStream)
let fileBytes = charsPerPage-pos
if lvBytes!0 eq 0 & lvBytes!1 ge 0 then
fileBytes = Min(fileBytes, lvBytes!1)
PositionPtr(diskStream, pos+fileBytes, false)
fileBytes = CurrentPos(diskStream)-pos
if BSPWriteBlock(bspStream, ksBuffer, pos, fileBytes) ne fileBytes then
resultis ecDiskToNet
FlipCursor()
DoubleIncrement(lvBytes, -fileBytes)
if pos+fileBytes ls charsPerPage break
CleanupDiskStream(diskStream)
]
diskStream>>ST.error = SysErr
resultis 0
]
//---------------------------------------------------------------------------
and DiskToNetError(s, ec, par) be
//---------------------------------------------------------------------------
// If a hard data error occurs then just abort the transfer.
[
if ec eq ecUnRecovDiskError then
[
s>>ST.error = SysErr
ReturnFrom(DiskToNet, ecDiskError)
]
SysErr(s, ec, par)
]
//--------------------------------------------------------------------------
and FileType(diskStream) = valof
//--------------------------------------------------------------------------
// true = text; false = binary
[
let text = true
let charsPerPage = 2 lshift LnPageSize(diskStream)
let ksBuffer = KsBufferAddress(diskStream)
Resets(diskStream)
[
PositionPtr(diskStream, charsPerPage, false)
let fileBytes = CurrentPos(diskStream)
if DataIsBinary(ksBuffer, fileBytes) then [ text = false; break ]
if fileBytes ls charsPerPage break
CleanupDiskStream(diskStream)
] repeat
Resets(diskStream)
resultis text
]
//---------------------------------------------------------------------------
and FlipCursor() be
//---------------------------------------------------------------------------
[
manifest cursorBitMap = 431b
for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
]