--- OpenCL/OpenCL.xs 2012/04/19 13:06:55 1.26 +++ OpenCL/OpenCL.xs 2012/04/19 14:36:46 1.31 @@ -2,6 +2,10 @@ #include "perl.h" #include "XSUB.h" +#ifdef I_DLFCN + #include +#endif + #ifdef __APPLE__ #include #else @@ -33,6 +37,22 @@ /*****************************************************************************/ +// name must include a leading underscore +static void * +getsym (const char *name) +{ + #if defined I_DLFCN && defined RTLD_DEFAULT + #if !DLSYM_NEEDS_UNDERSCORE + ++name; // skip _ + #endif + return dlsym (RTLD_DEFAULT, name); + #else + return 0; + #endif +} + +/*****************************************************************************/ + /* up to two temporary buffers */ static void * tmpbuf (size_t size) @@ -146,7 +166,7 @@ if (SvROK (sv) && SvTYPE (SvRV (sv)) == SVt_PVAV) { AV *av = (AV *)SvRV (sv); - int i, len = av_len (av); + int i, len = av_len (av) + 1; cl_context_properties *p = tmpbuf (sizeof (cl_context_properties) * (len + extracount + 1)); cl_context_properties *l = p; @@ -158,14 +178,15 @@ for (i = 0; i < len; i += 2) { - cl_context_properties t = SvIV (*av_fetch (av, i, 0)); + cl_context_properties t = SvIV (*av_fetch (av, i , 0)); + SV *p_sv = *av_fetch (av, i + 1, 0); cl_context_properties v; switch (t) { default: /* unknown property, treat as int */ - v = SvIV (*av_fetch (av, i, 0)); + v = SvIV (p_sv); break; } @@ -338,7 +359,7 @@ context (OpenCL::Platform self, cl_context_properties *properties = 0, SV *devices, FUTURE notify = 0) PPCODE: if (!SvROK (devices) || SvTYPE (SvRV (devices)) != SVt_PVAV) - croak ("OpenCL::Platform argument 'device' must be an arrayref with device objects, in call"); + croak ("OpenCL::Platform::context argument 'device' must be an arrayref with device objects, in call"); AV *av = (AV *)SvRV (devices); cl_uint num_devices = av_len (av) + 1; @@ -618,7 +639,7 @@ buffer (OpenCL::Context self, cl_mem_flags flags, size_t len) PPCODE: if (flags & (CL_MEM_USE_HOST_PTR | CL_MEM_COPY_HOST_PTR)) - croak ("clCreateBuffer: cannot use/copy host ptr when no data is given, use $context->buffer_sv instead?"); + croak ("OpenCL::Context::buffer: cannot use/copy host ptr when no data is given, use $context->buffer_sv instead?"); NEED_SUCCESS_ARG (cl_mem mem, CreateBuffer, (self, flags, len, 0, &res)); XPUSH_NEW_OBJ ("OpenCL::BufferObj", mem); @@ -629,7 +650,7 @@ STRLEN len; char *ptr = SvOK (data) ? SvPVbyte (data, len) : 0; if (!(flags & (CL_MEM_USE_HOST_PTR | CL_MEM_COPY_HOST_PTR))) - croak ("clCreateBuffer: have to specify use or copy host ptr when buffer data is given, use $context->buffer instead?"); + croak ("OpenCL::Context::buffer_sv: you have to specify use or copy host ptr when buffer data is given, use $context->buffer instead?"); NEED_SUCCESS_ARG (cl_mem mem, CreateBuffer, (self, flags, len, ptr, &res)); XPUSH_NEW_OBJ ("OpenCL::BufferObj", mem); @@ -1039,33 +1060,35 @@ if (ev) XPUSH_NEW_OBJ ("OpenCL::Event", ev); -#if 0 #if cl_apple_gl_sharing || cl_khr_gl_sharing void enqueue_acquire_gl_objects (OpenCL::Queue self, SV *objects, ...) + ALIAS: + enqueue_release_gl_objects = 1 CODE: - cl_event ev = 0; - EVENT_LIST (2, items - 2); - - NEED_SUCCESS (EnqueueAcquireGLObjects, (self, ..., event_list_count, event_list_ptr, GIMME_V != G_VOID ? &ev : 0)); - - if (ev) - XPUSH_NEW_OBJ ("OpenCL::Event", ev); + if (!SvROK (objects) || SvTYPE (SvRV (objects)) != SVt_PVAV) + croak ("OpenCL::Queue::enqueue_acquire/release_gl_objects argument 'objects' must be an arrayref with memory objects, in call"); -void -enqueue_release_gl_objects (OpenCL::Queue self, SV *objects, ...) - CODE: cl_event ev = 0; EVENT_LIST (2, items - 2); + AV *av = (AV *)SvRV (objects); + cl_uint num_objects = av_len (av) + 1; + cl_mem *object_list = tmpbuf (sizeof (cl_mem) * num_objects); + int i; - NEED_SUCCESS (EnqueueAcquireGLObjects, (self, ..., event_list_count, event_list_ptr, GIMME_V != G_VOID ? &ev : 0)); + for (i = num_objects; i--; ) + object_list [i] = SvPTROBJ ("OpenCL::Queue::enqueue_acquire/release_gl_objects", "objects", *av_fetch (av, i, 0), "OpenCL::Memory"); + + if (ix) + NEED_SUCCESS (EnqueueReleaseGLObjects, (self, num_objects, object_list, event_list_count, event_list_ptr, GIMME_V != G_VOID ? &ev : 0)); + else + NEED_SUCCESS (EnqueueAcquireGLObjects, (self, num_objects, object_list, event_list_count, event_list_ptr, GIMME_V != G_VOID ? &ev : 0)); if (ev) XPUSH_NEW_OBJ ("OpenCL::Event", ev); #endif -#endif void enqueue_marker (OpenCL::Queue self) @@ -1243,7 +1266,7 @@ PPCODE: cl_gl_object_type type; cl_GLuint name; - NEED_SUCCESS (clGetGLObjectInfo, (self, &type, &name)); + NEED_SUCCESS (GetGLObjectInfo, (self, &type, &name)); EXTEND (SP, 2); PUSHs (sv_2mortal (newSVuv (type))); PUSHs (sv_2mortal (newSVuv (name))); @@ -1298,7 +1321,7 @@ target (OpenCL::Image self) PPCODE: cl_GLenum value [1]; - NEED_SUCCESS (GetGlTextureInfo, (self, CL_GL_TEXTURE_TARGET, sizeof (value), value, 0)); + NEED_SUCCESS (GetGLTextureInfo, (self, CL_GL_TEXTURE_TARGET, sizeof (value), value, 0)); EXTEND (SP, 1); const int i = 0; PUSHs (sv_2mortal (newSVuv (value [i]))); @@ -1307,7 +1330,7 @@ gl_mipmap_level (OpenCL::Image self) PPCODE: cl_GLint value [1]; - NEED_SUCCESS (GetGlTextureInfo, (self, CL_GL_MIPMAP_LEVEL, sizeof (value), value, 0)); + NEED_SUCCESS (GetGLTextureInfo, (self, CL_GL_MIPMAP_LEVEL, sizeof (value), value, 0)); EXTEND (SP, 1); const int i = 0; PUSHs (sv_2mortal (newSViv (value [i])));