-- file: MFMathImpl.mesa
-- Pascal-to-Mesa translator output, translated at September 26, 1985 5:09:49 pm PDT
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFInteraction,
MFMath;
MFMathImpl: PROGRAM IMPORTS PascalBasic, MFInteraction EXPORTS MFMath = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFInteraction, MFMath;
--:91----97:--
ArithError: PascalBoolean;
--:97----129:
TwoToThe: LONG POINTER TO ARRAY PascalInteger[0..30] OF PascalInteger ← PascalStaticZone.NEW[ARRAY PascalInteger[0..30] OF PascalInteger];
SpecLog: LONG POINTER TO ARRAY PascalInteger[1..28] OF PascalInteger ← PascalStaticZone.NEW[ARRAY PascalInteger[1..28] OF PascalInteger];
--:129
--137:--SpecAtan: LONG POINTER TO ARRAY PascalInteger[1..26] OF Angle ← PascalStaticZone.NEW[ARRAY PascalInteger[1..26] OF Angle];
--:137----144:--
NSin: Fraction;
NCos: Fraction;
--:144----148:--Randoms: LONG POINTER TO ARRAY PascalInteger[0..54] OF Fraction ← PascalStaticZone.NEW[ARRAY PascalInteger[0..54] OF Fraction];
JRandom: PascalInteger[0..54];
ClearArith: PROCEDURE
=
BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];Print[173]; END;
BEGIN HelpPtr←4;HelpLine↑[3]←174;HelpLine↑[2]←175;HelpLine↑[1]←176;
HelpLine↑[0]←177; END;Error[];ArithError←FALSE; END;--:99----100:
RoundDecimals: PROCEDURE[K: SmallNumber] RETURNS[RoundDecimalsResult: Scaled] =
BEGIN A:PascalInteger; A←0;
WHILE INT[K]>0 DO BEGIN K←K-1;A← (A+Dig↑[K]*131072)/10; END ENDLOOP ;
RoundDecimalsResult← PascalDIVPower2[(A+1),1]; END;--:102----107:
MakeFraction: PROCEDURE[P,Q: PascalInteger] RETURNS[MakeFractionResult: Fraction] =
BEGIN F:PascalInteger;N:PascalInteger;
Negative:PascalBoolean;BeCareful:PascalInteger;
IF P>=0 THEN Negative←FALSE ELSE BEGIN P←-P;Negative←TRUE; END;
IF Q<=0 THEN BEGIN IF Q=0 THEN Confusion[47];Q←-Q;
Negative← NOT Negative; END;N← P /Q;P← P MOD Q;
IF N>=8 THEN BEGIN ArithError←TRUE;
IF Negative THEN MakeFractionResult←-2147483647 ELSE MakeFractionResult←
2147483647; END ELSE BEGIN N←(N-1)*268435456;--108:--F←1;
DO BeCareful←P-Q;P←BeCareful+P;
IF P>=0 THEN F←F+F+1 ELSE BEGIN F←F+F;P←P+Q; END; IF F>=268435456 THEN EXIT; ENDLOOP;
BeCareful←P-Q;IF BeCareful+P>=0 THEN F←F+1--:108--;
IF Negative THEN MakeFractionResult←-(F+N) ELSE MakeFractionResult←F+N; END; END;
--:107----109:-- TakeFraction: PROCEDURE[Q: PascalInteger,F: Fraction] RETURNS[TakeFractionResult: PascalInteger]
=
BEGIN P:PascalInteger;Negative:PascalBoolean;N:PascalInteger;BeCareful:PascalInteger;--110:
IF F>=0 THEN Negative←FALSE ELSE BEGIN F←-F;Negative←TRUE; END;
IF Q<0 THEN BEGIN Q←-Q;Negative← NOT Negative; END;--:110--IF F<268435456 THEN N←0 ELSE BEGIN N← PascalDIVPower2[F ,28];
F← PascalMODPower2Mask[F ,268435455];
IF Q<=2147483647 /N THEN N←N*Q ELSE BEGIN ArithError←TRUE;
N←2147483647; END; END;F←F+268435456;--111:--P←134217728;
IF Q<1073741824 THEN DO IF PascalODD[F] THEN P← PascalDIVPower2[(P+Q),1] ELSE P← PascalDIVPower2[(P),1];F← PascalDIVPower2[(F),1];
IF F=1 THEN EXIT; ENDLOOP ELSE DO IF PascalODD[F] THEN P← P+PascalDIVPower2[(Q-P),1] ELSE P← PascalDIVPower2[(P),1];
F← PascalDIVPower2[(F),1]; IF F=1--:111-- THEN EXIT; ENDLOOP;BeCareful←N-2147483647;
IF BeCareful+P>0 THEN BEGIN ArithError←TRUE;N←2147483647-P; END;
IF Negative THEN TakeFractionResult←-(N+P) ELSE TakeFractionResult←N+P; END;--:109
--112:-- TakeScaled: PROCEDURE[Q: PascalInteger,F: Scaled] RETURNS[TakeScaledResult: PascalInteger] =
BEGIN P:PascalInteger;
Negative:PascalBoolean;N:PascalInteger;BeCareful:PascalInteger;--110:
IF F>=0 THEN Negative←FALSE ELSE BEGIN F←-F;Negative←TRUE; END;
IF Q<0 THEN BEGIN Q←-Q;Negative← NOT Negative; END;--:110--IF F<65536 THEN N←0 ELSE BEGIN N← PascalDIVPower2[F ,16];F← PascalMODPower2Mask[F ,65535];
IF Q<=2147483647 /N THEN N←N*Q ELSE BEGIN ArithError←TRUE;
N←2147483647; END; END;F←F+65536;--113:--P←32768;
IF Q<1073741824 THEN DO IF PascalODD[F] THEN P← PascalDIVPower2[(P+Q),1] ELSE P← PascalDIVPower2[(P),1];F← PascalDIVPower2[(F),1];
IF F=1 THEN EXIT; ENDLOOP ELSE DO IF PascalODD[F] THEN P← P+PascalDIVPower2[(Q-P),1] ELSE P← PascalDIVPower2[(P),1];
F← PascalDIVPower2[(F),1]; IF F=1--:113-- THEN EXIT; ENDLOOP;BeCareful←N-2147483647;
IF BeCareful+P>0 THEN BEGIN ArithError←TRUE;N←2147483647-P; END;
IF Negative THEN TakeScaledResult←-(N+P) ELSE TakeScaledResult←N+P; END;--:112
--114:-- MakeScaled: PROCEDURE[P,Q: PascalInteger] RETURNS[MakeScaledResult: Scaled] =
BEGIN F:PascalInteger;N:PascalInteger;
Negative:PascalBoolean;BeCareful:PascalInteger;
IF P>=0 THEN Negative←FALSE ELSE BEGIN P←-P;Negative←TRUE; END;
IF Q<=0 THEN BEGIN IF Q=0 THEN Confusion[47];Q←-Q;
Negative← NOT Negative; END;N← P /Q;P← P MOD Q;
IF N>=32768 THEN BEGIN ArithError←TRUE;
IF Negative THEN MakeScaledResult←-2147483647 ELSE MakeScaledResult←2147483647;
END ELSE BEGIN N←(N-1)*65536;--115:--F←1;DO BeCareful←P-Q;
P←BeCareful+P;IF P>=0 THEN F←F+F+1 ELSE BEGIN F←F+F;P←P+Q; END;
IF F>=65536 THEN EXIT; ENDLOOP;BeCareful←P-Q;IF BeCareful+P>=0 THEN F←F+1--:115--;
IF Negative THEN MakeScaledResult←-(F+N) ELSE MakeScaledResult←F+N; END; END;--:114
--116:-- Velocity: PROCEDURE[St,Ct,Sf,Cf: Fraction,T: Scaled] RETURNS[VelocityResult: Fraction]
=
BEGIN Acc, Num, Denom:PascalInteger;
Acc←TakeFraction[St-( PascalDIVPower2[Sf ,4]),Sf-( PascalDIVPower2[St ,4])];
Acc←TakeFraction[Acc,Ct-Cf];
Num←536870912+TakeFraction[Acc,379625062];
Denom←805306368+TakeFraction[Ct,497706707]+TakeFraction[Cf,307599661]
;IF T#65536 THEN Num←MakeScaled[Num,T];
IF PascalDIVPower2[Num ,2]>=Denom THEN VelocityResult←1073741824 ELSE VelocityResult←
MakeFraction[Num,Denom]; END;--:116----117:
AbVsCd: PROCEDURE[A,B,C,D: PascalInteger] RETURNS[AbVsCdResult: PascalInteger] =
BEGIN Q, R:PascalInteger;
--118:--IF A<0 THEN BEGIN A←-A;B←-B; END;IF C<0 THEN BEGIN C←-C;
D←-D; END;
{IF D<=0 THEN BEGIN IF B>=0 THEN IF((A=0)OR (B=0))AND ((C=0)OR (D=0)) THEN
BEGIN AbVsCdResult←0; GOTO Label10; END ELSE BEGIN AbVsCdResult←1; GOTO Label10; END;
IF D=0 THEN IF A=0 THEN BEGIN AbVsCdResult←0; GOTO Label10;
END ELSE BEGIN AbVsCdResult←-1; GOTO Label10; END;Q←A;A←C;C←Q;Q←-B;B←-D;D←Q;
END ELSE IF B<=0 THEN BEGIN IF B<0 THEN IF A>0 THEN BEGIN AbVsCdResult←-1;
GOTO Label10; END;IF C=0 THEN BEGIN AbVsCdResult←0; GOTO Label10;
END ELSE BEGIN AbVsCdResult←-1; GOTO Label10; END; END--:118--;
WHILE TRUE DO BEGIN Q← A /D;R← C /B;
IF Q#R THEN IF Q>R THEN BEGIN AbVsCdResult←1; GOTO Label10;
END ELSE BEGIN AbVsCdResult←-1; GOTO Label10; END;Q← A MOD D;R← C MOD B;
IF R=0 THEN IF Q=0 THEN BEGIN AbVsCdResult←0; GOTO Label10;
END ELSE BEGIN AbVsCdResult←1; GOTO Label10; END;IF Q=0 THEN BEGIN AbVsCdResult←-1;
GOTO Label10; END;A←B;B←Q;C←D;D←R; END ENDLOOP ;EXITS Label10 => NULL}; END;--:117----119:
FloorScaled: PROCEDURE[X: Scaled] RETURNS[FloorScaledResult: Scaled] =
BEGIN BeCareful:PascalInteger;
IF X>=0 THEN FloorScaledResult←X-( PascalMODPower2Mask[X ,65535]) ELSE BEGIN BeCareful←X
+1;FloorScaledResult←X+( PascalMODPower2Mask[(-BeCareful),65535])-65535; END; END;
FloorUnscaled: PROCEDURE[X: Scaled] RETURNS[FloorUnscaledResult: PascalInteger] =
BEGIN BeCareful:PascalInteger;
IF X>=0 THEN FloorUnscaledResult← PascalDIVPower2[X ,16] ELSE BEGIN BeCareful←X
+1;FloorUnscaledResult←-(1+( PascalDIVPower2[(-BeCareful),16])); END; END;
RoundUnscaled: PROCEDURE[X: Scaled] RETURNS[RoundUnscaledResult: PascalInteger] =
BEGIN BeCareful:PascalInteger;
IF X>=32768 THEN RoundUnscaledResult←1+( PascalDIVPower2[(X-32768),16]) ELSE IF
X>=- INT[32768 ] THEN RoundUnscaledResult←0 ELSE BEGIN BeCareful←X+1;
RoundUnscaledResult←-(1+( PascalDIVPower2[(-BeCareful-32768),16])); END; END;
RoundFraction: PROCEDURE[X: Fraction] RETURNS[RoundFractionResult: Scaled] =
BEGIN BeCareful:PascalInteger;
IF X>=2048 THEN RoundFractionResult←1+( PascalDIVPower2[(X-2048),12]) ELSE IF
X>=-2048 THEN RoundFractionResult←0 ELSE BEGIN BeCareful←X+1;
RoundFractionResult←-(1+( PascalDIVPower2[(-BeCareful-2048),12])); END; END;--:119----121:
SquareRt: PROCEDURE[X: Scaled] RETURNS[SquareRtResult: Scaled] =
BEGIN K:SmallNumber;Y, Q:PascalInteger;
IF X<=0 THEN--122:
BEGIN IF X<0 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[178]; END;PrintScaled[X];Print[179];BEGIN HelpPtr←2;
HelpLine↑[1]←180;HelpLine↑[0]←181; END;Error[]; END;SquareRtResult←0; END--:122
ELSE BEGIN K←23;Q←2;WHILE X<536870912 DO BEGIN K←K-1;X←X+X+X+X; END ENDLOOP ;
IF X<1073741824 THEN Y←0 ELSE BEGIN X←X-1073741824;Y←1; END;
DO--123:--X←X+X;Y←Y+Y;IF X>=1073741824 THEN BEGIN X←X-1073741824;
Y←Y+1; END;X←X+X;Y←Y+Y-Q;Q←Q+Q;
IF X>=1073741824 THEN BEGIN X←X-1073741824;Y←Y+1; END;
IF Y>Q THEN BEGIN Y←Y-Q;Q←Q+2; END ELSE IF Y<=0 THEN BEGIN Q←Q-2;
Y←Y+Q; END;K←K-1--:123--; IF K=0 THEN EXIT; ENDLOOP;SquareRtResult← PascalDIVPower2[(Q),1]; END; END;--:121
--124:-- PythAdd: PROCEDURE[A,B: PascalInteger] RETURNS[PythAddResult: PascalInteger] =
BEGIN R:Fraction;
Big:PascalBoolean; A←ABS[A];B←ABS[B];IF A<B THEN BEGIN R←B;B←A;A←R;
END;
IF A>0 THEN BEGIN
IF A<536870912 THEN Big←FALSE ELSE BEGIN A← PascalDIVPower2[A ,2];
B← PascalDIVPower2[B ,2];Big←TRUE; END;--125:
{WHILE TRUE DO BEGIN R←MakeFraction[B,A];R←TakeFraction[R,R];
IF R=0 THEN GOTO Label30;R←MakeFraction[R,1073741824+R];
A←A+TakeFraction[A+A,R];B←TakeFraction[B,R]; END ENDLOOP ;EXITS Label30 => NULL};--:125--IF Big THEN IF A<536870912 THEN A←A+A+A+A ELSE BEGIN ArithError←TRUE;
A←2147483647; END; END;PythAddResult←A; END;--:124----126:
PythSub: PROCEDURE[A,B: PascalInteger] RETURNS[PythSubResult: PascalInteger] =
BEGIN R:Fraction;
Big:PascalBoolean; A←ABS[A];B←ABS[B];IF A<=B THEN--128:
BEGIN IF A<B THEN BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[182]; END;PrintScaled[A];Print[183];PrintScaled[B];Print[179];
BEGIN HelpPtr←2;HelpLine↑[1]←180;HelpLine↑[0]←181; END;Error[]; END;
A←0; END--:128
ELSE BEGIN
IF A<1073741824 THEN Big←FALSE ELSE BEGIN A← PascalDIVPower2[(A),1];
B← PascalDIVPower2[(B),1];Big←TRUE; END;--127:
{WHILE TRUE DO BEGIN R←MakeFraction[B,A];R←TakeFraction[R,R];
IF R=0 THEN GOTO Label30;R←MakeFraction[R,1073741824-R];
A←A-TakeFraction[A+A,R];B←TakeFraction[B,R]; END ENDLOOP ;EXITS Label30 => NULL};--:127--IF Big THEN A←A+A; END;PythSubResult←A; END;--:126----132:
MLog: PROCEDURE[X: Scaled] RETURNS[MLogResult: Scaled] =
BEGIN Y, Z:PascalInteger;K:PascalInteger;
IF X<=0 THEN--134:--BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[184]; END;PrintScaled[X];Print[179];BEGIN HelpPtr←2;
HelpLine↑[1]←185;HelpLine↑[0]←181; END;Error[];MLogResult←0; END--:134
ELSE BEGIN Y←1302456860;Z←6581195;WHILE X<1073741824 DO BEGIN X←X+X;
Y←Y-93032639;Z←Z-48782; END ENDLOOP ;Y←Y+( PascalDIVPower2[Z ,16]);K←2;
WHILE X>1073741828 DO--133:--BEGIN Z←( (X-1)/TwoToThe↑[K])+1;
WHILE X<1073741824+Z DO BEGIN Z← PascalDIVPower2[(Z+1),1];K←K+1; END ENDLOOP ;Y←Y+SpecLog↑[K];
X←X-Z; END--:133-- ENDLOOP ;MLogResult← PascalDIVPower2[Y ,3]; END; END;--:132----135:
MExp: PROCEDURE[X: Scaled] RETURNS[MExpResult: Scaled] =
BEGIN K:SmallNumber;Y, Z:PascalInteger;
IF X>174436200 THEN BEGIN ArithError←TRUE;MExpResult←2147483647;
END ELSE IF X<-197694359 THEN MExpResult←0 ELSE BEGIN IF X<=0 THEN BEGIN Z←
-8*X;Y←1048576;
END ELSE BEGIN IF X<=127919879 THEN Z←1023359037-8*X ELSE Z←8*(
174436200-X);Y←2147483647; END;--136:--K←1;
WHILE Z>0 DO BEGIN WHILE Z>=SpecLog↑[K]DO BEGIN Z←Z-SpecLog↑[K];
Y←Y-1-( (Y-TwoToThe↑[K-1])/TwoToThe↑[K]); END ENDLOOP ;K←K+1; END--:136-- ENDLOOP ;
IF X<=127919879 THEN MExpResult← PascalDIVPower2[(Y+8),4] ELSE MExpResult←Y; END; END;--:135
--139:-- NArg: PROCEDURE[X,Y: PascalInteger] RETURNS[NArgResult: Angle] =
BEGIN Z:Angle;T:PascalInteger;
K:SmallNumber;Octant:PascalInteger[1..8];
IF X>=0 THEN Octant←1 ELSE BEGIN X←-X;Octant←2; END;
IF Y<0 THEN BEGIN Y←-Y;Octant←Octant+2; END;IF X<Y THEN BEGIN T←Y;
Y←X;X←T;Octant←Octant+4; END;IF X=0 THEN--140:
BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];Print[186]; END;
BEGIN HelpPtr←2;HelpLine↑[1]←187;HelpLine↑[0]←181; END;Error[];
NArgResult←0; END--:140-- ELSE BEGIN--142:
WHILE X>=536870912 DO BEGIN X← PascalDIVPower2[(X),1];Y← PascalDIVPower2[(Y),1]; END ENDLOOP ;Z←0;
IF Y>0 THEN BEGIN WHILE X<268435456 DO BEGIN X←X+X;Y←Y+Y; END ENDLOOP ;--143:
K←0;DO Y←Y+Y;K←K+1;IF Y>X THEN BEGIN Z←Z+SpecAtan↑[K];T←X;
X←X+( Y /TwoToThe↑[K+K]);Y←Y-T; END; IF K=15 THEN EXIT; ENDLOOP;DO Y←Y+Y;K←K+1;
IF Y>X THEN BEGIN Z←Z+SpecAtan↑[K];Y←Y-X; END; IF K=26--:143-- THEN EXIT; ENDLOOP;
END--:142--;--141:--SELECT Octant FROM 1 =>NArgResult←Z;5 =>NArgResult←94371840-Z;
6 =>NArgResult←94371840+Z;2 =>NArgResult←188743680-Z;4 =>NArgResult←Z-188743680;
8 =>NArgResult←-Z-94371840;7 =>NArgResult←Z-94371840;3 =>NArgResult←-Z; ENDCASE--:141--; END; END;
--:139----145:-- NSinCos: PROCEDURE[Z: Angle] =
BEGIN K:SmallNumber;Q:PascalInteger[0..7];
R:Fraction;X, Y, T:PascalInteger; WHILE Z<0 DO Z←Z+377487360 ENDLOOP ;
Z← Z MOD 377487360;Q← Z /47185920;Z← Z MOD 47185920;X←268435456;
Y←X;IF NOT PascalODD[Q] THEN Z←47185920-Z;--147:--K←1;
WHILE Z>0 DO BEGIN IF Z>=SpecAtan↑[K] THEN BEGIN Z←Z-SpecAtan↑[K];T←X;
X← T+Y /TwoToThe↑[K];Y← Y-T /TwoToThe↑[K]; END;K←K+1; END ENDLOOP ;
IF Y<0 THEN Y←0--:147--;--146:--SELECT Q FROM 0 => NULL;1 =>BEGIN T←X;X←Y;Y←T; END;
2 =>BEGIN T←X;X←-Y;Y←T; END;3 =>X←-X;4 =>BEGIN X←-X;Y←-Y; END;
5 =>BEGIN T←X;X←-Y;Y←-T; END;6 =>BEGIN T←X;X←Y;Y←-T; END;7 =>Y←-Y;
ENDCASE--:146--;R←PythAdd[X,Y];NCos←MakeFraction[X,R];
NSin←MakeFraction[Y,R]; END;--:145----149:-- NewRandoms: PROCEDURE
=
BEGIN K:PascalInteger[0..54];X:Fraction;
FOR i:INT IN [ INT[0 ].. INT[23 ]] DO K ← i; X←Randoms↑[K]-Randoms↑[K+31];
IF X<0 THEN X←X+268435456;Randoms↑[K]←X; ENDLOOP;
FOR i:INT IN [ INT[24 ].. INT[54 ]] DO K ← i; X←Randoms↑[K]-Randoms↑[K-24];
IF X<0 THEN X←X+268435456;Randoms↑[K]←X; ENDLOOP;JRandom←54; END;--:149
--150:-- InitRandoms: PROCEDURE[Seed: Scaled] =
BEGIN J, Jj, K:Fraction;I:PascalInteger[0..54];
J←ABS[Seed];WHILE J>=268435456 DO J← PascalDIVPower2[(J),1] ENDLOOP ;K←1;
FOR i:INT IN [ INT[0 ].. INT[54 ]] DO I ← i; Jj←K;K←J-K;J←Jj;IF K<0 THEN K←K+268435456;
Randoms↑[ (I*21)MOD 55]←J; ENDLOOP;NewRandoms[];NewRandoms[];NewRandoms[]; END;
--:150----151:-- UnifRand: PROCEDURE[X: Scaled] RETURNS[UnifRandResult: Scaled] =
BEGIN Y:Scaled;
IF X<=0 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[188]; END;PrintScaled[X];Print[179];BEGIN HelpPtr←2;
HelpLine↑[1]←189;HelpLine↑[0]←181; END;Error[];UnifRandResult←0;
END ELSE BEGIN IF JRandom=0 THEN NewRandoms [] ELSE JRandom←JRandom-1;
Y←TakeFraction[X,Randoms↑[JRandom]];
IF Y=X THEN UnifRandResult←0 ELSE UnifRandResult←Y; END; END;--:151----152:
NormRand: PROCEDURE RETURNS[NormRandResult: Scaled] =
BEGIN X, U, L:PascalInteger;
DO DO IF JRandom=0 THEN NewRandoms [] ELSE JRandom←
JRandom-1;X←TakeFraction[112429,Randoms↑[JRandom]-134217728];
IF JRandom=0 THEN NewRandoms [] ELSE JRandom←JRandom-1;
U←Randoms↑[JRandom]; IF ABS[X]<U THEN EXIT; ENDLOOP;X←MakeFraction[X,U];
L←139548960-MLog[U]; IF AbVsCd[1024,L,X,X]>=0 THEN EXIT; ENDLOOP;NormRandResult←X; END;
END.