|
0
|
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
|
