1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

inline unsigned getbits(unsigned x, int k, int j){ return (x>>k)&~(~0<<j); }

void linoptstraightradix(int a[], int N, int bits){
    int M=1, m, i, j, pass, *count, b[N];
    m=bits/4;
    for(i=0; i<m; i++,M*=2);          //2^m berechnen
    count=(int*)malloc(M*sizeof(int));
    for(pass=0; pass<bits/m; pass++){        //die Bits der Reihe nach betrachten
        for(j=0; j<M; j++) count[j]=0;        //count[] mit 0 initialisieren
        for(i=0; i<N; i++) count[getbits(a[i],pass*m,m)]++;  //Vorkommen der Schlüssel speichern
        for(j=1; j<M; j++)
            count[j]=count[j-1]+count[j];      //Positionen im Array bestimmen
        for(i=N-1; i>=0; i--)
            b[--count[getbits(a[i],pass*m,m)]]=a[i];    //in b einordnen, jeweiligen Zähler verringern
        for(i=0; i<N; i++) a[i]=b[i];        //auf a zurück speichern
    }
    free(count);
}					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:

type
  TDWORDArray = Array of DWORD;

// holt bit k (von rechts) bis bit j aus x raus und gibt es als Rückgabewert
function getbits(x : DWORD; k : Integer; j : Integer) : DWORD;
begin
  Result := x shr k;
  Result := Result AND ($FFFFFFFF shr (32 - j));
end;

// optimiertes "linear optimized straight radix sort"
procedure linoptstraightradix(var a : TDWORDArray; N : Integer; bits : Integer);
var
  count : TDWORDArray;
  b     : TDWORDArray;
  M     : Integer;
  m1    : Integer;
  i     : Integer;
  j     : Integer;
  pass  : Integer;
  temp  : DWORD;
  PPtr  : Pointer;
begin
  M := 1;
  SetLength(b, N);
  m1 := bits div 4;
  for i := 0 to m1 - 1 do
    M := M * 2;
  SetLength(count, M);
  for pass := 0 to bits div m1 - 1 do
  begin
    for j := 0 to M - 1 do
      count[j] := 0;
    for i := 0 to N - 1 do
      inc(count[getbits(a[i], pass * m1, m1)], 1);
    for j := 1 to M - 1 do
      count[j] := count[j-1] + count[j];
    for i := N - 1 downto 0 do
    begin
      temp := getbits(a[i], pass * m1, m1);
      count[temp]    := count[temp] - 1;
      b[count[temp]] := a[i];
    end;
    for i := 0 to N - 1 do
      a[i] := b[i];
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:

// optimiertes "linear optimized straight radix sort"
procedure linoptstraightradix(var a : TDWORDArray; N : Integer; bits : Integer);
var
  count : TDWORDArray;
  b     : TDWORDArray;
  M     : Integer;
  m1    : Integer;
  i     : Integer;
  j     : Integer;
  pass  : Integer;
  temp  : DWORD;
  PPtr  : Pointer;
begin
  M := 1;
  SetLength(b, N);
  m1 := bits div 4;
  for i := 0 to m1 - 1 do
    M := M * 2;
  SetLength(count, M);
  for pass := 0 to bits div m1 - 1 do
  begin
    for j := 0 to M - 1 do
      count[j] := 0;
    for i := 0 to N - 1 do
    // direkte Zuweisung ohne Aufruf von getbits (viel schneller)
    inc(count[(a[i] shr (pass * m1)) AND ($FFFFFFFF shr (32 - m1))], 1);
    for j := 1 to M - 1 do
      count[j] := count[j-1] + count[j];
    for i := N - 1 downto 0 do
    begin
      // direkte Zuweisung ohne Aufruf von getbits (viel schneller)
      temp := (a[i] shr (pass * m1)) AND ($FFFFFFFF shr (32 - m1));
      count[temp]    := count[temp] - 1;
      b[count[temp]] := a[i];
    end;
    // Arraypointer vertauschen, um Zeit zu sparen, anstatt jeden
    // einzelnen Wert von Array b nach Array a zu kopieren
    PPtr := Pointer(a);
    DWORD(Pointer(a)) := DWORD(Pointer(b));
    DWORD(Pointer(b)) := DWORD(PPtr);
  end;
end;					

1:

function getbits(x : DWORD; k : Integer; j : Integer) : DWORD; inline;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

function getbits(x : DWORD; k : Integer; j : Integer) : DWORD;
begin
// Assemblercode von getbits (bringt aber keine Geschwindigkeitsverbesserung, hab mit gettickcount die Zeit gestoppt)
  asm
    mov eax, x
    mov ecx, k
    mov edx, j
    shr eax, cl  // Result := x shr k;

    or  edi, $FFFFFFFF
    mov cl,  32
    sub cl,  dl
    shr edi, cl  // ($FFFFFFFF shr (32 - j))

    and eax, edi // Result := Result AND ...

    mov Result, eax
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:

procedure Sort_BinBucket(const Data: TDWORDArray);
//  EAX ==> Pointer to the array to sort
asm
    MOV     ECX, 32

    //Required to hold 3 pointers ...
    PUSH    ESI
    PUSH    EDI

@@SortLoop:
    //Initialize the pointers ... ESI = Start of Data, EDI = End of Data
    MOV     ESI, EAX
    MOV     EDX, DWORD PTR [EAX - 4]
    LEA     EDI, DWORD PTR [EAX + 4*EDX - 4]

@@SortDataLoop_0:
    //Sort all entries with an 0 at current LSb ...
    ROR     DWORD PTR [ESI], 1  //Copy the LSb into CF
    JC      @@SortDataLoop_0_Detected1    

    //The element is already in the right place ... skip over to the next ...
    ADD     ESI, 4
    DEC     EDX
    JNZ     @@SortDataLoop_0
    JMP     @@SortDataLoop_E

@@SortDataLoop_0_Detected1:
    //Memory Exchange ESI and EDI contents
    XCHG    EAX, DWORD PTR [ESI]
    XCHG    EAX, DWORD PTR [EDI]
    XCHG    EAX, DWORD PTR [ESI]

    //EDI is in the right place ... so skip it ...
    SUB     EDI, 4
    DEC     EDX
    JZ      @@SortDataLoop_E

@@SortDataLoop_1:
    //Sort all entries with an 1 at current LSb ...
    ROR     DWORD PTR [EDI], 1  //Copy the LSb into CF
    JNC     @@SortDataLoop_1_Detected0
    SUB     EDI, 4
    DEC     EDX
    JNZ     @@SortDataLoop_0

@@SortDataLoop_1_Detected0:
    //Memory Exchange ESI and EDI contents
    XCHG    EAX, DWORD PTR [EDI]
    XCHG    EAX, DWORD PTR [ESI]
    XCHG    EAX, DWORD PTR [EDI]

    //ESI is in the right place ... so skip it ...
    ADD     ESI, 4
    DEC     EDX
    JNZ     @@SortDataLoop_0
    
@@SortDataLoop_E:
    DEC     ECX
    JNZ     @@SortLoop

    //Restore them for Delphi to be happy ...
    POP     EDI
    POP     ESI
end;					

1:

    for(i=0; i<m; i++,M*=2);          //2^m berechnen					

1:
2:
3:
4:
5:
6:

for i := N - 1 downto 0 do  
begin  
temp:=getbits(a[i],pass*m1,m1);  
b[count[temp]]:=a[i];  
count[temp]:=pred(count[temp])
end;