├── .Rbuildignore ├── .editorconfig ├── .github └── workflows │ └── ci.yaml ├── .gitignore ├── ChangeLog ├── DESCRIPTION ├── NAMESPACE ├── R └── serialization.R ├── README.md ├── cleanup ├── inst ├── NEWS.Rd └── include │ └── RApiSerializeAPI.h ├── man └── RApiSerialize-package.Rd ├── src ├── init.c └── serialize.cpp └── tests ├── simpleTests.R └── simpleTests.Rout.save /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | .travis\.yml 4 | ^.*\.tar\.gz 5 | ^\.github 6 | ^\.editorconfig 7 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig is awesome: http://EditorConfig.org 2 | 3 | # top-most EditorConfig file 4 | root = true 5 | 6 | # Unix-style newlines with a newline ending every file 7 | [*] 8 | end_of_line = lf 9 | insert_final_newline = true 10 | trim_trailing_whitespace = true 11 | 12 | # Matches multiple files with brace expansion notation 13 | # 4 space indentation 14 | [*.{c,cpp,h,hpp,R,r}] 15 | indent_style = space 16 | indent_size = 4 17 | 18 | # Tab indentation (no size specified) 19 | [Makefile] 20 | indent_style = tab 21 | 22 | -------------------------------------------------------------------------------- /.github/workflows/ci.yaml: -------------------------------------------------------------------------------- 1 | # Run CI for R using https://eddelbuettel.github.io/r-ci/ 2 | 3 | name: ci 4 | 5 | on: 6 | push: 7 | pull_request: 8 | 9 | env: 10 | _R_CHECK_FORCE_SUGGESTS_: "false" 11 | 12 | jobs: 13 | ci: 14 | strategy: 15 | matrix: 16 | include: 17 | #- {os: macOS-latest} 18 | - {os: ubuntu-latest} 19 | 20 | runs-on: ${{ matrix.os }} 21 | 22 | steps: 23 | - name: Checkout 24 | uses: actions/checkout@v4 25 | 26 | - name: Setup 27 | uses: eddelbuettel/github-actions/r-ci@master 28 | 29 | - name: Dependencies 30 | run: ./run.sh install_all 31 | 32 | - name: Test 33 | run: ./run.sh run_tests 34 | 35 | #- name: Coverage 36 | # if: ${{ matrix.os == 'ubuntu-latest' }} 37 | # run: ./run.sh coverage 38 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | src/*.o 5 | src/*.so 6 | src/*.dll 7 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 2025-02-21 Dirk Eddelbuettel 2 | 3 | * .github/workflows/ci.yaml (jobs): Use r-ci with included bootstrap 4 | 5 | 2024-09-28 Dirk Eddelbuettel 6 | 7 | * DESCRIPTION (Version, Date): Release 0.1.4 8 | 9 | 2024-09-26 Dirk Eddelbuettel 10 | 11 | * DESCRIPTION (Version, Date): Roll minor version and date 12 | 13 | * .editorconfig: Added 14 | * .Rbuildignore: Updated 15 | * cleanup: Added 16 | 17 | 2024-09-24 Dirk Eddelbuettel 18 | 19 | * inst/include/RApiSerializeAPI.h: Add C++ namespace 20 | 21 | 2024-09-23 Dirk Eddelbuettel 22 | 23 | * inst/include/RApiSerializeAPI.h: Added comment on C++ preference 24 | 25 | 2024-09-06 Dirk Eddelbuettel 26 | 27 | * DESCRIPTION (Authors@R): Added 28 | 29 | 2024-05-20 Dirk Eddelbuettel 30 | 31 | * README.md: Use tinyverse.netlify.app for dependency badge 32 | 33 | 2024-05-13 Dirk Eddelbuettel 34 | 35 | * DESCRIPTION (Version, Date): Release 0.1.3 36 | 37 | * inst/include/RApiSerializeAPI.h (serializeToRaw): Updated 38 | 39 | 2024-05-11 Dirk Eddelbuettel 40 | 41 | * R/serialization.R (serializeToRaw): Add an xdr=TRUE argument 42 | * man/RApiSerialize-package.Rd: Document it 43 | * tests/simpleTests.R: Add simple tests for xdr feature 44 | * tests/simpleTests.Rout.save: Idem 45 | 46 | * src/serialize.cpp: Define R_NO_REMAP, switch to Rf_error and 47 | Rf_allocVector 48 | 49 | 2024-05-10 Travers Ching 50 | 51 | * src/serialize.cpp (serializeToRaw): Add xdr argument, 52 | set to false to use binary format instead 53 | * inst/include/RApiSerializeAPI.h (serializeToRaw): Idem 54 | 55 | 2024-02-23 Dirk Eddelbuettel 56 | 57 | * .github/workflows/ci.yaml (jobs): Update to actions/checkout@v4, 58 | add r-ci-setup actions 59 | 60 | 2022-11-10 Dirk Eddelbuettel 61 | 62 | * .github/workflows/ci.yaml (jobs): Update to actions/checkout@v3 63 | 64 | 2022-08-25 Dirk Eddelbuettel 65 | 66 | * DESCRIPTION (Version, Date): Release 0.1.2 67 | 68 | * src/serialize.cpp (CloseMemOutPStream): Correct error() call 69 | when missing long vector support to not use i18n macro 70 | 71 | 2022-08-07 Dirk Eddelbuettel 72 | 73 | * DESCRIPTION (Version, Date): Release 0.1.1 74 | 75 | 2022-08-03 Dirk Eddelbuettel 76 | 77 | * DESCRIPTION (Version, Date): Roll minor version and date 78 | 79 | * src/serialize.cpp (serializeToRaw): Support serialization version 80 | argument to select 2 (pre-ALTREP) or 3 (with ALTREP support) 81 | * src/init.c (callMethods): Update interface 82 | * inst/include/RApiSerializeAPI.h (serializeToRaw): Idem 83 | * R/serialization.R (serializeToRaw): Support new argument 84 | * man/RApiSerialize-package.Rd: Document new argument 85 | 86 | * README.md: Update http URLs to https 87 | 88 | * NAMESPACE: Turn on registration and fixes for library load, 89 | export two functions explicitly 90 | * R/serialization.R: Use registered and fixed symbols in calls 91 | 92 | * src/serialize.cpp (CloseMemOutPStream): Minor upstream update 93 | 94 | * tests/simpleTests.R: Updated tests 95 | * tests/simpleTests.Rout.save: Idem 96 | 97 | 2021-04-12 Dirk Eddelbuettel 98 | 99 | * DESCRIPTION (URL, BugRreports): Added to DESCRIPTION file 100 | 101 | 2021-01-01 Dirk Eddelbuettel 102 | 103 | * .github/workflows/ci.yaml: Add CI runner using r-ci 104 | * README.md: Add new CI badge 105 | 106 | 2020-06-02 Dirk Eddelbuettel 107 | 108 | * README.md: Added 'last commit' badge 109 | 110 | * .travis.yml: Switch to R 4.0.0 and bionic 111 | 112 | 2019-01-03 Dirk Eddelbuettel 113 | 114 | * DESCRIPTION (Version, Date): Roll minor version 115 | 116 | * DESCRIPTION (Description): Minor rewording 117 | 118 | * README.md: Added dependencies badge 119 | 120 | 2018-09-02 Dirk Eddelbuettel 121 | 122 | * .travis.yml: Minor Travis CI update 123 | 124 | 2017-04-23 Dirk Eddelbuettel 125 | 126 | * .travis.yml: Switch to run.sh from maintained for R and Travis 127 | 128 | 2015-03-25 Dirk Eddelbuettel 129 | 130 | * src/serialize.cpp: Added some comments regarding differences 131 | between this file and the original src/main/serialize.c code 132 | 133 | 2014-05-07 Dirk Eddelbuettel 134 | 135 | * DESCRIPTION (and other files): Per email by Junji, reordered all 136 | references to first list Ei-ji and then him 137 | 138 | 2014-04-19 Dirk Eddelbuettel 139 | 140 | * DESCRIPTION: Finalizing initial public version 0.1.0 141 | 142 | * DESCRIPTION: Expanded and edited Description: text 143 | * man/RApiSerialize-package.Rd: Expanded Details section 144 | 145 | * inst/NEWS.Rd: Added NEWS file with first short entry 146 | 147 | 2014-04-15 Dirk Eddelbuettel 148 | 149 | * tests/simpleTests.R: Added simple test script 150 | * tests/simpleTests.Rout.save: Added reference output 151 | 152 | * src/serialize.cpp: Removed to/from char functions 153 | * src/init.c: Removed interface for to/from char functions 154 | * inst/include/RApiSerializeAPI.h: Ditto 155 | * R/serialization.R: Ditto 156 | * man/RApiSerialize-package.Rd: Ditto 157 | 158 | 2014-04-12 Dirk Eddelbuettel 159 | 160 | * DESCRIPTION: Prepating initial version 0.1.0 161 | 162 | * src/serialize.cpp: With credits to Ei-ji, Junji, and R Core 163 | * src/init.c: Exporting for use by other R package 164 | 165 | * inst/include/RApiSerializeAPI.h: Exported header used by others 166 | 167 | * R/serialization.R: Simple R wrappers for testing 168 | 169 | * man/RApiSerialize-package.Rd: Basic documentation 170 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: RApiSerialize 2 | Type: Package 3 | Title: R API Serialization 4 | Version: 0.1.4 5 | Date: 2024-09-28 6 | Authors@R: c(person("Dirk", "Eddelbuettel", role = c("aut", "cre"), email = "edd@debian.org", 7 | comment = c(ORCID = "0000-0001-6419-907X")), 8 | person("Ei-ji", "Nakama", role = "aut", comment = "Code in package Rhpc"), 9 | person("Junji", "Nakano", role = "aut", comment = "Code in package Rhpc"), 10 | person("R Core", role = "aut", comment = "Code in R file src/main/serialize.c")) 11 | Description: Access to the internal R serialization code is provided for 12 | use by other packages at the C function level by using the registration of 13 | native function mechanism. Client packages simply include a single header 14 | file RApiSerializeAPI.h provided by this package. This packages builds on 15 | the Rhpc package by Ei-ji Nakama and Junji Nakano which also includes a 16 | (partial) copy of the file src/main/serialize.c from R itself. The R Core 17 | group is the original author of the serialization code made available by 18 | this package. 19 | URL: https://github.com/eddelbuettel/rapiserialize, https://dirk.eddelbuettel.com/code/rapiserialize.html 20 | BugReports: https://github.com/eddelbuettel/rapiserialize/issues 21 | License: GPL (>= 2) 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | useDynLib(RApiSerialize, .registration=TRUE, .fixes = "C_") 2 | export("serializeToRaw", 3 | "unserializeFromRaw") 4 | -------------------------------------------------------------------------------- /R/serialization.R: -------------------------------------------------------------------------------- 1 | 2 | ## RApiSerialize -- Packge to provide Serialization as in the R API 3 | ## 4 | ## Copyright (C) 2014 - 2024 Dirk Eddelbuettel 5 | ## 6 | ## This file is part of RApiSerialize. 7 | ## 8 | ## RApiSerialize is free software: you can redistribute it and/or modify 9 | ## it under the terms of the GNU General Public License as published by 10 | ## the Free Software Foundation, either version 2 of the License, or 11 | ## (at your option) any later version. 12 | ## 13 | ## RApiSerialize is distributed in the hope that it will be useful, 14 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ## GNU General Public License for more details. 17 | ## 18 | ## You should have received a copy of the GNU General Public License 19 | ## along with RApiSerialize. If not, see . 20 | 21 | serializeToRaw <- function(obj, version=2, xdr=TRUE) { 22 | .Call(C_serializeToRaw, obj, version, xdr) 23 | } 24 | 25 | unserializeFromRaw <- function(obj) { 26 | .Call(C_unserializeFromRaw, obj) 27 | } 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## RApiSerialize: C-level Serialization from R 2 | 3 | [![CI](https://github.com/eddelbuettel/rapiserialize/workflows/ci/badge.svg)](https://github.com/eddelbuettel/rapiserialize/actions?query=workflow%3Aci) 4 | [![License](https://img.shields.io/badge/license-GPL%20%28%3E=%202%29-brightgreen.svg?style=flat)](https://www.gnu.org/licenses/gpl-2.0.html) 5 | [![CRAN](https://www.r-pkg.org/badges/version/RApiSerialize)](https://cran.r-project.org/package=RApiSerialize) 6 | [![Dependencies](https://tinyverse.netlify.app/badge/RApiSerialize)](https://cran.r-project.org/package=RApiSerialize) 7 | [![Downloads](https://cranlogs.r-pkg.org/badges/RApiSerialize?color=brightgreen)](https://www.r-pkg.org/pkg/RApiSerialize) 8 | [![Last Commit](https://img.shields.io/github/last-commit/eddelbuettel/rapiserialize)](https://github.com/eddelbuettel/rapiserialize) 9 | 10 | ### Synopsis 11 | 12 | This package provides C-level serialization as R does for itself. It is 13 | useful if you are writing C (or C++) code in an R package which needs to 14 | (un)serialize R data structures, and wants to do it faster than calling the 15 | corresponding R level function would do. 16 | 17 | In other words, this is somewhat specialised for situation of high data 18 | throughput, or other cases of a need for high performance. Or maybe you are 19 | just impatient and want the result faster. 20 | 21 | This package owes a lot of debt to the 22 | [Rhpc](https://cran.r-project.org/package=Rhpc) package by 23 | Ei-ji Nakama and Junji Nakano. It gave me the idea of using a copy of the 24 | code which is not exported by R itself. And of course credit is due to the R 25 | Core team for writing R, and the code used here. 26 | 27 | ### Example use 28 | 29 | See my [RcppRedis](https://github.com/eddelbuettel/rcppredis) package for use 30 | of this package 31 | 32 | ### Copyrights 33 | 34 | Copyrights are held by the respective authors, in particular 35 | Ei-ji Nakama and Junji Nakano as well as the R Core Team 36 | for the intial version of the actual serialization code, and 37 | Dirk Eddelbuettel for subsequent modificatons and the remainder 38 | of the package. 39 | 40 | ### License 41 | 42 | GPL (>= 2) 43 | 44 | -------------------------------------------------------------------------------- /cleanup: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | rm -f src/*.o src/*.so 3 | -------------------------------------------------------------------------------- /inst/NEWS.Rd: -------------------------------------------------------------------------------- 1 | \name{NEWS} 2 | \title{News for Package \pkg{RApiSerialize}} 3 | \newcommand{\ghpr}{\href{https://github.com/eddelbuettel/rapiserialize/pull/#1}{##1}} 4 | \newcommand{\ghit}{\href{https://github.com/eddelbuettel/rapiserialize/issues/#1}{##1}} 5 | \newcommand{\cpkg}{\href{https://CRAN.R-project.org/package=#1}{\pkg{#1}}} 6 | 7 | \section{Changes in version 0.1.4 (2024-09-28)}{ 8 | \itemize{ 9 | \item Add C++ namespace in APU header (Dirk in \ghpr{9} closing 10 | \ghit{8}) 11 | \item Several packaging updates: switched to Authors@R, README.md badge 12 | updates, added .editorconfig and cleanup 13 | } 14 | } 15 | 16 | \section{Changes in version 0.1.3 (2024-05-13)}{ 17 | \itemize{ 18 | \item Add an \code{xdr} argument to disable XDR for an approx. 19 | threefold speed increase (Travers Ching and Dirk in \ghpr{6}) 20 | \item Use R_NO_REMAP and Rf_* prefix for API calls 21 | \item Minor continuous integration updates 22 | } 23 | } 24 | 25 | \section{Changes in version 0.1.2 (2022-08-25)}{ 26 | \itemize{ 27 | \item Correct an \code{error()} call (when missing long vector 28 | support) to not use i18n macro 29 | } 30 | } 31 | 32 | \section{Changes in version 0.1.1 (2022-08-07)}{ 33 | \itemize{ 34 | \item Updated CI use to \href{https://eddelbuettel.github.io/r-ci/}{r-ci} 35 | \item Expanded and updated both DESCRIPTION and README.md 36 | \item Updated package internals to register compiled functions 37 | \item Add support for serialization format 3, default remains 2 38 | \item Minor synchronization with upstream 39 | } 40 | } 41 | 42 | \section{Changes in version 0.1.0 (2014-04-19)}{ 43 | \itemize{ 44 | \item Initial public version and CRAN upload 45 | \item Two simple functions \code{serializeToRaw} and 46 | \code{unserializeFromRaw} are provided in this version; each takes 47 | a \code{SEXP} argument and returns a \code{SEXP} argument 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /inst/include/RApiSerializeAPI.h: -------------------------------------------------------------------------------- 1 | /* 2 | * RApiSerialize -- Package to provide Serialization as in the R API 3 | * 4 | * Copyright (C) 2014-2024 Dirk Eddelbuettel 5 | * 6 | * This file is part of RApiSerialize. 7 | * 8 | * RApiSerialize is free software: you can redistribute it and/or modify 9 | * it under the terms of the GNU General Public License as published by 10 | * the Free Software Foundation, either version 2 of the License, or 11 | * (at your option) any later version. 12 | * 13 | * RApiSerialize is distributed in the hope that it will be useful, 14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | * GNU General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU General Public License 19 | * along with RApiSerialize. If not, see . 20 | */ 21 | 22 | 23 | /* 24 | This header file provides the interface used by other packages, 25 | and should be included once per package. At present, the file 26 | contains default arguments to serializeToRaw which make use from 27 | C++ easier. We may remove these in a future release. 28 | */ 29 | 30 | 31 | #ifndef _R_Api_Serialize_API_h_ 32 | #define _R_Api_Serialize_API_h_ 33 | 34 | /* number of R header files (possibly listing too many) */ 35 | #include 36 | #include 37 | #include 38 | #include 39 | #include 40 | 41 | #ifdef HAVE_VISIBILITY_ATTRIBUTE 42 | # define attribute_hidden __attribute__ ((visibility ("hidden"))) 43 | #else 44 | # define attribute_hidden 45 | #endif 46 | 47 | #ifdef __cplusplus 48 | extern "C" { 49 | #endif 50 | 51 | /* provided the interface for the function exported */ 52 | /* in ../src/init.c via R_RegisterCCallable() */ 53 | 54 | SEXP attribute_hidden serializeToRaw(SEXP x, SEXP ver = R_NilValue, 55 | SEXP use_xdr = R_NilValue) { 56 | static SEXP(*fun)(SEXP, SEXP, SEXP) = 57 | (SEXP(*)(SEXP,SEXP,SEXP)) R_GetCCallable("RApiSerialize", "serializeToRaw"); 58 | return fun(x, ver, use_xdr); 59 | } 60 | 61 | SEXP attribute_hidden unserializeFromRaw(SEXP x) { 62 | static SEXP(*fun)(SEXP) = 63 | (SEXP(*)(SEXP)) R_GetCCallable("RApiSerialize", "unserializeFromRaw"); 64 | return fun(x); 65 | } 66 | 67 | #ifdef __cplusplus 68 | } 69 | 70 | /* add a namespace for C++ use */ 71 | namespace R { 72 | inline SEXP serializeToRaw(SEXP x, SEXP ver = R_NilValue, SEXP use_xdr = R_NilValue) { 73 | return ::serializeToRaw(x, ver, use_xdr); 74 | } 75 | inline SEXP unserializeFromRaw(SEXP x) { 76 | return ::unserializeFromRaw(x); 77 | } 78 | } 79 | 80 | #endif /* __cplusplus */ 81 | 82 | #endif /* _R_Api_Serialize_API_h */ 83 | -------------------------------------------------------------------------------- /man/RApiSerialize-package.Rd: -------------------------------------------------------------------------------- 1 | \name{RApiSerialize-package} 2 | \alias{RApiSerialize-package} 3 | \alias{RApiSerialize} 4 | \alias{serializeToRaw} 5 | \alias{unserializeFromRaw} 6 | \docType{package} 7 | \title{ 8 | R API for Serialization 9 | } 10 | \description{ 11 | This package provides other packages with access to the internal 12 | R serialization code. Access is provided at the C function level via the 13 | registered function facility 14 | 15 | For convenience and testing purposes, two wrapper functions are also 16 | provided at the R level. 17 | } 18 | \usage{ 19 | serializeToRaw(obj, version=2, xdr=TRUE) 20 | unserializeFromRaw(obj) 21 | } 22 | \arguments{ 23 | \item{obj}{An R object which is going to (un)serialized by the corresponding function.} 24 | \item{version}{An integer selection the R serialization format. Default is 25 | 2, and values 2 or 3 are currently supported.} 26 | \item{xdr}{A logical value selection (portable) XDR encoding which is the 27 | default. Use \code{FALSE} for speed-up suitable for common little-endian 28 | system at a loss of portability.} 29 | } 30 | \details{ 31 | The C code in this package is taken from R source code, where it 32 | provided for use by R only in a way that renders it inaccessible to 33 | other packages. 34 | 35 | This package aims to fill this gap by providing access to the same 36 | functionality, at the cost of making a copy. 37 | 38 | To use the serialization and deserialization code provided here, a 39 | client package simply adds \code{LinkingTo: RApiSerialize} in its 40 | \code{DESCRIPTION} file and includes the header file 41 | \code{RApiSerializeAPI.h}. 42 | } 43 | \author{ 44 | Dirk Eddelbuettel put together this package, based on earlier work by 45 | Ei-ji Nakama and Junji Nakano who also included the C code from R for 46 | serialization in their \pkg{Rhpc} package. R Core wrote the 47 | underlying C code for use in R itself. 48 | 49 | The package is maintained by Dirk Eddelbuettel. 50 | } 51 | \keyword{package} 52 | \seealso{ 53 | The R source code in \code{src/main/serialize.c}. 54 | } 55 | \examples{ 56 | ## calling the R wrapper 57 | serializeToRaw(letters) 58 | } 59 | -------------------------------------------------------------------------------- /src/init.c: -------------------------------------------------------------------------------- 1 | /* 2 | * RApiSerialize -- Packge to provide Serialization as in the R API 3 | * 4 | * Copyright (C) 2014 - 2024 Dirk Eddelbuettel 5 | * 6 | * This file is part of RApiSerialize. 7 | * 8 | * RApiSerialize is free software: you can redistribute it and/or modify 9 | * it under the terms of the GNU General Public License as published by 10 | * the Free Software Foundation, either version 2 of the License, or 11 | * (at your option) any later version. 12 | * 13 | * RApiSerialize is distributed in the hope that it will be useful, 14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | * GNU General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU General Public License 19 | * along with RApiSerialize. If not, see . 20 | */ 21 | 22 | #include 23 | #include 24 | #include 25 | 26 | 27 | /* function declarations -- could be in external header file if used */ 28 | /* by functions in anotherfile in this package */ 29 | SEXP serializeToRaw(SEXP object, SEXP versionSexp, SEXP useXdrSexp); 30 | SEXP unserializeFromRaw(SEXP object); 31 | 32 | 33 | /* definition of functions provided for .Call() */ 34 | static const R_CallMethodDef callMethods[] = { 35 | { "serializeToRaw", (DL_FUNC) &serializeToRaw, 3 }, 36 | { "unserializeFromRaw", (DL_FUNC) &unserializeFromRaw, 1 }, 37 | { NULL, NULL, 0 } 38 | }; 39 | 40 | 41 | /* functions being called when package is loaded -- used to register */ 42 | /* the functions we are exporting here */ 43 | void R_init_RApiSerialize(DllInfo *info) { 44 | 45 | /* used by external packages linking to internal serialization code from C */ 46 | R_RegisterCCallable("RApiSerialize", "serializeToRaw", 47 | (DL_FUNC) &serializeToRaw); 48 | R_RegisterCCallable("RApiSerialize", "unserializeFromRaw", 49 | (DL_FUNC) &unserializeFromRaw); 50 | 51 | R_registerRoutines(info, 52 | NULL, /* slot for .C */ 53 | callMethods, /* slot for .Call */ 54 | NULL, /* slot for .Fortran */ 55 | NULL); /* slot for .External */ 56 | 57 | R_useDynamicSymbols(info, TRUE); /* controls visibility */ 58 | 59 | } 60 | 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /src/serialize.cpp: -------------------------------------------------------------------------------- 1 | // 2 | // RApiSerialize -- Packge to provide Serialization as in the R API 3 | // 4 | // Copyright (C) 2014 - 2024 Dirk Eddelbuettel 5 | // Copyright (C) 2013 - 2014 Ei-ji Nakama and Junji Nakano 6 | // Copyright (C) 1995 - 2013 The R Core Team 7 | // 8 | // This file is part of RApiSerialize. 9 | // 10 | // RApiSerialize is free software: you can redistribute it and/or modify 11 | // it under the terms of the GNU General Public License as published by 12 | // the Free Software Foundation, either version 2 of the License, or 13 | // (at your option) any later version. 14 | // 15 | // RApiSerialize is distributed in the hope that it will be useful, 16 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | // GNU General Public License for more details. 19 | // 20 | // You should have received a copy of the GNU General Public License 21 | // along with RApiSerialize. If not, see . 22 | 23 | 24 | 25 | // serialize/unserialize from Rhpc package, which takes it from R-3.0.2 26 | // also looked into with binary serialization (as alternative) to ascii 27 | 28 | 29 | // this file does a subset of the things done by src/main/serialize.c, 30 | // inparticular, in the serializeToRaw() function 31 | // version = R_DefaultSerializeVersion; 32 | // type = R_pstream_xdr_format; 33 | // ie no binary or ascii 'type' is supported. Similarly, in 34 | // function unserializeFromRaw() only TYPEOF(object)==RAWSXP is 35 | // supported, and no 'hook' or 'fun' arguments are supported 36 | // 37 | // last checked agains R-devel in March 2015 prior to the R 3.2.0 release 38 | 39 | 40 | /* 41 | * 42 | * From R-3.0.2 archive, src/main/serialize.c 43 | * 44 | */ 45 | /* 46 | * R : A Computer Language for Statistical Data Analysis 47 | * Copyright (C) 1995--2013 The R Core Team 48 | * 49 | * This program is free software; you can redistribute it and/or modify 50 | * it under the terms of the GNU General Public License as published by 51 | * the Free Software Foundation; either version 2 of the License, or 52 | * (at your option) any later version. 53 | * 54 | * This program is distributed in the hope that it will be useful, 55 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 56 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 57 | * GNU General Public License for more details. 58 | * 59 | * You should have received a copy of the GNU General Public License 60 | * along with this program; if not, a copy is available at 61 | * http://www.r-project.org/Licenses/ 62 | */ 63 | 64 | #include 65 | #include 66 | 67 | #ifndef R_NO_REMAP 68 | #define R_NO_REMAP 69 | #endif 70 | 71 | // does not seem to be needed #define USE_INTERNAL 72 | #include 73 | 74 | static const int R_DefaultSerializeVersion = 2; 75 | 76 | 77 | /* 78 | * Persistent Memory Streams 79 | */ 80 | 81 | typedef struct membuf_st { 82 | R_xlen_t size; 83 | R_xlen_t count; 84 | unsigned char *buf; 85 | } *membuf_t; 86 | 87 | #define MAXELTSIZE 8192 88 | #define INCR MAXELTSIZE 89 | 90 | static void resize_buffer(membuf_t mb, R_xlen_t needed) { 91 | unsigned char *tmp; 92 | if (needed > R_XLEN_T_MAX) 93 | Rf_error("serialization is too large to store in a raw vector"); 94 | #ifdef LONG_VECTOR_SUPPORT 95 | if(needed < 10000000) /* ca 10MB */ 96 | needed = (1+2*needed/INCR) * INCR; 97 | else 98 | needed = (R_xlen_t)((1+1.2*(double)needed/INCR) * INCR); 99 | #else 100 | if(needed < 10000000) /* ca 10MB */ 101 | needed = (1+2*needed/INCR) * INCR; 102 | else if(needed < 1700000000) /* close to 2GB/1.2 */ 103 | needed = (R_xlen_t)((1+1.2*(double)needed/INCR) * INCR); 104 | else if(needed < INT_MAX - INCR) 105 | needed = (1+needed/INCR) * INCR; 106 | #endif 107 | tmp = (unsigned char*) realloc((void*) mb->buf, (size_t) needed); 108 | if (tmp == NULL) { 109 | free(mb->buf); mb->buf = NULL; 110 | Rf_error("cannot allocate buffer"); 111 | } else mb->buf = tmp; 112 | mb->size = needed; 113 | } 114 | 115 | static void OutCharMem(R_outpstream_t stream, int c) 116 | { 117 | membuf_t mb = (membuf_t) stream->data; 118 | if (mb->count >= mb->size) 119 | resize_buffer(mb, mb->count + 1); 120 | mb->buf[mb->count++] = (char) c; 121 | } 122 | 123 | static void OutBytesMem(R_outpstream_t stream, void *buf, int length) 124 | { 125 | membuf_t mb = (membuf_t) stream->data; 126 | R_xlen_t needed = mb->count + (R_xlen_t) length; 127 | #ifndef LONG_VECTOR_SUPPORT 128 | /* There is a potential overflow here on 32-bit systems */ 129 | if ((double) mb->count + length > (double) INT_MAX) 130 | Rf_error("serialization is too large to store in a raw vector"); 131 | #endif 132 | if (needed > mb->size) resize_buffer(mb, needed); 133 | memcpy(mb->buf + mb->count, buf, length); 134 | mb->count = needed; 135 | } 136 | 137 | static int InCharMem(R_inpstream_t stream) 138 | { 139 | membuf_t mb = (membuf_t) stream->data; 140 | if (mb->count >= mb->size) 141 | Rf_error("read error"); 142 | return mb->buf[mb->count++]; 143 | } 144 | 145 | static void InBytesMem(R_inpstream_t stream, void *buf, int length) 146 | { 147 | membuf_t mb = (membuf_t) stream->data; 148 | if (mb->count + (R_xlen_t) length > mb->size) 149 | Rf_error("read error"); 150 | memcpy(buf, mb->buf + mb->count, length); 151 | mb->count += length; 152 | } 153 | 154 | static void InitMemInPStream(R_inpstream_t stream, membuf_t mb, 155 | void *buf, R_xlen_t length, 156 | SEXP (*phook)(SEXP, SEXP), SEXP pdata) 157 | { 158 | mb->count = 0; 159 | mb->size = length; 160 | mb->buf = (unsigned char*) buf; 161 | R_InitInPStream(stream, (R_pstream_data_t) mb, R_pstream_any_format, 162 | InCharMem, InBytesMem, phook, pdata); 163 | } 164 | 165 | static void InitMemOutPStream(R_outpstream_t stream, membuf_t mb, 166 | R_pstream_format_t type, int version, 167 | SEXP (*phook)(SEXP, SEXP), SEXP pdata) 168 | { 169 | mb->count = 0; 170 | mb->size = 0; 171 | mb->buf = NULL; 172 | R_InitOutPStream(stream, (R_pstream_data_t) mb, type, version, 173 | OutCharMem, OutBytesMem, phook, pdata); 174 | } 175 | 176 | static void free_mem_buffer(void *data) 177 | { 178 | membuf_t mb = (membuf_t) data; 179 | if (mb->buf != NULL) { 180 | unsigned char *buf = mb->buf; 181 | mb->buf = NULL; 182 | free(buf); 183 | } 184 | } 185 | 186 | static SEXP CloseMemOutPStream(R_outpstream_t stream) 187 | { 188 | SEXP val; 189 | membuf_t mb = (membuf_t) stream->data; 190 | /* duplicate check, for future proofing */ 191 | #ifndef LONG_VECTOR_SUPPORT 192 | if(mb->count > INT_MAX) 193 | Rf_error("serialization is too large to store in a raw vector"); 194 | #endif 195 | PROTECT(val = Rf_allocVector(RAWSXP, mb->count)); 196 | memcpy(RAW(val), mb->buf, mb->count); 197 | free_mem_buffer(mb); 198 | UNPROTECT(1); 199 | return val; 200 | } 201 | 202 | /** ---- **/ 203 | 204 | extern "C" SEXP serializeToRaw(SEXP object, SEXP versionSexp = R_NilValue, 205 | SEXP useXdrSexp = R_NilValue) { 206 | struct R_outpstream_st out; 207 | R_pstream_format_t type; 208 | int version; 209 | struct membuf_st mbs; 210 | SEXP val; 211 | 212 | if (versionSexp == R_NilValue) { 213 | version = R_DefaultSerializeVersion; 214 | } else { 215 | version = Rf_asInteger(versionSexp); 216 | } 217 | if (version == NA_INTEGER || version <= 0) { 218 | Rf_error("bad version value"); 219 | } 220 | 221 | 222 | //type = R_pstream_binary_format; 223 | //type = R_pstream_ascii_format; 224 | //type = R_pstream_xdr_format; 225 | if (useXdrSexp == R_NilValue) { 226 | type = R_pstream_xdr_format; 227 | } else { 228 | int use_xdr = Rf_asLogical(useXdrSexp); 229 | if (use_xdr) { 230 | type = R_pstream_xdr_format; 231 | } else { 232 | type = R_pstream_binary_format; 233 | } 234 | } 235 | 236 | /* set up a context which will free the buffer if there is an error */ 237 | 238 | InitMemOutPStream(&out, &mbs, type, version, NULL, R_NilValue); 239 | R_Serialize(object, &out); 240 | 241 | val = CloseMemOutPStream(&out); 242 | 243 | /* end the context after anything that could raise an error but before 244 | calling OutTerm so it doesn't get called twice */ 245 | 246 | return val; 247 | } 248 | 249 | extern "C" SEXP unserializeFromRaw(SEXP object) { 250 | 251 | struct R_inpstream_st in; 252 | 253 | /* We might want to read from a long raw vector */ 254 | struct membuf_st mbs; 255 | 256 | if (TYPEOF(object) == RAWSXP) { 257 | void *data = RAW(object); 258 | R_xlen_t length = XLENGTH(object); 259 | InitMemInPStream(&in, &mbs, data, length, NULL, NULL); 260 | return R_Unserialize(&in); 261 | } 262 | Rf_error("can't unserialize object"); 263 | return(R_UnboundValue); 264 | } 265 | 266 | 267 | -------------------------------------------------------------------------------- /tests/simpleTests.R: -------------------------------------------------------------------------------- 1 | 2 | library(RApiSerialize) 3 | 4 | data(trees) 5 | fit <- lm(log(Girth) ~ log(Volume) + log(Height), trees) 6 | 7 | ## serialize and use R's unserialize 8 | identical(unserialize(serializeToRaw(fit)), fit) 9 | identical(unserialize(serializeToRaw(fit,2)), fit) 10 | identical(unserialize(serializeToRaw(fit,3)), fit) 11 | ## serialize and use our unserialize 12 | identical(unserializeFromRaw(serializeToRaw(fit)), fit) 13 | identical(unserializeFromRaw(serializeToRaw(fit,2)), fit) 14 | identical(unserializeFromRaw(serializeToRaw(fit,3)), fit) 15 | ## R's serialize and our unserialize 16 | identical(unserializeFromRaw(serialize(fit, NULL)), fit) 17 | ## R's serialize and R's unserialize (doh) 18 | identical(unserialize(serialize(fit, NULL)), fit) 19 | ## serialize and use our unserialize, no xdr 20 | identical(unserializeFromRaw(serializeToRaw(fit,2,TRUE)), fit) 21 | identical(unserializeFromRaw(serializeToRaw(fit,3,TRUE)), fit) 22 | identical(unserializeFromRaw(serializeToRaw(fit,2,FALSE)), fit) 23 | identical(unserializeFromRaw(serializeToRaw(fit,3,FALSE)), fit) 24 | -------------------------------------------------------------------------------- /tests/simpleTests.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 4.4.0 (2024-04-24) -- "Puppy Cup" 3 | Copyright (C) 2024 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > 19 | > library(RApiSerialize) 20 | > 21 | > data(trees) 22 | > fit <- lm(log(Girth) ~ log(Volume) + log(Height), trees) 23 | > 24 | > ## serialize and use R's unserialize 25 | > identical(unserialize(serializeToRaw(fit)), fit) 26 | [1] TRUE 27 | > identical(unserialize(serializeToRaw(fit,2)), fit) 28 | [1] TRUE 29 | > identical(unserialize(serializeToRaw(fit,3)), fit) 30 | [1] TRUE 31 | > ## serialize and use our unserialize 32 | > identical(unserializeFromRaw(serializeToRaw(fit)), fit) 33 | [1] TRUE 34 | > identical(unserializeFromRaw(serializeToRaw(fit,2)), fit) 35 | [1] TRUE 36 | > identical(unserializeFromRaw(serializeToRaw(fit,3)), fit) 37 | [1] TRUE 38 | > ## R's serialize and our unserialize 39 | > identical(unserializeFromRaw(serialize(fit, NULL)), fit) 40 | [1] TRUE 41 | > ## R's serialize and R's unserialize (doh) 42 | > identical(unserialize(serialize(fit, NULL)), fit) 43 | [1] TRUE 44 | > ## serialize and use our unserialize, no xdr 45 | > identical(unserializeFromRaw(serializeToRaw(fit,2,TRUE)), fit) 46 | [1] TRUE 47 | > identical(unserializeFromRaw(serializeToRaw(fit,3,TRUE)), fit) 48 | [1] TRUE 49 | > identical(unserializeFromRaw(serializeToRaw(fit,2,FALSE)), fit) 50 | [1] TRUE 51 | > identical(unserializeFromRaw(serializeToRaw(fit,3,FALSE)), fit) 52 | [1] TRUE 53 | > 54 | > proc.time() 55 | user system elapsed 56 | 0.355 0.481 0.174 57 | --------------------------------------------------------------------------------