-- beadsbelow.mesa
-- watch out for push through!

DIRECTORY IODefs:FROM"IODefs",
BeadsInlines:FROM"BeadsInlines",
InlineDefs:FROM"InlineDefs",
SystemDefs:FROM"SystemDefs",
BeadsDefs:FROM"BeadsDefs";
BeadsBelow:PROGRAM IMPORTS BeadsInlines, InlineDefs, IODefs, BeadsDefs,SystemDefs
EXPORTS BeadsDefs =
BEGIN OPEN BeadsDefs, BeadsInlines;

--/// The operations on the below table are:
--/// Allocate: assign storage (only)
--/// Reset: set up a couple of parameters
--/// Make: build the data structure from the beads
--/// TryAll: use the structure to enumerate all j below i
--/// Free: release storage
--/// Show: print the structure (for debugging only)

Error:SIGNAL=CODE;

worstBelow:PUBLIC CARDINAL;-- a storage performance monitor
moreBelow:PUBLIC BOOLEAN;-- a debugging switch
timeV5,timeV6:PUBLIC LONG CARDINAL←0;-- performance monitors

maxSpit:CARDINAL=4500;
belowData:LONG POINTER TO ARRAY[0..10000] OF CARDINAL←NIL;
belowNext:LONG POINTER TO ARRAY[0..10000] OF CARDINAL←NIL;
--spit:PtrToCardArray;
spit:LONG POINTER TO ARRAY[0..maxSpit] OF CARDINAL←NIL;
topBelow:CARDINAL;
processNo:CARDINAL;

bi:CARDINAL;
id:Desc;
iy,level,delta:INTEGER;
flag:BOOLEAN;
flagBead:CARDINAL;

AllocateBelow:PUBLIC PROCEDURE=BEGIN OPEN SystemDefs;
doradoBelowBase1:LONG CARDINAL=1600000B;
doradoBelowBase2:LONG CARDINAL=1700000B;
spit←AllocateSegment[maxSpit+1];
IF noBelow >6000 THEN BEGIN
belowData←LOOPHOLE[doradoBelowBase1];
belowNext←LOOPHOLE[doradoBelowBase2];
END
ELSE BEGIN
belowData←AllocateSegment[noBelow+1];
belowNext←AllocateSegment[noBelow+1];
END;
END;

FreeBelow:PUBLIC PROCEDURE=BEGIN OPEN SystemDefs;
FreeSegment[InlineDefs.LowHalf[spit]];
IF noBelow >6000 THEN BEGIN
FreeSegment[InlineDefs.LowHalf[belowData]];
FreeSegment[InlineDefs.LowHalf[belowNext]];
END;
END;

ResetBelow:PUBLIC PROCEDURE=BEGIN END;

ShowBelow:PUBLIC PROCEDURE=BEGIN EnumerateBeads[Show2]; END;

Show1:PROCEDURE[i:Desc]=BEGIN OPEN IODefs;
WriteChar[CR ];
WriteNumber[i.z, [10,FALSE,TRUE,3]];
WriteString[": "];
FOR s:CARDINAL←i.p.nextBelow, belowNext[s] UNTIL s=noBelow
DO WriteNumber[belowData[s],[10,FALSE,TRUE,4]]; ENDLOOP;
END;

Show2:PROCEDURE[i:Desc]=BEGIN OPEN IODefs;
bi←i.z;
IF VerticalWire[i] THEN RETURN;
WriteChar[CR ];
WriteNumber[i.z, [10,FALSE,TRUE,3]];
WriteString[": "];
[]←TryAllBelow[i.z,Show3];
END;

Show3:PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]=BEGIN OPEN IODefs;
m:Desc←GetDesc[i];
n:Desc←GetDesc[j];
WriteChar[’( ];
WriteNumber[n.z,[10,FALSE,TRUE,4]];
WriteChar[’ ];
WriteNumber[Delta[m,n].y+Height[n],[10,FALSE,TRUE,4]];
WriteChar[IF StrictlyBelow[n] THEN ’T ELSE ’F ];
WriteChar[’) ];
RETURN[TRUE];
END;

MakeBelow:PUBLIC PROCEDURE=
BEGIN InitBelow[]; SetBelow[0]; SetBelow[1]; SetBelow[2]; END;

--must be three passes because a red can wipe a green out of spit without shielding it

InitBelow:PROCEDURE=BEGIN
Init:PROCEDURE[i:Desc]=
BEGIN wpi:WorkPtr←Getw[i]; wpi.seen←noBead; wpi.oldY←Bot[i]; END;
EnumerateBeads[Init];
MyResetBelow[];
flag←FALSE;
topBelow←177777B;
FOR i:CARDINAL IN [0..noBelow] DO belowNext[i]←noBelow; ENDLOOP;
END;

MyResetBelow:PROCEDURE=BEGIN
Init:PROCEDURE[i:Desc]= BEGIN Getw[i].processNo←0; END;
EnumerateBeads[Init];
processNo←0;
END;

SetBelow:PROCEDURE[l:INTEGER] =BEGIN
--level - 0,1,2,3 are green, red, blue,orange. Transistors are red.
level←l;
delta←SELECT l FROM 0,2=>6, ENDCASE=>4;
IF maxX+10>=maxSpit THEN Error;
FOR s:INTEGER IN [0..maxX] DO spit[s]←noBead; ENDLOOP;
EnumerateSortedBottomUp[SetOneBead];
IF topBelow>worstBelow THEN worstBelow←topBelow;
END;

SetOneBead:PROCEDURE[i:Desc] =BEGIN
soh:INTEGER←desP[Type[i]].stickOutToRight;
low:INTEGER←MAX[Lfm[i]-soh,0];
high:INTEGER←MIN[Rtm[i]+soh,maxX];
bi←i.z;
id←i;
iy←Bot[i];
IF Type[i]=none THEN Error;
IF VerticalWire[i] OR Width[i]<0 THEN RETURN;
SELECT desP[Type[i]].level FROM
level=>BEGIN
ReadyBelow[low-delta,high+delta];
FOR s:[0..10000] IN [low..high) DO spit[s]←i.z; ENDLOOP;
END;
1-level=>ReadyBelow[low-2,high+2];
ENDCASE;
END;

ReadyBelow:PROCEDURE[lowE,highE:INTEGER]=BEGIN
lo:[0..10000]←IF lowE IN [0..maxX] THEN lowE ELSE 0;
hi:[0..10000]←IF highE IN [0..maxX] THEN highE ELSE maxX;
FOR s:[0..10000] IN [lo..hi) DO
ss:Desc←GetDesc[spit[s]];
IF ~NoBead[ss] AND Getw[ss].seen#bi THEN BEGIN
criticalC←ss.p.circuit;
criticalLevel←desP[Type[ss]].level;
LikelyBelow[ss];
END;
ENDLOOP;
END;

LikelyBelow:PROCEDURE[j:Desc]=BEGIN
i:Desc=id;
wpj:WorkPtr←Getw[j];
IF NoBead[j] OR j=i OR wpj.seen=bi OR j.p.circuit#criticalC THEN RETURN;
wpj.seen←bi;
flagBead←j.z;
IF ~VerticalWire[j]
AND StrictlyBelow[j]
AND Width[j]>=0
AND desP[Type[j]].level=criticalLevel
AND ~BracketBead[i,j]
AND ~BracketBead[j,i]
THEN BEGIN
flag←TRUE;
IF TryAllBelow[bi,Dummy] THEN AddToBelow[i,j];
flag←FALSE;
IF SameCircuit[i,j] THEN []←TryAllBelow[j.z,SeeThru];
END;
LikelyBelow[DescR[j]];
LikelyBelow[DescL[j]];
LikelyBelow[DescU[j]];
LikelyBelow[DescD[j]];
LikelyBelow[DescT[j]];
END;

SeeThru:PROCEDURE[i,j:CARDINAL]RETURNS[BOOLEAN]=
{LikelyBelow[GetDesc[j]]; RETURN[TRUE]};

StrictlyBelow:PROCEDURE[j:Desc] RETURNS[BOOLEAN]=BEGIN
delta:Coord←Delta[id,j];
bendableI:BOOLEAN←bendingWires AND id.p.wire;
bendableJ:BOOLEAN←bendingWires AND j.p.wire;
extraROfJ:INTEGER←0;
extraLOfI:INTEGER←0;
extraROfI:INTEGER←0;
extraLOfJ:INTEGER←0;
IF bendableI THEN extraROfI←IF Type[DescR[id]]=tt THEN 0 ELSE Height[id];
IF bendableI THEN extraLOfI←IF Type[DescL[id]]=tt THEN 0 ELSE Height[id];
IF bendableJ THEN extraROfJ←IF Type[DescR[j ]]=tt THEN 0 ELSE Height[j ];
IF bendableJ THEN extraLOfJ←IF Type[DescL[j ]]=tt THEN 0 ELSE Height[j ];
RETURN[ ~VerticalWire[j]
AND Lfm[id]<Rtm[j]+delta.x+extraROfJ+extraLOfI
AND Lfm[j]<Rtm[id]+delta.x+extraROfI+extraLOfJ
AND Bot[j]<=Bot[id]];
END;

criticalC:INTEGER;
criticalLevel:INTEGER;

Dummy:PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]=BEGIN
Error;
RETURN[TRUE];
END;

AddToBelow:PROCEDURE[i,s:Desc]=BEGIN
timeV6←timeV6+1;
-- IODefs.WriteChar[CR ];
-- IODefs.WriteString["AddToBelow "];
-- IODefs.WriteNumber[i.z, [10,FALSE,TRUE,3]];
-- IODefs.WriteNumber[s.z, [10,FALSE,TRUE,3]];
IF i.z>topBead OR s.z>topBead THEN Error;
IF NoBead[s] THEN Error;
IF VerticalWire[id] THEN Error;
IF VerticalWire[s] THEN Error;
IF Unrelated[id,s] THEN Error;
IF Bot[id]<Bot[s] THEN Error;--whether this is <= is very trickey
InsertBelow[id,s.z];
END;

InsertBelow:PROCEDURE[i:Desc,s:CARDINAL]=BEGIN
IF (topBelow←topBelow+1)=noBelow THEN Error;
timeV5←timeV5+1;
belowData[topBelow]←s;
belowNext[topBelow]←i.p.nextBelow;
i.p.nextBelow←topBelow;
IF s=trackBead THEN WriteOneNumber[" Bead Above=",i.z];
IF i.z=trackBead THEN WriteOneNumber[" Bead Below=",s];
END;

TryAllBelow:PUBLIC PROCEDURE[ii:CARDINAL,call:ProcessPair] RETURNS[BOOLEAN]=
BEGIN
i:Desc←GetDesc[ii];
left:Desc←DescL[i];
right:Desc←DescR[i];
IF VerticalWire[i] THEN Error;
IF processNo=177777B THEN BEGIN Error; MyResetBelow[]; END;
processNo←processNo+1;
RETURN[TryABeadAndItsTies[i,i,TRUE,call]
AND TryABeadAndItsTies[i,left,FALSE,call]
AND TryABeadAndItsTies[i,right,FALSE,call]
AND TryJustBelow[i,i,call]
AND (~bendingWires OR ~i.p.wire OR
TryJustBelow[i,left,call] AND TryJustBelow[i,right,call])];
END;

TryABeadAndItsTies:PROCEDURE[i,j:Desc,q:BOOLEAN,call:ProcessPair]
RETURNS[BOOLEAN]= BEGIN
k:Desc;
IF NoBead[j] THEN RETURN[TRUE];
IF i#j AND ~CallBelow[i,j,call] THEN RETURN[FALSE];
k←j;
DO
k←DescT[k];
IF k=j OR NoBead[k] THEN RETURN[TRUE];
IF (Bot[k]<=Bot[j] OR q)
AND ( ~CallBelow[i,k,call]
OR Bot[k]<=Bot[j] AND
(~CallBelow[i,DescR[k],call] OR ~CallBelow[i,DescL[k],call]))
THEN RETURN[FALSE];
--CHECK ~ ON SameLevel
IF ~SameLevel[i,k] AND ~TryJustBelow[i,k,call] THEN RETURN[FALSE];
ENDLOOP;
END;

TryJustBelow:PROCEDURE[i,s:Desc,call:ProcessPair]
RETURNS [t:BOOLEAN]=
BEGIN
j:Desc←DescD[s];
k:Desc←DescD[j];
l:Desc←DescT[k];
m:Desc←DescT[l];
t← NoBead[j] OR NoBead[k]
OR MeLeftRight[i,k,call] AND (NoBead[l]
OR MeLeftRight[i,l,call] AND (m=k OR MeLeftRight[i,m,call]));
IF ~t THEN RETURN[FALSE];
FOR w:CARDINAL←s.p.nextBelow, belowNext[w] UNTIL w=noBelow
DO IF ~MeLeftRight[i,GetDesc[belowData[j.z]],call] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
END;

MeLeftRight:PROCEDURE[i,j:Desc,call:ProcessPair]
RETURNS [t:BOOLEAN]= BEGIN
IF NoBead[j] THEN RETURN[TRUE];
IF TiedBeads[i,j] THEN Error;
IF ~SameLevel[i,j] THEN RETURN[TRUE];
RETURN[cft[i,j,call]
AND cft[i,DescR[j],call]
AND cft[i,DescL[j],call]];
END;

cft:PROCEDURE[i,j:Desc,call:ProcessPair] RETURNS [t:BOOLEAN]= BEGIN
IF NoBead[j] THEN RETURN[TRUE];
IF flag THEN RETURN[j.z#flagBead];
IF TiedBeads[i,j] OR ~SameLevel[i,j] THEN Error;
RETURN[ Getw[j].processNo=processNo OR CallBelow[i,j,call]];
END;

CallBelow:PROCEDURE[i,j:Desc,call:ProcessPair]RETURNS[BOOLEAN]=BEGIN
IF NoBead[j] THEN RETURN[TRUE];
IF flag THEN RETURN[j.z#flagBead] ELSE BEGIN
wpj:WorkPtr←Getw[j];
IF wpj.processNo=processNo THEN RETURN[TRUE];
wpj.processNo←processNo;
IF wpj.oldY>=Getw[i].oldY+Height[i]
AND desP[Type[i]].level#desP[Type[j]].level THEN RETURN[TRUE];
IF ~SameLevel[i,j] AND ~TiedBeads[i,j] THEN RETURN[TRUE];
IF j=i THEN RETURN[TRUE];--move up?
RETURN[call[i.z,j.z]];
END; END;

END..

*AllocateBelow: AllocateSegment(3)
*FreeBelow: FreeSegment(3) LowHalf(3)
*ResetBelow:
*ShowBelow: EnumerateBeads Show2
Show1 WriteChar WriteNumber(2) WriteString
Show2: WriteChar WriteNumber WriteString TryAllBelow Show3
Show3: WriteChar(4) WriteNumber(2) Delta StrictlyBelow
*MakeBelow: InitBelow SetBelow(3)
InitBelow: EnumerateBeads Init MyResetBelow
Init:
MyResetBelow: EnumerateBeads Init
Init:
SetBelow: EnumerateSortedBottomUp SetOneBead
SetOneBead: ReadyBelow(2)
ReadyBelow: LikelyBelow
LikelyBelow: StrictlyBelow BracketBead(2) TryAllBelow(2) Dummy
AddToBelow SeeThru LikelyBelow(5)
SeeThru: LikelyBelow
StrictlyBelow: Delta
Dummy:
AddToBelow: InsertBelow
InsertBelow: WriteOneNumber(2)
*TryAllBelow: MyResetBelow TryABeadAndItsTies(3) TryJustBelow(3)
TryABeadAndItsTies: CallBelow(4) SameLevel TryJustBelow
TryJustBelow: MeLeftRight(4)
MeLeftRight: SameLevel cft(3)
cft: SameLevel CallBelow
CallBelow: SameLevel