static void _clear(SEXP Rptr){
if (R_ExternalPtrAddr(Rptr) != NULL){
void *Cptr = (void *) R_ExternalPtrAddr(Rptr);
free(Cptr);
R_ClearExternalPtr(Rptr);
}
}
SEXP
RGDAL_CloseHandle(SEXP sxpHandle) {
GDALDataset *pDataset =
(GDALDataset *) R_ExternalPtrAddr(sxpHandle);
#ifdef RGDALDEBUG
Rprintf("Closing GDAL dataset handle %p... ", (void *) pDataset);
#endif
installErrorHandler();
if (pDataset != NULL) {
// Even Roualt 120816
GDALClose((GDALDatasetH)pDataset);
// pDataset->~GDALDataset();
R_ClearExternalPtr(sxpHandle);
#ifdef RGDALDEBUG
Rprintf(" destroyed ... ");
#endif
}
uninstallErrorHandlerAndTriggerError();
#ifdef RGDALDEBUG
Rprintf("done.\n");
#endif
return(R_NilValue);
}
void _sphere_finalizer(SEXP Rextp)
{
checkPtr(Rextp, sphere_type_tag);
STGM::CBoolSphereSystem *sp = (STGM::CBoolSphereSystem *)(R_ExternalPtrAddr(Rextp));
_free_spheres(sp);
R_ClearExternalPtr(Rextp);
}
void VecNimArr_Finalizer(SEXP Sp) {
// std::cout<< "In VecNimArr_Finalizer\n";
NimVecType* np = static_cast<NimVecType*>(R_ExternalPtrAddr(Sp));
if(np) delete np;
R_ClearExternalPtr(Sp);
}
static void contextFinalizer(SEXP context_) {
zmq::context_t* context = reinterpret_cast<zmq::context_t*>(R_ExternalPtrAddr(context_));
if(context) {
delete context;
R_ClearExternalPtr(context_);
}
}
static void xmockFinalizer(SEXP xm) {
xmock* _xm = reinterpret_cast<xmock*>(R_ExternalPtrAddr(xm));
if( _xm ) {
delete _xm;
R_ClearExternalPtr(xm);
}
}
static void hbhmat_finalizer(SEXP ptr) {
ext_matrix *e;
hbhankel_matrix *h;
if (TYPEOF(ptr) != EXTPTRSXP)
return;
e = R_ExternalPtrAddr(ptr);
if (!e)
return;
if (strcmp(e->type, "hbhankel matrix"))
return;
h = e->matrix;
free_area(h->col_ind);
free_area(h->row_ind);
Free(h->weights);
free_circulant(h);
Free(h);
Free(e);
R_ClearExternalPtr(ptr);
}
SEXP
RGDAL_CloseHandle(SEXP sxpHandle) {
GDALDataset *pDataset =
(GDALDataset *) R_ExternalPtrAddr(sxpHandle);
#ifdef RGDALDEBUG
Rprintf("Closing GDAL dataset handle %p... ", (void *) pDataset);
#endif
if (pDataset != NULL) {
pDataset->~GDALDataset();
R_ClearExternalPtr(sxpHandle);
#ifdef RGDALDEBUG
Rprintf(" destroyed ... ");
#endif
}
#ifdef RGDALDEBUG
Rprintf("done.\n");
#endif
return(R_NilValue);
}
static void kernelFinalizer(SEXP jk) {
JuniperKernel* jkernel = reinterpret_cast<JuniperKernel*>(R_ExternalPtrAddr(jk));
if( jkernel ) {
delete jkernel;
R_ClearExternalPtr(jk);
}
}
void ring_buffer_finalize(SEXP extPtr) {
ring_buffer *buffer = ring_buffer_get(extPtr, 0);
if (buffer) {
ring_buffer_destroy(buffer);
R_ClearExternalPtr(extPtr);
}
}
void fin_handle(SEXP ptr){
//Rprintf("running finalizer...\n");
reference *ref = (reference*) R_ExternalPtrAddr(ptr);
ref->refCount--;
clean_handle(ref);
R_ClearExternalPtr(ptr);
}
/*
* Originally, we retained the DOBJ and stored a pointer to it in the
* SEXP. For that reason, garbage collection was an issue and this
* function was used to clean up the data object when the SEXP was
* deleted. No longer needed, should be save to remove.
*/
static void
DObjFinalizer(SEXP dPtr)
{
DOBJ *data = R_ExternalPtrAddr(dPtr);
asspFClose(data, AFC_FREE);
R_ClearExternalPtr(dPtr); /* not really needed */
}
static void socketFinalizer(SEXP socket_) {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(socket) {
delete socket;
R_ClearExternalPtr(socket_);
}
}
void RGtk_finalizer(USER_OBJECT_ extptr) {
void *ptr = getPtrValue(extptr);
/*Rprintf("finalizing a %s\n", asCString(GET_CLASS(extptr)));*/
if (ptr) {
((RPointerFinalizer)getPtrValue(R_ExternalPtrTag(extptr)))(ptr);
R_ClearExternalPtr(extptr);
}
}
static void queryResultsFinalizer(SEXP query_results_sexp) {
QueryResults* query_results = reinterpret_cast<QueryResults*>(R_ExternalPtrAddr(query_results_sexp));
if(query_results) {
// call c++ destructor
delete query_results;
R_ClearExternalPtr(query_results_sexp);
}
}
static void connFinalizer(SEXP dbi_conn_sexp) {
DatabaseConnection* conn = reinterpret_cast<DatabaseConnection*>(R_ExternalPtrAddr(dbi_conn_sexp));
if(conn) {
// call c++ destructor
delete conn;
R_ClearExternalPtr(dbi_conn_sexp);
}
}
static void d_finalizer(SEXP d_ptr)
{
if(!R_ExternalPtrAddr(d_ptr))
return;
cublasFree(R_ExternalPtrAddr(d_ptr));
R_ClearExternalPtr(d_ptr);
}
void mpcFinalizer(SEXP ptr) {
mpc_t *z = (mpc_t *)R_ExternalPtrAddr(ptr);
if (z) {
mpc_clear(*z);
free(z);
R_ClearExternalPtr(ptr);
}
}
/*
* realvec is an external-pointer vector of floats.
* Three operations:
* (1) create
* (2) get (sub vector)
* (3) set (sub vector)
* The length of the vector is stored as an integer
* at the start. The data starts 2 floats into the memory
* (to allow for the unlikely possibility that an integer
* takes twice as many bytes as a float).
*/
static void realvec_finalizer(SEXP ptr)
{
float *mem = R_ExternalPtrAddr(ptr);
if (!mem)
return;
Free(mem);
R_ClearExternalPtr(ptr);
}
static void wl_finalize(SEXP ptr)
{
if (NULL == R_ExternalPtrAddr(ptr))
return;
wordlist_t *wl = (wordlist_t *) R_ExternalPtrAddr(ptr);
free_wordlist(wl);
R_ClearExternalPtr(ptr);
}
static void ngl_finalize(SEXP ptr)
{
if (NULL == R_ExternalPtrAddr(ptr))
return;
ngramlist_t *ngl = (ngramlist_t *) R_ExternalPtrAddr(ptr);
free_ngl(ngl);
R_ClearExternalPtr(ptr);
}
// With inspiration from Martin Morgan
static void str_finalize(SEXP ptr)
{
if (NULL == R_ExternalPtrAddr(ptr))
return;
char *str = (char *) R_ExternalPtrAddr(ptr);
free(str);
R_ClearExternalPtr(ptr);
}
static void realhrr_ramdbx1_finalizer(SEXP ptr)
{
signed char *mem = (signed char*) R_ExternalPtrAddr(ptr);
if (!mem)
return;
/* close the ramdb and free the storage */
Free(mem);
R_ClearExternalPtr(ptr);
}
void
R_free(SEXP rptr)
{
void *ptr = R_ExternalPtrAddr(rptr);
if(ptr) {
free(ptr);
R_ClearExternalPtr(rptr);
}
}
void
RDCOM_SafeArray_finalizer(SEXP s)
{
SAFEARRAY *arr;
arr = (SAFEARRAY*) R_ExternalPtrAddr(s);
if(arr) {
SafeArrayDestroy(arr);
R_ClearExternalPtr(s);
}
}
static void testClientFinalizer(SEXP jtc) {
JupyterTestClient* jclient = reinterpret_cast<JupyterTestClient*>(R_ExternalPtrAddr(jtc));
if( jclient ) {
Rcpp::Rcout << "deleting test client" << std::endl;
delete jclient;
Rcpp::Rcout << "attempting to clear the external pointer" << std::endl;
R_ClearExternalPtr(jtc);
Rcpp::Rcout << "external pointer for test client cleared" << std::endl;
}
}
SEXP mongo_gridfile_writer_finish(SEXP gfw) {
gridfile* gfile = _checkGridfileWriter(gfw);
SEXP ret;
PROTECT(ret = allocVector(LGLSXP, 1));
LOGICAL(ret)[0] = (gridfile_writer_done(gfile) == MONGO_OK);
Free(gfile);
R_ClearExternalPtr(getAttrib(gfw, sym_mongo_gridfile));
UNPROTECT(1);
return ret;
}
static void
_finalizer(SEXP ext)
{
if (NULL == R_ExternalPtrAddr(ext))
return;
Rprintf("finalizing\n");
char *ptr = (char *) R_ExternalPtrAddr(ext);
Free(ptr);
R_ClearExternalPtr(ext);
}
SEXP rmongo_cursor_destroy(SEXP cursor) {
mongo_cursor* _cursor = _checkCursor(cursor);
SEXP ret;
PROTECT(ret = allocVector(LGLSXP, 1));
LOGICAL(ret)[0] = mongo_cursor_destroy(_cursor);
SEXP ptr = getAttrib(cursor, sym_mongo_cursor);
R_ClearExternalPtr(ptr);
UNPROTECT(1);
return ret;
}
SEXP Rgraphviz_fin(SEXP s) {
/* Finalizer for the external reference */
Agraph_t *g;
CHECK_Rgraphviz_graph(s);
g = R_ExternalPtrAddr(s);
agclose(g);
R_ClearExternalPtr(s);
return(R_NilValue);
}
