SEXP devnext(SEXP args)
{
checkArity_length;
int nxt = INTEGER(CAR(args))[0];
if (nxt == NA_INTEGER) error(_("NA argument is invalid"));
return ScalarInteger( nextDevice(nxt - 1) + 1 );
}
int selectDevice(int devNum)
{
/* Valid to select nullDevice, but that will open a new device.
See ?dev.set.
*/
if((devNum >= 0) && (devNum < R_MaxDevices) &&
(R_Devices[devNum] != NULL) && active[devNum])
{
pGEDevDesc gdd;
if (!NoDevices()) {
pGEDevDesc oldd = GEcurrentDevice();
if (oldd->dev->deactivate) oldd->dev->deactivate(oldd->dev);
}
R_CurrentDevice = devNum;
/* maintain .Device */
gsetVar(R_DeviceSymbol,
elt(getSymbolValue(R_DevicesSymbol), devNum),
R_BaseEnv);
gdd = GEcurrentDevice(); /* will start a device if current is null */
if (!NoDevices()) /* which it always will be */
if (gdd->dev->activate) gdd->dev->activate(gdd->dev);
return devNum;
}
else
return selectDevice(nextDevice(devNum));
}
/**
* Device disposed handler
**/
void DeviceManager::notifyDisposed(Disposable* disposed)
{
Container::iterator pos = std::find( devices.begin(), devices.end(), static_cast<Device*>( disposed ) );
assert( pos != devices.end() );
if ( pos == current ) {
if ( devices.size() == 1 )
current = devices.end();
else
nextDevice();
}
devices.erase(pos);
}
int mandelbrotvis (cl_int *data, cl_fract *job)
{
cl_int error;
int i;
#if MULTI_GPUS
int currentdevice = nextDevice();
#else
int currentdevice = 0;
#endif
cl_command_queue *cqm = get_command_queue();
cl_context *cm = get_cl_context();
// Allocate memory for the kernel to work with
cl_mem mem1, mem2;
mem1 = clCreateBuffer(*cm, CL_MEM_WRITE_ONLY, sizeof(cl_int)*(visheight*viswidth*framesperworker), 0, &error);
if (mandelbrot_cl_float) {
cl_float jobfloat[framesperworker*JOBS_PER_FRAME];
for (i=0; i<framesperworker*JOBS_PER_FRAME; i++)
jobfloat[i] = (cl_float) job[i];
mem2 = clCreateBuffer(*cm, CL_MEM_COPY_HOST_PTR, sizeof(cl_float)*framesperworker*JOBS_PER_FRAME, jobfloat, &error);
} else {
mem2 = clCreateBuffer(*cm, CL_MEM_COPY_HOST_PTR, sizeof(cl_fract)*framesperworker*JOBS_PER_FRAME, job, &error);
}
// get a handle and map parameters for the kernel
error = clSetKernelArg(k_mandelbrotvis[currentdevice], 0, sizeof(mem1), &mem1);
error = clSetKernelArg(k_mandelbrotvis[currentdevice], 1, sizeof(mem2), &mem2);
size_t worksize[3] = {visheight, viswidth, framesperworker};
error = clEnqueueNDRangeKernel(*cqm, k_mandelbrotvis[currentdevice], 3, NULL, &worksize[0], 0, 0, 0, 0);
// Read the result back into data
error = clEnqueueReadBuffer(*cqm, mem1, CL_TRUE, 0, sizeof(cl_int)*(visheight*viswidth*framesperworker), data, 0, 0, 0);
// cleanup - don't perform a flush as the queue is now shared between all executions. The
// blocking clEnqueueReadBuffer should be enough
clReleaseMemObject(mem1);
clReleaseMemObject(mem2);
if (error) {
fprintf (stderr, "ERROR! : %s\n", errorMessageCL(error));
exit(10);
}
return error;
}
/* historically the close was in the [kK]illDevices.
only use findNext = FALSE when shutting R dowm, and .Device[s] are not
updated.
*/
static
void removeDevice(int devNum, Rboolean findNext)
{
/* Not vaild to remove nullDevice */
if((devNum > 0) && (devNum < R_MaxDevices) &&
(R_Devices[devNum] != NULL) && active[devNum])
{
int i;
SEXP s;
pGEDevDesc g = R_Devices[devNum];
active[devNum] = FALSE; /* stops it being selected again */
R_NumDevices--;
if(findNext) {
/* maintain .Devices */
PROTECT(s = getSymbolValue(R_DevicesSymbol));
for (i = 0; i < devNum; i++) s = CDR(s);
SETCAR(s, mkString(""));
UNPROTECT(1);
/* determine new current device */
if (devNum == R_CurrentDevice) {
R_CurrentDevice = nextDevice(R_CurrentDevice);
/* maintain .Device */
gsetVar(R_DeviceSymbol,
elt(getSymbolValue(R_DevicesSymbol), R_CurrentDevice),
R_BaseEnv);
/* activate new current device */
if (R_CurrentDevice) {
pGEDevDesc gdd = GEcurrentDevice();
if(gdd->dev->activate) gdd->dev->activate(gdd->dev);
}
}
}
g->dev->close(g->dev);
GEdestroyDevDesc(g);
R_Devices[devNum] = NULL;
}
}
SEXP attribute_hidden
do_getGraphicsEvent(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP result = R_NilValue, prompt;
pDevDesc dd;
pGEDevDesc gd;
int i, count=0, devNum;
checkArity(op, args);
prompt = CAR(args);
if (!isString(prompt) || !length(prompt)) error(_("invalid prompt"));
/* NB: cleanup of event handlers must be done by driver in onExit handler */
if (!NoDevices()) {
/* Initialize all devices */
i = 1;
devNum = curDevice();
while (i++ < NumDevices()) {
gd = GEgetDevice(devNum);
dd = gd->dev;
if (dd->gettingEvent)
error(_("recursive use of getGraphicsEvent not supported"));
if (dd->eventEnv != R_NilValue) {
if (dd->eventHelper) dd->eventHelper(dd, 1);
dd->gettingEvent = TRUE;
defineVar(install("result"), R_NilValue, dd->eventEnv);
count++;
}
devNum = nextDevice(devNum);
}
if (!count)
error(_("no graphics event handlers set"));
Rprintf("%s\n", CHAR(asChar(prompt)));
R_FlushConsole();
/* Poll them */
while (result == R_NilValue) {
R_ProcessEvents();
R_CheckUserInterrupt();
i = 1;
devNum = curDevice();
while (i++ < NumDevices()) {
gd = GEgetDevice(devNum);
dd = gd->dev;
if (dd->eventEnv != R_NilValue) {
if (dd->eventHelper) dd->eventHelper(dd, 2);
result = findVar(install("result"), dd->eventEnv);
if (result != R_NilValue && result != R_UnboundValue) {
break;
}
}
devNum = nextDevice(devNum);
}
}
/* clean up */
i = 1;
devNum = curDevice();
while (i++ < NumDevices()) {
gd = GEgetDevice(devNum);
dd = gd->dev;
if (dd->eventEnv != R_NilValue) {
if (dd->eventHelper) dd->eventHelper(dd, 0);
dd->gettingEvent = FALSE;
}
devNum = nextDevice(devNum);
}
}
return(result);
}
int mandelbrot (cl_char (*data)[200], cl_fract *job)
{
cl_int error;
int i;
#if ERROR_CHECK
if (prog == NULL) {
init_mandelbrot();
}
#endif
#if MULTI_GPUS
// move to new context/cq
int currentdevice = nextDevice();
cl_command_queue *cq = get_command_queue();
cl_context *context = get_cl_context();
#else
int currentdevice = 0;
#endif
// Allocate memory for the kernel to work with
cl_mem mem1, mem2;
mem1 = clCreateBuffer(*context, CL_MEM_WRITE_ONLY, sizeof(cl_char)*(IMAGEHEIGHT*IMAGEWIDTH*2), 0, &error);
if (mandelbrot_cl_float) {
cl_float jobfloat[4];
for (i=0; i<4; i++)
jobfloat[i] = (cl_float) job[i];
mem2 = clCreateBuffer(*context, CL_MEM_COPY_HOST_PTR, sizeof(cl_float)*4, jobfloat, &error);
} else {
mem2 = clCreateBuffer(*context, CL_MEM_COPY_HOST_PTR, sizeof(cl_fract)*4, job, &error);
}
// get a handle and map parameters for the kernel
error = clSetKernelArg(k_mandelbrot[currentdevice], 0, sizeof(cl_mem), &mem1);
error = clSetKernelArg(k_mandelbrot[currentdevice], 1, sizeof(cl_mem), &mem2);
// Perform the operation (width is 100 in this example)
size_t worksize[3] = {IMAGEHEIGHT, IMAGEWIDTH, 0};
error = clEnqueueNDRangeKernel(*cq, k_mandelbrot[currentdevice], 2, NULL, &worksize[0], 0, 0, 0, 0);
// Read the result back into data
error = clEnqueueReadBuffer(*cq, mem1, CL_TRUE, 0, sizeof(cl_char)*(IMAGEHEIGHT*IMAGEWIDTH*2), data, 0, 0, 0);
// cleanup - don't perform a flush as the queue is now shared between all executions. The
// blocking clEnqueueReadBuffer should be enough
clReleaseMemObject(mem1);
clReleaseMemObject(mem2);
if (error) {
fprintf (stderr, "ERROR! : %s\n", errorMessageCL(error));
exit(10);
}
#if C_PRINT
// this will print a frame coming out of the CL kernel in a dirty but functional manner
int j;
int colour = -1;
for (i=0; i < IMAGEHEIGHT; i++) {
for (j=0; j < IMAGEWIDTH*2; j++) {
if (colour != data[i][j]) {
colour = data[i][j];
textcolour(colour);
}
j++;
fprintf (stdout, "%c", data[i][j]);
}
fprintf(stdout, "\n");
}
#endif
return error;
}
