ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/OpenCL/OpenCL.xs
(Generate patch)

Comparing OpenCL/OpenCL.xs (file contents):
Revision 1.70 by root, Sat May 5 02:33:55 2012 UTC vs.
Revision 1.71 by root, Sat May 5 02:45:38 2012 UTC

… …
57typedef cl_kernel OpenCL__Kernel; 57typedef cl_kernel OpenCL__Kernel;
58typedef cl_event OpenCL__Event; 58typedef cl_event OpenCL__Event;
59typedef cl_event OpenCL__UserEvent; 59typedef cl_event OpenCL__UserEvent;
60 60
61typedef struct mapped * OpenCL__Mapped; 61typedef struct mapped * OpenCL__Mapped;
62
63typedef SV *FUTURE;
64 62
65static HV 63static HV
66 *stash_platform, 64 *stash_platform,
67 *stash_device, 65 *stash_device,
68 *stash_subdevice, 66 *stash_subdevice,
… …
246#define XPUSH_CLOBJ(stash,id) XPUSHs (new_clobj ((stash), (IV)(id))) 244#define XPUSH_CLOBJ(stash,id) XPUSHs (new_clobj ((stash), (IV)(id)))
247 245
248/* cl objects are either \$iv, or [$iv, ...] */ 246/* cl objects are either \$iv, or [$iv, ...] */
249/* they can be upgraded at runtime to the array form */ 247/* they can be upgraded at runtime to the array form */
250static void * ecb_noinline 248static void * ecb_noinline
251SvCLOBJ (const char *func, const char *svname, SV *sv, const char *pkg) 249SvCLOBJ (CV *cv, const char *svname, SV *sv, const char *pkg)
252{ 250{
253 // sv_derived_from is quite slow :( 251 // sv_derived_from is quite slow :(
254 if (SvROK (sv) && sv_derived_from (sv, pkg)) 252 if (SvROK (sv) && sv_derived_from (sv, pkg))
255 return (void *)SvIV (SvRV (sv)); 253 return (void *)SvIV (SvRV (sv));
256 254
257 croak ("%s: %s is not of type %s", func, svname, pkg); 255 croak ("%s: %s is not of type %s", cv_get_name (cv), svname, pkg);
258} 256}
259 257
260// the "no-inherit" version of the above 258// the "no-inherit" version of the above
261static void * ecb_noinline 259static void * ecb_noinline
262SvCLOBJ_ni (const char *func, const char *svname, SV *sv, HV *stash) 260SvCLOBJ_ni (CV *cv, const char *svname, SV *sv, HV *stash)
263{ 261{
264 if (SvROK (sv) && SvSTASH (SvRV (sv)) == stash) 262 if (SvROK (sv) && SvSTASH (SvRV (sv)) == stash)
265 return (void *)SvIV (SvRV (sv)); 263 return (void *)SvIV (SvRV (sv));
266 264
267 croak ("%s: %s is not of type %s", func, svname, HvNAME (stash)); 265 croak ("%s: %s is not of type %s", cv_get_name (cv), svname, HvNAME (stash));
268} 266}
269 267
270/*****************************************************************************/ 268/*****************************************************************************/
271 269
272static cl_context_properties * ecb_noinline 270static cl_context_properties * ecb_noinline
273SvCONTEXTPROPERTIES (const char *func, const char *svname, SV *sv, cl_context_properties *extra, int extracount) 271SvCONTEXTPROPERTIES (CV *cv, const char *svname, SV *sv, cl_context_properties *extra, int extracount)
274{ 272{
275 if (!sv || !SvOK (sv)) 273 if (!sv || !SvOK (sv))
276 if (extra) 274 if (extra)
277 sv = sv_2mortal (newRV_noinc ((SV *)newAV ())); // slow, but rarely used hopefully 275 sv = sv_2mortal (newRV_noinc ((SV *)newAV ())); // slow, but rarely used hopefully
278 else 276 else
… …
284 int i, len = av_len (av) + 1; 282 int i, len = av_len (av) + 1;
285 cl_context_properties *p = tmpbuf (sizeof (cl_context_properties) * (len + extracount + 1)); 283 cl_context_properties *p = tmpbuf (sizeof (cl_context_properties) * (len + extracount + 1));
286 cl_context_properties *l = p; 284 cl_context_properties *l = p;
287 285
288 if (len & 1) 286 if (len & 1)
289 croak ("%s: %s is not a property list (must contain an even number of elements)", func, svname); 287 croak ("%s: %s is not a property list (must contain an even number of elements)", cv_get_name (cv), svname);
290 288
291 while (extracount--) 289 while (extracount--)
292 *l++ = *extra++; 290 *l++ = *extra++;
293 291
294 for (i = 0; i < len; i += 2) 292 for (i = 0; i < len; i += 2)
… …
299 297
300 switch (t) 298 switch (t)
301 { 299 {
302 case CL_CONTEXT_PLATFORM: 300 case CL_CONTEXT_PLATFORM:
303 if (SvROK (p_sv)) 301 if (SvROK (p_sv))
304 v = (cl_context_properties)SvCLOBJ (func, svname, p_sv, "OpenCL::Platform"); 302 v = (cl_context_properties)SvCLOBJ (cv, svname, p_sv, "OpenCL::Platform");
305 break; 303 break;
306 304
307 case CL_GLX_DISPLAY_KHR: 305 case CL_GLX_DISPLAY_KHR:
308 if (!SvOK (p_sv)) 306 if (!SvOK (p_sv))
309 { 307 {
… …
334 *l = 0; 332 *l = 0;
335 333
336 return p; 334 return p;
337 } 335 }
338 336
339 croak ("%s: %s is not a property list (either undef or [type => value, ...])", func, svname); 337 croak ("%s: %s is not a property list (either undef or [type => value, ...])", cv_get_name (cv), svname);
340} 338}
341 339
340// parse an array of CLOBJ into a void ** array in C - works only for CLOBJs whose representation
341// is a pointer (and only on well-behaved systems).
342static void * ecb_noinline 342static void * ecb_noinline
343object_list (CV *cv, int or_undef, const char *argname, SV *arg, const char *klass, cl_uint *rcount) 343object_list (CV *cv, int or_undef, const char *argname, SV *arg, const char *klass, cl_uint *rcount)
344{ 344{
345 const char *funcname = cv_get_name (cv);
346
347 if (!SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) 345 if (!SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
348 croak ("%s: '%s' parameter must be %sa reference to an array of %s objects", 346 croak ("%s: '%s' parameter must be %sa reference to an array of %s objects",
349 funcname, argname, or_undef ? "undef or " : "", klass); 347 cv_get_name (cv), argname, or_undef ? "undef or " : "", klass);
350 348
351 AV *av = (AV *)SvRV (arg); 349 AV *av = (AV *)SvRV (arg);
352 void **list = 0; 350 void **list = 0;
353 cl_uint count = av_len (av) + 1; 351 cl_uint count = av_len (av) + 1;
354 352
355 if (count) 353 if (count)
356 { 354 {
357 list = tmpbuf (sizeof (*list) * count); 355 list = tmpbuf (sizeof (*list) * count);
358 int i; 356 int i;
359 for (i = 0; i < count; ++i) 357 for (i = 0; i < count; ++i)
360 list [i] = SvCLOBJ (funcname, argname, *av_fetch (av, i, 1), klass); 358 list [i] = SvCLOBJ (cv, argname, *av_fetch (av, i, 1), klass);
361 } 359 }
362 360
363 if (!count && !or_undef) 361 if (!count && !or_undef)
364 croak ("%s: '%s' must contain at least one %s object", 362 croak ("%s: '%s' must contain at least one %s object",
365 funcname, argname, klass); 363 cv_get_name (cv), argname, klass);
366 364
367 *rcount = count; 365 *rcount = count;
368 return (void *)list; 366 return (void *)list;
369} 367}
370 368
… …
628 clGetImageInfo (img, CL_IMAGE_ROW_PITCH, sizeof (res), &res, 0); 626 clGetImageInfo (img, CL_IMAGE_ROW_PITCH, sizeof (res), &res, 0);
629 return res; 627 return res;
630} 628}
631 629
632static cl_event * ecb_noinline 630static cl_event * ecb_noinline
633event_list (SV **items, cl_uint *rcount, cl_event extra) 631event_list (CV *cv, SV **items, cl_uint *rcount, cl_event extra)
634{ 632{
635 cl_uint count = *rcount; 633 cl_uint count = *rcount;
636 634
637 if (count > 0x7fffffffU) // yeah, it's a hack - the caller might have underflowed 635 if (count > 0x7fffffffU) // yeah, it's a hack - the caller might have underflowed
638 *rcount = count = 0; 636 *rcount = count = 0;
… …
643 cl_event *list = tmpbuf (sizeof (cl_event) * (count + 1)); 641 cl_event *list = tmpbuf (sizeof (cl_event) * (count + 1));
644 int i = 0; 642 int i = 0;
645 643
646 while (count--) 644 while (count--)
647 if (SvOK (items [count])) 645 if (SvOK (items [count]))
648 list [i++] = SvCLOBJ ("clEnqueue", "wait_events", items [count], "OpenCL::Event"); 646 list [i++] = SvCLOBJ (cv, "wait_events", items [count], "OpenCL::Event");
649 647
650 if (extra) 648 if (extra)
651 list [i++] = extra; 649 list [i++] = extra;
652 650
653 *rcount = i; 651 *rcount = i;
… …
655 return i ? list : 0; 653 return i ? list : 0;
656} 654}
657 655
658#define EVENT_LIST(skip) \ 656#define EVENT_LIST(skip) \
659 cl_uint event_list_count = items - (skip); \ 657 cl_uint event_list_count = items - (skip); \
660 cl_event *event_list_ptr = event_list (&ST (skip), &event_list_count, 0) 658 cl_event *event_list_ptr = event_list (cv, &ST (skip), &event_list_count, 0)
661 659
662#define INFO(class) \ 660#define INFO(class) \
663{ \ 661{ \
664 size_t size; \ 662 size_t size; \
665 NEED_SUCCESS (Get ## class ## Info, (self, name, 0, 0, &size)); \ 663 NEED_SUCCESS (Get ## class ## Info, (self, name, 0, 0, &size)); \
… …
747 745
748 mapped->ptr = 0; 746 mapped->ptr = 0;
749} 747}
750 748
751static void 749static void
752mapped_unmap (SV *self, OpenCL__Mapped mapped, cl_command_queue queue, SV **wait_list, cl_uint event_list_count) 750mapped_unmap (CV *cv, SV *self, OpenCL__Mapped mapped, cl_command_queue queue, SV **wait_list, cl_uint event_list_count)
753{ 751{
754 cl_event *event_list_ptr = event_list (wait_list, &event_list_count, mapped->event); 752 cl_event *event_list_ptr = event_list (cv, wait_list, &event_list_count, mapped->event);
755 cl_event ev; 753 cl_event ev;
756 754
757 NEED_SUCCESS (EnqueueUnmapMemObject, (queue, mapped->memobj, mapped->ptr, event_list_count, event_list_ptr, &ev)); 755 NEED_SUCCESS (EnqueueUnmapMemObject, (queue, mapped->memobj, mapped->ptr, event_list_count, event_list_ptr, &ev));
758 756
759 clReleaseEvent (mapped->event); 757 clReleaseEvent (mapped->event);
… …
861 CONTEXT_NOTIFY_CALLBACK; 859 CONTEXT_NOTIFY_CALLBACK;
862 NEED_SUCCESS_ARG (cl_context ctx, CreateContextFromType, (properties, type, pfn_notify, user_data, &res)); 860 NEED_SUCCESS_ARG (cl_context ctx, CreateContextFromType, (properties, type, pfn_notify, user_data, &res));
863 XPUSH_CLOBJ_CONTEXT; 861 XPUSH_CLOBJ_CONTEXT;
864 862
865void 863void
866context (FUTURE properties, FUTURE devices, FUTURE notify) 864context (cl_context_properties *properties, SV *devices, SV *notify = &PL_sv_undef)
867 PPCODE: 865 PPCODE:
868 /* der Gipfel der Kunst */ 866 cl_uint device_count;
867 cl_device_id *device_list = object_list (cv, 0, "devices", devices, "OpenCL::Device", &device_count);
868
869 CONTEXT_NOTIFY_CALLBACK;
870 NEED_SUCCESS_ARG (cl_context ctx, CreateContext, (properties, device_count, device_list, pfn_notify, user_data, &res));
871 XPUSH_CLOBJ_CONTEXT;
869 872
870void 873void
871wait_for_events (...) 874wait_for_events (...)
872 CODE: 875 CODE:
873 EVENT_LIST (0); 876 EVENT_LIST (0);
… …
924 EXTEND (SP, count); 927 EXTEND (SP, count);
925 for (i = 0; i < count; ++i) 928 for (i = 0; i < count; ++i)
926 PUSH_CLOBJ (stash_device, list [i]); 929 PUSH_CLOBJ (stash_device, list [i]);
927 930
928void 931void
929context (OpenCL::Platform self, SV *properties = 0, SV *devices, SV *notify = &PL_sv_undef) 932context (OpenCL::Platform self, SV *properties, SV *devices, SV *notify = &PL_sv_undef)
930 PPCODE: 933 PPCODE:
931 cl_context_properties extra[] = { CL_CONTEXT_PLATFORM, (cl_context_properties)self }; 934 cl_context_properties extra[] = { CL_CONTEXT_PLATFORM, (cl_context_properties)self };
932 cl_context_properties *props = SvCONTEXTPROPERTIES ("OpenCL::Platform::context", "properties", properties, extra, 2); 935 cl_context_properties *props = SvCONTEXTPROPERTIES (cv, "properties", properties, extra, 2);
933 936
934 cl_uint device_count = 0; 937 cl_uint device_count;
935 cl_device_id *device_list = object_list (cv, 0, "devices", devices, "OpenCL::Device", &device_count); 938 cl_device_id *device_list = object_list (cv, 0, "devices", devices, "OpenCL::Device", &device_count);
936 939
937 CONTEXT_NOTIFY_CALLBACK; 940 CONTEXT_NOTIFY_CALLBACK;
938 NEED_SUCCESS_ARG (cl_context ctx, CreateContext, (props, device_count, device_list, pfn_notify, user_data, &res)); 941 NEED_SUCCESS_ARG (cl_context ctx, CreateContext, (props, device_count, device_list, pfn_notify, user_data, &res));
939 XPUSH_CLOBJ_CONTEXT; 942 XPUSH_CLOBJ_CONTEXT;
940 943
941void 944void
942context_from_type (OpenCL::Platform self, SV *properties = 0, cl_device_type type = CL_DEVICE_TYPE_DEFAULT, SV *notify = &PL_sv_undef) 945context_from_type (OpenCL::Platform self, SV *properties = 0, cl_device_type type = CL_DEVICE_TYPE_DEFAULT, SV *notify = &PL_sv_undef)
943 PPCODE: 946 PPCODE:
944 cl_context_properties extra[] = { CL_CONTEXT_PLATFORM, (cl_context_properties)self }; 947 cl_context_properties extra[] = { CL_CONTEXT_PLATFORM, (cl_context_properties)self };
945 cl_context_properties *props = SvCONTEXTPROPERTIES ("OpenCL::Platform::context_from_type", "properties", properties, extra, 2); 948 cl_context_properties *props = SvCONTEXTPROPERTIES (cv, "properties", properties, extra, 2);
946 949
947 CONTEXT_NOTIFY_CALLBACK; 950 CONTEXT_NOTIFY_CALLBACK;
948 NEED_SUCCESS_ARG (cl_context ctx, CreateContextFromType, (props, type, pfn_notify, user_data, &res)); 951 NEED_SUCCESS_ARG (cl_context ctx, CreateContextFromType, (props, type, pfn_notify, user_data, &res));
949 XPUSH_CLOBJ_CONTEXT; 952 XPUSH_CLOBJ_CONTEXT;
950 953
… …
1274 const cl_image_desc desc = { 1277 const cl_image_desc desc = {
1275 type, 1278 type,
1276 width, height, depth, 1279 width, height, depth,
1277 array_size, row_pitch, slice_pitch, 1280 array_size, row_pitch, slice_pitch,
1278 num_mip_level, num_samples, 1281 num_mip_level, num_samples,
1279 type == CL_MEM_OBJECT_IMAGE1D_BUFFER ? (cl_mem)SvCLOBJ ("OpenCL::Context::Image", "data", data, "OpenCL::Buffer") : 0 1282 type == CL_MEM_OBJECT_IMAGE1D_BUFFER ? (cl_mem)SvCLOBJ (cv, "data", data, "OpenCL::Buffer") : 0
1280 }; 1283 };
1281 NEED_SUCCESS_ARG (cl_mem mem, CreateImage, (self, flags, &format, &desc, ptr, &res)); 1284 NEED_SUCCESS_ARG (cl_mem mem, CreateImage, (self, flags, &format, &desc, ptr, &res));
1282 HV *stash = stash_image; 1285 HV *stash = stash_image;
1283 switch (type) 1286 switch (type)
1284 { 1287 {
… …
1464#if CL_VERSION_1_2 1467#if CL_VERSION_1_2
1465 1468
1466void 1469void
1467program_with_built_in_kernels (OpenCL::Context self, SV *devices, SV *kernel_names) 1470program_with_built_in_kernels (OpenCL::Context self, SV *devices, SV *kernel_names)
1468 PPCODE: 1471 PPCODE:
1469 cl_uint device_count = 0; 1472 cl_uint device_count;
1470 cl_device_id *device_list = object_list (cv, 0, "devices", devices, "OpenCL::Device", &device_count); 1473 cl_device_id *device_list = object_list (cv, 0, "devices", devices, "OpenCL::Device", &device_count);
1471 1474
1472 NEED_SUCCESS_ARG (cl_program prog, CreateProgramWithBuiltInKernels, (self, device_count, device_list, SvPVbyte_nolen (kernel_names), &res)); 1475 NEED_SUCCESS_ARG (cl_program prog, CreateProgramWithBuiltInKernels, (self, device_count, device_list, SvPVbyte_nolen (kernel_names), &res));
1473 1476
1474 XPUSH_CLOBJ (stash_program, prog); 1477 XPUSH_CLOBJ (stash_program, prog);
1475 1478
… …
1899 XPUSHs (mapped_new (stash_mappedimage, self, img, map_flags, ptr, cb, ev, row_pitch, slice_pitch)); 1902 XPUSHs (mapped_new (stash_mappedimage, self, img, map_flags, ptr, cb, ev, row_pitch, slice_pitch));
1900 1903
1901void 1904void
1902unmap (OpenCL::Queue self, OpenCL::Mapped mapped, ...) 1905unmap (OpenCL::Queue self, OpenCL::Mapped mapped, ...)
1903 PPCODE: 1906 PPCODE:
1904 mapped_unmap (ST (1), mapped, self, &ST (2), items - 2); 1907 mapped_unmap (cv, ST (1), mapped, self, &ST (2), items - 2);
1905 if (GIMME_V != G_VOID) 1908 if (GIMME_V != G_VOID)
1906 { 1909 {
1907 clRetainEvent (mapped->event); 1910 clRetainEvent (mapped->event);
1908 XPUSH_CLOBJ (stash_event, mapped->event); 1911 XPUSH_CLOBJ (stash_event, mapped->event);
1909 } 1912 }
… …
2456 HE *he; 2459 HE *he;
2457 int i = 0; 2460 int i = 0;
2458 while (he = hv_iternext (hv)) 2461 while (he = hv_iternext (hv))
2459 { 2462 {
2460 header_name [i] = SvPVbyte_nolen (HeSVKEY_force (he)); 2463 header_name [i] = SvPVbyte_nolen (HeSVKEY_force (he));
2461 header_list [i] = SvCLOBJ ("clCompileProgram", "headers", HeVAL (he), "OpenCL::Program"); 2464 header_list [i] = SvCLOBJ (cv, "headers", HeVAL (he), "OpenCL::Program");
2462 ++i; 2465 ++i;
2463 } 2466 }
2464 } 2467 }
2465 2468
2466 void *user_data; 2469 void *user_data;
… …
2681 case 'f': arg.cf = SvNV (sv); size = sizeof (arg.cf); break; 2684 case 'f': arg.cf = SvNV (sv); size = sizeof (arg.cf); break;
2682 case 'd': arg.cd = SvNV (sv); size = sizeof (arg.cd); break; 2685 case 'd': arg.cd = SvNV (sv); size = sizeof (arg.cd); break;
2683 2686
2684 case 'z': nullarg = 1; size = SvIV (sv); break; 2687 case 'z': nullarg = 1; size = SvIV (sv); break;
2685 2688
2686 case 'm': nullarg = !SvOK (sv); arg.cm = SvCLOBJ ("OpenCL::Kernel::setf", "m", sv, "OpenCL::Memory" ); size = sizeof (arg.cm); break; 2689 case 'm': nullarg = !SvOK (sv); arg.cm = SvCLOBJ (cv, "m", sv, "OpenCL::Memory" ); size = sizeof (arg.cm); break;
2687 case 'a': nullarg = !SvOK (sv); arg.ca = SvCLOBJ ("OpenCL::Kernel::setf", "a", sv, "OpenCL::Sampler"); size = sizeof (arg.ca); break; 2690 case 'a': nullarg = !SvOK (sv); arg.ca = SvCLOBJ (cv, "a", sv, "OpenCL::Sampler"); size = sizeof (arg.ca); break;
2688 case 'e': nullarg = !SvOK (sv); arg.ca = SvCLOBJ ("OpenCL::Kernel::setf", "e", sv, "OpenCL::Event" ); size = sizeof (arg.ce); break; 2691 case 'e': nullarg = !SvOK (sv); arg.ca = SvCLOBJ (cv, "e", sv, "OpenCL::Event" ); size = sizeof (arg.ce); break;
2689 2692
2690 default: 2693 default:
2691 croak ("OpenCL::Kernel::setf format character '%c' not supported", type); 2694 croak ("OpenCL::Kernel::setf format character '%c' not supported", type);
2692 } 2695 }
2693 2696
… …
3072 Safefree (mapped); 3075 Safefree (mapped);
3073 3076
3074void 3077void
3075unmap (OpenCL::Mapped self, ...) 3078unmap (OpenCL::Mapped self, ...)
3076 CODE: 3079 CODE:
3077 mapped_unmap (ST (0), self, self->queue, &ST (1), items - 1); 3080 mapped_unmap (cv, ST (0), self, self->queue, &ST (1), items - 1);
3078 3081
3079bool 3082bool
3080mapped (OpenCL::Mapped self) 3083mapped (OpenCL::Mapped self)
3081 CODE: 3084 CODE:
3082 RETVAL = !!self->ptr; 3085 RETVAL = !!self->ptr;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines