Hi folks,
I've attached a patch to the svn trunk that improves the performance
of the serialize/unserialize interface for vector types. The current
implementation: a) invokes the R_XDREncode operation for each element
of the vector type, and b) uses a switch statement to determine the
stream type for each element of the vector type. I've added
R_XDREncodeVector/R_XDRDecodeVector functions that accept N elements
at a time, and I've reorganized the implementation so that the stream
type is not queried once per element.
In the following microbenchmark (below), I've observed performance
improvements of about x2.4. In a real benchmark that is using the
serialization interface to make MPI calls, I see about a 10%
improvement in performance.
Cheers,
--Michael
microbenchmark:
input <- matrix(1:100000000, 10000, 10000)
output <- serialize(input, NULL)
for(i in 1:10) { print(system.time(serialize(input, NULL))) }
for(i in 1:10) { print(system.time(unserialize(output))) }
Index: src/include/Rinternals.h
===================================================================
--- src/include/Rinternals.h (revision 57107)
+++ src/include/Rinternals.h (working copy)
@@ -749,6 +749,7 @@
void Rf_warningcall_immediate(SEXP, const char *, ...);
/* Save/Load Interface */
+#define R_XDR_COMPLEX_SIZE 16
#define R_XDR_DOUBLE_SIZE 8
#define R_XDR_INTEGER_SIZE 4
@@ -757,6 +758,13 @@
void R_XDREncodeInteger(int i, void *buf);
int R_XDRDecodeInteger(void *buf);
+void R_XDREncodeDoubleVector(double *d, void *buf, int len);
+void R_XDRDecodeDoubleVector(void *input, double *output, int len);
+void R_XDREncodeComplexVector(Rcomplex *c, void *buf, int len);
+void R_XDRDecodeComplexVector(void *input, Rcomplex *output, int len);
+void R_XDREncodeIntegerVector(int *i, void *buf, int len);
+void R_XDRDecodeIntegerVector(void *input, int *output, int len);
+
typedef void *R_pstream_data_t;
typedef enum {
Index: src/main/serialize.c
===================================================================
--- src/main/serialize.c (revision 57107)
+++ src/main/serialize.c (working copy)
@@ -792,20 +792,62 @@
WriteItem(STRING_ELT(s, i), ref_table, stream);
}
-/* e.g., OutVec(fp, obj, INTEGER, OutInteger) */
-#define OutVec(fp, obj, accessor, outfunc) \
- do { \
- int cnt; \
- for (cnt = 0; cnt < LENGTH(obj); ++cnt) \
- outfunc(fp, accessor(obj, cnt)); \
- } while (0)
-
-#define LOGICAL_ELT(x,__i__) LOGICAL(x)[__i__]
#define INTEGER_ELT(x,__i__) INTEGER(x)[__i__]
#define REAL_ELT(x,__i__) REAL(x)[__i__]
#define COMPLEX_ELT(x,__i__) COMPLEX(x)[__i__]
#define RAW_ELT(x,__i__) RAW(x)[__i__]
+#define OutVec(NAME, CAPNAME, XDR, CAPXDR, TYPE) \
+static R_INLINE void Out ## NAME ## Vec(R_outpstream_t stream, SEXP s, int length) \
+{ \
+ OutInteger(stream, length); \
+ switch (stream->type) { \
+ case R_pstream_xdr_format: \
+ if (length > (128 / R_XDR_## CAPXDR ##_SIZE)) \
+ { \
+ char *buf = Calloc( R_XDR_ ## CAPXDR ## _SIZE * length, char); \
+ R_XDREncode ## XDR ## Vector(CAPNAME(s), buf, length); \
+ stream->OutBytes(stream, buf, R_XDR_ ## CAPXDR ## _SIZE * length); \
+ Free(buf); \
+ } else { \
+ char buf[128]; \
+ R_XDREncode ## XDR ## Vector(CAPNAME(s), buf, length); \
+ stream->OutBytes(stream, buf, R_XDR_ ## CAPXDR ## _SIZE * length); \
+ } \
+ break; \
+ case R_pstream_binary_format: \
+ stream->OutBytes(stream, CAPNAME(s), sizeof(TYPE) * length); \
+ break; \
+ default: \
+ { \
+ int cnt; \
+ for (cnt = 0; cnt < length; ++cnt) \
+ Out ## NAME(stream, CAPNAME ## _ELT(s, cnt)); \
+ } \
+ } \
+}
+
+OutVec(Integer, INTEGER, Integer, INTEGER, int)
+OutVec(Real, REAL, Double, DOUBLE, double)
+OutVec(Complex, COMPLEX, Complex, COMPLEX, Rcomplex)
+
+static R_INLINE void OutByteVec(R_outpstream_t stream, SEXP s, int length)
+{
+ OutInteger(stream, length);
+ switch (stream->type) {
+ case R_pstream_xdr_format:
+ case R_pstream_binary_format:
+ stream->OutBytes(stream, RAW(s), length);
+ break;
+ default:
+ {
+ int cnt;
+ for (cnt = 0; cnt < length; ++cnt)
+ OutByte(stream, RAW_ELT(s, cnt));
+ }
+ }
+}
+
static void WriteItem (SEXP s, SEXP ref_table, R_outpstream_t stream)
{
int i;
@@ -932,16 +974,13 @@
break;
case LGLSXP:
case INTSXP:
- OutInteger(stream, LENGTH(s));
- OutVec(stream, s, INTEGER_ELT, OutInteger);
+ OutIntegerVec(stream, s, LENGTH(s));
break;
case REALSXP:
- OutInteger(stream, LENGTH(s));
- OutVec(stream, s, REAL_ELT, OutReal);
+ OutRealVec(stream, s, LENGTH(s));
break;
case CPLXSXP:
- OutInteger(stream, LENGTH(s));
- OutVec(stream, s, COMPLEX_ELT, OutComplex);
+ OutComplexVec(stream, s, LENGTH(s));
break;
case STRSXP:
OutInteger(stream, LENGTH(s));
@@ -962,8 +1001,7 @@
error(_("this version of R cannot write byte code objects"));
#endif
case RAWSXP:
- OutInteger(stream, LENGTH(s));
- OutVec(stream, s, RAW_ELT, OutByte);
+ OutByteVec(stream, s, LENGTH(s));
break;
case S4SXP:
break; /* only attributes (i.e., slots) count */
@@ -1214,21 +1252,44 @@
return s;
}
-#define InVec(fp, obj, accessor, infunc, length) \
- do { \
- int cnt; \
- for (cnt = 0; cnt < length; ++cnt) \
- accessor(obj, cnt, infunc(fp)); \
- } while (0)
+#define InVec(NAME, CAPNAME, XDR, CAPXDR, TYPE) \
+static R_INLINE void In ## NAME ## Vec(R_inpstream_t stream, SEXP obj, int length) \
+{ \
+ switch (stream->type) { \
+ case R_pstream_xdr_format: \
+ if (length > (128 / R_XDR_## CAPXDR ##_SIZE)) \
+ { \
+ char *buf = Calloc( R_XDR_ ## CAPXDR ## _SIZE * length, char); \
+ stream->InBytes(stream, buf, R_XDR_ ## CAPXDR ## _SIZE * length); \
+ R_XDRDecode ## XDR ## Vector(buf, CAPNAME(obj), length); \
+ Free(buf); \
+ } else { \
+ char buf[128]; \
+ stream->InBytes(stream, buf, R_XDR_ ## CAPXDR ## _SIZE * length); \
+ R_XDRDecode ## XDR ## Vector(buf, CAPNAME(obj), length); \
+ } \
+ break; \
+ case R_pstream_binary_format: \
+ stream->InBytes(stream, CAPNAME(obj), sizeof(TYPE) * length); \
+ break; \
+ default: \
+ { \
+ int cnt; \
+ for (cnt = 0; cnt < length; ++cnt) \
+ SET_ ## CAPNAME ## _ELT(obj, cnt, In ## NAME(stream)); \
+ } \
+ } \
+}
-
-
-#define SET_LOGICAL_ELT(x,__i__,v) (LOGICAL_ELT(x,__i__)=(v))
#define SET_INTEGER_ELT(x,__i__,v) (INTEGER_ELT(x,__i__)=(v))
#define SET_REAL_ELT(x,__i__,v) (REAL_ELT(x,__i__)=(v))
#define SET_COMPLEX_ELT(x,__i__,v) (COMPLEX_ELT(x,__i__)=(v))
#define SET_RAW_ELT(x,__i__,v) (RAW_ELT(x,__i__)=(v))
+InVec(Integer, INTEGER, Integer, INTEGER, int)
+InVec(Real, REAL, Double, DOUBLE, double)
+InVec(Complex, COMPLEX, Complex, COMPLEX, Rcomplex)
+
static SEXP ReadItem (SEXP ref_table, R_inpstream_t stream)
{
SEXPTYPE type;
@@ -1379,24 +1440,20 @@
}
break;
case LGLSXP:
- length = InInteger(stream);
- PROTECT(s = allocVector(type, length));
- InVec(stream, s, SET_LOGICAL_ELT, InInteger, length);
- break;
case INTSXP:
length = InInteger(stream);
PROTECT(s = allocVector(type, length));
- InVec(stream, s, SET_INTEGER_ELT, InInteger, length);
+ InIntegerVec(stream, s, length);
break;
case REALSXP:
length = InInteger(stream);
PROTECT(s = allocVector(type, length));
- InVec(stream, s, SET_REAL_ELT, InReal, length);
+ InRealVec(stream, s, length);
break;
case CPLXSXP:
length = InInteger(stream);
PROTECT(s = allocVector(type, length));
- InVec(stream, s, SET_COMPLEX_ELT, InComplex, length);
+ InComplexVec(stream, s, length);
break;
case STRSXP:
length = InInteger(stream);
Index: src/main/saveload.c
===================================================================
--- src/main/saveload.c (revision 57107)
+++ src/main/saveload.c (working copy)
@@ -2079,6 +2079,7 @@
}
/* defined in Rinternals.h
+#define R_XDR_COMPLEX_SIZE 16
#define R_XDR_DOUBLE_SIZE 8
#define R_XDR_INTEGER_SIZE 4
*/
@@ -2134,6 +2135,101 @@
return i;
}
+void attribute_hidden R_XDREncodeDoubleVector(double *d, void *buf, int len)
+{
+ XDR xdrs;
+ int cnt, success = 1;
+
+ xdrmem_create(&xdrs, (char *) buf, len * R_XDR_DOUBLE_SIZE, XDR_ENCODE);
+ for(cnt = 0; cnt < len && success; cnt++) {
+ success = xdr_double(&xdrs, d + cnt);
+ }
+
+ xdr_destroy(&xdrs);
+ if (! success)
+ error(_("XDR write failed"));
+}
+
+void attribute_hidden R_XDRDecodeDoubleVector(void *input, double *output, int len)
+{
+ XDR xdrs;
+ int cnt, success = 1;
+
+ xdrmem_create(&xdrs, (char*) input, len * R_XDR_DOUBLE_SIZE, XDR_DECODE);
+
+ for(cnt = 0; cnt < len && success; cnt++) {
+ success = xdr_double(&xdrs, output + cnt);
+ }
+
+ xdr_destroy(&xdrs);
+ if (! success)
+ error(_("XDR read failed"));
+}
+
+void attribute_hidden R_XDREncodeComplexVector(Rcomplex *c, void *buf, int len)
+{
+ XDR xdrs;
+ int cnt, success = 1;
+
+ xdrmem_create(&xdrs, (char *) buf, len * R_XDR_COMPLEX_SIZE, XDR_ENCODE);
+ for(cnt = 0; cnt < len && success; cnt++) {
+ success = xdr_double(&xdrs, &(c[cnt].r));
+ if (success) success = xdr_double(&xdrs, &(c[cnt].i));
+ }
+
+ xdr_destroy(&xdrs);
+ if (! success)
+ error(_("XDR write failed"));
+}
+
+void attribute_hidden R_XDRDecodeComplexVector(void *input, Rcomplex *output, int len)
+{
+ XDR xdrs;
+ int cnt, success = 1;
+
+ xdrmem_create(&xdrs, (char*) input, len * R_XDR_COMPLEX_SIZE, XDR_DECODE);
+
+ for(cnt = 0; cnt < len && success; cnt++) {
+ success = xdr_double(&xdrs, &(output[cnt].r));
+ if (success) success = xdr_double(&xdrs, &(output[cnt].i));
+ }
+
+ xdr_destroy(&xdrs);
+ if (! success)
+ error(_("XDR read failed"));
+}
+
+void attribute_hidden R_XDREncodeIntegerVector(int *i, void *buf, int len)
+{
+ XDR xdrs;
+ int cnt, success = 1;
+
+ xdrmem_create(&xdrs, (char *) buf, len * R_XDR_INTEGER_SIZE, XDR_ENCODE);
+ for(cnt = 0; cnt < len && success; cnt++) {
+ success = xdr_int(&xdrs, i + cnt);
+ }
+
+ xdr_destroy(&xdrs);
+ if (! success)
+ error(_("XDR write failed"));
+}
+
+void attribute_hidden R_XDRDecodeIntegerVector(void *input, int *output, int len)
+{
+ XDR xdrs;
+ int cnt, success = 1;
+
+ xdrmem_create(&xdrs, (char*) input, len * R_XDR_INTEGER_SIZE, XDR_DECODE);
+
+ for(cnt = 0; cnt < len && success; cnt++) {
+ success = xdr_int(&xdrs, output + cnt);
+ }
+
+ xdr_destroy(&xdrs);
+ if (! success)
+ error(_("XDR read failed"));
+}
+
/* Next two were used in gnomeGUI package, are in Rinterface.h */
void R_SaveGlobalEnvToFile(const char *name)
{
______________________________________________
[email protected] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
