-- File: DisjointCollapse.mesa
-- routines to remove small symbols
-- Written by Martin Newell/Dan Fitzpatrick June 1981
-- Last edited (Alto/Pilot): September 1, 1981  7:57 PM

DIRECTORY

DisjointTypes: FROM "DisjointTypes" USING [Instance, Rectangle, Symbol, Geometry, PropID, PropList],
DisjointAllocDefs: FROM "DisjointAllocDefs" USING [EnumerateSymbols, AllocateGeometry, AllocateInstance, FreeGeometry, FreeInstance, FreeRectangle, FreeMarkedSymbols],
DisjointCollapseDefs: FROM "DisjointCollapseDefs",
DisjointPropDefs: FROM "DisjointPropDefs" USING [AllocPropID, PutProp, GetProp, RemoveProp],
IODefs: FROM "IODefs" USING [WriteLine];
 
DisjointCollapse: PROGRAM
IMPORTS DisjointAllocDefs, DisjointPropDefs, IODefs
EXPORTS DisjointCollapseDefs =
BEGIN
OPEN DisjointAllocDefs, DisjointPropDefs, DisjointTypes, IODefs;

GarbageCollect: PUBLIC PROCEDURE[symb: Symbol] =
BEGIN

	Mark: PROC[symb: Symbol] RETURNS[BOOLEAN] =
	BEGIN
		PutProp[@symb.prop,markID,1];
		RETURN[FALSE];
		END; -- Proc Mark

	Check: PROC[symb: Symbol] =
	-- Remove mark from symb and all subsymbols
	BEGIN
		n: INTEGER;
		FOR in:Instance _ symb.insts,in.next UNTIL in = NIL DO
			n _ GetProp[in.symbol.prop,markID];
			IF n = 1 THEN	Check[in.symbol];			-- never seen before
			ENDLOOP;
		RemoveProp[symb.prop,markID];					-- Remove mark from symbol
		END; -- Proc Check

	Remove: PROC[symb: Symbol] RETURNS[BOOLEAN] =
	BEGIN
		IF GetProp[symb.prop,markID] # NIL THEN ReleaseSymbol[symb];
		RETURN[FALSE];
		END; -- Proc Remove

	[] _ EnumerateSymbols[Mark];						-- Mark all symbol
	Check[symb];										-- UnMark all sub-symbols of symb
	RemoveProp[symb.prop,markID];						-- UnMark symb
	[] _ EnumerateSymbols[Remove];					-- Free crude attached to marked symbols
	FreeMarkedSymbols[markID];						-- Free all marked symbols
	END;

SetCollapseSize: PUBLIC PROCEDURE [n:INTEGER] =
BEGIN
	IF n < 0 THEN WriteLine["can't call SetCollapseSize with negative value"]
	 ELSE CollapseSize _ n;
	END;

Collapse: PUBLIC PROCEDURE[symb: Symbol] =
BEGIN

	Mark: PROC[symb: Symbol] RETURNS[BOOLEAN] =
	BEGIN
		PutProp[@symb.prop,markID,1];
		RETURN[FALSE];
		END; -- Proc Mark

	Remove: PROC[symb: Symbol] RETURNS[BOOLEAN] =
	BEGIN
		n: INTEGER _ GetProp[symb.prop,markID];
		IF n = 2 THEN ReleaseSymbol[symb]	-- throw away, too small
		 ELSE RemoveProp[symb.prop,markID];	-- unmark symbol
		RETURN[FALSE];
		END; -- Proc Remove

	[] _ EnumerateSymbols[Mark];
	DoCollapse[symb];
	PutProp[@symb.prop,markID,3];			-- be careful not to throw away top level symbol
	-- if top symbol has only one call replace it with the called symbol
	IF symb.insts # NIL AND symb.geom = NIL AND symb.insts.next = NIL THEN {
		tmp: Symbol _ symb.insts.symbol;
		FOR p:Instance _ tmp.insts,p.next UNTIL p = NIL DO
			p.xOffset _ p.xOffset + symb.insts.xOffset;
			p.yOffset _ p.yOffset + symb.insts.yOffset;
			ENDLOOP; 
		FOR p:Geometry _ tmp.geom,p.next UNTIL p = NIL DO
			p.l _ p.l + symb.insts.xOffset;
			p.b _ p.b + symb.insts.yOffset;
			p.r _ p.r + symb.insts.xOffset;
			p.t _ p.t + symb.insts.yOffset;
			ENDLOOP; 
		symb.insts _ tmp.insts;
		tmp.insts _ NIL;
		symb.geom _ tmp.geom;
		tmp.geom _ NIL;
		};
	[] _ EnumerateSymbols[Remove];
	FreeMarkedSymbols[markID];
	END;

DoCollapse: PROCEDURE[symb: Symbol] =
BEGIN
	n: INTEGER;
	next: Instance _ symb.insts;
	symb.insts _ NIL;
	FOR in:Instance _ next,next UNTIL in = NIL DO
		next _ in.next;
		n _ GetProp[in.symbol.prop,markID];
		IF n = 1 THEN {							-- never seen before
			DoCollapse[in.symbol];
			n _ GetProp[in.symbol.prop,markID];
			};
		SELECT n FROM
			2 => Combine[symb,in];									-- throw away, too small
			3 => {in.next _ symb.insts; symb.insts _ in};			-- retain
			ENDCASE => SIGNAL CollapseError["bad mark value in Collapse"];	-- bug
		ENDLOOP;
	-- count instances and geoms
	n _ 0;
	FOR in:Instance _ symb.insts,in.next UNTIL in = NIL DO
		n _ n + 1;
		ENDLOOP;
	FOR g:Geometry _ symb.geom,g.next UNTIL g = NIL DO
		n _ n + 1;
		ENDLOOP;
	IF n > CollapseSize THEN PutProp[@symb.prop,markID,3]
	 ELSE PutProp[@symb.prop,markID,2];
	END;

Combine: PROCEDURE[symb: Symbol, inst:Instance] =
BEGIN
	osymb: Symbol _ inst.symbol;
	-- copy instances and geom of osymb onto symb
	FOR in:Instance _ osymb.insts,in.next UNTIL in = NIL DO
		new: Instance _ AllocateInstance[];
		new^ _ [
				next: symb.insts,
				symbol: in.symbol,
				xOffset: in.xOffset + inst.xOffset,
				yOffset: in.yOffset + inst.yOffset
				];
		symb.insts _ new;
		ENDLOOP;
	FOR g:Geometry _ osymb.geom,g.next UNTIL g = NIL DO
		new: Geometry _ AllocateGeometry[];
		new^ _ [
				next: symb.geom,
				layer: g.layer,
				l: g.l + inst.xOffset,
				b: g.b + inst.yOffset,
				r: g.r + inst.xOffset,
				t: g.t + inst.yOffset
				];
		symb.geom _ new;
		ENDLOOP;
	-- now free inst
	FreeInstance[inst];
	END;

ReleaseSymbol: PROCEDURE[symb: Symbol] =
BEGIN
	nexti: Instance;
	nextw: Rectangle;
	nextg: Geometry;
	-- delete instances, windows, and geom of symb
	FOR in:Instance _ symb.insts,nexti UNTIL in = NIL DO
		nexti _ in.next;
		FreeInstance[in];
		ENDLOOP;
	FOR rec:Rectangle _ symb.windows,nextw UNTIL rec = NIL DO
		nextw _ rec.next;
		FreeRectangle[rec];
		ENDLOOP;
	FOR g:Geometry _ symb.geom,nextg UNTIL g = NIL DO
		nextg _ g.next;
		FreeGeometry[g];
		ENDLOOP;
	END;

markID: PropID _ AllocPropID[];
CollapseSize: INTEGER _ 1;

CollapseError: SIGNAL[msg: STRING] _ CODE;

END.
e6(635)