-- a program to run within Chipmonk

-- last modified by Petit, October ?, 1981 2:20 PM
-- written by Petit, October 9, 1981 2:04 PM

DIRECTORY
ppddefs,
ppdddefs,
ppdefs,
rldefs,
ZoneAllocDefs,
StringDefs;

rlmain: PROGRAM
IMPORTS ppddefs, ppdefs, ZoneAllocDefs, ppdddefs, rldefs
--EXPORTS rldefs-- =
BEGIN OPEN ppddefs, rldefs, ppdddefs, ppdefs, StringDefs;


downWireArray:TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF downWireRec];
dwAr:LONG POINTER TO downWireArray;
nodeArray:TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF INTEGER];
nodeAr:LONG POINTER TO nodeArray;
horLineArray:TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF hLineRec];
hlAr:LONG POINTER TO horLineArray;

hLev:INTEGER;
downWireCnt,maxNodeNum:INTEGER;
maxx,maxys,minys:INTEGER←0;
mine,ll:LONG POINTER TO list;


doSwitch:PROCEDURE[i,j:INTEGER] =
BEGIN
t:INTEGER;
t←dwAr[i].node;dwAr[i].node←dwAr[j].node;dwAr[j].node←t;
t←dwAr[i].dwLeft;dwAr[i].dwLeft←dwAr[j].dwLeft;dwAr[j].dwLeft←t;
t←dwAr[i].dwRight;dwAr[i].dwRight←dwAr[j].dwRight;dwAr[j].dwRight←t;
IF (t←dwAr[i].dwLeft)#0 THEN dwAr[t].dwRight←i;
IF (t←dwAr[j].dwLeft)#0 THEN dwAr[t].dwRight←j;
IF (t←dwAr[i].dwRight)#0 THEN dwAr[t].dwLeft←i;
IF (t←dwAr[j].dwRight)#0 THEN dwAr[t].dwLeft←j;
END;
runLength:PROCEDURE[i:INTEGER] RETURNS[INTEGER] =
BEGIN
l,r:INTEGER;
l←dwAr[i].dwLeft;
r←dwAr[i].dwRight;
IF l=0 THEN l←i ELSE
UNTIL dwAr[l].dwLeft=0 DO l←dwAr[l].dwLeft;ENDLOOP;
IF r=0 THEN r←i ELSE
UNTIL dwAr[r].dwRight=0 DO r←dwAr[r].dwRight;ENDLOOP;
UNTIL dwAr[l].fixed OR dwAr[l].rightEnd=0 OR dwAr[l+1].fixed DO l←l+1;ENDLOOP;
UNTIL dwAr[r].fixed OR dwAr[r].leftEnd=0 OR dwAr[r-1].fixed DO r←r-1;ENDLOOP;
RETURN[r-l];
END;

moveDown:PROCEDURE[cur,amt:INTEGER] RETURNS[INTEGER] =
BEGIN
t:INTEGER;
IF amt=0 THEN
BEGIN
amt←10000;
FOR i:INTEGER IN [1..downWireCnt] DO
t←hlAr[i].distance;
IF t>=0 AND t<amt THEN amt←t;
ENDLOOP;
amt←IF amt=10000 THEN 1 ELSE amt+1;
END;
FOR i:INTEGER IN [1..downWireCnt] DO
IF hlAr[i].btyp=none THEN LOOP;
t←hlAr[i].distance;
t←t-amt;
IF t<-3 THEN hlAr[i]←[none,-5]
ELSE hlAr[i].distance←t;
ENDLOOP;
RETURN[cur+amt];
END;

findGap:PROCEDURE[strt:INTEGER] RETURNS[ok:BOOLEAN,le,re:INTEGER] =
BEGIN
ok←TRUE;
UNTIL strt>downWireCnt OR hlAr[strt].distance<0 DO
strt←strt+1;ENDLOOP;
le←re←strt;
IF strt>downWireCnt THEN BEGIN ok←FALSE;RETURN;END;
UNTIL strt>downWireCnt OR hlAr[strt].distance>=0 DO
strt←strt+1;ENDLOOP;
re←strt-1;
END;

wireOne:PROCEDURE[le,re:INTEGER] RETURNS[gotOne,allDone:BOOLEAN] =
BEGIN
i,fav,len,t,relLev,rr:INTEGER;
polyWire:BOOLEAN←FALSE;
favPoly,tb,wrbl:BOOLEAN;
gotOne←FALSE;
allDone←TRUE;
FOR i IN [1..downWireCnt] DO
IF NOT (dwAr[i].wiredLeft AND dwAr[i].wiredRight)
THEN allDone←FALSE;
[wrbl,tb,t]←wireable[i,le,re];
IF wrbl AND t>0 THEN
BEGIN
IF gotOne THEN
BEGIN
IF t<len THEN {fav←i;len←t;favPoly←tb};
END
ELSE
BEGIN
fav←i;
len←t;
favPoly←tb;
gotOne←TRUE;
END;
END;
ENDLOOP;
IF NOT gotOne THEN
BEGIN
IF le<=1 AND re>=downWireCnt THEN allDone←TRUE;
RETURN;
END;
i←finalDW[fav];
rr←i+len;
polyWire←favPoly;
IF i#fav THEN doSwitch[i,fav];
IF polyWire AND dwAr[rr].topWireable THEN -- assumes i is output
BEGIN
t←dwAr[i].dwRight;
doTopWires[i,rr];
dwAr[rr].wiredLeft←dwAr[rr].wiredRight←dwAr[rr].fixed←TRUE;
dwAr[i].wiredLeft←dwAr[i].wiredRight←dwAr[i].fixed←TRUE;
IF dwAr[i].dwLeft=0 AND dwAr[rr].dwRight=0 THEN RETURN;
dwAr[rr].wiredLeft←dwAr[rr].wiredRight←FALSE;
t←dwAr[i].dwLeft;
dwAr[rr].dwLeft←t;
IF t#0 THEN dwAr[t].dwRight←rr;
RETURN;
END;
relLev←0;
FOR t IN [i..rr] DO
SELECT hlAr[t].btyp FROM
met => IF polyWire THEN relLev←MAX[relLev,hlAr[t].distance+2]
ELSE relLev←MAX[relLev,hlAr[t].distance+3];
poly => relLev←MAX[relLev,hlAr[t].distance+2];
cell => IF NOT polyWire THEN
relLev←MAX[relLev,hlAr[t].distance+3];
ENDCASE;
ENDLOOP;
t←i;
UNTIL t=0 DO
rr←finalDW[t];
IF t#rr THEN doSwitch[t,rr];
doDownWire[rr,relLev,(NOT polyWire)];
dwAr[rr].wiredLeft←dwAr[rr].wiredRight←dwAr[rr].fixed←TRUE;
IF polyWire AND t#i THEN EXIT;
t←dwAr[rr].dwRight;
ENDLOOP;
doHWire[i,rr,relLev,polyWire];
IF polyWire THEN
BEGIN
IF dwAr[i].dwLeft=0 AND dwAr[rr].dwRight=0 THEN RETURN;
IF dwAr[rr].dwRight#0 OR dwAr[rr].leftEnd#0 THEN
BEGIN
dwAr[rr].wiredLeft←dwAr[rr].wiredRight←FALSE;
t←dwAr[i].dwLeft;
dwAr[rr].dwLeft←t;
IF t#0 THEN dwAr[t].dwRight←rr;
IF dwAr[rr].leftEnd#0 THEN dwAr[rr].x←dwAr[rr].x-4;
END
ELSE
BEGIN
dwAr[i].wiredLeft←dwAr[i].wiredRight←FALSE;
dwAr[i].dwRight←0;
END;
END;
END;
wireable:PROCEDURE[i,le,re:INTEGER] RETURNS[BOOLEAN,BOOLEAN,INTEGER] =
BEGIN
j:INTEGER←i;
IF dwAr[i].wiredRight AND dwAr[i].wiredLeft THEN
RETURN[FALSE,FALSE,0];
IF dwAr[i].dwRight=i+1 THEN
BEGIN
IF i+1>re OR i<le THEN RETURN[FALSE,FALSE,0];
RETURN[TRUE,TRUE,1];
END;
IF dwAr[i].dwLeft#0 OR i+dwAr[i].rightEnd<le THEN
RETURN[FALSE,FALSE,0];
IF i-dwAr[i].leftEnd>re THEN RETURN[FALSE,FALSE,0];
WHILE dwAr[j].dwRight#0 DO j←dwAr[j].dwRight;ENDLOOP;
UNTIL dwAr[i].fixed OR dwAr[i].rightEnd=0 OR dwAr[i+1].fixed DO
i←i+1;ENDLOOP;
UNTIL dwAr[j].fixed OR dwAr[j].leftEnd=0 OR dwAr[j-1].fixed DO
j←j-1;ENDLOOP;
IF i<le OR j>re THEN RETURN[FALSE,FALSE,0];
RETURN[TRUE,FALSE,runLength[i]];
END;
doDownWire:PROCEDURE[dw,lev:INTEGER,cont:BOOLEAN] =
BEGIN
coff:INTEGER←2;
lev←(lev+hLev)*2;
ll←makeList[makeWire[lev-dwAr[dw].y+4,4,pol]
,dwAr[dw].x-2,dwAr[dw].y,0,0];
mine←insertList[mine,ll];
maxx←MAX[maxx,dwAr[dw].x+2];
IF cont THEN
BEGIN
IF dwAr[dw].dwRight=0
OR (dwAr[dw].dwLeft#0 AND dwAr[dw].rightEnd>0
AND NOT dwAr[dw+1].fixed)
OR (dwAr[dw].andCnt=1 AND dw<downWireCnt AND
dwAr[dw+1].x-dwAr[dw].x<12) THEN coff←6;
IF dwAr[dw].andCnt=1 AND dw>1 AND
dwAr[dw].x-dwAr[dw-1].x<12 THEN coff←2;
ll←makeList[makePolycon[8],dwAr[dw].x-coff,lev,0,0];
mine←insertList[mine,ll];
END;
END;
doHWire:PROCEDURE[l,r,lev:INTEGER,poly:BOOLEAN] =
BEGIN
lv:INTEGER←(lev+hLev)*2;
ll←makeList[makeWire[dwAr[r].x-dwAr[l].x,IF poly THEN 4 ELSE 6,
IF poly THEN pol ELSE met],dwAr[l].x,lv,2,0];
mine←insertList[mine,ll];
FOR i:INTEGER IN [l..r] DO
hlAr[i]←IF poly THEN [poly,lev+2] ELSE [met,lev+4];
ENDLOOP;
maxys←MAX[maxys,lv+(IF poly THEN 4 ELSE 8)];
END;
doTopWires:PROCEDURE[l,r:INTEGER] =
BEGIN
ll←makeList[makeWire[ABS[dwAr[r].ty-dwAr[l].y],4,pol],dwAr[l].x-2,
MIN[dwAr[r].ty,dwAr[l].y],0,0];
mine←insertList[mine,ll];
ll←makeList[makeWire[dwAr[r].tx-dwAr[l].x+2,4,pol]
,dwAr[l].x,MAX[dwAr[r].ty,dwAr[l].y]-4,2,0];
mine←insertList[mine,ll];
END;
finalDW:PROCEDURE[i:INTEGER] RETURNS[INTEGER] =
BEGIN
IF dwAr[i].fixed THEN RETURN[i];
IF dwAr[i].dwLeft=0 THEN {UNTIL dwAr[i].fixed OR
dwAr[i].rightEnd=0 OR dwAr[i+1].fixed DO i←i+1;ENDLOOP;RETURN[i];};
UNTIL dwAr[i].fixed OR dwAr[i].leftEnd=0 OR dwAr[i-1].fixed DO i←i-1;ENDLOOP;
RETURN[i];
END;

conv:PROCEDURE[s:STRING] RETURNS[i:INTEGER] =
BEGIN
i←0;
FOR j:CARDINAL IN [0..s.length) DO
IF NOT s[j] IN [’0..’9] THEN {IF s[j]#15C AND s[j]#33C THEN
i←-1;EXIT;};
i←i*10+(s[j]-’0);
ENDLOOP;
END;


-- M a i n P r o g r a m

myZone ← ZoneAllocDefs.GetAnXMZone[];

BEGIN
ENABLE BEGIN fileErr => GOTO fler;abbrt => GOTO aborts;END; -- for exits

ok,allDone,didOne,tw:BOOLEAN;
i,j,k,aCnt,ai:INTEGER;
le,re:INTEGER;
gp,tgp:LONG POINTER TO GateList;
xx,yy:locNum←0;

mine←NIL;

[gp,downWireCnt,maxNodeNum]←inputCircuit[];
IF gp=NIL THEN GOTO noFile;

tgp←gp;
WHILE tgp#NIL DO
tgp.x←xx;
tgp.y←yy;
maxx←MAX[maxx,xx+tgp.gat.cell.ob.size[0]];
xx←xx+tgp.gat.out.x+2;
IF tgp.nxt#NIL THEN xx←xx+tgp.nxt.gat.lSpac*2;
i←tgp.gat.cell.ob.size[1];
maxys←MAX[maxys,i];
minys←IF minys=0 THEN i ELSE MIN[minys,i];
tgp←tgp.nxt;
ENDLOOP;

tgp←gp;
WHILE tgp#NIL DO
anyChanges←sinceIOchanges←TRUE;
ll←makeList[tgp.gat.cell.ob.p.anotherme[tgp.gat.cell.ob]
,tgp.x,tgp.y,0,0];
mine←insertList[mine,ll];
IF tgp.nxt#NIL THEN
BEGIN
i←yy+MIN[tgp.gat.cell.ob.size[1],tgp.nxt.gat.cell.ob.size[1]];
j←tgp.x+tgp.gat.gnd.x;
ll←makeList[makeWire[tgp.nxt.x+4-j,6,met],j,i-6,2,0];
mine←insertList[mine,ll];
END;
tgp←tgp.nxt;
ENDLOOP;

dwAr←myZone.NEW[downWireArray[downWireCnt+1]];
tgp←gp;
i←1;
WHILE tgp#NIL DO
j←0;
FOR k IN [0..tgp.gat.charac.norCnt) DO
aCnt←tgp.gat.charac.ands[k];
FOR ai IN [0..aCnt) DO
dwAr[i].x ← tgp.x+tgp.gat.ins[j].x;
dwAr[i].y ← tgp.y+tgp.gat.ins[j].y;
dwAr[i].node ← tgp.nodes[j];
dwAr[i].fixed ← aCnt=1;
dwAr[i].andCnt ← aCnt;
dwAr[i].leftEnd ← ai;
dwAr[i].rightEnd ← aCnt-ai-1;
dwAr[i].wiredLeft←dwAr[i].wiredRight←FALSE;
tw← j=0 AND tgp.gat.firstInTopAvail;
dwAr[i].topWireable←tw;
IF tw THEN
BEGIN
dwAr[i].tx ← tgp.x+tgp.gat.firstInTop.x;
dwAr[i].ty ← tgp.y+tgp.gat.firstInTop.y;
END;
i←i+1;
j←j+1;
ENDLOOP;
ENDLOOP;
dwAr[i].x ← tgp.x+tgp.gat.out.x;
dwAr[i].y ← tgp.y+tgp.gat.out.y;
dwAr[i].node ← tgp.outNode;
dwAr[i].fixed ← TRUE;
dwAr[i].andCnt ← 1;
dwAr[i].wiredLeft←dwAr[i].wiredRight←FALSE;
i←i+1;
tgp←tgp.nxt;
ENDLOOP;

nodeAr←myZone.NEW[nodeArray[maxNodeNum+1]];
FOR i IN [0..maxNodeNum] DO nodeAr[i]←0;ENDLOOP;
FOR i IN [1..downWireCnt] DO
ai←dwAr[i].node;
k←nodeAr[ai];
dwAr[i].dwLeft←k;
IF k>0 THEN dwAr[k].dwRight←i;
nodeAr[ai]←i;
ENDLOOP;
FOR i IN [0..maxNodeNum] DO
k←nodeAr[i];
IF k>0 THEN dwAr[k].dwRight←0;
ENDLOOP;

hlAr←myZone.NEW[horLineArray[downWireCnt+1]];
tgp←gp;
i←1;
WHILE tgp#NIL DO
j←(tgp.y+tgp.gat.cell.ob.size[1])/2;
FOR k IN [0..tgp.gat.charac.norCnt) DO
aCnt←tgp.gat.charac.ands[k];
FOR ai IN [0..aCnt) DO
hlAr[i].distance ← j;
hlAr[i].btyp ← cell;
i←i+1;
ENDLOOP;
ENDLOOP;
hlAr[i].distance ← -3;
hlAr[i].btyp ← none;
i←i+1;
tgp←tgp.nxt;
ENDLOOP;
hLev←0;

FOR i IN [1..downWireCnt] DO
IF (dwAr[i].dwLeft=i-1 AND i>1) OR dwAr[i].dwRight=i+1 THEN
dwAr[i].fixed←TRUE;
ENDLOOP;

allDone←FALSE;
UNTIL allDone DO
hLev←moveDown[hLev,0];
[ok,le,re]←findGap[1];
WHILE ok DO
[didOne,allDone]←wireOne[le,re];
IF NOT allDone THEN
[ok,le,re]←findGap[IF didOne THEN le ELSE re+1]
ELSE EXIT;
ENDLOOP
ENDLOOP;

ll←makeList[makeWire[maxx,8,met],0,0,2,0];
mine←insertList[mine,ll];

ll←makeList[makeCell[maxx,maxys,0,mine],markPnt.x,markPnt.y,0,0];
masterList←insertList[masterList,ll];

EXITS fler => []←typeInC["Syntax error in file"L,"Type CR to abort"L,""L];
noFile => []←typeInC["No such file"L,"Type CR to abort"L,""L];
aborts => NULL;
END;

dChange ← TRUE;

myZone ← ZoneAllocDefs.DestroyAnXMZone[myZone];



END. -- of rlmain