-- file: MFEdgesImpl4.mesa
-- Pascal-to-Mesa translator output, translated at October 31, 1985 4:28:01 pm PST
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFProcArray,
MFMemory,
MFEdges;
MFEdgesImpl4: PROGRAM IMPORTS PascalBasic, MFProcArray, MFMemory, MFEdges EXPORTS MFEdges = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFMemory, MFEdges;
SortEdges: PROCEDURE[H: Halfword] =
BEGIN
K:Halfword;P, Q, R, S:Halfword; R←Mem[ INT[H]+1]↑.Hh.Lh;
Mem[ INT[H]+1]↑.Hh.Lh←0;P←Mem[R]↑.Hh.Rh;Mem[R]↑.Hh.Rh←50000;
Mem[49999]↑.Hh.Rh←R;WHILE INT[P]>1 DO BEGIN K←Mem[P]↑.Hh.Lh;Q←49999;
DO R←Q;Q←Mem[R]↑.Hh.Rh; IF INT[K]<=Mem[Q]↑.Hh.Lh THEN EXIT; ENDLOOP;Mem[R]↑.Hh.Rh←P;
R←Mem[P]↑.Hh.Rh;Mem[P]↑.Hh.Rh←Q;P←R; END ENDLOOP ;--347:--BEGIN R← INT[H]+1;
Q←Mem[R]↑.Hh.Rh;P←Mem[49999]↑.Hh.Rh;{WHILE TRUE DO BEGIN K←Mem[P]↑.Hh.Lh;
WHILE INT[K]>Mem[Q]↑.Hh.Lh DO BEGIN R←Q;Q←Mem[R]↑.Hh.Rh; END ENDLOOP ;Mem[R]↑.Hh.Rh←P;
S←Mem[P]↑.Hh.Rh;Mem[P]↑.Hh.Rh←Q;IF S=50000 THEN GOTO Label30;R←P;P←S; END ENDLOOP ;
EXITS Label30 => NULL}; END--:347--; END;--:346----348:
CullEdges: PROCEDURE[WLo,WHi,WOut,WIn: PascalInteger] =
BEGIN
P, Q, R, S:Halfword;W:PascalInteger;D:PascalInteger;M:PascalInteger;Mm:PascalInteger;
Ww:PascalInteger;PrevW:PascalInteger;N, MinN, MaxN:Halfword;MinD, MaxD:Halfword;
MinD←65535;MaxD←0;MinN←65535;MaxN←0;
P←Mem[CurEdges]↑.Hh.Rh;N←Mem[ INT[CurEdges]+1]↑.Hh.Lh;
WHILE P#CurEdges DO BEGIN IF INT[Mem[ INT[P]+1]↑.Hh.Lh]>1 THEN SortEdges[P];
IF Mem[ INT[P]+1]↑.Hh.Rh#50000 THEN--349:--BEGIN R←49999;Q←Mem[ INT[P]+1]↑.Hh.Rh;
Ww←0;M←1000000;PrevW←0;
{WHILE TRUE DO BEGIN IF Q=50000 THEN Mm←1000000 ELSE BEGIN D←Mem[Q]↑.Hh.
Lh;Mm← PascalDIVPower2[D ,3];Ww←Ww+( PascalMODPower2Mask[D ,7])-4; END;IF Mm>M THEN BEGIN--350:
IF W#PrevW THEN BEGIN S←GetAvail[];Mem[R]↑.Hh.Rh←S;
Mem[S]↑.Hh.Lh←8*M+4+W-PrevW;R←S;PrevW←W; END--:350--;
IF Q=50000 THEN GOTO Label30; END;M←Mm;
IF Ww>=WLo THEN IF Ww<=WHi THEN W←WIn ELSE W←WOut ELSE W←WOut;
S←Mem[Q]↑.Hh.Rh;BEGIN Mem[Q]↑.Hh.Rh←Avail;Avail←Q;DynUsed←DynUsed-1;
END;Q←S; END ENDLOOP ;EXITS Label30 => NULL};Mem[R]↑.Hh.Rh←50000;Mem[ INT[P]+1]↑.Hh.Rh←Mem[49999]↑.Hh.Rh;
IF R#49999 THEN--351:--BEGIN IF MinN=65535 THEN MinN←N;MaxN←N;
IF INT[MinD]>Mem[Mem[49999]↑.Hh.Rh]↑.Hh.Lh THEN MinD←Mem[Mem[49999]↑.Hh.Rh]↑.
Hh.Lh;IF INT[MaxD]<Mem[R]↑.Hh.Lh THEN MaxD←Mem[R]↑.Hh.Lh; END--:351--; END--:349
;P←Mem[P]↑.Hh.Rh;N← INT[N]+1; END ENDLOOP ;--352:--IF INT[MinN]>MaxN THEN--353:
BEGIN P←Mem[CurEdges]↑.Hh.Rh;
WHILE P#CurEdges DO BEGIN Q←Mem[P]↑.Hh.Rh;FreeNode[P,2];P←Q; END ENDLOOP ;
InitEdges[CurEdges]; END--:353-- ELSE BEGIN N←Mem[ INT[CurEdges]+1]↑.Hh.Lh;
Mem[ INT[CurEdges]+1]↑.Hh.Lh←MinN;
WHILE INT[MinN]>N DO BEGIN P←Mem[CurEdges]↑.Hh.Rh;
Mem[CurEdges]↑.Hh.Rh←Mem[P]↑.Hh.Rh;Mem[Mem[P]↑.Hh.Rh]↑.Hh.Lh←CurEdges;
FreeNode[P,2];N← INT[N]+1; END ENDLOOP ;N←Mem[ INT[CurEdges]+1]↑.Hh.Rh;
Mem[ INT[CurEdges]+1]↑.Hh.Rh←MaxN;Mem[ INT[CurEdges]+5]↑.Hh.Lh← INT[MaxN]+1;
Mem[ INT[CurEdges]+5]↑.Hh.Rh←CurEdges;
WHILE INT[MaxN]<N DO BEGIN P←Mem[CurEdges]↑.Hh.Lh;
Mem[CurEdges]↑.Hh.Lh←Mem[P]↑.Hh.Lh;Mem[Mem[P]↑.Hh.Lh]↑.Hh.Rh←CurEdges;
FreeNode[P,2];N← INT[N]-1; END ENDLOOP ;
Mem[ INT[CurEdges]+2]↑.Hh.Lh←( PascalDIVPower2[(MinD),3])-Mem[ INT[CurEdges]+3]↑.Hh.Lh+4096;
Mem[ INT[CurEdges]+2]↑.Hh.Rh←( PascalDIVPower2[(MaxD),3])-Mem[ INT[CurEdges]+3]↑.Hh.Lh+4096;
END--:352--;Mem[ INT[CurEdges]+4]↑.Int←0; END;--:348----354:
MergeEdges: PROCEDURE[H: Halfword] =
BEGIN
P, Q, R, Pp, Qq, Rr:Halfword;N:PascalInteger;K:Halfword;Delta:PascalInteger;
IF Mem[H]↑.Hh.Rh#H THEN BEGIN IF( INT[Mem[ INT[H]+2]↑.Hh.Lh]<Mem[ INT[CurEdges]+2]↑.
Hh.Lh)OR ( INT[Mem[ INT[H]+2]↑.Hh.Rh]>Mem[ INT[CurEdges]+2]↑.Hh.Rh)OR ( INT[Mem[ INT[H]+1]↑.Hh.Lh]<Mem[
INT[CurEdges]+1]↑.Hh.Lh)OR ( INT[Mem[ INT[H]+1]↑.Hh.Rh]>Mem[ INT[CurEdges]+1]↑.Hh.Rh) THEN
EdgePrep[ INT[Mem[ INT[H]+2]↑.Hh.Lh]-4096, INT[Mem[ INT[H]+2]↑.Hh.Rh]-4096, INT[Mem[ INT[H]+1]↑.Hh.Lh]-4096,
INT[Mem[ INT[H]+1]↑.Hh.Rh]-4095];
IF Mem[ INT[H]+3]↑.Hh.Lh#Mem[ INT[CurEdges]+3]↑.Hh.Lh THEN--367:
BEGIN Pp←Mem[H]↑.Hh.Rh;Delta←8*( INT[Mem[ INT[CurEdges]+3]↑.Hh.Lh]-Mem[ INT[H]+3]↑.Hh.Lh);
DO Qq←Mem[ INT[Pp]+1]↑.Hh.Rh;
WHILE Qq#50000 DO BEGIN Mem[Qq]↑.Hh.Lh←Mem[Qq]↑.Hh.Lh+Delta;
Qq←Mem[Qq]↑.Hh.Rh; END ENDLOOP ;Qq←Mem[ INT[Pp]+1]↑.Hh.Lh;
WHILE INT[Qq]>1 DO BEGIN Mem[Qq]↑.Hh.Lh←Mem[Qq]↑.Hh.Lh+Delta;
Qq←Mem[Qq]↑.Hh.Rh; END ENDLOOP ;Pp←Mem[Pp]↑.Hh.Rh; IF Pp=H THEN EXIT; ENDLOOP; END--:367--;
N←Mem[ INT[CurEdges]+1]↑.Hh.Lh;P←Mem[CurEdges]↑.Hh.Rh;Pp←Mem[H]↑.Hh.Rh;
WHILE N<Mem[ INT[H]+1]↑.Hh.Lh DO BEGIN N←N+1;P←Mem[P]↑.Hh.Rh; END ENDLOOP ;DO--368:
Qq←Mem[ INT[Pp]+1]↑.Hh.Lh;
IF INT[Qq]>1 THEN IF INT[Mem[ INT[P]+1]↑.Hh.Lh]<=1 THEN Mem[ INT[P]+1]↑.Hh.Lh←Qq ELSE BEGIN
WHILE INT[Mem[Qq]↑.Hh.Rh]>1 DO Qq←Mem[Qq]↑.Hh.Rh ENDLOOP ;
Mem[Qq]↑.Hh.Rh←Mem[ INT[P]+1]↑.Hh.Lh;Mem[ INT[P]+1]↑.Hh.Lh←Mem[ INT[Pp]+1]↑.Hh.Lh; END;
Mem[ INT[Pp]+1]↑.Hh.Lh←0;Qq←Mem[ INT[Pp]+1]↑.Hh.Rh;
{IF Qq#50000 THEN BEGIN IF Mem[ INT[P]+1]↑.Hh.Lh=1 THEN Mem[ INT[P]+1]↑.Hh.Lh←0;
Mem[ INT[Pp]+1]↑.Hh.Rh←50000;R← INT[P]+1;Q←Mem[R]↑.Hh.Rh;
IF Q=50000 THEN Mem[ INT[P]+1]↑.Hh.Rh←Qq ELSE WHILE TRUE DO BEGIN K←Mem[Qq]↑.
Hh.Lh;WHILE INT[K]>Mem[Q]↑.Hh.Lh DO BEGIN R←Q;Q←Mem[R]↑.Hh.Rh; END ENDLOOP ;
Mem[R]↑.Hh.Rh←Qq;Rr←Mem[Qq]↑.Hh.Rh;Mem[Qq]↑.Hh.Rh←Q;
IF Rr=50000 THEN GOTO Label30;R←Qq;Qq←Rr; END ENDLOOP ; END;EXITS Label30 => NULL};--:368--Pp←Mem[Pp]↑.Hh.Rh;P←Mem[P]↑.Hh.Rh; IF Pp=H THEN EXIT; ENDLOOP; END; END;--:366----369:
TotalWeight: PROCEDURE[H: Halfword] RETURNS[TotalWeightResult: PascalInteger] =
BEGIN P, Q:Halfword;N:PascalInteger;
M:PascalInteger[0..65535]; N←0;P←Mem[H]↑.Hh.Rh;
WHILE P#H DO BEGIN Q←Mem[ INT[P]+1]↑.Hh.Rh;WHILE Q#50000 DO--370:
BEGIN M←Mem[Q]↑.Hh.Lh;N←N-(( PascalMODPower2Mask[M ,7])-4)*( PascalDIVPower2[M ,3]);Q←Mem[Q]↑.Hh.Rh;
END--:370-- ENDLOOP ;Q←Mem[ INT[P]+1]↑.Hh.Lh;WHILE INT[Q]>1 DO--370:--BEGIN M←Mem[Q]↑.Hh.Lh;
N←N-(( PascalMODPower2Mask[M ,7])-4)*( PascalDIVPower2[M ,3]);Q←Mem[Q]↑.Hh.Rh; END--:370-- ENDLOOP ;P←Mem[P]↑.Hh.Rh;
END ENDLOOP ;TotalWeightResult←N; END;--:369----372:--
END.