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