-- File: DisjointJoin.mesa
-- Mates sub-cells in a cell
-- Written by Martin Newell/Dan Fitzpatrick August 1981
-- Last edited (Alto): August 7, 1981 11:55 AM

DIRECTORY

DisjointAllocDefs: FROM "DisjointAllocDefs" USING [AllocateInstance, FreeInstance, AllocateSymbol, AllocateRectangle, Alloc, Free],
DisjointJoinDefs: FROM "DisjointJoinDefs",
DisjointPropDefs: FROM "DisjointPropDefs" USING [GetProp, PutProp, AllocPropID],
DisjointTypes: FROM "DisjointTypes" USING [Instance, Rectangle, Symbol, PropID, InstanceRecord],
Inline: FROM "Inline" USING [LowHalf],
Real: FROM "Real" USING [Fix];

DisjointJoin: PROGRAM
IMPORTS DisjointAllocDefs, DisjointPropDefs, Inline, Real
EXPORTS DisjointJoinDefs =
BEGIN
OPEN DisjointTypes, DisjointAllocDefs, DisjointPropDefs, Inline, Real;

Join: PUBLIC PROCEDURE[symbol: Symbol] =
BEGIN
next:SymbCell;

HashTbl ← ALL[NIL];
Mate[symbol];
FOR i:INTEGER IN [0..TblSize) DO
FOR p:SymbCell ← HashTbl[i],next UNTIL p = NIL DO
next ← p.next;
FreeSymbCell[p];
ENDLOOP;
ENDLOOP;
END;

Mate: PUBLIC PROCEDURE[symbol: Symbol] =
BEGIN
-- mate all the calls in symbol with their neighbors
nomoreH:BOOLEAN ← FALSE;
nomoreV:BOOLEAN ← FALSE;
PutProp[@symbol.prop,checkID,1];
FOR instance:Instance ← symbol.insts,instance.next UNTIL instance = NIL DO
-- see that all sub-symbols have been joined
IF GetProp[instance.symbol.prop,checkID] # 1 THEN Mate[instance.symbol];
ENDLOOP;
UNTIL nomoreH OR nomoreV DO
nomoreV ← MateV[symbol];
nomoreH ← MateH[symbol];
ENDLOOP;
UNTIL nomoreH DO
nomoreH ← MateH[symbol];
ENDLOOP;
UNTIL nomoreV DO
nomoreV ← MateV[symbol];
ENDLOOP;
END;

MateH: PROCEDURE[symbol: Symbol] RETURNS[nomore:BOOLEAN] =
-- mates sub-cells of symbols up with their right neighbor
-- replace instance list of symbol with new mated instance list
-- Returns true when it cannot mate any one
BEGIN
i1,i2:Instance;
iList:Instance ← Sort[symbol.insts,HCompare];
nomore ← TRUE;
List ← NIL;-- empty global instance list
FOR i1 ← iList,iList UNTIL i1 = NIL DO
iList ← iList.next;
i2 ← iList;
IF i2 = NIL THEN {
Add[i1];
EXIT;
};
IF TouchingH[i1,i2] THEN {-- mate i1 & i2
symb:Symbol ← FindSymbol[i1,i2];
in:Instance ← MakeInstance[symb,i1,i2];
Add[in];
iList ← iList.next;
FreeInstance[i1];FreeInstance[i2];
nomore ← FALSE;
LOOP;
};
Add[i1];-- can’t use i1 so put back on List
ENDLOOP;
symbol.insts ← List;
END;

MateV: PROCEDURE[symbol: Symbol] RETURNS[nomore:BOOLEAN] =
-- mates sub-cells of symbols up with their above neighbor
-- Returns true when it cannot mate any one
BEGIN
i1,i2:Instance;
iList:Instance ← Sort[symbol.insts,VCompare];
nomore ← TRUE;
List ← NIL;-- empty global instance list
FOR i1 ← iList,iList UNTIL i1 = NIL DO
iList ← iList.next;
i2 ← iList;
IF i2 = NIL THEN {
Add[i1];
EXIT;
};
IF TouchingV[i1,i2] THEN {-- mate i1 & i2
symb:Symbol ← FindSymbol[i1,i2];
in:Instance ← MakeInstance[symb,i1,i2];
Add[in];
iList ← iList.next;
FreeInstance[i1];FreeInstance[i2];
nomore ← FALSE;
LOOP;
};
Add[i1];-- can’t use i1 so put back on List
ENDLOOP;
symbol.insts ← List;
END;

FindSymbol: PROCEDURE[i1,i2:Instance] RETURNS[Symbol] =
-- tries to find symbol that represents i1 & i2, creates one if necessary
BEGIN
cell:SymbCell;
x:REAL ← i2.xOffset - i1.xOffset;
y:REAL ← i2.yOffset - i1.yOffset;
n:CARDINAL ← hash[i1,i2];
FOR cell ← HashTbl[n],cell.next UNTIL cell = NIL DO
IF i1.symbol = cell.symbol1 AND i2.symbol = cell.symbol2 AND
x = cell.xOffset AND y = cell.yOffset THEN RETURN[cell.ActualSymbol];
ENDLOOP;
-- if we get here the symbol wasn’t in hash table (create a symbol)
cell ← AllocateSymbCell[];
cell↑ ← [
next: HashTbl[n],
symbol1: i1.symbol,
symbol2: i2.symbol,
xOffset: x,
yOffset: y,
ActualSymbol: MakeSymbol[i1,i2]
];
HashTbl[n] ← cell;
RETURN[cell.ActualSymbol];
END;

hash: PROCEDURE[i1,i2:Instance] RETURNS[m:INTEGER] = INLINE
BEGIN
n:LONG INTEGER ← (LOOPHOLE[i1.symbol,LONG CARDINAL]/3 +
LOOPHOLE[i2.symbol,LONG CARDINAL]/13);
n ← n + Fix[i2.xOffset - i1.xOffset] + 7*Fix[i2.yOffset - i1.yOffset];
m ← LowHalf[n];
m ← m MOD TblSize;
IF m < 0 THEN RETURN[-m];
END;

MakeSymbol: PROCEDURE[i1,i2:Instance] RETURNS[symb:Symbol] =
-- creates a new symbol with copies of i1 & i2 in it
BEGIN
wList:Rectangle;
newi1:Instance ← AllocateInstance[];
newi2:Instance ← AllocateInstance[];
newi1↑ ← [
next: newi2,
symbol: i1.symbol,
xOffset: 0,
yOffset: 0
];
newi2↑ ← [
next: NIL,
symbol: i2.symbol,
xOffset: i2.xOffset - i1.xOffset,
yOffset: i2.yOffset - i1.yOffset
];
wList ← CreateWindowList[i1.symbol.windows,i2.symbol.windows,newi2.xOffset,newi2.yOffset];
symb ← AllocateSymbol[];
symb↑ ← [
next: symb.next,
geom: NIL,
insts: newi1,
windows: wList
];
END;

CreateWindowList: PROCEDURE[w1,w2:Rectangle,x,y:REAL] RETURNS[win:Rectangle] =
-- try to merge window lists if possible
BEGIN
p,q,new:Rectangle;
win ← NIL;
FOR q ← w1,q.next UNTIL q = NIL DO
new ← AllocateRectangle[];
new↑ ← [
next: win,
l: q.l,
b: q.b,
r: q.r,
t: q.t
];
win ← new;
ENDLOOP;
FOR p ← w2,p.next UNTIL p = NIL DO
FOR q ← win,q.next UNTIL q = NIL DO
IF q.b = p.b+y AND q.t = p.t+y THEN {
IF q.r = p.l+x THEN {-- p is to the right of q
q.r ← p.r+x;
GOTO found;
};
IF q.l = p.r+x THEN {-- p is to the left of q
q.l ← p.l+x;
GOTO found;
};
};
IF q.l = p.l+x AND q.r = p.r+x THEN {
IF q.t = p.b+y THEN {-- p is above q
q.t ← p.t+y;
GOTO found;
};
IF q.b = p.t+y THEN {-- p is below q
q.b ← p.b+y;
GOTO found;
};
};
REPEAT
found => NULL;
FINISHED => {
-- if we get here we must create a new window
new ← AllocateRectangle[];
new↑ ← [
next: win,
l: p.l+x,
b: p.b+y,
r: p.r+x,
t: p.t+y
];
win ← new;
};
ENDLOOP;
ENDLOOP;
END;

Add: PROCEDURE[in:Instance] =
-- add in to List
BEGIN
in.next ← List;
List ← in;
END;

Sort: PROCEDURE[iList:Instance,comp:PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN]] RETURNS[Instance] =
-- sort iList using comp
BEGIN
list:InstanceRecord;
p,next:Instance;
list.next ← NIL;
FOR in:Instance ← iList,next UNTIL in = NIL DO
next ← in.next;
-- insert in into new list
FOR p ← @list,p.next UNTIL p.next = NIL DO
IF comp[p.next,in] THEN EXIT;
ENDLOOP;
in.next ← p.next;
p.next ← in;
ENDLOOP;
RETURN[list.next];
END;

TouchingH: PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN] = INLINE
-- return true if i1 is touching i2 to the left or right
BEGIN
w1:Rectangle ← i1.symbol.windows;
w2:Rectangle ← i2.symbol.windows;
x:REAL ← i2.xOffset - i1.xOffset;
y:REAL ← i2.yOffset - i1.yOffset;
IF AtY[i1] # AtY[i2] THEN RETURN[FALSE];
w1 ← i1.symbol.windows;w2 ← i2.symbol.windows;
IF w1.b # w2.b+y OR w1.t # w2.t+y THEN RETURN[FALSE];
IF w1.r = w2.l+x THEN RETURN[TRUE];
IF w1.l = w2.r+x THEN RETURN[TRUE];
RETURN[FALSE];
END;

TouchingV: PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN] = INLINE
-- return true if i1 is touching i2 above or below
BEGIN
w1:Rectangle ← i1.symbol.windows;
w2:Rectangle ← i2.symbol.windows;
x:REAL ← i2.xOffset - i1.xOffset;
y:REAL ← i2.yOffset - i1.yOffset;
IF AtX[i1] # AtX[i2] THEN RETURN[FALSE];
w1 ← i1.symbol.windows;w2 ← i2.symbol.windows;
IF w1.r # w2.r+y OR w1.l # w2.l+y THEN RETURN[FALSE];
IF w1.b = w2.t+x THEN RETURN[TRUE];
IF w1.t = w2.b+x THEN RETURN[TRUE];
RETURN[FALSE];
END;

HCompare: PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN] =
-- return true if i1 is below i2 or at same height but to the left of i2
BEGIN
RETURN[AtY[i1] < AtY[i2] OR (AtY[i1]=AtY[i2] AND AtX[i1] < AtX[i2])];
END;

VCompare: PROCEDURE[i1,i2:Instance] RETURNS[BOOLEAN] =
-- return true if i1 is below i2 or at same height but to the left of i2
BEGIN
RETURN[AtX[i1] < AtX[i2] OR (AtX[i1]=AtX[i2] AND AtY[i1] < AtY[i2])];
END;

AtY: PROCEDURE[in:Instance] RETURNS[y:REAL] =
-- return the location of bottom of in
BEGIN
RETURN[in.yOffset+in.symbol.windows.b];
END;

AtX: PROCEDURE[in:Instance] RETURNS[x:REAL] =
-- return the location of left of in
BEGIN
RETURN[in.xOffset+in.symbol.windows.l];
END;

MakeInstance: PROCEDURE[symb:Symbol, i1,i2:Instance] RETURNS[in:Instance] =
BEGIN
in ← AllocateInstance[];
in↑ ← [
next: NIL,
symbol:symb,
xOffset:i1.xOffset,
yOffset:i1.yOffset
];
END;

AllocateSymbCell: PROCEDURE RETURNS[cell:SymbCell] = INLINE
BEGIN
cell ← Alloc[SIZE[SymbCellRecord]];
END;

FreeSymbCell: PROCEDURE[cell:SymbCell] = INLINE
BEGIN
Free[cell,SIZE[SymbCellRecord]];
END;

List:Instance;

SymbCell:TYPE = LONG POINTER TO SymbCellRecord;
SymbCellRecord:TYPE = RECORD [
next: SymbCell,-- next in hash bucket chain
symbol1: Symbol,-- first symbol
symbol2: Symbol,-- second symbol
xOffset,yOffset: REAL,-- displacement of symbol2 from symbol1
ActualSymbol: Symbol-- symbol which represents two symbs & offset
];
HashTbl:ARRAY [0..TblSize) OF SymbCell;
TblSize:CARDINAL = 512;
checkID:PropID ← AllocPropID[];


END.