Prev: Skybuck presents RotateLeft and RotateRight routines.
Next: Wanna do a WriteLongwordBits contest ? (Skybuck's Fourth Entry: Lightning Fast A1B1)
From: Skybuck Flying on 5 May 2008 11:44
Hello,

Skybuck presents:

KeepLowBits and KeepHighBits functions.

Visual inspection/verification program included ! ;)

// *** Begin of Code ***

program Project1;

{$APPTYPE CONSOLE}

{

Skybuck presents KeepLowBits and KeepHighBits

Version 0.01 created on 5 may 2008 by Skybuck Flying

Correct implementations this time.

Functions to keep original values could come in handy.

Visual Inspection/Verification program.

}

uses
SysUtils,
Windows;

// make overloaded versions for easy coding
// display in big endian.
procedure WriteBitPattern( const ParaByte : byte ); overload;
type
TbitRange = 0..7;
TbitSet = set of TbitRange;
var
vBit : TbitRange;
begin
for vBit:= 0 to 7 do
begin
if vBit in TbitSet(ParaByte) then
begin
write('1');
end else
begin
write('0');
end;
end;
end;

procedure WriteBitPattern( const ParaWord : word ); overload;
type
TbitRange = 0..15;
TbitSet = set of TbitRange;
var
vBit : TbitRange;
begin
for vBit:= 0 to 15 do
begin
if vBit in TbitSet(ParaWord) then
begin
write('1');
end else
begin
write('0');
end;
end;
end;

procedure WriteBitPattern( const ParaLongWord : longword ); overload;
type
TbitRange = 0..31;
TbitSet = set of TbitRange;
var
vBit : TbitRange;
begin
for vBit:= 0 to 31 do
begin
if vBit in TbitSet(ParaLongWord) then
begin
write('1');
end else
begin
write('0');
end;
end;
end;

function KeepLowBits( Value : longword; Bits : longword ) : longword;
begin
Result := Value; // 32 bits case.
if Bits <= 31 then
begin
Result := Result and not (4294967295 shl Bits); // shl instruction limited
to 31.
end;
end;

{

8 instructions:

Project1.dpr.85: if Bits <= 31 then
00408FA4 83FA1F cmp edx,$1f
00408FA7 770B jnbe $00408fb4
Project1.dpr.87: Result := Result and not (4294967295 shl Bits); // shl
instruction limited to 31.
00408FA9 8BCA mov ecx,edx
00408FAB 83CAFF or edx,-$01
00408FAE D3E2 shl edx,cl
00408FB0 F7D2 not edx
00408FB2 23C2 and eax,edx
Project1.dpr.89: end;
00408FB4 C3 ret

}

function KeepHighBits( Value : longword; Bits : longword ) : longword;
begin
Result := Value; // 32 bits case.
if Bits <= 31 then // 0 to 31 bits case.
begin
Result := Result and not (4294967295 shr Bits); // shr instruction limited
to 31.
end;
end;

{

8 instructions:

Project1.dpr.94: if Bits <= 31 then // 0 to 31 bits case.
00408FB8 83FA1F cmp edx,$1f
00408FBB 770B jnbe $00408fc8
Project1.dpr.96: Result := Result and not (4294967295 shr Bits); // shr
instruction limited to 31.
00408FBD 8BCA mov ecx,edx
00408FBF 83CAFF or edx,-$01
00408FC2 D3EA shr edx,cl
00408FC4 F7D2 not edx
00408FC6 23C2 and eax,edx
Project1.dpr.98: end;
00408FC8 C3 ret

}


procedure Main;
var
vValue : longword;
vBits : longword;
vResult : longword;
begin
// Test KeepHighBits

writeln('Press enter to test KeepHighBits maximum value');
readln;

// test maximum value
vValue := 4294967295;
for vBits := 0 to 33 do // go over to see what happens ;) ok no problemo
begin
vResult := KeepHighBits( vValue, vBits );
Writeln( 'KeepHighBits Value: ', vValue, ' Bits: ', vBits, ' Result: ',
vResult );
WriteBitPattern( vValue ); WriteLn;
WriteLn( '21098765432109876543210987654321');
WriteBitPattern( vResult ); WriteLn;
end;

writeln('Press enter to test KeepHighBits minimum value');
readln;

// test minimum value
vValue := 0;
for vBits := 0 to 33 do // go over to see what happens ;) ok no problemo
begin
vResult := KeepHighBits( vValue, vBits );
Writeln( 'KeepHighBits Value: ', vValue, ' Bits: ', vBits, ' Result: ',
vResult );
WriteBitPattern( vValue ); WriteLn;
WriteLn( '21098765432109876543210987654321');
WriteBitPattern( vResult ); WriteLn;
end;

writeln('Press enter to test KeepHighBits random value');
readln;

// test random value
vValue := GetTickCount;
for vBits := 0 to 33 do // go over to see what happens ;) ok no problemo
begin
vResult := KeepHighBits( vValue, vBits );
Writeln( 'KeepHighBits Value: ', vValue, ' Bits: ', vBits, ' Result: ',
vResult );
WriteBitPattern( vValue ); WriteLn;
WriteLn( '21098765432109876543210987654321');
WriteBitPattern( vResult ); WriteLn;
end;

// Test KeepLowBits

writeln('Press enter to test KeepLowBits maximum value');
readln;

// test maximum value
vValue := 4294967295;
for vBits := 0 to 33 do // go over to see what happens ;) ok no problemo
begin
vResult := KeepLowBits( vValue, vBits );
Writeln( 'KeepLowBits Value: ', vValue, ' Bits: ', vBits, ' Result: ',
vResult );
WriteBitPattern( vValue ); WriteLn;
WriteLn( '12345678901234567890123456789012');
WriteBitPattern( vResult ); WriteLn;
end;

writeln('Press enter to test KeepHighBits minimum value');
readln;

// test minimum value
vValue := 0;
for vBits := 0 to 33 do // go over to see what happens ;) ok no problemo
begin
vResult := KeepLowBits( vValue, vBits );
Writeln( 'KeepLowBits Value: ', vValue, ' Bits: ', vBits, ' Result: ',
vResult );
WriteBitPattern( vValue ); WriteLn;
WriteLn( '12345678901234567890123456789012');
WriteBitPattern( vResult ); WriteLn;
end;

writeln('Press enter to test KeepHighBits random value');
readln;

// test random value
vValue := GetTickCount;
for vBits := 0 to 33 do // go over to see what happens ;) ok no problemo
begin
vResult := KeepLowBits( vValue, vBits );
Writeln( 'KeepLowBits Value: ', vValue, ' Bits: ', vBits, ' Result: ',
vResult );
WriteBitPattern( vValue ); WriteLn;
WriteLn( '12345678901234567890123456789012');
WriteBitPattern( vResult ); WriteLn;
end;
writeln('done');
end;

begin
try
Main;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
readln;
end.

// *** End of Code ***

Bye,
Skybuck =D


 | 
Pages: 1
Prev: Skybuck presents RotateLeft and RotateRight routines.
Next: Wanna do a WriteLongwordBits contest ? (Skybuck's Fourth Entry: Lightning Fast A1B1)