annotate R/rdyncall/src/rdyncall.c @ 3:f5d4d5c2f750

- gemspec fix
author cslag
date Thu, 31 Dec 2015 20:24:53 +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 /** ===========================================================================
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
2 ** R-Package: rdyncall
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
3 ** File: src/rdyncall.c
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
4 ** Description: R bindings to dyncall
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
5 **/
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
6
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
7 #include <Rinternals.h>
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
8 #include "dyncall.h"
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
9 #include "rdyncall_signature.h"
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
10 #include <string.h>
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
11 #include <ctype.h>
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
12
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
13 /** ---------------------------------------------------------------------------
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
14 ** C-Function: new_callvm
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
15 ** R-Interface: .Call
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
16 **/
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
17
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
18 SEXP r_new_callvm(SEXP mode_x, SEXP size_x)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
19 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
20 /* default call mode is "cdecl" */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
21 int size_i = INTEGER(size_x)[0];
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
22
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
23 const char* mode_S = CHAR( STRING_ELT( mode_x, 0 ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
24
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
25 int mode_i = DC_CALL_C_DEFAULT;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
26 if (strcmp(mode_S,"default") == 0 || strcmp(mode_S,"cdecl") == 0) mode_i = DC_CALL_C_DEFAULT;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
27 #if WIN32
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
28 else if (strcmp(mode_S,"stdcall") == 0) mode_i = DC_CALL_C_X86_WIN32_STD;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
29 else if (strcmp(mode_S,"thiscall") == 0) mode_i = DC_CALL_C_X86_WIN32_THIS_GNU;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
30 else if (strcmp(mode_S,"thiscall.gcc") == 0) mode_i = DC_CALL_C_X86_WIN32_THIS_GNU;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
31 else if (strcmp(mode_S,"thiscall.msvc") == 0) mode_i = DC_CALL_C_X86_WIN32_THIS_MS;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
32 else if (strcmp(mode_S,"fastcall") == 0) mode_i = DC_CALL_C_X86_WIN32_FAST_GNU;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
33 else if (strcmp(mode_S,"fastcall.msvc") == 0) mode_i = DC_CALL_C_X86_WIN32_FAST_MS;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
34 else if (strcmp(mode_S,"fastcall.gcc") == 0) mode_i = DC_CALL_C_X86_WIN32_FAST_GNU;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
35 #endif
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
36 /*
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
37 else { error("invalid 'callmode'"); return R_NilValue; }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
38 */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
39
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
40 DCCallVM* pvm = dcNewCallVM(size_i);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
41 dcMode( pvm, mode_i );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
42 return R_MakeExternalPtr( pvm, R_NilValue, R_NilValue );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
43 }
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 ** C-Function: free_callvm
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
47 ** R-Interface: .Call
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
48 **/
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
49
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
50 SEXP r_free_callvm(SEXP callvm_x)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
51 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
52 DCCallVM* callvm_p = (DCCallVM*) R_ExternalPtrAddr( callvm_x );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
53 dcFree( callvm_p );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
54 return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
55 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
56
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
57 /** ---------------------------------------------------------------------------
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
58 ** C-Function: r_dyncall
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
59 ** R-Interface: .External
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
60 **/
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
61
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
62 SEXP r_dyncall(SEXP args) /* callvm, address, signature, args ... */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
63 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
64 DCCallVM* pvm;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
65 void* addr;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
66 const char* signature;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
67 const char* sig;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
68 SEXP arg;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
69 int ptrcnt;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
70 int argpos;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
71
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
72 args = CDR(args);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
73
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
74 /* extract CallVM reference, address and signature */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
75
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
76 pvm = (DCCallVM*) R_ExternalPtrAddr( CAR(args) ); args = CDR(args);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
77
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
78 switch(TYPEOF(CAR(args))) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
79 case EXTPTRSXP:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
80 addr = R_ExternalPtrAddr( CAR(args) ); args = CDR(args);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
81 if (!addr) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
82 error("Target address is null-pointer.");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
83 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
84 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
85 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
86 default:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
87 error("Target address must be external pointer.");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
88 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
89 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
90 signature = CHAR( STRING_ELT( CAR(args), 0 ) ); args = CDR(args);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
91 sig = signature;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
92
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
93 if (!pvm) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
94 error("Argument 'callvm' is null");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
95 /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
96 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
97 if (!addr) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
98 error("Argument 'addr' is null");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
99 /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
100 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
101 /* reset CallVM to initial state */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
102
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
103 dcReset(pvm);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
104 ptrcnt = 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
105 argpos = 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
106
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
107 /* function calling convention prefix '_' */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
108 if (*sig == DC_SIGCHAR_CC_PREFIX) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
109 /* specify calling convention by signature prefix hint */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
110 ++sig;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
111 char ch = *sig++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
112 int mode = DC_CALL_C_DEFAULT;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
113 switch(ch)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
114 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
115 case DC_SIGCHAR_CC_STDCALL:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
116 mode = DC_CALL_C_X86_WIN32_STD; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
117 case DC_SIGCHAR_CC_FASTCALL_GNU:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
118 mode = DC_CALL_C_X86_WIN32_FAST_GNU; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
119 case DC_SIGCHAR_CC_FASTCALL_MS:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
120 mode = DC_CALL_C_X86_WIN32_FAST_MS; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
121 default:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
122 error("Unknown calling convention prefix hint signature character '%c'", ch );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
123 /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
124 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
125 dcMode(pvm, mode);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
126 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
127
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
128 /* load arguments */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
129 for(;;) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
130
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
131 char ch = *sig++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
132
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
133 if (ch == '\0') {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
134 error("Function-call signature '%s' is invalid - missing argument terminator character ')' and return type signature.", signature);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
135 /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
136 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
137 /* argument terminator */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
138 if (ch == ')') break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
139
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
140 /* end of arguments? */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
141 if (args == R_NilValue) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
142 error("Not enough arguments for function-call signature '%s'.", signature);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
143 /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
144 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
145 /* pointer counter */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
146 else if (ch == '*') { ptrcnt++; continue; }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
147
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
148 /* unpack next argument */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
149 arg = CAR(args); args = CDR(args);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
150 argpos++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
151
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
152 int type_id = TYPEOF(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
153
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
154 if (ptrcnt == 0) { /* base types */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
155
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
156 /* 'x' signature for passing language objects 'as-is' */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
157 if (ch == DC_SIGCHAR_SEXP) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
158 dcArgPointer(pvm, (void*)arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
159 continue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
160 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
161
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
162 if ( type_id != NILSXP && type_id != EXTPTRSXP && LENGTH(arg) == 0 ) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
163 error("Argument type mismatch at position %d: expected length greater zero.", argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
164 /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
165 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
166 switch(ch) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
167 case DC_SIGCHAR_BOOL:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
168 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
169 DCbool boolValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
170 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
171 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
172 case LGLSXP: boolValue = ( LOGICAL(arg)[0] == 0 ) ? DC_FALSE : DC_TRUE; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
173 case INTSXP: boolValue = ( INTEGER(arg)[0] == 0 ) ? DC_FALSE : DC_TRUE; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
174 case REALSXP: boolValue = ( REAL(arg)[0] == 0.0 ) ? DC_FALSE : DC_TRUE; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
175 case RAWSXP: boolValue = ( RAW(arg)[0] == 0 ) ? DC_FALSE : DC_TRUE; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
176 default: error("Argument type mismatch at position %d: expected C bool convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
177 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
178 dcArgBool(pvm, boolValue );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
179 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
180 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
181 case DC_SIGCHAR_CHAR:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
182 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
183 char charValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
184 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
185 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
186 case LGLSXP: charValue = (char) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
187 case INTSXP: charValue = (char) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
188 case REALSXP: charValue = (char) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
189 case RAWSXP: charValue = (char) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
190 default: error("Argument type mismatch at position %d: expected C char convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
191 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
192 dcArgChar(pvm, charValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
193 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
194 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
195 case DC_SIGCHAR_UCHAR:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
196 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
197 unsigned char charValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
198 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
199 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
200 case LGLSXP: charValue = (unsigned char) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
201 case INTSXP: charValue = (unsigned char) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
202 case REALSXP: charValue = (unsigned char) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
203 case RAWSXP: charValue = (unsigned char) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
204 default: error("Argument type mismatch at position %d: expected C unsigned char convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
205 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
206 dcArgChar(pvm, *( (char*) &charValue ));
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
207 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
208 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
209 case DC_SIGCHAR_SHORT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
210 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
211 short shortValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
212 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
213 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
214 case LGLSXP: shortValue = (short) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
215 case INTSXP: shortValue = (short) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
216 case REALSXP: shortValue = (short) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
217 case RAWSXP: shortValue = (short) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
218 default: error("Argument type mismatch at position %d: expected C short convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
219 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
220 dcArgShort(pvm, shortValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
221 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
222 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
223 case DC_SIGCHAR_USHORT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
224 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
225 unsigned short shortValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
226 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
227 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
228 case LGLSXP: shortValue = (unsigned short) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
229 case INTSXP: shortValue = (unsigned short) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
230 case REALSXP: shortValue = (unsigned short) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
231 case RAWSXP: shortValue = (unsigned short) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
232 default: error("Argument type mismatch at position %d: expected C unsigned short convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
233 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
234 dcArgShort(pvm, *( (short*) &shortValue ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
235 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
236 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
237 case DC_SIGCHAR_LONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
238 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
239 long longValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
240 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
241 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
242 case LGLSXP: longValue = (long) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
243 case INTSXP: longValue = (long) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
244 case REALSXP: longValue = (long) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
245 case RAWSXP: longValue = (long) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
246 default: error("Argument type mismatch at position %d: expected C long convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
247 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
248 dcArgLong(pvm, longValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
249 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
250 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
251 case DC_SIGCHAR_ULONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
252 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
253 unsigned long ulongValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
254 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
255 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
256 case LGLSXP: ulongValue = (unsigned long) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
257 case INTSXP: ulongValue = (unsigned long) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
258 case REALSXP: ulongValue = (unsigned long) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
259 case RAWSXP: ulongValue = (unsigned long) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
260 default: error("Argument type mismatch at position %d: expected C unsigned long convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
261 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
262 dcArgLong(pvm, (unsigned long) ulongValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
263 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
264 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
265 case DC_SIGCHAR_INT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
266 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
267 int intValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
268 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
269 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
270 case LGLSXP: intValue = (int) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
271 case INTSXP: intValue = INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
272 case REALSXP: intValue = (int) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
273 case RAWSXP: intValue = (int) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
274 default: error("Argument type mismatch at position %d: expected C int convertable value", argpos); /*dummy*/ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
275 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
276 dcArgInt(pvm, intValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
277 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
278 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
279 case DC_SIGCHAR_UINT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
280 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
281 unsigned int intValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
282 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
283 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
284 case LGLSXP: intValue = (unsigned int) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
285 case INTSXP: intValue = (unsigned int) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
286 case REALSXP: intValue = (unsigned int) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
287 case RAWSXP: intValue = (unsigned int) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
288 default: error("Argument type mismatch at position %d: expected C unsigned int convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
289 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
290 dcArgInt(pvm, * (int*) &intValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
291 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
292 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
293 case DC_SIGCHAR_FLOAT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
294 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
295 float floatValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
296 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
297 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
298 case LGLSXP: floatValue = (float) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
299 case INTSXP: floatValue = (float) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
300 case REALSXP: floatValue = (float) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
301 case RAWSXP: floatValue = (float) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
302 default: error("Argument type mismatch at position %d: expected C float convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
303 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
304 dcArgFloat( pvm, floatValue );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
305 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
306 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
307 case DC_SIGCHAR_DOUBLE:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
308 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
309 DCdouble doubleValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
310 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
311 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
312 case LGLSXP: doubleValue = (double) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
313 case INTSXP: doubleValue = (double) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
314 case REALSXP: doubleValue = REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
315 case RAWSXP: doubleValue = (double) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
316 default: error("Argument type mismatch at position %d: expected C double convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
317 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
318 dcArgDouble( pvm, doubleValue );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
319 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
320 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
321 case DC_SIGCHAR_LONGLONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
322 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
323 DClonglong longlongValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
324 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
325 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
326 case LGLSXP: longlongValue = (DClonglong) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
327 case INTSXP: longlongValue = (DClonglong) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
328 case REALSXP: longlongValue = (DClonglong) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
329 case RAWSXP: longlongValue = (DClonglong) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
330 default: error("Argument type mismatch at position %d: expected C long long (int64_t) convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
331 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
332 dcArgLongLong( pvm, longlongValue );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
333 }
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 case DC_SIGCHAR_ULONGLONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
336 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
337 DCulonglong ulonglongValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
338 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
339 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
340 case LGLSXP: ulonglongValue = (DCulonglong) LOGICAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
341 case INTSXP: ulonglongValue = (DCulonglong) INTEGER(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
342 case REALSXP: ulonglongValue = (DCulonglong) REAL(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
343 case RAWSXP: ulonglongValue = (DCulonglong) RAW(arg)[0]; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
344 default: error("Argument type mismatch at position %d: expected C unsigned long long (uint64_t) convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
345 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
346 dcArgLongLong( pvm, *( (DClonglong*)&ulonglongValue ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
347 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
348 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
349 case DC_SIGCHAR_POINTER:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
350 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
351 DCpointer ptrValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
352 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
353 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
354 case NILSXP: ptrValue = (DCpointer) 0; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
355 case CHARSXP: ptrValue = (DCpointer) CHAR(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
356 case SYMSXP: ptrValue = (DCpointer) PRINTNAME(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
357 case STRSXP: ptrValue = (DCpointer) CHAR(STRING_ELT(arg,0)); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
358 case LGLSXP: ptrValue = (DCpointer) LOGICAL(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
359 case INTSXP: ptrValue = (DCpointer) INTEGER(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
360 case REALSXP: ptrValue = (DCpointer) REAL(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
361 case CPLXSXP: ptrValue = (DCpointer) COMPLEX(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
362 case RAWSXP: ptrValue = (DCpointer) RAW(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
363 case EXTPTRSXP: ptrValue = R_ExternalPtrAddr(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
364 // case ENVSXP: ptrValue = (DCpointer) arg; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
365 default: error("Argument type mismatch at position %d: expected C pointer convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
366 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
367 dcArgPointer(pvm, ptrValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
368 }
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 case DC_SIGCHAR_STRING:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
371 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
372 DCpointer cstringValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
373 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
374 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
375 case NILSXP: cstringValue = (DCpointer) 0; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
376 case CHARSXP: cstringValue = (DCpointer) CHAR(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
377 case SYMSXP: cstringValue = (DCpointer) PRINTNAME(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
378 case STRSXP: cstringValue = (DCpointer) CHAR( STRING_ELT(arg,0) ); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
379 case EXTPTRSXP: cstringValue = R_ExternalPtrAddr(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
380 default: error("Argument type mismatch at position %d: expected C string pointer convertable value", argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
381 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
382 dcArgPointer(pvm, cstringValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
383 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
384 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
385 default: error("Signature type mismatch at position %d: Unknown token '%c' at argument %d.", ch, argpos); /* dummy */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
386 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
387 } else { /* ptrcnt > 0 */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
388 DCpointer ptrValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
389 if (ch == '<') { /* typed high-level struct/union pointer */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
390 char const * e;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
391 char const * b;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
392 char const * n;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
393 int l;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
394 b = sig;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
395 while( isalnum(*sig) || *sig == '_' ) sig++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
396 if (*sig != '>') {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
397 error("Invalid signature '%s' - missing '>' marker for structure at argument %d.", signature, argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
398 return R_NilValue; /* Dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
399 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
400 sig++;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
401 /* check pointer type */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
402 if (type_id != NILSXP) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
403 SEXP structName = getAttrib(arg, install("struct"));
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
404 if (structName == R_NilValue) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
405 error("typed pointer needed here");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
406 return R_NilValue; /* Dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
407 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
408 e = sig-1;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
409 l = e - b;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
410 n = CHAR(STRING_ELT(structName,0));
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
411 if ( (strlen(n) != l) || (strncmp(b,n,l) != 0) ) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
412 error("incompatible pointer types");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
413 return R_NilValue; /* Dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
414 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
415 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
416 switch(type_id) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
417 case NILSXP: ptrValue = (DCpointer) 0; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
418 case EXTPTRSXP: ptrValue = R_ExternalPtrAddr(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
419 case RAWSXP: ptrValue = (DCpointer) RAW(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
420 default: error("internal error: typed-pointer can be external pointers or raw only.");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
421 return R_NilValue; /* Dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
422 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
423 dcArgPointer(pvm, ptrValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
424 ptrcnt = 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
425 } else { /* typed low-level pointers */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
426 switch(ch) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
427 case DC_SIGCHAR_VOID:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
428 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
429 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
430 case NILSXP: ptrValue = (DCpointer) 0; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
431 case STRSXP: ptrValue = (DCpointer) CHAR(STRING_ELT(arg,0)); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
432 case LGLSXP: ptrValue = (DCpointer) LOGICAL(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
433 case INTSXP: ptrValue = (DCpointer) INTEGER(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
434 case REALSXP: ptrValue = (DCpointer) REAL(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
435 case CPLXSXP: ptrValue = (DCpointer) COMPLEX(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
436 case RAWSXP: ptrValue = (DCpointer) RAW(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
437 case EXTPTRSXP: ptrValue = R_ExternalPtrAddr(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
438 default: error("Argument type mismatch at position %d: expected pointer convertable value", argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
439 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
440 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
441 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
442 case DC_SIGCHAR_CHAR:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
443 case DC_SIGCHAR_UCHAR:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
444 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
445 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
446 case NILSXP: ptrValue = (DCpointer) 0; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
447 case STRSXP:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
448 if (ptrcnt == 1) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
449 ptrValue = (DCpointer) CHAR( STRING_ELT(arg,0) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
450 } else {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
451 error("Argument type mismatch at position %d: expected 'C string' convertable value", argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
452 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
453 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
454 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
455 case RAWSXP:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
456 if (ptrcnt == 1) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
457 ptrValue = RAW(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
458 } else {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
459 error("Argument type mismatch at position %d: expected 'C string' convertable value", argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
460 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
461 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
462 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
463 case EXTPTRSXP: ptrValue = R_ExternalPtrAddr(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
464 default:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
465 error("Argument type mismatch at position %d: expected 'C string' convertable value", argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
466 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
467 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
468 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
469 case DC_SIGCHAR_USHORT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
470 case DC_SIGCHAR_SHORT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
471 error("Signature '*[sS]' not implemented");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
472 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
473 case DC_SIGCHAR_UINT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
474 case DC_SIGCHAR_INT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
475 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
476 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
477 case NILSXP: ptrValue = (DCpointer) 0; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
478 case INTSXP: ptrValue = (DCpointer) INTEGER(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
479 default: error("Argument type mismatch at position %d: expected 'pointer to C integer' convertable value", argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
480 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
481 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
482 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
483 case DC_SIGCHAR_ULONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
484 case DC_SIGCHAR_LONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
485 error("Signature '*[jJ]' not implemented");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
486 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
487 case DC_SIGCHAR_ULONGLONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
488 case DC_SIGCHAR_LONGLONG:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
489 error("Signature '*[lJ]' not implemented");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
490 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
491 case DC_SIGCHAR_FLOAT:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
492 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
493 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
494 case NILSXP: ptrValue = (DCpointer) 0; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
495 case RAWSXP:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
496 if ( strcmp( CHAR(STRING_ELT(getAttrib(arg, install("class")),0)),"floatraw") == 0 ) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
497 ptrValue = (DCpointer) RAW(arg);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
498 } else {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
499 error("Argument type mismatch at position %d: expected 'pointer to C double' convertable value", argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
500 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
501 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
502 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
503 default: error("Argument type mismatch at position %d: expected 'pointer to C double' convertable value", argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
504 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
505 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
506 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
507 case DC_SIGCHAR_DOUBLE:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
508 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
509 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
510 case NILSXP: ptrValue = (DCpointer) 0; break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
511 case REALSXP: ptrValue = (DCpointer) REAL(arg); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
512 default: error("Argument type mismatch at position %d: expected 'pointer to C double' convertable value", argpos);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
513 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
514 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
515 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
516 case DC_SIGCHAR_POINTER:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
517 case DC_SIGCHAR_STRING:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
518 switch(type_id)
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
519 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
520 case EXTPTRSXP:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
521 ptrValue = R_ExternalPtrAddr( arg ); break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
522 default: error("low-level typed pointer on pointer not implemented");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
523 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
524 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
525 break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
526 default:
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
527 error("low-level typed pointer on C char pointer not implemented");
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
528 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
529 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
530 dcArgPointer(pvm, ptrValue);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
531 ptrcnt = 0;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
532 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
533 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
534 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
535
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
536
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
537 if (args != R_NilValue) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
538 error ("Too many arguments for signature '%s'.", signature);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
539 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
540 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
541 /* process return type, invoke call and return R value */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
542
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
543 switch(*sig++) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
544 case DC_SIGCHAR_BOOL: return ScalarLogical( ( dcCallBool(pvm, addr) == DC_FALSE ) ? FALSE : TRUE );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
545
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
546 case DC_SIGCHAR_CHAR: return ScalarInteger( (int) dcCallChar(pvm, addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
547 case DC_SIGCHAR_UCHAR: return ScalarInteger( (int) ( (unsigned char) dcCallChar(pvm, addr ) ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
548
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
549 case DC_SIGCHAR_SHORT: return ScalarInteger( (int) dcCallShort(pvm,addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
550 case DC_SIGCHAR_USHORT: return ScalarInteger( (int) ( (unsigned short) dcCallShort(pvm,addr) ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
551
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
552 case DC_SIGCHAR_INT: return ScalarInteger( dcCallInt(pvm,addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
553 case DC_SIGCHAR_UINT: return ScalarReal( (double) (unsigned int) dcCallInt(pvm, addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
554
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
555 case DC_SIGCHAR_LONG: return ScalarReal( (double) dcCallLong(pvm, addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
556 case DC_SIGCHAR_ULONG: return ScalarReal( (double) ( (unsigned long) dcCallLong(pvm, addr) ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
557
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
558 case DC_SIGCHAR_LONGLONG: return ScalarReal( (double) dcCallLongLong(pvm, addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
559 case DC_SIGCHAR_ULONGLONG: return ScalarReal( (double) dcCallLongLong(pvm, addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
560
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
561 case DC_SIGCHAR_FLOAT: return ScalarReal( (double) dcCallFloat(pvm,addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
562 case DC_SIGCHAR_DOUBLE: return ScalarReal( dcCallDouble(pvm,addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
563 case DC_SIGCHAR_POINTER: return R_MakeExternalPtr( dcCallPointer(pvm,addr), R_NilValue, R_NilValue );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
564 case DC_SIGCHAR_STRING: return mkString( dcCallPointer(pvm, addr) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
565 case DC_SIGCHAR_VOID: dcCallVoid(pvm,addr); /* TODO: return invisible */ return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
566 case '*':
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
567 {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
568 SEXP ans;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
569 ptrcnt = 1;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
570 while (*sig == '*') { ptrcnt++; sig++; }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
571 switch(*sig) {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
572 case '<': {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
573 /* struct/union pointers */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
574 PROTECT(ans = R_MakeExternalPtr( dcCallPointer(pvm, addr), R_NilValue, R_NilValue ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
575 char buf[128];
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
576 const char* begin = ++sig;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
577 const char* end = strchr(sig, '>');
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
578 size_t n = end - begin;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
579 strncpy(buf, begin, n);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
580 buf[n] = '\0';
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
581 setAttrib(ans, install("struct"), mkString(buf) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
582 setAttrib(ans, install("class"), mkString("struct") );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
583 } break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
584 case 'C':
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
585 case 'c': {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
586 PROTECT(ans = mkString( dcCallPointer(pvm, addr) ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
587 } break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
588 case 'v': {
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
589 PROTECT(ans = R_MakeExternalPtr( dcCallPointer(pvm, addr), R_NilValue, R_NilValue ) );
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
590 } break;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
591 default: error("Unsupported return type signature"); return R_NilValue;
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
592 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
593 UNPROTECT(1);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
594 return(ans);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
595 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
596 default: error("Unknown return type specification for signature '%s'.", signature);
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
597 return R_NilValue; /* dummy */
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
598 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
599
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
600 }
0cfcc391201f initial from svn dyncall-1745
Daniel Adler
parents:
diff changeset
601