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