//		A L T O   E X E C U T I V E
//	Dump/Load module - DumpLoad.bcpl
// Copyright Xerox Corporation 1979

//	This module implements the DUMP, COPY, and LOAD functions
//	of the Executive.

//	E. McCreight
//	last edited by R. Johnsson May 23, 1980  10:04 AM


get "sysdefs.d"
get "altofilesys.d"
get "streams.d"
get "COMSTRUCT.bcpl"

external
	[ Dump
	Load
	Copy
	]

static
	[ BreakBetweenPages
	]

structure BYTES:
	[ char↑1,1 byte
	]


manifest
	[ NameBlock = #377
	DataBlock = #376
	EndBlock = #374
	ErrorBlock = #375
	DateBlock = #373
	]


let Dump(ISTREAM, DSTREAM) be

	[ DumpCopy(ISTREAM, DSTREAM, true)
	]


and Copy(IStream, DStream) be

	[ DumpCopy(IStream, DStream, false)
	]


and DumpCopy(ISTREAM, DSTREAM, ReallyDump) be

	[ static
		[ IsReallyDump

		DIFile
		DOFile

		DIBlock
		DIBlockSize

		DOBlock
		DOBlockSize
		DOStream
		]


	let DOPutOverflow(S, item) = valof

		[ WriteBlock(DOFile, DOBlock, DOBlockSize)
		SetupFstream(S, DOBlock, 0, 2*DOBlockSize)
		resultis RetryCall(S, item)
		]


	let PutBytes(NBytes, Block) be

		[ for i=1 to NBytes do
			Puts(DOStream, Block>>BYTES.char↑i)
		]


	let PutDataBlock(NBytes, Block) be

		[ Puts(DOStream, DataBlock)

		PutBytes(2, lv NBytes)

		let Checksum = NBytes

		for i=0 to (NBytes/2)-1 do
			Checksum = Checksum+(Block!i)

		PutBytes(2, lv Checksum)

		PutBytes(NBytes, Block)
		]


	let FN = vec 200
	let Sw = vec 100
	let IFN = vec 200

	let T = nil

	IsReallyDump = ReallyDump

	SetupReadParam(FN, Sw, ISTREAM, Sw)

	let Clobber = AmongSwitches(Sw, $C)
	BreakBetweenPages = AmongSwitches(Sw, $P)

	if ReadParam($P, -1, FN) eq -1 then
		[ WRITE(FORMATN("No <S>ee file!*N",
			(IsReallyDump? "dump", "copy")))
		return
		]

	let IFNFull = false

	unless IsReallyDump do
		if (ReadParam($P, -1, IFN) eq -1) %
		    (IFN!0 ne "←"!0) then
			[ WRITE(FORMATN(
			   "*"←*" missing; OK to write into <S>? ",
				FN))
			switchon Gets(keys) into
				[ case $Y:
				case $y:
				case $*N:
				case $*L:
				case $*S:
					WRITE("Yes*N")
					IFNFull = true
					endcase

				default:
					WRITE("No*N")
					return
				]
			]

	DOFile = MyOpenFile(FN, (Clobber? ksTypeReadWrite,
						ksTypeWriteOnly),
				charItem)

	INITDIRBLK(MADEBLK)	// So no more allocations
				// will happen due to directory
				// block construction
	
	DOStream = Allocate(CZ, lFS)
	InitializeFstream(DOStream, charItem, DOPutOverflow, 0)

	let TotalBlockSize = BiggestFreeBlock()
	DIBlockSize = ((TotalBlockSize/256)*128)+1
	if DIBlockSize ls 129 then DIBlockSize = 129
	DIBlock = Allocate(CZ, DIBlockSize)

	DOBlockSize = BiggestFreeBlock()
	if DOBlockSize ls 100 then DOBlockSize = 100

	DOBlock = Allocate(CZ, DOBlockSize)
	SetupFstream(DOStream, DOBlock, 0, 2*DOBlockSize)

	let fileCount = 0
	let oldCreationDate = vec lTIME-1

	while IFNFull % (ReadParam($P, -1, IFN) ne -1) do

		[ MAKETIMELINE()

		let DIFile = MyOpenFile(IFN, ksTypeReadOnly,
				charItem)

		IFNFull = false

		test DIFile eq 0

		ifso	[ if WRITE(FORMATN(
				"File <S> doesn't exist.*N",
				IFN), BreakBetweenPages) ne 0 then
					break
			loop
			]

		ifnot	if WRITE(FORMATN("<S>...*N", IFN),
				BreakBetweenPages) ne 0 then
					break

		fileCount = fileCount + 1

		// remember creation date of first file on copy
		unless IsReallyDump % fileCount ne 1 do
			GetCreationDate(DIFile, oldCreationDate)

		if IsReallyDump then
			[ Puts(DOStream, NameBlock)

			for i=1 to 2 do Puts(DOStream, 0)  // File attributes

			for i=1 to IFN>>STRING.length do
				Puts(DOStream, IFN>>STRING.char↑i) // File name

			Puts(DOStream, 0)	// terminating null
			let date = vec 2
			GetCreationDate(DIFile, date)
			date!2 = 0
			Puts(DOStream, DateBlock)
			for i = 1 to 6 do Puts(DOStream, date>>BYTES.char↑i)			]

		let CurDIBlock = DIBlock
		let BytesInCurDIBlock = 0

		until Endofs(DIFile) do

			[ CurDIBlock = DIBlock
	
			let WordsInDIBlock = BytesInCurDIBlock/2
	
			BytesInCurDIBlock = 2*ReadBlock(DIFile,
					DIBlock+WordsInDIBlock,
					DIBlockSize-WordsInDIBlock)+
					BytesInCurDIBlock
	
			if Endofs(DIFile) then
				if (FileLength(DIFile) & 1) ne 0 then
					BytesInCurDIBlock =
						BytesInCurDIBlock-1
	
			test IsReallyDump

			ifso
			    [ while BytesInCurDIBlock ge 258 do
				[ PutDataBlock(256, CurDIBlock)
				CurDIBlock = CurDIBlock+128
				BytesInCurDIBlock =
					BytesInCurDIBlock-256
				]
	
			    MoveBlock(DIBlock, CurDIBlock,
					(BytesInCurDIBlock+1)/2)
			    ]

			ifnot
			    [ for i=1 to BytesInCurDIBlock do
				Puts(DOStream,
					CurDIBlock>>BYTES.char↑i)
			    BytesInCurDIBlock = 0
			    ]
			]

		if IsReallyDump then
		    [ if BytesInCurDIBlock ge 130 then
			[ PutDataBlock(128, CurDIBlock)
			CurDIBlock = CurDIBlock+64
			BytesInCurDIBlock =
				BytesInCurDIBlock-128
			]

		    for i=1 to 2 do
		        CurDIBlock>>BYTES.char↑
				(BytesInCurDIBlock+i) = 0

		    let BytesToTransfer = (BytesInCurDIBlock ls 2)?
					2, BytesInCurDIBlock
		    PutDataBlock(BytesToTransfer, CurDIBlock)
		    ]

		Closes(DIFile)
		]

	if IsReallyDump then Puts(DOStream, EndBlock)

	let CurPos = CurrentPos(DOStream)
	if CurPos ge 2 then
		WriteBlock(DOFile, DOBlock, CurPos/2)
	if (CurPos&1) ne 0 then
		Puts(DOFile, DOBlock>>BYTES.char↑CurPos)

	TruncateDiskStream(DOFile)

	// if copying only one file then copy creation date too
	unless IsReallyDump % fileCount ne 1 do
		SetCreationDate(DOFile, oldCreationDate)

	Closes(DOFile)

	Free(CZ, DOStream)
	Free(CZ, DIBlock)
	Free(CZ, DOBlock)
	]


and GetCreationDate(file, date) be

	[ let leader = vec 255
	ReadLeaderPage(file, leader)
	MoveBlock(date, lv leader>>LD.created, lTIME)
	]


and SetCreationDate(file, date) be

	[ let leader = vec 255
	ReadLeaderPage(file, leader)
	MoveBlock(lv leader>>LD.created, date, lTIME)
	WriteLeaderPage(file, leader)
	]


and AmongSwitches(Switches, char) = valof

	[ for i=1 to Switches!0 do
		if ((Switches!i xor char) &
			($A eqv $a)) eq 0 then resultis true
	resultis false
	]


and BiggestFreeBlock() = valof

	[ let Result = nil
	Allocate(CZ, #77777, lv Result)
	resultis Result
	]


and Load(IStream, DStream) be

	[ static
		[ loadCreationDate
		LDStream

		LIFile
		LOFile

		LIBlock
		LIBlockSize
		LIStream

		LOFileName
		LOBlock
		LOBlockSize
		LOStream
		IsReallyWriting

		LClobber
		LVerify
		]


	let OPutOverflow(S, char) = valof

		[ if IsReallyWriting then
			WriteBlock(LOFile, LOBlock, LOBlockSize)
		SetupFstream(S, LOBlock, 0, 2*LOBlockSize)
		resultis RetryCall(S, char)
		]


	let Cleanup() be

		[ if IsReallyWriting then
			[ let CurPos = CurrentPos(LOStream)
			if CurPos ge 2 then
				WriteBlock(LOFile, LOBlock,
					CurPos/2)
			if (CurPos&1) ne 0 then
				Puts(LOFile, LOBlock>>BYTES.char↑
					CurPos)

			TruncateDiskStream(LOFile)

			if (loadCreationDate!0 % loadCreationDate!1) ne 0 then
			    SetCreationDate(LOFile, loadCreationDate)
			Closes(LOFile)
			IsReallyWriting = false
			]
		Zero(loadCreationDate,3)
		]


	let IGetOverflow(S) = valof

		[ if Endofs(LIFile) then
			[ SetEof(S, true)
			resultis RetryCall(S)
			]

		let BytesRead = 2*
			ReadBlock(LIFile, LIBlock, LIBlockSize)

		if Endofs(LIFile) then
			if (FileLength(LIFile)&1) ne 0 then
				BytesRead = BytesRead-1

		SetupFstream(S, LIBlock, 0, BytesRead)
		resultis RetryCall(S)
		]


	let GetBytes(NBytes, Block) be

		[ for i=1 to NBytes do
			Block>>BYTES.char↑i = Gets(LIStream)
		]


	let GetDataBlock() be

		[ let NBytes = nil
		let Checksum = nil

		GetBytes(2, lv NBytes)
		GetBytes(2, lv Checksum)

		Checksum = Checksum-NBytes

		for i=1 to (NBytes/2) do
			[ let FirstByte = Gets(LIStream)
			let SecondByte = Gets(LIStream)

			Checksum = Checksum-
					((FirstByte lshift 8)+
					SecondByte)

			Puts(LOStream, FirstByte)
			Puts(LOStream, SecondByte)
			]


		if (NBytes&1) ne 0 then
			Puts(LOStream, Gets(LIStream))

		if Checksum ne 0 then
			[ WRITE("*300N O T E: Load checksum differs from dump checksum*301*N*T*T(press any key to continue)*N")
			Resets(keys)
			Gets(keys)
			]
		]

	let SetupOutputFile() = valof

		[ for i=1 to 2 do Gets(LIStream)
		let CharsInFileName = 0
		let Char = Gets(LIStream)

		while Char ne 0 do
			[ CharsInFileName = CharsInFileName+1
			LOFileName>>STRING.char↑CharsInFileName =
				Char
			Char = Gets(LIStream)
			]

		LOFileName>>STRING.length = CharsInFileName

		WRITE(FORMATN("<S>...", LOFileName))
		MAKETIMELINE()	// make new time line
		if LVerify then
			[ WRITE(" OK? ")
			switchon Gets(keys) into
				[ case $Y:
				case $y:
				case $*N:
				case $*L:
				case $*S:
					WRITE("Yes")
					endcase

				case $c:
				case $C:
					WRITE("Yes, but change its name to: ")
					ReadString(LOBlock, "*N",
						keys, LDStream)
					EvalParam(LOBlock, $P, -1,
						LOFileName)
					endcase

				default:
					resultis (WRITE("No*N",
					    BreakBetweenPages) eq
						0)
				]
			]

		if (WRITE($*N, BreakBetweenPages) ne 0) then
			resultis false


		LOFile = MyOpenFile(LOFileName, (LClobber?
				ksTypeReadWrite, ksTypeWriteOnly),
				charItem)

		if LOFile eq 0 then
			[ let T = WRITE("*300Couldn't open the output file*301*N*T*T(press any key to continue)*N",
				BreakBetweenPages)
			Resets(keys)
			Gets(keys)
			resultis (T eq 0)
			]

		SetupFstream(LOStream, LOBlock, 0, 2*LOBlockSize)
		IsReallyWriting = true
		resultis true
		]


	let FN = vec 200
	let Sw = vec 100
	let date = vec 2; Zero(date, 3); loadCreationDate = date

	LDStream = DStream

	let T = nil

	SetupReadParam(FN, Sw, IStream, Sw)

	LClobber = AmongSwitches(Sw, $C)
	LVerify = AmongSwitches(Sw, $V)
	BreakBetweenPages = AmongSwitches(Sw, $P)

	if ReadParam($P, -1, FN) eq -1 then
		[ WRITE("No dump file!*N")
		return
		]

	LIFile = MyOpenFile(FN, ksTypeReadOnly, charItem)

	if LIFile eq 0 then
		[ WRITE(FORMATN(
			"File *"<S>*" doesn't exist.*N", FN))
		return
		]

	INITDIRBLK(MADEBLK)

	LIStream = Allocate(CZ, lFS)
	InitializeFstream(LIStream, charItem, 0, IGetOverflow)
	LOStream = Allocate(CZ, lFS)
	InitializeFstream(LOStream, charItem, OPutOverflow)
	LOFileName = Allocate(CZ, 129)

	let TotalBlockSize = BiggestFreeBlock()
	LIBlockSize = TotalBlockSize/2
	if LIBlockSize ls 129 then LIBlockSize = 129
	LIBlock = Allocate(CZ, LIBlockSize)
	SetupFstream(LIStream, LIBlock, 0, 0)

	LOBlockSize = BiggestFreeBlock()
	LOBlock = Allocate(CZ, LOBlockSize)
	SetupFstream(LOStream, LOBlock, 0, 2*LOBlockSize)

	let dataCount = 0

	while true do

		[ let BlockType = Gets(LIStream)

		switchon BlockType into

			[ case EndBlock:
				Cleanup()
				break
				endcase

			case DataBlock:
				GetDataBlock()
				dataCount = dataCount + 1
				endcase

			case ErrorBlock:
				Cleanup()
				WRITE("Error block encountered!*N")
				break
				endcase

			case DateBlock:
				if dataCount ne 0 then Cleanup()
				GetBytes(6,loadCreationDate)
				endcase

			case NameBlock:
				Cleanup()
				dataCount = 0
				unless SetupOutputFile() do break
				endcase

			default:
				WRITE(FORMATN(
				"Strange block type #<OCT> encountered.*N",
				BlockType))
				Cleanup()
				break
			]

		]

	Closes(LIFile)

	Free(CZ, LIStream)
	Free(CZ, LOStream)
	Free(CZ, LIBlock)
	Free(CZ, LOBlock)
	Free(CZ, LOFileName)

	WIPEDIRBLK()
	]