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

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

--/// 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..2] OF CARDINAL←NIL;
belowNext:LONG POINTER TO ARRAY[0..2] OF CARDINAL←NIL;
spit:PtrToCardArray;
topBelow:CARDINAL;
processNo:CARDINAL;

bpi,bps:BeadPtr;
bi,bs:CARDINAL;
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[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:CARDINAL,bpi:BeadPtr]=BEGIN OPEN IODefs; s:CARDINAL;
WriteChar[CR ];
WriteNumber[i, [10,FALSE,TRUE,3]];
WriteString[": "];
FOR s←Get[i].nextBelow, belowNext[s] UNTIL s=noBelow
DO WriteNumber[belowData[s],[10,FALSE,TRUE,4]]; ENDLOOP;
END;

Show2:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN OPEN IODefs;
bi←i;
IF bpi.wire AND bpi.beadR=noBead THEN RETURN;
WriteChar[CR ];
WriteNumber[i, [10,FALSE,TRUE,3]];
WriteString[": "];
[]←TryAllBelow[i,Show3];
END;

Show3:PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]=BEGIN OPEN IODefs;
y:INTEGER;
[,y]←Deltas[i,j];
y←y+Get[j].h;
WriteChar[’( ];
WriteNumber[j,[10,FALSE,TRUE,4]];
WriteChar[’ ];
WriteNumber[y,[10,FALSE,TRUE,4]];
WriteChar[IF StrictlyBelow[j] 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 i:CARDINAL; wpi:WorkPtr;
FOR i IN [0..topBead]
DO wpi←GetW[i]; wpi.seen←noBead; wpi.oldY←Get[i].y; ENDLOOP;
MyResetBelow[];
flag←FALSE;
topBelow←177777B;
FOR i IN [0..noBelow] DO belowNext[i]←noBelow; ENDLOOP;
END;

MyResetBelow:PROCEDURE=BEGIN i:CARDINAL;
FOR i IN [0..topBead] DO GetW[i].processNo←0; ENDLOOP;
processNo←0;
END;

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

SetOneBead:PROCEDURE[i:CARDINAL,bpix:BeadPtr] =BEGIN
soh:INTEGER←desP[bpix.t].stickOutToRight;
low:INTEGER←MAX[bpix.x-soh,0];
high:INTEGER←MIN[bpix.x+bpix.w+soh,maxX];
bpi←bpix;
bi←i;
iy←bpi.y;
IF bpi.t=none THEN Error;
IF bpi.wire AND bpi.beadU#noBead OR bpi.w<0 THEN RETURN;
SELECT desP[bpi.t].level FROM
level=>BEGIN
s:[0..10000];
ReadyBelow[low-delta,high+delta,i];
FOR s IN [low..high) DO spit[s]←i; ENDLOOP;
END;
1-level=>ReadyBelow[low-2,high+2,i];
ENDCASE;
END;

ReadyBelow:PROCEDURE[lowE,highE:[0..10000],i:CARDINAL]=BEGIN
s:[0..10000]; ss:CARDINAL; bpss:BeadPtr;
IF lowE NOT IN [0..maxX] THEN lowE←0;
IF highE NOT IN [0..maxX] THEN highE←maxX;
FOR s IN [lowE..highE) DO
ss←spit[s];
IF ss#noBead AND GetW[ss].seen#bi THEN BEGIN
bpss←Get[ss];
criticalC←bpss.circuit;
criticalLevel←desP[bpss.t].level;
LikelyBelow[ss];
END;
ENDLOOP;
END;

LikelyBelow:PROCEDURE[j:CARDINAL]=BEGIN
bpj:BeadPtr←Get[j];
wpj:WorkPtr←GetW[j];
IF j=noBead OR j=bi OR wpj.seen=bi OR bpj.circuit#criticalC THEN RETURN;
wpj.seen←bi;
flagBead←j;
IF ~(bpj.wire AND bpj.beadU#noBead)
AND StrictlyBelow[j]
AND bpj.w>=0
AND desP[bpj.t].level=criticalLevel
AND ~(bpi.beadL=bpj.beadR AND bpi.beadL#noBead)
AND ~(bpi.beadR=bpj.beadL AND bpi.beadR#noBead)
THEN BEGIN
flag←TRUE;
IF TryAllBelow[bi,Dummy] THEN AddToBelow[bi,j];
flag←FALSE;
IF bpi.circuit=bpj.circuit THEN []←TryAllBelow[j,SeeThru];
END;
LikelyBelow[bpj.beadR];
LikelyBelow[bpj.beadL];
LikelyBelow[bpj.beadU];
LikelyBelow[bpj.beadD];
LikelyBelow[bpj.beadT];
END;

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

StrictlyBelow:PROCEDURE[j:CARDINAL] RETURNS[BOOLEAN]=BEGIN
bpj:BeadPtr←Get[j];
deltaX:INTEGER;
bendableI:BOOLEAN←bendingWires AND bpi.wire;
bendableJ:BOOLEAN←bendingWires AND bpj.wire;
extraRightOfJ:INTEGER←0;
extraLeftOfI:INTEGER←0;
extraRightOfI:INTEGER←0;
extraLeftOfJ:INTEGER←0;
IF bendableI THEN extraRightOfI←IF Get[bpi.beadR].t=tt THEN 0 ELSE bpi.h;
IF bendableI THEN extraLeftOfI←IF Get[bpi.beadL].t=tt THEN 0 ELSE bpi.h;
IF bendableJ THEN extraRightOfJ←IF Get[bpj.beadR].t=tt THEN 0 ELSE bpj.h;
IF bendableJ THEN extraLeftOfJ←IF Get[bpj.beadL].t=tt THEN 0 ELSE bpj.h;
[deltaX,]←Deltas[bi,j];
RETURN[ ~(bpj.wire AND bpj.beadR=noBead)
AND bpi.x<bpj.x+bpj.w+deltaX+extraRightOfJ+extraLeftOfI
AND bpj.x<bpi.x+bpi.w+deltaX+extraRightOfI+extraLeftOfJ
AND bpj.y<=bpi.y];
END;

criticalC:INTEGER;
criticalLevel:INTEGER;

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

AddToBelow:PROCEDURE[i,s:CARDINAL]=BEGIN
bs←s; bps←Get[s];--really local
timeV6←timeV6+1;
-- IODefs.WriteChar[CR ];
-- IODefs.WriteString["AddToBelow "];
-- IODefs.WriteNumber[i, [10,FALSE,TRUE,3]];
-- IODefs.WriteNumber[s, [10,FALSE,TRUE,3]];
IF i>topBead OR s>topBead THEN Error;
IF s=noBead THEN Error;
IF bpi.wire AND bpi.beadR=noBead THEN Error;
IF bps.wire AND bps.beadR=noBead THEN Error;
IF desP[bpi.t].lessLevel#desP[bps.t].lessLevel THEN Error;
IF bpi.beadL=bps.beadR AND bpi.beadL#noBead THEN Error;
IF bpi.beadR=bps.beadL AND bpi.beadR#noBead THEN Error;
IF bpi.y<bps.y THEN Error;--whether this is <= is very trickey
InsertBelow[bpi,i,s];
END;

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

TryAllBelow:PUBLIC PROCEDURE[i:CARDINAL,call:ProcessPair] RETURNS[BOOLEAN]=
BEGIN
bpi:BeadPtr←Get[i];
left:CARDINAL←bpi.beadL;
right:CARDINAL←bpi.beadR;
IF bpi.wire AND left=noBead THEN Error;
IF processNo=177777B THEN BEGIN Error; MyResetBelow[]; END;
processNo←processNo+1;
RETURN[TryABeadAndItsTies[bpi,i,i,TRUE,call]
AND TryABeadAndItsTies[bpi,i,left,FALSE,call]
AND TryABeadAndItsTies[bpi,i,right,FALSE,call]
AND TryJustBelow[bpi,i,i,call]
AND (~bendingWires OR ~bpi.wire OR
TryJustBelow[bpi,i,left,call] AND TryJustBelow[bpi,i,right,call])];
END;

TryABeadAndItsTies:
PROCEDURE[bpi:BeadPtr,i,j:CARDINAL,q:BOOLEAN,call:ProcessPair]
RETURNS[BOOLEAN]= BEGIN
k:CARDINAL←j;
pbj:BeadPtr←Get[j];
pbk:BeadPtr;
IF j=noBead THEN RETURN[TRUE];
IF i#j AND ~CallBelow[bpi,i,j,call] THEN RETURN[FALSE];
DO
k←Get[k].beadT; pbk←Get[k];
IF k=j OR k=noBead THEN RETURN[TRUE];
IF (pbk.y<=pbj.y OR q)
AND ( ~CallBelow[bpi,i,k,call]
OR pbk.y<=pbj.y
AND (~CallBelow[bpi,i,pbk.beadR,call] OR ~CallBelow[bpi,i,pbk.beadL,call]))
THEN RETURN[FALSE];
IF desP[bpi.t].lessLevel=desP[pbk.t].lessLevel
AND ~TryJustBelow[bpi,i,k,call] THEN RETURN [FALSE];
ENDLOOP;
END;

TryJustBelow:PROCEDURE[bpi:BeadPtr,i,s:CARDINAL,call:ProcessPair]
RETURNS [t:BOOLEAN]=
BEGIN
j:CARDINAL←Get[s].beadD;
k:CARDINAL←Get[j].beadD;
l:CARDINAL←Get[k].beadT;
m:CARDINAL←Get[l].beadT;
t← j=noBead OR k=noBead
OR MeLeftRight[bpi,i,k,call] AND (l=noBead
OR MeLeftRight[bpi,i,l,call] AND (m=k OR MeLeftRight[bpi,i,m,call]));
IF ~t THEN RETURN[FALSE];
FOR j←Get[s].nextBelow, belowNext[j] UNTIL j=noBelow
DO IF ~MeLeftRight[bpi,i,belowData[j],call] THEN RETURN[FALSE]; ENDLOOP;
RETURN[TRUE];
END;

MeLeftRight:PROCEDURE[bpi:BeadPtr,i,j:CARDINAL,call:ProcessPair] RETURNS [t:BOOLEAN]= BEGIN
bpj:BeadPtr←Get[j];
IF bpi.beadT=j OR bpj.beadT=i THEN Error;
IF desP[bpi.t].lessLevel#desP[bpj.t].lessLevel THEN RETURN[TRUE];
IF j=noBead THEN RETURN[TRUE];
RETURN[cft[bpi,i,j,call]
AND cft[bpi,i,bpj.beadR,call]
AND cft[bpi,i,bpj.beadL,call]];
END;

cft:PROCEDURE[bpi:BeadPtr,i,j:CARDINAL,call:ProcessPair] RETURNS [t:BOOLEAN]= BEGIN
bpj:BeadPtr;
IF j=noBead THEN RETURN[TRUE];
IF flag THEN RETURN[j#flagBead];
bpj←Get[j];
IF bpi.beadT=j OR bpj.beadT=i THEN Error;
IF desP[bpi.t].lessLevel#desP[bpj.t].lessLevel THEN Error;
RETURN[ GetW[j].processNo=processNo OR CallBelow[bpi,i,j,call]];
END;

CallBelow:PROCEDURE[bpi:BeadPtr,i,j:CARDINAL,call:ProcessPair] RETURNS[BOOLEAN]=BEGIN
wpj:WorkPtr;
bpj:BeadPtr;
IF j=noBead THEN RETURN[TRUE];
IF flag THEN RETURN[j#flagBead];
wpj←GetW[j];
IF wpj.processNo=processNo THEN RETURN[TRUE];
wpj.processNo←processNo;
bpj←Get[j];
IF wpj.oldY>=GetW[i].oldY+bpi.h AND desP[bpi.t].level#desP[bpj.t].level
THEN RETURN[TRUE];
IF desP[bpi.t].lessLevel#desP[bpj.t].lessLevel
AND bpi.beadT#j AND bpj.beadT#i THEN RETURN[TRUE];
IF j=i THEN RETURN[TRUE];--move up?
RETURN[call[i,j]];
END;

END..