-- File: DisjointAlloc.mesa
-- Allocation routines for Disjoint
-- Written by Martin Newell/Dan Fitzpatrick June 1981
-- Last edited (Alto/Pilot): September 1, 1981  7:34 PM

DIRECTORY

DisjointTypes: FROM "DisjointTypes" USING [DisCell, DisCellRecord, Instance,
	InstanceRecord, Symbol, SymbolRecord, Rectangle, RectangleRecord, PIP,
	PIPRecord, Geometry, GeometryRecord, PropID, PropList, PropListRecord],
DisjointAllocDefs: FROM "DisjointAllocDefs",
DisjointIODefs: FROM "DisjointIODefs" USING [WriteLongDecimal],
DisjointPropDefs: FROM "DisjointPropDefs" USING [GetProp],
IODefs: FROM "IODefs" USING [WriteString, WriteLine,WriteDecimal],
Runtime: FROM "Runtime" USING [CallDebugger],
String: FROM "String" USING [AppendString, EqualString],
SystemDefs: FROM "SystemDefs" USING [AllocateHeapString],
XFSPDefs: FROM "XFSPDefs" USING [XAllocateHeapNode];
 
DisjointAlloc: PROGRAM
IMPORTS DisjointIODefs, DisjointPropDefs, IODefs, Runtime, String, SystemDefs, XFSPDefs
EXPORTS DisjointAllocDefs =
BEGIN
OPEN DisjointIODefs, DisjointPropDefs, DisjointTypes, IODefs, Runtime, 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;
	symb _ Alloc[SIZE[SymbolRecord]];
	symb.insts _ NIL;
	symb.prop _ 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;
	Free[symb,SIZE[SymbolRecord]];
	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;
	inst _ Alloc[SIZE[InstanceRecord]];
	END;

FreeInstance: PUBLIC PROCEDURE[inst: Instance] =
BEGIN
	instAllocCount _ instAllocCount-1;
	Free[inst,SIZE[InstanceRecord]];
	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;
	g _ Alloc[SIZE[GeometryRecord]];
	END;

FreeGeometry: PUBLIC PROCEDURE[g: Geometry] =
BEGIN
	gAllocCount _ gAllocCount-1;
	Free[g,SIZE[GeometryRecord]];
	END;

-- Allocation for PIP's

AllocatePIP: PUBLIC PROCEDURE[] RETURNS[pip: PIP] =
BEGIN
	pipAllocCount _ pipAllocCount+1;
	pip _ Alloc[SIZE[PIPRecord]];
	END;

FreePIP: PUBLIC PROCEDURE[pip: PIP] =
BEGIN
	Free[pip,SIZE[PIPRecord]];
	pipAllocCount _ pipAllocCount-1;
	END;

-- Allocation for DisCells

AllocateDisCell: PUBLIC PROCEDURE[] RETURNS[dc: DisCell] =
BEGIN
	discellAllocCount _ discellAllocCount+1;
	dc _ Alloc[SIZE[DisCellRecord]];
	END;

FreeDisCell: PUBLIC PROCEDURE[dc: DisCell] =
BEGIN
	Free[dc,SIZE[DisCellRecord]];
	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;
	r _ Alloc[SIZE[RectangleRecord]];
	END;

FreeRectangle: PUBLIC PROCEDURE[r: DisjointTypes.Rectangle] =
BEGIN
	Free[r,SIZE[RectangleRecord]];
	recAllocCount _ recAllocCount-1;
	END;

-- Allocation for Property Cells

AllocateProp: PUBLIC PROCEDURE[] RETURNS[p: PropList] =
BEGIN
	propAllocCount _ propAllocCount+1;
	p _ Alloc[SIZE[PropListRecord]];
	END;

FreeProp: PUBLIC PROCEDURE[p: PropList] =
BEGIN
	Free[p,SIZE[PropListRecord]];
	propAllocCount _ propAllocCount-1;
	END;

Alloc: PUBLIC PROCEDURE[n:INTEGER] RETURNS[p: LONG POINTER] =
BEGIN
	IF n < AllocMin OR AllocMax < n THEN {
		WriteString["Alloc@DisjointAlloc:n is "]; WriteDecimal[n]; WriteLine[""];
		CallDebugger["Tried to Alloc too big (or too small) a structure"];
		p _ XAllocateHeapNode[n];
		};
	allocated[n] _ allocated[n] + 1;
	IF FreeList[n] = NIL THEN p _ XAllocateHeapNode[n]
		ELSE {
			p _ FreeList[n];
			FreeList[n] _ FreeList[n].next;
			};
	END;

Free: PUBLIC PROCEDURE[p:LONG POINTER, n:INTEGER] =
BEGIN
	ptr: DummyCell _ p;
	IF n < AllocMin OR AllocMax < n THEN {
		WriteString["Free@DisjointAlloc:n is "]; WriteDecimal[n]; WriteLine[""];
		CallDebugger["Tried to Free too big (or too small) a structure"];
		};
	allocated[n] _ allocated[n] - 1;
	ptr.next _ FreeList[n]; FreeList[n] _ ptr;
	END;

AllocMin: CARDINAL = 4;
AllocMax: CARDINAL = 36;
allocated: ARRAY [AllocMin..AllocMax] OF LONG CARDINAL _ ALL[0];
FreeList: ARRAY [AllocMin..AllocMax] OF DummyCell _ ALL[NIL];
DummyCell: TYPE = LONG POINTER TO DummyRecord;
DummyRecord: TYPE = RECORD [
		next: DummyCell
		];

PrintAlloc: PUBLIC PROCEDURE =
BEGIN
	free: LONG CARDINAL;
	totalFree: LONG CARDINAL _ 0;
	totalAlloc: LONG CARDINAL _ 0;
	WriteLine["Alloc summary"];
	FOR i:INTEGER IN [AllocMin..AllocMax] DO
		free _ 0;
		FOR p:DummyCell _ FreeList[i],p.next UNTIL p=NIL DO
			free_free+1;
			ENDLOOP;
		WriteDecimal[i]; WriteString[": "];
		WriteLongDecimal[allocated[i]]; WriteString[" allocated, "];
		WriteLongDecimal[free]; WriteLine[" free"];
		totalFree _ totalFree + i*free;
		totalAlloc _ totalAlloc + i*allocated[i];
		ENDLOOP;
	WriteString["Totals: "];
	WriteLongDecimal[totalAlloc/1024]; WriteString["K allocated, "];
	WriteLongDecimal[totalFree/1024]; WriteLine["K free"];
	CheckAlloc[];
	WriteAlloc["Symbols", symbAllocCount, usedSymb];
	WriteAlloc["Instances", instAllocCount, usedInst];
	WriteAlloc["PIPs", pipAllocCount, 0];
	WriteAlloc["DisCells", discellAllocCount, 0];
	WriteAlloc["Windows", recAllocCount, usedWind];
	WriteAlloc["Geometrys", gAllocCount, usedGeom];
	WriteAlloc["Props", propAllocCount, 0];
	END;

WriteAlloc: PROCEDURE[s: STRING, nAlloc,nUsed: LONG CARDINAL] =
	BEGIN
	WriteString[s];	WriteString[": "];	WriteLongDecimal[nAlloc];
	WriteString[" allocated, "]; WriteLongDecimal[nUsed];
	WriteLine[" used"];
	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:LONG CARDINAL;
usedInst:LONG CARDINAL;
usedWind:LONG CARDINAL;
usedGeom:LONG CARDINAL;

SymbolList: Symbol _ NIL;

symbAllocCount: LONG CARDINAL _ 0;
instAllocCount: LONG CARDINAL _ 0;
gAllocCount: LONG CARDINAL _ 0;
pipAllocCount: LONG CARDINAL _ 0;
discellAllocCount: LONG CARDINAL _ 0;
recAllocCount: LONG CARDINAL _ 0;
propAllocCount: LONG CARDINAL _ 0;

END.
e6(635)