diff -u rpy-1.0.3/debian/changelog rpy-1.0.3/debian/changelog --- rpy-1.0.3/debian/changelog +++ rpy-1.0.3/debian/changelog @@ -1,8 +1,23 @@ -rpy (1.0.3-18build1) precise; urgency=low +rpy (1.0.3-20) unstable; urgency=low - * Rebuild to drop python2.6 dependencies. + * Rebuilt under R 2.14.1 - -- Matthias Klose Sat, 31 Dec 2011 02:13:40 +0000 + * debian/control: Set (Build-)Depends: to current R version + * debian/control: Set Standards-Version: to current version + + -- Dirk Eddelbuettel Sat, 24 Dec 2011 08:22:25 -0600 + +rpy (1.0.3-19) unstable; urgency=low + + * Rebuilt under R 2.14.0 (prereleases -- release coming October 31) + + * debian/control: Set (Build-)Depends: to current R version + * debian/control: Set Standards-Version: to current version + + * debian/control: Added 'Breaks: r-base-core (>= 2.15.0)' + (Closes: #646969) + + -- Dirk Eddelbuettel Fri, 28 Oct 2011 15:58:16 -0500 rpy (1.0.3-18) unstable; urgency=low diff -u rpy-1.0.3/debian/rules rpy-1.0.3/debian/rules --- rpy-1.0.3/debian/rules +++ rpy-1.0.3/debian/rules @@ -38,7 +38,9 @@ dh_testdir touch configure-stamp -build: configure-stamp build-stamp +build: configure-stamp build-arch build-indep +build-arch: build-stamp +build-indep: build-stamp build-stamp: dh_testdir # CFLAGS="$(compilerflags)" $(PYTHON2.3) setup.py build \ diff -u rpy-1.0.3/debian/control rpy-1.0.3/debian/control --- rpy-1.0.3/debian/control +++ rpy-1.0.3/debian/control @@ -2,13 +2,14 @@ Section: python Priority: optional Maintainer: Dirk Eddelbuettel -Standards-Version: 3.9.1 +Standards-Version: 3.9.2 XS-Python-Version: all -Build-Depends: debhelper (>= 7.2.17), r-base-dev (>= 2.13.0~20110316), python-all-dev (>= 2.6.6-3), python-numpy (>= 1:1.3.0), texinfo, texi2html, texlive-base, texlive-latex-base +Build-Depends: debhelper (>= 7.2.17), r-base-dev (>= 2.14.1), python-all-dev (>= 2.6.6-3), python-numpy (>= 1:1.3.0), python, texinfo, texi2html, texlive-base, texlive-latex-base Package: python-rpy Architecture: any -Depends: ${misc:Depends}, ${shlibs:Depends}, ${python:Depends}, python-numpy (>= 1:1.3.0), r-base-core (>= 2.13.0~20110316) +Depends: ${misc:Depends}, ${shlibs:Depends}, ${python:Depends}, python-numpy (>= 1:1.3.0), r-base-core (>= 2.14.1) +Breaks: r-base-core (>= 2.15.0) Replaces: python2.2-rpy (<< 0.99.2-4), python2.3-rpy (<< 0.99.2-4), python2.4-rpy (<< 0.99.2-4) Conflicts: python2.2-rpy (<< 0.99.2-4), python2.3-rpy (<< 0.99.2-4), python2.4-rpy (<< 0.99.2-4) XB-Python-Version: ${python:Versions} diff -u rpy-1.0.3/debian/python-rpy.lintian-overrides rpy-1.0.3/debian/python-rpy.lintian-overrides --- rpy-1.0.3/debian/python-rpy.lintian-overrides +++ rpy-1.0.3/debian/python-rpy.lintian-overrides @@ -1,6 +1,4 @@ -python-rpy: script-not-executable ./usr/share/pycentral/python-rpy/site-packages/rpy_options.py -python-rpy: script-not-executable ./usr/share/pyshared/rpy_options.py -python-rpy: binary-or-shlib-defines-rpath ./usr/lib/python2.5/site-packages/_rpy2130.so /usr/lib/R/bin -python-rpy: binary-or-shlib-defines-rpath ./usr/lib/python2.5/site-packages/_rpy2130.so /usr/lib/R/lib -python-rpy: binary-or-shlib-defines-rpath ./usr/lib/python2.6/dist-packages/_rpy2130.so /usr/lib/R/bin -python-rpy: binary-or-shlib-defines-rpath ./usr/lib/python2.6/dist-packages/_rpy2130.so /usr/lib/R/lib +python-rpy: binary-or-shlib-defines-rpath usr/lib/python2.6/dist-packages/_rpy2141.so /usr/lib/R/bin +python-rpy: binary-or-shlib-defines-rpath usr/lib/python2.6/dist-packages/_rpy2141.so /usr/lib/R/lib +python-rpy: binary-or-shlib-defines-rpath usr/lib/python2.7/dist-packages/_rpy2141.so /usr/lib/R/bin +python-rpy: binary-or-shlib-defines-rpath usr/lib/python2.7/dist-packages/_rpy2141.so /usr/lib/R/lib reverted: --- rpy-1.0.3/src/R_eval2130.c +++ rpy-1.0.3.orig/src/R_eval2130.c @@ -1,197 +0,0 @@ -/* - * $Id: R_eval.c 363 2007-11-12 23:27:48Z warnes $ - * Evaluation of R expressions. - */ - -/* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1/GPL 2.0/LGPL 2.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is the RPy python module. - * - * The Initial Developer of the Original Code is Walter Moreira. - * Portions created by the Initial Developer are Copyright (C) 2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Gregory R. Warnes (Maintainer) - * - * Alternatively, the contents of this file may be used under the terms of - * either the GNU General Public License Version 2 or later (the "GPL"), or - * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), - * in which case the provisions of the GPL or the LGPL are applicable instead - * of those above. If you wish to allow use of your version of this file only - * under the terms of either the GPL or the LGPL, and not to allow others to - * use your version of this file under the terms of the MPL, indicate your - * decision by deleting the provisions above and replace them with the notice - * and other provisions required by the GPL or the LGPL. If you do not delete - * the provisions above, a recipient may use your version of this file under - * the terms of any one of the MPL, the GPL or the LGPL. - * - * ***** END LICENSE BLOCK ***** */ -/* - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - * - * - * Evaluation of R expressions. - * - * $Id: R_eval.c 363 2007-11-12 23:27:48Z warnes $ - * - */ - -#include - -/* The Python original SIGINT handler */ -PyOS_sighandler_t python_sigint; - -/* Indicates whether the R interpreter was interrupted by a SIGINT */ -int interrupted = 0; - -/* Abort the current R computation due to a SIGINT */ -void interrupt_R(int signum) -{ - interrupted = 1; - error("Interrupted"); -} - - -/* Evaluate a SEXP. It must be constructed by hand. It raises a Python - exception if an error ocurred in the evaluation */ -SEXP do_eval_expr(SEXP e) { - SEXP res; - int error = 0; - PyOS_sighandler_t old_int; - - /* Enable our handler for SIGINT inside the R - interpreter. Otherwise, we cannot stop R calculations, since - SIGINT is only processed between Python bytecodes. Also, save the - Python SIGINT handler because it is necessary to temporally - restore it in user defined I/O Python functions. */ - stop_events(); - - #ifdef _WIN32 - old_int = PyOS_getsig(SIGBREAK); - #else - old_int = PyOS_getsig(SIGINT); - #endif - python_sigint = old_int; - - signal(SIGINT, interrupt_R); - - interrupted = 0; - res = R_tryEval(e, R_GlobalEnv, &error); - - #ifdef _WIN32 - PyOS_setsig(SIGBREAK, old_int); - #else - PyOS_setsig(SIGINT, old_int); - #endif - - start_events(); - - if (error) { - if (interrupted) { - PyErr_SetNone(PyExc_KeyboardInterrupt); - } - else - PyErr_SetString(RPy_RException, get_last_error_msg()); - return NULL; - } - - - return res; -} - -/* Evaluate a function given by a name (without arguments) */ -SEXP do_eval_fun(char *name) { - SEXP exp, fun, res; - - fun = get_fun_from_name(name); - if (!fun) - return NULL; - - PROTECT(fun); - PROTECT(exp = allocVector(LANGSXP, 1)); - SETCAR(exp, fun); - - PROTECT(res = do_eval_expr(exp)); - UNPROTECT(3); - return res; -} - -/* - * Get an R **function** object by its name. When not found, an exception is - * raised. The checking of the length of the identifier is needed to - * avoid R raising an error causing Python to dump core. - */ -SEXP get_fun_from_name(char *ident) { - SEXP obj; - - /* For R not to throw an error, we must check the identifier is - neither null nor greater than MAXIDSIZE */ - if (!*ident) { - PyErr_SetString(RPy_Exception, "attempt to use zero-length variable name"); - return NULL; - } - if (strlen(ident) > MAXIDSIZE) { - PyErr_SetString(RPy_Exception, "symbol print-name too long"); - return NULL; - } - -#if R_VERSION < 0x20000 - obj = Rf_findVar(Rf_install(ident), R_GlobalEnv); -#else - /* - * For R-2.0.0 and later, it is necessary to use findFun to get - * functions. Unfortunately, calling findFun on an undefined name - * causes a segfault! - * - * Solution: - * - * 1) Call findVar on the name - * - * 2) If something has the name, call findFun - * - * 3) Raise an error if either step 1 or 2 fails. - */ - obj = Rf_findVar(Rf_install(ident), R_GlobalEnv); - - if (obj != R_UnboundValue) - obj = Rf_findFun(Rf_install(ident), R_GlobalEnv); -#endif - - if (obj == R_UnboundValue) { - PyErr_Format(RPy_Exception, "R Function \"%s\" not found", ident); - return NULL; - } - return obj; -} - -/* Obtain the text of the last R error message */ -const char *get_last_error_msg() { - SEXP msg; - - msg = do_eval_fun("geterrmessage"); - return CHARACTER_VALUE(msg); -} reverted: --- rpy-1.0.3/src/rpymodule2130.c +++ rpy-1.0.3.orig/src/rpymodule2130.c @@ -1,2108 +0,0 @@ -/* - * $Id: rpymodule.c 515 2008-05-14 13:53:05Z warnes $ - * Implementation of the module '_rpy' and the 'Robj' type. - */ - -/* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1/GPL 2.0/LGPL 2.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is the RPy python module. - * - * The Initial Developer of the Original Code is Walter Moreira. - * Portions created by the Initial Developer are Copyright (C) 2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Gregory R. Warnes (Maintainer) - * - * Alternatively, the contents of this file may be used under the terms of - * either the GNU General Public License Version 2 or later (the "GPL"), or - * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), - * in which case the provisions of the GPL or the LGPL are applicable instead - * of those above. If you wish to allow use of your version of this file only - * under the terms of either the GPL or the LGPL, and not to allow others to - * use your version of this file under the terms of the MPL, indicate your - * decision by deleting the provisions above and replace them with the notice - * and other provisions required by the GPL or the LGPL. If you do not delete - * the provisions above, a recipient may use your version of this file under - * the terms of any one of the MPL, the GPL or the LGPL. - * - * ***** END LICENSE BLOCK ***** */ - -#include -#if (R_VERSION >= R_Version(2,3,0)) - -# ifndef _WIN32 -# define CSTACK_DEFNS // Enable definitions needed for stack checking control -# endif - -#endif - -#include "RPy.h" - -#define NONAMELESSUNION -#include -#include -#include - -/* Flag indicating whether Numpy/Numeric is available in this session - * - * This is necessary since Numpy/Numeric may not available at run time, even if - * it was available at compile time. -*/ -static int use_numeric=0; - - -/* Local function definitions */ -DL_EXPORT(void) INIT_RPY(void); /* Module initializer */ -static PyObject *r_init(PyObject *self, /* Class initializer */ - PyObject *args); -static PyObject *r_cleanup(void); /* Clean up R & release resources */ - -#ifdef _WIN32 -static void init_embedded_win32(int argc, char *argv[]); -#endif - -/* Global objects */ -static SEXP get_item; -static SEXP set_item; -static SEXP length; -static SEXP aperm; -static PyObject *class_table; -static PyObject *proc_table; -static int default_mode; -static PyObject *r_lock; -PyObject *RPy_Exception; -PyObject *RPy_TypeConversionException; -PyObject *RPy_RException; - -static char RHOME[BUFSIZ]; -static char RVERSION[BUFSIZ]; -static char RVER[BUFSIZ]; -static char RUSER[BUFSIZ]; -char *defaultargv[] = {"rpy", "-q", "--vanilla"}; -int defaultargc = sizeof(defaultargv) / sizeof(defaultargv[0]); - -/* Global interpreter */ -PyInterpreterState *my_interp; - -/* Signal whether R is running interactively */ -int R_interact; - -/* RPy namespace */ -PyObject *rpy; -PyObject *rpy_dict; - - -#ifdef WITH_NUMERIC -static PyObject *Py_transpose; -#endif - -/* Global list to protect R objects from garbage collection */ -/* This is inspired in $R_SRC/src/main/memory.c */ -static SEXP R_References; - -static SEXP -RecursiveRelease(SEXP obj, SEXP list) -{ - if (!isNull(list)) { - if (obj == CAR(list)) - return CDR(list); - else - SETCDR(list, RecursiveRelease(obj, CDR(list))); - } - return list; -} - -/* Robj methods. Following xxmodule.c from Python distro. */ - -static void -Robj_dealloc(RobjObject *self) -{ - /* Remove the object from the list of protected objects */ - R_References = RecursiveRelease(self->R_obj, R_References); - SET_SYMVALUE(install("R.References"), R_References); - - PyObject_Del(self); -} - -RobjObject * -Robj_new(SEXP robj, int conversion) -{ - RobjObject *self; - self = PyObject_New(RobjObject, &Robj_Type); - if (!self) - return NULL; - - if (!robj) - return NULL; - - /* Protect the R object */ - R_References = CONS(robj, R_References); - SET_SYMVALUE(install("R.References"), R_References); - - self->R_obj = robj; - self->conversion = conversion; - return self; -} - -#ifndef PRE_2_2 -static PyObject * -Robj_tpnew(PyTypeObject *type, PyObject *args, PyObject *kwds) -{ - PyObject *self; - - self = type->tp_alloc(type, 0); - return self; -} -#endif - -/* Type conversion routines. See documentation for details */ - -/* These are auxiliaries for a state machine for converting Python - list to the coarsest R vector type */ -#define ANY_T 0 -#define BOOL_T 1 -#define INT_T 2 -#define FLOAT_T 3 -#define COMPLEX_T 4 -#define STRING_T 5 -#define ROBJ_T 6 - -static int -type_to_int(PyObject *obj) -{ - if (PyBool_Check(obj)) - return BOOL_T; - else if (PyInt_Check(obj)) - return INT_T; - else if (PyFloat_Check(obj)) - return FLOAT_T; - else if (PyComplex_Check(obj)) - return COMPLEX_T; - else if (PyNumber_Check(obj)) - return ANY_T; - else if (PyString_Check(obj)) - return STRING_T; - else if (PyUnicode_Check(obj)) - return STRING_T; - else if (Robj_Check(obj)) - return ROBJ_T; - else - return ANY_T; -} - -/* Make a R list or vector from a Python sequence */ -static SEXP -seq_to_R(PyObject *obj) -{ - PyObject *it; - SEXP robj, rit; - int i, len, state; - - /* This matrix defines what mode a vector should take given what - it already contains and a new item - - E.g. Row 0 indicates that if we've seen an any, the vector will - always remain an any. Row 3 indicates that if we've seen a - float, then seeing an boolean, integer, or float will preserve - the vector as a float vector, while seeing a string or an Robj will - convert it into an any vector. - */ - int fsm[7][7] = { - {0, 0, 0, 0, 0, 0, 0}, // any - {0, 1, 2, 3, 4, 0, 0}, // bool - {0, 2, 2, 3, 4, 0, 0}, // int - {0, 3, 3, 3, 4, 0, 0}, // float - {0, 4, 4, 4, 4, 0, 0}, // complex - {0, 0, 0, 0, 0, 5, 0}, // string - {0, 0, 0, 0, 0, 0, 6} // RObj - }; - - len = PySequence_Length(obj); - if (len == 0) - return R_NilValue; - - PROTECT(robj = NEW_LIST(len)); - - state = -1; - for (i=0; idimensions; - type = obj->descr->type_num; - size = PyArray_Size( (PyObject*) obj); - - /* Handle a vector without dimensions, just length */ - if(obj->nd==0) - { - PROTECT(Rdims = allocVector(INTSXP, 1)); - PROTECT(tRdims = allocVector(INTSXP, 1)); - INTEGER(Rdims)[0] = size; - INTEGER(tRdims)[0] = size; - } - else - { - PROTECT(Rdims = allocVector(INTSXP, obj->nd)); - PROTECT(tRdims = allocVector(INTSXP, obj->nd)); - - for (i=0; ind; i++) - { - if (dims[i] == 0) - { - UNPROTECT(2); - return R_NilValue; - } - INTEGER(Rdims)[i] = dims[(obj->nd)-i-1]; - INTEGER(tRdims)[i] = (obj->nd)-i; - } - } - - switch(type) - { - - /*******************/ - /* String Variants */ - /*******************/ - /* TODO: Add proper handling of NumPy character arrays. - The following code DOES NOT WORK: - - #if WITH_NUMERIC==3 - case PyArray_UNICODE: - case PyArray_STRING: - case PyArray_CHAR: - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_STRING, 0, 0); - #endif - - The problem is that the PyArray call throws an exception, - presumably because we haven't given a width specifier. - - NumPy strings are fixed-width, and may not be null terminated. R only handles - null terminated (varying width) strings. We need a separate - code path to handle this, as it requires quite different - handling than the numeric arrays dealt with below. - */ - - - /******************************************/ - /* All complex to (double,double) complex */ - /******************************************/ - -#if WITH_NUMERIC==1 /* Numeric */ - case PyArray_CFLOAT: - case PyArray_CDOUBLE: -#else /* NumPy */ - case PyArray_COMPLEX64: - case PyArray_COMPLEX128: -#endif - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_CDOUBLE, 0, 0); - break; - - - /**********************************************************************************/ - /* Convert all integers to platform integer (except 64 bit int on 32 bit platforms) */ - /************************************************************************************/ - -#if WITH_NUMERIC==1 /* Numeric */ - case PyArray_UBYTE: - case PyArray_SBYTE: - case PyArray_SHORT: - case PyArray_INT: - case PyArray_LONG: - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_INT, 0, 0); - break; -#else /* NumPy */ - case PyArray_BOOL: - case PyArray_INT8: - case PyArray_UINT8: - case PyArray_INT16: - case PyArray_UINT16: - case PyArray_INT32: - case PyArray_UINT32: -#if PyArray_INT==PyArray_INT64 /* 64 bit platform */ - case PyArray_INT64: - case PyArray_UINT64: -#else - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_INT, 0, 0); - break; -#endif -#endif - - /**************************************************/ - /* All floats (and over-sized integers) to double */ - /**************************************************/ -#if WITH_NUMERIC==1 /* Numeric */ - case PyArray_FLOAT: - case PyArray_DOUBLE: -#else /* NumPy */ - case PyArray_FLOAT32: - case PyArray_FLOAT64: -#if PyArray_INT!=PyArray_INT64 /* 32 bit platform */ - case PyArray_INT64: - case PyArray_UINT64: -#endif -#endif - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_DOUBLE, 0, 0); - break; - - default: - UNPROTECT(2); - PyErr_Format(RPy_TypeConversionException, - "Numeric/NumPy arrays containing %s are not supported.", - obj->ob_type->tp_name); - return R_NilValue; - break; - } - - - pytl = Py_BuildValue("[i]", size); - nobj = PyArray_Reshape(obj, pytl); - Py_XDECREF(pytl); - Py_XDECREF(obj); - - if (nobj == NULL) - { - UNPROTECT(2); - return R_NilValue; - } - - - PROTECT(Rarray = seq_to_R(nobj)); - if (Rarray == NULL) - { - UNPROTECT(3); - return R_NilValue; - } - - - Py_XDECREF(nobj); - SET_DIM(Rarray, Rdims); - - PROTECT(e = allocVector(LANGSXP, 3)); - SETCAR(e, aperm); - SETCAR(CDR(e), Rarray); - SETCAR(CDR(CDR(e)), tRdims); - PROTECT(Rarray = do_eval_expr(e)); - - UNPROTECT(5); - return Rarray; -} -#endif - -/* Convert a Python object to a R object. An Robj is passed w/o - * modifications, an object which provides a '.as_r()' method, is - * passed as the result of that method */ -SEXP -to_Robj(PyObject *obj) -{ - SEXP robj; - Py_complex c; - PyObject *to_r_meth; - PyObject *tempObj; - int do_decref = 0; - - if (obj==NULL) - return NULL; - - if (obj == Py_None) { - return R_NilValue; - } - - to_r_meth = PyObject_GetAttrString(obj, "as_r"); - if (to_r_meth) { - obj = PyObject_CallObject(to_r_meth, NULL); - Py_DECREF(to_r_meth); - if (obj==NULL) - return NULL; - do_decref = 1; - } - PyErr_Clear(); - - - if (Robj_Check(obj)) - { - PROTECT(robj = ((RobjObject *)obj)->R_obj); - } - else if (PyBool_Check(obj)) - { - PROTECT(robj = NEW_LOGICAL(1)); - LOGICAL_DATA(robj)[0] = (Py_True==obj); - } - else if (PyInt_Check(obj)) - { - PROTECT(robj = NEW_INTEGER(1)); - INTEGER_DATA(robj)[0] = (int) PyInt_AsLong(obj); - } - else if (PyFloat_Check(obj)) - { - PROTECT(robj = NEW_NUMERIC(1)); - NUMERIC_DATA(robj)[0] = PyFloat_AsDouble(obj); - } - else if (PyComplex_Check(obj)) - { - PROTECT(robj = NEW_COMPLEX(1)); - c = PyComplex_AsCComplex(obj); - COMPLEX_DATA(robj)[0].r = c.real; - COMPLEX_DATA(robj)[0].i = c.imag; - } - else if (PyUnicode_Check(obj)) - { - /** Handle Unicode Strings. - * - * Ideally: Python Unicode -> R Unicode, - * - * Unfortunately, the R documentation is not forthcoming on how - * to accomplish this - * - * So, for the moment: - * python Unicode -> Python ASCII -> ordinary string -> R string - * - */ - PROTECT(robj = NEW_STRING(1)); - SET_STRING_ELT(robj, 0, COPY_TO_USER_STRING(PyString_AsString(PyUnicode_AsASCIIString(obj)))); - } - else if (PyString_Check(obj)) - { - PROTECT(robj = NEW_STRING(1)); - SET_STRING_ELT(robj, 0, COPY_TO_USER_STRING(PyString_AsString(obj))); - } -#ifdef WITH_NUMERIC - else if (use_numeric && PyArray_Check(obj)) - { - PROTECT(robj = to_Rarray(obj)); - } -#endif - else if ((PySequence_Check(obj)) && - (PySequence_Size(obj) >= 0)) - { - PROTECT(robj = seq_to_R(obj)); /* No labels */ - } - else if ((PyMapping_Check(obj)) && - (PyMapping_Size(obj) >= 0)) - { - PROTECT(robj = dict_to_R(obj)); - } - else if (PyNumber_Check(obj)) /* generic number interface */ - { - tempObj = PyNumber_Float(obj); - if(!tempObj) goto error; - - PROTECT(robj = NEW_NUMERIC(1)); - NUMERIC_DATA(robj)[0] = PyFloat_AsDouble(tempObj); - Py_DECREF(tempObj); - } - else - { - error: - PyErr_Format(RPy_TypeConversionException, - "cannot convert from type '%s'", - obj->ob_type->tp_name); - PROTECT(robj = NULL); /* Protected to avoid stack inbalance */ - } - - if (do_decref) - { - Py_DECREF(obj); - } - UNPROTECT(1); - return robj; -} - -/* Convert a R named vector or list to a Python dictionary */ -static PyObject * -to_PyDict(PyObject *obj, SEXP names) -{ - int len, i; - PyObject *it, *dict; - const char *name; - - if ((len = PySequence_Length(obj)) < 0) - return NULL; - - dict = PyDict_New(); - for (i=0; i 1) && (res[l-1] == '_') && (res[l-2] != '_')) - res[l-1]=0; - - while ((r=strchr(r, '_'))) - *r = '.'; - - return res; -} - -/* Convert a dict to keywords arguments for a R function */ -int -make_kwds(int lkwds, PyObject *kwds, SEXP *e) -{ - SEXP r; - const char *s; - int i; - PyObject *citems=NULL, *it; - PyObject *kwname; - - if (kwds) { - citems = PyMapping_Items(kwds); - } - - for (i=0; iR_obj); - e = CDR(e); - - if (!make_args(largs, args, &e)) { - UNPROTECT(1); - return NULL; - } - if (!make_kwds(lkwds, kwds, &e)) { - UNPROTECT(1); - return NULL; - } - - PROTECT(res = do_eval_expr(exp)); - if (!res) { - UNPROTECT(2); - return NULL; - } - - if (default_mode < 0) - conv = ((RobjObject *)self)->conversion; - else - conv = default_mode; - - obj = to_Pyobj_with_mode(res, conv); - UNPROTECT(2); - - PrintWarnings(); /* show any warning messages */ - - return obj; -} - -/* Convert a sequence of (name, value) pairs to arguments to an R - function call */ -int -make_argl(int largl, PyObject *argl, SEXP *e) -{ - SEXP rvalue; - const char *name; - int i; - PyObject *it, *nobj, *value; - - if( !PySequence_Check(argl) ) goto fail_arg; - - for (i=0; i0) - { - SET_TAG(*e, Rf_install(name)); - PyMem_Free((void*) name); - } - - /* Move index to new end of call */ - *e = CDR(*e); - } - return 1; - - fail_arg: - PyErr_SetString(PyExc_ValueError, - "Argument must be a sequence of (\"name\", value) pairs.\n"); - fail: - return 0; -} - -/* Methods for the 'Robj' type */ - -/* Explicitly call an R object with a list containing (name, value) * - * argument pairs. 'name' can be None or '' to provide unnamed - * arguments. This function is necessary when the *order* of named - * arguments needs to be preserved. - */ - -static PyObject * -Robj_lcall(PyObject *self, PyObject *args) -{ - SEXP exp, e, res; - int largs, largl, conv; - PyObject *obj, *argl; - - /* Check arguments, there should be *exactly one* unnamed sequence. */ - largs = 0; - if (args) - largs = PyObject_Length(args); - if (largs<0) - return NULL; - - if(largs != 1 || !PySequence_Check(args) ) - { - PyErr_SetString(PyExc_ValueError, - "Argument must be a sequence of (\"name\", value) pairs.\n"); - return NULL; - } - - // extract our one argument - argl = PySequence_GetItem(args, 0); - Py_DECREF(args); - - largl = 0; - if (argl) - largl = PyObject_Length(argl); - if (largl<0) - return NULL; - - // A SEXP with the function to call and the arguments - PROTECT(exp = allocVector(LANGSXP, largl+1)); - e = exp; - SETCAR(e, ((RobjObject *)self)->R_obj); - e = CDR(e); - - // Add the arguments to the SEXP - if (!make_argl(largl, argl, &e)) { - UNPROTECT(1); - return NULL; - } - - // Evaluate - PROTECT(res = do_eval_expr(exp)); - if (!res) { - UNPROTECT(2); - return NULL; - } - - // Convert - if (default_mode < 0) - conv = ((RobjObject *)self)->conversion; - else - conv = default_mode; - - obj = to_Pyobj_with_mode(res, conv); - UNPROTECT(2); - - // Return - return obj; -} - - -/* Without args return the value of the conversion flag. With an - argument set the conversion flag to the truth value of the argument. */ -static PyObject * -Robj_autoconvert(PyObject *self, PyObject *args, PyObject *kwds) -{ - PyObject *obj; - int conversion=-2; - char *kwlist[] = {"val", 0}; - - if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:autoconvert", kwlist, - &conversion)) - return NULL; - - if (conversion > TOP_MODE) { - PyErr_SetString(PyExc_ValueError, "wrong mode"); - return NULL; - } - - if (conversion == -2) { - obj = PyInt_FromLong((long)((RobjObject *)self)->conversion); - } else { - ((RobjObject *)self)->conversion = conversion; - obj = Py_None; - Py_XINCREF(obj); - } - - return obj; -} - -static PyObject * -Robj_as_py(PyObject *self, PyObject *args, PyObject *kwds) -{ - PyObject *obj; - char *kwlist[] = {"mode", 0}; - int conv=default_mode; - - if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:as_py", kwlist, - &conv)) - return NULL; - - if (conv <= -2 || conv > TOP_MODE) { - PyErr_SetString(PyExc_ValueError, "wrong mode"); - return NULL; - } - - if (conv < 0) - conv = TOP_MODE; - - obj = to_Pyobj_with_mode(((RobjObject *)self)->R_obj, conv); - return obj; -} - -static PyMethodDef Robj_methods[] = { - {"autoconvert", (PyCFunction)Robj_autoconvert, METH_VARARGS|METH_KEYWORDS}, - {"local_mode", (PyCFunction)Robj_autoconvert, METH_VARARGS|METH_KEYWORDS}, - {"as_py", (PyCFunction)Robj_as_py, METH_VARARGS|METH_KEYWORDS}, - {"lcall", (PyCFunction)Robj_lcall, METH_VARARGS}, - {NULL, NULL} /* sentinel */ -}; - -/* Sequence protocol implementation */ - -/* len(a) */ -static int -Robj_len(PyObject *a) -{ - SEXP e, robj; - - PROTECT(e = allocVector(LANGSXP, 2)); - SETCAR(e, length); - SETCAR(CDR(e), ((RobjObject *)a)->R_obj); - - if (!(robj = do_eval_expr(e))) { - UNPROTECT(1); - return -1; - } - - UNPROTECT(1); - return INTEGER_DATA(robj)[0]; -} - -/* a[i] = v */ -static int -Robj_ass_item(PyObject *a, int i, PyObject *v) -{ - SEXP e, ri, robj; - - PROTECT(e = allocVector(LANGSXP, 4)); - ri = NEW_INTEGER(1); - INTEGER_DATA(ri)[0] = i+1; - SETCAR(e, set_item); - SETCAR(CDR(e), ((RobjObject *)a)->R_obj); - SETCAR(CDR(CDR(e)), ri); - SETCAR(CDR(CDR(CDR(e))), to_Robj(v)); - - if(PyErr_Occurred()) - return -1; - - if (!(robj = do_eval_expr(e))) { - UNPROTECT(1); - return -1; - } - - ((RobjObject *)a)->R_obj = robj; - UNPROTECT(1); - return 0; -} - -/* a[i] */ -static PyObject * -Robj_item(PyObject *a, int i) -{ - SEXP ri, robj, e; - PyObject *obj; - int len, c; - - if ((len = Robj_len(a)) < 0) - return NULL; - if (i >= len || i < 0) { - PyErr_SetString(PyExc_IndexError, "R object index out of range"); - return NULL; - } - - PROTECT(ri = NEW_INTEGER(1)); - INTEGER_DATA(ri)[0] = i+1; - PROTECT(e = allocVector(LANGSXP, 3)); - SETCAR(e, get_item); - SETCAR(CDR(e), ((RobjObject *)a)->R_obj); - SETCAR(CDR(CDR(e)), ri); - - if (!(robj = do_eval_expr(e))) { - UNPROTECT(2); - return NULL; - } - - UNPROTECT(2); - - /* If there is a default mode, use it; otherwise, use the top mode. */ - if (default_mode < 0) - c = TOP_MODE; - else - c = default_mode; - obj = to_Pyobj_with_mode(robj, c); - return obj; -} - -/* Get a slice: a[x:y] */ -/*FIXME: starting with Python 2.5, ilow and ihigh should probably - * be of type Py_ssize_t. - */ -static PyObject * -Robj_slice(PyObject *a, int ilow, int ihigh) -{ - SEXP robj, e, index; - PyObject *obj; - int robjLen, sliceLen, c; - int ii; - - robjLen = Robj_len(a); - - if (robjLen < 0) - return NULL; - - if (ilow < 0) { - PyErr_SetString(PyExc_IndexError, - "R object index out of range (lowest index is negative)"); - return NULL; - //ilow = 0; - } else if (ilow > robjLen) { - PyErr_SetString(PyExc_IndexError, - "R object index out of range (lowest index > object length)"); - return NULL; - //ilow = robjLen; - } - if (ihigh < ilow) { - PyErr_SetString(PyExc_IndexError, - "R object index out of range (highest index < lowest index)"); - return NULL; - //ihigh = ilow; - } else if (ihigh > robjLen) { - PyErr_SetString(PyExc_IndexError, - "R object index out of range (highest index > object length)"); - //return NULL; - ihigh = robjLen; - } - sliceLen = ihigh - ilow; - - /* if (ilow >= robjLen || ilow < 0) { */ - /* PyErr_SetString(PyExc_IndexError, "R object index out of range"); */ - /* return NULL; */ - /* } */ - - PROTECT(index = allocVector(INTSXP, sliceLen)); - - for (ii = 0; ii < sliceLen; ii++) { - INTEGER_POINTER(index)[ii] = ii + ilow + 1; - } - - PROTECT(e = allocVector(LANGSXP, 3)); - SETCAR(e, get_item); - SETCAR(CDR(e), ((RobjObject *)a)->R_obj); - SETCAR(CDR(CDR(e)), index); - - if (!(robj = do_eval_expr(e))) { - UNPROTECT(2); - return NULL; - } - - UNPROTECT(2); - - /* If there is a default mode, use it; otherwise, use the top mode. */ - if (default_mode < 0) - c = TOP_MODE; - else - c = default_mode; - obj = to_Pyobj_with_mode(robj, c); - return obj; -} - - -/* FIXME: - * Python 2.5 will feel happier with ssizeargfunc and ssizessizeargfunc - */ -/* We should implement sq_slice, sq_contains ... */ -static PySequenceMethods Robj_as_sequence = { - (inquiry)Robj_len, /* sq_length */ - 0, /* sq_concat */ - 0, /* sq_repeat */ - (intargfunc)Robj_item, /* sq_item */ - (intintargfunc)Robj_slice, /* sq_slice */ - (intobjargproc)Robj_ass_item, /* sq_ass_item */ - 0, /* sq_ass_slice */ - 0, /* sq_contains */ - 0, /* sq_inplace_concat */ - 0 /* sq_inplace_repeat */ -}; - - -/* The 'Robj' table. When compiled under Python 2.2, the type 'Robj' - is subclassable. */ - -#ifdef PRE_2_2 -static PyObject * -Robj_getattr(RobjObject *self, char *name) -{ - return Py_FindMethod(Robj_methods, (PyObject *)self, name); -} -#endif - -PyTypeObject Robj_Type = { - /* The ob_type field must be initialized in the module init function - * to be portable to Windows without using C++. */ -#if defined(PRE_2_2) || defined(_WIN32) // Matjaz - PyObject_HEAD_INIT(NULL) -#else - PyObject_HEAD_INIT(&PyType_Type) -#endif - 0, /*ob_size*/ - "Robj", /*tp_name*/ - sizeof(RobjObject), /*tp_basicsize*/ - 0, /*tp_itemsize*/ - /* methods */ - (destructor)Robj_dealloc, /*tp_dealloc*/ - 0, /*tp_print*/ -#ifdef PRE_2_2 - (getattrfunc)Robj_getattr, -#else - 0, -#endif - 0, - 0, /*tp_compare*/ - 0, /*tp_repr*/ - 0, /*tp_as_number*/ - &Robj_as_sequence, /*tp_as_sequence*/ - 0, /*tp_as_mapping*/ - 0, /*tp_hash*/ - (ternaryfunc)Robj_call, /*tp_call*/ - 0, /*tp_str*/ -#if defined(PRE_2_2) || defined(_WIN32) - 0, -#else - PyObject_GenericGetAttr, /*tp_getattro*/ -#endif - 0, /*tp_setattro*/ - 0, /*tp_as_buffer*/ -#ifdef PRE_2_2 - 0, -#else - Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/ -#endif - 0, /*tp_doc*/ - 0, /*tp_traverse*/ -#ifndef PRE_2_2 - 0, /*tp_clear*/ - 0, /*tp_richcompare*/ - 0, /*tp_weaklistoffset*/ - 0, /*tp_iter*/ - 0, /*tp_iternext*/ - Robj_methods, /*tp_methods*/ - 0, /*tp_members*/ - 0, /*tp_getset*/ - 0, /*tp_base*/ - 0, /*tp_dict*/ - 0, /*tp_descr_get*/ - 0, /*tp_descr_set*/ - 0, /*tp_dictoffset*/ - 0, /*tp_init*/ -#ifdef _WIN32 - 0, /*tp_alloc*/ -#else - PyType_GenericAlloc, /*tp_alloc*/ -#endif - Robj_tpnew, /*tp_new*/ - 0, /*tp_free*/ - 0, /*tp_is_gc*/ -#endif -}; - - -/* Module functions */ - -/* Obtain an R object via its name. 'autoconvert' is the keyword to - set the autoconversion flag. */ -static PyObject * -get_fun(PyObject *self, PyObject *args, PyObject *kwds) -{ - char *obj_str; - int conversion=TOP_MODE; - SEXP robj; - - static char *kwlist[] = {"name", "autoconvert", 0}; - if (!PyArg_ParseTupleAndKeywords(args, kwds, "s|i:get", kwlist, - &obj_str, &conversion)) - return NULL; - - robj = get_fun_from_name(obj_str); - if (!robj) - return NULL; - - return (PyObject *)Robj_new(robj, conversion); -} - -static PyObject * -set_mode(PyObject *self, PyObject *args) -{ - int i=-1; - - if (!PyArg_ParseTuple(args, "i:set_mode", &i)) - return NULL; - - if (i<-1 || i>TOP_MODE) { - PyErr_SetString(PyExc_ValueError, "wrong mode"); - return NULL; - } - - default_mode = i; - Py_INCREF(Py_None); - return Py_None; -} - -static PyObject * -get_mode(PyObject *self, PyObject *args) -{ - if (!PyArg_ParseTuple(args, ":get_mode")) - return NULL; - - return PyInt_FromLong(default_mode); -} - -static PyObject * -r_events(PyObject *self, PyObject *args, PyObject *kwds) -#ifdef _WIN32 -{ - return NULL; -} -#else -{ - fd_set *what; - int usec=10000; - - static char *kwlist[] = {"usec", 0}; - if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:r_events", - kwlist, &usec)) - return NULL; - - if (R_interact) { - Py_BEGIN_ALLOW_THREADS - what = R_checkActivity(usec, 0); - R_runHandlers(R_InputHandlers, what); - Py_END_ALLOW_THREADS - } - - Py_INCREF(Py_None); - return Py_None; -} -#endif - -void -stop_events(void) -{ - PyObject *o; - - if (!rpy_dict) - return; - - if (!r_lock) - r_lock = PyDict_GetItemString(rpy_dict, "_r_lock"); - - o = PyObject_CallMethod(r_lock, "acquire", NULL); - Py_XDECREF(o); -} - -void -start_events(void) -{ - PyObject *o; - - if (!rpy_dict) - return; - - if (!r_lock) - r_lock = PyDict_GetItemString(rpy_dict, "_r_lock"); - - o = PyObject_CallMethod(r_lock, "release", NULL); - Py_XDECREF(o); -} - - -/* - * Based on code from Rstd_CleanUp(); - * from src/unix/sys-std.c - */ - -void r_finalize(void) -{ -#if (R_VERSION < R_Version(2,4,0)) - unsigned char buf[1024]; - char * tmpdir; -#endif - - R_dot_Last(); - R_RunExitFinalizers(); - CleanEd(); -#if (R_VERSION >= R_Version(2,7,0)) - Rf_KillAllDevices(); -#else - KillAllDevices(); -#endif - -#if (R_VERSION >= R_Version(2,4,0)) - R_CleanTempDir(); -#else - if((tmpdir = getenv("R_SESSION_TMPDIR"))) { - -# ifdef _WIN32 - snprintf((char *)buf, 1024, "rmdir /S /Q %s", tmpdir); -# else - snprintf((char *)buf, 1024, "rm -rf %s", tmpdir); -# endif - - R_system((char *)buf); - } -#endif - - PrintWarnings(); /* from device close and .Last */ - R_gc(); /* Remove any remaining R objects from memory */ -} - - -static PyObject * -r_cleanup(void) -{ - r_finalize(); - Py_INCREF(Py_None); - return Py_None; -} - -#ifdef WITH_NUMERIC -static void -init_numeric(void) -{ - PyObject *multiarray, *dict; - - if(use_numeric) - { - import_array(); - multiarray = PyImport_ImportModule(PY_ARRAY_MODULE_NAME); - if (multiarray) { - dict = PyModule_GetDict(multiarray); - if (dict) - Py_transpose = PyDict_GetItemString(dict, "transpose"); - } - } -} -#endif - -static PyObject * -r_init(PyObject *self, PyObject *args) -{ - static int first=1; - int i; - - if (!PyArg_ParseTuple(args, "i:r_init", &i)) - return NULL; - use_numeric = i; - -#ifdef WITH_NUMERIC - if(use_numeric) - init_numeric(); -#endif - - if(first==1) - { - first=0; - Py_INCREF(Py_None); - return Py_None; - } - else - { - PyErr_SetString(PyExc_RuntimeError, "Only one R object may be instantiated per session"); - return NULL; - } -} - -/* List of functions defined in the module */ -static PyMethodDef rpy_methods[] = { - {"get_fun", (PyCFunction)get_fun, METH_VARARGS | METH_KEYWORDS}, - {"set_mode", (PyCFunction)set_mode, METH_VARARGS}, - {"get_mode", (PyCFunction)get_mode, METH_VARARGS}, - {"set_output", (PyCFunction)set_output, METH_VARARGS}, - {"set_input", (PyCFunction)set_input, METH_VARARGS}, - {"set_showfiles", (PyCFunction)set_showfiles, METH_VARARGS}, - {"get_output", (PyCFunction)get_output, METH_VARARGS}, - {"get_input", (PyCFunction)get_input, METH_VARARGS}, - {"get_showfiles", (PyCFunction)get_showfiles, METH_VARARGS}, - {"r_events", (PyCFunction)r_events, METH_VARARGS | METH_KEYWORDS}, - {"r_cleanup", (PyCFunction)r_cleanup, METH_NOARGS}, - {"r_init", (PyCFunction)r_init, METH_VARARGS}, - {NULL, NULL} /* sentinel */ -}; - -#ifdef _WIN32 -static void char_message( char *s ) -{ - if (!s) return; - R_WriteConsole(s, strlen(s)); -} - -static int char_yesnocancel( char *s ) -{ - return 1; -} - -static void -RPyBusy( int which ) -{ - /* set a busy cursor ... in which = 1, unset if which = 0 */ -} - -static void -RPyDoNothing( void ) -{ -} - -/* initialise embedded R; based on rproxy_impl.c from the R distribution */ -static void -init_embedded_win32(int argc, - char *argv[]) -{ - structRstart rp; - Rstart Rp = &rp; - char Rversion[25]; - int index; - - - snprintf( Rversion, 25, "%s.%s", R_MAJOR, R_MINOR ); - if( strcmp( getDLLVersion(), Rversion ) != 0 ) { - PyErr_SetString( PyExc_ImportError, "R.DLL version does not match" ); - return; - } - - R_DefParams(Rp); - - /* set R_HOME */ - Rp->rhome = RHOME; - - index = strlen(RUSER) - 1; - - if (RUSER[index] == '/' || RUSER[index] == '\\') - RUSER[index] = '\0'; - - Rp->home = RUSER; - Rp->CharacterMode = LinkDLL; - - Rp->ReadConsole = (blah1) RPy_ReadConsole; // Matjaz - Rp->WriteConsole = (blah2) RPy_WriteConsole; // Matjaz - - Rp->CallBack = (blah3) RPyDoNothing; -#if R_VERSION < 0x20100 - Rp->message = char_message; - Rp->yesnocancel = char_yesnocancel; - Rp->busy = RPyBusy; -#else - Rp->ShowMessage = char_message; - Rp->YesNoCancel = char_yesnocancel; - Rp->Busy = RPyBusy; -#endif - - Rp->R_Quiet = TRUE; - - /* run as "interactive", so server won't be killed after an error */ - Rp->R_Slave = Rp->R_Verbose = 0; - Rp->R_Interactive = TRUE; - Rp->RestoreAction = SA_NORESTORE; /* no restore */ - Rp->SaveAction = SA_NOSAVE; /* no save */ - -#if R_VERSION < 0x20000 // pre-R-2.0.0 - - Rp->CommandLineArgs = NULL; - Rp->NumCommandLineArgs = 0; -#else - R_set_command_line_arguments(argc, argv); -#endif - R_SetParams(Rp); /* so R_ShowMessage is set */ - R_SizeFromEnv(Rp); - - R_SetParams(Rp); - - setup_term_ui(); - setup_Rmainloop(); -} -#endif - -/* Initialization function for the module */ -DL_EXPORT(void) -INIT_RPY(void) -{ - PyObject *m, *d; - PyOS_sighandler_t old_int; -#ifndef _WIN32 - PyOS_sighandler_t old_usr1, old_usr2; -#endif - SEXP interact; - - /* Get path and version information from environment */ - strncpy(RHOME, getenv("RPY_RHOME"), BUFSIZ); - strncpy(RVERSION, getenv("RPY_RVERSION"), BUFSIZ); - strncpy(RVER, getenv("RPY_RVER"), BUFSIZ); - strncpy(RUSER, getenv("RPY_RUSER"), BUFSIZ); - - if( !strlen(RHOME) || !strlen(RVERSION) || !strlen(RVER) || !strlen(RUSER)) - { - PyErr_Format(RPy_Exception, - "Unable to load R path or version information"); - return; - } - - Robj_Type.ob_type = &PyType_Type; -#if defined( _WIN32 ) && ! defined( PRE_2_2 ) - Robj_Type.tp_getattro = PyObject_GenericGetAttr; - Robj_Type.tp_alloc = PyType_GenericAlloc; -#endif - - /* Initialize the module with its content */ - if (PyType_Ready(&Robj_Type) < 0) - return; - m = Py_InitModule3(xstr(RPY_SHNAME), - rpy_methods, - "Python interface to the R Programming Language"); - Py_INCREF(&Robj_Type); - PyModule_AddObject(m, Robj_Type.tp_name, - (PyObject *)&Robj_Type); - - d = PyModule_GetDict(m); - - /* Save this interpreter */ - PyEval_InitThreads(); - my_interp = PyThreadState_Get()->interp; - - /* Save the Python signal handlers. If R inserts its handlers, we - cannot return to the Python interpreter. */ - old_int = PyOS_getsig(SIGINT); - python_sigint = old_int; -#ifndef _WIN32 - old_usr1 = PyOS_getsig(SIGUSR1); - old_usr2 = PyOS_getsig(SIGUSR2); -#endif - -#ifdef _WIN32 - init_embedded_win32(defaultargc, - defaultargv); -#else - Rf_initEmbeddedR(defaultargc, - defaultargv); -#endif - - -#ifdef CSTACK_DEFNS - /* Disable C stack checking, which is incompatible with use as a - shared library. */ - R_CStackLimit = (uintptr_t)-1; -#endif - - /* Restore Python handlers */ - PyOS_setsig(SIGINT, old_int); -#ifndef _WIN32 - PyOS_setsig(SIGUSR1, old_usr1); - PyOS_setsig(SIGUSR2, old_usr2); -#endif - - /* Several new exceptions: */ - RPy_Exception = PyErr_NewException("rpy.RPy_Exception", NULL, NULL); - RPy_TypeConversionException = PyErr_NewException("rpy.RPy_TypeConversionException", RPy_Exception, NULL); - RPy_RException = PyErr_NewException("rpy.RPy_RException", RPy_Exception, NULL); - - if (!RPy_Exception || !RPy_TypeConversionException || !RPy_RException ) - { - PyErr_Format(RPy_Exception, "Unable create RPy exceptions"); - return; - } - - PyDict_SetItemString(d, "RPy_Exception", RPy_Exception); - PyDict_SetItemString(d, "RPy_TypeConversionException", RPy_TypeConversionException); - PyDict_SetItemString(d, "RPy_RException", RPy_RException); - - // The conversion table - class_table = PyDict_New(); - proc_table = PyDict_New(); - PyDict_SetItemString(d, "__class_table__", class_table); - PyDict_SetItemString(d, "__proc_table__", proc_table); - - // The globals R objects for the sequence protocol - get_item = get_fun_from_name("["); - set_item = get_fun_from_name("[<-"); - length = get_fun_from_name("length"); - - // Function to transpose arrays - aperm = get_fun_from_name("aperm"); - - // Initialize the list of protected objects - R_References = R_NilValue; - SET_SYMVALUE(install("R.References"), R_References); - - // Initialize the default mode - default_mode = -1; - - // Check whether R is interactive or no - interact = do_eval_fun("interactive"); - R_interact = INTEGER(interact)[0]; - - // I/O routines - init_io_routines(); - - rpy = PyImport_ImportModule("rpy"); - rpy_dict = PyModule_GetDict(rpy); - // r_lock = PyDict_GetItemString(rpy_dict, "_r_lock"); - // PyObject_Print(r_lock, stderr, Py_PRINT_RAW); - r_lock = NULL; - - if( Py_AtExit( r_finalize ) ) - { - fprintf(stderr, "Warning: Unable to set R finalizer."); - fflush(stderr); - } - - -} - - reverted: --- rpy-1.0.3/src/io2122.c +++ rpy-1.0.3.orig/src/io2122.c @@ -1,273 +0,0 @@ -/* - * $Id: io.c 515 2008-05-14 13:53:05Z warnes $ - * Input/Output routines - */ - -/* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1/GPL 2.0/LGPL 2.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is the RPy python module. - * - * The Initial Developer of the Original Code is Walter Moreira. - * Portions created by the Initial Developer are Copyright (C) 2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Gregory R. Warnes (Maintainer) - * - * Alternatively, the contents of this file may be used under the terms of - * either the GNU General Public License Version 2 or later (the "GPL"), or - * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), - * in which case the provisions of the GPL or the LGPL are applicable instead - * of those above. If you wish to allow use of your version of this file only - * under the terms of either the GPL or the LGPL, and not to allow others to - * use your version of this file under the terms of the MPL, indicate your - * decision by deleting the provisions above and replace them with the notice - * and other provisions required by the GPL or the LGPL. If you do not delete - * the provisions above, a recipient may use your version of this file under - * the terms of any one of the MPL, the GPL or the LGPL. - * - * ***** END LICENSE BLOCK ***** */ - - -#include "RPy.h" - -#define ENTER_PY { PyThreadState* tstate = NULL;\ - if (_PyThreadState_Current == NULL) {\ - tstate = PyThreadState_New(my_interp);\ - PyEval_AcquireThread(tstate);\ - } - -#define LEAVE_PY if (tstate) {\ - PyEval_ReleaseThread(tstate);}\ - } - -PyObject *rpy_output=NULL, *rpy_input=NULL, *rpy_showfiles=NULL; - -/* Show the traceback of an exception which occurred in a I/O process, - except when the error is a KeyboardInterrupt, in which case abort - the R interpreter */ -void -RPy_ShowException() -{ - PyObject *err; - - if ((err = PyErr_Occurred())) { - if (PyErr_GivenExceptionMatches(err, PyExc_KeyboardInterrupt)) { - interrupt_R(0); - } - else { - PyErr_WriteUnraisable(err); - PyErr_Clear(); - } - } -} - - -void -RPy_WriteConsole(char *buf, int len) -{ - PyOS_sighandler_t old_int; - PyObject *dummy; - - /* It is necessary to restore the Python handler when using a Python - function for I/O. */ - old_int = PyOS_getsig(SIGINT); - PyOS_setsig(SIGINT, python_sigint); - if (rpy_output) { - ENTER_PY - dummy = PyObject_CallFunction(rpy_output, "s", buf); - Py_XDECREF(dummy); - LEAVE_PY - } - signal(SIGINT, old_int); - RPy_ShowException(); -} - -#ifdef _WIN32 -int -RPy_ReadConsole(char *prompt, - char *buf, - int len, - int addtohistory) -#else -int -RPy_ReadConsole(char *prompt, - unsigned char *buf, - int len, - int addtohistory) -#endif -{ - PyObject *input_data; - PyOS_sighandler_t old_int; - - if (!rpy_input) - return 0; - - old_int = PyOS_getsig(SIGINT); - PyOS_setsig(SIGINT, python_sigint); - ENTER_PY - start_events(); - input_data = PyObject_CallFunction(rpy_input, "si", prompt, len); - stop_events(); - LEAVE_PY - - signal(SIGINT, old_int); - - RPy_ShowException(); - - if (!input_data) { - PyErr_Clear(); - return 0; - } - snprintf( (char*) buf, len, "%s", PyString_AsString(input_data)); - Py_DECREF(input_data); - return 1; -} - -int -RPy_ShowFiles(int nfile, char **file, char **headers, - char *wtitle, int del, char *pager) -{ - PyObject *pyfiles, *pyheaders, *result, *f, *h; - PyOS_sighandler_t old_int; - int i; - - if (rpy_showfiles==NULL) - return 0; - - old_int = PyOS_getsig(SIGINT); - PyOS_setsig(SIGINT, python_sigint); - - ENTER_PY - - pyfiles = PyList_New(0); - pyheaders = PyList_New(0); - if (!(pyfiles && pyheaders)) { - return 0; - } - - for (i=0; i (Maintainer) - * - * Alternatively, the contents of this file may be used under the terms of - * either the GNU General Public License Version 2 or later (the "GPL"), or - * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), - * in which case the provisions of the GPL or the LGPL are applicable instead - * of those above. If you wish to allow use of your version of this file only - * under the terms of either the GPL or the LGPL, and not to allow others to - * use your version of this file under the terms of the MPL, indicate your - * decision by deleting the provisions above and replace them with the notice - * and other provisions required by the GPL or the LGPL. If you do not delete - * the provisions above, a recipient may use your version of this file under - * the terms of any one of the MPL, the GPL or the LGPL. - * - * ***** END LICENSE BLOCK ***** */ -/* - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - * - * - * Evaluation of R expressions. - * - * $Id: R_eval.c 363 2007-11-12 23:27:48Z warnes $ - * - */ - -#include - -/* The Python original SIGINT handler */ -PyOS_sighandler_t python_sigint; - -/* Indicates whether the R interpreter was interrupted by a SIGINT */ -int interrupted = 0; - -/* Abort the current R computation due to a SIGINT */ -void interrupt_R(int signum) -{ - interrupted = 1; - error("Interrupted"); -} - - -/* Evaluate a SEXP. It must be constructed by hand. It raises a Python - exception if an error ocurred in the evaluation */ -SEXP do_eval_expr(SEXP e) { - SEXP res; - int error = 0; - PyOS_sighandler_t old_int; - - /* Enable our handler for SIGINT inside the R - interpreter. Otherwise, we cannot stop R calculations, since - SIGINT is only processed between Python bytecodes. Also, save the - Python SIGINT handler because it is necessary to temporally - restore it in user defined I/O Python functions. */ - stop_events(); - - #ifdef _WIN32 - old_int = PyOS_getsig(SIGBREAK); - #else - old_int = PyOS_getsig(SIGINT); - #endif - python_sigint = old_int; - - signal(SIGINT, interrupt_R); - - interrupted = 0; - res = R_tryEval(e, R_GlobalEnv, &error); - - #ifdef _WIN32 - PyOS_setsig(SIGBREAK, old_int); - #else - PyOS_setsig(SIGINT, old_int); - #endif - - start_events(); - - if (error) { - if (interrupted) { - PyErr_SetNone(PyExc_KeyboardInterrupt); - } - else - PyErr_SetString(RPy_RException, get_last_error_msg()); - return NULL; - } - - - return res; -} - -/* Evaluate a function given by a name (without arguments) */ -SEXP do_eval_fun(char *name) { - SEXP exp, fun, res; - - fun = get_fun_from_name(name); - if (!fun) - return NULL; - - PROTECT(fun); - PROTECT(exp = allocVector(LANGSXP, 1)); - SETCAR(exp, fun); - - PROTECT(res = do_eval_expr(exp)); - UNPROTECT(3); - return res; -} - -/* - * Get an R **function** object by its name. When not found, an exception is - * raised. The checking of the length of the identifier is needed to - * avoid R raising an error causing Python to dump core. - */ -SEXP get_fun_from_name(char *ident) { - SEXP obj; - - /* For R not to throw an error, we must check the identifier is - neither null nor greater than MAXIDSIZE */ - if (!*ident) { - PyErr_SetString(RPy_Exception, "attempt to use zero-length variable name"); - return NULL; - } - if (strlen(ident) > MAXIDSIZE) { - PyErr_SetString(RPy_Exception, "symbol print-name too long"); - return NULL; - } - -#if R_VERSION < 0x20000 - obj = Rf_findVar(Rf_install(ident), R_GlobalEnv); -#else - /* - * For R-2.0.0 and later, it is necessary to use findFun to get - * functions. Unfortunately, calling findFun on an undefined name - * causes a segfault! - * - * Solution: - * - * 1) Call findVar on the name - * - * 2) If something has the name, call findFun - * - * 3) Raise an error if either step 1 or 2 fails. - */ - obj = Rf_findVar(Rf_install(ident), R_GlobalEnv); - - if (obj != R_UnboundValue) - obj = Rf_findFun(Rf_install(ident), R_GlobalEnv); -#endif - - if (obj == R_UnboundValue) { - PyErr_Format(RPy_Exception, "R Function \"%s\" not found", ident); - return NULL; - } - return obj; -} - -/* Obtain the text of the last R error message */ -const char *get_last_error_msg() { - SEXP msg; - - msg = do_eval_fun("geterrmessage"); - return CHARACTER_VALUE(msg); -} reverted: --- rpy-1.0.3/src/io2130.c +++ rpy-1.0.3.orig/src/io2130.c @@ -1,273 +0,0 @@ -/* - * $Id: io.c 515 2008-05-14 13:53:05Z warnes $ - * Input/Output routines - */ - -/* ***** BEGIN LICENSE BLOCK ***** - * Version: MPL 1.1/GPL 2.0/LGPL 2.1 - * - * The contents of this file are subject to the Mozilla Public License Version - * 1.1 (the "License"); you may not use this file except in compliance with - * the License. You may obtain a copy of the License at - * http://www.mozilla.org/MPL/ - * - * Software distributed under the License is distributed on an "AS IS" basis, - * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License - * for the specific language governing rights and limitations under the - * License. - * - * The Original Code is the RPy python module. - * - * The Initial Developer of the Original Code is Walter Moreira. - * Portions created by the Initial Developer are Copyright (C) 2002 - * the Initial Developer. All Rights Reserved. - * - * Contributor(s): - * Gregory R. Warnes (Maintainer) - * - * Alternatively, the contents of this file may be used under the terms of - * either the GNU General Public License Version 2 or later (the "GPL"), or - * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), - * in which case the provisions of the GPL or the LGPL are applicable instead - * of those above. If you wish to allow use of your version of this file only - * under the terms of either the GPL or the LGPL, and not to allow others to - * use your version of this file under the terms of the MPL, indicate your - * decision by deleting the provisions above and replace them with the notice - * and other provisions required by the GPL or the LGPL. If you do not delete - * the provisions above, a recipient may use your version of this file under - * the terms of any one of the MPL, the GPL or the LGPL. - * - * ***** END LICENSE BLOCK ***** */ - - -#include "RPy.h" - -#define ENTER_PY { PyThreadState* tstate = NULL;\ - if (_PyThreadState_Current == NULL) {\ - tstate = PyThreadState_New(my_interp);\ - PyEval_AcquireThread(tstate);\ - } - -#define LEAVE_PY if (tstate) {\ - PyEval_ReleaseThread(tstate);}\ - } - -PyObject *rpy_output=NULL, *rpy_input=NULL, *rpy_showfiles=NULL; - -/* Show the traceback of an exception which occurred in a I/O process, - except when the error is a KeyboardInterrupt, in which case abort - the R interpreter */ -void -RPy_ShowException() -{ - PyObject *err; - - if ((err = PyErr_Occurred())) { - if (PyErr_GivenExceptionMatches(err, PyExc_KeyboardInterrupt)) { - interrupt_R(0); - } - else { - PyErr_WriteUnraisable(err); - PyErr_Clear(); - } - } -} - - -void -RPy_WriteConsole(char *buf, int len) -{ - PyOS_sighandler_t old_int; - PyObject *dummy; - - /* It is necessary to restore the Python handler when using a Python - function for I/O. */ - old_int = PyOS_getsig(SIGINT); - PyOS_setsig(SIGINT, python_sigint); - if (rpy_output) { - ENTER_PY - dummy = PyObject_CallFunction(rpy_output, "s", buf); - Py_XDECREF(dummy); - LEAVE_PY - } - signal(SIGINT, old_int); - RPy_ShowException(); -} - -#ifdef _WIN32 -int -RPy_ReadConsole(char *prompt, - char *buf, - int len, - int addtohistory) -#else -int -RPy_ReadConsole(char *prompt, - unsigned char *buf, - int len, - int addtohistory) -#endif -{ - PyObject *input_data; - PyOS_sighandler_t old_int; - - if (!rpy_input) - return 0; - - old_int = PyOS_getsig(SIGINT); - PyOS_setsig(SIGINT, python_sigint); - ENTER_PY - start_events(); - input_data = PyObject_CallFunction(rpy_input, "si", prompt, len); - stop_events(); - LEAVE_PY - - signal(SIGINT, old_int); - - RPy_ShowException(); - - if (!input_data) { - PyErr_Clear(); - return 0; - } - snprintf( (char*) buf, len, "%s", PyString_AsString(input_data)); - Py_DECREF(input_data); - return 1; -} - -int -RPy_ShowFiles(int nfile, char **file, char **headers, - char *wtitle, int del, char *pager) -{ - PyObject *pyfiles, *pyheaders, *result, *f, *h; - PyOS_sighandler_t old_int; - int i; - - if (rpy_showfiles==NULL) - return 0; - - old_int = PyOS_getsig(SIGINT); - PyOS_setsig(SIGINT, python_sigint); - - ENTER_PY - - pyfiles = PyList_New(0); - pyheaders = PyList_New(0); - if (!(pyfiles && pyheaders)) { - return 0; - } - - for (i=0; i (Maintainer) - * - * Alternatively, the contents of this file may be used under the terms of - * either the GNU General Public License Version 2 or later (the "GPL"), or - * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), - * in which case the provisions of the GPL or the LGPL are applicable instead - * of those above. If you wish to allow use of your version of this file only - * under the terms of either the GPL or the LGPL, and not to allow others to - * use your version of this file under the terms of the MPL, indicate your - * decision by deleting the provisions above and replace them with the notice - * and other provisions required by the GPL or the LGPL. If you do not delete - * the provisions above, a recipient may use your version of this file under - * the terms of any one of the MPL, the GPL or the LGPL. - * - * ***** END LICENSE BLOCK ***** */ - -#include -#if (R_VERSION >= R_Version(2,3,0)) - -# ifndef _WIN32 -# define CSTACK_DEFNS // Enable definitions needed for stack checking control -# endif - -#endif - -#include "RPy.h" - -#define NONAMELESSUNION -#include -#include -#include - -/* Flag indicating whether Numpy/Numeric is available in this session - * - * This is necessary since Numpy/Numeric may not available at run time, even if - * it was available at compile time. -*/ -static int use_numeric=0; - - -/* Local function definitions */ -DL_EXPORT(void) INIT_RPY(void); /* Module initializer */ -static PyObject *r_init(PyObject *self, /* Class initializer */ - PyObject *args); -static PyObject *r_cleanup(void); /* Clean up R & release resources */ - -#ifdef _WIN32 -static void init_embedded_win32(int argc, char *argv[]); -#endif - -/* Global objects */ -static SEXP get_item; -static SEXP set_item; -static SEXP length; -static SEXP aperm; -static PyObject *class_table; -static PyObject *proc_table; -static int default_mode; -static PyObject *r_lock; -PyObject *RPy_Exception; -PyObject *RPy_TypeConversionException; -PyObject *RPy_RException; - -static char RHOME[BUFSIZ]; -static char RVERSION[BUFSIZ]; -static char RVER[BUFSIZ]; -static char RUSER[BUFSIZ]; -char *defaultargv[] = {"rpy", "-q", "--vanilla"}; -int defaultargc = sizeof(defaultargv) / sizeof(defaultargv[0]); - -/* Global interpreter */ -PyInterpreterState *my_interp; - -/* Signal whether R is running interactively */ -int R_interact; - -/* RPy namespace */ -PyObject *rpy; -PyObject *rpy_dict; - - -#ifdef WITH_NUMERIC -static PyObject *Py_transpose; -#endif - -/* Global list to protect R objects from garbage collection */ -/* This is inspired in $R_SRC/src/main/memory.c */ -static SEXP R_References; - -static SEXP -RecursiveRelease(SEXP obj, SEXP list) -{ - if (!isNull(list)) { - if (obj == CAR(list)) - return CDR(list); - else - SETCDR(list, RecursiveRelease(obj, CDR(list))); - } - return list; -} - -/* Robj methods. Following xxmodule.c from Python distro. */ - -static void -Robj_dealloc(RobjObject *self) -{ - /* Remove the object from the list of protected objects */ - R_References = RecursiveRelease(self->R_obj, R_References); - SET_SYMVALUE(install("R.References"), R_References); - - PyObject_Del(self); -} - -RobjObject * -Robj_new(SEXP robj, int conversion) -{ - RobjObject *self; - self = PyObject_New(RobjObject, &Robj_Type); - if (!self) - return NULL; - - if (!robj) - return NULL; - - /* Protect the R object */ - R_References = CONS(robj, R_References); - SET_SYMVALUE(install("R.References"), R_References); - - self->R_obj = robj; - self->conversion = conversion; - return self; -} - -#ifndef PRE_2_2 -static PyObject * -Robj_tpnew(PyTypeObject *type, PyObject *args, PyObject *kwds) -{ - PyObject *self; - - self = type->tp_alloc(type, 0); - return self; -} -#endif - -/* Type conversion routines. See documentation for details */ - -/* These are auxiliaries for a state machine for converting Python - list to the coarsest R vector type */ -#define ANY_T 0 -#define BOOL_T 1 -#define INT_T 2 -#define FLOAT_T 3 -#define COMPLEX_T 4 -#define STRING_T 5 -#define ROBJ_T 6 - -static int -type_to_int(PyObject *obj) -{ - if (PyBool_Check(obj)) - return BOOL_T; - else if (PyInt_Check(obj)) - return INT_T; - else if (PyFloat_Check(obj)) - return FLOAT_T; - else if (PyComplex_Check(obj)) - return COMPLEX_T; - else if (PyNumber_Check(obj)) - return ANY_T; - else if (PyString_Check(obj)) - return STRING_T; - else if (PyUnicode_Check(obj)) - return STRING_T; - else if (Robj_Check(obj)) - return ROBJ_T; - else - return ANY_T; -} - -/* Make a R list or vector from a Python sequence */ -static SEXP -seq_to_R(PyObject *obj) -{ - PyObject *it; - SEXP robj, rit; - int i, len, state; - - /* This matrix defines what mode a vector should take given what - it already contains and a new item - - E.g. Row 0 indicates that if we've seen an any, the vector will - always remain an any. Row 3 indicates that if we've seen a - float, then seeing an boolean, integer, or float will preserve - the vector as a float vector, while seeing a string or an Robj will - convert it into an any vector. - */ - int fsm[7][7] = { - {0, 0, 0, 0, 0, 0, 0}, // any - {0, 1, 2, 3, 4, 0, 0}, // bool - {0, 2, 2, 3, 4, 0, 0}, // int - {0, 3, 3, 3, 4, 0, 0}, // float - {0, 4, 4, 4, 4, 0, 0}, // complex - {0, 0, 0, 0, 0, 5, 0}, // string - {0, 0, 0, 0, 0, 0, 6} // RObj - }; - - len = PySequence_Length(obj); - if (len == 0) - return R_NilValue; - - PROTECT(robj = NEW_LIST(len)); - - state = -1; - for (i=0; idimensions; - type = obj->descr->type_num; - size = PyArray_Size( (PyObject*) obj); - - /* Handle a vector without dimensions, just length */ - if(obj->nd==0) - { - PROTECT(Rdims = allocVector(INTSXP, 1)); - PROTECT(tRdims = allocVector(INTSXP, 1)); - INTEGER(Rdims)[0] = size; - INTEGER(tRdims)[0] = size; - } - else - { - PROTECT(Rdims = allocVector(INTSXP, obj->nd)); - PROTECT(tRdims = allocVector(INTSXP, obj->nd)); - - for (i=0; ind; i++) - { - if (dims[i] == 0) - { - UNPROTECT(2); - return R_NilValue; - } - INTEGER(Rdims)[i] = dims[(obj->nd)-i-1]; - INTEGER(tRdims)[i] = (obj->nd)-i; - } - } - - switch(type) - { - - /*******************/ - /* String Variants */ - /*******************/ - /* TODO: Add proper handling of NumPy character arrays. - The following code DOES NOT WORK: - - #if WITH_NUMERIC==3 - case PyArray_UNICODE: - case PyArray_STRING: - case PyArray_CHAR: - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_STRING, 0, 0); - #endif - - The problem is that the PyArray call throws an exception, - presumably because we haven't given a width specifier. - - NumPy strings are fixed-width, and may not be null terminated. R only handles - null terminated (varying width) strings. We need a separate - code path to handle this, as it requires quite different - handling than the numeric arrays dealt with below. - */ - - - /******************************************/ - /* All complex to (double,double) complex */ - /******************************************/ - -#if WITH_NUMERIC==1 /* Numeric */ - case PyArray_CFLOAT: - case PyArray_CDOUBLE: -#else /* NumPy */ - case PyArray_COMPLEX64: - case PyArray_COMPLEX128: -#endif - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_CDOUBLE, 0, 0); - break; - - - /**********************************************************************************/ - /* Convert all integers to platform integer (except 64 bit int on 32 bit platforms) */ - /************************************************************************************/ - -#if WITH_NUMERIC==1 /* Numeric */ - case PyArray_UBYTE: - case PyArray_SBYTE: - case PyArray_SHORT: - case PyArray_INT: - case PyArray_LONG: - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_INT, 0, 0); - break; -#else /* NumPy */ - case PyArray_BOOL: - case PyArray_INT8: - case PyArray_UINT8: - case PyArray_INT16: - case PyArray_UINT16: - case PyArray_INT32: - case PyArray_UINT32: -#if PyArray_INT==PyArray_INT64 /* 64 bit platform */ - case PyArray_INT64: - case PyArray_UINT64: -#else - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_INT, 0, 0); - break; -#endif -#endif - - /**************************************************/ - /* All floats (and over-sized integers) to double */ - /**************************************************/ -#if WITH_NUMERIC==1 /* Numeric */ - case PyArray_FLOAT: - case PyArray_DOUBLE: -#else /* NumPy */ - case PyArray_FLOAT32: - case PyArray_FLOAT64: -#if PyArray_INT!=PyArray_INT64 /* 32 bit platform */ - case PyArray_INT64: - case PyArray_UINT64: -#endif -#endif - obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, - PyArray_DOUBLE, 0, 0); - break; - - default: - UNPROTECT(2); - PyErr_Format(RPy_TypeConversionException, - "Numeric/NumPy arrays containing %s are not supported.", - obj->ob_type->tp_name); - return R_NilValue; - break; - } - - - pytl = Py_BuildValue("[i]", size); - nobj = PyArray_Reshape(obj, pytl); - Py_XDECREF(pytl); - Py_XDECREF(obj); - - if (nobj == NULL) - { - UNPROTECT(2); - return R_NilValue; - } - - - PROTECT(Rarray = seq_to_R(nobj)); - if (Rarray == NULL) - { - UNPROTECT(3); - return R_NilValue; - } - - - Py_XDECREF(nobj); - SET_DIM(Rarray, Rdims); - - PROTECT(e = allocVector(LANGSXP, 3)); - SETCAR(e, aperm); - SETCAR(CDR(e), Rarray); - SETCAR(CDR(CDR(e)), tRdims); - PROTECT(Rarray = do_eval_expr(e)); - - UNPROTECT(5); - return Rarray; -} -#endif - -/* Convert a Python object to a R object. An Robj is passed w/o - * modifications, an object which provides a '.as_r()' method, is - * passed as the result of that method */ -SEXP -to_Robj(PyObject *obj) -{ - SEXP robj; - Py_complex c; - PyObject *to_r_meth; - PyObject *tempObj; - int do_decref = 0; - - if (obj==NULL) - return NULL; - - if (obj == Py_None) { - return R_NilValue; - } - - to_r_meth = PyObject_GetAttrString(obj, "as_r"); - if (to_r_meth) { - obj = PyObject_CallObject(to_r_meth, NULL); - Py_DECREF(to_r_meth); - if (obj==NULL) - return NULL; - do_decref = 1; - } - PyErr_Clear(); - - - if (Robj_Check(obj)) - { - PROTECT(robj = ((RobjObject *)obj)->R_obj); - } - else if (PyBool_Check(obj)) - { - PROTECT(robj = NEW_LOGICAL(1)); - LOGICAL_DATA(robj)[0] = (Py_True==obj); - } - else if (PyInt_Check(obj)) - { - PROTECT(robj = NEW_INTEGER(1)); - INTEGER_DATA(robj)[0] = (int) PyInt_AsLong(obj); - } - else if (PyFloat_Check(obj)) - { - PROTECT(robj = NEW_NUMERIC(1)); - NUMERIC_DATA(robj)[0] = PyFloat_AsDouble(obj); - } - else if (PyComplex_Check(obj)) - { - PROTECT(robj = NEW_COMPLEX(1)); - c = PyComplex_AsCComplex(obj); - COMPLEX_DATA(robj)[0].r = c.real; - COMPLEX_DATA(robj)[0].i = c.imag; - } - else if (PyUnicode_Check(obj)) - { - /** Handle Unicode Strings. - * - * Ideally: Python Unicode -> R Unicode, - * - * Unfortunately, the R documentation is not forthcoming on how - * to accomplish this - * - * So, for the moment: - * python Unicode -> Python ASCII -> ordinary string -> R string - * - */ - PROTECT(robj = NEW_STRING(1)); - SET_STRING_ELT(robj, 0, COPY_TO_USER_STRING(PyString_AsString(PyUnicode_AsASCIIString(obj)))); - } - else if (PyString_Check(obj)) - { - PROTECT(robj = NEW_STRING(1)); - SET_STRING_ELT(robj, 0, COPY_TO_USER_STRING(PyString_AsString(obj))); - } -#ifdef WITH_NUMERIC - else if (use_numeric && PyArray_Check(obj)) - { - PROTECT(robj = to_Rarray(obj)); - } -#endif - else if ((PySequence_Check(obj)) && - (PySequence_Size(obj) >= 0)) - { - PROTECT(robj = seq_to_R(obj)); /* No labels */ - } - else if ((PyMapping_Check(obj)) && - (PyMapping_Size(obj) >= 0)) - { - PROTECT(robj = dict_to_R(obj)); - } - else if (PyNumber_Check(obj)) /* generic number interface */ - { - tempObj = PyNumber_Float(obj); - if(!tempObj) goto error; - - PROTECT(robj = NEW_NUMERIC(1)); - NUMERIC_DATA(robj)[0] = PyFloat_AsDouble(tempObj); - Py_DECREF(tempObj); - } - else - { - error: - PyErr_Format(RPy_TypeConversionException, - "cannot convert from type '%s'", - obj->ob_type->tp_name); - PROTECT(robj = NULL); /* Protected to avoid stack inbalance */ - } - - if (do_decref) - { - Py_DECREF(obj); - } - UNPROTECT(1); - return robj; -} - -/* Convert a R named vector or list to a Python dictionary */ -static PyObject * -to_PyDict(PyObject *obj, SEXP names) -{ - int len, i; - PyObject *it, *dict; - const char *name; - - if ((len = PySequence_Length(obj)) < 0) - return NULL; - - dict = PyDict_New(); - for (i=0; i 1) && (res[l-1] == '_') && (res[l-2] != '_')) - res[l-1]=0; - - while ((r=strchr(r, '_'))) - *r = '.'; - - return res; -} - -/* Convert a dict to keywords arguments for a R function */ -int -make_kwds(int lkwds, PyObject *kwds, SEXP *e) -{ - SEXP r; - const char *s; - int i; - PyObject *citems=NULL, *it; - PyObject *kwname; - - if (kwds) { - citems = PyMapping_Items(kwds); - } - - for (i=0; iR_obj); - e = CDR(e); - - if (!make_args(largs, args, &e)) { - UNPROTECT(1); - return NULL; - } - if (!make_kwds(lkwds, kwds, &e)) { - UNPROTECT(1); - return NULL; - } - - PROTECT(res = do_eval_expr(exp)); - if (!res) { - UNPROTECT(2); - return NULL; - } - - if (default_mode < 0) - conv = ((RobjObject *)self)->conversion; - else - conv = default_mode; - - obj = to_Pyobj_with_mode(res, conv); - UNPROTECT(2); - - PrintWarnings(); /* show any warning messages */ - - return obj; -} - -/* Convert a sequence of (name, value) pairs to arguments to an R - function call */ -int -make_argl(int largl, PyObject *argl, SEXP *e) -{ - SEXP rvalue; - const char *name; - int i; - PyObject *it, *nobj, *value; - - if( !PySequence_Check(argl) ) goto fail_arg; - - for (i=0; i0) - { - SET_TAG(*e, Rf_install(name)); - PyMem_Free((void*) name); - } - - /* Move index to new end of call */ - *e = CDR(*e); - } - return 1; - - fail_arg: - PyErr_SetString(PyExc_ValueError, - "Argument must be a sequence of (\"name\", value) pairs.\n"); - fail: - return 0; -} - -/* Methods for the 'Robj' type */ - -/* Explicitly call an R object with a list containing (name, value) * - * argument pairs. 'name' can be None or '' to provide unnamed - * arguments. This function is necessary when the *order* of named - * arguments needs to be preserved. - */ - -static PyObject * -Robj_lcall(PyObject *self, PyObject *args) -{ - SEXP exp, e, res; - int largs, largl, conv; - PyObject *obj, *argl; - - /* Check arguments, there should be *exactly one* unnamed sequence. */ - largs = 0; - if (args) - largs = PyObject_Length(args); - if (largs<0) - return NULL; - - if(largs != 1 || !PySequence_Check(args) ) - { - PyErr_SetString(PyExc_ValueError, - "Argument must be a sequence of (\"name\", value) pairs.\n"); - return NULL; - } - - // extract our one argument - argl = PySequence_GetItem(args, 0); - Py_DECREF(args); - - largl = 0; - if (argl) - largl = PyObject_Length(argl); - if (largl<0) - return NULL; - - // A SEXP with the function to call and the arguments - PROTECT(exp = allocVector(LANGSXP, largl+1)); - e = exp; - SETCAR(e, ((RobjObject *)self)->R_obj); - e = CDR(e); - - // Add the arguments to the SEXP - if (!make_argl(largl, argl, &e)) { - UNPROTECT(1); - return NULL; - } - - // Evaluate - PROTECT(res = do_eval_expr(exp)); - if (!res) { - UNPROTECT(2); - return NULL; - } - - // Convert - if (default_mode < 0) - conv = ((RobjObject *)self)->conversion; - else - conv = default_mode; - - obj = to_Pyobj_with_mode(res, conv); - UNPROTECT(2); - - // Return - return obj; -} - - -/* Without args return the value of the conversion flag. With an - argument set the conversion flag to the truth value of the argument. */ -static PyObject * -Robj_autoconvert(PyObject *self, PyObject *args, PyObject *kwds) -{ - PyObject *obj; - int conversion=-2; - char *kwlist[] = {"val", 0}; - - if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:autoconvert", kwlist, - &conversion)) - return NULL; - - if (conversion > TOP_MODE) { - PyErr_SetString(PyExc_ValueError, "wrong mode"); - return NULL; - } - - if (conversion == -2) { - obj = PyInt_FromLong((long)((RobjObject *)self)->conversion); - } else { - ((RobjObject *)self)->conversion = conversion; - obj = Py_None; - Py_XINCREF(obj); - } - - return obj; -} - -static PyObject * -Robj_as_py(PyObject *self, PyObject *args, PyObject *kwds) -{ - PyObject *obj; - char *kwlist[] = {"mode", 0}; - int conv=default_mode; - - if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:as_py", kwlist, - &conv)) - return NULL; - - if (conv <= -2 || conv > TOP_MODE) { - PyErr_SetString(PyExc_ValueError, "wrong mode"); - return NULL; - } - - if (conv < 0) - conv = TOP_MODE; - - obj = to_Pyobj_with_mode(((RobjObject *)self)->R_obj, conv); - return obj; -} - -static PyMethodDef Robj_methods[] = { - {"autoconvert", (PyCFunction)Robj_autoconvert, METH_VARARGS|METH_KEYWORDS}, - {"local_mode", (PyCFunction)Robj_autoconvert, METH_VARARGS|METH_KEYWORDS}, - {"as_py", (PyCFunction)Robj_as_py, METH_VARARGS|METH_KEYWORDS}, - {"lcall", (PyCFunction)Robj_lcall, METH_VARARGS}, - {NULL, NULL} /* sentinel */ -}; - -/* Sequence protocol implementation */ - -/* len(a) */ -static int -Robj_len(PyObject *a) -{ - SEXP e, robj; - - PROTECT(e = allocVector(LANGSXP, 2)); - SETCAR(e, length); - SETCAR(CDR(e), ((RobjObject *)a)->R_obj); - - if (!(robj = do_eval_expr(e))) { - UNPROTECT(1); - return -1; - } - - UNPROTECT(1); - return INTEGER_DATA(robj)[0]; -} - -/* a[i] = v */ -static int -Robj_ass_item(PyObject *a, int i, PyObject *v) -{ - SEXP e, ri, robj; - - PROTECT(e = allocVector(LANGSXP, 4)); - ri = NEW_INTEGER(1); - INTEGER_DATA(ri)[0] = i+1; - SETCAR(e, set_item); - SETCAR(CDR(e), ((RobjObject *)a)->R_obj); - SETCAR(CDR(CDR(e)), ri); - SETCAR(CDR(CDR(CDR(e))), to_Robj(v)); - - if(PyErr_Occurred()) - return -1; - - if (!(robj = do_eval_expr(e))) { - UNPROTECT(1); - return -1; - } - - ((RobjObject *)a)->R_obj = robj; - UNPROTECT(1); - return 0; -} - -/* a[i] */ -static PyObject * -Robj_item(PyObject *a, int i) -{ - SEXP ri, robj, e; - PyObject *obj; - int len, c; - - if ((len = Robj_len(a)) < 0) - return NULL; - if (i >= len || i < 0) { - PyErr_SetString(PyExc_IndexError, "R object index out of range"); - return NULL; - } - - PROTECT(ri = NEW_INTEGER(1)); - INTEGER_DATA(ri)[0] = i+1; - PROTECT(e = allocVector(LANGSXP, 3)); - SETCAR(e, get_item); - SETCAR(CDR(e), ((RobjObject *)a)->R_obj); - SETCAR(CDR(CDR(e)), ri); - - if (!(robj = do_eval_expr(e))) { - UNPROTECT(2); - return NULL; - } - - UNPROTECT(2); - - /* If there is a default mode, use it; otherwise, use the top mode. */ - if (default_mode < 0) - c = TOP_MODE; - else - c = default_mode; - obj = to_Pyobj_with_mode(robj, c); - return obj; -} - -/* Get a slice: a[x:y] */ -/*FIXME: starting with Python 2.5, ilow and ihigh should probably - * be of type Py_ssize_t. - */ -static PyObject * -Robj_slice(PyObject *a, int ilow, int ihigh) -{ - SEXP robj, e, index; - PyObject *obj; - int robjLen, sliceLen, c; - int ii; - - robjLen = Robj_len(a); - - if (robjLen < 0) - return NULL; - - if (ilow < 0) { - PyErr_SetString(PyExc_IndexError, - "R object index out of range (lowest index is negative)"); - return NULL; - //ilow = 0; - } else if (ilow > robjLen) { - PyErr_SetString(PyExc_IndexError, - "R object index out of range (lowest index > object length)"); - return NULL; - //ilow = robjLen; - } - if (ihigh < ilow) { - PyErr_SetString(PyExc_IndexError, - "R object index out of range (highest index < lowest index)"); - return NULL; - //ihigh = ilow; - } else if (ihigh > robjLen) { - PyErr_SetString(PyExc_IndexError, - "R object index out of range (highest index > object length)"); - //return NULL; - ihigh = robjLen; - } - sliceLen = ihigh - ilow; - - /* if (ilow >= robjLen || ilow < 0) { */ - /* PyErr_SetString(PyExc_IndexError, "R object index out of range"); */ - /* return NULL; */ - /* } */ - - PROTECT(index = allocVector(INTSXP, sliceLen)); - - for (ii = 0; ii < sliceLen; ii++) { - INTEGER_POINTER(index)[ii] = ii + ilow + 1; - } - - PROTECT(e = allocVector(LANGSXP, 3)); - SETCAR(e, get_item); - SETCAR(CDR(e), ((RobjObject *)a)->R_obj); - SETCAR(CDR(CDR(e)), index); - - if (!(robj = do_eval_expr(e))) { - UNPROTECT(2); - return NULL; - } - - UNPROTECT(2); - - /* If there is a default mode, use it; otherwise, use the top mode. */ - if (default_mode < 0) - c = TOP_MODE; - else - c = default_mode; - obj = to_Pyobj_with_mode(robj, c); - return obj; -} - - -/* FIXME: - * Python 2.5 will feel happier with ssizeargfunc and ssizessizeargfunc - */ -/* We should implement sq_slice, sq_contains ... */ -static PySequenceMethods Robj_as_sequence = { - (inquiry)Robj_len, /* sq_length */ - 0, /* sq_concat */ - 0, /* sq_repeat */ - (intargfunc)Robj_item, /* sq_item */ - (intintargfunc)Robj_slice, /* sq_slice */ - (intobjargproc)Robj_ass_item, /* sq_ass_item */ - 0, /* sq_ass_slice */ - 0, /* sq_contains */ - 0, /* sq_inplace_concat */ - 0 /* sq_inplace_repeat */ -}; - - -/* The 'Robj' table. When compiled under Python 2.2, the type 'Robj' - is subclassable. */ - -#ifdef PRE_2_2 -static PyObject * -Robj_getattr(RobjObject *self, char *name) -{ - return Py_FindMethod(Robj_methods, (PyObject *)self, name); -} -#endif - -PyTypeObject Robj_Type = { - /* The ob_type field must be initialized in the module init function - * to be portable to Windows without using C++. */ -#if defined(PRE_2_2) || defined(_WIN32) // Matjaz - PyObject_HEAD_INIT(NULL) -#else - PyObject_HEAD_INIT(&PyType_Type) -#endif - 0, /*ob_size*/ - "Robj", /*tp_name*/ - sizeof(RobjObject), /*tp_basicsize*/ - 0, /*tp_itemsize*/ - /* methods */ - (destructor)Robj_dealloc, /*tp_dealloc*/ - 0, /*tp_print*/ -#ifdef PRE_2_2 - (getattrfunc)Robj_getattr, -#else - 0, -#endif - 0, - 0, /*tp_compare*/ - 0, /*tp_repr*/ - 0, /*tp_as_number*/ - &Robj_as_sequence, /*tp_as_sequence*/ - 0, /*tp_as_mapping*/ - 0, /*tp_hash*/ - (ternaryfunc)Robj_call, /*tp_call*/ - 0, /*tp_str*/ -#if defined(PRE_2_2) || defined(_WIN32) - 0, -#else - PyObject_GenericGetAttr, /*tp_getattro*/ -#endif - 0, /*tp_setattro*/ - 0, /*tp_as_buffer*/ -#ifdef PRE_2_2 - 0, -#else - Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/ -#endif - 0, /*tp_doc*/ - 0, /*tp_traverse*/ -#ifndef PRE_2_2 - 0, /*tp_clear*/ - 0, /*tp_richcompare*/ - 0, /*tp_weaklistoffset*/ - 0, /*tp_iter*/ - 0, /*tp_iternext*/ - Robj_methods, /*tp_methods*/ - 0, /*tp_members*/ - 0, /*tp_getset*/ - 0, /*tp_base*/ - 0, /*tp_dict*/ - 0, /*tp_descr_get*/ - 0, /*tp_descr_set*/ - 0, /*tp_dictoffset*/ - 0, /*tp_init*/ -#ifdef _WIN32 - 0, /*tp_alloc*/ -#else - PyType_GenericAlloc, /*tp_alloc*/ -#endif - Robj_tpnew, /*tp_new*/ - 0, /*tp_free*/ - 0, /*tp_is_gc*/ -#endif -}; - - -/* Module functions */ - -/* Obtain an R object via its name. 'autoconvert' is the keyword to - set the autoconversion flag. */ -static PyObject * -get_fun(PyObject *self, PyObject *args, PyObject *kwds) -{ - char *obj_str; - int conversion=TOP_MODE; - SEXP robj; - - static char *kwlist[] = {"name", "autoconvert", 0}; - if (!PyArg_ParseTupleAndKeywords(args, kwds, "s|i:get", kwlist, - &obj_str, &conversion)) - return NULL; - - robj = get_fun_from_name(obj_str); - if (!robj) - return NULL; - - return (PyObject *)Robj_new(robj, conversion); -} - -static PyObject * -set_mode(PyObject *self, PyObject *args) -{ - int i=-1; - - if (!PyArg_ParseTuple(args, "i:set_mode", &i)) - return NULL; - - if (i<-1 || i>TOP_MODE) { - PyErr_SetString(PyExc_ValueError, "wrong mode"); - return NULL; - } - - default_mode = i; - Py_INCREF(Py_None); - return Py_None; -} - -static PyObject * -get_mode(PyObject *self, PyObject *args) -{ - if (!PyArg_ParseTuple(args, ":get_mode")) - return NULL; - - return PyInt_FromLong(default_mode); -} - -static PyObject * -r_events(PyObject *self, PyObject *args, PyObject *kwds) -#ifdef _WIN32 -{ - return NULL; -} -#else -{ - fd_set *what; - int usec=10000; - - static char *kwlist[] = {"usec", 0}; - if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:r_events", - kwlist, &usec)) - return NULL; - - if (R_interact) { - Py_BEGIN_ALLOW_THREADS - what = R_checkActivity(usec, 0); - R_runHandlers(R_InputHandlers, what); - Py_END_ALLOW_THREADS - } - - Py_INCREF(Py_None); - return Py_None; -} -#endif - -void -stop_events(void) -{ - PyObject *o; - - if (!rpy_dict) - return; - - if (!r_lock) - r_lock = PyDict_GetItemString(rpy_dict, "_r_lock"); - - o = PyObject_CallMethod(r_lock, "acquire", NULL); - Py_XDECREF(o); -} - -void -start_events(void) -{ - PyObject *o; - - if (!rpy_dict) - return; - - if (!r_lock) - r_lock = PyDict_GetItemString(rpy_dict, "_r_lock"); - - o = PyObject_CallMethod(r_lock, "release", NULL); - Py_XDECREF(o); -} - - -/* - * Based on code from Rstd_CleanUp(); - * from src/unix/sys-std.c - */ - -void r_finalize(void) -{ -#if (R_VERSION < R_Version(2,4,0)) - unsigned char buf[1024]; - char * tmpdir; -#endif - - R_dot_Last(); - R_RunExitFinalizers(); - CleanEd(); -#if (R_VERSION >= R_Version(2,7,0)) - Rf_KillAllDevices(); -#else - KillAllDevices(); -#endif - -#if (R_VERSION >= R_Version(2,4,0)) - R_CleanTempDir(); -#else - if((tmpdir = getenv("R_SESSION_TMPDIR"))) { - -# ifdef _WIN32 - snprintf((char *)buf, 1024, "rmdir /S /Q %s", tmpdir); -# else - snprintf((char *)buf, 1024, "rm -rf %s", tmpdir); -# endif - - R_system((char *)buf); - } -#endif - - PrintWarnings(); /* from device close and .Last */ - R_gc(); /* Remove any remaining R objects from memory */ -} - - -static PyObject * -r_cleanup(void) -{ - r_finalize(); - Py_INCREF(Py_None); - return Py_None; -} - -#ifdef WITH_NUMERIC -static void -init_numeric(void) -{ - PyObject *multiarray, *dict; - - if(use_numeric) - { - import_array(); - multiarray = PyImport_ImportModule(PY_ARRAY_MODULE_NAME); - if (multiarray) { - dict = PyModule_GetDict(multiarray); - if (dict) - Py_transpose = PyDict_GetItemString(dict, "transpose"); - } - } -} -#endif - -static PyObject * -r_init(PyObject *self, PyObject *args) -{ - static int first=1; - int i; - - if (!PyArg_ParseTuple(args, "i:r_init", &i)) - return NULL; - use_numeric = i; - -#ifdef WITH_NUMERIC - if(use_numeric) - init_numeric(); -#endif - - if(first==1) - { - first=0; - Py_INCREF(Py_None); - return Py_None; - } - else - { - PyErr_SetString(PyExc_RuntimeError, "Only one R object may be instantiated per session"); - return NULL; - } -} - -/* List of functions defined in the module */ -static PyMethodDef rpy_methods[] = { - {"get_fun", (PyCFunction)get_fun, METH_VARARGS | METH_KEYWORDS}, - {"set_mode", (PyCFunction)set_mode, METH_VARARGS}, - {"get_mode", (PyCFunction)get_mode, METH_VARARGS}, - {"set_output", (PyCFunction)set_output, METH_VARARGS}, - {"set_input", (PyCFunction)set_input, METH_VARARGS}, - {"set_showfiles", (PyCFunction)set_showfiles, METH_VARARGS}, - {"get_output", (PyCFunction)get_output, METH_VARARGS}, - {"get_input", (PyCFunction)get_input, METH_VARARGS}, - {"get_showfiles", (PyCFunction)get_showfiles, METH_VARARGS}, - {"r_events", (PyCFunction)r_events, METH_VARARGS | METH_KEYWORDS}, - {"r_cleanup", (PyCFunction)r_cleanup, METH_NOARGS}, - {"r_init", (PyCFunction)r_init, METH_VARARGS}, - {NULL, NULL} /* sentinel */ -}; - -#ifdef _WIN32 -static void char_message( char *s ) -{ - if (!s) return; - R_WriteConsole(s, strlen(s)); -} - -static int char_yesnocancel( char *s ) -{ - return 1; -} - -static void -RPyBusy( int which ) -{ - /* set a busy cursor ... in which = 1, unset if which = 0 */ -} - -static void -RPyDoNothing( void ) -{ -} - -/* initialise embedded R; based on rproxy_impl.c from the R distribution */ -static void -init_embedded_win32(int argc, - char *argv[]) -{ - structRstart rp; - Rstart Rp = &rp; - char Rversion[25]; - int index; - - - snprintf( Rversion, 25, "%s.%s", R_MAJOR, R_MINOR ); - if( strcmp( getDLLVersion(), Rversion ) != 0 ) { - PyErr_SetString( PyExc_ImportError, "R.DLL version does not match" ); - return; - } - - R_DefParams(Rp); - - /* set R_HOME */ - Rp->rhome = RHOME; - - index = strlen(RUSER) - 1; - - if (RUSER[index] == '/' || RUSER[index] == '\\') - RUSER[index] = '\0'; - - Rp->home = RUSER; - Rp->CharacterMode = LinkDLL; - - Rp->ReadConsole = (blah1) RPy_ReadConsole; // Matjaz - Rp->WriteConsole = (blah2) RPy_WriteConsole; // Matjaz - - Rp->CallBack = (blah3) RPyDoNothing; -#if R_VERSION < 0x20100 - Rp->message = char_message; - Rp->yesnocancel = char_yesnocancel; - Rp->busy = RPyBusy; -#else - Rp->ShowMessage = char_message; - Rp->YesNoCancel = char_yesnocancel; - Rp->Busy = RPyBusy; -#endif - - Rp->R_Quiet = TRUE; - - /* run as "interactive", so server won't be killed after an error */ - Rp->R_Slave = Rp->R_Verbose = 0; - Rp->R_Interactive = TRUE; - Rp->RestoreAction = SA_NORESTORE; /* no restore */ - Rp->SaveAction = SA_NOSAVE; /* no save */ - -#if R_VERSION < 0x20000 // pre-R-2.0.0 - - Rp->CommandLineArgs = NULL; - Rp->NumCommandLineArgs = 0; -#else - R_set_command_line_arguments(argc, argv); -#endif - R_SetParams(Rp); /* so R_ShowMessage is set */ - R_SizeFromEnv(Rp); - - R_SetParams(Rp); - - setup_term_ui(); - setup_Rmainloop(); -} -#endif - -/* Initialization function for the module */ -DL_EXPORT(void) -INIT_RPY(void) -{ - PyObject *m, *d; - PyOS_sighandler_t old_int; -#ifndef _WIN32 - PyOS_sighandler_t old_usr1, old_usr2; -#endif - SEXP interact; - - /* Get path and version information from environment */ - strncpy(RHOME, getenv("RPY_RHOME"), BUFSIZ); - strncpy(RVERSION, getenv("RPY_RVERSION"), BUFSIZ); - strncpy(RVER, getenv("RPY_RVER"), BUFSIZ); - strncpy(RUSER, getenv("RPY_RUSER"), BUFSIZ); - - if( !strlen(RHOME) || !strlen(RVERSION) || !strlen(RVER) || !strlen(RUSER)) - { - PyErr_Format(RPy_Exception, - "Unable to load R path or version information"); - return; - } - - Robj_Type.ob_type = &PyType_Type; -#if defined( _WIN32 ) && ! defined( PRE_2_2 ) - Robj_Type.tp_getattro = PyObject_GenericGetAttr; - Robj_Type.tp_alloc = PyType_GenericAlloc; -#endif - - /* Initialize the module with its content */ - if (PyType_Ready(&Robj_Type) < 0) - return; - m = Py_InitModule3(xstr(RPY_SHNAME), - rpy_methods, - "Python interface to the R Programming Language"); - Py_INCREF(&Robj_Type); - PyModule_AddObject(m, Robj_Type.tp_name, - (PyObject *)&Robj_Type); - - d = PyModule_GetDict(m); - - /* Save this interpreter */ - PyEval_InitThreads(); - my_interp = PyThreadState_Get()->interp; - - /* Save the Python signal handlers. If R inserts its handlers, we - cannot return to the Python interpreter. */ - old_int = PyOS_getsig(SIGINT); - python_sigint = old_int; -#ifndef _WIN32 - old_usr1 = PyOS_getsig(SIGUSR1); - old_usr2 = PyOS_getsig(SIGUSR2); -#endif - -#ifdef _WIN32 - init_embedded_win32(defaultargc, - defaultargv); -#else - Rf_initEmbeddedR(defaultargc, - defaultargv); -#endif - - -#ifdef CSTACK_DEFNS - /* Disable C stack checking, which is incompatible with use as a - shared library. */ - R_CStackLimit = (uintptr_t)-1; -#endif - - /* Restore Python handlers */ - PyOS_setsig(SIGINT, old_int); -#ifndef _WIN32 - PyOS_setsig(SIGUSR1, old_usr1); - PyOS_setsig(SIGUSR2, old_usr2); -#endif - - /* Several new exceptions: */ - RPy_Exception = PyErr_NewException("rpy.RPy_Exception", NULL, NULL); - RPy_TypeConversionException = PyErr_NewException("rpy.RPy_TypeConversionException", RPy_Exception, NULL); - RPy_RException = PyErr_NewException("rpy.RPy_RException", RPy_Exception, NULL); - - if (!RPy_Exception || !RPy_TypeConversionException || !RPy_RException ) - { - PyErr_Format(RPy_Exception, "Unable create RPy exceptions"); - return; - } - - PyDict_SetItemString(d, "RPy_Exception", RPy_Exception); - PyDict_SetItemString(d, "RPy_TypeConversionException", RPy_TypeConversionException); - PyDict_SetItemString(d, "RPy_RException", RPy_RException); - - // The conversion table - class_table = PyDict_New(); - proc_table = PyDict_New(); - PyDict_SetItemString(d, "__class_table__", class_table); - PyDict_SetItemString(d, "__proc_table__", proc_table); - - // The globals R objects for the sequence protocol - get_item = get_fun_from_name("["); - set_item = get_fun_from_name("[<-"); - length = get_fun_from_name("length"); - - // Function to transpose arrays - aperm = get_fun_from_name("aperm"); - - // Initialize the list of protected objects - R_References = R_NilValue; - SET_SYMVALUE(install("R.References"), R_References); - - // Initialize the default mode - default_mode = -1; - - // Check whether R is interactive or no - interact = do_eval_fun("interactive"); - R_interact = INTEGER(interact)[0]; - - // I/O routines - init_io_routines(); - - rpy = PyImport_ImportModule("rpy"); - rpy_dict = PyModule_GetDict(rpy); - // r_lock = PyDict_GetItemString(rpy_dict, "_r_lock"); - // PyObject_Print(r_lock, stderr, Py_PRINT_RAW); - r_lock = NULL; - - if( Py_AtExit( r_finalize ) ) - { - fprintf(stderr, "Warning: Unable to set R finalizer."); - fflush(stderr); - } - - -} - - only in patch2: unchanged: --- rpy-1.0.3.orig/src/R_eval2141.c +++ rpy-1.0.3/src/R_eval2141.c @@ -0,0 +1,197 @@ +/* + * $Id: R_eval.c 363 2007-11-12 23:27:48Z warnes $ + * Evaluation of R expressions. + */ + +/* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1/GPL 2.0/LGPL 2.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is the RPy python module. + * + * The Initial Developer of the Original Code is Walter Moreira. + * Portions created by the Initial Developer are Copyright (C) 2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * Gregory R. Warnes (Maintainer) + * + * Alternatively, the contents of this file may be used under the terms of + * either the GNU General Public License Version 2 or later (the "GPL"), or + * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), + * in which case the provisions of the GPL or the LGPL are applicable instead + * of those above. If you wish to allow use of your version of this file only + * under the terms of either the GPL or the LGPL, and not to allow others to + * use your version of this file under the terms of the MPL, indicate your + * decision by deleting the provisions above and replace them with the notice + * and other provisions required by the GPL or the LGPL. If you do not delete + * the provisions above, a recipient may use your version of this file under + * the terms of any one of the MPL, the GPL or the LGPL. + * + * ***** END LICENSE BLOCK ***** */ +/* + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + * + * + * Evaluation of R expressions. + * + * $Id: R_eval.c 363 2007-11-12 23:27:48Z warnes $ + * + */ + +#include + +/* The Python original SIGINT handler */ +PyOS_sighandler_t python_sigint; + +/* Indicates whether the R interpreter was interrupted by a SIGINT */ +int interrupted = 0; + +/* Abort the current R computation due to a SIGINT */ +void interrupt_R(int signum) +{ + interrupted = 1; + error("Interrupted"); +} + + +/* Evaluate a SEXP. It must be constructed by hand. It raises a Python + exception if an error ocurred in the evaluation */ +SEXP do_eval_expr(SEXP e) { + SEXP res; + int error = 0; + PyOS_sighandler_t old_int; + + /* Enable our handler for SIGINT inside the R + interpreter. Otherwise, we cannot stop R calculations, since + SIGINT is only processed between Python bytecodes. Also, save the + Python SIGINT handler because it is necessary to temporally + restore it in user defined I/O Python functions. */ + stop_events(); + + #ifdef _WIN32 + old_int = PyOS_getsig(SIGBREAK); + #else + old_int = PyOS_getsig(SIGINT); + #endif + python_sigint = old_int; + + signal(SIGINT, interrupt_R); + + interrupted = 0; + res = R_tryEval(e, R_GlobalEnv, &error); + + #ifdef _WIN32 + PyOS_setsig(SIGBREAK, old_int); + #else + PyOS_setsig(SIGINT, old_int); + #endif + + start_events(); + + if (error) { + if (interrupted) { + PyErr_SetNone(PyExc_KeyboardInterrupt); + } + else + PyErr_SetString(RPy_RException, get_last_error_msg()); + return NULL; + } + + + return res; +} + +/* Evaluate a function given by a name (without arguments) */ +SEXP do_eval_fun(char *name) { + SEXP exp, fun, res; + + fun = get_fun_from_name(name); + if (!fun) + return NULL; + + PROTECT(fun); + PROTECT(exp = allocVector(LANGSXP, 1)); + SETCAR(exp, fun); + + PROTECT(res = do_eval_expr(exp)); + UNPROTECT(3); + return res; +} + +/* + * Get an R **function** object by its name. When not found, an exception is + * raised. The checking of the length of the identifier is needed to + * avoid R raising an error causing Python to dump core. + */ +SEXP get_fun_from_name(char *ident) { + SEXP obj; + + /* For R not to throw an error, we must check the identifier is + neither null nor greater than MAXIDSIZE */ + if (!*ident) { + PyErr_SetString(RPy_Exception, "attempt to use zero-length variable name"); + return NULL; + } + if (strlen(ident) > MAXIDSIZE) { + PyErr_SetString(RPy_Exception, "symbol print-name too long"); + return NULL; + } + +#if R_VERSION < 0x20000 + obj = Rf_findVar(Rf_install(ident), R_GlobalEnv); +#else + /* + * For R-2.0.0 and later, it is necessary to use findFun to get + * functions. Unfortunately, calling findFun on an undefined name + * causes a segfault! + * + * Solution: + * + * 1) Call findVar on the name + * + * 2) If something has the name, call findFun + * + * 3) Raise an error if either step 1 or 2 fails. + */ + obj = Rf_findVar(Rf_install(ident), R_GlobalEnv); + + if (obj != R_UnboundValue) + obj = Rf_findFun(Rf_install(ident), R_GlobalEnv); +#endif + + if (obj == R_UnboundValue) { + PyErr_Format(RPy_Exception, "R Function \"%s\" not found", ident); + return NULL; + } + return obj; +} + +/* Obtain the text of the last R error message */ +const char *get_last_error_msg() { + SEXP msg; + + msg = do_eval_fun("geterrmessage"); + return CHARACTER_VALUE(msg); +} only in patch2: unchanged: --- rpy-1.0.3.orig/src/io2141.c +++ rpy-1.0.3/src/io2141.c @@ -0,0 +1,273 @@ +/* + * $Id: io.c 515 2008-05-14 13:53:05Z warnes $ + * Input/Output routines + */ + +/* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1/GPL 2.0/LGPL 2.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is the RPy python module. + * + * The Initial Developer of the Original Code is Walter Moreira. + * Portions created by the Initial Developer are Copyright (C) 2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * Gregory R. Warnes (Maintainer) + * + * Alternatively, the contents of this file may be used under the terms of + * either the GNU General Public License Version 2 or later (the "GPL"), or + * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), + * in which case the provisions of the GPL or the LGPL are applicable instead + * of those above. If you wish to allow use of your version of this file only + * under the terms of either the GPL or the LGPL, and not to allow others to + * use your version of this file under the terms of the MPL, indicate your + * decision by deleting the provisions above and replace them with the notice + * and other provisions required by the GPL or the LGPL. If you do not delete + * the provisions above, a recipient may use your version of this file under + * the terms of any one of the MPL, the GPL or the LGPL. + * + * ***** END LICENSE BLOCK ***** */ + + +#include "RPy.h" + +#define ENTER_PY { PyThreadState* tstate = NULL;\ + if (_PyThreadState_Current == NULL) {\ + tstate = PyThreadState_New(my_interp);\ + PyEval_AcquireThread(tstate);\ + } + +#define LEAVE_PY if (tstate) {\ + PyEval_ReleaseThread(tstate);}\ + } + +PyObject *rpy_output=NULL, *rpy_input=NULL, *rpy_showfiles=NULL; + +/* Show the traceback of an exception which occurred in a I/O process, + except when the error is a KeyboardInterrupt, in which case abort + the R interpreter */ +void +RPy_ShowException() +{ + PyObject *err; + + if ((err = PyErr_Occurred())) { + if (PyErr_GivenExceptionMatches(err, PyExc_KeyboardInterrupt)) { + interrupt_R(0); + } + else { + PyErr_WriteUnraisable(err); + PyErr_Clear(); + } + } +} + + +void +RPy_WriteConsole(char *buf, int len) +{ + PyOS_sighandler_t old_int; + PyObject *dummy; + + /* It is necessary to restore the Python handler when using a Python + function for I/O. */ + old_int = PyOS_getsig(SIGINT); + PyOS_setsig(SIGINT, python_sigint); + if (rpy_output) { + ENTER_PY + dummy = PyObject_CallFunction(rpy_output, "s", buf); + Py_XDECREF(dummy); + LEAVE_PY + } + signal(SIGINT, old_int); + RPy_ShowException(); +} + +#ifdef _WIN32 +int +RPy_ReadConsole(char *prompt, + char *buf, + int len, + int addtohistory) +#else +int +RPy_ReadConsole(char *prompt, + unsigned char *buf, + int len, + int addtohistory) +#endif +{ + PyObject *input_data; + PyOS_sighandler_t old_int; + + if (!rpy_input) + return 0; + + old_int = PyOS_getsig(SIGINT); + PyOS_setsig(SIGINT, python_sigint); + ENTER_PY + start_events(); + input_data = PyObject_CallFunction(rpy_input, "si", prompt, len); + stop_events(); + LEAVE_PY + + signal(SIGINT, old_int); + + RPy_ShowException(); + + if (!input_data) { + PyErr_Clear(); + return 0; + } + snprintf( (char*) buf, len, "%s", PyString_AsString(input_data)); + Py_DECREF(input_data); + return 1; +} + +int +RPy_ShowFiles(int nfile, char **file, char **headers, + char *wtitle, int del, char *pager) +{ + PyObject *pyfiles, *pyheaders, *result, *f, *h; + PyOS_sighandler_t old_int; + int i; + + if (rpy_showfiles==NULL) + return 0; + + old_int = PyOS_getsig(SIGINT); + PyOS_setsig(SIGINT, python_sigint); + + ENTER_PY + + pyfiles = PyList_New(0); + pyheaders = PyList_New(0); + if (!(pyfiles && pyheaders)) { + return 0; + } + + for (i=0; i (Maintainer) + * + * Alternatively, the contents of this file may be used under the terms of + * either the GNU General Public License Version 2 or later (the "GPL"), or + * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), + * in which case the provisions of the GPL or the LGPL are applicable instead + * of those above. If you wish to allow use of your version of this file only + * under the terms of either the GPL or the LGPL, and not to allow others to + * use your version of this file under the terms of the MPL, indicate your + * decision by deleting the provisions above and replace them with the notice + * and other provisions required by the GPL or the LGPL. If you do not delete + * the provisions above, a recipient may use your version of this file under + * the terms of any one of the MPL, the GPL or the LGPL. + * + * ***** END LICENSE BLOCK ***** */ + +#include +#if (R_VERSION >= R_Version(2,3,0)) + +# ifndef _WIN32 +# define CSTACK_DEFNS // Enable definitions needed for stack checking control +# endif + +#endif + +#include "RPy.h" + +#define NONAMELESSUNION +#include +#include +#include + +/* Flag indicating whether Numpy/Numeric is available in this session + * + * This is necessary since Numpy/Numeric may not available at run time, even if + * it was available at compile time. +*/ +static int use_numeric=0; + + +/* Local function definitions */ +DL_EXPORT(void) INIT_RPY(void); /* Module initializer */ +static PyObject *r_init(PyObject *self, /* Class initializer */ + PyObject *args); +static PyObject *r_cleanup(void); /* Clean up R & release resources */ + +#ifdef _WIN32 +static void init_embedded_win32(int argc, char *argv[]); +#endif + +/* Global objects */ +static SEXP get_item; +static SEXP set_item; +static SEXP length; +static SEXP aperm; +static PyObject *class_table; +static PyObject *proc_table; +static int default_mode; +static PyObject *r_lock; +PyObject *RPy_Exception; +PyObject *RPy_TypeConversionException; +PyObject *RPy_RException; + +static char RHOME[BUFSIZ]; +static char RVERSION[BUFSIZ]; +static char RVER[BUFSIZ]; +static char RUSER[BUFSIZ]; +char *defaultargv[] = {"rpy", "-q", "--vanilla"}; +int defaultargc = sizeof(defaultargv) / sizeof(defaultargv[0]); + +/* Global interpreter */ +PyInterpreterState *my_interp; + +/* Signal whether R is running interactively */ +int R_interact; + +/* RPy namespace */ +PyObject *rpy; +PyObject *rpy_dict; + + +#ifdef WITH_NUMERIC +static PyObject *Py_transpose; +#endif + +/* Global list to protect R objects from garbage collection */ +/* This is inspired in $R_SRC/src/main/memory.c */ +static SEXP R_References; + +static SEXP +RecursiveRelease(SEXP obj, SEXP list) +{ + if (!isNull(list)) { + if (obj == CAR(list)) + return CDR(list); + else + SETCDR(list, RecursiveRelease(obj, CDR(list))); + } + return list; +} + +/* Robj methods. Following xxmodule.c from Python distro. */ + +static void +Robj_dealloc(RobjObject *self) +{ + /* Remove the object from the list of protected objects */ + R_References = RecursiveRelease(self->R_obj, R_References); + SET_SYMVALUE(install("R.References"), R_References); + + PyObject_Del(self); +} + +RobjObject * +Robj_new(SEXP robj, int conversion) +{ + RobjObject *self; + self = PyObject_New(RobjObject, &Robj_Type); + if (!self) + return NULL; + + if (!robj) + return NULL; + + /* Protect the R object */ + R_References = CONS(robj, R_References); + SET_SYMVALUE(install("R.References"), R_References); + + self->R_obj = robj; + self->conversion = conversion; + return self; +} + +#ifndef PRE_2_2 +static PyObject * +Robj_tpnew(PyTypeObject *type, PyObject *args, PyObject *kwds) +{ + PyObject *self; + + self = type->tp_alloc(type, 0); + return self; +} +#endif + +/* Type conversion routines. See documentation for details */ + +/* These are auxiliaries for a state machine for converting Python + list to the coarsest R vector type */ +#define ANY_T 0 +#define BOOL_T 1 +#define INT_T 2 +#define FLOAT_T 3 +#define COMPLEX_T 4 +#define STRING_T 5 +#define ROBJ_T 6 + +static int +type_to_int(PyObject *obj) +{ + if (PyBool_Check(obj)) + return BOOL_T; + else if (PyInt_Check(obj)) + return INT_T; + else if (PyFloat_Check(obj)) + return FLOAT_T; + else if (PyComplex_Check(obj)) + return COMPLEX_T; + else if (PyNumber_Check(obj)) + return ANY_T; + else if (PyString_Check(obj)) + return STRING_T; + else if (PyUnicode_Check(obj)) + return STRING_T; + else if (Robj_Check(obj)) + return ROBJ_T; + else + return ANY_T; +} + +/* Make a R list or vector from a Python sequence */ +static SEXP +seq_to_R(PyObject *obj) +{ + PyObject *it; + SEXP robj, rit; + int i, len, state; + + /* This matrix defines what mode a vector should take given what + it already contains and a new item + + E.g. Row 0 indicates that if we've seen an any, the vector will + always remain an any. Row 3 indicates that if we've seen a + float, then seeing an boolean, integer, or float will preserve + the vector as a float vector, while seeing a string or an Robj will + convert it into an any vector. + */ + int fsm[7][7] = { + {0, 0, 0, 0, 0, 0, 0}, // any + {0, 1, 2, 3, 4, 0, 0}, // bool + {0, 2, 2, 3, 4, 0, 0}, // int + {0, 3, 3, 3, 4, 0, 0}, // float + {0, 4, 4, 4, 4, 0, 0}, // complex + {0, 0, 0, 0, 0, 5, 0}, // string + {0, 0, 0, 0, 0, 0, 6} // RObj + }; + + len = PySequence_Length(obj); + if (len == 0) + return R_NilValue; + + PROTECT(robj = NEW_LIST(len)); + + state = -1; + for (i=0; idimensions; + type = obj->descr->type_num; + size = PyArray_Size( (PyObject*) obj); + + /* Handle a vector without dimensions, just length */ + if(obj->nd==0) + { + PROTECT(Rdims = allocVector(INTSXP, 1)); + PROTECT(tRdims = allocVector(INTSXP, 1)); + INTEGER(Rdims)[0] = size; + INTEGER(tRdims)[0] = size; + } + else + { + PROTECT(Rdims = allocVector(INTSXP, obj->nd)); + PROTECT(tRdims = allocVector(INTSXP, obj->nd)); + + for (i=0; ind; i++) + { + if (dims[i] == 0) + { + UNPROTECT(2); + return R_NilValue; + } + INTEGER(Rdims)[i] = dims[(obj->nd)-i-1]; + INTEGER(tRdims)[i] = (obj->nd)-i; + } + } + + switch(type) + { + + /*******************/ + /* String Variants */ + /*******************/ + /* TODO: Add proper handling of NumPy character arrays. + The following code DOES NOT WORK: + + #if WITH_NUMERIC==3 + case PyArray_UNICODE: + case PyArray_STRING: + case PyArray_CHAR: + obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, + PyArray_STRING, 0, 0); + #endif + + The problem is that the PyArray call throws an exception, + presumably because we haven't given a width specifier. + + NumPy strings are fixed-width, and may not be null terminated. R only handles + null terminated (varying width) strings. We need a separate + code path to handle this, as it requires quite different + handling than the numeric arrays dealt with below. + */ + + + /******************************************/ + /* All complex to (double,double) complex */ + /******************************************/ + +#if WITH_NUMERIC==1 /* Numeric */ + case PyArray_CFLOAT: + case PyArray_CDOUBLE: +#else /* NumPy */ + case PyArray_COMPLEX64: + case PyArray_COMPLEX128: +#endif + obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, + PyArray_CDOUBLE, 0, 0); + break; + + + /**********************************************************************************/ + /* Convert all integers to platform integer (except 64 bit int on 32 bit platforms) */ + /************************************************************************************/ + +#if WITH_NUMERIC==1 /* Numeric */ + case PyArray_UBYTE: + case PyArray_SBYTE: + case PyArray_SHORT: + case PyArray_INT: + case PyArray_LONG: + obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, + PyArray_INT, 0, 0); + break; +#else /* NumPy */ + case PyArray_BOOL: + case PyArray_INT8: + case PyArray_UINT8: + case PyArray_INT16: + case PyArray_UINT16: + case PyArray_INT32: + case PyArray_UINT32: +#if PyArray_INT==PyArray_INT64 /* 64 bit platform */ + case PyArray_INT64: + case PyArray_UINT64: +#else + obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, + PyArray_INT, 0, 0); + break; +#endif +#endif + + /**************************************************/ + /* All floats (and over-sized integers) to double */ + /**************************************************/ +#if WITH_NUMERIC==1 /* Numeric */ + case PyArray_FLOAT: + case PyArray_DOUBLE: +#else /* NumPy */ + case PyArray_FLOAT32: + case PyArray_FLOAT64: +#if PyArray_INT!=PyArray_INT64 /* 32 bit platform */ + case PyArray_INT64: + case PyArray_UINT64: +#endif +#endif + obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj, + PyArray_DOUBLE, 0, 0); + break; + + default: + UNPROTECT(2); + PyErr_Format(RPy_TypeConversionException, + "Numeric/NumPy arrays containing %s are not supported.", + obj->ob_type->tp_name); + return R_NilValue; + break; + } + + + pytl = Py_BuildValue("[i]", size); + nobj = PyArray_Reshape(obj, pytl); + Py_XDECREF(pytl); + Py_XDECREF(obj); + + if (nobj == NULL) + { + UNPROTECT(2); + return R_NilValue; + } + + + PROTECT(Rarray = seq_to_R(nobj)); + if (Rarray == NULL) + { + UNPROTECT(3); + return R_NilValue; + } + + + Py_XDECREF(nobj); + SET_DIM(Rarray, Rdims); + + PROTECT(e = allocVector(LANGSXP, 3)); + SETCAR(e, aperm); + SETCAR(CDR(e), Rarray); + SETCAR(CDR(CDR(e)), tRdims); + PROTECT(Rarray = do_eval_expr(e)); + + UNPROTECT(5); + return Rarray; +} +#endif + +/* Convert a Python object to a R object. An Robj is passed w/o + * modifications, an object which provides a '.as_r()' method, is + * passed as the result of that method */ +SEXP +to_Robj(PyObject *obj) +{ + SEXP robj; + Py_complex c; + PyObject *to_r_meth; + PyObject *tempObj; + int do_decref = 0; + + if (obj==NULL) + return NULL; + + if (obj == Py_None) { + return R_NilValue; + } + + to_r_meth = PyObject_GetAttrString(obj, "as_r"); + if (to_r_meth) { + obj = PyObject_CallObject(to_r_meth, NULL); + Py_DECREF(to_r_meth); + if (obj==NULL) + return NULL; + do_decref = 1; + } + PyErr_Clear(); + + + if (Robj_Check(obj)) + { + PROTECT(robj = ((RobjObject *)obj)->R_obj); + } + else if (PyBool_Check(obj)) + { + PROTECT(robj = NEW_LOGICAL(1)); + LOGICAL_DATA(robj)[0] = (Py_True==obj); + } + else if (PyInt_Check(obj)) + { + PROTECT(robj = NEW_INTEGER(1)); + INTEGER_DATA(robj)[0] = (int) PyInt_AsLong(obj); + } + else if (PyFloat_Check(obj)) + { + PROTECT(robj = NEW_NUMERIC(1)); + NUMERIC_DATA(robj)[0] = PyFloat_AsDouble(obj); + } + else if (PyComplex_Check(obj)) + { + PROTECT(robj = NEW_COMPLEX(1)); + c = PyComplex_AsCComplex(obj); + COMPLEX_DATA(robj)[0].r = c.real; + COMPLEX_DATA(robj)[0].i = c.imag; + } + else if (PyUnicode_Check(obj)) + { + /** Handle Unicode Strings. + * + * Ideally: Python Unicode -> R Unicode, + * + * Unfortunately, the R documentation is not forthcoming on how + * to accomplish this + * + * So, for the moment: + * python Unicode -> Python ASCII -> ordinary string -> R string + * + */ + PROTECT(robj = NEW_STRING(1)); + SET_STRING_ELT(robj, 0, COPY_TO_USER_STRING(PyString_AsString(PyUnicode_AsASCIIString(obj)))); + } + else if (PyString_Check(obj)) + { + PROTECT(robj = NEW_STRING(1)); + SET_STRING_ELT(robj, 0, COPY_TO_USER_STRING(PyString_AsString(obj))); + } +#ifdef WITH_NUMERIC + else if (use_numeric && PyArray_Check(obj)) + { + PROTECT(robj = to_Rarray(obj)); + } +#endif + else if ((PySequence_Check(obj)) && + (PySequence_Size(obj) >= 0)) + { + PROTECT(robj = seq_to_R(obj)); /* No labels */ + } + else if ((PyMapping_Check(obj)) && + (PyMapping_Size(obj) >= 0)) + { + PROTECT(robj = dict_to_R(obj)); + } + else if (PyNumber_Check(obj)) /* generic number interface */ + { + tempObj = PyNumber_Float(obj); + if(!tempObj) goto error; + + PROTECT(robj = NEW_NUMERIC(1)); + NUMERIC_DATA(robj)[0] = PyFloat_AsDouble(tempObj); + Py_DECREF(tempObj); + } + else + { + error: + PyErr_Format(RPy_TypeConversionException, + "cannot convert from type '%s'", + obj->ob_type->tp_name); + PROTECT(robj = NULL); /* Protected to avoid stack inbalance */ + } + + if (do_decref) + { + Py_DECREF(obj); + } + UNPROTECT(1); + return robj; +} + +/* Convert a R named vector or list to a Python dictionary */ +static PyObject * +to_PyDict(PyObject *obj, SEXP names) +{ + int len, i; + PyObject *it, *dict; + const char *name; + + if ((len = PySequence_Length(obj)) < 0) + return NULL; + + dict = PyDict_New(); + for (i=0; i 1) && (res[l-1] == '_') && (res[l-2] != '_')) + res[l-1]=0; + + while ((r=strchr(r, '_'))) + *r = '.'; + + return res; +} + +/* Convert a dict to keywords arguments for a R function */ +int +make_kwds(int lkwds, PyObject *kwds, SEXP *e) +{ + SEXP r; + const char *s; + int i; + PyObject *citems=NULL, *it; + PyObject *kwname; + + if (kwds) { + citems = PyMapping_Items(kwds); + } + + for (i=0; iR_obj); + e = CDR(e); + + if (!make_args(largs, args, &e)) { + UNPROTECT(1); + return NULL; + } + if (!make_kwds(lkwds, kwds, &e)) { + UNPROTECT(1); + return NULL; + } + + PROTECT(res = do_eval_expr(exp)); + if (!res) { + UNPROTECT(2); + return NULL; + } + + if (default_mode < 0) + conv = ((RobjObject *)self)->conversion; + else + conv = default_mode; + + obj = to_Pyobj_with_mode(res, conv); + UNPROTECT(2); + + PrintWarnings(); /* show any warning messages */ + + return obj; +} + +/* Convert a sequence of (name, value) pairs to arguments to an R + function call */ +int +make_argl(int largl, PyObject *argl, SEXP *e) +{ + SEXP rvalue; + const char *name; + int i; + PyObject *it, *nobj, *value; + + if( !PySequence_Check(argl) ) goto fail_arg; + + for (i=0; i0) + { + SET_TAG(*e, Rf_install(name)); + PyMem_Free((void*) name); + } + + /* Move index to new end of call */ + *e = CDR(*e); + } + return 1; + + fail_arg: + PyErr_SetString(PyExc_ValueError, + "Argument must be a sequence of (\"name\", value) pairs.\n"); + fail: + return 0; +} + +/* Methods for the 'Robj' type */ + +/* Explicitly call an R object with a list containing (name, value) * + * argument pairs. 'name' can be None or '' to provide unnamed + * arguments. This function is necessary when the *order* of named + * arguments needs to be preserved. + */ + +static PyObject * +Robj_lcall(PyObject *self, PyObject *args) +{ + SEXP exp, e, res; + int largs, largl, conv; + PyObject *obj, *argl; + + /* Check arguments, there should be *exactly one* unnamed sequence. */ + largs = 0; + if (args) + largs = PyObject_Length(args); + if (largs<0) + return NULL; + + if(largs != 1 || !PySequence_Check(args) ) + { + PyErr_SetString(PyExc_ValueError, + "Argument must be a sequence of (\"name\", value) pairs.\n"); + return NULL; + } + + // extract our one argument + argl = PySequence_GetItem(args, 0); + Py_DECREF(args); + + largl = 0; + if (argl) + largl = PyObject_Length(argl); + if (largl<0) + return NULL; + + // A SEXP with the function to call and the arguments + PROTECT(exp = allocVector(LANGSXP, largl+1)); + e = exp; + SETCAR(e, ((RobjObject *)self)->R_obj); + e = CDR(e); + + // Add the arguments to the SEXP + if (!make_argl(largl, argl, &e)) { + UNPROTECT(1); + return NULL; + } + + // Evaluate + PROTECT(res = do_eval_expr(exp)); + if (!res) { + UNPROTECT(2); + return NULL; + } + + // Convert + if (default_mode < 0) + conv = ((RobjObject *)self)->conversion; + else + conv = default_mode; + + obj = to_Pyobj_with_mode(res, conv); + UNPROTECT(2); + + // Return + return obj; +} + + +/* Without args return the value of the conversion flag. With an + argument set the conversion flag to the truth value of the argument. */ +static PyObject * +Robj_autoconvert(PyObject *self, PyObject *args, PyObject *kwds) +{ + PyObject *obj; + int conversion=-2; + char *kwlist[] = {"val", 0}; + + if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:autoconvert", kwlist, + &conversion)) + return NULL; + + if (conversion > TOP_MODE) { + PyErr_SetString(PyExc_ValueError, "wrong mode"); + return NULL; + } + + if (conversion == -2) { + obj = PyInt_FromLong((long)((RobjObject *)self)->conversion); + } else { + ((RobjObject *)self)->conversion = conversion; + obj = Py_None; + Py_XINCREF(obj); + } + + return obj; +} + +static PyObject * +Robj_as_py(PyObject *self, PyObject *args, PyObject *kwds) +{ + PyObject *obj; + char *kwlist[] = {"mode", 0}; + int conv=default_mode; + + if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:as_py", kwlist, + &conv)) + return NULL; + + if (conv <= -2 || conv > TOP_MODE) { + PyErr_SetString(PyExc_ValueError, "wrong mode"); + return NULL; + } + + if (conv < 0) + conv = TOP_MODE; + + obj = to_Pyobj_with_mode(((RobjObject *)self)->R_obj, conv); + return obj; +} + +static PyMethodDef Robj_methods[] = { + {"autoconvert", (PyCFunction)Robj_autoconvert, METH_VARARGS|METH_KEYWORDS}, + {"local_mode", (PyCFunction)Robj_autoconvert, METH_VARARGS|METH_KEYWORDS}, + {"as_py", (PyCFunction)Robj_as_py, METH_VARARGS|METH_KEYWORDS}, + {"lcall", (PyCFunction)Robj_lcall, METH_VARARGS}, + {NULL, NULL} /* sentinel */ +}; + +/* Sequence protocol implementation */ + +/* len(a) */ +static int +Robj_len(PyObject *a) +{ + SEXP e, robj; + + PROTECT(e = allocVector(LANGSXP, 2)); + SETCAR(e, length); + SETCAR(CDR(e), ((RobjObject *)a)->R_obj); + + if (!(robj = do_eval_expr(e))) { + UNPROTECT(1); + return -1; + } + + UNPROTECT(1); + return INTEGER_DATA(robj)[0]; +} + +/* a[i] = v */ +static int +Robj_ass_item(PyObject *a, int i, PyObject *v) +{ + SEXP e, ri, robj; + + PROTECT(e = allocVector(LANGSXP, 4)); + ri = NEW_INTEGER(1); + INTEGER_DATA(ri)[0] = i+1; + SETCAR(e, set_item); + SETCAR(CDR(e), ((RobjObject *)a)->R_obj); + SETCAR(CDR(CDR(e)), ri); + SETCAR(CDR(CDR(CDR(e))), to_Robj(v)); + + if(PyErr_Occurred()) + return -1; + + if (!(robj = do_eval_expr(e))) { + UNPROTECT(1); + return -1; + } + + ((RobjObject *)a)->R_obj = robj; + UNPROTECT(1); + return 0; +} + +/* a[i] */ +static PyObject * +Robj_item(PyObject *a, int i) +{ + SEXP ri, robj, e; + PyObject *obj; + int len, c; + + if ((len = Robj_len(a)) < 0) + return NULL; + if (i >= len || i < 0) { + PyErr_SetString(PyExc_IndexError, "R object index out of range"); + return NULL; + } + + PROTECT(ri = NEW_INTEGER(1)); + INTEGER_DATA(ri)[0] = i+1; + PROTECT(e = allocVector(LANGSXP, 3)); + SETCAR(e, get_item); + SETCAR(CDR(e), ((RobjObject *)a)->R_obj); + SETCAR(CDR(CDR(e)), ri); + + if (!(robj = do_eval_expr(e))) { + UNPROTECT(2); + return NULL; + } + + UNPROTECT(2); + + /* If there is a default mode, use it; otherwise, use the top mode. */ + if (default_mode < 0) + c = TOP_MODE; + else + c = default_mode; + obj = to_Pyobj_with_mode(robj, c); + return obj; +} + +/* Get a slice: a[x:y] */ +/*FIXME: starting with Python 2.5, ilow and ihigh should probably + * be of type Py_ssize_t. + */ +static PyObject * +Robj_slice(PyObject *a, int ilow, int ihigh) +{ + SEXP robj, e, index; + PyObject *obj; + int robjLen, sliceLen, c; + int ii; + + robjLen = Robj_len(a); + + if (robjLen < 0) + return NULL; + + if (ilow < 0) { + PyErr_SetString(PyExc_IndexError, + "R object index out of range (lowest index is negative)"); + return NULL; + //ilow = 0; + } else if (ilow > robjLen) { + PyErr_SetString(PyExc_IndexError, + "R object index out of range (lowest index > object length)"); + return NULL; + //ilow = robjLen; + } + if (ihigh < ilow) { + PyErr_SetString(PyExc_IndexError, + "R object index out of range (highest index < lowest index)"); + return NULL; + //ihigh = ilow; + } else if (ihigh > robjLen) { + PyErr_SetString(PyExc_IndexError, + "R object index out of range (highest index > object length)"); + //return NULL; + ihigh = robjLen; + } + sliceLen = ihigh - ilow; + + /* if (ilow >= robjLen || ilow < 0) { */ + /* PyErr_SetString(PyExc_IndexError, "R object index out of range"); */ + /* return NULL; */ + /* } */ + + PROTECT(index = allocVector(INTSXP, sliceLen)); + + for (ii = 0; ii < sliceLen; ii++) { + INTEGER_POINTER(index)[ii] = ii + ilow + 1; + } + + PROTECT(e = allocVector(LANGSXP, 3)); + SETCAR(e, get_item); + SETCAR(CDR(e), ((RobjObject *)a)->R_obj); + SETCAR(CDR(CDR(e)), index); + + if (!(robj = do_eval_expr(e))) { + UNPROTECT(2); + return NULL; + } + + UNPROTECT(2); + + /* If there is a default mode, use it; otherwise, use the top mode. */ + if (default_mode < 0) + c = TOP_MODE; + else + c = default_mode; + obj = to_Pyobj_with_mode(robj, c); + return obj; +} + + +/* FIXME: + * Python 2.5 will feel happier with ssizeargfunc and ssizessizeargfunc + */ +/* We should implement sq_slice, sq_contains ... */ +static PySequenceMethods Robj_as_sequence = { + (inquiry)Robj_len, /* sq_length */ + 0, /* sq_concat */ + 0, /* sq_repeat */ + (intargfunc)Robj_item, /* sq_item */ + (intintargfunc)Robj_slice, /* sq_slice */ + (intobjargproc)Robj_ass_item, /* sq_ass_item */ + 0, /* sq_ass_slice */ + 0, /* sq_contains */ + 0, /* sq_inplace_concat */ + 0 /* sq_inplace_repeat */ +}; + + +/* The 'Robj' table. When compiled under Python 2.2, the type 'Robj' + is subclassable. */ + +#ifdef PRE_2_2 +static PyObject * +Robj_getattr(RobjObject *self, char *name) +{ + return Py_FindMethod(Robj_methods, (PyObject *)self, name); +} +#endif + +PyTypeObject Robj_Type = { + /* The ob_type field must be initialized in the module init function + * to be portable to Windows without using C++. */ +#if defined(PRE_2_2) || defined(_WIN32) // Matjaz + PyObject_HEAD_INIT(NULL) +#else + PyObject_HEAD_INIT(&PyType_Type) +#endif + 0, /*ob_size*/ + "Robj", /*tp_name*/ + sizeof(RobjObject), /*tp_basicsize*/ + 0, /*tp_itemsize*/ + /* methods */ + (destructor)Robj_dealloc, /*tp_dealloc*/ + 0, /*tp_print*/ +#ifdef PRE_2_2 + (getattrfunc)Robj_getattr, +#else + 0, +#endif + 0, + 0, /*tp_compare*/ + 0, /*tp_repr*/ + 0, /*tp_as_number*/ + &Robj_as_sequence, /*tp_as_sequence*/ + 0, /*tp_as_mapping*/ + 0, /*tp_hash*/ + (ternaryfunc)Robj_call, /*tp_call*/ + 0, /*tp_str*/ +#if defined(PRE_2_2) || defined(_WIN32) + 0, +#else + PyObject_GenericGetAttr, /*tp_getattro*/ +#endif + 0, /*tp_setattro*/ + 0, /*tp_as_buffer*/ +#ifdef PRE_2_2 + 0, +#else + Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/ +#endif + 0, /*tp_doc*/ + 0, /*tp_traverse*/ +#ifndef PRE_2_2 + 0, /*tp_clear*/ + 0, /*tp_richcompare*/ + 0, /*tp_weaklistoffset*/ + 0, /*tp_iter*/ + 0, /*tp_iternext*/ + Robj_methods, /*tp_methods*/ + 0, /*tp_members*/ + 0, /*tp_getset*/ + 0, /*tp_base*/ + 0, /*tp_dict*/ + 0, /*tp_descr_get*/ + 0, /*tp_descr_set*/ + 0, /*tp_dictoffset*/ + 0, /*tp_init*/ +#ifdef _WIN32 + 0, /*tp_alloc*/ +#else + PyType_GenericAlloc, /*tp_alloc*/ +#endif + Robj_tpnew, /*tp_new*/ + 0, /*tp_free*/ + 0, /*tp_is_gc*/ +#endif +}; + + +/* Module functions */ + +/* Obtain an R object via its name. 'autoconvert' is the keyword to + set the autoconversion flag. */ +static PyObject * +get_fun(PyObject *self, PyObject *args, PyObject *kwds) +{ + char *obj_str; + int conversion=TOP_MODE; + SEXP robj; + + static char *kwlist[] = {"name", "autoconvert", 0}; + if (!PyArg_ParseTupleAndKeywords(args, kwds, "s|i:get", kwlist, + &obj_str, &conversion)) + return NULL; + + robj = get_fun_from_name(obj_str); + if (!robj) + return NULL; + + return (PyObject *)Robj_new(robj, conversion); +} + +static PyObject * +set_mode(PyObject *self, PyObject *args) +{ + int i=-1; + + if (!PyArg_ParseTuple(args, "i:set_mode", &i)) + return NULL; + + if (i<-1 || i>TOP_MODE) { + PyErr_SetString(PyExc_ValueError, "wrong mode"); + return NULL; + } + + default_mode = i; + Py_INCREF(Py_None); + return Py_None; +} + +static PyObject * +get_mode(PyObject *self, PyObject *args) +{ + if (!PyArg_ParseTuple(args, ":get_mode")) + return NULL; + + return PyInt_FromLong(default_mode); +} + +static PyObject * +r_events(PyObject *self, PyObject *args, PyObject *kwds) +#ifdef _WIN32 +{ + return NULL; +} +#else +{ + fd_set *what; + int usec=10000; + + static char *kwlist[] = {"usec", 0}; + if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:r_events", + kwlist, &usec)) + return NULL; + + if (R_interact) { + Py_BEGIN_ALLOW_THREADS + what = R_checkActivity(usec, 0); + R_runHandlers(R_InputHandlers, what); + Py_END_ALLOW_THREADS + } + + Py_INCREF(Py_None); + return Py_None; +} +#endif + +void +stop_events(void) +{ + PyObject *o; + + if (!rpy_dict) + return; + + if (!r_lock) + r_lock = PyDict_GetItemString(rpy_dict, "_r_lock"); + + o = PyObject_CallMethod(r_lock, "acquire", NULL); + Py_XDECREF(o); +} + +void +start_events(void) +{ + PyObject *o; + + if (!rpy_dict) + return; + + if (!r_lock) + r_lock = PyDict_GetItemString(rpy_dict, "_r_lock"); + + o = PyObject_CallMethod(r_lock, "release", NULL); + Py_XDECREF(o); +} + + +/* + * Based on code from Rstd_CleanUp(); + * from src/unix/sys-std.c + */ + +void r_finalize(void) +{ +#if (R_VERSION < R_Version(2,4,0)) + unsigned char buf[1024]; + char * tmpdir; +#endif + + R_dot_Last(); + R_RunExitFinalizers(); + CleanEd(); +#if (R_VERSION >= R_Version(2,7,0)) + Rf_KillAllDevices(); +#else + KillAllDevices(); +#endif + +#if (R_VERSION >= R_Version(2,4,0)) + R_CleanTempDir(); +#else + if((tmpdir = getenv("R_SESSION_TMPDIR"))) { + +# ifdef _WIN32 + snprintf((char *)buf, 1024, "rmdir /S /Q %s", tmpdir); +# else + snprintf((char *)buf, 1024, "rm -rf %s", tmpdir); +# endif + + R_system((char *)buf); + } +#endif + + PrintWarnings(); /* from device close and .Last */ + R_gc(); /* Remove any remaining R objects from memory */ +} + + +static PyObject * +r_cleanup(void) +{ + r_finalize(); + Py_INCREF(Py_None); + return Py_None; +} + +#ifdef WITH_NUMERIC +static void +init_numeric(void) +{ + PyObject *multiarray, *dict; + + if(use_numeric) + { + import_array(); + multiarray = PyImport_ImportModule(PY_ARRAY_MODULE_NAME); + if (multiarray) { + dict = PyModule_GetDict(multiarray); + if (dict) + Py_transpose = PyDict_GetItemString(dict, "transpose"); + } + } +} +#endif + +static PyObject * +r_init(PyObject *self, PyObject *args) +{ + static int first=1; + int i; + + if (!PyArg_ParseTuple(args, "i:r_init", &i)) + return NULL; + use_numeric = i; + +#ifdef WITH_NUMERIC + if(use_numeric) + init_numeric(); +#endif + + if(first==1) + { + first=0; + Py_INCREF(Py_None); + return Py_None; + } + else + { + PyErr_SetString(PyExc_RuntimeError, "Only one R object may be instantiated per session"); + return NULL; + } +} + +/* List of functions defined in the module */ +static PyMethodDef rpy_methods[] = { + {"get_fun", (PyCFunction)get_fun, METH_VARARGS | METH_KEYWORDS}, + {"set_mode", (PyCFunction)set_mode, METH_VARARGS}, + {"get_mode", (PyCFunction)get_mode, METH_VARARGS}, + {"set_output", (PyCFunction)set_output, METH_VARARGS}, + {"set_input", (PyCFunction)set_input, METH_VARARGS}, + {"set_showfiles", (PyCFunction)set_showfiles, METH_VARARGS}, + {"get_output", (PyCFunction)get_output, METH_VARARGS}, + {"get_input", (PyCFunction)get_input, METH_VARARGS}, + {"get_showfiles", (PyCFunction)get_showfiles, METH_VARARGS}, + {"r_events", (PyCFunction)r_events, METH_VARARGS | METH_KEYWORDS}, + {"r_cleanup", (PyCFunction)r_cleanup, METH_NOARGS}, + {"r_init", (PyCFunction)r_init, METH_VARARGS}, + {NULL, NULL} /* sentinel */ +}; + +#ifdef _WIN32 +static void char_message( char *s ) +{ + if (!s) return; + R_WriteConsole(s, strlen(s)); +} + +static int char_yesnocancel( char *s ) +{ + return 1; +} + +static void +RPyBusy( int which ) +{ + /* set a busy cursor ... in which = 1, unset if which = 0 */ +} + +static void +RPyDoNothing( void ) +{ +} + +/* initialise embedded R; based on rproxy_impl.c from the R distribution */ +static void +init_embedded_win32(int argc, + char *argv[]) +{ + structRstart rp; + Rstart Rp = &rp; + char Rversion[25]; + int index; + + + snprintf( Rversion, 25, "%s.%s", R_MAJOR, R_MINOR ); + if( strcmp( getDLLVersion(), Rversion ) != 0 ) { + PyErr_SetString( PyExc_ImportError, "R.DLL version does not match" ); + return; + } + + R_DefParams(Rp); + + /* set R_HOME */ + Rp->rhome = RHOME; + + index = strlen(RUSER) - 1; + + if (RUSER[index] == '/' || RUSER[index] == '\\') + RUSER[index] = '\0'; + + Rp->home = RUSER; + Rp->CharacterMode = LinkDLL; + + Rp->ReadConsole = (blah1) RPy_ReadConsole; // Matjaz + Rp->WriteConsole = (blah2) RPy_WriteConsole; // Matjaz + + Rp->CallBack = (blah3) RPyDoNothing; +#if R_VERSION < 0x20100 + Rp->message = char_message; + Rp->yesnocancel = char_yesnocancel; + Rp->busy = RPyBusy; +#else + Rp->ShowMessage = char_message; + Rp->YesNoCancel = char_yesnocancel; + Rp->Busy = RPyBusy; +#endif + + Rp->R_Quiet = TRUE; + + /* run as "interactive", so server won't be killed after an error */ + Rp->R_Slave = Rp->R_Verbose = 0; + Rp->R_Interactive = TRUE; + Rp->RestoreAction = SA_NORESTORE; /* no restore */ + Rp->SaveAction = SA_NOSAVE; /* no save */ + +#if R_VERSION < 0x20000 // pre-R-2.0.0 + + Rp->CommandLineArgs = NULL; + Rp->NumCommandLineArgs = 0; +#else + R_set_command_line_arguments(argc, argv); +#endif + R_SetParams(Rp); /* so R_ShowMessage is set */ + R_SizeFromEnv(Rp); + + R_SetParams(Rp); + + setup_term_ui(); + setup_Rmainloop(); +} +#endif + +/* Initialization function for the module */ +DL_EXPORT(void) +INIT_RPY(void) +{ + PyObject *m, *d; + PyOS_sighandler_t old_int; +#ifndef _WIN32 + PyOS_sighandler_t old_usr1, old_usr2; +#endif + SEXP interact; + + /* Get path and version information from environment */ + strncpy(RHOME, getenv("RPY_RHOME"), BUFSIZ); + strncpy(RVERSION, getenv("RPY_RVERSION"), BUFSIZ); + strncpy(RVER, getenv("RPY_RVER"), BUFSIZ); + strncpy(RUSER, getenv("RPY_RUSER"), BUFSIZ); + + if( !strlen(RHOME) || !strlen(RVERSION) || !strlen(RVER) || !strlen(RUSER)) + { + PyErr_Format(RPy_Exception, + "Unable to load R path or version information"); + return; + } + + Robj_Type.ob_type = &PyType_Type; +#if defined( _WIN32 ) && ! defined( PRE_2_2 ) + Robj_Type.tp_getattro = PyObject_GenericGetAttr; + Robj_Type.tp_alloc = PyType_GenericAlloc; +#endif + + /* Initialize the module with its content */ + if (PyType_Ready(&Robj_Type) < 0) + return; + m = Py_InitModule3(xstr(RPY_SHNAME), + rpy_methods, + "Python interface to the R Programming Language"); + Py_INCREF(&Robj_Type); + PyModule_AddObject(m, Robj_Type.tp_name, + (PyObject *)&Robj_Type); + + d = PyModule_GetDict(m); + + /* Save this interpreter */ + PyEval_InitThreads(); + my_interp = PyThreadState_Get()->interp; + + /* Save the Python signal handlers. If R inserts its handlers, we + cannot return to the Python interpreter. */ + old_int = PyOS_getsig(SIGINT); + python_sigint = old_int; +#ifndef _WIN32 + old_usr1 = PyOS_getsig(SIGUSR1); + old_usr2 = PyOS_getsig(SIGUSR2); +#endif + +#ifdef _WIN32 + init_embedded_win32(defaultargc, + defaultargv); +#else + Rf_initEmbeddedR(defaultargc, + defaultargv); +#endif + + +#ifdef CSTACK_DEFNS + /* Disable C stack checking, which is incompatible with use as a + shared library. */ + R_CStackLimit = (uintptr_t)-1; +#endif + + /* Restore Python handlers */ + PyOS_setsig(SIGINT, old_int); +#ifndef _WIN32 + PyOS_setsig(SIGUSR1, old_usr1); + PyOS_setsig(SIGUSR2, old_usr2); +#endif + + /* Several new exceptions: */ + RPy_Exception = PyErr_NewException("rpy.RPy_Exception", NULL, NULL); + RPy_TypeConversionException = PyErr_NewException("rpy.RPy_TypeConversionException", RPy_Exception, NULL); + RPy_RException = PyErr_NewException("rpy.RPy_RException", RPy_Exception, NULL); + + if (!RPy_Exception || !RPy_TypeConversionException || !RPy_RException ) + { + PyErr_Format(RPy_Exception, "Unable create RPy exceptions"); + return; + } + + PyDict_SetItemString(d, "RPy_Exception", RPy_Exception); + PyDict_SetItemString(d, "RPy_TypeConversionException", RPy_TypeConversionException); + PyDict_SetItemString(d, "RPy_RException", RPy_RException); + + // The conversion table + class_table = PyDict_New(); + proc_table = PyDict_New(); + PyDict_SetItemString(d, "__class_table__", class_table); + PyDict_SetItemString(d, "__proc_table__", proc_table); + + // The globals R objects for the sequence protocol + get_item = get_fun_from_name("["); + set_item = get_fun_from_name("[<-"); + length = get_fun_from_name("length"); + + // Function to transpose arrays + aperm = get_fun_from_name("aperm"); + + // Initialize the list of protected objects + R_References = R_NilValue; + SET_SYMVALUE(install("R.References"), R_References); + + // Initialize the default mode + default_mode = -1; + + // Check whether R is interactive or no + interact = do_eval_fun("interactive"); + R_interact = INTEGER(interact)[0]; + + // I/O routines + init_io_routines(); + + rpy = PyImport_ImportModule("rpy"); + rpy_dict = PyModule_GetDict(rpy); + // r_lock = PyDict_GetItemString(rpy_dict, "_r_lock"); + // PyObject_Print(r_lock, stderr, Py_PRINT_RAW); + r_lock = NULL; + + if( Py_AtExit( r_finalize ) ) + { + fprintf(stderr, "Warning: Unable to set R finalizer."); + fflush(stderr); + } + + +} + +