-- 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
EXPORTS WiresDefs =BEGIN OPEN WiresDefs;

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

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

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

Go:PROCEDURE=BEGIN
i,j: INTEGER;
circuitName: STRING ←[30];
GetInput[TRUE,circuitName];
MakeWireList[TRUE];
InitRejectWires[];
PlaceSimpleWires[TRUE];
IF topRejectWire>0 THEN Error;
[i,j]←GenerateCoordinates[];
RecoverStorage[];
DoOutputs[circuitName,i,j];
END;

RecoverStorage: PROCEDURE= BEGIN
RecoverStuffInCreate[];
RecoverStuffInPlace[];
RecoverStuffInSeg[];
END;

RecoverStuffInPlace: PROCEDURE = BEGIN OPEN SystemDefs;
FreeSegment[rejectWireList];
rejectWireList←NIL;
FreeSegment[hopperList];
hopperList←NIL;
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;
PlotSegs[];
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
Error;
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
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;


SetSeg:PUBLIC PROCEDURE[from:NodePtr,col:Color,circuit: Circuit,
old:SegPtr,tieN,tieB:BOOLEAN]
RETURNS[SegPtr]=BEGIN
this:SegPtr←AddToSeg[];
back:SegPtr←from.s;
t,extra,next:SegPtr;
forward: BOOLEAN;
myLevel:BOOLEAN←from.l;
backAcross,nextAcross, tieExists, tieForward :BOOLEAN;
IF from=NIL THEN Error;
IF IllegalSeg[back] THEN Error;
this.c←IF myLevel THEN b ELSE col;
this.circuit←circuit;
this.xy←back.xy;
this.xy.l←myLevel;
-- set the next and back pointers
IF (backAcross←back.xy.l#myLevel) THEN BEGIN
IF ~back.dummy THEN Error;-- should be true only if back is a dummy
next←back.across;
back.across←this;
END ELSE BEGIN
next←back.next;
back.next←this;
END;
this.next←next; IF next=NIL THEN Error; -- remove these traps soon
this.back←back; IF back=NIL THEN Error;
IF (nextAcross←next.xy.l#myLevel) THEN next.across←this
ELSE next.back←this;
-- Now decide who’s electrically connected.
tieExists←IF backAcross THEN back.ac ELSE back.nc;
-- this stuff with tieN and tieB should and can be easily eliminated.
IF tieExists OR tieN THEN BEGIN
this.nc←TRUE;
IF nextAcross THEN next.ac←TRUE
ELSE next.bc←TRUE;
END;
IF ~nextAcross AND this.circuit=next.circuit
THEN this.nc←next.bc←TRUE;
IF tieExists OR tieB THEN BEGIN
this.bc←TRUE;
IF backAcross THEN back.ac←TRUE
ELSE back.nc←TRUE;
END;
IF ~backAcross AND this.circuit=this.back.circuit
THEN this.bc←this.back.nc←TRUE;
-- Finally handle the across and first/second connections
IF old#NIL THEN BEGIN
IF old.xy.l=myLevel THEN BEGIN
IF this.xy#old.xy THEN BEGIN -- just hook up first and second
old.second←this;
this.first←old;
END
ELSE BEGIN -- we’re in a hairpin
FOR t←this.next,t.next UNTIL t=NIL DO -- which way ?
IF t=old THEN GOTO FoundIt;
REPEAT
FoundIt => tieForward←TRUE;
FINISHED =>tieForward←FALSE;
ENDLOOP;
IF tieForward THEN
FOR t←this,t.next UNTIL t=old DO
IF t.next=NIL THEN Error; -- just in case
t.nc← t.next.bc ←TRUE;
ENDLOOP
ELSE FOR t←this,t.back UNTIL t=old DO
IF t.back=NIL THEN Error; -- just in case
t.bc← t.back.nc ←TRUE;
ENDLOOP;
END;
END -- of the code handling the case when we stay on one level.
ELSE IF ~old.dummy THEN BEGIN -- change levels
IF old.across#NIL THEN BEGIN -- old already crosses once
extra←AddToSeg[];-- so add an extra segment
extra.xy←old.xy;
extra.c←old.c;
extra.circuit←old.circuit;
-- decide which side it belongs on
forward←TRUE;
FOR t←this.next,t.next UNTIL t.dummy DO
IF old.across=t THEN BEGIN
forward←FALSE; EXIT; END;
ENDLOOP;
IF forward THEN BEGIN -- add extra on the next side of old
extra.next←old.next;
IF old.next.xy.l#old.xy.l THEN
old.next.across←extra
ELSE old.next.back←extra;
extra.back←old;
old.next←extra;
extra.bc←old.nc←TRUE;
END ELSE BEGIN -- add extra on the back side of old
extra.back←old.back;
IF old.back.xy.l#old.xy.l THEN
old.back.across←extra
ELSE old.back.next←extra;
extra.next←old;
old.back←extra;
extra.nc←old.bc←TRUE;
END;
old←extra;
END;
old.across←this;
this.across←old;
END;
END;
RETURN[this];
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=6*maxSide*maxSide;
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 DECREASING 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 (IF v.dummy AND ~n.l THEN ~v.ac ELSE ~v.nc) THEN
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;

homeSeg: SegPtr;
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;
blocked: BOOLEAN← s.nc;
-- see if there are any legal hairpin turns.
IF ~s.nc THEN FOR t←IF s.dummy AND n.l THEN s.across ELSE s.next,
t.next DO --
IF t=NIL OR t.nc THEN EXIT; -- cant hop over dummies or "next"s
w←t.first; IF w#NIL AND choice=LDOk[t,w] THEN EXIT; -- blocked
w←t.second; IF w#NIL AND choice=LDOk[t,w] THEN EXIT;
IF t.across=NIL THEN Error;
AddFollow[t]; -- assert: t is at a change of level
ENDLOOP;
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;
IF ~blocked AND ~t.bc THEN BEGIN
IF t.across=NIL THEN Error;
AddFollow[t.back];
END ELSE blocked←TRUE;
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;
homeSeg←s;
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 homeL AND s.dummy THEN IF s.ac THEN RETURN ELSE NULL
ELSE IF s.nc 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=homeSeg 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.