[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    {
    To the SWAG:
    I would like this version of my unit to replace the older version called
    'Handling Massive Number functions' in the 'Math' snippet. If it is possible.
    }

    program BigNum;

    { BigNum v2.0, 16-bit  by Jes R. Klinke

      Implements calculations on integers of arbitrary size.
      All operations necessary for cryptographic applications are provided.

      You may use this unit for whatever you want. But if you make a commercial
      product please at least send me a copy of it.

      New in version 2:
      * Dynamic size
          Each instance of TBigNum has just enough memory allocated to it to
          keep its current value. You don't have to specify a BigNumSize anymore.
      * Negative numbers
          Most of the calculations now support negative values.
      * More efficient calculations
          As each instance of TBigNum keeps track of how many words are actually
          used in it's value, only the necessary calculations are performed.
          This particularly speeds up the multiplication, as lots of
          MUL's with zero words are avoided.

      To do's:
      * 32-bit calculations on 386+ processors for better performance

      Any comment or bug reports are welcome. I am especially interested in
      knowing if there are sufficient demand for a 32-bit version.
      You can reach me at jesk@diku.dk or jesk@dk-online.dk.
      My snail-mail address is Jes Rahbek Klinke
                               Haandvaerkerhaven 3, 2. mf
                               2400 Copenhagen NV
    }

    uses
      Crt, Dos;

    type
      PWordArr = ^TWordArr;
      TWordArr = array [0..999] of Word;

      PBigNum = ^TBigNum;
      TBigNum = object
        Value: PWordArr;
        Alloc, Used: Word;
        Sign: Boolean;
        constructor Init;
        destructor Done;
        procedure Assign(const AValue: TBigNum);
        procedure AssignLong(AValue: LongInt);
        procedure Add(const AValue: TBigNum);
        procedure Subtract(const AValue: TBigNum);
        procedure Multiply(const AValue: TBigNum);
        function Divide(const ADivisor: TBigNum): Boolean;
        function Modulo(const ADivisor: TBigNum): Boolean;
        procedure PowerModulo(const AExponent, AModulo: TBigNum);
        procedure BitwiseOr(const AMask: TBigNum);
        function Compare(const AValue: TBigNum): Integer;
        procedure Mult10;
        procedure Div10;
        procedure Mult2;
        procedure Div2;
        function Str: string;
        function StrHex: string;
        procedure Val(const S: string);
        function AsLong: LongInt;
        procedure Swap(var AValue: TBigNum);
      { procedures working on absolute values only, mainly for internal use. }
        procedure AbsIncrement(By: Word);
        procedure AbsDecrement(By: Word);
        function AbsCompare(const AValue: TBigNum): Integer;
        procedure AbsAdd(const AValue: TBigNum);
        procedure AbsSubtract(const AValue: TBigNum);
        function AbsDivide(const ADivisor: TBigNum): Boolean;
        function AbsModulo(const ADivisor: TBigNum): Boolean;
      private { internal procedures for memory management }
        procedure Realloc(Words: Word; Preserve: Boolean);
        function Critical: Boolean;
        procedure CountUsed;
      end;

    constructor TBigNum.Init;
    begin
      Alloc := 0;
      Used := 0;
    end;

    destructor TBigNum.Done;
    begin
      FreeMem(Value, Alloc * SizeOf(Word));
    end;

    procedure TBigNum.Assign(const AValue: TBigNum);
    begin
      if Alloc < AValue.Used then
        Realloc(AValue.Used, False);
      Used := AValue.Used;
      Move(AValue.Value^, Value^, Used shl 1);
      FillChar(Value^[Used], (Alloc - Used) shl 1, 0);
      Sign := AValue.Sign;
    end;

    procedure TBigNum.AssignLong(AValue: LongInt);
    begin
      if AValue < 0 then
      begin
        Sign := True;
        AValue := -AValue;
      end
      else
        Sign := False;
      if Alloc < 2 then
        Realloc(2, False);
      Move(AValue, Value^[0], SizeOf(LongInt));;
      Used := 2;
      if Alloc > Used then
        FillChar(Value^[Used], (Alloc - Used) shl 1, 0);
      CountUsed;
    end;

    procedure TBigNum.Add(const AValue: TBigNum);
    var
      MValue: TBigNum;
    begin
      if Sign xor AValue.Sign then
        if AbsCompare(AValue) >= 0 then
          AbsSubtract(AValue)
        else
        begin
          MValue.Init;
          MValue.Assign(AValue);
          TBigNum.Swap(MValue);
          AbsSubtract(MValue);
          MValue.Done;
        end
      else
        AbsAdd(AValue);
    end;

    procedure TBigNum.Subtract(const AValue: TBigNum);
    var
      MValue: TBigNum;
    begin
      if Sign xor AValue.Sign then
        AbsAdd(AValue)
      else
        if AbsCompare(AValue) >= 0 then
          AbsSubtract(AValue)
        else
        begin
          MValue.Init;
          MValue.Assign(AValue);
          TBigNum.Swap(MValue);
          AbsSubtract(MValue);
          MValue.Done;
          Sign := not Sign;
        end;
    end;

    procedure TBigNum.Multiply(const AValue: TBigNum);
    var
      Needed: Word;
      Result: PWordArr;
      SmallVal, BigVal: PWordArr;
      Small, Big, I: Integer;
      X: Word;
    begin
      if Used = 0 then
        Exit;
      if AValue.Used = 0 then
      begin
        Used := 0;
        Exit;
      end;
      Sign := Sign xor AValue.Sign;
      Needed := Used + AValue.Used + 1;
      GetMem(Result, Needed * SizeOf(Word));
      FillChar(Result^, Needed * SizeOf(Word), 0);
      if Used > AValue.Used then
      begin
        SmallVal := AValue.Value;
        Small := AValue.Used;
        BigVal := Value;
        Big := Used;
      end
      else
      begin
        BigVal := AValue.Value;
        Big := AValue.Used;
        SmallVal := Value;
        Small := Used;
      end;
      asm
        PUSH  DS
        CLD
        XOR    DX,DX
    @@0:PUSH  DX
        LES    DI,SmallVal
        ADD    DI,DX
        ADD    DI,DX
        MOV    AX,[ES:DI]
        LES    DI,Result
        ADD    DI,DX
        ADD    DI,DX
        LDS    SI,BigVal
        MOV    CX,Big
        PUSH  BP
        MOV    BP,AX
        XOR    DX,DX
    @@1:MOV    BX,DX
        LODSW
        MUL    BP
        ADD    BX,AX
        ADC    DX,0
        MOV    AX,[ES:DI]
        ADD    AX,BX
        STOSW
        ADC    DX,0
        LOOP  @@1
        MOV    AX,[ES:DI]
        ADD    AX,DX
        STOSW
        POP    BP
        POP    DX
        INC    DX
        CMP    DX,Small
        JNE    @@0
        POP    DS
      end;
      Realloc(Needed, False);
      Move(Result^, Value^, Needed * SizeOf(Word));
      if Alloc - Needed > 0 then
        FillChar(Value^[Needed], (Alloc - Needed) * SizeOf(Word), 0);
      FreeMem(Result, Needed * SizeOf(Word));
      CountUsed;
    end;

    { Note: At first sight, you might think, that Divide and Modulo gives wrong
      results for negative values. This depends on the definition of the quoient
      and remainder.
      The definition used by these routines is:
      Given the divident N and divisor D, the quotient Q and remainder R is then
      defined by the equation
        N = D * Q + R,
      where the absolute value of R is less then the absolute value of D and R
      have the same sign as D.
      This will prove to be very convinient.}

    function TBigNum.Divide(const ADivisor: TBigNum): Boolean;
    begin
      if Sign xor ADivisor.Sign then
      begin
        Subtract(ADivisor);
        AbsDecrement(1);
        AbsDivide(ADivisor);
        Sign := not Sign;
      end
      else
      begin
        AbsDivide(ADivisor);
      end;
    end;

    function TBigNum.Modulo(const ADivisor: TBigNum): Boolean;
    begin
      if Sign xor ADivisor.Sign then
      begin
        Subtract(ADivisor);
        AbsDecrement(1);
        AbsModulo(ADivisor);
        Add(ADivisor);
        AbsDecrement(1);
      end
      else
      begin
        AbsModulo(ADivisor);
      end;
    end;

    procedure TBigNum.PowerModulo(const AExponent, AModulo: TBigNum);
    var
      Result, A: TBigNum;
      I: Integer;
    begin
      if AExponent.Sign then
        RunError(201);
      Result.Init;
      A.Init;
      Result.AssignLong(1);
      A.Assign(Self);
      for I := 0 to AExponent.Used * 16 - 1 do
      begin
        if AExponent.Value^[I shr 4] and (1 shl (I and 15)) <> 0 then
        begin
          Result.Multiply(A);
          Result.Modulo(AModulo);
        end;
        A.Multiply(A);
        A.Modulo(AModulo);
      end;
      Assign(Result);
      A.Done;
      Result.Done;
    end;

    procedure TBigNum.BitwiseOr(const AMask: TBigNum);
    begin
      if AMask.Used > Used then
        Realloc(AMask.Used, True);
      asm
        PUSH  DS
        LES   DI,Self
        LES   DI,[ES:DI.TBigNum.Value]
        LDS   SI,AMask
        MOV   CX,[DS:SI.TBigNum.Used]
        JCXZ  @@1
        LDS   SI,[DS:SI.TBigNum.Value]
        CLD
    @@0:LODSW
        OR    AX,[ES:DI]
        STOSW
        LOOP  @@0
    @@1:POP   DS
      end;
      CountUsed;
    end;

    function TBigNum.Compare(const AValue: TBigNum): Integer;
    begin
      if Sign xor AValue.Sign then
        if Sign then
          Compare := -1
        else
          Compare := 1
      else
        if Sign then
          Compare := -AbsCompare(AValue)
        else
          Compare := AbsCompare(AValue);
    end;

    procedure TBigNum.Mult10;
    begin
      Realloc(Used + 1, True);
      asm
        LES   DI,Self
        MOV   CX,[ES:DI.TBigNum.Used]
        JCXZ  @@1
        LES    DI,[ES:DI.TBigNum.Value]
        XOR   BX,BX
        CLD
    @@0:MOV   AX,[ES:DI]
        MOV   DX,10
        MUL   DX
        ADD   AX,BX
        ADC   DX,0
        STOSW
        MOV   BX,DX
        LOOP  @@0
        MOV   [ES:DI],BX
    @@1:
      end;
      CountUsed;
    end;

    procedure TBigNum.Div10;
    begin
      asm
        LES   DI,Self
        MOV   CX,[ES:DI.TBigNum.Used]
        JCXZ  @@1
        LES    DI,[ES:DI.TBigNum.Value]
        MOV   DX,CX
        DEC   DX
        SHL   DX,1
        STD
        ADD   DI,DX
        XOR   DX,DX
    @@0:MOV   AX,[ES:DI]
        MOV   BX,10
        DIV   BX
        STOSW
        LOOP  @@0
    @@1:
      end;
      CountUsed;
    end;

    procedure TBigNum.Mult2;
    begin
      if Critical then
      begin
        Realloc(Used + 1, True);
        Used := Used + 1;
      end;
      asm
        LES   DI,Self
        MOV   CX,[ES:DI.TBigNum.Used]
        JCXZ  @@1
        LES    DI,[ES:DI.TBigNum.Value]
        CLC
        CLD
    @@0:MOV   AX,[ES:DI]
        RCL   AX,1
        STOSW
        LOOP  @@0
    @@1:
      end;
      CountUsed;
    end;

    procedure TBigNum.Div2;
    begin
      asm
        LES   DI,Self
        MOV   CX,[ES:DI.TBigNum.Used]
        JCXZ  @@1
        LES    DI,[ES:DI.TBigNum.Value]
        MOV   DX,CX
        DEC   DX
        SHL   DX,1
        ADD   DI,DX
        XOR   DX,DX
        CLC
        STD
    @@0:MOV   AX,[ES:DI]
        RCR   AX,1
        STOSW
        LOOP  @@0
    @@1:
      end;
      CountUsed;
    end;

    function TBigNum.Str: string;
    var
      M, T: TBigNum;
      Res: string;
      I, Ciffer: Integer;
    begin
      if Used = 0 then
      begin
        Str := '0';
        Exit;
      end;
      M.Init;
      T.Init;
      M.Assign(Self);
      T.AssignLong(1);
      I := 0;
      while M.AbsCompare(T) >= 0 do
      begin
        T.Mult10;
        Inc(I);
      end;
      if I <= 1 then
      begin
        if Sign then
          Str := '-' + Char(Byte('0') + M.Value^[0])
        else
          Str := Char(Byte('0') + M.Value^[0]);
      end
      else
      begin
        if Sign then
          Res := '-'
        else
          Res := '';
        T.Div10;
        while I > 0 do
        begin
          Ciffer := 0;
          while (M.AbsCompare(T) >= 0) do
          begin
            M.AbsSubtract(T);
            Inc(Ciffer);
          end;
          Res := Res + Char(Byte('0') + Ciffer);
          Dec(I);
          T.Div10;
        end;
        Str := Res;
      end;
      T.Done;
      M.Done;
    end;

    function TBigNum.StrHex: string;
    const
      HexCif: array [0..15] of Char = '0123456789ABCDEF';
    var
      Res: string;
      I: Integer;
      HasBegun: Boolean;
    begin
      if Used = 0 then
      begin
        StrHex := '0';
        Exit;
      end;
      HasBegun := False;
      if Sign then
        Res := '-'
      else
        Res := '';
      for I := Used - 1 downto 0 do
      begin
        if HasBegun or (Value^[I] <> 0) then
        begin
          if HasBegun or (Value^[I] shr 12 and $F <> 0) then
          begin
            Res := Res + HexCif[Value^[I] shr 12 and $F];
            HasBegun := True;
          end;
          if HasBegun or (Value^[I] shr 8 and $F <> 0) then
          begin
            Res := Res + HexCif[Value^[I] shr 8 and $F];
            HasBegun := True;
          end;
          if HasBegun or (Value^[I] shr 4 and $F <> 0) then
          begin
            Res := Res + HexCif[Value^[I] shr 4 and $F];
            HasBegun := True;
          end;
          Res := Res + HexCif[Value^[I] and $F];
          HasBegun := True;
        end;
      end;
      StrHex := Res;
    end;

    procedure TBigNum.Val(const S: string);
    var
      I: Integer;
    begin
      Used := 0;
      if S[1] = '-' then
      begin
        Sign := True;
        I := 2;
      end
      else
      begin
        Sign := False;
        I := 1;
      end;
      while I <= Length(S) do
      begin
        Mult10;
        AbsIncrement(Byte(S[I]) - Byte('0'));
        Inc(I);
      end;
    end;

    function TBigNum.AsLong: LongInt;
    var
      Res: LongInt;
    begin
      if (Used > 2) or (Used = 2) and Critical then
        RunError(215);
      if Used = 2 then
        Res := Value^[1] shl 16 or Value^[0]
      else if Used = 1 then
        Res := Value^[0]
      else
        Res := 0;
      if Sign then
        AsLong := -Res
      else
        AsLong := Res;
    end;

    procedure TBigNum.Swap(var AValue: TBigNum);
    var
      MW: Word;
      MP: PWordArr;
      MB: Boolean;
    begin
      MW := Alloc;
      Alloc := AValue.Alloc;
      AValue.Alloc := MW;
      MW := Used;
      Used := AValue.Used;
      AValue.Used := MW;
      MP := Value;
      Value := AValue.Value;
      AValue.Value := MP;
      MB := Sign;
      Sign := AValue.Sign;
      AValue.Sign := MB;
    end;

    function TBigNum.AbsCompare(const AValue: TBigNum): Integer;
    begin
      if Used > AValue.Used then
        AbsCompare := 1
      else if Used < AValue.Used then
        AbsCompare := -1
      else
        asm
          PUSH  DS
          LES    DI,Self
          LES    DI,[ES:DI.TBigNum.Value]
          LDS   SI,AValue
          MOV    CX,[DS:SI.TBigNum.Used]
          LDS    SI,[DS:SI.TBigNum.Value]
          MOV    DX,CX
          DEC    DX
          SHL    DX,1
          ADD    DI,DX
          ADD    SI,DX
          STD
          REPZ  CMPSW
          MOV    @Result,0FFFFh
          JA    @@1
          MOV    @Result,0000h
          JE    @@1
          MOV    @Result,0001h
    @@1:  POP    DS
        end;
    end;

    procedure TBigNum.AbsIncrement(By: Word);
    begin
      if (Used = 0) or Critical then
      begin
        Inc(Used);
        Realloc(Used, True);
      end;
      asm
        LES   DI,Self
        MOV   CX,[ES:DI.TBigNum.Used]
        DEC    CX
        LES   DI,[ES:DI.TBigNum.Value]
        CLD
        MOV   AX,[ES:DI]
        ADD   AX,By
        STOSW
        JCXZ  @@1
    @@0:MOV   AX,[ES:DI]
        ADC   AX,0
        STOSW
        LOOP  @@0
    @@1:
      end;
      CountUsed;
    end;

    procedure TBigNum.AbsDecrement(By: Word);
    begin
      asm
        LES   DI,Self
        MOV   CX,[ES:DI.TBigNum.Used]
        DEC    CX
        LES   DI,[ES:DI.TBigNum.Value]
        CLD
        MOV   AX,ES:[DI]
        SUB   AX,By
        STOSW
        JCXZ  @@1
    @@0:MOV   AX,ES:[DI]
        SBB   AX,0
        STOSW
        LOOP  @@0
    @@1:
      end;
      CountUsed;
    end;

    procedure TBigNum.AbsAdd(const AValue: TBigNum);
    var
      RealAdds, ExtraAdds: Word;
    begin
      if AValue.Used >= Alloc then
        if AValue.Critical or (AValue.Used = Alloc) and (Alloc = Used) and Critical then
          Realloc(AValue.Used + 1, True)
        else
          if AValue.Used > Alloc then
            Realloc(AValue.Used, True)
      else if AValue.Used < Alloc then
        if (Used = Alloc) and Critical then
          Realloc(Used + 1, True);
      RealAdds := AValue.Used;
      ExtraAdds := Alloc - RealAdds;
      asm
        PUSH  DS
        LES    DI,Self
        LES    DI,[ES:DI.TBigNum.Value]
        LDS    SI,AValue
        LDS    SI,[DS:SI.TBigNum.Value]
        MOV    CX,RealAdds
        JCXZ  @@2
        CLD
        CLC
    @@0:LODSW
        ADC    [ES:DI],AX
        INC    DI
        INC    DI
        LOOP  @@0
        MOV    CX,ExtraAdds
        JCXZ  @@2
    @@1:ADC    WORD PTR [ES:DI],0
        INC    DI
        INC    DI
        LOOP  @@1
    @@2:POP    DS
      end;
      CountUsed;
    end;

    procedure TBigNum.AbsSubtract(const AValue: TBigNum);
    begin
      asm
        PUSH  DS
        LES   DI,Self
        MOV   DX,[ES:DI.TBigNum.Used]
        LES   DI,[ES:DI.TBigNum.Value]
        LDS   SI,AValue
        MOV   CX,[DS:SI.TBigNum.Used]
        LDS   SI,[DS:SI.TBigNum.Value]
        SUB    DX,CX
        JCXZ  @@2
        CLD
        CLC
    @@0:LODSW
        SBB   [ES:DI],AX
        INC   DI
        INC   DI
        LOOP  @@0
        MOV    CX,DX
        JCXZ  @@2
    @@1:SBB   WORD PTR [ES:DI],0
        INC   DI
        INC   DI
        LOOP  @@0
    @@2:POP   DS
      end;
      CountUsed;
    end;

    function TBigNum.AbsDivide(const ADivisor: TBigNum): Boolean;
    var
      Bit, Res, Divisor: TBigNum;
      NoRemainder: Boolean;
    begin
      if ADivisor.Used = 0 then
        RunError(200);
      Bit.Init;
      Res.Init;
      Divisor.Init;
      Divisor.Assign(ADivisor);
      NoRemainder := False;
      Bit.AssignLong(1);
      Res.AssignLong(0);
      while AbsCompare(Divisor) >= 0 do
      begin
        Bit.Mult2;
        Divisor.Mult2;
      end;
      while (Bit.Value^[0] and 1 = 0) and not NoRemainder do
      begin
        Bit.Div2;
        Divisor.Div2;
        case AbsCompare(Divisor) of
          1:
          begin
            Res.BitwiseOr(Bit);
            AbsSubtract(Divisor);
          end;
          0:
          begin
            NoRemainder := True;
            Res.BitwiseOr(Bit);
            AbsSubtract(Divisor);
          end;
        end;
      end;
      AbsDivide := NoRemainder;
      Assign(Res);
      Divisor.Done;
      Res.Done;
      Bit.Done;
    end;

    function TBigNum.AbsModulo(const ADivisor: TBigNum): Boolean;
    var
      Divisor: TBigNum;
      NoRemainder: Boolean;
      Count: Integer;
    begin
      if ADivisor.Used = 0 then
        RunError(200);
      Divisor.Init;
      Divisor.Assign(ADivisor);
      NoRemainder := False;
      Count := 0;
      while AbsCompare(Divisor) >= 0 do
      begin
        Inc(Count);
        Divisor.Mult2;
      end;
      while (Count <> 0) and not NoRemainder do
      begin
        Divisor.Div2;
        case AbsCompare(Divisor) of
          1:
          begin
            AbsSubtract(Divisor);
          end;
          0:
          begin
            NoRemainder := True;
            AbsSubtract(Divisor);
          end;
        end;
        Dec(Count);
      end;
      AbsModulo := NoRemainder;
      Divisor.Done;
    end;

    procedure TBigNum.Realloc(Words: Word; Preserve: Boolean);
    var
      NewValue: PWordArr;
    begin
      if Words <= Alloc then
      begin
        if Preserve then
        begin
          FillChar(Value^[Used], (Alloc - Used) shl 1, 0);
        end;
        Exit;
      end;
      if Preserve then
      begin
        GetMem(NewValue, Words * SizeOf(Word));
        Move(Value^, NewValue^, Used shl 1);
        FillChar(NewValue^[Used], (Words - Used) shl 1, 0);
        FreeMem(Value, Alloc * SizeOf(Word));
        Value := NewValue;
        Alloc := Words;
      end
      else
      begin
        FreeMem(Value, Alloc * SizeOf(Word));
        Alloc := Words;
        GetMem(Value, Alloc * SizeOf(Word));
      end;
    end;

    function TBigNum.Critical: Boolean;
    begin
      Critical := (Used > 0) and (Value^[Used - 1] and (1 shl (SizeOf(Word) * 8 - 1)) <> 0);
    end;

    procedure TBigNum.CountUsed;
    begin
      Used := Alloc;
      while (Used > 0) and (Value^[Used - 1] = 0) do
        Dec(Used);
    end;

    var
      BigA, BigB: TBigNum;
      I: Integer;

    begin
      BigA.Init; { Caution: Because of the new dynamic memory allocation }
      BigB.Init; {          you have to use Init and Done. }
      WriteLn('Fibonacci numbers:');
      BigA.Val('0');
      BigB.Val('1');
      for I := 1 to 370 do
      begin
        WriteLn(BigB.Str: 79);
        BigA.Add(BigB);
        BigA.Swap(BigB);
      end;
      WriteLn(BigB.Str: 79);
      WriteLn('Factorials:');
      BigA.Val('1');
      BigB.Val('1');
      for I := 1 to 49 do
      begin
        WriteLn(BigA.Str: 70, ' = ', BigB.Str, '!');
        BigB.AbsIncrement(1);
        BigA.Multiply(BigB);
      end;
      for I := 1 to 49 do
      begin
        WriteLn(BigA.Str: 70, ' = ', BigB.Str, '!');
        BigA.Divide(BigB);
        BigB.AbsDecrement(1);
      end;
      WriteLn(BigA.Str: 70, ' = ', BigB.Str, '!');
      WriteLn('Powers of 2:');
      BigA.Val('1');
      BigB.Val('-2');
      for I := 1 to 250 do
      begin
        WriteLn(BigA.Str: 79);
        BigA.Multiply(BigB);
      end;
      for I := 1 to 250 do
      begin
        WriteLn(BigA.Str: 79);
        BigA.Divide(BigB);
      end;
      WriteLn(BigA.Str: 79);
      BigB.Done;
      BigA.Done;
      Write('Press enter to exit.');
      ReadLn;
    end.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]