MultiID.Pas Program Listing




{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}

Return to Juggler Numbers
Return to Harry's Home Page
This page accessed times since October 20, 2004.
Page created by: hjsmithh@sbcglobal.net
Changes last made on Saturday, 14-May-05 12:49:07 PDT

1