Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2011.05.08;
Скачать: [xml.tar.bz2];

Вниз

Преобразование Byte в Word?   Найти похожие ветки 

 
ZV ©   (2011-01-26 17:04) [0]

Как в Delphi  преобразовать 2 значения Byte в Word. На Си делаю побитовый сдвиг и наложение маски а как это сделать в Delphi? Может есть какая функция или делать так же как и на Си. Может кто покажет пример?


 
sniknik ©   (2011-01-26 17:19) [1]

> Может кто покажет пример?
w:= b;


 
Германн ©   (2011-01-26 17:21) [2]

1. Word1:=Byte1+(Byte2 shl 8)
2. type
 TMyWord = packed record
   case Integer of
     0 : (Byte1, Byte2 : Byte);
     1 : (Word1 : Word);
   end;


 
12 ©   (2011-01-26 17:33) [3]

var
 w:Word;
 b1, b2:Byte;
begin
 b1 := 0;
 b2 := 1;
 asm
   push ax
   mov al, b1
   mov ah, b2
   mov w, ax
   pop ax
 end;
 ShowMessage( IntToStr(w) );


 
sniknik ©   (2011-01-26 17:55) [4]

и еще на конкурс извращенцев...
procedure TForm1.Button1Click(Sender: TObject);
var
 w: Word;
 b: byte absolute w;
begin
 w:= 0;
 b:= $FF;
 ShowMessage(IntToStr(w));
end;


 
Игорь Шевченко ©   (2011-01-26 18:17) [5]


> Может есть какая функция или делать так же как и на Си.


а как на С сделано ?


 
Германн ©   (2011-01-26 18:20) [6]


> sniknik ©   (26.01.11 17:55) [4]
>
> и еще на конкурс извращенцев...

Не проходит по условию. Нужно два байта. :)


 
ZV ©   (2011-01-26 19:11) [7]


> а как на С сделано ?


unsigned int word;
unsigned char Ah, Bl;
Word=Ah;
word=(word<<8)|Bl;


То же на Delphi -  Word1:=Byte1+(Byte2 shl 8) (1 вариант от Германн)
нормально работает


 
DiamondShark ©   (2011-01-26 19:26) [8]

мне бы ваши проблемы


 
sniknik ©   (2011-01-26 19:28) [9]

> Не проходит по условию. Нужно два байта. :)
блин, упустил почему то, и получается фигню нес...
тогда так
var
 w: Word;
 b: array[0..1] of byte absolute w;
begin
 b[0]:= 1;
 b[1]:= 1;
 ShowMessage(IntToStr(w));
end;


 
DiamondShark ©   (2011-01-26 19:36) [10]

const
Q: array[byte,byte] of word = (
(0,1,2,3 ... 255),
(256, 257 ... 511)
...
(65280, ... ,65535)
);

w := Q[b1, b2];


 
sniknik ©   (2011-01-26 19:48) [11]

ну или тот же код что в [9] по мотивам asm ([3])
var
 w: Word;
begin
 asm
   mov byte ptr w[0], $01
   mov byte ptr W[1], $01
 end;
 ShowMessage(IntToStr(w));
end;


 
Студент   (2011-01-27 04:42) [12]

Занятно...))

А поясните пожалуйста "case Integer of" в record (кстати packed ни разу не пригодился, остаётся тож самое)?

А какой будет самым быстрым? Случайно не [10]?


 
KilkennyCat ©   (2011-01-27 04:55) [13]

strtoint(inttostr(b1) +inttostr(b2))


 
Студент   (2011-01-27 05:39) [14]

Ну... Вот с "Hex" такое бы сработало...


 
Inovet ©   (2011-01-27 05:45) [15]

> [12] Студент   (27.01.11 04:42)
> А какой будет самым быстрым?

Самый быстрый, который ничего не делает - с рекордом и с массивом, а [10] - это явный кандидат в победители на конкурсе извращенцев.:)))


 
Студент   (2011-01-27 06:50) [16]

Скомпилировал [10]... Неправильно считает... Нужно как-то по другому заполнять масив...
Про [11] говорит мол "Invalid combination of opcode and operands" если пытаться пременную подставить...((
У [13] результат неверный... Нужно через Hex: Word1:=HexToInt(IntToHex(Byte2, 2)+IntToHex(Byte1, 2));


 
Студент   (2011-01-27 06:51) [17]

Чуть не забыл:

procedure TForm1.Button8Click(Sender: TObject);
var i: Integer; S: String;
begin
S:="((0, ";
For i:=1 To 65534 Do
     Begin
     If (i mod 256)=0 Then
           S:=S+"),"#13#10"("+IntToStr(i)+", "
     Else
           If ((i+1) mod 256)=0 Then
                 S:=S+IntToStr(i)
           Else
                 S:=S+IntToStr(i)+", ";
     If (i mod 100)=0 Then
           S:=S+#13#10;
     End;
S:=S+"65535));";
Memo1.Text:=S;
end;


Да, я дурак..... %))


 
han_malign   (2011-01-27 08:41) [18]


> А какой будет самым быстрым? Случайно не [10]?

- случайно:
Германн ©   (26.01.11 17:21) [2]
1. Word1:=Byte1+(Byte2 shl 8)

- т.к. нет лишних обращений к памяти, а таких регистровых операций - современные CPU хавают по десятку за такт...
Недаром девиз Мелкомягких - "Все что можно пересчитать - лучше не хранить"...


 
RWolf ©   (2011-01-27 09:25) [19]


> Inovet ©   (27.01.11 05:45) [15]
> > [12] Студент   (27.01.11 04:42)> А какой будет самым быстрым?
> Самый быстрый, который ничего не делает - с рекордом и с
> массивом,

Самый быстрый — это сдвиг + OR.


 
Игорь Шевченко ©   (2011-01-27 10:30) [20]


> - т.к. нет лишних обращений к памяти, а таких регистровых
> операций - современные CPU хавают по десятку за такт...


обычно подобные утверждения подкрепляются тестовыми измерениями.


> Недаром девиз Мелкомягких - "Все что можно пересчитать -
>  лучше не хранить"...


кто не работает - не ест, ты спутал, батя


 
Германн ©   (2011-01-27 15:10) [21]


> han_malign   (27.01.11 08:41) [18]
>
>
> > А какой будет самым быстрым? Случайно не [10]?
>
> - случайно:
> Германн ©   (26.01.11 17:21) [2]
> 1. Word1:=Byte1+(Byte2 shl 8)
>
> - т.к. нет лишних обращений к памяти, а таких регистровых
> операций - современные CPU хавают по десятку за такт...
>

Хорошо подумал прежде чем написать такую чушь?
Нахрена нужны какие-то "операции" для того, чтобы всего лишь расположить два байта рядом в памяти???


 
han_malign   (2011-01-27 17:40) [22]


> ты спутал, батя

- я изредка брежу, но редко путаю:program hilo_word;
{$APPTYPE CONSOLE}
{$IF CompilerVersion >= 15.0}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$IFEND}
uses
 Windows, SysUtils;

const repeatCount = 10;

type
  TLoHiWord = packed record
  case Integer of
    0 : (Lo, Hi : Byte);
    1 : (value : Word);
  end;

  PByteArray = ^TByteArray;
  TByteArray = array[word]of byte;
  PWordArray = ^TWordArray;
  TWordArray = array[word]of TLoHiWord;

var _ft_start: TFileTime;
procedure _startProfile;
var _ftDumb: TFileTime;
begin
  GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_start);

end;
procedure _stopProfile(const title: string);
var _ft_end, _ftDumb: TFileTime;
begin
  GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_end);
  WriteLn(title:10,": ", _ft_end.dwHighDateTime - _ft_start.dwHighDateTime, ".", _ft_end.dwLowDateTime - _ft_start.dwLowDateTime:10, " x 100ns" );
end;

var rgwLookup: array[byte,byte]of word;
var
   pbl, pbh: PByteArray;
   pw: PWordArray;
   alloc, base, i, cnt: cardinal;
   si: TSystemInfo;
begin
  alloc:= 0;
  if( ParamCount > 0 )then alloc:= StrToIntDef(ParamStr(1), 0);
  if( alloc = 0 )then alloc:= 1024*1024*1024;

  GetSystemInfo(si);
  inc(alloc, cardinal(-alloc) mod si.dwAllocationGranularity);

  pbl:= PByteArray(VirtualAlloc(nil, alloc, MEM_COMMIT, PAGE_READWRITE));
  if( pbl = nil )then begin
     Writeln("Alloc failed - ", GetLastError());
  end;
  //prepare lookup table
  for i:= 0 to $FFFF do PWordArray(@rgwLookup)[i].value:= i;

  base:= alloc div 4;
  Write("GO"#13);
  _startProfile;
  for cnt:= 1 to repeatCount do begin
     for i:= 0 to base - 1 do PWordArray(pbl)[i].value:= Random(65536);
     Write(cnt:2,#13);
  end;
  _stopProfile("Random");

  pbh:= PByteArray(@pbl[base]);
  pw:= PWordArray(@pbh[base]);

  _startProfile;
  for cnt:= 1 to repeatCount do begin
     for i:= 0 to base - 1 do pw[i].value:= (pbh[i] shl 8) or pbl[i];
     Write(cnt:2,#13);
  end;
  _stopProfile("Combine");

  _startProfile;
  for cnt:= 1 to repeatCount do begin
     for i:= 0 to base - 1 do with pw[i] do begin
        lo:= pbl[i];
        hi:= pbh[i];
     end;
     Write(cnt:2,#13);
  end;
  _stopProfile("Direct");

  _startProfile;
  for cnt:= 1 to repeatCount do begin
     for i:= 0 to base - 1 do pw[i].value:= rgwLookup[pbl[i], pbh[i]];
     Write(cnt:2,#13);
  end;
  _stopProfile("Lookup");

  _startProfile;
  for cnt:= 1 to repeatCount do begin
     move(pbl^, pw^, base*2);
     Write(cnt:2,#13);
  end;
  _stopProfile("just copy");

  VirtualFree(pbl, 0, MEM_RELEASE);
end.

-----------------------------------------------------
   Random: 0. 106406250 x 100ns
  Combine: 0.  52500000 x 100ns
   Direct: 0.  55781250 x 100ns
   Lookup: 0.  91406250 x 100ns
just copy: 0.  33125000 x 100ns


 
Игорь Шевченко ©   (2011-01-27 18:12) [23]

Я несколько изменил порядок тестов

  Combine: 0.  13437500 x 100ns
just copy: 0.   7031250 x 100ns
   Lookup: 0.  15156250 x 100ns
   Random: 0.  25625000 x 100ns
   Direct: 0.  13281250 x 100ns


 
Игорь Шевченко ©   (2011-01-27 18:13) [24]

program BtoWProfile;
{$APPTYPE CONSOLE}
{$IF CompilerVersion >= 15.0}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$IFEND}
uses
 Windows,
 SysUtils;

const repeatCount = 10;

type
 TLoHiWord = packed record
 case Integer of
   0 : (Lo, Hi : Byte);
   1 : (value : Word);
 end;

 PByteArray = ^TByteArray;
 TByteArray = array[word]of byte;
 PWordArray = ^TWordArray;
 TWordArray = array[word]of TLoHiWord;

var _ft_start: TFileTime;
procedure _startProfile;
var _ftDumb: TFileTime;
begin
 GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_start);

end;
procedure _stopProfile(const title: string);
var _ft_end, _ftDumb: TFileTime;
begin
 GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_end);
 WriteLn(title:10,": ", _ft_end.dwHighDateTime - _ft_start.dwHighDateTime, ".", _ft_end.dwLowDateTime - _ft_start.dwLowDateTime:10, " x 100ns" );
end;

var rgwLookup: array[byte,byte]of word;
var
  pbl, pbh: PByteArray;
  pw: PWordArray;
  alloc, base, i, cnt: cardinal;
  si: TSystemInfo;
begin
 alloc:= 0;
 if( ParamCount > 0 )then alloc:= StrToIntDef(ParamStr(1), 0);
 if( alloc = 0 )then alloc:= 256*1024*1024;

 GetSystemInfo(si);
 inc(alloc, cardinal(-alloc) mod si.dwAllocationGranularity);

 pbl:= PByteArray(VirtualAlloc(nil, alloc, MEM_COMMIT, PAGE_READWRITE));
 if( pbl = nil )then begin
    Writeln("Alloc failed - ", GetLastError());
 end;
 //prepare lookup table
 for i:= 0 to $FFFF do PWordArray(@rgwLookup)[i].value:= i;

 base:= alloc div 4;
 Write("GO"#13);
 
 pbh:= PByteArray(@pbl[base]);
 pw:= PWordArray(@pbh[base]);

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    for i:= 0 to base - 1 do pw[i].value:= (pbh[i] shl 8) or pbl[i];
    Write(cnt:2,#13);
 end;
 _stopProfile("Combine");

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    move(pbl^, pw^, base*2);
    Write(cnt:2,#13);
 end;
 _stopProfile("just copy");

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    for i:= 0 to base - 1 do pw[i].value:= rgwLookup[pbl[i], pbh[i]];
    Write(cnt:2,#13);
 end;
 _stopProfile("Lookup");

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    for i:= 0 to base - 1 do PWordArray(pbl)[i].value:= Random(65536);
    Write(cnt:2,#13);
 end;
 _stopProfile("Random");

 _startProfile;
 for cnt:= 1 to repeatCount do begin
    for i:= 0 to base - 1 do with pw[i] do begin
       lo:= pbl[i];
       hi:= pbh[i];
    end;
    Write(cnt:2,#13);
 end;
 _stopProfile("Direct");

 VirtualFree(pbl, 0, MEM_RELEASE);
end.


 
han_malign   (2011-01-27 18:27) [25]


>    Lookup: 0.  15156250 x 100ns
>    Random: 0.  25625000 x 100ns

- молодец, но даже учитывая, что тест всегда обращается к rgwLookup[0, 0], поскольку память инициализирована нулями - таблица все равно самый плохой вариант...


 
han_malign   (2011-01-27 18:33) [26]

и естественно - все Page Fault достались Combine...


 
Игорь Шевченко ©   (2011-01-27 18:39) [27]


> и естественно - все Page Fault достались Combine...


отсюда возникает вопрос - что тестируем ?


 
Inovet ©   (2011-01-27 19:54) [28]

> [18] han_malign   (27.01.11 08:41)

> [19] RWolf ©   (27.01.11 09:25)
> Самый быстрый — это сдвиг + OR.

Это в произвольном случае, а когда надо всё время и так и так обращаться, то лучше ничего не делать а сразу организовать хранение рядом, я об этом говорил. Хотя как оно там будет на каком железе должно

> [20] Игорь Шевченко ©   (27.01.11 10:30)
> подкрепляются тестовыми измерениями


 
han_malign   (2011-01-28 09:02) [29]


> отсюда возникает вопрос - что тестируем ?

- вы ничего не тестируете, поскольку подбираете условия по каким то выгодным вам критериям...

Между прочим, если совсем исключить из теста Combine инициализацию страниц памяти нулем при первом обращении(заполнив Random-ом всю выделенную память, а не первую половину) - отрыв еще больше увеличивается...

З.Ы. Самое прикольное это - rgwLookup[Hi, Lo] - как по вашему вычисляется смещение, если адресная арифметика поддерживает только масштабы 1, 2, 4, 8...


 
12 ©   (2011-01-28 09:44) [30]


> han_malign   (27.01.11 17:40) [22]


> Игорь Шевченко ©   (27.01.11 18:13) [24]

вы - маньяки :)


 
han_malign   (2011-01-28 09:45) [31]

И о главном: почему опасно пользоваться приведением типа для доступа к битовым полям(в Delphi, в C - все порадужней), и когда таблица таки выгодна...
(посвящается структуре TRGBQuad)
program hilo_word;
{$APPTYPE CONSOLE}
{$IF CompilerVersion >= 15.0}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$IFEND}
uses
 Windows, SysUtils;

const repeatCount = 10;

type
  TLoHiWord = packed record
  case Integer of
    0 : (Lo, Hi : Byte);
    1 : (value : Word);
  end;
  PLoHiWord = ^TLoHiWord;

  PByteArray = ^TByteArray;
  TByteArray = array[word]of byte;
  PWordArray = ^TWordArray;
  TWordArray = array[word]of word;

var _ft_start: TFileTime;
procedure _startProfile;
var _ftDumb: TFileTime;
begin
  GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_start);

end;
procedure _stopProfile(const title: string);
var _ft_end, _ftDumb: TFileTime;
begin
  GetThreadTimes(GetCurrentThread(), _ftDumb, _ftDumb, _ftDumb, _ft_end);
  WriteLn(title:10,": ", _ft_end.dwHighDateTime - _ft_start.dwHighDateTime, ".", _ft_end.dwLowDateTime - _ft_start.dwLowDateTime:10, " x 100ns" );
end;

function TRANSFORM(val: word): word;
begin
  //ну пускай будет BGR16 в BGR15
  Result:= val and $1F or (val shr 1) and $7FE;
end;

const _title: array[0..2]of string = ("Combine", "Cast", "Map");

var rgwLookup: array[byte,byte]of word;
var
   pbl, pbh: PByteArray;
   pw: PWordArray;
   alloc, base, i, cnt: cardinal;
   si: TSystemInfo;
   _b2w: TLoHiWord;
   choice: integer;
   _hitChoice: array[0..2]of integer;
   fdwDoneChoice: LongWord;
begin
  alloc:= 0;
  if( ParamCount > 0 )then alloc:= StrToIntDef(ParamStr(1), 0);
  if( alloc = 0 )then alloc:= 1024*1024*1024;

  GetSystemInfo(si);
  inc(alloc, cardinal(-alloc) mod si.dwAllocationGranularity);

  pbl:= PByteArray(VirtualAlloc(nil, alloc, MEM_COMMIT, PAGE_READWRITE));
  if( pbl = nil )then begin
     Writeln("Alloc failed - ", GetLastError());
  end;
  //prepare lookup table
  for i:= 0 to $FFFF do PWordArray(@rgwLookup)[i]:= TRANSFORM(i);

  base:= alloc div 4;
  Write("GO"#13);
  _startProfile;
  for i:= 0 to base*2 - 1 do PWordArray(pbl)[i]:= Random(65536);
  _stopProfile("Random");

  pbh:= PByteArray(@pbl[base]);
  pw:= PWordArray(@pbh[base]);

  FillChar(_hitChoice, sizeof(_hitChoice), 0);
  fdwDoneChoice:= 0;

  while( fdwDoneChoice <> 7 )do begin
     //дабы никому не пришло в голову упрекнуть меня в предвзятости
     choice:= Random(3);
     inc(_hitChoice[choice]);
     if( _hitChoice[choice] > 2 )then fdwDoneChoice:= fdwDoneChoice or (1 shl choice);
     _startProfile;
     for cnt:= 1 to repeatCount do begin
        case(choice)of
        0: for i:= 0 to base - 1 do pw[i]:= TRANSFORM((pbh[i] shl 8) or pbl[i]);
        1: for i:= 0 to base - 1 do with _b2w do begin
           lo:= pbl[i];
           hi:= pbh[i];
           pw[i]:= TRANSFORM(value);
        end;
        2: for i:= 0 to base - 1 do pw[i]:= rgwLookup[pbl[i], pbh[i]];
        end;
        Write(cnt:2,#13);
     end;
     _stopProfile(_title[choice]);
  end;

  VirtualFree(pbl, 0, MEM_RELEASE);
end.

--------------------------------------
     Cast: 0. 274687500 x 100ns
      Map: 0.  90000000 x 100ns
  Combine: 0. 141250000 x 100ns
  Combine: 0. 141250000 x 100ns
     Cast: 0. 275000000 x 100ns
     Cast: 0. 275000000 x 100ns
      Map: 0.  89843750 x 100ns
  Combine: 0. 141250000 x 100ns
      Map: 0.  90000000 x 100ns


 
RWolf ©   (2011-01-28 10:20) [32]

C:\>hilo_word.exe 67108864
   Random: 0.   2187500 x 100ns
  Combine: 0.  10781250 x 100ns
  Combine: 0.  10625000 x 100ns
  Combine: 0.  10468750 x 100ns
     Cast: 0.  19218750 x 100ns
  Combine: 0.  10468750 x 100ns
      Map: 0.  18593750 x 100ns
  Combine: 0.  10468750 x 100ns
     Cast: 0.  20156250 x 100ns
      Map: 0.  18593750 x 100ns
      Map: 0.  18437500 x 100ns
     Cast: 0.  19687500 x 100ns


Атлон64 3000+. Налицо двукратный выигрыш shl-or.
И почему вдруг в Дельфи опасно пользоваться приведением типа, и чем Дельфи в этом смысле отличается от Си?


 
RWolf ©   (2011-01-28 10:28) [33]

или смысл в том, чтобы загнать тест в свопы?


 
uniken1 ©   (2011-01-31 08:04) [34]


> и еще на конкурс извращенцев...

Интересно на какое место попадет функция
TwoByteToWord из Indy модуль(IdGlobal)? Собственный динамический массив с изменением размера и с двойным преобразованием.
Появляются подозрения, что Indy не очень-то оптимальна по производительности.


 
Anatoly Podgoretsky ©   (2011-01-31 08:48) [35]

> uniken1  (31.01.2011 08:04:34)  [34]

Лучше подумать, что курили разработчки и почему с нами не поделились


 
sniknik ©   (2011-01-31 09:28) [36]

> uniken1 ©   (31.01.11 08:04) [34]
если бы не динамический массив... не все так страшно, хотя предпочел бы типа (соглашения о передаче параметров из функции вроде неизменны) -

function TwoByteToWord(AByte1, AByte2: Byte): Word;
asm
  mov al, AByte1
  mov ah, AByte2
end;


> почему с нами не поделились
главный вопрос...


 
Anatoly Podgoretsky ©   (2011-01-31 11:22) [37]

> sniknik  (31.01.2011 09:28:36)  [36]

Правильно, главный, их код нам и нафиг не нужен.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2011.05.08;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.56 MB
Время: 0.006 c
15-1295442066
Бывший студент
2011-01-19 16:01
2011.05.08
Слово о Дворковиче


1-1253765391
Чипырик
2009-09-24 08:09
2011.05.08
Превью в TImage


15-1295351568
начинающий2
2011-01-18 14:52
2011.05.08
как можно создать такой класс?


11-1233446413
Thaddy
2009-02-01 03:00
2011.05.08
kolnmck.ru etc


15-1295739103
Грамотей
2011-01-23 02:31
2011.05.08
Где взять скомпилированные dll от ODE?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский