// IfsCopyDiskJob.bcpl
// Copyright Xerox Corporation 1980, 1981
// Last modified December 11, 1981  6:26 PM by Taft

get KDH, freePages, FA, pageNumber, lFA from "AltoFileSys.d"
get DSK, diskKd from "Disks.d"
get ecFileSystemFull, ecDiskError from "IfsDirs.decl"
get "Ifs.decl"
get "IfsSystemInfo.decl"
get "Streams.d"
get "IfsRS.decl"
get "IfsCopyDisk.decl"

external
[
// outgoing procedures
CopyDiskJob
PutString; PutIfsEc; PutBlock

// incoming procedures
CDVersion; CDLogin; CDSendErrors; CDCloseFile
CDSendDiskParams; CDHereAreDiskParams

CreateUserInfo; DestroyUserInfo; DestroyJob
BSPReadBlock; BSPWriteBlock; BSPForceOutput
LnPageSize; KsBufferAddress; CurrentPos; TruncateDiskStream
CleanupDiskStream; SetDirty; PositionPtr; WriteBlock
KsGetDisk; GetCurrentFa; JumpToFa; PositionPage
CreateStringStream; PutTemplate; LookupErrorCode
MoveBlock; Min; ReturnFrom; SysErr; GotoFrame; MyFrame; Noop
Gets; Puts; Closes; Resets; Endofs; SysAllocate; SysFree

// incoming statics
offsetBSPStr; CtxRunning
]

manifest
[
ecUnRecovDiskError = 2412  // for Trident disks only
ecDiskFull = 2413  // for Trident disks only
cursorBitMap = 431b
pagesPerBatch = 19*9  // preallocate 1 cylinder's worth of pages at a time
]

//----------------------------------------------------------------------------
let CopyDiskJob(ctx) be		// an IFS job
//----------------------------------------------------------------------------
[
let bspStream = ctx>>RSCtx.bspSoc + offsetBSPStr
ctx>>RSCtx.userInfo = CreateUserInfo()

CopyDiskServer(bspStream)  //the work happens in here

if ctx>>RSCtx.connFlag ne 0 then Closes(bspStream)
CDCloseFile()
DestroyUserInfo(ctx>>RSCtx.userInfo)
DestroyJob()  //suicide
]

//----------------------------------------------------------------------------
and CopyDiskServer(bspStream) be
//----------------------------------------------------------------------------
[
let length = Gets(bspStream, 18000) lshift 8  // 3 minute top level timeout
length = Gets(bspStream) + length
if length ugr 150 return  // don't be too gullible
let cb = SysAllocate(length)
cb>>CB.length = length
if BSPReadBlock(bspStream, lv cb>>CB.type, 0,
 (length-1) lshift 1) ne (length-1) lshift 1 then  // stream failed
   [ SysFree(cb); return ]

switchon cb>>CB.type into
   [
   case version:
      [ CDVersion(cb); endcase ]
   case login:
      [ CDLogin(cb); endcase ]
   case sendDiskParamsR: case sendDiskParamsW:
      [ CDSendDiskParams(cb); endcase ]
   case hereAreDiskParams:
      [ CDHereAreDiskParams(cb); endcase ]
   case storeDisk:
      [ CDStoreDisk(cb); endcase ]
   case retrieveDisk:
      [ CDRetrieveDisk(cb); endcase ]
   case sendErrors:
      [ CDSendErrors(cb); endcase ]
   case comment:
      endcase
   default:
      [ PutIfsEc(no, ecUnknownCmd); endcase ]
   ]
SysFree(cb)
] repeat

//----------------------------------------------------------------------------
and CDStoreDisk(cb) be
//----------------------------------------------------------------------------
// Copies data from bspStream to diskStream.
[
test CtxRunning>>CDCtx.diskStream eq 0
   ifso [ PutIfsEc(no, ecNoDisk); return ]
   ifnot test CtxRunning>>CDCtx.diskParams eq 0
      ifso [ PutIfsEc(no, ecNoDiskParams); return ]
      ifnot PutIfsEc(yes, ecReadyForDisk)

let bspStream = CtxRunning>>RSCtx.bspSoc+offsetBSPStr
let diskStream = CtxRunning>>CDCtx.diskStream
let charsPerPage = 2 lshift LnPageSize(diskStream)
let ksBuffer = KsBufferAddress(diskStream)

let savedErrorProc = diskStream>>ST.error
diskStream>>ST.error = CDStoreDiskError
diskStream>>ST.par2 = MyFrame()

Resets(diskStream)
let dp = CtxRunning>>CDCtx.diskParams
WriteBlock(diskStream, dp, dp>>CB.length)

let cbType = nil
let pagesPreallocated = 0
CtxRunning>>CDCtx.delete = false

// CDStoreDisk (cont'd)

   [ // repeat -- transfer blocks to and including endOfTransfer block
   let cbLength = Gets(bspStream) lshift 8
   cbLength = Gets(bspStream) + cbLength
   if (cbLength-2) ugr 1500 then
      [ CtxRunning>>CDCtx.delete = true; break ]   // bad block size
   cbType = Gets(bspStream) lshift 8
   cbType = Gets(bspStream) + cbType
   Puts(diskStream, cbLength)  // wordItem stream
   Puts(diskStream, cbType)

   let cbBytes = (cbLength-2) lshift 1  // remaining bytes in block
   while cbBytes ne 0 do
      [
      let pos = CurrentPos(diskStream)
      let netBytes = Min(cbBytes, charsPerPage-pos)
      if BSPReadBlock(bspStream, ksBuffer, pos, netBytes) ne netBytes then
         [ CtxRunning>>CDCtx.delete = true; break ]  // stream died
      if netBytes ne 0 then SetDirty(diskStream, true)
      PositionPtr(diskStream, pos+netBytes)
      cbBytes = cbBytes-netBytes

      if pos+netBytes eq charsPerPage then
         [
         test CtxRunning>>CDCtx.delete
            ifso PositionPtr(diskStream, 0)
            ifnot CleanupDiskStream(diskStream)  // write out stream buffer
         for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
         pagesPreallocated = pagesPreallocated-1
         if pagesPreallocated le 0 & not CtxRunning>>CDCtx.delete then
            [
            // Preallocate a new batch of pages, so long as that doesn't run
            // the file system too close to exhaustion.
            pagesPreallocated = pagesPerBatch
            if Endofs(diskStream) &
             KsGetDisk(diskStream)>>DSK.diskKd>>KDH.freePages ugr
             pagesPerBatch+250 then
               [
               let currentFA = vec lFA; GetCurrentFa(diskStream, currentFA)
               PositionPage(diskStream, currentFA>>FA.pageNumber + pagesPerBatch)
               JumpToFa(diskStream, currentFA)
               ]
            ]
         ]
      ]

   if cbType eq endOfTransfer break
   ] repeat

diskStream>>ST.error = savedErrorProc
test CtxRunning>>CDCtx.delete
   ifso [ SetDirty(diskStream, false); CDCloseFile() ]
   ifnot TruncateDiskStream(diskStream)
]

//---------------------------------------------------------------------------
and CDStoreDiskError(s, ec, par) be
//---------------------------------------------------------------------------
// If local disk becomes full then set discard flag in ST.par3, which will
// cause the remainder of the incoming disk image to be thrown away.
[
if ec eq ecDiskFull then
   [
   SetDirty(s, false)
   s>>ST.puts = Noop
   CtxRunning>>CDCtx.delete = true
   CtxRunning>>CDCtx.errorCode = ecFileSystemFull
   GotoFrame(s>>ST.par2)
   ]
SysErr(s, ec, par)
]

//----------------------------------------------------------------------------
and CDRetrieveDisk(cb) be
//----------------------------------------------------------------------------
// Copies data from diskStream to bspStream.
// Stops if the stream goes bad or end of file.
[
test CtxRunning>>CDCtx.diskStream eq 0
   ifso
      [
      PutIfsEc(no, (CtxRunning>>CDCtx.errorCode ne 0?
       CtxRunning>>CDCtx.errorCode, ecNoDisk))
      return
      ]
   ifnot PutIfsEc(yes, ecHereIsDisk)

let bspStream = CtxRunning>>RSCtx.bspSoc+offsetBSPStr
let diskStream = CtxRunning>>CDCtx.diskStream
let charsPerPage = 2 lshift LnPageSize(diskStream)
let ksBuffer = KsBufferAddress(diskStream)

let savedErrorProc = diskStream>>ST.error
diskStream>>ST.error = CDRetrieveDiskError

// skip disk param block - assumed to be smaller than ksBuffer
Resets(diskStream)
PositionPtr(diskStream, ksBuffer>>CB.length*2, false)

   [
   let pos = CurrentPos(diskStream)
   PositionPtr(diskStream, charsPerPage, false)
   let fileBytes = CurrentPos(diskStream)-pos
   if BSPWriteBlock(bspStream, ksBuffer, pos, fileBytes) ne fileBytes break
   if pos+fileBytes ls charsPerPage break
   CleanupDiskStream(diskStream)
   for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
   ] repeat

BSPForceOutput(CtxRunning>>RSCtx.bspSoc)
diskStream>>ST.error = savedErrorProc
]

//---------------------------------------------------------------------------
and CDRetrieveDiskError(s, ec, par) be
//---------------------------------------------------------------------------
// If hard error on local disk, remember error code and proceed.
[
if ec eq ecUnRecovDiskError then
   [
   CtxRunning>>CDCtx.errorCode = ecDiskError
   return  // TFS will ignore the error
   ]
SysErr(s, ec, par)
]

//----------------------------------------------------------------------------
and PutBlock(cb, type, length) be
//----------------------------------------------------------------------------
[
cb>>CB.type = type
cb>>CB.length = length
let bspStream = CtxRunning>>RSCtx.bspSoc+offsetBSPStr
if BSPWriteBlock(bspStream, cb, 0, length*2) eq length*2 then
   BSPForceOutput(CtxRunning>>RSCtx.bspSoc)
]

//----------------------------------------------------------------------------
and PutString(type, code, string, a0, a1, a2, a3, a4) be
//----------------------------------------------------------------------------
[
let cb = SysAllocate(lenCodeString+128)
cb>>CB.codeString.code = code
let str = lv cb>>CB.codeString.string
let ss = CreateStringStream(str, 255)
PutTemplate(ss, string, a0, a1, a2, a3, a4)
Closes(ss)
PutBlock(cb, type, lenCodeString + str>>String.length rshift 1 +1)
SysFree(cb)
]

//----------------------------------------------------------------------------
and PutIfsEc(type, ec) be
//----------------------------------------------------------------------------
[
let errRec = LookupErrorCode(ec)
PutString(type, errRec>>ErrRec.ftpEc, lv errRec>>ErrRec.errorString)
SysFree(errRec)
]