Fix/ImageResizer CL code not compiling

Fix/ImageResizer CL code not compiling

__constant sampler_t sampler = CLK_NORMALIZED_COORDS_TRUE | CLK_ADDRESS_NONE | CLK_FILTER_LINEAR;
__constant sampler_t sampler2 = CLK_NORMALIZED_COORDS_FALSE | CLK_ADDRESS_NONE | CLK_FILTER_LINEAR;

void writeToImage(__write_only image2d_t input, int2 position, float4 value) {
    int dataType = get_image_channel_data_type(input);
	if(dataType == CLK_FLOAT) {
		write_imagef(input, position, value);
	} else if(dataType == CLK_UNSIGNED_INT8 || dataType == CLK_UNSIGNED_INT16) {
		write_imageui(input, position, convert_uint4(value));
	} else {
		write_imagei(input, position, convert_int4(value));
    }
}

float4 readFromImage(__read_only image2d_t input, float2 position) {
    int dataType = get_image_channel_data_type(input);
	if(dataType == CLK_FLOAT) {
		return read_imagef(input, sampler, position);
	} else if(dataType == CLK_UNSIGNED_INT8 || dataType == CLK_UNSIGNED_INT16) {
        return convert_float4(read_imageui(input, sampler, position));
	} else {
        return convert_float4(read_imagei(input, sampler, position));
    }
}

__kernel void resize2DpreserveAspect(
	__read_only image2d_t input,
	__write_only image2d_t output,
    __private int newHeight
	) {
	const int2 position = {get_global_id(0), get_global_id(1)};
    const float scale = (float)newHeight / get_image_height(input);
	const float2 readPosition = {(float)position.x / get_global_size(0), (float)position.y / (scale*get_image_height(input))};
    if(position.y >= newHeight) {
        writeToImage(output, position, (float4)(0,0,0,0));
    } else {
        writeToImage(output, position, readFromImage(input, readPosition));
    }
}

__kernel void resize2D(
		__read_only image2d_t input,
		__write_only image2d_t output
    ) {
	const int2 position = {get_global_id(0), get_global_id(1)};
	const float2 normalizedPosition = {(float)position.x / get_global_size(0), (float)position.y / get_global_size(1)};
	int dataType = get_image_channel_data_type(input);
	if(dataType == CLK_FLOAT) {
		write_imagef(output, position, read_imagef(input, sampler, normalizedPosition));
	} else if(dataType == CLK_UNSIGNED_INT8 || dataType == CLK_UNSIGNED_INT16) {
		write_imageui(output, position, read_imageui(input, sampler, normalizedPosition));
	} else {
		write_imagei(output, position, read_imagei(input, sampler, normalizedPosition));
	}
}

__constant sampler_t sampler = CLK_NORMALIZED_COORDS_TRUE | CLK_ADDRESS_NONE | CLK_FILTER_LINEAR;
__constant sampler_t sampler2 = CLK_NORMALIZED_COORDS_FALSE | CLK_ADDRESS_NONE | CLK_FILTER_LINEAR;

void writeToImage(image2d_t input, int2 position, float4 value) {
    int dataType = get_image_channel_data_type(input);
	if(dataType == CLK_FLOAT) {
		write_imagef(input, position, value);
	} else if(dataType == CLK_UNSIGNED_INT8 || dataType == CLK_UNSIGNED_INT16) {
		write_imageui(input, position, convert_uint4(value));
	} else {
		write_imagei(input, position, convert_int4(value));
    }
}

float4 readFromImage(image2d_t input, float2 position) {
    int dataType = get_image_channel_data_type(input);
	if(dataType == CLK_FLOAT) {
		return read_imagef(input, sampler, position);
	} else if(dataType == CLK_UNSIGNED_INT8 || dataType == CLK_UNSIGNED_INT16) {
        return convert_float4(read_imageui(input, sampler, position));
	} else {
        return convert_float4(read_imagei(input, sampler, position));
    }
}

__kernel void resize2DpreserveAspect(
	__read_only image2d_t input,
	__write_only image2d_t output,
    __private int newHeight
	) {
	const int2 position = {get_global_id(0), get_global_id(1)};
    const float scale = (float)newHeight / get_image_height(input);
	const float2 readPosition = {(float)position.x / get_global_size(0), (float)position.y / (scale*get_image_height(input))};
    if(position.y >= newHeight) {
        writeToImage(output, position, (float4)(0,0,0,0));
    } else {
        writeToImage(output, position, readFromImage(input, readPosition));
    }
}

__kernel void resize2D(
		__read_only image2d_t input,
		__write_only image2d_t output
    ) {
	const int2 position = {get_global_id(0), get_global_id(1)};
	const float2 normalizedPosition = {(float)position.x / get_global_size(0), (float)position.y / get_global_size(1)};
	int dataType = get_image_channel_data_type(input);
	if(dataType == CLK_FLOAT) {
		write_imagef(output, position, read_imagef(input, sampler, normalizedPosition));
	} else if(dataType == CLK_UNSIGNED_INT8 || dataType == CLK_UNSIGNED_INT16) {
		write_imageui(output, position, read_imageui(input, sampler, normalizedPosition));
	} else {
		write_imagei(output, position, read_imagei(input, sampler, normalizedPosition));
	}
}


minor

minor

/*
 * Copyright (c) 2017 AMD Inc.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a
 * copy of this software and/or associated documentation files (the
 * "Materials"), to deal in the Materials without restriction, including
 * without limitation the rights to use, copy, modify, merge, publish,
 * distribute, sublicense, and/or sell copies of the Materials, and to
 * permit persons to whom the Materials are 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 Materials.
 *
 * THE MATERIALS ARE 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
 * MATERIALS OR THE USE OR OTHER DEALINGS IN THE MATERIALS.
 */

#define _FLOAT					float
#define _FLOAT2					float2
#define _FLOAT4					float4
#define _FLOAT8					float8

#ifndef FLT_MAX
#define FLT_MAX         3.402823466e+38F        /* max value */
#endif

__attribute__((always_inline))
int iDiv(int v, int d)
{
	int r = (int)((float)v / d + 0.00001f);
	return(r);
}

__attribute__((always_inline))
int iMod(int v, int u, int d)
{
	int r = v - mul24((int)u, (int)d);
	return(r);
}

inline void ReduceKernel(__local _FLOAT * lcl_blob, __private _FLOAT *weights_accum, int lcl_id, int scan_lcl, int sum_stride, int unit_len, bool debug)
{

	for (int j = (sum_stride >> 1); j > 0; j >>= 1)
	{
		barrier(CLK_LOCAL_MEM_FENCE);
		if (scan_lcl < j)
		{
			for (int i = 0; i < unit_len; ++i)
			{
				weights_accum[i] += lcl_blob[(lcl_id + j) * unit_len + i];

				lcl_blob[lcl_id * unit_len + i] = weights_accum[i];

			}

		}
	}
}

static inline void  Kahan_summation(__private _FLOAT *sum, __private _FLOAT * c, _FLOAT v)
{
	_FLOAT y = v - *c;    //So far, so good: c is zero.
	_FLOAT t = *sum + y;         //Alas, sum is big, y small, so low-order digits of y are lost.
	*c = (t - *sum) - y;   //(t - sum) recovers the high-order part of y; subtracting y recovers -(low part of y)
	*sum = t;             //Algebraically, c should always be zero. Beware eagerly optimising compilers!
}

/*********************************************************************************************************
// wrw algorithm for large filters
// idea:
// read MLO_OUT_STACKS output maps into LDS
// read MLO_N_LCL_IN_MAPS per wk_item input maps

// alg

// convolve
// reduce with transform

// write out

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

__attribute__((reqd_work_group_size(MLO_GRP_SZ0, MLO_GRP_SZ1, MLO_GRP_SZ2)))
__kernel void MIOpenCvBwdWrWSmap(
	const __global _FLOAT * __restrict top_df,
	const __global _FLOAT * __restrict bot,
	__global _FLOAT * __restrict weights_df,
	_FLOAT padding_val
)
{
	// reduction memory.

	__local _FLOAT lcl_mem[MLO_LCL_MEM_SZ];
	__local _FLOAT * red_mem = lcl_mem;

	int lcl_id = get_local_id(0);

	int k_idx = get_group_id(0) * (MLO_N_LCL_OUT_MAPS); // output map index base

	int c_idx = get_group_id(1) * (MLO_N_LCL_IN_MAPS * MLO_N_MAPS_PER_GROUP); // input map index based

	int ib = get_group_id(2); // batch id

	int gbl_in_off = c_idx * MLO_IN_CHANNEL_STRIDE + ib * MLO_IN_BATCH_STRIDE;
	int gbl_out_off = k_idx * MLO_OUT_CHANNEL_STRIDE + ib * MLO_OUT_BATCH_STRIDE;

#define MLO_TOP_DAT_SZ (MLO_N_LCL_OUT_MAPS* MLO_READ_UNIT)

	__private _FLOAT top_dat[MLO_TOP_DAT_SZ];

#define MLO_BOT_DAT_SZ (MLO_N_LCL_IN_MAPS * MLO_READ_UNIT)

	__private _FLOAT bot_dat[MLO_BOT_DAT_SZ];

#define MLO_ACCUM_SZ (MLO_N_LCL_OUT_MAPS* MLO_N_LCL_IN_MAPS)

	__private _FLOAT pvt_accum[MLO_ACCUM_SZ];

	for (int i = 0; i < MLO_ACCUM_SZ; ++i)
	{
		pvt_accum[i] = 0;
	}

	for (int i = lcl_id; i < MLO_LCL_MEM_SZ; i += MLO_GRP_SZ)
	{
		lcl_mem[i] = 0;
	}

// map id inside the group, super-pixel inside the map
#if (MLO_MAP_WK_SZ &  (MLO_MAP_WK_SZ - 1))

	int m_id = iDiv(lcl_id, MLO_MAP_WK_SZ);  // map
	int p4 = iMod(lcl_id, m_id, MLO_MAP_WK_SZ); // pixel
#else
	int m_id = ((uint)lcl_id / MLO_MAP_WK_SZ);  // map
	int p4 = ((uint)lcl_id & (MLO_MAP_WK_SZ - 1)); // pixel

#endif

	gbl_in_off += p4 * MLO_READ_UNIT;
//	gbl_out_off += p4 * MLO_READ_UNIT;
// input is kept in registers at the start
	gbl_in_off += m_id * MLO_IN_CHANNEL_STRIDE;

	bool last_pixel = (p4 == MLO_MAP_WK_SZ - 1);
// inside input range
	bool inside_map_range_input = ((c_idx + m_id) < MLO_N_INPUTS && m_id < MLO_N_MAPS_PER_GROUP);
	bool inside_range_input = (p4 < MLO_MAP_WK_SZ &&  inside_map_range_input);

	// inside output range
	bool inside_range_output = (p4 < MLO_MAP_WK_SZ);

	for (int b = 0; b < MLO_BATCH_SZ; ++b, gbl_in_off += MLO_IN_BATCH_STRIDE, gbl_out_off += MLO_OUT_BATCH_STRIDE)
	{

		// read all inputs into registers
		int bot_off = gbl_in_off;

#if MLO_N_PIXS_OFF > 0

			if (last_pixel)
			{
				for (int c = 0; c < MLO_N_LCL_IN_MAPS; ++c, bot_off += MLO_N_MAPS_PER_GROUP*MLO_IN_CHANNEL_STRIDE)
				{

					// reading in order per group and jump over maps been read
					// read arbitrary data but inside the range

					bool inside_range_input2 = inside_range_input && ((c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS);

					bot_off = (inside_range_input2) ? bot_off : 0;

					for (int i = 0; i < MLO_N_PIXS_OFF; ++i)
					{
						bot_dat[c*MLO_READ_UNIT + i] = bot[bot_off + i];
					}
					for (int i = MLO_N_PIXS_OFF; i < MLO_READ_UNIT; ++i)
					{
						bot_dat[c*MLO_READ_UNIT + i] = 0;
					}

				}

			}
			else
#endif
			{
				// check
				for (int c = 0; c < MLO_N_LCL_IN_MAPS; ++c, bot_off += MLO_N_MAPS_PER_GROUP*MLO_IN_CHANNEL_STRIDE)
				{
					// reading in order per group and jump over maps been read
					// read arbitrary data but inside the range

					bool inside_range_input2 = inside_range_input && ((c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS);

					bot_off = (inside_range_input2) ? bot_off : 0;

					for (int i = 0; i < MLO_READ_UNIT; ++i)
					{
						bot_dat[c*MLO_READ_UNIT + i] = bot[bot_off + i];
					}

				}

			} // if (last_pixel)

//			int top_off = (inside_range_output) ? gbl_out_off : 0;

		int top_off = gbl_out_off;

		// read all outputs
		// assum division by MLO_N_LCL_OUT
		for (int kb = 0; kb < MLO_N_LCL_OUT; kb++, top_off += MLO_OUT_LCL_BLK * MLO_OUT_CHANNEL_STRIDE)
		{

			barrier(CLK_LOCAL_MEM_FENCE);

			for (int p = lcl_id; p < MLO_OUT_LCL_BLK * MLO_MAP_WK_SZ; p += MLO_GRP_SZ)
			{
#if (MLO_MAP_WK_SZ & (MLO_MAP_WK_SZ - 1))
				int m = iDiv(p, MLO_MAP_WK_SZ);
				int pm = iMod(p, m, MLO_MAP_WK_SZ);
#else
				int m = ((uint)p / MLO_MAP_WK_SZ);
				int pm = ((uint)p & (MLO_MAP_WK_SZ - 1));
#endif

				int top_off1 = top_off + m * MLO_OUT_CHANNEL_STRIDE + pm*MLO_READ_UNIT;
#if MLO_N_OUT_MAPS_ALIGNED == 0
				top_off1 = (k_idx + m < MLO_N_OUTPUTS) ? top_off1 : 0;
#endif
#if MLO_N_PIXS_OFF > 0
				if (pm == MLO_MAP_WK_SZ - 1)
				{
					for (int i = 0; i < MLO_N_PIXS_OFF; ++i)
					{
						lcl_mem[p*MLO_READ_UNIT + i] = top_df[top_off1 + i];
					}
					for (int i = MLO_N_PIXS_OFF; i < MLO_READ_UNIT; ++i)
					{
						lcl_mem[p*MLO_READ_UNIT + i] = 0;
					}

				}
				else

#endif
				{
					for (int i = 0; i < MLO_READ_UNIT; ++i)
					{
						lcl_mem[p*MLO_READ_UNIT + i] = top_df[top_off1 + i];

					}
				}

			} // for(int p = 0; p < MLO_OUT_LCL_BLK * MLO_MAP_WK_SZ; p += MLO_GRP_SZ)

			barrier(CLK_LOCAL_MEM_FENCE);

			for (int k = kb*MLO_OUT_LCL_BLK; k < (kb + 1)*MLO_OUT_LCL_BLK; ++k)
			{
				// processing
				for (int c = 0; c < MLO_N_LCL_IN_MAPS; ++c)
				{
					for (int i = 0; i < MLO_READ_UNIT; ++i)
					{
						_FLOAT bot_val = bot_dat[c*MLO_READ_UNIT + i];
						_FLOAT top_val = lcl_mem[((k - kb*MLO_OUT_LCL_BLK) * MLO_MAP_WK_SZ + p4)*MLO_READ_UNIT + i];
						pvt_accum[k * MLO_N_LCL_IN_MAPS + c] += top_val * bot_val;
#if 0
						if (top_val * bot_val !=0  &&  k == 0 && c == 0 && m_id == 0 && get_group_id(0) == 0 && get_group_id(1) == 1 && lcl_id ==0 )
						{

							printf("K:c: %d %d %d %d %f %f %f %f\n",
								c_idx + m_id + c*MLO_N_MAPS_PER_GROUP,
								lcl_id,
								c*MLO_READ_UNIT + i,
								((k - kb*MLO_OUT_LCL_BLK) * MLO_MAP_WK_SZ + p4)*MLO_READ_UNIT + i,
								pvt_accum[k * MLO_N_LCL_IN_MAPS + c],
								top_val * bot_val,
								bot_val,
								top_val

							);
						}

#endif

					}
				}
			}

		} // for(int kb = 0; kb < MLO_N_LCL_OUT; kb++, top_off += MLO_OUT_LCL_BLK * MLO_OUT_CHANNEL_STRIDE)
	} // for (int b = 0; b < MLO_BATCH_SZ; ++b, gbl_in_off += MLO_IN_BATCH_STRIDE, gbl_out_off += MLO_OUT_BATCH_STRIDE)

	// write out
	// inputs are outputs
	int wei_df_off = ((ib * MLO_N_OUTPUTS + k_idx) * (int)MLO_WEI_BATCH_STRIDE) + (c_idx + m_id) * MLO_WEI_CHANNEL_STRIDE;

// final summation optimized.

#define MLO_N_FIRST_SPLITS  (1 << (MLO_LG2_REDUC_ROUNDS - 1))
// transpose data using MLO_REDUC_LOOP_STEP wk-items from each small map
	__private _FLOAT final_sum[(MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP)];

#if 1 // MLO_LG2_REDUC_ROUNDS > 1
// first round
// transpose and split into sub-group for logar summation
	for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
	{
		final_sum[r] = 0;

		barrier(CLK_LOCAL_MEM_FENCE);
// write out only valid pixels
#if MLO_MAP_WK_SZ < MLO_GRP_SZ
		if (lcl_id < MLO_N_MAPS_PER_GROUP*MLO_MAP_WK_SZ)
#endif

		{

			for (int rr = 0; rr < MLO_REDUC_LOOP_STEP; ++rr)
			{
				lcl_mem[lcl_id*MLO_REDUC_LOOP_STEP + rr] = pvt_accum[r*MLO_REDUC_LOOP_STEP + rr];
			}
		}
		barrier(CLK_LOCAL_MEM_FENCE);

		if (p4 < (MLO_REDUC_LOOP_STEP<< (MLO_LG2_REDUC_ROUNDS - 1)))
		{
			// what split the pix belong to
#if (MLO_REDUC_LOOP_STEP & (MLO_REDUC_LOOP_STEP -1))
			int split = iDiv(p4, MLO_REDUC_LOOP_STEP);
			int split_pix = iMod(p4, split, MLO_REDUC_LOOP_STEP);
#else
			int split = ((uint)p4 / MLO_REDUC_LOOP_STEP);
			int split_pix = ((uint)p4 & (MLO_REDUC_LOOP_STEP - 1));
#endif

			for (int j = 0; j < MLO_FIRST_ROUND; j++)
			{
#if MLO_FIRST_CAN_DIVIDE ==0
				if (split*MLO_FIRST_ROUND + j < MLO_MAP_WK_SZ)
#endif
				{
					final_sum[r] += lcl_mem[(m_id*MLO_MAP_WK_SZ + split*MLO_FIRST_ROUND + j)*MLO_REDUC_LOOP_STEP + split_pix];
				}
			}

		}
	}

#if MLO_LG2_REDUC_ROUNDS > 1
// log summation
	for (int rd = (MLO_LG2_REDUC_ROUNDS - 2); rd >= 0; --rd)
	{

		barrier(CLK_LOCAL_MEM_FENCE);
		if (p4 < (MLO_REDUC_LOOP_STEP << (rd + 1)))
		{
			for (int rr = 0; rr < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++rr)
			{
				lcl_mem[(rr*MLO_N_MAPS_PER_GROUP + m_id)*MLO_REDUC_LOOP_STEP*(1 << (rd + 1)) + p4] = final_sum[rr];
			}
		}
		barrier(CLK_LOCAL_MEM_FENCE);

		if (p4 < (MLO_REDUC_LOOP_STEP << rd))
		{
			for (int rr = 0; rr < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++rr)
			{
				final_sum[rr] += lcl_mem[(rr*MLO_N_MAPS_PER_GROUP + m_id)*MLO_REDUC_LOOP_STEP*(1 << (rd + 1)) + (MLO_REDUC_LOOP_STEP << rd) + p4];
			}
		}
	}

#endif

	if (p4 < MLO_REDUC_LOOP_STEP)
	{
		for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
		{
			int wei_idx = r* (MLO_REDUC_LOOP_STEP)+p4;

#if (MLO_N_LCL_IN_MAPS & (MLO_N_LCL_IN_MAPS - 1))
			int k = iDiv(wei_idx, MLO_N_LCL_IN_MAPS);
			int c = iMod(wei_idx, k, MLO_N_LCL_IN_MAPS);
#else
			int k = ((uint)wei_idx / MLO_N_LCL_IN_MAPS);
			int c = ((uint)wei_idx & (MLO_N_LCL_IN_MAPS - 1));
#endif

			if (m_id < MLO_N_MAPS_PER_GROUP && (c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS
#if MLO_N_OUT_MAPS_ALIGNED == 0
				&& k_idx + k < MLO_N_OUTPUTS
#endif
				)
			{
				int wei_off = wei_df_off + k*MLO_WEI_BATCH_STRIDE + c*MLO_N_MAPS_PER_GROUP*MLO_WEI_CHANNEL_STRIDE;
				weights_df[wei_off] = final_sum[r];
			}

		} // for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
	} // if (p4 < MLO_REDUC_LOOP_STEP)

#elif 1
//	if (inside_range_input)
	{
		for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
		{
			final_sum[r] = 0;

			barrier(CLK_LOCAL_MEM_FENCE);

			for (int rr = 0; rr < MLO_REDUC_LOOP_STEP; ++rr)
			{
				lcl_mem[lcl_id*MLO_REDUC_LOOP_STEP + rr] = pvt_accum[r*MLO_REDUC_LOOP_STEP + rr];
			}
			barrier(CLK_LOCAL_MEM_FENCE);

			if (p4 < MLO_REDUC_LOOP_STEP)
			{
				for (int j = 0; j < MLO_MAP_WK_SZ; j++)
				{
					final_sum[r] += lcl_mem[(m_id*MLO_MAP_WK_SZ + j)*MLO_REDUC_LOOP_STEP + p4];
				}

			}
		}

		if (p4 < MLO_REDUC_LOOP_STEP)
		{
			for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
			{
				int wei_idx = r* ( MLO_REDUC_LOOP_STEP) + p4;

#if (MLO_N_LCL_IN_MAPS & (MLO_N_LCL_IN_MAPS - 1))
				int k = iDiv(wei_idx, MLO_N_LCL_IN_MAPS);
				int c = iMod(wei_idx, k, MLO_N_LCL_IN_MAPS);
#else
				int k = ((uint)wei_idx / MLO_N_LCL_IN_MAPS);
				int c = ((uint)wei_idx & (MLO_N_LCL_IN_MAPS-1));
#endif

				if (m_id < MLO_N_MAPS_PER_GROUP && (c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS
#if MLO_N_OUT_MAPS_ALIGNED == 0
					&& k_idx + k < MLO_N_OUTPUTS
#endif
					)
				{
					int wei_off = wei_df_off + k*MLO_WEI_BATCH_STRIDE + c*MLO_N_MAPS_PER_GROUP*MLO_WEI_CHANNEL_STRIDE;
					weights_df[wei_off] = final_sum[r];
				}

			} // for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
		} // if (p4 < MLO_REDUC_LOOP_STEP)
	} // if (inside_range_input)
#else
	for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
	{
		barrier(CLK_LOCAL_MEM_FENCE);

		for (int rr = 0; rr < MLO_REDUC_LOOP_STEP; ++rr)
		{
			lcl_mem[lcl_id*MLO_REDUC_LOOP_STEP + rr] = pvt_accum[r*MLO_REDUC_LOOP_STEP + rr];
		}
		barrier(CLK_LOCAL_MEM_FENCE);

		if (p4 == 0 && inside_range_input)
		{
			for (int j = 1; j < MLO_MAP_WK_SZ; j++)
			{
				for (int rr = 0; rr < MLO_REDUC_LOOP_STEP; ++rr)
				{
					pvt_accum[r*MLO_REDUC_LOOP_STEP + rr] += lcl_mem[(lcl_id + j)*MLO_REDUC_LOOP_STEP + rr];
				}
			}
		}
	}

	if (p4 == 0)
	{
		for (int kb = 0; kb < MLO_N_LCL_OUT; kb++)
		{
			for (int k = kb*MLO_OUT_LCL_BLK; k < (kb + 1)*MLO_OUT_LCL_BLK; ++k)
			{
				for (int c = 0; c < MLO_N_LCL_IN_MAPS; ++c)
				{
					if ( (c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS
#if MLO_N_OUT_MAPS_ALIGNED == 0
						  && k_idx + k < MLO_N_OUTPUTS
#endif
						)
					{
						int wei_off = wei_df_off + k*MLO_WEI_BATCH_STRIDE + c*MLO_N_MAPS_PER_GROUP*MLO_WEI_CHANNEL_STRIDE;
						weights_df[wei_off] = pvt_accum[k*MLO_N_LCL_IN_MAPS + c];
					}

				}

			}
		}

	}

#endif

}

/*
 * Copyright (c) 2017 AMD Inc.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a
 * copy of this software and/or associated documentation files (the
 * "Materials"), to deal in the Materials without restriction, including
 * without limitation the rights to use, copy, modify, merge, publish,
 * distribute, sublicense, and/or sell copies of the Materials, and to
 * permit persons to whom the Materials are 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 Materials.
 *
 * THE MATERIALS ARE 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
 * MATERIALS OR THE USE OR OTHER DEALINGS IN THE MATERIALS.
 */

#define _FLOAT					float
#define _FLOAT2					float2
#define _FLOAT4					float4
#define _FLOAT8					float8

#ifndef FLT_MAX
#define FLT_MAX         3.402823466e+38F        /* max value */
#endif

__attribute__((always_inline))
int iDiv(int v, int d)
{
	int r = (int)((float)v / d + 0.00001f);
	return(r);
}

__attribute__((always_inline))
int iMod(int v, int u, int d)
{
	int r = v - mul24((int)u, (int)d);
	return(r);
}

inline void ReduceKernel(__local _FLOAT * lcl_blob, __private _FLOAT *weights_accum, int lcl_id, int scan_lcl, int sum_stride, int unit_len, bool debug)
{

	for (int j = (sum_stride >> 1); j > 0; j >>= 1)
	{
		barrier(CLK_LOCAL_MEM_FENCE);
		if (scan_lcl < j)
		{
			for (int i = 0; i < unit_len; ++i)
			{
				weights_accum[i] += lcl_blob[(lcl_id + j) * unit_len + i];

				lcl_blob[lcl_id * unit_len + i] = weights_accum[i];

			}

		}
	}
}

static inline void  Kahan_summation(__private _FLOAT *sum, __private _FLOAT * c, _FLOAT v)
{
	_FLOAT y = v - *c;    //So far, so good: c is zero.
	_FLOAT t = *sum + y;         //Alas, sum is big, y small, so low-order digits of y are lost.
	*c = (t - *sum) - y;   //(t - sum) recovers the high-order part of y; subtracting y recovers -(low part of y)
	*sum = t;             //Algebraically, c should always be zero. Beware eagerly optimising compilers!
}

/*********************************************************************************************************
// wrw algorithm for large filters
// idea:
// read MLO_OUT_STACKS output maps into LDS
// read MLO_N_LCL_IN_MAPS per wk_item input maps

// alg

// convolve
// reduce with transform

// write out

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

__attribute__((reqd_work_group_size(MLO_GRP_SZ0, MLO_GRP_SZ1, MLO_GRP_SZ2)))
__kernel void MIOpenCvBwdWrWSmap(
	const __global _FLOAT * __restrict top_df,
	const __global _FLOAT * __restrict bot,
	__global _FLOAT * __restrict weights_df,
	_FLOAT padding_val
)
{
	// reduction memory.

	__local _FLOAT lcl_mem[MLO_LCL_MEM_SZ];
	__local _FLOAT * red_mem = lcl_mem;

	int lcl_id = get_local_id(0);

	int k_idx = get_group_id(0) * (MLO_N_LCL_OUT_MAPS); // output map index base

	int c_idx = get_group_id(1) * (MLO_N_LCL_IN_MAPS * MLO_N_MAPS_PER_GROUP); // input map index based

	int ib = get_group_id(2); // batch id

	int gbl_in_off = c_idx * MLO_IN_CHANNEL_STRIDE + ib * MLO_IN_BATCH_STRIDE;
	int gbl_out_off = k_idx * MLO_OUT_CHANNEL_STRIDE + ib * MLO_OUT_BATCH_STRIDE;

#define MLO_TOP_DAT_SZ (MLO_N_LCL_OUT_MAPS* MLO_READ_UNIT)

	__private _FLOAT top_dat[MLO_TOP_DAT_SZ];

#define MLO_BOT_DAT_SZ (MLO_N_LCL_IN_MAPS * MLO_READ_UNIT)

	__private _FLOAT bot_dat[MLO_BOT_DAT_SZ];

#define MLO_ACCUM_SZ (MLO_N_LCL_OUT_MAPS* MLO_N_LCL_IN_MAPS)

	__private _FLOAT pvt_accum[MLO_ACCUM_SZ];

	for (int i = 0; i < MLO_ACCUM_SZ; ++i)
	{
		pvt_accum[i] = 0;
	}

	for (int i = lcl_id; i < MLO_LCL_MEM_SZ; i += MLO_GRP_SZ)
	{
		lcl_mem[i] = 0;
	}

// map id inside the group, super-pixel inside the map
#if (MLO_MAP_WK_SZ &  (MLO_MAP_WK_SZ - 1))

	int m_id = iDiv(lcl_id, MLO_MAP_WK_SZ);  // map
	int p4 = iMod(lcl_id, m_id, MLO_MAP_WK_SZ); // pixel
#else
	int m_id = ((uint)lcl_id / MLO_MAP_WK_SZ);  // map
	int p4 = ((uint)lcl_id & (MLO_MAP_WK_SZ - 1)); // pixel

#endif

	gbl_in_off += p4 * MLO_READ_UNIT;
//	gbl_out_off += p4 * MLO_READ_UNIT;
// input is kept in registers at the start
	gbl_in_off += m_id * MLO_IN_CHANNEL_STRIDE;

	bool last_pixel = (p4 == MLO_MAP_WK_SZ - 1);
// inside input range
	bool inside_map_range_input = ((c_idx + m_id) < MLO_N_INPUTS && m_id < MLO_N_MAPS_PER_GROUP);
	bool inside_range_input = (p4 < MLO_MAP_WK_SZ &&  inside_map_range_input);

	// inside output range
	bool inside_range_output = (p4 < MLO_MAP_WK_SZ);

	for (int b = 0; b < MLO_BATCH_SZ; ++b, gbl_in_off += MLO_IN_BATCH_STRIDE, gbl_out_off += MLO_OUT_BATCH_STRIDE)
	{

		// read all inputs into registers
		int bot_off = gbl_in_off;

#if MLO_N_PIXS_OFF > 0

			if (last_pixel)
			{
				for (int c = 0; c < MLO_N_LCL_IN_MAPS; ++c, bot_off += MLO_N_MAPS_PER_GROUP*MLO_IN_CHANNEL_STRIDE)
				{

					// reading in order per group and jump over maps been read
					// read arbitrary data but inside the range

					bool inside_range_input2 = inside_range_input && ((c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS);

					bot_off = (inside_range_input2) ? bot_off : 0;

					for (int i = 0; i < MLO_N_PIXS_OFF; ++i)
					{
						bot_dat[c*MLO_READ_UNIT + i] = bot[bot_off + i];
					}
					for (int i = MLO_N_PIXS_OFF; i < MLO_READ_UNIT; ++i)
					{
						bot_dat[c*MLO_READ_UNIT + i] = 0;
					}

				}

			}
			else
#endif
			{
				// check
				for (int c = 0; c < MLO_N_LCL_IN_MAPS; ++c, bot_off += MLO_N_MAPS_PER_GROUP*MLO_IN_CHANNEL_STRIDE)
				{
					// reading in order per group and jump over maps been read
					// read arbitrary data but inside the range

					bool inside_range_input2 = inside_range_input && ((c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS);

					bot_off = (inside_range_input2) ? bot_off : 0;

					for (int i = 0; i < MLO_READ_UNIT; ++i)
					{
						bot_dat[c*MLO_READ_UNIT + i] = bot[bot_off + i];
					}

				}

			} // if (last_pixel)

//			int top_off = (inside_range_output) ? gbl_out_off : 0;

		int top_off = gbl_out_off;

		// read all outputs
		// assum division by MLO_N_LCL_OUT
		for (int kb = 0; kb < MLO_N_LCL_OUT; kb++, top_off += MLO_OUT_LCL_BLK * MLO_OUT_CHANNEL_STRIDE)
		{

			barrier(CLK_LOCAL_MEM_FENCE);

			for (int p = lcl_id; p < MLO_OUT_LCL_BLK * MLO_MAP_WK_SZ; p += MLO_GRP_SZ)
			{
#if (MLO_MAP_WK_SZ & (MLO_MAP_WK_SZ - 1))
				int m = iDiv(p, MLO_MAP_WK_SZ);
				int pm = iMod(p, m, MLO_MAP_WK_SZ);
#else
				int m = ((uint)p / MLO_MAP_WK_SZ);
				int pm = ((uint)p & (MLO_MAP_WK_SZ - 1));
#endif

				int top_off1 = top_off + m * MLO_OUT_CHANNEL_STRIDE + pm*MLO_READ_UNIT;
#if MLO_N_OUT_MAPS_ALIGNED == 0
				top_off1 = (k_idx + m < MLO_N_OUTPUTS) ? top_off1 : 0;
#endif
#if MLO_N_PIXS_OFF > 0
				if (pm == MLO_MAP_WK_SZ - 1)
				{
					for (int i = 0; i < MLO_N_PIXS_OFF; ++i)
					{
						lcl_mem[p*MLO_READ_UNIT + i] = top_df[top_off1 + i];
					}
					for (int i = MLO_N_PIXS_OFF; i < MLO_READ_UNIT; ++i)
					{
						lcl_mem[p*MLO_READ_UNIT + i] = 0;
					}

				}
				else

#endif
				{
					for (int i = 0; i < MLO_READ_UNIT; ++i)
					{
						lcl_mem[p*MLO_READ_UNIT + i] = top_df[top_off1 + i];

					}
				}

			} // for(int p = 0; p < MLO_OUT_LCL_BLK * MLO_MAP_WK_SZ; p += MLO_GRP_SZ)

			barrier(CLK_LOCAL_MEM_FENCE);

			for (int k = kb*MLO_OUT_LCL_BLK; k < (kb + 1)*MLO_OUT_LCL_BLK; ++k)
			{
				// processing
				for (int c = 0; c < MLO_N_LCL_IN_MAPS; ++c)
				{
					for (int i = 0; i < MLO_READ_UNIT; ++i)
					{
						_FLOAT bot_val = bot_dat[c*MLO_READ_UNIT + i];
						_FLOAT top_val = lcl_mem[((k - kb*MLO_OUT_LCL_BLK) * MLO_MAP_WK_SZ + p4)*MLO_READ_UNIT + i];
						pvt_accum[k * MLO_N_LCL_IN_MAPS + c] += top_val * bot_val;
#if 0
						if (top_val * bot_val !=0  &&  k == 0 && c == 0 && m_id == 0 && get_group_id(0) == 0 && get_group_id(1) == 1 && lcl_id ==0 )
						{

							printf("K:c: %d %d %d %d %f %f %f %f\n",
								c_idx + m_id + c*MLO_N_MAPS_PER_GROUP,
								lcl_id,
								c*MLO_READ_UNIT + i,
								((k - kb*MLO_OUT_LCL_BLK) * MLO_MAP_WK_SZ + p4)*MLO_READ_UNIT + i,
								pvt_accum[k * MLO_N_LCL_IN_MAPS + c],
								top_val * bot_val,
								bot_val,
								top_val

							);
						}

#endif

					}
				}
			}

		} // for(int kb = 0; kb < MLO_N_LCL_OUT; kb++, top_off += MLO_OUT_LCL_BLK * MLO_OUT_CHANNEL_STRIDE)
	} // for (int b = 0; b < MLO_BATCH_SZ; ++b, gbl_in_off += MLO_IN_BATCH_STRIDE, gbl_out_off += MLO_OUT_BATCH_STRIDE)

	// write out
	// inputs are outputs
	int wei_df_off = ((ib * MLO_N_OUTPUTS + k_idx) * (int)MLO_WEI_BATCH_STRIDE) + (c_idx + m_id) * MLO_WEI_CHANNEL_STRIDE;

// final summation optimized.

#define MLO_N_FIRST_SPLITS  (1 << (MLO_LG2_REDUC_ROUNDS - 1))
// transpose data using MLO_REDUC_LOOP_STEP wk-items from each small map
	__private _FLOAT final_sum[(MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP)];

#if 1 // MLO_LG2_REDUC_ROUNDS > 1
// first round
// transpose and split into sub-group for logar summation
	for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
	{
		final_sum[r] = 0;

		barrier(CLK_LOCAL_MEM_FENCE);
// write out only valid pixels
#if MLO_MAP_WK_SZ < MLO_GRP_SZ
		if (lcl_id < MLO_N_MAPS_PER_GROUP*MLO_MAP_WK_SZ)
#endif

		{

			for (int rr = 0; rr < MLO_REDUC_LOOP_STEP; ++rr)
			{
				lcl_mem[lcl_id*MLO_REDUC_LOOP_STEP + rr] = pvt_accum[r*MLO_REDUC_LOOP_STEP + rr];
			}
		}
		barrier(CLK_LOCAL_MEM_FENCE);

		if (p4 < (MLO_REDUC_LOOP_STEP<< (MLO_LG2_REDUC_ROUNDS - 1)))
		{
			// what split the pix belong to
#if (MLO_REDUC_LOOP_STEP && (MLO_REDUC_LOOP_STEP -1))
			int split = iDiv(p4, MLO_REDUC_LOOP_STEP);
			int split_pix = iMod(p4, split, MLO_REDUC_LOOP_STEP);
#else
			int split = ((uint)p4 / MLO_REDUC_LOOP_STEP);
			int split_pix = ((uint)p4 & (MLO_REDUC_LOOP_STEP - 1));
#endif

			for (int j = 0; j < MLO_FIRST_ROUND; j++)
			{
#if MLO_FIRST_CAN_DIVIDE ==0
				if (split*MLO_FIRST_ROUND + j < MLO_MAP_WK_SZ)
#endif
				{
					final_sum[r] += lcl_mem[(m_id*MLO_MAP_WK_SZ + split*MLO_FIRST_ROUND + j)*MLO_REDUC_LOOP_STEP + split_pix];
				}
			}

		}
	}

#if MLO_LG2_REDUC_ROUNDS > 1
// log summation
	for (int rd = (MLO_LG2_REDUC_ROUNDS - 2); rd >= 0; --rd)
	{

		barrier(CLK_LOCAL_MEM_FENCE);
		if (p4 < (MLO_REDUC_LOOP_STEP << (rd + 1)))
		{
			for (int rr = 0; rr < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++rr)
			{
				lcl_mem[(rr*MLO_N_MAPS_PER_GROUP + m_id)*MLO_REDUC_LOOP_STEP*(1 << (rd + 1)) + p4] = final_sum[rr];
			}
		}
		barrier(CLK_LOCAL_MEM_FENCE);

		if (p4 < (MLO_REDUC_LOOP_STEP << rd))
		{
			for (int rr = 0; rr < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++rr)
			{
				final_sum[rr] += lcl_mem[(rr*MLO_N_MAPS_PER_GROUP + m_id)*MLO_REDUC_LOOP_STEP*(1 << (rd + 1)) + (MLO_REDUC_LOOP_STEP << rd) + p4];
			}
		}
	}

#endif

	if (p4 < MLO_REDUC_LOOP_STEP)
	{
		for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
		{
			int wei_idx = r* (MLO_REDUC_LOOP_STEP)+p4;

#if (MLO_N_LCL_IN_MAPS & (MLO_N_LCL_IN_MAPS - 1))
			int k = iDiv(wei_idx, MLO_N_LCL_IN_MAPS);
			int c = iMod(wei_idx, k, MLO_N_LCL_IN_MAPS);
#else
			int k = ((uint)wei_idx / MLO_N_LCL_IN_MAPS);
			int c = ((uint)wei_idx & (MLO_N_LCL_IN_MAPS - 1));
#endif

			if (m_id < MLO_N_MAPS_PER_GROUP && (c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS
#if MLO_N_OUT_MAPS_ALIGNED == 0
				&& k_idx + k < MLO_N_OUTPUTS
#endif
				)
			{
				int wei_off = wei_df_off + k*MLO_WEI_BATCH_STRIDE + c*MLO_N_MAPS_PER_GROUP*MLO_WEI_CHANNEL_STRIDE;
				weights_df[wei_off] = final_sum[r];
			}

		} // for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
	} // if (p4 < MLO_REDUC_LOOP_STEP)

#elif 1
//	if (inside_range_input)
	{
		for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
		{
			final_sum[r] = 0;

			barrier(CLK_LOCAL_MEM_FENCE);

			for (int rr = 0; rr < MLO_REDUC_LOOP_STEP; ++rr)
			{
				lcl_mem[lcl_id*MLO_REDUC_LOOP_STEP + rr] = pvt_accum[r*MLO_REDUC_LOOP_STEP + rr];
			}
			barrier(CLK_LOCAL_MEM_FENCE);

			if (p4 < MLO_REDUC_LOOP_STEP)
			{
				for (int j = 0; j < MLO_MAP_WK_SZ; j++)
				{
					final_sum[r] += lcl_mem[(m_id*MLO_MAP_WK_SZ + j)*MLO_REDUC_LOOP_STEP + p4];
				}

			}
		}

		if (p4 < MLO_REDUC_LOOP_STEP)
		{
			for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
			{
				int wei_idx = r* ( MLO_REDUC_LOOP_STEP) + p4;

#if (MLO_N_LCL_IN_MAPS & (MLO_N_LCL_IN_MAPS - 1))
				int k = iDiv(wei_idx, MLO_N_LCL_IN_MAPS);
				int c = iMod(wei_idx, k, MLO_N_LCL_IN_MAPS);
#else
				int k = ((uint)wei_idx / MLO_N_LCL_IN_MAPS);
				int c = ((uint)wei_idx & (MLO_N_LCL_IN_MAPS-1));
#endif

				if (m_id < MLO_N_MAPS_PER_GROUP && (c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS
#if MLO_N_OUT_MAPS_ALIGNED == 0
					&& k_idx + k < MLO_N_OUTPUTS
#endif
					)
				{
					int wei_off = wei_df_off + k*MLO_WEI_BATCH_STRIDE + c*MLO_N_MAPS_PER_GROUP*MLO_WEI_CHANNEL_STRIDE;
					weights_df[wei_off] = final_sum[r];
				}

			} // for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
		} // if (p4 < MLO_REDUC_LOOP_STEP)
	} // if (inside_range_input)
#else
	for (int r = 0; r < (MLO_ACCUM_SZ / MLO_REDUC_LOOP_STEP); ++r)
	{
		barrier(CLK_LOCAL_MEM_FENCE);

		for (int rr = 0; rr < MLO_REDUC_LOOP_STEP; ++rr)
		{
			lcl_mem[lcl_id*MLO_REDUC_LOOP_STEP + rr] = pvt_accum[r*MLO_REDUC_LOOP_STEP + rr];
		}
		barrier(CLK_LOCAL_MEM_FENCE);

		if (p4 == 0 && inside_range_input)
		{
			for (int j = 1; j < MLO_MAP_WK_SZ; j++)
			{
				for (int rr = 0; rr < MLO_REDUC_LOOP_STEP; ++rr)
				{
					pvt_accum[r*MLO_REDUC_LOOP_STEP + rr] += lcl_mem[(lcl_id + j)*MLO_REDUC_LOOP_STEP + rr];
				}
			}
		}
	}

	if (p4 == 0)
	{
		for (int kb = 0; kb < MLO_N_LCL_OUT; kb++)
		{
			for (int k = kb*MLO_OUT_LCL_BLK; k < (kb + 1)*MLO_OUT_LCL_BLK; ++k)
			{
				for (int c = 0; c < MLO_N_LCL_IN_MAPS; ++c)
				{
					if ( (c_idx + m_id + c*MLO_N_MAPS_PER_GROUP) < MLO_N_INPUTS
#if MLO_N_OUT_MAPS_ALIGNED == 0
						  && k_idx + k < MLO_N_OUTPUTS
#endif
						)
					{
						int wei_off = wei_df_off + k*MLO_WEI_BATCH_STRIDE + c*MLO_N_MAPS_PER_GROUP*MLO_WEI_CHANNEL_STRIDE;
						weights_df[wei_off] = pvt_accum[k*MLO_N_LCL_IN_MAPS + c];
					}

				}

			}
		}

	}

#endif

}


don't really need that. Looks mostly stable, although needs more basic drawing functions, and more events.

(load "base.cl")
(load "repl-config.cl")

(declaim #+sbcl(sb-ext:muffle-conditions style-warning))
(declaim #+sbcl(sb-ext:muffle-conditions warning))

(in-package arboreta)

(setf *random-state* (make-random-state t))

(defparameter *cursor-blink-status* t)
(defparameter *cursor-blink-time* 0)
(defparameter *cursor-blink-delay* 1000)

;; descriptive function names, huh?
(defun cat (list)
   (format nil "~{~a~}" list))

(defmacro cats (&rest rest)
   `(cat (list ,@rest)))

(defun catn (list)
   (format nil "~{~a~%~}" list))

(defmacro catans (&rest rest)
   `(catn (list ,@rest)))

(defun cursor-blink-timer ()
   (let ((time (get-internal-real-time)))
         (when (>= time *cursor-blink-time*)
               (setf *cursor-blink-status* (not *cursor-blink-status*))
               (setf *cursor-blink-time* (+ (get-internal-real-time) *cursor-blink-delay*))
               (setf *buffer-needs-update* t))))

(defparameter *last-scroll-value* 0)
(defparameter *scroll-fade-timer* 0)

(defparameter *scroll-fade-delay* 1500)
(defparameter *scroll-fade-time* 500)

(defparameter *scroll-status* 'hidden)

(defun scrollbar-fade-timer ()
   (let ((ct (get-internal-real-time)))
      (case *scroll-status*
         (active
            (when (> ct (+ *scroll-fade-timer* *scroll-fade-delay*))
                  (setf *scroll-status* 'fade)))
         (fade
            (setf *scrollbar-opacity*
               (- 0 (/ (- ct (+ *scroll-fade-timer* *scroll-fade-delay* *scroll-fade-time*)) (* 2 *scroll-fade-time*))))
            (setf *buffer-needs-update* t)
            (when (> ct (+ *scroll-fade-timer* *scroll-fade-delay* *scroll-fade-time*))
                  (setf *scroll-status* 'hidden)))
         (hidden
            (setf *scrollbar-opacity* 0)))
    (when (not (eql *last-scroll-value* *scroll-offset*))
          (setf *scroll-fade-timer* ct)
          (setf *scroll-status* 'active)
          (setf *scrollbar-opacity* 0.5)
          (setf *buffer-needs-update* t))
    (setf *last-scroll-value* *scroll-offset*)))

(defun repl-update-loop ()
   (iter (for x = (+ (get-internal-real-time) 20))
         (cursor-blink-timer)
         (scrollbar-fade-timer)
         (when *buffer-needs-update*
            (draw root-window)
            (cairo::refresh context)
            (setf *buffer-needs-update* nil))
         (iter (while (cairo::handle-event context)))
         (sleep (let ((delay (/ (- x (get-internal-real-time)) 1000)))
                      ;; (print (* 1000.0 delay))
                      (if (> delay 0) delay 0)))))

(defparameter *current-input* "")
(defparameter *cursor-index* 0)
(defparameter *buffer-needs-update* t)

(defun editor-insert (str)
   (setf *current-input*
      (concatenate 'string
         (subseq *current-input* 0 *cursor-index*)
         str
         (subseq *current-input* *cursor-index*)))
   (incf *cursor-index* (length str)))

(defun editor-delete-char ()
   (setf *current-input*
      (concatenate 'string
         (subseq *current-input* 0 (- *cursor-index* 1))
         (subseq *current-input* *cursor-index*)))
   (decf *cursor-index*))

(defun simple-eval ()
   (let* ((str (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t))
          (res (with-output-to-string (stream str)
                 (let* ((*standard-output* stream)
                        (val (format nil "~s" (ignore-errors (eval (read-from-string *current-input*))))))
                        (list val str)))))
          `((,(alexandria:copy-sequence 'string *current-input*) ,@res))))

(defun handle-repl-key-events ()
   (iter (for x = (+ (get-internal-real-time) 17))
      (if *key-events*
         (let ((kev (pop *key-events*)))
               (setf *cursor-blink-status* t)
               (setf *cursor-blink-time* (+ (get-internal-real-time) *cursor-blink-delay*))

               (setf *buffer-needs-update* t)
               (when (and (eql (keypress-code kev) 113) (eql (keypress-mods kev) 4)) ;; C-q
                     (cairo:destroy context)
                     (sb-ext:exit))
               (when (and (eql (keypress-code kev) 97) (eql (keypress-mods kev) 4)) ;; C-a
                     (setf *cursor-index* 0) (center-view))
               (when (and (eql (keypress-code kev) 101) (eql (keypress-mods kev) 4)) ;; C-e
                     (setf *cursor-index* (length *current-input*)) (center-view))
               (when (and (eql (keypress-code kev) 108) (eql (keypress-mods kev) 4)) ;; C-l
                     (setf *scroll-offset* *max-scroll*))
               (alexandria::switch ((keypress-str kev) :test #'equalp)
                  ("Return" (alexandria:appendf *buffer-history* (simple-eval))
                            (setf *current-input* "")
                            (setf *cursor-index* 0)
                            (center-view))
                  ("left" (unless (eql *cursor-index* 0) (decf *cursor-index*)))
                  ("right" (unless (eql *cursor-index* (length *current-input*)) (incf *cursor-index*)))
                  ("up" nil)
                  ("down" nil)
                  ("Shift_L" nil)
                  ("Control_L" nil)
                  ("Control_R" nil)
                  ("Shift_R" nil)
                  ("BackSpace" (center-view)
                     (when (and (not (eql *cursor-index* 0)) (> (length *current-input*) 0))
                           (editor-delete-char)))
                  (otherwise
                     (center-view)
                     (when (<= #x20 (keypress-code kev) #x13be) ;; latin chars
                        (editor-insert (if (> (length (keypress-str kev)) 1)
                                         (string (code-char (keypress-code kev)))
                                         (keypress-str kev))))))))
      (sleep (let ((delay (/ (- x (get-internal-real-time)) 1000)))
                   ;; (print (* 1000.0 delay))
                   (if (> delay 0) delay 0)))))

;; DO NOT DELETE THIS CODE
;; it took me too long to make work correctly
(defparameter *scroll-friction* 0.7)
(defparameter *scroll-acceleration* 0) ;; px/frame^2
(defparameter *scroll-velocity* 0)     ;; px/frame

(defun handle-repl-mouse-events ()
   (iter (for x = (+ (get-internal-real-time) 17))
      (when (or (> (abs *scroll-velocity*) 1) (> (abs *scroll-acceleration*) 1))
       (setf *scroll-acceleration* (alexandria:clamp (* *scroll-acceleration* *scroll-friction*) -15 15))
       (setf *scroll-velocity* (* *scroll-friction* (+ *scroll-velocity* *scroll-acceleration*)))
       (setf *scroll-offset* (alexandria:clamp (+ *scroll-offset* *scroll-velocity*) *min-scroll* *max-scroll*))
       (setf *buffer-needs-update* t))
      (if *mouse-events*
         (let ((kev (pop *mouse-events*)))
               (when (eql (second kev) 4)
                     (decf *scroll-acceleration* 4)
                     (setf *scroll-acceleration* (* *scroll-acceleration* 1.2)))
               (when (eql (second kev) 5)
                     (incf *scroll-acceleration* 4)
                     (setf *scroll-acceleration* (* *scroll-acceleration* 1.2)))))
      (sleep (let ((delay (/ (- x (get-internal-real-time)) 1000)))
                   ;; (print (* 1000.0 delay))
                   (if (> delay 0) delay 0)))))

(defun get-block (index size seq)
   (nth index
      (iter (for x from 0 to (length seq) by size)
            (for y from size to (length seq) by size)
            (collect (subseq seq x y)))))

(defun set-hex-color (hex)
   (let ((colors (mapcar (lambda (x) (/ (parse-integer x :radix 16) 256))
                         (iter (for i from 0 to 2) (collect (get-block i 2 hex))))))
         (set-source-rgb (first colors) (second colors) (third colors))))

(defun basic-write (str color x y)
   (let ((pango-layout (pango:pango_cairo_create_layout (slot-value cairo:*context* 'cairo::pointer))))
         (pango:pango_layout_set_font_description pango-layout font)

         (new-path)
         (move-to x y)
         (set-hex-color color)
         (pango:pango_layout_set_text pango-layout str -1)

         (pango:pango_cairo_update_layout (slot-value *context* 'cairo::pointer) pango-layout)
         (pango:pango_cairo_show_layout (slot-value *context* 'cairo::pointer) pango-layout)
         (pango:g_object_unref pango-layout)))

;; (prompt result printed)
(defparameter *buffer-history* nil)

(defun line-count (str)
   (if (equalp str "")
       0
       (+ 1 (iter (for c in-string (string-trim '(#\Newline) str))
                  (counting (eql c #\newline))))))

(defun line-count* (str)
   (+ 1 (iter (for c in-string (string-trim '(#\Newline) str))
              (counting (eql c #\newline)))))

(defun paragraph-height (str)
   (* *font-height* (line-count str)))

(defun total-height (repl-result)
   (+ (prompt-height (first repl-result))
      (paragraph-height (second repl-result))
      (paragraph-height (third repl-result))))

(defun prompt-height (text)
   (+ (* 2 inner-padding) (* 2 outer-padding)
      (* *font-height* (line-count* text))))

(defparameter *font-height* 0)

(defparameter triangle-offset 0)
(defparameter outer-padding 0)
(defparameter inner-padding 0)
(defparameter prompt-offset 0)
(defparameter text-offset 0)

(defun draw-prompt-bg (y-offset)
   (when *draw-prompt-bg?*
      (new-path)
      (set-hex-color *prompt-bg-color*)
      (rectangle 0 (+ outer-padding y-offset) w (+ *font-height* (* 2 inner-padding)))
      (fill-path))

   (move-to 0 (+ outer-padding y-offset))
   (new-path)
   (set-hex-color *triangle-color*)
   (line-to (- (+ (ceiling (/ *font-height* 2)) (* 2 inner-padding)) triangle-offset)
            (+ y-offset outer-padding (ceiling (/ *font-height* 2)) (* 1 inner-padding)))
   (line-to (- triangle-offset) (+ y-offset outer-padding *font-height* (* 2 inner-padding)))
   (line-to (- triangle-offset) (+ outer-padding y-offset))
   (fill-path))

(defun draw-prompt (text y-offset)
   (draw-prompt-bg y-offset)

   (basic-write text *prompt-fg-color* prompt-offset (+ outer-padding inner-padding y-offset))
   (+ *font-height* (* 2 outer-padding) (* 2 inner-padding)))

(defun draw-current-prompt (text y-offset)
   (draw-prompt-bg y-offset)

   (let ((str text) (color *prompt-fg-color*) (x prompt-offset) (y (+ outer-padding inner-padding y-offset)))
      (let ((pango-layout (pango:pango_cairo_create_layout (slot-value cairo:*context* 'cairo::pointer))))
            (pango:pango_layout_set_font_description pango-layout font)

            (new-path)
            (move-to x y)
            (set-hex-color color)
            (pango:pango_layout_set_text pango-layout str -1)

            (pango:pango_cairo_update_layout (slot-value *context* 'cairo::pointer) pango-layout)
            (pango:pango_cairo_show_layout (slot-value *context* 'cairo::pointer) pango-layout)

            (when *cursor-blink-status*
               (new-path)
               (set-hex-color *prompt-fg-color*)
               (let ((cursor (pango:get-cursor-pos pango-layout *cursor-index*)))
                     (rectangle (+ (first cursor) prompt-offset 0) (+ (second cursor) outer-padding inner-padding y-offset)
                                (+ 0.5 (third cursor)) (fourth cursor)))
               (fill-path))
            (pango:g_object_unref pango-layout)))

   (+ *font-height* (* 2 outer-padding) (* 2 inner-padding)))

(defun draw-active-result (str y-offset)
   (incf y-offset (draw-current-prompt str y-offset)))

(defun draw-result (result y-offset)
   (incf y-offset (draw-prompt (first result) y-offset))
   (when (not (equalp (third result) ""))
         (basic-write (string-trim '(#\Newline) (third result)) *printed-fg-color* text-offset y-offset)
         (incf y-offset (paragraph-height (string-trim '(#\Newline) (third result)))))
   (basic-write (second result) *return-form-color* text-offset y-offset)
   (incf y-offset *font-height*))

(defparameter *max-results* 50)
(defparameter *scroll-offset* 0) ;; how far down we're currently scrolled
(defparameter *min-scroll* 0)
(defparameter *max-scroll* 0)

(defun center-view ()
   (iter (for x in *buffer-history*)
         (sum (total-height x) into th)
         (finally
            (setf *max-scroll* th)
            (when (< (+ h *scroll-offset*) th)
                    (setf *scroll-offset*
                       (alexandria:clamp (+ (prompt-height *current-input*) (- *max-scroll* h))
                           *min-scroll* *max-scroll*))))))

;; actual space (+ *max-scroll* h)
;; viewport size
(defparameter *scrollbar-padding* 2)
(defparameter *scrollbar-opacity* 0.5)

(defun draw-scrollbar ()
   (when (eql *max-scroll* 0) (return-from draw-scrollbar))
   (let ((sb-start (round (* (- h (* 2 *scrollbar-padding*)) (/ *scroll-offset* (+ h *max-scroll*)))))
         (sb-end (round (* (- h (* 2 *scrollbar-padding*)) (/ (+ *scroll-offset* h) (+ h *max-scroll*))))))
      (set-source-rgba 0.1 0.1 0.1 *scrollbar-opacity*)
      (new-path)
      (rectangle (- w 8) (+ *scrollbar-padding* sb-start) 5 (- sb-end sb-start))
      (fill-path)))

;; start of viewport = *scroll-offset*
;; end of viewport = (+ *scroll-offset* h)
(defun draw-repl-body ()
   (iter (for x in *buffer-history*)
         (for rh = (total-height x))
         (when (or (< *scroll-offset* acc (+ *scroll-offset* h))
                   (< *scroll-offset* (+ acc rh)))
               (draw-result x (- acc *scroll-offset*)))
         (sum rh into acc)
         (finally
            (setf *max-scroll* acc)
            (when (or (< *scroll-offset* acc (+ *scroll-offset* h))
                      (< *scroll-offset* (+ acc (prompt-height *current-input*))))
                  (draw-active-result *current-input* (- acc *scroll-offset*))))))

;; get the font height by making a layout and then finding the cursor size
(defun pango-font-height-hack ()
   (let ((pango-layout (pango:pango_cairo_create_layout (slot-value cairo:*context* 'cairo::pointer)))
         (size 0))
     (pango:pango_layout_set_font_description pango-layout font)
     (setf size (fourth (pango:get-cursor-pos pango-layout 0)))
     (pango:g_object_unref pango-layout)
     size))

(defun font-scaled (n) (round (* *font-height* n)))

(defun pull-x-attribute (name)
   (cairo::x-get-defualt cairo::arboreta-display *xrm-application-name* name))

(defun hex-tint (amt hex)
   (let ((col (cl-colors:as-rgb hex)))
         (cl-colors:print-hex-rgb (cl-colors:rgb-combination col (cl-colors:as-rgb "FFFFFF") amt) :hash nil :destination nil)))

(defun handle-x-font (name)
   (when name
      (let* ((fields (cdr (cl-ppcre:split "-" name)))
             (family (nth 1 fields))
             (size (nth 6 fields)))
         (setf font
            (pango:pango_font_description_from_string
               (if (and size (not (equalp size "*")))
                   (cats family " " size)
                   (cats family))))
         (pango:pango_layout_set_font_description layout font)
         (setf *font-height* (+ 0 (pango-font-height-hack))))))

;; todo: make test to determine if light or dark theme from bg/fg, get white/black colors accordingly
(defun pull-x-resources ()
   ;; background and accent colors
   (setf *background-color* (subseq (pull-x-attribute "background") 1)) ;; base
   (setf *triangle-color* (subseq (pull-x-attribute "color4") 1)) ;; color accent 1
   (setf *prompt-bg-color*
      (hex-tint 0.05 (subseq (pull-x-attribute "background") 1))) ;; highlight 1
   ;; font colors
   (setf *prompt-fg-color* (subseq (pull-x-attribute "foreground") 1)) ;; text
   (setf *printed-fg-color* (subseq (pull-x-attribute "color7") 1)) ;; text highlight 1
   (setf *return-form-color* (subseq (pull-x-attribute "color15") 1)) ;; text highlight 2
   (handle-x-font (pull-x-attribute "font")))

(defparameter *default-font* "Fantasque Sans Mono 10")

(defun repl-test ()
   (setf layout (pango:pango_cairo_create_layout (slot-value cairo:*context* 'cairo::pointer)))
   (setf font (pango:pango_font_description_from_string *default-font*))
   (pango:pango_layout_set_font_description layout font)

   (setf *font-height* (+ 0 (pango-font-height-hack)))

   (sb-thread:make-thread 'handle-repl-key-events :name "keyevents-thread")
   (sb-thread:make-thread 'handle-repl-mouse-events :name "mouseevents-thread")

   (when *load-xresources?* (pull-x-resources))

   (setf triangle-offset (font-scaled 0.35))
   (setf outer-padding (font-scaled 0.25))
   (setf inner-padding (font-scaled 0.15))
   (setf prompt-offset (font-scaled 0.8))
   (setf text-offset prompt-offset)

   (unless *padding?*
      (setf outer-padding 0)
      (setf inner-padding 0)
      (setf triangle-offset (font-scaled 0.20)))

   (setf root-window
      (make-window :draw
         (lambda (window)
            (when *buffer-needs-update*
               (new-path)
               (set-hex-color *background-color*)
               (rectangle 0 0 w h)
               (fill-path)

               (draw-repl-body)
               (draw-scrollbar))
            (draw-subwindows window))))
   (repl-update-loop))

(defparameter *padding?* t)
(defparameter *load-xresources?* nil)
(defparameter *draw-prompt-bg?* t)
(defparameter *xrm-application-name* "arboreta-repl")
(defparameter *args* (cdr sb-ext:*posix-argv*))

;; todo: make general fixed-arity command-line handling library
(defun handle-arguments ()
   (when *args*
    (iter (for i from 0 to (- (length *args*) 1))
          (for x = (nth i *args*))
          (alexandria:switch (x :test #'equalp)
            ("--help"
               (princ (catans
                  "arboreta-repl command line options:"
                  "   --no-padding         display the prompt at normal line spacing"
                  "   --font (name)        font to render, ignored if used with --use-xresources"
                  "   --no-prompt-shading  disable background shading for the prompt"
                  "   --use-xresources     pull font and colors from x resource manager"
                  "   --xrm-name (name)    use x resource settings from a different application, such as URxtv"))
               (sb-ext:exit))
            ("--no-padding" (setf *padding?* nil))
            ("--no-prompt-shading" (setf *draw-prompt-bg?* nil))
            ("--use-xresources" (setf *load-xresources?* t))
            ("--xrm-name"
               (setf *xrm-application-name* (aif (nth (+ i 1) *args*) it (error "no path argument provided to --xrm-name")))
               (incf i))
            ("--font"
               (setf *default-font* (aif (nth (+ i 1) *args*) it (error "no font name argument provided to --font")))
               (incf i))
            (otherwise (warn "unrecognized command line argument '~a', ignoring" x))))))

(defun toplevel-start-render ()
   (handle-arguments)
   (setf context (cairo::create-arboreta-window w h))
   (setf surface (get-target context))
   (with-context (context)
      (repl-test)))

(toplevel-start-render)