-- File Merge.mesa
-- Written by Martin Newell, June 1980
-- Last updated: December 21, 1981  3:40 PM by DF

DIRECTORY

crD: FROM "CoreDefs" USING [CloseFile, OpenFile, PageNumber, ReadPages, UFileHandle,
	UFileTruncate, WritePages],
InlineDefs: FROM "InlineDefs" USING[BITAND, BITSHIFT],
MergeDefs: FROM "MergeDefs" USING[MergeValue],
MiscDefs: FROM "MiscDefs" USING [Zero],
Mopcodes: FROM "Mopcodes" USING [zEXCH, zPOP],
ovD: FROM "OverviewDefs" USING [ErrorCode, ok],
-- SegmentDefs: FROM "SegmentDefs" USING [NewFile, Read, OldFileOnly, DestroyFile],
StringDefs: FROM "StringDefs" USING [AppendString],
SystemDefs: FROM "SystemDefs" USING [AllocateResidentPages, FreePages];

Merge: PROGRAM
IMPORTS crD, InlineDefs, MiscDefs, StringDefs, SystemDefs
EXPORTS MergeDefs =

BEGIN OPEN crD, InlineDefs, MergeDefs, MiscDefs, Mopcodes, ovD, StringDefs, SystemDefs;


InitMerge: PUBLIC PROCEDURE [fileName: STRING] =
-- Initialize merge to use file fileName
	BEGIN
	GenValue _ ZeroValue;
	OpenMergeFile[fileName];
	END;

ConsolidateMerge: PUBLIC PROCEDURE =
	BEGIN
	n, k, nbuff: CARDINAL;
	m, r, t: MergeValue;
	ncount: LONG CARDINAL _ 0;

	-- go through the node number table, sequentiallly renumbering root nodes
	k _ LowHalf[GenValue];
	FOR n IN [1 .. k] DO
		m _ LOOPHOLE[LONG[n], MergeValue];
		nbuff _ Lock[m,0];
		r _ IntLookup[m,nbuff].r;
		IF m=r 
			THEN BEGIN
				t _ LOOPHOLE[(ncount _ ncount + 1) + 2B10];
				[] _ SetValue[m,nbuff,t];
			 END
			ELSE t _ r;
		Unlock[nbuff];
	 ENDLOOP;

	-- Set Consolidate Flag
	Pass2 _ TRUE;
	END;

FinishMerge: PUBLIC PROCEDURE =
-- Close files and release structures
	BEGIN
	CloseMergeFile[];
	END;

GenMergeValue: PUBLIC PROCEDURE RETURNS[n: MergeValue] =
--Generate new Merge value
	BEGIN
	RETURN[GenValue _ GenValue + 1];
	END;

Merge: PUBLIC PROCEDURE [n1,n2: MergeValue] RETURNS[r: MergeValue] =
--Merge numbers n1 and n2 towards smaller of the two
--Returns resulting value of Lookup[n1] (=Lookup[n2])
	BEGIN
	r1,r2: MergeValue;
	n1buff,n2buff,r1buff,r2buff: CARDINAL;
	n1buff _ Lock[n1,0];
	n2buff _ Lock[n2,0];
--find roots, r1,r2 of n1,n2
	[r1,r1buff] _ IntLookup[n1,n1buff];
	[] _ Lock[r1,r1buff];
	[r2,r2buff] _ IntLookup[n2,n2buff];
	[] _ Lock[r2,r2buff];
--merge roots
--new root is min of r1 and r2
	IF LessThan[r1,r2] THEN
		BEGIN
		r _ r1;
		[] _ SetValue[r2,r2buff,r];
		END
	ELSE
		BEGIN
		r _ r2;
		[] _ SetValue[r1,r1buff,r];
		END;
--shorten paths from n1 and n2 to new root
	[] _ SetValue[n1,n1buff,r];
	[] _ SetValue[n2,n2buff,r];
	UnlockAll[];
	END;

Lookup: PUBLIC PROCEDURE[n: MergeValue]
		RETURNS[r: MergeValue] =
--Return smallest number to which n has been merged, transitively closed
	BEGIN
	nbuff: CARDINAL;
	nbuff _ Lock[n,0];
	r _ IntLookup[n,nbuff].r;
	[] _ SetValue[n,nbuff,r];
	Unlock[nbuff];
	END;

Lookup2: PUBLIC PROCEDURE[n: MergeValue]
		RETURNS[r: MergeValue] =
--Return smallest number to which n has been merged, transitively closed
	BEGIN
	nbuff: CARDINAL;
	nbuff _ Lock[n,0];
	r _ IntLookup2[n,nbuff].r;
	Unlock[nbuff];
	END;


--Private procedures--

BufferTable: ARRAY [0..4) OF BufferDesc;
BufferDesc: TYPE = RECORD [
	page: INTEGER,
	dirty: BOOLEAN,
	lock: INTEGER,
	buffer: POINTER
];

next4: ARRAY [0..4) OF CARDINAL _ [1, 2, 3, 0];

FileName: STRING _ [40];
uFH: crD.UFileHandle _ NIL;
bufferArea: POINTER;
Pass2: BOOLEAN _ FALSE;

OpenMergeFile: PROCEDURE[fileName: STRING] =
	BEGIN
	i: CARDINAL;
	erc: ovD.ErrorCode;
	buffer: POINTER;
	FileName.length _ 0;
	AppendString[FileName,fileName];
	[erc,uFH] _ crD.OpenFile[[["Extractor"],[""]],[fileName],update];
	IF erc#ovD.ok THEN MergeError["Problem opening file"];
	IF crD.UFileTruncate[0,0,uFH]#ovD.ok THEN MergeError["Problem opening old file"];
	bufferArea _ AllocateResidentPages[4];
	buffer _ bufferArea;
	FOR i IN [0..4) DO
		BufferTable[i] _ [
			page: -1,
			dirty: FALSE,
			lock: 0,
			buffer: buffer];
		buffer _ buffer + 256;
	ENDLOOP;
	END;

CloseMergeFile: PROCEDURE =
	BEGIN
	FreePages[bufferArea];
	IF crD.UFileTruncate[0,0,uFH]#ovD.ok THEN MergeError["Problem truncating file"];
	IF crD.CloseFile[uFH]#ovD.ok THEN MergeError["Problem closing file"];
	uFH _ NIL;
 	--DestroyFile[NewFile[FileName,Read,OldFileOnly]];
	END;

IntLookup: PROCEDURE[n: MergeValue, nbuff: CARDINAL]
		RETURNS[r: MergeValue, rbuff: CARDINAL] =
--Return smallest number to which n has been merged, transitively closed
	BEGIN
	t: MergeValue;
	flag : BOOLEAN _ FALSE;

--find root, r, of n
	[t,nbuff,flag] _ GetValue[n,nbuff];
	r _ n;
	rbuff _ nbuff;
	UNTIL flag OR r=t DO
		r _ t;
		[t,rbuff,flag] _ GetValue[r,rbuff]; --rbuff is only a hint on rhs
	ENDLOOP;
	END;

IntLookup2: PROCEDURE[n: MergeValue, nbuff: CARDINAL]
		RETURNS[r: MergeValue, rbuff: CARDINAL] =
--Return smallest number to which n has been merged, transitively closed
	BEGIN
	t: MergeValue;
	flag : BOOLEAN _ FALSE;

--find root, r, of n
	[t,nbuff,flag] _ GetValue[n,nbuff];
	r _ n;
	rbuff _ nbuff;
	UNTIL flag OR r=t DO
		r _ t;
		[t,rbuff,flag] _ GetValue[r,rbuff]; --rbuff is only a hint on rhs
	REPEAT 
		FINISHED => IF Pass2 AND flag THEN r _ t;
	ENDLOOP;
	END;

SetValue: PROCEDURE[n: MergeValue, nbuff: CARDINAL, v: MergeValue]
		RETURNS[realnbuff: CARDINAL] =
	BEGIN
	vptr: POINTER TO MergeValue;
	npage,noffset: CARDINAL;
	IF n=v THEN RETURN; --not uncommon
	[npage,noffset] _ PageAddress[n];
	realnbuff _ GetPage[npage,nbuff];
	vptr _ BufferTable[realnbuff].buffer + noffset;
	IF vptr^#v THEN --avoid setting .dirty if possible
		BEGIN
		vptr^ _ v;
		BufferTable[realnbuff].dirty _ TRUE;
		END;
	END;

GetValue: PROCEDURE[n: MergeValue, nbuff: CARDINAL]
		RETURNS[v: MergeValue, realnbuff: CARDINAL, done: BOOLEAN] =
	BEGIN
	vptr: POINTER TO MergeValue;
	npage,noffset: CARDINAL;
	[npage,noffset] _ PageAddress[n];
	realnbuff _ GetPage[npage,nbuff];
	vptr _ BufferTable[realnbuff].buffer + noffset;
	IF ((v _ vptr^) = ZeroValue) THEN v _ n;
	IF done _ (LOOPHOLE[v, LONG CARDINAL] >= 2B10)
			THEN v _ LOOPHOLE[(LOOPHOLE[v, LONG CARDINAL] - 2B10)];
	END;

Lock: PROCEDURE[n: MergeValue, nbuff: CARDINAL] RETURNS[realnbuff: CARDINAL] =
	BEGIN
	npage,noffset: CARDINAL;
	[npage,noffset] _ PageAddress[n];
	realnbuff _ GetPage[npage,nbuff];
	BufferTable[realnbuff].lock _ BufferTable[realnbuff].lock + 1;
	END;

Unlock: PROCEDURE[buff: CARDINAL] =
	BEGIN
	BufferTable[buff].lock _ BufferTable[buff].lock - 1;
	END;

UnlockAll: PROCEDURE =
	BEGIN
	i: CARDINAL;
	FOR i IN [0..4) DO
		BufferTable[i].lock _ 0;
	ENDLOOP;
	END;

LessThan: PROCEDURE[n1,n2: MergeValue] RETURNS[BOOLEAN] =
	BEGIN
	c1: LONG CARDINAL _ LOOPHOLE[n1];
	c2: LONG CARDINAL _ LOOPHOLE[n2];
	RETURN[c1<c2];
	END;

GetPage: PROCEDURE [page: CARDINAL, buff: CARDINAL]
	RETURNS [realbuff: CARDINAL] =
--Get page from disk into realbuff
--buff is used as hint for present buffer holding page
	BEGIN
	freebuff: INTEGER _ -1;
	ipage: INTEGER _ page;
	realbuff _ buff;
	THROUGH [0..4) DO
		IF BufferTable[realbuff].page = ipage THEN RETURN;
		IF BufferTable[realbuff].lock=0 AND
			(freebuff=-1 OR ~BufferTable[realbuff].dirty) THEN freebuff _ realbuff;
		realbuff _ next4[realbuff];
	ENDLOOP;
	IF freebuff=-1 THEN MergeError["No free paging buffer"];
	realbuff _ freebuff;
	IF BufferTable[realbuff].dirty THEN
		WritePage[BufferTable[realbuff].buffer,BufferTable[realbuff].page];
	ReadPage[BufferTable[realbuff].buffer,page];
	BufferTable[realbuff].page _ page;
	BufferTable[realbuff].dirty _ FALSE;
	BufferTable[realbuff].lock _ 0;
	END;

PageAddress: PROCEDURE [addr: LONG POINTER]
	RETURNS [pageNum,addrInPage: CARDINAL] =
	-- Returns 16 bit page # and address in page from 23 bit, 2-word index -
	--	specifically for 256 word pages
	BEGIN
		RETURN[BITSHIFT[LowHalf[addr],-7]+BITSHIFT[HighHalf[addr],9],
				BITSHIFT[BITAND[LowHalf[addr], 177B],1]];
	END;

ReadPage: PROCEDURE [memaddr: POINTER, page: CARDINAL] =
--Read a page to memory address memaddr
	BEGIN
		erc: ovD.ErrorCode;
		bytesRead: CARDINAL;
		[erc,bytesRead] _ crD.ReadPages[memaddr, 512, page, uFH];
		IF erc#ovD.ok THEN MergeError["Read problem"];
		IF bytesRead=0 THEN Zero[memaddr,256];
	END;

WritePage: PROCEDURE [memaddr: POINTER, page: CARDINAL] =
--Write a page from memory address memaddr
	BEGIN
		IF crD.WritePages[memaddr, 512, page, uFH]#ovD.ok THEN
			MergeError["Write problem"];
	END;

HighHalf: PROCEDURE [LONG POINTER] RETURNS [INTEGER] =
	MACHINE CODE BEGIN zEXCH; zPOP END;

LowHalf: PROCEDURE [LONG POINTER] RETURNS [INTEGER] =
	MACHINE CODE BEGIN zPOP END;

GenValue: MergeValue;
ZeroValue: MergeValue = LOOPHOLE[LONG[0],MergeValue];

MergeError: PUBLIC ERROR[reason: STRING] = CODE;

END.
(635)\109b9B562b5B179b9B143b17B511b11B92b13B119b5B738b6B256b7B542b13B561b14B270b9B408b10B461b8B436b8B445b4B249b6B98b9B99b8B150b7B813b11B309b8B298b9B195b8B85b7B155b10B