-- 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];
[i,j]←TurnToStks[TRUE];
DoOutputs["wires3",i,j];
END;
AllocateStuffForPlace:PROCEDURE=BEGIN OPEN SystemDefs;
rejectWireList←AllocateSegment[SIZE[rejectWireListArray]];
hopperList←AllocateSegment[SIZE[hopperListArray]];
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
rejectWireList[topRejectWire]←w;
topRejectWire←topRejectWire+1;
IF topRejectWire>maxRejectWire THEN Error;
END;

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

PlaceSimpleWires:PROCEDURE[print:BOOLEAN]=
BEGIN InitSegs[];
EnumerateWires[PlaceOneWire];
IF print THEN BEGIN
PrintSegs[];
debugPrint←TRUE;
EnumerateGrid[PrintOrientations];
debugPrint←FALSE
END;
END;

PlaceOneWire:PROCEDURE[wire:WirePtr]=
BEGIN BackwardRun[wire,ForwardRun[wire]]; END;

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

OneNode:PROCEDURE[n:NodePtr]RETURNS[BOOLEAN]=
BEGIN RETURN[n.hop>maxLength OR EnumerateFollow[n,OnePlace]]; END;
OnePlace:PROCEDURE[n:NodePtr,s:SegPtr,level:BOOLEAN]RETURNS[BOOLEAN]=
BEGIN
done←AddHopper[s,n.hop+1,n,TRUE,level];
IF IllegalNode[done] THEN Error;
RETURN[done#NIL];
END;
SetEnd:PROCEDURE[s:SegPtr, c: Contact]RETURNS[BOOLEAN]=
BEGIN
done←AlsoAdd[s,none,terminalHop];
done.contact←c;
IF IllegalNode[done] THEN Error;
RETURN[done#NIL];
END;
SetStart:PROCEDURE[s:SegPtr, c: Contact]RETURNS[BOOLEAN]=
BEGIN
done←AlsoAdd[s,none,0];
done.contact←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]RETURNS[done:NodePtr]=BEGIN
level:BOOLEAN←s.xy.l;
IF s=NIL OR s.dummy AND t=n THEN RETURN[NIL];
done←AddHopper[s,h,NIL,TRUE,level];
IF t=none AND ~s.dummy AND ~s.nc THEN RETURN;
IF done=NIL AND (t=s OR t=f) AND ~s.bc AND ~s.dummy
THEN done←AddHopper[s.back,h,NIL,FALSE,level];
IF done=NIL AND t#n AND s.bc THEN done←AlsoAdd[s.back,b,h];
IF done=NIL AND t#b AND s.nc THEN done←AlsoAdd[s.next,n,h];
IF done=NIL AND t#s AND ~s.dummy THEN done←AlsoAdd[s.first,f,h];
IF done=NIL AND t#f AND ~s.dummy THEN done←AlsoAdd[s.second,s,h];
IF done=NIL AND t#a AND ~s.dummy THEN done←AlsoAdd[s.across,a,h];
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] UNTIL n=NIL DO
where←SetSeg[from:n,col:color,circuit:w.circuit,old:where,
tieN:~free AND ~down, tieB:~free AND down];
free ← TRUE
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]
RETURNS[NodePtr]=BEGIN
i:INTEGER; t:NodePtr;
IF s.w=l OR s.w=d THEN RETURN[NIL];
IF ~s.dummy AND s.xy.l#l THEN BEGIN Error; RETURN[NIL]; END;
FOR i IN [0..hopperInsert) DO
t←@hopperList[i];
IF s=t.s AND l=t.l
THEN BEGIN IF t.hop=terminalHop AND h#terminalHop
THEN t.back←bk ELSE t←NIL; RETURN[t]; END;
ENDLOOP;
t←AddToHopper[];
t↑←[s:s,hop:h,back:bk,normal:nor,movingLD:LD[bk.s,s],l:l, contact: none];
RETURN[NIL];
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 ///////

followAns:ARRAY[0..20) OF SegPtr;
topAns:INTEGER;

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
IF v.across#NIL THEN BEGIN
IF ~(v.dummy AND (n.l OR v.across.dummy)) THEN v←v.across;
EXIT;
END;
IF v.dummy THEN Error;
ENDLOOP;
RETURN[call[n,v,~n.l]];
END;

home:Where;
homeL:BOOLEAN;

StartFollow:PROCEDURE[n:NodePtr]=BEGIN
w,t:SegPtr←NIL;
s:SegPtr←n.s;
ld:BOOLEAN←n.movingLD;
IF s=NIL THEN BEGIN Error; RETURN; END;
home←s.xy;
homeL←n.l;
topAns←0;
IF n.hop=0 THEN BEGIN F1B[s.first]; F1B[s.second]; RETURN; END;
IF homeL AND s.dummy AND s.ac THEN FOR t←s.across,t.next DO
IF t.first#NIL
THEN IF t.second#NIL THEN RETURN ELSE w←t.first
ELSE IF t.second#NIL THEN w←t.second ELSE IF t.nc THEN LOOP;
IF w=NIL AND ~t.nc THEN EXIT;
IF w#NIL AND ld#LDOk[t,w] THEN RETURN;
IF ~t.nc THEN BEGIN F1B[w]; RETURN; END;
ENDLOOP;
IF s.nc AND ~(homeL AND s.dummy) THEN FOR t←s.next,t.next DO
IF t.first#NIL
THEN IF t.second#NIL THEN RETURN ELSE w←t.first
ELSE IF t.second#NIL THEN w←t.second ELSE IF t.nc THEN LOOP;
IF w=NIL AND ~t.nc THEN EXIT;
IF w#NIL AND ld#LDOk[t,w] THEN RETURN;
IF ~t.nc THEN BEGIN F1B[w]; RETURN; END;
ENDLOOP;
IF s.first#NIL AND s.second#NIL OR ~s.bc THEN BEGIN
F1B[IF ld=LDOk[s,s.first] THEN s.first ELSE s.second]; RETURN; END;
FOR t←s,IF homeL AND t.dummy THEN t.across ELSE t.back DO
w←t.first; IF w#NIL AND ld=LDOk[t,w] THEN EXIT;
w←t.second; IF w#NIL AND ld=LDOk[t,w] THEN EXIT;
IF t=NIL THEN BEGIN Error; RETURN; END;
ENDLOOP;
F1B[w];
END;

F1B:PROCEDURE[m:SegPtr]=BEGIN
t:BOOLEAN; s,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;
t←Right[m];
AddFollow[IF t THEN m ELSE IF m.dummy AND homeL THEN m.across ELSE m.back];
IF c=2 THEN EXIT;
k←IF m.dummy AND homeL THEN m.across ELSE IF t THEN m.next ELSE m.back;
FOR s←k,IF t THEN s.next ELSE s.back
UNTIL TowardHome[m←s.first] OR TowardHome[m←s.second] DO ENDLOOP;
ENDLOOP;
END;

LD:PROCEDURE[a,b:SegPtr] RETURNS[BOOLEAN]=
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]=
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
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
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;
topAns←topAns+1;
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.