-- file: MFOpsImpl1.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,
MFInput,
MFFileNames,
MFParsing,
MFOps,
MFTFM;
MFOpsImpl1: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFEdges, MFOctants, MFEnvelopes, MFInput, MFFileNames, MFParsing, MFTFM EXPORTS MFOps = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFEdges, MFOctants, MFEnvelopes, MFInput, MFFileNames, MFParsing, MFOps, MFTFM;
--:820
--953:--
Txx: Scaled;
Txy: Scaled;
Tyx: Scaled;
Tyy: Scaled;
Tx: Scaled;
Ty: Scaled;
--:953----1076:--
StartSym: Halfword;
--:1076----1083:--
LongHelpSeen: PascalBoolean;
DoNullary: PROCEDURE[C: Quarterword] =
BEGIN K:PascalInteger;
BEGIN IF ArithError THEN ClearArith[]; END;
IF Internal↑[7]>131072 THEN ShowCmdMod[33,C];
SELECT C FROM 30,31 =>BEGIN CurType←2;CurExp←C; END;32 =>BEGIN CurType←11;
CurExp←GetNode[6];InitEdges[CurExp]; END;33 =>BEGIN CurType←6;
CurExp←3; END;37 =>BEGIN CurType←16;CurExp←NormRand[]; END;36 =>--895:
BEGIN CurType←8;CurExp←GetNode[7];Mem[CurExp]↑.Hh.B0←4;
Mem[CurExp]↑.Hh.B1←4;Mem[CurExp]↑.Hh.Rh←CurExp;Mem[CurExp+1]↑.Int←0;
Mem[CurExp+2]↑.Int←0;Mem[CurExp+3]↑.Int←65536;Mem[CurExp+4]↑.Int←0;
Mem[CurExp+5]↑.Int←0;Mem[CurExp+6]↑.Int←65536; END--:895--;
34 =>BEGIN IF JobName=0 THEN OpenLogFile[];CurType←4;CurExp←JobName;
END;35 =>--896:--BEGIN IF INT[Interaction]<=1 THEN FatalError[700];
BeginFileReading[];CurInput.NameField←1;BEGIN Print[157];TermInput[];
END;
BEGIN IF INT[PoolPtr+Last]-CurInput.StartField>MaxPoolPtr THEN BEGIN IF
INT[PoolPtr+Last]-CurInput.StartField>PoolSize THEN Overflow[129,
PoolSize-InitPoolPtr];
MaxPoolPtr← INT[PoolPtr+Last]-CurInput.StartField; END; END;
FOR i:INT IN [ INT[CurInput.StartField ].. INT[Last-1 ]] DO K ← i; StrPool↑[PoolPtr]←
Buffer↑[K];PoolPtr←PoolPtr+1; ENDLOOP;EndFileReading[];CurType←4;
CurExp←MakeString[]; END--:896--; ENDCASE;
BEGIN IF ArithError THEN ClearArith[]; END; END;--:894----897:----898:
NicePair: PROCEDURE[P: PascalInteger,T: Quarterword] RETURNS[NicePairResult: PascalBoolean] =
BEGIN
{IF T=14 THEN BEGIN P←Mem[P+1]↑.Int;
IF Mem[P]↑.Hh.B0=16 THEN IF Mem[P+2]↑.Hh.B0=16 THEN BEGIN NicePairResult←TRUE;
GOTO Label10; END; END;NicePairResult←FALSE;EXITS Label10 => NULL}; END;--:898----899:
PrintKnownOrUnknownType: PROCEDURE[T: SmallNumber,V: PascalInteger]
=
BEGIN PrintChar[40];
IF INT[T]<17 THEN IF T#14 THEN PrintType[T] ELSE IF NicePair[V,14] THEN
Print[209] ELSE Print[701] ELSE Print[702];PrintChar[41]; END;--:899----900:
BadUnary: PROCEDURE[C: Quarterword] =
BEGIN DispErr[0,703];PrintOp[C];
PrintKnownOrUnknownType[CurType,CurExp];BEGIN HelpPtr←3;
HelpLine↑[2]←704;HelpLine↑[1]←705;HelpLine↑[0]←706; END;PutGetError[];
END;--:900----903:-- NegateDepList: PROCEDURE[P: Halfword] =
BEGIN
{WHILE TRUE DO BEGIN Mem[ INT[P]+1]↑.Int←-Mem[ INT[P]+1]↑.Int;
IF Mem[P]↑.Hh.Lh=0 THEN GOTO Label10;P←Mem[P]↑.Hh.Rh; END ENDLOOP ;EXITS Label10 => NULL}; END;--:903----907:
PairToPath: PROCEDURE =
BEGIN CurExp←NewKnot[];CurType←9; END;--:907
--909:-- TakePart: PROCEDURE[C: Quarterword] =
BEGIN P:Halfword;
P←Mem[CurExp+1]↑.Int;Mem[18]↑.Int←P;Mem[17]↑.Hh.B0←CurType;
Mem[P]↑.Hh.Rh←17;FreeNode[CurExp,2];MakeExpCopy[ INT[P]+2*(C-53)];
RecycleValue[17]; END;--:909----912:-- StrToNum: PROCEDURE[C: Quarterword]
=
BEGIN N:PascalInteger;M:AsciiCode;K:PoolPointer;B:PascalInteger[8..16];BadChar:PascalBoolean;
IF C=49 THEN IF(StrStart↑[CurExp+1]-StrStart↑[CurExp])=0 THEN N
←-1 ELSE N←StrPool↑[StrStart↑[CurExp]] ELSE BEGIN IF C=47 THEN B←8
ELSE B←16;N←0;BadChar←FALSE;
FOR i:INT IN [ INT[StrStart↑[CurExp]].. INT[StrStart↑[CurExp+1]-1 ]] DO K ← i; M←StrPool↑
[K];IF( INT[M]>=48)AND ( INT[M]<=57) THEN M←M-48 ELSE IF( INT[M]>=65)AND ( INT[M]<=70) THEN M←M-55
ELSE IF( INT[M]>=97)AND ( INT[M]<=102) THEN M←M-87 ELSE BEGIN BadChar←TRUE;M←0;
END;IF INT[M]>=B THEN BEGIN BadChar←TRUE;M←0; END;
IF N<32768 /B THEN N←N*B+M ELSE N←32767; ENDLOOP;--913:
IF BadChar THEN BEGIN DispErr[0,708];IF C=47 THEN BEGIN HelpPtr←1;
HelpLine↑[0]←709; END ELSE BEGIN HelpPtr←1;HelpLine↑[0]←710; END;
PutGetError[]; END;IF N>4095 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;
PrintNl[133];Print[711]; END;PrintInt[N];PrintChar[41];
BEGIN HelpPtr←1;HelpLine↑[0]←712; END;PutGetError[]; END--:913--; END;
FlushCurExp[N*65536]; END;--:912----915:-- PathLength: PROCEDURE RETURNS[PathLengthResult: Scaled]
=
BEGIN N:Scaled;P:Halfword; P←CurExp;
IF Mem[P]↑.Hh.B0=0 THEN N←-65536 ELSE N←0;DO P←Mem[P]↑.Hh.Rh;
N←N+65536; IF P=CurExp THEN EXIT; ENDLOOP;PathLengthResult←N; END;--:915----918:
TestKnown: PROCEDURE[C: Quarterword] =
BEGIN B:PascalInteger[30..31];P, Q:Halfword;
B←31;SELECT CurType FROM 1,2,4,6,8,9,11,16 =>B←30;
13,14 =>BEGIN P←Mem[CurExp+1]↑.Int;Q← INT[P]+BigNodeSize↑[CurType];
{DO Q← INT[Q]-2;IF Mem[Q]↑.Hh.B0#16 THEN GOTO Label30; IF Q=P THEN EXIT; ENDLOOP;B←30;EXITS Label30 => NULL}; END;
ENDCASE => NULL;IF C=39 THEN FlushCurExp[B] ELSE FlushCurExp[61-B];
CurType←2; END;--:918-- DoUnary: PROCEDURE[C: Quarterword]
=
BEGIN P, Q:Halfword;X:PascalInteger; BEGIN IF ArithError THEN ClearArith[];
END;IF Internal↑[7]>131072 THEN--901:--BEGIN BeginDiagnostic[];
PrintNl[123];PrintOp[C];PrintChar[40];PrintExp[0,0];Print[707];
EndDiagnostic[FALSE]; END--:901--;
SELECT C FROM 69 =>IF INT[CurType]<14 THEN IF CurType#11 THEN BadUnary[69];
70 =>--902:--SELECT CurType FROM 14,19 =>BEGIN Q←CurExp;MakeExpCopy[Q];
IF CurType=17 THEN NegateDepList[Mem[CurExp+1]↑.Hh.Rh] ELSE IF
CurType=14 THEN BEGIN P←Mem[CurExp+1]↑.Int;
IF Mem[P]↑.Hh.B0=16 THEN Mem[ INT[P]+1]↑.Int←-Mem[ INT[P]+1]↑.Int ELSE NegateDepList
[Mem[ INT[P]+1]↑.Hh.Rh];
IF Mem[ INT[P]+2]↑.Hh.B0=16 THEN Mem[ INT[P]+3]↑.Int←-Mem[ INT[P]+3]↑.Int ELSE
NegateDepList[Mem[ INT[P]+3]↑.Hh.Rh]; END;RecycleValue[Q];FreeNode[Q,2]; END;
17,18 =>NegateDepList[Mem[CurExp+1]↑.Hh.Rh];16 =>CurExp←-CurExp;
11 =>NegateEdges[CurExp]; ENDCASE =>BadUnary[70]--:902--;--904:
41 =>IF CurType#2 THEN BadUnary[41] ELSE CurExp←61-CurExp;--:904
--905:
59,60,61,62,63,64,65,38,66 =>IF CurType#16 THEN BadUnary[C] ELSE SELECT C
FROM 59 =>CurExp←SquareRt[CurExp];60 =>CurExp←MExp[CurExp];
61 =>CurExp←MLog[CurExp];
62,63 =>BEGIN NSinCos[( CurExp MOD 23592960)*16];
IF C=62 THEN CurExp←RoundFraction[NSin] ELSE CurExp←RoundFraction[
NCos]; END;64 =>CurExp←FloorScaled[CurExp];
65 =>CurExp←UnifRand[CurExp];
38 =>BEGIN IF PascalODD[RoundUnscaled[CurExp]] THEN CurExp←30 ELSE CurExp←
31;CurType←2; END;66 =>--1180:
BEGIN CurExp← PascalMODPower2Mask[RoundUnscaled[CurExp],255];
IF CurExp<0 THEN CurExp←CurExp+256;
IF CharExists↑[CurExp] THEN CurExp←30 ELSE CurExp←31;CurType←2;
END--:1180--; ENDCASE;--:905----906:
67 =>IF NicePair[CurExp,CurType] THEN BEGIN P←Mem[CurExp+1]↑.Int;
X←NArg[Mem[ INT[P]+1]↑.Int,Mem[ INT[P]+3]↑.Int];
IF X>=0 THEN FlushCurExp[ PascalDIVPower2[(X+8),4]] ELSE FlushCurExp[-( PascalDIVPower2[(-X+8),4])]; END ELSE BadUnary[67];--:906----908:
53,54 =>IF( INT[CurType]<=14)AND ( INT[CurType]>=13) THEN TakePart[C] ELSE BadUnary[C
];55,56,57,58 =>IF CurType=13 THEN TakePart[C] ELSE BadUnary[C];--:908
--911:
50 =>IF CurType#16 THEN BadUnary[50] ELSE BEGIN CurExp← PascalMODPower2Mask[RoundUnscaled[
CurExp],127];CurType←4;IF CurExp<0 THEN CurExp←CurExp+128;
IF(StrStart↑[CurExp+1]-StrStart↑[CurExp])#1 THEN BEGIN BEGIN IF
INT[PoolPtr+1]>MaxPoolPtr THEN BEGIN IF INT[PoolPtr+1]>PoolSize THEN Overflow
[129,PoolSize-InitPoolPtr];MaxPoolPtr←PoolPtr+1; END; END;
BEGIN StrPool↑[PoolPtr]←CurExp;PoolPtr←PoolPtr+1; END;
CurExp←MakeString[]; END; END;
42 =>IF CurType#16 THEN BadUnary[42] ELSE BEGIN OldSetting←Selector;
Selector←5;PrintScaled[CurExp];CurExp←MakeString[];
Selector←OldSetting;CurType←4; END;
47,48,49 =>IF CurType#4 THEN BadUnary[C] ELSE StrToNum[C];--:911----914:
51 =>IF CurType=4 THEN FlushCurExp[(StrStart↑[CurExp+1]-StrStart↑
[CurExp])*65536] ELSE IF CurType=9 THEN FlushCurExp[PathLength[]] ELSE
IF CurType=16 THEN CurExp←ABS[CurExp] ELSE IF NicePair[CurExp,
CurType] THEN FlushCurExp[PythAdd[Mem[Mem[CurExp+1]↑.Int+1]↑.Int,Mem[
Mem[CurExp+1]↑.Int+3]↑.Int]] ELSE BadUnary[C];--:914----916:
52 =>IF CurType=14 THEN FlushCurExp[0] ELSE IF CurType#9 THEN
BadUnary[52] ELSE IF Mem[CurExp]↑.Hh.B0=0 THEN FlushCurExp[0] ELSE
BEGIN CurPen←3;CurPathType←1;
CurExp←MakeSpec[CurExp,-1879080960,0];
FlushCurExp[TurningNumber*65536]; END;--:916----917:
2 =>BEGIN IF( INT[CurType]>=2)AND ( INT[CurType]<=3) THEN FlushCurExp[30] ELSE
FlushCurExp[31];CurType←2; END;
4 =>BEGIN IF( INT[CurType]>=4)AND ( INT[CurType]<=5) THEN FlushCurExp[30] ELSE
FlushCurExp[31];CurType←2; END;
6 =>BEGIN IF( INT[CurType]>=6)AND ( INT[CurType]<=8) THEN FlushCurExp[30] ELSE
FlushCurExp[31];CurType←2; END;
9 =>BEGIN IF( INT[CurType]>=9)AND ( INT[CurType]<=10) THEN FlushCurExp[30] ELSE
FlushCurExp[31];CurType←2; END;
11 =>BEGIN IF( INT[CurType]>=11)AND ( INT[CurType]<=12) THEN FlushCurExp[30] ELSE
FlushCurExp[31];CurType←2; END;
13,14 =>BEGIN IF CurType=C THEN FlushCurExp[30] ELSE FlushCurExp[31];
CurType←2; END;
15 =>BEGIN IF( INT[CurType]>=16)AND ( INT[CurType]<=19) THEN FlushCurExp[30] ELSE
FlushCurExp[31];CurType←2; END;39,40 =>TestKnown[C];--:917----919:
68 =>BEGIN IF CurType#9 THEN FlushCurExp[31] ELSE IF Mem[CurExp]↑.Hh.B0
#0 THEN FlushCurExp[30] ELSE FlushCurExp[31];CurType←2; END;--:919
--920:--45 =>BEGIN IF CurType=14 THEN PairToPath[];
IF CurType=9 THEN CurType←8 ELSE BadUnary[45]; END;
44 =>BEGIN IF CurType=8 THEN MaterializePen[];
IF CurType#6 THEN BadUnary[44] ELSE BEGIN FlushCurExp[MakePath[
CurExp]];CurType←9; END; END;
46 =>IF CurType#11 THEN BadUnary[46] ELSE FlushCurExp[TotalWeight[
CurExp]];43 =>IF CurType=9 THEN BEGIN P←HtapYpoc[CurExp];
IF Mem[P]↑.Hh.B1=0 THEN P←Mem[P]↑.Hh.Rh;TossKnotList[CurExp];
CurExp←P; END ELSE IF CurType=14 THEN PairToPath [] ELSE BadUnary[43];
--:920-- ENDCASE;BEGIN IF ArithError THEN ClearArith[]; END; END;--:897----921:
END.