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

Comparing OpenCL/OpenCL.xs (file contents):
Revision 1.61 by root, Tue May 1 16:37:23 2012 UTC vs.
Revision 1.64 by root, Thu May 3 23:30:08 2012 UTC

1#include "EXTERN.h" 1#include "EXTERN.h"
2#include "perl.h" 2#include "perl.h"
3#include "XSUB.h" 3#include "XSUB.h"
4
5#include "ecb.h"//D
4 6
5#define X_STACKSIZE sizeof (void *) * 512 * 1024 // 2-4mb should be enough, really 7#define X_STACKSIZE sizeof (void *) * 512 * 1024 // 2-4mb should be enough, really
6#include "xthread.h" 8#include "xthread.h"
7#include "schmorp.h" 9#include "schmorp.h"
8 10
… …
44typedef cl_command_queue OpenCL__Queue; 46typedef cl_command_queue OpenCL__Queue;
45typedef cl_mem OpenCL__Memory; 47typedef cl_mem OpenCL__Memory;
46typedef cl_mem OpenCL__Buffer; 48typedef cl_mem OpenCL__Buffer;
47typedef cl_mem OpenCL__BufferObj; 49typedef cl_mem OpenCL__BufferObj;
48typedef cl_mem OpenCL__Image; 50typedef cl_mem OpenCL__Image;
49typedef cl_mem OpenCL__Image2D;
50typedef cl_mem OpenCL__Image3D;
51typedef cl_mem OpenCL__Memory_ornull; 51typedef cl_mem OpenCL__Memory_ornull;
52typedef cl_mem OpenCL__Buffer_ornull; 52typedef cl_mem OpenCL__Buffer_ornull;
53typedef cl_mem OpenCL__Image_ornull; 53typedef cl_mem OpenCL__Image_ornull;
54typedef cl_mem OpenCL__Image2D_ornull;
55typedef cl_mem OpenCL__Image3D_ornull;
56typedef cl_sampler OpenCL__Sampler; 54typedef cl_sampler OpenCL__Sampler;
57typedef cl_program OpenCL__Program; 55typedef cl_program OpenCL__Program;
58typedef cl_kernel OpenCL__Kernel; 56typedef cl_kernel OpenCL__Kernel;
59typedef cl_event OpenCL__Event; 57typedef cl_event OpenCL__Event;
60typedef cl_event OpenCL__UserEvent; 58typedef cl_event OpenCL__UserEvent;
… …
133} 131}
134 132
135/*****************************************************************************/ 133/*****************************************************************************/
136 134
137/* up to two temporary buffers */ 135/* up to two temporary buffers */
138static void * 136static void * ecb_noinline
139tmpbuf (size_t size) 137tmpbuf (size_t size)
140{ 138{
141 enum { buffers = 3 }; 139 enum { buffers = 4 };
142 static int idx; 140 static int idx;
143 static void *buf [buffers]; 141 static void *buf [buffers];
144 static size_t len [buffers]; 142 static size_t len [buffers];
145 143
146 idx = (idx + 1) % buffers; 144 idx = (idx + 1) % buffers;
… …
219 if (res) \ 217 if (res) \
220 FAIL (name); 218 FAIL (name);
221 219
222/*****************************************************************************/ 220/*****************************************************************************/
223 221
224static cl_context_properties * 222static cl_context_properties * ecb_noinline
225SvCONTEXTPROPERTIES (const char *func, const char *svname, SV *sv, cl_context_properties *extra, int extracount) 223SvCONTEXTPROPERTIES (const char *func, const char *svname, SV *sv, cl_context_properties *extra, int extracount)
226{ 224{
227 if (!sv || !SvOK (sv)) 225 if (!sv || !SvOK (sv))
228 if (extra) 226 if (extra)
229 sv = sv_2mortal (newRV_noinc ((SV *)newAV ())); // slow, but rarely used hopefully 227 sv = sv_2mortal (newRV_noinc ((SV *)newAV ())); // slow, but rarely used hopefully
… …
297#define PUSH_CLOBJ(stash,id) PUSHs (new_clobj ((stash), (IV)(id))) 295#define PUSH_CLOBJ(stash,id) PUSHs (new_clobj ((stash), (IV)(id)))
298#define XPUSH_CLOBJ(stash,id) XPUSHs (new_clobj ((stash), (IV)(id))) 296#define XPUSH_CLOBJ(stash,id) XPUSHs (new_clobj ((stash), (IV)(id)))
299 297
300/* cl objects are either \$iv, or [$iv, ...] */ 298/* cl objects are either \$iv, or [$iv, ...] */
301/* they can be upgraded at runtime to the array form */ 299/* they can be upgraded at runtime to the array form */
302static void * 300static void * ecb_noinline
303SvCLOBJ (const char *func, const char *svname, SV *sv, const char *pkg) 301SvCLOBJ (const char *func, const char *svname, SV *sv, const char *pkg)
304{ 302{
303 // sv_derived_from is quite slow :(
305 if (SvROK (sv) && sv_derived_from (sv, pkg)) 304 if (SvROK (sv) && sv_derived_from (sv, pkg))
306 return (void *)SvIV (SvRV (sv)); 305 return (void *)SvIV (SvRV (sv));
307 306
308 croak ("%s: %s is not of type %s", func, svname, pkg); 307 croak ("%s: %s is not of type %s", func, svname, pkg);
308}
309
310// the "no-inherit" version of the above
311static void * ecb_noinline
312SvCLOBJ_ni (const char *func, const char *svname, SV *sv, HV *stash)
313{
314 if (SvROK (sv) && SvSTASH (SvRV (sv)) == stash)
315 return (void *)SvIV (SvRV (sv));
316
317 croak ("%s: %s is not of type %s", func, svname, HvNAME (stash));
309} 318}
310 319
311/*****************************************************************************/ 320/*****************************************************************************/
312/* callback stuff */ 321/* callback stuff */
313 322
… …
335static void (*eq_signal_func)(void *signal_arg, int value); 344static void (*eq_signal_func)(void *signal_arg, int value);
336static void *eq_signal_arg; 345static void *eq_signal_arg;
337static xmutex_t eq_lock = X_MUTEX_INIT; 346static xmutex_t eq_lock = X_MUTEX_INIT;
338static eq_item *eq_head, *eq_tail; 347static eq_item *eq_head, *eq_tail;
339 348
340static void 349static void ecb_noinline
341eq_enq (eq_vtbl *vtbl, SV *cb, void *data1, void *data2, void *data3) 350eq_enq (eq_vtbl *vtbl, SV *cb, void *data1, void *data2, void *data3)
342{ 351{
343 eq_item *item = malloc (sizeof (eq_item)); 352 eq_item *item = malloc (sizeof (eq_item));
344 353
345 item->next = 0; 354 item->next = 0;
… …
412} 421}
413 422
414/*****************************************************************************/ 423/*****************************************************************************/
415/* context notify */ 424/* context notify */
416 425
417static void 426static void ecb_noinline
418eq_context_push (void *data1, void *data2, void *data3) 427eq_context_push (void *data1, void *data2, void *data3)
419{ 428{
420 dSP; 429 dSP;
421 PUSHs (sv_2mortal (newSVpv (data1, 0))); 430 PUSHs (sv_2mortal (newSVpv (data1, 0)));
422 PUSHs (sv_2mortal (newSVpvn (data2, (STRLEN)data3))); 431 PUSHs (sv_2mortal (newSVpvn (data2, (STRLEN)data3)));
… …
444 { \ 453 { \
445 pfn_notify = eq_context_notify; \ 454 pfn_notify = eq_context_notify; \
446 user_data = s_get_cv (notify); \ 455 user_data = s_get_cv (notify); \
447 } 456 }
448 457
449static SV * 458static SV * ecb_noinline
450new_clobj_context (cl_context ctx, void *user_data) 459new_clobj_context (cl_context ctx, void *user_data)
451{ 460{
452 SV *sv = new_clobj (stash_context, (IV)ctx); 461 SV *sv = new_clobj (stash_context, (IV)ctx);
453 462
454 if (user_data) 463 if (user_data)
… …
497 else 506 else
498 clReleaseProgram (arg->program); 507 clReleaseProgram (arg->program);
499 508
500 free (arg->options); 509 free (arg->options);
501 free (arg); 510 free (arg);
511
512 return 0;
502} 513}
503 514
504static void 515static void
505build_program_async (cl_program program, cl_uint num_devices, const cl_device_id *device_list, const char *options, void *user_data) 516build_program_async (cl_program program, cl_uint num_devices, const cl_device_id *device_list, const char *options, void *user_data)
506{ 517{
… …
536 clRetainEvent (event); 547 clRetainEvent (event);
537 eq_enq (&eq_event_vtbl, user_data, (void *)event, (void *)(IV)event_command_exec_status, 0); 548 eq_enq (&eq_event_vtbl, user_data, (void *)event, (void *)(IV)event_command_exec_status, 0);
538} 549}
539 550
540/*****************************************************************************/ 551/*****************************************************************************/
541/* mapped_xxx */ 552/* utilities for XS code */
542
543static OpenCL__Mapped
544SvMAPPED (SV *sv)
545{
546 // no typechecking atm., keep your fingers crossed
547 return (OpenCL__Mapped)SvMAGIC (SvRV (sv))->mg_ptr;
548}
549
550struct mapped
551{
552 cl_command_queue queue;
553 cl_mem memobj;
554 void *ptr;
555 size_t cb;
556 cl_event event;
557 size_t row_pitch;
558 size_t slice_pitch;
559};
560
561static SV *
562mapped_new (HV *stash, cl_command_queue queue, cl_mem memobj, cl_map_flags flags, void *ptr, size_t cb, cl_event ev, size_t row_pitch, size_t slice_pitch)
563{
564 SV *data = newSV (0);
565 SvUPGRADE (data, SVt_PVMG);
566
567 OpenCL__Mapped mapped;
568 New (0, mapped, 1, struct mapped);
569
570 clRetainCommandQueue (queue);
571
572 mapped->queue = queue;
573 mapped->memobj = memobj;
574 mapped->ptr = ptr;
575 mapped->cb = cb;
576 mapped->event = ev;
577 mapped->row_pitch = row_pitch;
578 mapped->slice_pitch = slice_pitch;
579
580 sv_magicext (data, 0, PERL_MAGIC_ext, 0, (char *)mapped, 0);
581
582 if (!(flags & CL_MAP_WRITE))
583 SvREADONLY_on (data);
584
585 if (SvLEN (data))
586 Safefree (data);
587
588 SvPVX (data) = (char *)ptr;
589 SvCUR_set (data, cb);
590 SvLEN_set (data, 0);
591 SvPOK_only (data);
592
593 return sv_2mortal (sv_bless (newRV_noinc (data), stash));
594}
595
596static void
597mapped_detach (SV *sv, OpenCL__Mapped mapped)
598{
599 SV *data = SvRV (sv);
600
601 if (SvPVX (data) != (char *)mapped->ptr)
602 warn ("FATAL: OpenCL memory mapped scalar changed location, detected");
603 else
604 {
605 SvREADONLY_off (data);
606 SvCUR_set (data, 0);
607 SvPVX (data) = 0;
608 SvOK_off (data);
609 }
610
611 mapped->ptr = 0;
612}
613
614/*****************************************************************************/
615 553
616static size_t 554static size_t
617img_row_pitch (cl_mem img) 555img_row_pitch (cl_mem img)
618{ 556{
619 size_t res; 557 size_t res;
620 clGetImageInfo (img, CL_IMAGE_ROW_PITCH, sizeof (res), &res, 0); 558 clGetImageInfo (img, CL_IMAGE_ROW_PITCH, sizeof (res), &res, 0);
621 return res; 559 return res;
622} 560}
623 561
624static cl_event * 562static cl_event * ecb_noinline
625event_list (SV **items, cl_uint *rcount, cl_event extra) 563event_list (SV **items, cl_uint *rcount, cl_event extra)
626{ 564{
627 cl_uint count = *rcount; 565 cl_uint count = *rcount;
566
567 if (count > 0x7fffffffU) // yeah, it's a hack - the caller might have underflowed
568 *rcount = count = 0;
628 569
629 if (!count && !extra) 570 if (!count && !extra)
630 return 0; 571 return 0;
631 572
632 cl_event *list = tmpbuf (sizeof (cl_event) * (count + 1)); 573 cl_event *list = tmpbuf (sizeof (cl_event) * (count + 1));
633 int i = 0; 574 int i = 0;
634 575
635 while (count) 576 while (count--)
636 {
637 --count;
638 if (SvOK (items [count])) 577 if (SvOK (items [count]))
639 list [i++] = SvCLOBJ ("clEnqueue", "wait_events", items [count], "OpenCL::Event"); 578 list [i++] = SvCLOBJ ("clEnqueue", "wait_events", items [count], "OpenCL::Event");
640 }
641 579
642 if (extra) 580 if (extra)
643 list [i++] = extra; 581 list [i++] = extra;
644 582
645 *rcount = i; 583 *rcount = i;
646 584
647 return i ? list : 0; 585 return i ? list : 0;
648} 586}
649 587
650#define EVENT_LIST(skip) \ 588#define EVENT_LIST(skip) \
651 cl_uint event_list_count = items - skip; \ 589 cl_uint event_list_count = items - (skip); \
652 cl_event *event_list_ptr = event_list (&ST (skip), &event_list_count, 0) 590 cl_event *event_list_ptr = event_list (&ST (skip), &event_list_count, 0)
653 591
654#define INFO(class) \ 592#define INFO(class) \
655{ \ 593{ \
656 size_t size; \ 594 size_t size; \
… …
660 SvPOK_only (sv); \ 598 SvPOK_only (sv); \
661 SvCUR_set (sv, size); \ 599 SvCUR_set (sv, size); \
662 NEED_SUCCESS (Get ## class ## Info, (self, name, size, SvPVX (sv), 0)); \ 600 NEED_SUCCESS (Get ## class ## Info, (self, name, size, SvPVX (sv), 0)); \
663 XPUSHs (sv); \ 601 XPUSHs (sv); \
664} 602}
603
604/*****************************************************************************/
605/* mapped_xxx */
606
607static OpenCL__Mapped
608SvMAPPED (SV *sv)
609{
610 // no typechecking atm., keep your fingers crossed
611 return (OpenCL__Mapped)SvMAGIC (SvRV (sv))->mg_ptr;
612}
613
614struct mapped
615{
616 cl_command_queue queue;
617 cl_mem memobj;
618 void *ptr;
619 size_t cb;
620 cl_event event;
621 size_t row_pitch;
622 size_t slice_pitch;
623};
624
625static SV *
626mapped_new (HV *stash, cl_command_queue queue, cl_mem memobj, cl_map_flags flags, void *ptr, size_t cb, cl_event ev, size_t row_pitch, size_t slice_pitch)
627{
628 SV *data = newSV (0);
629 SvUPGRADE (data, SVt_PVMG);
630
631 OpenCL__Mapped mapped;
632 New (0, mapped, 1, struct mapped);
633
634 clRetainCommandQueue (queue);
635
636 mapped->queue = queue;
637 mapped->memobj = memobj;
638 mapped->ptr = ptr;
639 mapped->cb = cb;
640 mapped->event = ev;
641 mapped->row_pitch = row_pitch;
642 mapped->slice_pitch = slice_pitch;
643
644 sv_magicext (data, 0, PERL_MAGIC_ext, 0, (char *)mapped, 0);
645
646 if (SvLEN (data))
647 Safefree (data);
648
649 SvPVX (data) = (char *)ptr;
650 SvCUR_set (data, cb);
651 SvLEN_set (data, 0);
652 SvPOK_only (data);
653
654 SV *obj = sv_2mortal (sv_bless (newRV_noinc (data), stash));
655
656 if (!(flags & CL_MAP_WRITE))
657 SvREADONLY_on (data);
658
659 return obj;
660}
661
662static void
663mapped_detach (SV *sv, OpenCL__Mapped mapped)
664{
665 SV *data = SvRV (sv);
666
667 // the next check checks both before AND after detach, where SvPVX should STILL be 0
668 if (SvPVX (data) != (char *)mapped->ptr)
669 warn ("FATAL: OpenCL memory mapped scalar changed location, detected");
670 else
671 {
672 SvREADONLY_off (data);
673 SvCUR_set (data, 0);
674 SvPVX (data) = 0;
675 SvOK_off (data);
676 }
677
678 mapped->ptr = 0;
679}
680
681static void
682mapped_unmap (SV *self, OpenCL__Mapped mapped, cl_command_queue queue, SV **wait_list, cl_uint event_list_count)
683{
684 cl_event *event_list_ptr = event_list (wait_list, &event_list_count, mapped->event);
685 cl_event ev;
686
687 NEED_SUCCESS (EnqueueUnmapMemObject, (queue, mapped->memobj, mapped->ptr, event_list_count, event_list_ptr, &ev));
688
689 clReleaseEvent (mapped->event);
690 mapped->event = ev;
691
692 mapped_detach (self, mapped);
693}
694
695/*****************************************************************************/
665 696
666MODULE = OpenCL PACKAGE = OpenCL 697MODULE = OpenCL PACKAGE = OpenCL
667 698
668PROTOTYPES: ENABLE 699PROTOTYPES: ENABLE
669 700
… …
755 786
756void 787void
757context_from_type (cl_context_properties *properties = 0, cl_device_type type = CL_DEVICE_TYPE_DEFAULT, SV *notify = &PL_sv_undef) 788context_from_type (cl_context_properties *properties = 0, cl_device_type type = CL_DEVICE_TYPE_DEFAULT, SV *notify = &PL_sv_undef)
758 PPCODE: 789 PPCODE:
759 CONTEXT_NOTIFY_CALLBACK; 790 CONTEXT_NOTIFY_CALLBACK;
760 NEED_SUCCESS_ARG (cl_context ctx, CreateContextFromType, (properties, type, 0, 0, &res)); 791 NEED_SUCCESS_ARG (cl_context ctx, CreateContextFromType, (properties, type, pfn_notify, user_data, &res));
761 XPUSH_CLOBJ_CONTEXT; 792 XPUSH_CLOBJ_CONTEXT;
762 793
763void 794void
764context (FUTURE properties, FUTURE devices, FUTURE notify) 795context (FUTURE properties, FUTURE devices, FUTURE notify)
765 PPCODE: 796 PPCODE:
… …
822 EXTEND (SP, count); 853 EXTEND (SP, count);
823 for (i = 0; i < count; ++i) 854 for (i = 0; i < count; ++i)
824 PUSH_CLOBJ (stash_device, list [i]); 855 PUSH_CLOBJ (stash_device, list [i]);
825 856
826void 857void
827context (OpenCL::Platform self, cl_context_properties *properties, SV *devices, SV *notify = &PL_sv_undef) 858context (OpenCL::Platform self, SV *properties = 0, SV *devices, SV *notify = &PL_sv_undef)
828 PPCODE: 859 PPCODE:
829 if (!SvROK (devices) || SvTYPE (SvRV (devices)) != SVt_PVAV) 860 if (!SvROK (devices) || SvTYPE (SvRV (devices)) != SVt_PVAV)
830 croak ("OpenCL::Platform::context argument 'device' must be an arrayref with device objects, in call"); 861 croak ("OpenCL::Platform::context argument 'device' must be an arrayref with device objects, in call");
862
863 cl_context_properties extra[] = { CL_CONTEXT_PLATFORM, (cl_context_properties)self };
864 cl_context_properties *props = SvCONTEXTPROPERTIES ("OpenCL::Platform::context", "properties", properties, extra, 2);
831 865
832 AV *av = (AV *)SvRV (devices); 866 AV *av = (AV *)SvRV (devices);
833 cl_uint num_devices = av_len (av) + 1; 867 cl_uint num_devices = av_len (av) + 1;
834 cl_device_id *device_list = tmpbuf (sizeof (cl_device_id) * num_devices); 868 cl_device_id *device_list = tmpbuf (sizeof (cl_device_id) * num_devices);
835 869
836 int i; 870 int i;
837 for (i = num_devices; i--; ) 871 for (i = num_devices; i--; )
838 device_list [i] = SvCLOBJ ("clCreateContext", "devices", *av_fetch (av, i, 0), "OpenCL::Device"); 872 device_list [i] = SvCLOBJ ("clCreateContext", "devices", *av_fetch (av, i, 0), "OpenCL::Device");
839 873
840 CONTEXT_NOTIFY_CALLBACK; 874 CONTEXT_NOTIFY_CALLBACK;
841 NEED_SUCCESS_ARG (cl_context ctx, CreateContext, (properties, num_devices, device_list, pfn_notify, user_data, &res)); 875 NEED_SUCCESS_ARG (cl_context ctx, CreateContext, (props, num_devices, device_list, pfn_notify, user_data, &res));
842 XPUSH_CLOBJ_CONTEXT; 876 XPUSH_CLOBJ_CONTEXT;
843 877
844void 878void
845context_from_type (OpenCL::Platform self, SV *properties = 0, cl_device_type type = CL_DEVICE_TYPE_DEFAULT, SV *notify = &PL_sv_undef) 879context_from_type (OpenCL::Platform self, SV *properties = 0, cl_device_type type = CL_DEVICE_TYPE_DEFAULT, SV *notify = &PL_sv_undef)
846 PPCODE: 880 PPCODE:
847 cl_context_properties extra[] = { CL_CONTEXT_PLATFORM, (cl_context_properties)self }; 881 cl_context_properties extra[] = { CL_CONTEXT_PLATFORM, (cl_context_properties)self };
848 cl_context_properties *props = SvCONTEXTPROPERTIES ("OpenCL::Platform::context_from_type", "properties", properties, extra, 2); 882 cl_context_properties *props = SvCONTEXTPROPERTIES ("OpenCL::Platform::context_from_type", "properties", properties, extra, 2);
849 883
850 CONTEXT_NOTIFY_CALLBACK; 884 CONTEXT_NOTIFY_CALLBACK;
851 NEED_SUCCESS_ARG (cl_context ctx, CreateContextFromType, (props, type, 0, 0, &res)); 885 NEED_SUCCESS_ARG (cl_context ctx, CreateContextFromType, (props, type, pfn_notify, user_data, &res));
852 XPUSH_CLOBJ_CONTEXT; 886 XPUSH_CLOBJ_CONTEXT;
853 887
854MODULE = OpenCL PACKAGE = OpenCL::Device 888MODULE = OpenCL PACKAGE = OpenCL::Device
855 889
856void 890void
… …
1279 1313
1280 len2 = len; 1314 len2 = len;
1281 NEED_SUCCESS_ARG (cl_program prog, CreateProgramWithSource, (self, 1, &ptr, &len2, &res)); 1315 NEED_SUCCESS_ARG (cl_program prog, CreateProgramWithSource, (self, 1, &ptr, &len2, &res));
1282 XPUSH_CLOBJ (stash_program, prog); 1316 XPUSH_CLOBJ (stash_program, prog);
1283 1317
1318void
1319program_with_binary (OpenCL::Context self, SV *devices, SV *binaries)
1320 PPCODE:
1321 if (!SvROK (devices) || SvTYPE (SvRV (devices)) != SVt_PVAV)
1322 croak ("OpenCL::Context::program_with_binary: devices must be specified as reference to an array of device objects");
1323
1324 devices = SvRV (devices);
1325
1326 if (!SvROK (binaries) || SvTYPE (SvRV (binaries)) != SVt_PVAV)
1327 croak ("OpenCL::Context::program_with_binary: binaries must be specified as reference to an array of strings");
1328
1329 binaries = SvRV (binaries);
1330
1331 if (av_len ((AV *)devices) != av_len ((AV *)binaries))
1332 croak ("OpenCL::Context::program_with_binary: differing numbers of devices and binaries are not allowed");
1333
1334 int count = av_len ((AV *)devices) + 1;
1335 cl_device_id *device_list = tmpbuf (sizeof (*device_list) * count);
1336 size_t *length_list = tmpbuf (sizeof (*length_list) * count);
1337 const unsigned char **binary_list = tmpbuf (sizeof (*binary_list) * count);
1338 cl_int *status_list = tmpbuf (sizeof (*status_list) * count);
1339
1340 int i;
1341 for (i = 0; i < count; ++i)
1342 {
1343 device_list [i] = SvCLOBJ ("OpenCL::Context::program_with_binary", "devices", *av_fetch ((AV *)devices, i, 0), "OpenCL::Device");
1344 STRLEN len;
1345 binary_list [i] = (const unsigned char *)SvPVbyte (*av_fetch ((AV *)binaries, i, 0), len);
1346 length_list [i] = len;
1347 }
1348
1349 NEED_SUCCESS_ARG (cl_program prog, CreateProgramWithBinary, (self, count, device_list, length_list, binary_list, GIMME_V == G_ARRAY ? status_list : 0, &res));
1350
1351 EXTEND (SP, 2);
1352 PUSH_CLOBJ (stash_program, prog);
1353
1354 if (GIMME_V == G_ARRAY)
1355 {
1356 AV *av = newAV ();
1357 PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
1358
1359 for (i = count; i--; )
1360 av_store (av, i, newSViv (status_list [i]));
1361 }
1362
1284#BEGIN:context 1363#BEGIN:context
1285 1364
1286void 1365void
1287reference_count (OpenCL::Context self) 1366reference_count (OpenCL::Context self)
1288 ALIAS: 1367 ALIAS:
… …
1383fill_image (OpenCL::Queue self, OpenCL::Image img, NV r, NV g, NV b, NV a, size_t x, size_t y, size_t z, size_t width, size_t height, size_t depth, ...) 1462fill_image (OpenCL::Queue self, OpenCL::Image img, NV r, NV g, NV b, NV a, size_t x, size_t y, size_t z, size_t width, size_t height, size_t depth, ...)
1384 ALIAS: 1463 ALIAS:
1385 enqueue_fill_image = 0 1464 enqueue_fill_image = 0
1386 PPCODE: 1465 PPCODE:
1387 cl_event ev = 0; 1466 cl_event ev = 0;
1388 STRLEN len;
1389 const size_t origin [3] = { x, y, z }; 1467 const size_t origin [3] = { x, y, z };
1390 const size_t region [3] = { width, height, depth }; 1468 const size_t region [3] = { width, height, depth };
1391 EVENT_LIST (12); 1469 EVENT_LIST (12);
1392 1470
1393 const cl_float c_f [4] = { r, g, b, a }; 1471 const cl_float c_f [4] = { r, g, b, a };
… …
1607 1685
1608 if (ev) 1686 if (ev)
1609 XPUSH_CLOBJ (stash_event, ev); 1687 XPUSH_CLOBJ (stash_event, ev);
1610 1688
1611void 1689void
1612map_buffer (OpenCL::Queue self, OpenCL::Buffer buf, cl_bool blocking = 1, cl_map_flags map_flags = CL_MAP_READ | CL_MAP_WRITE, size_t offset = 0, size_t cb = 0, ...) 1690map_buffer (OpenCL::Queue self, OpenCL::Buffer buf, cl_bool blocking = 1, cl_map_flags map_flags = CL_MAP_READ | CL_MAP_WRITE, size_t offset = 0, SV *cb_ = &PL_sv_undef, ...)
1613 ALIAS: 1691 ALIAS:
1614 enqueue_map_buffer = 0 1692 enqueue_map_buffer = 0
1615 PPCODE: 1693 PPCODE:
1616 cl_event ev; 1694 cl_event ev;
1617 EVENT_LIST (7); 1695 EVENT_LIST (6);
1696 size_t cb = SvIV (cb_);
1697
1698 if (!SvOK (cb_))
1699 {
1700 NEED_SUCCESS (GetMemObjectInfo, (buf, CL_MEM_SIZE, sizeof (cb), &cb, 0));
1701 cb -= offset;
1702 }
1618 1703
1619 NEED_SUCCESS_ARG (void *ptr, EnqueueMapBuffer, (self, buf, blocking, map_flags, offset, cb, event_list_count, event_list_ptr, &ev, &res)); 1704 NEED_SUCCESS_ARG (void *ptr, EnqueueMapBuffer, (self, buf, blocking, map_flags, offset, cb, event_list_count, event_list_ptr, &ev, &res));
1620 XPUSHs (mapped_new (stash_mappedbuffer, self, buf, map_flags, ptr, cb, ev, 0, 0)); 1705 XPUSHs (mapped_new (stash_mappedbuffer, self, buf, map_flags, ptr, cb, ev, 0, 0));
1621 1706
1622void 1707void
1623map_image (OpenCL::Queue self, OpenCL::Image img, cl_bool blocking = 1, cl_map_flags map_flags = CL_MAP_READ | CL_MAP_WRITE, size_t x = 0, size_t y = 0, size_t z = 0, size_t width = 0, size_t height = 0, size_t depth = 0, ...) 1708map_image (OpenCL::Queue self, OpenCL::Image img, cl_bool blocking = 1, cl_map_flags map_flags = CL_MAP_READ | CL_MAP_WRITE, size_t x = 0, size_t y = 0, size_t z = 0, SV *width_ = &PL_sv_undef, SV *height_ = &PL_sv_undef, SV *depth_ = &PL_sv_undef, ...)
1624 ALIAS: 1709 ALIAS:
1625 enqueue_map_image = 0 1710 enqueue_map_image = 0
1626 PPCODE: 1711 PPCODE:
1627 cl_event ev; 1712 size_t width = SvIV (width_);
1713 if (!SvOK (width_))
1714 {
1715 NEED_SUCCESS (GetImageInfo, (img, CL_IMAGE_WIDTH, sizeof (width), &width, 0));
1716 width -= x;
1717 }
1718
1719 size_t height = SvIV (width_);
1720 if (!SvOK (height_))
1721 {
1722 NEED_SUCCESS (GetImageInfo, (img, CL_IMAGE_HEIGHT, sizeof (height), &height, 0));
1723 height -= y;
1724 }
1725
1726 size_t depth = SvIV (width_);
1727 if (!SvOK (depth_))
1728 {
1729 NEED_SUCCESS (GetImageInfo, (img, CL_IMAGE_DEPTH, sizeof (depth), &depth, 0));
1730 depth -= z;
1731
1732 // stupid opencl returns 0 for depth, but requires 1 for 2d images
1733 if (!depth)
1734 depth = 1;
1735 }
1736
1628 const size_t origin[3] = { x, y, z }; 1737 const size_t origin[3] = { x, y, z };
1629 const size_t region[3] = { width, height, depth }; 1738 const size_t region[3] = { width, height, depth };
1630 size_t row_pitch, slice_pitch; 1739 size_t row_pitch, slice_pitch;
1631 EVENT_LIST (11); 1740 EVENT_LIST (10);
1632 1741
1742 cl_event ev;
1633 NEED_SUCCESS_ARG (void *ptr, EnqueueMapImage, (self, img, blocking, map_flags, origin, region, &row_pitch, &slice_pitch, event_list_count, event_list_ptr, &ev, &res)); 1743 NEED_SUCCESS_ARG (void *ptr, EnqueueMapImage, (self, img, blocking, map_flags, origin, region, &row_pitch, &slice_pitch, event_list_count, event_list_ptr, &ev, &res));
1634 1744
1635 size_t cb = slice_pitch ? slice_pitch * region [2] 1745 size_t cb = slice_pitch ? slice_pitch * region [2]
1636 : row_pitch ? row_pitch * region [1] 1746 : row_pitch ? row_pitch * region [1]
1637 : region [0]; 1747 : region [0];
… …
1639 XPUSHs (mapped_new (stash_mappedimage, self, img, map_flags, ptr, cb, ev, row_pitch, slice_pitch)); 1749 XPUSHs (mapped_new (stash_mappedimage, self, img, map_flags, ptr, cb, ev, row_pitch, slice_pitch));
1640 1750
1641void 1751void
1642unmap (OpenCL::Queue self, OpenCL::Mapped mapped, ...) 1752unmap (OpenCL::Queue self, OpenCL::Mapped mapped, ...)
1643 PPCODE: 1753 PPCODE:
1644 cl_uint event_list_count = items - 2; 1754 mapped_unmap (ST (1), mapped, self, &ST (2), items - 2);
1645 cl_event *event_list_ptr = event_list (&ST (2), &event_list_count, mapped->event);
1646
1647 NEED_SUCCESS (EnqueueUnmapMemObject, (self, mapped->memobj, mapped->ptr, event_list_count, event_list_ptr, &mapped->event));
1648 mapped_detach (ST (1), mapped);
1649
1650 if (GIMME_V != G_VOID) 1755 if (GIMME_V != G_VOID)
1756 {
1757 clRetainEvent (mapped->event);
1651 XPUSH_CLOBJ (stash_event, mapped->event); 1758 XPUSH_CLOBJ (stash_event, mapped->event);
1759 }
1652 1760
1653void 1761void
1654task (OpenCL::Queue self, OpenCL::Kernel kernel, ...) 1762task (OpenCL::Queue self, OpenCL::Kernel kernel, ...)
1655 ALIAS: 1763 ALIAS:
1656 enqueue_task = 0 1764 enqueue_task = 0
… …
2708 2816
2709 clEnqueueUnmapMemObject (mapped->queue, mapped->memobj, mapped->ptr, 1, &mapped->event, 0); 2817 clEnqueueUnmapMemObject (mapped->queue, mapped->memobj, mapped->ptr, 1, &mapped->event, 0);
2710 mapped_detach (self, mapped); 2818 mapped_detach (self, mapped);
2711 2819
2712 clReleaseCommandQueue (mapped->queue); 2820 clReleaseCommandQueue (mapped->queue);
2713
2714 if (mapped->event)
2715 clReleaseEvent (mapped->event); 2821 clReleaseEvent (mapped->event);
2716
2717 Safefree (mapped); 2822 Safefree (mapped);
2823
2824void
2825unmap (OpenCL::Mapped self, ...)
2826 CODE:
2827 mapped_unmap (ST (0), self, self->queue, &ST (1), items - 1);
2718 2828
2719bool 2829bool
2720mapped (OpenCL::Mapped self) 2830mapped (OpenCL::Mapped self)
2721 CODE: 2831 CODE:
2722 RETVAL = !!self->ptr; 2832 RETVAL = !!self->ptr;
… …
2749ptr (OpenCL::Mapped self) 2859ptr (OpenCL::Mapped self)
2750 CODE: 2860 CODE:
2751 RETVAL = PTR2IV (self->ptr); 2861 RETVAL = PTR2IV (self->ptr);
2752 OUTPUT: 2862 OUTPUT:
2753 RETVAL 2863 RETVAL
2864
2865void
2866set (OpenCL::Mapped self, size_t offset, SV *data)
2867 CODE:
2868 STRLEN len;
2869 const char *ptr = SvPVbyte (data, len);
2870
2871 if (offset + len > self->cb)
2872 croak ("OpenCL::Mapped::set out of bound condition detected");
2873
2874 memcpy (offset + (char *)self->ptr, ptr, len);
2754 2875
2755MODULE = OpenCL PACKAGE = OpenCL::MappedBuffer 2876MODULE = OpenCL PACKAGE = OpenCL::MappedBuffer
2756 2877
2757MODULE = OpenCL PACKAGE = OpenCL::MappedImage 2878MODULE = OpenCL PACKAGE = OpenCL::MappedImage
2758 2879

Diff Legend

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