Умножение длинных целых чисел в дополнительном коде, Ошибка Опции

[olven]

Программа умножает двоичные числа в дополнительном коде. Но умножает неправильно. Помогите пожалуйста найти проблему

var
 temp,i,j: longint;
 n,n2,res:longint;
 s,s2,sim,sim2:string;
 alf:set of char;
 ch:char;
 p,p2,s1,s22,por,pr,apr,step,k:longint;
 a,b:longint;
 apr2:longint;
 arr: array[1..10] of string;
 c,c2:boolean;
begin
 c:=false; c2:=false;
 alf:=['0'..'9'];
 Write('vvedite pervoe chislo: ');
 Readln(s);
 Write('vvedite vtoroe chislo: ');
 Readln(s2);
 n:=length(s);
 n2:=length(s2);
 sim:='';p:=0; sim2:=''; p2:=0;
 For i:=1 to n do begin						 {vudelenie cifr iz 1 stroki}
   If s[i] in alf then sim:=sim+s[i];
   If s[i]='-' then c:=true;
 end;
 For j:=1 to n2 do begin					   {vudelenie cifr iz 2 stroki}
   If s2[j] in alf then
	 sim2:=sim2+s2[j];
	 If s2[j]='-' then c2:=true;
 end;
 For i:=1 to length(sim) do begin		 {perevod iz stroki v chislo (1)}
   s1:=ord(sim[i])-ord('0');
   p:=p*10+s1;
 end;
 For j:=1 to length(sim2) do begin		{perevod iz stroki v chislo (2)}
   s22:=ord(sim2[j])-ord('0');
   p2:=p2*10+s22;
 end;
 Writeln('chisla: ',p,' ',p2);
 a:=0; step:=1;n:=1;
 While p>=2 do begin					  {perevod iz 10i ss v 2ss (1)}
   pr:=p div 2;
   apr:=p-pr*2;
   a:=a+apr*step;
   p:=pr;
   step:=step*10;
   n:=n+1;
   If p=1 then a:=step+a;
 end;
 Writeln('dvoichnoe predstavlenie 1 chsla: ',a);
 step:=1; b:=0; por:=1;					  {perevod iz 10i ss v 2ss (2)}
 While p2>=2 do begin
   pr:=p2 div 2;
   apr:=p2-pr*2;
   b:=b+apr*step;
   p2:=pr;
   step:=step*10;
   If p2=1 then b:=step+b;
   por:=por+1;
 end;
 Writeln('dvoichnoe predstavlenie 2 chisla: ',b);
 Writeln('kolichestvo cifr 1: ',n);
 Writeln('				 2: ',por);
 If c=true then begin
	 apr:=a; pr:=a; a:=0; k:=1;		 {perevod 1go chisla v dopolnitelnui kod}
   For i:=1 to n do begin
	 apr:=pr mod 10;
	 pr:=pr div 10;
	 If apr=0 then apr2:=1;
	 If apr=1 then apr2:=0;
	 a:=a+apr2*k;
	 k:=k*10;
   end;
   k:=a mod 10;
   If k=1 then begin
	 apr:=0;
	 a:=(a div 10)*10+apr;
   end;
   If k=0 then begin
	 k:=1;
	 a:=(a div 10)*10+apr;
   end;

  end;
{  If c=false then a:=p;}
  Writeln('v dopolnit kode 1: ',a);
  If c2=true then begin
	 apr:=b; pr:=b; b:=0; k:=1;	  {perevod 2go chisla v dopolnitelnui kod}
   For j:=1 to por do begin
	 apr:=pr mod 10;
	 pr:=pr div 10;
	 If apr=0 then apr2:=1;
	 If apr=1 then apr2:=0;
	 b:=b+apr2*k;
	 k:=k*10;
	end;
	k:=b mod 10;
	 If k=1 then begin
	 apr:=0;
	 b:=(b div 10)*10+apr;
	end;
	If k=0 then begin
	  k:=1;
	  b:=(b div 10)*10+apr;
	end;
  end;
 { If c2=false then b:=p2;}
  Writeln('v dopolnit kode 2: ',b);
  res:=0;										{ymnozenie}
  k:=0;
  n:=1;
 While k<=64 do begin
   temp:=n and b;
   if temp<>0
	 then res:=res+a;
   a:=a shl 1;
   n:=n*2;
   k:=k+1;
 end;
 writeln('rezyltat v dopolnitelnom kode: ',res);
 readln;
end.

[Федосеев Павел]

Прикольно - ваш препод знает толк в извращениях.
К чему это я...
Например. у нас 4-х байтовое число. прои умножении указанным образом имеем 32 слагаемых (для отображения на экран), плюс обрамление... В общем на экране в 25 строк не поместится. Следующее задание - вывод результата в файл или пауза для ожидания нажатия на клавишу?

{сдвиг влево на один разряд}
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
    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;
  end;
END;

Умножение я реализовал как википедии "http://en.wikipedia.org/wiki/Two's_complement" - с отсечением "лишних" разрядов.

Сообщение отредактировано: Федосеев Павел - 30.04.2012 0:37