-- 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.