void
Rsqlite_ReleaseAggregate(void *ptr)
{
SEXP *arr = (SEXP *) ptr;
R_ReleaseObject(arr[0]);
R_ReleaseObject(arr[1]);
free(ptr);
}
SEXP onUnload() {
R_ReleaseObject(TRUESEXP);
R_ReleaseObject(FALSESEXP);
return R_NilValue;
}/*C_ONUNLOAD*/
/* Generic callback stuff */
void R_freeCBData(R_CallbackData *cbdata) {
R_ReleaseObject(cbdata->function);
if(cbdata->useData && cbdata->data != NULL) {
R_ReleaseObject(cbdata->data);
}
g_free(cbdata);
}
void SexpObject_clear(SexpObject *sexpobj)
{
(*sexpobj).count--;
#ifdef RPY_VERBOSE
printf("R:%p -- sexp count is %i...",
sexpobj->sexp, sexpobj->count);
#endif
if (((*sexpobj).count == 0) && (*sexpobj).sexp) {
#ifdef RPY_VERBOSE
printf("freeing SEXP resources...");
#endif
if (sexpobj->sexp != R_NilValue) {
#ifdef RPY_DEBUG_PRESERVE
printf(" PRESERVE -- Sexp_clear: R_ReleaseObject -- %p ",
sexpobj->sexp);
preserved_robjects -= 1;
printf("-- %i\n", preserved_robjects);
#endif
R_ReleaseObject(sexpobj->sexp);
}
PyMem_Free(sexpobj);
/* self->ob_type->tp_free((PyObject*)self); */
#ifdef RPY_VERBOSE
printf("done.\n");
#endif
}
}
SEXP deque_pop(deque_t *dl)
{
list_t *tmp;
if (dl->len == 0)
return R_NilValue;
list_t *l = dl->start;
if (l->next)
{
tmp = l;
l = l->next;
l->prev = NULL;
l = tmp;
}
dl->start = l->next;
if (dl->len == 1)
dl->end = NULL;
dl->len--;
SEXP ret = l->data;
R_ReleaseObject(ret);
free(l);
return ret;
}
void RFunction::Deallocate()
{
if(this->object)
{
R_ReleaseObject(this->object);
this->object=NULL;
}
}
static void userCleanup(void **userData)
{
for (int i=0; i<3; i++) {
if (userData[i]) {
R_ReleaseObject((SEXP)userData[i]);
userData[i] = 0;
}
}
}
gboolean onWinDestroy (GtkWidget * wnd, GdkEvent * event, gpointer user_data) {
udata *dat=(udata *)user_data;
UNUSED(wnd);
UNUSED(event);
R_ReleaseObject(dat->xx);
g_free (dat);
return FALSE;
}
DataFrameModel::~DataFrameModel() {
R_ReleaseObject(_dataframe);
R_ReleaseObject(_roles);
R_ReleaseObject(_rowHeader);
R_ReleaseObject(_colHeader);
R_ReleaseObject(_useRoles);
R_ReleaseObject(_editable);
}
SEXP Rserve_set_context(SEXP sObj) {
if (!sObj)
sObj = R_NilValue;
if (RS_current_context == sObj) return sObj;
if (RS_current_context != R_NilValue && RS_current_context_is_protected)
R_ReleaseObject(RS_current_context);
RS_current_context = sObj;
RS_current_context_is_protected = 0;
if (RS_current_context != R_NilValue) {
R_PreserveObject(RS_current_context);
RS_current_context_is_protected = 1;
}
return RS_current_context;
}
SEXP
R_setInitialModuleFunction(SEXP v)
{
SEXP prev;
if(R_initializeModuleFunction && GET_LENGTH(R_initializeModuleFunction))
R_ReleaseObject(R_initializeModuleFunction);
prev = R_initializeModuleFunction ? R_initializeModuleFunction : R_NilValue;
if(GET_LENGTH(v))
R_PreserveObject(v);
R_initializeModuleFunction = v;
return(prev);
}
USER_OBJECT_
RS_GGOBI(setSmoothFunction)(USER_OBJECT_ func)
{
USER_OBJECT_ old;
old = RS_smoothFunction;
if(old != NULL)
R_ReleaseObject(RS_smoothFunction);
else
old = NULL_USER_OBJECT;
RS_smoothFunction = func;
R_PreserveObject(RS_smoothFunction);
return(old);
}
void RVector::append(SEXP e) {
if (size_ == capacity_) {
Protect p(e);
capacity_ *= grow;
SEXP new_vector = Rf_allocVector(VECSXP, capacity_);
for (size_t i = 0; i < size_; ++i) {
SET_VECTOR_ELT(new_vector, i, at(i));
}
R_ReleaseObject(vector);
R_PreserveObject(new_vector);
vector = new_vector;
}
size_++;
SETLENGTH(vector, size_);
SET_VECTOR_ELT(vector, size_ - 1, e);
}
void deque_free(deque_t *dl)
{
list_t *tmp;
list_t *l = dl->start;
while (l)
{
if (l->data != R_NilValue)
R_ReleaseObject(l->data);
tmp = l->next;
free(l);
l = tmp;
}
free(dl);
}
/* this is pretty much hard-coded for now - it's picking "xp" attribute */
REPC SEXP RReleaseREXP(SEXP ptr) {
jobject o;
if (TYPEOF(ptr)==EXTPTRSXP) error("invalid object");
o = (jobject)EXTPTR_PTR(ptr);
{
JNIEnv *env = getJNIEnv();
jclass cls = (*env)->GetObjectClass(env, o);
if (cls) {
jfieldID fid=(*env)->GetFieldID(env,cls,"xp","J");
if (fid) {
jlong r = (*env)->GetLongField(env, o, fid);
SEXP x = (SEXP) r;
if (x) R_ReleaseObject(x);
}
}
}
return R_NilValue;
}
SmokeObject::~SmokeObject() {
#ifdef MEM_DEBUG
qDebug("%p: destructing", this);
#endif
if (_sexp) {
#ifdef MEM_DEBUG
qDebug("%p: orphaned sexp %p", this, _sexp);
#endif
orphanTable(HASHTAB(_sexp));
}
if (_internalTable) {
#ifdef MEM_DEBUG
qDebug("%p: orphaned internal table %p", this, _internalTable);
#endif
orphanTable(_internalTable);
}
if (_fieldEnv)
R_ReleaseObject(_fieldEnv);
instances.remove(_ptr);
}
bool DataFrameModel::setData(const QModelIndex &index, const QVariant &value,
int role)
{
int col = index.column();
int row = index.row();
QModelIndex dummy;
if (!index.isValid()) {
qCritical("Model index is invalid");
return false;
}
if (col >= columnCount(dummy)) {
qCritical("Column index %d out of bounds", col);
return false;
}
if (row >= rowCount(dummy)) {
qCritical("Row index %d out of bounds", row);
return false;
}
if (role >= length(_roles)) {
qCritical("Role index %d out of bounds", role);
return false;
}
SEXP roleVector = VECTOR_ELT(_roles, role);
int dfIndex;
if (roleVector == R_NilValue || (dfIndex = INTEGER(roleVector)[col]) == -1)
return(false);
SEXP tmpDataframe = duplicate(_dataframe);
R_ReleaseObject(_dataframe);
_dataframe = tmpDataframe;
R_PreserveObject(_dataframe);
SEXP v = VECTOR_ELT(_dataframe, dfIndex);
bool success = qvariant_into_vector(value, v, row);
if (success)
dataChanged(index, index);
return success;
}
RClass::~RClass() {
R_ReleaseObject(_klass);
}
void
Rsqlite_Release(void *val)
{
R_ReleaseObject((SEXP) val);
}
RDynamicQObject::~RDynamicQObject() {
R_ReleaseObject(_function);
if (_userData)
R_ReleaseObject(_userData);
}
/* TODO: This needs implementing as a Ruby destructor for each RObj */
void
Robj_dealloc(SEXP robj)
{
R_ReleaseObject(robj);
}
static void matrix_finalizer(SEXP handle)
{
R_ReleaseObject(protected_objects[*INTEGER(R_ExternalPtrTag(handle))]);
std::cout << "R/PLEX: Distance matrix unprotected." << std::endl;
}
