--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.