Turbo Toolbox/Turbo_Toolbox.iso/1987/06/longint.pas

Pascal/Delphi Source File | 1987-05-18 | 4.9 KB | 204 lines

(* -------------------------------------------------- *)
(*                   LONGINT.PAS                      *)
(* impl. beliebig langer positiver Integers in Pascal *)
(* -------------------------------------------------- *)

CONST LONGINT_Digits= 150; (* Anz. Stellen f. LONGINT *)
      (* Anzahl Bytes zur internen Darstellung der
         gewuenschten Stellenzahl
         = LONGINT_Digits/log(256):                   *)
      LONGINT_Len   = 63;

TYPE  LONGINT = ARRAY[1..LONGINT_Len] OF BYTE;

(* -------------------------------------------------- *)
(*  norm. INTEGER in eine LONGINTeger konvertieren:   *)

PROCEDURE IntToLong (VAR a: LONGINT; b: INTEGER);

VAR i: INTEGER;

BEGIN
  FOR i := 3 TO LONGINT_Len DO a[I] := 0;
  a[2] := Hi(b);  a[1] := Lo(b);
END;

(* -------------------------------------------------- *)
(*                       a < b ?                      *)

FUNCTION LLess (a, b: LONGINT): BOOLEAN;

VAR i: INTEGER;

BEGIN
  i := LONGINT_Len;  LLess := FALSE;
  WHILE (a[i] = b[i]) AND (i > 1) DO i := Pred(i);
  IF a[i] < b[i] THEN LLess := TRUE;
END;

(* -------------------------------------------------- *)
(*                  sum := a + b                      *)

PROCEDURE LAdd (VAR sum: LONGINT; a, b: LONGINT);

VAR i, j: INTEGER;
    mov : BYTE;

BEGIN
  mov := 0;
  FOR i := 1 TO LONGINT_Len DO
  BEGIN
    j := a[i] + b[i] + mov;  sum[i] := Lo(j);
    mov := Hi(j);
  END;
END;

(* -------------------------------------------------- *)
(*                  diff := a - b                     *)

PROCEDURE LSub (VAR diff: LONGINT; a, b: LONGINT);

VAR i: INTEGER;
    one: LONGINT;

BEGIN
  (* Zweierlomplement des Subtrahenden b bilden: *)
  FOR i := 1 TO LONGINT_Len DO b[i] := NOT b[i];
  IntToLong(one, 1);  LAdd(b, b, one);
  LAdd(diff, a, b);        (* und zu a addieren! *)
END;


(* -------------------------------------------------- *)
(*    Links-Shift, entspricht Multiplikation mit 2    *)

PROCEDURE LShl (VAR a: LONGINT);

VAR i: INTEGER;
    mov, schieb: BYTE;

BEGIN
  mov := 0;
  FOR i := 1 TO LONGINT_Len DO
  BEGIN
    schieb := (a[i] SHL 1) + mov;
    mov := a[i] SHR 7;  a[i] := schieb;
  END;
END;

(* -------------------------------------------------- *)
(*     Rechts-Shift, entspricht Division durch 2      *)

PROCEDURE LShr (VAR a: LONGINT);

VAR i: INTEGER;
    mov, schieb: BYTE;

BEGIN
  mov := 0;
  FOR i := LONGINT_Len DOWNTO 1 DO
  BEGIN
    schieb := (a[i] SHR 1) + mov;
    mov := a[i] SHL 7;  a[i] := schieb;
  END;
END;

(* -------------------------------------------------- *)
(*                 prod := a * b                      *)

PROCEDURE LMul (VAR prod: LONGINT; a, b: LONGINT);

VAR i, j, x, alen, blen: INTEGER;

BEGIN
  IntToLong(prod, 0);
  alen := LONGINT_Len;  blen := LONGINT_Len;
  WHILE (a[alen] = 0) AND (alen > 1) DO
    alen := Pred(alen);
  WHILE (b[blen] = 0) AND (blen > 1) DO
    blen := Pred(blen);
  FOR i := 1 TO alen DO
  BEGIN
    x := 0;
    FOR j := 1 TO blen DO
    BEGIN
      x := a[i] * b[j] + Hi(x) + prod[Pred(i+j)];
      prod[Pred(i+j)] := Lo(x);
    END;
    prod[i+blen] := Hi(x);
  END;
END;

(* -------------------------------------------------- *)
(*         quot := a DIV b, rest := a MOD b           *)

PROCEDURE LDiv (VAR quot, rest: LONGINT; a, b: LONGINT);

VAR p, one: LONGINT;

BEGIN
  p := b;  IntToLong(quot, 0);  IntToLong(one, 1);
  REPEAT  LShl(b)  UNTIL NOT LLess(b, a);
  REPEAT
    LShl(quot);  LShr(b);
    IF NOT LLess(a, b) THEN
    BEGIN
      LSub(a, a, b);  LAdd(quot, quot, one);
    END;
  UNTIL NOT LLess(p, b);
  rest := a;
END;

(* -------------------------------------------------- *)

PROCEDURE LRead (VAR a: LONGINT);

VAR i, j, m: INTEGER;
    lin: STRING[LONGINT_Digits];
    mov: BYTE;

BEGIN
  IntToLong(a, 0);  ReadLn(lin);  i := 1;
  WHILE i <= Length(lin) DO
  BEGIN
    IF lin[i] IN ['0'..'9'] THEN
      BEGIN
        mov := Ord(lin[i]) - Ord('0');
        FOR j := 1 TO LONGINT_Len DO
        BEGIN
          m := a[j] * 10 + mov;
          a[j] := Lo(m);  mov := Hi(m);
        END;
        i := Succ(i);
      END
    ELSE
      i := Succ(Length(lin));
  END;
END;

(* -------------------------------------------------- *)

PROCEDURE LWrite (a: LONGINT);

VAR i, j, k, m, mov: INTEGER;
    puffer: ARRAY[1..LONGINT_Digits] OF CHAR;

BEGIN
  j := LONGINT_Len;  k := 0;
  WHILE a[j] = 0 DO j := Pred(j);
  REPEAT
    k := Succ(k);  mov := 0;
    FOR i := j DOWNTO 1 DO
    BEGIN
      m := a[i] + mov * 256;
      a[i] := m DIV 10;  mov := m MOD 10;
    END;
    puffer[k] := CHAR(Ord('0') + mov);
    IF a[j] = 0 THEN j := Pred(j);
  UNTIL j = 0;
  FOR i := k DOWNTO 1 DO Write(puffer[i]);
END;

(* -------------------------------------------------- *)
(*              Ende von LONGINT.PAS                  *)