-- file: MFParsingImpl2.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,
MFDebug,
MFOps;
MFParsingImpl2: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFEdges, MFOctants, MFEnvelopes, MFEquations, MFInput, MFParsing, MFDebug, MFOps EXPORTS MFParsing = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFEdges, MFOctants, MFEnvelopes, MFEquations, MFInput, MFParsing, MFDebug, MFOps;
--854:----855:-- Encapsulate: PROCEDURE[P: Halfword]
=
BEGIN CurExp←GetNode[2];Mem[CurExp]↑.Hh.B0←CurType;
Mem[CurExp]↑.Hh.B1←11;NewDep[CurExp,P]; END;--:855----857:
Install: PROCEDURE[R,Q: Halfword] =
BEGIN P:Halfword;
IF Mem[Q]↑.Hh.B0=16 THEN BEGIN Mem[ INT[R]+1]↑.Int←Mem[ INT[Q]+1]↑.Int;
Mem[R]↑.Hh.B0←16;
END ELSE IF Mem[Q]↑.Hh.B0=19 THEN BEGIN P←SingleDependency[Q];
IF P=DepFinal THEN BEGIN Mem[R]↑.Hh.B0←16;Mem[ INT[R]+1]↑.Int←0;
FreeNode[P,2]; END ELSE BEGIN Mem[R]↑.Hh.B0←17;NewDep[R,P]; END;
END ELSE BEGIN Mem[R]↑.Hh.B0←Mem[Q]↑.Hh.B0;
NewDep[R,CopyDepList[Mem[ INT[Q]+1]↑.Hh.Rh]]; END; END;--:857
MakeExpCopy: PROCEDURE[P: Halfword] =
BEGIN Q, R, T:Halfword;
DO {--Label20:--CurType←Mem[P]↑.Hh.B0;
SELECT CurType FROM 1,2,16 =>CurExp←Mem[ INT[P]+1]↑.Int;
3,5,7,12,10 =>CurExp←NewRingEntry[P];4 =>BEGIN CurExp←Mem[ INT[P]+1]↑.Int;
BEGIN IF INT[StrRef↑[CurExp]]<127 THEN StrRef↑[CurExp]←StrRef↑[CurExp]+1;
END; END;6 =>BEGIN CurExp←Mem[ INT[P]+1]↑.Int;
Mem[CurExp]↑.Hh.Lh← INT[Mem[CurExp]↑.Hh.Lh]+1; END;
11 =>CurExp←CopyEdges[Mem[ INT[P]+1]↑.Int];
9,8 =>CurExp←CopyPath[Mem[ INT[P]+1]↑.Int];13,14 =>--856:
BEGIN IF Mem[ INT[P]+1]↑.Int=0 THEN InitBigNode[P];T←GetNode[2];
Mem[T]↑.Hh.B1←11;Mem[T]↑.Hh.B0←CurType;InitBigNode[T];
Q←Mem[ INT[P]+1]↑.Int+BigNodeSize↑[CurType];
R←Mem[ INT[T]+1]↑.Int+BigNodeSize↑[CurType];DO Q← INT[Q]-2;R← INT[R]-2;
Install[R,Q]; IF Q=Mem[ INT[P]+1]↑.Int THEN EXIT; ENDLOOP;CurExp←T; END--:856--;
17,18 =>Encapsulate[CopyDepList[Mem[ INT[P]+1]↑.Hh.Rh]];
15 =>BEGIN Mem[P]↑.Hh.B0←19;Mem[ INT[P]+1]↑.Int←0; GOTO Label20; END;
19 =>BEGIN Q←SingleDependency[P];IF Q=DepFinal THEN BEGIN CurType←16;
CurExp←0;FreeNode[Q,2]; END ELSE BEGIN CurType←17;Encapsulate[Q];
END; END; ENDCASE =>Confusion[665];EXIT; EXITS Label20 => NULL} ENDLOOP; END;--:854-- BinaryMac: PROCEDURE[P,C,N: Halfword] =
BEGIN Q, R:Halfword;
Q←GetAvail[];R←GetAvail[];Mem[Q]↑.Hh.Rh←R;Mem[Q]↑.Hh.Lh←P;
Mem[R]↑.Hh.Lh←StashCurExp[];MacroCall[C,Q,N]; END;--:862----864:
MaterializePen: PROCEDURE =
BEGIN
AMinusB, APlusB, MajorAxis, MinorAxis:Scaled;Theta:Angle;
P:Halfword;Q:Halfword; Q←CurExp;
{IF Mem[Q]↑.Hh.B0=0 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[671]; END;BEGIN HelpPtr←2;HelpLine↑[1]←672;HelpLine↑[0]←443;
END;PutGetError[];CurExp←3; GOTO Label50;
END ELSE IF Mem[Q]↑.Hh.B0=4 THEN--865:--BEGIN Tx←Mem[ INT[Q]+1]↑.Int;
Ty←Mem[ INT[Q]+2]↑.Int;Txx←Mem[ INT[Q]+3]↑.Int-Tx;Tyx←Mem[ INT[Q]+4]↑.Int-Ty;
Txy←Mem[ INT[Q]+5]↑.Int-Tx;Tyy←Mem[ INT[Q]+6]↑.Int-Ty;
AMinusB←PythAdd[Txx-Tyy,Tyx+Txy];
APlusB←PythAdd[Txx+Tyy,Tyx-Txy];
MajorAxis← PascalDIVPower2[(AMinusB+APlusB),1];
MinorAxis← PascalDIVPower2[(ABS[APlusB-AMinusB]),1];
IF MajorAxis=MinorAxis THEN Theta←0 ELSE Theta← PascalDIVPower2[(NArg[Txx-Tyy,
Tyx+Txy]+NArg[Txx+Tyy,Tyx-Txy]),1];FreeNode[Q,7];
Q←MakeEllipse[MajorAxis,MinorAxis,Theta];
IF(Tx#0)OR (Ty#0) THEN--866:--BEGIN P←Q;
DO Mem[ INT[P]+1]↑.Int←Mem[ INT[P]+1]↑.Int+Tx;Mem[ INT[P]+2]↑.Int←Mem[ INT[P]+2]↑.Int+Ty;
P←Mem[P]↑.Hh.Rh; IF P=Q THEN EXIT; ENDLOOP; END--:866--; END--:865--;CurExp←MakePen[Q];
EXITS Label50 => NULL};TossKnotList[Q];CurType←6; END;--:864----870:----871:
KnownPair: PROCEDURE =
BEGIN P:Halfword;
IF CurType#14 THEN BEGIN DispErr[0,674];BEGIN HelpPtr←5;
HelpLine↑[4]←675;HelpLine↑[3]←676;HelpLine↑[2]←677;HelpLine↑[1]←678;
HelpLine↑[0]←679; END;PutGetFlushError[0];CurX←0;CurY←0;
END ELSE BEGIN P←Mem[CurExp+1]↑.Int;--872:
IF Mem[P]↑.Hh.B0=16 THEN CurX←Mem[ INT[P]+1]↑.Int ELSE BEGIN DispErr[P,680];
BEGIN HelpPtr←5;HelpLine↑[4]←681;HelpLine↑[3]←676;HelpLine↑[2]←677;
HelpLine↑[1]←678;HelpLine↑[0]←679; END;PutGetError[];RecycleValue[P];
CurX←0; END;
IF Mem[ INT[P]+2]↑.Hh.B0=16 THEN CurY←Mem[ INT[P]+3]↑.Int ELSE BEGIN DispErr[ INT[P]+2,
682];BEGIN HelpPtr←5;HelpLine↑[4]←683;HelpLine↑[3]←676;
HelpLine↑[2]←677;HelpLine↑[1]←678;HelpLine↑[0]←679; END;PutGetError[];
RecycleValue[ INT[P]+2];CurY←0; END--:872--;FlushCurExp[0]; END; END;--:871
ScanDirection: PROCEDURE RETURNS[ScanDirectionResult: SmallNumber] =
BEGIN T:PascalInteger[2..4];X:Scaled;
GetXNext[];IF CurCmd=60 THEN--875:--BEGIN GetXNext[];
ScanExpression[];IF(CurType#16)OR (CurExp<0) THEN BEGIN DispErr[0,686];
BEGIN HelpPtr←1;HelpLine↑[0]←687; END;PutGetFlushError[65536]; END;
T←3; END--:875-- ELSE--876:--BEGIN ScanExpression[];IF INT[CurType]>14 THEN--877:
BEGIN IF CurType#16 THEN BEGIN DispErr[0,680];BEGIN HelpPtr←5;
HelpLine↑[4]←681;HelpLine↑[3]←676;HelpLine↑[2]←677;HelpLine↑[1]←678;
HelpLine↑[0]←679; END;PutGetFlushError[0]; END;X←CurExp;
IF CurCmd#79 THEN BEGIN MissingErr[44];BEGIN HelpPtr←2;
HelpLine↑[1]←688;HelpLine↑[0]←689; END;BackError[]; END;GetXNext[];
ScanExpression[];IF CurType#16 THEN BEGIN DispErr[0,682];
BEGIN HelpPtr←5;HelpLine↑[4]←683;HelpLine↑[3]←676;HelpLine↑[2]←677;
HelpLine↑[1]←678;HelpLine↑[0]←679; END;PutGetFlushError[0]; END;
CurY←CurExp;CurX←X; END--:877-- ELSE KnownPair[];
IF(CurX=0)AND (CurY=0) THEN T←4 ELSE BEGIN T←2;
CurExp←NArg[CurX,CurY]; END; END--:876--;
IF CurCmd#65 THEN BEGIN MissingErr[125];BEGIN HelpPtr←3;
HelpLine↑[2]←684;HelpLine↑[1]←685;HelpLine↑[0]←564; END;BackError[];
END;GetXNext[];ScanDirectionResult←T; END;--:874----894:
ScanPrimary: PROCEDURE
=
BEGIN P, Q, R:Halfword;C:Quarterword;MyVarFlag:PascalInteger[0..82];
LDelim, RDelim:Halfword;--830:--GroupLine:PascalInteger;--:830----835:
Num, Denom:Scaled;--:835----842:--PreHead, PostHead, Tail:Halfword;
Tt:SmallNumber;T:Halfword;MacroRef:Halfword;--:842
MyVarFlag←VarFlag;VarFlag←0;
DO {--Label20:--BEGIN IF ArithError THEN ClearArith[]; END;--824:
IF Panicking THEN CheckMem[FALSE];
IF Interrupt#0 THEN IF OkToInterrupt THEN BEGIN BackInput[];
BEGIN IF Interrupt#0 THEN PauseForInstructions[]; END;GetXNext[];
END--:824--;{SELECT CurCmd FROM 31 =>--825:--BEGIN LDelim←CurSym;
RDelim←CurMod;GetXNext[];ScanExpression[];
IF(CurCmd=79)AND ( INT[CurType]>=16) THEN--829:--BEGIN P←GetNode[2];
Mem[P]↑.Hh.B0←14;Mem[P]↑.Hh.B1←11;InitBigNode[P];Q←Mem[ INT[P]+1]↑.Int;
StashIn[Q];GetXNext[];ScanExpression[];
IF INT[CurType]<16 THEN BEGIN DispErr[0,640];BEGIN HelpPtr←4;
HelpLine↑[3]←641;HelpLine↑[2]←642;HelpLine↑[1]←643;HelpLine↑[0]←644;
END;PutGetFlushError[0]; END;StashIn[ INT[Q]+2];
CheckDelimiter[LDelim,RDelim];CurType←14;CurExp←P; END--:829
ELSE CheckDelimiter[LDelim,RDelim]; END--:825--;32 =>--831:
BEGIN GroupLine←Line;
IF Internal↑[7]>0 THEN ShowCmdMod[CurCmd,CurMod];BEGIN P←GetAvail[];
Mem[P]↑.Hh.Lh←0;Mem[P]↑.Hh.Rh←SavePtr;SavePtr←P; END;
DO DoStatement[]; IF CurCmd#80 THEN EXIT; ENDLOOP;
IF CurCmd#81 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[645]; END;PrintInt[GroupLine];Print[646];BEGIN HelpPtr←2;
HelpLine↑[1]←647;HelpLine↑[0]←648; END;BackError[];CurCmd←81; END;
Unsave[];IF Internal↑[7]>0 THEN ShowCmdMod[CurCmd,CurMod]; END--:831--;
39 =>--832:--BEGIN CurType←4;CurExp←CurMod; END--:832--;42 =>--836:
BEGIN CurExp←CurMod;CurType←16;GetXNext[];
IF CurCmd#54 THEN BEGIN Num←0;Denom←0; END ELSE BEGIN GetXNext[];
IF CurCmd#42 THEN BEGIN BackInput[];CurCmd←54;CurMod←72;
CurSym←2233; GOTO Label30; END;Num←CurExp;Denom←CurMod;
IF Denom=0 THEN--837:--BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[649]; END;BEGIN HelpPtr←1;HelpLine↑[0]←650; END;Error[]; END--:837
ELSE CurExp←MakeScaled[Num,Denom];
BEGIN IF ArithError THEN ClearArith[]; END;GetXNext[]; END;
IF INT[CurCmd]>=30 THEN IF INT[CurCmd]<42 THEN BEGIN P←StashCurExp[];
ScanPrimary[];
IF(ABS[Num]>=ABS[Denom])OR ( INT[CurType]<14) THEN DoBinary[P,71] ELSE BEGIN
FracMult[Num,Denom];FreeNode[P,2]; END; END; GOTO Label30; END--:836--;33 =>--833:
DoNullary[CurMod]--:833--;34,30,36,43 =>--834:--BEGIN C←CurMod;GetXNext[];
ScanPrimary[];DoUnary[C]; GOTO Label30; END--:834--;37 =>--838:--BEGIN C←CurMod;
GetXNext[];ScanExpression[];IF CurCmd#69 THEN BEGIN MissingErr[348];
Print[582];PrintCmdMod[37,C];BEGIN HelpPtr←1;HelpLine↑[0]←583; END;
BackError[]; END;P←StashCurExp[];GetXNext[];ScanPrimary[];DoBinary[P,C];
GOTO Label30; END--:838--;35 =>--839:--BEGIN GetXNext[];ScanSuffix[];
OldSetting←Selector;Selector←5;ShowTokenList[CurExp,0,100000,0];
FlushTokenList[CurExp];CurExp←MakeString[];Selector←OldSetting;
CurType←4; GOTO Label30; END--:839--;40 =>--840:--BEGIN Q←CurMod;
IF MyVarFlag=77 THEN BEGIN GetXNext[];
IF CurCmd=77 THEN BEGIN CurExp←GetAvail[];Mem[CurExp]↑.Hh.Lh← INT[Q]+2241;
CurType←20; GOTO Label30; END;BackInput[]; END;CurType←16;
CurExp←Internal↑[Q]; END--:840--;38 =>MakeExpCopy[CurMod];41 =>--843:
BEGIN BEGIN PreHead←Avail;
IF PreHead=0 THEN PreHead←GetAvail [] ELSE BEGIN Avail←Mem[PreHead]↑.
Hh.Rh;Mem[PreHead]↑.Hh.Rh←0;DynUsed←DynUsed+1; END; END;
Tail←PreHead;PostHead←0;Tt←1;{WHILE TRUE DO BEGIN T←CurTok[];
Mem[Tail]↑.Hh.Rh←T;IF Tt#0 THEN BEGIN--849:
BEGIN P←Mem[PreHead]↑.Hh.Rh;Q←Mem[P]↑.Hh.Lh;Tt←0;
{IF Eqtb↑[Q].Lh MOD 83=41 THEN BEGIN Q←Eqtb↑[Q].Rh;IF Q=0 THEN GOTO Label32;
WHILE TRUE DO BEGIN P←Mem[P]↑.Hh.Rh;IF P=0 THEN BEGIN Tt←Mem[Q]↑.Hh.B0;
GOTO Label32; END;IF Mem[Q]↑.Hh.B0#21 THEN GOTO Label32;
Q←Mem[Mem[ INT[Q]+1]↑.Hh.Lh]↑.Hh.Rh;
IF INT[P]>=HiMemMin THEN BEGIN DO Q←Mem[Q]↑.Hh.Rh;
IF INT[Mem[ INT[Q]+2]↑.Hh.Lh]>=Mem[P]↑.Hh.Lh THEN EXIT; ENDLOOP;
IF INT[Mem[ INT[Q]+2]↑.Hh.Lh]>Mem[P]↑.Hh.Lh THEN GOTO Label32; END; END ENDLOOP ; END;EXITS Label32 => NULL}; END--:849--;
IF INT[Tt]>=22 THEN--844:--BEGIN Mem[Tail]↑.Hh.Rh←0;
IF INT[Tt]>22 THEN BEGIN PostHead←GetAvail[];Tail←PostHead;
Mem[Tail]↑.Hh.Rh←T;Tt←0;MacroRef←Mem[ INT[Q]+1]↑.Int;
Mem[MacroRef]↑.Hh.Lh← INT[Mem[MacroRef]↑.Hh.Lh]+1; END ELSE--852:
BEGIN P←GetAvail[];Mem[PreHead]↑.Hh.Lh←Mem[PreHead]↑.Hh.Rh;
Mem[PreHead]↑.Hh.Rh←P;Mem[P]↑.Hh.Lh←T;
MacroCall[Mem[ INT[Q]+1]↑.Int,PreHead,0];GetXNext[]; GOTO Label20; END--:852--;
END--:844--; END;GetXNext[];Tail←T;IF CurCmd=63 THEN--845:
BEGIN GetXNext[];ScanExpression[];IF CurCmd#64 THEN--846:
BEGIN BackInput[];BackExpr[];CurCmd←63;CurMod←0;CurSym←2232;
END--:846-- ELSE BEGIN IF CurType#16 THEN BadSubscript[];CurCmd←42;
CurMod←CurExp;CurSym←0; END; END--:845--;IF INT[CurCmd]>42 THEN GOTO Label31;
IF INT[CurCmd]<40 THEN GOTO Label31; END ENDLOOP ;EXITS Label31 => NULL};--851:--IF PostHead#0 THEN--853:
BEGIN BackInput[];P←GetAvail[];Q←Mem[PostHead]↑.Hh.Rh;
Mem[PreHead]↑.Hh.Lh←Mem[PreHead]↑.Hh.Rh;Mem[PreHead]↑.Hh.Rh←PostHead;
Mem[PostHead]↑.Hh.Lh←Q;Mem[PostHead]↑.Hh.Rh←P;
Mem[P]↑.Hh.Lh←Mem[Q]↑.Hh.Rh;Mem[Q]↑.Hh.Rh←0;
MacroCall[MacroRef,PreHead,0];
Mem[MacroRef]↑.Hh.Lh← INT[Mem[MacroRef]↑.Hh.Lh]-1;GetXNext[]; GOTO Label20;
END--:853--;Q←Mem[PreHead]↑.Hh.Rh;BEGIN Mem[PreHead]↑.Hh.Rh←Avail;
Avail←PreHead;DynUsed←DynUsed-1; END;
IF CurCmd=MyVarFlag THEN BEGIN CurType←20;CurExp←Q; GOTO Label30; END;
P←FindVariable[Q];
IF P#0 THEN MakeExpCopy[P] ELSE BEGIN Obliterated[Q];
HelpLine↑[2]←662;HelpLine↑[1]←663;HelpLine↑[0]←664;
PutGetFlushError[0]; END;FlushNodeList[Q]; GOTO Label30--:851--; END--:843--;
ENDCASE =>BEGIN BadExp[634]; GOTO Label20; END ;GetXNext[];
EXITS Label30 => NULL};IF CurCmd=63 THEN IF INT[CurType]>=16 THEN--858:--BEGIN P←StashCurExp[];
GetXNext[];ScanExpression[];IF CurCmd#79 THEN BEGIN--846:
BEGIN BackInput[];BackExpr[];CurCmd←63;CurMod←0;CurSym←2232;
END--:846--;UnstashCurExp[P]; END ELSE BEGIN Q←StashCurExp[];GetXNext[];
ScanExpression[];IF CurCmd#64 THEN BEGIN MissingErr[93];
BEGIN HelpPtr←3;HelpLine↑[2]←666;HelpLine↑[1]←667;HelpLine↑[0]←564;
END;BackError[]; END;R←StashCurExp[];MakeExpCopy[Q];DoBinary[R,70];
DoBinary[P,71];DoBinary[Q,69];GetXNext[]; END; END--:858--;EXIT; EXITS Label20 => NULL} ENDLOOP; END;--:822
--859:-- ScanSuffix: PROCEDURE =
BEGIN H, T:Halfword;P:Halfword;
H←GetAvail[];T←H;{WHILE TRUE DO BEGIN IF CurCmd=63 THEN--860:
BEGIN GetXNext[];ScanExpression[];IF CurType#16 THEN BadSubscript[];
IF CurCmd#64 THEN BEGIN MissingErr[93];BEGIN HelpPtr←3;
HelpLine↑[2]←668;HelpLine↑[1]←667;HelpLine↑[0]←564; END;BackError[];
END;CurCmd←42;CurMod←CurExp; END--:860--;
IF CurCmd=42 THEN P←NewNumTok[CurMod] ELSE IF(CurCmd=41)OR (
CurCmd=40) THEN BEGIN P←GetAvail[];Mem[P]↑.Hh.Lh←CurSym; END ELSE GOTO Label30;
Mem[T]↑.Hh.Rh←P;T←P;GetXNext[]; END ENDLOOP ;EXITS Label30 => NULL};CurExp←Mem[H]↑.Hh.Rh;
BEGIN Mem[H]↑.Hh.Rh←Avail;Avail←H;DynUsed←DynUsed-1; END;
CurType←20; END;--:859----861:--
END.