Hi,

C code for this problem is embedded. I am not clear about the
R_interface.c.
I would appreciate if someone could point out problems that may lead to
sporadic problems?

Thanks,

Russ

//c_mat.h
 typedef struct cMatrix {
        int m;
        int n;
        double *d;
    } c_mat;
//c_mat.c
void
c_mat_free( c_mat *A ) {
    assert( A != NULL );
    if ( A->d != NULL ) {
        free( A->d );
        A->d = NULL;
    }
    free( A );
    A = NULL;
}
//R_interface.c
// Copies ordinary R matrix (r_matrix)
// and returns an S4 object of type RMat (r_mat)
// RMat has a single slot a pointer (ptr_c_mat)
// to C object of type c_mat (D)
SEXP copy_mat_rtoc(SEXP r_matrix)
{
 SEXP r_mat;
    PROTECT(r_mat = NEW_OBJECT(MAKE_CLASS("RMat")));
 SEXP dims, rptr_c_mat;
 int m,n,i;
 dims = GET_DIM(r_matrix);//needs protecting?
 m = INTEGER(dims)[0];
 n = INTEGER(dims)[1];
 c_mat *D = (c_mat*) malloc(sizeof(c_mat));assert(D);
        D->m = m;
        D->n = n;
        D->d = (double*) calloc(m*n, sizeof(double));assert(D->d);
        for (i = 0; i < m*n; i++){D->d[i] = REAL(r_matrix)[i];}
        PROTECT(rptr_c_mat = R_MakeExternalPtr(D, R_NilValue, R_NilValue));
        R_RegisterCFinalizer(rptr_c_mat, R_mat_free);
  SET_SLOT(r_mat, install("ptr_c_mat"), rptr_c_mat);
        UNPROTECT(2);
 return r_mat;
}
//Finalizer for rptr_c_mat
static void R_mat_free(SEXP rptr_c_mat)
{
    REprintf("Finalizing\n");
 if (TYPEOF(rptr_c_mat) != EXTPTRSXP) error("Argument is not an external
pointer");
 c_mat* m = R_ExternalPtrAddr(rptr_c_mat);
 c_mat_free(m);
    R_ClearExternalPtr(rptr_c_mat);
 REprintf("Finalized\n");
}
// Copies an S4 object of type RMat (r_mat) to an R matrix (r_matrix)
// Data from the C object c_mat pointed to by rptr_c_mat is copied to
// r_matrix
SEXP copy_mat_ctor(SEXP r_mat)
{
 if(!IS_S4_OBJECT(r_mat)) error("'r_mat' must be a RMat object");
 SEXP rptr_c_mat = GET_SLOT(r_mat, install("ptr_c_mat"));//needs protecting?
 c_mat *d = R_ExternalPtrAddr(rptr_c_mat);
 SEXP r_matrix;
 PROTECT( r_matrix  = allocMatrix(REALSXP, d->m , d->n ) ) ;
 int i;
    for (i = 0; i < d->m*d->n; i++){REAL( r_matrix )[i] = d->d[i];}
    UNPROTECT(1);
    return r_matrix;
}
//init.c
SEXP copy_mat_ctor(SEXP);
SEXP copy_mat_rtoc(SEXP);
 static  R_CallMethodDef CallDef[] = {
    {"copy_mat_rtoc", (DL_FUNC)&copy_mat_rtoc, 1},
    {"copy_mat_ctor", (DL_FUNC)&copy_mat_ctor, 1},
 {NULL, NULL, 0},
};
void
R_init_rctest(DllInfo *dll)
{
    R_registerRoutines(dll, NULL, CallDef, NULL, NULL);
    R_useDynamicSymbols(dll, FALSE);
}
/*
Invoked as:
a <- matrix(rnorm(200),40,50)
b <- copyMatrixToRMat(a)
c <- copyRMatToMatrix(b)
rm(a)
rm(b)
rm(c)
gc() ## This prints out the message from the finalizer
*/

Hi,

I have followed the recommended steps for creating a package (rctest). As of
now, my goal is simply to understand how various pieces fit together. The
package includes:

Russ

        [[alternative HTML version deleted]]

______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel

Reply via email to