procedure sort( var r : ArrayToSort; lo, up : integer );
label 999;
var d, i, j : integer;
tempr : ArrayEntry;
begin
d := up-lo+1;
while d>1 do begin
if d<5 then d := 1
else d := trunc( 0.45454*d );
{*** Do linear insertion sort in steps size d ***}
for i:=up-d downto lo do begin
tempr := r[i];
j := i+d;
while j <= up do
if tempr.k > r[j].k then begin
r[j-d] := r[j];
j := j+d
end
else goto 999; {*** break ***}
999:
r[j-d] := tempr
end
end
end;
|