Remove 2 unecessary computation of 1<<scale (the GPU is definitively AWEFUL at thoses)

__kernel void
downscaledconvolution(
        __write_only image2d_t convoluted_image,
        __read_only image2d_t input_image,
        int scale)
{
    const float mask[5][5] = {
        0.003906, 0.015625, 0.023438, 0.015625, 0.003906,
        0.015625, 0.062500, 0.093750, 0.062500, 0.015625,
        0.023438, 0.093750, 0.140625, 0.093750, 0.023438,
        0.015625, 0.062500, 0.093750, 0.062500, 0.015625,
        0.003906, 0.015625, 0.023438, 0.015625, 0.003906
    };

    const sampler_t sampler =
        CLK_FILTER_NEAREST|CLK_NORMALIZED_COORDS_FALSE|CLK_ADDRESS_CLAMP_TO_EDGE;

    int sf = 1<<scale;

    int x_in_output = get_global_id(0);
    int y_in_output = get_global_id(1);

    int x_in_input = x_in_output*sf;
    int y_in_input = y_in_output*sf;

    int i, j;

    float4 c = (float4)0.f;

    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*sf, y_in_input-2*sf))) * mask[0][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*sf, y_in_input-2*sf))) * mask[1][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*sf, y_in_input-2*sf))) * mask[2][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*sf, y_in_input-2*sf))) * mask[3][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*sf, y_in_input-2*sf))) * mask[4][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*sf, y_in_input-1*sf))) * mask[0][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*sf, y_in_input-1*sf))) * mask[1][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*sf, y_in_input-1*sf))) * mask[2][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*sf, y_in_input-1*sf))) * mask[3][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*sf, y_in_input-1*sf))) * mask[4][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*sf, y_in_input+0*sf))) * mask[0][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*sf, y_in_input+0*sf))) * mask[1][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*sf, y_in_input+0*sf))) * mask[2][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*sf, y_in_input+0*sf))) * mask[3][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*sf, y_in_input+0*sf))) * mask[4][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*sf, y_in_input+1*sf))) * mask[0][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*sf, y_in_input+1*sf))) * mask[1][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*sf, y_in_input+1*sf))) * mask[2][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*sf, y_in_input+1*sf))) * mask[3][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*sf, y_in_input+1*sf))) * mask[4][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*sf, y_in_input+2*sf))) * mask[0][4];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*sf, y_in_input+2*sf))) * mask[1][4];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*sf, y_in_input+2*sf))) * mask[2][4];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*sf, y_in_input+2*sf))) * mask[3][4];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*sf, y_in_input+2*sf))) * mask[4][4];

    write_imageui(convoluted_image, (int2)(x_in_output, y_in_output), convert_int4(c));
}

__kernel void
downscaledconvolution(
        __write_only image2d_t convoluted_image,
        __read_only image2d_t input_image,
        int scale)
{
    const float mask[5][5] = {
        0.003906, 0.015625, 0.023438, 0.015625, 0.003906,
        0.015625, 0.062500, 0.093750, 0.062500, 0.015625,
        0.023438, 0.093750, 0.140625, 0.093750, 0.023438,
        0.015625, 0.062500, 0.093750, 0.062500, 0.015625,
        0.003906, 0.015625, 0.023438, 0.015625, 0.003906
    };

    const sampler_t sampler =
        CLK_FILTER_NEAREST|CLK_NORMALIZED_COORDS_FALSE|CLK_ADDRESS_CLAMP_TO_EDGE;

    int x_in_output = get_global_id(0);
    int y_in_output = get_global_id(1);

    int x_in_input = x_in_output*(1<<scale);
    int y_in_input = y_in_output*(1<<scale);

    int i, j;

    int ss = 1<<scale;

    float4 c = (float4)0.f;

    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*ss, y_in_input-2*ss))) * mask[0][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*ss, y_in_input-2*ss))) * mask[1][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*ss, y_in_input-2*ss))) * mask[2][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*ss, y_in_input-2*ss))) * mask[3][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*ss, y_in_input-2*ss))) * mask[4][0];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*ss, y_in_input-1*ss))) * mask[0][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*ss, y_in_input-1*ss))) * mask[1][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*ss, y_in_input-1*ss))) * mask[2][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*ss, y_in_input-1*ss))) * mask[3][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*ss, y_in_input-1*ss))) * mask[4][1];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*ss, y_in_input+0*ss))) * mask[0][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*ss, y_in_input+0*ss))) * mask[1][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*ss, y_in_input+0*ss))) * mask[2][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*ss, y_in_input+0*ss))) * mask[3][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*ss, y_in_input+0*ss))) * mask[4][2];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*ss, y_in_input+1*ss))) * mask[0][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*ss, y_in_input+1*ss))) * mask[1][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*ss, y_in_input+1*ss))) * mask[2][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*ss, y_in_input+1*ss))) * mask[3][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*ss, y_in_input+1*ss))) * mask[4][3];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-2*ss, y_in_input+2*ss))) * mask[0][4];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input-1*ss, y_in_input+2*ss))) * mask[1][4];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+0*ss, y_in_input+2*ss))) * mask[2][4];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+1*ss, y_in_input+2*ss))) * mask[3][4];
    c += convert_float4(read_imageui(input_image, sampler, (int2)(x_in_input+2*ss, y_in_input+2*ss))) * mask[4][4];

    write_imageui(convoluted_image, (int2)(x_in_output, y_in_output), convert_int4(c));
}


Delete prngcl_xor7.cl

Delete prngcl_xor7.cl

/******************************************************************************
 * @file     prngcl_xor7.cl
 * @author   Vadim Demchik <vadimdi@yahoo.com>
 * @version  1.0
 *
 * @brief    [PRNGCL library]
 *           contains OpenCL implementation of seven-XOR pseudo-random number generator
 *
 *
 * @section  CREDITS
 *
 *   Francois Panneton and Pierre L'ecuyer,
 *   "On the xorshift random number generators",
 *   ACM Transactions on Modeling and Computer Simulation (TOMACS), 15, 4 (2005), 346--361.
 *
 *
 * @section  LICENSE
 *
 * Copyright (c) 2013, Vadim Demchik
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without modification,
 * are permitted provided that the following conditions are met:
 *
 *    Redistributions of source code must retain the above copyright notice,
 *      this list of conditions and the following disclaimer.
 *
 *    Redistributions in binary form must reproduce the above copyright notice,
 *      this list of conditions and the following disclaimer in the documentation
 *      and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 *****************************************************************************/

#ifndef PRNGCL_XOR7_CL
#define PRNGCL_XOR7_CL

#include "prngcl_common.cl"

#define XOR7_m_FP   (4294967296.0f)
#define XOR7_min    1
#define XOR7_max    4294967295
#define XOR7_k      (2.3283064365386962890625E-10) // 1/(2^32-1)

__attribute__((always_inline)) void
xor7_step(uint4* seed1,uint4* seed2)
{
    uint t, y;
        t = (*seed2).w;     t = t ^ (t<<13);    y = t ^ (t<<9);
        t = (*seed2).x;     y^= t ^ (t<<7);
        t = (*seed1).w;     y^= t ^ (t>>3);
        t = (*seed1).y;     y^= t ^ (t>>10);
        t = (*seed1).x;     t = t ^ (t>>7);     y^= t ^ (t<<24);

        (*seed1).xyz = (*seed1).yzw;
        (*seed1).w   = (*seed2).x;
        (*seed2).xyz = (*seed2).yzw;
        (*seed2).w   = y;
}

#ifdef PRECISION_DOUBLE  // if double precision is defined
__attribute__((always_inline)) hgpu_double
xor7_step_double(uint4* seed1,uint4* seed2)
{
    hgpu_double rnd_double;
    uint rnd1, rnd2;
    uint4 sed1 = (*seed1);
    uint4 sed2 = (*seed2);
    bool flag = true;
    while (flag) {
        xor7_step(&sed1,&sed2);
        rnd1 = sed2.w;
        if ((rnd1>XOR7_min) && (rnd1<XOR7_max)) {
            xor7_step(&sed1,&sed2);
            rnd2 = sed2.w;
            rnd_double = hgpu_uint_to_double(rnd1,rnd2,XOR7_min,XOR7_max,XOR7_k);
            flag = false;
        }
    }
    (*seed1) = sed1;
    (*seed2) = sed2;
    return rnd_double;
}
#endif

__kernel void
xor7(__global uint4* seed_table,
     __global hgpu_float4* randoms,
       const uint N)
{
    uint giddst = GID;
#ifdef PRECISION_DOUBLE  // if double precision is defined
    hgpu_double4 result;
#else
    float4 result;
    float4 normal = (float4) XOR7_m_FP;
#endif
    uint4 seed1 = seed_table[GID];
    uint4 seed2 = seed_table[GID + GID_SIZE];
    for (uint i = 0; i < N; i++) {
#ifdef PRECISION_DOUBLE // if double precision is defined
        result.x = xor7_step_double(&seed1,&seed2);
        result.y = xor7_step_double(&seed1,&seed2);
        result.z = xor7_step_double(&seed1,&seed2);
        result.w = xor7_step_double(&seed1,&seed2);
        randoms[giddst] = result;
#else
        xor7_step(&seed1,&seed2);
            result.x = (float) seed2.w;
        xor7_step(&seed1,&seed2);
            result.y = (float) seed2.w;
        xor7_step(&seed1,&seed2);
            result.z = (float) seed2.w;
        xor7_step(&seed1,&seed2);
            result.w = (float) seed2.w;
        randoms[giddst] = result / normal;
#endif
        giddst += GID_SIZE;
    }
    seed_table[GID] = seed1;
    seed_table[GID + GID_SIZE] = seed2;
}

#endif


r1903: mod with-database again...

r1903: mod with-database again...

;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          functional.cl
;;;; Purpose:       Functional interface
;;;; Programmer:    Pierre R. Mai
;;;;
;;;; Copyright (c) 1999-2001 Pierre R. Mai
;;;;
;;;; $Id: functional.cl,v 1.5 2002/05/04 09:27:12 marc.battyani Exp $
;;;;
;;;; This file is part of CLSQL.
;;;;
;;;; CLSQL is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License (version 2) as
;;;; published by the Free Software Foundation.
;;;;
;;;; CLSQL is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with CLSQL; if not, write to the Free Software Foundation, Inc.,
;;;; 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
;;;; *************************************************************************

(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :clsql-sys)

;;;; This file implements the more advanced functions of the
;;;; functional SQL interface, which are just nicer layers above the
;;;; basic SQL interface.

(defun insert-records
    (&key into attributes values av-pairs query (database *default-database*))
  "Insert records into the given table according to the given options."
  (cond
    ((and av-pairs (or attributes values))
     (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
    ((and (or av-pairs values) query)
     (error
      "Supply either query or values/av-pairs to call of insert-records."))
    ((and attributes (not query)
          (or (not (listp values)) (/= (length attributes) (length values))))
     (error "You must supply a matching values list when using attributes in call of insert-records."))
    (query
     (execute-command
      (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
      :database database))
    (t
     (execute-command
      (multiple-value-bind (attributes values)
          (if av-pairs
              (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
              (values attributes values))
	(format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
		into attributes values))
      :database database))))

(defun delete-records (&key from where (database *default-database*))
  "Delete the indicated records from the given database."
  (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
                   :database database))

(defun update-records (table &key attributes values av-pairs where (database *default-database*))
  "Update the specified records in the given database."
  (cond
    ((and av-pairs (or attributes values))
     (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
    ((and attributes
          (or (not (listp values)) (/= (length attributes) (length values))))
     (error "You must supply a matching values list when using attributes in call of update-records."))
    ((or (and attributes (not values)) (and values (not attributes)))
     (error "You must supply both values and attributes in call of update-records."))
    (t
     (execute-command
      (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
              table
              (or av-pairs
                  (mapcar #'list attributes values))
              where)
      :database database))))

(defmacro with-database ((db-var connection-spec &rest connect-args) &body body)
  "Evaluate the body in an environment, where `db-var' is bound to the
database connection given by `connection-spec' and `connect-args'.
The connection is automatically closed or released to the pool on exit from the body."
  `(let ((,db-var (connect ,connection-spec ,@connect-args)))
    (unwind-protect
	 (let ((,db-var ,db-var)) ,@body)
      (disconnect :database ,db-var))))

;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          functional.cl
;;;; Purpose:       Functional interface
;;;; Programmer:    Pierre R. Mai
;;;;
;;;; Copyright (c) 1999-2001 Pierre R. Mai
;;;;
;;;; $Id: functional.cl,v 1.4 2002/05/04 02:43:15 kevin Exp $
;;;;
;;;; This file is part of CLSQL.
;;;;
;;;; CLSQL is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License (version 2) as
;;;; published by the Free Software Foundation.
;;;;
;;;; CLSQL is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with CLSQL; if not, write to the Free Software Foundation, Inc.,
;;;; 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
;;;; *************************************************************************

(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :clsql-sys)

;;;; This file implements the more advanced functions of the
;;;; functional SQL interface, which are just nicer layers above the
;;;; basic SQL interface.

(defun insert-records
    (&key into attributes values av-pairs query (database *default-database*))
  "Insert records into the given table according to the given options."
  (cond
    ((and av-pairs (or attributes values))
     (error "Supply either av-pairs or values (and possibly attributes) to call of insert-records."))
    ((and (or av-pairs values) query)
     (error
      "Supply either query or values/av-pairs to call of insert-records."))
    ((and attributes (not query)
          (or (not (listp values)) (/= (length attributes) (length values))))
     (error "You must supply a matching values list when using attributes in call of insert-records."))
    (query
     (execute-command
      (format nil "insert into ~A ~@[(~{~A~^,~}) ~]~A" into attributes query)
      :database database))
    (t
     (execute-command
      (multiple-value-bind (attributes values)
          (if av-pairs
              (values (mapcar #'first av-pairs) (mapcar #'second av-pairs))
              (values attributes values))
	(format nil "insert into ~A ~@[(~{~A~^,~}) ~]values (~{'~A'~^,~})"
		into attributes values))
      :database database))))

(defun delete-records (&key from where (database *default-database*))
  "Delete the indicated records from the given database."
  (execute-command (format nil "delete from ~A ~@[where ~A ~]" from where)
                   :database database))

(defun update-records (table &key attributes values av-pairs where (database *default-database*))
  "Update the specified records in the given database."
  (cond
    ((and av-pairs (or attributes values))
     (error "Supply either av-pairs or values (and possibly attributes) to call of update-records."))
    ((and attributes
          (or (not (listp values)) (/= (length attributes) (length values))))
     (error "You must supply a matching values list when using attributes in call of update-records."))
    ((or (and attributes (not values)) (and values (not attributes)))
     (error "You must supply both values and attributes in call of update-records."))
    (t
     (execute-command
      (format nil "update ~A set ~:{~A = '~A'~:^, ~}~@[ where ~A~]"
              table
              (or av-pairs
                  (mapcar #'list attributes values))
              where)
      :database database))))

(defmacro with-database ((db-var connection-spec
				 &rest connect-args
				 &key (pool nil))
			 &body body)
  "Evaluate the body in an environment, where `db-var' is bound to the
database connection given by `connection-spec' and `connect-args'.
If pool is t the the connection will be taken from the general pool,
if pool is a conn-pool object the connection will be taken from this pool.
The connection is automatically closed or released to the pool
on exit from the body."
  `(let ((,db-var (connect ,connection-spec :pool ,pool ,@connect-args)))
     (unwind-protect
	 (progn
	   ,@body)
       (disconnect :database ,db-var :poool ,pool))))