{Start of file MultiID.Pas *************************************************}
unit MultiID; {Multiple-precision integer decimal algorithms}
{ Version = 'Version 2.00, last revised: 92/02/09, 1000 hours';
Author = 'Copyright (c) 1981-1992 by author: Harry J. Smith,';
Address = '19628 Via Monte Dr., Saratoga, CA 95070. All rights reserved.';
}
{***************************************************************************}
{$I-} {Do our own i/o error checks}
{$N+} {Uses numeric coprocessor}
{$R-} {No index Range checking}
{$V-} {Parameter string length need not match}
{Developed in TURBO Pascal 5.5, maintained in TURBO Pascal 6.0}
{ Revisions made - Listed after end. statement }
{In Turbo Pascal 4.0 etc. the max odd integer to store in a Single is}
{2**24-1 = 167,77215; for a Double is 2**53-1 = 9,00719,92547,40991}
interface
uses Dos, Crt, Printer; {Turbo Pascal interface}
const
MuDMax = 7; {Max number of decimal digits in a super digit}
MuNMax = 16379; {Max number of super digits in a multi-precision number}
{Each super digit is from 0 to 9999999, i.e. Base = 10**7}
type
Mu1Digit = Single; {Can hold + or - integer <= Base}
Mu2Digit = Double; {Can hold + or - integer <= Base squared + Base}
VType = Array[0..MuNMax] of Mu1Digit; {Value, LSD at index 0}
VPtr = ^VType;
MultiIDO = object {Multiple-precision integer decimal algorithms}
constructor Init( MuMbM : Integer);
destructor Done;
end;
MultiUI = object {A multiple-precision unsigned integer}
N : Integer; {Current length in super digits, 1..MuNMax}
M : Integer; {Max number of super digits ever in this number}
V : VPtr;
constructor Init( NMaxI : Integer);
destructor Done; virtual;
procedure Clear; virtual; {Set value = 0}
procedure SetTo( var X : MultiUI); {Self:= X}
procedure Norm; {Normalize}
procedure RAdd( var X : MultiUI); {Self:= Self + X}
procedure RSub( var X : MultiUI); {Self:= Self - X}
procedure Add( var X, Y : MultiUI); {Self:= X + Y}
procedure Sub( var X, Y : MultiUI); {Self:= X - Y}
function AbComp( var X : MultiUI): Integer; {AbComp = sign(|Self| - |X|)}
function ZTest : Boolean; {True if Self is Zero}
function EQ1( D1 : Mu1Digit) : Boolean; {True if |Self| = D1}
function GT1( D1 : Mu1Digit) : Boolean; {True if |Self| > D1}
end;
MultiSI = object( MultiUI) {A multiple-precision signed integer}
S : Boolean; {Sign, True = negative}
constructor Init( NMaxI : Integer);
destructor Done; virtual;
procedure Clear; virtual; {Set value = 0}
procedure ChS; {Change sign, Self = 0 - Self}
procedure SetTo( var X : MultiSI); {Self:= X}
procedure Norm; {Normalize}
procedure RAdd( var X : MultiSI); {Self:= Self + X}
procedure RSub( var X : MultiSI); {Self:= Self - X}
procedure Add( var X, Y : MultiSI); {Self:= X + Y}
procedure Sub( var X, Y : MultiSI); {Self:= X - Y}
procedure Value( St : String; var I : Integer);
{Convert String to Self, returns I = # of character used}
procedure SetTo1( D1 : Mu1Digit); {Self = D1 Mod Base}
procedure SetToEx( Ex : Extended); {Self = Ex Mod Base**4}
procedure SetToD( Db : Double); {Self = Db Mod Base**4}
procedure Get1( var D1 : Mu1Digit); {D1 = Self Mod Base}
procedure GetEx( var Ex : Extended); {Ex = Self Mod Base**4}
procedure GetD( var Db : Double); {Db = Self Mod Base**4}
procedure RAdd1( D1 : Mu1Digit); {Self = Self + D1}
procedure Add1( var X : MultiSI; D1 : Mu1Digit); {Self = X + D1}
function Comp( var X : MultiSI) : Integer; {Comp = sign( Self - X)}
procedure Writ( var Out : TEXT); {Output Self as a line of text}
procedure WritLn( var Out : TEXT); {Output Self and a new line}
procedure ShortWr( var Out : TEXT; Short : LongInt);
{Output Self in short form ... if more than Short digits}
procedure ShortWrLn( var Out : TEXT; Short : LongInt);
{Output Self short and a new line}
procedure RMul1( D1 : Mu1Digit); {Self = Self * D1}
procedure Mul1( var X : MultiSI; D1 : Mu1Digit); {Self = X * D1}
procedure Mul( var X, Y : MultiSI); {Self = X * Y}
procedure RMul( var X : MultiSI); {Self = Self * X}
procedure Sq( var X : MultiSI); {Self = X * X}
procedure RSq; {Self = Self * Self}
procedure PowMB( var B, P : MultiSI); {Self = (B ** P) Mod MuMB}
procedure RPowMB( var P : MultiSI); {Self = (Self ** P) Mod MuMB}
procedure ModMB; {Self = Self Mod MuMB}
procedure RDiv1( D1 : Mu1Digit); {Self = Self / D1}
procedure Div1( var U : MultiSI; D1 : Mu1Digit); {Self = U / D1}
procedure Mod1( D1: Mu1Digit; var R1: Mu1Digit); {R1 = Rem( Self / D1)}
procedure RDiv1QR( D1: Mu1Digit; var R1: Mu1Digit);
{Self = Self / D1, R1 = Rem}
procedure Div1QR( var U: MultiSI; D1: Mu1Digit; var R1: Mu1Digit);
{Self = U / D1, R1 = Rem}
procedure Divi( var U, D : MultiSI); {Self = U / D}
procedure RDiv( var D : MultiSI); {Self = Self / D}
procedure Modu( var U, D : MultiSI); {Self = Rem(U / D)}
procedure RMod( var D : MultiSI); {Self = Rem( Self / D)}
procedure DivQR( var U, D, R : MultiSI); {Self = U / D, R = Rem}
procedure RDivQR( var D, R : MultiSI); {Self = Self / D, R = Rem}
procedure GCD( var A, B : MultiSI);{Self = Greatest common divisor A, B}
procedure RGCD( var A : MultiSI); {Self=Greatest common divisor A, Self}
procedure FacMB( var X : MultiSI); {Self = (X !) Mod MuMB = 1*2*3*...*X}
procedure RFacMB; {Self = (Self !) Mod MuMB = 1*2*3*...*X}
procedure SqRtRem( var X, R : MultiSI); {Self = SqRt(X), R = Rem}
procedure RSqRtRem( var R : MultiSI); {Self = SqRt( Self), R = Rem}
procedure SqRoot( var X : MultiSI); {Self = SqRt(X)}
procedure RSqRt; {Self = SqRt( Self)}
end;
var
MultiIDV : MultiIDO; {Multiple-precision integer decimal algorithms}
{The following are set when the unit MultiID is loaded}
Base : Mu2Digit; {Radix of multi-precision numbers, 10**MuDMax}
MaxDigit : Mu1Digit; {Base - 1}
BaseSq : Mu2Digit; {Base squared}
BSMB : Mu2Digit; {(BaseSq - Base) for MuDiv and MuSqRt}
OutP : Array[0..1] of ^Text; {Pointers to Output and Lst}
{The following can be tested by user}
MuErr : Boolean; {True if multi-precision error occurred}
MuAbort : Boolean; {True if Mu procedure interrupted by operator}
KeyHit : Boolean; {True if KeyPressed has been cleared}
KeyCh : Char; {Key input when KeyPressed was cleared}
{The following can be changed by user}
Echo : Integer; {1 if in Echo output to printer mode, 0 otherwise}
MuDpG : Integer; {Digits per group in number output display >= 2}
MuLenD : Integer; {Min length in digits to display length in digits}
MuErrRep : Boolean; {True if multi-precision error reports are desired}
MMax : Integer; {Max number of super digits <= MuNMax}
TracN : LongInt; {Number if iterations of an innermost loop}
Trace : LongInt; {Number of "Digits" left to compute}
DiagOn : Boolean; {Diagnostics turned on}
TV0 : Double; {Dos time value at time zero for diag}
TV1 : Double; {Dos time value for delta time, TV2 - TV1}
TV2 : Double; {Dos time value for total time, TV2 - TV0}
DosClockP: Double; {Previous value of the Dos clock for day cycle test}
DosDays : Integer; {Number of days to add to Dos clock}
MuMaxW : Integer; {Max number of characters to write on a line}
MuTot : Integer; {Total number of characters on the line so far}
{The following are set when the object MultiIDV is initialized}
MuMB : ^MultiSI; {Multi-precision modulo base, 0 => normal aritm.}
procedure ShiftUp( var St : String); {Shift string to upper case}
procedure MuWriteErr( St : String); {Write error statement and set error flag}
procedure ReadLInt( Mess : String; Min, Max, Nom : LongInt;
var II : LongInt); {Read in a long integer from keyboard}
procedure ReadInt( Mess : String; Min, Max, Nom : Integer;
var II : Integer); {Read in an integer from keyboard}
procedure MuSetMMax( NRegs : Integer); {Set MMax using MemAvail}
procedure MuInterrupt; {Test for ESC key pressed to abort operation}
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}
procedure Diag( Mess : String); {Output a diagnostic message with delta times}
procedure WriteMax( var Out : TEXT; St : String);
{Output String and line feed every MuMaxW, MuTot = characters on line so far}
procedure WriteMaxLn( var Out : TEXT; St : String);
implementation
{--------------------------------------}
{ Common hidden routines }
{--------------------------------------}
{--------------------------------------}
procedure IpAdd( var X, Y : MultiUI; var K : Mu1Digit); {|Y| = |Y| + |X|}
{Multi-precision integer add absolute values in place; Y is changed}
{Y.N Must be >= X.N, X.S and Y.S not used or changed; X not changed}
{Overflow super digit returned not zero if and only if Y overflows}
{MuErr flag not set. Address of X and Y can be the same, then X is changed}
var
I : Integer;
T : Mu2Digit;
begin
I:= 0; K:= 0;
while I < X.N do begin
T:= X.V^[I] + Y.V^[I] + K; {Add next super digit with carry}
if T >= Base then begin
K:= 1; Y.V^[I]:= T - Base;
end
else begin
K:= 0; Y.V^[I]:= T;
end;
Inc(I);
end;
if K = 0 then Exit;
while (I < Y.N) do begin {X = 0 from here on}
if Y.V^[I] = MaxDigit then begin {K = 1, carry to next super digit of Y}
Y.V^[I]:= 0;
end
else begin
Y.V^[I]:= Y.V^[I] + 1; K:= 0; Exit; {Return K = 0}
end;
Inc(I);
end;
Y.N:= Y.N + 1;
if Y.N > Y.M then begin {If overflow return K = 1}
Y.N:= Y.M;
Y.Norm;
end
else begin
Y.V^[ Y.N-1]:= 1; K:= 0; {Return K = 0}
end;
end; {IpAdd}
{--------------------------------------}
procedure IpSub( var X, Y : MultiUI); {|Y| = |Y| - |X|}
{Multi-precision integer subtract absolute values in place; Y is changed}
{|Y| Must be >= |X|, X.S and Y.S not used or changed; X not changed}
{MuErr flag not set. Address of X and Y can be the same, then X is changed}
var
I : Integer;
K : Mu1Digit;
T : Mu2Digit;
begin
I:= 0; K:= 0;
while (I < X.N) do begin
T:= Y.V^[I] - X.V^[I] + K; {Subtract next super digit with borrow}
if T < 0 then begin
K:= -1; Y.V^[I]:= T + Base;
end
else begin
K:= 0; Y.V^[I]:= T;
end;
Inc(I);
end;
if (K = 0) or (X.N = Y.N) then begin Y.Norm; Exit; end;
while (I < Y.N) do begin {X = 0 from here on}
if Y.V^[I] = 0 then begin {K = -1, borrow from next super digit of Y}
Y.V^[I]:= MaxDigit;
end
else begin
Y.V^[I]:= Y.V^[I] - 1; Y.Norm; Exit;
end;
Inc(I);
end;
end; {IpSub}
{--------------------------------------}
procedure IpMul1(D : Mu1Digit; var X : MultiUI; var K : Mu1Digit);{X = |D| * X}
{Multi-precision one super digit multiply in place; X is changed}
{K = Overflow super digit returned > zero if and only if X overflows}
{Signs not used}
var
I : Integer;
T : Mu2Digit;
begin
D:= Abs(D);
K:= 0;
for I:= 0 to X.N - 1 do begin
T:= D * X.V^[I] + K; {Multiply next super digit and add carry}
K:= Int(T / Base);
X.V^[I]:= T - K * Base;
end;
if K = 0 then Exit;
X.N:= X.N + 1;
if X.N > X.M then begin {If overflow return K > 0}
X.N:= X.M;
end
else begin
X.V^[ X.N-1]:= K; K:= 0;
end;
end; {IpMul1}
{--------------------------------------}
procedure IpDiv1(D : Mu1Digit; var U : MultiSI; var R : Mu1Digit); {U = U / D}
{Multi-precision one super digit divide in place, U is changed} {R = Remainder}
{Allows literal D, MuErr set True if D = 0}
var
T : Mu2Digit;
I : Integer;
AD : Mu1Digit;
begin
R:= 0;
if D = 0 then begin
MuWriteErr('Cannot divide by zero, continuing...');
Exit;
end;
MuInterrupt;
if MuAbort then begin
U.Clear; Exit;
end;
AD:= Abs(D);
I:= U.N - 1;
while I >= 0 do begin
T:= R * Base + U.V^[I]; {Divide next super digit and save remainder}
U.V^[I]:= Int(T / AD);
R:= T - U.V^[I] * AD;
Dec(I);
end;
if U.S and (R <> 0) then R:= -R;
U.S:= U.S xor (D < 0);
U.Norm;
end; {IpDiv1}
{--------------------------------------}
procedure IpDiv( var D, U, Q, R : MultiSI); {Q = U / D, R = Rem}
{U and D are not changed, U is moved to R and then R is divided}
{in place to give Q and a remainder in R, it is OK for U and R}
{to have the same location in memory, but then U will be changed}
{Sets MuErr True if D = 0}
{See Knuth Vol. 2 of "The Art..." Algorithm D, pg. 237.}
var
V1, V2, D1, K, QH : Mu1Digit;
T : Mu2Digit;
I, J, IJ : Integer;
begin
if D.N = 1 then begin {Use IpDiv1 for a one super digit divide}
Q.SetTo(U); D1:= D.V^[0];
if D.S and (D1 <> 0) then D1:= -D1;
IpDiv1( D1, Q, K);
R.S:= (K < 0);
R.V^[0]:= Abs(K);
R.N:= 1;
end
else begin
R.SetTo(U); {SetTo is No-Op if same address}
if R.N < D.N then begin
Q.Clear; Exit;
end;
Q.N:= R.N - D.N + 1;
J:= R.N;
R.V^[ R.N]:= 0;
D.V^[ D.N]:= 0;
V1:= D.V^[ D.N-1];
V2:= D.V^[ D.N-2];
D1:= Int( Base / (V1 + 1)); {D1. Normalize}
if D1 > 1 then begin
IpMul1( D1, D, K); V1:= D.V^[ D.N-1]; V2:= D.V^[ D.N-2];
IpMul1( D1, R, K);
if K <> 0 then R.V^[J]:= K;
end; {D2. Init J done above}
KeyHit:= False;
while J >= D.N do begin {D3. Calculate Q hat}
T:= R.V^[J] * Base + R.V^[ J-1];
if V1 = R.V^[J]
then QH:= MaxDigit
else QH:= Int(T / V1);
while (V2 * QH > (T - QH * V1) * Base + R.V^[ J-2]) do QH:= QH - 1;
{QH:=QH+1; .Diag for add back test}
K:= Base;
for I:= 0 to D.N do begin {D4. Multiply and subtract}
IJ:= I + J - D.N;
T:= R.V^[ IJ] - QH * D.V^[I] + K + BSMB; {+ BaseSq - Base}
K:= Int(T / Base);
R.V^[ IJ]:= T - K * Base;
end;
Q.V^[J - D.N]:= QH; {D5. Test remainder}
if K = MaxDigit then begin
{WriteLn('MuDiv: Doing an add back'); .Diag for add back test}
Q.V^[J - D.N]:= QH - 1; {D6. Add back}
K:= 0; IJ:= J - D.N;
for I:= 0 to D.N do begin
T:= D.V^[I] + R.V^[ IJ] + K;
K:= Int(T / Base);
R.V^[ IJ]:= T - K * Base;
Inc( IJ);
end;
end;
Dec(J); {D7. Loop on J}
MuInterrupt;
if MuAbort then begin
Q.Clear; R.Clear; Exit;
end;
if KeyHit then begin
for I:= 0 to Echo do
WriteLn( OutP[I]^, 'Integer Divide: ',
Trunc( (100.0 * (R.N - J)) / (R.N - D.N + 1)), ' Percent done');
KeyHit:= False;
end;
end;
Q.S:= U.S xor D.S;
R.S:= U.S;
Q.Norm;
R.Norm;
if D1 > 1 then begin {D8. Unnormalize}
IpDiv1( D1, R, K);
IpDiv1( D1, D, K);
end;
end;
end; {IpDiv}
{---End of common hidden routines------}
{--------------------------------------}
{ MultiIDO's method implementation }
{--------------------------------------}
{--------------------------------------}
constructor MultiIDO.Init( MuMbM: Integer);{Initialize Multi-precision package}
{Input: MuMbM, M for MuMb}
{Initialize: MuMB = 0}
begin
if MuMbM > MuNMax then MuMbM:= MuNMax;
New( MuMB, Init( MuMbM));
end; {MultiIDO.Init}
{--------------------------------------}
destructor MultiIDO.Done; {Destruct Multi-precision package}
begin
Dispose( MuMB, Done);
end; {MultiIDO.Done}
{------End of MultiIDO's methods-------}
{--------------------------------------}
{ MultiUI's method implementation }
{--------------------------------------}
constructor MultiUI.Init( NMaxI : Integer);
var
Size : Word;
I : Integer;
begin
M:= NMaxI;
if M > MuNMax then M:= MuNMax;
Size:= SizeOf( Mu1Digit);
Size:= (M+1) * Size;
if Size > MaxAvail then begin
if MemAvail = MaxAvail then
for I:= 0 to Echo do Write( OutP[I]^, 'MemAvail = MaxAvail = ')
else
for I:= 0 to Echo do
Write( OutP[I]^, 'MemAvail = ', MemAvail, ', MaxAvail = ');
for I:= 0 to Echo do
WriteLn( OutP[I]^, MaxAvail, ', need ', Size);
M:= 1; Size:= SizeOf( Mu1Digit); Size:= (M+1) * Size; MuAbort:= True;
end;
GetMem(V, Size);
Clear;
end; {MultiUI.Init}
{--------------------------------------}
destructor MultiUI.Done;
var
Size : Word;
begin
Size:= SizeOf( Mu1Digit);
Size:= (M+1) * Size;
FreeMem(V, Size);
M:= -1;
end; {MultiUI.Done}
{--------------------------------------}
procedure MultiUI.Clear; {Set value = 0}
begin
V^[0]:= 0; N:= 1;
end; {MultiUI.Clear}
{--------------------------------------}
procedure MultiUI.SetTo( var X : MultiUI); {Self = X, copy used "digits" only}
var
I : Integer;
begin
if Self.V = X.V then Exit;
N:= X.N;
if N > M then begin
N:= M;
MuWriteErr('SetTo overflow, continuing...');
end;
for I:= 0 to N - 1 do V^[I]:= X.V^[I];
end; {MultiUI.SetTo}
{--------------------------------------}
procedure MultiUI.Norm; {Normalize}
var
I : Integer;
begin
if N < 1 then Clear;
I:= N - 1; {Delete leading zeros}
while (V^[I] = 0) and (I > 0) do begin
Dec(I);
end;
N:= I + 1;
end; {MultiUI.Norm}
{--------------------------------------}
function MultiUI.AbComp( var X: MultiUI): Integer; {AbComp= sign(|Self| - |X|)}
{Si = -1 if |Self| < |X|; Si = 0 if |Self| = |X|; Si = +1 if |Self| > |X|}
{Self.S and X.S not used or changed; Self, X not changed}
var
I : Integer;
begin
if N < X.N then begin AbComp:= -1; Exit; end;
if N > X.N then begin AbComp:= +1; Exit; end;
I:= N - 1;
while (V^[I] = X.V^[I]) and (I > 0) do begin
Dec(I);
end;
if V^[I] < X.V^[I] then begin AbComp:= -1; Exit; end;
if V^[I] > X.V^[I] then begin AbComp:= +1; Exit; end;
AbComp:= 0;
end; {MultiUI.AbComp}
{--------------------------------------}
procedure MultiUI.RAdd( var X : MultiUI); {Self:= Self + X}
{Sets MuErr True if overflow}
var
K : Mu1Digit;
I : Integer;
begin
if N < X.N then begin {If Digits in Self < Digits in X}
if M >= X.N then begin
for I:= N to X.N-1 do V^[I]:= 0;
N:= X.N;
end
else begin
MuWriteErr('X too big to add, continuing...');
end;
end;
IpAdd(X, Self, K);
if (K > 0) then MuWriteErr('Addition overflow, continuing...');
end; {MultiUI.RAdd}
{--------------------------------------}
procedure MultiUI.RSub( var X : MultiUI); {Self:= Self - X}
{Sets MuErr True if N > Self}
var
I : Integer;
begin
I:= AbComp(X);
if I = 0 then Clear
else if I < 0 then {If Self < X, Error}
MuWriteErr('Unsigned subtraction error, continuing...')
else
IpSub(X, Self);
end; {MultiUI.RSub}
{--------------------------------------}
procedure MultiUI.Add( var X, Y : MultiUI); {Self:= X + Y}
{Sets MuErr True if overflow}
begin
if Self.V = X.V then
RAdd(Y)
else if Self.V = Y.V then
RAdd(X)
else if X.N >= Y.N then begin
SetTo(X); RAdd(Y);
end
else begin
SetTo(Y); RAdd(X);
end;
end; {MultiUI.Add}
{--------------------------------------}
procedure MultiUI.Sub( var X, Y : MultiUI); {Self:= X - Y}
{Sets MuErr True if overflow}
var
YL : ^MultiUI;
begin
if @X = @Y then Clear
else if Self.V = X.V then
RSub(Y)
else if Self.V = Y.V then begin
New( YL, Init( Y.N)); YL^.SetTo(Y);
SetTo(X);
RSub( YL^);
Dispose( YL, Done);
end
else begin
SetTo(X);
RSub(Y);
end;
end; {MultiUI.Sub}
{--------------------------------------}
function MultiUI.ZTest : Boolean; {True if Self is Zero}
begin
ZTest:= (N = 1) and (V^[0] = 0);
end; {MuLTI.ZTest}
{--------------------------------------}
function MultiUI.EQ1( D1 : Mu1Digit) : Boolean; {True if |Self| = D1}
{Self, D1 are not changed, allows literal D1}
begin
EQ1:= (N = 1) and (V^[0] = D1);
end; {MultiUI.EQ1}
{--------------------------------------}
function MultiUI.GT1( D1 : Mu1Digit) : Boolean; {True if |Self| > D1}
{Self, D1 are not changed, allows literal D1}
begin
GT1:= (N > 1) or (V^[0] > D1);
end; {MultiUI.GT1}
{------End of MultiUI's methods--------}
{--------------------------------------}
{ MultiSI's method implementation }
{--------------------------------------}
{--------------------------------------}
constructor MultiSI.Init( NMaxI : Integer);
begin
MultiUI.Init( NMaxI);
S:= False;
end; {MultiSI.Init}
{--------------------------------------}
destructor MultiSI.Done;
begin
MultiUI.Done;
end; {MultiSI.Done}
{--------------------------------------}
procedure MultiSI.Clear; {Set value = 0}
begin
MultiUI.Clear;
S:= False;
end; {MultiSI.Clear}
{--------------------------------------}
procedure MultiSI.ChS; {Change sign, Self = - Self}
begin
if not ZTest then S:= not S;
end; {MultiSI.ChS}
{--------------------------------------}
procedure MultiSI.SetTo( var X : MultiSI); {Self:= X}
begin
MultiUI.SetTo(X);
S:= X.S;
end; {MultiSI.SetTo}
{--------------------------------------}
procedure MultiSI.Norm; {Normalize}
begin
MultiUI.Norm;
if ZTest then S:= False; {Prevent -0}
end; {MultiSI.Norm}
{--------------------------------------}
procedure MultiSI.RAdd( var X : MultiSI); {Self:= Self + X}
{Sets MuErr True if overflow}
var
Temp : ^MultiUI;
K : Mu1Digit;
I : Integer;
begin
if S = X.S then {Same signs}
MultiUI.RAdd(X)
else begin {Opposite signs}
I:= AbComp(X);
if I < 0 then begin {If |Self| < |X|, |Self| = |X| - |Self|}
New( Temp, Init(N));
Temp^.SetTo( Self); {Temp:= Small Self}
Self.SetTo(X); {Self:= Large X}
IpSub( Temp^, Self);
Dispose( Temp, Done);
end
else if I > 0 then {If |Self| > |X|, |Self| = |Self| - |X|}
IpSub(X, Self)
else
Clear; {If |Self| = |X|, Self = 0}
end;
end; {MultiSI.RAdd}
{--------------------------------------}
procedure MultiSI.RSub( var X : MultiSI); {Self:= Self - X}
{Sets MuErr True if overflow}
begin
if Self.V = X.V then
Clear
else begin
X.S:= not X.S;
RAdd(X);
X.S:= not X.S;
end;
end; {MultiSI.RSub}
{--------------------------------------}
procedure MultiSI.Add( var X, Y : MultiSI); {Self:= X + Y}
{Sets MuErr True if overflow}
var
I : Integer;
begin
if Self.V = X.V then
RAdd(Y)
else if Self.V = Y.V then
RAdd(X)
else if X.S = Y.S then begin
MultiUI.Add(X, Y); S:= X.S;
end
else begin
I:= X.AbComp(Y); {Signs are different}
if I = 0 then Clear
else if I > 0 then begin
SetTo(X); IpSub(Y, Self); {|X| > |Y|, so |X| - |Y|}
end
else begin
SetTo(Y); IpSub(X, Self);
end;
end;
end; {MultiSI.Add}
{--------------------------------------}
procedure MultiSI.Sub( var X, Y : MultiSI); {Self:= X - Y}
{Sets MuErr True if overflow}
begin
if @X = @Y then Clear
else if Self.V = X.V then
RSub(Y)
else if Self.V = Y.V then begin
RSub(X); ChS;
end
else begin
Y.S:= not Y.S;
Add(X, Y);
Y.S:= not Y.S;
end;
end; {MultiSI.Sub}
{--------------------------------------}
procedure MultiSI.Value( St : String; var I : Integer);
{Convert String to Self, returns I = # of character used}
{Allows St to be a literal, MuErr set True if overflow}
var
K : Mu1Digit;
Len : Integer;
J, D : Integer;
Fini : Boolean;
Overflow : Boolean;
begin
I:= 1;
While St[I] = ' ' do Inc(I);
if (St[I] = '-') or (St[I] = '+') then Inc(I);
while (I <= Length( St)) and
(((St[I] >= '0') and (St[I] <= '9')) or (St[I] = ',')) do
Inc(I);
Dec(I);
Clear; Fini:= False; Overflow:= False;
Len:= I;
if Len = 0 then Exit;
J:= 1;
While St[J] = ' ' do Inc(J); { HJS 91/04/24, 91/09/24 }
if St[J] = '-' then begin Inc(J); S:= True; end
else if St[J] = '+' then Inc(J);
while Not Fini and (J <= Len) do begin
if (St[J] >= '0') and (St[J] <= '9') then begin
if (N = M) and (V^[ N-1] >= Base / 10) then begin
Overflow:= True;
Fini:= True;
end
else begin
D:= Ord( St[J]) - Ord('0');
IpMul1( 10, Self, K);
if K > 0 then Overflow:= True;
V^[0]:= V^[0] + D;
end;
end
else
if St[J] <> ',' then Fini:= True;
Inc(J);
end;
if Overflow then MuWriteErr('Input number overflow, continuing...');
Norm;
end; {MultiSI.Value}
{--------------------------------------}
procedure MultiSI.SetTo1( D1 : Mu1Digit); {Self = D1 Mod Base}
{Allows a literal D1, D1 an integer, |D1| < Base, D1 not changed}
var
AbsD : Mu1Digit;
begin
AbsD:= Abs( D1);
N:= 1; S:= (D1 < 0);
if AbsD < Base then V^[0]:= AbsD
else
V^[0]:= AbsD - Int( AbsD / Base) * Base;
end; {MultiSI.SetTo1}
{--------------------------------------}
procedure MultiSI.SetToEx( Ex : Extended); {Self = Ex Mod Base**4}
{Allows a literal Ex, Ex not changed, MuErr set True if overflow}
{ Added procedure SetToEx HJS 91/05/02 }
var
St1, St2 : String[ 255];
AE, E1, E2 : Extended;
L, ML : Integer;
begin
AE:= Abs( Ex); E1:= Int( AE / Base); E2:= AE - E1 * Base + Base;
Str( E1:0:0, St1); Str( E2:0:0, St2);
Delete( St2, 1, 1);
St1:= St1 + St2;
L:= Length( St1); ML:= 4 * MuDMax;
if L > ML then St1:= Copy( St1, L - ML + 1, ML);
Value( St1, L);
if Ex < 0.0 then ChS; {Prevents -0}
end; {MultiSI.SetToEx}
{--------------------------------------}
procedure MultiSI.SetToD( Db : Double); {Self = Db Mod Base**4}
{Allows a literal Db, Db not changed, MuErr set True if overflow}
begin
SetToEx( Db);
end; {MultiSI.SetToD}
{--------------------------------------}
procedure MultiSI.Get1( var D1 : Mu1Digit); {D1 = Self Mod Base}
{Self is not changed}
begin
D1:= V^[0];
if S and (D1 <> 0) then D1:= -D1;
end; {MultiSI.Get1}
{--------------------------------------}
procedure MultiSI.GetEx( var Ex : Extended); {Ex = Self Mod Base**4}
{Self is not changed} { Added procedure GetEx HJS 91/05/02 }
var
I : Integer;
T : Extended;
begin
I:= 1; Ex:= V^[0]; T:= Base;
while (I < N) and (I < 4) do begin
Ex:= Ex + V^[I] * T; {Add next super digit}
T:= T * Base;
Inc(I);
end;
if S and (Ex <> 0.0) then Ex:= -Ex;
end; {MultiSI.GetEx}
{--------------------------------------}
procedure MultiSI.GetD( var Db : Double); {Db = Self Mod Base**4}
{Self is not changed}
var
T : Extended;
begin
GetEx( T); Db:= T;
end; {MultiSI.GetD}
{--------------------------------------}
procedure MultiSI.RAdd1( D1 : Mu1Digit); {Self = Self + D1}
{Allows literal D1, D1 is not changed, sets MuErr True if overflow}
var
DL : ^MultiSI;
begin
New( DL, Init(1));
DL^.SetTo1( D1);
RAdd( DL^);
Dispose( DL, Done);
end; {MultiSI.RAdd1}
{--------------------------------------}
procedure MultiSI.Add1( var X : MultiSI; D1 : Mu1Digit); {Self = X + D1}
{Allows literal D1, D1 is not changed, sets MuErr True if overflow}
begin
SetTo(X);
RAdd1( D1);
end; {MultiSI.Add1}
times since October 20, 2004.