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