LCOV - code coverage report
Current view: top level - monetdb5/extras/rapi - rapi.c (source / functions) Hit Total Coverage
Test: coverage.info Lines: 221 271 81.5 %
Date: 2020-06-29 20:00:14 Functions: 11 12 91.7 %

          Line data    Source code
       1             : /*
       2             :  * This Source Code Form is subject to the terms of the Mozilla Public
       3             :  * License, v. 2.0.  If a copy of the MPL was not distributed with this
       4             :  * file, You can obtain one at http://mozilla.org/MPL/2.0/.
       5             :  *
       6             :  * Copyright 1997 - July 2008 CWI, August 2008 - 2020 MonetDB B.V.
       7             :  */
       8             : 
       9             : /*
      10             :  * H. Muehleisen, M. Kersten
      11             :  * The R interface
      12             :  */
      13             : #include "monetdb_config.h"
      14             : #include "mal.h"
      15             : #include "mal_stack.h"
      16             : #include "mal_linker.h"
      17             : #include "gdk_utils.h"
      18             : #include "gdk.h"
      19             : #include "sql_catalog.h"
      20             : #include "sql_execute.h"
      21             : #include "rapi.h"
      22             : 
      23             : // R headers
      24             : #define R_INTERFACE_PTRS 1
      25             : #define CSTACK_DEFNS 1
      26             : 
      27             : /* R redefines these */
      28             : #undef SIZEOF_SIZE_T
      29             : #undef ERROR
      30             : 
      31             : #define USE_RINTERNALS 1
      32             : 
      33             : #include <Rversion.h>
      34             : #include <Rembedded.h>
      35             : #include <Rdefines.h>
      36             : #include <Rinternals.h>
      37             : #include <R_ext/Parse.h>
      38             : 
      39             : // other headers
      40             : #include <string.h>
      41             : 
      42             : //#define _RAPI_DEBUG_
      43             : 
      44             : // this macro blows up mmath.h pragmas
      45             : #ifdef warning
      46             : # undef warning
      47             : #endif
      48             : 
      49             : /* we need the BAT-SEXP-BAT conversion in two places, here and in tools/embedded */
      50             : #include "converters.c.h"
      51             : 
      52             : const char* rapi_enableflag = "embedded_r";
      53             : 
      54          79 : static bool RAPIEnabled(void) {
      55          79 :         return (GDKgetenv_istrue(rapi_enableflag)
      56          79 :                         || GDKgetenv_isyes(rapi_enableflag));
      57             : }
      58             : 
      59             : // The R-environment should be single threaded, calling for some protective measures.
      60             : static MT_Lock rapiLock = MT_LOCK_INITIALIZER("rapiLock");
      61             : static bool rapiInitialized = false;
      62             : static char* rtypenames[] = { "NIL", "SYM", "LIST", "CLO", "ENV", "PROM",
      63             :                 "LANG", "SPECIAL", "BUILTIN", "CHAR", "LGL", "unknown", "unknown",
      64             :                 "INT", "REAL", "CPLX", "STR", "DOT", "ANY", "VEC", "EXPR", "BCODE",
      65             :                 "EXTPTR", "WEAKREF", "RAW", "S4" };
      66             : 
      67             : static Client rapiClient = NULL;
      68             : 
      69             : 
      70             : // helper function to translate R TYPEOF() return values to something readable
      71           0 : char* rtypename(int rtypeid) {
      72           0 :         if (rtypeid < 0 || rtypeid > 25) {
      73             :                 return "unknown";
      74             :         } else
      75           0 :                 return rtypenames[rtypeid];
      76             : }
      77             : 
      78          68 : void writeConsoleEx(const char * buf, int buflen, int foo) {
      79          68 :         (void) buflen;
      80          68 :         (void) foo;
      81          68 :         (void) buf; // silence compiler
      82             : #ifdef _RAPI_DEBUG_
      83             :         printf("# %s", buf);
      84             : #endif
      85          68 : }
      86             : 
      87          68 : void writeConsole(const char * buf, int buflen) {
      88          68 :         writeConsoleEx(buf, buflen, -42);
      89          68 : }
      90             : 
      91           6 : void clearRErrConsole(void) {
      92             :         // Do nothing?
      93           6 : }
      94             : 
      95             : static char *RAPIinstalladdons(void);
      96             : 
      97             : /* UNIX-like initialization */
      98             : #ifndef WIN32
      99             : 
     100             : #define R_INTERFACE_PTRS 1
     101             : #define CSTACK_DEFNS 1
     102             : #include <Rinterface.h>
     103             : 
     104           7 : static char *RAPIinitialize(void) {
     105             : // TODO: check for header/library version mismatch?
     106           7 :         char *e;
     107             : 
     108             :         // set R_HOME for packages etc. We know this from our configure script
     109           7 :         putenv("R_HOME=" RHOME);
     110             : 
     111             :         // set some command line arguments
     112             :         {
     113           7 :                 structRstart rp;
     114           7 :                 char *rargv[] = { "R",
     115             : #if R_VERSION >= R_Version(4,0,0)
     116             :                                                   "--no-echo",
     117             : #else
     118             :                                                   "--slave",
     119             : #endif
     120             :                                                   "--vanilla" };
     121           7 :                 int stat = 0;
     122             : 
     123           7 :                 R_DefParams(&rp);
     124             : #if R_VERSION >= R_Version(4,0,0)
     125             :                 rp.R_NoEcho = (Rboolean) TRUE;
     126             : #else
     127           7 :                 rp.R_Slave = (Rboolean) TRUE;
     128             : #endif
     129           7 :                 rp.R_Quiet = (Rboolean) TRUE;
     130           7 :                 rp.R_Interactive = (Rboolean) FALSE;
     131           7 :                 rp.R_Verbose = (Rboolean) FALSE;
     132           7 :                 rp.LoadSiteFile = (Rboolean) FALSE;
     133           7 :                 rp.LoadInitFile = (Rboolean) FALSE;
     134           7 :                 rp.RestoreAction = SA_NORESTORE;
     135           7 :                 rp.SaveAction = SA_NOSAVE;
     136           7 :                 rp.NoRenviron = TRUE;
     137           7 :                 stat = Rf_initialize_R(2, rargv);
     138           7 :                 if (stat < 0) {
     139           0 :                         return "Rf_initialize failed";
     140             :                 }
     141           7 :                 R_SetParams(&rp);
     142             :         }
     143             : 
     144             :         /* disable stack checking, because threads will throw it off */
     145           7 :         R_CStackLimit = (uintptr_t) -1;
     146             :         /* redirect input/output and set error handler */
     147           7 :         R_Outputfile = NULL;
     148           7 :         R_Consolefile = NULL;
     149             :         /* we do not want R to handle any signal, will interfere with monetdbd */
     150           7 :         R_SignalHandlers = 0;
     151             :         /* we want control R's output and input */
     152           7 :         ptr_R_WriteConsoleEx = writeConsoleEx;
     153           7 :         ptr_R_WriteConsole = writeConsole;
     154           7 :         ptr_R_ReadConsole = NULL;
     155           7 :         ptr_R_ClearerrConsole = clearRErrConsole;
     156             : 
     157             :         // big boy here
     158           7 :         setup_Rmainloop();
     159             : 
     160           7 :         if ((e = RAPIinstalladdons()) != 0) {
     161             :                 return e;
     162             :         }
     163             :         // patch R internals to disallow quit and system. Setting them to NULL produces an error.
     164           7 :         SET_INTERNAL(install("quit"), R_NilValue);
     165             :         // install.packages() uses system2 to call gcc etc., so we cannot disable it (perhaps store the pointer somewhere just for that?)
     166             :         //SET_INTERNAL(install("system"), R_NilValue);
     167             : 
     168           7 :         rapiInitialized = true;
     169           7 :         return NULL;
     170             : }
     171             : #else
     172             : 
     173             : #define S_IRWXU         0000700
     174             : 
     175             : static char *RAPIinitialize(void) {
     176             :         return "Sorry, no R API on Windows";
     177             : }
     178             : 
     179             : #endif
     180             : 
     181             : 
     182           7 : static char *RAPIinstalladdons(void) {
     183           7 :         int evalErr;
     184           7 :         ParseStatus status;
     185           7 :         char rlibs[FILENAME_MAX];
     186           7 :         char rapiinclude[BUFSIZ];
     187           7 :         SEXP librisexp;
     188           7 :         int len;
     189             : 
     190             :         // r library folder, create if not exists
     191           7 :         len = snprintf(rlibs, sizeof(rlibs), "%s%c%s", GDKgetenv("gdk_dbpath"), DIR_SEP, "rapi_packages");
     192           7 :         if (len == -1 || len >= FILENAME_MAX)
     193             :                 return "cannot create rapi_packages directory because the path is too large";
     194             : 
     195           7 :         if (mkdir(rlibs, S_IRWXU) != 0 && errno != EEXIST) {
     196             :                 return "cannot create rapi_packages directory";
     197             :         }
     198             : #ifdef _RAPI_DEBUG_
     199             :         printf("# R libraries installed in %s\n",rlibs);
     200             : #endif
     201             : 
     202           7 :         PROTECT(librisexp = allocVector(STRSXP, 1));
     203           7 :         SET_STRING_ELT(librisexp, 0, mkChar(rlibs));
     204           7 :         Rf_defineVar(Rf_install(".rapi.libdir"), librisexp, R_GlobalEnv);
     205           7 :         UNPROTECT(1);
     206             : 
     207             :         // run rapi.R environment setup script
     208             :         {
     209           7 :                 char *f = locate_file("rapi", ".R", 0);
     210           7 :                 snprintf(rapiinclude, sizeof(rapiinclude), "source(\"%s\")", f);
     211           7 :                 GDKfree(f);
     212             :         }
     213             : #if DIR_SEP != '/'
     214             :         {
     215             :                 char *p;
     216             :                 for (p = rapiinclude; *p; p++)
     217             :                         if (*p == DIR_SEP)
     218             :                                 *p = '/';
     219             :         }
     220             : #endif
     221           7 :         R_tryEvalSilent(
     222           7 :                 VECTOR_ELT(
     223             :                         R_ParseVector(mkString(rapiinclude), 1, &status,
     224             :                                                   R_NilValue), 0), R_GlobalEnv, &evalErr);
     225             : 
     226             :         // of course the script may contain errors as well
     227           7 :         if (evalErr != FALSE) {
     228           0 :                 return "failure running R setup script";
     229             :         }
     230             :         return NULL;
     231             : }
     232             : 
     233          64 : rapi_export str RAPIevalStd(Client cntxt, MalBlkPtr mb, MalStkPtr stk,
     234             :                                                         InstrPtr pci) {
     235          64 :         return RAPIeval(cntxt, mb, stk, pci, 0);
     236             : }
     237           8 : rapi_export str RAPIevalAggr(Client cntxt, MalBlkPtr mb, MalStkPtr stk,
     238             :                                                          InstrPtr pci) {
     239           8 :         return RAPIeval(cntxt, mb, stk, pci, 1);
     240             : }
     241             : 
     242          72 : str RAPIeval(Client cntxt, MalBlkPtr mb, MalStkPtr stk, InstrPtr pci, bit grouped) {
     243          72 :         sql_func * sqlfun = NULL;
     244          72 :         str exprStr = *getArgReference_str(stk, pci, pci->retc + 1);
     245             : 
     246          72 :         SEXP x, env, retval;
     247          72 :         SEXP varname = R_NilValue;
     248          72 :         SEXP varvalue = R_NilValue;
     249          72 :         ParseStatus status;
     250          72 :         int i = 0;
     251          72 :         char argbuf[64];
     252          72 :         char *argnames = NULL;
     253          72 :         size_t argnameslen;
     254          72 :         size_t pos;
     255          72 :         char* rcall = NULL;
     256          72 :         size_t rcalllen;
     257          72 :         int ret_cols = 0; /* int because pci->retc is int, too*/
     258          72 :         str *args;
     259          72 :         int evalErr;
     260          72 :         char *msg = MAL_SUCCEED;
     261          72 :         BAT *b;
     262          72 :         node * argnode;
     263          72 :         int seengrp = FALSE;
     264             : 
     265          72 :         rapiClient = cntxt;
     266             : 
     267          72 :         if (!RAPIEnabled()) {
     268           0 :                 throw(MAL, "rapi.eval",
     269             :                           "Embedded R has not been enabled. Start server with --set %s=true",
     270             :                           rapi_enableflag);
     271             :         }
     272          72 :         if (!rapiInitialized) {
     273           0 :                 throw(MAL, "rapi.eval",
     274             :                           "Embedded R initialization has failed");
     275             :         }
     276             : 
     277          72 :         if (!grouped) {
     278          64 :                 sql_subfunc *sqlmorefun = (*(sql_subfunc**) getArgReference(stk, pci, pci->retc));
     279          64 :                 if (sqlmorefun) sqlfun = (*(sql_subfunc**) getArgReference(stk, pci, pci->retc))->func;
     280             :         } else {
     281           8 :                 sqlfun = *(sql_func**) getArgReference(stk, pci, pci->retc);
     282             :         }
     283             : 
     284          72 :         args = (str*) GDKzalloc(sizeof(str) * pci->argc);
     285          72 :         if (args == NULL) {
     286           0 :                 throw(MAL, "rapi.eval", SQLSTATE(HY013) MAL_MALLOC_FAIL);
     287             :         }
     288             : 
     289             :         // get the lock even before initialization of the R interpreter, as this can take a second and must be done only once.
     290          72 :         MT_lock_set(&rapiLock);
     291             : 
     292          72 :         env = PROTECT(eval(lang1(install("new.env")), R_GlobalEnv));
     293          72 :         assert(env != NULL);
     294             : 
     295             :         // first argument after the return contains the pointer to the sql_func structure
     296             :         // NEW macro temporarily renamed to MNEW to allow including sql_catalog.h
     297             : 
     298          72 :         if (sqlfun != NULL && sqlfun->ops->cnt > 0) {
     299          27 :                 int carg = pci->retc + 2;
     300          27 :                 argnode = sqlfun->ops->h;
     301         138 :                 while (argnode) {
     302         111 :                         char* argname = ((sql_arg*) argnode->data)->name;
     303         111 :                         args[carg] = GDKstrdup(argname);
     304         111 :                         carg++;
     305         111 :                         argnode = argnode->next;
     306             :                 }
     307             :         }
     308             :         // the first unknown argument is the group, we don't really care for the rest.
     309          72 :         argnameslen = 2;
     310         230 :         for (i = pci->retc + 2; i < pci->argc; i++) {
     311         158 :                 if (args[i] == NULL) {
     312          47 :                         if (!seengrp && grouped) {
     313           5 :                                 args[i] = GDKstrdup("aggr_group");
     314           5 :                                 seengrp = TRUE;
     315             :                         } else {
     316          42 :                                 snprintf(argbuf, sizeof(argbuf), "arg%i", i - pci->retc - 1);
     317          42 :                                 args[i] = GDKstrdup(argbuf);
     318             :                         }
     319             :                 }
     320         158 :                 argnameslen += strlen(args[i]) + 2; /* extra for ", " */
     321             :         }
     322             : 
     323             :         // install the MAL variables into the R environment
     324             :         // we can basically map values to int ("INTEGER") or double ("REAL")
     325         230 :         for (i = pci->retc + 2; i < pci->argc; i++) {
     326         158 :                 int bat_type = getBatType(getArgType(mb,pci,i));
     327             :                 // check for BAT or scalar first, keep code left
     328         158 :                 if (!isaBatType(getArgType(mb,pci,i))) {
     329          22 :                         b = COLnew(0, getArgType(mb, pci, i), 0, TRANSIENT);
     330          22 :                         if (b == NULL) {
     331           0 :                                 msg = createException(MAL, "rapi.eval", SQLSTATE(HY013) MAL_MALLOC_FAIL);
     332           0 :                                 goto wrapup;
     333             :                         }
     334          22 :                         if ( getArgType(mb,pci,i) == TYPE_str) {
     335           1 :                                 if (BUNappend(b, *getArgReference_str(stk, pci, i), false) != GDK_SUCCEED) {
     336           0 :                                         BBPreclaim(b);
     337           0 :                                         b = NULL;
     338           0 :                                         msg = createException(MAL, "rapi.eval", SQLSTATE(HY013) MAL_MALLOC_FAIL);
     339           0 :                                         goto wrapup;
     340             :                                 }
     341             :                         } else {
     342          21 :                                 if (BUNappend(b, getArgReference(stk, pci, i), false) != GDK_SUCCEED) {
     343           0 :                                         BBPreclaim(b);
     344           0 :                                         b = NULL;
     345           0 :                                         msg = createException(MAL, "rapi.eval", SQLSTATE(HY013) MAL_MALLOC_FAIL);
     346           0 :                                         goto wrapup;
     347             :                                 }
     348             :                         }
     349             :                 } else {
     350         136 :                         b = BATdescriptor(*getArgReference_bat(stk, pci, i));
     351         136 :                         if (b == NULL) {
     352           0 :                                 msg = createException(MAL, "rapi.eval", SQLSTATE(HY013) MAL_MALLOC_FAIL);
     353           0 :                                 goto wrapup;
     354             :                         }
     355             :                 }
     356             : 
     357             :                 // check the BAT count, if it is bigger than RAPI_MAX_TUPLES, fail
     358         158 :                 if (BATcount(b) > RAPI_MAX_TUPLES) {
     359           0 :                         msg = createException(MAL, "rapi.eval",
     360             :                                                                   "Got "BUNFMT" rows, but can only handle "LLFMT". Sorry.",
     361             :                                                                   BATcount(b), (lng) RAPI_MAX_TUPLES);
     362           0 :                         BBPunfix(b->batCacheid);
     363           0 :                         goto wrapup;
     364             :                 }
     365         158 :                 varname = PROTECT(Rf_install(args[i]));
     366         158 :                 varvalue = bat_to_sexp(b, bat_type);
     367         158 :                 if (varvalue == NULL) {
     368           0 :                         msg = createException(MAL, "rapi.eval", "unknown argument type ");
     369           0 :                         goto wrapup;
     370             :                 }
     371         158 :                 BBPunfix(b->batCacheid);
     372             : 
     373             :                 // install vector into R environment
     374         158 :                 Rf_defineVar(varname, varvalue, env);
     375         158 :                 UNPROTECT(2);
     376             :         }
     377             : 
     378             :         /* we are going to evaluate the user function within an anonymous function call:
     379             :          * ret <- (function(arg1){return(arg1*2)})(42)
     380             :          * the user code is put inside the {}, this keeps our environment clean (TM) and gives
     381             :          * a clear path for return values, namely using the builtin return() function
     382             :          * this is also compatible with PL/R
     383             :          */
     384          72 :         pos = 0;
     385          72 :         argnames = malloc(argnameslen);
     386          72 :         if (argnames == NULL) {
     387           0 :                 msg = createException(MAL, "rapi.eval", SQLSTATE(HY013) MAL_MALLOC_FAIL);
     388           0 :                 goto wrapup;
     389             :         }
     390          72 :         argnames[0] = '\0';
     391         230 :         for (i = pci->retc + 2; i < pci->argc; i++) {
     392         316 :                 pos += snprintf(argnames + pos, argnameslen - pos, "%s%s",
     393         210 :                                                 args[i], i < pci->argc - 1 ? ", " : "");
     394             :         }
     395          72 :         rcalllen = 2 * pos + strlen(exprStr) + 100;
     396          72 :         rcall = malloc(rcalllen);
     397          72 :         if (rcall == NULL) {
     398           0 :                 msg = createException(MAL, "rapi.eval", SQLSTATE(HY013) MAL_MALLOC_FAIL);
     399           0 :                 goto wrapup;
     400             :         }
     401          72 :         snprintf(rcall, rcalllen,
     402             :                          "ret <- as.data.frame((function(%s){%s})(%s), nm=NA, stringsAsFactors=F)\n",
     403             :                          argnames, exprStr, argnames);
     404          72 :         free(argnames);
     405          72 :         argnames = NULL;
     406             : #ifdef _RAPI_DEBUG_
     407             :         printf("# R call %s\n",rcall);
     408             : #endif
     409             : 
     410          72 :         x = R_ParseVector(mkString(rcall), 1, &status, R_NilValue);
     411             : 
     412          72 :         if (LENGTH(x) != 1 || status != PARSE_OK) {
     413           0 :                 msg = createException(MAL, "rapi.eval",
     414             :                                                           "Error parsing R expression '%s'. ", exprStr);
     415           0 :                 goto wrapup;
     416             :         }
     417             : 
     418          72 :         retval = R_tryEval(VECTOR_ELT(x, 0), env, &evalErr);
     419          72 :         if (evalErr != FALSE) {
     420           6 :                 char* errormsg = strdup(R_curErrorBuf());
     421           6 :                 size_t c;
     422           6 :                 if (errormsg == NULL) {
     423           0 :                         msg = createException(MAL, "rapi.eval", "Error running R expression.");
     424           0 :                         goto wrapup;
     425             :                 }
     426             :                 // remove newlines from error message so it fits into a MAPI error (lol)
     427         843 :                 for (c = 0; c < strlen(errormsg); c++) {
     428         837 :                         if (errormsg[c] == '\r' || errormsg[c] == '\n') {
     429          15 :                                 errormsg[c] = ' ';
     430             :                         }
     431             :                 }
     432           6 :                 msg = createException(MAL, "rapi.eval",
     433             :                                                           "Error running R expression: %s", errormsg);
     434           6 :                 free(errormsg);
     435           6 :                 goto wrapup;
     436             :         }
     437             : 
     438             :         // ret should be a data frame with exactly as many columns as we need from retc
     439          66 :         ret_cols = LENGTH(retval);
     440          66 :         if (ret_cols != pci->retc) {
     441           0 :                 msg = createException(MAL, "rapi.eval",
     442             :                                                           "Expected result of %d columns, got %d", pci->retc, ret_cols);
     443           0 :                 goto wrapup;
     444             :         }
     445             : 
     446             :         // collect the return values
     447         146 :         for (i = 0; i < pci->retc; i++) {
     448          81 :                 SEXP ret_col = VECTOR_ELT(retval, i);
     449          81 :                 int bat_type = getBatType(getArgType(mb,pci,i));
     450          81 :                 if (bat_type == TYPE_any || bat_type == TYPE_void) {
     451           0 :                         getArgType(mb,pci,i) = bat_type;
     452           0 :                         msg = createException(MAL, "rapi.eval",
     453             :                                                                   "Unknown return value, possibly projecting with no parameters.");
     454           0 :                         goto wrapup;
     455             :                 }
     456             : 
     457             :                 // hand over the vector into a BAT
     458          81 :                 b = sexp_to_bat(ret_col, bat_type);
     459          81 :                 if (b == NULL) {
     460           1 :                         msg = createException(MAL, "rapi.eval",
     461             :                                                                   "Failed to convert column %i", i);
     462           1 :                         goto wrapup;
     463             :                 }
     464             :                 // bat return
     465          80 :                 if (isaBatType(getArgType(mb,pci,i))) {
     466          72 :                         *getArgReference_bat(stk, pci, i) = b->batCacheid;
     467             :                 } else { // single value return, only for non-grouped aggregations
     468           8 :                         BATiter li = bat_iterator(b);
     469           8 :                         if (VALinit(&stk->stk[pci->argv[i]], bat_type,
     470          10 :                                                 BUNtail(li, 0)) == NULL) { // TODO BUNtail here
     471           0 :                                 msg = createException(MAL, "rapi.eval", SQLSTATE(HY013) MAL_MALLOC_FAIL);
     472           0 :                                 goto wrapup;
     473             :                         }
     474             :                 }
     475          80 :                 msg = MAL_SUCCEED;
     476             :         }
     477             :         /* unprotect environment, so it will be eaten by the GC. */
     478          65 :         UNPROTECT(1);
     479          72 :   wrapup:
     480          72 :         MT_lock_unset(&rapiLock);
     481          72 :         if (argnames)
     482           0 :                 free(argnames);
     483          72 :         if (rcall)
     484          72 :                 free(rcall);
     485         461 :         for (i = 0; i < pci->argc; i++)
     486         389 :                 GDKfree(args[i]);
     487          72 :         GDKfree(args);
     488             : 
     489          72 :         return msg;
     490             : }
     491             : 
     492           3 : void* RAPIloopback(void *query) {
     493           3 :         res_table* output = NULL;
     494           3 :         char* querystr = (char*)CHAR(STRING_ELT(query, 0));
     495           3 :         char* err = SQLstatementIntern(rapiClient, &querystr, "name", 1, 0, &output);
     496             : 
     497           3 :         if (err) { // there was an error
     498           0 :                 return ScalarString(RSTR(err));
     499             :         }
     500           3 :         if (output) {
     501           3 :                 int ncols = output->nr_cols;
     502           3 :                 if (ncols > 0) {
     503           3 :                         int i;
     504           3 :                         SEXP retlist, names, varvalue = R_NilValue;
     505           3 :                         retlist = PROTECT(allocVector(VECSXP, ncols));
     506           3 :                         names = PROTECT(NEW_STRING(ncols));
     507           9 :                         for (i = 0; i < ncols; i++) {
     508           3 :                                 BAT *b = BATdescriptor(output->cols[i].b);
     509           3 :                                 if (b == NULL || !(varvalue = bat_to_sexp(b, TYPE_any))) {
     510           0 :                                         UNPROTECT(i + 3);
     511           0 :                                         if (b)
     512           0 :                                                 BBPunfix(b->batCacheid);
     513           0 :                                         return ScalarString(RSTR("Conversion error"));
     514             :                                 }
     515           3 :                                 BBPunfix(b->batCacheid);
     516           3 :                                 SET_STRING_ELT(names, i, RSTR(output->cols[i].name));
     517           3 :                                 SET_VECTOR_ELT(retlist, i, varvalue);
     518             :                         }
     519           3 :                         res_table_destroy(output);
     520           3 :                         SET_NAMES(retlist, names);
     521           3 :                         UNPROTECT(ncols + 2);
     522           3 :                         return retlist;
     523             :                 }
     524           0 :                 res_table_destroy(output);
     525             :         }
     526           0 :         return ScalarLogical(1);
     527             : }
     528             : 
     529             : 
     530           7 : str RAPIprelude(void *ret) {
     531           7 :         (void) ret;
     532             : 
     533           7 :         if (RAPIEnabled()) {
     534           7 :                 MT_lock_set(&rapiLock);
     535             :                 /* startup internal R environment  */
     536           7 :                 if (!rapiInitialized) {
     537           7 :                         char *initstatus;
     538           7 :                         initstatus = RAPIinitialize();
     539           7 :                         if (initstatus != 0) {
     540           0 :                                 MT_lock_unset(&rapiLock);
     541           0 :                                 throw(MAL, "rapi.eval",
     542             :                                           "failed to initialize R environment (%s)", initstatus);
     543             :                         }
     544           7 :                         Rf_defineVar(Rf_install("MONETDB_LIBDIR"), ScalarString(RSTR(LIBDIR)), R_GlobalEnv);
     545             : 
     546             :                 }
     547           7 :                 MT_lock_unset(&rapiLock);
     548           7 :                 printf("# MonetDB/R   module loaded\n");
     549             :         }
     550             :         return MAL_SUCCEED;
     551             : }

Generated by: LCOV version 1.14