// CopyDiskUtilB.bcpl // Copyright Xerox Corporation 1979, 1980, 1981 // Last modified December 12, 1981 5:52 PM by Boggs get "Streams.d" get "AltoDefs.d" get "CopyDisk.decl" external [ // outgoing procedures InitCopyDiskUtil MakeSS; DeclareDevice PrintDiskParams; DeclareDiskParams DoIt; GetBuffer; ReleaseBuffer GetNumber; GetString; Confirm Wss; Ding; FatalError; DataCompare // incoming procedures from other parts of CopyDisk MakeNetSS // incoming procedures from OS and packages Allocate; Free; DefaultArgs; Block; InitializeContext SetTimer; TimerHasExpired; Dismiss MoveBlock; Zero; Usc; BlockEq; ReadCalendar Enqueue; Dequeue; Unqueue; DoubleDifference CreateKeywordTable; InsertKeyword; LookupKeyword SetBitPos; CharWidth; EraseBits PutTemplate; Resets; Gets; Puts ExtractSubstring; CopyString // outgoing statics driveLock; compareErrors; seriousErrors // incoming statics show; noShow; keys; dsp ctxQ; sysZone; CtxRunning; debugFlag ] static [ driveLock; compareErrors; seriousErrors deviceKT; pdpQ ] structure String [ length byte; char^1,1 byte ] structure PDP: [ link word diskType word printProc word ] manifest lenPDP = size PDP/16 //---------------------------------------------------------------------------- let InitCopyDiskUtil() be //---------------------------------------------------------------------------- [ deviceKT = CreateKeywordTable(30, 1) pdpQ = Allocate(sysZone, 2); pdpQ!0 = 0 ] //---------------------------------------------------------------------------- and DeclareDevice(name, proc) be InsertKeyword(deviceKT, name)!0 = proc //---------------------------------------------------------------------------- //---------------------------------------------------------------------------- and MakeSS(name, write) = valof //---------------------------------------------------------------------------- // returns an SS or 0 [ Puts(dsp, $*S) test name>>String.char^1 eq $[ ifso resultis MakeNetSS(name, write) ifnot [ let device = nil let kte = LookupKeyword(deviceKT, name, lv device) test kte eq 0 ifso [ Wss(dsp, "- No such disk"); resultis false ] ifnot resultis (kte!0)(device, write) ] ] //---------------------------------------------------------------------------- and DeclareDiskParams(diskType, printProc) be //---------------------------------------------------------------------------- [ let pdp = Allocate(sysZone, lenPDP) pdp>>PDP.diskType = diskType pdp>>PDP.printProc = printProc Enqueue(pdpQ, pdp) ] //---------------------------------------------------------------------------- and PrintDiskParams(cd) be //---------------------------------------------------------------------------- [ let pdp = pdpQ!0 while pdp ne 0 do [ if cd>>CD.diskParams.diskType eq pdp>>PDP.diskType then (pdp>>PDP.printProc)(cd) pdp = pdp>>PDP.link ] ] //---------------------------------------------------------------------------- and DoIt(src, snk, write, tp) = valof //---------------------------------------------------------------------------- [ if src eq 0 % snk eq 0 resultis false manifest lenRWCtx = 400 let freeQ = vec 1; freeQ!0 = 0 let srcCtx = Allocate(sysZone, lenRWCtx) Enqueue(ctxQ, InitializeContext(srcCtx, lenRWCtx, src>>SS.read, 1)) srcCtx>>CDCtx.ss = src src>>SS.inputQ = freeQ let srcTempQ = vec 1; srcTempQ!0 = 0 src>>SS.tempQ = srcTempQ let srcOutputQ = vec 1; srcOutputQ!0 = 0 src>>SS.outputQ = srcOutputQ src>>SS.otherSS = snk src>>SS.tp = tp src>>SS.fatalFlag = false src>>SS.doneFlag = false let snkCtx = Allocate(sysZone, lenRWCtx) Enqueue(ctxQ, InitializeContext(snkCtx, lenRWCtx, (write? snk>>SS.write, snk>>SS.read), 1)) snkCtx>>CDCtx.ss = snk snk>>SS.inputQ = write? srcOutputQ, freeQ let snkTempQ = vec 1; snkTempQ!0 = 0 snk>>SS.tempQ = snkTempQ let snkOutputQ = vec 1; snkOutputQ!0 = 0 snk>>SS.outputQ = write? freeQ, snkOutputQ snk>>SS.otherSS = src snk>>SS.tp = tp snk>>SS.fatalFlag = false snk>>SS.doneFlag = false let lenBuffer = src>>SS.lenBuffer ne 0? src>>SS.lenBuffer, snk>>SS.lenBuffer let numBuffers = 0 let freeSlop = Allocate(sysZone, 1000) [ let buffer = Allocate(sysZone, lenBuffer, true) if buffer eq 0 break Enqueue(freeQ, buffer) numBuffers = numBuffers +1 ] repeat Free(sysZone, freeSlop) unless write do numBuffers = numBuffers rshift 1 src>>SS.numBuffers, src>>SS.maxBuffers = numBuffers, numBuffers snk>>SS.numBuffers, snk>>SS.maxBuffers = numBuffers, numBuffers // DoIt (cont'd) driveLock = false compareErrors = 0 let timer = nil; SetTimer(lv timer, 0) let startTime = vec 2; ReadCalendar(startTime) [ Block() if TimerHasExpired(lv timer) then [ UpdateDAs(src, snk); SetTimer(lv timer, 20) ] let compareDone = write? true, Compare(src, snk) if (src>>SS.doneFlag & snk>>SS.doneFlag & compareDone) % src>>SS.fatalFlag % snk>>SS.fatalFlag break ] repeat UpdateDAs(0, 0) if debugFlag then [ PutTemplate(dsp, "*N$D buffers", numBuffers) let endTime = vec 2; ReadCalendar(endTime) let seconds = DoubleDifference(endTime, startTime) PutTemplate(dsp, "*N$D:$2F0D seconds", seconds/60, seconds rem 60) ] Unqueue(ctxQ, srcCtx); Free(sysZone, srcCtx) Unqueue(ctxQ, snkCtx); Free(sysZone, snkCtx) src>>SS.otherSS, snk>>SS.otherSS = 0, 0 DestroyQueue(freeQ) DestroyQueue(srcTempQ) DestroyQueue(srcOutputQ) DestroyQueue(snkTempQ) DestroyQueue(snkOutputQ) seriousErrors = src>>SS.fatalFlag % snk>>SS.fatalFlag (src>>SS.printBlock)(src, src>>SS.errors) (snk>>SS.printBlock)(snk, snk>>SS.errors) resultis not seriousErrors ] //---------------------------------------------------------------------------- and FatalError(string, a0, a1, a2, a3, a4; numargs na) be //---------------------------------------------------------------------------- [ if na gr 0 & string ne 0 then PutTemplate(dsp, string, a0, a1, a2, a3, a4) CtxRunning>>CDCtx.ss>>SS.fatalFlag = true driveLock = false Block() repeat ] //---------------------------------------------------------------------------- and Compare(src, snk) = valof //---------------------------------------------------------------------------- [ if (src>>SS.outputQ)!0 eq 0 resultis (snk>>SS.outputQ)!0 eq 0 if (snk>>SS.outputQ)!0 eq 0 resultis false let buf1 = Dequeue(snk>>SS.outputQ) let buf2 = Dequeue(src>>SS.outputQ) unless (src>>SS.compare)(src, buf1, buf2) do compareErrors = compareErrors +1 ReleaseBuffer(buf1) ReleaseBuffer(buf2) resultis false ] //---------------------------------------------------------------------------- and DataCompare(buf1, buf2, length) be //---------------------------------------------------------------------------- [ let errors = 0 for i = 0 to length-1 if buf1!i ne buf2!i then [ PutTemplate(dsp, "*N$U6O/$U6O $U6O/$U6O", buf1+i, buf1!i, buf2+i, buf2!i) errors = errors +1 if errors gr 4 break ] ] //---------------------------------------------------------------------------- and UpdateDAs(src, snk) be //---------------------------------------------------------------------------- [ if @displayListHead eq 0 return Resets(noShow) if src ne 0 & snk ne 0 then [ let ss = snk>>SS.type eq ssDisk? snk, src (ss>>SS.printDA)(noShow, ss) ] let dcb = @displayListHead; if dcb ne 0 then [ while dcb>>DCB.next ne show>>DS.cdcb do dcb = dcb>>DCB.next noShow>>DS.cdcb>>DCB.next = show>>DS.cdcb>>DCB.next dcb>>DCB.next = noShow>>DS.cdcb let temp = noShow; noShow = show; show = temp ] ] //---------------------------------------------------------------------------- and DestroyQueue(Q) be //---------------------------------------------------------------------------- while Q!0 ne 0 do Free(sysZone, Dequeue(Q)) //---------------------------------------------------------------------------- and GetBuffer(returnOnFail; numargs na) = valof //---------------------------------------------------------------------------- [ let ss = CtxRunning>>CDCtx.ss let buffer = nil [ if ss>>SS.numBuffers gr 0 then [ buffer = Dequeue(ss>>SS.inputQ) if buffer ne 0 break ] if na gr 0 & returnOnFail resultis false Block() ] repeat buffer>>Buffer.ss = ss ss>>SS.numBuffers = ss>>SS.numBuffers -1 resultis buffer ] //---------------------------------------------------------------------------- and ReleaseBuffer(buffer) be //---------------------------------------------------------------------------- [ let ss = buffer>>Buffer.ss ss>>SS.numBuffers = ss>>SS.numBuffers +1 Enqueue(ss>>SS.inputQ, buffer) ] //---------------------------------------------------------------------------- and Wss(stream, string) be //---------------------------------------------------------------------------- for i = 1 to string>>String.length do Puts(stream, string>>String.char^i) //---------------------------------------------------------------------------- and Ding(stream) be //---------------------------------------------------------------------------- [ let dcb = stream>>DS.fdcb [ dcb>>DCB.background = not dcb>>DCB.background dcb = dcb>>DCB.next if dcb eq stream>>DS.ldcb break ] repeat Dismiss(10) let dcb = stream>>DS.fdcb [ dcb>>DCB.background = not dcb>>DCB.background dcb = dcb>>DCB.next if dcb eq stream>>DS.ldcb break ] repeat ] //---------------------------------------------------------------------------- and GetString(prompt, def, mode, question; numargs na) = valof //---------------------------------------------------------------------------- [ DefaultArgs(lv na, 0, 0, 0, editEcho+editReplace, 0) let echo = (mode & editEcho) ne 0 let replace = (mode & editReplace) ne 0 if prompt then Wss(dsp, prompt) let string, count = vec 128, 0 if def then [ count = def>>String.length CopyString(string, def) if echo & replace then Wss(dsp, def) Free(sysZone, def) ] [ let char = Gets(keys) switchon char into [ case $*001: case $*010: [ replace = false if count ne 0 then [ if echo ne 0 then EraseBits(dsp, -CharWidth(dsp, string>>String.char^count)) count = count -1 ] endcase ] case $*S: case $*N: case $*033: break case $?: [ if count eq 0 & question ne 0 then [ question(); if prompt then Wss(dsp, prompt) ] endcase ] case $*177: [ Wss(dsp, " XXX"); resultis 0 ] default: [ if char eq $*027 % replace then [ if echo then for i = count to 1 by -1 do EraseBits(dsp, -CharWidth(dsp, string>>String.char^i)) count, replace = 0, false ] if char ge $*S & char le $*177 then [ count = count +1 string>>String.char^count = char if echo then Puts(dsp, char) ] endcase ] ] ] repeat if count eq 0 resultis 0 string>>String.length = count resultis ExtractSubstring(string) ] //---------------------------------------------------------------------------- and GetNumber(prompt, def; numargs na) = valof //---------------------------------------------------------------------------- [ DefaultArgs(lv na, 0, 0, 0) if prompt then Wss(dsp, prompt) if na gr 1 then PutTemplate(dsp, "$UO", def) let number = def let digitTyped = na gr 1 [ let char = Gets(keys) switchon char into [ case $*N: case $*S: case $*033: [ if digitTyped resultis number; endcase ] case $*177: [ Wss(dsp, " XXX"); resultis 0 ] case $0 to $7: [ if na gr 1 then [ na = 0 while number ne 0 do [ EraseBits(dsp, -CharWidth(dsp, (number&7)+$0)) number = number rshift 3 ] ] number = number lshift 3 + char-$0 Puts(dsp, char) digitTyped = true endcase ] case $*001: case $*010: [ na = 0 if number ne 0 then EraseBits(dsp, -CharWidth(dsp, (number&7)+$0)) number = number lshift 3 endcase ] ] ] repeat ] //---------------------------------------------------------------------------- and Confirm(prompt; numargs na) = valof //---------------------------------------------------------------------------- [ PutTemplate(dsp, "$S [Confirm] ", (na? prompt, "")) switchon Gets(keys) into [ case $Y: case $y: case $*N: [ Wss(dsp, "Yes"); resultis true ] case $N: case $n: case $*177: [ Wss(dsp, "No"); resultis false ] case $?: [ Wss(dsp, "Y, y, , or N, n, "); loop ] default: [ Ding(dsp); endcase ] ] repeat ]