<<>>
<<SoftHdwRouter.mesa>>
    <<Copyright Ó 1988 by Xerox Corporation.  All rights reserved.>>
    <<Minsky, July 18, 1989 4:55:47 pm PDT>>
    <<Barth, September 6, 1989 12:42:02 pm PDT>>
    <<>>
    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[surface];>>
        };

    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;
                <<Now compute the array sizes for the various node types >>
                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];
        <<-- INTERCHIP HOOK>>
        <<BuildInterChipArcs[surface, sizes];>>
        };

    BuildArcsForMinorArrays: PROC [surface: Surface, position, otherPosition: ArrayPosition] ~ {
        <<...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. >>
        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] ~ {
        <<...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>>
        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] ~ {
        <<...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).>>
        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
                    <<To enumerate all the long lines, iterate over all the minor arrays in the direction orthogonal to the Long orientation.>>
                    minorDim: INT _ 
                        SELECT orient FROM
                            Horizontal => sizes.minorArray.y,
                            Vertical => sizes.minorArray.x,
                            ENDCASE => ERROR;
                    FOR minorIndex: INT IN [0..minorDim) DO
                        <<Iterate over each grain in each minor array>>
                        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];
                            <<Set the minor array index.>>
                            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]  ~ {
        <<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. >>
        grainNode: Node;
        sizes: ArrayPosition _ surface.sizes;
        minorDim: INT _ 
            SELECT position.orientation FROM
                Horizontal => sizes.minorArray.x,
                Vertical => sizes.minorArray.y,
                ENDCASE => ERROR;
        <<A. LToI Long (longNode) to Input of each grain we cross>>
        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]  ~ {
        <<...Creates arcs to all perpendicular outputs, as well as the parallel output.>>
        <<First, enumerate all perpendicular outputs.>>
        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;
        <<And get the parallel output:>>
        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]  ~ {
        <<...Creates arcs to all nodes which can be driven by a LeftDown from position.>>
        myNode, otherNode: Node;
        myNode _ PositionToNode[surface, position];
        <<Here are the possible nodes we can drive from this LeftDown: >>
        <<A.  LDToI drive our own input>>
        otherPosition.type _ Input;
        otherNode _ PositionToNode[surface, otherPosition];
        CreateArc[surface, myNode, otherNode];
        <<B.  LDToLD drive LD of left neighbor>>
        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]  ~ {
        <<...Creates arcs to all nodes which can be driven by a RightUp from position.>>
        myNode, otherNode: Node;
        myNode _ PositionToNode[surface, position];
        <<Here are the possible nodes we can drive from this LeftDown: >>
        <<A.  RUToRU drive RU of right neighbor>>
        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]; 
            <<RUToI drive right neigbhors Input>>
            otherPosition.type _ Input;
            otherNode _ PositionToNode[surface, otherPosition];
            CreateArc[surface, myNode, otherNode];
            };
        };

    BuildArcsForOutput: PROC [surface: Surface, position, otherPosition: ArrayPosition, atTheNearEdge, atTheFarEdge: BOOLEAN]  ~ {
        <<...Creates arcs to all nodes which can be driven by an Output at this position>>
        myNode, otherNode: Node;
        myNode _ PositionToNode[surface, position];
        <<Here are the possible nodes we can drive from this output: >>
        <<A.  ORUToI parallel input>>
        otherPosition.type _ Input;
        otherNode _ PositionToNode[surface, otherPosition];
        CreateArc[surface, myNode, otherNode];
        <<B.  OLDToI drive input of right neighbor>>
        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]; 
            <<OLDToRU drive RU of right neighbor>>
            otherPosition.type _ RightUp;
            otherNode _ PositionToNode[surface, otherPosition];
            CreateArc[surface, myNode, otherNode];  };
        <<C. ORUToL drive the perpendicular Long line>>
        otherPosition^ _ position^;
        otherPosition.type _ Long;
        otherNode _ PositionToNode[surface, otherPosition];
        CreateArc[surface, myNode, otherNode]; 
        <<D. ORUToLD drive left neighbor's LD line>>
        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];
        <<Calculate Chip address offset>>
        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;
        <<Then calculate minor array horizontal or vertical offset>>
        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 no driver, just connect destinations together.>>
                IF ne.source=NIL THEN seed _ sourceDestinations.first
                ELSE seed _ ne.source;
                <<Make a list of the destinations, excluding the seed.>>
                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;
                    <<Loop until all path extensions are exhausted:>>
                    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 {
                                <<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.>>
                                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];
                                <<Remove the successfully routed destination from the destinations list.>>
                                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;
                            };
                        <<If paths to explore are exhausted, and route is not done yet, mark an incomplete>>
                        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 {
        <<Traces back pointers from the source node, and produces a path tree.>>
        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[NEW[ArrayPositionRec _ current.position]];
        DO
        <<'neighbors' is a list of all neighbors of current who have both the same label as current, and whose back pointer points at 
        current. >>
            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[NEW[ArrayPositionRec _ current.position], positions];
                    };
                ENDCASE => {  -- tree branches
                    subPaths: SubPaths _ NEW[SubPathsRec[neighborCount]];
                    <<Create a sequence of linear path from of all the positions up to this branch.>>
                    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;
        <<Iterate over ALL minor array grain sites. >>
        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;
        <<Special Case 1: Iterate over all chip long line nodes. >>
        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;
        <<Special Case 2: Iterate over all Interchip sites>>
        <<-- INTERCHIP HOOK>>
        };

    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.