{--------------------------------------}
function MultiSI.Comp( var X : MultiSI) : Integer; {Comp = sign( Self - X)}
{Sign = -1 if Self < X; Sign = 0 if Self = X; Sign = +1 if Self > X}
{Self.S and X.S used but not changed; Self, X not changed}
begin
if Not S and Not X.S then Comp:= AbComp(X) {Both positive}
else if S and X.S then Comp:= X.AbComp( Self) {Both negative}
else if X.S then Comp:= +1 {Self pos, X neg}
else Comp:= -1; {Self neg, X pos}
end; {MultiSI.Comp}
{--------------------------------------}
procedure WriteMax( var Out : TEXT; St : String);
{Output String and line feed every MuMaxW, MuTot = characters on line so far}
var
I : Integer;
begin
if (@Out = @OutPut) or (MuMaxW <= 0) then Write( Out, St)
else
for I:= 1 to Length( St) do begin
Write( Out, St[I]); Inc( MuTot);
if (MuTot >= MuMaxW) then begin
WriteLn( Out); MuTot:= 0;
end;
end;
end; {WriteMax}
{--------------------------------------}
procedure WriteMaxLn( var Out : TEXT; St : String);
{Output String and line feed every MuMaxW, MuTot = characters on line so far
and a new line}
begin
WriteMax( Out, St);
WriteLn( Out); MuTot:= 0;
end; {WriteMaxLn}
{--------------------------------------}
procedure MultiSI.Writ( var Out : TEXT); {Output Self as a line of text}
{Self is not modified}
var
I, J, ToGo, LenD : LongInt;
St : String[8];
begin
ToGo:= LongInt(N) * MuDMax;
if S then WriteMax( Out, '-');
Str( Base + V^[N - 1] :0:0, St);
J:= 1;
repeat
Inc(J);
until (St[J] <> '0') or (J = MuDMax+1);
WriteMax( Out, St[J]);
Dec( ToGo, J - 1);
LenD:= ToGo + 1;
while J <= MuDMax do begin
Inc(J);
if (ToGo Mod MuDpG) = 0 then WriteMax( Out, ',');
WriteMax( Out, St[J]);
Dec( ToGo);
end;
for I:= 2 to N do begin
Str( Base + V^[N - I] :0:0, St);
for J:= 2 to MuDMax+1 do begin
if (ToGo Mod MuDpG) = 0 then WriteMax( Out, ',');
WriteMax( Out, St[J]);
Dec( ToGo);
end;
end;
if LenD >= MuLenD then begin
Str( LenD, St);
if (@Out <> @OutPut) and (MuMaxW > 0) and
(Length(St) > (MuMaxW - MuTot - 3)) then begin
WriteLn( Out); MuTot:= 0;
end;
if (@Out = @OutPut) or (MuMaxW <= 0) or (MuTot <> 0) then
WriteMax( Out, ' ');
WriteMax( Out, '(' + St + ')');
end;
end; {MultiSI.Writ}
{--------------------------------------}
procedure MultiSI.WritLn( var Out : TEXT); {Output Self and a new line}
begin
Writ( Out);
WriteLn( Out); MuTot:= 0;
end; {MultiSI.WritLn}
{--------------------------------------}
procedure MultiSI.ShortWr( var Out : TEXT; Short : LongInt);
{Output Self in short form ... if more than Short digits}
{Self is not modified}
var
Did : Integer;
I, J, ToGo, LenD : LongInt;
St : String[8];
begin
if (N < 3) or (N <= Short div MuDMax) then begin
Writ( Out); Exit;
end;
ToGo:= LongInt(N) * MuDMax;
if S then Write( Out, '-');
Str( Base + V^[N - 1] :0:0, St);
J:= 1;
repeat
Inc(J);
until (St[J] <> '0') or (J = MuDMax+1);
Write( Out, St[J]); Did:= 1;
Dec( ToGo, J - 1);
LenD:= ToGo + 1;
while (J <= MuDMax) and (Did < 5) do begin
Inc(J);
Write( Out, St[J]); Inc( Did);
end;
Str( Base + V^[N - 2] :0:0, St);
for J:= 2 to 6-Did do begin
Write( Out, St[J]);
end;
Write( Out, ',...,');
Str( Base + V^[0] :0:0, St);
for J:= MuDMax-3 to MuDMax+1 do begin
Write( Out, St[J]);
end;
Write( Out, ' (', LenD, ')');
end; {MultiSI.ShortWr}
{--------------------------------------}
procedure MultiSI.ShortWrLn( var Out: TEXT; Short : LongInt);
{Output Self short and a new line}
begin
ShortWr( Out, Short);
WriteLn( Out); MuTot:= 0;
end; {MultiSI.ShortWrLn}
{--------------------------------------}
procedure MultiSI.RMul1( D1 : Mu1Digit); {Self = Self * D1}
{Multi-precision one super digit multiply; D1 is not changed}
{MuErr set true if Self overflows}
var
K : Mu1Digit;
begin
S:= S xor (D1 < 0);
IpMul1(D1, Self, K);
if K > 0 then
MuWriteErr('One digit multiply overflow, continuing...');
end; {MultiSI.RMul1}
{--------------------------------------}
procedure MultiSI.Mul1( var X : MultiSI; D1 : Mu1Digit); {Self = X * D1}
{Multi-precision one super digit multiply; X and D1 are not changed}
{MuErr set true if Self overflows}
begin
SetTo(X);
RMul1( D1);
end; {MultiSI.Mul1}
{--------------------------------------}
procedure MultiSI.Mul( var X, Y : MultiSI); {Self = X * Y}
{X or Y or both may have the same address in memory as Self}
{X, Y are not changed unless they share memory with Self}
{Sets MuErr True if overflow}
var
XL, YL : ^MultiSI;
I, J, IJ : Integer;
K : Mu1Digit;
T : Mu2Digit;
NewXL, NewYL : Boolean;
begin
XL:= @X; NewXL:= False;
YL:= @Y; NewYL:= False;
if X.V = Self.V then begin
New( XL, Init( X.N)); XL^.SetTo(X); NewXL:= True;
end
else if Y.V = Self.V then begin
New( YL, Init( Y.N)); YL^.SetTo(Y); NewYL:= True;
end;
if @X = @Y then YL:= XL;
S:= XL^.S xor YL^.S;
for I:= 0 to XL^.N-1 do V^[I]:= 0; {Clear lower of Self}
KeyHit:= False;
for J:= 0 to YL^.N-1 do begin
K:= 0; I:= 0;
while I < XL^.N do begin
IJ:= I + J;
if IJ < Self.M then begin {Mult, add and carry next Digit}
T:= XL^.V^[I] * YL^.V^[J] + Self.V^[ IJ] + K;
K:= Int(T / Base);
Self.V^[ IJ]:= T - K * Base;
end
else
I:= XL^.N; {Break out of inner loop}
Inc(I);
end;
Inc( IJ);
if IJ < Self.M then Self.V^[ IJ]:= K;
MuInterrupt;
if MuAbort then begin
Clear;
if NewXL then Dispose( XL, Done);
if NewYL then Dispose( YL, Done);
Exit;
end;
if KeyHit then begin
for I:= 0 to Echo do
WriteLn( OutP[I]^, 'Integer Multiply: ',
Trunc( (100.0 * (J+1)) / YL^.N), ' Percent done');
KeyHit:= False;
end;
end;
if K <> 0 then Inc( IJ);
if IJ > Self.M then begin
IJ:= Self.M;
MuWriteErr('Multiplication overflow, continuing...');
end;
N:= IJ;
Norm;
if NewXL then Dispose( XL, Done);
if NewYL then Dispose( YL, Done);
end; {MultiSI.Mul}
{--------------------------------------}
procedure MultiSI.RMul( var X : MultiSI); {Self = Self * X}
{X may have the same address in memory as Self}
{X is not changed unless it shares memory with Self}
{Sets MuErr True if overflow}
begin
Mul( Self, X);
end; {MultiSI.RMul}
{--------------------------------------}
procedure MultiSI.Sq( var X : MultiSI); {Self = X * X}
{X may have the same address in memory as Self}
{X is not changed unless it shares memory with Self}
{Sets MuErr True if overflow}
begin
Mul(X, X);
end; {MultiSI.Sq}
{--------------------------------------}
procedure MultiSI.RSq; {Self = Self * Self}
{Sets MuErr True if overflow}
begin
Mul( Self, Self);
end; {MultiSI.RSq}
{--------------------------------------}
procedure MultiSI.ModMB; {Self = Self Mod MuMB}
{Self is changed}
var I : Integer; QL : ^MultiSI;
begin
if MuMB^.ZTest then Exit;
I:= AbComp( MuMB^);
if I >= 0 then begin {if |Self| >= |MuMB|}
New( QL, Init( Self.N));
IpDiv( MuMB^, Self, QL^, Self);
Dispose( QL, Done);
end;
end; {MultiSI.ModMB}
{--------------------------------------}
procedure MultiSI.RDiv1( D1 : Mu1Digit); {Self = Self / D1}
{Multi-precision one super digit divide, D1 is not changed}
{Allows literal D1, MuErr set True if D1 = 0}
var
RL : Mu1Digit;
begin
IpDiv1( D1, Self, RL);
end; {MultiSI.RDiv1}
{--------------------------------------}
procedure MultiSI.Div1( var U : MultiSI; D1 : Mu1Digit); {Self = U / D1}
{Multi-precision one super digit divide, D1 and U not changed}
{U and Self may have same address in memory, then U is changed}
{Allows literal D1, MuErr set True if D1 = 0}
var
RL : Mu1Digit;
begin
SetTo(U);
IpDiv1( D1, Self, RL);
end; {MultiSI.Div1}
{--------------------------------------}
procedure MultiSI.Mod1( D1: Mu1Digit; var R1: Mu1Digit); {R1 = Rem( Self / D1)}
{Multi-precision one super digit Modulo, D1 and Self not changed}
{D1 and R1 may have same address in memory, then D1 is changed}
{Allows literal D1, MuErr set True if D1 = 0}
var
QL : ^MultiSI;
begin
New( QL, Init( Self.N));
QL^.SetTo( Self);
IpDiv1( D1, QL^, R1);
Dispose( QL, Done);
end; {MultiSI.Mod1}
{--------------------------------------}
procedure MultiSI.RDiv1QR( D1: Mu1Digit; var R1: Mu1Digit);
{Self = Self / D1, R1 = Rem}
{Multi-precision one super digit Divide Q & R. D1 and U not changed}
{D1 and R1 may have same address in memory, then D1 is changed}
{Allows literal D1, MuErr set True if D1 = 0}
begin
IpDiv1( D1, Self, R1);
end; {MultiSI.RDiv1QR}
{--------------------------------------}
procedure MultiSI.Div1QR( var U: MultiSI; D1: Mu1Digit; var R1: Mu1Digit);
{Self = U / D1, R1 = Rem}
{Multi-precision one super digit Divide Q & R. D1 and U not changed}
{D1 and R1 may have same address in memory, then D1 is changed}
{Allows literal D1, MuErr set True if D1 = 0}
begin
SetTo(U);
IpDiv1( D1, Self, R1);
end; {MultiSI.Div1QR}
{--------------------------------------}
procedure MultiSI.Divi( var U, D : MultiSI); {Self = U / D}
{U or D or both may have the same address in memory as Self}
{U, D are not changed unless they share memory with Self}
{Sets MuErr True if D = 0}
var
DL, RL : ^MultiSI;
NewDL : Boolean;
begin
DL:= @D; NewDL:= False;
if D.V = Self.V then begin
New( DL, Init( D.N)); DL^.SetTo(D); NewDL:= True;
end;
New( RL, Init( U.N)); RL^.SetTo(U);
IpDiv( DL^, RL^, Self, RL^);
if NewDL then Dispose( DL, Done);
Dispose( RL, Done);
end; {MultiSI.Divi}
{--------------------------------------}
procedure MultiSI.RDiv( var D : MultiSI); {Self = Self / D}
{D may have the same address in memory as Self}
{D is not changed unless it shares memory with Self}
{Sets MuErr True if D = 0}
begin
Divi( Self, D);
end; {MultiSI.RDiv}
{--------------------------------------}
procedure MultiSI.Modu( var U, D : MultiSI); {Self = Rem(U / D)}
{U or D or both may have the same address in memory as Self}
{U, D are not changed unless they share memory with Self}
{Sets MuErr True if D = 0}
var
DL, QL : ^MultiSI;
NewDL : Boolean;
begin
DL:= @D; NewDL:= False;
if D.V = Self.V then begin
New( DL, Init( D.N)); DL^.SetTo(D); NewDL:= True;
end;
New( QL, Init( U.N));
SetTo(U);
IpDiv( DL^, Self, QL^, Self);
if NewDL then Dispose( DL, Done);
Dispose( QL, Done);
end; {MultiSI.Modu}
{--------------------------------------}
procedure MultiSI.RMod( var D : MultiSI); {Self = Rem( Self / D)}
{D may have the same address in memory as Self}
{D is not changed unless it shares memory with Self}
{Sets MuErr True if D = 0}
begin
Modu( Self, D);
end; {MultiSI.RMod}
{--------------------------------------}
procedure MultiSI.DivQR( var U, D, R : MultiSI); {Self = U / D, R = Rem}
{U or D or both may have the same address in memory as Self or R}
{U, D are not changed unless they share memory with Self or R}
{Self and R may not have the same location in memory. Sets MuErr True if D = 0}
var
DL : ^MultiSI;
NewDL : Boolean;
begin
if Self.V = R.V then begin
MuWriteErr(
'Cannot set same location to both quotient and remainder, continuing...');
Exit;
end;
DL:= @D; NewDL:= False;
if (D.V = Self.V) or (@D = @R) then begin
New( DL, Init( D.N)); DL^.SetTo(D); NewDL:= True;
end;
R.SetTo(U);
IpDiv( DL^, R, Self, R);
if NewDL then Dispose( DL, Done);
end; {MultiSI.DivQR}
{--------------------------------------}
procedure MultiSI.RDivQR( var D, R : MultiSI); {Self = Self / D, R = Rem}
{Self may have the same address in memory as D or R}
{D is not changed unless it shares memory with Self or R}
{Sets MuErr True if D = 0}
begin
DivQR( Self, D, R);
end; {MultiSI.RDivQR}
{--------------------------------------}
procedure MultiSI.PowMB( var B, P : MultiSI); {Self = (B ** P) Mod MuMB}
{B or P or both may have the same address in memory as Self}
{B, P are not changed unless they share memory with Self}
{Sets MuErr True if overflow or error}
var
BL, PL : ^MultiSI;
L : LongInt;
R : Mu1Digit;
Fini : Boolean;
begin
if B.ZTest then begin {B = 0}
if P.S then begin
MuWriteErr('Cannot raise zero to a negative power');
end
else if P.ZTest then begin {P = 0}
MuWriteErr('Cannot raise zero to the zero power');
end;
Clear; Exit;
end;
if (P.S) and ((B.N > 1) or (B.V^[0] > 1)) then begin { (>1) ** -P}
Clear; Exit;
end;
if (B.N = 1) and (B.V^[0] = 1) then begin {B = +/-1}
L:= Round( P.V^[0]);
S:= B.S and ((L Mod 2) = 1);
N:= 1; V^[0]:= 1; Exit;
end;
Fini:= False;
New( BL, Init( Self.M)); BL^.SetTo(B);
New( PL, Init( P.N)); PL^.SetTo(P);
SetTo1(1);
repeat
L:= Round( PL^.V^[0]);
if (L Mod 2) = 1 then begin
Self.Mul( BL^, Self);
Self.ModMB;
end;
IpDiv1(2, PL^, R);
if PL^.ZTest then Fini:= True
else begin
BL^.Mul( BL^, BL^);
BL^.ModMB;
end;
if MuAbort then begin
Clear;
Fini:= True;
end;
until Fini;
Dispose( PL, Done);
Dispose( BL, Done);
end; {MultiSI.PowMB}
{--------------------------------------}
procedure MultiSI.RPowMB( var P : MultiSI); {Self = (Self ** P) Mod MuMB}
{P may have the same address in memory as Self}
{P is not changed unless it shares memory with Self}
{Sets MuErr True if overflow or error}
begin
PowMB( Self, P);
end; {MultiSI.RPowMB}
{--------------------------------------}
procedure MultiSI.GCD( var A, B : MultiSI);{Self = Greatest common divisor A, B}
{A, B are not modified unless they share memory with Self}
{Will write to standard output if MuErrRep is True}
var
AL, BL : ^MultiSI;
I, NN : Integer;
Fini : Boolean;
begin
New( AL, Init( A.N)); AL^.SetTo(A);
New( BL, Init( B.N)); BL^.SetTo(B);
Fini:= False;
AL^.S:= False; BL^.S:= False;
if AL^.ZTest then begin Self.SetTo( BL^); Fini:= True; end;
if BL^.ZTest then begin Self.SetTo( AL^); Fini:= True; end;
NN:= 0;
{ if MuErrRep and Not Fini then for I:= 0 to Echo do WriteLn( OutP[I]^); }
while Not Fini do begin
Inc( NN);
if Odd( NN) then begin
AL^.Modu( AL^, BL^);
if MuErrRep then begin
for I:= 0 to Echo do begin
Write( OutP[I]^, NN, ' '); AL^.WritLn( OutP[I]^);
end;
end;
if AL^.ZTest then begin Self.SetTo( BL^); Fini:= True; end;
end
else begin
BL^.Modu( BL^, AL^);
if MuErrRep then begin
for I:= 0 to Echo do begin
Write( OutP[I]^, NN, ' '); BL^.WritLn( OutP[I]^);
end;
end;
if BL^.ZTest then begin Self.SetTo( AL^); Fini:= True; end;
end;
end;
Dispose( AL, Done);
Dispose( BL, Done);
end; {MultiSI.GCD}
{--------------------------------------}
procedure MultiSI.RGCD( var A: MultiSI); {Self=Greatest common divisor A, Self}
{A is not modified unless it shares memory with Self}
{Will write to standard output if MuErrRep is True}
begin
GCD(A, Self);
end; {MultiSI.RGCD}
{--------------------------------------}
procedure MultiSI.FacMB( var X: MultiSI); {Self = (X !) Mod MuMB = 1*2*3*...*X}
{X may have the same address in memory as Self}
{X is not changed unless it shares memory with Self}
{Sets MuErr True if overflow or error}
var
XL : ^MultiSI;
NN : Double;
begin
if X.S then begin
MuWriteErr('Cannot take factorial of number < zero');
Clear; Exit;
end;
if X.N > 2 then begin
MuWriteErr('Number too large for factorial function');
Clear; Exit;
end;
New( XL, Init( X.N)); XL^.SetTo(X);
Self.SetTo1(1);
XL^.GetD( NN);
while NN > 1 do begin
Self.Mul( XL^, Self);
Self.ModMB;
if MuAbort then begin
Dispose( XL, Done);
Clear; Exit;
end;
NN:= NN - 1;
XL^.SetToD( NN);
end;
Dispose( XL, Done);
end; {MultiSI.FacMB}
{--------------------------------------}
procedure MultiSI.RFacMB; {Self = (Self !) Mod MuMB = 1*2*3*...*X}
{Sets MuErr True if overflow or error}
begin
FacMB( Self);
end; {MultiSI.RFacMB}
{--------------------------------------}
procedure MultiSI.SqRtRem( var X, R : MultiSI); {Self = SqRt(X), R = Rem}
{X is not changed, X is moved to R and then R is "divided"}
{in place to give the SqRt in Self and a remainder in R, it is ok for X and R}
{or X and Self to have the same location in memory, but then X will be changed}
{Self and R may not have the same location in memory. Sets MuErr True if error}
var
D0, QH : Mu1Digit;
T, T2, D4, K : Mu2Digit;
I, J, RI0, DI0, RI, DI, IJ : Integer;
begin
if Self.V = R.V then begin
MuWriteErr(
'Cannot set same location to both square root and remainder, continuing...');
Exit;
end;
R.SetTo(X);
MultiSI.CLear;
if R.S then begin
MuWriteErr('Cannot take square root of negative number, continuing...');
R.Clear; Exit;
end;
if R.N < 4 then begin
for I:= R.N to 3 do R.V^[I]:= 0;
R.N:= 4;
end;
if Odd( R.N) then begin
R.V^[ R.N]:= 0;
R.N:= R.N + 1;
end;
Self.N:= R.N div 2 + 1;
T:= 0;
for I:= 1 to 4 do T:= T * Base + R.V^[ R.N - I];
T2:= Int( SqRt(T));
repeat
D0:= Int( T2 / Base);
QH:= 1 + T2 - D0 * Base; {+1 for safety}
T:= R.V^[ R.N - 1] * Base + R.V^[ R.N - 2] - D0 * D0;
if T < 0 then T2:= T2 - 1;
until T >= 0;
K:= Int(T / Base);
R.V^[ R.N - 2]:= T - K * Base;
R.V^[ R.N - 1]:= K;
if Self.N >= 4 then Self.V^[ Self.N - 4]:= 0;
Self.V^[ Self.N - 3]:= QH;
T:= 2 * D0;
K:= Int(T / Base);
Self.V^[ Self.N - 2]:= T - K * Base;
Self.V^[ Self.N - 1]:= K;
KeyHit:= False;
for J:= 2 to R.N div 2 do begin
K:= Base; RI0:= R.N - J - J; DI0:= Self.N - J - 1;
RI:= RI0; DI:= DI0; IJ:= RI0 + J;
while RI <= IJ do begin {Multiply and subtract}
T:= R.V^[ RI] - QH * Self.V^[ DI] + K + BSMB; {+ BaseSq - Base}
K:= Int(T / Base);
T:= T - K * Base;
R.V^[ RI]:= T;
Inc( RI); Inc( DI);
end;
T:= R.V^[ RI] + K + BSMB; {+ BaseSq - Base}
K:= Int(T / Base);
R.V^[ RI]:= T - K * Base;
while K = MaxDigit do begin {Test remainder}
{WriteLn('MuSqRt: Doing an add back'); .Diag for add back test}
QH:= QH - 1; {Add back}
K:= QH; RI:= RI0; DI:= DI0;
while RI <= IJ do begin
T:= R.V^[ RI] + Self.V^[ DI] + K;
K:= Int(T / Base);
R.V^[ RI]:= T - K * Base;
Inc( RI); Inc( DI);
end;
T:= R.V^[ RI] + K;
K:= Int(T / Base);
R.V^[ RI]:= T - K * Base;
K:= K + MaxDigit;
Self.V^[ DI0]:= QH;
end;
I:= DI0; IJ:= I + J; K:= QH;
while (I <= IJ) do begin
T:= Self.V^[I] + K; {Carry to next super digit}
K:= Int(T / Base);
Self.V^[I]:= T - K * Base;
if K = 0 then I:= IJ; {Break out of loop}
Inc(I);
end;
if J < R.N div 2 then begin
T:= 0;
for I:= 0 to 4 do begin
T:= T * Base + R.V^[ R.N - J - I];
end;
D4:= 0;
for I:= 1 to 4 do begin
D4:= D4 * Base + Self.V^[ Self.N - I];
end;
QH:= 1 + Int(T / D4);
Self.V^[ Self.N - J - 2]:= QH;
end;
MuInterrupt;
if MuAbort then begin
Self.Clear; R.Clear; Exit;
end;
if KeyHit then begin
for I:= 0 to Echo do
WriteLn( OutP[I]^, 'Integer Square Root: ',
Trunc( (100.0 * J) / (R.N / 2)), ' Percent done');
KeyHit:= False;
end;
end;
R.N:= R.N div 2 + 1;
R.Norm;
Self.Norm;
IpDiv1(2, Self, QH);
end; {MultiSI.SqRtRem}
{--------------------------------------}
procedure MultiSI.RSqRtRem( var R : MultiSI); {Self = SqRt( Self), R = Rem}
{Self is moved to R and then R is "divided" in place to give the SqRt in Self}
{and a remainder in R, Self and R may not have the same location in memory}
{Sets MuErr True if error}
begin
SqRtRem( Self, R);
end; {MultiSI.RSqRtRem}
{--------------------------------------}
procedure MultiSI.SqRoot( var X : MultiSI); {Self = SqRt(X)}
{X is not changed, it is ok for X and Self to have the same location in memory}
{but then X will be changed. Sets MuErr True if error}
var
RL : ^MultiSI;
begin
New( RL, Init( X.N));
SqRtRem(X, RL^);
Dispose( RL, Done);
end; {MultiSI.SqRoot}
{--------------------------------------}
procedure MultiSI.RSqRt; {Self = SqRt( Self)}
{Sets MuErr True if error}
begin
SqRoot( Self);
end; {MultiSI.RSqRt}
{------End of MultiSI's methods--------}
{--------------------------------------}
{ End of method implementation }
{--------------------------------------}
{--------------------------------------}
{ Other services }
{--------------------------------------}
{--------------------------------------}
procedure ShiftUp( var St : String); {Shift string to upper case}
var
I : Integer;
begin
for I:= 1 to Length( St) do St[I]:= UpCase( St[I]);
end; {ShiftUp}
{--------------------------------------}
procedure MuWriteErr( St : String); {Write error statement and set error flag}
{Allows St to be a literal string}
var
I : Integer;
begin
MuErr:= True;
if MuErrRep then
for I:= 0 to Echo do begin
WriteLn( OutP[I]^, St); WriteLn( OutP[I]^);
end;
end; {MuWriteErr}
{--------------------------------------}
procedure ReadLInt( Mess : String; Min, Max, Nom : LongInt;
var II : LongInt); {Read in a long integer from keyboard}
var
St : String[ 255];
Stat : Integer;
LI : LongInt;
I : Integer;
begin
repeat
repeat
for I:= 0 to Echo do begin
WriteLn( OutP[I]^, Mess);
Write( OutP[I]^, ' [', Min, ', ', Max, '] (ENTER => ', Nom, '): ');
end;
ReadLn( St);
for I:= 1 to Echo do WriteLn( OutP[I]^, St);
until IOResult = 0;
Val( St, LI, Stat);
until ((Stat = 0) and (LI >= Min) and (LI <= Max)) or (Length( St) = 0);
if Length( St) = 0 then LI:= Nom;
II:= LI;
for I:= 0 to Echo do begin
WriteLn( OutP[I]^, 'Input = ', II);
WriteLn( OutP[I]^);
end;
end; {ReadLInt}
{--------------------------------------}
procedure ReadInt( Mess : String; Min, Max, Nom : Integer;
var II : Integer); {Read in an integer from keyboard}
var
St : String[ 255];
Stat : Integer;
LI : LongInt;
I : Integer;
begin
repeat
repeat
for I:= 0 to Echo do begin
WriteLn( OutP[I]^, Mess);
Write( OutP[I]^, ' [', Min, ', ', Max, '] (ENTER => ', Nom, '): ');
end;
ReadLn( St);
for I:= 1 to Echo do WriteLn( OutP[I]^, St);
until IOResult = 0;
Val( St, LI, Stat);
until ((Stat = 0) and (LI >= Min) and (LI <= Max)) or (Length( St) = 0);
if Length( St) = 0 then LI:= Nom;
II:= LI;
for I:= 0 to Echo do begin
WriteLn( OutP[I]^, 'Input = ', II);
WriteLn( OutP[I]^);
end;
end; {ReadInt}
{--------------------------------------}
procedure MuSetMMax( NRegs : Integer); {Set MMax}
var
Max : LongInt;
Percent : Integer;
I : Integer;
begin
Max:= MemAvail;
for I:= 0 to Echo do
WriteLn( OutP[I]^, 'MemAvail = ', Max);
ReadInt('Input % of available memory to use:', 0, 100, 100, Percent);
Max:= ((Max - 256) * Percent) div (100 * NRegs); {Max per register}
MMax:= (Max - SizeOf( MultiSI)) div SizeOf( Mu1Digit) - 1;
if MMax > MuNMax then MMax:= MuNMax;
if MMax < 5 then MMax:= 5;
end; {MuSetMMax}
{--------------------------------------}
procedure MuInterrupt; {Test for ESC key pressed to abort operation}
{MuAbort set TRUE if ESC pressed twice, unchanged if no ESC or ESC, SPACE}
const
Esc = Chr( 27); {ESCAPE}
Ret = Chr( 13); {RETURN}
var
I : Integer;
Ch : Char;
begin
If not Keypressed then Exit;
while Keypressed do begin
Ch:= ReadKey;
end;
KeyHit:= True; KeyCh:= Ch;
if Trace > 0 then begin
for I:= 0 to Echo do
WriteLn( OutP[I]^, '<', Tracn, ' ', Trace, '>');
Trace:= 0;
end;
if (Ch <> Esc) or MuAbort then Exit;
for I:= 0 to Echo do begin
WriteLn( OutP[I]^, '*** INTERRUPT: To Continue Press RETURN Key;');
WriteLn( OutP[I]^, 'To Abort Computation Press ESCAPE Key.');
WriteLn( OutP[I]^);
KeyHit:= False;
end;
repeat
Ch:= ReadKey;
until (Ch = Esc) or (Ch = Ret);
if Ch = Ret then for I:= 0 to Echo do begin
WriteLn( OutP[I]^, 'Continuing...'); WriteLn( OutP[I]^);
end;
if Ch = Esc then begin
MuAbort:= True;
for I:= 0 to Echo do begin
WriteLn( OutP[I]^, 'Computation aborted by operator!');
WriteLn( OutP[I]^);
end;
end;
end; {MuInterrupt}
{---------------------------------------}
function DosClock : Double; {Get the value of the Dos clock in total seconds}
{Only good to 0.01 seconds, must call earlier once each day}
var
DC : Double; {Local value of DosClock}
Regs : Registers; {Registers for Dos calls defined in Turbo Pascal}
{ Regs : record
case Integer of
1 : (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Word);
2 : (AL, AH, BL, BH, CL, CH, DL, DH : Byte);
end;
}
begin
Regs.AH:= $2C;
MsDos( Regs);
with Regs do
DC:= DosDays * 86400.0 + CH * 3600.0 + CL * 60.0 + DH + DL / 100.0;
if DC < DosClockP then begin
Inc( DosDays);
DC:= DC + 86400.0;
end;
DosClockP:= DC;
DosClock := DC;
end; {DosClock}
{--------------------------------------}
procedure Diag( Mess : String); {Output a diagnostic message with delta times}
var
EI : Integer;
Del0 : Double; {Total time from TV0}
Del1 : Double; {Delta time from last Diag call}
begin
if DiagOn then begin
TV1:= TV2; TV2:= DosClock;
Del0:= TV2 - TV0;
Del1:= TV2 - TV1;
for EI:= 0 to Echo do
WriteLn( OutP[ EI]^, 'T = ', Del0:0:2,
' DT = ', Del1:0:2, ' sec. ',Mess);
end;
end; {Diag}
{--------End of other services---------}
{--------------------------------------}
{ Initialization section }
{--------------------------------------}
{Initialize Multi-precision package}
{Input: MuDMax, MuNMax}
{Output: Base, BaseSq, MaxDigit, BSMB, OutP}
{Initialize: MuDpG=5, MuLenD=21, MuErr=False, MuErrRep=True, MuAbort=False,}
{Echo=0, MMax=MuNMax, TracN=0, Trace=0, DiagOn=False, TV0=TV1=TV2=DosClock}
var I : Integer;
begin
Base:= 10;
for I:= 2 to MuDMax do Base:= 10 * Base;
MaxDigit := Base - 1;
BaseSq := Base * Base;
BSMB := BaseSq - Base;
MuDpG := 5;
MuLenD := 21;
MuErr := False;
MuErrRep := True;
MuAbort := False;
KeyHit := False;
KeyCh := ' ';
Echo := 0;
OutP[0] := @Output; OutP[1]:= @Lst;
MMax := MuNMax;
TracN := 0;
Trace := 0;
DiagOn := False;
DosClockP:= 86400.0;
DosDays := 0;
TV0 := DosClock;
TV1 := TV0;
TV2 := TV1;
MuMaxW := 65;
MuTot := 0;
end. {MultiIDO unit init}
Revisions made -
--------
Changed line in procedure MultiSI.Value from:
While St[J] = ' ' do J:= J + J;
to:
While St[J] = ' ' do Inc(J); { HJS 91/04/24, 91/09/24 }
--------
Added procedures SetToEx and GetEx { HJS 91/05/02 and 91/05/04 }
--------
Added test of KeyHit in SqRtRem { HJS 91/08/17 }
--------
Added MuMaxW and MuTot to global vars and MultiSI.Writ { HJS 92/02/07 }
--------
{End of file MultiID.Pas ***************************************************}
times since October 20, 2004.