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