--Cells

--this module does three quite independent tasks:
--     1) It reads and parses the input file
--     2) it makes an initial assignment of columns, sources before uses
--     3) it makes an initial assignment of rows, packing upward.

DIRECTORY
  ppdefs, ZoneAllocDefs, IODefs, ImageDefs,
  CellsDefs, StringDefs, SystemDefs, StreamDefs;

Cells:PROGRAM IMPORTS StringDefs, ppdefs, ImageDefs, IODefs, SystemDefs, StreamDefs, ZoneAllocDefs EXPORTS CellsDefs=BEGIN OPEN CellsDefs;

Error:SIGNAL=CODE;
Done:SIGNAL=CODE;
Feed:CHARACTER=14C;
Tab:CHARACTER='	;
Comma:CHARACTER=',;
SQ:CHARACTER='';
Gets:CHARACTER='←;
lParen:CHARACTER='(;
rParen:CHARACTER=');
Plus:CHARACTER='+;
Minus:CHARACTER='-;
Del:CHARACTER=377C;

--///// PARSE /////



gnd:INTEGER=3;
vdd:INTEGER=2;
int:INTEGER=1;

equalCode:INTEGER=-1;
endFileCode:INTEGER=-2;
norCode:INTEGER=-3;
rtBktCode:INTEGER=-4;
aoiCode:INTEGER=-5;
passCode:INTEGER=-6;
cutCode:INTEGER=-7;
wireCode:INTEGER=-8;
fixedCode:INTEGER=-9;
nearCode:INTEGER=-10;

sig:PUBLIC LONG POINTER TO sigType;

innstream:StreamDefs.DiskHandle←NIL;

fileName:STRING← [50];

ParseInput:PUBLIC PROCEDURE=BEGIN
Parse[GetInputFileName[]];
IF TRUE THEN PrintSig[];
END;

GetInputFileName:PROCEDURE RETURNS[STRING]=BEGIN
ok:BOOLEAN;
IF chip THEN BEGIN OPEN ppdefs;
[ok, fileName, ] ← typeIn[""L, "input file name= "L,""L];
IF fileName.length=0 OR NOT ok THEN ImageDefs.StopMesa[];
fileName ← FixExtension[fileName, ".txt"L];
RETURN[fileName];
  END;
AskForFileName["input file name= "];
IF fileName.length=0 THEN ImageDefs.StopMesa[];
StringDefs.AppendString[fileName,".txt"];
RETURN[fileName];
END;

FixExtension: PROCEDURE [s, ext: STRING] RETURNS [se: STRING] =
  BEGIN OPEN ppdefs;
    FOR i: CARDINAL IN [0..s.length) DO IF s[i] = '. THEN RETURN[s] ENDLOOP;
    se ← GetString[s.length + ext.length];
    StringDefs.AppendString[to: se, from: s];
    StringDefs.AppendString[to: se, from: ext];
    FreeString[s];
  END;

AskForFileName:PROCEDURE[s:STRING]= BEGIN
i:CARDINAL;
IODefs.WriteChar[Ret];
IODefs.WriteString[s];
IODefs.ReadID[fileName !IODefs.Rubout=>RETRY];
FOR i IN [0..fileName.length) DO
    IF fileName[i]='. THEN BEGIN fileName.length←i; EXIT; END;
    ENDLOOP;
END;

Parse:PROCEDURE[file:STRING]=BEGIN
innstream←StreamDefs.NewByteStream[file,StreamDefs.Read];
held←Del;
sig↑←ALL[NilSig];
hold←FALSE;
TListInit[];
DictInit[];
ReadTheFile[];
innstream.destroy[innstream];
END;

ReadTheFile:PROCEDURE=BEGIN DO
  base:INTEGER←0;
  DO
  t:INTEGER←GetToken[];
  SELECT t FROM
    >0=>{IF base=0 THEN base←t ELSE Error; LOOP};
    =0=>Error;
    equalCode=>LOOP;
    endFileCode=>RETURN;
    nearCode=>{[]←Number[]; Error};--near not implemented
    fixedCode=>BEGIN
         x:INTEGER←Number[];
         IF sig[base].def=NIL AND x#-1 THEN Error;--parse error
         SELECT x FROM
           0=>sig[base].fixed←lo;
           -1=>sig[base].fixed←hi;
           ENDCASE=>{sig[base].columnNum←x; sig[base].fixed←mid};
        END;
    norCode,aoiCode=>BEGIN
      ptr:TList←GetTlistWithT[];
      last:TList←sig[base].def;
      IF base<=0 THEN Error;
      ptr.s↑←[type:norPullUp,cutG:FALSE,cutD:FALSE,g:vdd,d:int,e:base];
      SetSig[base,ptr,last];
      DO
        t←GetToken[];
        SELECT t FROM rtBktCode=>EXIT; <=0=>Error; ENDCASE;
        ptr←ptr.next←GetTlistWithT[];
        ptr.s↑←[type:norPullDown,cutG:FALSE,cutD:FALSE,g:vdd,d:t,e:int];
        ptr.next←last;
        ENDLOOP;
      END;
    wireCode=>BEGIN
      ptr:TList←GetTlistWithT[];
      last:TList←sig[base].def;
      IF base<=0 THEN Error;
      ptr.s↑←[type:wire,cutG:FALSE,cutD:FALSE,g:vdd,d:int,e:base];
      SetSig[base,ptr,last];
      DO
        t←GetToken[];
        SELECT t FROM rtBktCode=>EXIT; <=0=>Error; ENDCASE;
        ptr←ptr.next←GetTlistWithT[];
        ptr.s↑←[type:wire,cutG:FALSE,cutD:FALSE,g:vdd,d:t,e:int];
        ptr.next←last;
        ENDLOOP;
      END;
    cutCode=>BEGIN
      IF base<=0 THEN Error;
      t←GetToken[];
      IF t<=0 THEN Error;
      FOR j:TList←sig[base].def,j.next DO
        IF j=NIL THEN {Error; EXIT};
        IF j.s.d=t THEN {j.s.cutD←TRUE; EXIT};
        IF j.s.g=t THEN {j.s.cutG←TRUE; EXIT};
        ENDLOOP;
      END;
    passCode=>BEGIN  a,b:INTEGER;
      ptr,last:TList;
      IF base<=0 THEN Error;
      SELECT a←GetToken[] FROM rtBktCode,<=0=>Error; ENDCASE;
      SELECT b←GetToken[] FROM rtBktCode,<=0=>Error; ENDCASE;
      SELECT GetToken[] FROM rtBktCode=>NULL; ENDCASE=>Error;
      Append[base,a];
      Append[b,a];
      last←sig[base].def;
      ptr←GetTlistWithT[];
      ptr.s↑←[type:pass1,cutG:FALSE,cutD:FALSE,g:b,d:a,e:base];
      SetSig[base,ptr,last];
      last←sig[a].def;
      ptr←GetTlistWithT[];
      ptr.s↑←[type:pass2,cutG:FALSE,cutD:FALSE,g:gnd,d:b,e:base];
      SetSig[a,ptr,last];
      END;
--    aoiCode=>BEGIN
--      DO
--        t←GetToken[];
--        SELECT t FROM rtBktCode=>EXIT; <=0=>Error; ENDCASE;
--        ENDLOOP;
--      END;
  ENDCASE=>Error;
EXIT;
ENDLOOP; ENDLOOP; END;

SetSig:PROCEDURE[s:INTEGER,ptr,last:TList]=BEGIN
ptr.next←last;
sig[s]←NilSig; sig[s].def←ptr; sig[s].printString←dict[dictBase+s].s;
END;

Append:PROCEDURE[s,a:INTEGER]=BEGIN
  j:TList←NIL;
  ptr:TList←GetTlistWithT[];
  ptr.s↑←[type:pass,cutG:FALSE,cutD:FALSE,g:gnd,d:a,e:int];
  FOR i:TList←sig[s].def, i.next UNTIL i=NIL DO j←i; ENDLOOP;
  IF j=NIL THEN sig[s].def←ptr ELSE j.next←ptr;
  END;

--////// manage list and transistor storage

tListArrayType:TYPE=ARRAY[0..tListMax) OF TListBody;
tArrayType:TYPE=ARRAY[0..tMax) OF Transistor;
tListArray:LONG POINTER TO tListArrayType;
tArray:LONG POINTER TO tArrayType;
tListEnd,tEnd:INTEGER;
tListMax:INTEGER=3000;
tMax:INTEGER=2000;

TListInit:PROCEDURE=BEGIN tListEnd←tEnd←0; END;

GetTlistWithT:PROCEDURE RETURNS[x:TList]=BEGIN
  x←@tListArray[tListEnd]; tListEnd←tListEnd+1;
  x↑←[s:@tArray[tEnd],next:NIL];  tEnd←tEnd+1; 
  END;

--////// end of list and transistor storage
--////// manage tokens and dictionary

dictType:TYPE=ARRAY [0..dictMax) OF Dict;

dict:LONG POINTER TO dictType;
dictMax:INTEGER=1000;
dictEnd:INTEGER←0;
dictBase:INTEGER←4;
Dict:TYPE=RECORD[s:STRING,v:INTEGER];

DictInit:PROCEDURE=BEGIN
dict[0]←["nor",norCode];
dict[1]←["aoi",aoiCode];
dict[2]←["pass",passCode];
dict[3]←["end",endFileCode];
dict[4]←["illegal",0];
dict[5]←["int",int];
dict[6]←["gnd",gnd];
dict[7]←["vdd",vdd];
dict[8]←["cut",cutCode];
dict[9]←["wire",wireCode];
dict[10]←["fixed",fixedCode];
dict[11]←["near",nearCode];
dictEnd←12;
END;

GetToken:PROCEDURE RETURNS[INTEGER]=BEGIN DO
  t:STRING←GetRealWords[];
  IF t=NIL THEN RETURN[endFileCode];
  SELECT t[0] FROM
    '==>RETURN[equalCode];
    ',,'[=>LOOP;
    ']=>RETURN[rtBktCode];
    ENDCASE=>RETURN[Lookup[t]];
  ENDLOOP; END;

Lookup:PROCEDURE[s:STRING] RETURNS[z:INTEGER]=BEGIN
  z←dictEnd;
  FOR i:INTEGER IN [0..z) DO
    IF SameString[s,dict[i].s] THEN RETURN[dict[i].v];
    ENDLOOP;
  dict[z]←[s,z-dictBase];
  dictEnd←dictEnd+1;
  RETURN[dict[z].v];
  END;

Lookup2:PUBLIC PROCEDURE[z:INTEGER] RETURNS[STRING]=BEGIN
  RETURN[dict[z+dictBase].s];
  END;

hold:BOOLEAN; holdC:CHARACTER←' ;

GetRealWords:PROCEDURE RETURNS[t:STRING]=BEGIN
  s:STRING←GetFreeString[];
  c:CHARACTER; s.length←0; t←NIL;
  IF hold THEN {hold←FALSE; s[0]←holdC; s.length←1; RETURN[s]}; 
  DO
    IF innstream.endof[innstream] THEN RETURN[NIL];
    SELECT c←GetChar[] FROM
      Space,Ret,Tab,Comma=>IF s.length >0 THEN RETURN[s] ELSE s.length←0;
      IN ['a..'z],SQ,Gets,lParen,rParen,Plus,Minus, IN ['0..'9]=>
              {s[s.length]←c; s.length←s.length+1};
      IN ['A..'Z]=> {s[s.length]←c-'A+'a; s.length←s.length+1};
      '[,'],'==> IF s.length=0 THEN {s[0]←c; s.length←1; RETURN[s];}
                    ELSE {hold←TRUE; holdC←c; RETURN[s]};
      ENDCASE=>Error;--illegal character
    ENDLOOP;
  END;

Number:PROCEDURE RETURNS[INTEGER]=BEGIN
  found,min:BOOLEAN←FALSE;  c:CHARACTER;
  i:INTEGER←0;
  DO
    SELECT c←GetChar[] FROM
      Space,Ret,Tab,Comma=>IF found THEN RETURN[IF min THEN -i ELSE i];
      IN ['0..'9]=>{i←i*10+(c-'0); found←TRUE};
      Minus=> min←TRUE;
      ENDCASE=>Error;--illegal character
    ENDLOOP;
  END;

Suck:PROCEDURE=
  {UNTIL SELECT Get[] FROM Ret=>TRUE, ENDCASE=>FALSE DO ENDLOOP};

held:CHARACTER←Del;

GetChar:PROCEDURE RETURNS[c:CHARACTER]=BEGIN
  IF held#Del THEN {c←held; held←Del} ELSE c←Get[];
  IF c=Minus AND (held←Get[])=Minus THEN {Suck[];  held←Del;  c←Ret};
  END;

Get:PROCEDURE RETURNS[c:CHARACTER]=--INLINE--BEGIN
  c←innstream.get[innstream];
  END;

empties:ARRAY [0..200) OF STRING←ALL[NIL];
emptyEnd:INTEGER←0;

GetFreeString:PROCEDURE RETURNS[s:STRING]=BEGIN
  IF emptyEnd=0 THEN RETURN[SystemDefs.AllocateHeapString[30]];
  emptyEnd←emptyEnd-1;
  RETURN[empties[emptyEnd]];
  END;

FreeString:PROCEDURE[s:STRING]=BEGIN
  IF emptyEnd<200 THEN { empties[emptyEnd]←s; emptyEnd←emptyEnd+1}
                  ELSE SystemDefs.FreeHeapString[s];
  END;

SameString:PROCEDURE[a,b:STRING]RETURNS[BOOLEAN]=BEGIN
  IF a.length#b.length THEN RETURN[FALSE];
  FOR i:CARDINAL IN [0..a.length) DO
    IF a[i]#b[i] THEN RETURN[FALSE];
    ENDLOOP;
  RETURN[TRUE];
  END;

PrintSig:PROCEDURE=BEGIN OPEN IODefs;
  IF ~print THEN RETURN;
  FOR i:INTEGER IN [8..signalMax) DO
    IF sig[i].def=NIL THEN LOOP;
    WriteChar[Ret];
    WriteDecimal[i];
    WriteChar[' ];
    WriteString[Lookup2[i]];
    WriteChar[' ];
    FOR j:TList←sig[i].def,j.next UNTIL j=NIL DO
      t:TP←j.s;
      WriteChar['[];
      WriteDecimal[t.g];
      WriteChar[' ];
      WriteDecimal[t.d];
      WriteChar[' ];
      WriteDecimal[t.e];
      WriteChar[']];
      ENDLOOP;
    ENDLOOP;
  END;

--///// END PARSE  //////

--///////////ASSIGN COLUMNS

ColumnEntry:TYPE=RECORD[s:INTEGER];
column:PUBLIC LONG POINTER TO columnType;

AssignColumns:PUBLIC PROCEDURE=BEGIN  c:INTEGER←0;
  s:INTEGER;
  IncrementUp:PROCEDURE[i:INTEGER]=BEGIN sig[i].up←sig[i].up+1; END;
  DecrementUp:PROCEDURE[i:INTEGER]=
    BEGIN sig[i].up←sig[i].up-1; IF sig[i].up=0 THEN AddToAvailable[i]; END;
  EnumerateLegs:PROCEDURE[s:INTEGER,c:PROCEDURE[INTEGER]]=BEGIN
    FOR t:TList←sig[s].def,t.next UNTIL t=NIL DO
        IF t.s.type=pass THEN LOOP;
        IF ~(t.s.cutD OR t.s.d=s) THEN c[t.s.d];
        IF ~(t.s.cutG OR t.s.g=s OR t.s.type=pass1) THEN c[t.s.g];
        ENDLOOP;
    END;
  SetColumn:PROCEDURE[s:INTEGER]={column[c]←s; sig[s].columnNum←c; c←c+1};
  FOR i:INTEGER IN [1..signalMax) DO EnumerateLegs[i,IncrementUp]; ENDLOOP;
  availableEnd←0;
  column↑←ALL[0];
  runCount←0;
  FOR i:INTEGER IN [1..signalMax)
     DO SELECT sig[i].fixed FROM
          lo=>SetColumn[i];
          mid=>column[sig[i].columnNum]←i;
          ENDCASE; ENDLOOP;
  FOR i:INTEGER IN [1..signalMax)
     DO IF sig[i].def#NIL AND sig[i].up=0 THEN AddToAvailable[i]; ENDLOOP;
  c←0;
  UNTIL c>=columnMax DO
    s←column[c];
    IF s=0 THEN SELECT s←GetBestSignal[] FROM
        0 => EXIT;
       -1 => {c←c+1; LOOP};
       ENDCASE=>--IF sig[s].def=NIL OR sig[s].def.s.type#wire THEN
                {column[c]←s; sig[s].columnNum←c};
    EnumerateLegs[s,DecrementUp];
    c←c+1;
    ENDLOOP;
  FOR i:INTEGER IN [1..signalMax)
     DO IF sig[i].fixed=hi THEN SetColumn[i]; ENDLOOP;
  RemoveInvisibleColumns[];
  IF FALSE THEN PrintColumns[];
  IF FALSE THEN DumpCols[];
  END;

availableType:TYPE=ARRAY[0..availableMax) OF INTEGER;
available:LONG POINTER TO availableType;
availableMax:INTEGER=400;
availableEnd:INTEGER;
runCount:INTEGER;

AddToAvailable:PROCEDURE[i:INTEGER]=BEGIN
IF i=gnd OR i=vdd OR i=int OR sig[i].fixed#none THEN RETURN;
available[availableEnd]←i; availableEnd←availableEnd+1;
END;

GetBestSignal:PROCEDURE RETURNS[n:INTEGER]=BEGIN
IF availableEnd=0 THEN RETURN[0];
n←available[availableEnd-1];
--IF sig[n].def#NIL AND sig[n].def.s.type=wire
--   THEN {availableEnd←availableEnd-1; RETURN[n]};
IF runCount=2 AND sig[n].def#NIL THEN
  {runCount←0; IF ~SearchForNonPullup[] THEN RETURN[-1]};
n←available[availableEnd-1];
IF sig[n].def=NIL THEN runCount←0 ELSE runCount←runCount+1;
availableEnd←availableEnd-1;
END;

HasPullup:PROCEDURE[this:INTEGER] RETURNS[BOOLEAN]=BEGIN
IF sig[this].def=NIL THEN RETURN[FALSE];
SELECT sig[this].def.s.type FROM norPullUp,aoiPullUp=>RETURN[TRUE];
  ENDCASE=>RETURN[FALSE];
END;

SearchForNonPullup:PROCEDURE RETURNS[BOOLEAN]=BEGIN
FOR i:INTEGER DECREASING IN [0..availableEnd) DO
  this:INTEGER←available[i];
  IF HasPullup[this] THEN LOOP;
  available[i]←available[availableEnd-1];
  available[availableEnd-1]←this;
  RETURN[TRUE];
  ENDLOOP;
RETURN[FALSE];
END;

PrintColumns:PROCEDURE=BEGIN OPEN IODefs;
  IF ~print THEN RETURN;
FOR i:INTEGER IN [0..columnMax) DO
  c:INTEGER←column[i];
  IF c=0 THEN LOOP;
  WriteChar[Ret];
  WriteDecimal[i];
  WriteChar[Space];
  WriteDecimal[c];
  WriteChar[Space];
  WriteString[Lookup2[c]];
  ENDLOOP;
END;
   
DumpCols:PROCEDURE=BEGIN OPEN IODefs;
  IF ~print THEN RETURN;
WriteChar[Ret];
FOR i:INTEGER IN [8..signalMax) DO  ps:STRING;
  t:INTEGER;
  s:LONG POINTER TO SignalEntry←@sig[i];
  IF s.printString=NIL AND s.def=NIL THEN LOOP;
  ps←Lookup2[i];
  t←IF ps#NIL THEN ps.length ELSE 0;
  WriteChar[Ret];
  WriteDecimal[i];
  WriteChar[Space]; IF i<10 THEN WriteChar[Space];
  WriteString[ps];
  FOR j:INTEGER IN [0..12-t) DO WriteChar[Space]; ENDLOOP;
  WriteChar[Space];
  WriteDecimal[s.columnNum];
  WriteChar[Space];
  WriteDecimal[s.up];
  WriteChar[Space];
  WriteChar[SELECT s.fixed FROM mid=>'m,hi=>'h, lo=>'l, ENDCASE=>'x];
  ENDLOOP;
END;

PrintTracks:PUBLIC PROCEDURE=BEGIN OPEN IODefs;
  IF ~print THEN RETURN;
WriteChar[Ret]; WriteChar[Feed]; EnumerateColumns[ShowTrack];
END;

EnumerateColumns:PUBLIC PROCEDURE[call:PROCEDURE[c,s,z:INTEGER]]=BEGIN
--c is column number including dummy columns, z is true column number.
--s is correcponding signal number.
n:INTEGER; z:INTEGER←0;
FOR i:INTEGER IN [0..signalMax) DO
  n←column[i]; IF n>=8 AND ~NoContacts[i] THEN {call[i,n,z]; z←z+1};
  ENDLOOP;
END;

ShowTrack:PROCEDURE[c,s,z:INTEGER]=BEGIN OPEN IODefs;
ps:STRING←Lookup2[s];
t:INTEGER←IF ps#NIL THEN ps.length ELSE 0;
WriteChar[Ret];
WriteDecimal[z];
WriteChar[Space]; IF z<10 THEN WriteChar[Space];
WriteString[ps];
FOR j:INTEGER IN [0..12-t) DO WriteChar[Space]; ENDLOOP;
WriteChar[Tab];
PrintTrack[c];
END;

track:PUBLIC LONG POINTER TO trackType;
Pair:TYPE=RECORD[a,b:INTEGER];

PrintTrack:PROCEDURE[i:INTEGER]=BEGIN OPEN IODefs;
  IF ~print THEN RETURN;
FOR j:INTEGER IN Track DO WriteChar[track[i][j]]; ENDLOOP;
END;

NoContacts:PROCEDURE[i:INTEGER] RETURNS[BOOLEAN]=BEGIN
FOR j:INTEGER IN Track
 DO SELECT track[i][j] FROM 'B,Space,'-=>NULL; ENDCASE=>RETURN[FALSE]; ENDLOOP;
RETURN[TRUE];
END;

RemoveInvisibleColumns:PROCEDURE=BEGIN z:INTEGER←0;
c:PROCEDURE[k:INTEGER]=BEGIN END;
FOR i:INTEGER IN [0..signalMax)
   DO track[i]←ALL[Space]; sig[i].invisible←FALSE; ENDLOOP;
FOR i:INTEGER IN [0..signalMax) DO Fol[i,c]; ENDLOOP;
FOR i:INTEGER IN [0..signalMax) DO
  n:INTEGER←column[i];
  IF n>=8 AND ~sig[n].invisible THEN {column[z]←n; z←z+1};
  ENDLOOP;
FOR i:INTEGER IN [z..signalMax) DO column[i]←0; ENDLOOP;
FOR i:INTEGER IN [0..z) DO sig[column[i]].columnNum←i; ENDLOOP;
END;

MakeTracks:PUBLIC PROCEDURE=BEGIN
track↑←ALL[ALL[Space]];
FOR i:INTEGER IN [0..signalMax) DO
  t:INTEGER;  range:Pair;
  IF sig[i].def=NIL OR sig[i].invisible THEN LOOP;
  range←FindRange[i]; IF range.a>=range.b THEN LOOP;
  t←FindTrack[range];
  IF t IN Track THEN FillTrack[i,t,range] ELSE
      IF print THEN IODefs.WriteChar['X];
  ENDLOOP;
END;


FindRange:PROCEDURE[s:INTEGER] RETURNS[Pair]=BEGIN
c:PROCEDURE[k:INTEGER]=BEGIN
  l:INTEGER=sig[k].columnNum;
  IF l>high THEN high←l;
  IF l<lo THEN lo←l;
  END;
high:INTEGER←-1; lo:INTEGER←30000;
c[s]; Fol[s,c];
SELECT sig[s].def.s.type FROM
  pass1=>BEGIN
          c[sig[s].def.s.d];
          --c[sig[s].def.s.g];
          END;
  wire=>BEGIN
         FOR i:TList ← sig[s].def.next, i.next UNTIL i=NIL DO
            p:INTEGER←i.s.d;
            e,g:INTEGER;
            IF sig[p].def=NIL OR sig[p].def.s.type#pass1 THEN Error;
            e←sig[p].def.s.d;
            g←sig[p].def.s.g;
            IF sig[e].columnNum#high THEN LOOP;
            IF sig[g].columnNum<=high THEN LOOP;
            high←sig[g].columnNum;
            ENDLOOP;
          END;
  ENDCASE;
IF high=lo THEN RETURN[[lo,high]];
IF high MOD 2 = 1 OR Passer[s,high] THEN high←high+1;
IF lo#0 AND lo MOD 2 = 0 AND Passer[s,lo] THEN lo←lo-1;
RETURN[[lo,high]];
END;

Passer:PROCEDURE[s,g:INTEGER]RETURNS[BOOLEAN]=BEGIN
FOR t:TList←sig[g].def,t.next UNTIL t=NIL DO
  IF t.s.type#pass2 THEN LOOP; 
  IF t.s.d=s OR t.s.e=s THEN RETURN[TRUE]; 
  IF sig[s].def=NIL OR sig[s].def.s.type#wire THEN LOOP;
  FOR q:TList←sig[s].def.next,q.next UNTIL q=NIL DO
    IF q.s.d=t.s.d OR q.s.d=t.s.e THEN RETURN[TRUE]; ENDLOOP;
  ENDLOOP;
RETURN[FALSE];
END;

Fol:PROCEDURE[k:INTEGER,c:PROCEDURE[INTEGER]]=BEGIN
going:BOOLEAN←FALSE;
IF k<dictBase THEN RETURN;
FOR t:TList←sig[k].def,t.next UNTIL t=NIL
  DO SELECT t.s.type FROM
      pass1,pass2 =>NULL;
      wire=>IF going THEN {
          IF t.s.d>=dictBase THEN {sig[t.s.d].invisible←TRUE; Fol[t.s.d,c]};
          IF t.s.g>=dictBase THEN {sig[t.s.g].invisible←TRUE; Fol[t.s.g,c]};
          IF t.s.e>=dictBase THEN {sig[t.s.e].invisible←TRUE; Fol[t.s.e,c]}};
      ENDCASE=>{IF t.s.d>=dictBase THEN c[t.s.d];
                IF t.s.g>=dictBase THEN c[t.s.g];
                IF t.s.e>=dictBase THEN c[t.s.e]};
    going←TRUE;
  ENDLOOP;
END;

FindTrack:PROCEDURE[p:Pair] RETURNS[INTEGER]=BEGIN
FOR i:INTEGER IN Track DO
  found:BOOLEAN←TRUE;
  FOR j:INTEGER IN [p.a..p.b] DO
    IF track[j][i]#Space THEN {found←FALSE; EXIT};
  ENDLOOP;
  IF found THEN RETURN[i];
ENDLOOP;
RETURN[-1];
END;

FillTrack:PROCEDURE[s,t:INTEGER,p:Pair]=BEGIN
c:PROCEDURE[k:INTEGER]={track[sig[k].columnNum][t]←'C};
FOR j:INTEGER IN [p.a..p.b) DO track[j][t]←'-; ENDLOOP;
track[p.a][t]←track[p.b][t]←'B; --for blank
Fol[s,c];
track[p.a][t]←'1;
SELECT sig[s].def.s.type FROM
  pass1=>BEGIN
          e:INTEGER←sig[s].def.s.d;
          g:INTEGER←sig[s].def.s.g;
          track[sig[e].columnNum][t]←'P;
          track[sig[g].columnNum][t]←'Q;
          END;
  wire=>BEGIN
         FOR i:TList ← sig[s].def.next, i.next UNTIL i=NIL DO
            m:INTEGER←i.s.d;
            e,g:INTEGER;
            IF sig[m].def=NIL OR sig[m].def.s.type#pass1 THEN Error;
            e←sig[m].def.s.d;
            g←sig[m].def.s.g;
            IF sig[e].columnNum#p.b THEN LOOP;
            IF sig[g].columnNum<=p.b THEN LOOP;
            track[sig[e].columnNum][t]←'P;
            track[sig[g].columnNum][t]←'Q;
            ENDLOOP;
          END;
  ENDCASE;
track[sig[s].columnNum][t]←'S;
END;

zone:PUBLIC UNCOUNTED ZONE;

InitStorage:PROCEDURE=BEGIN
zone←ZoneAllocDefs.GetAnXMZone[];
sig←zone.NEW[sigType];
tListArray←zone.NEW[tListArrayType];
tArray←zone.NEW[tArrayType];
dict←zone.NEW[dictType←ALL[[NIL,0]]];
column←zone.NEW[columnType];
available←zone.NEW[availableType];
track←zone.NEW[trackType];
END;

ReturnStorage:PUBLIC PROCEDURE={zone←ZoneAllocDefs.DestroyAnXMZone[zone]};

InitStorage;
END..