Prev: (Advanced) CopyBits routine (Skybuck Entry 1, bugged)
Next: International Distributors
From: Skybuck Flying on 3 Jan 2008 08:46
Ok,

It was a display issue, thank god for that LOL.

Now that a first version has been made, if any future/alternative versions
are made a benchmark program could be made to benchmark the speed of the
different versions.

Assuming this first version is correct, the first version could be used to
verify alternative implementations with a more thorough test/verification
program which will have to be made as well ;)

For now I can use this simple/lazy version to proceed, though probably be it
slowly ;) =D

// *** Begin of Code ***

program Project1;

{$APPTYPE CONSOLE}

{

Skybuck's (Advanced) CopyBits Entry 1

Version 0.01 created on 3 january 2008 by Skybuck Flying.

Code copy & pasted from other projects, main code is new as well as CopyBits
routine

Something strange is going on according to the main code/demonstration code.

Bits are copied weird.

Don't know yet what is going on. Could be a pretty serious (dumb ?) bug
somewhere ;)

Amazing and strange...

Ok, it was a display issue.

Bits were being display in little endian format.

Bits now displayed in big endian format for nice displaying from zero to
N-1.

}

uses
SysUtils;

procedure SetBit( BaseAddress : pointer; BitIndex : longword );
asm
bts [eax], edx
end;

procedure ClearBit( BaseAddress : pointer; BitIndex : longword );
asm
btr [eax], edx
end;

function GetBit( BaseAddress : pointer; BitIndex : longword ) : boolean;
asm
mov result, false
bt [eax], edx
jnc @exit
mov result, true
@exit:
end;

// 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;

procedure CopyBits(
SourceBase : pointer;
SourcePosition : integer;

DestBase : pointer;
DestPosition : integer;

BitsToCopy : integer );
var
vLoop : integer;
begin
for vLoop := 0 to BitsToCopy-1 do
begin
if GetBit( SourceBase, SourcePosition ) then
begin
SetBit(DestBase, DestPosition);
end else
begin
ClearBit(DestBase, DestPosition);
end;

SourcePosition := SourcePosition + 1;
DestPosition := DestPosition + 1;
end;
end;


procedure Main;
var
InputArray : array of byte;
OutputArray : array of byte;
vIndex : integer;
begin
writeln('program started');

SetLength( InputArray, 10 );
SetLength( OutputArray, 10 );

InputArray[0] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;
InputArray[1] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;
InputArray[2] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;
InputArray[3] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;
InputArray[4] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;
InputArray[5] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;
InputArray[6] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;
InputArray[7] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;
InputArray[8] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;
InputArray[9] := 0 + 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128;


{
InputArray[0] := 0;
InputArray[1] := 1;
InputArray[2] := 2;
InputArray[3] := 4;
InputArray[4] := 8;
InputArray[5] := 16;
InputArray[6] := 32;
InputArray[7] := 64;
InputArray[8] := 128;
InputArray[9] := 0;
}

FillChar( OutputArray[0], 10, 0 + 1 + 4 + 16 + 64 );
// FillChar( pointer(@OutputArray[0])^, 10, 0 );

writeln('InputArray before copybits: ');
for vIndex := 0 to 9 do
begin
WriteBitPattern( InputArray[vIndex] );
// Write( ' ' );
end;
writeln;

writeln('OutputArray before copybits: ');
for vIndex := 0 to 9 do
begin
WriteBitPattern( OutputArray[vIndex] );
// Write( ' ' );
end;
writeln;

CopyBits( @InputArray[0], 55, @OutputArray[0], 66, 10 );

writeln('InputArray after copybits: ');
for vIndex := 0 to 9 do
begin
WriteBitPattern( InputArray[vIndex] );
// Write( ' ' );
end;
writeln;

writeln('OutputArray after copybits: ');
for vIndex := 0 to 9 do
begin
WriteBitPattern( OutputArray[vIndex] );
// Write( ' ' );
end;
writeln;

OutputArray := nil;
InputArray := nil;

writeln('program finished');
end;

begin
try
Main;
{ TODO -oUser -cConsole Main : Insert code here }
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
writeln('press enter to exit');
readln;
end.

{

Undesired output:

(Output is in BigEndian)

program started
InputArray before copybits:
11111111111111111111111111111111111111111111111111111111111111111111111111111111

OutputArray before copybits:
01010101010101010101010101010101010101010101010101010101010101010101010101010101

InputArray after copybits:
11111111111111111111111111111111111111111111111111111111111111111111111111111111

OutputArray after copybits:
01010101010101010101010101010101010101010101010101010101010101011111110101011111

^ ? ^ ?
program finished
press enter to exit

}

{

Desired output:

(Output is in LittleEndian)

program started
InputArray before copybits:
11111111111111111111111111111111111111111111111111111111111111111111111111111111

OutputArray before copybits:
10101010101010101010101010101010101010101010101010101010101010101010101010101010

InputArray after copybits:
11111111111111111111111111111111111111111111111111111111111111111111111111111111

OutputArray after copybits:
10101010101010101010101010101010101010101010101010101010101010101011111111111010

program finished
press enter to exit

}

// *** End of Code ***

Bye,
Skybuck.


 | 
Pages: 1
Prev: (Advanced) CopyBits routine (Skybuck Entry 1, bugged)
Next: International Distributors