-- 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
(1792)