// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
//
// api.cpp: Rcpp R/C++ interface class library -- Rcpp api
//
// Copyright (C) 2012 - 2016 Dirk Eddelbuettel and Romain Francois
//
// This file is part of Rcpp.
//
// Rcpp is free software: you can redistribute it and/or modify it
// under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 2 of the License, or
// (at your option) any later version.
//
// Rcpp is distributed in the hope that it will be useful, but
// WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with Rcpp. If not, see .
#define COMPILING_RCPP
#include
using namespace Rcpp;
#include "internal.h"
#include
#ifdef RCPP_HAS_DEMANGLING
#include
#endif
#if defined(__GNUC__) || defined(__clang__)
#if defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX) || defined(__MUSL__)
// do nothing
#else
#include
// Extract mangled name e.g. ./test(baz+0x14)[0x400962]
static std::string demangler_one(const char* input) {
static std::string buffer;
buffer = input;
size_t last_open = buffer.find_last_of('(');
size_t last_close = buffer.find_last_of(')');
if (last_open == std::string::npos ||
last_close == std::string::npos) {
return input;
}
std::string function_name = buffer.substr(last_open + 1, last_close - last_open - 1);
// Strip the +0x14 (if it exists, which it does not in earlier versions of gcc)
size_t function_plus = function_name.find_last_of('+');
if (function_plus != std::string::npos) {
function_name.resize(function_plus);
}
buffer.replace(last_open + 1, function_name.size(), demangle(function_name));
return buffer;
}
#endif
#endif
namespace Rcpp {
namespace internal {
namespace {
unsigned long RNGScopeCounter = 0;
}
// [[Rcpp::register]]
unsigned long enterRNGScope() {
if (RNGScopeCounter == 0) GetRNGstate();
RNGScopeCounter++;
return RNGScopeCounter;
}
// [[Rcpp::register]]
unsigned long exitRNGScope() {
RNGScopeCounter--;
if (RNGScopeCounter == 0) PutRNGstate();
return RNGScopeCounter;
}
// [[Rcpp::register]]
char* get_string_buffer() {
static char buffer[MAXELTSIZE];
return buffer;
}
}
// [[Rcpp::register]]
const char * type2name(SEXP x) {
switch (TYPEOF(x)) {
case NILSXP: return "NILSXP";
case SYMSXP: return "SYMSXP";
case RAWSXP: return "RAWSXP";
case LISTSXP: return "LISTSXP";
case CLOSXP: return "CLOSXP";
case ENVSXP: return "ENVSXP";
case PROMSXP: return "PROMSXP";
case LANGSXP: return "LANGSXP";
case SPECIALSXP: return "SPECIALSXP";
case BUILTINSXP: return "BUILTINSXP";
case CHARSXP: return "CHARSXP";
case LGLSXP: return "LGLSXP";
case INTSXP: return "INTSXP";
case REALSXP: return "REALSXP";
case CPLXSXP: return "CPLXSXP";
case STRSXP: return "STRSXP";
case DOTSXP: return "DOTSXP";
case ANYSXP: return "ANYSXP";
case VECSXP: return "VECSXP";
case EXPRSXP: return "EXPRSXP";
case BCODESXP: return "BCODESXP";
case EXTPTRSXP: return "EXTPTRSXP";
case WEAKREFSXP: return "WEAKREFSXP";
case S4SXP: return "S4SXP";
default:
return "";
}
}
} // namespace Rcpp
// [[Rcpp::register]]
std::string demangle(const std::string& name) {
#ifdef RCPP_HAS_DEMANGLING
std::string real_class;
int status =-1;
char *dem = 0;
dem = abi::__cxa_demangle(name.c_str(), 0, 0, &status);
if (status == 0) {
real_class = dem;
free(dem);
} else {
real_class = name;
}
return real_class;
#else
return name;
#endif
}
// [[Rcpp::register]]
const char* short_file_name(const char* file) {
std::string f(file);
size_t index = f.find("/include/");
if (index != std::string::npos) {
f = f.substr(index + 9);
}
return f.c_str();
}
// [[Rcpp::internal]]
SEXP as_character_externalptr(SEXP xp) {
char buffer[20];
snprintf(buffer, 20, "%p", (void*)EXTPTR_PTR(xp));
return Rcpp::wrap((const char*)buffer);
}
// [[Rcpp::internal]]
SEXP rcpp_capabilities() {
Shield cap(Rf_allocVector(LGLSXP, 13));
Shield names(Rf_allocVector(STRSXP, 13));
#ifdef HAS_VARIADIC_TEMPLATES
LOGICAL(cap)[0] = TRUE;
#else
LOGICAL(cap)[0] = FALSE;
#endif
#ifdef HAS_CXX0X_INITIALIZER_LIST
LOGICAL(cap)[1] = TRUE;
#else
LOGICAL(cap)[1] = FALSE;
#endif
/* exceptions are always supported */
LOGICAL(cap)[2] = TRUE;
#ifdef HAS_TR1_UNORDERED_MAP
LOGICAL(cap)[3] = TRUE;
#else
LOGICAL(cap)[3] = FALSE;
#endif
#ifdef HAS_TR1_UNORDERED_SET
LOGICAL(cap)[4] = TRUE;
#else
LOGICAL(cap)[4] = FALSE;
#endif
LOGICAL(cap)[5] = TRUE;
#ifdef RCPP_HAS_DEMANGLING
LOGICAL(cap)[6] = TRUE;
#else
LOGICAL(cap)[6] = FALSE;
#endif
LOGICAL(cap)[7] = FALSE;
#ifdef RCPP_HAS_LONG_LONG_TYPES
LOGICAL(cap)[8] = TRUE;
#else
LOGICAL(cap)[8] = FALSE;
#endif
#ifdef HAS_CXX0X_UNORDERED_MAP
LOGICAL(cap)[9] = TRUE;
#else
LOGICAL(cap)[9] = FALSE;
#endif
#ifdef HAS_CXX0X_UNORDERED_SET
LOGICAL(cap)[10] = TRUE;
#else
LOGICAL(cap)[10] = FALSE;
#endif
#ifdef RCPP_USING_CXX11
LOGICAL(cap)[11] = TRUE;
#else
LOGICAL(cap)[11] = FALSE;
#endif
#ifdef RCPP_NEW_DATE_DATETIME_VECTORS
LOGICAL(cap)[12] = TRUE;
#else
LOGICAL(cap)[12] = FALSE;
#endif
SET_STRING_ELT(names, 0, Rf_mkChar("variadic templates"));
SET_STRING_ELT(names, 1, Rf_mkChar("initializer lists"));
SET_STRING_ELT(names, 2, Rf_mkChar("exception handling"));
SET_STRING_ELT(names, 3, Rf_mkChar("tr1 unordered maps"));
SET_STRING_ELT(names, 4, Rf_mkChar("tr1 unordered sets"));
SET_STRING_ELT(names, 5, Rf_mkChar("Rcpp modules"));
SET_STRING_ELT(names, 6, Rf_mkChar("demangling"));
SET_STRING_ELT(names, 7, Rf_mkChar("classic api"));
SET_STRING_ELT(names, 8, Rf_mkChar("long long"));
SET_STRING_ELT(names, 9, Rf_mkChar("C++0x unordered maps"));
SET_STRING_ELT(names, 10, Rf_mkChar("C++0x unordered sets"));
SET_STRING_ELT(names, 11, Rf_mkChar("Full C++11 support"));
SET_STRING_ELT(names, 12, Rf_mkChar("new date(time) vectors"));
Rf_setAttrib(cap, R_NamesSymbol, names);
return cap;
}
// [[Rcpp::internal]]
SEXP rcpp_can_use_cxx0x() {
#if defined(HAS_VARIADIC_TEMPLATES) || defined(RCPP_USING_CXX11)
return Rf_ScalarLogical(TRUE);
#else
return Rf_ScalarLogical(FALSE);
#endif
}
// [[Rcpp::internal]]
SEXP rcpp_can_use_cxx11() {
#if defined(RCPP_USING_CXX11)
return Rf_ScalarLogical(TRUE);
#else
return Rf_ScalarLogical(FALSE);
#endif
}
// [[Rcpp::register]]
SEXP stack_trace(const char* file, int line) {
#if defined(__GNUC__) || defined(__clang__)
#if defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX) || defined(__MUSL__)
// Simpler version for Windows and *BSD
List trace = List::create(_["file"] = file,
_[ "line" ] = line,
_[ "stack" ] = "C++ stack not available on this system");
trace.attr("class") = "Rcpp_stack_trace";
return trace;
#else // ! (defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX)
/* inspired from http://tombarta.wordpress.com/2008/08/01/c-stack-traces-with-gcc/ */
const size_t max_depth = 100;
int stack_depth;
void *stack_addrs[max_depth];
char **stack_strings;
stack_depth = backtrace(stack_addrs, max_depth);
stack_strings = backtrace_symbols(stack_addrs, stack_depth);
std::string current_line;
CharacterVector res(stack_depth - 1);
std::transform(stack_strings + 1, stack_strings + stack_depth, res.begin(), demangler_one);
free(stack_strings); // malloc()ed by backtrace_symbols
List trace = List::create(_["file" ] = file,
_["line" ] = line,
_["stack"] = res);
trace.attr("class") = "Rcpp_stack_trace";
return trace;
#endif
#else /* !defined( __GNUC__ ) */
return R_NilValue;
#endif
}
// // [ [ Rcpp::register ] ]
// void print(SEXP s) {
// Rf_PrintValue(s); // defined in Rinternals.h
// }
// }}}