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
#	Content
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