# 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