Added OpenCL reorder kernel

Added OpenCL reorder 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
 ********************************************************/

#ifndef T
#define T float
#endif

#ifndef dim_type
#define dim_type int
#endif

__kernel __attribute__ ((reqd_work_group_size(32, 8, 1)))
void reorder_kernel(__global T *out,
                    const dim_type odim0,
                    const dim_type odim1,
                    const dim_type odim2,
                    const dim_type odim3,
                    const dim_type ostride0,
                    const dim_type ostride1,
                    const dim_type ostride2,
                    const dim_type ostride3,
                    const dim_type ooffset,
                    __global const T *in,
                    const dim_type idim0,
                    const dim_type idim1,
                    const dim_type idim2,
                    const dim_type idim3,
                    const dim_type istride0,
                    const dim_type istride1,
                    const dim_type istride2,
                    const dim_type istride3,
                    const dim_type ioffset,
                    const dim_type d0,
                    const dim_type d1,
                    const dim_type d2,
                    const dim_type d3,
                    const dim_type blocksPerMatX,
                    const dim_type blocksPerMatY)
{
    const dim_type oz = get_group_id(0) / blocksPerMatX;
    const dim_type ow = get_group_id(1) / blocksPerMatY;

    const dim_type blockIdx_x = get_group_id(0) - oz * blocksPerMatX;
    const dim_type blockIdx_y = get_group_id(1) - ow * blocksPerMatY;

    const dim_type xx = get_local_id(0) + blockIdx_x * get_local_size(0);
    const dim_type yy = get_local_id(1) + blockIdx_y * get_local_size(1);

    if(xx >= odim0 ||
       yy >= odim1 ||
       oz >= odim2 ||
       ow >= odim3)
        return;

    const dim_type incy = blocksPerMatY * get_local_size(1);
    const dim_type incx = blocksPerMatX * get_local_size(0);

    const dim_type o_off   = ow * ostride3 + oz * ostride2;
    const dim_type rdims[] = {d0, d1, d2, d3};
          dim_type ods[]   = {xx, yy, oz, ow};
          dim_type ids[4]  = {0};

    ids[rdims[3]] = ow;
    ids[rdims[2]] = oz;

    for(dim_type oy = yy; oy < odim1; oy += incy) {
        ids[rdims[1]] = oy;
        for(dim_type ox = xx; ox < odim0; ox += incx) {
            ids[rdims[0]] = ox;

            const dim_type oIdx = o_off + oy * ostride1 + ox;

            const dim_type iIdx = ids[3] * istride3 + ids[2] * istride2 +
                                  ids[1] * istride1 + ids[0];

            out[oIdx] = in[ioffset + iIdx];
        }
    }
}

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


Added OpenCL tile kernel

Added OpenCL tile 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
 ********************************************************/

#ifndef T
#define T float
#endif

#ifndef dim_type
#define dim_type int
#endif

__kernel __attribute__ ((reqd_work_group_size(32, 8, 1)))
void tile_kernel(__global T *out,
                 const dim_type odim0,
                 const dim_type odim1,
                 const dim_type odim2,
                 const dim_type odim3,
                 const dim_type ostride0,
                 const dim_type ostride1,
                 const dim_type ostride2,
                 const dim_type ostride3,
                 const dim_type ooffset,
                 __global const T *in,
                 const dim_type idim0,
                 const dim_type idim1,
                 const dim_type idim2,
                 const dim_type idim3,
                 const dim_type istride0,
                 const dim_type istride1,
                 const dim_type istride2,
                 const dim_type istride3,
                 const dim_type ioffset,
                 const dim_type blocksPerMatX, const dim_type blocksPerMatY)
{
    const dim_type oz = get_group_id(0) / blocksPerMatX;
    const dim_type ow = get_group_id(1) / blocksPerMatY;

    const dim_type blockIdx_x = get_group_id(0) - oz * blocksPerMatX;
    const dim_type blockIdx_y = get_group_id(1) - ow * blocksPerMatY;

    const dim_type xx = get_local_id(0) + blockIdx_x * get_local_size(0);
    const dim_type yy = get_local_id(1) + blockIdx_y * get_local_size(1);

    if(xx >= odim0 ||
       yy >= odim1 ||
       oz >= odim2 ||
       ow >= odim3)
        return;

    const dim_type iz = oz % idim2;
    const dim_type iw = ow % idim3;
    const dim_type izw = iw * istride3 + iz * istride2;
    const dim_type ozw = ow * ostride3 + oz * ostride2;

    const dim_type incy = blocksPerMatY * get_local_size(1);
    const dim_type incx = blocksPerMatX * get_local_size(0);

    for(dim_type oy = yy; oy < odim1; oy += incy) {
        const dim_type iy = oy % idim1;
        for(dim_type ox = xx; ox < odim0; ox += incx) {
            const dim_type ix = ox % idim0;

            dim_type iMem = izw + iy * istride1 + ix;
            dim_type oMem = ozw + oy * ostride1 + ox;

            out[oMem] = in[ioffset + iMem];
        }
    }
}

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


adds the OpenCL code from the Apple QuaterionJulia example

//
// File:       qjulia.c
//
// Abstract:   This example shows how to use OpenCL to raytrace a 4d Quaternion Julia-Set
//             Fractal and intermix the results of a compute kernel with OpenGL for rendering.
//
// Version:    <1.0>
//
// Disclaimer: IMPORTANT:  This Apple software is supplied to you by Apple Inc. ("Apple")
//             in consideration of your agreement to the following terms, and your use,
//             installation, modification or redistribution of this Apple software
//             constitutes acceptance of these terms.  If you do not agree with these
//             terms, please do not use, install, modify or redistribute this Apple
//             software.
//
//             In consideration of your agreement to abide by the following terms, and
//             subject to these terms, Apple grants you a personal, non - exclusive
//             license, under Apple's copyrights in this original Apple software ( the
//             "Apple Software" ), to use, reproduce, modify and redistribute the Apple
//             Software, with or without modifications, in source and / or binary forms;
//             provided that if you redistribute the Apple Software in its entirety and
//             without modifications, you must retain this notice and the following text
//             and disclaimers in all such redistributions of the Apple Software. Neither
//             the name, trademarks, service marks or logos of Apple Inc. may be used to
//             endorse or promote products derived from the Apple Software without specific
//             prior written permission from Apple.  Except as expressly stated in this
//             notice, no other rights or licenses, express or implied, are granted by
//             Apple herein, including but not limited to any patent rights that may be
//             infringed by your derivative works or by other works in which the Apple
//             Software may be incorporated.
//
//             The Apple Software is provided by Apple on an "AS IS" basis.  APPLE MAKES NO
//             WARRANTIES, EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION THE IMPLIED
//             WARRANTIES OF NON - INFRINGEMENT, MERCHANTABILITY AND FITNESS FOR A
//             PARTICULAR PURPOSE, REGARDING THE APPLE SOFTWARE OR ITS USE AND OPERATION
//             ALONE OR IN COMBINATION WITH YOUR PRODUCTS.
//
//             IN NO EVENT SHALL APPLE BE LIABLE FOR ANY SPECIAL, INDIRECT, INCIDENTAL OR
//             CONSEQUENTIAL DAMAGES ( INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
//             SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
//             INTERRUPTION ) ARISING IN ANY WAY OUT OF THE USE, REPRODUCTION, MODIFICATION
//             AND / OR DISTRIBUTION OF THE APPLE SOFTWARE, HOWEVER CAUSED AND WHETHER
//             UNDER THEORY OF CONTRACT, TORT ( INCLUDING NEGLIGENCE ), STRICT LIABILITY OR
//             OTHERWISE, EVEN IF APPLE HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
//
// Copyright ( C ) 2008 Apple Inc. All Rights Reserved.
//
////////////////////////////////////////////////////////////////////////////////////////////////////

#ifndef WIDTH
#define WIDTH                       (512)
#endif
#ifndef HEIGHT
#define HEIGHT                      (512)
#endif
#define ASPECT                      ((float)WIDTH / (float)HEIGHT)
#define SQR(x)                      ((x)*(x))
#define BOUNDING_RADIUS             (2.0f)
#define BOUNDING_RADIUS_SQR         (SQR(BOUNDING_RADIUS))
#define ESCAPE_THRESHOLD            (BOUNDING_RADIUS * 1.5f)
#define DELTA                       (1e-5f)
#define ITERATIONS                  (10)
#define EPSILON                     (0.003f)
#define SHADOWS                     (0)

////////////////////////////////////////////////////////////////////////////////////////////////////

float4 qmult( float4 q1, float4 q2 )
{
    float4 r;
    float3 t;

    float3 q1yzw = (float3)(q1.y, q1.z, q1.w);
    float3 q2yzw = (float3)(q2.y, q2.z, q2.w);
    float3 c = cross( q1yzw, q2yzw );

    t = q2yzw * q1.x + q1yzw * q2.x + c;
    r.x = q1.x * q2.x - dot( q1yzw, q2yzw );
    r.yzw = t.xyz;

    return r;
}

float4 qsqr( float4 q )
{
    float4 r;
    float3 t;

    float3 qyzw = (float3)(q.y, q.z, q.w);

    t     = 2.0f * q.x * qyzw;
    r.x   = q.x * q.x - dot( qyzw, qyzw );
    r.yzw = t.xyz;

    return r;
}

////////////////////////////////////////////////////////////////////////////////////////////////////

float3
EstimateNormalQJulia(
    float3 p,
    float4 c,
    int iterations )
{
    float4 qp = (float4)( p.x, p.y, p.z, 0.0f );
    float4 gx1 = qp - (float4)( DELTA, 0.0f, 0.0f, 0.0f );
    float4 gx2 = qp + (float4)( DELTA, 0.0f, 0.0f, 0.0f );
    float4 gy1 = qp - (float4)( 0.0f, DELTA, 0.0f, 0.0f );
    float4 gy2 = qp + (float4)( 0.0f, DELTA, 0.0f, 0.0f );
    float4 gz1 = qp - (float4)( 0.0f, 0.0f, DELTA, 0.0f );
    float4 gz2 = qp + (float4)( 0.0f, 0.0f, DELTA, 0.0f );

    for ( int i = 0; i < iterations; i++ )
    {
        gx1 = qsqr( gx1 ) + c;
        gx2 = qsqr( gx2 ) + c;
        gy1 = qsqr( gy1 ) + c;
        gy2 = qsqr( gy2 ) + c;
        gz1 = qsqr( gz1 ) + c;
        gz2 = qsqr( gz2 ) + c;
    }

    float nx = fast_length(gx2) - fast_length(gx1);
    float ny = fast_length(gy2) - fast_length(gy1);
    float nz = fast_length(gz2) - fast_length(gz1);

    float3 normal = fast_normalize((float3)( nx, ny, nz ));

    return normal;
}

////////////////////////////////////////////////////////////////////////////////////////////////////

float4
IntersectQJulia(
    float3 rO,
    float3 rD,
    float4 c,
    float epsilon,
    float escape)
{
    float rd = 0.0f;
    float dist = epsilon;
    while ( dist >= epsilon && rd < escape)
    {
        float4 z = (float4)( rO.x, rO.y, rO.z, 0.0f );
        float4 zp = (float4)( 1.0f, 0.0f, 0.0f, 0.0f );
        float zd = 0.0f;
        uint count = 0;
        while(zd < escape && count < ITERATIONS)
        {
            zp = 2.0f * qmult(z, zp);
            z = qsqr(z) + c;
            zd = dot(z, z);
            count++;
        }

        float normZ = fast_length( z );
        dist = 0.5f * normZ * half_log( normZ ) / fast_length( zp );
        rO += rD * dist;
        rd = dot(rO, rO);
    }

    return (float4)(rO.x, rO.y, rO.z, dist);
}

////////////////////////////////////////////////////////////////////////////////////////////////////

float3
Phong(
    float3 light,
    float3 eye,
    float3 pt,
    float3 normal,
    float3 base)
{
    const float SpecularExponent = 10.0f;
    const float Specularity = 0.45f;

    float3 light_dir = fast_normalize( light - pt );
    float3 eye_dir = fast_normalize( eye - pt );
    float NdotL = dot( normal, light_dir );
    float3 reflect_dir = light_dir - 2.0f * NdotL * normal;

    base += fabs(normal) * 0.5f;
    float3 diffuse = base * fmax(NdotL, 0.0f);
    float3 specular = Specularity * half_powr( fmax( dot(eye_dir, reflect_dir), 0.0f), SpecularExponent );
    return diffuse + specular;
}

////////////////////////////////////////////////////////////////////////////////////////////////////

float
IntersectSphere(
    float3 rO,
    float3 rD,
    float radius )
{
    float fB = 2.0f * dot( rO, rD );
    float fB2 = fB * fB;
    float fC = dot( rO, rO ) - radius;
    float fT = (fB2 - 4.0f * fC);
    if (fT <= 0.0f)
        return 0.0f;
    float fD = half_sqrt( fT );
    float fT0 = ( -fB + fD ) * 0.5f;
    float fT1 = ( -fB - fD ) * 0.5f;
    fT = fmin(fT0, fT1);
    return fT;
}

////////////////////////////////////////////////////////////////////////////////////////////////////

float4
RaytraceQJulia(
    float3 rO,
    float3 rD,
    float4 mu,
    float epsilon,
    float3 eye,
    float3 light,
    float3 diffuse,
    float radius,
    bool shadows,
    int iterations )
{
    const float4 background = (float4)( 0.15f, 0.15f, 0.15f, 0.0f );
    float4 color = background;

    rD = fast_normalize( rD );
    float t = IntersectSphere( rO, rD, radius );
    if ( t <= 0.0f )
        return color;

    rO += rD * t;
    float4 hit = IntersectQJulia( rO, rD, mu, epsilon, ESCAPE_THRESHOLD );
    float dist = hit.w;
    if (dist >= epsilon)
        return color;

    rO.xyz = hit.xyz;
    float3 normal = EstimateNormalQJulia( rO, mu, iterations );

    float3 rgb = Phong( light, rD, rO, normal, diffuse );
    color.xyz = rgb.xyz;
    color.w = 1.0f;

    if (SHADOWS)
    {
        float3 light_dir = fast_normalize( light - rO );
        rO += normal * epsilon * 2.0f;
        hit = IntersectQJulia( rO, light_dir, mu, epsilon, ESCAPE_THRESHOLD );
        dist = hit.w;
        color.xyz *= (dist < epsilon) ? (0.4f) : (1.0f);
    }

    return color;
}

///////////////////////////////////////////////////////////////////////////////////////////

float4
QJulia(
    float4 coord,
    float4 mu,
    float4 diffuse,
    float epsilon,
    float iterations,
    int shadows,
    uint width,
    uint height)
{
    float zoom = BOUNDING_RADIUS_SQR;
    float radius = BOUNDING_RADIUS_SQR;

    float2 size = (float2)((float)width, (float)height);
    float scale = max(size.x, size.y);
    float2 h = (float2)(0.5f, 0.5f); // half
    float2 position = (coord.xy - h * size) / scale;
    float2 frame = (position) * zoom;

    float3 light = (float3)(1.5f, 0.5f, 4.0f);
    float3 eye = (float3)(0.0f, 0.0f, 4.0f);
    float3 ray = (float3)(frame.x, frame.y, 0.0f);
    float3 base = (float3)(diffuse.x, diffuse.y, diffuse.z);

    float3 rO = eye;
    float3 rD = (ray - rO);

    float4 color = RaytraceQJulia( rO, rD, mu, epsilon, eye, light, base, radius, shadows, iterations);

    return color;
}

////////////////////////////////////////////////////////////////////////////////////////////////////

__kernel void
QJuliaKernel(
    __global uchar4 *result,
    const float4 mu,
    const float4 diffuse,
    const float epsilon)
{
    int tx = get_global_id(0);
    int ty = get_global_id(1);
    int sx = get_global_size(0);
    int sy = get_global_size(1);
    int index = ty * WIDTH + tx;
    bool valid = (tx < WIDTH) && (ty < HEIGHT);

    float4 coord = (float4)((float)tx, (float)ty, 0.0f, 0.0f);

    if(valid)
    {
        float4 color = QJulia(coord, mu, diffuse, epsilon, ITERATIONS, SHADOWS, WIDTH, HEIGHT);
        uchar4 output = convert_uchar4_sat_rte(color * 255.0f);
        result[index] = output;
    }
}

////////////////////////////////////////////////////////////////////////////////////////////////////


implemented 3D binary thresholding

implemented 3D binary thresholding

__constant sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE | CLK_ADDRESS_NONE | CLK_FILTER_NEAREST;

float getIntensity(__read_only image2d_t image, int2 pos) {
    float value;
    int dataType = get_image_channel_data_type(image);
    if(dataType == CLK_FLOAT) {
        value = read_imagef(image, sampler, pos).x;
    } else if(dataType == CLK_UNSIGNED_INT8 || dataType == CLK_UNSIGNED_INT16) {
        value = read_imageui(image, sampler, pos).x;
    } else {
        value = read_imagei(image, sampler, pos).x;
    }
    return value;
}

__kernel void thresholding(
        __read_only image2d_t image,
        __write_only image2d_t segmentation,
        __private uchar label,
        __private float lowerThreshold,
        __private float upperThreshold
        ) {
    const int2 pos = {get_global_id(0), get_global_id(1)};

    const float value = getIntensity(image, pos);

    uchar writeValue = 0;
    if(value >= lowerThreshold && value <= lowerThreshold) {
        writeValue = label;
    }
    write_imageui(segmentation, pos, writeValue);
}
__kernel void thresholdingWithOnlyLower(
        __read_only image2d_t image,
        __write_only image2d_t segmentation,
        __private uchar label,
        __private float lowerThreshold
        ) {
    const int2 pos = {get_global_id(0), get_global_id(1)};

    const float value = getIntensity(image, pos);

    uchar writeValue = 0;
    if(value >= lowerThreshold) {
        writeValue = label;
    }
    write_imageui(segmentation, pos, writeValue);
}
__kernel void thresholdingWithOnlyUpper(
        __read_only image2d_t image,
        __write_only image2d_t segmentation,
        __private uchar label,
        __private float upperThreshold
        ) {
    const int2 pos = {get_global_id(0), get_global_id(1)};

    const float value = getIntensity(image, pos);

    uchar writeValue = 0;
    if(value <= upperThreshold) {
        writeValue = label;
    }
    write_imageui(segmentation, pos, writeValue);
}

error: pathspec 'source/Algorithms/BinaryThresholding/BinaryThresholding2D.cl' did not match any file(s) known to git


Adding .travis.cl back because... why not.

language: rust

rust:
- nightly
- beta
- stable

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


Fix an OpenCL test case that was OpenCL conformant.
It had program scope variables that were not in the constant address space,
make them to be function scope variables instead.
Also move the test to the SemaOpenCL directory.

git-svn-id: ffe668792ed300d6c2daa1f6eba2e0aa28d7ec6c@173352 91177308-0d34-0410-b5e6-96231b3b80d8

// RUN: %clang_cc1 -x cl -O0 -emit-llvm  %s -o - -triple x86_64-linux-gnu | FileCheck %s
// OpenCL essentially reduces all shift amounts to the last word-size bits before evaluating.
// Test this both for variables and constants evaluated in the front-end.

//CHECK: @negativeShift32
int negativeShift32(int a,int b) {
  //CHECK: %array0 = alloca [256 x i8]
  char array0[((int)1)<<40];
  //CHECK: %array1 = alloca [256 x i8]
  char array1[((int)1)<<(-24)];

  //CHECK: ret i32 65536
  return ((int)1)<<(-16);
}

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


Wrapped x00, ..., x14 into mps[15]

Wrapped x00, ..., x14 into mps[15]

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/HongjianLi/idock.git/'


Create ccl.cl

Create ccl.cl

// This is a sample implementation of a connected component labeling algorithm
// Written by Naoki Shibata shibatch.sf.net@gmail.com http://ito-lab.naist.jp/~n-sibata/cclarticle/index.xhtml
// This program is in public domain. You can use and modify this code for any purpose without any obligation.

// Naoki Shibata, Shinya Yamamoto: GPGPU-Assisted Subpixel Tracking Method for Fiducial Markers,
// Journal of Information Processing, Vol.22(2014), No.1, pp.19-28, 2014-01. DOI:10.2197/ipsjjip.22.19

__kernel void labelxPreprocess_int_int(global int *label, global int *pix, global int *flags, int maxpass, int bgc, int iw, int ih) {
  const int x = get_global_id(0), y = get_global_id(1);
  const int p0 = y * iw + x;

  if (y == 0 && x < maxpass+1) {
    flags[x] = x == 0 ? 1 : 0;
  }

  if (x >= 0 && y >= 0 && x <= iw-1 && y <= ih-1) label[p0] = 0;
  if (x == 0 || y == 0 || x >= iw-1 || y >= ih-1) return;

  label[p0] = pix[p0] == bgc ? 0 : p0;
}

__kernel void label8xMain_int_int(global int *label, global int *pix, global int *flags, int pass, int iw, int ih) {
  const int x = get_global_id(0), y = get_global_id(1);
  if (x == 0 || y == 0 || x >= iw-1 || y >= ih-1) return;
  const int p0 = y * iw + x;

  if (flags[pass-1] == 0) return;

  int g = label[p0], og = g, s;

  if (g == 0) return;

  if (y > 1) {
    int p1 = p0 - iw; s = label[p1];
    if (s < g && pix[p0] == pix[p1]) g = s;
  }

  if (x > 1) {
    int p1 = p0 - 1; s = label[p1];
    if (s < g && pix[p0] == pix[p1]) g = s;
  }

  if (x < iw-2) {
    int p1 = p0 + 1; s = label[p1];
    if (s < g && pix[p0] == pix[p1]) g = s;
  }

  if (y < ih-2) {
    int p1 = p0 + iw; s = label[p1];
    if (s < g && pix[p0] == pix[p1]) g = s;
  }

  if (y > 1 && x > 1) {
    int p1 = p0 - iw - 1; s = label[p1];
    if (s < g && pix[p0] == pix[p1]) g = s;
  }

  if (y > 1 && x < iw-2) {
    int p1 = p0 - iw + 1; s = label[p1];
    if (s < g && pix[p0] == pix[p1]) g = s;
  }

  if (y < ih-2 && x < iw-2) {
    int p1 = p0 + iw + 1; s = label[p1];
    if (s < g && pix[p0] == pix[p1]) g = s;
  }

  if (y < ih-2 && x > 1) {
    int p1 = p0 + iw - 1; s = label[p1];
    if (s < g && pix[p0] == pix[p1]) g = s;
  }

  for(int j=0;j<16;j++) {
    int s0 = label[g];
    if (s0 >= g) break;
    g = s0;
  }

  if (g != og) {
    atomic_min(&label[og], g);
    atomic_min(&label[p0], g);
    flags[pass] = 1;
  }
}

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


lisp bindings from Peter Szolovits

lisp bindings from Peter Szolovits

git-svn-id: fc35eccb03ccef1c432fd0fcf5295fcceaca86a6@32362 bcba8976-2d24-0410-9c9c-aab3bd5fdfd6

;;; -*- Mode: Lisp; Package: User; -*-

#|
  This is a hand-built Lisp interface to the Link Grammar Parser,
  following its API declarations in link-includes.h.  That parser is
  available from
  http://www.abisource.org/projects/link-grammar/
  and its API is described in
  http://www.abisource.com/projects/link-grammar/api/index.html
  as of March, 2009.

  That API supports five basic data structures: Dictionary, Sentence,
  Parse_Options, Linkage and PostProcessor.  In order to avoid memory
  leaks in creating these (and some other things) within Lisp, the
  appropriate (delete_...) calls should be made. We have tried to
  package these up in macros of the form (with-...), but for heavy
  weight items such as Dictionary, it may be more appropriate to
  create the structure and only delete it when it is no longer of
  use.  Note that only the five basic data structures and large
  strings returned by the linkage-print-... functions need to be
  deleted. The link parser appears to take care of managing memory for
  its short strings, such as individual tokens. In this interface, it
  is the functions that return :foreign-address that require special
  attention to potential memory leaks.

  An alternative to this implementation would be to wrap every
  link-parser object in a CLOS object and use the Lisp garbage
  collector's finalization mechanism to make sure that the link-parser
  object is deleted when the corresponding Lisp object is gc'd.  This
  would be more elegant and error-proof, but the with-... macros
  provide the same protection locally in code, with less overhead.

  This code was written in 2009 by Peter Szolovits (psz@mit.edu), and
  is made available under the "MIT License":

  Copyright (c) 2009 Peter Szolovits and Massachusetts Institute of
  Technology.

  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.

  |#

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :foreign)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Dictionary
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ff:def-foreign-call dictionary_create
    ((dict :foreign-address)
     (knowledge :foreign-address)
     (post :foreign-address)
     (affix :foreign-address))
  :strings-convert nil
  :returning :foreign-address)

(defun dict-create (dictname knowlname postname affixname)
  (with-native-string (c_dn (or dictname ""))
    (with-native-string (c_kn (or knowlname ""))
      (with-native-string (c_pn (or postname ""))
	(with-native-string (c_an (or affixname ""))
	  (format t "wtf?~%")
	  (dictionary_create
	   (if dictname c_dn 0)
	   (if knowlname c_kn 0)
	   (if postname c_pn 0)
	   (if affixname c_an 0)))))))

(ff:def-foreign-call dictionary_create_lang ((lang (* :char) string))
  :strings-convert t
  :returning :foreign-address)

(ff:def-foreign-call dictionary_create_default_lang (:void)
  :returning :foreign-address)

(ff:def-foreign-call dictionary_delete ((dict :foreign-address))
  :returning :int)

;;; with dictionary, execute the following program (in body b).
(defmacro with-dictionary ((name &optional d k p a) &body b)
  `(let ((,name nil))
     (unwind-protect
	 (unless
	     (zerop (setq ,name (dict-create ,d ,k ,p ,a)))
	   ,@b)
       (when (and ,name (not (zerop ,name)))
	 (dictionary_delete ,name)))))

(defmacro with-dictionary-lang
    ((name &optional (language nil lang-given)) &body b)
  `(let ((,name nil))
     (unwind-protect
	 (unless
	     (zerop (setq ,name
		      ,(if lang-given
			   `(dictionary_create_lang ,language)
			 '(dictionary_create_default_lang))))
	   ,@b)
       (when (and ,name (not (zerop ,name)))
	 (dictionary_delete ,name)))))

(ff:def-foreign-call dictionary_get_max_cost ((dict :foreign-address))
  :returning :int)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Parse_options
;;;
;;;
;;; Some of these options are numerical, others Boolean. We follow C
;;; conventions and require that the Boolean ones are set to 0 or 1 for
;;; FALSE or TRUE. Alternatively, we could declare these parameters to
;;; be of the form (argname :int boolean).
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ff:def-foreign-call parse_options_create (:void)
  :returning :foreign-address)

(ff:def-foreign-call parse_options_delete ((po :foreign-address))
  :returning :int)

;;; Macro to allow use of a parse-options, making sure to delete it
;;; when done.  The value of the last form in the body is
;;; returned. Options, if given, is a list of alternating keywords and
;;; values, appropriate for set-parse-options.
(defmacro with-parse-options ((name &optional options) &body b)
  `(let ((,name nil))
     (unwind-protect
	 (if (zerop (setq ,name (parse_options_create)))
	     (error "Unable to create parse_options.")
	   (progn
	     ,@(if options
		   (cons `(apply #'set-parse-options ,name ,options)
			 b)
		 b)))
       (when (and ,name (not (zerop ,name)))
	 (parse_options_delete ,name)))))

(ff:def-foreign-call parse_options_set_verbosity
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_verbosity
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_linkage_limit
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_linkage_limit
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_disjunct_cost
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_disjunct_cost
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_min_null_count
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_min_null_count
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_max_null_count
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_max_null_count
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_null_block
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_null_block
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_islands_ok
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_islands_ok
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_short_length
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_short_length
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_max_memory
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_max_memory
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_max_sentence_length
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_max_sentence_length
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_max_parse_time
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_max_parse_time
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_cost_model_type
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_cost_model_type
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_timer_expired
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_memory_exhausted
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_resources_exhausted
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_screen_width
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_screen_width
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_allow_null
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_allow_null
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_display_walls
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_display_walls
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_all_short_connectors
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_all_short_connectors
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_reset_resources
    ((po :foreign-address))
  :returning :void)

(ff:def-foreign-call parse_options_set_batch_mode
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_batch_mode
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_panic_mode
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_panic_mode
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_display_on
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_display_on
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_display_postscript
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_display_postscript
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_display_constituents
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_display_constituents
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_display_bad
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_display_bad
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_display_links
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_display_links
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_display_union
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_display_union
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_display_disjuncts
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_display_disjuncts
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_display_senses
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_display_senses
    ((po :foreign-address))
  :returning :int)

(ff:def-foreign-call parse_options_set_echo_on
    ((po :foreign-address)
     (param :int fixnum))
  :returning :void)

(ff:def-foreign-call parse_options_get_echo_on
    ((po :foreign-address))
  :returning :int)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Sentence
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; This is a hugely incomplete whack at trying to define a Lisp
;;; version of the Sentence structure.  If I were better at FFI, I
;;; would do this for all the public structures of LG, making them
;;; more easily manipulable in Lisp.
(ff:def-foreign-type Sentence
    (:struct (dict (* Dictionary))
	     (word (:array (* char)))
	     (is_conjunction (* char))
	     (deletable (* (* char)))
	     (dptr (* (* char)))
	     (effective_dist (* (* char)))
	     (num_linkages_found :int)
	     (num_linkages_allocated :int)
	     (num_linkages_post_processed :int)
	     (num_valid_linkages :int)
	     (null_links :int)
	     (null_count :int)
	     ;; There is actually more, but ...
	     ))

(ff:def-foreign-call sentence_create
    ((sent (* :char) string)
     (dict :foreign-address))
  :strings-convert t
  :returning :foreign-address)

(ff:def-foreign-call sentence_delete ((sent :foreign-address))
  :returning :void)

(defmacro with-sentence ((name val dict) &body b)
  `(let ((,name nil))
     (unwind-protect
	 (unless
	     (zerop (setq ,name (sentence_create ,val ,dict)))
	   ,@b)
       (when (and ,name (not (zerop ,name)))
	 (sentence_delete ,name)))))

(ff:def-foreign-call sentence_parse
    ((sent :foreign-address)
     (opts :foreign-address))
  :strings-convert nil
  :returning :int)

(ff:def-foreign-call sentence_length ((sent :foreign-address))
  :returning :int)

(ff:def-foreign-call sentence_get_word ((sent :foreign-address)
					(wordnum :int))
  :returning ((* :char)))

(ff:def-foreign-call sentence_null_count ((sent :foreign-address))
  :returning :int)

(ff:def-foreign-call sentence_num_linkages_found ((sent :foreign-address))
  :returning :int)

(ff:def-foreign-call sentence_num_valid_linkages ((sent :foreign-address))
  :returning :int)

(ff:def-foreign-call sentence_num_linkages_post_processed
    ((sent :foreign-address))
  :returning :int)

(ff:def-foreign-call sentence_num_violations
    ((sent :foreign-address)
     (i :int))
  :returning :int)

;; This is in the API, but not the documentation.
(ff:def-foreign-call sentence_and_cost
    ((sent :foreign-address)
     (i :int))
  :returning :int)

(ff:def-foreign-call sentence_disjunct_cost
    ((sent :foreign-address)
     (i :int))
  :returning :int)

(ff:def-foreign-call sentence_get_nth_word
    ((sent :foreign-address)
     (i :int))
  :returning ((* :char)))

(ff:def-foreign-call sentence_nth_word_has_disjunction
    ((sent :foreign-address)
     (i :int))
  :returning ((* :char)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Linkage
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ff:def-foreign-call linkage_create
    ((index :int)
     (sent :foreign-address)
     (opts :foreign-address))
  :returning :foreign-address)

(ff:def-foreign-call linkage_set_current_sublinkage
    ((linkage :foreign-address)
     (index :int))
  :returning :int)

(ff:def-foreign-call linkage_delete ((linkage :foreign-address))
  :returning :void)

(defmacro with-linkage ((name index sent opts) &body b)
  `(let ((,name nil))
     (unwind-protect
	 (unless
	     (zerop (setq ,name (linkage_create ,index ,sent ,opts)))
	   ,@b)
       (when (and ,name (not (zerop ,name)))
	 (linkage_delete ,name)))))

(ff:def-foreign-call linkage_get_sentence ((linkage :foreign-address))
  :returning :foreign-address)

(ff:def-foreign-call linkage_get_num_sublinkages
    ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_get_num_words
    ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_get_num_links
    ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_get_link_lword
    ((linkage :foreign-address)
     (index :int))
  :returning :int)

(ff:def-foreign-call linkage_get_link_rword
    ((linkage :foreign-address)
     (index :int))
  :returning :int)

(ff:def-foreign-call linkage_get_link_length
    ((linkage :foreign-address)
     (index :int))
  :returning :int)

(ff:def-foreign-call linkage_get_link_label
    ((linkage :foreign-address)
     (index :int))
  :returning ((* :char)))

(ff:def-foreign-call linkage_get_link_llabel
    ((linkage :foreign-address)
     (index :int))
  :returning ((* :char)))

(ff:def-foreign-call linkage_get_link_rlabel
    ((linkage :foreign-address)
     (index :int))
  :returning ((* :char)))

(ff:def-foreign-call linkage_get_link_num_domains
    ((linkage :foreign-address)
     (index :int))
  :returning :int)

;;; linkage_get_link_domain_names returns char**, which I don't really
;;; understand how to handle in Lisp. It should be possible to define
;;; a foreign structure something like this:
;;; (ff:def-foreign-type StringVec (:array (* :char) *))
;;; but I need to know the length.
(ff:def-foreign-call linkage_get_link_domain_names
    ((linkage :foreign-address))
  :returning :foreign-address ;; StringVec
  )

;;; linkage_get_words returns char**, which I dont' know how to handle.
(ff:def-foreign-call linkage_get_words ((linkage :foreign-address))
  :returning ((* (* :char)) (simple-array string (*))))

(ff:def-foreign-call linkage_get_word ((linkage :foreign-address)
				       (index :int))
  :returning ((* :char)))

(ff:def-foreign-call linkage_print_links_and_domains
    ((linkage :foreign-address))
  :returning :foreign-address)

(ff:def-foreign-call linkage_free_links_and_domains
    ((str :foreign-address))
  :returning :void)

(defun links-and-domains-str (linkage)
  "Retrieves and converts to a Lisp string the
  linkage_print_links_and_domains string from LP, and then frees
  it. The converted string is returned, as ordinary Lisp string."
  (let ((foreign-str nil))
    (unwind-protect
	(unless
	    (zerop
	     (setq foreign-str
	       (linkage_print_links_and_domains linkage)))
	  (native-to-string foreign-str))
      (when foreign-str
	(linkage_free_links_and_domains foreign-str)
	nil))))

(ff:def-foreign-call linkage_print_constituent_tree
    ((linkage :foreign-address)
     (mode :int))
  :returning :foreign-address)

(ff:def-foreign-call linkage_free_constituent_tree_str
    ((str :foreign-address))
  :returning :void)

(defun constituent-tree-str (linkage mode)
  "Retrieves and converts to a Lisp string the
  linkage_print_constituent_tree string from LP, and then frees
  it. The converted string is returned, as ordinary Lisp string."
  (let ((foreign-str nil))
    (unwind-protect
	(unless
	    (zerop
	     (setq foreign-str
	       (linkage_print_constituent_tree linkage mode)))
	  (native-to-string foreign-str))
      (when foreign-str
	(linkage_free_constituent_tree_str foreign-str)
	nil))))

(ff:def-foreign-call linkage_print_diagram ((linkage :foreign-address))
  :returning :foreign-address)

(ff:def-foreign-call linkage_free_diagram
    ((str :foreign-address))
  :returning :void)

(defun diagram-str (linkage)
  "Retrieves and converts to a Lisp string the
  linkage_print_diagram string from LP, and then frees
  it. The converted string is returned, as ordinary Lisp string."
  (let ((foreign-str nil))
    (unwind-protect
	(unless
	    (zerop
	     (setq foreign-str
	       (linkage_print_diagram linkage)))
	  (native-to-string foreign-str))
      (when foreign-str
	(linkage_free_diagram foreign-str)
	nil))))

(ff:def-foreign-call linkage_print_postscript ((linkage :foreign-address)
					       (mode :int))
  :returning :foreign-address)

(ff:def-foreign-call linkage_free_postscript
    ((str :foreign-address))
  :returning :void)

(defun postscript-str (linkage mode)
  "Retrieves and converts to a Lisp string the
  linkage_print_diagram string from LP, and then frees
  it. The converted string is returned, as ordinary Lisp string."
  (let ((foreign-str nil))
    (unwind-protect
	(unless
	    (zerop
	     (setq foreign-str
	       (linkage_print_postscript linkage mode)))
	  (native-to-string foreign-str))
      (when foreign-str
	(linkage_free_postscript foreign-str)
	nil))))

(ff:def-foreign-call linkage_compute_union ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_unused_word_cost ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_disjunct_cost ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_and_cost ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_link_cost ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_is_canonical ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_is_improper ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_has_inconsistent_domains
    ((linkage :foreign-address))
  :returning :int)

(ff:def-foreign-call linkage_get_violation_name
    ((linkage :foreign-address))
  :returning ((* :char)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; PostProcessor
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ff:def-foreign-call post_process_open ((name (* :char) string))
    :strings-convert nil
    :returning :foreign-address)

(ff:def-foreign-call post_process_close ((pp :foreign-address))
  :returning :void)

(ff:def-foreign-call linkage_post_process
    ((linkage :foreign-address)
     (pp :foreign-address))
  :returning :void)

(defmacro with-post-processor (name &body b)
  `(let ((,name nil))
     (unwind-protect
	 (unless
	     (zerop (setq ,name (post_process_open name)))
	   ,@b)
       (when (and ,name (not (zerop ,name)))
	 (post_process_close ,name)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Constituent Structure
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ff:def-foreign-type CNode
    (:struct (label (* :char))
	     (child (* CNode))
	     (next (* CNode))
	     (start :int)
	     (end :int)))

(ff:def-foreign-call linkage_constituent_tree
    ((linkage :foreign-address))
  :returning ((* CNode)))

(ff:def-foreign-call linkage_free_constituent_tree
    ((node CNode))
  :returning :void)

;; This could also be just
;; (ff:slot-value-typed 'CNode :foreign linkage 'label)
(ff:def-foreign-call linkage_constituent_node_get_label
    ((linkage :foreign-address))
  :returning ((* :char)))

;; This could also be just
;; (ff:slot-value-typed 'CNode :foreign linkage 'child)
(ff:def-foreign-call linkage_constituent_node_get_child
    ((linkage :foreign-address))
  :returning ((* CNode)))

;; This could also be just
;; (ff:slot-value-typed 'CNode :foreign linkage 'next)
(ff:def-foreign-call linkage_constituent_node_get_next
    ((linkage :foreign-address))
  :returning ((* CNode)))

;; This could also be just
;; (ff:slot-value-typed 'CNode :foreign linkage 'start)
(ff:def-foreign-call linkage_constituent_node_get_start
    ((linkage :foreign-address))
  :returning :int)

;; This could also be just
;; (ff:slot-value-typed 'CNode :foreign linkage 'end)
(ff:def-foreign-call linkage_constituent_node_get_end
    ((linkage :foreign-address))
  :returning :int)

(defmacro with-constituent-tree ((name linkage) &body b)
  `(let ((,name nil))
     (unwind-protect
	 (unless
	     (zerop (setq ,name (linkage_constituent_tree ,linkage)))
	   ,@b)
       (when (and ,name (not (zerop ,name)))
	 (linkage_free_constituent_tree ,name)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Utility
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ff:def-foreign-call linkgrammar_get_version (:void)
  :returning :foreign-address)

(defun linkgrammar-get-version ()
  (native-to-string (linkgrammar_get_version)))

(ff:def-foreign-call setlocale ((localename :string))
  :returning :void)

(provide :link)

error: pathspec 'link-grammar/lisp/link-interface.cl' did not match any file(s) known to git


Wpacket Group Handler is almost done

Wpacket Group Handler is almost done

Merge/Borrow/Split not yet implemented

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/CLBplustree/CLBplustree.git/'


Import CLISP pnmmodules code.

Import CLISP pnmmodules code.

; Common LISP module for doing image I/O.
; Owain Kenway

; Write out an array d as a pgm.
; - white - white value (max colour value)
; - filename = file to write to

; NOTE: we convert d to integers via floor.
(defun writepgm (d white filename)
  (defvar w (array-dimension d 0))
  (defvar h (array-dimension d 1))

  (with-open-file (pnmfile filename
                       :direction :output
                       :if-exists :supersede
                       :if-does-not-exist :create)
    (format pnmfile "P2~%")
    (format pnmfile "# Written by pnmmodules (https://github.com/owainkenwayucl/pnmmodules).~% ")
    (format pnmfile "~a ~a ~%" w h)
    (format pnmfile "~a ~%" white)
    (loop for j from 0 to (- h 1) do
      (loop for i from 0 to (- w 1) do
        (format pnmfile "~a " (floor (aref d i j)))
      )
      (format pnmfile "~%")
    )
  )
)

; Write out an array d as a pbm.
; - threshold - threshold at which a number is 1 rather than 0
; - filename = file to write to
(defun writepbm (d threshold filename)
  (defvar w (array-dimension d 0))
  (defvar h (array-dimension d 1))

  (with-open-file (pnmfile filename
                       :direction :output
                       :if-exists :supersede
                       :if-does-not-exist :create)
    (format pnmfile "P1~%")
    (format pnmfile "# Written by pnmmodules (https://github.com/owainkenwayucl/pnmmodules).~% ")
    (format pnmfile "~a ~a ~%" w h)
    (loop for j from 0 to (- h 1) do
      (loop for i from 0 to (- w 1) do
        (if (>= (aref d i j) threshold)
           (format pnmfile "~a " 1)
           (format pnmfile "~a " 0)
        )
      )
      (format pnmfile "~%")
    )
  )
)

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


Added OpenCL index kernel

Added OpenCL index 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
 ********************************************************/

#ifndef T
#define T float
#endif

#ifndef dim_type
#define dim_type int
#endif

dim_type trimIndex(dim_type idx, const dim_type len)
{
    dim_type ret_val = idx;
    dim_type offset  = abs(ret_val)%len;
    if (ret_val<0) {
        ret_val = offset-1;
    } else if (ret_val>=len) {
        ret_val = len-offset-1;
    }
    return ret_val;
}

__kernel
void indexKernel(__global T * optr,
                 const dim_type odim0,
                 const dim_type odim1,
                 const dim_type odim2,
                 const dim_type odim3,
                 const dim_type ostride0,
                 const dim_type ostride1,
                 const dim_type ostride2,
                 const dim_type ostride3,
                 __global const T * iptr,
                 const dim_type idim0,
                 const dim_type idim1,
                 const dim_type idim2,
                 const dim_type idim3,
                 const dim_type poff0,
                 const dim_type poff1,
                 const dim_type poff2,
                 const dim_type poff3,
                 const dim_type pstrd0,
                 const dim_type pstrd1,
                 const dim_type pstrd2,
                 const dim_type pstrd3,
                 const char pseq0,
                 const char pseq1,
                 const char pseq2,
                 const char pseq3,
                 __global const T* ptr0, __global const T* ptr1,
                 __global const T* ptr2, __global const T* ptr3,
                 const dim_type nBBS0, const dim_type nBBS1)
{
    // retrive booleans that tell us which indexer to use
    const bool s0 = pseq0;
    const bool s1 = pseq1;
    const bool s2 = pseq2;
    const bool s3 = pseq3;

    const dim_type gz = get_group_id(0)/nBBS0;
    const dim_type gw = get_group_id(1)/nBBS1;
    const dim_type gx = get_local_size(0) * (get_group_id(0) - gz*nBBS0) + get_local_id(0);
    const dim_type gy = get_local_size(1) * (get_group_id(1) - gw*nBBS1) + get_local_id(1);

    if (gx<odim0 && gy<odim1 && gz<odim2 && gw<odim3) {
        // calculate pointer offsets for input
        dim_type i = pstrd0 * trimIndex(s0 ? gx+poff0 : ptr0[gx], idim0);
        dim_type j = pstrd1 * trimIndex(s1 ? gy+poff1 : ptr1[gy], idim1);
        dim_type k = pstrd2 * trimIndex(s2 ? gz+poff2 : ptr2[gz], idim2);
        dim_type l = pstrd3 * trimIndex(s3 ? gw+poff3 : ptr3[gw], idim3);
        // offset input and output pointers
        global const T *src = iptr + (i+j+k+l);
        global T *dst = optr + (gx*ostride0+
                                gy*ostride1+
                                gz*ostride2+
                                gw*ostride3);
        // set the output
        dst[0] = src[0];
    }
}

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


[OpenCL] Add test for program scope variable restrictions in OpenCL v2.0

http://reviews.llvm.org/D13105

git-svn-id: ffe668792ed300d6c2daa1f6eba2e0aa28d7ec6c@250892 91177308-0d34-0410-b5e6-96231b3b80d8

// RUN: %clang_cc1 %s -verify -pedantic -fsyntax-only -DCL20 -cl-std=CL2.0

static constant int G1 = 0;
int G2 = 0;// expected-error{{program scope variable must reside in global or constant address space}}
global int G3 = 0;
local int G4 = 0;// expected-error{{program scope variable must reside in global or constant address space}}

void kernel foo() {
  static int S1 = 5;// expected-error{{program scope variable must reside in global or constant address space}}
  static global int S2 = 5;
  static private int S3 = 5;// expected-error{{program scope variable must reside in global or constant address space}}

  constant int L1 = 0;
  local int L2;
}

error: pathspec 'test/SemaOpenCL/storageclass-cl20.cl' did not match any file(s) known to git


[OpenCL] Add the lit test for image size which was omitted by r277647.

git-svn-id: ffe668792ed300d6c2daa1f6eba2e0aa28d7ec6c@277756 91177308-0d34-0410-b5e6-96231b3b80d8

// RUN: %clang_cc1 -emit-llvm -o - -triple amdgcn--amdhsa %s | FileCheck --check-prefix=AMDGCN %s
// RUN: %clang_cc1 -emit-llvm -o - -triple spir-unknown-unknown %s | FileCheck --check-prefix=SPIR %s

#ifdef __AMDGCN__

constant int* convert(image2d_t img) {
  // AMDGCN: bitcast %opencl.image2d_ro_t addrspace(2)* %img to i32 addrspace(2)*
  return __builtin_astype(img, constant int*);
}

#else

global int* convert(image2d_t img) {
  // SPIR: bitcast %opencl.image2d_ro_t addrspace(1)* %img to i32 addrspace(1)*
  return __builtin_astype(img, global int*);
}

#endif

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


Added #ifdef CL_LOCAL to cl_mc_kernel.cl


Add non recursive factorial

Add non recursive factorial

class Main inherits A2I
{
    main() : Object
    {
        (new IO).out_string(i2a(fact(a2i((new IO).in_string()))).concat("\n"))
    };

    fact(i : Int): Int
    {
        let fact: Int <- 1 in
        {
            while(not(i = 0)) loop
            {
                fact <- fact * i;
                i <- i - 1;
            }
            pool;
            fact;
        }
    };
};

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


Added first OpenCl C implementation.

Added first OpenCl C implementation.

#pragma OPENCL EXTENSION cl_khr_int64_base_atomics : enable

typedef struct {
   __global float *learningInputs, *learningOutputs;
   int totalLearningLines;
   __global float *testInputs, *testOutputs;
   int totalTestLines;
} taskData_t;

typedef struct {
    int numOfLayers;
    __local int *layers;
    bool classification;
    float minOutputValue;
    float maxOutputValue;
    float learningFactor;
    float lambda;
} setup_t;

typedef struct {
    int maxEpochs;
    float minProgress;
    float maxGeneralizationLoss;
} criteria_t;

typedef struct {
    int epoch;
    __global float *weights;
    __local float *values;
    __local float *errors;
    int testLine;
    int learningLine;
} state_t;

typedef struct {
    setup_t setup;
    criteria_t criteria;
    state_t state;
    float currentSquareErrorCounter;
    float bestSquareError[2];
    __global float *squareErrorHistory;
} neuralNetwork_t;

typedef struct {
    int taskData_b_offset_learningInputs, taskData_b_offset_learningOutputs;
    int taskData_totalLearningLines;
    int taskData_b_offset_testInputs, taskData_b_offset_testOutputs;
    int taskData_totalTestLines;
    int taskData_b_size;

    int setup_numOfLayers;
    int setup_b_offset_layers;
    bool setup_classification;
    float setup_minOutputValue;
    float setup_maxOutputValue;
    float setup_learningFactor;
    float setup_lambda;

    int criteria_maxEpochs;
    float criteria_minProgress;
    float criteria_maxGeneralizationLoss;

    int state_epoch;
    int state_b_offset_weights;
    int state_b_offset_values;
    int state_b_size_values;
    int state_b_offset_errors;
    int state_b_size_errors;
    int state_testLine;
    int state_learningLine;

    float neuralNetwork_currentSquareErrorCounter;
    float neuralNetwork_bestSquareError[2];
    int neuralNetwork_b_offset_squareErrorHistory;
    int neuralNetwork_b_size;
} transform_structure_t;

size_t get_local_linear_id() {
    return  (get_local_id(2) * get_local_size(1) *
            (0)) + (get_local_id(1) *
            get_local_size(0)) + get_local_id(0);
    }

size_t get_group_linear_id() {
    return  (get_group_id(2) * get_num_groups(1) *
            (0)) + (get_group_id(1) *
            get_num_groups(0)) + get_group_id(0);
    }

/**
     * Returns a learning vector for neural network.
     */
bool getLearningVector(neuralNetwork_t *neuralNetwork, taskData_t *taskData, __local float *expectedOutput) {

    if (neuralNetwork->state.learningLine >= taskData->totalLearningLines) {
        return false;
    }

    event_t e = async_work_group_copy(neuralNetwork->state.values,
                                    (taskData->learningInputs +
                                        neuralNetwork->state.learningLine * neuralNetwork->setup.layers[0]),
                                    neuralNetwork->setup.layers[0], 0);
    wait_group_events(1, &e);
    for (int input = 0; input < neuralNetwork->setup.layers[0]; input++) {
        neuralNetwork->state.values[input] = taskData->learningInputs[input + neuralNetwork->state.learningLine * neuralNetwork->setup.layers[0]];
    }

    event_t e2 = async_work_group_copy(expectedOutput,
                                    (taskData->learningOutputs +
                                        neuralNetwork->state.learningLine * neuralNetwork->setup.layers[neuralNetwork->setup.numOfLayers - 1]),
                                    neuralNetwork->setup.layers[neuralNetwork->setup.numOfLayers - 1], 0);
    wait_group_events(1, &e2);

    neuralNetwork->state.learningLine++;
    return true;
}

/**
     * Returns a test vector for neural network.
     */
bool getTestVector(neuralNetwork_t *neuralNetwork, taskData_t *taskData, __local float *expectedOutput) {

    if (neuralNetwork->state.testLine >= taskData->totalTestLines) {
        return false;
    }
    event_t e = async_work_group_copy(neuralNetwork->state.values,
                                    (taskData->testInputs +
                                        neuralNetwork->state.testLine * neuralNetwork->setup.layers[0]),
                                    neuralNetwork->setup.layers[0], 0);
    wait_group_events(1, &e);
    for (int input = 0; input < neuralNetwork->setup.layers[0]; input++) {
        neuralNetwork->state.values[input] = taskData->testInputs[input + neuralNetwork->state.testLine * neuralNetwork->setup.layers[0]];
    }

    event_t e2 = async_work_group_copy(expectedOutput,
                                    (taskData->testOutputs +
                                        neuralNetwork->state.testLine * neuralNetwork->setup.layers[neuralNetwork->setup.numOfLayers - 1]),
                                    neuralNetwork->setup.layers[neuralNetwork->setup.numOfLayers - 1], 0);
    wait_group_events(1, &e2);
    neuralNetwork->state.testLine ++;
    return true;
}

/**
 * Finds lowest square error and sets it as the best one.
 */
void findAndSetBestSquareError(neuralNetwork_t *neuralNetwork) {
    neuralNetwork->bestSquareError[0] = 0;
    neuralNetwork->bestSquareError[1] = neuralNetwork->squareErrorHistory[0];

    for (int i = 1; i <= neuralNetwork->state.epoch; i++) {
        if (neuralNetwork->squareErrorHistory[i] < neuralNetwork->bestSquareError[1]) {
            neuralNetwork->bestSquareError[0] = i;
            neuralNetwork->bestSquareError[1] = neuralNetwork->squareErrorHistory[i];
        }
    }
}

void neuralLearnCycle(neuralNetwork_t *neuralNetwork,
                       __local float *expectedOutput,
                       int neuron) {
    int numOfLayers = neuralNetwork->setup.numOfLayers;
    __local int * layers = neuralNetwork->setup.layers;
    __local float * values = neuralNetwork->state.values;
    __global float * weights = neuralNetwork->state.weights;
    __local float * errors = neuralNetwork->state.errors;

    int valueOffset = 0;
    int prevValueOffset = 0;
    int followValueOffset = 0;
    int weightOffset = 0;

    int layer;
    float value;
    int neurons;
    int prevNeurons;
    int prevNeuron;
    int followNeurons;
    int followNeuron;

    float ex;
    float classValue;
    float weightError;

    // foward value computation
    for (layer = 1; layer < numOfLayers; layer++) {
        prevNeurons = layers[layer - 1];
        neurons = layers[layer];
        valueOffset += prevNeurons;
        weightOffset += neuron * prevNeurons;
        if (neuron < neurons) {
            value = 0;
            for (prevNeuron = 0; prevNeuron < prevNeurons; prevNeuron++) {
                value += values[prevNeuron + prevValueOffset] * weights[prevNeuron + weightOffset];
            }
            values[neuron + valueOffset] = 1. / (1. + exp(-neuralNetwork->setup.lambda * value));
        }
        weightOffset += (neurons - neuron) * prevNeurons;
        prevValueOffset += prevNeurons;
        barrier(CLK_LOCAL_MEM_FENCE);
    }

    // backwards error computation
    neurons = layers[numOfLayers - 1];
    if (neuron < neurons) {
        value = values[neuron + valueOffset];
        classValue = value;
        if (neuralNetwork->setup.classification) {
            classValue = round(value);
        }

        if (expectedOutput[neuron] - classValue) {
            float ex = 1.f / (1.f + exp(-neuralNetwork->setup.lambda * value));;
            errors[neuron + valueOffset] = (expectedOutput[neuron] - value) * (ex * (1 - ex));
        } else {
            errors[neuron + valueOffset] = 0;
        }
    }
    barrier(CLK_LOCAL_MEM_FENCE);

    followValueOffset = valueOffset;
    for (layer = numOfLayers - 2; layer > 0; layer--) {
        followNeurons = layers[layer + 1];
        neurons = layers[layer];
        valueOffset -= neurons;
        weightOffset -= (neurons - neuron) * followNeurons;
        if (neuron < neurons) {
            weightError = 0.f;
            for (followNeuron = 0; followNeuron < followNeurons; followNeuron++) {
                weightError += errors[followNeuron + followValueOffset] *
                              weights[followNeuron + weightOffset];
            }
            value = values[neuron + valueOffset];
            ex = exp(-neuralNetwork->setup.lambda * value);
            errors[neuron + valueOffset] = weightError * (ex * (1 - ex));
        }
        weightOffset -= neuron * followNeurons;
        followValueOffset -= neurons;
        barrier(CLK_LOCAL_MEM_FENCE);
    }
    // error propagation
    weightOffset = 0;
    valueOffset = 0;
    for (layer = 1; layer < numOfLayers; layer++) {
        prevNeurons = layers[layer - 1];
        neurons = layers[layer];
        weightOffset += neuron * prevNeurons;
        if (neuron < neurons) {
            for (prevNeuron = 0; prevNeuron < prevNeurons; prevNeuron++) {
                weights[prevNeuron + weightOffset] = weights[prevNeuron + weightOffset] +
                                                     neuralNetwork->setup.learningFactor * values[prevNeuron + valueOffset] *
                                                     errors[neuron + valueOffset + prevNeurons];
            }
        }
        weightOffset += (neurons - neuron) * prevNeurons;
        valueOffset += prevNeurons;
    }
    barrier(CLK_GLOBAL_MEM_FENCE);
}

/**
 * Performs a test cycle of neural network. Input vector is transformed to output vector.
 * Output vector si compared with expected output. Accurancy is counted from this error.
 */
void neuralTestCycle(neuralNetwork_t *neuralNetwork,
                     __local float *expectedOutput,
                     int neuron) {

    int numOfLayers = neuralNetwork->setup.numOfLayers;
    __local int *layers = neuralNetwork->setup.layers;
    __local float *values = neuralNetwork->state.values;
    __global float *weights = neuralNetwork->state.weights;

    int valueOffset = 0;
    int prevValueOffset = 0;
    int weightOffset = 0;

    int layer;
    float value;
    int neurons;
    int prevNeurons;
    int prevNeuron;

    float classValue;
    float diff;

    // foward value computation
    for (layer = 1; layer < numOfLayers; layer++) {
        neurons = layers[layer];
        prevNeurons = layers[layer - 1];
        valueOffset += prevNeurons;
        weightOffset += neuron * prevNeurons;
        if (neuron < neurons) {
            value = 0.f;
            for (prevNeuron = 0; prevNeuron < prevNeurons; prevNeuron++) {
                value += values[prevNeuron + prevValueOffset] * weights[prevNeuron + weightOffset];
            }
            values[neuron + valueOffset] = 1.f / (1.f + exp(-neuralNetwork->setup.lambda * value));
        }
        weightOffset += (neurons - neuron) * prevNeurons;
        prevValueOffset += prevNeurons;
        barrier(CLK_LOCAL_MEM_FENCE);
    }

    // error of prediction
    neurons = layers[numOfLayers - 1];
    // if (neuron == 0) { // meuron == work item
        for (int neur = 0; neur < neurons; neur++) {
            value = values[neur + valueOffset];

            if (neuralNetwork->setup.classification) {
                // conversion to bool
                classValue = round(value);
                if (classValue != expectedOutput[neur]) {
                    neuralNetwork->currentSquareErrorCounter += 1;
                }
            } else {
                diff = expectedOutput[neur] - value;
                neuralNetwork->currentSquareErrorCounter += diff * diff;
            }
        }
    // }
}

typedef struct {
    float *x;
    float *y;
    float val;
} my_struct_t;

typedef struct {
    my_struct_t a;
    int cnt;
} my_arr_struct_t;

void importDataStructures(__global transform_structure_t *transform, __global float * neuralNetworkBuffer, __global float *task_data_buffer, neuralNetwork_t *neuralNetwork, taskData_t *taskData) {
    int lid = get_local_linear_id();
    taskData->learningInputs = (task_data_buffer + transform->taskData_b_offset_learningInputs);
    taskData->learningOutputs = (task_data_buffer + transform->taskData_b_offset_learningOutputs);
    taskData->totalLearningLines = transform->taskData_totalLearningLines;
    taskData->testInputs = (task_data_buffer + transform->taskData_b_offset_testInputs);
    taskData->testOutputs = (task_data_buffer + transform->taskData_b_offset_testOutputs);
    taskData->totalTestLines = transform->taskData_totalTestLines;

    neuralNetwork->setup.numOfLayers = transform->setup_numOfLayers;
    neuralNetwork->setup.classification = transform->setup_classification;
    neuralNetwork->setup.minOutputValue = transform->setup_minOutputValue;
    neuralNetwork->setup.maxOutputValue = transform->setup_maxOutputValue;
    neuralNetwork->setup.learningFactor = transform->setup_learningFactor;
    neuralNetwork->setup.lambda = transform->setup_lambda;
    event_t e1 = async_work_group_copy(neuralNetwork->setup.layers,
                                    (__global int *)(neuralNetworkBuffer + transform->setup_b_offset_layers),
                                    transform->setup_numOfLayers, 0);
    wait_group_events(1, &e1);

    neuralNetwork->criteria.maxEpochs = transform->criteria_maxEpochs;
    neuralNetwork->criteria.minProgress = transform->criteria_minProgress;
    neuralNetwork->criteria.maxGeneralizationLoss = transform->criteria_maxGeneralizationLoss;

    neuralNetwork->state.epoch = transform->state_epoch;
    neuralNetwork->state.testLine = transform->state_testLine;
    neuralNetwork->state.learningLine = transform->state_learningLine;
    neuralNetwork->state.weights = (neuralNetworkBuffer + transform->state_b_offset_weights);
    event_t e2 = async_work_group_copy(neuralNetwork->state.values,
                                    (neuralNetworkBuffer + transform->state_b_offset_values),
                                    transform->state_b_size_values, 0);
    wait_group_events(1, &e2);

    event_t e3 = async_work_group_copy(neuralNetwork->state.errors,
                                    (neuralNetworkBuffer + transform->state_b_offset_errors),
                                    transform->state_b_size_errors, 0);
    wait_group_events(1, &e3);
    if (lid == 0) {
        neuralNetwork->currentSquareErrorCounter = transform->neuralNetwork_currentSquareErrorCounter;
    }
    neuralNetwork->bestSquareError[0] = transform->neuralNetwork_bestSquareError[0];
    neuralNetwork->bestSquareError[1] = transform->neuralNetwork_bestSquareError[1];
    neuralNetwork->squareErrorHistory = (neuralNetworkBuffer + transform->neuralNetwork_b_offset_squareErrorHistory);
}

void exportDataStructures(__global transform_structure_t *transform, __global float * neuralNetworkBuffer, __global float *task_data_buffer, neuralNetwork_t *neuralNetwork, taskData_t *taskData) {
    int lid = get_local_linear_id();
    transform->setup_numOfLayers = neuralNetwork->setup.numOfLayers;
    transform->setup_classification = neuralNetwork->setup.classification;
    transform->setup_minOutputValue = neuralNetwork->setup.minOutputValue;
    transform->setup_maxOutputValue = neuralNetwork->setup.maxOutputValue;
    transform->setup_learningFactor = neuralNetwork->setup.learningFactor;
    neuralNetwork->setup.lambda = transform->setup_lambda;
    event_t e1 = async_work_group_copy((__global int *)(neuralNetworkBuffer + transform->setup_b_offset_layers),
                                        neuralNetwork->setup.layers,
                                        transform->setup_numOfLayers, 0);
    wait_group_events(1, &e1);

    transform->criteria_maxEpochs = neuralNetwork->criteria.maxEpochs;
    transform->criteria_minProgress = neuralNetwork->criteria.minProgress;
    transform->criteria_maxGeneralizationLoss = neuralNetwork->criteria.maxGeneralizationLoss;

    transform->state_epoch = neuralNetwork->state.epoch;
    transform->state_testLine = neuralNetwork->state.testLine;
    transform->state_learningLine = neuralNetwork->state.learningLine;
    event_t e2 = async_work_group_copy((neuralNetworkBuffer + transform->state_b_offset_values),
                                        neuralNetwork->state.values,
                                        transform->state_b_size_values, 0);
    wait_group_events(1, &e2);

    event_t e3 = async_work_group_copy((neuralNetworkBuffer + transform->state_b_offset_errors),
                                        neuralNetwork->state.errors,
                                        transform->state_b_size_errors, 0);
    wait_group_events(1, &e3);
    if (lid == 0) {
        transform->neuralNetwork_currentSquareErrorCounter = neuralNetwork->currentSquareErrorCounter;
    }
    transform->neuralNetwork_bestSquareError[0] = neuralNetwork->bestSquareError[0];
    transform->neuralNetwork_bestSquareError[1] = neuralNetwork->bestSquareError[1];
}

__kernel void run_neural_network(
    __global transform_structure_t *transform,
    __global float *neuralNetworkBuffer,
    __global float *task_data_buffer
    )
{
    int lid = get_local_linear_id();
    taskData_t taskData;
    neuralNetwork_t neuralNetwork;
    __local float *expectedOutput;
    __local float sharedMemory[2000];
    neuralNetwork.setup.layers = (__local int*)sharedMemory;
    neuralNetwork.state.values = sharedMemory + transform->setup_numOfLayers;
    neuralNetwork.state.errors = sharedMemory + transform->setup_numOfLayers + transform->state_b_size_values;
    importDataStructures(transform, neuralNetworkBuffer, task_data_buffer, &neuralNetwork, &taskData);
    expectedOutput = sharedMemory + transform->setup_numOfLayers + transform->state_b_size_values + transform->state_b_size_errors;

    for (neuralNetwork.state.epoch = 0; neuralNetwork.state.epoch < neuralNetwork.criteria.maxEpochs; neuralNetwork.state.epoch++) {
        neuralNetwork.state.learningLine = 0;
        neuralNetwork.state.testLine = 0;
        while (getLearningVector(&neuralNetwork, &taskData, expectedOutput)) {
            neuralLearnCycle(&neuralNetwork, expectedOutput, lid);
            // if (neuralNetwork.state.learningLine > 349  && neuralNetwork.state.epoch >= 0) {
            //     exportDataStructures(transform, neuralNetworkBuffer, task_data_buffer, &neuralNetwork, &taskData);
            //     return;
            // }
        }
        // if (lid == 0){
            neuralNetwork.currentSquareErrorCounter = 0.f;
        // }

        while (getTestVector(&neuralNetwork, &taskData, expectedOutput)) {
            neuralTestCycle(&neuralNetwork, expectedOutput, lid);
            // if (neuralNetwork.state.testLine > 348  && neuralNetwork.state.epoch >= 0) {
                // exportDataStructures(transform, neuralNetworkBuffer, task_data_buffer, &neuralNetwork, &taskData);
                // return;
            // }
        }

        neuralNetwork.squareErrorHistory[neuralNetwork.state.epoch] = (neuralNetwork.setup.maxOutputValue - neuralNetwork.setup.minOutputValue) *
                                                                        neuralNetwork.currentSquareErrorCounter / (neuralNetwork.setup.layers[neuralNetwork.setup.numOfLayers - 1] *
                                                                        taskData.totalTestLines);
        findAndSetBestSquareError(&neuralNetwork);
        // break;
    }
    exportDataStructures(transform, neuralNetworkBuffer, task_data_buffer, &neuralNetwork, &taskData);
}

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


kernel lib: Add OpenCL2.0 atomics implementation (host device part)

This implements 2.0 atomics via Clang's C11 atomic builtins (and
some nonstandard builtins for min/max). The min/max builtins are only
for int & uint; TODO find something better.

/* OpenCL built-in library: OpenCL 2.0 Atomics (C11 subset) implementation for host device

   Copyright (c) 2015 Michal Babej / Tampere University of Technology

   This relies on Clang's C11 atomic builtins.

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

#ifndef _SVM_ATOMICS_H
#include "svm_atomics.h"

#define CONV_ORDER(mo) ((mo==memory_order_relaxed) ? __ATOMIC_RELAXED : \
                       ((mo==memory_order_acquire) ? __ATOMIC_ACQUIRE : \
                       ((mo==memory_order_release) ? __ATOMIC_RELEASE : \
                       ((mo==memory_order_acq_rel) ? __ATOMIC_ACQ_REL : \
                                                     __ATOMIC_SEQ_CST ))))
#define _SVM_ATOMICS_H
#endif

#if !defined(Q)

#  define Q __global
#  define QUAL(f) f ## __global
#  include "svm_atomics_host.cl"
#  undef Q
#  undef QUAL

#  define Q __local
#  define QUAL(f) f ## __local
#  include "svm_atomics_host.cl"
#  undef Q
#  undef QUAL

#elif !defined(ATOMIC_TYPE)

bool _CL_OVERLOADABLE QUAL(pocl_atomic_flag_test_and_set) ( volatile Q atomic_flag  *object ,
  memory_order order,
  memory_scope scope)
{
  return __atomic_test_and_set(object, CONV_ORDER(order));
}

void _CL_OVERLOADABLE QUAL(pocl_atomic_flag_clear) ( volatile Q atomic_flag  *object ,
  memory_order order,
  memory_scope scope)
{
  __atomic_clear(object, CONV_ORDER(order));
}

#  define ATOMIC_TYPE atomic_int
#  define NONATOMIC_TYPE int
#  define IS_INT
#  include "svm_atomics_host.cl"
#  undef IS_INT
#  undef ATOMIC_TYPE
#  undef NONATOMIC_TYPE

#  define ATOMIC_TYPE atomic_uint
#  define NONATOMIC_TYPE uint
#  define IS_UINT
#  include "svm_atomics_host.cl"
#  undef IS_UINT
#  undef ATOMIC_TYPE
#  undef NONATOMIC_TYPE

#  define ATOMIC_TYPE atomic_float
#  define NONATOMIC_TYPE float
#  define NON_INTEGER
#  include "svm_atomics_host.cl"
#  undef NON_INTEGER
#  undef ATOMIC_TYPE
#  undef NONATOMIC_TYPE

#if defined(cl_khr_int64_base_atomics) && defined(cl_khr_int64_extended_atomics)

#  define ATOMIC_TYPE atomic_long
#  define NONATOMIC_TYPE long
#  include "svm_atomics_host.cl"
#  undef ATOMIC_TYPE
#  undef NONATOMIC_TYPE

#  define ATOMIC_TYPE atomic_ulong
#  define NONATOMIC_TYPE ulong
#  include "svm_atomics_host.cl"
#  undef ATOMIC_TYPE
#  undef NONATOMIC_TYPE

#endif

#ifdef cl_khr_fp64

#  define ATOMIC_TYPE atomic_double
#  define NONATOMIC_TYPE double
#  define NON_INTEGER
#  include "svm_atomics_host.cl"
#  undef NON_INTEGER
#  undef ATOMIC_TYPE
#  undef NONATOMIC_TYPE

#endif

#else

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

_CL_OVERLOADABLE void QUAL(pocl_atomic_store)( volatile Q ATOMIC_TYPE  *object,
                              NONATOMIC_TYPE  desired,
                              memory_order order,
                              memory_scope scope)
{
  __c11_atomic_store(object, desired, CONV_ORDER(order));
}

_CL_OVERLOADABLE NONATOMIC_TYPE QUAL(pocl_atomic_load) ( volatile Q ATOMIC_TYPE  *object,
                                        memory_order order,
                                        memory_scope scope)
{
  return __c11_atomic_load(object, CONV_ORDER(order));
}

_CL_OVERLOADABLE NONATOMIC_TYPE QUAL(pocl_atomic_exchange) ( volatile Q ATOMIC_TYPE  *object,
                                            NONATOMIC_TYPE  desired,
                                            memory_order order,
                                            memory_scope scope)
{
  return __c11_atomic_exchange(object, desired, CONV_ORDER(order));
}

bool _CL_OVERLOADABLE QUAL(pocl_atomic_compare_exchange_strong) ( volatile Q ATOMIC_TYPE  *object,
  NONATOMIC_TYPE  *expected,
  NONATOMIC_TYPE  desired,
  memory_order success,
  memory_order failure,
  memory_scope scope)
{
  return __c11_atomic_compare_exchange_strong(object,  expected, desired, CONV_ORDER(success), CONV_ORDER(failure));
}

bool _CL_OVERLOADABLE QUAL(pocl_atomic_compare_exchange_weak) ( volatile Q ATOMIC_TYPE  *object,
  NONATOMIC_TYPE  *expected,
  NONATOMIC_TYPE  desired,
  memory_order success,
  memory_order failure,
  memory_scope scope)
{
  return __c11_atomic_compare_exchange_weak(object,  expected, desired, CONV_ORDER(success), CONV_ORDER(failure));
}

#ifndef NON_INTEGER

NONATOMIC_TYPE _CL_OVERLOADABLE QUAL(pocl_atomic_fetch_add) ( volatile Q ATOMIC_TYPE  *object,
  NONATOMIC_TYPE  operand,
  memory_order order,
  memory_scope scope)
{
  return __c11_atomic_fetch_add(object, operand, CONV_ORDER(order));
}

NONATOMIC_TYPE _CL_OVERLOADABLE QUAL(pocl_atomic_fetch_sub) ( volatile Q ATOMIC_TYPE  *object,
  NONATOMIC_TYPE  operand,
  memory_order order,
  memory_scope scope)
{
  return __c11_atomic_fetch_sub(object, operand, CONV_ORDER(order));
}

NONATOMIC_TYPE _CL_OVERLOADABLE QUAL(pocl_atomic_fetch_or) ( volatile Q ATOMIC_TYPE  *object,
  NONATOMIC_TYPE  operand,
  memory_order order,
  memory_scope scope)
{
  return __c11_atomic_fetch_or(object, operand, CONV_ORDER(order));
}

NONATOMIC_TYPE _CL_OVERLOADABLE QUAL(pocl_atomic_fetch_xor) ( volatile Q ATOMIC_TYPE  *object,
  NONATOMIC_TYPE  operand,
  memory_order order,
  memory_scope scope)
{
  return __c11_atomic_fetch_xor(object, operand, CONV_ORDER(order));
}

NONATOMIC_TYPE _CL_OVERLOADABLE QUAL(pocl_atomic_fetch_and) ( volatile Q ATOMIC_TYPE  *object,
  NONATOMIC_TYPE  operand,
  memory_order order,
  memory_scope scope)
{
  return __c11_atomic_fetch_and(object, operand, CONV_ORDER(order));
}

NONATOMIC_TYPE _CL_OVERLOADABLE QUAL(pocl_atomic_fetch_min) ( volatile Q ATOMIC_TYPE  *object,
  NONATOMIC_TYPE  operand,
  memory_order order,
  memory_scope scope)
{
#if defined(IS_INT)
  return __sync_fetch_and_min((volatile Q NONATOMIC_TYPE *)object, operand);
#elif defined(IS_UINT)
  return __sync_fetch_and_umin((volatile Q NONATOMIC_TYPE *)object, operand);
#else
  __builtin_trap();
  return 0;
#endif
}

NONATOMIC_TYPE _CL_OVERLOADABLE QUAL(pocl_atomic_fetch_max) ( volatile Q ATOMIC_TYPE  *object,
  NONATOMIC_TYPE  operand,
  memory_order order,
  memory_scope scope)
{
#if defined(IS_INT)
  return __sync_fetch_and_max((volatile Q NONATOMIC_TYPE *)object, operand);
#elif defined(IS_UINT)
  return __sync_fetch_and_umax((volatile Q NONATOMIC_TYPE *)object, operand);
#else
  __builtin_trap();
  return 0;
#endif
}

#endif

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

#endif

error: pathspec 'lib/kernel/svm_atomics_host.cl' did not match any file(s) known to git


Initial Commit

Initial Commit

(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))

(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)))))

;; 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 lambda is returned instead of the actual binding
;;   when - same as test, except the result of the provided expression is returned
;;   on-fail - expression to be returned by the whole thing if that subform fails to match

;; 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)
   )

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


fixed bug in threshold check condition block
also G_MAX was applied after G's were used

git-svn-id: 602a26e73ae9f2a14e2bb95676f2e137fcc39919@3399 7c0444ca-5550-0410-9008-faecdbe78eb5

#include "LIF_params.h"
#include "cl_random.hcl"
#include "../utils/pv_random.h"

#ifndef PV_USE_OPENCL
#  include <math.h>
#  define EXP expf
#  define CL_KERNEL
#  define CL_MEM_GLOBAL
#  define CL_MEM_LOCAL
#else  /* compiling with OpenCL */
#  define EXP exp
#  define CL_KERNEL       __kernel
#  define CL_MEM_GLOBAL   __global
#  define CL_MEM_LOCAL    __local
#  include "conversions.hcl"
#endif

//
// update the state of a retinal layer (spiking)
//
//    assume called with 1D kernel
//
CL_KERNEL
void LIF_update_state(
    const float time,
    const float dt,

    const int nx,
    const int ny,
    const int nf,
    const int nb,

    CL_MEM_GLOBAL LIF_params * params,
    CL_MEM_GLOBAL uint4 * rnd,
    CL_MEM_GLOBAL float * V,
    CL_MEM_GLOBAL float * Vth,
    CL_MEM_GLOBAL float * G_E,
    CL_MEM_GLOBAL float * G_I,
    CL_MEM_GLOBAL float * G_IB,
    CL_MEM_GLOBAL float * phiExc,
    CL_MEM_GLOBAL float * phiInh,
    CL_MEM_GLOBAL float * phiInhB,
    CL_MEM_GLOBAL float * R,
    CL_MEM_GLOBAL float * activity)
{
   int k;

   float exp_tauE = EXP(-dt/params->tauE);
   float exp_tauI = EXP(-dt/params->tauI);
   float exp_tauIB = EXP(-dt/params->tauIB);
   float exp_tauVth = EXP(-dt/params->tauVth);
   float exp_tauRate = EXP(-dt/params->tauRate);

#ifndef PV_USE_OPENCL

for (k = 0; k < nx*ny*nf; k++) {
#else
   k = get_global_id(0);
#endif

   int kex = kIndexExtended(k, nx, ny, nf, nb);

   //
   // kernel (nonheader part) begins here
   //

   // local param variables
   float tau, tauE, tauI, tauIB, tauRate, Vrest, VthRest, Vexc, Vinh, VinhB, tauVth, deltaVth;

   float dt_sec;
   const float GMAX = 10.0;

   // local variables
   float l_activ;

   uint4 l_rnd = rnd[k];

   float l_V   = V[k];
   float l_Vth = Vth[k];

   float l_G_E  = G_E[k];
   float l_G_I  = G_I[k];
   float l_G_IB = G_IB[k];

   float l_phiExc  = phiExc[k];
   float l_phiInh  = phiInh[k];
   float l_phiInhB = phiInhB[k];

   float l_R = R[k];

   // temporary arrays
   float tauInf, VmemInf;

   //
   // start of LIF2_update_exact_linear
   //

   // define local param variables
   //
   tau   = params->tau;
   //tauE  = params->tauE;
   //tauI  = params->tauI;
   //tauIB = params->tauIB;

   Vrest = params->Vrest;
   Vexc  = params->Vexc;
   Vinh  = params->Vinh;
   VinhB = params->VinhB;

   //tauRate  = params->tauRate;
   //tauVth   = params->tauVth;
   VthRest  = params->VthRest;
   deltaVth = params->deltaVth;

   // add noise
   //
   dt_sec = .001 * dt;   // convert to seconds

#undef CLRANDOM

#ifdef CLRANDOM
   l_rnd = cl_random_get(l_rnd);
   if (cl_random_prob(l_rnd) < dt_sec*params->noiseFreqE) {
      l_rnd = cl_random_get(l_rnd);
      l_phiExc = l_phiExc + params->noiseAmpE*cl_random_prob(l_rnd);
   }

   l_rnd = cl_random_get(l_rnd);
   if (cl_random_prob(l_rnd) < dt_sec*params->noiseFreqI) {
      l_rnd = cl_random_get(l_rnd);
      l_phiInh = l_phiInh + params->noiseAmpI*cl_random_prob(l_rnd);
   }

   l_rnd = cl_random_get(l_rnd);
   if (cl_random_prob(l_rnd) < dt_sec*params->noiseFreqIB) {
      l_rnd = cl_random_get(l_rnd);
      l_phiInhB = l_phiInhB + params->noiseAmpIB*cl_random_prob(l_rnd);
   }
#else
   if (pv_random_prob() < dt_sec*params->noiseFreqE) {
      l_phiExc = l_phiExc + params->noiseAmpE*pv_random_prob();
   }

   if (pv_random_prob() < dt_sec*params->noiseFreqI) {
      l_phiInh = l_phiInh + params->noiseAmpI*pv_random_prob();
   }

   if (pv_random_prob() < dt_sec*params->noiseFreqIB) {
      l_phiInhB = l_phiInhB + params->noiseAmpIB*pv_random_prob();
   }
#endif

   l_G_E  = l_phiExc  + l_G_E *exp_tauE;
   l_G_I  = l_phiInh  + l_G_I *exp_tauI;
   l_G_IB = l_phiInhB + l_G_IB*exp_tauIB;

   l_G_E  = (l_G_E  > GMAX) ? GMAX : l_G_E;
   l_G_I  = (l_G_I  > GMAX) ? GMAX : l_G_I;
   l_G_IB = (l_G_IB > GMAX) ? GMAX : l_G_IB;

   tauInf  = (dt/tau) * (1.0 + l_G_E + l_G_I + l_G_IB);
   VmemInf = (Vrest + l_G_E*Vexc + l_G_I*Vinh + l_G_IB*VinhB)
           / (1.0 + l_G_E + l_G_I + l_G_IB);

   l_V = VmemInf + (l_V - VmemInf)*EXP(-tauInf);;

   //
   // start of LIF2_update_finish
   //

   //l_phiExc  = 0.0f;
   //l_phiInh  = 0.0f;
   //l_phiInhB = 0.0f;

   l_Vth = VthRest + (l_Vth - VthRest)*exp_tauVth;

   //
   // start of update_f
   //

   //l_activ = activity[kex];

//   l_activ = (l_V > l_Vth) ? 1.0f           : 0.0f;
   bool fired_flag = (l_V > l_Vth);
   l_activ = (float) fired_flag;
   l_V     = fired_flag ? Vrest            : l_V;
   l_Vth   = fired_flag ? l_Vth + deltaVth : l_Vth;
   l_G_IB  = fired_flag ? l_G_IB + 1.0f    : l_G_IB;

   // update average rate
   l_R = l_activ + l_R*exp_tauRate;

   //
   // These actions must be done outside of kernel
   //    1. set activity to 0 in boundary (if needed)
   //    2. update active indices
   //

   // store local variables back to global memory
   //
   activity[kex] = l_activ;

   R[k] = l_R;

   V[k]   = l_V;
   Vth[k] = l_Vth;

   G_E[k]  = l_G_E;
   G_I[k]  = l_G_I;
   G_IB[k] = l_G_IB;

   phiExc[k]  = l_phiExc;
   phiInh[k]  = l_phiInh;
   phiInhB[k] = l_phiInhB;

#ifndef PV_USE_OPENCL
   } // loop over k
#endif

}

#include "LIF_params.h"
#include "cl_random.hcl"
#include "../utils/pv_random.h"

#ifndef PV_USE_OPENCL
#  include <math.h>
#  define EXP expf
#  define CL_KERNEL
#  define CL_MEM_GLOBAL
#  define CL_MEM_LOCAL
#else  /* compiling with OpenCL */
#  define EXP exp
#  define CL_KERNEL       __kernel
#  define CL_MEM_GLOBAL   __global
#  define CL_MEM_LOCAL    __local
#  include "conversions.hcl"
#endif

//
// update the state of a retinal layer (spiking)
//
//    assume called with 1D kernel
//
CL_KERNEL
void LIF_update_state(
    const float time,
    const float dt,

    const int nx,
    const int ny,
    const int nf,
    const int nb,

    CL_MEM_GLOBAL LIF_params * params,
    CL_MEM_GLOBAL uint4 * rnd,
    CL_MEM_GLOBAL float * V,
    CL_MEM_GLOBAL float * Vth,
    CL_MEM_GLOBAL float * G_E,
    CL_MEM_GLOBAL float * G_I,
    CL_MEM_GLOBAL float * G_IB,
    CL_MEM_GLOBAL float * phiExc,
    CL_MEM_GLOBAL float * phiInh,
    CL_MEM_GLOBAL float * phiInhB,
    CL_MEM_GLOBAL float * R,
    CL_MEM_GLOBAL float * activity)
{
   int k;

   float exp_tauE = EXP(-dt/params->tauE);
   float exp_tauI = EXP(-dt/params->tauI);
   float exp_tauIB = EXP(-dt/params->tauIB);
   float exp_tauVth = EXP(-dt/params->tauVth);
   float exp_tauRate = EXP(-dt/params->tauRate);

#ifndef PV_USE_OPENCL

for (k = 0; k < nx*ny*nf; k++) {
#else
   k = get_global_id(0);
#endif

   int kex = kIndexExtended(k, nx, ny, nf, nb);

   //
   // kernel (nonheader part) begins here
   //

   // local param variables
   float tau, tauE, tauI, tauIB, tauRate, Vrest, VthRest, Vexc, Vinh, VinhB, tauVth, deltaVth;

   float dt_sec;
   const float GMAX = 10.0;

   // local variables
   float l_activ;

   uint4 l_rnd = rnd[k];

   float l_V   = V[k];
   float l_Vth = Vth[k];

   float l_G_E  = G_E[k];
   float l_G_I  = G_I[k];
   float l_G_IB = G_IB[k];

   float l_phiExc  = phiExc[k];
   float l_phiInh  = phiInh[k];
   float l_phiInhB = phiInhB[k];

   float l_R = R[k];

   // temporary arrays
   float tauInf, VmemInf;

   //
   // start of LIF2_update_exact_linear
   //

   // define local param variables
   //
   tau   = params->tau;
   tauE  = params->tauE;
   tauI  = params->tauI;
   tauIB = params->tauIB;

   Vrest = params->Vrest;
   Vexc  = params->Vexc;
   Vinh  = params->Vinh;
   VinhB = params->VinhB;

   tauRate  = params->tauRate;
   tauVth   = params->tauVth;
   VthRest  = params->VthRest;
   deltaVth = params->deltaVth;

   // add noise
   //
   dt_sec = .001 * dt;   // convert to seconds

#undef CLRANDOM

#ifdef CLRANDOM
   l_rnd = cl_random_get(l_rnd);
   if (cl_random_prob(l_rnd) < dt_sec*params->noiseFreqE) {
      l_rnd = cl_random_get(l_rnd);
      l_phiExc = l_phiExc + params->noiseAmpE*cl_random_prob(l_rnd);
   }

   l_rnd = cl_random_get(l_rnd);
   if (cl_random_prob(l_rnd) < dt_sec*params->noiseFreqI) {
      l_rnd = cl_random_get(l_rnd);
      l_phiInh = l_phiInh + params->noiseAmpI*cl_random_prob(l_rnd);
   }

   l_rnd = cl_random_get(l_rnd);
   if (cl_random_prob(l_rnd) < dt_sec*params->noiseFreqIB) {
      l_rnd = cl_random_get(l_rnd);
      l_phiInhB = l_phiInhB + params->noiseAmpIB*cl_random_prob(l_rnd);
   }
#else
   if (pv_random_prob() < dt_sec*params->noiseFreqE) {
      l_phiExc = l_phiExc + params->noiseAmpE*pv_random_prob();
   }

   if (pv_random_prob() < dt_sec*params->noiseFreqI) {
      l_phiInh = l_phiInh + params->noiseAmpI*pv_random_prob();
   }

   if (pv_random_prob() < dt_sec*params->noiseFreqIB) {
      l_phiInhB = l_phiInhB + params->noiseAmpIB*pv_random_prob();
   }
#endif

   l_G_E  = l_phiExc  + l_G_E *exp_tauE;
   l_G_I  = l_phiInh  + l_G_I *exp_tauI;
   l_G_IB = l_phiInhB + l_G_IB*exp_tauIB;

   tauInf  = (dt/tau) * (1.0 + l_G_E + l_G_I + l_G_IB);
   VmemInf = (Vrest + l_G_E*Vexc + l_G_I*Vinh + l_G_IB*VinhB)
           / (1.0 + l_G_E + l_G_I + l_G_IB);

   l_V = VmemInf + (l_V - VmemInf)*EXP(-tauInf);;

   //
   // start of LIF2_update_finish
   //

   l_phiExc  = 0.0f;
   l_phiInh  = 0.0f;
   l_phiInhB = 0.0f;

   l_Vth = VthRest + (l_Vth - VthRest)*exp_tauVth;

   //
   // start of update_f
   //

   l_G_E  = (l_G_E  > GMAX) ? GMAX : l_G_E;
   l_G_I  = (l_G_I  > GMAX) ? GMAX : l_G_I;
   l_G_IB = (l_G_IB > GMAX) ? GMAX : l_G_IB;

   l_activ = activity[kex];

   l_activ = (l_V > l_Vth) ? 1.0f           : 0.0f;
   l_V     = (l_V > l_Vth) ? Vrest          : l_V;
   l_Vth   = (l_V > l_Vth) ? l_Vth + deltaVth : l_Vth;
   l_G_IB  = (l_V > l_Vth) ? l_G_IB + 1.0f    : l_G_IB;

   // update average rate
   l_R = l_activ + l_R*exp_tauRate;

   //
   // These actions must be done outside of kernel
   //    1. set activity to 0 in boundary (if needed)
   //    2. update active indices
   //

   // store local variables back to global memory
   //
   activity[kex] = l_activ;

   R[k] = l_R;

   V[k]   = l_V;
   Vth[k] = l_Vth;

   G_E[k]  = l_G_E;
   G_I[k]  = l_G_I;
   G_IB[k] = l_G_IB;

   phiExc[k]  = l_phiExc;
   phiInh[k]  = l_phiInh;
   phiInhB[k] = l_phiInhB;

#ifndef PV_USE_OPENCL
   } // loop over k
#endif

}