Динамічна пам'ять, принципи її організації і роботи

procedure DecToBin(n: Integer); { процедура перевода десятичного числа в массив битов}

var i: Integer;

begin

for i:=1 to 8 do ASymbol[i]:=0;

i:=8;

while n>1 do

begin

ASymbol[i]:=n mod 2;

n:=n div 2;

dec(i);

end;

ASymbol[i]:=n;

end;

function CheckCod: Integer; { Процедура проверки кода на наличие повреждения}

var i, j, n, Res:Integer; { возвращаемое значение - номер поврежденного бита}

begin { или 0, если код не поврежден}

for i:=0 to 7 do { определение количества контрольных битов}

if NHemCod<APower2[i] then

begin

NContr:=i;

Break;

end;

for i:=0 to NContr-1 do AContrSum[i]:=0; { обнуление контрольных сумм}

NCur:=0;

for i:=1 to NHemCod do

if i=APower2[NCur] then inc(NCur) { если номер бита - степень 2-ки, пропускаем его}

else if AHemCod[i]>0 then { иначе если бит - 1-ца прибавляем 1 к каждому}

begin { контрольному биту, контролирующий i-й, для чего}

n:=i; { раскладываем i по степеням двойки}

for j:=NContr-1 downto 0 do

if n>=APower2[j] then

begin

inc(AContrSum[j]);

n:=n-APower2[j];

end;

end;

Res:=0; { определение номера поврежденного бита по несовпавшим}

for i:=0 to NContr-1 do { контрольным суммам}

if (AContrSum[i] mod 2)<>AHemCod[APower2[i]] then Res:=Res+APower2[i];

CheckCod:=Res;

end;

Begin

ClrScr;

Writeln(' ПРОГРАММА ДЛЯ ПЕРЕВОДА СЛОВ В КОД ХЕМИНГА');

Write('Введите слово для кодирования (максимум - 10 букв):');

Readln(Slovo);

if Length(Slovo)<1 then { проверка наличия введенных символов}

begin

Writeln('Нужно ввести слово');

Halt;

end;

if Length(Slovo)>10 then { проверка длины слова}

begin

Writeln('Длина слова - не более 10 символов');

Halt;

end;

BinCod:='';

HemCod:='';

Write('ASCII-код слова: ');

for i:=1 to Length(Slovo) do

begin

Write(Ord(Slovo[i]), ' ');

{ перевод символа в ASCII-код}

DecToBin(Ord(Slovo[i])); { перевод символа в бинарный код}

for j:=1 to 8 do

ABinCod[(i-1)*8+j]:=ASymbol[j];

{ добавление бинарного кода символа к слову}

end;

Writeln;

NBinCod:=Length(Slovo)*8;

while ABinCod[1]=0 do { удаление лидирующих нулей в двоичном виде слова}

begin

for i:=1 to NBinCod-1 do ABinCod[i]:=ABinCod[i+1];

dec(NBinCod);

end;

Write('Бинарный код слова: ');

for i:=1 to NBinCod do Write(ABinCod[i]);

Writeln;

for i:=0 to 7 do AContrSum[i]:=0; { обнуление массивов}

for i:=1 to 88 do AHemCod[i]:=0;

i:=NBinCod;

j:=1;

NContr:=0;

while i>0 do { кодируем слово начиная с конца}

begin

if j=APower2[NContr] then inc(NContr) { если номер бита - степень 2-ки резервируем его для контрольного бита}

else if ABinCod[i]>0 then { записываем информационный бит, если он - 1-ца}

begin

AHemCod[j]:=1;

n:=j;

k:=0;

while n>1 do { увеличение контрольных сумм битов, контролирующих

j-й символ кодированной строки}

begin

if Odd(n) then inc(AContrSum[k]);

n:=n div 2;

inc(k);

end;

inc(AContrSum[k]);

dec(i);

end

else dec(i); { если инф. бит 0 - переходим на следующий без увеличения

контрольных сумм}

inc(j);

end;

NHemCod:=j-1; { длина кодированной последовательности}

for i:=0 to NContr-1 do if Odd(AContrSum[i]) then AHemCod[APower2[i]]:=1;

{ расчет значений контрольных битов по контрольным суммам}

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

Write('Код Хеминга слова: ');

for i:=NHemCod downto 1 do Write(AHemCod[i]);

Writeln;

Writeln;

Writeln('Изменяем 32-й бит в коде Хеминга');

if AHemCod[32]=1 then AHemCod[32]:=0

else AHemCod[32]:=1;

Write('Поврежденный код Хеминга: ');

for i:=NHemCod downto 1 do Write(AHemCod[i]);

Writeln;

n:=CheckCod; { определение поврежденного бита (если таковой есть)}

if n>NHemCod then { количество повреждений явно больше 1}

Writeln('По-видимому ошибок больше одной, декодирование невозможно')

else if n>0 then { вывод исправленного кода и сообщения об исправлении}

begin

if AHemCod[n]=0 then AHemCod[n]:=1 else AHemCod[n]:=0;

Writeln('Исправлен ', n, '-й бит');

Write('Исправленный код Хеминга: ');

for i:=NHemCod downto 1 do Write(AHemCod[i]);

Writeln;

end

else Writeln('Код верен. Исправления не требуется.');

Writeln;

End.