-- File DJExtMerge2.mesa
-- Written by Martin Newell, June 1981
-- Last updated: August 25, 1981  4:59 PM

DIRECTORY

crD: FROM "CoreDefs" USING [CloseFile, OpenFile, PageNumber, ReadPages, UFileHandle, UFileTruncate, WritePages],
DJExtMergeDefs: FROM "DJExtMergeDefs",
DJExtTypes: FROM "DJExtTypes" USING [NodeNumber],
MiscDefs: FROM "MiscDefs" USING [CallDebugger, Zero],
Mopcodes: FROM "Mopcodes" USING [zEXCH, zPOP],
ovD: FROM "OverviewDefs" USING [ErrorCode, ok],
--SegmentDefs: FROM "SegmentDefs" USING [NewFile, Read, OldFileOnly, DestroyFile],
String: FROM "String" USING [AppendString],
SystemDefs: FROM "SystemDefs" USING [AllocateResidentPages, FreePages];

DJExtMerge2: PROGRAM
IMPORTS crD, MiscDefs, String, SystemDefs
EXPORTS DJExtMergeDefs =

BEGIN OPEN crD, DJExtTypes, MiscDefs, Mopcodes, ovD, String, SystemDefs;


InitMerge: PUBLIC PROCEDURE [] =
-- Initialize merge to use file fileName
	BEGIN
	GenValue _ ZeroValue;
	SmallValue _ ZeroValue;
	OpenMergeFile["merge.tmp$"];
	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--

FileName: STRING _ [40];
uFH: crD.UFileHandle _ NIL;

OpenMergeFile: PROCEDURE[fileName: STRING] =
	BEGIN
	i: CARDINAL;
	erc: ovD.ErrorCode;
	FileName.length _ 0;
	AppendString[FileName,fileName];
	[erc,uFH] _ crD.OpenFile[[["Extractor"],[""]],[fileName],update];
	IF erc#ovD.ok THEN CallDebugger["Problem opening file"];
	IF crD.UFileTruncate[0,0,uFH]#ovD.ok THEN CallDebugger["Problem opening old file"];
	UnusedList _ NIL;
	FOR i IN [0..NBlocks) DO
		BlkPtr[i] _ [
			next: UnusedList,
			n: 0,
			block: AllocateResidentPages[NPages],
			lastref: 0,
			dirty: FALSE,
			valid: FALSE
			];
		UnusedList _ @BlkPtr[i];
		ENDLOOP;
	FOR i IN [0..HashTblSize) DO
		HashTbl[i] _ NIL;
		ENDLOOP;
	END;

CloseMergeFile: PROCEDURE =
	BEGIN
	i: CARDINAL;
	FOR i IN [0..NBlocks) DO
		FreePages[BlkPtr[i].block];
		ENDLOOP;
	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: 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
	high:LONG CARDINAL;
	low:CARDINAL;
	blk:BlkPointer;
	[high,low] _ Split[n];
	blk _ FindBlock[high];
	blk.lastref _ time _ time + 1;
	RETURN[blk.block[low],blk.block[low+1]];
	END;

PutNodeNumber: PROCEDURE [n:NodeNumber, v:NodeNumber] =
-- put the value v at node location n
BEGIN
	high:LONG CARDINAL;
	low:CARDINAL;
	blk:BlkPointer;
	[high,low] _ Split[n];
	blk _ FindBlock[high];
	blk.lastref _ time _ time + 1;
	IF blk.block[low] # v THEN {
		blk.dirty _ TRUE;
		blk.block[low] _ v;
		};
	END;

PutData: PROCEDURE [n:NodeNumber, data:LONG UNSPECIFIED] =
-- put the data at node location n
BEGIN
	high:LONG CARDINAL;
	low:CARDINAL;
	blk:BlkPointer;
	[high,low] _ Split[n];
	blk _ FindBlock[high];
	blk.lastref _ time _ time + 1;
	IF blk.block[low+1] # data THEN {
		blk.dirty _ TRUE;
		blk.block[low+1] _ data;
		};
	END;

FindBlock: PROCEDURE [n:LONG CARDINAL] RETURNS[blk:BlkPointer] = INLINE
-- return a pointer to block n if in core, otherwise allocate a block
BEGIN
	h:CARDINAL _ hash[n];
	FOR blk _ HashTbl[h],blk.next UNTIL blk = NIL DO
		IF blk.n = n THEN RETURN;		-- in core
		ENDLOOP;
	blk _ FingerBlock[];
	IF blk.dirty THEN WriteBlock[blk];
	IF blk.valid THEN {
		-- remove blk from hash table
		next: BlkPointer;
		tmp: BlkPointer _ NIL;
		h _ hash[blk.n];
		FOR b:BlkPointer _ HashTbl[h],next UNTIL b = NIL DO
			next _ b.next;
			IF b # blk THEN {
				b.next _ tmp;
				tmp _ b;
				};
			ENDLOOP;
		HashTbl[h] _ tmp;
		};
	blk.dirty _ FALSE;
	blk.valid _ TRUE;
	blk.n _ n;
	blk.lastref _ time;
	ReadBlock[blk];
	h _ hash[n];
	blk.next _ HashTbl[h];
	HashTbl[h] _ blk;
	END;

FingerBlock: PROCEDURE RETURNS[blk:BlkPointer] = INLINE
-- return a pointer to a block that should be deleted
BEGIN
	max,n: LONG CARDINAL;
	IF UnusedList # NIL THEN {
		blk _ UnusedList;
		UnusedList _ UnusedList.next;
		RETURN;
		};
	max _ 0;
	blk _ @BlkPtr[tab];
	FOR i:INTEGER IN [0..7) DO
		tab _ tab + 1;
		IF tab >= NBlocks THEN tab _ 0;
		n _ time - BlkPtr[tab].lastref;
		IF time < BlkPtr[tab].lastref THEN
			RETURN[@BlkPtr[tab]];
		IF max < n THEN {
			max _ n;
			blk _ @BlkPtr[tab];
			};
		ENDLOOP;
	END;

tab: CARDINAL _ 0;

WriteBlock: PROCEDURE [blk:BlkPointer] = INLINE
-- write blk out to disk
BEGIN
	page:CARDINAL _ PageAddress[blk.n];
	PutPage[page,blk.block];
	END;

ReadBlock: PROCEDURE [blk:BlkPointer] = INLINE
-- read blk from disk
BEGIN
	page:CARDINAL _ PageAddress[blk.n];
	GetPage[page,blk.block];
	END;

PutPage: PROCEDURE [page:CARDINAL,memAddr:POINTER] = INLINE
-- write blk out to disk
BEGIN
	IF crD.WritePages[memAddr,4*BlockSize,page,uFH]#ovD.ok THEN
		CallDebugger["Bad write to disk"];
	END;

GetPage: PROCEDURE [page:CARDINAL,memAddr:POINTER] = INLINE
-- read blk from disk
BEGIN
		erc: ovD.ErrorCode;
		bytesRead: CARDINAL;
		[erc,bytesRead] _ crD.ReadPages[memAddr,4*BlockSize,page,uFH];
		IF erc#ovD.ok THEN CallDebugger["Bad read from disk"];
		IF bytesRead=0 THEN Zero[memAddr,2*BlockSize];
	END;

PageAddress: PROCEDURE [addr:LONG CARDINAL]
	RETURNS [pageNum:CARDINAL] = INLINE
	-- Returns 16 bit page # and address in page from 23 bit, 2-word index -
	--	specifically for 256 word pages
BEGIN
		RETURN[LowHalf[addr]];
	END;

Split: PROCEDURE [addr:LONG CARDINAL]
	RETURNS [high:LONG CARDINAL, low:INTEGER] = INLINE
	-- Returns 16 bit page # and address in page from 23 bit, 2-word index -
	--	specifically for 256 word pages
	BEGIN
		addr _ 2*addr;
		low _ LowHalf[addr MOD BlockSize];
		IF low < 0 THEN low _ -low;
		high _ addr/BlockSize;
	END;

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

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

hash: PROCEDURE[n:LONG CARDINAL] RETURNS[h:INTEGER] = INLINE
BEGIN
	h _ LowHalf[n];
	h _ h MOD HashTblSize;
	IF h < 0 THEN RETURN[-h];
	END;

HashTbl: ARRAY [0..HashTblSize) OF LONG POINTER TO BlockPointer;
HashTblSize: CARDINAL = 2*NBlocks;

time: LONG CARDINAL _ 0;					-- current time


UnusedList: LONG POINTER TO BlockPointer;
BlkPtr:ARRAY [0..NBlocks) OF BlockPointer;
BlkPointer:TYPE = LONG POINTER TO BlockPointer;
BlockPointer: TYPE = RECORD [
		next: BlkPointer,
		n: LONG CARDINAL,			-- block number
		block: POINTER TO Block,	-- block data
		lastref: LONG CARDINAL,			-- time of last reference
		dirty: BOOLEAN _ FALSE,
		valid: BOOLEAN _ FALSE
		];
Block: TYPE = ARRAY [0..BlockSize) OF LONG UNSPECIFIED;

BlockSize: CARDINAL = 128;		-- Number of long words per block
NShift:CARDINAL = 7;				-- BlockSize = 2**NShift
NPages:CARDINAL = 1;				-- number of pages per block
NBlocks:CARDINAL = 16;				-- Number of blocks

END.
(635)\107b9B553b11B153b9B156b17B35b11B92b13B119b18B77b5B633b6B222b9B196b9B108b8B354b8B120b8B251b13B632b14B326b9B404b10B539b8B172b8B258b10B40b3B75i47I189b13B45i35I224b7B54i32I234b9B65i67I112i7I96i26I386b11B47i51I430b10B40i22I77b9B40i19I77b7B55i22I112b7B55i19I230b11B218b5B318b8B86b7B79b4B271i12I211i12I31i10I32i22I145i30I28i21I28i25I30i16I