// FastCopy.bcpl created by Steve Putz
// last edited by Steve Putz February 13, 1985 10:40 PM
// to load: BLDR FastCopy BFSInit GP Password
// to run: FastCopy newFile[/partition] ← oldFile[/partition]
get "AltoFileSys.d"
get "Streams.d"
external
[ CallSwat // from OS
DayTime
OpenFile
ReadBlock
WriteBlock
FilePos
SetFilePos
PositionPtr
TruncateDiskStream
ReadLeaderPage
WriteLeaderPage
Closes
BFSClose
MoveBlock
Gets
Puts
Ws
Wns
dsp
keys
sysZone
lvUserFinishProc
UserPassword
BFSInit // from BFSInit.br
ReadParam // from GP.br
SetupReadParam
Password // from Password.br
]
manifest
[ pageSize = 256
bufferPages = 127
bufferSize = bufferPages*pageSize
]
static
[ savedUFP
oldPart
]
structure String:
[ length byte
char↑1,255 byte
]
let FastCopy() be
[ Ws("FastCopy.run -- Fast cross-partition file copy program of February 13, 1985*n")
// define special Alto call procedures
let AltoVersion = table [ 61014b; 1401b ]
let ChangePartition = table [ 61037b; 1401b ]
if AltoVersion() rshift 12 ls 4 then
[ Ws("No partitions on this machine.")
finish
]
oldPart = ChangePartition(0)
savedUFP = @lvUserFinishProc
@lvUserFinishProc = MyCleanUp
let buffer = vec bufferSize // allocate large disk buffer
let destName = vec 50
let sourceName = vec 50
let switches = vec 50 // unpacked string
SetupReadParam(0, switches)
let noAccessCheck = switches!0 eq 1 & switches!1 eq $P
ReadParam($P, "destination file: ", destName) // packed BCPL string
let destPart = 0
for i = 1 to switches!0 do destPart = destPart*10 + (switches!i) - $0
if destPart eq 0 then destPart = oldPart
if ReadParam($P, -1, sourceName) ne -1 & sourceName!0 ne "←"!0
then SyntaxError()
ReadParam($P, "source file: ", sourceName) // packed BCPL string
let sourcePart = 0
for i = 1 to switches!0 do sourcePart = sourcePart*10 + (switches!i) - $0
if sourcePart eq 0 then sourcePart = oldPart
if ChangePartition(sourcePart) eq 0 then
[ Ws("unable to access BFS"); Wns(dsp, sourcePart)
finish
]
let sourceDisk = 0 // i.e. default to sysDisk
if sourcePart ne oldPart then
[ sourceDisk = BFSInit(sysZone, false) // (false = no allocation)
if sourceDisk eq 0 then
[ Ws("unable to access BFS"); Wns(dsp, sourcePart)
finish
]
]
unless noAccessCheck % CheckAccess(sourcePart, sourceDisk) do
[ Ws("Password incorrect for BFS"); Wns(dsp, sourcePart)
if sourcePart ne oldPart then BFSClose(sourceDisk)
finish
]
let source = OpenFile(sourceName, ksTypeReadOnly, charItem, 0, 0, 0, 0, 0, sourceDisk)
if source eq 0 then
[ Ws("BFS"); Wns(dsp, sourcePart); Ws(":")
Ws(sourceName); Ws(" not found")
finish
]
if ChangePartition(destPart) eq 0 then
[ Ws("unable to access BFS"); Wns(dsp, destPart)
finish
]
let destDisk = 0 // i.e. default to sysDisk
if destPart ne oldPart then
[ test destPart eq sourcePart
ifso destDisk = sourceDisk
ifnot
[ destDisk = BFSInit(sysZone, true) // (true = allow allocation)
if destDisk eq 0 then
[ Ws("unable to access BFS"); Wns(dsp, destPart)
ChangePartition(sourcePart)
Closes(source)
if sourcePart ne oldPart then BFSClose(sourceDisk)
finish
]
]
]
unless noAccessCheck % CheckAccess(destPart, destDisk) do
[ Ws("Password required for BFS"); Wns(dsp, destPart)
ChangePartition(sourcePart)
Closes(source)
if sourcePart ne oldPart then BFSClose(sourceDisk)
finish
]
let dest = OpenFile(destName, ksTypeWriteOnly, charItem, 0, 0, 0, 0, 0, destDisk)
if dest eq 0 then
[ Ws("Error opening ")
Ws("BFS"); Wns(dsp, destPart); Ws(":"); Ws(destName)
ChangePartition(sourcePart)
Closes(source)
if sourcePart ne oldPart then BFSClose(sourceDisk)
finish
]
Ws("copying ")
Ws("BFS"); Wns(dsp, sourcePart); Ws(":"); Ws(sourceName)
Ws(" to ")
Ws("BFS"); Wns(dsp, destPart); Ws(":"); Ws(destName)
Ws(" (buffer size = "); Wns(dsp, bufferPages); Ws(" pages)")
let readCount = nil
let writeCount = nil
let transfers = 0
let startTime = vec 2
DayTime(startTime)
[ ChangePartition(sourcePart)
readCount = ReadBlock(source, buffer, bufferSize) // number of words read
ChangePartition(destPart)
writeCount = WriteBlock(dest, buffer, readCount)
if readCount ne writeCount
then [ ChangePartition(oldPart); CallSwat("Error Writing") ]
Ws(".")
transfers = transfers + 1
] repeatuntil readCount ls bufferSize
ChangePartition(sourcePart)
let bytePos = FilePos(source) & (pageSize*2-1) // chars in last page
ChangePartition(destPart)
PositionPtr(dest, bytePos) // back up if length is odd
TruncateDiskStream(dest)
let leader = vec pageSize
ReadLeaderPage(dest, leader)
ChangePartition(sourcePart)
ReadLeaderPage(source, buffer)
MoveBlock(lv leader>>LD.created, lv buffer>>LD.created, lTIME)
ChangePartition(destPart)
WriteLeaderPage(dest, leader) // copy source creation date
Closes(dest)
if destPart ne oldPart then BFSClose(destDisk)
ChangePartition(sourcePart)
Closes(source)
if sourcePart ne oldPart & destPart ne sourcePart then BFSClose(sourceDisk)
ChangePartition(oldPart)
let stopTime = vec 2
DayTime(stopTime)
let elapsedTime = stopTime!1 - startTime!1
Ws("done.*n")
Wns(dsp, (transfers-1)*bufferPages+(readCount+pageSize-1)/pageSize)
Ws(" pages copied in "); Wns(dsp, elapsedTime); Ws(" seconds.")
finish
]
and SyntaxError() be
[
Ws("Syntax is:*n*t>FastCopy newFile[/partition] ← oldFile[/partition]")
finish
]
and CheckAccess(diskPart, disk) = valof
[ if disk eq 0 then resultis true // disk is current partition
let sysBoot = OpenFile("Sys.boot", ksTypeReadOnly, wordItem, 0, 0, 0, 0, 0, disk)
if sysBoot eq 0 then
[ Ws("Unable to access BFS"); Wns(dsp, diskPart)
Ws(":Sys.boot -- cannot determine if ") // "Password required..."
resultis false
]
SetFilePos(sysBoot, 0, 1400b) //see Password.bcpl in OS
let diskPsw = vec 9
ReadBlock(sysBoot, diskPsw, 9)
Closes(sysBoot)
if diskPsw!0 eq 0 then resultis true // no disk password
let userPsw = vec 50
let char = 0
MoveBlock(userPsw, UserPassword, UserPassword!-1)
until Password(userPsw, diskPsw, false) do
[ if char ne 0 then Ws("Incorrect. ")
Ws("Please enter password for BFS"); Wns(dsp, diskPart); Ws(": ")
userPsw>>String.length = 0
[ char = Gets(keys)
if char eq $*n then break
if char eq 127 then [ Ws("XXX*n"); resultis false ] // DEL aborts
userPsw>>String.length = (userPsw>>String.length)+1
userPsw>>String.char↑(userPsw>>String.length) = char
Puts(dsp, $**) // echo *
] repeat
Puts(dsp, $*n) // new line
]
resultis true
]
and MyCleanUp(code) be
[
let ChangePartition = table [ 61037b; 1401b ]
ChangePartition(oldPart)
@lvUserFinishProc = savedUFP
]