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]] ______________________________________________ R-devel@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel