-- File DJExtMerge3.mesa
-- Written by Martin Newell/Dan Fitzpatrick, June 1981
-- Last updated (Pilot): 12-Aug-81 10:09:02
DIRECTORY
DJExtMergeDefs: FROM "DJExtMergeDefs",
DJExtTypes: FROM "DJExtTypes" USING [NodeNumber],
Runtime: FROM "Runtime" USING [CallDebugger],
Space USING[Handle, Create, CreateUniformSwapUnits, Map, LongPointer, virtualMemory];
DJExtMerge2: 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 ← 2*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 ← 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 = 10000; -- 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.