← Back to branch summary

~ubuntu-branches/debian/sid/simpleitk/sid

« back to all changes in this revision

Viewing changes to Wrapping/R/rrun.swg

  • Committer: Package Import Robot
  • Author(s): Ghislain Antony Vaillant
  • Date: 2017-11-02 08:49:18 UTC
  • Revision ID: package-import@ubuntu.com-20171102084918-7hs09ih668xq87ej
Tags: upstream-1.0.1
Import upstream version 1.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
Wrapping/R/rrun.swg
 
1
 
 
2
/* Remove global namespace pollution */
 
3
#if !defined(SWIG_NO_R_NO_REMAP)
 
4
# define R_NO_REMAP
 
5
#endif
 
6
#if !defined(SWIG_NO_STRICT_R_HEADERS)
 
7
# define STRICT_R_HEADERS
 
8
#endif
 
9
 
 
10
#include <Rdefines.h>
 
11
#include <Rversion.h>
 
12
 
 
13
#ifdef __cplusplus
 
14
#include <exception>
 
15
extern "C" {
 
16
#endif
 
17
 
 
18
/* for raw pointer */
 
19
#define SWIG_ConvertPtr(obj, pptr, type, flags)         SWIG_R_ConvertPtr(obj, pptr, type, flags)
 
20
#define SWIG_ConvertPtrAndOwn(obj,pptr,type,flags,own)  SWIG_R_ConvertPtr(obj, pptr, type, flags)
 
21
#define SWIG_NewPointerObj(ptr, type, flags)            SWIG_R_NewPointerObj(ptr, type, flags)
 
22
 
 
23
#include <stdlib.h>
 
24
#include <assert.h>
 
25
 
 
26
#if R_VERSION >= R_Version(2,6,0)
 
27
#define VMAXTYPE void *
 
28
#else
 
29
#define VMAXTYPE char *
 
30
#endif
 
31
 
 
32
/*
 
33
  This is mainly a way to avoid having lots of local variables that may
 
34
  conflict with those in the routine.
 
35
 
 
36
   Change name to R_SWIG_Callb....
 
37
*/
 
38
typedef struct RCallbackFunctionData {
 
39
 
 
40
  SEXP fun;
 
41
  SEXP userData;
 
42
 
 
43
 
 
44
  SEXP expr;
 
45
  SEXP retValue;
 
46
  int errorOccurred;
 
47
 
 
48
  SEXP el;  /* Temporary pointer used in the construction of the expression to call the R function. */
 
49
 
 
50
  struct RCallbackFunctionData *previous;   /* Stack */
 
51
 
 
52
} RCallbackFunctionData;
 
53
 
 
54
static RCallbackFunctionData  *callbackFunctionDataStack;
 
55
 
 
56
 
 
57
SWIGRUNTIME SEXP
 
58
R_SWIG_debug_getCallbackFunctionData()
 
59
{
 
60
  int n, i;
 
61
  SEXP ans;
 
62
  RCallbackFunctionData  *p = callbackFunctionDataStack;
 
63
 
 
64
  n = 0;
 
65
  while(p) {
 
66
    n++;
 
67
    p = p->previous;
 
68
  }
 
69
 
 
70
  Rf_protect(ans = Rf_allocVector(VECSXP, n));
 
71
  for(p = callbackFunctionDataStack, i = 0; i < n; p = p->previous, i++)
 
72
      SET_VECTOR_ELT(ans, i, p->fun);
 
73
 
 
74
  Rf_unprotect(1);
 
75
 
 
76
  return(ans);
 
77
}
 
78
 
 
79
 
 
80
 
 
81
SWIGRUNTIME RCallbackFunctionData *
 
82
R_SWIG_pushCallbackFunctionData(SEXP fun, SEXP userData)
 
83
{
 
84
   RCallbackFunctionData *el;
 
85
   el = (RCallbackFunctionData *) calloc(1, sizeof(RCallbackFunctionData));
 
86
   el->fun = fun;
 
87
   el->userData = userData;
 
88
   el->previous = callbackFunctionDataStack;
 
89
 
 
90
   callbackFunctionDataStack = el;
 
91
 
 
92
   return(el);
 
93
}
 
94
 
 
95
 
 
96
SWIGRUNTIME SEXP
 
97
R_SWIG_R_pushCallbackFunctionData(SEXP fun, SEXP userData)
 
98
{
 
99
    R_SWIG_pushCallbackFunctionData(fun, userData);
 
100
    return R_NilValue;
 
101
}
 
102
 
 
103
SWIGRUNTIME RCallbackFunctionData *
 
104
R_SWIG_getCallbackFunctionData()
 
105
{
 
106
  if(!callbackFunctionDataStack) {
 
107
    Rf_error("Supposedly impossible error occurred in the SWIG callback mechanism."
 
108
            "  No callback function data set.");
 
109
  }
 
110
 
 
111
  return callbackFunctionDataStack;
 
112
}
 
113
 
 
114
SWIGRUNTIME void
 
115
R_SWIG_popCallbackFunctionData(int doFree)
 
116
{
 
117
  RCallbackFunctionData  *el = NULL;
 
118
  if(!callbackFunctionDataStack)
 
119
    return ; /* Error !!! */
 
120
 
 
121
  el = callbackFunctionDataStack ;
 
122
  callbackFunctionDataStack = callbackFunctionDataStack->previous;
 
123
 
 
124
  if(doFree)
 
125
     free(el);
 
126
}
 
127
 
 
128
 
 
129
/*
 
130
  Interface to S function
 
131
      is(obj, type)
 
132
  which is to be used to determine if an
 
133
  external pointer inherits from the right class.
 
134
 
 
135
  Ideally, we would like to be able to do this without an explicit call to the is() function.
 
136
  When the S4 class system uses its own SEXP types, then we will hopefully be able to do this
 
137
  in the C code.
 
138
 
 
139
  Should we make the expression static and preserve it to avoid the overhead of
 
140
  allocating each time.
 
141
*/
 
142
SWIGRUNTIME int
 
143
R_SWIG_checkInherits(SEXP obj, SEXP tag, const char *type)
 
144
{
 
145
  SEXP e, val;
 
146
  int check_err = 0;
 
147
 
 
148
  Rf_protect(e = Rf_allocVector(LANGSXP, 3));
 
149
  SETCAR(e, Rf_install("extends"));
 
150
 
 
151
  SETCAR(CDR(e), Rf_mkString(CHAR(PRINTNAME(tag))));
 
152
  SETCAR(CDR(CDR(e)), Rf_mkString(type));
 
153
 
 
154
  val = R_tryEval(e, R_GlobalEnv, &check_err);
 
155
  Rf_unprotect(1);
 
156
  if(check_err)
 
157
    return(0);
 
158
 
 
159
 
 
160
  return(LOGICAL(val)[0]);
 
161
}
 
162
 
 
163
 
 
164
SWIGRUNTIME void *
 
165
R_SWIG_resolveExternalRef(SEXP arg, const char * const type, const char * const argName, Rboolean nullOk)
 
166
{
 
167
  void *ptr;
 
168
  SEXP orig = arg;
 
169
 
 
170
  if(TYPEOF(arg) != EXTPTRSXP)
 
171
    arg = GET_SLOT(arg, Rf_mkString("ref"));
 
172
 
 
173
 
 
174
  if(TYPEOF(arg) != EXTPTRSXP) {
 
175
    Rf_error("argument %s must be an external pointer (from an ExternalReference)", argName);
 
176
  }
 
177
 
 
178
 
 
179
  ptr = R_ExternalPtrAddr(arg);
 
180
 
 
181
  if(ptr == NULL && nullOk == (Rboolean) FALSE) {
 
182
    Rf_error("the external pointer (of type %s) for argument %s has value NULL", argName, type);
 
183
  }
 
184
 
 
185
  if(type[0] && R_ExternalPtrTag(arg) != Rf_install(type) && strcmp(type, "voidRef")
 
186
      && !R_SWIG_checkInherits(orig,  R_ExternalPtrTag(arg), type)) {
 
187
    Rf_error("the external pointer for argument %s has tag %s, not the expected value %s",
 
188
             argName, CHAR(PRINTNAME(R_ExternalPtrTag(arg))), type);
 
189
  }
 
190
 
 
191
 
 
192
  return(ptr);
 
193
}
 
194
 
 
195
SWIGRUNTIME void
 
196
R_SWIG_ReferenceFinalizer(SEXP el)
 
197
{
 
198
  void *ptr = R_SWIG_resolveExternalRef(el, "", "<finalizer>",  (Rboolean) 1);
 
199
  fprintf(stderr, "In R_SWIG_ReferenceFinalizer for %p\n", ptr);
 
200
  Rf_PrintValue(el);
 
201
 
 
202
  if(ptr) {
 
203
     if(TYPEOF(el) != EXTPTRSXP)
 
204
        el = GET_SLOT(el, Rf_mkString("ref"));
 
205
 
 
206
     if(TYPEOF(el) == EXTPTRSXP)
 
207
        R_ClearExternalPtr(el);
 
208
 
 
209
     free(ptr);
 
210
  }
 
211
 
 
212
  return;
 
213
}
 
214
 
 
215
typedef enum {R_SWIG_EXTERNAL, R_SWIG_OWNER } R_SWIG_Owner;
 
216
 
 
217
SWIGRUNTIME SEXP
 
218
SWIG_MakePtr(void *ptr, const char *typeName, R_SWIG_Owner owner)
 
219
{
 
220
  SEXP external, r_obj;
 
221
 
 
222
  Rf_protect(external = R_MakeExternalPtr(ptr, Rf_install(typeName), R_NilValue));
 
223
  Rf_protect(r_obj = NEW_OBJECT(MAKE_CLASS((char *) typeName)));
 
224
 
 
225
  if(owner)
 
226
    R_RegisterCFinalizer(external, R_SWIG_ReferenceFinalizer);
 
227
 
 
228
  r_obj = SET_SLOT(r_obj, Rf_mkString((char *) "ref"), external);
 
229
  SET_S4_OBJECT(r_obj);
 
230
  Rf_unprotect(2);
 
231
 
 
232
  return(r_obj);
 
233
}
 
234
 
 
235
 
 
236
SWIGRUNTIME SEXP
 
237
R_SWIG_create_SWIG_R_Array(const char *typeName, SEXP ref, int len)
 
238
{
 
239
   SEXP arr;
 
240
 
 
241
/*XXX remove the char * cast when we can. MAKE_CLASS should be declared appropriately. */
 
242
   Rf_protect(arr = NEW_OBJECT(MAKE_CLASS((char *) typeName)));
 
243
   Rf_protect(arr = R_do_slot_assign(arr, Rf_mkString("ref"), ref));
 
244
   Rf_protect(arr = R_do_slot_assign(arr, Rf_mkString("dims"), Rf_ScalarInteger(len)));
 
245
 
 
246
   Rf_unprotect(3);
 
247
   SET_S4_OBJECT(arr);
 
248
   return arr;
 
249
}
 
250
 
 
251
#define ADD_OUTPUT_ARG(result, pos, value, name)  r_ans = AddOutputArgToReturn(pos, value, name, OutputValues);
 
252
 
 
253
SWIGRUNTIME SEXP
 
254
AddOutputArgToReturn(int pos, SEXP value, const char *name, SEXP output)
 
255
{
 
256
  SET_VECTOR_ELT(output, pos, value);
 
257
 
 
258
  return(output);
 
259
}
 
260
 
 
261
/* Create a new pointer object */
 
262
SWIGRUNTIMEINLINE SEXP
 
263
SWIG_R_NewPointerObj(void *ptr, swig_type_info *type, int flags) {
 
264
  SEXP rptr = R_MakeExternalPtr(ptr,
 
265
  R_MakeExternalPtr(type, R_NilValue, R_NilValue), R_NilValue);
 
266
  SET_S4_OBJECT(rptr);
 
267
  return rptr;
 
268
}
 
269
 
 
270
 
 
271
/* Convert a pointer value */
 
272
SWIGRUNTIMEINLINE int
 
273
SWIG_R_ConvertPtr(SEXP obj, void **ptr, swig_type_info *ty, int flags) {
 
274
  void *vptr;
 
275
  if (!obj) return SWIG_ERROR;
 
276
  if (obj == R_NilValue) {
 
277
    if (ptr) *ptr = NULL;
 
278
    return SWIG_OK;
 
279
  }
 
280
 
 
281
  vptr = R_ExternalPtrAddr(obj);
 
282
  if (ty) {
 
283
    swig_type_info *to = (swig_type_info*)
 
284
      R_ExternalPtrAddr(R_ExternalPtrTag(obj));
 
285
    if (to == ty) {
 
286
      if (ptr) *ptr = vptr;
 
287
    } else {
 
288
      swig_cast_info *tc = SWIG_TypeCheck(to->name,ty);
 
289
      int newmemory = 0;
 
290
      if (ptr) *ptr = SWIG_TypeCast(tc,vptr,&newmemory);
 
291
      assert(!newmemory); /* newmemory handling not yet implemented */
 
292
    }
 
293
  } else {
 
294
      if (ptr) *ptr = vptr;
 
295
 }
 
296
  return SWIG_OK;
 
297
}
 
298
 
 
299
SWIGRUNTIME swig_module_info *
 
300
SWIG_GetModule(void *SWIGUNUSEDPARM(clientdata)) {
 
301
  static void *type_pointer = (void *)0;
 
302
  return (swig_module_info *) type_pointer;
 
303
}
 
304
 
 
305
SWIGRUNTIME void
 
306
SWIG_SetModule(void *v, swig_module_info *swig_module) {
 
307
}
 
308
 
 
309
typedef struct {
 
310
  void *pack;
 
311
  swig_type_info *ty;
 
312
  size_t size;
 
313
} RSwigPacked;
 
314
 
 
315
/* Create a new packed object */
 
316
 
 
317
SWIGRUNTIMEINLINE SEXP RSwigPacked_New(void *ptr, size_t sz,
 
318
                  swig_type_info *ty) {
 
319
  SEXP rptr;
 
320
  RSwigPacked *sobj =
 
321
  (RSwigPacked*) malloc(sizeof(RSwigPacked));
 
322
  if (sobj) {
 
323
    void *pack = malloc(sz);
 
324
    if (pack) {
 
325
      memcpy(pack, ptr, sz);
 
326
      sobj->pack = pack;
 
327
      sobj->ty   = ty;
 
328
      sobj->size = sz;
 
329
    } else {
 
330
      sobj = 0;
 
331
    }
 
332
  }
 
333
  rptr = R_MakeExternalPtr(sobj, R_NilValue, R_NilValue);
 
334
  return rptr;
 
335
}
 
336
 
 
337
SWIGRUNTIME swig_type_info *
 
338
RSwigPacked_UnpackData(SEXP obj, void *ptr, size_t size)
 
339
{
 
340
    RSwigPacked *sobj =
 
341
        (RSwigPacked *)R_ExternalPtrAddr(obj);
 
342
    if (sobj->size != size) return 0;
 
343
    memcpy(ptr, sobj->pack, size);
 
344
    return sobj->ty;
 
345
}
 
346
 
 
347
SWIGRUNTIMEINLINE SEXP
 
348
SWIG_R_NewPackedObj(void *ptr, size_t sz, swig_type_info *type) {
 
349
  return ptr ? RSwigPacked_New((void *) ptr, sz, type) : R_NilValue;
 
350
}
 
351
 
 
352
/* Convert a packed value value */
 
353
 
 
354
SWIGRUNTIME int
 
355
SWIG_R_ConvertPacked(SEXP obj, void *ptr, size_t sz, swig_type_info *ty) {
 
356
  swig_type_info *to = RSwigPacked_UnpackData(obj, ptr, sz);
 
357
  if (!to) return SWIG_ERROR;
 
358
  if (ty) {
 
359
    if (to != ty) {
 
360
      /* check type cast? */
 
361
      swig_cast_info *tc = SWIG_TypeCheck(to->name,ty);
 
362
      if (!tc) return SWIG_ERROR;
 
363
    }
 
364
  }
 
365
  return SWIG_OK;
 
366
}
 
367
 
 
368
#ifdef __cplusplus
 
369
#define SWIG_exception_noreturn(code, msg) do { throw std::runtime_error(msg); } while(0)
 
370
#else
 
371
#define SWIG_exception_noreturn(code, msg) do { return result; } while(0)
 
372
#endif
 
373
 
 
374
#ifdef __cplusplus
 
375
}
 
376
#endif