porStreamBuf *get_porStreamBuf(SEXP porStream){
if(TYPEOF(porStream) != EXTPTRSXP || R_ExternalPtrTag(porStream) != install("porStreamBuf"))
error("not a porStream");
porStreamBuf *b = R_ExternalPtrAddr(porStream);
if (b == NULL){
b = Calloc(1,porStreamBuf);
R_SetExternalPtrAddr(porStream,b);
initPorStreamBuf(b);
SEXP name = getAttrib(porStream,install("file.name"));
if(name == R_NilValue || name == NULL){
R_SetExternalPtrAddr(porStream,NULL);
Free(b);
error("need filename to reopen file");
}
b->f = fopen(CHAR(STRING_ELT(name, 0)),"rb");
if(b->f == NULL){
R_SetExternalPtrAddr(porStream,NULL);
Free(b);
error("cannot reopen file -- does it still exist?");
}
Rprintf("File '%s' reopened\n",CHAR(STRING_ELT(name, 0)));
}
if (b == NULL) error("something strange happened here!?");
return(b);
}
// From: RCurl
// BSD_3_clause
// YEAR: 2001-2014
// COPYRIGHT HOLDER: Duncan Temple Lang
// ORGANIZATION: Bell Labs, Lucent Technologies; University of California
void close_file(SEXP r_file) {
FILE *f = (FILE *) R_ExternalPtrAddr(r_file);
if (f) {
fflush(f);
fclose(f);
R_SetExternalPtrAddr(r_file, NULL);
}
}
static void _bamfile_finalizer(SEXP ext)
{
if (NULL == R_ExternalPtrAddr(ext))
return;
_bamfile_close(ext);
BAM_FILE bfile = BAMFILE(ext);
Free(bfile);
R_SetExternalPtrAddr(ext, NULL);
}
SEXP rdcFree(SEXP sLibHandle)
{
void* libHandle;
libHandle = R_ExternalPtrAddr(sLibHandle);
dlFreeLibrary( libHandle );
R_SetExternalPtrAddr(sLibHandle, 0);
return R_NilValue;
}
R_stream_callback(JSONNODE *node)
#endif
{
#ifdef NEW_JSON_NEW_STREAM
SEXP expr = (SEXP) data;
#endif
SEXP ref;
ref = CAR(CDR(expr));
R_SetExternalPtrAddr(ref, node);
Rf_eval(expr, R_GlobalEnv);
}
void
R_xmlFreeNode(SEXP node)
{
xmlNodePtr p;
p = R_ExternalPtrAddr(node);
if(p) {
xmlFreeNode(p);
#ifdef R_XML_DEBUG
fprintf(stderr, "Freeing XML node from a branch\n");
#endif
}
R_SetExternalPtrAddr(node, NULL_USER_OBJECT);
}
SEXP R_RngStreams_SetData (SEXP R_obj, SEXP R_stream, SEXP R_stream_data, SEXP R_name)
/*----------------------------------------------------------------------*/
/* Create and initialize Stream generator object and */
/* set data structure of Stream object. */
/* */
/* parameters: */
/* obj ... (S4 class) ... rstream object */
/* R_stream ... (pointer) ... pointer the Stream object */
/* R_stream_data ... (double[20]) ... pointer the Stream object */
/* R_name ... (string) ... name of the Stream */
/* */
/* return: */
/* pointer to Stream object */
/*----------------------------------------------------------------------*/
{
RngStream newstream;
const char *name;
size_t len;
/* check argument */
if (!R_name || TYPEOF(R_name) != STRSXP)
error("bad string\n");
if (LENGTH(R_stream_data) != 20) {
error("invalid data for Stream object\n");
}
/* get name */
name = CHAR(STRING_ELT(R_name,0));
len = strlen(name);
/* allocate memory */
newstream = malloc(sizeof(struct RngStream_InfoState));
if (newstream == NULL) {
error("no more memory\n");
}
newstream->name = malloc(len+1);
if (newstream->name == NULL) {
free(newstream);
error("no more memory\n");
}
/* copy data */
PROTECT(R_stream_data = AS_NUMERIC(R_stream_data));
memcpy(newstream->Cg, NUMERIC_POINTER(R_stream_data) , 6*sizeof(double));
memcpy(newstream->Bg, NUMERIC_POINTER(R_stream_data)+ 6, 6*sizeof(double));
memcpy(newstream->Ig, NUMERIC_POINTER(R_stream_data)+12, 6*sizeof(double));
newstream->Anti = (int) NUMERIC_POINTER(R_stream_data)[18];
newstream->IncPrec = (int) NUMERIC_POINTER(R_stream_data)[19];
strncpy(newstream->name, name, len+1);
UNPROTECT(1);
/* store pointer to Stream generator in R external pointer */
R_SetExternalPtrAddr(R_stream, newstream);
/* ... and reset the protector just in case R_obj is different from the */
/* orignal protector of R_stream */
R_SetExternalPtrProtected(R_stream, R_obj);
/* update tag */
R_SetExternalPtrTag(R_stream, RngStreams_tag());
/* There is no need to return an object to R */
return R_NilValue;
} /* end of R_RngStreams_SetData() */
void R_ClearExternalPtr(SEXP s) {
R_SetExternalPtrAddr(s, NULL);
}
/** @brief Reset the encapsulated pointer to a null pointer.
*
* @param s Pointer to a rho::ExternalPointer (checked).
*/
inline void R_ClearExternalPtr(SEXP s)
{
R_SetExternalPtrAddr(s, nullptr);
}
