OpenCL/OpenCL.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include <CL/opencl.h>

typedef cl_platform_id       OpenCL__Platform;
typedef cl_device_id         OpenCL__Device;
typedef cl_context           OpenCL__Context;
typedef cl_command_queue     OpenCL__Queue;

static const struct {
  IV iv;
  const char *name;
} cl_error[] = {
#define def_error(name) { (IV)CL_ ## name, # name },
#include "invalid.h"
};

static const char *
clstrerror (cl_int res)
{
  int i;
  static char numbuf [32];

  for (i = sizeof (cl_error) / sizeof (cl_error [0]); i--; )
    if (cl_error [i].iv == res)
      return cl_error [i].name;

  snprintf (numbuf, sizeof (numbuf), "ERROR(%d)", res);

  return numbuf;
}

#define FAIL(name,res) \
  croak (# name ": %s", clstrerror (res));

#define NEED_SUCCESS(name,args) \
  do { \
    cl_int res = name args; \
    \
    if (res) \
      FAIL (name, res); \
  } while (0)

MODULE = OpenCL         PACKAGE = OpenCL

BOOT:
{
        HV *stash = gv_stashpv ("OpenCL", 1);
        static const struct {
          const char *name;
          IV iv;
        } *civ, const_iv[] = {
#define const_iv(name) { # name, (IV)CL_ ## name },
#include "constiv.h"
        };
        for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ > const_iv; civ--)
          newCONSTSUB (stash, (char *)civ[-1].name, newSViv (civ[-1].iv));
}

void
platforms ()
        PPCODE:
{
        cl_platform_id *list;
        cl_uint count;
        int i;

        NEED_SUCCESS (clGetPlatformIDs, (0, 0, &count));
        Newx (list, count, cl_platform_id);
        NEED_SUCCESS (clGetPlatformIDs, (count, list, 0));

        EXTEND (SP, count);
        for (i = 0; i < count; ++i)
          PUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Platform", list [i]));

        Safefree (list);
}

void
context_from_type_simple (cl_device_type type = CL_DEVICE_TYPE_DEFAULT)
        PPCODE:
{
        cl_int res;
        cl_context ctx = clCreateContextFromType (0, type, 0, 0, &res);

        if (res)
          FAIL (clCreateContextFromType, res);

        XPUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Context", ctx));
}

MODULE = OpenCL         PACKAGE = OpenCL::Platform

void
info (OpenCL::Platform this, cl_platform_info name)
        PPCODE:
{
        size_t size;
        SV *sv;

        NEED_SUCCESS (clGetPlatformInfo, (this, name, 0, 0, &size));
        sv = sv_2mortal (newSV (size));
        SvUPGRADE (sv, SVt_PV);
        SvPOK_only (sv);
        SvCUR_set (sv, size);
        NEED_SUCCESS (clGetPlatformInfo, (this, name, size, SvPVX (sv), 0));
        XPUSHs (sv);
}

void
devices (OpenCL::Platform this, cl_device_type type = CL_DEVICE_TYPE_ALL)
        PPCODE:
{
        cl_device_id *list;
        cl_uint count;
        int i;

        NEED_SUCCESS (clGetDeviceIDs, (this, type, 0, 0, &count));
        Newx (list, count, cl_device_id);
        NEED_SUCCESS (clGetDeviceIDs, (this, type, count, list, 0));

        EXTEND (SP, count);
        for (i = 0; i < count; ++i)
          PUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Device", list [i]));

        Safefree (list);
}

void
context_from_type_simple (OpenCL::Platform this, cl_device_type type = CL_DEVICE_TYPE_DEFAULT)
        PPCODE:
{
        cl_int res;
        cl_context_properties props[] = { CL_CONTEXT_PLATFORM, (cl_context_properties)this, 0 };
        cl_context ctx = clCreateContextFromType (props, type, 0, 0, &res);

        if (res)
          FAIL (clCreateContextFromType, res);

        XPUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Context", ctx));
}

MODULE = OpenCL         PACKAGE = OpenCL::Device

void
info (OpenCL::Device this, cl_device_info name)
        PPCODE:
{
        size_t size;
        SV *sv;

        NEED_SUCCESS (clGetDeviceInfo, (this, name, 0, 0, &size));
        sv = sv_2mortal (newSV (size));
        SvUPGRADE (sv, SVt_PV);
        SvPOK_only (sv);
        SvCUR_set (sv, size);
        NEED_SUCCESS (clGetDeviceInfo, (this, name, size, SvPVX (sv), 0));
        XPUSHs (sv);
}

void
context_simple (OpenCL::Device this)
        PPCODE:
{
        cl_int res;
        cl_context ctx = clCreateContext (0, 1, &this, 0, 0, &res);

        if (res)
          FAIL (clCreateContext, res);

        XPUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Context", ctx));
}

MODULE = OpenCL         PACKAGE = OpenCL::Context

void
DESTROY (OpenCL::Context context)
        CODE:
        clReleaseContext (context);

void
info (OpenCL::Context this, cl_context_info name)
        PPCODE:
{
        size_t size;
        SV *sv;

        NEED_SUCCESS (clGetContextInfo, (this, name, 0, 0, &size));
        sv = sv_2mortal (newSV (size));
        SvUPGRADE (sv, SVt_PV);
        SvPOK_only (sv);
        SvCUR_set (sv, size);
        NEED_SUCCESS (clGetContextInfo, (this, name, size, SvPVX (sv), 0));
        XPUSHs (sv);
}

void
command_queue_simple (OpenCL::Context this, OpenCL::Device device)
        PPCODE:
{
        cl_int res;
        cl_command_queue queue = clCreateCommandQueue (this, device, 0, &res);

        if (res)
          FAIL (clCreateCommandQueue, res);

        XPUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Queue", queue));
}

MODULE = OpenCL         PACKAGE = OpenCL::Queue

void
DESTROY (OpenCL::Queue this)
        CODE:
        clReleaseCommandQueue (this);

void
info (OpenCL::Queue this, cl_command_queue_info name)
        PPCODE:
{
        size_t size;
        SV *sv;

        NEED_SUCCESS (clGetCommandQueueInfo, (this, name, 0, 0, &size));
        sv = sv_2mortal (newSV (size));
        SvUPGRADE (sv, SVt_PV);
        SvPOK_only (sv);
        SvCUR_set (sv, size);
        NEED_SUCCESS (clGetCommandQueueInfo, (this, name, size, SvPVX (sv), 0));
        XPUSHs (sv);
}

Revision:	1.1
Committed:	Tue Nov 15 06:50:30 2011 UTC (12 years, 6 months ago) by root
Branch:	MAIN
CVS Tags:	rel-0_01
Log Message:	0.01
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5			#include <CL/opencl.h>
6
7			typedef cl_platform_id OpenCL__Platform;
8			typedef cl_device_id OpenCL__Device;
9			typedef cl_context OpenCL__Context;
10			typedef cl_command_queue OpenCL__Queue;
11
12			static const struct {
13			IV iv;
14			const char *name;
15			} cl_error[] = {
16			#define def_error(name) { (IV)CL_ ## name, # name },
17			#include "invalid.h"
18			};
19
20			static const char *
21			clstrerror (cl_int res)
22			{
23			int i;
24			static char numbuf [32];
25
26			for (i = sizeof (cl_error) / sizeof (cl_error [0]); i--; )
27			if (cl_error [i].iv == res)
28			return cl_error [i].name;
29
30			snprintf (numbuf, sizeof (numbuf), "ERROR(%d)", res);
31
32			return numbuf;
33			}
34
35			#define FAIL(name,res) \
36			croak (# name ": %s", clstrerror (res));
37
38			#define NEED_SUCCESS(name,args) \
39			do { \
40			cl_int res = name args; \
41			\
42			if (res) \
43			FAIL (name, res); \
44			} while (0)
45
46			MODULE = OpenCL PACKAGE = OpenCL
47
48			BOOT:
49			{
50			HV *stash = gv_stashpv ("OpenCL", 1);
51			static const struct {
52			const char *name;
53			IV iv;
54			} *civ, const_iv[] = {
55			#define const_iv(name) { # name, (IV)CL_ ## name },
56			#include "constiv.h"
57			};
58			for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ > const_iv; civ--)
59			newCONSTSUB (stash, (char *)civ[-1].name, newSViv (civ[-1].iv));
60			}
61
62			void
63			platforms ()
64			PPCODE:
65			{
66			cl_platform_id *list;
67			cl_uint count;
68			int i;
69
70			NEED_SUCCESS (clGetPlatformIDs, (0, 0, &count));
71			Newx (list, count, cl_platform_id);
72			NEED_SUCCESS (clGetPlatformIDs, (count, list, 0));
73
74			EXTEND (SP, count);
75			for (i = 0; i < count; ++i)
76			PUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Platform", list [i]));
77
78			Safefree (list);
79			}
80
81			void
82			context_from_type_simple (cl_device_type type = CL_DEVICE_TYPE_DEFAULT)
83			PPCODE:
84			{
85			cl_int res;
86			cl_context ctx = clCreateContextFromType (0, type, 0, 0, &res);
87
88			if (res)
89			FAIL (clCreateContextFromType, res);
90
91			XPUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Context", ctx));
92			}
93
94			MODULE = OpenCL PACKAGE = OpenCL::Platform
95
96			void
97			info (OpenCL::Platform this, cl_platform_info name)
98			PPCODE:
99			{
100			size_t size;
101			SV *sv;
102
103			NEED_SUCCESS (clGetPlatformInfo, (this, name, 0, 0, &size));
104			sv = sv_2mortal (newSV (size));
105			SvUPGRADE (sv, SVt_PV);
106			SvPOK_only (sv);
107			SvCUR_set (sv, size);
108			NEED_SUCCESS (clGetPlatformInfo, (this, name, size, SvPVX (sv), 0));
109			XPUSHs (sv);
110			}
111
112			void
113			devices (OpenCL::Platform this, cl_device_type type = CL_DEVICE_TYPE_ALL)
114			PPCODE:
115			{
116			cl_device_id *list;
117			cl_uint count;
118			int i;
119
120			NEED_SUCCESS (clGetDeviceIDs, (this, type, 0, 0, &count));
121			Newx (list, count, cl_device_id);
122			NEED_SUCCESS (clGetDeviceIDs, (this, type, count, list, 0));
123
124			EXTEND (SP, count);
125			for (i = 0; i < count; ++i)
126			PUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Device", list [i]));
127
128			Safefree (list);
129			}
130
131			void
132			context_from_type_simple (OpenCL::Platform this, cl_device_type type = CL_DEVICE_TYPE_DEFAULT)
133			PPCODE:
134			{
135			cl_int res;
136			cl_context_properties props[] = { CL_CONTEXT_PLATFORM, (cl_context_properties)this, 0 };
137			cl_context ctx = clCreateContextFromType (props, type, 0, 0, &res);
138
139			if (res)
140			FAIL (clCreateContextFromType, res);
141
142			XPUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Context", ctx));
143			}
144
145			MODULE = OpenCL PACKAGE = OpenCL::Device
146
147			void
148			info (OpenCL::Device this, cl_device_info name)
149			PPCODE:
150			{
151			size_t size;
152			SV *sv;
153
154			NEED_SUCCESS (clGetDeviceInfo, (this, name, 0, 0, &size));
155			sv = sv_2mortal (newSV (size));
156			SvUPGRADE (sv, SVt_PV);
157			SvPOK_only (sv);
158			SvCUR_set (sv, size);
159			NEED_SUCCESS (clGetDeviceInfo, (this, name, size, SvPVX (sv), 0));
160			XPUSHs (sv);
161			}
162
163			void
164			context_simple (OpenCL::Device this)
165			PPCODE:
166			{
167			cl_int res;
168			cl_context ctx = clCreateContext (0, 1, &this, 0, 0, &res);
169
170			if (res)
171			FAIL (clCreateContext, res);
172
173			XPUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Context", ctx));
174			}
175
176			MODULE = OpenCL PACKAGE = OpenCL::Context
177
178			void
179			DESTROY (OpenCL::Context context)
180			CODE:
181			clReleaseContext (context);
182
183			void
184			info (OpenCL::Context this, cl_context_info name)
185			PPCODE:
186			{
187			size_t size;
188			SV *sv;
189
190			NEED_SUCCESS (clGetContextInfo, (this, name, 0, 0, &size));
191			sv = sv_2mortal (newSV (size));
192			SvUPGRADE (sv, SVt_PV);
193			SvPOK_only (sv);
194			SvCUR_set (sv, size);
195			NEED_SUCCESS (clGetContextInfo, (this, name, size, SvPVX (sv), 0));
196			XPUSHs (sv);
197			}
198
199			void
200			command_queue_simple (OpenCL::Context this, OpenCL::Device device)
201			PPCODE:
202			{
203			cl_int res;
204			cl_command_queue queue = clCreateCommandQueue (this, device, 0, &res);
205
206			if (res)
207			FAIL (clCreateCommandQueue, res);
208
209			XPUSHs (sv_setref_pv (sv_newmortal (), "OpenCL::Queue", queue));
210			}
211
212			MODULE = OpenCL PACKAGE = OpenCL::Queue
213
214			void
215			DESTROY (OpenCL::Queue this)
216			CODE:
217			clReleaseCommandQueue (this);
218
219			void
220			info (OpenCL::Queue this, cl_command_queue_info name)
221			PPCODE:
222			{
223			size_t size;
224			SV *sv;
225
226			NEED_SUCCESS (clGetCommandQueueInfo, (this, name, 0, 0, &size));
227			sv = sv_2mortal (newSV (size));
228			SvUPGRADE (sv, SVt_PV);
229			SvPOK_only (sv);
230			SvCUR_set (sv, size);
231			NEED_SUCCESS (clGetCommandQueueInfo, (this, name, size, SvPVX (sv), 0));
232			XPUSHs (sv);
233			}
234