program BitRev;

	const
		maxN = 8192;
		maxNless1 = 8191;

	type

		revElem = record
				d: integer;
				swapped: boolean;
			end;
		revArr = array[0..maxNless1] of revElem;
		revArrPtr = ^revArr;
		intArr = array[0..maxNless1] of integer;
		intArrPtr = ^intArr;

	var
		i, iRev, j, N, Nlog2, numSwaps: integer;
		dat: revArrPtr;
		symmetric: boolean;
		resFileRef, rsID: integer;
		rDatH: handle;
		rDatPtr: intArrPtr;
		x, y, z: intArrPtr;

	function log2 (x: integer): integer;
		var
			count: integer;
	begin
		count := 15;
		while not BTST(x, count) do
			count := count - 1;
		log2 := count;
	end;

	function BitRev (x, bitlen: integer): integer;
		var
			i: integer;
			temp: longint;
	begin
		temp := 0;
		for i := 0 to bitlen do
			if BTST(x, i) then
				BSET(temp, bitlen - i - 1);
		BitRev := LoWord(temp);
	end;

	procedure BitRevIArr (var x: intArr;
									bitlen: integer);
		var
			i: integer;
			tempArr: intArr;
	begin
		for i := 0 to N - 1 do
			tempArr[i] := x[BitRev(i, bitlen)];
		x := tempArr;
	end;

	procedure BitRevIArrR (var x: intArr;
									Length: integer);
		var
			i, ad1, ad2, temp: integer;
			rDatH: Handle;
			rDatPtr: intArrPtr;
	begin
{¥  Debugger;¥}
		rDatH := GetResource('BREV', Length + 124);
		if rDatH = nil then
			begin
				writeln('No resource handle is nil in BitRevIArrR');
				halt;
			end;
		rDatPtr := intArrPtr(rDatH^);
		numSwaps := rDatPtr^[0];
		for i := 1 to numSwaps do
			begin
				ad1 := rDatPtr^[i * 2 - 1] div 2;		{ div 2 necessary because 2wice the address values are }
				ad2 := rDatPtr^[i * 2] div 2;			{ stored to speed indexing in BitRevEZ }
				temp := x[ad1];
				x[ad1] := x[ad2];
				x[ad2] := temp;
			end;
		ReleaseResource(rDatH);
	end;

	procedure BitRevEZ (x: ptr;
									length: integer);
	external;

	procedure BitRevQ (x: ptr;
									length: integer;
									BitRevTbl: ptr);
	external;

	procedure allocMem;
	begin
		dat := revArrPtr(NewPtr(longint(maxN) * sizeOf(revElem)));
		x := intArrPtr(NewPtr(maxN * sizeOf(Integer)));
		y := intArrPtr(NewPtr(maxN * sizeOf(Integer)));
		z := intArrPtr(NewPtr(maxN * sizeOf(Integer)));
		if (dat = nil) or (x = nil) or (y = nil) or (z = nil) then
			begin
				writeln('Couldn''t Allocate Memory in proc Alloc Mem');
				SysBeep(0);
				ExitToShell;
			end;
	end;

	procedure initData (N: integer);
		var
			i: integer;
	begin
		for i := 0 to N - 1 do
			begin
				with dat^[i] do
					begin
						d := i;
						swapped := false;
					end;
				x^[i] := i;
				y^[i] := i;
				z^[i] := i;
			end;
	end;

	procedure CreateBitRevRsrc;
{ this routine produces a resource file 'BitRev.rsrc'.  A number (= log2(maxN)-2) of 'BREV' }
{ resources are created and saved in this file with ID's = 4 to maxN.  Each resource }
{ consists of a sequence of integers.  The resource ID 128 (= 4 + 124), for example, is a sequence }
{ of 3 integers.  The first records the number of swaps necessary to bit-reverse a length 4 array (1).}
{  The next two integers are the addresses of the elements that need to be swapped.  For a length 16 }
{ array, 6 swaps are necessary as can be found by looking at the first word of BREV rsrc ID=140.  The }
{ following 12 words describe which pairs need swapping.  The addresses of the numbers to be swapped }
{ are multiplied by 2, since the addresses are used in an array of integers and memory accesses must }
{ occur on even byte boundaries. }
		var
			i: integer;
	begin
		createResFile('BitRev.rsrc');
		N := 4;
		while N <= maxN do
			begin
				initData(N);
				Nlog2 := log2(N);
				numSwaps := 0;
				for i := 0 to N - 1 do
					begin
						iRev := bitRev(i, Nlog2);
						symmetric := (iRev = i);
						if (not symmetric) and (not dat^[i].swapped) then
							begin
{¥     j := dat^[i].d;¥}
{¥     dat^[i].d := dat^[iRev].d;¥}
{¥     dat^[iRev].d := j;¥}
								dat^[i].swapped := true;
								dat^[iRev].swapped := true;
								numSwaps := numSwaps + 1;
							end;
					end;
				initData(N);
				ResFileRef := OpenResFile('BitRev.rsrc');
				rDatH := NewHandle((numSwaps * 2 + 1) * sizeOf(integer));
				rDatPtr := intArrPtr(rDatH^);
				rDatPtr^[0] := numSwaps;
				j := 1;
				for i := 0 to N - 1 do
					begin
						iRev := bitRev(i, Nlog2);
						symmetric := (iRev = i);
						if (not symmetric) and (not dat^[i].swapped) then
							begin
								dat^[i].swapped := true;
								dat^[iRev].swapped := true;
								rDatPtr^[j] := i * 2;				{ mult by 2 to get even offsets }
								rDatPtr^[j + 1] := iRev * 2;		{ mult by 2 to get even offsets }
								j := j + 2;
							end;
					end;
				rsID := N + 124;
				AddResource(rDatH, 'BREV', rsID, concat(stringOf(N : 4), ' BitReversed'));
				WriteResource(rDatH);
				CloseResFile(resFileRef);
				DisposHandle(rDatH);

				writeln('N = ', N : 10);
				writeln('NumSwaps', numSwaps : 10);
				N := N * 2;
			end;
	end;

	procedure TestBitRevSpeed (list: boolean);
		const
			loopCount = 20;
		var
			BitRevH: handle;
			startTime, endTime, i, ad1, ad2, temp: integer;
	begin
		N := 4;
		while N <= maxN do
			begin
				InitData(N);
				Nlog2 := log2(N);
				writeln('N = ', N : 5, '  numCalls = ', loopCount : 5);
				startTime := tickCount;
				for i := 1 to loopCount do
					BitRevIArr(x^, Nlog2);
				endTime := tickCount;
				writeln('Time for normal BitRev = ', (endTime - startTime) / 60 : 10 : 5, ' secs');

				startTime := tickCount;
				for i := 1 to loopCount do
					BitRevIArrR(y^, N);
				endTime := tickCount;
				writeln('Time for super  BitRev = ', (endTime - startTime) / 60 : 10 : 5, ' secs');

				startTime := tickCount;
				for i := 1 to loopCount do
					BitRevEZ(ptr(z), N);
				endTime := tickCount;
				writeln('Time for duper  BitRev = ', (endTime - startTime) / 60 : 10 : 5, ' secs');

				BitRevH := GetResource('BREV', N + 124);
				HLock(BitRevH);
				startTime := tickCount;
				for i := 1 to loopCount do
					BitRevQ(ptr(z), N, BitRevH^);
				endTime := tickCount;
				writeln('Time for honky  BitRev = ', (endTime - startTime) / 60 : 10 : 5, ' secs');
				HUnlock(BitRevH);

				if list then
					begin
						for i := 0 to N - 1 do
							writeln(x^[i] : 5, y^[i] : 5, z^[i] : 5);
						writeln;
					end;

				N := N * 2;
			end;
	end;

begin
	ShowText;
	AllocMem;

{¥ CreateBitRevRsrc;						{ first create the resource file, then include it w/Run.. ¥]}
	TestBitRevSpeed(false);					{ to test & compare the bitRev speeds }
end.