Помогите:битовые операции, Pascal

[TOSA]

используя только битовые операции написать функцию которая меняет местами соседние группы из четырех битов в заданном беззнаковом длинном целом числе.

вот что я набросал:

Код: Выделить всё

uses crt, math;
var Nfirst, Ntemp, Ntemp1, Nfirst1, Nfirst2:longint;
    binary:string;
    i,j,p,q,w,e,r:integer;


begin
             clrscr;
             writeln ('Vvedit''4uslo');
             readln (Nfirst);
             writeln;
             writeln;
             writeln ('Zadane 4uslo  ', Nfirst);
             Nfirst1:= Nfirst;
             Nfirst2:= Nfirst;
     for i:= 1 to 32 do
begin
Ntemp := Nfirst div 2;
j:= Nfirst mod 2;
Nfirst:= Ntemp;
write(j);
end;




             for q:=1 to 4 do
             begin
             p:= Nfirst1 shl 4;
            {begin
             p:= Nfirst1 shr 4;
             end;}
             end;


             for q:= 5 to 8 do
             begin
             p:= Nfirst1 shr 4;
             end;

           { for q:=17 to 20 do
             begin
             p:= Nfirst1 shr 4;
             end;

             for q:=25 to 28 do
             begin
             p:= Nfirst1 shr 4;
             end;

for q:=5 to 8 do
begin
p:=Nfirst2 shl 4;
end;

for q:=13 to 16 do
begin
p:=Nfirst2 shl 4;
end;

for q:=21 to 24 do
begin
p:=Nfirst2 shl 4;
end;

for q:=29 to 32 do
begin
p:=Nfirst2 shl 4;
end};

writeln;
writeln;
writeln ('P=     ' ,p );
for e:=1 to 32 do
begin
Ntemp1:=p div 2;
r:= p mod 2;
p:= Ntemp1;
write (r );
end;
readln;
end.

что не так ???

[Naeel Maqsudov]

1) longint - это не беззнаковое целое
беззнаковые целые это -
byte 0..255
word 0..65535
Остальные беззнаковые целые зависят от версии Pascal. Так что уточните с каким Паскалем имеете дело?

2)
Не нужно переводить число в жвоичную систему. Просто Readln(X) и все - сразу выполняйте операции над битами числа X

3)
В задании сказано: "написать функцию", - что обычно подразумевает все-таки объявление собственной функции, а уж потом ее вызовы.

[TOSA]

версия BP 7.

не могу зделать ету замену... точнее разделить на группы замену делать легко

сдвигами влево и вправо...

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

thx.

[airyashov]

Код: Выделить всё

uses crt;
var X,Res,temp:longint;
    MyByte,g:Byte;
    i,j:integer;

Procedure WriteBin(c:longint);
  var i,j:integer;
begin
  for i:= 0 to 3 do begin
    for j:= 0 to 7 do begin
      Write(c mod 2);
      c:=c div 2;
    end;
    write(' ');
  end;
end;

begin
  clrscr;
  writeln ('Vvedit''4uslo');
  readln (X);
  writeln;
  writeln ('Zadane 4uslo  ', X);

  WriteBin(X);

  writeln;
  Res:=0;
  for i:=3 downto 0 do begin
    MyByte:=X SHR (i*8);

    Res:=Res OR ( ((MyByte SHL 4) OR (MyByte SHR 4)) AND $ff );
    if i<>0 then Res:=Res SHL 8;

  end;

  Writeln;
  WriteBin(Res);
  readln;
end.

[TOSA]

thx... very n1n3.

[TOSA]

Разработать рекурсивную функцию которая выделяет определенную цифру от 0 до 9 из десятичной записи натурального числа и выводит ее на экран. На основе разработанной функции вывести на экран десятичную запись заданных натуральных чисел а) в зворотнему порядке бы) в прямом начиная со старших разрядов дополнительно разработать не рекурсивный вариант.


ето не рекурсивный вариант

Код: Выделить всё

uses crt, math;
var a, rez_od1, rez_des1, rez_des2, rez_sot1, rez_sot2, rez_tus:integer;
begin
clrscr;
writeln('Vvedit chuslo vid 0 do 999: ');
readln(a);
if a < 10 then
begin
rez_od1:=a;
writeln('Odunuci ',rez_od1);
end;
if (a>=10) and (a<100) then
begin
rez_od1:=a mod 10;
writeln('Odunuci = ', rez_od1);
rez_des1:= a div 10;
writeln('Desjati =', rez_des1);
end;
if (a>=100) and (a<1000) then
begin
rez_od1:= a mod 10;
writeln('Odunuci = ', rez_od1);
writeln;
rez_des1 := a div 10;
rez_des2 := rez_des1 mod 10;
writeln('Desjati = ', rez_des2);
writeln;
rez_sot1 := a div 100;
{rez_sot2 := rez_sot1 div 10;}
writeln('Soti = ', rez_sot1);
writeln;
end;
readln;
{readln;}
end.

нужна помощь с рекурсивным...

[TOSA]

up!

need help!