annotate R/rdc/src/api.c @ 54:918dab7a6606

- added callback support (comes with some bigger refactoring) - allow CPython's Py{CObject,Capsule} to be used as 'p'ointers
author Tassilo Philipp
date Tue, 02 Feb 2021 20:42:02 +0100
parents 0cfcc391201f
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
1 #include <R.h>
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
2 #define USE_RINTERNALS
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
3 #include <Rinternals.h>
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
4 #include <R_ext/Rdynload.h>
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
5 #include "dynload.h"
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
6 #include "dyncall.h"
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
7 #include "dyncall_signature.h"
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
8
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
9
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
10 /* rdcLoad */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
11
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
12 SEXP rdcLoad(SEXP sLibPath)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
13 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
14 void* libHandle;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
15 const char* libPath;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
16 SEXP r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
17 libPath = CHAR(STRING_ELT(sLibPath,0));
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
18
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
19 libHandle = dlLoadLibrary(libPath);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
20
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
21 if (!libHandle) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
22 error("rdcLoad failed on path %s", libPath );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
23 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
24
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
25 r = R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
26
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
27 PROTECT( r = R_MakeExternalPtr(libHandle, R_NilValue, R_NilValue) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
28 UNPROTECT(1);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
29
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
30 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
31 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
32
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
33 /* rdcFree */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
34
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
35 SEXP rdcFree(SEXP sLibHandle)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
36 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
37 void* libHandle;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
38
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
39 libHandle = R_ExternalPtrAddr(sLibHandle);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
40 dlFreeLibrary( libHandle );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
41
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
42 R_SetExternalPtrAddr(sLibHandle, 0);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
43 return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
44 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
45
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
46 /* rdcFind */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
47
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
48 SEXP rdcFind(SEXP sLibHandle, SEXP sSymbol)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
49 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
50 void* libHandle;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
51 const char* symbol;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
52 void* addr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
53 SEXP r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
54 libHandle = R_ExternalPtrAddr(sLibHandle);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
55 symbol = CHAR(STRING_ELT(sSymbol,0) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
56 addr = dlFindSymbol( libHandle, symbol );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
57
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
58 r = R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
59
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
60 PROTECT( r = R_MakeExternalPtr(addr, R_NilValue, R_NilValue) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
61 UNPROTECT(1);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
62
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
63 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
64 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
65
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
66 SEXP r_dcCall(SEXP sCallVM, SEXP sFuncPtr, SEXP sSignature, SEXP sArgs)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
67 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
68 DCCallVM* pvm;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
69 void* funcPtr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
70 const char* signature;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
71 const char* ptr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
72 int i,l,protect_count;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
73 SEXP r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
74
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
75 pvm = R_ExternalPtrAddr(sCallVM);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
76 if (!pvm) error("callvm is null");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
77
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
78 funcPtr = R_ExternalPtrAddr(sFuncPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
79 if (!funcPtr) error("funcptr is null");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
80
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
81 signature = CHAR(STRING_ELT(sSignature,0) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
82 if (!signature) error("signature is null");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
83
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
84 dcReset(pvm);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
85 ptr = signature;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
86
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
87 l = LENGTH(sArgs);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
88 i = 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
89 protect_count = 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
90 for(;;) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
91 char ch = *ptr++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
92 SEXP arg;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
93
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
94 if (ch == '\0') error("invalid signature - no return type specified");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
95
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
96 if (ch == ')') break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
97
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
98 if (i >= l) error("not enough arguments for given signature (arg length = %d %d %c)", l,i,ch );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
99
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
100 arg = VECTOR_ELT(sArgs,i);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
101 switch(ch) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
102 case DC_SIGCHAR_BOOL:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
103 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
104 DCbool value;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
105 if ( isLogical(arg) )
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
106 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
107 value = ( LOGICAL(arg)[0] == 0 ) ? DC_FALSE : DC_TRUE;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
108 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
109 else
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
110 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
111 value = LOGICAL( coerceVector(arg, LGLSXP) )[0] ? DC_FALSE : DC_TRUE;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
112 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
113 dcArgBool(pvm, value );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
114 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
115 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
116 case DC_SIGCHAR_INT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
117 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
118 int value;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
119 if ( isInteger(arg) )
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
120 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
121 value = INTEGER(arg)[0];
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
122 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
123 else
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
124 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
125 value = INTEGER( coerceVector(arg, INTSXP) )[0];
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
126 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
127 dcArgInt(pvm, value);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
128 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
129 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
130 case DC_SIGCHAR_FLOAT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
131 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
132 dcArgFloat( pvm, (float) REAL( coerceVector(arg, REALSXP) )[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
133 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
134 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
135 case DC_SIGCHAR_DOUBLE:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
136 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
137 double value;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
138 if ( isReal(arg) )
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
139 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
140 value = REAL(arg)[0];
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
141 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
142 else
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
143 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
144 value = REAL( coerceVector(arg,REALSXP) )[0];
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
145 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
146 dcArgDouble( pvm, value );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
147 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
148 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
149 /*
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
150 case DC_SIGCHAR_LONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
151 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
152 PROTECT(arg = coerceVector(arg, REALSXP) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
153 dcArgLong( pvm, (DClong) ( REAL(arg)[0] ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
154 UNPROTECT(1);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
155 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
156 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
157 */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
158 case DC_SIGCHAR_STRING:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
159 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
160 DCpointer ptr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
161 if (arg == R_NilValue) ptr = (DCpointer) 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
162 else if (isString(arg)) ptr = (DCpointer) CHAR( STRING_ELT(arg,0) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
163 else {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
164 if (protect_count) UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
165 error("invalid value for C string argument"); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
166 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
167 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
168 case DC_SIGCHAR_POINTER:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
169 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
170 DCpointer ptr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
171 if ( arg == R_NilValue ) ptr = (DCpointer) 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
172 else if (isString(arg) ) ptr = (DCpointer) CHAR( STRING_ELT(arg,0) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
173 else if (isReal(arg) ) ptr = (DCpointer) REAL(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
174 else if (isInteger(arg) ) ptr = (DCpointer) INTEGER(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
175 else if (isLogical(arg) ) ptr = (DCpointer) LOGICAL(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
176 else if (TYPEOF(arg) == EXTPTRSXP) ptr = R_ExternalPtrAddr(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
177 else {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
178 if (protect_count) UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
179 error("invalid signature"); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
180 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
181 dcArgPointer(pvm, ptr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
182 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
183 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
184 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
185 ++i;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
186 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
187
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
188 if ( i != l )
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
189 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
190 if (protect_count)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
191 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
192 error ("signature claims to have %d arguments while %d arguments are given", i, l);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
193 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
194
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
195 switch(*ptr) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
196 case DC_SIGCHAR_BOOL:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
197 PROTECT( r = allocVector(LGLSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
198 LOGICAL(r)[0] = ( dcCallBool(pvm, funcPtr) == DC_FALSE ) ? FALSE : TRUE;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
199 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
200 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
201 case DC_SIGCHAR_CHAR:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
202 PROTECT( r = allocVector(INTSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
203 INTEGER(r)[0] = dcCallChar(pvm, funcPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
204 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
205 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
206 case DC_SIGCHAR_SHORT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
207 PROTECT( r = allocVector(INTSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
208 INTEGER(r)[0] = dcCallShort(pvm, funcPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
209 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
210 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
211 case DC_SIGCHAR_LONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
212 PROTECT( r = allocVector(INTSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
213 INTEGER(r)[0] = dcCallLong(pvm, funcPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
214 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
215 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
216 case DC_SIGCHAR_INT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
217 PROTECT( r = allocVector(INTSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
218 INTEGER(r)[0] = dcCallInt(pvm, funcPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
219 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
220 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
221 case DC_SIGCHAR_LONGLONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
222 PROTECT( r = allocVector(REALSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
223 REAL(r)[0] = (double) ( dcCallLong(pvm, funcPtr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
224 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
225 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
226 case DC_SIGCHAR_FLOAT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
227 PROTECT( r = allocVector(REALSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
228 REAL(r)[0] = (double) ( dcCallFloat(pvm, funcPtr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
229 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
230 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
231 case DC_SIGCHAR_DOUBLE:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
232 PROTECT( r = allocVector(REALSXP, 1) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
233 protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
234 REAL(r)[0] = dcCallDouble(pvm, funcPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
235 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
236 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
237 case DC_SIGCHAR_POINTER:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
238 PROTECT( r = R_MakeExternalPtr( dcCallPointer(pvm,funcPtr), R_NilValue, R_NilValue ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
239 protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
240 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
241 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
242 case DC_SIGCHAR_VOID:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
243 dcCallVoid(pvm,funcPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
244 if (protect_count) UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
245 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
246 default:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
247 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
248 if (protect_count)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
249 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
250 error("invalid return type signature");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
251 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
252 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
253 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
254 return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
255
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
256 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
257
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
258 /* rdcCall */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
259
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
260 DCCallVM* gCall;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
261
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
262 SEXP rdcCall(SEXP sFuncPtr, SEXP sSignature, SEXP sArgs)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
263 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
264 void* funcPtr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
265 const char* signature;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
266 const char* ptr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
267 int i,l,protect_count;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
268 SEXP r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
269
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
270 funcPtr = R_ExternalPtrAddr(sFuncPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
271
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
272 if (!funcPtr) error("funcptr is null");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
273
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
274 signature = CHAR(STRING_ELT(sSignature,0) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
275
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
276 if (!signature) error("signature is null");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
277
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
278 dcReset(gCall);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
279 ptr = signature;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
280
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
281 l = LENGTH(sArgs);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
282 i = 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
283 protect_count = 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
284 for(;;) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
285 char ch = *ptr++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
286 SEXP arg;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
287
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
288 if (ch == '\0') error("invalid signature - no return type specified");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
289
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
290 if (ch == ')') break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
291
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
292 if (i >= l) error("not enough arguments for given signature (arg length = %d %d %c)", l,i,ch );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
293
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
294 arg = VECTOR_ELT(sArgs,i);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
295 switch(ch) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
296 case DC_SIGCHAR_BOOL:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
297 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
298 if ( !isLogical(arg) )
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
299 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
300 PROTECT(arg = coerceVector(arg, LGLSXP));
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
301 protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
302 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
303 dcArgBool(gCall, ( LOGICAL(arg)[0] == 0 ) ? DC_FALSE : DC_TRUE );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
304 // UNPROTECT(1);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
305 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
306 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
307 case DC_SIGCHAR_INT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
308 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
309 if ( !isInteger(arg) )
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
310 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
311 PROTECT(arg = coerceVector(arg, INTSXP));
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
312 protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
313 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
314 dcArgInt(gCall, INTEGER(arg)[0]);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
315 // UNPROTECT(1);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
316 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
317 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
318 case DC_SIGCHAR_FLOAT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
319 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
320 PROTECT(arg = coerceVector(arg, REALSXP) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
321 dcArgFloat( gCall, REAL(arg)[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
322 UNPROTECT(1);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
323 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
324 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
325 case DC_SIGCHAR_DOUBLE:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
326 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
327 if ( !isReal(arg) )
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
328 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
329 PROTECT(arg = coerceVector(arg, REALSXP) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
330 protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
331 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
332 dcArgDouble( gCall, REAL(arg)[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
333 // UNPROTECT(1);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
334 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
335 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
336 /*
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
337 case DC_SIGCHAR_LONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
338 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
339 PROTECT(arg = coerceVector(arg, REALSXP) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
340 dcArgLong( gCall, (DClong) ( REAL(arg)[0] ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
341 UNPROTECT(1);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
342 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
343 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
344 */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
345 case DC_SIGCHAR_STRING:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
346 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
347 DCpointer ptr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
348 if (arg == R_NilValue) ptr = (DCpointer) 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
349 else if (isString(arg)) ptr = (DCpointer) CHAR( STRING_ELT(arg,0) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
350 else {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
351 if (protect_count) UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
352 error("invalid value for C string argument"); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
353 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
354 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
355 case DC_SIGCHAR_POINTER:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
356 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
357 DCpointer ptr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
358 if ( arg == R_NilValue ) ptr = (DCpointer) 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
359 else if (isString(arg) ) ptr = (DCpointer) CHAR( STRING_ELT(arg,0) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
360 else if (isReal(arg) ) ptr = (DCpointer) REAL(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
361 else if (isInteger(arg) ) ptr = (DCpointer) INTEGER(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
362 else if (isLogical(arg) ) ptr = (DCpointer) LOGICAL(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
363 else if (TYPEOF(arg) == EXTPTRSXP) ptr = R_ExternalPtrAddr(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
364 else {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
365 if (protect_count) UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
366 error("invalid signature"); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
367 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
368 dcArgPointer(gCall, ptr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
369 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
370 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
371 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
372 ++i;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
373 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
374
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
375 if ( i != l )
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
376 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
377 if (protect_count)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
378 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
379 error ("signature claims to have %d arguments while %d arguments are given", i, l);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
380 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
381
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
382 switch(*ptr) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
383 case DC_SIGCHAR_BOOL:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
384 PROTECT( r = allocVector(LGLSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
385 LOGICAL(r)[0] = ( dcCallBool(gCall, funcPtr) == DC_FALSE ) ? FALSE : TRUE;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
386 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
387 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
388 case DC_SIGCHAR_INT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
389 PROTECT( r = allocVector(INTSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
390 INTEGER(r)[0] = dcCallInt(gCall, funcPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
391 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
392 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
393 case DC_SIGCHAR_LONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
394 PROTECT( r = allocVector(REALSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
395 REAL(r)[0] = (double) ( dcCallLong(gCall, funcPtr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
396 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
397 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
398 case DC_SIGCHAR_FLOAT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
399 PROTECT( r = allocVector(REALSXP, 1) ); protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
400 REAL(r)[0] = (double) ( dcCallFloat(gCall, funcPtr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
401 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
402 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
403 case DC_SIGCHAR_DOUBLE:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
404 PROTECT( r = allocVector(REALSXP, 1) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
405 protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
406 REAL(r)[0] = dcCallDouble(gCall, funcPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
407 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
408 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
409 case DC_SIGCHAR_POINTER:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
410 PROTECT( r = R_MakeExternalPtr( dcCallPointer(gCall,funcPtr), R_NilValue, R_NilValue ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
411 protect_count++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
412 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
413 return r;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
414 case DC_SIGCHAR_VOID:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
415 dcCallVoid(gCall,funcPtr);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
416 if (protect_count) UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
417 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
418 default:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
419 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
420 if (protect_count)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
421 UNPROTECT(protect_count);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
422 error("invalid return type signature");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
423 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
424 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
425 return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
426 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
427
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
428 SEXP rdcUnpack1(SEXP ptr_x, SEXP offset, SEXP sig_x)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
429 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
430 char* ptr = ( (char*) R_ExternalPtrAddr(ptr_x) ) + INTEGER(offset)[0];
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
431 const char* sig = CHAR(STRING_ELT(sig_x,0) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
432 switch(sig[0])
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
433 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
434 case DC_SIGCHAR_CHAR: return ScalarInteger( ( (unsigned char*)ptr)[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
435 case DC_SIGCHAR_INT: return ScalarInteger( ( (int*)ptr )[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
436 case DC_SIGCHAR_FLOAT: return ScalarReal( (double) ( (float*) ptr )[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
437 case DC_SIGCHAR_DOUBLE: return ScalarReal( ((double*)ptr)[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
438 default: error("invalid signature");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
439 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
440 return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
441 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
442
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
443 SEXP rdcDataPtr(SEXP x, SEXP offset)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
444 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
445 void* ptr = ( ( (unsigned char*) DATAPTR(x) ) + INTEGER(offset)[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
446 return R_MakeExternalPtr( ptr, R_NilValue, R_NilValue );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
447 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
448
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
449 SEXP rdcMode(SEXP id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
450 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
451 dcMode( gCall, INTEGER(id)[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
452 dcReset( gCall );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
453 return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
454 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
455
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
456 SEXP r_dcNewCallVM(SEXP size)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
457 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
458 return R_MakeExternalPtr( dcNewCallVM( INTEGER(size)[0] ), R_NilValue, R_NilValue );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
459 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
460
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
461 SEXP r_dcFree(SEXP callvm)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
462 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
463 DCCallVM* pvm = R_ExternalPtrAddr(callvm);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
464 dcFree(pvm);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
465 return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
466 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
467
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
468 SEXP r_dcMode(SEXP callvm, SEXP id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
469 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
470 DCCallVM* pvm = R_ExternalPtrAddr(callvm);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
471 dcMode( pvm, INTEGER(id)[0] );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
472 dcReset( pvm );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
473 return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
474 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
475
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
476 /* register R to C calls */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
477
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
478 R_CallMethodDef callMethods[] =
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
479 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
480 {"rdcLoad", (DL_FUNC) &rdcLoad, 1},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
481 {"rdcFree", (DL_FUNC) &rdcFree, 1},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
482 {"rdcFind", (DL_FUNC) &rdcFind, 2},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
483 {"rdcCall", (DL_FUNC) &rdcCall, 3},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
484 {"rdcUnpack1", (DL_FUNC) &rdcUnpack1, 3},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
485 {"rdcDataPtr", (DL_FUNC) &rdcDataPtr, 2},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
486 {"rdcMode", (DL_FUNC) &rdcMode, 1},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
487
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
488 {"dcNewCallVM", (DL_FUNC) &r_dcNewCallVM, 1},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
489 {"dcFree", (DL_FUNC) &r_dcFree, 1},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
490 {"dcCall", (DL_FUNC) &r_dcCall, 4},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
491 {"dcMode", (DL_FUNC) &r_dcMode, 2},
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
492
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
493 {NULL, NULL, 0}
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
494 };
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
495
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
496 void R_init_rdc(DllInfo *info)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
497 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
498 R_registerRoutines(info, NULL, callMethods, NULL, NULL);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
499 gCall = dcNewCallVM(4096);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
500 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
501
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
502 void R_unload_rdc(DllInfo *info)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
503 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
504 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
505