Contributor: JES R. KLINKE

{
You may use the following unit I have made for an encryption program
of mine. It implements real binary arithmetic, no BCD. But be careful,
there is currently no range checking at all, and overflows may result
in endless loops. If you need 2048 bit integers you have to set
BigNumLength to at least 128, a little more would be safer. Also
notice that the routines cannot handle negative numbers.

I hope you find this one useful.

        Jes R Klinke
}


PROGRAM BigNum;

USES

  Crt, Dos;

CONST

  BigNumLength = 20; {Number of words in value}

TYPE

  PBigNum = ^TBigNum;
  TBigNum = object

    Value : ARRAY [0..BigNumLength - 1] OF WORD;

    PROCEDURE ASSIGN (VAR AValue : TBigNum);
    PROCEDURE AssignLong (AValue : LONGINT);
    PROCEDURE ADD (VAR AValue : TBigNum);
    PROCEDURE Subtract (VAR AValue : TBigNum);
    PROCEDURE Multiply (VAR AMultiplicator : TBigNum);
    FUNCTION Divide (VAR ADivisor : TBigNum) : BOOLEAN;
    FUNCTION Modulus (VAR ADivisor : TBigNum) : BOOLEAN;
    PROCEDURE SquareRoot;
    PROCEDURE Increment (By : WORD);
    PROCEDURE Decrement (By : WORD);
    PROCEDURE BitwiseOr (VAR AMaske : TBigNum);
    FUNCTION Compare (VAR AValue : TBigNum) : INTEGER;
    PROCEDURE Mult10;
    PROCEDURE Div10;
    PROCEDURE Mult2;
    PROCEDURE Div2;
    FUNCTION STR : STRING;
    FUNCTION Str16 : STRING;
    PROCEDURE VAL (CONST S : STRING);
    FUNCTION AsLong : LONGINT;
  END;



PROCEDURE TBigNum.ASSIGN (VAR AValue : TBigNum);
BEGIN
  MOVE (AValue.Value, Value, SIZEOF (Value) );;
END;

PROCEDURE TBigNum.AssignLong (AValue : LONGINT);
BEGIN
  MOVE (AValue, Value [0], SIZEOF (LONGINT) );;
  FILLCHAR (Value [SIZEOF (LONGINT) SHR 1], BigNumLength SHL 1 -
SIZEOF (LONGINT), 0);
END;

PROCEDURE TBigNum.ADD (VAR AValue : TBigNum); assembler;
asm

    PUSH  DS
    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    LDS    SI, AValue
    ADD    SI, OFFSET TBigNum.Value
    MOV    CX, BigNumLength
    CLD
    CLC
@@0 : LODSW
    ADC    [ES : DI], AX
    INC    DI
    INC    DI
    LOOP  @@0
    POP    DS
END;

PROCEDURE TBigNum.Subtract (VAR AValue : TBigNum); assembler;

asm

    PUSH  DS
    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    LDS    SI, AValue
    ADD    SI, OFFSET TBigNum.Value
    MOV    CX, BigNumLength
    CLD
    CLC
@@0 : LODSW
    SBB    [ES : DI], AX
    INC    DI
    INC    DI
    LOOP  @@0
    POP    DS
END;

PROCEDURE TBigNum.Multiply (VAR AMultiplicator : TBigNum); assembler;

VAR

  Res : ARRAY [0..BigNumLength] OF WORD;
asm

    PUSH  DS
    PUSH  BP
    STD
    LES    DI, AMultiplicator
    ADD    DI, OFFSET TBigNum.Value
    LDS    SI, Self
    ADD    SI, OFFSET TBigNum.Value
    PUSH  SI
    LEA    BP, Res
    XOR    SI, SI
    MOV    CX, BigNumLength
    XOR    AX, AX
@@8 : MOV    SS : [BP + SI], AX
    ADD    SI, 2
    LOOP  @@8
    POP    SI
    XOR    BX, BX
@@0 : MOV    CX, BX
    MOV    DX, CX
    SHL    DX, 1
    ADD    SI, DX
    INC    CX
@@1 : LODSW
    MOV    DX, ES : [DI]
    ADD    DI, 2
    MUL    DX
    ADD    SS : [BP], AX
    ADC    SS : [BP + 2], DX
    JC    @@3
@@2 : LOOP  @@1
    MOV    DX, BX
    INC    DX
    SHL    DX, 1
    SUB    DI, DX
    ADD    SI, 2
    ADD    BP, 2
    INC    BX
    CMP    BX, BigNumLength
    JNE    @@0
    CLD
    POP    BP
    LEA    SI, Res
    PUSH  SS
    POP    DS
    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    MOV    CX, BigNumLength
    REP    MOVSW
    POP    DS
    JMP    @@9
@@3 : PUSH  SI
    MOV    DX, 1
    MOV    SI, 4
@@4 : ADD    [BP + SI], DX
    INC   SI
    INC    SI
    JC    @@4
    POP    SI
    JMP    @@2
@@9 :
END;

FUNCTION TBigNum.Divide (VAR ADivisor : TBigNum) : BOOLEAN;

VAR
  Bit, Res, Divisor : TBigNum;
  WholeResult : BOOLEAN;
BEGIN

  Divisor.ASSIGN (ADivisor);
  WholeResult := FALSE;
  Bit.AssignLong (1);
  Res.AssignLong (0);
  WHILE Compare (Divisor) >= 0 DO
  BEGIN
    Bit.Mult2;
    Divisor.Mult2;
  END;
  WHILE (Bit.Value [0] AND 1 = 0) AND NOT WholeResult DO
  BEGIN
    Bit.Div2;
    Divisor.Div2;
    CASE Compare (Divisor) OF
      1 :
      BEGIN
        Res.BitwiseOr (Bit);
        Subtract (Divisor);
      END;

      0 :
      BEGIN
        WholeResult := TRUE;
        Res.BitwiseOr (Bit);
        Subtract (Divisor);
      END;
    END;

  END;

  ASSIGN (Res);
  Divide := WholeResult;

END;

FUNCTION TBigNum.Modulus (VAR ADivisor : TBigNum) : BOOLEAN;

VAR

  Bit, Res, Divisor : TBigNum;
  WholeResult : BOOLEAN;

BEGIN

  Divisor.ASSIGN (ADivisor);
  WholeResult := FALSE;
  Bit.AssignLong (1);
  Res.AssignLong (0);

  WHILE Compare (Divisor) >= 0 DO
  BEGIN

    Bit.Mult2;
    Divisor.Mult2;

  END;

  WHILE (Bit.Value [0] AND 1 = 0) AND NOT WholeResult DO
  BEGIN
    Bit.Div2;
    Divisor.Div2;

    CASE Compare (Divisor) OF
      1 :
      BEGIN
        Res.BitwiseOr (Bit);
        Subtract (Divisor);
      END;

      0 :
      BEGIN
        WholeResult := TRUE;
        Res.BitwiseOr (Bit);
        Subtract (Divisor);
      END;

    END;

  END;

  Modulus := WholeResult;

END;

PROCEDURE TBigNum.SquareRoot;

VAR

  Guess, NewGuess : TBigNum;

BEGIN

  NewGuess.ASSIGN (Self);
  NewGuess.Div2;

  REPEAT

    Guess.ASSIGN (NewGuess);
    NewGuess.ASSIGN (Self);
    NewGuess.Divide (Guess);
    NewGuess.ADD (Guess);
    NewGuess.Div2;

  UNTIL NewGuess.Compare (Guess) = 0;

  ASSIGN (NewGuess);

END;

PROCEDURE TBigNum.Increment (By : WORD); assembler;

asm

    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    CLD
    MOV    AX, ES : [DI]
    ADD    AX, By
    STOSW
    MOV    CX, BigNumLength - 1
@@0 : MOV    AX, ES : [DI]
    ADC    AX, 0
    STOSW
    LOOP  @@0
END;


PROCEDURE TBigNum.Decrement (By : WORD); assembler;

asm

    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    CLD
    MOV    AX, ES : [DI]
    SUB    AX, By
    STOSW
    MOV    CX, BigNumLength - 1
@@0 : MOV    AX, ES : [DI]
    SBB    AX, 0
    STOSW
    LOOP  @@0
END;

PROCEDURE TBigNum.BitwiseOr (VAR AMaske : TBigNum); assembler;

asm

    PUSH  DS
    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    LDS    SI, AMaske
    ADD    SI, OFFSET TBigNum.Value
    MOV    CX, BigNumLength
    CLD
@@0 : LODSW
    OR    AX, ES : [DI]
    STOSW
    LOOP  @@0
    POP    DS
END;

FUNCTION TBigNum.Compare (VAR AValue : TBigNum) : INTEGER; assembler;

asm
    PUSH  DS
    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    LDS    SI, AValue
    ADD    SI, OFFSET TBigNum.Value
    MOV    CX, BigNumLength
    MOV    DX, CX
    DEC    DX
    SHL    DX, 1
    ADD    DI, DX
    ADD    SI, DX
    STD
    REPZ  CMPSW
    MOV    AX, 0FFFFh
    JA    @@1
    MOV    AX, 0000h
    JE    @@1
    MOV    AX, 0001h
@@1 : POP    DS
END;

PROCEDURE TBigNum.Mult10; assembler;

asm

    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    XOR    BX, BX
    MOV    CX, BigNumLength
@@0 : MOV    AX, [ES : DI]
    MOV    DX, 10
    MUL    DX
    ADD    AX, BX
    ADC    DX, 0
    MOV    [ES : DI], AX
    INC    DI
    INC    DI
    MOV    BX, DX
    LOOP  @@0
END;

PROCEDURE TBigNum.Div10; assembler;

asm
    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    MOV    CX, BigNumLength
    MOV    DX, CX
    DEC    DX
    SHL    DX, 1
    ADD    DI, DX
    XOR    DX, DX
@@0 : MOV    AX, [ES : DI]
    MOV    BX, 10
    DIV    BX
    MOV    [ES : DI], AX
    DEC    DI
    DEC    DI
    LOOP  @@0
END;

PROCEDURE TBigNum.Mult2; assembler;

asm
    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    XOR    BX, BX
    MOV    CX, BigNumLength
    CLC
    CLD
@@0 : MOV    AX, [ES : DI]
    RCL    AX, 1
    STOSW
    LOOP  @@0
END;

PROCEDURE TBigNum.Div2; assembler;

asm
    LES    DI, Self
    ADD    DI, OFFSET TBigNum.Value
    MOV    CX, BigNumLength
    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
END;

FUNCTION TBigNum.STR : STRING;

VAR

  M, T : TBigNum;
  Res : STRING;
  I, Ciffer : INTEGER;

BEGIN

  M.ASSIGN (Self);
  T.AssignLong (1);
  I := 0;
  WHILE M.Compare (T) >= 0 DO
  BEGIN
    T.Mult10;
    INC (I);
  END;
  IF I <= 1 THEN
  BEGIN
    STR := CHAR (BYTE ('0') + M.Value [0]);
  END
  ELSE
  BEGIN
    Res := '';
    T.Div10;
    WHILE I > 0 DO
    BEGIN
      Ciffer := 0;
      WHILE (M.Compare (T) >= 0) DO
      BEGIN
        M.Subtract (T);
        INC (Ciffer);
      END;
      Res := Res + CHAR (BYTE ('0') + Ciffer);
      DEC (I);
      T.Div10;
    END;
    STR := Res;
  END;
END;

FUNCTION TBigNum.Str16 : STRING;

CONST
  HexCif : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
VAR
  Res : STRING;
  I : INTEGER;
  ErMed : BOOLEAN;
BEGIN
  ErMed := FALSE;
  Res := '';
  FOR I := BigNumLength - 1 DOWNTO 0 DO
  BEGIN
    IF ErMed OR (Value [I] <> 0) THEN
    BEGIN
      IF ErMed OR (Value [I] SHR 12 AND $F <> 0) THEN
      BEGIN
        Res := Res + HexCif [Value [I] SHR 12 AND $F];
        ErMed := TRUE;
      END;
      IF ErMed OR (Value [I] SHR 8 AND $F <> 0) THEN
      BEGIN
        Res := Res + HexCif [Value [I] SHR 8 AND $F];
        ErMed := TRUE;
      END;
      IF ErMed OR (Value [I] SHR 4 AND $F <> 0) THEN
      BEGIN
        Res := Res + HexCif [Value [I] SHR 4 AND $F];
        ErMed := TRUE;
      END;
      Res := Res + HexCif [Value [I] AND $F];
      ErMed := TRUE;
    END;
  END;
  Str16 := Res;
END;

PROCEDURE TBigNum.VAL (CONST S : STRING);
VAR
  I : INTEGER;
BEGIN
  AssignLong (0);
  I := 1;
  WHILE I <= LENGTH (S) DO
  BEGIN
    Mult10;
    Increment (BYTE (S [I]) - BYTE ('0') );
    INC (I);
  END;
END;

FUNCTION TBigNum.AsLong : LONGINT;
VAR
 Res : ^LONGINT;

BEGIN
  Res := @Value [0];
  AsLong := Res^;
END;

VAR
  ABigNum : TBigNum;
  I : INTEGER;


BEGIN
  ABigNum.AssignLong (1);
  FOR I := 1 TO 260 DO
  BEGIN
    WRITELN (ABigNum.STR : 79);
    ABigNum.Mult2;
  END;
  FOR I := 1 TO 260 DO
  BEGIN
    WRITELN (ABigNum.STR : 79);
    ABigNum.Div2;
  END;
  WRITELN (ABigNum.STR : 79);
  WRITE ('Press enter to exit.');
  READLN;
END.