DIRECTORY   Core, CoreFlat, DABasics, IO, PrincOps, RefTab, SoftHdwBasics, SoftHdwCompiler, SymTab, TerminalIO, VM;

SoftHdwRouter: CEDAR PROGRAM
IMPORTS CoreFlat, RefTab, SoftHdwBasics, IO, TerminalIO, VM
EXPORTS SoftHdwCompiler
= BEGIN OPEN SoftHdwCompiler;

surface: Surface;

CreateSurfaceAndRoute: PUBLIC PROC [placement: Placement] RETURNS [route: RefTab.Ref, incompleteNetEnds: NetEndList, incomplete: INT _ 0] = {
sizes: ArrayPosition _ NEW[ArrayPositionRec];
sizes^ _ placement.sizes^;
sizes.chip.x _ placement.maxChip.x + 1;
sizes.chip.y _ placement.maxChip.y + 1;
surface _ CreateSurface[sizes];
[route, incompleteNetEnds] _ RouteSurface[placement, surface];
FOR nel: NetEndList _ incompleteNetEnds, nel.rest UNTIL nel=NIL DO
incomplete _ incomplete + 1;
ENDLOOP;
};

FreeSurface: PUBLIC PROC [surface: Surface] = {
FOR nt: WireNodeType IN WireNodeType DO
FOR orient: Orientation IN Orientation DO
FreeNodeArray[surface.nodes[nt][orient].base];
ENDLOOP;
ENDLOOP;
};

CreateSurface: PROC [sizes: ArrayPosition] RETURNS [surface: Surface] = {
position: ArrayPosition _ NEW[ArrayPositionRec];
otherPosition: ArrayPosition _ NEW[ArrayPositionRec];
surface _ NEW[SurfaceRec];
FOR nt: WireNodeType IN WireNodeType DO
FOR orient: Orientation IN Orientation DO
grain: INT _ SELECT orient FROM
Horizontal => sizes.grain.x,
Vertical => sizes.grain.y,
ENDCASE => ERROR;
surface.nodes[nt][orient].maxNeighbors _ SELECT nt FROM
Long => (SELECT orient FROM 
Horizontal => sizes.minorArray.x+2,
Vertical => sizes.minorArray. y+2, 
ENDCASE => ERROR),
Input => 1+grain,
Output => 5,
LeftDown => 2, 
RightUp => 2,
Interchip => 1, --As yet Unimplemented
ENDCASE => ERROR;
surface.nodes[nt][orient].nodeSize _ SIZE[NodeRec]+(surface.nodes[nt][orient].maxNeighbors*SIZE[Node]);
surface.nodes[nt][orient].grainSize _ surface.nodes[nt][orient].nodeSize*(SELECT orient FROM
Horizontal => sizes.grain.y,
Vertical => sizes.grain.x,
ENDCASE => ERROR);
surface.nodes[nt][orient].chipXSize _ surface.nodes[nt][orient].grainSize*sizes.chip.x;
surface.nodes[nt][orient].chipYSize _ surface.nodes[nt][orient].chipXSize*sizes.chip.y;
surface.nodes[nt][orient].minorXSize _ surface.nodes[nt][orient].chipYSize*sizes.minorArray.x;
surface.nodes[nt][orient].base _ AllocateNodeArray	[SELECT nt FROM
Long => (SELECT orient FROM 
Horizontal => surface.nodes[nt][orient].chipYSize*sizes.minorArray.y,
Vertical => surface.nodes[nt][orient].chipYSize*sizes.minorArray.x, 
ENDCASE => ERROR),
Interchip => surface.nodes[nt][orient].nodeSize, -- As yet Unimplemented
Input, Output, LeftDown, RightUp => surface.nodes[nt][orient].minorXSize*sizes.minorArray.y,
ENDCASE => ERROR];
ENDLOOP;
ENDLOOP;
surface.sizes _ sizes;
TerminalIO.PutF["\nInitializing Nodes..."];
EnumerateNodes[surface, position, InitializeNode];
TerminalIO.PutF["\nConnecting Minor Array Nodes..."];
BuildArcsForMinorArrays[surface, position, otherPosition];
TerminalIO.PutF["\nConnecting Long Line Nodes..."];
BuildArcsForLongLines[surface, position, otherPosition];
};

BuildArcsForMinorArrays: PROC [surface: Surface, position, otherPosition: ArrayPosition] ~ {
sizes: ArrayPosition _ surface.sizes;
FOR chipX: INT IN [0..sizes.chip.x) DO
FOR chipY: INT IN [0..sizes.chip.y) DO
FOR orient: Orientation IN Orientation DO
FOR minorX: INT IN [0..sizes.minorArray.x) DO
FOR minorY: INT IN [0..sizes.minorArray.y) DO
FOR nt: WireNodeType IN WireNodeType DO
position.chip.x _ chipX;
position.chip.y _ chipY;
position.orientation _ orient;
position.minorArray.x _ minorX;
position.minorArray.y _ minorY;
position.type _ nt;
BuildArcsForMinorArray[surface, position, otherPosition];
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
};

BuildArcsForMinorArray: PROC [surface: Surface, position, otherPosition: ArrayPosition] ~ {
sizes: ArrayPosition _ surface.sizes;
grainDim: INT _ SELECT position.orientation FROM 
Horizontal => sizes.grain.y,
Vertical => sizes.grain.x,
ENDCASE => ERROR;
atTheFarEdge: BOOLEAN _ SELECT position.orientation FROM
Horizontal => position.minorArray.x = sizes.minorArray.x-1,
Vertical => position.minorArray.y = sizes.minorArray.y-1,
ENDCASE => ERROR;
atTheNearEdge: BOOLEAN _ SELECT position.orientation FROM
Horizontal => position.minorArray.x = 0,
Vertical => position.minorArray.y = 0,
ENDCASE => ERROR;
FOR grain: INT IN [0..grainDim) DO 
SetInterestingGrainCoord[position, grain];
otherPosition^ _ position^;
SELECT position.type FROM 
Input => BuildArcsForInput[surface, position, otherPosition];
Output => BuildArcsForOutput[surface, position, otherPosition, atTheNearEdge, atTheFarEdge];
LeftDown => BuildArcsForLeftDown[surface, position, otherPosition, atTheNearEdge];
RightUp =>BuildArcsForRightUp[surface, position, otherPosition, atTheFarEdge];
Interchip => NULL;
Long => NULL;
ENDCASE => ERROR;
ENDLOOP;
};

BuildArcsForLongLines: PROC [surface: Surface, position, otherPosition: ArrayPosition] ~ {
sizes: ArrayPosition _ surface.sizes;
longNode: Node;
FOR chipX: INT IN [0..sizes.chip.x) DO
FOR chipY: INT IN [0..sizes.chip.y) DO
FOR orient: Orientation IN Orientation DO
minorDim: INT _ 
SELECT orient FROM
Horizontal => sizes.minorArray.y,
Vertical => sizes.minorArray.x,
ENDCASE => ERROR;
FOR minorIndex: INT IN [0..minorDim) DO
grainDim: INT _ SELECT orient FROM 
Horizontal => sizes.grain.y,
Vertical => sizes.grain.x,
ENDCASE => ERROR;
FOR grain: INT IN [0..grainDim) DO 
SetInterestingGrainCoord[position, grain];
SELECT orient FROM
Vertical => { position.minorArray.x _ minorIndex; position.minorArray.y _ 0};
Horizontal => { position.minorArray.y _ minorIndex; position.minorArray.x _ 0};
ENDCASE => ERROR;
position.orientation _ orient;
position.chip.y _ chipY;
position.chip.x _ chipX;
position.type _ Long;
longNode _ PositionToNode[surface, position];
otherPosition^ _ position^;
BuildArcsFromLong[surface, otherPosition, longNode];
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
};

BuildArcsFromLong: PROC [surface: Surface, position: ArrayPosition, longNode: Node]  ~ {
grainNode: Node;
sizes: ArrayPosition _ surface.sizes;
minorDim: INT _ 
SELECT position.orientation FROM
Horizontal => sizes.minorArray.x,
Vertical => sizes.minorArray.y,
ENDCASE => ERROR;
position.type _ Input;
FOR minorIndex: INT IN [0..minorDim) DO
SELECT position.orientation FROM
Horizontal =>  position.minorArray.x _ minorIndex;
Vertical => position.minorArray.y _ minorIndex;
ENDCASE => ERROR;
grainNode _ PositionToNode[surface, position];
CreateArc[surface, longNode, grainNode];
ENDLOOP;
};


BuildArcsForInput: PROC [surface: Surface, position, otherPosition: ArrayPosition]  ~ {
myNode, otherNode: Node;
sizes: ArrayPosition _ surface.sizes;
perpGrainDim: INT _ SELECT position.orientation FROM 
Horizontal => sizes.grain.x,
Vertical => sizes.grain.y,
ENDCASE => ERROR;
perpOrient: Orientation _ SELECT position.orientation FROM
Horizontal => Vertical,
Vertical => Horizontal,
ENDCASE => ERROR;
myNode _ PositionToNode[surface, position];
otherPosition.type _ Output;
FOR grain: INT IN [0..perpGrainDim) DO 
otherPosition.orientation _ perpOrient;
SetInterestingGrainCoord[otherPosition, grain];
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode];
ENDLOOP;
position.type _ Output;
otherNode _ PositionToNode[surface, position];
CreateArc[surface, myNode, otherNode];
position.type _ Input;
};

SetInterestingGrainCoord: PROC [position: ArrayPosition, grain: INT] ~ {
SELECT position.orientation FROM 
Horizontal => { position.grain.y _ grain; position.grain.x _ 0; };
Vertical => { position.grain.x _ grain; position.grain.y _ 0; };
ENDCASE => ERROR;
};

BuildArcsForLeftDown: PROC [surface: Surface, position, otherPosition: ArrayPosition, atTheNearEdge: BOOLEAN]  ~ {
myNode, otherNode: Node;
myNode _ PositionToNode[surface, position];
otherPosition.type _ Input;
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode];
IF NOT atTheNearEdge THEN {
SELECT position.orientation FROM
Horizontal => otherPosition.minorArray.x _ otherPosition.minorArray.x-1;
Vertical => otherPosition.minorArray.y _ otherPosition.minorArray.y-1;
ENDCASE => ERROR;
otherPosition.type _ LeftDown;
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode];  };
};

BuildArcsForRightUp: PROC [surface: Surface, position, otherPosition: ArrayPosition, atTheFarEdge: BOOLEAN]  ~ {
myNode, otherNode: Node;
myNode _ PositionToNode[surface, position];
IF NOT atTheFarEdge THEN {
SELECT position.orientation FROM
Horizontal => otherPosition.minorArray.x _ otherPosition.minorArray.x+1;
Vertical => otherPosition.minorArray.y _ otherPosition.minorArray.y+1;
ENDCASE => ERROR;
otherPosition.type _ RightUp;
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode]; 
otherPosition.type _ Input;
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode];
};
};

BuildArcsForOutput: PROC [surface: Surface, position, otherPosition: ArrayPosition, atTheNearEdge, atTheFarEdge: BOOLEAN]  ~ {
myNode, otherNode: Node;
myNode _ PositionToNode[surface, position];
otherPosition.type _ Input;
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode];
IF NOT atTheFarEdge THEN {
SELECT position.orientation FROM
Horizontal => otherPosition.minorArray.x _ otherPosition.minorArray.x+1;
Vertical => otherPosition.minorArray.y _ otherPosition.minorArray.y+1;
ENDCASE => ERROR;
otherPosition.type _ Input;
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode]; 
otherPosition.type _ RightUp;
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode];  };
otherPosition^ _ position^;
otherPosition.type _ Long;
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode]; 
IF NOT atTheNearEdge THEN {
SELECT position.orientation FROM
Horizontal => otherPosition.minorArray.x _ otherPosition.minorArray.x-1;
Vertical => otherPosition.minorArray.y _ otherPosition.minorArray.y-1;
ENDCASE => ERROR;
otherPosition.type _ LeftDown;
otherNode _ PositionToNode[surface, otherPosition];
CreateArc[surface, myNode, otherNode];
};
};

AllocateNodeArray: PROC [words: INT] RETURNS [array: NodeArray] = {
pageCount: INT _ VM.PagesForWords[words];
interval: VM.Interval _ VM.SimpleAllocate[pageCount];
IF interval.count#pageCount THEN ERROR;
array.pages _ pageCount;
array.base _ VM.AddressForPageNumber[interval.page];
};

FreeNodeArray: PROC [array: NodeArray ] = TRUSTED {
VM.Free[[LOOPHOLE[array.base, INT]/PrincOps.wordsPerPage, array.pages]];
};

InitializeNode: EachNodeProc = TRUSTED {
node: Node _ PositionToNode[surface, position];
node.position _ position^;
node.label _ NIL;
node.back _ NIL;
node.size _ surface.nodes[position.type][position.orientation].maxNeighbors;
FOR index: INT IN [0..node.size) DO
node.neighbors[index] _ NIL;
ENDLOOP;
};

CreateArc: PROC [surface: Surface, source: Node, destination: Node] = TRUSTED {
FOR nodeIndex: INT IN [0..source.size) DO
IF source[nodeIndex]=NIL THEN {
source[nodeIndex] _ destination;
RETURN;
};
ENDLOOP;
ERROR;
};

PositionToNode: PROC [surface: Surface, position: ArrayPosition] RETURNS [node: Node] = {
type: WireNodeType _ position.type;
orient: Orientation _ position.orientation;
nodeAddress: LONG CARDINAL _ LOOPHOLE[surface.nodes[type][orient].base.base];
grain: INT _  GrainCoord[position];
nodeAddress _ nodeAddress +
surface.nodes[type][orient].nodeSize*grain +
surface.nodes[type][orient].grainSize*position.chip.x +
surface.nodes[type][orient].chipXSize*position.chip.y;
nodeAddress _ nodeAddress + (SELECT type FROM
Input, Output, LeftDown, RightUp => surface.nodes[type][orient].chipYSize*position.minorArray.x 
+ surface.nodes[type][orient].minorXSize*position.minorArray.y,
Long => (SELECT orient FROM
Horizontal => surface.nodes[type][orient].chipYSize*position.minorArray.y,
Vertical => surface.nodes[type][orient].chipYSize*position.minorArray.x,
ENDCASE => ERROR),
ENDCASE => ERROR);
IF nodeAddress >= (LOOPHOLE[surface.nodes[type][orient].base.base, LONG CARDINAL] + LOOPHOLE[VM.WordsForPages[surface.nodes[type][orient].base.pages], LONG CARDINAL]) THEN ERROR;
node _ LOOPHOLE[nodeAddress];
};

GrainCoord: PROC [pos: ArrayPosition] RETURNS [coord: INT] ~ {
coord _ SELECT pos.orientation FROM
Horizontal => pos.grain.y,
Vertical => pos.grain.x,
ENDCASE => ERROR;
 };

maxNodeCount: NAT _ 0;
routesCompleted: INT _ 0;
doRoutesMin: INT _ 0;
doRoutesMax: INT _ LAST[INT];

DoRoutes: PUBLIC PROC [min, max: INT] ~ {
doRoutesMin _ min;
doRoutesMax _ max;
};

CheckPlacement: PUBLIC PROC [placement: Placement] = {
EachPrimitivePosition: RefTab.EachPairAction = TRUSTED {
p: Primitive _ NARROW[key];
pa: PrimitiveAssignment _ NARROW[val];
IF NOT RefTab.Insert[nodeTable, pa.position, p] THEN ERROR;
};
nodeTable: RefTab.Ref _ RefTab.Create[hash: SoftHdwBasics.ArrayPositionHash, equal: SoftHdwBasics.ArrayPositionEqual];
[] _ RefTab.Pairs[placement.positions, EachPrimitivePosition];

};

RouteSurface: PROC [placement: Placement, surface: Surface] RETURNS [route: RefTab.Ref, incomplete: NetEndList] = {
EachPrimitivePosition: RefTab.EachPairAction = TRUSTED {
p: Primitive _ NARROW[key];
pa: PrimitiveAssignment _ NARROW[val];
node: Node _ PositionToNode[surface, pa.position];
ne: NetEnds _ FetchNetEnds[p.flatOutput];
node.label _ LOOPHOLE[p.flatOutput];
primIndex _ primIndex+1;
IF ne.source#NIL THEN ERROR;
ne.source _ node;
position^ _ pa.position^;
position.orientation _ IF position.orientation=Vertical THEN Horizontal ELSE Vertical;
position.type _ Input;
FOR index: CARDINAL IN [0..p.size) DO
label: NodeLabel _ LOOPHOLE[p[index].flatInput];
ne: NetEnds _ FetchNetEnds[p[index].flatInput];
SELECT position.orientation FROM 
Horizontal => { position.grain.y _ pa[index]; position.grain.x _ 0; };
Vertical => { position.grain.x _ pa[index]; position.grain.y _ 0; };
ENDCASE => ERROR;
node _ PositionToNode[surface, position];
IF node.label#NIL AND node.label#label THEN ERROR;
node.label _ label;
ne.destinations _ CONS[node, ne.destinations];
ENDLOOP;
};
RouteWire: RefTab.EachPairAction = TRUSTED {
wire: CoreFlat.FlatWire _ NARROW[key];
ne: NetEnds _ NARROW[val];
sourceDestinations: Nodes _ ne.destinations;
routeIndex _ routeIndex + 1;
IF routeIndex<doRoutesMin OR routeIndex>doRoutesMax THEN RETURN;
IF sourceDestinations#NIL THEN {
seed: Node;
destinations: Nodes _ NIL;
IF ne.source=NIL THEN seed _ sourceDestinations.first
ELSE seed _ ne.source;
FOR il: Nodes _ sourceDestinations, il.rest UNTIL il=NIL DO
IF il.first#seed THEN destinations _ CONS[il.first, destinations];
ENDLOOP;
IF destinations#NIL THEN {
somePath: BOOL _ FALSE;
label: NodeLabel _ seed.label;
fifoFirst: Node _ seed;
fifoLast: Node _ fifoFirst;
fifoLast.fifoNext _ NIL;
UNTIL fifoFirst=NIL DO
trail: Nodes _ NIL;
FOR il: Nodes _ destinations, il.rest UNTIL il=NIL DO
IF il.first.back=NIL THEN trail _ il
ELSE {
nodeCount: NAT _ 0;
assign: Node _ il.first;
UNTIL assign=NIL DO
assign.label _ label;
assign _ assign.back;
nodeCount _ nodeCount + 1;
ENDLOOP;
maxNodeCount _ MAX[maxNodeCount, nodeCount];
IF trail=NIL THEN destinations _ il.rest
ELSE trail.rest _ il.rest;
somePath _ TRUE;
};
ENDLOOP;
IF destinations=NIL THEN { 
TerminalIO.PutF["."];  routesCompleted _ routesCompleted+1; EXIT; };
{
current: Node _ fifoFirst;
fifoFirst _ fifoFirst.fifoNext;
IF fifoFirst=NIL THEN fifoLast _ NIL;
FOR ni: CARDINAL IN [0..current.size) DO
neighbor: Node _ current[ni];
IF neighbor=NIL THEN EXIT;
IF (neighbor.label=NIL OR (neighbor#seed AND neighbor.label=label)) AND neighbor.back=NIL THEN {
neighbor.back _ current;
IF fifoLast=NIL THEN {
fifoFirst _ neighbor;
fifoLast _ fifoFirst;
}
ELSE {
fifoLast.fifoNext _ neighbor;
fifoLast _ fifoLast.fifoNext;
};
fifoLast.fifoNext _ NIL;
};
ENDLOOP;
};
REPEAT FINISHED => { incomplete _ CONS[NEW[NetEndsRec _ [source: seed, destinations: destinations]], incomplete];
TerminalIO.PutF["x"]; };
ENDLOOP;
IF somePath THEN IF NOT RefTab.Insert[route, wire, MakePath[seed]] THEN ERROR;
CleanUpBackPointers[seed];
};
};
};
FetchNetEnds: PROC [flatWire: CoreFlat.FlatWire] RETURNS [ne: NetEnds] = {
ne _ NARROW[RefTab.Fetch[netEnds, flatWire].val];
IF ne=NIL THEN {
ne _ NEW[NetEndsRec];
IF NOT RefTab.Insert[netEnds, flatWire, ne] THEN ERROR;
};
};
netEnds: RefTab.Ref _ RefTab.Create[hash: CoreFlat.FlatWireHash, equal: CoreFlat.FlatWireEqual];
position: ArrayPosition _ NEW[ArrayPositionRec];
routeIndex: INT _ 0;
primIndex: INT _ 0;
EnumerateNodes[surface, position, ScrubNode];
[] _ RefTab.Pairs[placement.positions, EachPrimitivePosition];
route _ RefTab.Create[hash: CoreFlat.FlatWireHash, equal: CoreFlat.FlatWireEqual];
routesCompleted _ 0;
TerminalIO.PutF["\nRouting: "];
[] _ RefTab.Pairs[netEnds, RouteWire];
TerminalIO.PutF["\n done; %d routes.\n ", IO.int[routesCompleted]];
};

ScrubNode: EachNodeProc = TRUSTED {
node: Node _ PositionToNode[surface, position];
node.label _ NIL;
node.back _ NIL;
};

CleanUpBackPointers: PROC [seed: Node] = TRUSTED {
fifoFirst: Node _ seed;
fifoLast: Node _ fifoFirst;
fifoLast.fifoNext _ NIL;
UNTIL fifoFirst=NIL DO
current: Node _ fifoFirst;
fifoFirst _ fifoFirst.fifoNext;
IF fifoFirst=NIL THEN fifoLast _ NIL;
FOR ni: CARDINAL IN [0..current.size) DO
neighbor: Node _ current[ni];
IF neighbor=NIL THEN EXIT;
IF neighbor.back#NIL THEN {
neighbor.back _ NIL;
IF fifoLast=NIL THEN {
fifoFirst _ neighbor;
fifoLast _ fifoFirst;
}
ELSE {
fifoLast.fifoNext _ neighbor;
fifoLast _ fifoLast.fifoNext;
};
fifoLast.fifoNext _ NIL;
};
ENDLOOP;
ENDLOOP;
};

MakePath: PROC [current: Node] RETURNS [path: Path] = TRUSTED {
ListToSequence: PROC RETURNS [path: Path] = TRUSTED {
size: CARDINAL _ 0;
FOR pl: ArrayPositions _ positions, pl.rest UNTIL pl=NIL DO
size _ size + 1;
ENDLOOP;
path _ NEW[PathRec[size]];
FOR index: CARDINAL DECREASING IN [0..size) DO
path[index] _ positions.first;
positions _ positions.rest;
ENDLOOP;
IF positions#NIL THEN ERROR;
};
positions: ArrayPositions _ LIST[SoftHdwBasics.CopyArrayPositionRec[current.position]];
DO
neighbors: Nodes _ NIL;
neighborCount: CARDINAL _ 0;
FOR ni: CARDINAL IN [0..current.size) DO
neighbor: Node _ current[ni];
IF neighbor=NIL THEN EXIT;
IF neighbor.back=current AND neighbor.label=current.label THEN {
neighbors _ CONS[neighbor, neighbors];
neighborCount _ neighborCount + 1;
};
ENDLOOP;
SELECT TRUE FROM
neighborCount=0 => {  -- tree leaf
path _ ListToSequence[];
EXIT;
};
neighborCount=1 => {  -- branch continues
current _ neighbors.first;
positions _ CONS[SoftHdwBasics.CopyArrayPositionRec[current.position], positions];
};
ENDCASE => {  -- tree branches
subPaths: SubPaths _ NEW[SubPathsRec[neighborCount]];
path _ ListToSequence[];
path.subPaths _ subPaths;
FOR index: CARDINAL DECREASING IN [0..neighborCount) DO
subPaths[index] _ MakePath[neighbors.first];
neighbors _ neighbors.rest;
ENDLOOP;
EXIT;
};
ENDLOOP;
};

EachNodeProc: TYPE = PROC [surface: Surface, position: ArrayPosition];
EnumerateNodes: PROC [surface: Surface, position: ArrayPosition, eachNode: EachNodeProc] = {
sizes: ArrayPosition _ surface.sizes;
FOR chipX: INT IN [0..sizes.chip.x) DO
position.chip.x _ chipX;
FOR chipY: INT IN [0..sizes.chip.y) DO
position.chip.y _ chipY;
FOR orient: Orientation IN Orientation DO
position.orientation _ orient;
FOR minorX: INT IN [0..sizes.minorArray.x) DO
position.minorArray.x _ minorX;
FOR minorY: INT IN [0..sizes.minorArray.y) DO
position.minorArray.y _ minorY;
FOR nt: WireNodeType IN WireNodeType DO
grainDim: INT _ SELECT position.orientation FROM 
Horizontal => sizes.grain.y,
Vertical => sizes.grain.x,
ENDCASE => ERROR;
position.type _ nt;
FOR grain: INT IN [0..grainDim) DO 
SELECT orient FROM 
Horizontal => { position.grain.x _ 0; 
position.grain.y _ grain; };
Vertical => { position.grain.y _ 0; 
position.grain.x _ grain; };
ENDCASE => ERROR;
SELECT nt FROM
Input, Output, LeftDown, RightUp => eachNode[surface, position];
Interchip, Long => NULL; -- These cases are handled below.
ENDCASE => ERROR;
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
position.type _ Long;
FOR chipX: INT IN [0..sizes.chip.x) DO
position.chip.x _ chipX;
FOR chipY: INT IN [0..sizes.chip.y) DO
position.chip.y _ chipY;
FOR orient: Orientation IN Orientation DO
grainDim: INT _ SELECT position.orientation FROM 
Horizontal => sizes.grain.y,
Vertical => sizes.grain.x,
ENDCASE => ERROR;
position.orientation _ orient;
FOR grain: INT IN [0..grainDim) DO 
SELECT orient FROM 
Horizontal => { position.grain.x _ 0; 
position.grain.y _ grain; };
Vertical => { position.grain.y _ 0; 
position.grain.x _ grain; };
ENDCASE => ERROR;
SELECT orient FROM 
Horizontal => { 
FOR minorY: INT IN [0..sizes.minorArray.y) DO
position.minorArray.y _ minorY;
position.minorArray.x _ 0;
eachNode[surface, position];
ENDLOOP; };
Vertical => {
FOR minorX: INT IN [0..sizes.minorArray.x) DO
position.minorArray.x _ minorX;
position.minorArray.y _ 0;
eachNode[surface, position];
ENDLOOP; };
ENDCASE => ERROR;
ENDLOOP;
ENDLOOP;
ENDLOOP;
ENDLOOP;
};

CheckRoute: PUBLIC PROC [route: RefTab.Ref] = {
EachRoutedWire: RefTab.EachPairAction = {
path: Path _ NARROW[val];
CheckPath[path];
};
CheckPath: PROC [path: Path] = {
FOR index: CARDINAL IN [0..path.size) DO
position: ArrayPosition _ NEW[ArrayPositionRec];
position _ path[index];
IF NOT RefTab.Insert[nodeTable, position, $Used] THEN ERROR;
ENDLOOP;
IF path.subPaths#NIL THEN FOR index: CARDINAL IN [0..path.subPaths.size) DO
CheckPath[path.subPaths[index]];
ENDLOOP;
};
nodeTable: RefTab.Ref _ RefTab.Create[hash: SoftHdwBasics.ArrayPositionHash, equal: SoftHdwBasics.ArrayPositionEqual];
[] _ RefTab.Pairs[route, EachRoutedWire];
};

END.
~
SoftHdwRouter.mesa
Copyright Σ 1988 by Xerox Corporation.  All rights reserved.
Minsky, July 18, 1989 4:55:47 pm PDT
Barth, September 7, 1989 5:03:26 pm PDT

FreeSurface[surface];
Now compute the array sizes for the various node types 
-- INTERCHIP HOOK
BuildInterChipArcs[surface, sizes];
...For each chip, this procedure builds the arcs from each node in each grain of each minor array to all the nodes which can be driven from the source node. 
...For a minor array at the given position (and orientation),  iterate over the grains in the correct dimension, and build arcs to all other nodes which we can drive from the node type indicated by position.type
...For each chip, this procedure builds the arcs from each Long node in each grain of each minor array to all the nodes which can be driven from that Long (i.e., Inputs of each grain which the Long passes through).
To enumerate all the long lines, iterate over all the minor arrays in the direction orthogonal to the Long orientation.
Iterate over each grain in each minor array
Set the minor array index.
Given a Long node, iterate over all the minor arrays it crosses, and create an Arc to the input of the grain which it goes through. 
A. LToI Long (longNode) to Input of each grain we cross
...Creates arcs to all perpendicular outputs, as well as the parallel output.
First, enumerate all perpendicular outputs.
And get the parallel output:
...Creates arcs to all nodes which can be driven by a LeftDown from position.
Here are the possible nodes we can drive from this LeftDown: 
A.  LDToI drive our own input
B.  LDToLD drive LD of left neighbor
...Creates arcs to all nodes which can be driven by a RightUp from position.
Here are the possible nodes we can drive from this LeftDown: 
A.  RUToRU drive RU of right neighbor
RUToI drive right neigbhors Input
...Creates arcs to all nodes which can be driven by an Output at this position
Here are the possible nodes we can drive from this output: 
A.  ORUToI parallel input
B.  OLDToI drive input of right neighbor
OLDToRU drive RU of right neighbor
C. ORUToL drive the perpendicular Long line
D. ORUToLD drive left neighbor's LD line
Calculate Chip address offset
Then calculate minor array horizontal or vertical offset
If no driver, just connect destinations together.
Make a list of the destinations, excluding the seed.
Loop until all path extensions are exhausted:
If any destination node has been reached (i.e., it has a non-null back pointer) then follow the back pointers from that destination node back to the seed, labeling the all the nodes in the path with LABEL.
Remove the successfully routed destination from the destinations list.
If paths to explore are exhausted, and route is not done yet, mark an incomplete
Traces back pointers from the source node, and produces a path tree.
'neighbors' is a list of all neighbors of current who have both the same label as current, and whose back pointer points at current. 
Create a sequence of linear path from of all the positions up to this branch.
Iterate over ALL minor array grain sites. 
Special Case 1: Iterate over all chip long line nodes. 
Special Case 2: Iterate over all Interchip sites
-- INTERCHIP HOOK
Κ ™š
œ™Icode™<Kš
œ$™$K™'K™—KšΟk	œœHœ
˜sK˜šΟn
œœ
˜Kšœ2˜;Kšœ˜Kšœœ˜—K˜K˜K˜šžœœœ@œ	˜
Kšœœ˜-Kš
œ˜Kš
œ'˜'Kš
œ'˜'Kš
œ˜Kš
œ>˜>šœ/œœ
˜BKš
œ˜Kšœ
˜—Kš
œ™K˜K˜—šžœœ˜/šœœ˜'šœœ
˜)Kš
œ.˜.Kšœ
˜—Kšœ
˜—K˜K˜—šž
œœœ˜IKšœœ˜0Kšœœ˜5Kšœ
œ
˜šœœ˜'šœœ
˜)šœœœ˜Kš
œ˜Kš
œ˜Kšœœ
˜—šœ)œ˜7šœ	œœ
˜Kš
œ#˜#Kš
œ#˜#Kšœœ˜—Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ
˜
KšœΟc˜&Kšœœ
˜—Kšœ%œ2œ˜gšœJœ˜\Kš
œ˜Kš
œ˜Kšœœ˜—Kš
œW˜WKš
œW˜WKš
œ^˜^K™7šœ4œ˜Bšœ	œœ
˜Kš
œE˜EKš
œD˜DKšœœ˜—Kšœ1Ÿ˜HKš
œ\˜\Kšœœ˜—Kšœ
˜—Kšœ
˜—K˜K˜+Kš
œ2˜2K˜5Kš
œ:˜:K˜3Kš
œ8˜8Kš
Ÿ™K™#K˜K˜—šžœœ?˜\K™
Kš
œ%˜%šœœ
œ˜&šœœ
œ˜&šœœ
˜)šœ	œ
œ˜-šœ	œ
œ˜-šœœ˜'Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ9˜9Kšœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—K˜K˜—šžœœ?˜[K™Σ
Kš
œ%˜%šœ
œœœ
˜1K˜Kš
œ˜Kšœœ
˜—šœœœ˜8K˜;K˜9Kšœœ
˜—šœœœ˜9K˜(K˜&Kšœœ
˜—šœœ
œœ
˜#Kš
œ*˜*Kš
œ˜šœœ
˜Kš
œ=˜=Kš
œ\˜\Kš
œR˜RKš
œN˜NKšœ
œ
˜Kšœœ
˜
Kšœœ
˜—Kšœ
˜—K˜—K˜šžœœ?˜ZK™Φ
Kš
œ%˜%Kš
œ˜šœœ
œ˜&šœœ
œ˜&šœœ
˜)K™wšœ
œ
˜šœ˜Kš
œ!˜!Kš
œ˜Kšœœ
˜——šœ
œ
œ˜'K™+šœ
œœœ
˜#K˜Kš
œ˜Kšœœ
˜—šœœ
œœ
˜#Kš
œ*˜*K™šœ˜Kš
œM˜MKš
œO˜OKšœœ
˜—Kš
œ˜Kš
œ˜Kš
œ˜K˜Kš
œ-˜-K˜Kš
œ4˜4Kšœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—K˜K˜—šžœœA˜XK™„
Kš
œ˜Kš
œ%˜%šœ
œ
˜šœ˜ Kš
œ!˜!Kš
œ˜Kšœœ
˜——K™7K˜šœ
œ
œ˜'šœ˜ Kš
œ2˜2Kš
œ/˜/Kšœœ
˜—Kš
œ.˜.Kš
œ(˜(Kšœ
˜—K˜—K˜K˜šžœœ@˜WK™MK™+K˜Kš
œ%˜%šœœœœ
˜5K˜Kš
œ˜Kšœœ
˜—šœœ˜:K˜K˜Kšœœ
˜—Kš
œ+˜+Kš
œ˜šœœ
œœ
˜'Kš
œ'˜'Kš
œ/˜/Kš
œ3˜3Kš
œ&˜&Kšœ
˜—K™Kš
œ˜Kš
œ.˜.Kš
œ&˜&Kš
œ˜K˜K˜—šžœœ"œ˜Hšœœ
˜!Kš
œB˜BKš
œ@˜@Kšœœ
˜—Kš
œ˜K˜—šžœœKœ˜rK™MK˜Kš
œ+˜+K™=K™Kš
œ˜Kš
œ3˜3Kš
œ&˜&K™$šœ
œ˜šœ˜ Kš
œH˜HKš
œF˜FKšœœ
˜—Kš
œ˜Kš
œ3˜3Kš
œ*˜*—K˜K˜—šžœœJœ˜pK™LK˜Kš
œ+˜+K™=Kšœœ™%šœ
œœ˜šœ˜ Kš
œH˜HKš
œF˜FKšœœ
˜—Kš
œ˜Kš
œ3˜3Kš
œ'˜'K™!Kš
œ˜Kš
œ3˜3Kš
œ&˜&Kš
œ˜—K˜K˜—šžœœYœ˜~K™NK˜Kš
œ+˜+K™;K™Kš
œ˜Kš
œ3˜3Kš
œ&˜&K™(šœ
œœ˜šœ˜ Kš
œH˜HKš
œF˜FKšœœ
˜—Kš
œ˜Kš
œ3˜3Kš
œ'˜'Kšœœ™"Kš
œ˜Kš
œ3˜3Kš
œ*˜*—K™+Kš
œ˜Kš
œ˜Kš
œ3˜3Kš
œ'˜'Kšœ!œ™(šœ
œœ˜šœ˜ Kš
œH˜HKš
œF˜FKšœœ
˜—Kš
œ˜Kš
œ3˜3Kš
œ&˜&Kš
œ˜—˜K˜——šžœœ	œœ˜CKšœœœ˜)Kšœ
œœ˜5Kšœœ
œ
˜'Kš
œ˜Kšœ
œ%˜4K˜K˜—šž
œœœ˜3Kšœœ
œ'˜HK˜K˜—šžœœ˜(Kš
œ/˜/Kš
œ˜Kšœ
œ
˜Kšœœ
˜Kš
œL˜Lšœœ
œ˜#Kšœœ
˜Kšœ
˜—K˜K˜—šž	œœ7œ˜Ošœœ
œ˜)šœœ
œ˜Kš
œ ˜ Kšœ
˜K˜—Kšœ
˜—Kšœ
˜K˜K˜—šžœœ-œ˜YKš
œ#˜#Kš
œ+˜+Kšœ
œ
œœ(˜MK™Kšœœ˜#š
œ˜Kš
œ,˜,Kš
œ7˜7Kš
œ6˜6—K™8šœœ˜-š
œ`˜`Kš
œ?˜?—šœ	œ˜Kš
œJ˜JKš
œH˜HKšœœ

˜—Kšœœ˜—Kšœœ(œ
œœ
œ8œ
œœ
œ
˜²
Kšœœ˜K˜—K˜šž
œœœ	œ˜>šœœ˜#Kš
œ˜Kš
œ˜Kšœœ
˜—Kš
œ˜K˜—Kšœœ˜Kšœœ˜Kšœ
œ˜Kšœ
œœ
œ˜K˜šžœœ
œœ˜)Kš
œ˜Kš
œ˜Kš
œ˜—K˜šžœœ
œ˜6šžœœ˜8Kšœœ˜Kšœœ˜&Kšœ
œ*œ
œ
˜;K˜—K˜vKš
œ>˜>K˜K˜K˜—šžœœ*œ0˜sšžœœ˜8Kšœœ˜Kšœœ˜&Kš
œ2˜2Kš
œ)˜)Kšœ
œ˜$K˜Kšœœ
œ
œ
˜Kš
œ˜Kš
œ˜Kšœœœœ
˜VKš
œ˜šœœ
œ
˜%Kšœœ˜0Kš
œ/˜/šœœ
˜!Kš
œF˜FKš
œD˜DKšœœ
˜—Kš
œ)˜)Kš
œœ
œœ
œ
˜2Kš
œ˜Kšœœ˜.Kšœ
˜—K˜—šž	œœ˜,Kšœœ˜&Kšœœ˜Kš
œ,˜,K˜Kšœœœ
œ
˜@šœœ
œ˜ Kš
œ˜Kšœœ
˜K™1Kšœœ
œ ˜5Kšœ˜K™4šœ)œœ
˜;Kšœœœ˜BKšœ
˜—šœœ
œ˜Kšœ
œœ
˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœœ
˜K™-šœœ
˜Kšœœ
˜šœ#œœ
˜5Kšœœ
œ˜$šœ˜K™Ν
Kšœœ˜K˜šœœ
˜Kš
œ˜K˜Kš
œ˜Kšœ
˜—Kšœœ˜,Kš
œF™FKšœœ
œ˜(Kšœ˜Kšœœ
˜Kš
œ˜—Kšœ
˜—šœœ
œ

œ
˜Kšœœ$œ˜D—˜
Kš
œ˜Kš
œ˜Kšœœ
œœ
˜%šœœ
œ˜(K˜Kšœ
œ
œ
œ
˜šœœ
œœœœ
œ˜`Kš
œ˜šœ
œ
œ˜Kš
œ˜Kš
œ˜K˜
—šœ˜Kš
œ˜Kš
œ˜K˜—Kšœœ
˜K˜—Kšœ
˜—K˜—K™Pšœ
œœ
œG˜qKš
œ˜—Kšœ
˜—Kšœ
œ
œ
œ,œ
œ
˜NKš
œ˜K˜—K˜—K˜—šžœœœ˜JKšœœ&˜1šœœ
œ˜Kšœœ
˜Kšœ
œ&œ
œ
˜7K˜—K˜—Kš
œ`˜`Kšœœ˜0Kšœœ˜Kšœœ˜Kš
œ-˜-Kš
œ>˜>Kš
œR˜RK˜K˜Kš
œ&˜&Kšœ*œ˜CK˜K˜—šž	œœ˜#Kš
œ/˜/Kšœ
œ
˜Kšœœ
˜K˜K˜—šžœœœ˜2Kš
œ˜Kš
œ˜Kšœœ
˜šœœ
˜Kš
œ˜Kš
œ˜Kšœœ
œœ
˜%šœœ
œ˜(K˜Kšœ
œ
œ
œ
˜šœœ
œ˜Kšœœ
˜šœ
œ
œ˜Kš
œ˜Kš
œ˜K˜
—šœ˜Kš
œ˜Kš
œ˜K˜—Kšœœ
˜K˜—Kšœ
˜—Kšœ
˜—K˜K˜—šžœœœœ˜?K™Dšžœœ
œœ˜5Kšœœ˜šœ)œœ
˜;K˜Kšœ
˜—Kšœœ˜š	œœ

œ
œ˜.K˜K˜Kšœ
˜—Kšœœ
œ
œ
˜K˜—Kšœœ7˜Wš
˜Itextš
œ…
™…
Kšœœ
˜Kšœœ˜šœœ
œ˜(K˜Kšœ
œ
œ
œ
˜šœœœ˜@Kšœœ˜&Kš
œ"˜"K˜—Kšœ
˜—šœ
œ
˜šœŸ˜"Kš
œ˜Kšœ
˜K˜—šœŸ˜)Kš
œ˜KšœœB˜RK˜—šœŸ˜Kšœœ˜5K™MK˜Kš
œ˜š	œœ

œ
œ˜7Kš
œ,˜,Kš
œ˜Kšœ
˜—Kšœ
˜K˜——Kšœ
˜—Kš
œ˜K˜—Kšœœœ-˜FšžœœH˜\Kš
œ%˜%K™*šœœ
œ˜&Kš
œ˜šœœ
œ˜&Kš
œ˜šœœ
˜)Kš
œ˜šœ	œ
œ˜-Kš
œ˜šœ	œ
œ˜-Kš
œ˜šœœ˜'šœ
œœœ
˜1K˜Kš
œ˜Kšœœ
˜—Kš
œ˜šœœ
œœ
˜#Kšœœ
˜š
œ&˜&Kš
œ˜—š
œ$˜$Kš
œ˜—Kšœœ
˜šœ˜Kš
œ@˜@Kšœœ#˜:Kšœœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—Kšœ
˜—K™7K˜šœœ
œ˜&Kš
œ˜šœœ
œ˜&Kš
œ˜šœœ
˜)šœ
œœœ
˜1K˜Kš
œ˜Kšœœ
˜—Kš
œ˜šœœ
œœ
˜#Kšœœ
˜š
œ&˜&Kš
œ˜—š
œ$˜$Kš
œ˜—Kšœœ
˜šœœ
˜˜šœ	œ
œ˜-Kš
œ˜Kš
œ˜Kš
œ˜Kšœ˜—˜
šœ	œ
œ˜-Kš
œ˜Kš
œ˜Kš
œ˜Kšœ˜——Kšœœ
˜—Kšœ
˜——Kšœ
˜—Kšœ
˜—Kšœ
˜—K™0K™K˜K˜—šž
œœ
œ˜/šžœ˜)Kšœ
œ˜K˜K˜—šž	œœ˜ šœœ
œ˜(Kšœœ˜0Kš
œ˜Kšœ
œ+œ
œ
˜<Kšœ
˜—š
œœ
œ
œœ
œ˜KKš
œ ˜ Kšœ
˜—K˜—K˜vKš
œ)˜)K˜K˜—Kšœ
˜—…—Tz{