-- file: MFEdgesImpl1.mesa
-- Pascal-to-Mesa translator output, translated at October 31, 1985 4:28:01 pm PST
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFProcArray,
MFInteraction,
MFMemory,
MFEdges;
MFEdgesImpl1: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMemory EXPORTS MFEdges = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMemory, MFEdges;
--:309----327:--
CurEdges: Halfword;
CurWt: PascalInteger;
--:327----371:--
TraceX: PascalInteger;
TraceY: PascalInteger;
TraceYy: PascalInteger;
--332:----333:-- PrintWeight: PROCEDURE[Q: Halfword,XOff: PascalInteger]
=
BEGIN W, M:PascalInteger;D:PascalInteger; D←Mem[Q]↑.Hh.Lh;W← PascalMODPower2Mask[D ,7];
M←( PascalDIVPower2[D ,3])-Mem[ INT[CurEdges]+3]↑.Hh.Lh;
IF INT[FileOffset]>MaxPrintLine-9 THEN PrintNl[32] ELSE PrintChar[32];
PrintInt[M+XOff];WHILE W>4 DO BEGIN PrintChar[43];W←W-1; END ENDLOOP ;
WHILE W<4 DO BEGIN PrintChar[45];W←W+1; END ENDLOOP ; END;--:333
PrintEdges: PROCEDURE[S: StrNumber,Nuline: PascalBoolean,XOff,YOff: PascalInteger]
=
BEGIN P, Q, R:Halfword;N:PascalInteger; PrintDiagnostic[400,S,Nuline];
P←Mem[CurEdges]↑.Hh.Lh;N← INT[Mem[ INT[CurEdges]+1]↑.Hh.Rh]-4096;
WHILE P#CurEdges DO BEGIN Q←Mem[ INT[P]+1]↑.Hh.Lh;R←Mem[ INT[P]+1]↑.Hh.Rh;
IF( INT[Q]>1)OR (R#50000) THEN BEGIN PrintNl[401];PrintInt[N+YOff];
PrintChar[58];WHILE INT[Q]>1 DO BEGIN PrintWeight[Q,XOff];Q←Mem[Q]↑.Hh.Rh;
END ENDLOOP ;Print[402];WHILE R#50000 DO BEGIN PrintWeight[R,XOff];
R←Mem[R]↑.Hh.Rh; END ENDLOOP ; END;P←Mem[P]↑.Hh.Lh;N←N-1; END ENDLOOP ;EndDiagnostic[TRUE];
END;--:332----388:-- TossEdges: PROCEDURE[H: Halfword]
=
BEGIN P, Q:Halfword; Q←Mem[H]↑.Hh.Rh;
WHILE Q#H DO BEGIN FlushList[Mem[ INT[Q]+1]↑.Hh.Rh];
IF INT[Mem[ INT[Q]+1]↑.Hh.Lh]>1 THEN FlushList[Mem[ INT[Q]+1]↑.Hh.Lh];P←Q;
Q←Mem[Q]↑.Hh.Rh;FreeNode[P,2]; END ENDLOOP ;FreeNode[H,6]; END;--:385----487:
InitEdges: PROCEDURE[H: Halfword] =
BEGIN Mem[H]↑.Hh.Lh←H;
Mem[H]↑.Hh.Rh←H;Mem[ INT[H]+1]↑.Hh.Lh←8191;Mem[ INT[H]+1]↑.Hh.Rh←1;
Mem[ INT[H]+2]↑.Hh.Lh←8191;Mem[ INT[H]+2]↑.Hh.Rh←1;Mem[ INT[H]+3]↑.Hh.Lh←4096;
Mem[ INT[H]+3]↑.Hh.Rh←0;Mem[ INT[H]+4]↑.Int←0;Mem[ INT[H]+5]↑.Hh.Rh←H;Mem[ INT[H]+5]↑.Hh.Lh←0;
END;--:326----328:-- FixOffset: PROCEDURE =
BEGIN P, Q:Halfword;Delta:PascalInteger;
Delta←8*( INT[Mem[ INT[CurEdges]+3]↑.Hh.Lh]-4096);
Mem[ INT[CurEdges]+3]↑.Hh.Lh←4096;Q←Mem[CurEdges]↑.Hh.Rh;
WHILE Q#CurEdges DO BEGIN P←Mem[ INT[Q]+1]↑.Hh.Rh;
WHILE P#50000 DO BEGIN Mem[P]↑.Hh.Lh←Mem[P]↑.Hh.Lh-Delta;
P←Mem[P]↑.Hh.Rh; END ENDLOOP ;P←Mem[ INT[Q]+1]↑.Hh.Lh;
WHILE INT[P]>1 DO BEGIN Mem[P]↑.Hh.Lh←Mem[P]↑.Hh.Lh-Delta;P←Mem[P]↑.Hh.Rh; END ENDLOOP ;
Q←Mem[Q]↑.Hh.Rh; END ENDLOOP ; END;--:328----329:
EdgePrep: PROCEDURE[Ml,Mr,Nl,Nr: PascalInteger] =
BEGIN Delta:Halfword;
P, Q:Halfword; Ml←Ml+4096;Mr←Mr+4096;Nl←Nl+4096;Nr←Nr+4095;
IF Ml<Mem[ INT[CurEdges]+2]↑.Hh.Lh THEN Mem[ INT[CurEdges]+2]↑.Hh.Lh←Ml;
IF Mr>Mem[ INT[CurEdges]+2]↑.Hh.Rh THEN Mem[ INT[CurEdges]+2]↑.Hh.Rh←Mr;
IF
NOT (ABS[ INT[Mem[ INT[CurEdges]+2]↑.Hh.Lh]+Mem[ INT[CurEdges]+3]↑.Hh.Lh-8192]<4096)OR NOT (ABS[ INT[Mem[ INT[CurEdges]+2]↑.Hh.Rh]+Mem[ INT[CurEdges]+3]↑.Hh.Lh-8192]<4096) THEN
FixOffset[];
IF Mem[CurEdges]↑.Hh.Rh=CurEdges THEN BEGIN Mem[ INT[CurEdges]+1]↑.Hh.Lh←Nr
+1;Mem[ INT[CurEdges]+1]↑.Hh.Rh←Nr; END;
IF Nl<Mem[ INT[CurEdges]+1]↑.Hh.Lh THEN--330:
BEGIN Delta←Mem[ INT[CurEdges]+1]↑.Hh.Lh-Nl;Mem[ INT[CurEdges]+1]↑.Hh.Lh←Nl;
P←Mem[CurEdges]↑.Hh.Rh;DO Q←GetNode[2];Mem[ INT[Q]+1]↑.Hh.Rh←50000;
Mem[ INT[Q]+1]↑.Hh.Lh←1;Mem[P]↑.Hh.Lh←Q;Mem[Q]↑.Hh.Rh←P;P←Q;Delta← INT[Delta]-1;
IF Delta=0 THEN EXIT; ENDLOOP;Mem[P]↑.Hh.Lh←CurEdges;Mem[CurEdges]↑.Hh.Rh←P;
IF Mem[ INT[CurEdges]+5]↑.Hh.Rh=CurEdges THEN Mem[ INT[CurEdges]+5]↑.Hh.Lh←Nl-1;
END--:330--;IF Nr>Mem[ INT[CurEdges]+1]↑.Hh.Rh THEN--331:
BEGIN Delta←Nr-Mem[ INT[CurEdges]+1]↑.Hh.Rh;Mem[ INT[CurEdges]+1]↑.Hh.Rh←Nr;
P←Mem[CurEdges]↑.Hh.Lh;DO Q←GetNode[2];Mem[ INT[Q]+1]↑.Hh.Rh←50000;
Mem[ INT[Q]+1]↑.Hh.Lh←1;Mem[P]↑.Hh.Rh←Q;Mem[Q]↑.Hh.Lh←P;P←Q;Delta← INT[Delta]-1;
IF Delta=0 THEN EXIT; ENDLOOP;Mem[P]↑.Hh.Rh←CurEdges;Mem[CurEdges]↑.Hh.Lh←P;
IF Mem[ INT[CurEdges]+5]↑.Hh.Rh=CurEdges THEN Mem[ INT[CurEdges]+5]↑.Hh.Lh←Nr+1;
END--:331--; END;--:329----334:-- CopyEdges: PROCEDURE[H: Halfword] RETURNS[CopyEdgesResult: Halfword]
=
BEGIN P, R:Halfword;Hh, Pp, Qq, Rr, Ss:Halfword; Hh←GetNode[6];
Mem[ INT[Hh]+1]↑←Mem[ INT[H]+1]↑;Mem[ INT[Hh]+2]↑←Mem[ INT[H]+2]↑;Mem[ INT[Hh]+3]↑←Mem[ INT[H]+3]↑;
Mem[ INT[Hh]+4]↑←Mem[ INT[H]+4]↑;Mem[ INT[Hh]+5]↑.Hh.Lh← INT[Mem[ INT[Hh]+1]↑.Hh.Rh]+1;
Mem[ INT[Hh]+5]↑.Hh.Rh←Hh;P←Mem[H]↑.Hh.Rh;Qq←Hh;
WHILE P#H DO BEGIN Pp←GetNode[2];Mem[Qq]↑.Hh.Rh←Pp;Mem[Pp]↑.Hh.Lh←Qq;
--335:--R←Mem[ INT[P]+1]↑.Hh.Rh;Rr← INT[Pp]+1;WHILE R#50000 DO BEGIN Ss←GetAvail[];
Mem[Rr]↑.Hh.Rh←Ss;Rr←Ss;Mem[Rr]↑.Hh.Lh←Mem[R]↑.Hh.Lh;R←Mem[R]↑.Hh.Rh;
END ENDLOOP ;Mem[Rr]↑.Hh.Rh←50000;R←Mem[ INT[P]+1]↑.Hh.Lh;Rr←49999;
WHILE INT[R]>1 DO BEGIN Ss←GetAvail[];Mem[Rr]↑.Hh.Rh←Ss;Rr←Ss;
Mem[Rr]↑.Hh.Lh←Mem[R]↑.Hh.Lh;R←Mem[R]↑.Hh.Rh; END ENDLOOP ;Mem[Rr]↑.Hh.Rh←R;
Mem[ INT[Pp]+1]↑.Hh.Lh←Mem[49999]↑.Hh.Rh--:335--;P←Mem[P]↑.Hh.Rh;Qq←Pp; END ENDLOOP ;
Mem[Qq]↑.Hh.Rh←Hh;Mem[Hh]↑.Hh.Lh←Qq;CopyEdgesResult←Hh; END;--:334----336:
NegateEdges: PROCEDURE[H: Halfword] =
BEGIN P, Q, R, S, T, U:Halfword;
P←Mem[H]↑.Hh.Rh;WHILE P#H DO BEGIN Q←Mem[ INT[P]+1]↑.Hh.Lh;
WHILE INT[Q]>1 DO BEGIN Mem[Q]↑.Hh.Lh←8-2*( PascalMODPower2Mask[(Mem[Q]↑.Hh.Lh),7])+Mem[Q]↑.Hh.Lh;
Q←Mem[Q]↑.Hh.Rh; END ENDLOOP ;Q←Mem[ INT[P]+1]↑.Hh.Rh;
IF Q#50000 THEN BEGIN DO Mem[Q]↑.Hh.Lh←
8-2*( PascalMODPower2Mask[(Mem[Q]↑.Hh.Lh),7])+Mem[Q]↑.Hh.Lh;Q←Mem[Q]↑.Hh.Rh; IF Q=50000 THEN EXIT; ENDLOOP;--345:--U← INT[P]+1;Q←Mem[U]↑.Hh.Rh;
R←Q;S←Mem[R]↑.Hh.Rh;
{WHILE TRUE DO IF INT[Mem[S]↑.Hh.Lh]>Mem[R]↑.Hh.Lh THEN BEGIN Mem[U]↑.Hh.Rh←Q;
IF S=50000 THEN GOTO Label30;U←R;Q←S;R←Q;S←Mem[R]↑.Hh.Rh;
END ELSE BEGIN T←S;S←Mem[T]↑.Hh.Rh;Mem[T]↑.Hh.Rh←Q;Q←T; END ENDLOOP ;
EXITS Label30 => NULL};Mem[R]↑.Hh.Rh←50000--:345--; END;P←Mem[P]↑.Hh.Rh; END ENDLOOP ;Mem[ INT[H]+4]↑.Int←0;
END;--:344----346:--
END.