Mercurial > pub > dyncall > bindings

comparison R/rdc/demo/stdio.R @ 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 if (.Platform$OS.type == "windows") {
2 .libC <- "/windows/system32/msvcrt"
3 } else if ( Sys.info()[["sysname"]] == "Darwin" ) {
4 .libC <- "/usr/lib/libc.dylib"
5 } else {
6 .libC <- "/lib/libc.so.6"
7 }
8
9 .libC <- rdcLoad(.libC)
10 .fopen <- rdcFind(.libC, "fopen")
11 .fwrite <- rdcFind(.libC, "fwrite")
12 .fread <- rdcFind(.libC, "fread")
13 .fclose <- rdcFind(.libC, "fclose")
14 .fprintf <- rdcFind(.libC, "fprintf")
15
16 fopen <- function(name, mode)
17 rdcCall(.fopen, "SS)p",name,mode)
18 fread <- function(buf, size, count, fp)
19 rdcCall(.fread,"piip)i", buf, size, count, fp)
20 fwrite <- function(buf, size, count, fp)
21 rdcCall(.fwrite, "piip)i", buf, size, count, fp)
22 fclose <- function(fp)
23 rdcCall(.fclose, "p)i", fp)
24
25
26
27 do.write <- function(filename, x)
28 {
29 fh <- fopen(filename, "wb")
30 error <- FALSE
31 offset <- 0L
32 size <- rdcSizeOf("double")
33 count <- length(x)
34 while( count > 0 && !error )
35 {
36 nwritten <- fwrite( rdcDataPtr(x,offset), size, count, fh )
37 if (nwritten < 0)
38 {
39 error <- TRUE
40 }
41 else
42 {
43 count <- count - nwritten
44 offset <- offset + nwritten * size
45 }
46 }
47 fclose(fh)
48 if (error)
49 stop("fwrite error")
50 }
51
52 do.read <- function(filename, x)
53 {
54 fh <- fopen(filename, "rb")
55 error <- FALSE
56 offset <- 0L
57 size <- rdcSizeOf("double")
58 count <- length(x)
59 while (size > 0 && !error )
60 {
61 nread <- fread( rdcDataPtr(x,offset), size, count, fh )
62 if (nread < 0)
63 {
64 error <- TRUE
65 }
66 else
67 {
68 size <- size - nread
69 offset <- offset + nread * size
70 }
71 }
72 fclose(fh)
73 if (error)
74 stop("fread error")
75 }
76
77 filename <- tempfile()
78 x <- rnorm(1000)
79 do.write(filename, x)
80 y <- numeric(1000)
81 do.read(filename,y)
82 identical(x,y)
83