31 lines
788 B
Text
31 lines
788 B
Text
(subscriptrange):
|
|
Hamming: procedure options (main); /* 14 November 2013 */
|
|
declare (H(3000), t) fixed (15);
|
|
declare (i, j, k, m, n) fixed binary;
|
|
declare swaps bit (1);
|
|
|
|
on underflow ;
|
|
|
|
m = 0; n = 12;
|
|
do k = 0 to n;
|
|
do j = 0 to n;
|
|
do i = 0 to n;
|
|
m = m + 1;
|
|
H(m) = 2**i * 3**j * 5**k;
|
|
end;
|
|
end;
|
|
end;
|
|
/* sort */
|
|
swaps = '1'b;
|
|
do while (swaps); /* Cocktail-shaker sort is adequate, because values are largely sorted */
|
|
swaps = '0'b;
|
|
do i = 1 to m-1, i-1 to 1 by -1;
|
|
if H(i) > H(i+1) then /* swap */
|
|
do; t = H(i); H(i) = H(i+1); H(i+1) = t; swaps = '1'b; end;
|
|
end;
|
|
end;
|
|
do i = 1 to m;
|
|
put skip data (H(i));
|
|
end;
|
|
put skip data (H(1653));
|
|
end Hamming;
|