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

[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.

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

Приведи пример, на котором возникла ошибка (и данные и программу). Сейчас я попробовал умножение из модуля dlinna - показал верный результат. Никаких дополнительных преобразований в двоичный код там не предполагается. В модуле есть штатные средства визуализации - WriteLong.
Ты уже столько сил затратила на изучение различныных форматов данных... Может стоит уточнить у преподавателя, что требуется от учебной программы?

любые числа. диапозон дб Longint -2147483648..2147483647 .
25 и 26 вводимые. результат в двоичн. дополнит. 10010001010

Добавлено через 5 мин.
пользователь должен ввести любое десятичное число. программа перевести его в дополнительный код и перемножить. независимо отрицателньое оно или положительное. результат выдается в десятичном же числе. Умножаются длинные целые числа

Если взять это за основу, то получается, что требуется "забыть" о существовании штатных Write и Read, и самостоятельно пересоздать их. Затем "забыть" о существовании типа longint и создать свои процедуры для работы с ним. Вот без реализации умножения и деления (по-сути с чего начался топик):

TYPE
  TLongBin = LongInt;

VAR
  LongBin_Error : Integer;

PROCEDURE LongBin_Add   (    m1,
                             m2  : TLongBin;
                         VAR Res : TLongBin);
BEGIN
END;

PROCEDURE LongBin_Sub   (    m1,
                             m2  : TLongBin;
                         VAR Res : TLongBin);
BEGIN
END;

PROCEDURE LongBin_Mul   (    m1,
                             m2  : TLongBin;
                         VAR Res : TLongBin);
BEGIN
  Res:=m1*m2;
END;

PROCEDURE LongBin_Div   (m1,
                         m2      : TLongBin;
                         VAR Res : TLongBin);
BEGIN
END;

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

PROCEDURE LongBin_WriteD(    Num : TLongBin);
BEGIN
  Write(Num);
END;

PROCEDURE LongBin_WriteB(    Num : TLongBin);
VAR
  i     : Integer;
  s     : String;
  Mask  : TLongBin;
BEGIN
  Mask:=1;
  for i:=1 to (SizeOf(TLongBin)*8-1) do
    Mask:=Mask shl 1;
  s:='';
  for i:=1 to SizeOf(TLongBin)*8 do begin
    if (Mask AND Num)<>0 then
      s:=s+'1'
    else
      s:=s+'0';
    Mask:=Mask shr 1;
  end;
  Write(s);
END;

VAR
  c1,
  c2,
  c3    : TLongBin;
BEGIN
  LongBin_Read(c1);
  LongBin_Read(c2);
  LongBin_Mul(c1, c2, c3);
  WriteLn('===============');
  LongBin_WriteD(c1);
  Write(' ');
  LongBin_WriteB(c1);
  WriteLn;
  LongBin_WriteD(c2);
  Write(' ');
  LongBin_WriteB(c2);
  WriteLn;
  LongBin_WriteD(c3);
  Write(' ');
  LongBin_WriteB(c3);
  WriteLn;
END.

-----------------------------
Добавлю во вложении исправленный вариант. В нём реализовано сложение, вычитание и умножение. Если реализовать деление, то можно корректно оформить и вывод в десятичном виде. Тогда размер длинных чисел можно будет не ограничивать 4 байтами.  LongBin.pas ( 5.09 килобайт ) Кол-во скачиваний: 756


Сообщение отредактировано: Федосеев Павел - 1.04.2012 2:54