// FtpUtilCompB.bcpl - Block compare net stream with disk stream // Copyright Xerox Corporation 1979, 1980, 1981, 1982 // Last modified May 13, 1982 1:28 PM by Boggs get "Pup.decl" get "FtpProt.decl" external [ // outgoing procedures CompareNetWithDisk // incoming procedures Zero; PutTemplate; DoubleIncrement; Min Endofs; FlipCursor; BlockEq; PrintBegin ReadBlock; CurrentPos; BSPReadBlock // incoming statics CtxRunning ] structure Byte↑0,0 byte //----------------------------------------------------------------------------------------- let CompareNetWithDisk(remotePL, localPL) = valof //----------------------------------------------------------------------------------------- [ PrintBegin(remotePL) let bspStream = CtxRunning>>FtpCtx.bspStream let diskStream = CtxRunning>>FtpCtx.diskStream let buffBytes = CtxRunning>>FtpCtx.bufferLength let buffWords = CtxRunning>>FtpCtx.bufferLength rshift 1 let netBuffer = CtxRunning>>FtpCtx.buffer let diskBuffer = netBuffer + buffWords let bytes = vec 1; Zero(bytes, 2) let diskBytes, netBytes, minBytes = nil, nil, nil let filesAreIdentical = valof [ test (CurrentPos(diskStream) & 1) eq 1 ifso diskBytes = 0 ifnot [ diskBytes = ReadBlock(diskStream, diskBuffer, buffWords) lshift 1 if (CurrentPos(diskStream) & 1) eq 1 then diskBytes = diskBytes -1 ] netBytes = BSPReadBlock(bspStream, netBuffer, 0, buffBytes) minBytes = Min(diskBytes, netBytes) FlipCursor() if netBytes ne diskBytes resultis false if netBytes eq 0 resultis Endofs(diskStream) unless BlockEq(diskBuffer, netBuffer, minBytes rshift 1) resultis false if (minBytes & 1) eq 1 then if netBuffer>>Byte↑(minBytes-1) ne diskBuffer>>Byte↑(minBytes-1) then resultis false DoubleIncrement(bytes, minBytes) ] repeat unless filesAreIdentical for i = 0 to minBytes-1 do if diskBuffer>>Byte↑i ne netBuffer>>Byte↑i then [ DoubleIncrement(bytes, i); break ] while BSPReadBlock(bspStream, netBuffer, 0, buffBytes) loop unless CtxRunning>>FtpCtx.bspSoc>>BSPSoc.markPending resultis false test filesAreIdentical ifso PutTemplate(CtxRunning>>FtpCtx.lst, "$ED identical bytes", bytes) ifnot PutTemplate(CtxRunning>>FtpCtx.lst, "First difference at byte pos $ED", bytes) resultis true ]