-- file: MFParsingImpl1.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,
MFOctants,
MFEnvelopes,
MFEquations,
MFInput,
MFParsing;
MFParsingImpl1: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFEdges, MFOctants, MFEnvelopes, MFEquations, MFInput, MFParsing EXPORTS MFParsing = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFEdges, MFOctants, MFEnvelopes, MFEquations, MFInput, MFParsing;
--:790----795:
CurType: SmallNumber;
CurExp: PascalInteger;
--:795----812:
MaxC: LONG POINTER TO ARRAY PascalInteger[17..18] OF PascalInteger ← PascalStaticZone.NEW[ARRAY PascalInteger[17..18] OF PascalInteger];
MaxPtr: LONG POINTER TO ARRAY PascalInteger[17..18] OF Halfword ← PascalStaticZone.NEW[ARRAY PascalInteger[17..18] OF Halfword];
MaxLink: LONG POINTER TO ARRAY PascalInteger[17..18] OF Halfword ← PascalStaticZone.NEW[ARRAY PascalInteger[17..18] OF Halfword];
--:812----820:--
VarFlag: PascalInteger[0..82];
PrintDp: PROCEDURE[T: SmallNumber,P: Halfword,Verbosity: SmallNumber]
=
BEGIN Q:Halfword; Q←Mem[P]↑.Hh.Rh;
IF(Mem[Q]↑.Hh.Lh=0)OR ( INT[Verbosity]>0) THEN PrintDependency[P,T] ELSE Print[
629]; END;--:804----798:-- StashCurExp: PROCEDURE RETURNS[StashCurExpResult: Halfword] =
BEGIN P:Halfword;
SELECT CurType FROM 3,5,7,12,10,13,14,17,18,19 =>P←CurExp;
ENDCASE =>BEGIN P←GetNode[2];Mem[P]↑.Hh.B1←11;Mem[P]↑.Hh.B0←CurType;
Mem[ INT[P]+1]↑.Int←CurExp; END ;CurType←1;Mem[P]↑.Hh.Rh←1;
StashCurExpResult←P; END;--:798----799:-- UnstashCurExp: PROCEDURE[P: Halfword]
=
BEGIN CurType←Mem[P]↑.Hh.B0;
SELECT CurType FROM 3,5,7,12,10,13,14,17,18,19 =>CurExp←P;
ENDCASE =>BEGIN CurExp←Mem[ INT[P]+1]↑.Int;FreeNode[P,2]; END ; END;--:799
PrintExp: PROCEDURE[P: Halfword,Verbosity: SmallNumber]
=
BEGIN RestoreCurExp:PascalBoolean;T:SmallNumber;V:PascalInteger;Q:Halfword;
IF P#0 THEN RestoreCurExp←FALSE ELSE BEGIN P←StashCurExp[];
RestoreCurExp←TRUE; END;T←Mem[P]↑.Hh.B0;
IF INT[T]<17 THEN V←Mem[ INT[P]+1]↑.Int ELSE IF INT[T]<19 THEN V←Mem[ INT[P]+1]↑.Hh.Rh;--801:
SELECT T FROM 1 =>Print[196];2 =>IF V=30 THEN Print[220] ELSE Print[221];
3,5,7,12,10,15 =>--805:--BEGIN PrintType[T];
IF V#0 THEN BEGIN PrintChar[32];
WHILE(Mem[V]↑.Hh.B1=11)AND (V#P)DO V←Mem[V+1]↑.Int ENDLOOP ;
PrintVariableName[V]; END; END--:805--;4 =>BEGIN PrintChar[34];
SlowPrint[V];PrintChar[34]; END;6,8,9,11 =>--803:
IF INT[Verbosity]<=1 THEN PrintType[T] ELSE BEGIN IF Selector=3 THEN IF
Internal↑[13]<=0 THEN BEGIN Selector←1;PrintType[T];Print[627];
Selector←3; END;SELECT T FROM 6 =>PrintPen[V,157,FALSE];
8 =>PrintPath[V,628,FALSE];9 =>PrintPath[V,157,FALSE];
11 =>BEGIN CurEdges←V;PrintEdges[157,FALSE,0,0]; END; ENDCASE; END--:803--;
13,14 =>IF V=0 THEN PrintType[T] ELSE--802:--BEGIN PrintChar[40];
Q←V+BigNodeSize↑[T];
DO IF Mem[V]↑.Hh.B0=16 THEN PrintScaled[Mem[V+1]↑.Int] ELSE IF Mem[V]↑.
Hh.B0=19 THEN PrintVariableName[V] ELSE PrintDp[Mem[V]↑.Hh.B0,Mem[V+1]↑.
Hh.Rh,Verbosity];V←V+2;IF V#Q THEN PrintChar[44]; IF V=Q THEN EXIT; ENDLOOP;
PrintChar[41]; END--:802--;16 =>PrintScaled[V];
17,18 =>PrintDp[T,V,Verbosity];19 =>PrintVariableName[P];
ENDCASE =>Confusion[626]--:801--;
IF RestoreCurExp THEN UnstashCurExp[P]; END;--:800----806:
DispErr: PROCEDURE[P: Halfword,S: StrNumber] =
BEGIN IF Interaction=3 THEN NULL;
PrintNl[630];PrintExp[P,1];IF S#157 THEN BEGIN PrintNl[133];
Print[S]; END; END;--:806----593:-- RecycleValue: PROCEDURE[P: Halfword] =
BEGIN T:SmallNumber;
V:PascalInteger;Vv:PascalInteger;Q, R, S, Pp:Halfword; T←Mem[P]↑.Hh.B0;
IF INT[T]<17 THEN V←Mem[ INT[P]+1]↑.Int;SELECT T FROM 0,1,2,16,15 => NULL;
3,5,7,12,10 =>RingDelete[P];
4 =>BEGIN IF INT[StrRef↑[V]]<127 THEN IF INT[StrRef↑[V]]>1 THEN StrRef↑[V]←StrRef↑
[V]-1 ELSE FlushString[V]; END;
6 =>IF Mem[V]↑.Hh.Lh=0 THEN TossPen[V] ELSE Mem[V]↑.Hh.Lh← INT[Mem[V]↑.Hh.Lh]-1;
9,8 =>TossKnotList[V];11 =>TossEdges[V];14,13 =>--809:
IF V#0 THEN BEGIN Q←V+BigNodeSize↑[T];DO Q← INT[Q]-2;RecycleValue[Q];
IF Q=V THEN EXIT; ENDLOOP;FreeNode[V,BigNodeSize↑[T]]; END--:809--;17,18 =>--810:
BEGIN Q←Mem[ INT[P]+1]↑.Hh.Rh;WHILE Mem[Q]↑.Hh.Lh#0 DO Q←Mem[Q]↑.Hh.Rh ENDLOOP ;
Mem[Mem[ INT[P]+1]↑.Hh.Lh]↑.Hh.Rh←Mem[Q]↑.Hh.Rh;
Mem[ INT[Mem[Q]↑.Hh.Rh]+1]↑.Hh.Lh←Mem[ INT[P]+1]↑.Hh.Lh;Mem[Q]↑.Hh.Rh←0;
FlushNodeList[Mem[ INT[P]+1]↑.Hh.Rh]; END--:810--;19 =>--811:--BEGIN MaxC↑[17]←0;
MaxC↑[18]←0;MaxLink↑[17]←0;MaxLink↑[18]←0;Q←Mem[13]↑.Hh.Rh;
WHILE Q#13 DO BEGIN S← INT[Q]+1;{WHILE TRUE DO BEGIN R←Mem[S]↑.Hh.Rh;
IF Mem[R]↑.Hh.Lh=0 THEN GOTO Label30;
IF Mem[R]↑.Hh.Lh#P THEN S←R ELSE BEGIN T←Mem[Q]↑.Hh.B0;
Mem[S]↑.Hh.Rh←Mem[R]↑.Hh.Rh;Mem[R]↑.Hh.Lh←Q;
IF ABS[Mem[ INT[R]+1]↑.Int]>MaxC↑[T] THEN--813:
BEGIN IF MaxC↑[T]>0 THEN BEGIN Mem[MaxPtr↑[T]]↑.Hh.Rh←MaxLink↑[T];
MaxLink↑[T]←MaxPtr↑[T]; END;MaxC↑[T]←ABS[Mem[ INT[R]+1]↑.Int];MaxPtr↑[T]←R;
END--:813-- ELSE BEGIN Mem[R]↑.Hh.Rh←MaxLink↑[T];MaxLink↑[T]←R; END; END;
END ENDLOOP ;EXITS Label30 => NULL};Q←Mem[R]↑.Hh.Rh; END ENDLOOP ;IF(MaxC↑[17]>0)OR (MaxC↑[18]>0) THEN--814:
BEGIN IF(MaxC↑[17]>=268435456)OR ( PascalDIVPower2[MaxC↑[17],12]>=MaxC↑[18]) THEN T←17
ELSE T←18;--815:--R←MaxPtr↑[T];Pp←Mem[R]↑.Hh.Lh;V←Mem[ INT[R]+1]↑.Int;
IF T=17 THEN Mem[ INT[R]+1]↑.Int←-268435456 ELSE Mem[ INT[R]+1]↑.Int←-65536;Q← INT[Pp]+1;
S←Mem[Q]↑.Hh.Rh;WHILE INT[Mem[S]↑.Hh.Lh]>Pp DO BEGIN Q←S;S←Mem[Q]↑.Hh.Rh; END ENDLOOP ;
Mem[Q]↑.Hh.Rh←R;Mem[R]↑.Hh.Rh←S;
WHILE Mem[S]↑.Hh.Lh#0 DO S←Mem[S]↑.Hh.Rh ENDLOOP ;Q←Mem[S]↑.Hh.Rh;
Mem[S]↑.Hh.Rh←0;S←Mem[ INT[Pp]+1]↑.Hh.Rh;Mem[ INT[Q]+1]↑.Hh.Lh←Mem[ INT[Pp]+1]↑.Hh.Lh;
Mem[Mem[ INT[Pp]+1]↑.Hh.Lh]↑.Hh.Rh←Q;Mem[Pp]↑.Hh.B0←19;Mem[ INT[Pp]+1]↑.Int←0;
IF CurExp=Pp THEN IF CurType=T THEN CurType←19;
IF Internal↑[2]>0 THEN--816:--IF Interesting[P] THEN BEGIN BeginDiagnostic[];
PrintNl[632];IF V>0 THEN PrintChar[45];
IF T=17 THEN Vv←RoundFraction[MaxC↑[17]] ELSE Vv←MaxC↑[18];
IF Vv#65536 THEN PrintScaled[Vv];PrintVariableName[P];
WHILE Mem[ INT[P]+1]↑.Int>0 DO BEGIN Print[456];Mem[ INT[P]+1]↑.Int←Mem[ INT[P]+1]↑.Int-2;
END ENDLOOP ;IF T=17 THEN PrintChar[61] ELSE Print[633];PrintDependency[S,T];
EndDiagnostic[FALSE]; END--:816----:815--;T←35-T;
IF MaxC↑[T]>0 THEN BEGIN Mem[MaxPtr↑[T]]↑.Hh.Rh←MaxLink↑[T];
MaxLink↑[T]←MaxPtr↑[T]; END;IF T#17 THEN--817:
FOR i:INT IN [ INT[17 ].. INT[18 ]] DO T ← i; R←MaxLink↑[T];
WHILE R#0 DO BEGIN Q←Mem[R]↑.Hh.Lh;
Mem[ INT[Q]+1]↑.Hh.Rh←PPlusFq[Mem[ INT[Q]+1]↑.Hh.Rh,MakeFraction[Mem[ INT[R]+1]↑.Int,-V],
S,T,17];IF Mem[ INT[Q]+1]↑.Hh.Rh=DepFinal THEN MakeKnown[Q,DepFinal];Q←R;
R←Mem[R]↑.Hh.Rh;FreeNode[Q,2]; END ENDLOOP ;--:817-- ENDLOOP ELSE--818:
FOR i:INT IN [ INT[17 ].. INT[18 ]] DO T ← i; R←MaxLink↑[T];
WHILE R#0 DO BEGIN Q←Mem[R]↑.Hh.Lh;
IF T=17 THEN BEGIN IF CurExp=Q THEN IF CurType=17 THEN CurType←18;
Mem[ INT[Q]+1]↑.Hh.Rh←POverV[Mem[ INT[Q]+1]↑.Hh.Rh,65536,17,18];Mem[Q]↑.Hh.B0←18;
Mem[ INT[R]+1]↑.Int←RoundFraction[Mem[ INT[R]+1]↑.Int]; END;
Mem[ INT[Q]+1]↑.Hh.Rh←PPlusFq[Mem[ INT[Q]+1]↑.Hh.Rh,MakeScaled[Mem[ INT[R]+1]↑.Int,-V],S,
18,18];IF Mem[ INT[Q]+1]↑.Hh.Rh=DepFinal THEN MakeKnown[Q,DepFinal];Q←R;
R←Mem[R]↑.Hh.Rh;FreeNode[Q,2]; END ENDLOOP ;--:818-- ENDLOOP;FlushNodeList[S];
IF FixNeeded THEN FixDependencies[];
BEGIN IF ArithError THEN ClearArith[]; END; END--:814--; END--:811--;
20,21 =>Confusion[631];22,23 =>DeleteMacRef[Mem[ INT[P]+1]↑.Int]; ENDCASE;
Mem[P]↑.Hh.B0←0; END;--:808----807:-- FlushCurExp: PROCEDURE[V: Scaled]
=
BEGIN SELECT CurType FROM 3,5,7,12,10,13,14,17,18,19 =>BEGIN RecycleValue[
CurExp];FreeNode[CurExp,2]; END;
6 =>IF Mem[CurExp]↑.Hh.Lh=0 THEN TossPen[CurExp] ELSE Mem[CurExp]↑.Hh.Lh
← INT[Mem[CurExp]↑.Hh.Lh]-1;
4 =>BEGIN IF INT[StrRef↑[CurExp]]<127 THEN IF INT[StrRef↑[CurExp]]>1 THEN StrRef↑
[CurExp]←StrRef↑[CurExp]-1 ELSE FlushString[CurExp]; END;
8,9 =>TossKnotList[CurExp];11 =>TossEdges[CurExp]; ENDCASE => NULL;
CurType←16;CurExp←V; END;--:807----819:-- FlushError: PROCEDURE[V: Scaled]
=
BEGIN Error[];FlushCurExp[V]; END; PutGetError: PROCEDURE =
BEGIN BackError[];
GetXNext[]; END; PutGetFlushError: PROCEDURE[V: Scaled]
=
BEGIN PutGetError[];FlushCurExp[V]; END;--:819----247:
--:605----606:-- ConstDependency: PROCEDURE[V: Scaled] RETURNS[ConstDependencyResult: Halfword]
=
BEGIN DepFinal←GetNode[2];Mem[ INT[DepFinal]+1]↑.Int←V;
Mem[DepFinal]↑.Hh.Lh←0;ConstDependencyResult←DepFinal; END;--:606----607:
SingleDependency: PROCEDURE[P: Halfword] RETURNS[SingleDependencyResult: Halfword] =
BEGIN Q:Halfword;
IF Mem[ INT[P]+1]↑.Int>28 THEN SingleDependencyResult←ConstDependency[0] ELSE
BEGIN Q←GetNode[2];Mem[ INT[Q]+1]↑.Int←TwoToThe↑[28-Mem[ INT[P]+1]↑.Int];
Mem[Q]↑.Hh.Lh←P;Mem[Q]↑.Hh.Rh←ConstDependency[0];SingleDependencyResult←Q;
END; END;--:607----608:-- CopyDepList: PROCEDURE[P: Halfword] RETURNS[CopyDepListResult: Halfword]
=
BEGIN Q:Halfword; Q←GetNode[2];DepFinal←Q;
{WHILE TRUE DO BEGIN Mem[DepFinal]↑.Hh.Lh←Mem[P]↑.Hh.Lh;
Mem[ INT[DepFinal]+1]↑.Int←Mem[ INT[P]+1]↑.Int;
IF Mem[DepFinal]↑.Hh.Lh=0 THEN GOTO Label30;
Mem[DepFinal]↑.Hh.Rh←GetNode[2];DepFinal←Mem[DepFinal]↑.Hh.Rh;
P←Mem[P]↑.Hh.Rh; END ENDLOOP ;EXITS Label30 => NULL};CopyDepListResult←Q; END;--:608----609:
--823:-- BadExp: PROCEDURE[S: StrNumber] =
BEGIN SaveFlag:PascalInteger[0..82];
BEGIN IF Interaction=3 THEN NULL;PrintNl[133];Print[S]; END;Print[635];
PrintCmdMod[CurCmd,CurMod];PrintChar[39];BEGIN HelpPtr←4;
HelpLine↑[3]←636;HelpLine↑[2]←637;HelpLine↑[1]←638;HelpLine↑[0]←639;
END;BackInput[];CurSym←0;CurCmd←42;CurMod←0;InsError[];
SaveFlag←VarFlag;VarFlag←0;GetXNext[];VarFlag←SaveFlag; END;
--:823----826:-- StashIn: PROCEDURE[P: Halfword] =
BEGIN Q:Halfword;
Mem[P]↑.Hh.B0←CurType;
IF CurType=16 THEN Mem[ INT[P]+1]↑.Int←CurExp ELSE BEGIN IF CurType=19 THEN
--828:--BEGIN Q←SingleDependency[CurExp];
IF Q=DepFinal THEN BEGIN Mem[P]↑.Hh.B0←16;Mem[ INT[P]+1]↑.Int←0;
FreeNode[Q,2]; END ELSE BEGIN Mem[P]↑.Hh.B0←17;NewDep[P,Q]; END;
RecycleValue[CurExp]; END--:828-- ELSE BEGIN Mem[ INT[P]+1]↑←Mem[CurExp+1]↑;
Mem[Mem[ INT[P]+1]↑.Hh.Lh]↑.Hh.Rh←P; END;FreeNode[CurExp,2]; END;CurType←1;
END;--:826----847:-- BackExpr: PROCEDURE =
BEGIN P:Halfword;
P←StashCurExp[];Mem[P]↑.Hh.Rh←0;BeginTokenList[P,10]; END;--:847
--848:-- BadSubscript: PROCEDURE =
BEGIN DispErr[0,651];BEGIN HelpPtr←3;
HelpLine↑[2]←652;HelpLine↑[1]←653;HelpLine↑[0]←654; END;
FlushError[0]; END;--:848----850:-- Obliterated: PROCEDURE[Q: Halfword]
=
BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];Print[655]; END;
ShowTokenList[Q,0,1000,0];Print[656];BEGIN HelpPtr←5;
HelpLine↑[4]←657;HelpLine↑[3]←658;HelpLine↑[2]←659;HelpLine↑[1]←660;
HelpLine↑[0]←661; END; END;--:850----862:
NewKnot: PROCEDURE RETURNS[NewKnotResult: Halfword] =
BEGIN Q:Halfword; Q←GetNode[7];
Mem[Q]↑.Hh.B0←0;Mem[Q]↑.Hh.B1←0;Mem[Q]↑.Hh.Rh←Q;KnownPair[];
Mem[ INT[Q]+1]↑.Int←CurX;Mem[ INT[Q]+2]↑.Int←CurY;NewKnotResult←Q; END;--:870----874:
END.