Переведення цілих чисел із 10-ї системи числення в 2-у і навпаки.

program delen_s_vost_ost;

uses crt;

const n:byte=4; {точность вычислений}

var A,B,_B,T,k:integer; {A,B - содержат прямой код}

{_B - это '-В' в дополнительном коде}

p_b,p_a,m:byte;

i,j:byte; {параметры цикла}

C,P,r:real; {результат}

z_a,z_b:boolean; {знак чисел А и В}

a_l,b_l,c_l:word; {?_l мантисса двоичной записи}

a_h,b_h,c_h:shortint;

d :char;

procedure shr_ab(var a:shortint;var b:word);

begin {линейный сдвиг вправо двоичной записи}

for i:=1 to 15 do {shr b}

if (((1 shl i) and b)<>0) and (((1 shl (i-1)) and b)=0)

then b:=b+(1 shl (i-1)) else

if (((1 shl i) and b)=0) and (((1 shl (i-1)) and b)<>0)

then b:=b-(1 shl (i-1));

if ((1 shl 15) and b)<>0 then b:=b-(1 shl 15);

if odd(a) then b:=b+trunc(exp(15*ln(2)));

for i:=1 to 6 do {sar a}

if (((1 shl i) and a)<>0) and (((1 shl (i-1)) and a)=0)

then a:=a+(1 shl (i-1)) else

if (((1 shl i) and a)=0) and (((1 shl (i-1)) and a)<>0)

then a:=a-(1 shl (i-1));

if ((1 shl 6) and a)<>0 then a:=a-(1 shl 6);

end;

procedure Write_ab(a:shortint;b:word);

begin {вывод на экран двоичной записи}

for i:=7 downto 0 do

{ write(ord(((1 shl i) and a)<>0):2);

write('.');}

for i:=15 downto 0 do

write(ord(((1 shl i) and b)<>0):2);

Writeln(' ');

end;

procedure add(var a:integer;_b:integer); {сложение}

var t:integer;

p:word;

i:byte;

begin

p:=0;

T:=0;

for i:= 0 to 15 do {slogenie}

case ord(((1 shl i) and A)<>0)+ord(((1 shl i) and _B)<>0)+

ord(((1 shl i) and p)<>0) of

1:T:=T or trunc(exp(i*ln(2)));

2:p:=p or trunc(exp((i+1)*ln(2)));

3:begin

T:=T or trunc(exp(i*ln(2)));

p:=p or trunc(exp((i+1)*ln(2)));

end;

end;

A:=T;

end;

begin

while true do

begin

clrscr;

textcolor(13);

writeln('Ограничения:');

writeln('# Эта программа работает только с целыми числами, вводите их без знака');

writeln('# После ввода каждого исходного числа нажимайте Enter');

writeln('# Вывод результата на экран - в 2-байтовом поле, слева направо:');

writeln(' - не допускайте переполнения разрядной сетки!');

writeln(' - для знака результата бит не зарезервирован!');

writeln(' - в старших битах - переведенная в двоичный код целая часть результата!');

writeln(' - в остальных битах - дробная часть результата!');

writeln;

textcolor(15);

Writeln(' DELENIE S VOSSTANOVLENIEM OSTATKA ');

Writeln;

Write('A= ');

Readln(T);

write('bin:', ' ':3);

for k:=15 downto 0 do

write(ord(((1 shl k) and t) <>0):2);

writeln(' ');

if T<0 then z_a:=true; {знак}

T:=abs(T);

for i:=15 downto 0 do {представление в прямом коде}

if ord((1 shl i) and T)<>0 then A:=A + trunc(exp(i*ln(2)));

Write(#10#13,'B= ');

Readln(T);

write('bin:', ' ':3);

for k:=15 downto 0 do

write(ord(((1 shl k) and t) <>0):2);

writeln(' ');

if T<0 then z_b:=true;{знак}

T:=abs(T);

for i:=15 downto 0 do{представление в прямом коде}

if ord((1 shl i) and T)<>0 then B:=B + trunc(exp(i*ln(2)));

_B:=B;

if B>0 then _B:=_B + trunc(exp(15*ln(2))); {знак _B}

for i:=14 downto 0 do {инвертировать _B}

if ((1 shl i)and _B)=0 then

_B:=_B + (1 shl i) else _B:=_B - (1 shl i) ;

{перевод в дополнительный код}

inc(_B);

{вычисление целой части результата}

While A>=0 do begin

Add(A,_B);

if A>=0 then c:=c+1;

end;

{деление с восстановлением остатка}

Add(A,B);

for i:=1 to N do begin

for j:=14 downto 0 do {shl A}

if (((1 shl j) and A)<>0) and (((1 shl (j+1)) and A)=0)

then A:=A+(1 shl (j+1)) else

if (((1 shl j) and A)=0) and (((1 shl (j+1)) and A)<>0)

then A:=A-(1 shl (j+1));

if odd(A) then dec(A);

ADD(A,_B); {А-В}

if A >= 0 then C:=C + exp((-i)*ln(2)) {Сi=1}

else ADD(A,B); {А+В}

end;

if z_a xor z_b then c:=-c; {знак результата}

Writeln(#10#13,'C= ',c:N+4:N);

r:=C;

a_h:=abs(trunc(r));

if r<0 then a_h:=a_h + trunc(exp(7*ln(2)));

r:=frac(r);

i:=15;

while (r<>0) and (i<>0) do

begin

r:=r*2;

if trunc(r) <>0 then a_l:=a_l + trunc(exp(i*ln(2)));

dec(i);

r:=frac(r);

end;

for i:=6 downto 0 do {нахождение порядка числа a}

if ord((1 shl i) and a_h)<>0 then begin p_a:=i+1; break; end;

{перевод в формат с плавающей точкой}

m:=p_a;

while m<>0 do begin shr_ab(a_h,a_l); dec(m); end;

a_h:=a_h+p_a;

Write_ab(a_h,a_l);

a_h:=0; a_l:=0; b_h:=0; b_l:=0; c_h:=0; c_l:=0;

p_a:=0; p_b:=0; m:=0; C:=0; p:=0; r:=0;

T:=0; k:=0; A:=0; B:=0; _B:=0;

z_a:=true; z_b:=true;

gotoxy(30,25);

textcolor(15);

writeln('Нажмите: Enter - чтобы продолжить и ');

write(' 1 - чтобы выйти');

d:=readkey;

if (d='1') then halt;

end;

end.