Mercurial > pub > dyncall > bindings

comparison R/rdyncall/src/rutils_float.c @ 0:0cfcc391201f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
initial from svn dyncall-1745
author Daniel Adler
date Thu, 19 Mar 2015 22:26:28 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:0cfcc391201f
1 /** ===========================================================================
2 ** R-Package: rdyncall
3 ** File: src/rutils_float.c
4 ** Description: Utility functions for handling C float data types.
5 **/
6
7 #define USE_RINTERNALS
8 #include <Rdefines.h>
9 #include <Rinternals.h>
10 #include <R_ext/RS.h>
11
12 /* Float utils */
13
14 SEXP r_as_floatraw(SEXP x)
15 {
16 SEXP ans;
17 int i, n;
18 double *dp;
19 float *fp;
20
21 dp = (double*) REAL(x);
22
23 n = LENGTH(x);
24 if (n < 1) {
25 error("length of x should be >= 1");
26 return R_NilValue;
27 }
28
29 ans = PROTECT( Rf_allocVector(RAWSXP, sizeof(float)*n) );
30
31 fp = (float*) RAW(ans);
32
33 for(i = 0 ; i < n ; ++i )
34 fp[i] = (float) dp[i];
35
36 UNPROTECT(1);
37 return ans;
38 }
39
40 SEXP r_floatraw2numeric(SEXP x)
41 {
42 SEXP ans;
43 int i, n;
44 float *fp;
45 double *dp;
46
47 fp = (float*) RAW(x);
48
49 n = LENGTH(x) / sizeof(float);
50 ans = PROTECT( Rf_allocVector(REALSXP, n) );
51
52 dp = (double*) REAL(ans);
53
54 for(i = 0 ; i < n ; ++i )
55 dp[i] = (double) fp[i];
56
57 UNPROTECT(1);
58 return ans;
59
60 }
61