-- File: DisjointAlloc.mesa
-- Allocation routines for Disjoint
-- Written by Martin Newell/Dan Fitzpatrick June 1981
-- Last edited (Pilot): 16-Jul-81 11:00:18

DIRECTORY

DisjointTypes: FROM "DisjointTypes" USING [DisCell, DisCellRecord, Instance,
InstanceRecord, Symbol, SymbolRecord, Rectangle, RectangleRecord, PIP,
PIPRecord, Geometry, GeometryRecord, PropID, PropList, PropListRecord],
DisjointAllocDefs: FROM "DisjointAllocDefs",
DisjointPropDefs: FROM "DisjointPropDefs" USING [GetProp],
IODefs: FROM "IODefs" USING [WriteString, WriteLine,WriteDecimal],
String: FROM "String" USING [AppendString, EqualString],
SystemDefs: FROM "SystemDefs" USING [AllocateHeapString],
XFSPDefs: FROM "XFSPDefs" USING [XAllocateHeapNode];

DisjointAlloc: PROGRAM
IMPORTS DisjointPropDefs, IODefs, String, SystemDefs, XFSPDefs
EXPORTS DisjointAllocDefs =
BEGIN
OPEN DisjointPropDefs, DisjointTypes, IODefs, String, SystemDefs, XFSPDefs;

-- Allocation for symbols

MakeSymbol: PUBLIC PROCEDURE [name: STRING, l,b,r,t: REAL] RETURNS[Symbol] =
BEGIN
s: Symbol ← LookupSymbol[name];
IF s=NIL THEN {
s ← AllocateSymbol[];
s.name ← AllocateHeapString[name.length];
AppendString[s.name, name];
};
s.windows ← MakeRectangle[l,b,r,t];
RETURN[s];
END;

AllocateSymbol: PUBLIC PROCEDURE[] RETURNS[symb: Symbol] =
BEGIN
symb ← GetSymbol[];
symb↑ ← [
next: SymbolList,
name: NIL,
geom: NIL,
insts: NIL,
windows: NIL
];
SymbolList ← symb;
END;

GetSymbol: PUBLIC PROCEDURE[] RETURNS[symb: Symbol] =
-- More primitive than AllocateSymbol, doesn’t put returned symbol on SymbolList
BEGIN
symbAllocCount ← symbAllocCount+1;
IF FreeSymbolList = NIL THEN symb ← XAllocateHeapNode[SIZE[SymbolRecord]]
ELSE {
symb ← FreeSymbolList;
FreeSymbolList ← FreeSymbolList.next;
};
symb.insts ← NIL;
END;

FreeSymbol: PUBLIC PROCEDURE[symb: Symbol] =
BEGIN
sptr: LONG POINTER TO Symbol;
FOR sptr ← @SymbolList, @sptr.next UNTIL sptr↑=NIL DO
IF sptr↑ = symb THEN {
sptr↑ ← symb.next;
EXIT;
};
ENDLOOP;
symbAllocCount ← symbAllocCount-1;
symb.next ← FreeSymbolList; FreeSymbolList ← symb;
END;

FreeMarkedSymbols: PUBLIC PROCEDURE[id: PropID] =
BEGIN
sptr,next: Symbol;
FOR sptr ← SymbolList, next UNTIL sptr=NIL DO
next ← sptr.next;
IF GetProp[sptr.prop,id] # NIL THEN FreeSymbol[sptr];
ENDLOOP;
END;

LookupSymbol: PUBLIC PROCEDURE [name: STRING] RETURNS[s: Symbol] =
BEGIN
FOR s ← SymbolList, s.next UNTIL s = NIL DO
IF EqualString[name,s.name] THEN RETURN;
ENDLOOP;
END;

EnumerateSymbols: PUBLIC PROCEDURE[proc: PROC[s: Symbol]RETURNS[BOOLEAN]]
RETURNS[BOOLEAN] =
--BOOLEAN returns are both abort flags
BEGIN
FOR s:Symbol ← SymbolList, s.next UNTIL s=NIL DO
IF proc[s] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;

InsertSymbolList: PUBLIC PROCEDURE [list: Symbol] =
BEGIN
next: Symbol;

FOR s:Symbol ← list, next UNTIL s = NIL DO
next ← s.next;
s.next ← SymbolList;
SymbolList ← s;
ENDLOOP;
END;

-- Allocation for instances

MakeInstance: PUBLIC PROCEDURE[parent: Symbol, name: STRING, x,y: REAL]
RETURNS[Instance] =
BEGIN
in: Instance;
s: Symbol ← LookupSymbol[name];
IF s=NIL THEN { -- a forward reference
s ← AllocateSymbol[];
s.name ← AllocateHeapString[name.length];
AppendString[s.name, name];
};
in ← AllocateInstance[];
in ↑ ← [
next: NIL,
symbol: s,
xOffset: x,
yOffset: y
];
in.next ← parent.insts;
parent.insts ← in;
RETURN[in];
END;

AllocateInstance: PUBLIC PROCEDURE[] RETURNS[inst: Instance] =
BEGIN
instAllocCount ← instAllocCount+1;
IF FreeInstanceList = NIL THEN inst ← XAllocateHeapNode[SIZE[InstanceRecord]]
ELSE {
inst ← FreeInstanceList;
FreeInstanceList ← FreeInstanceList.next;
};
END;

FreeInstance: PUBLIC PROCEDURE[inst: Instance] =
BEGIN
instAllocCount ← instAllocCount-1;
inst.next ← FreeInstanceList; FreeInstanceList ← inst;
END;

-- Allocation for Geometry

MakeGeometry: PUBLIC PROCEDURE[parent: Symbol, layer: CARDINAL, l,b,r,t: REAL]
RETURNS[Geometry] =
BEGIN
g: Geometry ← AllocateGeometry[];
g ↑ ← [
next: NIL,
layer: layer,
l: l,
b: b,
r: r,
t: t
];
g.next ← parent.geom;
parent.geom ← g;
RETURN[g];
END;

AllocateGeometry: PUBLIC PROCEDURE[] RETURNS[g: Geometry] =
BEGIN
gAllocCount ← gAllocCount+1;
IF FreeGeometryList = NIL THEN g ← XAllocateHeapNode[SIZE[GeometryRecord]]
ELSE {
g ← FreeGeometryList;
FreeGeometryList ← FreeGeometryList.next;
};
END;

FreeGeometry: PUBLIC PROCEDURE[g: Geometry] =
BEGIN
gAllocCount ← gAllocCount-1;
g.next ← FreeGeometryList; FreeGeometryList ← g;
END;

-- Allocation for PIP’s

AllocatePIP: PUBLIC PROCEDURE[] RETURNS[pip: PIP] =
BEGIN
pipAllocCount ← pipAllocCount+1;
IF FreePIPList = NIL THEN pip ← XAllocateHeapNode[SIZE[PIPRecord]]
ELSE {
pip ← FreePIPList;
FreePIPList ← FreePIPList.next;
};
END;

FreePIP: PUBLIC PROCEDURE[pip: PIP] =
BEGIN
pip.next ← FreePIPList; FreePIPList ← pip;
pipAllocCount ← pipAllocCount-1;
END;

-- Allocation for DisCells

AllocateDisCell: PUBLIC PROCEDURE[] RETURNS[dc: DisCell] =
BEGIN
discellAllocCount ← discellAllocCount+1;
IF FreeDisCellList = NIL THEN dc ← XAllocateHeapNode[SIZE[DisCellRecord]]
ELSE {
dc ← FreeDisCellList;
FreeDisCellList ← FreeDisCellList.next;
};
END;

FreeDisCell: PUBLIC PROCEDURE[dc: DisCell] =
BEGIN
dc.next ← FreeDisCellList; FreeDisCellList ← dc;
discellAllocCount ← discellAllocCount-1;
END;

-- Allocation for Windows

MakeRectangle: PUBLIC PROCEDURE[l,b,r,t: REAL]
RETURNS[rec: DisjointTypes.Rectangle] =
BEGIN
rec ← AllocateRectangle[];
rec↑ ← [
next: NIL,
l: l,
b: b,
r: r,
t: t
];
END;

AllocateRectangle: PUBLIC PROCEDURE[] RETURNS[r: DisjointTypes.Rectangle] =
BEGIN
recAllocCount ← recAllocCount+1;
IF FreeRectangleList = NIL THEN r ← XAllocateHeapNode[SIZE[RectangleRecord]]
ELSE {
r ← FreeRectangleList;
FreeRectangleList ← FreeRectangleList.next;
};
END;

FreeRectangle: PUBLIC PROCEDURE[r: DisjointTypes.Rectangle] =
BEGIN
r.next ← FreeRectangleList; FreeRectangleList ← r;
recAllocCount ← recAllocCount-1;
END;

-- Allocation for Property Cells

AllocateProp: PUBLIC PROCEDURE[] RETURNS[p: PropList] =
BEGIN
propAllocCount ← propAllocCount+1;
IF FreePropList = NIL THEN p ← XAllocateHeapNode[SIZE[PropListRecord]]
ELSE {
p ← FreePropList;
FreePropList ← FreePropList.next;
};
END;

FreeProp: PUBLIC PROCEDURE[p: PropList] =
BEGIN
p.next ← FreePropList; FreePropList ← p;
propAllocCount ← propAllocCount-1;
END;

PrintAlloc: PUBLIC PROCEDURE =
BEGIN
free: CARDINAL;
CheckAlloc[];
WriteLine["Alloc summary"];
free ← 0;
FOR s:Symbol ← FreeSymbolList, s.next UNTIL s=NIL DO free←free+1; ENDLOOP;
WriteAlloc["Symbols", symbAllocCount, free, usedSymb];
free ← 0;
FOR s:Instance ← FreeInstanceList, s.next UNTIL s=NIL
DO free←free+1; ENDLOOP;
WriteAlloc["Instances", instAllocCount, free, usedInst];
free ← 0;
FOR s:PIP ← FreePIPList, s.next UNTIL s=NIL
DO free←free+1; ENDLOOP;
WriteAlloc["PIPs", pipAllocCount, free, 0];
free ← 0;
FOR s:DisCell ← FreeDisCellList, s.next UNTIL s=NIL
DO free←free+1; ENDLOOP;
WriteAlloc["DisCells", discellAllocCount, free, 0];
free ← 0;
FOR s:Rectangle ← FreeRectangleList, s.next UNTIL s=NIL
DO free←free+1; ENDLOOP;
WriteAlloc["Windows", recAllocCount, free, usedWind];
free ← 0;
FOR s:Geometry ← FreeGeometryList, s.next UNTIL s=NIL
DO free←free+1; ENDLOOP;
WriteAlloc["Geometrys", gAllocCount, free, usedGeom];
END;

WriteAlloc: PROCEDURE[s: STRING, nAlloc,nFree,nUsed: CARDINAL] =
BEGIN
WriteString[s];WriteString[": "];WriteDecimal[nAlloc];
WriteString[" allocated, "]; WriteDecimal[nUsed];
WriteString[" used ("]; WriteDecimal[nFree]; WriteLine[" free)"];
END;

CheckAlloc: PUBLIC PROCEDURE =
BEGIN

Count: PROC[s: Symbol] RETURNS [BOOLEAN] =
BEGIN
usedSymb ← usedSymb + 1;
FOR i: Instance ← s.insts,i.next UNTIL i = NIL DO
usedInst ← usedInst + 1;
ENDLOOP;
FOR i: Rectangle ← s.windows,i.next UNTIL i = NIL DO
usedWind ← usedWind + 1;
ENDLOOP;
FOR i: Geometry ← s.geom,i.next UNTIL i = NIL DO
usedGeom ← usedGeom + 1;
ENDLOOP;
RETURN[FALSE];
END;

usedSymb ← 0;
usedInst ← 0;
usedWind ← 0;
usedGeom ← 0;
[] ← EnumerateSymbols[Count];
END;

usedSymb:CARDINAL;
usedInst:CARDINAL;
usedWind:CARDINAL;
usedGeom:CARDINAL;

SymbolList: Symbol ← NIL;

symbAllocCount: CARDINAL ← 0;
instAllocCount: CARDINAL ← 0;
gAllocCount: CARDINAL ← 0;
pipAllocCount: CARDINAL ← 0;
discellAllocCount: CARDINAL ← 0;
recAllocCount: CARDINAL ← 0;
propAllocCount: CARDINAL ← 0;

-- Free lists
FreeSymbolList: Symbol ← NIL;
FreeInstanceList: Instance ← NIL;
FreeGeometryList: Geometry ← NIL;
FreePIPList: PIP ← NIL;
FreeDisCellList: DisCell ← NIL;
FreeRectangleList: Rectangle ← NIL;
FreePropList: PropList ← NIL;


END.