PROGRAM LongBin;
TYPE
  TLongBin = LongInt;
CONST
  CLongLen = SizeOf(TLongBin);
TYPE
  TArrayBin= packed array [1..CLongLen] of Byte;
VAR
  LongBin_Error : Integer;

{Вывод на экран длинного числа Num в десятичном формате}
PROCEDURE LongBin_WriteD(    Num : TArrayBin);
BEGIN
  Write(TLongBin(Num));
END;

{Вывод на экран длинного числа Num в двоичном формате}
PROCEDURE LongBin_WriteB(    Num : TArrayBin);
VAR
  i, j  : Integer;
  s     : String;
  Mask  : Byte;
  Cnt   : integer;
BEGIN
  s:='';
  Cnt:=0;
  for i:=CLongLen downto 1 do begin {проход по байтам}
    Mask:=$80;
    for j:=1 to 8 do begin {проход по битам}
      if (Mask AND Num[i])<>0 then
        s:=s+'1'
      else
        s:=s+'0';
      Mask:=Mask shr 1;
    end;
    if i<>1 then s:=s+'''';
  end;
  Write(s);
END;

PROCEDURE LongBin_Show(    Num : TArrayBin);
BEGIN
  Write('(');
  LongBin_WriteB(Num);
  Write(') ');
  LongBin_WriteD(Num);
  WriteLn;
END;

{Возвращает абсолютное значение числа A}
PROCEDURE LongBin_Abs   (VAR A   : TArrayBin);
VAR
  i     : Integer;
  Carry : BOOLEAN;
BEGIN
  {Если число отрицательное, то выполняем обратное преобразование -
   из дополнительного кода в обычный: A:=NOT(A-1)}
  if (A[CLongLen] AND $80)<>0 then begin
    {A:=A-1}
    i:=1;
    Carry:=TRUE;
    repeat
      Carry:=(A[i]=0) AND Carry; {требуется ли заём из следующего разряда}
      Dec(A[i]);
      Inc(i);
    until NOT Carry;
    {A:=NOT(A)}
    for i:=1 to CLongLen do
      A[i]:=NOT(A[i]);
  end;
END;

{Возвращает (-A):
 если A>0, то отрицательное число в дополнительном коде
 если A<0, то абсолютное значение}
PROCEDURE LongBin_Neg   (VAR A   : TArrayBin);
VAR
  i     : Integer;
  Carry : BOOLEAN;
BEGIN
  {Если число положительное, то выполняем преобразование -
   в дополнительный код: A:=NOT(A)+1}
  if (A[CLongLen] AND $80)=0 then begin
    {A:=NOT(A)}
    for i:=1 to CLongLen do
      A[i]:=NOT(A[i]);
    {A:=A+1}
    i:=1;
    Carry:=TRUE;
    repeat
      Carry:=(A[i]=$FF) AND Carry; {требуется ли перенос в следующий разряд}
      Inc(A[i]);
      Inc(i);
    until NOT Carry;
  end
  else
    LongBin_Abs(A);
END;

PROCEDURE LongBin_Add   (    a ,
                             b   : TArrayBin;
                         VAR Res : TArrayBin);
VAR
  i     : Integer;
  c     : TArrayBin;
  a1,
  b1,
  c1    : Word;
BEGIN
  c1:=0;
  for i:=1 to CLongLen do begin
    c1:=Hi(c1);
    a1:=a[i];
    b1:=b[i];
    c1:=c1+a1+b1;
    c[i]:=Lo(c1);
  end;
  move(c, Res, SizeOf(Res));
END;

{Возвращает в Res разность чисел a и b (Res:=a-b)}
PROCEDURE LongBin_Sub   (    a,
                             b   : TArrayBin;
                         VAR Res : TArrayBin);
BEGIN
  LongBin_Neg(b);
  LongBin_Add(a, b, Res);
END;

PROCEDURE LongBin_SHL(VAR a : TArrayBin);
VAR
  i,
  CarryPrev,
  CarryCurr : Integer;
BEGIN
  CarryPrev:=0;{предыдущий байт при сдвиге не дал перенос}
  CarryCurr:=0;{текущий    байт при сдвиге не дал перенос}
  for i:=1 to CLongLen do begin
    CarryCurr:=(a[i] AND $80); {бит, который будет переноситься в следующий байт}
    {$ifopt R+} {временно отключим контроль переполнения}
      {$R-}
      {$define ReqSet_OptR}
    {$endif}
    a[i]:=a[i] SHL 1;
    {$ifdef ReqSet_OptR}
      {$R+}
      {$undef ReqSet_OptR}
    {$endif}
    if CarryPrev<>0 then a[i]:=(a[i] OR 1);
    CarryPrev:=CarryCurr;
  end;
END;

PROCEDURE LongBin_NewMul(    a,
                             b   : TArrayBin;
                         VAR Res : TArrayBin;
                             Log : BOOLEAN);
VAR
  i, j                  : Integer;
  Mask                  : Byte;
  Zero                  : TArrayBin; {равно нулю - для вывода на экран}
BEGIN
  if Log
  then begin
    Assign(output, 'log.txt');
    rewrite(output);
    LongBin_WriteB(a);
    WriteLn;
    WriteLn('x');
    LongBin_WriteB(b);
    WriteLn;
    WriteLn('---------------------------------');
  end;

  FillChar(Res, Sizeof(Res), 0);
  Zero:=Res;
  for i:=1 to CLongLen do begin {цикл по всем байтам числа b}
    Mask:=1;
    for j:=1 to 8 do begin      {цикл по всем битам числа b}
      if Log
      then begin
        if (Mask AND b[i])<>0 then
          LongBin_WriteB(a)
        else
          LongBin_WriteB(Zero);
        WriteLn;
      end;
      if (Mask AND b[i])<>0 then
        LongBin_Add(Res, a, Res);
      LongBin_SHL(a);
      {$ifopt R+} {временно отключим контроль переполнения}
        {$R-}
        {$define ReqSet_OptR}
      {$endif}
      Mask:=Mask SHL 1;
      {$ifdef ReqSet_OptR}
        {$R+}
        {$undef ReqSet_OptR}
      {$endif}
    end;
  end;
  if Log
  then begin
    WriteLn('---------------------------------');
    LongBin_WriteB(Res);
    WriteLn;
    Close(output);
    Assign(output, '');
    rewrite(output);
  end;
END;

{Умножает длинное число a на длинное число b}
PROCEDURE LongBin_Mul   (    a,
                             b   : TArrayBin;
                         VAR Res : TArrayBin;
                             Log : BOOLEAN);
TYPE
  TVeryLongBin=array [1..2*CLongLen] of Byte;
VAR
  Sign1, Sign2, SignRes : BOOLEAN;
  c                     : TVeryLongBin;
  b1, b2, b3            : Word;
  i, j                  : Integer;
  {Эти переменные - исключительно для демонстрации}
  x                     : TVeryLongBin;
  x1, x2, x3            : Word;
  y                     : TArrayBin;
BEGIN
  if Log then begin
    WriteLn('Initially:');
    Write('1st:');
    LongBin_Show(a);
    Write('2nd:');
    LongBin_Show(b);
  end;
  Sign1:=(a[CLongLen] AND $80)<>0;
  Sign2:=(b[CLongLen] AND $80)<>0;
  SignRes:=Sign1 XOR Sign2;
  LongBin_Abs(a);
  LongBin_Abs(b);

  if Log then begin
    WriteLn('After "abs" operation:');
    Write('1st:');
    LongBin_Show(a);
    Write('2nd:');
    LongBin_Show(b);
  end;

  if Log then begin
    WriteLn('Result is summa:')
  end;

  fillchar(c, SizeOf(c), 0);
  for i:=1 to CLongLen do begin
    b1:=a[i];
    b3:=0;

    x1:=a[i];
    x3:=0;
    fillchar(x, SizeOf(x), 0);

    for j:=1 to CLongLen do begin
      b2:=b[j];
      b3:=b1*b2+b3+c[i+j-1];
      c[i+j-1]:=Lo(b3);
      b3:=Hi(b3);

      x2:=b[j];
      x3:=x1*x2+x3;
      x[i+j-1]:=Lo(x3);
      x3:=Hi(x3);
    end;

    if Log then begin
      move(x, y, SizeOf(y));
      LongBin_Show(y);
    end;
  end;
  move(c, Res, SizeOf(Res));

  if Log then begin
    WriteLn('Absolute result:');
    LongBin_Show(Res);
  end;

  if SignRes then LongBin_Neg(Res);

  if Log then begin
    WriteLn('Signed result:');
    LongBin_Show(Res);
  end;
END;


{m1 - делимое (divident),
 m2 - делитель (divisor),
 Res - частное (quotient),
 Remainder - остаток}
PROCEDURE LongBin_Div   (m1,
                         m2      : TArrayBin;
                         VAR Res : TArrayBin);
BEGIN

END;

PROCEDURE LongBin_Read  (VAR Num : TArrayBin);
VAR
  s     : String;
  i,
  start : Integer;
  Sign  : BOOLEAN;
  a     : TArrayBin;
  ten   : TArrayBin;
  b     : TArrayBin;
BEGIN
  ReadLn(s);
  Sign:=(s[1]='-');
  if Sign then
    start:=2
  else
    start:=1;
  FillChar(a, SizeOf(a), 0);
  FillChar(b, SizeOf(b), 0);
  FillChar(ten, SizeOf(ten), 0);
  ten[1]:=10;
  for i:=start to Length(s) do begin
    if NOT (s[i] in ['0'..'9']) then begin
      LongBin_Error:=1;
      Exit;
    end;
    LongBin_Mul(a, ten, a, FALSE);
    b[1]:=(Ord(s[i])-Ord('0'));
    LongBin_Add(a, b, a);
  end;
  {Если число должно быть отрицательным, то преобразуем
   его в дополнительный код: Num:=NOT(Num)+1}
  if Sign then
    LongBin_Neg(a);
  move(a, Num, SizeOf(Num));
END;


VAR
  c1,
  c2,
  c3    : TArrayBin;
BEGIN
  WriteLn('#############################');
  Write  ('Enter the 1st number: ');
  LongBin_Read(c1);
  Write  ('Enter the 2nd number: ');
  LongBin_Read(c2);
  WriteLn('===============');
  LongBin_Show(c1);
  LongBin_Show(c2);
  WriteLn('----------- Mul ----------');
  LongBin_NewMul(c1, c2, c3, TRUE);
  LongBin_Show(c3);
  LongBin_Mul(c1, c2, c3, TRUE);
  LongBin_Show(c3);
  WriteLn('----------- Add ----------');
  LongBin_Add(c1, c2, c3);
  LongBin_Show(c3);
  WriteLn('----------- Sub ----------');
  LongBin_Sub(c1, c2, c3);
  LongBin_Show(c3);
END.