Rcpp Version 1.0.0
api.cpp
Go to the documentation of this file.
1 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
2 //
3 // api.cpp: Rcpp R/C++ interface class library -- Rcpp api
4 //
5 // Copyright (C) 2012 - 2016 Dirk Eddelbuettel and Romain Francois
6 //
7 // This file is part of Rcpp.
8 //
9 // Rcpp is free software: you can redistribute it and/or modify it
10 // under the terms of the GNU General Public License as published by
11 // the Free Software Foundation, either version 2 of the License, or
12 // (at your option) any later version.
13 //
14 // Rcpp is distributed in the hope that it will be useful, but
15 // WITHOUT ANY WARRANTY; without even the implied warranty of
16 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 // GNU General Public License for more details.
18 //
19 // You should have received a copy of the GNU General Public License
20 // along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
21 
22 #define COMPILING_RCPP
23 
24 #include <Rcpp.h>
25 
26 using namespace Rcpp;
27 
28 #include "internal.h"
29 #include <R_ext/PrtUtil.h>
30 
31 #ifdef RCPP_HAS_DEMANGLING
32 #include <cxxabi.h>
33 #endif
34 
35 #if defined(__GNUC__) || defined(__clang__)
36  #if defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX) || defined(__MUSL__) || defined(__HAIKU__) || defined(__ANDROID__)
37  // do nothing
38  #else
39  #include <execinfo.h>
40 
41  // Extract mangled name e.g. ./test(baz+0x14)[0x400962]
42  static std::string demangler_one(const char* input) {
43  static std::string buffer;
44  buffer = input;
45  size_t last_open = buffer.find_last_of('(');
46  size_t last_close = buffer.find_last_of(')');
47  if (last_open == std::string::npos ||
48  last_close == std::string::npos) {
49  return input; // #nocov
50  }
51  std::string function_name = buffer.substr(last_open + 1, last_close - last_open - 1);
52  // Strip the +0x14 (if it exists, which it does not in earlier versions of gcc)
53  size_t function_plus = function_name.find_last_of('+');
54  if (function_plus != std::string::npos) {
55  function_name.resize(function_plus);
56  }
57  buffer.replace(last_open + 1, function_name.size(), demangle(function_name));
58  return buffer;
59  }
60  #endif
61 #endif
62 
63 
64 namespace Rcpp {
65 
66  namespace internal {
67 
69 
70  // [[Rcpp::register]]
71  unsigned long enterRNGScope() {
72  if (rngSynchronizationSuspended == 0)
73  GetRNGstate();
74  return 0;
75  }
76 
77  // [[Rcpp::register]]
78  unsigned long exitRNGScope() {
79  if (rngSynchronizationSuspended == 0)
80  PutRNGstate();
81  return 0;
82  }
83 
84  // [[Rcpp::register]]
85  unsigned long beginSuspendRNGSynchronization() {
88  }
89 
90  // [[Rcpp::register]]
91  unsigned long endSuspendRNGSynchronization() {
94  }
95 
96  // [[Rcpp::register]]
97  char* get_string_buffer() {
98  static char buffer[MAXELTSIZE];
99  return buffer;
100  }
101 
102  }
103 
104  // [[Rcpp::register]]
105  const char * type2name(SEXP x) { // #nocov start
106  switch (TYPEOF(x)) {
107  case NILSXP: return "NILSXP";
108  case SYMSXP: return "SYMSXP";
109  case RAWSXP: return "RAWSXP";
110  case LISTSXP: return "LISTSXP";
111  case CLOSXP: return "CLOSXP";
112  case ENVSXP: return "ENVSXP";
113  case PROMSXP: return "PROMSXP";
114  case LANGSXP: return "LANGSXP";
115  case SPECIALSXP: return "SPECIALSXP";
116  case BUILTINSXP: return "BUILTINSXP";
117  case CHARSXP: return "CHARSXP";
118  case LGLSXP: return "LGLSXP";
119  case INTSXP: return "INTSXP";
120  case REALSXP: return "REALSXP";
121  case CPLXSXP: return "CPLXSXP";
122  case STRSXP: return "STRSXP";
123  case DOTSXP: return "DOTSXP";
124  case ANYSXP: return "ANYSXP";
125  case VECSXP: return "VECSXP";
126  case EXPRSXP: return "EXPRSXP";
127  case BCODESXP: return "BCODESXP";
128  case EXTPTRSXP: return "EXTPTRSXP";
129  case WEAKREFSXP: return "WEAKREFSXP";
130  case S4SXP: return "S4SXP";
131  default:
132  return "<unknown>";
133  }
134  } // #nocov end
135 
136 
137 } // namespace Rcpp
138 
139 // [[Rcpp::register]]
140 std::string demangle(const std::string& name) {
141  #ifdef RCPP_HAS_DEMANGLING
142  std::string real_class;
143  int status =-1;
144  char *dem = 0;
145  dem = abi::__cxa_demangle(name.c_str(), 0, 0, &status);
146  if (status == 0) {
147  real_class = dem;
148  free(dem);
149  } else {
150  real_class = name;
151  }
152  return real_class;
153  #else
154  return name;
155  #endif
156 }
157 
158 // [[Rcpp::register]]
159 const char* short_file_name(const char* file) { // #nocov start
160  std::string f(file);
161  size_t index = f.find("/include/");
162  if (index != std::string::npos) {
163  f = f.substr(index + 9);
164  }
165  return f.c_str();
166 } // #nocov end
167 
168 // [[Rcpp::internal]]
169 SEXP as_character_externalptr(SEXP xp) { // #nocov start
170  char buffer[20];
171  snprintf(buffer, 20, "%p", (void*)EXTPTR_PTR(xp));
172  return Rcpp::wrap((const char*)buffer);
173 } // #nocov end
174 
175 // [[Rcpp::internal]]
177  Shield<SEXP> cap(Rf_allocVector(LGLSXP, 13));
178  Shield<SEXP> names(Rf_allocVector(STRSXP, 13));
179  #ifdef HAS_VARIADIC_TEMPLATES
180  LOGICAL(cap)[0] = TRUE;
181  #else
182  LOGICAL(cap)[0] = FALSE;
183  #endif
184  #ifdef HAS_CXX0X_INITIALIZER_LIST
185  LOGICAL(cap)[1] = TRUE;
186  #else
187  LOGICAL(cap)[1] = FALSE;
188  #endif
189  /* exceptions are always supported */
190  LOGICAL(cap)[2] = TRUE;
191 
192  #ifdef HAS_TR1_UNORDERED_MAP
193  LOGICAL(cap)[3] = TRUE;
194  #else
195  LOGICAL(cap)[3] = FALSE;
196  #endif
197 
198  #ifdef HAS_TR1_UNORDERED_SET
199  LOGICAL(cap)[4] = TRUE;
200  #else
201  LOGICAL(cap)[4] = FALSE;
202  #endif
203 
204  LOGICAL(cap)[5] = TRUE;
205 
206  #ifdef RCPP_HAS_DEMANGLING
207  LOGICAL(cap)[6] = TRUE;
208  #else
209  LOGICAL(cap)[6] = FALSE;
210  #endif
211 
212  LOGICAL(cap)[7] = FALSE;
213 
214  #ifdef RCPP_HAS_LONG_LONG_TYPES
215  LOGICAL(cap)[8] = TRUE;
216  #else
217  LOGICAL(cap)[8] = FALSE;
218  #endif
219 
220  #ifdef HAS_CXX0X_UNORDERED_MAP
221  LOGICAL(cap)[9] = TRUE;
222  #else
223  LOGICAL(cap)[9] = FALSE;
224  #endif
225 
226  #ifdef HAS_CXX0X_UNORDERED_SET
227  LOGICAL(cap)[10] = TRUE;
228  #else
229  LOGICAL(cap)[10] = FALSE;
230  #endif
231 
232  #ifdef RCPP_USING_CXX11
233  LOGICAL(cap)[11] = TRUE;
234  #else
235  LOGICAL(cap)[11] = FALSE;
236  #endif
237 
238  #ifdef RCPP_NEW_DATE_DATETIME_VECTORS
239  LOGICAL(cap)[12] = TRUE;
240  #else
241  LOGICAL(cap)[12] = FALSE;
242  #endif
243 
244 
245  SET_STRING_ELT(names, 0, Rf_mkChar("variadic templates"));
246  SET_STRING_ELT(names, 1, Rf_mkChar("initializer lists"));
247  SET_STRING_ELT(names, 2, Rf_mkChar("exception handling"));
248  SET_STRING_ELT(names, 3, Rf_mkChar("tr1 unordered maps"));
249  SET_STRING_ELT(names, 4, Rf_mkChar("tr1 unordered sets"));
250  SET_STRING_ELT(names, 5, Rf_mkChar("Rcpp modules"));
251  SET_STRING_ELT(names, 6, Rf_mkChar("demangling"));
252  SET_STRING_ELT(names, 7, Rf_mkChar("classic api"));
253  SET_STRING_ELT(names, 8, Rf_mkChar("long long"));
254  SET_STRING_ELT(names, 9, Rf_mkChar("C++0x unordered maps"));
255  SET_STRING_ELT(names, 10, Rf_mkChar("C++0x unordered sets"));
256  SET_STRING_ELT(names, 11, Rf_mkChar("Full C++11 support"));
257  SET_STRING_ELT(names, 12, Rf_mkChar("new date(time) vectors"));
258  Rf_setAttrib(cap, R_NamesSymbol, names);
259  return cap;
260 }
261 
262 
263 // [[Rcpp::internal]]
264 SEXP rcpp_can_use_cxx0x() { // #nocov start
265  #if defined(HAS_VARIADIC_TEMPLATES) || defined(RCPP_USING_CXX11)
266  return Rf_ScalarLogical(TRUE);
267  #else
268  return Rf_ScalarLogical(FALSE);
269  #endif
270 } // #nocov end
271 
272 
273 // [[Rcpp::internal]]
274 SEXP rcpp_can_use_cxx11() { // #nocov start
275  #if defined(RCPP_USING_CXX11)
276  return Rf_ScalarLogical(TRUE);
277  #else
278  return Rf_ScalarLogical(FALSE);
279  #endif
280 } // #nocov end
281 
282 
283 // [[Rcpp::register]]
284 SEXP stack_trace(const char* file, int line) {
285  #if defined(__GNUC__) || defined(__clang__)
286  #if defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX) || defined(__MUSL__) || defined(__HAIKU__) || defined(__ANDROID__)
287  // Simpler version for Windows and *BSD
288  List trace = List::create(_["file"] = file,
289  _[ "line" ] = line,
290  _[ "stack" ] = "C++ stack not available on this system");
291  trace.attr("class") = "Rcpp_stack_trace";
292  return trace;
293  #else // ! (defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX) || defined(__ANDROID__)
294 
295  /* inspired from http://tombarta.wordpress.com/2008/08/01/c-stack-traces-with-gcc/ */
296  const size_t max_depth = 100;
297  int stack_depth;
298  void *stack_addrs[max_depth];
299  char **stack_strings;
300 
301  stack_depth = backtrace(stack_addrs, max_depth);
302  stack_strings = backtrace_symbols(stack_addrs, stack_depth);
303 
304  std::string current_line;
305 
306  CharacterVector res(stack_depth - 1);
307  std::transform(stack_strings + 1, stack_strings + stack_depth, res.begin(), demangler_one);
308  free(stack_strings); // malloc()ed by backtrace_symbols
309 
310  List trace = List::create(_["file" ] = file,
311  _["line" ] = line,
312  _["stack"] = res);
313  trace.attr("class") = "Rcpp_stack_trace";
314  return trace;
315  #endif
316  #else /* !defined( __GNUC__ ) */
317  return R_NilValue;
318  #endif
319 }
320 
321 // // [ [ Rcpp::register ] ]
322 // void print(SEXP s) {
323 // Rf_PrintValue(s); // defined in Rinternals.h
324 // }
325 
326 // }}}
327 
AttributeProxy attr(const std::string &name)
int rngSynchronizationSuspended
Definition: api.cpp:68
SEXP as_character_externalptr(SEXP xp)
Definition: api.cpp:169
SEXP rcpp_capabilities()
Definition: api.cpp:176
static internal::NamedPlaceHolder _
Definition: Named.h:64
SEXP stack_trace(const char *file, int line)
Definition: api.cpp:284
const char * short_file_name(const char *file)
Definition: api.cpp:159
SEXP rcpp_can_use_cxx11()
Definition: api.cpp:274
std::string demangle(const std::string &name)
Definition: api.cpp:140
#define MAXELTSIZE
Definition: headers.h:25
SEXP rcpp_can_use_cxx0x()
Definition: api.cpp:264
attribute_hidden unsigned long endSuspendRNGSynchronization()
Definition: routines.h:97
attribute_hidden unsigned long exitRNGScope()
Definition: routines.h:85
attribute_hidden const char * type2name(SEXP x)
Definition: routines.h:72
static Vector create()
Definition: Vector.h:1120
SEXP wrap(const Date &date)
Definition: Date.h:38
attribute_hidden unsigned long beginSuspendRNGSynchronization()
Definition: routines.h:91
attribute_hidden unsigned long enterRNGScope()
Definition: routines.h:79
attribute_hidden char * get_string_buffer()
Definition: routines.h:103
Rcpp API.
Definition: algo.h:28
iterator begin()
Definition: Vector.h:332