-- file: MFEquationsImpl.mesa
-- Pascal-to-Mesa translator output, translated at October 31, 1985 4:28:02 pm PST
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFProcArray,
MFInteraction,
MFMath,
MFMemory,
MFSymbols,
MFPaths,
MFEdges,
MFParsing,
MFEquations;
MFEquationsImpl: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFEdges, MFParsing EXPORTS MFEquations = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFEdges, MFParsing, MFEquations;
--:579----591:--
FixNeeded: PascalBoolean;
WatchCoefs: PascalBoolean;
DepFinal: Halfword;
SlowAdd: PROCEDURE[X,Y: PascalInteger] RETURNS[SlowAddResult: PascalInteger]
=
BEGIN IF X>=0 THEN IF Y<=2147483647-X THEN SlowAddResult←X+Y ELSE BEGIN
ArithError←TRUE;SlowAddResult←2147483647;
END ELSE IF-Y<=2147483647+X THEN SlowAddResult←X+Y ELSE BEGIN ArithError←
TRUE;SlowAddResult←-2147483647; END; END;--:100----102:
PrintDependency: PROCEDURE[P: Halfword,T: SmallNumber] =
BEGIN
V:PascalInteger;Pp, Q:Halfword; Pp←P;
{WHILE TRUE DO BEGIN V←ABS[Mem[ INT[P]+1]↑.Int];Q←Mem[P]↑.Hh.Lh;
IF Q=0 THEN BEGIN IF(V#0)OR (P=Pp) THEN BEGIN IF Mem[ INT[P]+1]↑.Int>0 THEN IF P
#Pp THEN PrintChar[43];PrintScaled[Mem[ INT[P]+1]↑.Int]; END; GOTO Label10; END;
--589:
IF Mem[ INT[P]+1]↑.Int<0 THEN PrintChar[45] ELSE IF P#Pp THEN PrintChar[43];
IF T=17 THEN V←RoundFraction[V];IF V#65536 THEN PrintScaled[V]--:589
;IF Mem[Q]↑.Hh.B0#19 THEN Confusion[455];PrintVariableName[Q];
V←Mem[ INT[Q]+1]↑.Int;WHILE V>0 DO BEGIN Print[456];V←V-2; END ENDLOOP ;
P←Mem[P]↑.Hh.Rh; END ENDLOOP ;EXITS Label10 => NULL}; END;--:588----800:----804:
PPlusFq: PROCEDURE[P: Halfword,F: PascalInteger,
Q: Halfword,T,Tt: SmallNumber] RETURNS[PPlusFqResult: Halfword] =
BEGIN Pp, Qq:Halfword;
R, S:Halfword;Threshold:PascalInteger;V:PascalInteger;
IF T=17 THEN Threshold←2685 ELSE Threshold←8;R←49999;
Pp←Mem[P]↑.Hh.Lh;Qq←Mem[Q]↑.Hh.Lh;
{WHILE TRUE DO IF Pp=Qq THEN IF Pp=0 THEN GOTO Label30 ELSE--594:
BEGIN IF Tt=17 THEN V←Mem[ INT[P]+1]↑.Int+TakeFraction[F,Mem[ INT[Q]+1]↑.Int] ELSE V
←Mem[ INT[P]+1]↑.Int+TakeScaled[F,Mem[ INT[Q]+1]↑.Int];Mem[ INT[P]+1]↑.Int←V;S←P;
P←Mem[P]↑.Hh.Rh;
IF ABS[V]<Threshold THEN FreeNode[S,2] ELSE BEGIN IF ABS[V]>=626349397
THEN IF WatchCoefs THEN BEGIN Mem[Qq]↑.Hh.B0←0;FixNeeded←TRUE; END;
Mem[R]↑.Hh.Rh←S;R←S; END;Pp←Mem[P]↑.Hh.Lh;Q←Mem[Q]↑.Hh.Rh;
Qq←Mem[Q]↑.Hh.Lh; END--:594-- ELSE IF INT[Pp]<Qq THEN--595:
BEGIN IF Tt=17 THEN V←TakeFraction[F,Mem[ INT[Q]+1]↑.Int] ELSE V←TakeScaled[
F,Mem[ INT[Q]+1]↑.Int];IF ABS[V]>PascalDIVPower2[(Threshold),1] THEN BEGIN S←GetNode[2];
Mem[S]↑.Hh.Lh←Qq;Mem[ INT[S]+1]↑.Int←V;
IF ABS[V]>=626349397 THEN IF WatchCoefs THEN BEGIN Mem[Qq]↑.Hh.B0←0;
FixNeeded←TRUE; END;Mem[R]↑.Hh.Rh←S;R←S; END;Q←Mem[Q]↑.Hh.Rh;
Qq←Mem[Q]↑.Hh.Lh; END--:595-- ELSE BEGIN Mem[R]↑.Hh.Rh←P;R←P;
P←Mem[P]↑.Hh.Rh;Pp←Mem[P]↑.Hh.Lh; END ENDLOOP ;
EXITS Label30 => NULL};IF T=17 THEN Mem[ INT[P]+1]↑.Int←SlowAdd[Mem[ INT[P]+1]↑.Int,TakeFraction[Mem[ INT[Q
]+1]↑.Int,F]] ELSE Mem[ INT[P]+1]↑.Int←SlowAdd[Mem[ INT[P]+1]↑.Int,TakeScaled[Mem[ INT[Q]+1]↑
.Int,F]];Mem[R]↑.Hh.Rh←P;DepFinal←P;PPlusFqResult←Mem[49999]↑.Hh.Rh; END;
--:593----599:-- POverV: PROCEDURE[P: Halfword,V: Scaled,
T0,T1: SmallNumber] RETURNS[POverVResult: Halfword] =
BEGIN R, S:Halfword;W:PascalInteger;
Threshold:PascalInteger;ScalingDown:PascalBoolean;
IF T0#T1 THEN ScalingDown←TRUE ELSE ScalingDown←FALSE;
IF T1=17 THEN Threshold←1342 ELSE Threshold←4;R←49999;
WHILE Mem[P]↑.Hh.Lh#0 DO BEGIN IF ScalingDown THEN IF ABS[V]<524288
THEN W←MakeScaled[Mem[ INT[P]+1]↑.Int,V*4096] ELSE W←MakeScaled[
RoundFraction[Mem[ INT[P]+1]↑.Int],V] ELSE W←MakeScaled[Mem[ INT[P]+1]↑.Int,V];
IF ABS[W]<=Threshold THEN BEGIN S←Mem[P]↑.Hh.Rh;FreeNode[P,2];P←S;
END ELSE BEGIN IF ABS[W]>=626349397 THEN BEGIN FixNeeded←TRUE;
Mem[Mem[P]↑.Hh.Lh]↑.Hh.B0←0; END;Mem[R]↑.Hh.Rh←P;R←P;Mem[ INT[P]+1]↑.Int←W;
P←Mem[P]↑.Hh.Rh; END; END ENDLOOP ;Mem[R]↑.Hh.Rh←P;
Mem[ INT[P]+1]↑.Int←MakeScaled[Mem[ INT[P]+1]↑.Int,V];POverVResult←Mem[49999]↑.Hh.Rh;
END;--:599----601:-- ValTooBig: PROCEDURE[X: Scaled]
=
BEGIN IF Internal↑[40]>0 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;
PrintNl[133];Print[457]; END;PrintScaled[X];PrintChar[41];
BEGIN HelpPtr←4;HelpLine↑[3]←458;HelpLine↑[2]←459;HelpLine↑[1]←460;
HelpLine↑[0]←461; END;Error[]; END; END;--:601----602:
MakeKnown: PROCEDURE[P,Q: Halfword] =
BEGIN T:PascalInteger[17..18];
Mem[ INT[Mem[Q]↑.Hh.Rh]+1]↑.Hh.Lh←Mem[ INT[P]+1]↑.Hh.Lh;
Mem[Mem[ INT[P]+1]↑.Hh.Lh]↑.Hh.Rh←Mem[Q]↑.Hh.Rh;T←Mem[P]↑.Hh.B0;
Mem[P]↑.Hh.B0←16;Mem[ INT[P]+1]↑.Int←Mem[ INT[Q]+1]↑.Int;FreeNode[Q,2];
IF ABS[Mem[ INT[P]+1]↑.Int]>=268435456 THEN ValTooBig[Mem[ INT[P]+1]↑.Int];
IF Internal↑[2]>0 THEN IF Interesting[P] THEN BEGIN BeginDiagnostic[];
PrintNl[462];PrintVariableName[P];PrintChar[61];
PrintScaled[Mem[ INT[P]+1]↑.Int];EndDiagnostic[FALSE]; END;
IF CurExp=P THEN IF CurType=T THEN BEGIN CurType←16;
CurExp←Mem[ INT[P]+1]↑.Int;FreeNode[P,2]; END; END;--:602----603:
FixDependencies: PROCEDURE =
BEGIN P, Q, R, S, T:Halfword;X:Halfword;
R←Mem[13]↑.Hh.Rh;S←0;WHILE R#13 DO BEGIN T←R;--604:--R← INT[T]+1;
{WHILE TRUE DO BEGIN Q←Mem[R]↑.Hh.Rh;X←Mem[Q]↑.Hh.Lh;IF X=0 THEN GOTO Label30;
IF INT[Mem[X]↑.Hh.B0]<=1 THEN BEGIN IF INT[Mem[X]↑.Hh.B0]<1 THEN BEGIN P←GetAvail[];
Mem[P]↑.Hh.Rh←S;S←P;Mem[S]↑.Hh.Lh←X;Mem[X]↑.Hh.B0←1; END;
Mem[ INT[Q]+1]↑.Int← PascalDIVPower2[Mem[ INT[Q]+1]↑.Int ,2];
IF Mem[ INT[Q]+1]↑.Int=0 THEN BEGIN Mem[R]↑.Hh.Rh←Mem[Q]↑.Hh.Rh;FreeNode[Q,2];
Q←R; END; END;R←Q; END ENDLOOP ;EXITS Label30 => NULL};--:604--R←Mem[Q]↑.Hh.Rh;
IF Q=Mem[ INT[T]+1]↑.Hh.Rh THEN MakeKnown[T,Q]; END ENDLOOP ;
WHILE S#0 DO BEGIN P←Mem[S]↑.Hh.Rh;X←Mem[S]↑.Hh.Lh;
BEGIN Mem[S]↑.Hh.Rh←Avail;Avail←S;DynUsed←DynUsed-1; END;S←P;
Mem[X]↑.Hh.B0←19;Mem[ INT[X]+1]↑.Int←Mem[ INT[X]+1]↑.Int+2; END ENDLOOP ;FixNeeded←FALSE; END;
RingDelete: PROCEDURE[P: Halfword]
=
BEGIN Q:Halfword; Q←Mem[ INT[P]+1]↑.Int;
IF Q#0 THEN IF Q#P THEN BEGIN WHILE Mem[ INT[Q]+1]↑.Int#P DO Q←Mem[ INT[Q]+1]↑.Int
ENDLOOP ;Mem[ INT[Q]+1]↑.Int←Mem[ INT[P]+1]↑.Int; END; END;--:619----808:
--:577----590:-- MaxCoef: PROCEDURE[P: Halfword] RETURNS[MaxCoefResult: Fraction] =
BEGIN X:Fraction;
X←0;
WHILE Mem[P]↑.Hh.Lh#0 DO BEGIN IF ABS[Mem[ INT[P]+1]↑.Int]>X THEN X←ABS[Mem[ INT[P
]+1]↑.Int];P←Mem[P]↑.Hh.Rh; END ENDLOOP ;MaxCoefResult←X; END;--:590----596:
PPlusQ: PROCEDURE[P: Halfword,Q: Halfword,T: SmallNumber] RETURNS[PPlusQResult: Halfword]
=
BEGIN Pp, Qq:Halfword;R, S:Halfword;Threshold:PascalInteger;V:PascalInteger;
IF T=17 THEN Threshold←2685 ELSE Threshold←8;R←49999;
Pp←Mem[P]↑.Hh.Lh;Qq←Mem[Q]↑.Hh.Lh;
{WHILE TRUE DO IF Pp=Qq THEN IF Pp=0 THEN GOTO Label30 ELSE--597:
BEGIN V←Mem[ INT[P]+1]↑.Int+Mem[ INT[Q]+1]↑.Int;Mem[ INT[P]+1]↑.Int←V;S←P;P←Mem[P]↑.Hh.Rh;
Pp←Mem[P]↑.Hh.Lh;
IF ABS[V]<Threshold THEN FreeNode[S,2] ELSE BEGIN IF ABS[V]>=626349397
THEN IF WatchCoefs THEN BEGIN Mem[Qq]↑.Hh.B0←0;FixNeeded←TRUE; END;
Mem[R]↑.Hh.Rh←S;R←S; END;Q←Mem[Q]↑.Hh.Rh;Qq←Mem[Q]↑.Hh.Lh; END--:597
ELSE IF INT[Pp]<Qq THEN BEGIN S←GetNode[2];Mem[S]↑.Hh.Lh←Qq;
Mem[ INT[S]+1]↑.Int←Mem[ INT[Q]+1]↑.Int;Q←Mem[Q]↑.Hh.Rh;Qq←Mem[Q]↑.Hh.Lh;
Mem[R]↑.Hh.Rh←S;R←S; END ELSE BEGIN Mem[R]↑.Hh.Rh←P;R←P;
P←Mem[P]↑.Hh.Rh;Pp←Mem[P]↑.Hh.Lh; END ENDLOOP ;
EXITS Label30 => NULL};Mem[ INT[P]+1]↑.Int←SlowAdd[Mem[ INT[P]+1]↑.Int,Mem[ INT[Q]+1]↑.Int];Mem[R]↑.Hh.Rh←P;
DepFinal←P;PPlusQResult←Mem[49999]↑.Hh.Rh; END;--:596----598:
PTimesV: PROCEDURE[P: Halfword,V: PascalInteger,T0,T1: SmallNumber,
VIsScaled: PascalBoolean] RETURNS[PTimesVResult: Halfword] =
BEGIN R, S:Halfword;W:PascalInteger;
Threshold:PascalInteger;ScalingDown:PascalBoolean;
IF T0#T1 THEN ScalingDown←TRUE ELSE ScalingDown←
NOT VIsScaled;IF T1=17 THEN Threshold←1342 ELSE Threshold←4;R←49999;
WHILE Mem[P]↑.Hh.Lh#0 DO BEGIN IF ScalingDown THEN W←TakeFraction[V,
Mem[ INT[P]+1]↑.Int] ELSE W←TakeScaled[V,Mem[ INT[P]+1]↑.Int];
IF ABS[W]<=Threshold THEN BEGIN S←Mem[P]↑.Hh.Rh;FreeNode[P,2];P←S;
END ELSE BEGIN IF ABS[W]>=626349397 THEN BEGIN FixNeeded←TRUE;
Mem[Mem[P]↑.Hh.Lh]↑.Hh.B0←0; END;Mem[R]↑.Hh.Rh←P;R←P;Mem[ INT[P]+1]↑.Int←W;
P←Mem[P]↑.Hh.Rh; END; END ENDLOOP ;Mem[R]↑.Hh.Rh←P;
IF VIsScaled THEN Mem[ INT[P]+1]↑.Int←TakeScaled[Mem[ INT[P]+1]↑.Int,V] ELSE Mem[ INT[P
]+1]↑.Int←TakeFraction[Mem[ INT[P]+1]↑.Int,V];PTimesVResult←Mem[49999]↑.Hh.Rh; END;
--:598----600:-- PWithXBecomingQ: PROCEDURE[P,X,Q: Halfword,
T: SmallNumber] RETURNS[PWithXBecomingQResult: Halfword] =
BEGIN R, S:Halfword;V:PascalInteger; S←P;R←49999;
WHILE INT[Mem[S]↑.Hh.Lh]>X DO BEGIN R←S;S←Mem[S]↑.Hh.Rh; END ENDLOOP ;
IF Mem[S]↑.Hh.Lh#X THEN PWithXBecomingQResult←P ELSE BEGIN Mem[49999]↑.Hh.
Rh←P;Mem[R]↑.Hh.Rh←Mem[S]↑.Hh.Rh;V←Mem[ INT[S]+1]↑.Int;FreeNode[S,2];
PWithXBecomingQResult←PPlusFq[Mem[49999]↑.Hh.Rh,V,Q,T,17]; END; END;--:600
--605:-- NewDep: PROCEDURE[Q,P: Halfword] =
BEGIN R:Halfword;
Mem[ INT[Q]+1]↑.Hh.Rh←P;Mem[ INT[Q]+1]↑.Hh.Lh←13;R←Mem[13]↑.Hh.Rh;
Mem[DepFinal]↑.Hh.Rh←R;Mem[ INT[R]+1]↑.Hh.Lh←DepFinal;Mem[13]↑.Hh.Rh←Q; END;
LinearEq: PROCEDURE[P: Halfword,T: SmallNumber] =
BEGIN Q, R, S:Halfword;
X:Halfword;N:PascalInteger;V:PascalInteger;PrevR:Halfword;FinalNode:Halfword;
W:PascalInteger;--610:--Q←P;R←Mem[P]↑.Hh.Rh;V←Mem[ INT[Q]+1]↑.Int;
WHILE Mem[R]↑.Hh.Lh#0 DO BEGIN IF ABS[Mem[ INT[R]+1]↑.Int]>ABS[V] THEN BEGIN Q←
R;V←Mem[ INT[R]+1]↑.Int; END;R←Mem[R]↑.Hh.Rh; END--:610-- ENDLOOP ;X←Mem[Q]↑.Hh.Lh;
N←Mem[ INT[X]+1]↑.Int;--611:--S←49999;Mem[S]↑.Hh.Rh←P;R←P;
DO IF R=Q THEN BEGIN Mem[S]↑.Hh.Rh←Mem[R]↑.Hh.Rh;FreeNode[R,2];
END ELSE BEGIN W←MakeFraction[Mem[ INT[R]+1]↑.Int,V];
IF ABS[W]<=1342 THEN BEGIN Mem[S]↑.Hh.Rh←Mem[R]↑.Hh.Rh;FreeNode[R,2];
END ELSE BEGIN Mem[ INT[R]+1]↑.Int←-W;S←R; END; END;R←Mem[S]↑.Hh.Rh;
IF Mem[R]↑.Hh.Lh=0 THEN EXIT; ENDLOOP;
IF T=18 THEN Mem[ INT[R]+1]↑.Int←-MakeScaled[Mem[ INT[R]+1]↑.Int,V] ELSE IF
V#-268435456 THEN Mem[ INT[R]+1]↑.Int←-MakeFraction[Mem[ INT[R]+1]↑.Int,V];
FinalNode←R;P←Mem[49999]↑.Hh.Rh--:611--;IF Internal↑[2]>0 THEN--612:
IF Interesting[X] THEN BEGIN BeginDiagnostic[];PrintNl[463];
PrintVariableName[X];W←N;WHILE W>0 DO BEGIN Print[456];W←W-2; END ENDLOOP ;
PrintChar[61];PrintDependency[P,17];EndDiagnostic[FALSE]; END--:612--;
--613:--PrevR←13;R←Mem[13]↑.Hh.Rh;
WHILE R#13 DO BEGIN S←Mem[ INT[R]+1]↑.Hh.Rh;
Q←PWithXBecomingQ[S,X,P,Mem[R]↑.Hh.B0];
IF Mem[Q]↑.Hh.Lh=0 THEN MakeKnown[R,Q] ELSE BEGIN Mem[ INT[R]+1]↑.Hh.Rh←Q;
DO Q←Mem[Q]↑.Hh.Rh; IF Mem[Q]↑.Hh.Lh=0 THEN EXIT; ENDLOOP;PrevR←Q; END;
R←Mem[PrevR]↑.Hh.Rh; END--:613-- ENDLOOP ;--614:--IF N>0 THEN--615:--BEGIN S←49999;
Mem[49999]↑.Hh.Rh←P;R←P;
DO IF N>30 THEN W←0 ELSE W← Mem[ INT[R]+1]↑.Int /TwoToThe↑[N];
IF(ABS[W]<=1342)AND (Mem[R]↑.Hh.Lh#0) THEN BEGIN Mem[S]↑.Hh.Rh←Mem[R]↑.Hh.
Rh;FreeNode[R,2]; END ELSE BEGIN Mem[ INT[R]+1]↑.Int←W;S←R; END;
R←Mem[S]↑.Hh.Rh; IF Mem[S]↑.Hh.Lh=0 THEN EXIT; ENDLOOP;P←Mem[49999]↑.Hh.Rh; END--:615--;
IF Mem[P]↑.Hh.Lh=0 THEN BEGIN Mem[X]↑.Hh.B0←16;
Mem[ INT[X]+1]↑.Int←Mem[ INT[P]+1]↑.Int;
IF ABS[Mem[ INT[X]+1]↑.Int]>=268435456 THEN ValTooBig[Mem[ INT[X]+1]↑.Int];
FreeNode[P,2];
IF CurExp=X THEN IF CurType=19 THEN BEGIN CurExp←Mem[ INT[X]+1]↑.Int;
CurType←16;FreeNode[X,2]; END; END ELSE BEGIN Mem[X]↑.Hh.B0←17;
DepFinal←FinalNode;NewDep[X,P];
IF CurExp=X THEN IF CurType=19 THEN CurType←17; END--:614--;
IF FixNeeded THEN FixDependencies[]; END;--:609----618:
NewRingEntry: PROCEDURE[P: Halfword] RETURNS[NewRingEntryResult: Halfword] =
BEGIN Q:Halfword;
Q←GetNode[2];Mem[Q]↑.Hh.B1←11;Mem[Q]↑.Hh.B0←Mem[P]↑.Hh.B0;
IF Mem[ INT[P]+1]↑.Int=0 THEN Mem[ INT[Q]+1]↑.Int←P ELSE Mem[ INT[Q]+1]↑.Int←Mem[ INT[P]+1]↑.Int;
Mem[ INT[P]+1]↑.Int←Q;NewRingEntryResult←Q; END;--:618----620:
NonlinearEq: PROCEDURE[V: PascalInteger,P: Halfword,FlushP: PascalBoolean]
=
BEGIN T:SmallNumber;Q, R:Halfword; T←Mem[P]↑.Hh.B0-1;Q←Mem[ INT[P]+1]↑.Int;
IF FlushP THEN Mem[P]↑.Hh.B0←1 ELSE P←Q;DO R←Mem[ INT[Q]+1]↑.Int;
Mem[Q]↑.Hh.B0←T;SELECT T FROM 2 =>Mem[ INT[Q]+1]↑.Int←V;4 =>BEGIN Mem[ INT[Q]+1]↑.Int←V;
BEGIN IF INT[StrRef↑[V]]<127 THEN StrRef↑[V]←StrRef↑[V]+1; END; END;
6 =>BEGIN Mem[ INT[Q]+1]↑.Int←V;Mem[V]↑.Hh.Lh← INT[Mem[V]↑.Hh.Lh]+1; END;
9 =>Mem[ INT[Q]+1]↑.Int←CopyPath[V];11 =>Mem[ INT[Q]+1]↑.Int←CopyEdges[V]; ENDCASE;Q←R;
IF Q=P THEN EXIT; ENDLOOP; END;--:620----621:-- RingMerge: PROCEDURE[P,Q: Halfword] =
BEGIN
R:Halfword; R←Mem[ INT[P]+1]↑.Int;
{WHILE R#P DO BEGIN IF R=Q THEN BEGIN--622:
BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];Print[466]; END;
BEGIN HelpPtr←2;HelpLine↑[1]←467;HelpLine↑[0]←468; END;PutGetError[];
END--:622--; GOTO Label10; END;R←Mem[ INT[R]+1]↑.Int; END ENDLOOP ;R←Mem[ INT[P]+1]↑.Int;
Mem[ INT[P]+1]↑.Int←Mem[ INT[Q]+1]↑.Int;Mem[ INT[Q]+1]↑.Int←R;EXITS Label10 => NULL}; END;--:621----625:
END.