--Cells2

--this module reorders the column numbers, in the hope that the number of rows being used will decrease. It uses MakeTracks and PrintTracks From Cells to actually compute the new rows.

--this module also happens to be the master control module for the system, calling cells(ParseInput, AssignColumns, MakeTracks), itself, and Cells3(Showtrack).

DIRECTORY
  IODefs: FROM "IODefs",
  CellsDefs: FROM "CellsDefs";

Cells2:PROGRAM IMPORTS IODefs, CellsDefs=BEGIN OPEN CellsDefs;

Error:SIGNAL=CODE;
Done:SIGNAL=CODE;

Status:TYPE={idle,type1};

status:ARRAY Track OF Status;
where:ARRAY Track OF INTEGER;
when:ARRAY Track OF INTEGER;
reassignments:INTEGER;



Main:PROCEDURE=BEGIN progress:BOOLEAN←TRUE;
ParseInput;  ClusterColumns[]; --AssignColumns;
Initialize;
UNTIL ~progress DO  AssignRows; progress←ReAssignColumns[]; ENDLOOP;
MakeLayout;
IODefs.WriteChar[Ret];
IODefs.WriteString["Done"];
ReturnStorage[];
END;

Initialize:PROCEDURE={reassignments←oldFixer←oldFixee←0};

AssignRows:PROCEDURE=BEGIN
  MakeTracks;
  FindTrackBounds;
  FOR i:INTEGER IN [0..40] UNTIL ~ExtraTest[] DO ENDLOOP;
  FOR i:INTEGER IN [0..4] UNTIL ~ReDoRows[] DO ENDLOOP;
  PrintTracks;
  END;

MakeLayout:PROCEDURE={Showtrack};

ReAssignColumns:PROCEDURE RETURNS[progress:BOOLEAN]=BEGIN
progress← FindTrouble[];
IF progress THEN MoveTrouble;
END;

FindTrouble:PROCEDURE RETURNS[BOOLEAN]=BEGIN OPEN IODefs;
y,l,j,m,x,f:INTEGER; run,oneRun:BOOLEAN;
FindWorstColumn:PROCEDURE[c,s,z:INTEGER]=BEGIN
  k:INTEGER←0;
  FOR j IN Track DO SELECT track[c][j] FROM Space,'B=>k←k+1; ENDCASE; ENDLOOP;
  IF k<y THEN {y←k; l←0; run←TRUE; m←z; x←c};
  IF k=y THEN {l←l+1; oneRun←run; IF run THEN f←z}; --not a select!
  IF k>y THEN run←FALSE;
  END;
FindAFix:PROCEDURE[c,s,z:INTEGER]=BEGIN
  k:INTEGER←-1;
  IF z>f THEN RETURN;
  FOR j IN Track DO
    SELECT track[c][j] FROM 'S,'C,'P=>{k←IF k=-1 THEN j ELSE -2}; ENDCASE; ENDLOOP;
  FOR j IN Track DO
    SELECT track[c][j] FROM
      '1=>IF k>=0 THEN {status[j]←type1; where[j]←k; when[j]←c; LOOP};
      '-=>NULL;
      ENDCASE=>status[j]←idle;
    IF status[j]=type1 AND where[j]#-1 THEN
      SELECT track[c][where[j]] FROM 'S,'1,Space=>status[j]←idle; ENDCASE;
    ENDLOOP;
  END;
FindAnotherFix:PROCEDURE[c,s,z:INTEGER]=BEGIN
  k:INTEGER←-1;
  IF fixA#-1 THEN RETURN;
  FOR j IN Track DO
    SELECT track[c][j] FROM
      Space,'-,'B=>NULL;
      'S=>IF ~TopS[c,j] THEN RETURN ELSE k←j;
      ENDCASE=>RETURN;
    ENDLOOP;
  IF k=-1  THEN RETURN;
  FOR p:INTEGER IN (c..signalMax) DO
    IF track[p][k]#'- THEN RETURN;
    IF Visible[p] THEN {IF c=oldFixer AND p=oldFixee THEN RETURN ELSE EXIT};
    ENDLOOP;
  where[k]←-1; when[k]←c; fixA←k;
  IF print THEN IODefs.WriteString[" Aha! "];
  END;
y←trackMax+1;
EnumerateColumns[FindWorstColumn];
IF print THEN BEGIN
  WriteChar[Ret];
  WriteDecimal[trackMax-y];
  WriteString[" wide,starting at "];
  WriteDecimal[m];
  WriteString[" length = "];
  WriteDecimal[l];
  WriteString[IF oneRun THEN " in one block" ELSE " scattered"];
  END;
status←ALL[idle];
EnumerateColumns[FindAFix];
IF print THEN WriteChar[Ret];
fixA←-1;
FOR j IN Track DO
  SELECT status[j] FROM
    type1=>{fixA←j; IF print THEN {WriteDecimal[j]; WriteChar[Space]}}; ENDCASE;
  ENDLOOP;
IF fixA=-1 THEN EnumerateColumns[FindAnotherFix];
reassignments←reassignments+1;
RETURN[fixA#-1 AND reassignments<10];
END;

Visible:PROCEDURE[p:INTEGER] RETURNS[BOOLEAN]=BEGIN
FOR pp:INTEGER IN [0..trackMax) DO
  SELECT track[p][pp] FROM Space,'-,'B=>NULL ENDCASE=>RETURN[TRUE]; ENDLOOP;
RETURN[FALSE];
END;

MoveTrouble:PROCEDURE=BEGIN
fixee:INTEGER;
fixer:INTEGER←when[fixA];
t:INTEGER←column[fixer];
FOR i:INTEGER IN (fixer..signalMax) DO
  SELECT track[i][fixA] FROM '-=>NULL; ENDCASE=>{fixee←i-1; EXIT}; ENDLOOP;
UNTIL column[fixee]#0 AND sig[column[fixee]].fixed=none
    DO fixee←fixee-1; ENDLOOP;
IF print THEN BEGIN
  IODefs.WriteString[Lookup2[t]];
  IODefs.WriteString[" swapped for "];
  IODefs.WriteString[Lookup2[column[fixee]]];
  END;
FOR i:INTEGER IN [fixer..fixee) DO
  column[i]←column[i+1];
  sig[column[i]].columnNum←i;
  ENDLOOP;
column[fixee]←t; sig[t].columnNum←fixee;
oldFixer←fixer; oldFixee←fixee;
END;

fixA:INTEGER;
progress:BOOLEAN←FALSE;
oldFixer,oldFixee:INTEGER;

ReDoRows:PROCEDURE RETURNS[prog:BOOLEAN]=BEGIN
prog←TRUE;
progress←FALSE;
IF print THEN IODefs.WriteChar[Ret];
FOR i:INTEGER IN [0..signalMax) DO
  g,d,e,rowG,rowE,colD:INTEGER;
  IF sig[i].def=NIL THEN LOOP;
  IF sig[i].invisible THEN LOOP;
  IF sig[i].def.s.type#pass1 THEN LOOP;
  d←sig[i].def.s.d;
  colD←sig[d].columnNum;
  IF colD=0 OR column[d+1]=0 THEN LOOP;
  [g,rowG]←TrueSignal[sig[i].def.s.g];
  [e,rowE]←TrueSignal[sig[i].def.s.e];
  IF rowG<rowE THEN {t:INTEGER←g; g←e; e←t; t←rowG; rowG←rowE; rowE←t};
  IF rowG=-1 OR rowE=-1 THEN {Error; LOOP};
  IF rowG=rowE THEN LOOP; 
  SELECT TRUE FROM
    track[colD+1][rowE]=Space AND track[colD-1][rowG]=Space => BEGIN
      ShowIt["Type 1 at ",d];
      IF FindumDown[rowE,rowG,colD] THEN RETURN;
      IF   FindumUp[rowG,rowE,colD] THEN RETURN;
      END;
    track[colD-1][rowE]=Space AND track[colD+1][rowG]=Space => BEGIN
      ShowIt["Type 2 at ",d];
      IF FindumDown[rowG,rowE,colD] THEN RETURN;
      IF   FindumUp[rowE,rowG,colD] THEN RETURN;
      END;
    (rowG=rowE+1)=>NULL;
    track[colD+1][rowG]=Space => BEGIN
      ShowIt["Type 3 at ",d];
      FOR i:INTEGER IN (rowE..rowG) DO
        IF track[colD][i]=Space AND FindumDown[rowG,i,colD] THEN RETURN;
        ENDLOOP;
      END;  
    track[colD+1][rowE]=Space => BEGIN
      ShowIt["Type 4 at ",d];
      FOR i:INTEGER DECREASING IN (rowE..rowG) DO
        IF track[colD][i]=Space AND FindumDown[rowE,i,colD] THEN RETURN;
        ENDLOOP;
      END;
    track[colD-1][rowE]=Space => BEGIN
      ShowIt["Type 5 at ",d];
      FOR i:INTEGER DECREASING IN (rowE..rowG) DO
        IF track[colD][i]=Space AND FindumUp[rowE,i,colD] THEN RETURN;
        ENDLOOP;
      END;  
    track[colD-1][rowG]=Space => BEGIN
      ShowIt["Type 6 at ",d];
      FOR i:INTEGER IN (rowE..rowG) DO
        IF track[colD][i]=Space AND FindumUp[rowG,i,colD] THEN RETURN;
        ENDLOOP;
      END;
    ENDCASE=>ShowIt["Type 7 at ",d];
  IF progress THEN Error;
  ENDLOOP;
RETURN[FALSE];
END;

trackEnd:Track←0;
columnEnd:INTEGER←0;

FindTrackBounds:PROCEDURE=BEGIN
trackEnd←columnEnd←0;
FOR c:INTEGER IN [0..signalMax) DO FOR t:Track IN Track DO
  IF track[c][t]=Space THEN LOOP;
  columnEnd←MAX[columnEnd,c+1];
  trackEnd←MAX[trackEnd,t+1];
  ENDLOOP; ENDLOOP;
END;

ExtraTest:PROCEDURE RETURNS[BOOLEAN]=BEGIN
FOR c:INTEGER IN [0..columnEnd) DO
  FOR t:INTEGER IN [0..trackEnd) DO
    IF track[c][t]#Space AND (c=0 OR track[c-1][t]=Space) THEN 
    FOR tt:INTEGER IN [0..trackEnd) DO
      IF track[c][tt]=Space AND TTIsBetterThanT[c,t,tt]
        THEN {{MoveTtoTT[c,t,tt]; progress←TRUE}};
      ENDLOOP;
    ENDLOOP;
  ENDLOOP;
RETURN[progress];
END;

TTIsBetterThanT:PROCEDURE[c:INTEGER,t,tt:Track] RETURNS[BOOLEAN]=BEGIN
  FOR i:INTEGER DECREASING IN [0..c) DO
    IF track[i][t] #Space THEN RETURN[FALSE];
    IF track[i][tt]#Space THEN RETURN[TRUE];
    ENDLOOP;
  RETURN[tt<t];
  END;

MoveTtoTT:PROCEDURE[c:INTEGER,t,tt:Track]=BEGIN
  temp:CHARACTER;
  FOR i:INTEGER IN [c..columnEnd) DO
    temp←track[i][t]; track[i][t]←track[i][tt]; track[i][tt]←temp;
    ENDLOOP;
  FOR i:INTEGER IN [0..columnEnd)
    DO IF track[i][t]#Space THEN RETURN; ENDLOOP;
  FOR i:INTEGER IN [0..columnEnd) DO
    temp←track[i][t]; track[i][t]←track[i][trackEnd]; track[i][trackEnd]←temp;
    ENDLOOP;
  trackEnd←trackEnd-1;
  END;

ShowIt:PROCEDURE[s:STRING,d:INTEGER]=BEGIN OPEN IODefs;
IF ~ print THEN RETURN;
WriteChar[Ret];
WriteString[s];
WriteString[Lookup2[d]];
END;

FindumDown:PROCEDURE[e,g,c:INTEGER] RETURNS[BOOLEAN]=BEGIN
FOR q:INTEGER DECREASING IN [0..c-1] DO
  SELECT track[q][e] FROM
    Space=>Swap[e,g,q+1,c];
    '1=>IF track[q][g]=Space THEN Swap[e,g,q,c];
    'S=>IF ~TopS[q,e] THEN LOOP ELSE IF track[q][g]=Space THEN Swap[e,g,q,c];
    ENDCASE=>IF track[q][g]=Space THEN LOOP;
  EXIT;
  ENDLOOP;
RETURN[progress];
END;

TopS:PROCEDURE[c,t:INTEGER] RETURNS[BOOLEAN]=BEGIN
FOR j:INTEGER DECREASING IN [0..c] DO
  SELECT track[j][t] FROM
    '1=>RETURN[FALSE];
    'S=>RETURN[TRUE];
    Space,'B=>RETURN[TRUE];
    ENDCASE;
  ENDLOOP;
RETURN[TRUE];
END;

FindumUp:PROCEDURE[e,g,c:INTEGER] RETURNS[BOOLEAN]=BEGIN
end:BOOLEAN←track[c][e]='S;
FOR q:INTEGER IN (c..signalMax) DO
  SELECT track[q][e] FROM
    Space,'1=>NULL;
    'S=>IF ~end THEN {end←TRUE; LOOP};
    ENDCASE=>IF track[q][g]=Space THEN LOOP ELSE EXIT;
  Swap[e,g,c,q-1];
  EXIT;
  ENDLOOP;
RETURN[progress];
END;


Swap:PROCEDURE[r1,r2,c1,c2:INTEGER]=BEGIN --r2 is empty
progress←TRUE;
FOR c:INTEGER IN [c1..c2] DO
   t:CHARACTER←track[c][r1]; track[c][r1]←track[c][r2]; track[c][r2]←t;
  ENDLOOP;
IF track[c2][r1]#Space THEN {track[c2][r1]←Space; track[c2][r2]←'3};
IF track[c1][r1]#Space THEN {track[c1][r1]←Space; track[c1][r2]←'3};
END;

TrueSignal:PROCEDURE[i:INTEGER] RETURNS[j,k:INTEGER]=BEGIN
c:INTEGER;
j←TrueSignal1[i]; k←-1; c←sig[j].columnNum;
FOR l:INTEGER IN [0..trackMax) DO IF track[c][l]='S THEN {k←l; EXIT}; ENDLOOP;
END;

TrueSignal1:PROCEDURE[i:INTEGER] RETURNS[INTEGER]=BEGIN
IF ~sig[i].invisible THEN RETURN[i];
FOR j:INTEGER IN [0..signalMax) DO
  IF sig[j].def#NIL AND sig[j].def.s.type=wire THEN 
    FOR k:TList←sig[j].def, k.next UNTIL k=NIL
      DO IF k.s.d=i THEN RETURN[j]; ENDLOOP;
  ENDLOOP;
ERROR;
END;



Main[];

END..