-- file: MFOpsImpl3.mesa
-- Pascal-to-Mesa translator output, translated at October 31, 1985 4:28:02 pm PST
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFProcArray,
MFInteraction,
MFMemory,
MFSymbols,
MFPaths,
MFEdges,
MFOctants,
MFContours,
MFEnvelopes,
MFEquations,
MFInput,
MFParsing,
MFOps;
MFOpsImpl3: PROGRAM IMPORTS MFProcArray, MFInteraction, MFMemory, MFSymbols, MFPaths, MFEdges, MFOctants, MFContours, MFEnvelopes, MFEquations, MFInput, MFParsing, MFOps EXPORTS MFOps = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMemory, MFSymbols, MFPaths, MFEdges, MFOctants, MFContours, MFEnvelopes, MFEquations, MFInput, MFParsing, MFOps;
DoInterim: PROCEDURE =
BEGIN GetXNext[];
IF CurCmd#40 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[789]; END;IF CurSym=0 THEN Print[794] ELSE Print[Hash↑[CurSym].Rh];
Print[795];BEGIN HelpPtr←1;HelpLine↑[0]←796; END;BackError[];
END ELSE BEGIN SaveInternal[CurMod];BackInput[]; END;DoStatement[]; END;
--:1033----1034:-- DoLet: PROCEDURE =
BEGIN L:Halfword; GetSymbol[];
L←CurSym;GetXNext[];
IF CurCmd#51 THEN IF CurCmd#77 THEN BEGIN MissingErr[61];
BEGIN HelpPtr←3;HelpLine↑[2]←797;HelpLine↑[1]←539;HelpLine↑[0]←798;
END;BackError[]; END;GetSymbol[];
SELECT CurCmd FROM 10,53,44,49 =>Mem[CurMod]↑.Hh.Lh← INT[Mem[CurMod]↑.Hh.Lh]+1;
ENDCASE => NULL;ClearSymbol[L,FALSE];Eqtb↑[L].Lh←CurCmd;
IF CurCmd=41 THEN Eqtb↑[L].Rh←0 ELSE Eqtb↑[L].Rh←CurMod;GetXNext[];
END;--:1034----1035:-- DoNewInternal: PROCEDURE
=
BEGIN DO IF IntPtr=MaxInternal THEN Overflow[799,MaxInternal];
GetClearSymbol[];IntPtr←IntPtr+1;Eqtb↑[CurSym].Lh←40;
Eqtb↑[CurSym].Rh←IntPtr;IntName↑[IntPtr]←Hash↑[CurSym].Rh;
Internal↑[IntPtr]←0;GetXNext[]; IF CurCmd#79 THEN EXIT; ENDLOOP; END;--:1035----1039:
DoShow: PROCEDURE =
BEGIN DO GetXNext[];ScanExpression[];PrintNl[630];
PrintExp[0,2];FlushCurExp[0]; IF CurCmd#79 THEN EXIT; ENDLOOP; END;--:1039----1040:
DispToken: PROCEDURE =
BEGIN PrintNl[805];IF CurSym=0 THEN--1041:
BEGIN IF CurCmd=42 THEN PrintScaled[CurMod] ELSE IF CurCmd=38 THEN
BEGIN GPointer←CurMod;PrintCapsule[]; END ELSE BEGIN PrintChar[34];
Print[CurMod];PrintChar[34];
BEGIN IF INT[StrRef↑[CurMod]]<127 THEN IF INT[StrRef↑[CurMod]]>1 THEN StrRef↑
[CurMod]←StrRef↑[CurMod]-1 ELSE FlushString[CurMod]; END; END;
END--:1041-- ELSE BEGIN Print[Hash↑[CurSym].Rh];PrintChar[61];
IF INT[Eqtb↑[CurSym].Lh]>=83 THEN Print[806];PrintCmdMod[CurCmd,CurMod];
IF CurCmd=10 THEN BEGIN PrintLn[];ShowMacro[CurMod,0,100000]; END; END;
END;--:1040----1043:-- DoShowToken: PROCEDURE =
BEGIN DO GetNext[];
DispToken[];GetXNext[]; IF CurCmd#79 THEN EXIT; ENDLOOP; END;--:1043----1044:
DoShowStats: PROCEDURE =
BEGIN PrintNl[815];PrintInt[VarUsed];
PrintChar[38];PrintInt[DynUsed];IF FALSE THEN Print[230];Print[426];
PrintInt[ INT[HiMemMin]-LoMemMax-1];Print[816];PrintLn[];PrintNl[817];
PrintInt[StrPtr-InitStrPtr];PrintChar[38];
PrintInt[PoolPtr-InitPoolPtr];Print[426];
PrintInt[MaxStrings-MaxStrPtr];PrintChar[38];
PrintInt[PoolSize-MaxPoolPtr];Print[816];PrintLn[];GetXNext[]; END;
--:1044----1045:-- DispVar: PROCEDURE[P: Halfword] =
BEGIN Q:Halfword;
N:PascalInteger[0..MaxPrintLine]; IF Mem[P]↑.Hh.B0=21 THEN--1046:
BEGIN Q←Mem[ INT[P]+1]↑.Hh.Lh;DO DispVar[Q];Q←Mem[Q]↑.Hh.Rh; IF Q=17 THEN EXIT; ENDLOOP;
Q←Mem[ INT[P]+1]↑.Hh.Rh;WHILE Mem[Q]↑.Hh.B1=3 DO BEGIN DispVar[Q];
Q←Mem[Q]↑.Hh.Rh; END ENDLOOP ; END--:1046-- ELSE IF INT[Mem[P]↑.Hh.B0]>=22 THEN--1047:
BEGIN PrintNl[157];PrintVariableName[P];
IF INT[Mem[P]↑.Hh.B0]>22 THEN Print[531];Print[818];
IF INT[FileOffset]>=MaxPrintLine-20 THEN N←5 ELSE N←
MaxPrintLine-FileOffset-15;ShowMacro[Mem[ INT[P]+1]↑.Int,0,N]; END--:1047
ELSE IF Mem[P]↑.Hh.B0#0 THEN BEGIN PrintNl[157];PrintVariableName[P];
PrintChar[61];PrintExp[P,0]; END; END;--:1045----1048:
DoShowVar: PROCEDURE =
BEGIN DO GetNext[];
{IF INT[CurSym]>0 THEN IF INT[CurSym]<=2241 THEN IF CurCmd=41 THEN IF CurMod#0
THEN BEGIN DispVar[CurMod]; GOTO Label30; END;DispToken[];EXITS Label30 => NULL};GetXNext[];
IF CurCmd#79 THEN EXIT; ENDLOOP; END;--:1048----1049:-- DoShowDependencies: PROCEDURE
=
BEGIN P:Halfword; P←Mem[13]↑.Hh.Rh;
WHILE P#13 DO BEGIN IF Interesting[P] THEN BEGIN PrintNl[157];
PrintVariableName[P];
IF Mem[P]↑.Hh.B0=17 THEN PrintChar[61] ELSE Print[633];
PrintDependency[Mem[ INT[P]+1]↑.Hh.Rh,Mem[P]↑.Hh.B0]; END;P←Mem[ INT[P]+1]↑.Hh.Rh;
WHILE Mem[P]↑.Hh.Lh#0 DO P←Mem[P]↑.Hh.Rh ENDLOOP ;P←Mem[P]↑.Hh.Rh; END ENDLOOP ;GetXNext[];
END;--:1049----1050:-- DoShowWhatever: PROCEDURE
=
BEGIN IF Interaction=3 THEN NULL;SELECT CurMod FROM 0 =>DoShowToken[];
1 =>DoShowStats[];2 =>DoShow[];3 =>DoShowVar[];4 =>DoShowDependencies[]; ENDCASE;
IF Internal↑[32]>0 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[819]; END;IF INT[Interaction]<3 THEN BEGIN HelpPtr←0;
ErrorCount←ErrorCount-1; END ELSE BEGIN HelpPtr←1;HelpLine↑[0]←820;
END;IF CurCmd=80 THEN Error [] ELSE PutGetError[]; END; END;--:1050----1053:
FindEdgesVar: PROCEDURE[T: Halfword] =
BEGIN P:Halfword;
P←FindVariable[T];CurEdges←0;IF P=0 THEN BEGIN Obliterated[T];
PutGetError[];
END ELSE IF Mem[P]↑.Hh.B0#11 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;
PrintNl[133];Print[655]; END;ShowTokenList[T,0,1000,0];Print[833];
PrintType[Mem[P]↑.Hh.B0];PrintChar[41];BEGIN HelpPtr←2;
HelpLine↑[1]←834;HelpLine↑[0]←835; END;PutGetError[];
END ELSE CurEdges←Mem[ INT[P]+1]↑.Int;FlushNodeList[T]; END;--:1056----1058:
DoAddTo: PROCEDURE =
BEGIN Lhs, Rhs:Halfword;W:PascalInteger;
P:Halfword;Q:Halfword; GetXNext[];VarFlag←68;ScanPrimary[];
IF CurType#20 THEN--1059:--BEGIN DispErr[0,836];BEGIN HelpPtr←4;
HelpLine↑[3]←837;HelpLine↑[2]←838;HelpLine↑[1]←839;HelpLine↑[0]←835;
END;PutGetFlushError[0]; END--:1059-- ELSE BEGIN Lhs←CurExp;
CurPathType←CurMod;CurType←1;GetXNext[];ScanExpression[];
IF CurPathType=2 THEN--1060:--BEGIN FindEdgesVar[Lhs];
IF CurEdges=0 THEN FlushCurExp[0] ELSE IF CurType#11 THEN BEGIN
DispErr[0,840];BEGIN HelpPtr←2;HelpLine↑[1]←841;HelpLine↑[0]←835;
END;PutGetFlushError[0]; END ELSE BEGIN MergeEdges[CurExp];
FlushCurExp[0]; END; END--:1060-- ELSE--1061:
BEGIN IF CurType=14 THEN PairToPath[];
IF CurType#9 THEN BEGIN DispErr[0,840];BEGIN HelpPtr←2;
HelpLine↑[1]←842;HelpLine↑[0]←835; END;PutGetFlushError[0];
FlushTokenList[Lhs]; END ELSE BEGIN Rhs←CurExp;W←1;CurPen←3;
WHILE CurCmd=66 DO IF ScanWith [] THEN IF CurType=16 THEN W←CurExp
ELSE--1062:
BEGIN IF Mem[CurPen]↑.Hh.Lh=0 THEN TossPen[CurPen] ELSE Mem[CurPen]↑.Hh
.Lh← INT[Mem[CurPen]↑.Hh.Lh]-1;CurPen←CurExp; END--:1062-- ENDLOOP ;--1063:
FindEdgesVar[Lhs];
IF CurEdges=0 THEN TossKnotList[Rhs] ELSE BEGIN
Lhs←0;
{IF Mem[Rhs]↑.Hh.B0=0 THEN IF CurPathType=0 THEN--1064:
IF Mem[Rhs]↑.Hh.Rh=Rhs THEN--1065:--BEGIN Mem[ INT[Rhs]+5]↑.Int←Mem[ INT[Rhs]+1]↑.Int;
Mem[ INT[Rhs]+6]↑.Int←Mem[ INT[Rhs]+2]↑.Int;Mem[ INT[Rhs]+3]↑.Int←Mem[ INT[Rhs]+1]↑.Int;
Mem[ INT[Rhs]+4]↑.Int←Mem[ INT[Rhs]+2]↑.Int;Mem[Rhs]↑.Hh.B0←1;Mem[Rhs]↑.Hh.B1←1;
END--:1065-- ELSE BEGIN P←HtapYpoc[Rhs];Q←Mem[P]↑.Hh.Rh;
Mem[ INT[PathTail]+5]↑.Int←Mem[ INT[Q]+5]↑.Int;Mem[ INT[PathTail]+6]↑.Int←Mem[ INT[Q]+6]↑.Int;
Mem[PathTail]↑.Hh.B1←Mem[Q]↑.Hh.B1;Mem[PathTail]↑.Hh.Rh←Mem[Q]↑.Hh.Rh;
FreeNode[Q,7];Mem[ INT[P]+5]↑.Int←Mem[ INT[Rhs]+5]↑.Int;
Mem[ INT[P]+6]↑.Int←Mem[ INT[Rhs]+6]↑.Int;Mem[P]↑.Hh.B1←Mem[Rhs]↑.Hh.B1;
Mem[P]↑.Hh.Rh←Mem[Rhs]↑.Hh.Rh;FreeNode[Rhs,7];Rhs←P; END--:1064
ELSE--1066:--BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];Print[843];
END;BEGIN HelpPtr←2;HelpLine↑[1]←844;HelpLine↑[0]←835; END;
PutGetError[];TossKnotList[Rhs]; GOTO Label45; END--:1066
ELSE IF CurPathType=0 THEN Lhs←HtapYpoc[Rhs];CurWt←W;
Rhs←MakeSpec[Rhs,Mem[ INT[CurPen]+9]↑.Int,Internal↑[5]];--1067:
{IF TurningNumber<=0 THEN IF CurPathType#0 THEN IF Internal↑[39]>0
THEN IF(TurningNumber<0)AND (Mem[CurPen]↑.Hh.Rh=0) THEN CurWt←-CurWt
ELSE BEGIN IF TurningNumber=0 THEN IF(Internal↑[39]<=65536)AND (Mem[
CurPen]↑.Hh.Rh=0) THEN GOTO Label30 ELSE PrintStrange[845] ELSE PrintStrange[
846];BEGIN HelpPtr←3;HelpLine↑[2]←847;HelpLine↑[1]←848;
HelpLine↑[0]←849; END;PutGetError[]; END;EXITS Label30 => NULL};--:1067--IF Mem[ INT[CurPen]+9]↑.Int=0 THEN FillSpec[Rhs] ELSE FillEnvelope[Rhs];
IF Lhs#0 THEN BEGIN RevTurns←TRUE;
Lhs←MakeSpec[Lhs,Mem[ INT[CurPen]+9]↑.Int,Internal↑[5]];RevTurns←FALSE;
IF Mem[ INT[CurPen]+9]↑.Int=0 THEN FillSpec[Lhs] ELSE FillEnvelope[Lhs]; END;
EXITS Label45 => NULL}; END--:1063--;
IF Mem[CurPen]↑.Hh.Lh=0 THEN TossPen[CurPen] ELSE Mem[CurPen]↑.Hh.Lh←
INT[Mem[CurPen]↑.Hh.Lh]-1; END; END--:1061--; END; END;--:1058----1069:----1097:
END.