formatting agin

formatting agin

/*******************************************************************************
 *
 * MIT License
 *
 * Copyright (c) 2017 Advanced Micro Devices, Inc.
 *
 * 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.
 *
 *******************************************************************************/
#define PPCAT_NX(A, B) A##B
#define PPCAT(A, B) PPCAT_NX(A, B)
#define TWO 2
#define FOUR 4
#define EIGHT 8

#if MIOPEN_USE_FP16 == 1
#pragma OPENCL EXTENSION cl_khr_fp16 : enable
#define _FLOAT half
#endif
#if MIOPEN_USE_FP32 == 1
#define _FLOAT float
#endif

#define _FLOAT2 PPCAT(_FLOAT, TWO)
#define _FLOAT4 PPCAT(_FLOAT, FOUR)
#define _FLOAT8 PPCAT(_FLOAT, EIGHT)

#define UNUSED __attribute__((__unused__))

#define MLO_NRN_GROUP_SZ2 1

#define MLO_NEURON_PASTHRU 0                       // x
#define MLO_NEURON_LOGISTIC MLO_NEURON_PASTHRU + 1 //	1 / (1 + e^-x)	//Sigmoid
#define MLO_NEURON_TANH MLO_NEURON_LOGISTIC + 1    //	a * tanh( b * x)
#define MLO_NEURON_RELU MLO_NEURON_TANH + 1        //	max(0, x)
#define MLO_NEURON_SOFTRELU \
    MLO_NEURON_RELU + 1                        //	log(1 + e^x)   // bonomial normal log likelihood
#define MLO_NEURON_ABS MLO_NEURON_SOFTRELU + 1 //	abs(x)
#define MLO_NEURON_POWER MLO_NEURON_ABS + 1    // (a + b * x ) ^power
//#define MLO_NEURON_BRELU		MLO_NEURON_POWER + 1		//	min(a, max(0, x))
//#define MLO_NEURON_SQUARE		BRELU + 1			//	x^2
//#define MLO_NEURON_SQR			MLO_NEURON_SQUARE + 1		//	sqr(x)
//#define MLO_NEURON_LINEAR		MLO_NEURON_SQR	+ 1			//	a + b * x
#define MLO_NEURON_TOTAL MLO_NEURON_POWER + 1

__attribute__((always_inline)) void
ActivationFunction_PassThru(uint n, _FLOAT* res, const _FLOAT* data)
{
    for(uint i = 0; i < n; i++)
    {
        res[i] = data[i];
    }
}

__attribute__((always_inline)) void
ActivationFunction_ReLU(uint n, _FLOAT* res, const _FLOAT* data, _FLOAT slope)
{
    for(uint i = 0; i < n; ++i)
    {
        res[i] = (data[i] > 0) ? data[i] : data[i] * slope;
    }
}

__attribute__((always_inline)) void
ActivationFunction_BReLU(uint n, _FLOAT* res, const _FLOAT* data, _FLOAT alpha)
{

    for(uint i = 0; i < n; ++i)
    {
        res[i] = fmin(alpha, fmax(data[i], 0));
    }
}

__attribute__((always_inline)) void
ActivationFunction_Sigmoid(uint n, _FLOAT* res, const _FLOAT* data)
{
    for(uint i = 0; i < n; i++)
    {
        // 1/(1 + exp(-x))
        res[i] = (_FLOAT)1.f / ((_FLOAT)1.f + exp(-data[i]));
    }
}

__attribute__((always_inline)) void
ActivationFunction_TanH(int n, _FLOAT* res, const _FLOAT* data, _FLOAT alpha, _FLOAT beta)
{
    for(uint i = 0; i < n; i++)
    {
        // (exp(2x) -1) / (exp(2x) + 1)
        res[i] = alpha * tanh(beta * data[i]);
    }
}
__attribute__((always_inline)) void ActivationFunction_Abs(uint n, _FLOAT* res, const _FLOAT* data)
{
    for(uint i = 0; i < n; i++)
    {
        res[i] = fabs(data[i]);
    }
}

__attribute__((always_inline)) void
ActivationFunction_Square(uint n, _FLOAT* res, const _FLOAT* data)
{
    for(uint i = 0; i < n; i++)
    {

        res[i] = data[i] * data[i];
    }
}

__attribute__((always_inline)) void ActivationFunction_Sqrt(uint n, _FLOAT* res, const _FLOAT* data)
{
    for(uint i = 0; i < n; i++)
    {

        res[i] = sqrt(data[i]);
    }
}

__attribute__((always_inline)) void
ActivationFunction_Linear(uint n, _FLOAT* res, const _FLOAT* data, _FLOAT alpha, _FLOAT beta)
{
    for(uint i = 0; i < n; i++)
    {
        // (exp(2x) -1) / (exp(2x) + 1)
        res[i] = alpha + beta * data[i];
    }
}

__attribute__((always_inline)) void ActivationFunction_Power(
    uint n, _FLOAT* res, const _FLOAT* data, _FLOAT power, _FLOAT alpha, _FLOAT beta)
{
    for(uint i = 0; i < n; i++)
    {
        // (shift + scale * x ) ^power
        _FLOAT arg     = alpha + data[i] * beta;
        _FLOAT run_arg = (arg == (_FLOAT)0) ? (_FLOAT)1 : arg;
        res[i]         = (arg == (_FLOAT)0) ? (_FLOAT)0 : pow(run_arg, power);
    }
}

__attribute__((always_inline)) void ActivationFunction_BNLL(uint n, _FLOAT* res, const _FLOAT* data)

{
    for(uint i = 0; i < n; i++)
    {
        //	log(1 + exp(x))
        res[i] = (data[i] > 0) ? data[i] + log((_FLOAT)1.f + exp(-data[i]))
                               : log((_FLOAT)(1.f) + exp(data[i]));
    }
}

void ActivationFunction(
    uint n, _FLOAT* res, const _FLOAT* data, _FLOAT power, _FLOAT alpha, _FLOAT beta)
{
    (void)power;
    (void)alpha;
    (void)beta;
#if MLO_NRN_OP_ID == MLO_NEURON_PASTHRU

    ActivationFunction_PassThru(n, res, data);

#elif MLO_NRN_OP_ID == MLO_NEURON_LOGISTIC
    // 1/(1 + exp(-x))
    ActivationFunction_Sigmoid(n, res, data);

#elif MLO_NRN_OP_ID == MLO_NEURON_TANH
    // (exp(2x) -1) / (exp(2x) + 1)
    ActivationFunction_TanH(n, res, data, alpha, beta);

#elif MLO_NRN_OP_ID == MLO_NEURON_RELU
    ActivationFunction_ReLU(n, res, data, alpha);

//#elif	MLO_NRN_OP_ID==MLO_NEURON_BRELU
//	ActivationFunction_BReLU(n, res, data, alpha);

#elif MLO_NRN_OP_ID == MLO_NEURON_SOFTRELU
    //	log(1 + exp(x))
    ActivationFunction_BNLL(n, res, data);
#elif MLO_NRN_OP_ID == MLO_NEURON_ABS
    ActivationFunction_Abs(n, res, data);

//#elif	MLO_NRN_OP_ID==MLO_NEURON_SQUARE
//	ActivationFunction_Square(res, data);

//#elif	MLO_NRN_OP_ID==MLO_NEURON_SQR
//	ActivationFunction_Sqrt(n, res, data);

#elif MLO_NRN_OP_ID == MLO_NEURON_POWER
    // (shift + scale * x ) ^power

    ActivationFunction_Power(n, res, data, power, alpha, beta);

#endif
}

/******************************************************************************/
/*                                  DIFF                                      */
/******************************************************************************/

static __constant _FLOAT kBNLL_THRESHOLD = (_FLOAT)50.;

__attribute__((always_inline)) void ActivationFunction_ReLU_Diff(uint n,
                                                                 _FLOAT* bot_diff,
                                                                 const _FLOAT* top_diff,
                                                                 const _FLOAT* bot_data,
                                                                 UNUSED _FLOAT negative_slope)
{

    for(uint i = 0; i < n; ++i)
    {
        bot_diff[i] = top_diff[i] * (bot_data[i] > 0);
    }
}

__attribute__((always_inline)) void ActivationFunction_TanH_Diff(uint n,
                                                                 _FLOAT* bot_diff,
                                                                 const _FLOAT* top_diff,
                                                                 const _FLOAT* top_data)
{
    for(uint i = 0; i < n; i++)
    {
        // (exp(2x) -1) / (exp(2x) + 1)
        _FLOAT tanh_x = top_data[i];
        bot_diff[i]   = top_diff[i] * (1 - tanh_x * tanh_x);
    }
}

__attribute__((always_inline)) void ActivationFunction_Sigmoid_Diff(uint n,
                                                                    _FLOAT* bot_diff,
                                                                    const _FLOAT* top_diff,
                                                                    const _FLOAT* top_data)
{
    for(uint i = 0; i < n; i++)
    {
        // 1/(1 + exp(-x))
        _FLOAT sigmoid_x = top_data[i];
        bot_diff[i]      = top_diff[i] * sigmoid_x * ((_FLOAT)1.f - sigmoid_x);
    }
}

__attribute__((always_inline)) void ActivationFunction_Abs_Diff(uint n,
                                                                _FLOAT* bot_diff,
                                                                const _FLOAT* top_diff,
                                                                const _FLOAT* bot_data)
{
    for(uint i = 0; i < n; i++)
    {
        bot_diff[i] = top_diff[i] * ((bot_data[i] >= 0) ? 1 : -1);
    }
}

// Compute dy/dx = scale * power * (shift + scale * x)^(power - 1)
//               = diff_scale * y / (shift + scale * x)
__attribute__((always_inline)) void ActivationFunction_Power_Diff(uint n,
                                                                  _FLOAT* bot_diff,
                                                                  UNUSED const _FLOAT* top_diff,
                                                                  const _FLOAT* top_data,
                                                                  const _FLOAT* bot_data,
                                                                  _FLOAT diff_scale,
                                                                  UNUSED _FLOAT power,
                                                                  _FLOAT scale,
                                                                  _FLOAT shift)
{

    for(uint i = 0; i < n; i++)
    {
        _FLOAT arg = shift + bot_data[i] * scale;
//		bot_diff[i] = (arg == 0) ? 0 : diff_scale * top_data[i] / arg;
#if MIOPEN_USE_FP16 == 1
        bot_diff[i] = (fabs(arg) < (_FLOAT)0.0001) ? (_FLOAT)0 : diff_scale * top_data[i] / arg;
#endif
#if MIOPEN_USE_FP32 == 1
        bot_diff[i] = (fabs(arg) < (_FLOAT)0.000001) ? (_FLOAT)0 : diff_scale * top_data[i] / arg;
#endif
    }
}

__attribute__((always_inline)) void ActivationFunction_BNLL_Diff(uint n,
                                                                 _FLOAT* bot_diff,
                                                                 const _FLOAT* top_diff,
                                                                 const _FLOAT* bot_data)
{
    for(uint i = 0; i < n; i++)
    {
        //	(log(1 + exp(x)))' = 1/ (1 + exp(-x))
        //		_FLOAT kBNLL_THRESHOLD = (_FLOAT)50.;
        _FLOAT expval = exp(fmin(bot_data[i], kBNLL_THRESHOLD));
        bot_diff[i]   = top_diff[i] * expval / (expval + (_FLOAT)1.f);
    }
}

#ifdef LITE

/**********************************************************************************************
**********************************************************************************************/

// N - batch size
// C - # of maps
// H - map height
// W - map width
// TENS_LEN = (N*C*H*W);
// RD_BLCK = (TENS_LEN%4==0) ? 4 : (TENS_LEN%3==0)? 3 : (TENS_LEN%2==0)? 2 : 1;
// READ_TYPE = (RD_BLCK==4) ? "float4" : (RD_BLCK == 3) ? "float3" : (RD_BLC==2) ? "float2" :
// "float";
// local size = (256, 1, 1)
// global size = ((TENS_LEN/RD_BLCK), 1, 1)

__kernel void MIOpenActiveFwdLite(const __global _FLOAT* bot,
                                  __global _FLOAT* top,
                                  _FLOAT power,
                                  _FLOAT scale,
                                  _FLOAT shift,
                                  const long bot_offset,
                                  const long top_offset)
{
    (void)power;
    (void)scale;
    (void)shift;

    uint gid0 = get_global_id(0);

    uint index = gid0 * MLO_READ_UNIT;

    _FLOAT data[MLO_READ_UNIT];
    _FLOAT response[MLO_READ_UNIT];

    *((MLO_READ_TYPE*)data) = *((const __global MLO_READ_TYPE*)(bot + bot_offset + index));

    ActivationFunction(MLO_READ_UNIT, response, (const _FLOAT*)data, power, scale, shift);

    *((__global MLO_READ_TYPE*)(top + top_offset + index)) = *((MLO_READ_TYPE*)response);
}

/**********************************************************************************************
**********************************************************************************************/

__kernel void MIOpenActiveFwd2DLite(const __global _FLOAT* bot,
                                    __global _FLOAT* top,
                                    _FLOAT power,
                                    _FLOAT scale,
                                    _FLOAT shift,
                                    const long bot_offset,
                                    const long top_offset,
                                    const uint bot_stride,
                                    const uint top_stride)
{

    (void)power;
    (void)scale;
    (void)shift;

    uint x_id = get_global_id(0);
    uint y    = get_global_id(1);

    uint bot_index = y * bot_stride + x_id * MLO_READ_UNIT;
    uint top_index = y * top_stride + x_id * MLO_READ_UNIT;

    _FLOAT data[MLO_READ_UNIT];
    _FLOAT response[MLO_READ_UNIT];

    *((MLO_READ_TYPE*)data) = *((const __global MLO_READ_TYPE*)(bot + bot_offset + bot_index));

    ActivationFunction(MLO_READ_UNIT, response, (const _FLOAT*)data, power, scale, shift);

    *((__global MLO_READ_TYPE*)(top + top_offset + top_index)) = *((MLO_READ_TYPE*)response);
}

/**********************************************************************************************
**********************************************************************************************/

__kernel void MIOpenActiveBwdLite(__global _FLOAT* bot_diff,
                                  __global const _FLOAT* top_diff,
                                  __global const _FLOAT* bot,
                                  __global const _FLOAT* top,
                                  _FLOAT diff_scale,
                                  _FLOAT power,
                                  _FLOAT scale,
                                  _FLOAT shift,
                                  const long bot_diff_offset,
                                  const long top_diff_offset,
                                  const long bot_offset,
                                  const long top_offset)
{
    (void)diff_scale;
    (void)power;
    (void)scale;
    (void)shift;

    int gid0 = get_global_id(0);

    int index = gid0 * MLO_READ_UNIT;

    _FLOAT bot_diff_dat[MLO_READ_UNIT];
    _FLOAT top_diff_dat[MLO_READ_UNIT];
    _FLOAT bot_dat[MLO_READ_UNIT];
    _FLOAT top_dat[MLO_READ_UNIT];

    *((MLO_READ_TYPE*)top_diff_dat) =
        *((const __global MLO_READ_TYPE*)(top_diff + top_diff_offset + index));
    *((MLO_READ_TYPE*)bot_dat) = *((const __global MLO_READ_TYPE*)(bot + bot_offset + index));
    *((MLO_READ_TYPE*)top_dat) = *((const __global MLO_READ_TYPE*)(top + top_offset + index));

#if MLO_NRN_OP_ID == MLO_NEURON_RELU
    {
        ActivationFunction_ReLU_Diff(MLO_READ_UNIT,
                                     bot_diff_dat,
                                     (const _FLOAT*)top_diff_dat,
                                     (const _FLOAT*)bot_dat,
                                     scale);
    }
#elif MLO_NRN_OP_ID == MLO_NEURON_LOGISTIC
    // 1/(1 + exp(-x))
    ActivationFunction_Sigmoid_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)top_dat);
#elif MLO_NRN_OP_ID == MLO_NEURON_TANH
    // (exp(2x) -1) / (exp(2x) + 1)

    ActivationFunction_TanH_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)top_dat);

#elif MLO_NRN_OP_ID == MLO_NEURON_ABS

    ActivationFunction_Abs_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)bot_dat);
#elif MLO_NRN_OP_ID == MLO_NEURON_POWER
    // (shift + scale * x ) ^power

    ActivationFunction_Power_Diff(MLO_READ_UNIT,
                                  bot_diff_dat,
                                  (const _FLOAT*)top_diff_dat,
                                  (const _FLOAT*)top_dat,
                                  (const _FLOAT*)bot_dat,
                                  diff_scale,
                                  power,
                                  scale,
                                  shift);

#elif MLO_NRN_OP_ID == MLO_NEURON_SOFTRELU
    //	log(1 + exp(x))
    ActivationFunction_BNLL_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)bot_dat);
#endif

    *((__global MLO_READ_TYPE*)(bot_diff + bot_diff_offset + index)) =
        *((MLO_READ_TYPE*)bot_diff_dat);
}

/**********************************************************************************************
**********************************************************************************************/

__kernel void MIOpenActiveBwd2DLite(__global _FLOAT* bot_diff,
                                    __global const _FLOAT* top_diff,
                                    __global const _FLOAT* bot,
                                    __global const _FLOAT* top,
                                    _FLOAT diff_scale,
                                    _FLOAT power,
                                    _FLOAT scale,
                                    _FLOAT shift,
                                    const long bot_diff_offset,
                                    const long top_diff_offset,
                                    const long bot_offset,
                                    const long top_offset,
                                    const uint bot_diff_stride,
                                    const uint top_diff_stride,
                                    const uint bot_stride,
                                    const uint top_stride)
{
    (void)diff_scale;
    (void)power;
    (void)scale;
    (void)shift;

    uint x_id = get_global_id(0);
    uint y    = get_global_id(1);

    uint bot_diff_index = y * bot_diff_stride + x_id * MLO_READ_UNIT;
    uint top_diff_index = y * top_diff_stride + x_id * MLO_READ_UNIT;
    uint bot_index      = y * bot_stride + x_id * MLO_READ_UNIT;
    uint top_index      = y * top_stride + x_id * MLO_READ_UNIT;

    _FLOAT bot_diff_dat[MLO_READ_UNIT];
    _FLOAT top_diff_dat[MLO_READ_UNIT];
    _FLOAT bot_dat[MLO_READ_UNIT];
    _FLOAT top_dat[MLO_READ_UNIT];

    *((MLO_READ_TYPE*)top_diff_dat) =
        *((const __global MLO_READ_TYPE*)(top_diff + top_diff_offset + top_diff_index));
    *((MLO_READ_TYPE*)bot_dat) = *((const __global MLO_READ_TYPE*)(bot + bot_offset + bot_index));
    *((MLO_READ_TYPE*)top_dat) = *((const __global MLO_READ_TYPE*)(top + top_offset + top_index));

#if MLO_NRN_OP_ID == MLO_NEURON_RELU
    {
        ActivationFunction_ReLU_Diff(MLO_READ_UNIT,
                                     bot_diff_dat,
                                     (const _FLOAT*)top_diff_dat,
                                     (const _FLOAT*)bot_dat,
                                     scale);
    }
#elif MLO_NRN_OP_ID == MLO_NEURON_LOGISTIC
    // 1/(1 + exp(-x))
    ActivationFunction_Sigmoid_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)top_dat);
#elif MLO_NRN_OP_ID == MLO_NEURON_TANH
    // (exp(2x) -1) / (exp(2x) + 1)

    ActivationFunction_TanH_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)top_dat);

#elif MLO_NRN_OP_ID == MLO_NEURON_ABS

    ActivationFunction_Abs_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)bot_dat);
#elif MLO_NRN_OP_ID == MLO_NEURON_POWER
    // (shift + scale * x ) ^power

    ActivationFunction_Power_Diff(MLO_READ_UNIT,
                                  bot_diff_dat,
                                  (const _FLOAT*)top_diff_dat,
                                  (const _FLOAT*)top_dat,
                                  (const _FLOAT*)bot_dat,
                                  diff_scale,
                                  power,
                                  scale,
                                  shift);

#elif MLO_NRN_OP_ID == MLO_NEURON_SOFTRELU
    //	log(1 + exp(x))
    ActivationFunction_BNLL_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)bot_dat);
#endif

    *((__global MLO_READ_TYPE*)(bot_diff + bot_diff_offset + bot_diff_index)) =
        *((MLO_READ_TYPE*)bot_diff_dat);
}

/**************************************************************************************************************/

#else

/***************************************************************************************************************/
__attribute__((reqd_work_group_size(MLO_NRN_GROUP_SZ0, MLO_NRN_GROUP_SZ1, MLO_NRN_GROUP_SZ2)))
__kernel void
MIOpenNeuronFwd(const __global _FLOAT* bot,
                __global _FLOAT* top,
                _FLOAT power,
                _FLOAT scale,
                _FLOAT shift,
                const long xOffset,
                const long yOffset)
{
    int x            = get_global_id(0); // channel x

#if MLO_N_OUT_STRIDE > MLO_OUT_BLOCK_SZ
    int n_out_stride = MLO_N_OUT_STRIDE;
    int c_out        = MLO_C_OUT;
    int h_out        = MLO_H_OUT;
    int w_out        = MLO_W_OUT;
#endif
#if MLO_N_IN_STRIDE > MLO_IN_BLOCK_SZ
    int n_in_stride  = MLO_N_IN_STRIDE;
    int c_in         = MLO_C_IN;
    int h_in         = MLO_H_IN;
    int w_in         = MLO_W_IN;
#endif

    _FLOAT data[MLO_READ_UNIT];
    _FLOAT response[MLO_READ_UNIT];
#if MLO_N_PIXS_OFF > 0
    if(x == MLO_MAP_SZ_ALIGNED - 1)
    {
        int i = 0;
        for(; i < MLO_N_PIXS_OFF; ++i)
        {
#if MLO_N_IN_STRIDE > MLO_IN_BLOCK_SZ
            if(n_in_stride > c_in * h_in * w_in && c_in != 0 && h_in != 0 && w_in != 0)
            {
                int loc, n_loc, c_loc, h_loc, w_loc;
                loc   = x * MLO_READ_UNIT + i;
                n_loc = loc / (MLO_C_IN * MLO_H_IN * MLO_W_IN);
                c_loc = (loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) / (MLO_H_IN * MLO_W_IN);
                h_loc =
                    ((loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) % (MLO_H_IN * MLO_W_IN)) / MLO_W_IN;
                w_loc =
                    ((loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) % (MLO_H_IN * MLO_W_IN)) % MLO_W_IN;

                data[i] = bot[xOffset + n_loc * MLO_N_IN_STRIDE + c_loc * MLO_C_IN_STRIDE +
                              h_loc * MLO_H_IN_STRIDE + w_loc * MLO_W_IN_STRIDE];
            }
            else
#endif
            {
                data[i] = bot[xOffset + x * MLO_READ_UNIT + i];
            }
        }
        for(; i < MLO_READ_UNIT; ++i)
        {
            data[i] = (_FLOAT)1.f;
        }
    }
    else
#endif
    {
        for(int i = 0; i < MLO_READ_UNIT; ++i)
        {
#if MLO_N_IN_STRIDE > MLO_IN_BLOCK_SZ
            if(n_in_stride > c_in * h_in * w_in && c_in != 0 && h_in != 0 && w_in != 0)
            {
                int loc, n_loc, c_loc, h_loc, w_loc;
                loc   = x * MLO_READ_UNIT + i;
                n_loc = loc / (MLO_C_IN * MLO_H_IN * MLO_W_IN);
                c_loc = (loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) / (MLO_H_IN * MLO_W_IN);
                h_loc =
                    ((loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) % (MLO_H_IN * MLO_W_IN)) / MLO_W_IN;
                w_loc =
                    ((loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) % (MLO_H_IN * MLO_W_IN)) % MLO_W_IN;

                data[i] = bot[xOffset + n_loc * MLO_N_IN_STRIDE + c_loc * MLO_C_IN_STRIDE +
                              h_loc * MLO_H_IN_STRIDE + w_loc * MLO_W_IN_STRIDE];
            }
            else
#endif
            {
                data[i] = bot[xOffset + x * MLO_READ_UNIT + i];
            }
        }
    }
    ActivationFunction(MLO_READ_UNIT, response, (const _FLOAT*)data, power, scale, shift);

#if MLO_N_PIXS_OFF > 0
    if(x == MLO_MAP_SZ_ALIGNED - 1)
    {
        int i = 0;
        for(; i < MLO_N_PIXS_OFF; ++i)
        {
#if MLO_N_OUT_STRIDE > MLO_OUT_BLOCK_SZ
            if(n_out_stride > c_out * h_out * w_out && c_out != 0 && h_out != 0 && w_out != 0)
            {
                int loc, n_loc, c_loc, h_loc, w_loc;
                loc   = x * MLO_READ_UNIT + i;
                n_loc = loc / (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT);
                c_loc = (loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) / (MLO_H_OUT * MLO_W_OUT);
                h_loc = ((loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) % (MLO_H_OUT * MLO_W_OUT)) /
                        MLO_W_OUT;
                w_loc = ((loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) % (MLO_H_OUT * MLO_W_OUT)) %
                        MLO_W_OUT;

                top[yOffset + n_loc * MLO_N_OUT_STRIDE + c_loc * MLO_C_OUT_STRIDE +
                    h_loc * MLO_H_OUT_STRIDE + w_loc * MLO_W_OUT_STRIDE] = response[i];
            }
            else
#endif
            {
                top[yOffset + x * MLO_READ_UNIT + i] = response[i];
            }
        }
    }
    else
#endif
    {
        for(int i = 0; i < MLO_READ_UNIT; ++i)
        {
#if MLO_N_OUT_STRIDE > MLO_OUT_BLOCK_SZ
            if(n_out_stride > c_out * h_out * w_out && c_out != 0 && h_out != 0 && w_out != 0)
            {
                int loc, n_loc, c_loc, h_loc, w_loc;
                loc   = x * MLO_READ_UNIT + i;
                n_loc = loc / (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT);
                c_loc = (loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) / (MLO_H_OUT * MLO_W_OUT);
                h_loc = ((loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) % (MLO_H_OUT * MLO_W_OUT)) /
                        MLO_W_OUT;
                w_loc = ((loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) % (MLO_H_OUT * MLO_W_OUT)) %
                        MLO_W_OUT;

                top[yOffset + n_loc * MLO_N_OUT_STRIDE + c_loc * MLO_C_OUT_STRIDE +
                    h_loc * MLO_H_OUT_STRIDE + w_loc * MLO_W_OUT_STRIDE] = response[i];
            }
            else
#endif
            {
                top[yOffset + x * MLO_READ_UNIT + i] = response[i];
            }
        }
    }
}

__attribute__((reqd_work_group_size(MLO_NRN_GROUP_SZ0, MLO_NRN_GROUP_SZ1, MLO_NRN_GROUP_SZ2)))
__kernel void
MIOpenNeuronBwd(__global _FLOAT* bot_diff,
                __global const _FLOAT* top_diff,
                __global const _FLOAT* bot_data,
                __global const _FLOAT* top_data,
                _FLOAT diff_scale,
                _FLOAT power,
                _FLOAT scale,
                _FLOAT shift,
                const long dxOffset,
                const long dyOffset,
                const long xOffset,
                const long yOffset)
{
    (void)diff_scale;
    (void)power;
    (void)scale;
    (void)shift;
    int x             = get_global_id(0); // channel x

#if MLO_N_OUT_STRIDE > MLO_OUT_BLOCK_SZ || MLO_N_DOUT_STRIDE > MLO_DOUT_BLOCK_SZ || \
    MLO_N_IN_STRIDE > MLO_IN_BLOCK_SZ
    int n_out_stride  = MLO_N_OUT_STRIDE;
    int c_out         = MLO_C_OUT;
    int h_out         = MLO_H_OUT;
    int w_out         = MLO_W_OUT;
    int n_dout_stride = MLO_N_DOUT_STRIDE;
    int c_dout        = MLO_C_DOUT;
    int h_dout        = MLO_H_DOUT;
    int w_dout        = MLO_W_DOUT;
    int n_in_stride   = MLO_N_IN_STRIDE;
    int c_in          = MLO_C_IN;
    int h_in          = MLO_H_IN;
    int w_in          = MLO_W_IN;
#endif

#if MLO_N_DIN_STRIDE > MLO_DIN_BLOCK_SZ
    int n_din_stride  = MLO_N_DIN_STRIDE;
    int c_din         = MLO_C_DIN;
    int h_din         = MLO_H_DIN;
    int w_din         = MLO_W_DIN;
#endif

    _FLOAT bot_diff_dat[MLO_READ_UNIT];
    _FLOAT top_diff_dat[MLO_READ_UNIT];
    _FLOAT bot_dat[MLO_READ_UNIT];
    _FLOAT top_dat[MLO_READ_UNIT];
#if MLO_N_PIXS_OFF > 0
    if(x == MLO_MAP_SZ_ALIGNED - 1)
    {
        int i = 0;
        for(; i < MLO_N_PIXS_OFF; ++i)
        {
#if MLO_N_OUT_STRIDE > MLO_OUT_BLOCK_SZ || MLO_N_DOUT_STRIDE > MLO_DOUT_BLOCK_SZ || \
    MLO_N_IN_STRIDE > MLO_IN_BLOCK_SZ
            if((n_out_stride > c_out * h_out * w_out || n_dout_stride > c_dout * h_dout * w_dout ||
                n_in_stride > c_in * h_in * w_in) &&
               c_out != 0 && h_out != 0 && w_out != 0 && c_dout != 0 && h_dout != 0 &&
               w_dout != 0 && c_in != 0 && h_in != 0 && w_in != 0)
            {
                int loc, n_loc_top_diff, c_loc_top_diff, h_loc_top_diff, w_loc_top_diff, n_loc_top,
                    c_loc_top, h_loc_top, w_loc_top, n_loc_bot, c_loc_bot, h_loc_bot, w_loc_bot;
                loc = x * MLO_READ_UNIT + i;

                n_loc_top_diff = loc / (MLO_C_DOUT * MLO_H_DOUT * MLO_W_DOUT);
                c_loc_top_diff =
                    (loc % (MLO_C_DOUT * MLO_H_DOUT * MLO_W_DOUT)) / (MLO_H_DOUT * MLO_W_DOUT);
                h_loc_top_diff =
                    ((loc % (MLO_C_DOUT * MLO_H_DOUT * MLO_W_DOUT)) % (MLO_H_DOUT * MLO_W_DOUT)) /
                    MLO_W_DOUT;
                w_loc_top_diff =
                    ((loc % (MLO_C_DOUT * MLO_H_DOUT * MLO_W_DOUT)) % (MLO_H_DOUT * MLO_W_DOUT)) %
                    MLO_W_DOUT;

                n_loc_top = loc / (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT);
                c_loc_top = (loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) / (MLO_H_OUT * MLO_W_OUT);
                h_loc_top =
                    ((loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) % (MLO_H_OUT * MLO_W_OUT)) /
                    MLO_W_OUT;
                w_loc_top =
                    ((loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) % (MLO_H_OUT * MLO_W_OUT)) %
                    MLO_W_OUT;

                n_loc_bot = loc / (MLO_C_IN * MLO_H_IN * MLO_W_IN);
                c_loc_bot = (loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) / (MLO_H_IN * MLO_W_IN);
                h_loc_bot =
                    ((loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) % (MLO_H_IN * MLO_W_IN)) / MLO_W_IN;
                w_loc_bot =
                    ((loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) % (MLO_H_IN * MLO_W_IN)) % MLO_W_IN;

                top_diff_dat[i] = top_diff[dyOffset + n_loc_top_diff * MLO_N_DOUT_STRIDE +
                                           c_loc_top_diff * MLO_C_DOUT_STRIDE +
                                           h_loc_top_diff * MLO_H_DOUT_STRIDE +
                                           w_loc_top_diff * MLO_W_DOUT_STRIDE];
                bot_dat[i] =
                    bot_data[xOffset + n_loc_bot * MLO_N_IN_STRIDE + c_loc_bot * MLO_C_IN_STRIDE +
                             h_loc_bot * MLO_H_IN_STRIDE + w_loc_bot * MLO_W_IN_STRIDE];
                top_dat[i] =
                    top_data[yOffset + n_loc_top * MLO_N_OUT_STRIDE + c_loc_top * MLO_C_OUT_STRIDE +
                             h_loc_top * MLO_H_OUT_STRIDE + w_loc_top * MLO_W_OUT_STRIDE];
            }
            else
#endif
            {
                top_diff_dat[i] = top_diff[dyOffset + x * MLO_READ_UNIT + i];
                bot_dat[i]      = bot_data[xOffset + x * MLO_READ_UNIT + i];
                top_dat[i]      = top_data[yOffset + x * MLO_READ_UNIT + i];
            }
        }
        for(; i < MLO_READ_UNIT; ++i)
        {
            top_diff_dat[i] = (_FLOAT)1.f;
            bot_dat[i]      = (_FLOAT)1.f;
            top_dat[i]      = (_FLOAT)1.f;
        }
    }
    else
#endif
    {
        for(int i = 0; i < MLO_READ_UNIT; ++i)
        {
#if MLO_N_OUT_STRIDE > MLO_OUT_BLOCK_SZ || MLO_N_DOUT_STRIDE > MLO_DOUT_BLOCK_SZ || \
    MLO_N_IN_STRIDE > MLO_IN_BLOCK_SZ
            if((n_out_stride > c_out * h_out * w_out || n_dout_stride > c_dout * h_dout * w_dout ||
                n_in_stride > c_in * h_in * w_in) &&
               c_out != 0 && h_out != 0 && w_out != 0 && c_dout != 0 && h_dout != 0 &&
               w_dout != 0 && c_in != 0 && h_in != 0 && w_in != 0)
            {
                int loc, n_loc_top_diff, c_loc_top_diff, h_loc_top_diff, w_loc_top_diff, n_loc_top,
                    c_loc_top, h_loc_top, w_loc_top, n_loc_bot, c_loc_bot, h_loc_bot, w_loc_bot;
                loc = x * MLO_READ_UNIT + i;

                n_loc_top_diff = loc / (MLO_C_DOUT * MLO_H_DOUT * MLO_W_DOUT);
                c_loc_top_diff =
                    (loc % (MLO_C_DOUT * MLO_H_DOUT * MLO_W_DOUT)) / (MLO_H_DOUT * MLO_W_DOUT);
                h_loc_top_diff =
                    ((loc % (MLO_C_DOUT * MLO_H_DOUT * MLO_W_DOUT)) % (MLO_H_DOUT * MLO_W_DOUT)) /
                    MLO_W_DOUT;
                w_loc_top_diff =
                    ((loc % (MLO_C_DOUT * MLO_H_DOUT * MLO_W_DOUT)) % (MLO_H_DOUT * MLO_W_DOUT)) %
                    MLO_W_DOUT;

                n_loc_top = loc / (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT);
                c_loc_top = (loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) / (MLO_H_OUT * MLO_W_OUT);
                h_loc_top =
                    ((loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) % (MLO_H_OUT * MLO_W_OUT)) /
                    MLO_W_OUT;
                w_loc_top =
                    ((loc % (MLO_C_OUT * MLO_H_OUT * MLO_W_OUT)) % (MLO_H_OUT * MLO_W_OUT)) %
                    MLO_W_OUT;

                n_loc_bot = loc / (MLO_C_IN * MLO_H_IN * MLO_W_IN);
                c_loc_bot = (loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) / (MLO_H_IN * MLO_W_IN);
                h_loc_bot =
                    ((loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) % (MLO_H_IN * MLO_W_IN)) / MLO_W_IN;
                w_loc_bot =
                    ((loc % (MLO_C_IN * MLO_H_IN * MLO_W_IN)) % (MLO_H_IN * MLO_W_IN)) % MLO_W_IN;

                top_diff_dat[i] = top_diff[dyOffset + n_loc_top_diff * MLO_N_DOUT_STRIDE +
                                           c_loc_top_diff * MLO_C_DOUT_STRIDE +
                                           h_loc_top_diff * MLO_H_DOUT_STRIDE +
                                           w_loc_top_diff * MLO_W_DOUT_STRIDE];
                bot_dat[i] =
                    bot_data[xOffset + n_loc_bot * MLO_N_IN_STRIDE + c_loc_bot * MLO_C_IN_STRIDE +
                             h_loc_bot * MLO_H_IN_STRIDE + w_loc_bot * MLO_W_IN_STRIDE];
                top_dat[i] =
                    top_data[yOffset + n_loc_top * MLO_N_OUT_STRIDE + c_loc_top * MLO_C_OUT_STRIDE +
                             h_loc_top * MLO_H_OUT_STRIDE + w_loc_top * MLO_W_OUT_STRIDE];
            }
            else
#endif
            {
                top_diff_dat[i] = top_diff[dyOffset + x * MLO_READ_UNIT + i];
                bot_dat[i]      = bot_data[xOffset + x * MLO_READ_UNIT + i];
                top_dat[i]      = top_data[yOffset + x * MLO_READ_UNIT + i];
            }
        }
    }

#if MLO_NRN_OP_ID == MLO_NEURON_RELU
    {
        ActivationFunction_ReLU_Diff(MLO_READ_UNIT,
                                     bot_diff_dat,
                                     (const _FLOAT*)top_diff_dat,
                                     (const _FLOAT*)bot_dat,
                                     scale);
    }
#elif MLO_NRN_OP_ID == MLO_NEURON_LOGISTIC
    // 1/(1 + exp(-x))
    ActivationFunction_Sigmoid_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)top_dat);
#elif MLO_NRN_OP_ID == MLO_NEURON_TANH
    // (exp(2x) -1) / (exp(2x) + 1)

    ActivationFunction_TanH_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)top_dat);

#elif MLO_NRN_OP_ID == MLO_NEURON_ABS

    ActivationFunction_Abs_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)bot_dat);
#elif MLO_NRN_OP_ID == MLO_NEURON_POWER
    // (shift + scale * x ) ^power

    ActivationFunction_Power_Diff(MLO_READ_UNIT,
                                  bot_diff_dat,
                                  (const _FLOAT*)top_diff_dat,
                                  (const _FLOAT*)top_dat,
                                  (const _FLOAT*)bot_dat,
                                  diff_scale,
                                  power,
                                  scale,
                                  shift);

#elif MLO_NRN_OP_ID == MLO_NEURON_SOFTRELU
    //	log(1 + exp(x))
    ActivationFunction_BNLL_Diff(
        MLO_READ_UNIT, bot_diff_dat, (const _FLOAT*)top_diff_dat, (const _FLOAT*)bot_dat);
#endif

#if MLO_N_PIXS_OFF > 0
    if(x == MLO_MAP_SZ_ALIGNED - 1)
    {
        int i = 0;
        for(; i < MLO_N_PIXS_OFF; ++i)
        {
#if MLO_N_DIN_STRIDE > MLO_DIN_BLOCK_SZ
            if(n_din_stride > c_din * h_din * w_din && c_din != 0 && h_din != 0 && w_din != 0)
            {
                int loc, n_loc_bot_diff, c_loc_bot_diff, h_loc_bot_diff, w_loc_bot_diff;
                loc = x * MLO_READ_UNIT + i;

                n_loc_bot_diff = loc / (MLO_C_DIN * MLO_H_DIN * MLO_W_DIN);
                c_loc_bot_diff =
                    (loc % (MLO_C_DIN * MLO_H_DIN * MLO_W_DIN)) / (MLO_H_DIN * MLO_W_DIN);
                h_loc_bot_diff =
                    ((loc % (MLO_C_DIN * MLO_H_DIN * MLO_W_DIN)) % (MLO_H_DIN * MLO_W_DIN)) /
                    MLO_W_DIN;
                w_loc_bot_diff =
                    ((loc % (MLO_C_DIN * MLO_H_DIN * MLO_W_DIN)) % (MLO_H_DIN * MLO_W_DIN)) %
                    MLO_W_DIN;

                bot_diff[dxOffset + n_loc_bot_diff * MLO_N_DIN_STRIDE +
                         c_loc_bot_diff * MLO_C_DIN_STRIDE + h_loc_bot_diff * MLO_H_DIN_STRIDE +
                         w_loc_bot_diff * MLO_W_DIN_STRIDE] = bot_diff_dat[i];
            }
            else
#endif
            {
                bot_diff[dxOffset + x * MLO_READ_UNIT + i] = bot_diff_dat[i];
            }
        }
    }
    else
#endif
    {
        for(int i = 0; i < MLO_READ_UNIT; ++i)
        {
#if MLO_N_DIN_STRIDE > MLO_DIN_BLOCK_SZ
            if(n_din_stride > c_din * h_din * w_din && c_din != 0 && h_din != 0 && w_din != 0)
            {
                int loc, n_loc_bot_diff, c_loc_bot_diff, h_loc_bot_diff, w_loc_bot_diff;
                loc = x * MLO_READ_UNIT + i;

                n_loc_bot_diff = loc / (MLO_C_DIN * MLO_H_DIN * MLO_W_DIN);
                c_loc_bot_diff =
                    (loc % (MLO_C_DIN * MLO_H_DIN * MLO_W_DIN)) / (MLO_H_DIN * MLO_W_DIN);
                h_loc_bot_diff =
                    ((loc % (MLO_C_DIN * MLO_H_DIN * MLO_W_DIN)) % (MLO_H_DIN * MLO_W_DIN)) /
                    MLO_W_DIN;
                w_loc_bot_diff =
                    ((loc % (MLO_C_DIN * MLO_H_DIN * MLO_W_DIN)) % (MLO_H_DIN * MLO_W_DIN)) %
                    MLO_W_DIN;

                bot_diff[dxOffset + n_loc_bot_diff * MLO_N_DIN_STRIDE +
                         c_loc_bot_diff * MLO_C_DIN_STRIDE + h_loc_bot_diff * MLO_H_DIN_STRIDE +
                         w_loc_bot_diff * MLO_W_DIN_STRIDE] = bot_diff_dat[i];
            }
            else
#endif
            {
                bot_diff[dxOffset + x * MLO_READ_UNIT + i] = bot_diff_dat[i];
            }
        }
    }
}

#endif
// #ifdef LITE


r1774: more implementation

r1774: more implementation

;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          tester-clsql.cl
;;;; Purpose:       Automated test of CLSQL using ACL's tester
;;;; Programmer:    Kevin M. Rosenberg
;;;; Date Started:  Mar 2002
;;;;
;;;; $Id: tester-clsql.cl,v 1.2 2002/04/08 02:52:39 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************

(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :cl-user)

(unless (find-package :util.test)
  (load (make-pathname :name "acl-compat-tester" :type "cl"
		       :defaults *load-truename*)))

(in-package :clsql-user)
(use-package :util.test)

(defvar *config-pathname* (make-pathname :name "test"
					 :type "config"
					 :defaults *load-truename*))

(defclass conn-specs ()
  ((aodbc-spec :accessor aodbc-spec)
   (mysql-spec :accessor mysql-spec)
   (pgsql-spec :accessor pgsql-spec)
   (pgsql-socket-spec :accessor pgsql-socket-spec))
  (:documentation "Test fixture for CLSQL testing"))

(error "Not yet implemented")

(defmethod setup ((fix conn-specs))
  (if (probe-file *config-pathname*)
      (let (config)
	(with-open-file (stream *config-pathname* :direction :input)
	  (setq config (read stream)))
	(setf (aodbc-spec fix) (cadr (assoc :aodbc config)))
	(setf (mysql-spec fix) (cadr (assoc :mysql config)))
	(setf (pgsql-spec fix) (cadr (assoc :postgresql config)))
	(setf (pgsql-socket-spec fix)
	      (cadr (assoc :postgresql-socket config))))
      (error "XPTest Config file ~S not found" *config-pathname*)))

(defmethod teardown ((fix conn-specs))
  t)

(defmethod mysql-table-test ((test conn-specs))
  (test-table (mysql-spec test) :mysql))

(defmethod aodbc-table-test ((test conn-specs))
  (test-table (aodbc-spec test) :aodbc))

(defmethod pgsql-table-test ((test conn-specs))
  (test-table (pgsql-spec test) :postgresql))

(defmethod pgsql-socket-table-test ((test conn-specs))
  (test-table (pgsql-socket-spec test) :postgresql-socket))

(defmethod test-table (spec type)
  (when spec
    (let ((db (clsql:connect spec :database-type type :if-exists :new)))
      (unwind-protect
	   (progn
	     (create-test-table db)
	     (dolist (row (query "select * from test_clsql" :database db :types :auto))
	       (test-table-row row :auto))
	     (dolist (row (query "select * from test_clsql" :database db :types nil))
	       (test-table-row row nil))
	     (loop for row across (map-query 'vector #'list "select * from test_clsql"
					     :database db :types :auto)
		   do (test-table-row row :auto))
	     (loop for row across (map-query 'vector #'list "select * from test_clsql"
					     :database db :types nil)
		   do (test-table-row row nil))
	     (loop for row in (map-query 'list #'list "select * from test_clsql"
					 :database db :types nil)
		   do (test-table-row row nil))
	     (loop for row in (map-query 'list #'list "select * from test_clsql"
					 :database db :types :auto)
		   do (test-table-row row :auto))
	     (when (map-query nil #'list "select * from test_clsql"
					 :database db :types :auto)
	       (failure "Expected NIL result from map-query nil"))
	     (do-query ((int float bigint str) "select * from test_clsql")
	       (test-table-row (list int float bigint str) nil))
	     (do-query ((int float bigint str) "select * from test_clsql" :types :auto)
	       (test-table-row (list int float bigint str) :auto))
	     (drop-test-table db)
	     )
	(disconnect :database db)))))

(defmethod mysql-low-level ((test conn-specs))
  (let ((spec (mysql-spec test)))
    (when spec
      (let ((db (clsql-mysql::database-connect spec :mysql)))
	(clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
	(clsql-mysql::database-execute-command
	 "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
	(dotimes (i 10)
	  (clsql-mysql::database-execute-command
	   (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
		   i (number-to-sql-string (sqrt i))
		   (number-to-sql-string (sqrt i)))
	   db))
	(let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
	  (unless (= 10 (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
	    (failure "Error calling mysql-num-rows"))
	  (clsql-mysql::database-dump-result-set res db))
	(clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
	(clsql-mysql::database-disconnect db)))))

(defparameter clsql-test-suite
    (make-test-suite
     "CLSQL Test Suite"
     "Basic test suite for database operations."
     ("MySQL Low Level Interface" 'conn-specs
		   :test-thunk 'mysql-low-level
		   :description "A test of MySQL low-level interface")
     ("MySQL Table" 'conn-specs
		   :test-thunk 'mysql-table-test
		   :description "A test of MySQL")
     ("PostgreSQL Table" 'conn-specs
		   :test-thunk 'pgsql-table-test
		   :description "A test of PostgreSQL tables")
     ("PostgreSQL Socket Table" 'conn-specs
		   :test-thunk 'pgsql-socket-table-test
		   :description "A test of PostgreSQL Socket tables")
  ))

#+allegro
(add-test (make-test-case "AODBC table test" 'conn-specs
			  :test-thunk 'aodbc-table-test
			  :description "Test AODBC table")
	  clsql-test-suite)

;;;; Testing functions

(defun transform-float-1 (i)
  (* i (abs (/ i 2)) (expt 10 (* 2 i))))

(defun transform-bigint-1 (i)
  (* i (expt 10 (* 3 (abs i)))))

(defun create-test-table (db)
  (ignore-errors
    (clsql:execute-command
     "DROP TABLE test_clsql" :database db))
  (clsql:execute-command
   "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))"
   :database db)
  (dotimes (i 11)
    (let* ((test-int (- i 5))
	   (test-flt (transform-float-1 test-int)))
      (clsql:execute-command
       (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')"
	       test-int
	       (number-to-sql-string test-flt)
	       (transform-bigint-1 test-int)
	       (number-to-sql-string test-flt)
	       )
       :database db))))

(defun parse-double (num-str)
  (let ((*read-default-float-format* 'double-float))
    (coerce (read-from-string num-str) 'double-float)))

(defun test-table-row (row types)
  (unless (and (listp row)
	       (= 4 (length row)))
    (failure "Row ~S is incorrect format" row))
  (destructuring-bind (int float bigint str) row
    (cond
      ((eq types :auto)
       (unless (and (integerp int)
		    (typep float 'double-float)
		    (integerp bigint)
		    (stringp str))
	 (failure "Incorrect field type for row ~S" row)))
       ((null types)
	(unless (and (stringp int)
		     (stringp float)
		     (stringp bigint)
		     (stringp str))
	  (failure "Incorrect field type for row ~S" row))
	(setq int (parse-integer int))
	(setq bigint (parse-integer bigint))
	(setq float (parse-double float)))
       ((listp types)
	(error "NYI")
	)
       (t
	(failure "Invalid types field (~S) passed to test-table-row" types)))
    (unless (= float (transform-float-1 int))
      (failure "Wrong float value ~A for int ~A (row ~S)" float int row))
    (unless (= float (parse-double str))
      (failure "Wrong string value ~A" str))))

(defun drop-test-table (db)
  (clsql:execute-command "DROP TABLE test_clsql"))

(report-result (run-test clsql-test-suite :handle-errors nil) :verbose t)

;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          tester-clsql.cl
;;;; Purpose:       Automated test of CLSQL using ACL's tester
;;;; Programmer:    Kevin M. Rosenberg
;;;; Date Started:  Mar 2002
;;;;
;;;; $Id: tester-clsql.cl,v 1.1 2002/04/08 02:50:28 kevin Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************

(error "Not yet implemented")

(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :cl-user)

(defvar *config-pathname* (make-pathname :name "test"
					 :type "config"
					 :defaults *load-truename*))
(unless (find-package :util.test)
  (load (make-pathname :name "acl-compat-tester" :type "cl"
		       :defaults *load-truename*)))

(in-package :clsql-user)
(use-package :util.test)

(def-test-fixture clsql-fixture ()
  ((aodbc-spec :accessor aodbc-spec)
   (mysql-spec :accessor mysql-spec)
   (pgsql-spec :accessor pgsql-spec)
   (pgsql-socket-spec :accessor pgsql-socket-spec))
  (:documentation "Test fixture for CLSQL testing"))

(defvar *config-pathname* (make-pathname :name "test"
					 :type "config"
					 :defaults *load-truename*))
(defmethod setup ((fix clsql-fixture))
  (if (probe-file *config-pathname*)
      (let (config)
	(with-open-file (stream *config-pathname* :direction :input)
	  (setq config (read stream)))
	(setf (aodbc-spec fix) (cadr (assoc :aodbc config)))
	(setf (mysql-spec fix) (cadr (assoc :mysql config)))
	(setf (pgsql-spec fix) (cadr (assoc :postgresql config)))
	(setf (pgsql-socket-spec fix)
	      (cadr (assoc :postgresql-socket config))))
      (error "XPTest Config file ~S not found" *config-pathname*)))

(defmethod teardown ((fix clsql-fixture))
  t)

(defmethod mysql-table-test ((test clsql-fixture))
  (test-table (mysql-spec test) :mysql))

(defmethod aodbc-table-test ((test clsql-fixture))
  (test-table (aodbc-spec test) :aodbc))

(defmethod pgsql-table-test ((test clsql-fixture))
  (test-table (pgsql-spec test) :postgresql))

(defmethod pgsql-socket-table-test ((test clsql-fixture))
  (test-table (pgsql-socket-spec test) :postgresql-socket))

(defmethod test-table (spec type)
  (when spec
    (let ((db (clsql:connect spec :database-type type :if-exists :new)))
      (unwind-protect
	   (progn
	     (create-test-table db)
	     (dolist (row (query "select * from test_clsql" :database db :types :auto))
	       (test-table-row row :auto))
	     (dolist (row (query "select * from test_clsql" :database db :types nil))
	       (test-table-row row nil))
	     (loop for row across (map-query 'vector #'list "select * from test_clsql"
					     :database db :types :auto)
		   do (test-table-row row :auto))
	     (loop for row across (map-query 'vector #'list "select * from test_clsql"
					     :database db :types nil)
		   do (test-table-row row nil))
	     (loop for row in (map-query 'list #'list "select * from test_clsql"
					 :database db :types nil)
		   do (test-table-row row nil))
	     (loop for row in (map-query 'list #'list "select * from test_clsql"
					 :database db :types :auto)
		   do (test-table-row row :auto))
	     (when (map-query nil #'list "select * from test_clsql"
					 :database db :types :auto)
	       (failure "Expected NIL result from map-query nil"))
	     (do-query ((int float bigint str) "select * from test_clsql")
	       (test-table-row (list int float bigint str) nil))
	     (do-query ((int float bigint str) "select * from test_clsql" :types :auto)
	       (test-table-row (list int float bigint str) :auto))
	     (drop-test-table db)
	     )
	(disconnect :database db)))))

(defmethod mysql-low-level ((test clsql-fixture))
  (let ((spec (mysql-spec test)))
    (when spec
      (let ((db (clsql-mysql::database-connect spec :mysql)))
	(clsql-mysql::database-execute-command "DROP TABLE IF EXISTS test_clsql" db)
	(clsql-mysql::database-execute-command
	 "CREATE TABLE test_clsql (i integer, sqrt double, sqrt_str CHAR(20))" db)
	(dotimes (i 10)
	  (clsql-mysql::database-execute-command
	   (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
		   i (number-to-sql-string (sqrt i))
		   (number-to-sql-string (sqrt i)))
	   db))
	(let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
	  (unless (= 10 (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)))
	    (failure "Error calling mysql-num-rows"))
	  (clsql-mysql::database-dump-result-set res db))
	(clsql-mysql::database-execute-command "DROP TABLE test_clsql" db)
	(clsql-mysql::database-disconnect db)))))

(defparameter clsql-test-suite
    (make-test-suite
     "CLSQL Test Suite"
     "Basic test suite for database operations."
     ("MySQL Low Level Interface" 'clsql-fixture
		   :test-thunk 'mysql-low-level
		   :description "A test of MySQL low-level interface")
     ("MySQL Table" 'clsql-fixture
		   :test-thunk 'mysql-table-test
		   :description "A test of MySQL")
     ("PostgreSQL Table" 'clsql-fixture
		   :test-thunk 'pgsql-table-test
		   :description "A test of PostgreSQL tables")
     ("PostgreSQL Socket Table" 'clsql-fixture
		   :test-thunk 'pgsql-socket-table-test
		   :description "A test of PostgreSQL Socket tables")
  ))

#+allegro
(add-test (make-test-case "AODBC table test" 'clsql-fixture
			  :test-thunk 'aodbc-table-test
			  :description "Test AODBC table")
	  clsql-test-suite)

;;;; Testing functions

(defun transform-float-1 (i)
  (* i (abs (/ i 2)) (expt 10 (* 2 i))))

(defun transform-bigint-1 (i)
  (* i (expt 10 (* 3 (abs i)))))

(defun create-test-table (db)
  (ignore-errors
    (clsql:execute-command
     "DROP TABLE test_clsql" :database db))
  (clsql:execute-command
   "CREATE TABLE test_clsql (t_int integer, t_float float, t_bigint BIGINT, t_str CHAR(30))"
   :database db)
  (dotimes (i 11)
    (let* ((test-int (- i 5))
	   (test-flt (transform-float-1 test-int)))
      (clsql:execute-command
       (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')"
	       test-int
	       (number-to-sql-string test-flt)
	       (transform-bigint-1 test-int)
	       (number-to-sql-string test-flt)
	       )
       :database db))))

(defun parse-double (num-str)
  (let ((*read-default-float-format* 'double-float))
    (coerce (read-from-string num-str) 'double-float)))

(defun test-table-row (row types)
  (unless (and (listp row)
	       (= 4 (length row)))
    (failure "Row ~S is incorrect format" row))
  (destructuring-bind (int float bigint str) row
    (cond
      ((eq types :auto)
       (unless (and (integerp int)
		    (typep float 'double-float)
		    (integerp bigint)
		    (stringp str))
	 (failure "Incorrect field type for row ~S" row)))
       ((null types)
	(unless (and (stringp int)
		     (stringp float)
		     (stringp bigint)
		     (stringp str))
	  (failure "Incorrect field type for row ~S" row))
	(setq int (parse-integer int))
	(setq bigint (parse-integer bigint))
	(setq float (parse-double float)))
       ((listp types)
	(error "NYI")
	)
       (t
	(failure "Invalid types field (~S) passed to test-table-row" types)))
    (unless (= float (transform-float-1 int))
      (failure "Wrong float value ~A for int ~A (row ~S)" float int row))
    (unless (= float (parse-double str))
      (failure "Wrong string value ~A" str))))

(defun drop-test-table (db)
  (clsql:execute-command "DROP TABLE test_clsql"))

(report-result (run-test clsql-test-suite :handle-errors nil) :verbose t)


need to test, but still might be issues with the last sym of a list

(proclaim '(optimize (speed 0) (safety 3) (debug 3) (space 0)))
;(declaim #+sbcl(sb-ext:muffle-conditions style-warning))
;(declaim #+sbcl(sb-ext:muffle-conditions warning))
(setf *print-case* :downcase)
(ql:quickload '(alexandria cl-ppcre iterate anaphora) :silent t)

(defpackage destr-match
 (:use cl alexandria iterate cl-ppcre anaphora))
(in-package destr-match)

(defparameter destr-match-clauses (make-hash-table :test #'equalp))
(defvar *list* nil)

(defmacro def-match-clause (name ll &rest rest)
	`(setf (gethash ',name destr-match-clauses) (lambda ,ll ,@rest)))

(defun parse-out-free-symbols (exp)
   (delete-duplicates
      (if (listp exp)
          (iter (for x in exp)
                (when (and (eq x (car exp)) (gethash x destr-match-clauses)) (next-iteration))
                (aif (parse-out-free-symbols x) (appending it)))
          (when (symbolp exp) (list exp)))))

;; remember to add a list test and nil case
;; also, if the car of the list is a list (clause), so that doesn't get fucked by the expansion order
;; how to be decide to stop on the last sym case?
;;   test for nil list somehow, win if more than 0 or 1 iterations?
;;   top level should not stop until full list is matched!
;;     this makes greedy and lazy hard to implement
(defmacro match (exp)
	(if (not (listp exp))
		 (error "uh oh")
		 (if (listp (car exp))
			  (aif (gethash (caar exp) destr-match-clauses)
				    (funcall it (cdr exp) (cdar exp))) ;; ew
			  (if (stringp (car exp))
				   `(when (and *list* (eq ,(intern (string-upcase (car exp))) (car *list*)))
						  (let ((*list (cdr *list*)))
							     (match ,(cdr exp))))
					(aif (gethash (car exp) destr-match-clauses)
						  (funcall it (cdr exp))
						  (with-gensyms (i)
						     `(iter (for ,i on *list*)
										(setf ,(cdr exp) ,i)
										(when (match ,(cddr exp))
												(leave t)))))))))

;; clauses
;;   switch - matches forms, takes the first to work, analogous to parmesan choice
;;   lazy, greedy - only on top on a single binding form
;;   any - causes it to match zero or more list elements
;;   single - causes it to match only one form
;;   test - means the form must match the condition described as well as the structure of the match
;;   key - same as test, except the result of the function is bound instead of the normal result
;;   on-fail - expression to be returned by the whole thing if that subform fails to match

(def-match-clause single (rest var)
	`(when *list*
			  (setf ,var (car *list*))
			  (let ((*list* (cdr *list*)))
				     ())))

;; general process
;;   process the match-form
;;   expand macros, warning or error on actual functions
;;   parse out the relevent symbols
;;   recursive expansion of clauses
;;   generate the full form, inside a let
(defmacro destructuring-match (exp match-form &rest body)
   (let ((match-form (macroexpand match-form)))
			(print match-form)
			''foo))

(proclaim '(optimize (speed 0) (safety 3) (debug 3) (space 0)))
;(declaim #+sbcl(sb-ext:muffle-conditions style-warning))
;(declaim #+sbcl(sb-ext:muffle-conditions warning))
(setf *print-case* :downcase)
(ql:quickload '(alexandria cl-ppcre iterate anaphora) :silent t)

(defpackage destr-match
 (:use cl alexandria iterate cl-ppcre anaphora))
(in-package destr-match)

(defparameter destr-match-clauses (make-hash-table :test #'equalp))
(defvar *list* nil)

(defmacro def-match-clause (name ll &rest rest)
	`(setf (gethash ',name destr-match-clauses) (lambda ,ll ,@rest)))

(defun parse-out-free-symbols (exp)
   (delete-duplicates
      (if (listp exp)
          (iter (for x in exp)
                (when (and (eq x (car exp)) (gethash x destr-match-clauses)) (next-iteration))
                (aif (parse-out-free-symbols x) (appending it)))
          (when (symbolp exp) (list exp)))))

;; remember to add a list test and nil case
;; how to be decide to stop on the last sym case?
;;   test for nil list somehow, win if more than 0 or 1 iterations?
(defmacro match (exp)
	(if (stringp (car exp))
		 `(when (and *list* (eq ,(intern (string-upcase (car exp))) (car *list*)))
			     (let ((*list (cdr *list*)))
					     (match ,(cdr exp))))
		 (aif (gethash (car exp) destr-match-clauses)
			   (apply it (cdr exp))
				(with-gensyms (i)
					`(iter (for ,i on *list*)
							 (setf ,(cdr list) ,i)
							 (when (match ,(cddr exp))
								    (leave t)))))))

;; clauses
;;   switch - matches forms, takes the first to work, analogous to parmesan choice
;;   lazy, greedy - only on top on a single binding form
;;   any - causes it to match zero or more list elements
;;   single - causes it to match only one form
;;   test - means the form must match the condition described as well as the structure of the match
;;   key - same as test, except the result of the function is bound instead of the normal result
;;   on-fail - expression to be returned by the whole thing if that subform fails to match

(def-match-clause single (rest)
	`(when *list*
			  (setf ,var (car *list*))
			  (let ((*list* (cdr *list*)))
				     (match ,rest))))

;; general process
;;   process the match-form
;;   expand macros, warning or error on actual functions
;;   parse out the relevent symbols
;;   recursive expansion of clauses
;;   generate the full form, inside a let
(defmacro destructuring-match (exp match-form &rest body)
   (let ((match-form (macroexpand-all match-form)))
			()))


OpenCL implementation of Park-Miller PRNG

/******************************************************************************
 * @file     prngcl_pm.cl
 * @author   Vadim Demchik <vadimdi@yahoo.com>
 * @version  1.1.1
 *
 * @brief    [PRNGCL library]
 *           contains OpenCL implementation of Park-Miller pseudo-random number generator
 *
 *
 * @section  CREDITS
 *
 *   Stephen K. Park, Keith W. Miller,
 *   "Random number generators: good ones are hard to find",
 *   Communications of the ACM {\bf 31} (10), 1192 (1988).
 *
 *
 * @section  LICENSE
 *
 * Copyright (c) 2013, 2014 Vadim Demchik
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without modification,
 * are permitted provided that the following conditions are met:
 *
 *    Redistributions of source code must retain the above copyright notice,
 *      this list of conditions and the following disclaimer.
 *
 *    Redistributions in binary form must reproduce the above copyright notice,
 *      this list of conditions and the following disclaimer in the documentation
 *      and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 *****************************************************************************/

#ifndef PRNGCL_PM_CL
#define PRNGCL_PM_CL

#include "prngcl_common.cl"

#define PM_m_FP   (2147483647.0)
#define PM_min    1
#define PM_max    2147483646
#define PM_k      (4.6566128752457969241058E-10) // 1/(2^31-1)

#define PM_m     2147483647
#define PM_a     16807
#define PM_q     127773         // (PM_m div PM_a)
#define PM_r     2836           // (PM_m mod PM_a)

//________________________________________________________________________________________________________ PARK-MILLER PRNG
//
// Stephen K. Park and Keith W. Miller
// "Random number generators: good ones are hard to find"
// Communications of the ACM 31 (10), 1192 (1988).
//

__attribute__((always_inline)) void
pm_step(uint4* seed)
//
// produces PRNs in range [1;2147483646]
// if seed=1 then 10001th = 1043618065
//
{
    uint4 PM_test_1, PM_test_2;

    PM_test_1 = ((uint) PM_a) * ((*seed) % PM_q);
    PM_test_2 = ((uint) PM_r) * ((*seed) / PM_q);

    if (PM_test_1.x > PM_test_2.x) (*seed).x = PM_test_1.x - PM_test_2.x; else (*seed).x = PM_test_1.x - PM_test_2.x + (uint) PM_m;
    if (PM_test_1.y > PM_test_2.y) (*seed).y = PM_test_1.y - PM_test_2.y; else (*seed).y = PM_test_1.y - PM_test_2.y + (uint) PM_m;
    if (PM_test_1.z > PM_test_2.z) (*seed).z = PM_test_1.z - PM_test_2.z; else (*seed).z = PM_test_1.z - PM_test_2.z + (uint) PM_m;
    if (PM_test_1.w > PM_test_2.w) (*seed).w = PM_test_1.w - PM_test_2.w; else (*seed).w = PM_test_1.w - PM_test_2.w + (uint) PM_m;
}

__kernel void
pm(__global uint4* seed_table,
   __global hgpu_float4* randoms,
      const uint N)
{
    uint giddst = GID;
#ifdef PRECISION_DOUBLE  // if double precision is defined
    uint4 rnd1, rnd2;
    hgpu_double4 result;
#else
    float4 m = (float4) PM_m_FP;
#endif
    uint4 seed = seed_table[GID];
    for (uint i = 0; i < N; i++) {
#ifdef PRECISION_DOUBLE // if double precision is defined
#ifndef PRNG_SKIP_CHECK
        rnd1 = (uint4) 0;
        while ((rnd1.x <= PM_min) || (rnd1.x >= PM_max) ||
               (rnd1.y <= PM_min) || (rnd1.y >= PM_max) ||
               (rnd1.z <= PM_min) || (rnd1.z >= PM_max) ||
               (rnd1.w <= PM_min) || (rnd1.w >= PM_max)
              )
#endif
        {
            pm_step(&seed);
            rnd1 = seed;
        }
        pm_step(&seed);
        rnd2 = seed;

        result = hgpu_uint4_to_double4(rnd1,rnd2,PM_min,PM_max,PM_k);
        randoms[giddst] = result;
#else
        pm_step(&seed);
        randoms[giddst] = hgpu_uint4_to_float4(seed) / m;
#endif
        giddst += GID_SIZE;
    }
    seed_table[GID] = seed;
}

#endif

/******************************************************************************
 * @file     prngcl_pm.cl
 * @author   Vadim Demchik <vadimdi@yahoo.com>
 * @version  1.1.1
 *
 * @brief    [PRNGCL library]
 *           contains OpenCL implementation of Park-Miller pseudo-random number generator
 *
 *
 * @section  CREDITS
 *
 *   Stephen K. Park, Keith W. Miller,
 *   "Random number generators: good ones are hard to find",
 *   Communications of the ACM {\bf 31} (10), 1192 (1988).
 *
 *
 * @section  LICENSE
 *
 * Copyright (c) 2013, 2014 Vadim Demchik
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without modification,
 * are permitted provided that the following conditions are met:
 *
 *    Redistributions of source code must retain the above copyright notice,
 *      this list of conditions and the following disclaimer.
 *
 *    Redistributions in binary form must reproduce the above copyright notice,
 *      this list of conditions and the following disclaimer in the documentation
 *      and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 *****************************************************************************/

#ifndef PRNGCL_PM_CL
#define PRNGCL_PM_CL

#include "prngcl_common.cl"

#define PM_m_FP   (2147483647.0)
#define PM_min    1
#define PM_max    2147483646
#define PM_k      (4.6566128752457969241058E-10) // 1/(2^31-1)

#define PM_m     2147483647
#define PM_a     16807
#define PM_q     127773         // (PM_m div PM_a)
#define PM_r     2836           // (PM_m mod PM_a)

//________________________________________________________________________________________________________ PARK-MILLER PRNG
//
// Stephen K. Park and Keith W. Miller
// "Random number generators: good ones are hard to find"
// Communications of the ACM 31 (10), 1192 (1988).
//

__attribute__((always_inline)) void
pm_step(uint4* seed)
//
// produces PRNs in range [1;2147483646]
// if seed=1 then 10001th = 1043618065
//
{
    uint4 PM_test_1, PM_test_2;

    PM_test_1 = ((uint) PM_a) * ((*seed) % PM_q);
    PM_test_2 = ((uint) PM_r) * ((*seed) / PM_q);

    if (PM_test_1.x > PM_test_2.x) (*seed).x = PM_test_1.x - PM_test_2.x; else (*seed).x = PM_test_1.x - PM_test_2.x + (uint) PM_m;
    if (PM_test_1.y > PM_test_2.y) (*seed).y = PM_test_1.y - PM_test_2.y; else (*seed).y = PM_test_1.y - PM_test_2.y + (uint) PM_m;
    if (PM_test_1.z > PM_test_2.z) (*seed).z = PM_test_1.z - PM_test_2.z; else (*seed).z = PM_test_1.z - PM_test_2.z + (uint) PM_m;
    if (PM_test_1.w > PM_test_2.w) (*seed).w = PM_test_1.w - PM_test_2.w; else (*seed).w = PM_test_1.w - PM_test_2.w + (uint) PM_m;
}

__kernel void
pm(__global uint4* seed_table,
   __global hgpu_float4* randoms,
      const uint N)
{
    uint giddst = GID;
#ifdef PRECISION_DOUBLE  // if double precision is defined
    uint4 rnd1, rnd2;
    hgpu_double4 result;
#else
    float4 normal = (float4) PM_m_FP;
#endif
    uint4 seed = seed_table[GID];
    for (uint i = 0; i < N; i++) {
#ifdef PRECISION_DOUBLE // if double precision is defined
        pm_step(&seed);
        rnd1 = seed;

#ifndef PRNG_SKIP_CHECK
        bool flag = true;
        while (flag) {
#endif
            pm_step(&seed);
            rnd2 = seed;
            result = hgpu_uint4_to_double4(rnd1,rnd2,PM_min,PM_max,PM_k);

#ifndef PRNG_SKIP_CHECK
            if ((rnd1.x>PM_min) && (rnd1.x<PM_max) &&
                (rnd1.y>PM_min) && (rnd1.y<PM_max) &&
                (rnd1.z>PM_min) && (rnd1.z<PM_max) &&
                (rnd1.w>PM_min) && (rnd1.w<PM_max)) {
                flag = false;
            }
            else
                rnd1 = rnd2;
        }
#endif

        randoms[giddst] = result;
#else
        pm_step(&seed);
        randoms[giddst] = hgpu_uint4_to_float4(seed) / normal;
#endif
        giddst += GID_SIZE;
    }
    seed_table[GID] = seed;
}

#endif