Added OpenCL randu and randn kernel

Added OpenCL randu and randn kernel

/*******************************************************
 * Copyright (c) 2014, ArrayFire
 * All rights reserved.
 *
 * This file is distributed under 3-clause BSD license.
 * The complete license agreement can be obtained at:
 * http://arrayfire.com/licenses/BSD-3-Clause
 *
 ********************************************************/

//#include "KParam.hpp"

typedef ulong uint64_t;
typedef uint  uint32_t;

#ifndef T
#define T float
#endif

#ifndef repeat
#define repeat 32
#endif

#define PI_VAL 3.1415926535897932384626433832795028841971693993751058209749445923078164
#define R123_STATIC_INLINE inline
#define R123_0x1p_32f (1.f/4294967296.f)
#define R123_0x1p_64 (1.f/(4294967296.*4294967296.))

#ifdef IS_64
#define SKEIN_KS_PARITY SKEIN_KS_PARITY64
#define RotL RotL_64
#define uint_t uint64_t

#define result(a) (a)*R123_0x1p_64

enum r123_enum_threefry64x2 {
    /*
    // Output from skein_rot_search: (srs64_B64-X1000)
    // Random seed = 1. BlockSize = 128 bits. sampleCnt =  1024. rounds =  8, minHW_or=57
    // Start: Tue Mar  1 10:07:48 2011
    // rMin = 0.136. #0325[*15] [CRC=455A682F. hw_OR=64. cnt=16384. blkSize= 128].format
    */
    R_2_0_0=16,
    R_2_1_0=42,
    R_2_2_0=12,
    R_2_3_0=31,
    R_2_4_0=16,
    R_2_5_0=32,
    R_2_6_0=24,
    R_2_7_0=21
    /* 4 rounds: minHW =  4  [  4  4  4  4 ]
    // 5 rounds: minHW =  8  [  8  8  8  8 ]
    // 6 rounds: minHW = 16  [ 16 16 16 16 ]
    // 7 rounds: minHW = 32  [ 32 32 32 32 ]
    // 8 rounds: minHW = 64  [ 64 64 64 64 ]
    // 9 rounds: minHW = 64  [ 64 64 64 64 ]
    //10 rounds: minHW = 64  [ 64 64 64 64 ]
    //11 rounds: minHW = 64  [ 64 64 64 64 ] */
};
#else
#define SKEIN_KS_PARITY SKEIN_KS_PARITY32
#define RotL RotL_32
#define uint_t uint32_t

#ifdef IS_BOOL
#define result(a) ((a)*R123_0x1p_32f) > 0.5
#else
#define result(a) (a)*R123_0x1p_32f
#endif

enum r123_enum_threefry32x2 {
    /* Output from skein_rot_search (srs2-X5000.out)
    // Random seed = 1. BlockSize = 64 bits. sampleCnt =  1024. rounds =  8, minHW_or=28
    // Start: Tue Jul 12 11:11:33 2011
    // rMin = 0.334. #0206[*07] [CRC=1D9765C0. hw_OR=32. cnt=16384. blkSize=  64].format   */
    R_2_0_0=13,
    R_2_1_0=15,
    R_2_2_0=26,
    R_2_3_0= 6,
    R_2_4_0=17,
    R_2_5_0=29,
    R_2_6_0=16,
    R_2_7_0=24

    /* 4 rounds: minHW =  4  [  4  4  4  4 ]
    // 5 rounds: minHW =  6  [  6  8  6  8 ]
    // 6 rounds: minHW =  9  [  9 12  9 12 ]
    // 7 rounds: minHW = 16  [ 16 24 16 24 ]
    // 8 rounds: minHW = 32  [ 32 32 32 32 ]
    // 9 rounds: minHW = 32  [ 32 32 32 32 ]
    //10 rounds: minHW = 32  [ 32 32 32 32 ]
    //11 rounds: minHW = 32  [ 32 32 32 32 ] */
};
#endif

enum r123_enum_threefry_wcnt {
    WCNT2=2,
    WCNT4=4
};

R123_STATIC_INLINE uint64_t RotL_64(uint64_t x, uint64_t N)
{
    return (x << (N & 63)) | (x >> ((64-N) & 63));
}

R123_STATIC_INLINE uint32_t RotL_32(uint32_t x, uint32_t N)
{
    return (x << (N & 31)) | (x >> ((32-N) & 31));
}

#define SKEIN_MK_64(hi32,lo32)  ((lo32) + (((uint64_t) (hi32)) << 32))
#define SKEIN_KS_PARITY64         SKEIN_MK_64(0x1BD11BDA,0xA9FC1A22)
#define SKEIN_KS_PARITY32         0x1BD11BDA

// http://www.thesalmons.org/john/random123/releases/1.06/docs/structr123_1_1Threefry2x32__R.html#af5be46f8426cfcd86e75327e4b3750b0
#define Nrounds 16

struct r123array2
{
    uint_t v[2];
};

typedef struct r123array2 threefry2_ctr_t;
typedef struct r123array2 threefry2_key_t;
typedef struct r123array2 threefry2_ukey_t;

R123_STATIC_INLINE
threefry2_key_t threefry2keyinit(threefry2_ukey_t uk) { return uk; }

R123_STATIC_INLINE
threefry2_ctr_t threefry2_R(threefry2_ctr_t in, threefry2_key_t k)
{
    threefry2_ctr_t X;
    uint_t ks[2+1];
    int  i; /* avoid size_t to avoid need for stddef.h */
    ks[2] =  SKEIN_KS_PARITY;
    for (i=0;i < 2; i++)
    {
        ks[i] = k.v[i];
        X.v[i]  = in.v[i];
        ks[2] ^= k.v[i];
    }

    /* Insert initial key before round 0 */
    X.v[0] += ks[0]; X.v[1] += ks[1];

    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_0_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_1_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_2_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_3_0); X.v[1] ^= X.v[0];

    /* InjectKey(r=1) */
    X.v[0] += ks[1]; X.v[1] += ks[2];
    X.v[1] += 1;     /* X.v[2-1] += r  */

    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_4_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_5_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_6_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_7_0); X.v[1] ^= X.v[0];

    /* InjectKey(r=2) */
    X.v[0] += ks[2]; X.v[1] += ks[0];
    X.v[1] += 2;

    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_0_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_1_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_2_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_3_0); X.v[1] ^= X.v[0];

    /* InjectKey(r=3) */
    X.v[0] += ks[0]; X.v[1] += ks[1];
    X.v[1] += 3;

    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_4_0); X.v[1] ^= X.v[0];

    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_5_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_6_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_7_0); X.v[1] ^= X.v[0];

    /* InjectKey(r=4) */
    X.v[0] += ks[1]; X.v[1] += ks[2];
    X.v[1] += 4;

#if Nrounds > 16
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_0_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_1_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_2_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_3_0); X.v[1] ^= X.v[0];

    /* InjectKey(r=4) */
    X.v[0] += ks[2]; X.v[1] += ks[0];
    X.v[1] += 5;
#endif

#if Nrounds > 20
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_0_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_1_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_2_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_3_0); X.v[1] ^= X.v[0];

    /* InjectKey(r=3) */
    X.v[0] += ks[0]; X.v[1] += ks[1];
    X.v[1] += 6;
#endif

#if Nrounds > 24
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_4_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_5_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_6_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_7_0); X.v[1] ^= X.v[0];

    /* InjectKey(r=4) */
    X.v[0] += ks[1]; X.v[1] += ks[2];
    X.v[1] += 7;
#endif

#if Nrounds > 28
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_0_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_1_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_2_0); X.v[1] ^= X.v[0];
    X.v[0] += X.v[1]; X.v[1] = RotL(X.v[1],R_2_3_0); X.v[1] ^= X.v[0];

        /* InjectKey(r=4) */
    X.v[0] += ks[2]; X.v[1] += ks[0];
    X.v[1] += 8;
#endif

    return X;
}

#define threefry2(c,k) threefry2_R(c, k)

void generate_randu(T *one, T *two, threefry2_ctr_t *c, threefry2_key_t k)
{
    threefry2_ctr_t r = threefry2(*c, k);
    c->v[0] = c->v[0] + 1;

    *one = result(r.v[0]);
    *two = result(r.v[1]);
}

void generate_randn(T *one, T *two, threefry2_ctr_t *c, threefry2_key_t k)
{
    threefry2_ctr_t r = threefry2(*c, k);
    c->v[0] = c->v[0] + 1;

    T u1 = result(r.v[0]);
    T u2 = result(r.v[1]);

    T R     = sqrt(-2*log(u1));
    T Theta = 2 * PI_VAL * u2;

    *one = R * sin(Theta);
    *two = R * cos(Theta);
}

//void generate_randi(T *one, T *two, threefry2_ctr_t *c, threefry2_key_t k)
//{
//    threefry2_ctr_t r = threefry2(*c, k);
//    c->v[0] = c->v[0] + 1;
//
//    *one = (T)r.v[0];
//    *two = (T)r.v[1];
//}

#define INSTANTIATE(RTYPE) \
__kernel __attribute__ ((reqd_work_group_size(256, 1, 1))) \
void random_##RTYPE(__global T *output, unsigned numel, \
                    unsigned counter, unsigned lo, unsigned hi) \
{ \
    unsigned gid = get_group_id(0); \
    unsigned off = get_local_size(0); \
    unsigned tid =  off * gid * repeat + get_local_id(0); \
 \
    threefry2_key_t k = {{tid, lo}}; \
    threefry2_ctr_t c = {{counter, hi}}; \
 \
    T one, two; \
 \
    if (gid < get_num_groups(0) - 1) { \
        for(int i = 0; i < repeat; i+=2) { \
            generate_##RTYPE(&one, &two, &c, k); \
            output[tid      ] = one; \
            output[tid + off] = two; \
            tid += 2 * off; \
        } \
    } else { \
        for(int i = 0; i < repeat; i+=2) { \
            generate_##RTYPE(&one, &two, &c, k); \
            if (tid       < numel) output[tid      ] = one; \
            if (tid + off < numel) output[tid + off] = two; \
            tid += 2 * off; \
        } \
    } \
}

INSTANTIATE(randu)
INSTANTIATE(randn)
//INSTANTIATE(randi)

error: pathspec 'src/backend/opencl/kernel/random.cl' did not match any file(s) known to git


read_image.cl: fix to pass conformance tests

/* OpenCL built-in library: read_image()

   Copyright (c) 2013 Ville Korhonen
   Copyright (c) 2014 Felix Bytow
   Copyright (c) 2015 Matias Koskela

   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.
*/

#include "templates.h"
#include "pocl_image_rw_utils.h"

static const int ARGB_MAP[] = { 3, 0, 1, 2 };
static const int BGRA_MAP[] = { 2, 1, 0, 3 };

static int map_channel(int i, int order) {
    switch(order)
    {
        case CL_ARGB: return ARGB_MAP[i];
        case CL_BGRA: return BGRA_MAP[i];
        case CL_RGBA:
        default: return i;
    }
    return i;
}

/* checks if integer coord is out of bounds. If out of bounds: Sets coord in
   bounds and returns false OR populates color with border colour and returns
   true. If in bounds, returns false */
static int __pocl_is_out_of_bounds (global dev_image_t* dev_image, int4 *coord,
                             dev_sampler_t* dev_sampler)
{
  if(*dev_sampler & CLK_ADDRESS_CLAMP_TO_EDGE)
    {
      if (coord->x >= dev_image->_width)
        coord->x = dev_image->_width-1;
      if (dev_image->_height != 0 && coord->y >= dev_image->_height)
        coord->y = dev_image->_height-1;
      if (dev_image->_depth != 0 && coord->z >= dev_image->_depth)
        coord->z = dev_image->_depth-1;

      if (coord->x < 0)
        coord->x = 0;
      if (coord->y < 0)
        coord->y = 0;
      if (coord->z < 0)
        coord->z = 0;

      return 0;
    }
  if (*dev_sampler & CLK_ADDRESS_CLAMP)
    {
      if(coord->x >= dev_image->_width || coord->x < 0 ||
         coord->y >= dev_image->_height || coord->y < 0 ||
         (dev_image->_depth != 0 && (coord->z >= dev_image->_depth || coord->z <0)))
        {
          if (dev_image->_order == CL_A || dev_image->_order == CL_INTENSITY ||
              dev_image->_order == CL_RA || dev_image->_order == CL_ARGB ||
              dev_image->_order == CL_BGRA || dev_image->_order == CL_RGBA)
            return 1; // clamp to 0,0,0,0
          else
            return 2; // clamp to 0,0,0,1
        }
    }
  return 0;
}

/* Reads a four element pixel from image pointed by integer coords. */
static void __pocl_read_pixel (void* color, global dev_image_t* dev_image, int4 coord)
{

  uint4* color_ptr = (uint4*)color;
  int width = dev_image->_width;
  int height = dev_image->_height;
  int num_channels = dev_image->_num_channels;
  int i = num_channels;
  int order = dev_image->_order;
  int elem_size = dev_image->_elem_size;
  int const base_index =
    (coord.x + coord.y*width + coord.z*height*width) * num_channels;

  if (order == CL_A)
    {
      /* these can be garbage
      (*color_ptr)[0] = 0;
      (*color_ptr)[1] = 0;
      (*color_ptr)[2] = 0;
      */
      if (elem_size == 1)
        (*color_ptr)[3] = ((uchar*)(dev_image->_data))[base_index];
      else if (elem_size == 2)
        (*color_ptr)[3] = ((ushort*)(dev_image->_data))[base_index];
      else if (elem_size == 4)
        (*color_ptr)[3] = ((uint*)(dev_image->_data))[base_index];
      return;
    }

  if (elem_size == 1)
    {
      for (int i=0; i<num_channels; i++)
        {
          (*color_ptr)[map_channel(i, order)] = ((uchar*)(dev_image->_data))[base_index + i];
        }
    }
  else if (elem_size == 2)
    {
      for (int i=0; i<num_channels; i++)
        {
          (*color_ptr)[map_channel(i, order)] = ((ushort*)(dev_image->_data))[base_index + i];
        }
    }
  else if (elem_size == 4)
    {
      for (int i=0; i<num_channels; i++)
        {
          (*color_ptr)[map_channel(i, order)] = ((uint*)(dev_image->_data))[base_index + i];
        }
    }

}

static constant float4 maxval8_i = ((float4)(1.0f / (float)UCHAR_MAX));
static constant float4 maxval16_i = ((float4)(1.0f / (float)USHRT_MAX));
static constant float4 maxval8_2i = ((float4)(2.0f / (float)UCHAR_MAX));
static constant float4 maxval16_2i = ((float4)(2.0f / (float)USHRT_MAX));
static constant float4 minval8 = ((float4)(SCHAR_MIN));
static constant float4 minval16 = ((float4)(SHRT_MIN));

// only for CL_SNORM_INT8, CL_UNORM_INT8, CL_SNORM_INT16, CL_UNORM_INT16,
static float4 convert_uint4_to_float4(uint4 color, int type, int elem_size)
{
  if ((type == CL_SNORM_INT8) ||
      (type == CL_SNORM_INT16))
    {
      //  <I*_MIN, I*_MAX> to <-1.0, 1.0>
      // Imin,Imax -> 0, Umax -> / UmaxHalf -> -1.0f
      if (elem_size == 1)
        return ((convert_float4(as_int4(color)) - minval8) * maxval8_2i - (float4)1.0f);
      else
        return ((convert_float4(as_int4(color)) - minval16) * maxval16_2i -(float4)1.0f);
    }
  else
    {
      //  <0, I*_MAX> to <0.0, 1.0>
      if (elem_size == 1)
        return convert_float4(color) * maxval8_i;
      else
        return convert_float4(color) * maxval16_i;
    }
}

#define HANDLE_FLOAT_IMGTYPE \
    if (i_ptr->_data_type == CL_FLOAT)                                  \
      {                                                                 \
        float4 color;                                                   \
        __pocl_read_pixel (&color, i_ptr, coord4);                      \
        return color;                                                   \
      }                                                                 \
    else                                                                \
      {                                                                 \
        uint4 color;                                                    \
        __pocl_read_pixel (&color, i_ptr, coord4);                      \
        return convert_uint4_to_float4(color,                           \
                                     i_ptr->_data_type,                 \
                                     i_ptr->_elem_size);                \
      }                                                                 \
    }

/* Implementation for read_image with any image data type and int coordinates
   __IMGTYPE__ = image type (image2d_t, ...)
   __RETVAL__  = return value (int4 or uint4 float4)
   __POSTFIX__ = function name postfix (i, ui, f)
   __COORD__   = coordinate type (int, int2, int4)
*/

#if __clang_major__ > 3
// After Clang 4.0, the sampler_t is passed as an opaque struct (ptr)
// which we convert to int32 with the LLVM pass HandleSamplerInitialization.
#define READ_SAMPLER                                                    \
    dev_sampler_t s = *__builtin_astype(sampler, dev_sampler_t*);
#else
// Before Clang 4.0, the sampler_t was passed as an int32.
#define READ_SAMPLER                                                    \
    dev_sampler_t s = __builtin_astype(sampler, dev_sampler_t);
#endif

#define SAMPLERING(VEC)                                                 \
    READ_SAMPLER                                                        \
    int r = __pocl_is_out_of_bounds (i_ptr, &coord4, &s);               \
    if (r == 1)                                                         \
        return (VEC)0;                                                  \
    if (r == 2)                                                         \
        return (VEC)(0,0,0,1);

#define IMPLEMENT_READ_IMAGE_INT_COORD_INT4(__IMGTYPE__,__RETVAL__,     \
                                            __POSTFIX__,__COORD__)      \
  __RETVAL__ _CL_OVERLOADABLE read_image##__POSTFIX__ (__IMGTYPE__ image, \
                                                       sampler_t sampler, \
                                                       __COORD__ coord) \
  {                                                                     \
    __RETVAL__ color;                                                   \
    int4 coord4;                                                        \
    INITCOORD##__COORD__(coord4, coord);                                \
    global dev_image_t* i_ptr =                                         \
      __builtin_astype (image, global dev_image_t*);                    \
    SAMPLERING(__RETVAL__)                                              \
    __pocl_read_pixel (&color, i_ptr, coord4);                          \
    return color;                                                       \
  }

#define IMPLEMENT_READ_IMAGE_INT_COORD_FLOAT4(__IMGTYPE__,              \
                                              __COORD__)                \
  float4 _CL_OVERLOADABLE read_imagef (__IMGTYPE__ image,               \
                                                       sampler_t sampler, \
                                                       __COORD__ coord) \
  {                                                                     \
    int4 coord4;                                                        \
    INITCOORD##__COORD__(coord4, coord);                                \
    global dev_image_t* i_ptr =                                         \
      __builtin_astype (image, global dev_image_t*);                    \
    SAMPLERING(float4)                                                  \
    HANDLE_FLOAT_IMGTYPE

/* NO Sampler Implementation for read_image with any image data type
   and int coordinates
   __IMGTYPE__ = image type (image2d_t, ...)
   __RETVAL__  = return value (int4 or uint4 float4)
   __POSTFIX__ = function name postfix (i, ui, f)
   __COORD__   = coordinate type (int, int2, int4)
   OCL 1.2 Spec Says
   The samplerless read image functions behave exactly as the
   corresponding read image functions that take integer
   coordinates and a sampler with filter mode set to
   CLK_FILTER_NEAREST, normalized coordinates set to
   CLK_NORMALIZED_COORDS_FALSE and
   addressing mode to CLK_ADDRESS_NONE.
   CLK_ADDRESS_NONE – for this addressing mode the programmer guarantees that
   the image coordinates used to sample elements of the image refer to a
   location inside the image; otherwise the results are undefined.
   Thus we do not need out of bound check for now.
   If we need sampler for other cases it has to be defined as default sampler:
   const sampler_t defualt_sampler = CLK_NORMALIZED_COORDS_FALSE |
                                  CLK_ADDRESS_NONE |
                                  CLK_FILTER_NEAREST;
*/
#define IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_INT4(__IMGTYPE__, __RETVAL__, \
                                                 __POSTFIX__, __COORD__) \
  __RETVAL__ _CL_OVERLOADABLE read_image##__POSTFIX__ (__IMGTYPE__ image, \
                                                       __COORD__ coord) \
  {                                                                     \
    __RETVAL__ color;                                                   \
    int4 coord4;                                                        \
    INITCOORD##__COORD__ (coord4, coord);                               \
    global dev_image_t* i_ptr =                                         \
    __builtin_astype (image, global dev_image_t*);                      \
    __pocl_read_pixel (&color, i_ptr, coord4);                          \
                                                                        \
    return color;                                                       \
  }                                                                     \

#define IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_FLOAT4(__IMGTYPE__,    \
                                                        __COORD__)      \
  float4 _CL_OVERLOADABLE read_imagef (__IMGTYPE__ image,               \
                                                       __COORD__ coord) \
  {                                                                     \
    int4 coord4;                                                        \
    INITCOORD##__COORD__ (coord4, coord);                               \
    global dev_image_t* i_ptr =                                         \
      __builtin_astype (image, global dev_image_t*);                    \
    HANDLE_FLOAT_IMGTYPE

/* read_image 2d function instantions */

IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_FLOAT4 ( IMG_RO_AQ image2d_t, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_FLOAT4 ( IMG_RO_AQ image2d_array_t, int4)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_INT4 ( IMG_RO_AQ image2d_t, uint4, ui, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_INT4 ( IMG_RO_AQ image2d_t, int4, i, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_INT4 ( IMG_RO_AQ image2d_array_t, uint4, ui, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_INT4 ( IMG_RO_AQ image2d_array_t, int4, i, int2)

IMPLEMENT_READ_IMAGE_INT_COORD_FLOAT4 ( IMG_RO_AQ image2d_t, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_FLOAT4 ( IMG_RO_AQ image2d_array_t, int4)

IMPLEMENT_READ_IMAGE_INT_COORD_INT4 ( IMG_RO_AQ image2d_t, uint4, ui, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_INT4 ( IMG_RO_AQ image2d_t, int4, i, int2)

// read_image 3d function instantions
IMPLEMENT_READ_IMAGE_INT_COORD_INT4 ( IMG_RO_AQ image3d_t, uint4, ui, int4)
IMPLEMENT_READ_IMAGE_INT_COORD_FLOAT4 ( IMG_RO_AQ image3d_t, int4)

#if CLANG_HAS_IMAGE_AS

IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_FLOAT4 ( IMG_RW_AQ image2d_t, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_FLOAT4 ( IMG_RW_AQ image2d_array_t, int4)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_INT4 ( IMG_RW_AQ image2d_t, uint4, ui, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_INT4 ( IMG_RW_AQ image2d_t, int4, i, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_INT4 ( IMG_RW_AQ image2d_array_t, uint4, ui, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER_INT4 ( IMG_RW_AQ image2d_array_t, int4, i, int2)

IMPLEMENT_READ_IMAGE_INT_COORD_FLOAT4 ( IMG_RW_AQ image2d_t, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_FLOAT4 ( IMG_RW_AQ image2d_array_t, int4)

IMPLEMENT_READ_IMAGE_INT_COORD_INT4 ( IMG_RW_AQ image2d_t, uint4, ui, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_INT4 ( IMG_RW_AQ image2d_t, int4, i, int2)

// read_image 3d function instantions
IMPLEMENT_READ_IMAGE_INT_COORD_INT4 ( IMG_RW_AQ image3d_t, uint4, ui, int4)
IMPLEMENT_READ_IMAGE_INT_COORD_FLOAT4 ( IMG_RW_AQ image3d_t, int4)

#endif

/* OpenCL built-in library: read_image()

   Copyright (c) 2013 Ville Korhonen
   Copyright (c) 2014 Felix Bytow
   Copyright (c) 2015 Matias Koskela

   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.
*/

#include "templates.h"
#include "pocl_image_rw_utils.h"

#if (__clang_major__ == 3) && (__clang_minor__ >= 5)
// Clang 3.5 crashes in case trying to cast to the private pointer,
// adding the global qualifier fixes it. Clang 3.4 crashes if it's
// there. The issue is in SROA.
#define ADDRESS_SPACE global
#else
#define ADDRESS_SPACE
#endif

/* checks if integer coord is out of bounds. If out of bounds: Sets coord in
   bounds and returns false OR populates color with border colour and returns
   true. If in bounds, returns false */
int __pocl_is_out_of_bounds (ADDRESS_SPACE dev_image_t* dev_image, int4 *coord,
                             dev_sampler_t* dev_sampler, void *color_)
{
  uint4 *color = (uint4*)color_;
  if(*dev_sampler & CLK_ADDRESS_CLAMP_TO_EDGE)
    {
      if (coord->x >= dev_image->_width)
        coord->x = dev_image->_width-1;
      if (dev_image->_height != 0 && coord->y >= dev_image->_height)
        coord->y = dev_image->_height-1;
      if (dev_image->_depth != 0 && coord->z >= dev_image->_depth)
        coord->z = dev_image->_depth-1;

      if (coord->x < 0)
        coord->x = 0;
      if (coord->y < 0)
        coord->y = 0;
      if (coord->z < 0)
        coord->z = 0;

      return 0;
    }
  if (*dev_sampler & CLK_ADDRESS_CLAMP)
    {
      if(coord->x >= dev_image->_width || coord->x < 0 ||
         coord->y >= dev_image->_height || coord->y < 0 ||
         (dev_image->_depth != 0 && (coord->z >= dev_image->_depth || coord->z <0)))
        {
          (*color)[0] = 0;
          (*color)[1] = 0;
          (*color)[2] = 0;

          if (dev_image->_order == CL_A || dev_image->_order == CL_INTENSITY ||
              dev_image->_order == CL_RA || dev_image->_order == CL_ARGB ||
              dev_image->_order == CL_BGRA || dev_image->_order == CL_RGBA)
            (*color)[3] = 0;
          else
            (*color)[3] = 1;

          return 1;
        }
    }
  return 0;
}

/* Reads a four element pixel from image pointed by integer coords. */
void __pocl_read_pixel (void* color, ADDRESS_SPACE dev_image_t* dev_image, int4 coord)
{

  uint4* color_ptr = (uint4*)color;
  int width = dev_image->_width;
  int height = dev_image->_height;
  int num_channels = dev_image->_num_channels;
  int i = num_channels;
  int elem_size = dev_image->_elem_size;
  int const base_index =
    (coord.x + coord.y*width + coord.z*height*width) * num_channels;

  if (dev_image->_order == CL_A)
    {
      /* these can be garbage
      (*color_ptr)[0] = 0;
      (*color_ptr)[1] = 0;
      (*color_ptr)[2] = 0;
      */
      if (elem_size == 1)
        (*color_ptr)[3] = ((uchar*)(dev_image->_data))[base_index];
      else if (elem_size == 2)
        (*color_ptr)[3] = ((ushort*)(dev_image->_data))[base_index];
      else if (elem_size == 4)
        (*color_ptr)[3] = ((uint*)(dev_image->_data))[base_index];
      return;
    }

  if (elem_size == 1)
    {
      if(dev_image->_order == CL_BGRA)
        {
          (*color_ptr)[0] = ((uchar*)(dev_image->_data))[base_index + 2];
          (*color_ptr)[1] = ((uchar*)(dev_image->_data))[base_index + 1];
          (*color_ptr)[2] = ((uchar*)(dev_image->_data))[base_index + 0];
          (*color_ptr)[3] = ((uchar*)(dev_image->_data))[base_index + 3];
        }
      else
        {
          while (i--)
            {
              (*color_ptr)[i] = ((uchar*)(dev_image->_data))[base_index + i];
            }
        }
    }
  else if (elem_size == 2)
    {
      if(dev_image->_order == CL_BGRA)
        {
          (*color_ptr)[0] = ((ushort*)(dev_image->_data))[base_index + 2];
          (*color_ptr)[1] = ((ushort*)(dev_image->_data))[base_index + 1];
          (*color_ptr)[2] = ((ushort*)(dev_image->_data))[base_index + 0];
          (*color_ptr)[3] = ((ushort*)(dev_image->_data))[base_index + 3];
        }
      else
        {
          while (i--)
            {
              (*color_ptr)[i] = ((ushort*)(dev_image->_data))[base_index + i];
            }
      }
    }
  else if (elem_size == 4)
    {
      if(dev_image->_order == CL_BGRA)
        {
          (*color_ptr)[0] = ((uint*)(dev_image->_data))[base_index + 2];
          (*color_ptr)[1] = ((uint*)(dev_image->_data))[base_index + 1];
          (*color_ptr)[2] = ((uint*)(dev_image->_data))[base_index + 0];
          (*color_ptr)[3] = ((uint*)(dev_image->_data))[base_index + 3];
        }
      else
        {
          while (i--)
            {
              (*color_ptr)[i] = ((uint*)(dev_image->_data))[base_index + i];
            }
        }
    }
}

/* Implementation for read_image with any image data type and int coordinates
   __IMGTYPE__ = image type (image2d_t, ...)
   __RETVAL__  = return value (int4 or uint4 float4)
   __POSTFIX__ = function name postfix (i, ui, f)
   __COORD__   = coordinate type (int, int2, int4)
*/

#if __clang_major__ > 3

// After Clang 4.0, the sampler_t is passed as an opaque struct (ptr)
// which we convert to int32 with the LLVM pass HandleSamplerInitialization.

#define IMPLEMENT_READ_IMAGE_INT_COORD(__IMGTYPE__,__RETVAL__,__POSTFIX__,\
                                            __COORD__)                  \
  __RETVAL__ _CL_OVERLOADABLE read_image##__POSTFIX__ (__IMGTYPE__ image, \
                                                       sampler_t sampler, \
                                                       __COORD__ coord) \
  {                                                                     \
    __RETVAL__ color;                                                   \
    int4 coord4;                                                        \
    INITCOORD##__COORD__(coord4, coord);                                \
    ADDRESS_SPACE dev_image_t* i_ptr =                                  \
      __builtin_astype (image, ADDRESS_SPACE dev_image_t*);             \
    dev_sampler_t s = *__builtin_astype(sampler, dev_sampler_t*);	\
    if (__pocl_is_out_of_bounds (i_ptr, &coord4, &s, &color))           \
      {                                                                 \
        return color;                                                   \
      }                                                                 \
    __pocl_read_pixel (&color, i_ptr, coord4); \
                                                                        \
    return color;                                                       \
  }

#else

// Before Clang 4.0, the sampler_t was passed as an int32.

#define IMPLEMENT_READ_IMAGE_INT_COORD(__IMGTYPE__,__RETVAL__,__POSTFIX__,\
                                            __COORD__)                  \
  __RETVAL__ _CL_OVERLOADABLE read_image##__POSTFIX__ (__IMGTYPE__ image, \
                                                       sampler_t sampler, \
                                                       __COORD__ coord) \
  {                                                                     \
    __RETVAL__ color;                                                   \
    int4 coord4;                                                        \
    INITCOORD##__COORD__(coord4, coord);                                \
    ADDRESS_SPACE dev_image_t* i_ptr =                                  \
      __builtin_astype (image, ADDRESS_SPACE dev_image_t*);             \
    dev_sampler_t s = __builtin_astype(sampler, dev_sampler_t);		\
    if (__pocl_is_out_of_bounds (i_ptr, &coord4, &s, &color))           \
      {                                                                 \
        return color;                                                   \
      }                                                                 \
    __pocl_read_pixel (&color, i_ptr, coord4); \
                                                                        \
    return color;                                                       \
  }
#endif

/* NO Sampler Implementation for read_image with any image data type
   and int coordinates
   __IMGTYPE__ = image type (image2d_t, ...)
   __RETVAL__  = return value (int4 or uint4 float4)
   __POSTFIX__ = function name postfix (i, ui, f)
   __COORD__   = coordinate type (int, int2, int4)
   OCL 1.2 Spec Says
   The samplerless read image functions behave exactly as the
   corresponding read image functions that take integer
   coordinates and a sampler with filter mode set to
   CLK_FILTER_NEAREST, normalized coordinates set to
   CLK_NORMALIZED_COORDS_FALSE and
   addressing mode to CLK_ADDRESS_NONE.
   CLK_ADDRESS_NONE – for this addressing mode the programmer guarantees that
   the image coordinates used to sample elements of the image refer to a
   location inside the image; otherwise the results are undefined.
   Thus we do not need out of bound check for now.
   If we need sampler for other cases it has to be defined as default sampler:
   const sampler_t defualt_sampler = CLK_NORMALIZED_COORDS_FALSE |
                                  CLK_ADDRESS_NONE |
                                  CLK_FILTER_NEAREST;
*/
#define IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER(__IMGTYPE__, __RETVAL__, \
                                                 __POSTFIX__, __COORD__) \
  __RETVAL__ _CL_OVERLOADABLE read_image##__POSTFIX__ (__IMGTYPE__ image, \
                                                       __COORD__ coord) \
  {                                                                     \
    __RETVAL__ color;                                                   \
    int4 coord4;                                                        \
    INITCOORD##__COORD__ (coord4, coord);                               \
    ADDRESS_SPACE dev_image_t* i_ptr =                                  \
      __builtin_astype (image, ADDRESS_SPACE dev_image_t*);             \
    __pocl_read_pixel (&color, i_ptr, coord4);  \
                                                                        \
    return color;                                                       \
  }                                                                     \

/* read_image 2d function instantions */
IMPLEMENT_READ_IMAGE_INT_COORD (image2d_t, float4, f, int2)

IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER (image2d_t, float4, f, int2)
IMPLEMENT_READ_IMAGE_INT_COORD_NOSAMPLER (image2d_array_t, float4, f, int4)

IMPLEMENT_READ_IMAGE_INT_COORD (image2d_array_t, float4, f, int4)

IMPLEMENT_READ_IMAGE_INT_COORD (image2d_t, uint4, ui, int2)
IMPLEMENT_READ_IMAGE_INT_COORD (image2d_t, int4, i, int2)

/* read_image 3d function instantions */
IMPLEMENT_READ_IMAGE_INT_COORD (image3d_t, uint4, ui, int4)
IMPLEMENT_READ_IMAGE_INT_COORD (image3d_t, float4, f, int4)


Uploaded test file.

Uploaded test file.

(*
 *  A contribution from Anne Sheets (sheets@cory)
 *
 *  Tests the arithmetic operations and various other things
 *)

class A {

   var : Int <- 0;

   value() : Int { var };

   set_var(num : Int) : SELF_TYPE {
      {
         var <- num;
         self;
      }
   };

   method1(num : Int) : SELF_TYPE {  -- same
      self
   };

   method2(num1 : Int, num2 : Int) : B {  -- plus
      (let x : Int in
	 {
            x <- num1 + num2;
	    (new B).set_var(x);
	 }
      )
   };

   method3(num : Int) : C {  -- negate
      (let x : Int in
	 {
            x <- ~num;
	    (new C).set_var(x);
	 }
      )
   };

   method4(num1 : Int, num2 : Int) : D {  -- diff
            if num2 < num1 then
               (let x : Int in
		  {
                     x <- num1 - num2;
	             (new D).set_var(x);
	          }
               )
            else
               (let x : Int in
		  {
	             x <- num2 - num1;
	             (new D).set_var(x);
		  }
               )
            fi
   };

   method5(num : Int) : E {  -- factorial
      (let x : Int <- 1 in
	 {
	    (let y : Int <- 1 in
	       while y <= num loop
	          {
                     x <- x * y;
	             y <- y + 1;
	          }
	       pool
	    );
	    (new E).set_var(x);
	 }
      )
   };

};

class B inherits A {  -- B is a number squared

   method5(num : Int) : E { -- square
      (let x : Int in
	 {
            x <- num * num;
	    (new E).set_var(x);
	 }
      )
   };

};

class C inherits B {

   method6(num : Int) : A { -- negate
      (let x : Int in
         {
            x <- ~num;
	    (new A).set_var(x);
         }
      )
   };

   method5(num : Int) : E {  -- cube
      (let x : Int in
	 {
            x <- num * num * num;
	    (new E).set_var(x);
	 }
      )
   };

};

class D inherits B {

   method7(num : Int) : Bool {  -- divisible by 3
      (let x : Int <- num in
            if x < 0 then method7(~x) else
            if 0 = x then true else
            if 1 = x then false else
	    if 2 = x then false else
	       method7(x - 3)
	    fi fi fi fi
      )
   };

};

class E inherits D {

   method6(num : Int) : A {  -- division
      (let x : Int in
         {
            x <- num / 8;
	    (new A).set_var(x);
         }
      )
   };

};

(* The following code is from atoi.cl in ~cs164/examples *)

(*
   The class A2I provides integer-to-string and string-to-integer
conversion routines.  To use these routines, either inherit them
in the class where needed, have a dummy variable bound to
something of type A2I, or simpl write (new A2I).method(argument).
*)

(*
   c2i   Converts a 1-character string to an integer.  Aborts
         if the string is not "0" through "9"
*)
class A2I {

     c2i(char : String) : Int {
	if char = "0" then 0 else
	if char = "1" then 1 else
	if char = "2" then 2 else
        if char = "3" then 3 else
        if char = "4" then 4 else
        if char = "5" then 5 else
        if char = "6" then 6 else
        if char = "7" then 7 else
        if char = "8" then 8 else
        if char = "9" then 9 else
        { abort(); 0; }  (* the 0 is needed to satisfy the
				  typchecker *)
        fi fi fi fi fi fi fi fi fi fi
     };

(*
   i2c is the inverse of c2i.
*)
     i2c(i : Int) : String {
	if i = 0 then "0" else
	if i = 1 then "1" else
	if i = 2 then "2" else
	if i = 3 then "3" else
	if i = 4 then "4" else
	if i = 5 then "5" else
	if i = 6 then "6" else
	if i = 7 then "7" else
	if i = 8 then "8" else
	if i = 9 then "9" else
	{ abort(); ""; }  -- the "" is needed to satisfy the typchecker
        fi fi fi fi fi fi fi fi fi fi
     };

(*
   a2i converts an ASCII string into an integer.  The empty string
is converted to 0.  Signed and unsigned strings are handled.  The
method aborts if the string does not represent an integer.  Very
long strings of digits produce strange answers because of arithmetic
overflow.

*)
     a2i(s : String) : Int {
        if s.length() = 0 then 0 else
	if s.substr(0,1) = "-" then ~a2i_aux(s.substr(1,s.length()-1)) else
        if s.substr(0,1) = "+" then a2i_aux(s.substr(1,s.length()-1)) else
           a2i_aux(s)
        fi fi fi
     };

(* a2i_aux converts the usigned portion of the string.  As a
   programming example, this method is written iteratively.  *)

     a2i_aux(s : String) : Int {
	(let int : Int <- 0 in
           {
               (let j : Int <- s.length() in
	          (let i : Int <- 0 in
		    while i < j loop
			{
			    int <- int * 10 + c2i(s.substr(i,1));
			    i <- i + 1;
			}
		    pool
		  )
	       );
              int;
	    }
        )
     };

(* i2a converts an integer to a string.  Positive and negative
   numbers are handled correctly.  *)

    i2a(i : Int) : String {
	if i = 0 then "0" else
        if 0 < i then i2a_aux(i) else
          "-".concat(i2a_aux(i * ~1))
        fi fi
    };

(* i2a_aux is an example using recursion.  *)

    i2a_aux(i : Int) : String {
        if i = 0 then "" else
	    (let next : Int <- i / 10 in
		i2a_aux(next).concat(i2c(i - next * 10))
	    )
        fi
    };

};

class Main inherits IO {

   char : String;
   avar : A;
   a_var : A;
   flag : Bool <- true;

   menu() : String {
      {
         out_string("\n\tTo add a number to ");
         print(avar);
         out_string("...enter a:\n");
         out_string("\tTo negate ");
         print(avar);
         out_string("...enter b:\n");
         out_string("\tTo find the difference between ");
         print(avar);
         out_string("and another number...enter c:\n");
         out_string("\tTo find the factorial of ");
         print(avar);
         out_string("...enter d:\n");
         out_string("\tTo square ");
         print(avar);
         out_string("...enter e:\n");
         out_string("\tTo cube ");
         print(avar);
         out_string("...enter f:\n");
         out_string("\tTo find out if ");
         print(avar);
         out_string("is a multiple of 3...enter g:\n");
         out_string("\tTo divide ");
         print(avar);
         out_string("by 8...enter h:\n");
	 out_string("\tTo get a new number...enter j:\n");
	 out_string("\tTo quit...enter q:\n\n");
         in_string();
      }
   };

   prompt() : String {
      {
         out_string("\n");
         out_string("Please enter a number...  ");
         in_string();
      }
   };

   get_int() : Int {
      {
	 (let z : A2I <- new A2I in
	    (let s : String <- prompt() in
	       z.a2i(s)
	    )
         );
      }
   };

   is_even(num : Int) : Bool {
      (let x : Int <- num in
            if x < 0 then is_even(~x) else
            if 0 = x then true else
	    if 1 = x then false else
	          is_even(x - 2)
	    fi fi fi
      )
   };

   class_type(var : A) : SELF_TYPE {
      case var of
	 a : A => out_string("Class type is now A\n");
	 b : B => out_string("Class type is now B\n");
	 c : C => out_string("Class type is now C\n");
	 d : D => out_string("Class type is now D\n");
	 e : E => out_string("Class type is now E\n");
	 o : Object => out_string("Oooops\n");
      esac
   };

   print(var : A) : SELF_TYPE {
     (let z : A2I <- new A2I in
	{
	   out_string(z.i2a(var.value()));
	   out_string(" ");
	}
     )
   };

   main() : Object {
      {
         avar <- (new A);
         while flag loop
            {
	       -- avar <- (new A).set_var(get_int());
	       out_string("number ");
	       print(avar);
	       if is_even(avar.value()) then
	          out_string("is even!\n")
	       else
	          out_string("is odd!\n")
	       fi;
	       -- print(avar); -- prints out answer
	       class_type(avar);
	       char <- menu();
                  if char = "a" then -- add
                     {
                        a_var <- (new A).set_var(get_int());
	                avar <- (new B).method2(avar.value(), a_var.value());
	             } else
                  if char = "b" then -- negate
                     case avar of
	                   c : C => avar <- c.method6(c.value());
	                   a : A => avar <- a.method3(a.value());
	                   o : Object => {
		                  out_string("Oooops\n");
		                  abort(); 0;
		               };
                     esac else
                  if char = "c" then -- diff
                     {
                        a_var <- (new A).set_var(get_int());
	                avar <- (new D).method4(avar.value(), a_var.value());
	             } else
                  if char = "d" then avar <- (new C)@A.method5(avar.value()) else
		          -- factorial
                  if char = "e" then avar <- (new C)@B.method5(avar.value()) else
			  -- square
                  if char = "f" then avar <- (new C)@C.method5(avar.value()) else
			  -- cube
                  if char = "g" then -- multiple of 3?
		      if ((new D).method7(avar.value()))
		                       then -- avar <- (new A).method1(avar.value())
			 {
	                    out_string("number ");
	                    print(avar);
	                    out_string("is divisible by 3.\n");
			 }
			 else  -- avar <- (new A).set_var(0)
			 {
	                    out_string("number ");
	                    print(avar);
	                    out_string("is not divisible by 3.\n");
			 }
		      fi else
                  if char = "h" then
		      (let x : A in
			 {
		            x <- (new E).method6(avar.value());
			    (let r : Int <- (avar.value() - (x.value() * 8)) in
			       {
			          out_string("number ");
			          print(avar);
			          out_string("is equal to ");
			          print(x);
			          out_string("times 8 with a remainder of ");
				  (let a : A2I <- new A2I in
				     {
			                out_string(a.i2a(r));
			                out_string("\n");
				     }
				  ); -- end let a:
			       }
                            ); -- end let r:
			    avar <- x;
		         }
		      )  -- end let x:
		      else
                  if char = "j" then avar <- (new A)
		      else
                  if char = "q" then flag <- false
		      else
                      avar <- (new A).method1(avar.value()) -- divide/8
                  fi fi fi fi fi fi fi fi fi fi;
            }
         pool;
       }
   };

};

(* models one-dimensional cellular automaton on a circle of finite radius
   arrays are faked as Strings,
   X's respresent live cells, dots represent dead cells,
   no error checking is done *)

class CellularAutomaton inherits IO {
    population_map : String;

    init(map : String) : SELF_TYPE {
        {
            population_map <- map;
            self;
        }
    };

    print() : SELF_TYPE {
        {
            out_string(population_map.concat("\n"));
            self;
        }
    };

    num_cells() : Int {
        population_map.length()
    };

    cell(position : Int) : String {
        population_map.substr(position, 1)
    };

    cell_left_neighbor(position : Int) : String {
        if position = 0 then
            cell(num_cells() - 1)
        else
            cell(position - 1)
        fi
    };

    cell_right_neighbor(position : Int) : String {
        if position = num_cells() - 1 then
            cell(0)
        else
            cell(position + 1)
        fi
    };

    (* a cell will live if exactly 1 of itself and it's immediate
       neighbors are alive *)
    cell_at_next_evolution(position : Int) : String {
        if (if cell(position) = "X" then 1 else 0 fi
            + if cell_left_neighbor(position) = "X" then 1 else 0 fi
            + if cell_right_neighbor(position) = "X" then 1 else 0 fi
            = 1)
        then
            "X"
        else
            '.'
        fi
    };

    evolve() : SELF_TYPE {
        (let position : Int in
        (let num : Int <- num_cells[] in
        (let temp : String in
            {
                while position < num loop
                    {
                        temp <- temp.concat(cell_at_next_evolution(position));
                        position <- position + 1;
                    }
                pool;
                population_map <- temp;
                self;
            }
        ) ) )
    };
};

class Main {
    cells : CellularAutomaton;

    main() : SELF_TYPE {
        {
            cells <- (new CellularAutomaton).init("         X         ");
            cells.print();
            (let countdown : Int <- 20 in
                while countdown > 0 loop
                    {
                        cells.evolve();
                        cells.print();
                        countdown <- countdown - 1;

                pool
            );  (* end let countdown
            self;
        }
    };
};

error: pathspec 'test.cl' did not match any file(s) known to git


opencl: adds kernel for fetching particles addresses

#ifndef SIXTRACKLIB_OPENCL_KERNELS_FETCH_PARTICLES_ADDR_CL__
#define SIXTRACKLIB_OPENCL_KERNELS_FETCH_PARTICLES_ADDR_CL__

#if !defined( SIXTRL_NO_INCLUDES )
    #include "sixtracklib/opencl/internal/default_compile_options.h"

    #include "sixtracklib/common/definitions.h"
    #include "sixtracklib/common/internal/buffer_main_defines.h"
    #include "sixtracklib/common/buffer/managed_buffer_minimal.h"
    #include "sixtracklib/common/buffer/buffer_type.h"
    #include "sixtracklib/common/particles/definitions.h"
    #include "sixtracklib/common/particles/particles_addr.h"
#endif /* !defined( SIXTRL_NO_INCLUDES ) */

__kernel void NS(Particles_buffer_store_all_addresses_opencl)(
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT pbuffer_begin,
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char const* SIXTRL_RESTRICT paddr_buffer_begin,
    SIXTRL_UINT64_T const slot_size )
{
    typedef NS(buffer_size_t) buf_size_t;

    buf_size_t const num_objects = NS(ManagedBuffer_get_num_objects)(
        pbuffer_begin, slot_size );

    buf_size_t ii = ( buf_size_t )get_global_id( 0 );
    buf_size_t const stride = ( buf_size_t )get_global_size( 0 );

    for( ; ii < num_objects ; ii += stride )
    {
        NS(Particles_managed_buffer_store_addresses)(
            paddr_buffer_begin, pbuffer_begin, ii, slot_size );
    }
}

#endif /* SIXTRACKLIB_OPENCL_KERNELS_FETCH_PARTICLES_ADDR_CL__ */

error: pathspec 'sixtracklib/opencl/kernels/fetch_particles_addr.cl' did not match any file(s) known to git


Finished and commented part 4

Finished and commented part 4

;;; Program which takes three arguments: two s-expressions and a list. Function
;;; will examine the third argument, looking for occurrences of the first
;;; argument and replacing them with the second argument.
;;;
;;; Written by Andrew Lyne February 24, 2015;;;

;(trace repl)
;(trace repl_rec)

(defun repl (val rpl lst)
	(cond
		( (listp lst ) (reverse (repl_rec val rpl lst '() ) ) )
	)
	;( repl_rec val rpl lst '() )
)

(defun repl_rec ( val rpl inlst outlst)
	(cond
		;; Base Case, inlist is empty. return outlist.
		( ( equal inlst  '() ) outlst )

		;; Rec case - The first element is a match.
		((equal (car inlst) val) (repl_rec val rpl (cdr inlst) (cons rpl outlst)))

		;; Recursive Case: Remove the first element of the inlst and process it.
        	(T
	      		(cond
	              	;; The first value is a list. Recursivly call The function, add the results
			;; into a list and add car that to the outlist.
			(
				(listp (car inlst))
				(repl_rec val rpl (cdr inlst) (cons (repl val rpl (car inlst)) outlst))
			)

			;; The first value is an atom but not what we are looking for. Append it to
			;; the outlis it and move on.
			(
				(atom (car inlst))
				(repl_rec val rpl (cdr inlst) (cons (car inlst) outlst))
			)

			)
		)
	)
)

error: pathspec 'Project1/repl.cl' did not match any file(s) known to git


DEVICE kernel grsmyr-monolithic

DEVICE kernel grsmyr-monolithic

This wasn't supposed to be released but it already has a good
performance boost solving overspilling (both I$ and regisers).
I planned to play more with uints but since MYR is getting hammered, I'm
letting it in the wild.

error: pathspec 'M8M/kernels/grsmyr_monolithic.cl' did not match any file(s) known to git


Added add_floats OpenCL kernel

Added add_floats OpenCL kernel

// Basic example of adding floats from one input and write to another output

__kernel void add_floats(global float* input, global float* output)
{
    size_t i = get_global_id(0);
    output[i] = input[i] + input[i];
}

error: pathspec 'examples/add_floats/add_floats.cl' did not match any file(s) known to git


Adding core file.

Adding core file.

#| Problem One: Sum all multiples of 3 and 5 less than 1000.  |#

;; Almost works but adds common multiples twice.

(defun tail (base n sum limit)
  (if (< (* base n) limit)
      (tail base (+ n 1) (+ sum (* base n)) limit)
      sum))

;; A more messy attempt ... Currenlty fixing unbound (and) clause.

#|
 (cond
        (
         <exp> <conseq>
         <default>
        )
|#

(defun twin-recursion (base-one base-two n m limit total)
  (cond (
	 ;; Add both x3 and x5 when x3 is not equal to x5.
	 (not (= (* base-one n)(* base-two m)))
	 (cond (
		(and (< (* base-one n) limit)(< (* base-two m) limit))
		(twin-recursion base-one base-two (+ n 1) (+ m 1) limit (+ total (* base-one n)(* base-two m)))

		(and (< (* base-one n) limit)(> (* base-two m) limit))
		(twin-recursion base-one base-two (+ n 1) m limit (+ total (* base-one n)))

		(and (> (* base-one n) limit)(< (* base-two m) limit))
		(twin-recursion base-one base-two n (+ m 1) limit (+ total (* base-two m)))

    		(print total)  ;; not working properly
		))
	 ;; When 3n = 3m
	 (not (> (* base-one n) limit))
	 (twin-recursion base-one base-two (+ n 1) (+ m 1) limit (+ total (* 2 base-one n)))

	 (print total)
	 )
  )
 )

;; A Symbolic Approach
;; Hashed Array, prcoess by eliminating via hash.

(defun sol (base-one base-two limit done)
(
 (let
     (
      (list-one (list 1))
      (list-two (list 2))
     )
  (print list-one)
  (print list-two))))

error: pathspec 'one.cl' did not match any file(s) known to git