mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 08:28:08 +02:00
281 lines
6.7 KiB
ObjectPascal
281 lines
6.7 KiB
ObjectPascal
{$mode macpas}
|
|
|
|
{$r-}
|
|
|
|
procedure error(l: longint);
|
|
begin
|
|
writeln('error near ',l);
|
|
halt(1);
|
|
end;
|
|
|
|
procedure test8bit;
|
|
type
|
|
ta = 0..1;
|
|
tb = packed array[0..999] of ta;
|
|
tc = array[0..124] of byte;
|
|
const
|
|
{$ifdef ENDIAN_BIG}
|
|
results: array[0..9] of ta = (1,0,1,0,1,0,1,0,1,0);
|
|
{$else}
|
|
results: array[0..9] of ta = (0,1,0,1,0,1,0,1,0,1);
|
|
{$endif}
|
|
var
|
|
a: ta;
|
|
b: tb;
|
|
i: longint;
|
|
begin
|
|
fillchar(b,sizeof(b),$AA);
|
|
if (b[0] <> results[0]) then
|
|
error(1);
|
|
if (b[1] <> results[1]) then
|
|
error(2);
|
|
if (b[2] <> results[2]) then
|
|
error(3);
|
|
if (b[3] <> results[3]) then
|
|
error(4);
|
|
if (b[4] <> results[4]) then
|
|
error(5);
|
|
// if (b[600] <> 1) then
|
|
// error(6);
|
|
for i := low(results) to high(results) do
|
|
if b[i] <> results[i] then
|
|
error(7);
|
|
// i := 500;
|
|
// if (b[i] <> 1) then
|
|
// error(8);
|
|
end;
|
|
|
|
|
|
procedure test8to16bit;
|
|
type
|
|
ta = 0..7;
|
|
tb = packed array[0..1000] of ta;
|
|
const
|
|
{$ifdef ENDIAN_BIG}
|
|
{ 010 110 100 101 101 001 011 010 010 11010010110100101101001011010 }
|
|
|
|
results: array[0..5] of ta = (2,6,4,5,5,1);
|
|
{$else}
|
|
{ (memory layout is different but equivalent with starting at end }
|
|
{ 01011010010110100101101001011 010 010 110 100 101 101 001 011 010 }
|
|
results: array[0..5] of ta = (2,3,1,5,5,4);
|
|
{$endif}
|
|
var
|
|
a: ta;
|
|
b: tb;
|
|
i: longint;
|
|
begin
|
|
fillchar(b,sizeof(b),$5A);
|
|
if (b[0] <> results[0]) then
|
|
error(11);
|
|
if (b[1] <> results[1]) then
|
|
error(12);
|
|
if (b[2] <> results[2]) then
|
|
error(13);
|
|
if (b[3] <> results[3]) then
|
|
error(14);
|
|
if (b[4] <> results[4]) then
|
|
error(15);
|
|
if (b[5] <> results[5]) then
|
|
error(155);
|
|
// if (b[600] <> 2) then
|
|
// error(16);
|
|
for i := low(results) to high(results) do
|
|
if b[i] <> results[i] then
|
|
error(17);
|
|
// i := 500;
|
|
// if (b[i] <> 5) then
|
|
// error(18);
|
|
end;
|
|
|
|
|
|
procedure test16bit;
|
|
type
|
|
ta = 0..511;
|
|
tb = packed array[0..799] of ta;
|
|
tc = array[0..899] of byte;
|
|
const
|
|
{$ifdef ENDIAN_BIG}
|
|
{ 010110100 111011001 011010011 101100101 101001110 110010110 100111011 001011010 0111011001011010011101100101101001110110 }
|
|
results: array[0..4] of ta = ($5A*2,$76 * 4 + 1,$69 * 2 + 1,$B2 * 2 + 1,$A7 * 2);
|
|
{$else}
|
|
{ algorithm: cut bit string in 16 bit chunks, byteswap, take 9 bits from right to left per chunck, continuing at the right of the next chunck if the previous one is used up }
|
|
{ 001011010 100111011 110010110 101001110 101100101 011 0101101001110110010110100111011001011010011101100101101001110110 }
|
|
|
|
results: array[0..4] of ta = ($2D*2,$9D*2+1,$CB*2,$A7*2,$B2*2+1);
|
|
{$endif}
|
|
var
|
|
a: ta;
|
|
b: tb;
|
|
i: longint;
|
|
begin
|
|
for i := 0 to high(tc) div 2 do
|
|
begin
|
|
tc(b)[i*2] := $5A;
|
|
tc(b)[i*2+1] := $76;
|
|
end;
|
|
if (b[0] <> results[0]) then
|
|
error(21);
|
|
if (b[1] <> results[1]) then
|
|
error(22);
|
|
if (b[2] <> results[2]) then
|
|
error(23);
|
|
if (b[3] <> results[3]) then
|
|
error(24);
|
|
if (b[4] <> results[4]) then
|
|
error(25);
|
|
// if (b[600] <> $76 * 2) then
|
|
// error(26);
|
|
for i := low(results) to high(results) do
|
|
if b[i] <> results[i] then
|
|
error(27);
|
|
// i := 500;
|
|
// if (b[i] <> $A7 * 2) then
|
|
// error(28);
|
|
end;
|
|
|
|
procedure test16to24bit;
|
|
type
|
|
ta = 0..2047;
|
|
tb = packed array[0..799] of ta;
|
|
tc = array[0..1099] of byte;
|
|
const
|
|
{$ifdef ENDIAN_BIG}
|
|
results: array[0..4] of ta = ($5A * 8 + 3,$B2 * 8 + 6,$9D * 8 + 4,$B4 * 8 + 7,$65 * 8 + 5);
|
|
{$else}
|
|
{ %11001011010 01101001110 00111011001 01100101101 10110100111 011101100 0111011001011010 0111011001011010 0111011001011010 }
|
|
results: array[0..4] of ta = ($0000065A,$0000034E,$000001D9,$0000032D,$000005A7);
|
|
{$endif}
|
|
var
|
|
a: ta;
|
|
b: tb;
|
|
i: longint;
|
|
begin
|
|
for i := 0 to high(tc) div 2 do
|
|
begin
|
|
tc(b)[i*2] := $5A;
|
|
tc(b)[i*2+1] := $76;
|
|
end;
|
|
if (b[0] <> results[0]) then
|
|
error(31);
|
|
if (b[1] <> results[1]) then
|
|
error(32);
|
|
if (b[2] <> results[2]) then
|
|
error(33);
|
|
if (b[3] <> results[3]) then
|
|
error(34);
|
|
if (b[4] <> results[4]) then
|
|
error(35);
|
|
// if (b[600] <> $76 * 8 + 2) then
|
|
// error(36);
|
|
for i := low(results) to high(results) do
|
|
if b[i] <> results[i] then
|
|
error(37);
|
|
// i := 500;
|
|
// if (b[i] <> $65 * 8 + 5) then
|
|
// error(38);
|
|
end;
|
|
|
|
|
|
procedure test32bit;
|
|
type
|
|
ta = 0..(1 shl 19) - 1;
|
|
tb = packed array[0..799] of ta;
|
|
tc = array[0..1899] of byte;
|
|
const
|
|
{$ifdef ENDIAN_BIG}
|
|
results: array[0..4] of ta = ($5A76*8+2, $D3B2*8+6,$9D96*8+4,$ECB4*8+7,$65A7*8+3);
|
|
{$else}
|
|
{ 0100111011001011010 0110100111011001011 0010110100111011001 0110010110100111011 1110110010110100111 0 01110110010110100111011001011010 01110110010110100111011001011010 01110110010110100111011001011010 01110110010110100111011001011010 01110110010110100111011001011010 01110110010110100111011001011010}
|
|
results: array[0..4] of ta = ($0002765A,$00034ECB,$000169D9,$00032D3B,$000765A7);
|
|
{$endif}
|
|
var
|
|
a: ta;
|
|
b: tb;
|
|
i: longint;
|
|
begin
|
|
for i := 0 to high(tc) div 2 do
|
|
begin
|
|
tc(b)[i*2] := $5A;
|
|
tc(b)[i*2+1] := $76;
|
|
end;
|
|
if (b[0] <> results[0]) then
|
|
error(41);
|
|
if (b[1] <> results[1]) then
|
|
error(42);
|
|
if (b[2] <> results[2]) then
|
|
error(43);
|
|
if (b[3] <> results[3]) then
|
|
error(44);
|
|
if (b[4] <> results[4]) then
|
|
error(45);
|
|
// if (b[600] <> $765A*8+3) then
|
|
// error(46);
|
|
for i := low(results) to high(results) do
|
|
if b[i] <> results[i] then
|
|
error(47);
|
|
// i := 500;
|
|
// if (b[i] <> $65a7*8+3) then
|
|
// error(48);
|
|
end;
|
|
|
|
{
|
|
write(hexstr(%1110110010110100111011001011010 ,8),',$');
|
|
write(hexstr(%1101100101101001110110010110100 ,8),',$');
|
|
write(hexstr(%1011001011010011101100101101001 ,8),',$');
|
|
write(hexstr(%0110010110100111011001011010011 ,8),',$');
|
|
writeln(hexstr(%1100101101001110110010110100111 ,8));
|
|
}
|
|
|
|
|
|
procedure test32to40bit;
|
|
type
|
|
ta = 0..$7fffffff;
|
|
tb = packed array[0..799] of ta;
|
|
tc = array[0..3099] of byte;
|
|
const
|
|
{$ifdef ENDIAN_BIG}
|
|
results: array[0..4] of ta = ($5A765A7*8+3,$2D3B2D3*8+5,$969D969*8+6,$CB4ECB4*8+7,$65A765A*8+3);
|
|
{$else}
|
|
{
|
|
1110110010110100111011001011010 1101100101101001110110010110100 1011001011010011101100101101001 0110010110100111011001011010011 1100101101001110110010110100111 1001011010011101100101101001110 011101
|
|
}
|
|
results: array[0..4] of ta = ($765A765A,$6CB4ECB4,$5969D969,$32D3B2D3,$65A765A7);
|
|
{$endif}
|
|
var
|
|
a: ta;
|
|
b: tb;
|
|
i: longint;
|
|
begin
|
|
for i := 0 to high(tc) div 2 do
|
|
begin
|
|
tc(b)[i*2] := $5A;
|
|
tc(b)[i*2+1] := $76;
|
|
end;
|
|
if (b[0] <> results[0]) then
|
|
error(51);
|
|
if (b[1] <> results[1]) then
|
|
error(52);
|
|
if (b[2] <> results[2]) then
|
|
error(53);
|
|
if (b[3] <> results[3]) then
|
|
error(54);
|
|
if (b[4] <> results[4]) then
|
|
error(55);
|
|
for i := low(results) to high(results) do
|
|
if b[i] <> results[i] then
|
|
error(57);
|
|
// i := 500;
|
|
// if (b[i] <> $65A765A*8+3) then
|
|
// error(58);
|
|
end;
|
|
|
|
begin
|
|
test8bit;
|
|
test8to16bit;
|
|
test16bit;
|
|
test16to24bit;
|
|
test32bit;
|
|
test32to40bit;
|
|
end.
|