External pointers to C objects

Introduction

External pointers are a method for keeping a reference to a C object across multiple calls.

A common usecase is when a struct in C is used to keep context and this context must be initialised once and then passed in to every subsequent function call.

Wrapping a C struct as an External Pointer

#include <R.h>
#include <Rinternals.h>

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// The struct we will allocate and use in multiple calls
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
typedef struct {
   double *a;
   int N;
} cdata_t;

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Finalize struct - free all allocated memory and clear the pointer
// This will be called by R's garbage collected when the variable 
// falls out of scope
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
void cdata_finalizer(SEXP cdata_) {
  Rprintf("cdata finalizer called to free the C pointer memory\n");
  
  cdata_t *cdata = R_ExternalPtrAddr(cdata_);
  if (cdata != NULL) {
    free(cdata->a);
    free(cdata);
    R_ClearExternalPtr(cdata_);
  }
}

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Allocate and initialise the struct by copying the floating point
// data in 'values' argument
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SEXP create_cdata(SEXP values) {
  int N = length(values);
  cdata_t *cdata = calloc(1, sizeof(cdata_t));
  if (cdata == NULL) {
    error("Couldn't allocate 'cdata'");
  }

  cdata->a = calloc(N, sizeof(double));
  if (cdata->a == NULL) {
    error("Couldn't allocate 'cdata->a'");
  }
  
  cdata->N = N;
  memcpy(cdata->a, REAL(values), N * sizeof(double));

  SEXP cdata_extptr = PROTECT(R_MakeExternalPtr(cdata, R_NilValue, R_NilValue));
  R_RegisterCFinalizer(cdata_extptr, cdata_finalizer);
  setAttrib(cdata_extptr, R_ClassSymbol, mkString("cdata_extptr"));

  UNPROTECT(1);
  return cdata_extptr;
}

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Print the struct
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SEXP print_cdata(SEXP cdata_extptr) {
  if (!inherits(cdata_extptr, "cdata_extptr")) {
    error("Expecting 'cdata' to be an 'cdata_extptr' ExternalPtr");
  }

  cdata_t *cdata = TYPEOF(cdata_extptr) != EXTPTRSXP ? NULL : (cdata_t *)R_ExternalPtrAddr(cdata_extptr);
  if (cdata == NULL) {
    error("MyCStruct pointer is invalid/NULL");
  }

  for (int i = 0; i < cdata->N; i++) {
    Rprintf("%.2f ", cdata->a[i]);
  }
  Rprintf("\n");

  return R_NilValue;
}
Click to show R code 
code = r"(
#include <R.h>
#include <Rinternals.h>

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// The struct we will allocate and use in multiple calls
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
typedef struct {
   double *a;
   int N;
} cdata_t;

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Finalize struct - free all allocated memory and clear the pointer
// This will be called by R's garbage collected when the variable 
// falls out of scope
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
void cdata_finalizer(SEXP cdata_) {
  Rprintf("cdata finalizer called to free the C pointer memory\n");
  
  cdata_t *cdata = R_ExternalPtrAddr(cdata_);
  if (cdata != NULL) {
    free(cdata->a);
    free(cdata);
    R_ClearExternalPtr(cdata_);
  }
}

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Allocate and initialise the struct by copying the floating point
// data in 'values' argument
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SEXP create_cdata(SEXP values) {
  int N = length(values);
  cdata_t *cdata = calloc(1, sizeof(cdata_t));
  if (cdata == NULL) {
    error("Couldn't allocate 'cdata'");
  }

  cdata->a = calloc(N, sizeof(double));
  if (cdata->a == NULL) {
    error("Couldn't allocate 'cdata->a'");
  }
  
  cdata->N = N;
  memcpy(cdata->a, REAL(values), N * sizeof(double));

  SEXP cdata_extptr = PROTECT(R_MakeExternalPtr(cdata, R_NilValue, R_NilValue));
  R_RegisterCFinalizer(cdata_extptr, cdata_finalizer);
  setAttrib(cdata_extptr, R_ClassSymbol, mkString("cdata_extptr"));

  UNPROTECT(1);
  return cdata_extptr;
}

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Print the struct
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SEXP print_cdata(SEXP cdata_extptr) {
  if (!inherits(cdata_extptr, "cdata_extptr")) {
    error("Expecting 'cdata' to be an 'cdata_extptr' ExternalPtr");
  }

  cdata_t *cdata = TYPEOF(cdata_extptr) != EXTPTRSXP ? NULL : (cdata_t *)R_ExternalPtrAddr(cdata_extptr);
  if (cdata == NULL) {
    error("MyCStruct pointer is invalid/NULL");
  }

  for (int i = 0; i < cdata->N; i++) {
    Rprintf("%.2f ", cdata->a[i]);
  }
  Rprintf("\n");

  return R_NilValue;
}
)"

callme::compile(code)
cdata <- create_cdata(c(1, 2, pi))
cdata
#> <pointer: 0x150e5d470>
#> attr(,"class")
#> [1] "cdata_extptr"
print_cdata(cdata)
#> 1.00 2.00 3.14
#> NULL