Rcpp Version 0.12.12
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__)
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  namespace {
68  unsigned long RNGScopeCounter = 0;
69  }
70 
71  // [[Rcpp::register]]
72  unsigned long enterRNGScope() {
73  if (RNGScopeCounter == 0) GetRNGstate();
74  RNGScopeCounter++;
75  return RNGScopeCounter;
76  }
77 
78  // [[Rcpp::register]]
79  unsigned long exitRNGScope() {
80  RNGScopeCounter--;
81  if (RNGScopeCounter == 0) PutRNGstate();
82  return RNGScopeCounter;
83  }
84 
85  // [[Rcpp::register]]
86  char* get_string_buffer() {
87  static char buffer[MAXELTSIZE];
88  return buffer;
89  }
90 
91  }
92 
93  // [[Rcpp::register]]
94  const char * type2name(SEXP x) { // #nocov start
95  switch (TYPEOF(x)) {
96  case NILSXP: return "NILSXP";
97  case SYMSXP: return "SYMSXP";
98  case RAWSXP: return "RAWSXP";
99  case LISTSXP: return "LISTSXP";
100  case CLOSXP: return "CLOSXP";
101  case ENVSXP: return "ENVSXP";
102  case PROMSXP: return "PROMSXP";
103  case LANGSXP: return "LANGSXP";
104  case SPECIALSXP: return "SPECIALSXP";
105  case BUILTINSXP: return "BUILTINSXP";
106  case CHARSXP: return "CHARSXP";
107  case LGLSXP: return "LGLSXP";
108  case INTSXP: return "INTSXP";
109  case REALSXP: return "REALSXP";
110  case CPLXSXP: return "CPLXSXP";
111  case STRSXP: return "STRSXP";
112  case DOTSXP: return "DOTSXP";
113  case ANYSXP: return "ANYSXP";
114  case VECSXP: return "VECSXP";
115  case EXPRSXP: return "EXPRSXP";
116  case BCODESXP: return "BCODESXP";
117  case EXTPTRSXP: return "EXTPTRSXP";
118  case WEAKREFSXP: return "WEAKREFSXP";
119  case S4SXP: return "S4SXP";
120  default:
121  return "<unknown>";
122  }
123  } // #nocov end
124 
125 
126 } // namespace Rcpp
127 
128 // [[Rcpp::register]]
129 std::string demangle(const std::string& name) {
130  #ifdef RCPP_HAS_DEMANGLING
131  std::string real_class;
132  int status =-1;
133  char *dem = 0;
134  dem = abi::__cxa_demangle(name.c_str(), 0, 0, &status);
135  if (status == 0) {
136  real_class = dem;
137  free(dem);
138  } else {
139  real_class = name;
140  }
141  return real_class;
142  #else
143  return name;
144  #endif
145 }
146 
147 // [[Rcpp::register]]
148 const char* short_file_name(const char* file) { // #nocov start
149  std::string f(file);
150  size_t index = f.find("/include/");
151  if (index != std::string::npos) {
152  f = f.substr(index + 9);
153  }
154  return f.c_str();
155 } // #nocov end
156 
157 // [[Rcpp::internal]]
158 SEXP as_character_externalptr(SEXP xp) { // #nocov start
159  char buffer[20];
160  snprintf(buffer, 20, "%p", (void*)EXTPTR_PTR(xp));
161  return Rcpp::wrap((const char*)buffer);
162 } // #nocov end
163 
164 // [[Rcpp::internal]]
166  Shield<SEXP> cap(Rf_allocVector(LGLSXP, 13));
167  Shield<SEXP> names(Rf_allocVector(STRSXP, 13));
168  #ifdef HAS_VARIADIC_TEMPLATES
169  LOGICAL(cap)[0] = TRUE;
170  #else
171  LOGICAL(cap)[0] = FALSE;
172  #endif
173  #ifdef HAS_CXX0X_INITIALIZER_LIST
174  LOGICAL(cap)[1] = TRUE;
175  #else
176  LOGICAL(cap)[1] = FALSE;
177  #endif
178  /* exceptions are always supported */
179  LOGICAL(cap)[2] = TRUE;
180 
181  #ifdef HAS_TR1_UNORDERED_MAP
182  LOGICAL(cap)[3] = TRUE;
183  #else
184  LOGICAL(cap)[3] = FALSE;
185  #endif
186 
187  #ifdef HAS_TR1_UNORDERED_SET
188  LOGICAL(cap)[4] = TRUE;
189  #else
190  LOGICAL(cap)[4] = FALSE;
191  #endif
192 
193  LOGICAL(cap)[5] = TRUE;
194 
195  #ifdef RCPP_HAS_DEMANGLING
196  LOGICAL(cap)[6] = TRUE;
197  #else
198  LOGICAL(cap)[6] = FALSE;
199  #endif
200 
201  LOGICAL(cap)[7] = FALSE;
202 
203  #ifdef RCPP_HAS_LONG_LONG_TYPES
204  LOGICAL(cap)[8] = TRUE;
205  #else
206  LOGICAL(cap)[8] = FALSE;
207  #endif
208 
209  #ifdef HAS_CXX0X_UNORDERED_MAP
210  LOGICAL(cap)[9] = TRUE;
211  #else
212  LOGICAL(cap)[9] = FALSE;
213  #endif
214 
215  #ifdef HAS_CXX0X_UNORDERED_SET
216  LOGICAL(cap)[10] = TRUE;
217  #else
218  LOGICAL(cap)[10] = FALSE;
219  #endif
220 
221  #ifdef RCPP_USING_CXX11
222  LOGICAL(cap)[11] = TRUE;
223  #else
224  LOGICAL(cap)[11] = FALSE;
225  #endif
226 
227  #ifdef RCPP_NEW_DATE_DATETIME_VECTORS
228  LOGICAL(cap)[12] = TRUE;
229  #else
230  LOGICAL(cap)[12] = FALSE;
231  #endif
232 
233 
234  SET_STRING_ELT(names, 0, Rf_mkChar("variadic templates"));
235  SET_STRING_ELT(names, 1, Rf_mkChar("initializer lists"));
236  SET_STRING_ELT(names, 2, Rf_mkChar("exception handling"));
237  SET_STRING_ELT(names, 3, Rf_mkChar("tr1 unordered maps"));
238  SET_STRING_ELT(names, 4, Rf_mkChar("tr1 unordered sets"));
239  SET_STRING_ELT(names, 5, Rf_mkChar("Rcpp modules"));
240  SET_STRING_ELT(names, 6, Rf_mkChar("demangling"));
241  SET_STRING_ELT(names, 7, Rf_mkChar("classic api"));
242  SET_STRING_ELT(names, 8, Rf_mkChar("long long"));
243  SET_STRING_ELT(names, 9, Rf_mkChar("C++0x unordered maps"));
244  SET_STRING_ELT(names, 10, Rf_mkChar("C++0x unordered sets"));
245  SET_STRING_ELT(names, 11, Rf_mkChar("Full C++11 support"));
246  SET_STRING_ELT(names, 12, Rf_mkChar("new date(time) vectors"));
247  Rf_setAttrib(cap, R_NamesSymbol, names);
248  return cap;
249 }
250 
251 
252 // [[Rcpp::internal]]
253 SEXP rcpp_can_use_cxx0x() { // #nocov start
254  #if defined(HAS_VARIADIC_TEMPLATES) || defined(RCPP_USING_CXX11)
255  return Rf_ScalarLogical(TRUE);
256  #else
257  return Rf_ScalarLogical(FALSE);
258  #endif
259 } // #nocov end
260 
261 
262 // [[Rcpp::internal]]
263 SEXP rcpp_can_use_cxx11() { // #nocov start
264  #if defined(RCPP_USING_CXX11)
265  return Rf_ScalarLogical(TRUE);
266  #else
267  return Rf_ScalarLogical(FALSE);
268  #endif
269 } // #nocov end
270 
271 
272 // [[Rcpp::register]]
273 SEXP stack_trace(const char* file, int line) {
274  #if defined(__GNUC__) || defined(__clang__)
275  #if defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX) || defined(__MUSL__) || defined(__HAIKU__)
276  // Simpler version for Windows and *BSD
277  List trace = List::create(_["file"] = file,
278  _[ "line" ] = line,
279  _[ "stack" ] = "C++ stack not available on this system");
280  trace.attr("class") = "Rcpp_stack_trace";
281  return trace;
282  #else // ! (defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX)
283 
284  /* inspired from http://tombarta.wordpress.com/2008/08/01/c-stack-traces-with-gcc/ */
285  const size_t max_depth = 100;
286  int stack_depth;
287  void *stack_addrs[max_depth];
288  char **stack_strings;
289 
290  stack_depth = backtrace(stack_addrs, max_depth);
291  stack_strings = backtrace_symbols(stack_addrs, stack_depth);
292 
293  std::string current_line;
294 
295  CharacterVector res(stack_depth - 1);
296  std::transform(stack_strings + 1, stack_strings + stack_depth, res.begin(), demangler_one);
297  free(stack_strings); // malloc()ed by backtrace_symbols
298 
299  List trace = List::create(_["file" ] = file,
300  _["line" ] = line,
301  _["stack"] = res);
302  trace.attr("class") = "Rcpp_stack_trace";
303  return trace;
304  #endif
305  #else /* !defined( __GNUC__ ) */
306  return R_NilValue;
307  #endif
308 }
309 
310 // // [ [ Rcpp::register ] ]
311 // void print(SEXP s) {
312 // Rf_PrintValue(s); // defined in Rinternals.h
313 // }
314 
315 // }}}
316 
AttributeProxy attr(const std::string &name)
SEXP as_character_externalptr(SEXP xp)
Definition: api.cpp:158
SEXP rcpp_capabilities()
Definition: api.cpp:165
static internal::NamedPlaceHolder _
Definition: Named.h:64
SEXP stack_trace(const char *file, int line)
Definition: api.cpp:273
const char * short_file_name(const char *file)
Definition: api.cpp:148
SEXP rcpp_can_use_cxx11()
Definition: api.cpp:263
std::string demangle(const std::string &name)
Definition: api.cpp:129
#define MAXELTSIZE
Definition: headers.h:25
SEXP rcpp_can_use_cxx0x()
Definition: api.cpp:253
attribute_hidden unsigned long exitRNGScope()
Definition: routines.h:83
attribute_hidden const char * type2name(SEXP x)
Definition: routines.h:70
static Vector create()
Definition: Vector.h:1117
SEXP wrap(const Date &date)
Definition: Date.h:38
attribute_hidden unsigned long enterRNGScope()
Definition: routines.h:77
attribute_hidden char * get_string_buffer()
Definition: routines.h:89
Rcpp API.
Definition: algo.h:28
iterator begin()
Definition: Vector.h:332