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)©_mat_rtoc, 1},
{"copy_mat_ctor", (DL_FUNC)©_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]]
______________________________________________
[email protected] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
