-- file: MFOpsImpl2.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,
MFOctants,
MFEnvelopes,
MFTime,
MFEquations,
MFParsing,
MFOps;
MFOpsImpl2: PROGRAM IMPORTS MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFOctants, MFEnvelopes, MFTime, MFEquations, MFParsing, MFOps EXPORTS MFOps = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFOctants, MFEnvelopes, MFTime, MFEquations, MFParsing, MFOps;
Bilin1: PROCEDURE[P: Halfword,
T: Scaled,Q: Halfword,U,Delta: Scaled] =
BEGIN R:Halfword;
IF T#65536 THEN DepMult[P,T,TRUE];
IF U#0 THEN IF Mem[Q]↑.Hh.B0=16 THEN Delta←Delta+TakeScaled[Mem[ INT[Q]+1]↑.
Int,U] ELSE BEGIN--968:
IF Mem[P]↑.Hh.B0#18 THEN BEGIN IF Mem[P]↑.Hh.B0=16 THEN NewDep[P,
ConstDependency[Mem[ INT[P]+1]↑.Int]] ELSE Mem[ INT[P]+1]↑.Hh.Rh←PTimesV[Mem[ INT[P]+1]↑.
Hh.Rh,65536,17,18,TRUE];Mem[P]↑.Hh.B0←18; END--:968--;
Mem[ INT[P]+1]↑.Hh.Rh←PPlusFq[Mem[ INT[P]+1]↑.Hh.Rh,U,Mem[ INT[Q]+1]↑.Hh.Rh,18,Mem[Q]↑.Hh.
B0]; END;
IF Mem[P]↑.Hh.B0=16 THEN Mem[ INT[P]+1]↑.Int←Mem[ INT[P]+1]↑.Int+Delta ELSE BEGIN R←
Mem[ INT[P]+1]↑.Hh.Rh;WHILE Mem[R]↑.Hh.Lh#0 DO R←Mem[R]↑.Hh.Rh ENDLOOP ;
Delta←Mem[ INT[R]+1]↑.Int+Delta;
IF R#Mem[ INT[P]+1]↑.Hh.Rh THEN Mem[ INT[R]+1]↑.Int←Delta ELSE BEGIN RecycleValue[P
];Mem[P]↑.Hh.B0←16;Mem[ INT[P]+1]↑.Int←Delta; END; END;
IF FixNeeded THEN FixDependencies[]; END;--:967----970:
AddMultDep: PROCEDURE[P: Halfword,V: Scaled,R: Halfword]
=
BEGIN IF Mem[R]↑.Hh.B0=16 THEN Mem[ INT[DepFinal]+1]↑.Int←Mem[ INT[DepFinal]+1]↑.Int
+TakeScaled[Mem[ INT[R]+1]↑.Int,V] ELSE BEGIN Mem[ INT[P]+1]↑.Hh.Rh←PPlusFq[Mem[ INT[P]+1
]↑.Hh.Rh,V,Mem[ INT[R]+1]↑.Hh.Rh,18,Mem[R]↑.Hh.B0];
IF FixNeeded THEN FixDependencies[]; END; END;--:970----971:
Bilin2: PROCEDURE[P,T: Halfword,V: Scaled,U,Q: Halfword] =
BEGIN Vv:Scaled;
Vv←Mem[ INT[P]+1]↑.Int;Mem[P]↑.Hh.B0←18;NewDep[P,ConstDependency[0]];
IF Vv#0 THEN AddMultDep[P,Vv,T];IF V#0 THEN AddMultDep[P,V,U];
IF Q#0 THEN AddMultDep[P,65536,Q];
IF Mem[ INT[P]+1]↑.Hh.Rh=DepFinal THEN BEGIN Vv←Mem[ INT[DepFinal]+1]↑.Int;
RecycleValue[P];Mem[P]↑.Hh.B0←16;Mem[ INT[P]+1]↑.Int←Vv; END; END;--:971----973:
Bilin3: PROCEDURE[P: Halfword,T,V,U,Delta: Scaled]
=
BEGIN IF T#65536 THEN Delta←Delta+TakeScaled[Mem[ INT[P]+1]↑.Int,T] ELSE
Delta←Delta+Mem[ INT[P]+1]↑.Int;
IF U#0 THEN Mem[ INT[P]+1]↑.Int←Delta+TakeScaled[V,U] ELSE Mem[ INT[P]+1]↑.Int←
Delta; END;--:973-- BigTrans: PROCEDURE[P: Halfword,C: Quarterword] =
BEGIN
Q, R, Pp, Qq:Halfword;S:SmallNumber;
S←BigNodeSize↑[Mem[P]↑.Hh.B0];Q←Mem[ INT[P]+1]↑.Int;R← INT[Q]+S;
{DO R← INT[R]-2;IF Mem[R]↑.Hh.B0#16 THEN--966:--BEGIN SetUpKnownTrans[C];
MakeExpCopy[P];R←Mem[CurExp+1]↑.Int;
IF CurType=13 THEN BEGIN Bilin1[ INT[R]+10,Tyy, INT[Q]+6,Tyx,0];
Bilin1[ INT[R]+8,Tyy, INT[Q]+4,Tyx,0];Bilin1[ INT[R]+6,Txx, INT[Q]+10,Txy,0];
Bilin1[ INT[R]+4,Txx, INT[Q]+8,Txy,0]; END;Bilin1[ INT[R]+2,Tyy,Q,Tyx,Ty];
Bilin1[R,Txx, INT[Q]+2,Txy,Tx]; GOTO Label10; END--:966--; IF R=Q THEN EXIT; ENDLOOP;--969:
SetUpTrans[C];IF CurType=16 THEN--972:--BEGIN MakeExpCopy[P];
R←Mem[CurExp+1]↑.Int;
IF CurType=13 THEN BEGIN Bilin3[ INT[R]+10,Tyy,Mem[ INT[Q]+7]↑.Int,Tyx,0];
Bilin3[ INT[R]+8,Tyy,Mem[ INT[Q]+5]↑.Int,Tyx,0];Bilin3[ INT[R]+6,Txx,Mem[ INT[Q]+11]↑.Int,Txy,0];
Bilin3[ INT[R]+4,Txx,Mem[ INT[Q]+9]↑.Int,Txy,0]; END;
Bilin3[ INT[R]+2,Tyy,Mem[ INT[Q]+1]↑.Int,Tyx,Ty];Bilin3[R,Txx,Mem[ INT[Q]+3]↑.Int,Txy,Tx];
END--:972-- ELSE BEGIN Pp←StashCurExp[];Qq←Mem[ INT[Pp]+1]↑.Int;
MakeExpCopy[P];R←Mem[CurExp+1]↑.Int;
IF CurType=13 THEN BEGIN Bilin2[ INT[R]+10, INT[Qq]+10,Mem[ INT[Q]+7]↑.Int, INT[Qq]+8,0];
Bilin2[ INT[R]+8, INT[Qq]+10,Mem[ INT[Q]+5]↑.Int, INT[Qq]+8,0];
Bilin2[ INT[R]+6, INT[Qq]+4,Mem[ INT[Q]+11]↑.Int, INT[Qq]+6,0];
Bilin2[ INT[R]+4, INT[Qq]+4,Mem[ INT[Q]+9]↑.Int, INT[Qq]+6,0]; END;
Bilin2[ INT[R]+2, INT[Qq]+10,Mem[ INT[Q]+1]↑.Int, INT[Qq]+8, INT[Qq]+2];
Bilin2[R, INT[Qq]+4,Mem[ INT[Q]+3]↑.Int, INT[Qq]+6,Qq];RecycleValue[Pp];FreeNode[Pp,2];
END;--:969--EXITS Label10 => NULL}; END;--:965----975:-- Cat: PROCEDURE[P: Halfword]
=
BEGIN A, B:StrNumber;K:PoolPointer; A←Mem[ INT[P]+1]↑.Int;B←CurExp;
BEGIN IF INT[PoolPtr]+(StrStart↑[A+1]-StrStart↑[A])+(
StrStart↑[B+1]-StrStart↑[B])>MaxPoolPtr THEN BEGIN IF INT[PoolPtr]+(
StrStart↑[A+1]-StrStart↑[A])+(StrStart↑[B+1]-StrStart↑[B])>PoolSize THEN Overflow[129,
PoolSize-InitPoolPtr];
MaxPoolPtr← INT[PoolPtr]+(StrStart↑[A+1]-StrStart↑[A])+(
StrStart↑[B+1]-StrStart↑[B]); END; END;
FOR i:INT IN [ INT[StrStart↑[A]].. INT[StrStart↑[A+1]-1 ]] DO K ← i; StrPool↑[PoolPtr]←
StrPool↑[K];PoolPtr←PoolPtr+1; ENDLOOP;
FOR i:INT IN [ INT[StrStart↑[B]].. INT[StrStart↑[B+1]-1 ]] DO K ← i; StrPool↑[PoolPtr]←
StrPool↑[K];PoolPtr←PoolPtr+1; ENDLOOP;CurExp←MakeString[];
BEGIN IF INT[StrRef↑[B]]<127 THEN IF INT[StrRef↑[B]]>1 THEN StrRef↑[B]←StrRef↑[B]
-1 ELSE FlushString[B]; END; END;--:975----976:
ChopString: PROCEDURE[P: Halfword] =
BEGIN A, B:PascalInteger;L:PascalInteger;K:PascalInteger;
S:StrNumber;Reversed:PascalBoolean; A←RoundUnscaled[Mem[ INT[P]+1]↑.Int];
B←RoundUnscaled[Mem[ INT[P]+3]↑.Int];
IF A<=B THEN Reversed←FALSE ELSE BEGIN Reversed←TRUE;K←A;A←B;B←K;
END;S←CurExp;L←(StrStart↑[S+1]-StrStart↑[S]);IF A<0 THEN BEGIN A←0;
IF B<0 THEN B←0; END;IF B>L THEN BEGIN B←L;IF A>L THEN A←L; END;
BEGIN IF PoolPtr+B-A>MaxPoolPtr THEN BEGIN IF PoolPtr+B-A>PoolSize
THEN Overflow[129,PoolSize-InitPoolPtr];MaxPoolPtr←PoolPtr+B-A;
END; END;
IF Reversed THEN FOR i:INT DECREASING IN [ INT[StrStart↑[S]+A ].. INT[StrStart↑[S]+B-1 ]] DO K ← i;
StrPool↑[PoolPtr]←StrPool↑[K];PoolPtr←PoolPtr+1;
ENDLOOP ELSE FOR i:INT IN [ INT[StrStart↑[S]+A ].. INT[StrStart↑[S]+B-1 ]] DO K ← i; StrPool↑
[PoolPtr]←StrPool↑[K];PoolPtr←PoolPtr+1; ENDLOOP;CurExp←MakeString[];
BEGIN IF INT[StrRef↑[S]]<127 THEN IF INT[StrRef↑[S]]>1 THEN StrRef↑[S]←StrRef↑[S]
-1 ELSE FlushString[S]; END; END;--:976----977:
ChopPath: PROCEDURE[P: Halfword] =
BEGIN Q:Halfword;Pp, Qq, Rr, Ss:Halfword;
A, B, K, L:Scaled;Reversed:PascalBoolean; L←PathLength[];A←Mem[ INT[P]+1]↑.Int;
B←Mem[ INT[P]+3]↑.Int;IF A<=B THEN Reversed←FALSE ELSE BEGIN Reversed←TRUE;
K←A;A←B;B←K; END;--978:
IF A<0 THEN IF Mem[CurExp]↑.Hh.B0=0 THEN BEGIN A←0;IF B<0 THEN B←0;
END ELSE DO A←A+L;B←B+L; IF A>=0 THEN EXIT; ENDLOOP;
IF B>L THEN IF Mem[CurExp]↑.Hh.B0=0 THEN BEGIN B←L;IF A>L THEN A←L;
END ELSE WHILE A>=L DO BEGIN A←A-L;B←B-L; END--:978-- ENDLOOP ;Q←CurExp;
WHILE A>=65536 DO BEGIN Q←Mem[Q]↑.Hh.Rh;A←A-65536;B←B-65536; END ENDLOOP ;
IF B=A THEN--980:--BEGIN IF A>0 THEN BEGIN Qq←Mem[Q]↑.Hh.Rh;
SplitCubic[Q,A*4096,Mem[ INT[Qq]+1]↑.Int,Mem[ INT[Qq]+2]↑.Int];Q←Mem[Q]↑.Hh.Rh; END;
Pp←CopyKnot[Q];Qq←Pp; END--:980-- ELSE--979:--BEGIN Pp←CopyKnot[Q];
Qq←Pp;DO Q←Mem[Q]↑.Hh.Rh;Rr←Qq;Qq←CopyKnot[Q];Mem[Rr]↑.Hh.Rh←Qq;
B←B-65536; IF B<=0 THEN EXIT; ENDLOOP;IF A>0 THEN BEGIN Ss←Pp;Pp←Mem[Pp]↑.Hh.Rh;
SplitCubic[Ss,A*4096,Mem[ INT[Pp]+1]↑.Int,Mem[ INT[Pp]+2]↑.Int];Pp←Mem[Ss]↑.Hh.Rh;
FreeNode[Ss,7];IF Rr=Ss THEN BEGIN B←MakeScaled[B,65536-A];Rr←Pp;
END; END;
IF B<0 THEN BEGIN SplitCubic[Rr,(B+65536)*4096,Mem[ INT[Qq]+1]↑.Int,Mem[ INT[Qq]+2]↑.
Int];FreeNode[Qq,7];Qq←Mem[Rr]↑.Hh.Rh; END; END--:979--;Mem[Pp]↑.Hh.B0←0;
Mem[Qq]↑.Hh.B1←0;Mem[Qq]↑.Hh.Rh←Pp;TossKnotList[CurExp];
IF Reversed THEN BEGIN CurExp←Mem[HtapYpoc[Pp]]↑.Hh.Rh;
TossKnotList[Pp]; END ELSE CurExp←Pp; END;--:977----981:
PairValue: PROCEDURE[X,Y: Scaled] =
BEGIN P:Halfword; P←GetNode[2];
FlushCurExp[P];CurType←14;Mem[P]↑.Hh.B0←14;Mem[P]↑.Hh.B1←11;
InitBigNode[P];P←Mem[ INT[P]+1]↑.Int;Mem[P]↑.Hh.B0←16;Mem[ INT[P]+1]↑.Int←X;
Mem[ INT[P]+2]↑.Hh.B0←16;Mem[ INT[P]+3]↑.Int←Y; END;--:981----983:
SetUpOffset: PROCEDURE[P: Halfword]
=
BEGIN FindOffset[Mem[ INT[P]+1]↑.Int,Mem[ INT[P]+3]↑.Int,CurExp];
PairValue[CurX,CurY]; END; SetUpDirectionTime: PROCEDURE[P: Halfword]
=
BEGIN FlushCurExp[FindDirectionTime[Mem[ INT[P]+1]↑.Int,Mem[ INT[P]+3]↑.Int,
CurExp]]; END;--:983----984:--
END.