-- wiresPlace6.mesa
-- reject wires
-- ties to middles and to ends
-- alternate paths
-- follow around nil ends

DIRECTORY SystemDefs:FROM"SystemDefs",
WiresDefs:FROM"WiresDefs",
IODefs:FROM"IODefs";
WiresPlace:PROGRAM IMPORTS SystemDefs, IODefs, WiresDefs=BEGIN OPEN WiresDefs;

Error:SIGNAL=CODE;
debugLevel: INTEGER ← 2;

--//////////////CONTROL///////////////

Main:PROCEDURE=BEGIN
AllocateStuffForCreate[PrintStks];
AllocateStuffForSeg[];
AllocateStuffForPlace[];
Go[];
END;

Go:PROCEDURE=BEGIN
i,j: INTEGER;
GetInput[TRUE];
MakeWireList[TRUE];
InitRejectWires[];
PlaceSimpleWires[TRUE];
IF topRejectWire>0 THEN Error;
[i,j]←TurnToStks[TRUE];
DoOutputs["wires3",i,j];
END;
AllocateStuffForPlace:PROCEDURE=BEGIN OPEN SystemDefs;
rejectWireList←AllocateSegment[SIZE[rejectWireListArray]];
hopperList←AllocateSegment[SIZE[hopperListArray]];
END;

Dump: PROCEDURE= BEGIN EnumerateGridPlusOne[PrintStubs]; END;

Dstk: PROCEDURE= BEGIN debugPrint←TRUE;
PrintStks[];
debugPrint←FALSE;
END;

--/////////////REJECT WIRES ///////////////

rejectWireListArray:TYPE=ARRAY [0..maxRejectWire] OF WirePtr;
rejectWireList:POINTER TO rejectWireListArray←NIL;
topRejectWire:INTEGER;
maxRejectWire:INTEGER=40;

InitRejectWires:PROCEDURE=BEGIN topRejectWire←0; END;

AddRejectWire:PROCEDURE[w:WirePtr]=BEGIN
ShowHopper[];
rejectWireList[topRejectWire]←w;
topRejectWire←topRejectWire+1;
IF topRejectWire>maxRejectWire THEN Error;
END;

--////// PLACE SIMPLE WIRES///////////////

PlaceSimpleWires:PROCEDURE[print:BOOLEAN]=
BEGIN InitSegs[];
EnumerateWires[PlaceOneWire];
END;

activeCircuit: INTEGER;

PlaceOneWire:PROCEDURE[i: INTEGER, wire:WirePtr]= BEGIN
IODefs.WriteChar[CR];
IODefs.WriteNumber[i,[10,FALSE,TRUE,4]];
activeCircuit ← wire.circuit;
BackwardRun[wire,ForwardRun[wire]];
END;

ForwardRun:PROCEDURE[w:WirePtr]RETURNS[done:NodePtr]=BEGIN

OneNode:PROCEDURE[n:NodePtr]RETURNS[BOOLEAN]=
BEGIN RETURN[EnumerateFollow[n,OnePlace]]; END;
OnePlace:PROCEDURE[n:NodePtr,s:SegPtr,level:BOOLEAN] RETURNS[BOOLEAN]=
BEGIN
[done,]←AddHopper[s,n.hop+1,n,TRUE,level,none];
IF IllegalNode[done] THEN Error;
RETURN[done#NIL];
END;
SetEnd:PROCEDURE[s:SegPtr, c: Contact]RETURNS[BOOLEAN]=
BEGIN
done←AlsoAdd[s,none,terminalHop,c];
IF IllegalNode[done] THEN Error;
RETURN[done#NIL];
END;
SetStart:PROCEDURE[s:SegPtr, c: Contact]RETURNS[BOOLEAN]=
BEGIN
done←AlsoAdd[s,none,0,c];
IF IllegalNode[done] THEN Error;
RETURN[done#NIL];
END;

-- BEGIN Body of ForwardRun
maxLength:INTEGER←WireLength[w.a,w.b]+7;
done←NIL;
ClearHopper[];
IF w.a.i=w.b.i AND w.a.j=w.b.j THEN RETURN; -- do nothing for pullups
IF ~EnumerateOrient[w.b,SetEnd] AND ~EnumerateOrient[w.a,SetStart]
THEN EnumerateHopper[OneNode];
END;

AlsoAdd:PROCEDURE[s:SegPtr,t:Twist,h:INTEGER, c: Slot]
RETURNS[done:NodePtr]=BEGIN
duplicateA, duplicateB: BOOLEAN;
level:BOOLEAN←s.xy.l;
IF s=NIL OR (s.circuit#activeCircuit AND s.circuit#nullCircuit AND t#none)
OR (s.dummy AND t=n) THEN RETURN[NIL];
[done,duplicateA]←AddHopper[s,h,NIL,TRUE,level,c];
IF (t=none AND ~s.dummy AND ~s.nc) THEN RETURN;
IF done=NIL AND ~s.bc AND ~s.dummy AND (t=s OR t=f OR t=a)
THEN [done,duplicateB]←AddHopper[s.back,h,NIL,FALSE,level,none]
ELSE duplicateB←FALSE;
IF duplicateA OR duplicateB THEN RETURN;
-- the remainder is a 5-ary tree traversal
IF done=NIL AND t#n AND s.bc THEN done←AlsoAdd[s.back,b,h,none];
IF done=NIL AND t#b AND s.nc THEN done←AlsoAdd[s.next,n,h,none];
IF done=NIL AND t#s AND ~s.dummy THEN done←AlsoAdd[s.first,f,h,none];
IF done=NIL AND t#f AND ~s.dummy THEN done←AlsoAdd[s.second,s,h,none];
IF done=NIL AND t#a AND ~s.dummy THEN done←AlsoAdd[s.across,a,h,none];
END;

BackwardRun:PROCEDURE[w:WirePtr,n:NodePtr]=BEGIN
where:SegPtr←NIL; down,free:BOOLEAN;
color:Color←IF w.a.contact=gate OR w.b.contact=gate THEN r ELSE g;
IF IllegalNode[n] THEN Error;
IF debugLevel>10 THEN ShowHopper[];
IF n=NIL THEN BEGIN
IF w.a.i=w.b.i AND w.a.j=w.b.j THEN SetPullup[w.a]
ELSE AddRejectWire[w];
RETURN;
END;
[down,free]←SetInitialSegment[w.b,n,w.circuit];
IF PreviousHopper[n]=NIL THEN where←(IF down THEN n.s ELSE n.s.next)
ELSE FOR n←n,PreviousHopper[n] DO
where←SetSeg[from:n,col:color,circuit:w.circuit,old:where,
tieN:~free AND ~down, tieB:~free AND down];
PrintOneSeg[where];
free ← TRUE;
IF PreviousHopper[n]=NIL THEN EXIT;
ENDLOOP;
SetFinalSegment[l:w.a,s:where, n:n, circuit: w.circuit];
IF debugLevel>10 THEN BEGIN
debugPrint←TRUE;
EnumerateGrid[PrintOrientations];
debugPrint←FALSE;
END;
END;

--/////// START HOPPER ///////

--The hopper is a fifo into which one can insert nodes. Duplicate entries
--will be suppressed (thereby suppressing longer passes to the same place
--one can also backtrack through the hopper chain

hopperListArray:TYPE=ARRAY [0..maxHopper] OF Node;
maxHopper:INTEGER=400;
hopperList:POINTER TO hopperListArray←NIL;
hopperInsert,hopperRemove:INTEGER;

IllegalNode:PROCEDURE[n:NodePtr] RETURNS[BOOLEAN]=BEGIN
foo1:CARDINAL←LOOPHOLE[n];
foo2:CARDINAL←LOOPHOLE[@hopperList[0]];
foo3:CARDINAL←LOOPHOLE[@hopperList[maxHopper]];
RETURN[n#NIL AND foo1 NOT IN [foo2..foo3]]; END;

ClearHopper:PROCEDURE=BEGIN hopperInsert←hopperRemove←0; END;

AddHopper:PROCEDURE[s:SegPtr,h:Hop,bk:NodePtr,nor,l:BOOLEAN, c: Slot]
RETURNS[NodePtr, BOOLEAN]=BEGIN
i:INTEGER; t:NodePtr;
IF s.w=l OR s.w=d THEN RETURN[NIL, FALSE];
IF ~s.dummy AND s.xy.l#l THEN BEGIN Error; RETURN[NIL, FALSE]; END;
FOR i IN [0..hopperInsert) DO
t←@hopperList[i];
IF s=t.s AND l=t.l THEN -- this segment is already in the hopper
BEGIN IF t.hop=terminalHop AND h#terminalHop -- i.e. we’re done
THEN t.back←bk ELSE t←NIL;
RETURN[t, TRUE];
END;
ENDLOOP;
t←AddToHopper[];
t↑←[s:s,hop:h,back:bk,normal:nor,movingLD:LD[bk.s,s],l:l, contact: c];
RETURN[NIL, FALSE];
END;

AddToHopper:PROCEDURE RETURNS[f:NodePtr]=BEGIN
f←@hopperList[hopperInsert];
IF (hopperInsert← hopperInsert+1) >= maxHopper THEN Error;
END;

EnumerateHopper:PROCEDURE[call:PROCEDURE[NodePtr]RETURNS[BOOLEAN]]=BEGIN
node:NodePtr;
FOR hopperRemove←hopperRemove,hopperRemove+1
WHILE hopperRemove<hopperInsert DO
node←@hopperList[hopperRemove];
IF node.hop#terminalHop THEN
IF call[@hopperList[hopperRemove]] THEN RETURN;
ENDLOOP;
END;

PreviousHopper:PROCEDURE[p:NodePtr]RETURNS[NodePtr]=BEGIN RETURN[p.back]; END;

ShowHopper:PROCEDURE=BEGIN OPEN IODefs;
node:NodePtr;
deb:INTEGER;
WriteChar[CR];
FOR deb IN [0..hopperInsert) DO
node←@hopperList[deb];
WriteChar[’[];
WriteNumber[deb,[10,FALSE,TRUE,3]];
PrintOneSeg[node.s];
WriteChar[IF node.l THEN ’B ELSE ’ ];
WriteChar[’[];
WriteNumber[ShowSeg[node.s],[10,FALSE,TRUE,3]];
WriteNumber[IF node.hop=terminalHop THEN 99 ELSE node.hop,[10,FALSE,TRUE,3]];
WriteNumber[IF node.back=NIL THEN 99 ELSE (node.back-@hopperList[0])/SIZE[Node],[10,FALSE,TRUE,3]];
WriteChar[CR];
ENDLOOP;
END;

--/////// END HOPPER //////
--/////// START FOLLOW ///////

maxAns: INTEGER=40;
topAns:INTEGER;
followAns:ARRAY[0..maxAns) OF SegPtr;

EnumerateFollow:PROCEDURE[n:NodePtr,
call:PROCEDURE[NodePtr,SegPtr,BOOLEAN]RETURNS[BOOLEAN]]
RETURNS[BOOLEAN]= BEGIN i:INTEGER; v:SegPtr;
StartFollow[n];
FOR i IN [0..topAns) DO
IF followAns[i].dummy AND followAns[i].back#NIL THEN Error;
IF call[n,followAns[i],n.l] THEN RETURN[TRUE]; ENDLOOP;
FOR v←n.s,v.back DO -- Find the constraining seg. on other level.
IF v.dummy THEN EXIT;
IF v.across#NIL AND ~v.across.dummy THEN BEGIN
v←v.across;
EXIT;
END;
ENDLOOP;
-- The constraining seg has been found. Now add all possible segs across.
IF v.nc THEN RETURN[FALSE];
IF call[n,v,~n.l] THEN RETURN[TRUE];
FOR v← IF v.dummy AND ~n.l THEN v.across ELSE v.next, v.next
UNTIL v.across#NIL DO
IF ~v.nc THEN IF call[n,v,~n.l] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;

home:Where;
homeL:BOOLEAN;

StartFollow:PROCEDURE[n:NodePtr]=BEGIN
-- Determines whether we can continue the search from n and if so
-- exactly where. Calls F1B to add possible continuations.
GoOn: PROCEDURE[s: SegPtr, choice: BOOLEAN]= BEGIN
w,t:SegPtr←NIL;
FOR t←s, t.back DO -- find our way around the corner.
IF t=NIL THEN BEGIN Error; RETURN; END;
w←t.first; IF w#NIL AND choice=LDOk[t,w] THEN EXIT;
w←t.second; IF w#NIL AND choice=LDOk[t,w] THEN EXIT;
ENDLOOP;
F1B[w]; -- w goes the way we want so follow it.
END;

s:SegPtr←n.s;
ld:BOOLEAN←n.movingLD;
IF s=NIL THEN BEGIN Error; RETURN; END;
home←s.xy;
homeL←n.l;
topAns←0;
-- First, handle the " source" wire.
IF n.back=NIL -- This will be true only for source segs, i.e. hop=0
OR n.back.l#homeL -- i.e. we just jumped levels
THEN BEGIN GoOn[s,TRUE]; GoOn[s,FALSE]; RETURN; END;
IF s.nc OR (homeL AND s.dummy AND s.ac) THEN RETURN; -- nowhere to go.
GoOn[s,ld]; -- normal case: continue in current direction
END;

F1B:PROCEDURE[m:SegPtr]=BEGIN
-- adds all accessable segs at this end and level.
t:BOOLEAN; nextM,k: SegPtr; c:INTEGER;
IF m=NIL THEN RETURN;
FOR c←0,c+1 DO
IF m=NIL THEN Error;
IF m.xy.x=home.x AND m.xy.y=home.y AND m.xy.h=home.h THEN RETURN;
-- We’re home again. Hairpins aren’t useful.
t←Right[m]; -- if t then we want to traverse next’s, otherwise back’s
IF t THEN BEGIN --Add everything between here and next seg toward home.
AddFollow[m];
FOR k←IF m.dummy AND homeL THEN m.across ELSE m.next, k.next
UNTIL (TowardHome[nextM←k.first] OR TowardHome[nextM←k.second])
DO
AddFollow[k];
ENDLOOP
END
ELSE
FOR k←IF m.dummy AND homeL THEN m.across ELSE m.back, k.back DO
AddFollow[k];
IF TowardHome[nextM←k.first] OR TowardHome[nextM←k.second]
THEN EXIT;
ENDLOOP;

IF c=2 THEN EXIT;
m←nextM;
ENDLOOP;
END;

LD:PROCEDURE[a,b:SegPtr] RETURNS[BOOLEAN]=
-- Predicate: Not going up or right.
BEGIN RETURN[b.xy.x-a.xy.x#1 AND b.xy.y-a.xy.y#1]; END;

LDOk:PROCEDURE[a,b:SegPtr] RETURNS[BOOLEAN]=
-- Predicate: true if b is connected to the LD side of a.
BEGIN RETURN[IF a.xy.h THEN b.xy.x-a.xy.x=-1 ELSE b.xy.y-a.xy.y=-1]; END;

TowardHome:PROCEDURE[s:SegPtr] RETURNS[BOOLEAN]=BEGIN
-- Predicate: s is "connected" to home on at least one end.
dy:INTEGER←s.xy.y-home.y;
dx:INTEGER←s.xy.x-home.x;
IF s=NIL THEN RETURN[FALSE];
IF ~home.h THEN BEGIN t:INTEGER←dx; dx←dy; dy←t; END;
RETURN[IF s.xy.h=home.h THEN dy=0 AND dx IN [-1..1]
ELSE dy IN [0..1] AND dx IN [-1..0]];
END;

Right:PROCEDURE[a:SegPtr] RETURNS[BOOLEAN]=BEGIN
-- Predicate: home is on the "next" side of constraining wire a
RETURN[a.xy.h=home.h OR ABS[(a.xy.x-home.x)-(a.xy.y-home.y)]#1];
END;

AddFollow:PROCEDURE[this:SegPtr]= BEGIN i:INTEGER;
FOR i IN [0..topAns) DO IF followAns[i]=this THEN RETURN; ENDLOOP;
IF topAns=15 THEN BEGIN Error; RETURN; END;
IF this.xy.x=home.x AND this.xy.y=home.y AND this.xy.h=home.h THEN
BEGIN Error; RETURN; END;
followAns[topAns]←this;
IF (topAns←topAns+1) > maxAns THEN Error;
END;

--/////// END FOLLOW ///////

Main[];
END..

The desired algorithm is simple:
1) break each circuit into individual point to point wires
2) sort the wires
3) place each wire in its shortest length configuration, counting level changes as equivalent to one unit wire on the grid.

The break up tries for short wires, and the sort puts green wirs first, power and ground last, and short wires ahead of long within these catagories.

The processing starts with the grid, which specifies what circuit each lead of each transistor connects to.
grid[x,y]=[a,b,c:CircuitNo]

The first two steps of the processing create auxilliary structures which permit access to the grid:
the Track, which links the transistors into lists by circuit
the wire list, which enumerates, by size and color, the individual wires necessary to implement all of the circuits (excluding power and ground)

The next step creates Segs, which are unit length pieces of wire running in channels between the transistors. A seg is defined by the segs it connects to on each end, plus the segs adjacent but parallel to it on both sides, plus two booleans to say whether it is electrically connected on the sides, plus a connection across to the other level. Each transistor comes with four built-in dummy segs forming a box around the transistor. The whole figure is surrounded by dummy transistors arranged so that their dummy segs connect to form a box around the whole figure (to eliminate bounds checking all the time).

The processing inserts one wire at a time ito the seg diagram. This is done using an auxialliary structure called a node array. Points adjacent to one end of the wire are inserted into the node array as destinations. Points adjacent to the other end are inserted with zero length. The node array is then processed in order of increasing length, each time adding any new nodes which can be reached by adding one seg from the current one. Eventually a destination will be found, and thereby the shortest path. This all gets a little hairy since a point is not simply an xy between transistors, but also an indication of which of the many wires that may already be at this intersection the point is between. Another magic - it is sufficient to store only the seg to the points immediate left to completely identify it.

Once the segs are determined, on has in principle the final stick diagram. However there is still the little matter of assigning coordinates to all of the ends implied by the seg structure. This is achieved with some little difficulty, by creating another structure called stks (I was making a massive edit removing a similar structure called sticks - hense the funny name). stks contain only the information necessary to draw the implied line: color, direction(h or v), major coordinate (the y for a horizontal stick, etc), and the two minor coordinates(start and end x for a horizontal stick). Sticks do not butt up to other sticks running in the same direction, so that one stick corresponds to several adjacent segs.

Finally, the sticks may be printed by calling a routine which enumerates through all the data structures calling "put box" with a colored rectangle to mark on the stick diagram. This includes not only the information in the stk structure, but also the little stubs leading out from each of the transistors to connect to that structure.