Little improvmenvce of ocl code.

Little improvmenvce of ocl code.

/*******************************************************************************
 * The MIT License (MIT)
 *
 * Copyright (c) 2011, 2017 OpenWorm.
 * http://openworm.org
 *
 * All rights reserved. This program and the accompanying materials
 * are made available under the terms of the MIT License
 * which accompanies this distribution, and is available at
 * http://opensource.org/licenses/MIT
 *
 * Contributors:
 *     	OpenWorm - http://openworm.org/people.html
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to deal
 * in the Software without restriction, including without limitation the rights
 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 * copies of the Software, and to permit persons to whom the Software is
 * furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in
 * all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
 * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
 * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE
 * USE OR OTHER DEALINGS IN THE SOFTWARE.
 *******************************************************************************/

#ifdef cl_amd_printf
	#pragma OPENCL EXTENSION cl_amd_printf : enable
	#define PRINTF_ON // this comment because using printf leads to very slow work on Radeon r9 290x on my machine
    	              // don't know why
#elif defined(cl_intel_printf)
	#pragma OPENCL EXTENSION cl_intel_printf : enable
	#define PRINTF_ON
#endif

#ifdef _DOUBLE_PRECISION
#ifdef cl_khr_fp64
	#pragma OPENCL EXTENSION cl_khr_fp64 : enable

#elif defined(cl_amd_fp64)
	#pragma OPENCL EXTENSION cl_amd_fp64 : enable
	#define _DOUBLE_PRECISION
#else
	#error "Double precision floating point not supported by OpenCL implementation."
#endif
#endif
#if defined(_WIN32) || defined(_WIN64)
#include "inc\\ocl_struct.h"
#else
#include "inc/ocl_struct.h"
#endif

typedef struct particle{
#ifdef _DOUBLE_PRECISION
	double4 pos;
	double4 vel;
#else
	float4 pos;
	float4 vel;
#endif
	size_t type_;
	size_t cell_id;
#ifdef _DOUBLE_PRECISION
	double density;
	double pressure;
#else
	float density;
	float pressure;
#endif
} particle;

/** Just for test
*/
__kernel void _ker_check_copy(__global struct extendet_particle * ext_particles,
							   __global struct
							   	particle
							   	* particles){
	int id = get_global_id(0);
#ifdef PRINTF_ON
	if(id == 0){
		printf("sizeof() of particles_f is %d\n", sizeof(particle) );
	}
#endif
	if(id == 0 && particles[0].pos.x == 1.67 && particles[0].pos.y == 1.67 && particles[0].pos.z == 1.67 ){
		printf("\nTEST PASSED.\n");
	}
}

/**Initialization of neighbour list by -1
* what means that it's no neighbours.
*/
__kernel void _ker_init_ext_particles(__global struct extendet_particle * ext_particles){
	int id = get_global_id(0);
	ext_particles[id].p_id = id;
	for(int i=0;i<NEIGHBOUR_COUNT;++i){
		ext_particles[id].neigbour_list[i] = -1;
	}
}

/** Calc current cell id for each particles
*/
__kernel void _ker_calc_cell_id(__global struct
								particle * particles){

}

/** Searchin for neigbours foe each particles
*/
__kernel void _ker_neighbour_search(__global struct extendet_particle * ext_particles,
							   __global struct
							   	particle * particles){
}

int cell_id(
		   int4 cell_factors_,
		   uint grid_cells_X,
		   uint grid_cells_Y,
		   uint grid_cells_Z//doesn't use
		   )
{
	int cell_id = cell_factors_.x + cell_factors_.y * grid_cells_X
		+ cell_factors_.z * grid_cells_X * grid_cells_Y;
	return cell_id;
}
/** Caculation spatial hash cellId for every particle
 *  Kernel fill up particleIndex buffer.
 */
 int4 cell_factors(
				 __global struct
				 particle * particle,
				 float x_min,
				 float y_min,
				 float z_min,
				 float hash_grid_cell_size_inv
				 )
{
	//xmin, ymin, zmin
	int4 result;
	result.x = (int)( particle->pos.x *  hash_grid_cell_size_inv );
	result.y = (int)( particle->pos.y *  hash_grid_cell_size_inv );
	result.z = (int)( particle->pos.z *  hash_grid_cell_size_inv );
	return result;
}
__kernel void hashParticles(
							__global struct
							particle * particles,
							uint gridCellsX,
							uint gridCellsY,
							uint gridCellsZ,
							float hashGridCellSizeInv,
							float xmin,
							float ymin,
							float zmin,
							__global uint2 * particleIndex,
							uint   PARTICLE_COUNT
							)
{
	/*int id = get_global_id( 0 );
	if( id >= PARTICLE_COUNT ) return;
	float4 _position = position[ id ];
	int4 cellFactors_ = cellFactors( _position, xmin, ymin, zmin, hashGridCellSizeInv );
	int cellId_ = cellId( cellFactors_, gridCellsX, gridCellsY, gridCellsZ ) & 0xffffff; // truncate to low 16 bits
	uint2 result;
	PI_CELL_ID( result ) = cellId_;
	PI_SERIAL_ID( result ) = id;
	particleIndex[ id ] = result;*/
}

/*******************************************************************************
 * The MIT License (MIT)
 *
 * Copyright (c) 2011, 2017 OpenWorm.
 * http://openworm.org
 *
 * All rights reserved. This program and the accompanying materials
 * are made available under the terms of the MIT License
 * which accompanies this distribution, and is available at
 * http://opensource.org/licenses/MIT
 *
 * Contributors:
 *     	OpenWorm - http://openworm.org/people.html
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to deal
 * in the Software without restriction, including without limitation the rights
 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 * copies of the Software, and to permit persons to whom the Software is
 * furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in
 * all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
 * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
 * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE
 * USE OR OTHER DEALINGS IN THE SOFTWARE.
 *******************************************************************************/

#ifdef cl_amd_printf
	#pragma OPENCL EXTENSION cl_amd_printf : enable
	#define PRINTF_ON // this comment because using printf leads to very slow work on Radeon r9 290x on my machine
    	              // don't know why
#elif defined(cl_intel_printf)
	#pragma OPENCL EXTENSION cl_intel_printf : enable
	#define PRINTF_ON
#endif

#ifdef _DOUBLE_PRECISION
#ifdef cl_khr_fp64
	#pragma OPENCL EXTENSION cl_khr_fp64 : enable

#elif defined(cl_amd_fp64)
	#pragma OPENCL EXTENSION cl_amd_fp64 : enable
	#define _DOUBLE_PRECISION
#else
	#error "Double precision floating point not supported by OpenCL implementation."
#endif
#endif
#if defined(_WIN32) || defined(_WIN64)
#include "inc\\ocl_struct.h"
#else
#include "inc/ocl_struct.h"
#endif

typedef struct particle_f{
	float4 pos;
	float4 vel;
	size_t type_;
	size_t cell_id;
	float density;
	float pressure;
} particle_f;

#ifdef _DOUBLE_PRECISION
typedef struct particle_d{
	double4 pos;
	double4 vel;
	size_t type_;
	size_t cell_id;
	double density;
	double pressure;
} particle_d;
#endif

/** Just for test
*/
__kernel void _ker_check_copy(__global struct extendet_particle * ext_particles,
							   __global struct
							   #ifdef _DOUBLE_PRECISION
									particle_d
							   #else
									particle_f
							   #endif
									* particles){
	int id = get_global_id(0);
#ifdef PRINTF_ON
	if(id == 0){
#ifdef _DOUBLE_PRECISION
		printf("sizeof() of particles_d is %d\n", sizeof(particle_d) );
#else
		printf("sizeof() of particles_f is %d\n", sizeof(particle_f) );
#endif
	}
#endif
	if(id == 0 && particles[0].pos.x == 1.67 && particles[0].pos.y == 1.67 && particles[0].pos.z == 1.67 ){
		printf("\nTEST PASSED.\n");
	}
}

/**Initialization of neighbour list by -1
* what means that it's no neighbours.
*/
__kernel void _ker_init_ext_particles(__global struct extendet_particle * ext_particles){
	int id = get_global_id(0);
	ext_particles[id].p_id = id;
	for(int i=0;i<NEIGHBOUR_COUNT;++i){
		ext_particles[id].neigbour_list[i] = -1;
	}
}

/** Calc current cell id for each particles
*/
__kernel void _ker_calc_cell_id(__global struct
							   #ifdef _DOUBLE_PRECISION
									particle_d
							   #else
									particle_f
							   #endif
									* particles){

}

/** Searchin for neigbours foe each particles
*/
__kernel void _ker_neighbour_search(__global struct extendet_particle * ext_particles,
							   __global struct
							   #ifdef _DOUBLE_PRECISION
									particle_d
							   #else
									particle_f
							   #endif
									* particles){

}

int cell_id(
		   int4 cell_factors_,
		   uint grid_cells_X,
		   uint grid_cells_Y,
		   uint grid_cells_Z//don't use
		   )
{
	int cell_id = cell_factors_.x + cell_factors_.y * grid_cells_X
		+ cell_factors_.z * grid_cells_X * grid_cells_Y;
	return cell_id;
}
/** Caculation spatial hash cellId for every particle
 *  Kernel fill up particleIndex buffer.
 */
 int4 cell_factors(
				 __global struct
				#ifdef _DOUBLE_PRECISION
					particle_d
				#else
					particle_f
				#endif
					* particle,
				 float x_min,
				 float y_min,
				 float z_min,
				 float hash_grid_cell_size_inv
				 )
{
	//xmin, ymin, zmin
	int4 result;
	result.x = (int)( particle->pos.x *  hash_grid_cell_size_inv );
	result.y = (int)( particle->pos.y *  hash_grid_cell_size_inv );
	result.z = (int)( particle->pos.z *  hash_grid_cell_size_inv );
	return result;
}
__kernel void hashParticles(
							__global struct
							#ifdef _DOUBLE_PRECISION
								particle_d
							#else
								particle_f
							#endif
								* particles,
							uint gridCellsX,
							uint gridCellsY,
							uint gridCellsZ,
							float hashGridCellSizeInv,
							float xmin,
							float ymin,
							float zmin,
							__global uint2 * particleIndex,
							uint   PARTICLE_COUNT
							)
{
	/*int id = get_global_id( 0 );
	if( id >= PARTICLE_COUNT ) return;
	float4 _position = position[ id ];
	int4 cellFactors_ = cellFactors( _position, xmin, ymin, zmin, hashGridCellSizeInv );
	int cellId_ = cellId( cellFactors_, gridCellsX, gridCellsY, gridCellsZ ) & 0xffffff; // truncate to low 16 bits
	uint2 result;
	PI_CELL_ID( result ) = cellId_;
	PI_SERIAL_ID( result ) = id;
	particleIndex[ id ] = result;*/
}


fix trivial format

fix trivial format

;; @file unit-testing-framework.cl
;;
;; @breif Simple unit testing framework to show the usage of macro
;;

; Original test codes
(defun test-+ ()
  (format t "~:[FAIL~;pass~] ... ~a~%" (= (+ 1 2) 3) '(= (+ 1 2) 3))
  (format t "~:[FAIL~;pass~] ... ~a~%" (= (+ 1 2 3) 6) '(= (+ 1 2 3) 6))
  (format t "~:[FAIL~;pass~] ... ~a~%" (= (+ -1 -2) -3) '(= (+ -1 -2) -3)))
; Factor the 'format ...' expression out
(defun report-result (result label)
  (format t "~:[FAIL~;pass~] ... ~a~%" result label))
; So now the 'test-+' function is simplified a little
(defun test-+-a ()
  (report-result (= (+ 1 2) 3) '(= (+ 1 2) 3))
  (report-result (= (+ 1 2 3) 6) '(= (+ 1 2 3) 6))
  (report-result (= (+ -1 -2) -3) '(= (+ -1 -2) -3)))
; To factor out the repeated contents in result and label, use macro
(defmacro check (form)
  `(report-result ,form ',form))
; Now the 'test' function is simplified further
(defun test-+-b ()
  (check (= (+ 1 2) 3))
  (check (= (+ 1 2 3) 6))
  (check (= (+ -1 -2) -3)))
; Well, it seems natural to make check take an arbitrary number of forms
; @note It is a common macro idiom to wrap `progn` around a series of forms in
; order to turn them into a single form. Notice also how `,@` can be used to
; splice in the result of an expression that returns a list of expressions that
; are themselves generated with a backquote template.
(defmacro check-a (&body forms)
  `(progn
    ,@(loop for form in forms collect `(report-result ,form ',form))))
; And finally, the 'test-+' function is as simple as follows:
(defun test-+-c ()
  (check-a
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -2) -3)))
;
; Fix the return value
(defun report-result-a (result label)
  (format t "~:[FAIL~;pass~] ... ~a~%" result label)
  result)
; Common macro-writting macro that generate unique symbols for temporary
; variables used in the macro definition, to avoid name collision
(defmacro with-gensyms ((&rest names) &body body)
  `(let ,(loop for n in names collect `(,n (gensym)))
    ,@body))
; `and`-like macro without the short-circuiting trait
(defmacro combine-results (&body forms)
  (with-gensyms (result)
    `(let ((,result t))
      ,@(loop for form in forms collect `(unless ,form (setf ,result nil)))
      ,result)))
; Replace `progn` with `combine-results` in the `check` macro
(defmacro check-b (&body forms)
  `(combine-results
    ,@(loop for form in forms collect `(report-result-a ,form ',form))))
; Now, the `test-+` is defined as follows:
(defun test-+-d ()
  (check-b
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -2) -3)))
;
; More test cases
(defun test-* ()
  (check-b
    (= (* 2 2) 4)
    (= (* -3 5) -15)
    (= (* 1 3) 3)
    (= (* 0 5) 0)))
; Run all test cases together, that is, a test suite
(defun test-arithmetic ()
  (combine-results
    (test-+-d)
    (test-*)))
; As more and more test cases are added in, it would be nice to know where a
; failed test comes from, namely, the name of the function containing the test.
(defun report-result-b (result label test-name)
  (format t "~:[FAIL~;pass~] ... ~a:~a~%" result test-name label)
  result)
; However, to make this possible, name of the function has to be passed to the
; `check` macro, which in turn pass the name to the function `report-result`,
; and at last the name is printed. This is so inconvenient, are there any other
; solutions? And the answer is yes, 'dynamic variables' is best friend. Actually,
; this is exactly the kind of problem dynamic variables were designed to solve.
;
; First, declare the variable at the top level
(defvar *test-name* nil)
; Second, change `report-result` to use the dynamic variable
(defun report-result-c (result label)
  (format t "~:[FAIL~;pass~] ... ~a: ~a~%" result *test-name* label)
  result)
; Redeclare other macros and functions
(defmacro check-c (&body forms)
  `(combine-results
    ,@(loop for form in forms collect `(report-result-c ,form ',form))))
; Remeber to binding '*test-name*' to the appropriate before run test
(defun test-+-e ()
  (let ((*test-name* 'test-+-e))
    (check-c
      (= (+ 1 2) 3)
      (= (+ 1 2 3) 6)
      (= (+ -1 -2) -3))))
;;;
(defun test-*-a ()
  (let ((*test-name* 'test-*-a))
    (check-c
      (= (* 2 2) 4)
      (= (* -3 5) -15)
      (= (* 1 3) 3)
      (= (* 0 5) 0))))
;;;
(defun test-arithmetic-a ()
  (combine-results
    (test-+-e)
    (test-*-a)))
;
; Well now, everything seems fairly good, except for the crummy duplication that
; every test has exactly the same three lines of codes that bind '*test-name*'
; to the function name of itself.
; This is because the abstraction of a test is only in the developer's mind, and
; to implement the abstraction, certain patterns has to be followed. To concrete
; the mind abstraction, `macro` is the best choice.
;
; The `deftest` macro expands to a `defun` declaration
(defmacro deftest (test-name params &body body)
  `(defun ,test-name ,params
    (let ((*test-name* ',test-name))
      ,@body)))
; With the `deftest` defined above, new test could be defined as follows:
(deftest test-+-f ()
  (check-c
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -2) -3)))
(deftest test-*-b ()
  (check-c
    (= (* 2 2) 4)
    (= (* -3 5) -15)
    (= (* 1 3) 3)
    (= (* 0 5) 0)))
;;;
(defun test-arithmetic-b ()
  (combine-results
    (test-+-f)
    (test-*-b)))
;
; Test hierarchy
; It is not uncommon for a test to be included in two test suites(context), and
; it's also not unheard of when the test succeeded in one context while failed
; in another. In such situation, there is no way to tell in what context the
; test failed.
; So we need a way to reflect the test hierarchy in the output, for example:
;
; pass ... (TEST-ARITHMETIC TEST-+): (= (+ 1 2) 3)
;
; To implement, we'll play with '*test-name*', and redefine `deftest`.
; @note `combine-results` is applied to `,@body` for this implementation, to
; simplify test suites definition(no `combine-results` is needed in the body).
(defmacro deftest (test-name params &body body)
  `(defun ,test-name ,params
    (let ((*test-name* (append *test-name* (list ',test-name))))
      (combine-results ,@body))))
; Some test cases
(deftest test-+-g ()
  (check-c
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -2) -3)))
(deftest test-*-c ()
  (check-c
    (= (* 2 2) 4)
    (= (* -3 5) -15)
    (= (* 1 3) 3)
    (= (* 0 5) 0)))
(deftest test-/-a ()
  (check-c
    (= (/ 2 1) 2)
    (= (/ 6 3) 2)))
; New test suites can now be defined with `deftest` macro as follows:
(deftest test-arithmetic-c ()
  (test-+-g)
  (test-*-c))
(deftest test-arithmetic-d ()
  (test-/-a)
  (test-*-c))
(deftest test-math ()
  (test-arithmetic-c)
  (test-arithmetic-d))
;

;; @file unit-testing-framework.cl
;;
;; @breif Simple unit testing framework to show the usage of macro
;;

; Original test codes
(defun test-+ ()
  (format t "~:[FAIL~;pass~] ... ~a~%" (= (+ 1 2) 3) '(= (+ 1 2) 3))
  (format t "~:[FAIL~;pass~] ... ~a~%" (= (+ 1 2 3) 6) '(= (+ 1 2 3) 6))
  (format t "~:[FAIL~;pass~] ... ~a~%" (= (+ -1 -2) -3) '(= (+ -1 -2) -3)))
; Factor the 'format ...' expression out
(defun report-result (result label)
  (format t "~:[FAIL~;pass~] ... ~a~%" result label))
; So now the 'test-+' function is simplified a little
(defun test-+-a ()
  (report-result (= (+ 1 2) 3) '(= (+ 1 2) 3))
  (report-result (= (+ 1 2 3) 6) '(= (+ 1 2 3) 6))
  (report-result (= (+ -1 -2) -3) '(= (+ -1 -2) -3)))
; To factor out the repeated contents in result and label, use macro
(defmacro check (form)
  `(report-result ,form ',form))
; Now the 'test' function is simplified further
(defun test-+-b ()
  (check (= (+ 1 2) 3))
  (check (= (+ 1 2 3) 6))
  (check (= (+ -1 -2) -3)))
; Well, it seems natural to make check take an arbitrary number of forms
; @note It is a common macro idiom to wrap `progn` around a series of forms in
; order to turn them into a single form. Notice also how `,@` can be used to
; splice in the result of an expression that returns a list of expressions that
; are themselves generated with a backquote template.
(defmacro check-a (&body forms)
  `(progn
    ,@(loop for form in forms collect `(report-result ,form ',form))))
; And finally, the 'test-+' function is as simple as follows:
(defun test-+-c ()
  (check-a
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -2) -3)))
;
; Fix the return value
(defun report-result-a (result label)
  (format t "~:[FAIL~;pass~] ... ~a~%" result label)
  result)
; Common macro-writting macro that generate unique symbols for temporary
; variables used in the macro definition, to avoid name collision
(defmacro with-gensyms ((&rest names) &body body)
  `(let ,(loop for n in names collect `(,n (gensym)))
    ,@body)
)
; `and`-like macro without the short-circuiting trait
(defmacro combine-results (&body forms)
  (with-gensyms (result)
    `(let ((,result t))
      ,@(loop for form in forms collect `(unless ,form (setf ,result nil)))
      ,result)))
; Replace `progn` with `combine-results` in the `check` macro
(defmacro check-b (&body forms)
  `(combine-results
    ,@(loop for form in forms collect `(report-result-a ,form ',form))))
; Now, the `test-+` is defined as follows:
(defun test-+-d ()
  (check-b
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -2) -3)))
;
; More test cases
(defun test-* ()
  (check-b
    (= (* 2 2) 4)
    (= (* -3 5) -15)
    (= (* 1 3) 3)
    (= (* 0 5) 0)))
; Run all test cases together, that is, a test suite
(defun test-arithmetic ()
  (combine-results
    (test-+-d)
    (test-*)))
; As more and more test cases are added in, it would be nice to know where a
; failed test comes from, namely, the name of the function containing the test.
(defun report-result-b (result label test-name)
  (format t "~:[FAIL~;pass~] ... ~a:~a~%" result test-name label)
  result)
; However, to make this possible, name of the function has to be passed to the
; `check` macro, which in turn pass the name to the function `report-result`,
; and at last the name is printed. This is so inconvenient, are there any other
; solutions? And the answer is yes, 'dynamic variables' is best friend. Actually,
; this is exactly the kind of problem dynamic variables were designed to solve.
;
; First, declare the variable at the top level
(defvar *test-name* nil)
; Second, change `report-result` to use the dynamic variable
(defun report-result-c (result label)
  (format t "~:[FAIL~;pass~] ... ~a: ~a~%" result *test-name* label)
  result)
; Redeclare other macros and functions
(defmacro check-c (&body forms)
  `(combine-results
    ,@(loop for form in forms collect `(report-result-c ,form ',form))))
; Remeber to binding '*test-name*' to the appropriate before run test
(defun test-+-e ()
  (let ((*test-name* 'test-+-e))
    (check-c
      (= (+ 1 2) 3)
      (= (+ 1 2 3) 6)
      (= (+ -1 -2) -3))))
;;;
(defun test-*-a ()
  (let ((*test-name* 'test-*-a))
    (check-c
      (= (* 2 2) 4)
      (= (* -3 5) -15)
      (= (* 1 3) 3)
      (= (* 0 5) 0))))
;;;
(defun test-arithmetic-a ()
  (combine-results
    (test-+-e)
    (test-*-a)))
;
; Well now, everything seems fairly good, except for the crummy duplication that
; every test has exactly the same three lines of codes that bind '*test-name*'
; to the function name of itself.
; This is because the abstraction of a test is only in the developer's mind, and
; to implement the abstraction, certain patterns has to be followed. To concrete
; the mind abstraction, `macro` is the best choice.
;
; The `deftest` macro expands to a `defun` declaration
(defmacro deftest (test-name params &body body)
  `(defun ,test-name ,params
    (let ((*test-name* ',test-name))
      ,@body)))
; With the `deftest` defined above, new test could be defined as follows:
(deftest test-+-f ()
  (check-c
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -2) -3)))
(deftest test-*-b ()
  (check-c
    (= (* 2 2) 4)
    (= (* -3 5) -15)
    (= (* 1 3) 3)
    (= (* 0 5) 0)))
;;;
(defun test-arithmetic-b ()
  (combine-results
    (test-+-f)
    (test-*-b)))
;
; Test hierarchy
; It is not uncommon for a test to be included in two test suites(context), and
; it's also not unheard of when the test succeeded in one context while failed
; in another. In such situation, there is no way to tell in what context the
; test failed.
; So we need a way to reflect the test hierarchy in the output, for example:
;
; pass ... (TEST-ARITHMETIC TEST-+): (= (+ 1 2) 3)
;
; To implement, we'll play with '*test-name*', and redefine `deftest`.
; @note `combine-results` is applied to `,@body` for this implementation, to
; simplify test suites definition(no `combine-results` is needed in the body).
(defmacro deftest (test-name params &body body)
  `(defun ,test-name ,params
    (let ((*test-name* (append *test-name* (list ',test-name))))
      (combine-results ,@body))))
; Some test cases
(deftest test-+-g ()
  (check-c
    (= (+ 1 2) 3)
    (= (+ 1 2 3) 6)
    (= (+ -1 -2) -3)))
(deftest test-*-c ()
  (check-c
    (= (* 2 2) 4)
    (= (* -3 5) -15)
    (= (* 1 3) 3)
    (= (* 0 5) 0)))
(deftest test-/-a ()
  (check-c
    (= (/ 2 1) 2)
    (= (/ 6 3) 2)))
; New test suites can now be defined with `deftest` macro as follows:
(deftest test-arithmetic-c ()
  (test-+-g)
  (test-*-c))
(deftest test-arithmetic-d ()
  (test-/-a)
  (test-*-c))
(deftest test-math ()
  (test-arithmetic-c)
  (test-arithmetic-d))
;


HOG-OpenCL: Optimizations from Anton

HOG-OpenCL: Optimizations from Anton

Former-commit-id: 9044bb1b566c51054c0188971ccf6c233d02b1cd

#ifndef NUMBER_OF_CELLS
#error NUMBER_OF_CELLS not defined
#endif
#ifndef NUMBER_OF_BINS
#error NUMBER_OF_BINS not defined
#endif
#ifndef GAUSSIAN_WEIGHTS
#error GAUSSIAN_WEIGHTS not defined
#endif
#ifndef SPARTIAL_WEIGHTS
#error SPARTIAL_WEIGHTS not defined
#endif
#ifndef SIGNED_HOG
#error SIGNED_HOG not defined
#endif

#define TOTAL_NUMBER_OF_BINS (NUMBER_OF_CELLS * NUMBER_OF_CELLS * NUMBER_OF_BINS)

//get_global_id(0): per location
//get_global_id(1): x coordinate
//get_global_id(2): y coordinate

inline void atomic_add_float_global(volatile __global float* source, float operand) {
    volatile __global int* sourceAsInt = (volatile __global int*)source;
    int oldVal;
    int oldVal_2 = atomic_add(sourceAsInt, 0);
    do {
        oldVal = oldVal_2;
        float newVal = as_float(oldVal) + operand;
        oldVal_2 = atomic_cmpxchg(sourceAsInt, oldVal, as_int(newVal));
    } while (oldVal_2 != oldVal);
}

#ifndef DISABLE_LOCAL
inline void atomic_add_float_local(volatile __local float* source, float operand) {
    volatile __local int* sourceAsInt = (volatile __local int*)source;
    int oldVal;
    int oldVal_2 = atomic_add(sourceAsInt, 0);
    do {
        oldVal = oldVal_2;
        float newVal = as_float(oldVal) + operand;
        oldVal_2 = atomic_cmpxchg(sourceAsInt, oldVal, as_int(newVal));
    } while (oldVal_2 != oldVal);
}
#endif

// OpenCL 1.1 does not have clEnqueueFillBuffer...
__kernel void fill_zeros(__global float * restrict arr, int size) {
    int i = get_global_id(0);
    if (i < size) {
        arr[i] = 0.0f;
    }
}

//Calculates the intermediate data
__kernel void calc_histogram( const int rows, const int cols, const int step_, __global const unsigned char * restrict image
                            , const int num_locations, __global const float2 * restrict location_global, __global const float2 * restrict blocksize_global
                            , __global float hist_global[][NUMBER_OF_CELLS][NUMBER_OF_CELLS][NUMBER_OF_BINS]
#ifndef DISABLE_LOCAL
                            ,  __local float  hist_local[][NUMBER_OF_CELLS][NUMBER_OF_CELLS][NUMBER_OF_BINS]
#endif
                            )
{
#ifdef DISABLE_LOCAL
    #define atomic_add_float_local atomic_add_float_global
    #define hist_local hist_global
#else
    //Clear hist_local
    for(int a = get_local_id(2); a < num_locations; a+=get_local_size(2)) {
        for(int b = get_local_id(1); b < NUMBER_OF_CELLS; b+=get_local_size(1)) {
            for(int c = get_local_id(0); c < NUMBER_OF_CELLS; c+=get_local_size(0)) {
                for(int n = 0; n < NUMBER_OF_BINS ; ++n) {
                    hist_local[a][b][c][n] = 0.0f;
                }
            }
        }
    }

    barrier(CLK_LOCAL_MEM_FENCE);
#endif
    int locationIdx = get_global_id(2);
    if (locationIdx < num_locations) {
        float2 location = location_global[locationIdx];
        float2 blck_size = blocksize_global[locationIdx];
        int2 img_size = (int2)(cols, rows);

        float2 minloc = location - blck_size * 0.5f;
        float2 maxloc = location + blck_size * 0.5f;

        int2 mini = max(convert_int2_rtp(minloc), 1);
        int2 maxi = min(convert_int2_rtn(maxloc), img_size - 2);

        int2 point = mini + (int2)(get_global_id(0),get_global_id(1));

        if (all(point <= maxi)) {
            //Read the image
            float mdx = image[(point.y  )*step_ + point.x+1] - image[(point.y  )*step_ + point.x-1];
            float mdy = image[(point.y+1)*step_ + point.x  ] - image[(point.y-1)*step_ + point.x  ];

            //calculate the magnitude
            float magnitude = hypot(mdx, mdy);

            //calculate the orientation
#if SIGNED_HOG
            float orientation = atan2pi(mdy, mdx) * 0.5f;
#else
            float orientation = atan2pi(mdy, mdx) + 0.5f;
#endif

#if GAUSSIAN_WEIGHTS
            {
                //float2 sigma = blck_size / 2.0f;
                //float2 sigmaSq = sigma*sigma;
                //float2 m1p2sigmaSq = -1.0f / (2.0f * sigmaSq);
                float2 m1p2sigmaSq = -2.0f / (blck_size * blck_size);
                float2 distance = convert_float2(point) - location;
                float2 distanceSq = distance*distance;
                magnitude *= exp(dot(distanceSq, m1p2sigmaSq));
            }
#endif
            float relative_orientation = orientation * NUMBER_OF_BINS - 0.5f;

            int   bin0        = convert_int_rtn(relative_orientation);
            float bin_weight1 = relative_orientation - convert_float(bin0);

            int   bin1        = 1    + bin0;
            float bin_weight0 = 1.0f - bin_weight1;

            int2   bin        = ((int2)(bin0, bin1) + NUMBER_OF_BINS) % NUMBER_OF_BINS;
            float2 bin_weight = magnitude * (float2)(bin_weight0, bin_weight1);

#if NUMBER_OF_CELLS == 1
            atomic_add_float_local( &(hist_local[locationIdx][0][0][bin.s0]), bin_weight.s0);
            atomic_add_float_local( &(hist_local[locationIdx][0][0][bin.s1]), bin_weight.s1);
#elif SPARTIAL_WEIGHTS
            float2 relative_pos = (convert_float2(point) - minloc) * NUMBER_OF_CELLS / blck_size - 0.5f;
            int2 celli = convert_int2_rtn(relative_pos);

            float2 scale1 = relative_pos - convert_float2(celli);
            float2 scale0 = 1.0f - scale1;

            if (celli.y >= 0 && celli.x >= 0) {
                atomic_add_float_local( &(hist_local[locationIdx][celli.y  ][celli.x  ][bin.s0]), scale0.y * scale0.x * bin_weight.s0);
                atomic_add_float_local( &(hist_local[locationIdx][celli.y  ][celli.x  ][bin.s1]), scale0.y * scale0.x * bin_weight.s1);
            }
            if (celli.y >= 0 && celli.x < NUMBER_OF_CELLS - 1) {
                atomic_add_float_local( &(hist_local[locationIdx][celli.y  ][celli.x+1][bin.s0]), scale0.y * scale1.x * bin_weight.s0);
                atomic_add_float_local( &(hist_local[locationIdx][celli.y  ][celli.x+1][bin.s1]), scale0.y * scale1.x * bin_weight.s1);
            }
            if (celli.y < NUMBER_OF_CELLS - 1 && celli.x >= 0) {
                atomic_add_float_local( &(hist_local[locationIdx][celli.y+1][celli.x  ][bin.s0]), scale1.y * scale0.x * bin_weight.s0);
                atomic_add_float_local( &(hist_local[locationIdx][celli.y+1][celli.x  ][bin.s1]), scale1.y * scale0.x * bin_weight.s1);
            }
            if (celli.y < NUMBER_OF_CELLS - 1 && celli.x < NUMBER_OF_CELLS - 1) {
                atomic_add_float_local( &(hist_local[locationIdx][celli.y+1][celli.x+1][bin.s0]), scale1.y * scale1.x * bin_weight.s0);
                atomic_add_float_local( &(hist_local[locationIdx][celli.y+1][celli.x+1][bin.s1]), scale1.y * scale1.x * bin_weight.s1);
            }
#else
            int2 celli = convert_int2_rtn((convert_float2(point) - minloc) * NUMBER_OF_CELLS / blck_size);

            atomic_add_float_local( &(hist_local[locationIdx][celli.y][celli.x][bin.s0]), bin_weight.s0);
            atomic_add_float_local( &(hist_local[locationIdx][celli.y][celli.x][bin.s1]), bin_weight.s1);
#endif
        }
    }
#ifndef DISABLE_LOCAL
    barrier(CLK_LOCAL_MEM_FENCE);

    //Add local version to global
    for(int a = get_local_id(2); a < num_locations; a+=get_local_size(2)) {
        for(int b = get_local_id(1); b < NUMBER_OF_CELLS; b+=get_local_size(1)) {
            for(int c = get_local_id(0); c < NUMBER_OF_CELLS; c+=get_local_size(0)) {
                for(int n = 0; n < NUMBER_OF_BINS ; ++n) {
                    atomic_add_float_global( &(hist_global[a][b][c][n]), hist_local[a][b][c][n] );
                }
            }
        }
    }
#endif
}

#ifndef NUMBER_OF_CELLS
#error NUMBER_OF_CELLS not defined
#endif
#ifndef NUMBER_OF_BINS
#error NUMBER_OF_BINS not defined
#endif
#ifndef GAUSSIAN_WEIGHTS
#error GAUSSIAN_WEIGHTS not defined
#endif
#ifndef SPARTIAL_WEIGHTS
#error SPARTIAL_WEIGHTS not defined
#endif
#ifndef SIGNED_HOG
#error SIGNED_HOG not defined
#endif

#define TOTAL_NUMBER_OF_BINS (NUMBER_OF_CELLS * NUMBER_OF_CELLS * NUMBER_OF_BINS)

//get_global_id(0): per location
//get_global_id(1): x coordinate
//get_global_id(2): y coordinate

inline void atomic_add_float_global(volatile __global float* source, float operand) {
    volatile __global int* sourceAsInt = (volatile __global int*)source;
    int oldVal;
    int oldVal_2 = atomic_add(sourceAsInt, 0);
    do {
        oldVal = oldVal_2;
        float newVal = as_float(oldVal) + operand;
        oldVal_2 = atomic_cmpxchg(sourceAsInt, oldVal, as_int(newVal));
    } while (oldVal_2 != oldVal);
}

#ifndef DISABLE_LOCAL
inline void atomic_add_float_local(volatile __local float* source, float operand) {
    volatile __local int* sourceAsInt = (volatile __local int*)source;
    int oldVal;
    int oldVal_2 = atomic_add(sourceAsInt, 0);
    do {
        oldVal = oldVal_2;
        float newVal = as_float(oldVal) + operand;
        oldVal_2 = atomic_cmpxchg(sourceAsInt, oldVal, as_int(newVal));
    } while (oldVal_2 != oldVal);
}
#endif

// OpenCL 1.1 does not have clEnqueueFillBuffer...
__kernel void fill_zeros(__global float * restrict arr, int size) {
    int i = get_global_id(0);
    if (i < size) {
        arr[i] = 0.0f;
    }
}

//Calculates the intermediate data
__kernel void calc_histogram( const int rows, const int cols, const int step_, __global const unsigned char * restrict image
                            , const int num_locations, __global const float2 * restrict location_global, __global const float2 * restrict blocksize_global
                            , __global float hist_global[][NUMBER_OF_CELLS][NUMBER_OF_CELLS][NUMBER_OF_BINS]
#ifndef DISABLE_LOCAL
                            ,  __local float  hist_local[][NUMBER_OF_CELLS][NUMBER_OF_CELLS][NUMBER_OF_BINS]
#endif
                            )
{
#ifdef DISABLE_LOCAL
    #define atomic_add_float_local atomic_add_float_global
    #define hist_local hist_global
#else
    //Clear hist_local
    for(int a = get_local_id(2); a < num_locations; a+=get_local_size(2)) {
        for(int b = get_local_id(1); b < NUMBER_OF_CELLS; b+=get_local_size(1)) {
            for(int c = get_local_id(0); c < NUMBER_OF_CELLS; c+=get_local_size(0)) {
                for(int n = 0; n < NUMBER_OF_BINS ; ++n) {
                    hist_local[a][b][c][n] = 0.0f;
                }
            }
        }
    }

    barrier(CLK_LOCAL_MEM_FENCE);
#endif
    int locationIdx = get_global_id(2);
    if (locationIdx < num_locations) {
        float2 location = location_global[locationIdx];
        float2 blck_size = blocksize_global[locationIdx];
        int2 img_size = (int2)(cols, rows);

        float2 minloc = location - blck_size / 2.0f;
        float2 maxloc = location + blck_size / 2.0f;

        int2 mini = max(convert_int2_rtp(minloc), 1);
        int2 maxi = min(convert_int2_rtn(maxloc), img_size - 2);

        int2 point = mini + (int2)(get_global_id(0),get_global_id(1));

        if (all(point <= maxi)) {
            //Read the image
            float mdx = image[(point.y  )*step_ + point.x+1] - image[(point.y  )*step_ + point.x-1];
            float mdy = image[(point.y+1)*step_ + point.x  ] - image[(point.y-1)*step_ + point.x  ];

            //calculate the magnitude
            float magnitude = hypot(mdx, mdy);

            //calculate the orientation
#if SIGNED_HOG
            float orientation = atan2pi(mdy, mdx) / 2.0f;
#else
            float orientation = atan2pi(mdy, mdx) + 0.5f;
#endif

#if GAUSSIAN_WEIGHTS
            {
                float2 sigma = blck_size / 2.0f;
                float2 sigmaSq = sigma*sigma;
                float2 m1p2sigmaSq = -1.0f / (2.0f * sigmaSq);
                float2 distanceSq = pown(convert_float2(point) - location, 2);
                magnitude *= exp(dot(distanceSq, m1p2sigmaSq));
            }
#endif
            float relative_orientation = orientation * NUMBER_OF_BINS - 0.5f;
            int bin1 = convert_int_rtp(relative_orientation);
            int bin0 = bin1 - 1;
            float bin_weight0 = magnitude * (convert_float(bin1) - relative_orientation);
            float bin_weight1 = magnitude * (relative_orientation - convert_float(bin0));
            bin0 = (bin0 + NUMBER_OF_BINS) % NUMBER_OF_BINS;
            bin1 = (bin1 + NUMBER_OF_BINS) % NUMBER_OF_BINS;

#if NUMBER_OF_CELLS == 1
            atomic_add_float_local( &(hist_local[locationIdx][0][0][bin0]), bin_weight0);
            atomic_add_float_local( &(hist_local[locationIdx][0][0][bin1]), bin_weight1);
#elif SPARTIAL_WEIGHTS
            float2 relative_pos = (convert_float2(point) - minloc) * NUMBER_OF_CELLS / blck_size - 0.5f;
            int2 celli = convert_int2_rtn(relative_pos);

            float2 scale1 = relative_pos - convert_float2(celli);
            float2 scale0 = 1.0f - scale1;

            if (celli.y >= 0 && celli.x >= 0) {
                atomic_add_float_local( &(hist_local[locationIdx][celli.y  ][celli.x  ][bin0]), scale0.y * scale0.x * bin_weight0);
                atomic_add_float_local( &(hist_local[locationIdx][celli.y  ][celli.x  ][bin1]), scale0.y * scale0.x * bin_weight1);
            }
            if (celli.y >= 0 && celli.x < NUMBER_OF_CELLS - 1) {
                atomic_add_float_local( &(hist_local[locationIdx][celli.y  ][celli.x+1][bin0]), scale0.y * scale1.x * bin_weight0);
                atomic_add_float_local( &(hist_local[locationIdx][celli.y  ][celli.x+1][bin1]), scale0.y * scale1.x * bin_weight1);
            }
            if (celli.y < NUMBER_OF_CELLS - 1 && celli.x >= 0) {
                atomic_add_float_local( &(hist_local[locationIdx][celli.y+1][celli.x  ][bin0]), scale1.y * scale0.x * bin_weight0);
                atomic_add_float_local( &(hist_local[locationIdx][celli.y+1][celli.x  ][bin1]), scale1.y * scale0.x * bin_weight1);
            }
            if (celli.y < NUMBER_OF_CELLS - 1 && celli.x < NUMBER_OF_CELLS - 1) {
                atomic_add_float_local( &(hist_local[locationIdx][celli.y+1][celli.x+1][bin0]), scale1.y * scale1.x * bin_weight0);
                atomic_add_float_local( &(hist_local[locationIdx][celli.y+1][celli.x+1][bin1]), scale1.y * scale1.x * bin_weight1);
            }
#else
            int2 celli = convert_int2_rtn((convert_float2(point) - minloc) * NUMBER_OF_CELLS / blck_size);

            atomic_add_float_local( &(hist_local[locationIdx][celli.y][celli.x][bin0]), bin_weight0);
            atomic_add_float_local( &(hist_local[locationIdx][celli.y][celli.x][bin1]), bin_weight1);
#endif
        }
    }
#ifndef DISABLE_LOCAL
    barrier(CLK_LOCAL_MEM_FENCE);

    //Add local version to global
    for(int a = get_local_id(2); a < num_locations; a+=get_local_size(2)) {
        for(int b = get_local_id(1); b < NUMBER_OF_CELLS; b+=get_local_size(1)) {
            for(int c = get_local_id(0); c < NUMBER_OF_CELLS; c+=get_local_size(0)) {
                for(int n = 0; n < NUMBER_OF_BINS ; ++n) {
                    atomic_add_float_global( &(hist_global[a][b][c][n]), hist_local[a][b][c][n] );
                }
            }
        }
    }
#endif
}