--File IntPhase2.mesa
--must be compiled /l for D* machines
--June 10, 1981 6:37 PM - MN, to always call Visible, and with parentVis parameter

DIRECTORY

InlineDefs: FROM "InlineDefs" USING[LongCOPY],

SegmentDefs: FROM "SegmentDefs" USING[DataSegmentHandle, NewDataSegment, DefaultXMBase,
LongDataSegmentAddress, GetMemoryConfig],

AltoDefs: FROM "AltoDefs" USING[PageSize],

IODefs: FROM "IODefs" USING [SP, CR, WriteString, WriteChar, WriteLine],

IntSetsDefs: FROM "IntSetsDefs" USING [EnumerateSet],

IntUtilityDefs: FROM "IntUtilityDefs" USING
[InitMM, MinMax, Extent, DoneMM, FindCallBB, BindSymbol, OKToContinue,
DefinedSet, LookUp],

IntStorageDefs: FROM "IntStorageDefs" USING
[FetchObject, ReplaceObject, Object, ObjectName,
ObjectRecord, ObjectType, NilObjectName],

IntPhase2Defs: FROM "IntPhase2Defs",

IntPhase2AccessDefs: FROM "IntPhase2AccessDefs",-- different versions for Alto/D*

IntDefs: FROM "IntDefs",-- IntPhase2 exports Instantiate and IBoundBox

-- IntPhase2 exports IExpand, IGetRootID, IStop, IGetFirstSymbol, IGetNextSymbol
AuxIntDefs: FROM "AuxIntDefs",

IntTransDefs: FROM "IntTransDefs" USING
[TransformPoint, IncrementRefCount, SwapContext, DecrementRefCount,
FreezeContext, ApplyLocal, Push, Pop],

OutputDefs: FROM "OutputDefs" USING
[OutputBox, OutputWire, OutputPolygon, OutputFlash, OutputUserObject,
Relation, Visible, VisibleType],

AuxOutputDefs: FROM "AuxOutputDefs" USING
[AuxBox, AuxWire, AuxPolygon, AuxFlash, AuxUserObject, AuxCall],

StringDefs: FROM "StringDefs" USING [AppendLongNumber, AppendLongDecimal],

ParserErrorDefs: FROM "ParserErrorDefs" USING [Report],

ParserTypeDefs: FROM "ParserTypeDefs" USING [Point, Path, FreePath, FreeUserNode];

IntPhase2: PROGRAM IMPORTS AuxOutputDefs, OutputDefs, ParserTypeDefs, IntUtilityDefs, IntStorageDefs, IntPhase2AccessDefs, IntTransDefs, InlineDefs, SegmentDefs, IODefs, StringDefs, ParserErrorDefs, IntSetsDefs
EXPORTS IntPhase2Defs, AuxIntDefs, IntDefs =

BEGIN OPEN IntPhase2Defs, IntPhase2AccessDefs;

iList: Item ← NilItem;-- list for bare items
iTree: Item ← NilItem;-- tree to expand from
lastLeft,lastRight,lastBottom,lastTop: LONG INTEGER;-- for ILastBB
RootID: IntStorageDefs.ObjectName = IntStorageDefs.NilObjectName;
halt: BOOLEAN;

InitPhase2: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN
IF NOT SegmentDefs.GetMemoryConfig[].useXM THEN
BEGIN
ParserErrorDefs.Report["Can’t run without an Alto II XM with Mesa 6 PROMS", FatalInternal];
RETURN[FALSE];
END
ELSE
RETURN[TRUE];
END;

FinishPhase2: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN
iList ← FreeList[iList];
RETURN[TRUE];
END;

Instantiate: PUBLIC PROCEDURE [] =
BEGIN
IF NOT IntUtilityDefs.OKToContinue[] THEN RETURN;

halt ← FALSE;
IF iTree # NilItem THEN
BEGIN
ParserErrorDefs.Report["Items left in tree!", FatalInternal];
RETURN;
END
ELSE ListToTree[iList];

UNTIL iTree = NilItem DO
ExpandRelMost;
ENDLOOP;
IntTransDefs.SwapContext[0];-- leave in context 0
END;

IBoundBox: PUBLIC PROCEDURE RETURNS [left,right,bottom,top: LONG INTEGER] =
BEGIN
IntTransDefs.SwapContext[0];-- get to context 0
[left,right,bottom,top] ← FindWholeBB[iList];
END;

ILastBB: PUBLIC PROCEDURE RETURNS [left,right,bottom,top: LONG INTEGER] =
BEGIN
RETURN[lastLeft,lastRight,lastBottom,lastTop];
END;

BareItem: PUBLIC PROCEDURE [it: IntStorageDefs.ObjectName] =
BEGIN OPEN IntStorageDefs;
newItem: Item;
itRec: ObjectRecord;

FetchObject[it,@itRec];
WITH foo:itRec SELECT FROM
Call =>
BEGIN
foo.uniqueID ← IntUtilityDefs.BindSymbol[foo.symNumber];
IntUtilityDefs.FindCallBB[@foo];
ReplaceObject[@foo,it];
END;
Wire => ParserTypeDefs.FreePath[foo.p];
Polygon => ParserTypeDefs.FreePath[foo.p];
User => ParserTypeDefs.FreeUserNode[foo.data];
ENDCASE;

newItem ← AllocateItem[];
SetItemKind[newItem,itRec.type]; SetItemWhat[newItem,it];
SetItemLevel[newItem,0]; SetItemContext[newItem,0];

IntTransDefs.IncrementRefCount[0];
iList ← InsList[iList,newItem];

END;

IGetRootID: PUBLIC PROCEDURE RETURNS [IntStorageDefs.ObjectName] =
{RETURN[RootID];};

IStop: PUBLIC PROCEDURE = {halt ← TRUE;};

IExpand: PUBLIC PROCEDURE [sym: IntStorageDefs.ObjectName] =
BEGIN OPEN IntTransDefs, IntStorageDefs, IntUtilityDefs, AuxOutputDefs;
temp,nextTemp: ObjectName;
tempRec: ObjectRecord;
symRec: STEntry ObjectRecord;
l,r,b,t: LONG INTEGER;

halt ← FALSE;
IF sym = RootID THEN {ListExpand[iList]; RETURN;};
FetchObject[sym,@symRec];
FOR temp ← symRec.guts, nextTemp UNTIL halt OR temp = NilObjectName DO
FetchObject[temp,@tempRec];-- get next object in symbol def
[l,r,b,t] ← ExtractBB[@tempRec];

WITH foo:tempRec SELECT FROM
Call =>
BEGIN
Push[];
ApplyLocal[@foo.t];
[lastLeft,lastRight,lastBottom,lastTop] ← TransBB[l,r,b,t];
Pop[];
END;
ENDCASE =>
[lastLeft,lastRight,lastBottom,lastTop] ← TransBB[l,r,b,t];

WITH foo:tempRec SELECT FROM
Call => {AuxCall[foo.uniqueID,foo.symNumber,@foo.t]; nextTemp ← foo.next;};
Wire =>
BEGIN
AuxWire[foo.layer,foo.width,foo.p];
ParserTypeDefs.FreePath[foo.p];
nextTemp ← foo.next;
END;
Flash => {nextTemp ← foo.next; AuxFlash[foo.layer,foo.diameter,foo.center];};
Polygon =>
BEGIN
AuxPolygon[foo.layer,foo.p];
ParserTypeDefs.FreePath[foo.p];
nextTemp ← foo.next;
END;
Box =>
BEGIN
AuxBox[foo.layer,foo.length,foo.width,foo.center,foo.xRot,foo.yRot];
nextTemp ← foo.next;
END;
MBox =>
BEGIN
AuxBox[foo.layer,(foo.bb.right-foo.bb.left),(foo.bb.top-foo.bb.bottom),
[(foo.bb.left+foo.bb.right)/2,(foo.bb.bottom+foo.bb.top)/2],
1,0];
nextTemp ← foo.next;
END;
User =>
BEGIN
AuxUserObject[foo.layer,foo.size,foo.data];
ParserTypeDefs.FreeUserNode[foo.data];
nextTemp ← foo.next;
END;
ENDCASE;

ENDLOOP;
END;

restOfSet: IntStorageDefs.ObjectName;-- remainder of defined set

IGetFirstSymbol: PUBLIC PROCEDURE RETURNS [IntStorageDefs.ObjectName] =
BEGIN OPEN IntStorageDefs;
flag: BOOLEAN ← TRUE;
oneSeen: BOOLEAN ← FALSE;
firstID,defined: ObjectName;

Bind: PROCEDURE [set:ObjectName, num:LONG CARDINAL] RETURNS [BOOLEAN] =
BEGIN
x: ObjectName ← IntUtilityDefs.BindSymbol[num];
IF flag THEN {firstID ← x; flag ← FALSE;};
RETURN [FALSE];
END;

TossFirst: PROCEDURE [set:ObjectName, num:LONG CARDINAL] RETURNS [BOOLEAN] =
BEGIN
IF NOT oneSeen THEN {oneSeen ← TRUE; RETURN[FALSE];}
ELSE RETURN [TRUE];
END;

defined ← IntUtilityDefs.DefinedSet[];
firstID ← NilObjectName;
[] ← IntSetsDefs.EnumerateSet[defined,Bind];
restOfSet ← IntSetsDefs.EnumerateSet[defined,TossFirst];
RETURN [firstID];
END;

IGetNextSymbol: PUBLIC PROCEDURE RETURNS [IntStorageDefs.ObjectName] =
BEGIN OPEN IntStorageDefs;
oneSeen: BOOLEAN ← FALSE;
firstID: ObjectName ← NilObjectName;

ProcessFirst: PROCEDURE [set:ObjectName, num:LONG CARDINAL] RETURNS [BOOLEAN] =
BEGIN
IF NOT oneSeen THEN
BEGIN
firstID ← IntUtilityDefs.LookUp[num];
oneSeen ← TRUE;
RETURN[FALSE];
END
ELSE RETURN [TRUE];
END;

restOfSet ← IntSetsDefs.EnumerateSet[restOfSet,ProcessFirst];
RETURN [firstID];
END;

--Private Procedures

ListExpand: PROCEDURE [head: Item]=
BEGIN OPEN IntTransDefs, IntStorageDefs, IntUtilityDefs, AuxOutputDefs;
curr: Item;
tempRec: ObjectRecord;
l,r,b,t: LONG INTEGER;

FOR curr ← head, GetItemSame[curr] UNTIL halt OR curr=NilItem DO
FetchObject[GetItemWhat[curr],@tempRec];-- get next object
[l,r,b,t] ← ExtractBB[@tempRec];

WITH foo:tempRec SELECT FROM
Call =>
BEGIN
Push[];
ApplyLocal[@foo.t];
[lastLeft,lastRight,lastBottom,lastTop] ← TransBB[l,r,b,t];
Pop[];
END;
ENDCASE =>
[lastLeft,lastRight,lastBottom,lastTop] ← TransBB[l,r,b,t];

WITH foo:tempRec SELECT FROM
Call => AuxCall[foo.uniqueID,foo.symNumber,@foo.t];
Wire => {AuxWire[foo.layer,foo.width,foo.p]; ParserTypeDefs.FreePath[foo.p];};
Flash => AuxFlash[foo.layer,foo.diameter,foo.center];
Polygon => {AuxPolygon[foo.layer,foo.p]; ParserTypeDefs.FreePath[foo.p];};
Box => AuxBox[foo.layer,foo.length,foo.width,foo.center,foo.xRot,foo.yRot];
MBox =>
AuxBox[foo.layer,(foo.bb.right-foo.bb.left),(foo.bb.top-foo.bb.bottom),
[(foo.bb.left+foo.bb.right)/2,(foo.bb.bottom+foo.bb.top)/2],
1,0];
User => {AuxUserObject[foo.layer,foo.size,foo.data];
ParserTypeDefs.FreeUserNode[foo.data];};
ENDCASE;

ENDLOOP;
END;

OutItem: PROCEDURE [arg: Item] =
BEGIN OPEN IntTransDefs, OutputDefs, IntStorageDefs;
lRec: ObjectRecord;
cntx: CARDINAL ← GetItemContext[arg];

IF NOT halt THEN
BEGIN
SwapContext[cntx];
FetchObject[GetItemWhat[arg],@lRec];
WITH foo:lRec SELECT FROM
Polygon =>
BEGIN
lastLeft ← GetItemLeft[arg]; lastRight ← GetItemRight[arg];
lastBottom ← GetItemBottom[arg]; lastTop ← GetItemTop[arg];
OutputPolygon[GetItemVisible[arg],foo.layer,foo.p];
ParserTypeDefs.FreePath[foo.p];
END;
Wire =>
BEGIN
lastLeft ← GetItemLeft[arg]; lastRight ← GetItemRight[arg];
lastBottom ← GetItemBottom[arg]; lastTop ← GetItemTop[arg];
OutputWire[GetItemVisible[arg],foo.layer,foo.width,foo.p];
ParserTypeDefs.FreePath[foo.p];
END;
Box =>
BEGIN
lastLeft ← GetItemLeft[arg]; lastRight ← GetItemRight[arg];
lastBottom ← GetItemBottom[arg]; lastTop ← GetItemTop[arg];
OutputBox[GetItemVisible[arg],foo.layer,foo.length,foo.width,
foo.center,foo.xRot,foo.yRot];
END;
MBox =>
BEGIN
lastLeft ← GetItemLeft[arg]; lastRight ← GetItemRight[arg];
lastBottom ← GetItemBottom[arg]; lastTop ← GetItemTop[arg];
OutputBox[GetItemVisible[arg],foo.layer,
(foo.bb.right-foo.bb.left),(foo.bb.top-foo.bb.bottom),
[(foo.bb.left+foo.bb.right)/2,(foo.bb.bottom+foo.bb.top)/2],
1,0];
END;
Flash =>
BEGIN
lastLeft ← GetItemLeft[arg]; lastRight ← GetItemRight[arg];
lastBottom ← GetItemBottom[arg]; lastTop ← GetItemTop[arg];
OutputFlash[GetItemVisible[arg],
foo.layer,foo.diameter,foo.center];
END;
Call =>
BEGIN
newCntx: CARDINAL;
Push[];
ApplyLocal[@foo.t];
newCntx ← FreezeContext[];
IncrementRefCount[newCntx];-- make sure context does not go away
Enumerate[GetItemVisible[arg],foo.uniqueID,
GetItemLevel[arg]+1,newCntx];
DecrementRefCount[newCntx];-- ok to release now
SwapContext[cntx];-- get back to where we were
Pop[];
END;
User =>
BEGIN
lastLeft ← GetItemLeft[arg]; lastRight ← GetItemRight[arg];
lastBottom ← GetItemBottom[arg]; lastTop ← GetItemTop[arg];
OutputUserObject[GetItemVisible[arg],foo.layer,foo.size,foo.data];
ParserTypeDefs.FreeUserNode[foo.data];
END;
ENDCASE;
END;
DecrementRefCount[cntx];
END;

ExtractBB: PROCEDURE[item: IntStorageDefs.Object] RETURNS [a,b,c,d: LONG INTEGER] =
BEGIN
WITH foo:item↑ SELECT FROM
Call => RETURN[foo.bb.left,foo.bb.right,foo.bb.bottom,foo.bb.top];
Box => RETURN[foo.bb.left,foo.bb.right,foo.bb.bottom,foo.bb.top];
MBox => RETURN[foo.bb.left,foo.bb.right,foo.bb.bottom,foo.bb.top];
Polygon => RETURN[foo.bb.left,foo.bb.right,foo.bb.bottom,foo.bb.top];
Wire => RETURN[foo.bb.left,foo.bb.right,foo.bb.bottom,foo.bb.top];
Flash => RETURN[foo.bb.left,foo.bb.right,foo.bb.bottom,foo.bb.top];
User => RETURN[foo.bb.left,foo.bb.right,foo.bb.bottom,foo.bb.top];
ENDCASE;
END;

TransBB: PROCEDURE [l,r,b,t: LONG INTEGER] RETURNS [nl,nr,nb,nt: LONG INTEGER] =
BEGIN OPEN IntTransDefs, IntUtilityDefs;
x,y: LONG INTEGER;
IF l<=r THEN
BEGIN
[x,y] ← TransformPoint[r,t];
InitMM[x,y];
[x,y] ← TransformPoint[l,t];
MinMax[x,y];
[x,y] ← TransformPoint[l,b];
MinMax[x,y];
[x,y] ← TransformPoint[r,b];
MinMax[x,y];
[nl,nr,nb,nt] ← Extent[];
DoneMM[];
END
ELSE RETURN[1,0,0,0];
END;

Enumerate: PROCEDURE [vis: OutputDefs.VisibleType, sym: IntStorageDefs.ObjectName,
level,context: CARDINAL] =
BEGIN OPEN IntTransDefs, IntStorageDefs, IntUtilityDefs;
newItem: Item;
temp,nextTemp: ObjectName;
tempRec: ObjectRecord;
symRec: STEntry ObjectRecord;
l,r,b,t: LONG INTEGER;
newVis: OutputDefs.VisibleType;

FetchObject[sym,@symRec];
FOR temp ← symRec.guts, nextTemp UNTIL temp = NilObjectName DO
FetchObject[temp,@tempRec];-- get next object in symbol def
[l,r,b,t] ← ExtractBB[@tempRec];
[l,r,b,t] ← TransBB[l,r,b,t];-- transform BB
WITH foo:tempRec SELECT FROM
Call => nextTemp ← foo.next;
Wire => {nextTemp ← foo.next; ParserTypeDefs.FreePath[foo.p];};
Flash => nextTemp ← foo.next;
Polygon => {nextTemp ← foo.next; ParserTypeDefs.FreePath[foo.p];};
Box => nextTemp ← foo.next;
MBox => nextTemp ← foo.next;
User => {nextTemp ← foo.next; ParserTypeDefs.FreeUserNode[foo.data];};
ENDCASE;

--IF vis = yes THEN newVis ← yes
--ELSE
--ALWAYS call visible to allow it to throw away items even if parent is vis, e.g. symbol names held in User Objects. Also include vis in call to Visible - MN, June 10, 1981 6:24 PM
SELECT OutputDefs.Visible[tempRec.type,level,vis,l,r,b,t] FROM
yes => newVis ← yes;
maybe => newVis ← maybe;
no => LOOP;
ENDCASE;

newItem ← AllocateItem[];
SetItemLeft[newItem,l]; SetItemRight[newItem,r];
SetItemBottom[newItem,b]; SetItemTop[newItem,t];
SetItemKind[newItem,tempRec.type]; SetItemWhat[newItem,temp];
SetItemLevel[newItem,level]; SetItemContext[newItem,context];
SetItemVisible[newItem,newVis];
IncrementRefCount[context];

InsTree[newItem];
ENDLOOP;
END;

InsTree: PROCEDURE [item: Item] =
-- Insert object into tree
BEGIN
curr: Item;

IF iTree = NilItem THEN BEGIN iTree ← item; RETURN; END;
IF item = NilItem THEN RETURN;

curr ← iTree;
DO
SELECT OutputDefs.Relation[GetItemLeft[item],GetItemRight[item],
GetItemBottom[item],GetItemTop[item],
GetItemLeft[curr],GetItemRight[curr],
GetItemBottom[curr],GetItemTop[curr]] FROM
rel =>
BEGIN
IF GetItemRel[curr] = NilItem
THEN BEGIN SetItemRel[curr,item]; EXIT; END
ELSE curr ← GetItemRel[curr];
END;
same =>
BEGIN temp: Item;-- inserted for bug in inline procs
temp ← GetItemSame[curr];
SetItemSame[item,temp];
SetItemSame[curr,item];
EXIT;
END;
norel =>
BEGIN
IF GetItemNoRel[curr] = NilItem
THENBEGIN SetItemNoRel[curr,item]; EXIT; END
ELSE curr ← GetItemNoRel[curr];
END;
dontcare =>
BEGIN
OutItem[item];
FreeItem[item];
RETURN;
END;
ENDCASE;
ENDLOOP;
END;

InsList: PROCEDURE [head, item: Item] RETURNS [Item] =
-- Insert object into list
BEGIN
IF item = NilItem THEN RETURN[head];
-- put item at head of list
SetItemSame[item,head];
RETURN[item];
END;

FreeList: PROCEDURE [head: Item] RETURNS [Item] =
-- Free contents of list
BEGIN
cur, next: Item;
FOR cur ← head,next UNTIL cur = NilItem DO
next ← GetItemSame[cur];
FreeItem[cur];
ENDLOOP;
RETURN[cur];
END;

ExpandRelMost: PROCEDURE =
-- Find rel-most object in tree and output its .same list to OutItem,
-- hooking its .norel branch back onto remaining tree.
BEGIN
next,prevItem,curItem,save: Item;

IF iTree = NilItem THEN RETURN;

curItem ← iTree;
IF GetItemRel[curItem] = NilItem THEN
-- special case, root needs to be deleted
iTree ← GetItemNoRel[curItem]
ELSE
BEGIN temp: Item;-- for bug in inline procs
UNTIL GetItemRel[curItem] = NilItem DO --chase rel pointers to relmost node
prevItem ← curItem;
curItem ← GetItemRel[curItem];
ENDLOOP;
temp ← GetItemNoRel[curItem];
SetItemRel[prevItem,temp];
END;

next ← curItem;
UNTIL next = NilItem DO --output the .same nodes
save ← next;
OutItem[next];
next ← GetItemSame[next];
FreeItem[save];
ENDLOOP;
END;

-- Create an Item tree from an Item list
ListToTree: PROCEDURE [head: Item] =
BEGIN
curr,newSame: Item;
visFlag: OutputDefs.VisibleType;

FOR curr ← head, GetItemSame[curr] UNTIL curr=NilItem DO
SELECT OutputDefs.Visible[GetItemKind[curr],GetItemLevel[curr], maybe,
GetItemLeft[curr],GetItemRight[curr],
GetItemBottom[curr],GetItemTop[curr]] FROM
yes => visFlag ← yes;
maybe => visFlag ← maybe;
no => LOOP;
ENDCASE;

newSame ← AllocateItem[];
CopyItem[curr,newSame];
SetItemVisible[newSame,visFlag];
SetItemSame[newSame,NilItem];
IntTransDefs.IncrementRefCount[GetItemContext[curr]];
InsTree[newSame];
ENDLOOP;
END;

--find the bounding box for the item list
FindWholeBB: PROCEDURE [head: Item] RETURNS [l,r,b,t: LONG INTEGER] =
BEGIN OPEN IntUtilityDefs, IntStorageDefs, IntTransDefs;
first: BOOLEAN ← TRUE;
nInList: Item;
tempRec: ObjectRecord;
temp: ObjectName;
lt,rt,bt,tp: LONG INTEGER;

FOR nInList ← head, GetItemSame[nInList] UNTIL nInList = NilItem DO
temp ← GetItemWhat[nInList];
FetchObject[temp,@tempRec];
WITH locRec:tempRec SELECT FROM
Call =>
[lt,rt,bt,tp] ← TransBB[locRec.bb.left,locRec.bb.right,
locRec.bb.bottom,locRec.bb.top];
Box =>
[lt,rt,bt,tp] ← TransBB[locRec.bb.left,locRec.bb.right,
locRec.bb.bottom,locRec.bb.top];
MBox =>
[lt,rt,bt,tp] ← TransBB[locRec.bb.left,locRec.bb.right,
locRec.bb.bottom,locRec.bb.top];
Flash =>
[lt,rt,bt,tp] ← TransBB[locRec.bb.left,locRec.bb.right,
locRec.bb.bottom,locRec.bb.top];
Polygon =>
BEGIN
[lt,rt,bt,tp] ← TransBB[locRec.bb.left,locRec.bb.right,
locRec.bb.bottom,locRec.bb.top];
ParserTypeDefs.FreePath[locRec.p];
END;
Wire =>
BEGIN
[lt,rt,bt,tp] ← TransBB[locRec.bb.left,locRec.bb.right,
locRec.bb.bottom,locRec.bb.top];
ParserTypeDefs.FreePath[locRec.p];
END;
User =>
BEGIN
[lt,rt,bt,tp] ← TransBB[locRec.bb.left,locRec.bb.right,
locRec.bb.bottom,locRec.bb.top];
ParserTypeDefs.FreeUserNode[locRec.data];
END;
ENDCASE;
-- save the result
SetItemLeft[nInList,lt];
SetItemRight[nInList,rt];
SetItemBottom[nInList,bt];
SetItemTop[nInList,tp];
-- use this item’s bb in whole chip
IF lt<=rt THEN-- ignore null BBs
BEGIN
IF first THEN BEGIN first ← FALSE; InitMM[rt,tp]; END
ELSE MinMax[rt,tp];
MinMax[lt,bt];
END;
ENDLOOP;

IF first THEN
BEGIN-- no items
ParserErrorDefs.Report["There are no items to find BB on!", Advisory];
RETURN[1,0,0,0];
END
ELSE
{[l,r,b,t] ← Extent[]; DoneMM[];};
END;

PrintTree: PROCEDURE [root: Item] =
-- Print an Item tree on whatever stream is IODefs.SetOutputStream’d
BEGIN OPEN IODefs;
WriteLine["Beginning of Tree"];
InternalPrintTree[root, 0];
WriteLine["End of Tree
"];
END;

InternalPrintTree: PROCEDURE [root: Item, indent: CARDINAL] =
BEGIN OPEN IODefs;
cur: Item;

IF root=NilItem THEN RETURN;

InternalPrintTree[GetItemNoRel[root], indent+1];

FOR cur ← root, GetItemSame[cur] UNTIL cur = NilItem DO
--print the .same nodes
THROUGH [0..indent) DO WriteChar[SP]; ENDLOOP; WriteChar[’|];
WriteString[SELECT GetItemKind[cur] FROM
STEntry=> "STEntry",
SetNode=> "SetNode",
Call=> "Call",
Box=> "Box",
MBox=> "MBox",
Flash=> "Flash",
Polygon=> "Polygon",
Wire=> "Wire",
User=> "User",
ENDCASE=> "Unknown type"];
WriteString[" Item: "]; WriteLongNumber[cur];
WriteChar[CR];
THROUGH [0..indent) DO WriteChar[SP]; ENDLOOP; WriteChar[’|];
WriteString[" l,r,b,t = "]; WriteLongDecimal[GetItemLeft[cur]];
WriteChar[’,]; WriteLongDecimal[GetItemRight[cur]];
WriteChar[’,]; WriteLongDecimal[GetItemBottom[cur]];
WriteChar[’,]; WriteLongDecimal[GetItemTop[cur]];
WriteChar[CR];
ENDLOOP;

InternalPrintTree[GetItemRel[root], indent+1];
END;

WriteLongNumber: PROCEDURE [n: LONG UNSPECIFIED] =
BEGIN
s: STRING ← [20];
StringDefs.AppendLongNumber[s,n,10];
IODefs.WriteString[s];
END;

WriteLongDecimal: PROCEDURE [n: LONG INTEGER] =
BEGIN
s: STRING ← [20];
StringDefs.AppendLongDecimal[s,n];
IODefs.WriteString[s];
END;

-- this is the XM stuff
ItemSpaceGone: PUBLIC ERROR = CODE;

Count: CARDINAL;
CurrentSegmentPointer: LONG POINTER ← NIL;
FreeItemList: LONG POINTER TO LONG POINTER ← NIL;

iCount: CARDINAL ← 0;-- item count
maxICount: CARDINAL ← 0;
pageCount: CARDINAL ← 0;-- pages allocated to items

-- create and initialize an ItemRecord
AllocateItem: PROCEDURE RETURNS [Item] =
BEGIN OPEN SegmentDefs;
ans: Item;
IF FreeItemList#NIL THEN
BEGIN --take one of the free list
ans ← LOOPHOLE[FreeItemList];
InlineDefs.LongCOPY[FreeItemList,SIZE[LONG POINTER],@FreeItemList]; -- i.e. FreeItemList ← FreeItemList↑;
END
ELSE
BEGIN --allocate a new one
IF CurrentSegmentPointer=NIL OR Count+SIZE[ItemRecord]>AltoDefs.PageSize THEN
BEGIN
CurrentSegmentPointer ← LongDataSegmentAddress[NewDataSegment[DefaultXMBase,1]];
Count ← 0;
pageCount ← pageCount+1;
END;
ans ← CurrentSegmentPointer + Count;
Count ← Count + SIZE[ItemRecord];
END;
iCount ← iCount+1;
IF iCount > maxICount THEN maxICount ← iCount;
SetItemRel[ans,NilItem];
SetItemNoRel[ans,NilItem];
SetItemSame[ans,NilItem];
RETURN[ans];
END;

FreeItem: PROCEDURE [item: Item] =
BEGIN
-- item↑ ← FreeItemList
InlineDefs.LongCOPY[@FreeItemList,SIZE[LONG POINTER],item];
FreeItemList ← LOOPHOLE[item];
iCount ← iCount-1;
END;

END.