-- File DJExtMerge3.mesa
-- Written by Martin Newell/Dan Fitzpatrick, June 1981
-- Last updated (Pilot): 12-Aug-81 16:35:39

DIRECTORY

DJExtMergeDefs: FROM "DJExtMergeDefs",
DJExtTypes: FROM "DJExtTypes" USING [NodeNumber],
Runtime: FROM "Runtime" USING [CallDebugger],
Space USING[Handle, Create, CreateUniformSwapUnits, Map, LongPointer, virtualMemory];

DJExtMerge3: PROGRAM
IMPORTS Runtime, Space
EXPORTS DJExtMergeDefs =

BEGIN OPEN DJExtTypes, Runtime;


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

ConsolidateMerge: PUBLIC PROCEDURE =
	BEGIN
	END;

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

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

ReserveNodeNumbers: PUBLIC PROCEDURE [n: NodeNumber] =
	BEGIN
	GenValue _ GenValue + n;
	END;

Merge: PUBLIC PROCEDURE [n1,n2: NodeNumber] RETURNS[r: NodeNumber] =
--Merge numbers n1 and n2 towards smaller of the two
--Returns resulting value of Lookup[n1] (=Lookup[n2])
BEGIN
	r1,r2: NodeNumber;
	IF n1 = 0 OR n2 = 0 THEN CallDebugger["Merge called with 0"];
	IF n1 = n2 THEN RETURN[n1];
--find roots, r1,r2 of n1,n2
	[r1] _ IntLookup[n1];
	[r2] _ IntLookup[n2];
--merge roots
--new root is min of r1 and r2
	IF LessThan[r1,r2] THEN {
		r _ r1;
		[] _ PutNodeNumber[r2,r];
		}
	ELSE {
		r _ r2;
		[] _ PutNodeNumber[r1,r];
		};
--shorten paths from n1 and n2 to new root
	[] _ PutNodeNumber[n1,r];
	[] _ PutNodeNumber[n2,r];
	END;

Lookup: PUBLIC PROCEDURE[n: NodeNumber]
		RETURNS[r: NodeNumber] =
--Return smallest number to which n has been merged, transitively closed
	BEGIN
	IF n = 0 THEN CallDebugger["Lookup called with 0"];
	r _ IntLookup[n].r;
	END;

LookSmall: PUBLIC PROCEDURE[n: NodeNumber]
		RETURNS[r: NodeNumber] =
--Return smallest number it can assign to n
	BEGIN
	IF n = 0 THEN CallDebugger["LookSmall called with 0"];
	r _ IntLookup2[n].r;
	END;

GetSmall: PUBLIC PROCEDURE RETURNS[NodeNumber] =
--Return smallest number assigned
BEGIN
	RETURN[SmallValue];
	END;

IsSmall: PUBLIC PROCEDURE[n: NodeNumber] RETURNS[BOOLEAN] =
--Return true if it has been assigned a small number
BEGIN
	r,t: NodeNumber;
	flag: BOOLEAN _ FALSE;
	IF n = 0 THEN CallDebugger["IsSmall called with 0"];
	--find root, r, of n
	[t,flag] _ GetValue[n];
	r _ n;
	UNTIL flag OR t = r DO
		r _ t;
		[t,flag] _ GetValue[r];
		ENDLOOP;
	RETURN[flag];
	END;

PutProp: PUBLIC PROCEDURE[n: NodeNumber, prop:LONG UNSPECIFIED] =
--attach prop to node number n
BEGIN
	PutData[n,prop];
	END;

GetProp: PUBLIC PROCEDURE[n: NodeNumber] RETURNS[LONG UNSPECIFIED] =
--get the prop that has been attached to n.
BEGIN
	v: LONG  UNSPECIFIED;
	v _ Get[n].data;
	RETURN[v];
	END;


--Private procedures--

OpenMergeFile: PROCEDURE =
	BEGIN
	IF BaseAddress=NIL THEN
	{	BaseSpace _ Space.Create[MergeTableSizeP, Space.virtualMemory];
		BaseAddress _ Space.LongPointer[BaseSpace];
		NPagesMapped _ 0;
		NWordsMapped _ 0;
	};
	NPagesAllocated _ 0;
	NWordsAllocated _ 0;
	END;

CloseMergeFile: PROCEDURE =
	BEGIN
	END;

IntLookup: PROCEDURE[n: NodeNumber]
		RETURNS[r: NodeNumber] =
--Return smallest number to which n has been merged, transitively closed
	BEGIN
	t: NodeNumber _ 0;
	flag: BOOLEAN _ FALSE;
--find root, r, of n
	[t] _ GetValue[n];
	r _ n;
	UNTIL flag OR t = r DO
		r _ t;
		[t,flag] _ GetValue[r];
	ENDLOOP;
	IF flag THEN CallDebugger["Lookup called after LookSmall"];
	IF n # r THEN [] _ PutNodeNumber[n,r];
	END;

IntLookup2: PROCEDURE[n: NodeNumber]
		RETURNS[r: NodeNumber] =
--Return smallest number it can assign to n
	BEGIN
	t: NodeNumber;
	flag: BOOLEAN _ FALSE;
--find root, r, of n
	[t,flag] _ GetValue[n];
	r _ n;
	UNTIL flag OR t = r DO
		r _ t;
		[t,flag] _ GetValue[r];
	ENDLOOP;
	IF n # r THEN [] _ PutNodeNumber[n,r];		-- otherwise you'ld destroy small value
	IF flag THEN {
		r _ LOOPHOLE[LOOPHOLE[t,LONG CARDINAL] - 2B10]
		}
	 ELSE {
		SmallValue _ SmallValue + 1;
		[] _ PutNodeNumber[r,LOOPHOLE[SmallValue+2B10]];
		r _ SmallValue;
		};
	END;

GetValue: PROCEDURE[n: NodeNumber]
		RETURNS[v: NodeNumber, done:BOOLEAN] =
	BEGIN
	v _ Get[n].v;
	IF v = ZeroValue THEN v _ n;
	done _ (LOOPHOLE[v,LONG CARDINAL] >= 2B10);
	END;

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

GenValue: NodeNumber;
SmallValue: NodeNumber;
ZeroValue: NodeNumber = LOOPHOLE[LONG[0],NodeNumber];

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

Get: PROCEDURE [n:NodeNumber] RETURNS[v:NodeNumber,data:LONG UNSPECIFIED] =
--return the record associated with node number n
BEGIN
	addr: Thing _ Validate[n];
	RETURN[addr.v,addr.data];
	END;

PutNodeNumber: PROCEDURE [n:NodeNumber, v:NodeNumber] =
-- put the value v at node location n
BEGIN
	Validate[n].v _ v;
	END;

PutData: PROCEDURE [n:NodeNumber, data:LONG UNSPECIFIED] =
-- put the data at node location n
BEGIN
	Validate[n].data _ data;
	END;

Validate: PROCEDURE [n:LONG CARDINAL] RETURNS[Thing] = INLINE
-- return a Thing, allocating it if necessary
BEGIN
	index: LONG CARDINAL _ 4*n;
	UNTIL index<NWordsAllocated DO ExtendAllocation[]; ENDLOOP;
	RETURN[BaseAddress+index];
	END;

ExtendAllocation: PROCEDURE =
-- Extend size of allocated space by one 'block'
BEGIN
	IF NWordsMapped=NWordsAllocated THEN
	{	h: Space.Handle;
		IF NWordsMapped = MergeTableSizeP THEN
			CallDebugger["Merge table overflow"];
		h _ Space.Create[BlockSizeP,BaseSpace,NPagesMapped];
		Space.CreateUniformSwapUnits[4,h];
		Space.Map[h];
		NPagesMapped _ NPagesMapped + BlockSizeP;
		NWordsMapped _ NWordsMapped + BlockSizeW;
	};
	Zero[BaseAddress+NWordsAllocated, BlockSizeW];
	NPagesAllocated _ NPagesAllocated + BlockSizeP;
	NWordsAllocated _ NWordsAllocated + BlockSizeW;
	END;

Zero: PROCEDURE [addr:LONG POINTER, nwords: LONG CARDINAL] = INLINE
-- There MUST be a fast system procedure for this!!!
	{ FOR i:LONG CARDINAL IN [0..nwords) DO (addr+i)^ _ 0; ENDLOOP; };


Thing:TYPE = LONG POINTER TO ThingRecord;
ThingRecord: TYPE = RECORD [
		v: NodeNumber,
		data: LONG UNSPECIFIED
		];
		
MergeTableSizeP: CARDINAL = 1000;	-- Max size of Merge file in Pages
BlockSizeP: CARDINAL = 128;		-- Block size in Pages
BlockSizeW: LONG CARDINAL = BlockSizeP*256;	-- Block size in Words
BaseSpace: Space.Handle;		-- Address space of merge table
BaseAddress: LONG POINTER _ NIL;	-- Address of start of ParentSpace
NPagesMapped: CARDINAL;			-- Number of pages mapped to file
NWordsMapped: LONG CARDINAL;		-- NPagesMapped*256
NPagesAllocated: CARDINAL;		-- Number of pages allocated for use
NWordsAllocated: LONG CARDINAL;		-- NPagesAllocated*256


END.