--routePaths2.mesa

DIRECTORY  RouteDefs;

RoutePaths2:PROGRAM IMPORTS RouteDefs EXPORTS RouteDefs=BEGIN
OPEN RouteDefs;

Error:SIGNAL=CODE;

hot:PlaceListPtr←NIL;
places:PlaceListPtr←NIL;--all the corners
saves:PlaceListPtr←NIL;--middles for this circuit
thisCircuit:Circuit←0;

ChannelLevelRouting:PUBLIC CtlProc=BEGIN
ShowLabel["PATH"];
ScavengePaths;
IF places#NIL THEN {Error; places←NIL};
EnumerateRectangles[AddFourPlaces];
EnumerateRectangles[AddLimitPointers];
ShowPlaces[];
DoCircuits;
ScavengePlaces;
CheckPaths;
RETURN[-1];
END;

ScavengePaths:PROCEDURE=BEGIN
UNTIL paths=NIL DO
  p:PathwayListPtr←paths;
  paths←p.t;
  UNTIL p.h.path=NIL DO
    q:PathListPtr←p.h.path;
    p.h.path←q.t; FreePath[q.h]; FreeList[q];
    ENDLOOP;
  FreePathway[p.h];
  FreeList[p];
  ENDLOOP;
END;

AddLimitPointers:PROCEDURE[rect:RectanglePtr]=BEGIN
SELECT rect.orient FROM hor,vert=>NULL; ENDCASE=>RETURN;
BEGIN
x1:Lambda=rect.pos.x;
x2:Lambda=rect.pos.x+rect.sizeL.x;
y1:Lambda=rect.pos.y;
y2:Lambda=rect.pos.y+rect.sizeL.y;
FOR pl:PlaceListPtr←places, pl.t UNTIL pl=NIL DO
  p:PlacePtr=pl.h;
  IF rect.orient =hor
    THEN IF p.pos.y=y1 OR p.pos.y=y2 THEN
        {IF p.pos.x#x1 THEN p.uw←rect; IF p.pos.x#x2 THEN p.ue←rect}
    ELSE IF p.pos.x=x1 OR p.pos.x=x2 THEN
        {IF p.pos.y#y1 THEN p.us←rect; IF p.pos.y#y2 THEN p.un←rect};
  ENDLOOP;
END; END;

AddFourPlaces:PROCEDURE[rect:RectanglePtr]=BEGIN
WestSide:PROCEDURE[y:Lambda,yes:BOOLEAN←FALSE]=BEGIN
  IF ~(yes OR y IN (pos.y..pos.y+size.y)) THEN RETURN;
  new←AddPlace[pos.x,y];
  IF this#NIL AND new#NIL THEN {this.n←new; new.s←this};
  IF new#NIL THEN new.perm←TRUE;
  this←new;
  END; 
NorthSide:PROCEDURE[x:Lambda,yes:BOOLEAN←FALSE]=BEGIN
  IF ~(yes OR x IN (pos.x..pos.x+size.x)) THEN RETURN;
  new←AddPlace[x,pos.y+size.y];
  IF this#NIL AND new#NIL THEN {this.e←new; new.w←this};
  IF new#NIL THEN new.perm←TRUE;
  this←new;
  END; 
EastSide:PROCEDURE[y:Lambda,yes:BOOLEAN←FALSE]=BEGIN
  IF ~(yes OR y IN (pos.y..pos.y+size.y)) THEN RETURN;
  new←AddPlace[pos.x+size.x,y];
  IF this#NIL AND new#NIL THEN {this.s←new; new.n←this};
  IF new#NIL THEN new.perm←TRUE;
  this←new;
  END; 
SouthSide:PROCEDURE[x:Lambda,yes:BOOLEAN←FALSE]=BEGIN
  IF ~(yes OR x IN (pos.x..pos.x+size.x)) THEN RETURN;
  new←AddPlace[x,pos.y];
  IF this#NIL AND new#NIL THEN {this.w←new; new.e←this};
  IF new#NIL THEN new.perm←TRUE;
  this←new;
  END; 
pos:CoordL=rect.pos;
size:CoordL=rect.sizeL;
this,save,new:PlacePtr←NIL;
f:RectanglePtr←NIL;
WestSide[pos.y,TRUE];
save←this;
IF (f←rect.w)#NIL THEN {WestSide[f.pos.y]; WestSide[f.pos.y+f.sizeL.y]};
WestSide[pos.y+size.y,TRUE];
IF (f←rect.n)#NIL THEN {NorthSide[f.pos.x]; NorthSide[f.pos.x+f.sizeL.x]};
NorthSide[pos.x+size.x,TRUE];
IF (f←rect.e)#NIL THEN {EastSide[f.pos.y+f.sizeL.y]; EastSide[f.pos.y]};
EastSide[pos.y,TRUE];
IF (f←rect.s)#NIL THEN {SouthSide[f.pos.x+f.sizeL.x]; SouthSide[f.pos.x]};
IF this#NIL AND save#NIL THEN {this.w←save; save.e←this};
END;

AddPlace:PROCEDURE[x,y:Lambda] RETURNS[p:PlacePtr]=BEGIN
pl:PlaceListPtr;
IF x NOT IN (0..problem.chipSize.x) THEN RETURN[NIL];
IF y NOT IN (0..problem.chipSize.y) THEN RETURN[NIL];
FOR pl←places, pl.t UNTIL pl=NIL
  DO p←pl.h; IF p.pos.x=x AND p.pos.y=y THEN RETURN; ENDLOOP;
FOR pl←saves, pl.t UNTIL pl=NIL
  DO p←pl.h; IF p.pos.x=x AND p.pos.y=y THEN RETURN; ENDLOOP;
p←AllocatePlace[];
pl←AllocateList[];
p.pos←[x,y];
pl↑←[p,places];
places←pl;
END;

ShowPlaces:PROCEDURE=BEGIN
ShowLabel["PLACES"];
FOR pl:PlaceListPtr←places, pl.t UNTIL pl=NIL DO ShowAPlace[pl.h]; ENDLOOP;
FOR pl:PlaceListPtr←saves, pl.t UNTIL pl=NIL DO ShowAPlace[pl.h]; ENDLOOP;
END;

ShowAPlace:PROCEDURE[p:PlacePtr]=BEGIN
Return[];
ShowPoint[p.pos];
ShowString[" n= "];
IF p.n = NIL THEN ShowString["none"] ELSE ShowPoint[p.n.pos];
ShowString[" s= "];
IF p.s = NIL THEN ShowString["none"] ELSE ShowPoint[p.s.pos];
ShowString[" e= "];
IF p.e = NIL THEN ShowString["none"] ELSE ShowPoint[p.e.pos];
ShowString[" w= "];
IF p.w = NIL THEN ShowString["none"] ELSE ShowPoint[p.w.pos];
END;

DoCircuits:PROCEDURE=BEGIN
FOR circuit:Circuit←1,circuit+1 DO
  IF allPaths#NIL THEN {Error; allPaths←NIL};
  thisCircuit←circuit;
  InitializePlaces[];
  hot←saves←NIL;
  circuitCount←0;
  EnumerateRectangles[InitializeHot];
  IF circuitCount=0 THEN EXIT;
  IF circuitCount<2 THEN Error ELSE BEGIN
  pathway:PathwayPtr←AllocatePathway[];
  pwl:PathwayListPtr←AllocateList[];
  pathway↑←[circuit,NIL];
  pwl↑←[pathway,paths];
  paths←pwl;
  Return[];
  UNTIL circuitCount<2 OR hot=NIL DO GoPlace[]; ENDLOOP;
  SetAboveAndBelowAndUsed[];
  SetHiAndLo[];
  MakePathFromLinks[];
  --ShowPath[];
  IF allPaths#NIL THEN ReducePath[];
  ShowPath[];
  pathway.path←allPaths;
  allPaths←NIL;
  ScavengeHot[]; --leaves hot nil
  ScavengeSaves[]; --leaves saves nil
  ScavengeLinks[]; --leaves links nil
  END; ENDLOOP;
END;

ScavengeHot:PROCEDURE=BEGIN
UNTIL hot=NIL DO
  pl:PlaceListPtr←hot;
  hot←pl.t;
  FreeList[pl];
  ENDLOOP;
END;

ScavengeSaves:PROCEDURE=BEGIN
UNTIL saves=NIL DO
  pl:PlaceListPtr←saves;
  p:PlacePtr←pl.h;
  saves←pl.t;
  IF p.e#NIL THEN p.e.w←p.w;
  IF p.w#NIL THEN p.w.e←p.e;
  IF p.n#NIL THEN p.n.s←p.s;
  IF p.s#NIL THEN p.s.n←p.n;
  FreePlace[p];
  FreeList[pl];
  ENDLOOP;
END;

ShowPoint:PROCEDURE[a:CoordL]={WritePoint[a.x,a.y]};

ScavengePlaces:PROCEDURE=BEGIN
UNTIL places=NIL DO
  pl:PlaceListPtr←places;
  places←pl.t;
  FreePlace[pl.h];
  FreeList[pl];
  ENDLOOP;
END;

InitializePlaces:PROCEDURE=BEGIN
FOR pl:PlaceListPtr←places, pl.t UNTIL pl=NIL DO
  p:PlacePtr=pl.h;
  p.score←bigLambda; p.back←NIL; p.circuit←0; p.done←FALSE;
  ENDLOOP;
END;

InitializeHot:PROCEDURE[rect:RectanglePtr]=BEGIN
--for each source this circuit, if not on grid add to grid (removably)
--  and set score to zero
circuit:Circuit=thisCircuit;
x1:Lambda=rect.pos.x;
x2:Lambda=x1+rect.sizeL.x;
y1:Lambda=rect.pos.y;
y2:Lambda=y1+rect.sizeL.y;
hor:BOOLEAN=rect.orient=hor;
FOR el:EventListPtr←rect.events, el.t UNTIL el=NIL DO
    e:EventPtr=el.h;
    IF e.circuit#circuit THEN LOOP;
    circuitCount←circuitCount+1;
    BEGIN
    onNS:BOOLEAN=(e.side=n OR e.side=s);
    top:Lambda=IF onNS THEN rect.sizeL.x ELSE rect.sizeL.y;
    off:Lambda=MIN[top-1,MAX[1,e.offset]];
    thisPos:CoordL=IF onNS THEN [x1+off,y1] ELSE [x1,y1+off];
    otherPos:CoordL=IF onNS THEN [x1+off,y2] ELSE [x2,y1+off];
    useOther:BOOLEAN=SELECT e.where FROM top,right=>hor,
                  ENDCASE=>NOT hor;
    myPos:CoordL=IF useOther THEN otherPos ELSE thisPos;
    myPlace:PlacePtr=FindPlace[myPos];
    IF myPlace#NIL
      THEN {myPlace.score←0; myPlace.circuit←e.net.netNo; LOOP};
    BEGIN
    saveList:PlaceListPtr=AllocateList[];
    hotList:PlaceListPtr=AllocateList[];
    save2List:PlaceListPtr=AllocateList[];
    this:PlacePtr=AllocatePlace[];
    other:PlacePtr=AllocatePlace[];
    mine:PlacePtr=IF useOther THEN other ELSE this;
    this.pos←thisPos;
    other.pos←otherPos;
    this.score←other.score←bigLambda;
    mine.score←0; mine.circuit←e.net.netNo;
    IF onNS THEN BEGIN
      this.n←other; other.s←this;
      this.w←AddPlace2[x1,y1,this]; IF this.w#NIL THEN this.w.e←this;
      this.e←AddPlace2[x2,y1,this]; IF this.e#NIL THEN this.e.w←this;
      other.w←AddPlace2[x1,y2,other]; IF other.w#NIL THEN other.w.e←other;
      other.e←AddPlace2[x2,y2,other]; IF other.e#NIL THEN other.e.w←other;
      this.ue←IF this.e=NIL THEN NIL ELSE this.e.uw;
      this.uw←IF this.w=NIL THEN NIL ELSE this.w.ue;
      other.ue←IF other.e=NIL THEN NIL ELSE other.e.uw;
      other.uw←IF other.w=NIL THEN NIL ELSE other.w.ue;
      END
    ELSE BEGIN
      this.w←other; other.e←this;
      this.s←AddPlace2[x1,y1,this]; IF this.s#NIL THEN this.s.n←this;
      this.n←AddPlace2[x1,y2,this]; IF this.n#NIL THEN this.n.s←this;
      other.s←AddPlace2[x2,y1,other]; IF other.s#NIL THEN other.s.n←other;
      other.n←AddPlace2[x2,y2,other]; IF other.n#NIL THEN other.n.s←other;
      this.un←IF this.n=NIL THEN NIL ELSE this.n.us;
      this.us←IF this.s=NIL THEN NIL ELSE this.s.un;
      other.un←IF other.n=NIL THEN NIL ELSE other.n.us;
      other.us←IF other.s=NIL THEN NIL ELSE other.s.un;
      END;
    hotList↑←[mine,hot];
    hot←hotList;
    saveList↑←[this,saves];
    save2List↑←[other,saveList];
    saves←save2List;
    END; END; ENDLOOP;
END;

FindPlace:PROCEDURE[w:CoordL] RETURNS[p:PlacePtr]=BEGIN
FOR pl:PlaceListPtr←places, pl.t UNTIL pl=NIL
  DO p←pl.h; IF p.pos=w THEN RETURN[p]; ENDLOOP;
FOR pl:PlaceListPtr←saves, pl.t UNTIL pl=NIL
  DO p←pl.h; IF p.pos=w THEN RETURN[p]; ENDLOOP;
RETURN[NIL];
END;

AddPlace2:PROCEDURE[x,y:Lambda,new:PlacePtr] RETURNS[pp:PlacePtr]=BEGIN
pp←AddPlace[x,y];
FOR hl:PlaceListPtr←saves,hl.t UNTIL hl=NIL DO
  hhh:PlacePtr←hl.h;
  IF new.pos.x=x AND hhh.pos.x=x AND Between[hhh.pos.y,new.pos.y,y]
   OR new.pos.y=y AND hhh.pos.y=y AND Between[hhh.pos.x,new.pos.x,x]
     THEN {pp←hhh; x←pp.pos.x; y←pp.pos.y};
  ENDLOOP;
FOR hl:PlaceListPtr←places,hl.t UNTIL hl=NIL DO
  hhh:PlacePtr←hl.h;
  IF new.pos.x=x AND hhh.pos.x=x AND Between[hhh.pos.y,new.pos.y,y]
   OR new.pos.y=y AND hhh.pos.y=y AND Between[hhh.pos.x,new.pos.x,x]
     THEN {pp←hhh; x←pp.pos.x; y←pp.pos.y};
  ENDLOOP;
END;

Between:PROCEDURE[a,b,c:Lambda] RETURNS[BOOLEAN]=BEGIN
RETURN[IF b<c THEN a IN (b..c) ELSE a IN (c..b)];
END;

circuitCount:INTEGER;

GoPlace:PROCEDURE=BEGIN
bestScore:Lambda←bigLambda;
best,back:PlacePtr←NIL;
next,prev:PlaceListPtr←NIL;
FOR hl:PlaceListPtr←hot,next UNTIL hl=NIL DO
  h:PlacePtr←hl.h;
  live:BOOLEAN←FALSE;
  Try:PROCEDURE[t:PlacePtr,s:Lambda]=BEGIN
    thisScore:Lambda←h.score+ABS[s];
    IF t.circuit=h.circuit THEN RETURN;
    IF thisScore<bestScore
      THEN {bestScore←thisScore; best←t; back←h};
    live←TRUE;
    END;
  Goable:PROCEDURE[w:PlacePtr,z:BOOLEAN,s:RectanglePtr]=BEGIN
    IF w=NIL THEN RETURN ELSE BEGIN
    l:Lambda=IF z THEN w.pos.y-h.pos.y ELSE w.pos.x-h.pos.x;
    IF s=NIL OR s.used<s.avail THEN Try[w,l];
    END; END;
  Goable[h.n,TRUE ,h.un];
  Goable[h.s,TRUE ,h.us];
  Goable[h.e,FALSE,h.ue];
  Goable[h.w,FALSE,h.uw];
  next←hl.t;
  IF ~live THEN {IF prev=NIL THEN hot←next ELSE prev.t←next; FreeList[hl]}
    ELSE prev←hl;
  ENDLOOP;
IF best=NIL THEN {Log[]; RETURN};
IF best.score=bigLambda THEN BEGIN
  temp:PlaceListPtr←AllocateList[];
  temp↑←[best,hot];
  hot←temp;
  best.score←bestScore;
  best.back←back;
  best.circuit←back.circuit;
  END
ELSE BEGIN
  FOR pl:PlacePtr←best, pl.back UNTIL pl.back=NIL OR pl.done DO
    AddPath[pl,pl.back]; pl.done←TRUE; --wierd
    ENDLOOP;
  FOR pl:PlacePtr←back, pl.back UNTIL pl.back=NIL OR pl.done DO
    AddPath[pl,pl.back]; pl.done←TRUE;
    ENDLOOP;
  AddPath[best,back];
  from←back.circuit;
  to←best.circuit;
  ChangeCircuit[back];
  FOR zz:PlaceListPtr←saves,zz.t UNTIL zz=NIL DO
    IF zz.h.circuit=from THEN zz.h.circuit←to; ENDLOOP;
  circuitCount←circuitCount-1;
  END;
END;

AddPath:PROCEDURE[a,b:PlacePtr]=BEGIN
vert:BOOLEAN=a.pos.x=b.pos.x;
hor:BOOLEAN=a.pos.y=b.pos.y;
gridlink:GridPtr←AllocateGrid[];
gridlist:GridListPtr←AllocateList[];
IF hor=vert THEN Error;
IF IF vert THEN a.pos.y>b.pos.y ELSE a.pos.x>b.pos.x
   THEN {t:PlacePtr←a; a←b; b←t};
gridlink.a←a; gridlink.b←b; gridlink.hor←hor;
gridlist↑←[gridlink,links];
links←gridlist;
DebugPath[a,b];
END;

-- PROCESS GRID

links:GridListPtr←NIL;

ScavengeLinks:PROCEDURE=BEGIN
UNTIL links=NIL DO
  pl:GridListPtr←links;
  links←pl.t;
  FreeGrid[pl.h];
  FreeList[pl];
  ENDLOOP;
END;

DoUsed:PROCEDURE[r:RectanglePtr]=BEGIN
IF r=NIL OR r.usedCircuit=thisCircuit THEN RETURN;
r.used←r.used+1;
IF r.used>r.avail THEN Log[];
r.usedCircuit←thisCircuit;
END;

SetAboveAndBelowAndUsed:PROCEDURE=BEGIN
FOR gl:GridListPtr←links,gl.t UNTIL gl=NIL DO
  grid:GridPtr=gl.h;
  a:PlacePtr=grid.a;
  hor:BOOLEAN=grid.hor;
  ax:Lambda←a.pos.x; ay:Lambda←a.pos.y;
  IF hor THEN {DoUsed[a.ue]; DoUsed[a.uw]} ELSE {DoUsed[a.un]; DoUsed[a.us]};
  IF hor THEN BEGIN
    FOR cl:RectangleListPtr←channels,cl.t UNTIL cl=NIL DO
      rect:RectanglePtr=cl.h;
      x1:Lambda=rect.pos.x;
      y1:Lambda=rect.pos.y;
      x2:Lambda=x1+rect.sizeL.x;
      y2:Lambda=y1+rect.sizeL.y;
      IF ax NOT IN [x1..x2) THEN LOOP;
      SELECT ay FROM
        y1 =>{grid.above.channel←rect; IF grid.below#nilG THEN EXIT};
        y2 =>{grid.below.channel←rect; IF grid.above#nilG THEN EXIT};
        IN (y1..y2)=>{grid.below.channel←grid.above.channel←rect; EXIT};
        ENDCASE;
      ENDLOOP;
    FOR il:RectangleListPtr←inters,il.t UNTIL il=NIL DO
      rect:RectanglePtr=il.h;
      x1:Lambda=rect.pos.x;
      y1:Lambda=rect.pos.y;
      x2:Lambda=x1+rect.sizeL.x;
      y2:Lambda=y1+rect.sizeL.y;
      IF ax NOT IN [x1..x2) THEN LOOP;
      SELECT ay FROM
        y1 =>{grid.above.inter←rect; IF grid.below#nilG THEN EXIT};
        y2 =>{grid.below.inter←rect; IF grid.above#nilG THEN EXIT};
        ENDCASE;
      ENDLOOP;
    END ELSE BEGIN
    FOR cl:RectangleListPtr←channels,cl.t UNTIL cl=NIL DO
      rect:RectanglePtr=cl.h;
      x1:Lambda=rect.pos.x;
      y1:Lambda=rect.pos.y;
      x2:Lambda=x1+rect.sizeL.x;
      y2:Lambda=y1+rect.sizeL.y;
      IF ay NOT IN [y1..y2) THEN LOOP;
      SELECT ax FROM
        x2 =>{grid.above.channel←rect; IF grid.below#nilG THEN EXIT};
        x1 =>{grid.below.channel←rect; IF grid.above#nilG THEN EXIT};
        IN (x1..x2)=>{grid.below.channel←grid.above.channel←rect; EXIT};
        ENDCASE;
      ENDLOOP;
    FOR il:RectangleListPtr←inters,il.t UNTIL il=NIL DO
      rect:RectanglePtr=il.h;
      x1:Lambda=rect.pos.x;
      y1:Lambda=rect.pos.y;
      x2:Lambda=x1+rect.sizeL.x;
      y2:Lambda=y1+rect.sizeL.y;
      IF ay NOT IN [y1..y2) THEN LOOP;
      SELECT ax FROM
        x2 =>{grid.above.inter←rect; IF grid.below#nilG THEN EXIT};
        x1 =>{grid.below.inter←rect; IF grid.above#nilG THEN EXIT};
        ENDCASE;
      ENDLOOP;
    END;
  ENDLOOP;
END;

SetHiAndLo:PROCEDURE=BEGIN
FOR gl:GridListPtr←links,gl.t UNTIL gl=NIL DO
    grid:GridPtr=gl.h;
    grid.hi←grid.above=nilG;
    grid.lo←grid.below=nilG;
    IF grid.hi AND grid.lo THEN Log[];
    ENDLOOP;
SimpleStraightCase[];
DO
  progress:BOOLEAN←FALSE;
  FOR gl:GridListPtr←links,gl.t UNTIL gl=NIL DO
    grid:GridPtr=gl.h;
    IF ~grid.hi AND ~grid.lo THEN BEGIN
      IF grid.above.channel=NIL THEN grid.hi←TRUE ELSE grid.lo←TRUE;
      progress←TRUE;
      SimpleStraightCase[];
      END;
    ENDLOOP;
  IF ~progress THEN EXIT;
  ENDLOOP;
FOR gl:GridListPtr←links,gl.t UNTIL gl=NIL DO
  grid:GridPtr=gl.h;
  IF grid.hi = grid.lo THEN Log[];
  ENDLOOP;
END;

SimpleStraightCase:PROCEDURE=BEGIN
DO
  progress:BOOLEAN←FALSE;
  FOR gl:GridListPtr←links,gl.t UNTIL gl=NIL DO
    grid:GridPtr=gl.h;
    an1,an2,an3,bn1,bn2,bn3,try:GridPtr;
    hi:BOOLEAN=grid.hi;
    lo:BOOLEAN=grid.lo;
    IF hi OR lo THEN LOOP;
    [an1,an2,an3,bn1,bn2,bn3]←Neighbors[grid];
    SELECT TRUE FROM
      an2=NIL AND an1#NIL AND an1.hor=grid.hor=>try←an1;
      bn2=NIL AND bn1#NIL AND bn1.hor=grid.hor=>try←bn1;
      ENDCASE=>LOOP;
    SELECT TRUE FROM
      try.hi =>grid.hi←progress←TRUE;
      try.lo =>grid.lo←progress←TRUE;
      ENDCASE
    ENDLOOP;
  IF ~progress THEN EXIT;
  ENDLOOP;
END;

MakePathFromLinks:PROCEDURE=BEGIN
path1,path2:PathPtr;
IF links=NIL THEN RETURN;
[path1,,]←Foo[FALSE,links.h];
[path2,,]←Foo[TRUE,links.h];
Tie[path1,path2,IF links.h.hor THEN e ELSE n];
END;

Foo:PROCEDURE[bEnd:BOOLEAN,key:GridPtr]
    RETURNS[path:PathPtr,orient:Side,hi:BOOLEAN]=BEGIN
eee:Side=IF key.hor THEN IF bEnd THEN e ELSE w ELSE IF bEnd THEN n ELSE s;
www:Side=IF key.hor THEN IF bEnd THEN w ELSE e ELSE IF bEnd THEN s ELSE n;
sss:Side=IF key.hor THEN s ELSE e;
nnn:Side=IF key.hor THEN n ELSE w;
rev:BOOLEAN=key.hor=bEnd;
north:Side=IF key.hi THEN nnn ELSE sss;
Bungle2:PROCEDURE=BEGIN
  IF rev=hi1 OR orient1=eee
  THEN SELECT TRUE FROM
    orient1=eee AND hi1=hi=> Tie[path,path1,eee];
    orient1#eee AND orient1#north=> Tie[path,path1,eee];
    orient1#eee=>Corner[key,path,path1,eee,orient1];
    ENDCASE=>Corner[key,path,path1,eee,north]
  ELSE SELECT TRUE FROM
    orient1#north=> Tie[path,path1,eee];
    ENDCASE=>Tie[Extend[eee,path,link],path1,orient1];
  END;
Bungle3:PROCEDURE=BEGIN
  swap:BOOLEAN=orient2=eee OR orient1=sss;
  IF orient1=orient2 THEN Error;
  IF swap THEN BEGIN
      {t:PathPtr←path1; path1←path2; path2←t};
      {t:Side←orient1; orient1←orient2; orient2←t};
      {t:BOOLEAN←hi1; hi1←hi2; hi2←t};
      END;
  BEGIN
  sh:BOOLEAN=(orient2=sss)=hi;
  hb2:BOOLEAN=(hi2=rev);
  nn:Side←IF orient2=sss THEN nnn ELSE sss;
  ss:Side←IF orient2=sss THEN sss ELSE nnn;
  IF orient1=eee THEN SELECT TRUE FROM
    (hi=hi1) AND hb2=>{Tie[path,path1,eee]; Tie[path2,path1,nn]};
    (hi=hi1) AND ~hb2=>{Tie[path,path1,eee]; Tie[path2,path,nn]};
     sh AND  hb2=>{Tie[path,path2,eee]; Tie[path2,path1,nn]};
    ~sh AND ~hb2=>{Tie[path,path2,ss];  Tie[path2,path1,eee]};
     sh AND ~hb2=>{Tie[path,path2,ss];  Corner[key,path,path1,eee,nn]};
    ~sh AND  hb2=>{Tie[path1,path2,ss]; Corner[key,path,path1,eee,ss]};
    ENDCASE=>Error
  ELSE BEGIN
    Tie[path,IF hi THEN path2 ELSE path1,eee];
    SELECT TRUE FROM
      hi1=hi2=>Tie[path2,path1,nnn];
      ~hi AND  hb2=>Corner[key,path1,path2,eee,sss]; 
       hi AND ~hb2=>Corner[key,path2,path1,eee,nnn]; 
      ~hi AND ~hb2=>Tie[path,path2,sss]; 
       hi AND  hb2=>Tie[path,path1,nnn]; 
    ENDCASE=>Error;
    END;
  END; END;
Bungle4:PROCEDURE=BEGIN
  new:PathPtr;
  DO SELECT orient1 FROM
    nnn=>{IF orient2=sss THEN BEGIN
      {t:PathPtr←path3; path3←path2; path2←t};
      {t:Side←orient3; orient3←orient2; orient2←t};
      {t:BOOLEAN←hi3; hi1←hi3; hi2←t}; END; EXIT};
    sss=>BEGIN
      {t:PathPtr←path1; path1←path3; path3←t};
      {t:Side←orient1; orient1←orient3; orient3←t};
      {t:BOOLEAN←hi1; hi1←hi3; hi3←t};
      END;
    eee=>Error;
    ENDCASE=>BEGIN
      {t:PathPtr←path1; path1←path2; path2←t};
      {t:Side←orient1; orient1←orient2; orient2←t};
      {t:BOOLEAN←hi1; hi1←hi2; hi2←t};
      END;
    ENDLOOP;
  new←IF hi1 AND hi3 THEN path ELSE Extend[eee,path,link];
  Tie[IF hi3 THEN path2 ELSE new,path3,sss];
  Tie[IF hi1 THEN path2 ELSE new,path3,nnn];
  SELECT TRUE FROM
    hi=hi2=>Tie[new,path2,eee];
    hi AND hi3=>Tie[new,path3,eee];
    hi AND ~hi1=>Tie[path1,path2,eee];
    ~hi AND hi1=>Tie[new,path1,eee];
    ~hi AND ~hi3=>Tie[path3,path2,eee];
    ENDCASE=>Corner[key,new,path2,eee,IF hi THEN nnn ELSE sss];
  END;
link:Link=IF key.hi THEN key.below ELSE key.above;
an1,an2,an3,bn1,bn2,bn3:GridPtr;
hi1,hi2,hi3:BOOLEAN;
path1,path2,path3:PathPtr←NIL;
orient1,orient2,orient3:Side←x;
place:PlacePtr=IF bEnd THEN key.b ELSE key.a;
rect:RectanglePtr=IF link.channel#NIL THEN link.channel ELSE link.inter;
IF rect=NIL THEN RETURN[NIL,x,TRUE];
BEGIN
pos:CoordL=rect.pos;
size:CoordL=rect.sizeL;
entry:BOOLEAN←IF key.hor
    THEN place.pos.x IN (pos.x..pos.x+size.x-1)
    ELSE place.pos.y IN (pos.y..pos.y+size.y-1);
[an1,an2,an3,bn1,bn2,bn3]←Neighbors[key];
path←MakePath[link];
orient←eee;
hi←key.hi;
IF bEnd THEN BEGIN
  IF bn1#NIL THEN [path1,orient1,hi1]←Foo[key.b=bn1.a,bn1];
  IF bn2#NIL THEN [path2,orient2,hi2]←Foo[key.b=bn2.a,bn2];
  IF bn3#NIL THEN [path3,orient3,hi3]←Foo[key.b=bn3.a,bn3];
  END
ELSE BEGIN
  IF an1#NIL THEN [path1,orient1,hi1]←Foo[key.a=an1.a,an1];
  IF an2#NIL THEN [path2,orient2,hi2]←Foo[key.a=an2.a,an2];
  IF an3#NIL THEN [path3,orient3,hi3]←Foo[key.a=an3.a,an3];
  END;
IF path1#NIL AND orient1=www THEN Error;
IF path2#NIL AND orient2=www THEN Error;
IF path3#NIL AND orient3=www THEN Error;
SELECT TRUE FROM
  path1=NIL=>NULL;
  path2=NIL=>Bungle2[];
  path3=NIL=>Bungle3[];
  ENDCASE=>Bungle4[];
BEGIN
c:INTEGER←0;
IF path.n#NIL THEN c←c+1; IF path.s#NIL THEN c←c+1;
IF path.e#NIL THEN c←c+1; IF path.w#NIL THEN c←c+1;
IF c>1 THEN {new:PathPtr←MakePath[link]; Tie[new,path,eee]; path←new;};
IF entry OR key.above.channel#NIL AND key.above.channel=key.below.channel
  THEN MakeEntryX[path,link,IF entry THEN north ELSE eee,place];
c←0;
IF path.n#NIL THEN c←c+1; IF path.s#NIL THEN c←c+1;
IF path.e#NIL THEN c←c+1; IF path.w#NIL THEN c←c+1;
IF c>1 THEN {new:PathPtr←MakePath[link]; Tie[new,path,eee]; path←new};
END; END; END;

MakeEntryX:PROCEDURE[path:PathPtr,link:Link,d2:Side,place:PlacePtr]=BEGIN
source:PathPtr;
rect:RectanglePtr=IF link.channel#NIL THEN link.channel ELSE link.inter;
newEvent:EventPtr←FindEntry[rect,place];
IF newEvent=NIL THEN RETURN;
source←MakePath[nilG];
source.index←newEvent;
DO SELECT d2 FROM
  n=>IF path.n#NIL THEN path←path.n ELSE EXIT;
  s=>IF path.s#NIL THEN path←path.s ELSE EXIT;
  e=>IF path.e#NIL THEN path←path.e ELSE EXIT;
  ENDCASE=>IF path.w#NIL THEN path←path.w ELSE EXIT;
  ENDLOOP;
Tie[path,source,d2];
END;

FindEntry:PROCEDURE[rect:RectanglePtr,place:PlacePtr]
   RETURNS[EventPtr]=BEGIN
hor:BOOLEAN=rect.orient=hor;
posG:CoordL←[place.pos.x-rect.pos.x,place.pos.y-rect.pos.y];
where:Where=SELECT TRUE FROM
  posG.y=0 => IF hor THEN bottom ELSE left,
  posG.x=0 => IF hor THEN left ELSE top,
  posG.y=rect.sizeL.y => IF hor THEN top ELSE right,
  ENDCASE => IF hor THEN right ELSE bottom;
offset:Lambda←SELECT where FROM
   top,bottom=>IF hor THEN posG.x ELSE posG.y,
   ENDCASE=>IF ~hor THEN posG.x ELSE posG.y;
IF offset=1 THEN offset←0;
FOR el:EventListPtr←rect.events, el.t UNTIL el=NIL DO
  event:EventPtr=el.h;
  IF event.circuit=thisCircuit AND
    where=event.where AND offset=event.offset THEN RETURN[event]; 
  ENDLOOP;
RETURN[NIL];
END;

Corner:PROCEDURE[key:GridPtr,m,n:PathPtr,f,t:Side]=
BEGIN
bend:Link←Extendable[key,f,f,t];
IF bend#nilG THEN Tie[Extend[f,m,bend],n,t]
     ELSE Tie[Extend[t,m,Extendable[key,f,t,t]],n,f];
END;

Extendable:PROCEDURE[gl:GridPtr,d,f,t:Side] RETURNS[Link]=BEGIN
a:PlacePtr=SELECT d FROM e,n=>gl.b, ENDCASE=>gl.a;
pos:CoordL←a.pos;
SELECT d FROM
  e=>SELECT f FROM
     n=>pos.x←pos.x-1;
     s=>{pos.x←pos.x-1; pos.y←pos.y-1};
     e=>IF t=n THEN pos.y←pos.y-1;
     ENDCASE=>Error;
  n=>SELECT f FROM
     e=>pos.y←pos.y-1;
     w=>{pos.x←pos.x-1; pos.y←pos.y-1};
     n=>IF t=e THEN pos.x←pos.x-1;
     ENDCASE=>Error;
  w=>SELECT f FROM
     n=>NULL;
     s=>pos.y←pos.y-1;
     w=>{pos.x←pos.x-1; IF t=n THEN pos.y←pos.y-1};
     ENDCASE=>Error;
  s=>SELECT f FROM
     e=>NULL;
     w=>pos.x←pos.x-1;
     s=>{pos.y←pos.y-1; IF t=e THEN pos.x←pos.x-1};
     ENDCASE=>Error;
  ENDCASE=>Error;
SELECT d FROM e,w=>IF ~gl.hor THEN Error;
   ENDCASE=>IF gl.hor THEN Error;
FOR  cl:RectangleListPtr←channels,cl.t UNTIL cl=NIL DO
      rect:RectanglePtr=cl.h;
      IF pos.x IN [rect.pos.x..rect.pos.x+rect.sizeL.x)
       AND pos.y IN [rect.pos.y..rect.pos.y+rect.sizeL.y)
      THEN RETURN[[channel:rect,inter:NIL]];
      ENDLOOP;
FOR  il:RectangleListPtr←inters,il.t UNTIL il=NIL DO
      rect:RectanglePtr=il.h;
      IF pos.x IN [rect.pos.x..rect.pos.x+rect.sizeL.x)
       AND pos.y IN [rect.pos.y..rect.pos.y+rect.sizeL.y)
      THEN RETURN[[channel:NIL,inter:rect]];
      ENDLOOP;
RETURN[nilG];
END;

Tie:PROCEDURE[a,b:PathPtr,d:Side]=BEGIN
IF a.channel#NIL AND b.channel#NIL AND a.channel#b.channel THEN Log[];
SELECT d FROM
  n=>IF a.n#b.s THEN Log[]; s=>IF a.s#b.n THEN Log[];
  e=>IF a.e#b.w THEN Log[]; w=>IF a.w#b.e THEN Log[];
  ENDCASE=>Error;
SELECT d FROM
  n=>{a.n←b; b.s←a};  s=>{a.s←b; b.n←a};
  e=>{a.e←b; b.w←a};  w=>{a.w←b; b.e←a};
  ENDCASE=>Error;
END;

Extend:PROCEDURE[dir:Side,old:PathPtr,l:Link] RETURNS[new:PathPtr]=BEGIN
IF l=nilG THEN Error;
new←MakePath[l];
Tie[old,new,dir];
END;

pathNo:INTEGER←0;

MakePath:PROCEDURE[link:Link]
   RETURNS[path:PathPtr]=BEGIN
pathList:PathListPtr←AllocateList[];
path←AllocatePath[];
path.channel←link.channel;
path.inter←link.inter;
path.circuit←thisCircuit;
path.pathNo←pathNo←pathNo+1;
pathList↑←[path,allPaths];
allPaths←pathList;
END;

Neighbors:PROCEDURE[grid:GridPtr]
   RETURNS[an1,an2,an3,bn1,bn2,bn3:GridPtr]=BEGIN
an1←an2←an3←bn1←bn2←bn3←NIL;
FOR gl2:GridListPtr←links,gl2.t UNTIL gl2=NIL DO
  grid2:GridPtr=gl2.h;
  SELECT TRUE FROM
    grid2=grid=>LOOP;
    grid2.a=grid.a OR grid2.b=grid.a=>SELECT TRUE FROM
      an1=NIL=>an1←grid2; an2=NIL=>an2←grid2; an3=NIL=>an3←grid2;
      ENDCASE=>Error;
    grid2.a=grid.b OR grid2.b=grid.b=>SELECT TRUE FROM
      bn1=NIL=>bn1←grid2; bn2=NIL=>bn2←grid2; bn3=NIL=>bn3←grid2;
      ENDCASE=>Error;
    ENDCASE;
  ENDLOOP;
END;

DebugPath:PROCEDURE[a,b:PlacePtr]=BEGIN
Return[];
ShowString["make path from "];
ShowPoint[a.pos];
ShowString[" to "];
ShowPoint[b.pos];
ShowDecimal[thisCircuit," circuit "];
END;

from,to:Circuit;

ChangeCircuit:PROCEDURE[p:PlacePtr]=BEGIN
IF p=NIL OR p.circuit#from THEN RETURN;
p.circuit←to;
ChangeCircuit[p.n];
ChangeCircuit[p.s];
ChangeCircuit[p.e];
ChangeCircuit[p.w];
END;

plowOn:BOOLEAN←FALSE;
logs:ARRAY [0..10) OF INTEGER←ALL[0];

Log:PROCEDURE[i:INTEGER←0]=BEGIN
IF i NOT IN [0..10) THEN i←0;
logs[i]←logs[i]+1;
IF ~plowOn THEN Error;
END;

CheckPaths:PROCEDURE=BEGIN
FOR pwl:PathwayListPtr←paths, pwl.t UNTIL pwl=NIL DO
  pathway:PathwayPtr=pwl.h;
  FOR pl:PathListPtr←pathway.path, pl.t UNTIL pl=NIL DO
    path:PathPtr=pl.h;
    inter:RectanglePtr=path.inter;
    chan:RectanglePtr=path.channel;
    IF inter#NIL THEN BEGIN
      IF path.n#NIL AND path.n.inter=inter THEN Log[1];
      IF path.s#NIL AND path.s.inter=inter THEN Log[1];
      IF path.e#NIL AND path.e.inter=inter THEN Log[1];
      IF path.w#NIL AND path.w.inter=inter THEN Log[1];
      END;
    IF chan#NIL AND chan.orient=vert THEN BEGIN
      IF (path.n#NIL AND path.n.channel=chan
         OR path.s#NIL AND path.s.channel=chan)
         AND path.e=NIL AND path.w=NIL THEN Log[3];
      IF path.e#NIL THEN SELECT path.e.channel FROM
        NIL=>NULL; chan=>IF path.e.index=NIL THEN Log[2]; ENDCASE=>Log[2];
      IF path.w#NIL THEN SELECT path.w.channel FROM
        NIL=>NULL; chan=>IF path.w.index=NIL THEN Log[2]; ENDCASE=>Log[2];
      END;
    IF chan#NIL AND chan.orient=hor THEN BEGIN
      IF (path.e#NIL AND path.e.channel=chan 
        OR path.w#NIL AND path.w.channel=chan)
        AND path.n=NIL AND path.s=NIL THEN Log[3];
      IF path.n#NIL THEN SELECT path.n.channel FROM
        NIL=>NULL; chan=>IF path.n.index=NIL THEN Log[2]; ENDCASE=>Log[2];
      IF path.s#NIL THEN SELECT path.s.channel FROM
        NIL=>NULL; chan=>IF path.s.index=NIL THEN Log[2]; ENDCASE=>Log[2];
      END;
    ENDLOOP;
  ENDLOOP;
END;

ShowPath:PROCEDURE=BEGIN
FOR pl:PathListPtr←allPaths, pl.t UNTIL pl=NIL DO
  path:PathPtr=pl.h;
  Return[];
  ShowPathID[path];
  ShowPathID2[" n= ",path.n];
  ShowPathID2[" s= ",path.s];
  ShowPathID2[" e= ",path.e];
  ShowPathID2[" w= ",path.w];
  ENDLOOP;
END;

ShowPathID:PROCEDURE[path:PathPtr]=BEGIN
IF path=NIL THEN {ShowString["none "]; RETURN};
ShowDecimal[path.pathNo];
ShowChar[' ];
SELECT TRUE FROM
  path.channel#NIL=>ShowDecimal[path.channel.channelNo,"Ch "];
  path.inter#NIL=>ShowDecimal[path.inter.channelNo,"Jn "];
  path.index#NIL=>ShowString["source"];
  ENDCASE=>Log[4];
END;

ShowPathID2:PROCEDURE[s:STRING,path:PathPtr]=BEGIN
ShowString[s];
IF path=NIL THEN ShowString["none "] ELSE ShowDecimal[path.pathNo];
END;

END.

--log 1 = in check, path has not combined inters into one.
--log 2 = in check, connection off the side of a channel.
--log 3 = in check, path has not combined chans into one.
--log 4 = in show, path has no rectangle or source.