From d75357cf059da0cee58063e9d25cc39f16b3868a Mon Sep 17 00:00:00 2001
From: Lionel Henry <lionel.hry@gmail.com>
Date: Fri, 3 Dec 2021 09:44:41 +0100
Subject: [PATCH] Add `root_precious_list()`

---
 DESCRIPTION               |  1 +
 NAMESPACE                 |  1 +
 NEWS.md                   |  5 +++++
 R/snapshot.R              | 40 +++++++++++++++++++++++++++++++++++----
 man/root_precious_list.Rd | 11 +++++++++++
 man/roots.Rd              | 11 ++++++++---
 6 files changed, 62 insertions(+), 7 deletions(-)
 create mode 100644 man/root_precious_list.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index 411dec6..7373f40 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -20,6 +20,7 @@ Imports:
     vctrs
 Suggests: 
     cli,
+    cpp11,
     covr,
     crayon,
     igraph,
diff --git a/NAMESPACE b/NAMESPACE
index 6e97730..50610ec 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -24,5 +24,6 @@ export(mem_stash)
 export(obj_address)
 export(root_cpp11)
 export(root_ns_registry)
+export(root_precious_list)
 import(rlang)
 useDynLib(memtools, .registration = TRUE)
diff --git a/NEWS.md b/NEWS.md
index 90702e3..e101ea7 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,10 @@
 # memtools (development version)
 
+- Added `root_precious_list()` to retrieve the R precious list. This
+  requires a custom build of R where `R_PreciousList` is redefined as
+  a non-static symbol.
+
+
 # memtools 0.1.0
 
 Initial release
diff --git a/R/snapshot.R b/R/snapshot.R
index 6e20db2..a74e22b 100644
--- a/R/snapshot.R
+++ b/R/snapshot.R
@@ -173,13 +173,17 @@ mem_stash <- function(...) {
 #' @description
 #' These functions return useful starting points to supply to
 #' [mem_snapshot()].
-#' 
+#'
 #' * `root_ns_registry()` returns R's namespace registry as a list. It
 #'   contains all the namespaces currently loaded in the R session.
 #'
 #' * `root_cpp11()` returns the precious list of cpp11. This is a
 #'   doubly linked list preserved in R's own precious list.
 #'
+#' * `root_precious_list()` returns R's precious list. However this
+#'   requires a custom build of R where `R_PreciousList` is exposed as a
+#'   non-static symbol.
+#'
 #' @section The precious list:
 #' The R precious list is (as currently implemented) a pairlist of
 #' objects currently protected via the C API function
@@ -193,9 +197,11 @@ mem_stash <- function(...) {
 #'
 #' R currently does not provide an easy way to get the precious list.
 #' So you will need to either patch R to expose it (e.g. remove its
-#' `static` qualifier) or run R though a debugger like `gdb` or
-#' `lldb`. The latter option is simpler. Once in the debugger, use `p`
-#' to print the address of the list:
+#' `static` qualifier) so that you can call `root_precious_list()`, or
+#' run R though a debugger like `gdb` or `lldb`.
+#'
+#' If you choose to use a debugger, use `p` to print the address of
+#' the list:
 #'
 #' ```
 #' p R_PreciousList
@@ -240,6 +246,32 @@ root_ns_registry <- function() {
   as.list(.Call(ffi_root_ns_registry))
 }
 
+the <- new_environment()
+
+precious_list_source <- "
+  #define R_NO_REMAP
+  #include <Rinternals.h>
+
+  extern SEXP R_PreciousList;
+
+  [[cpp11::register]]
+  SEXP precious_list() {
+    return R_PreciousList;
+  }
+"
+#' rdname roots
+#' @export
+root_precious_list <- function() {
+  check_installed(c("cpp11", "decor"))
+
+  if (is_null(the$precious_list)) {
+    cpp11::cpp_source(code = precious_list_source)
+    the$precious_list <- precious_list
+  }
+
+  the$precious_list()
+}
+
 #' Find all shortest or simple paths
 #'
 #' Wrappers around [igraph::all_shortest_paths()] and
diff --git a/man/root_precious_list.Rd b/man/root_precious_list.Rd
new file mode 100644
index 0000000..f4a34bb
--- /dev/null
+++ b/man/root_precious_list.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/snapshot.R
+\name{root_precious_list}
+\alias{root_precious_list}
+\title{rdname roots}
+\usage{
+root_precious_list()
+}
+\description{
+rdname roots
+}
diff --git a/man/roots.Rd b/man/roots.Rd
index e1cbe00..0331e72 100644
--- a/man/roots.Rd
+++ b/man/roots.Rd
@@ -18,6 +18,9 @@ These functions return useful starting points to supply to
 contains all the namespaces currently loaded in the R session.
 \item \code{root_cpp11()} returns the precious list of cpp11. This is a
 doubly linked list preserved in R's own precious list.
+\item \code{root_precious_list()} returns R's precious list. However this
+requires a custom build of R where \code{R_PreciousList} is exposed as a
+non-static symbol.
 }
 }
 \section{The precious list}{
@@ -34,9 +37,11 @@ list.
 
 R currently does not provide an easy way to get the precious list.
 So you will need to either patch R to expose it (e.g. remove its
-\code{static} qualifier) or run R though a debugger like \code{gdb} or
-\code{lldb}. The latter option is simpler. Once in the debugger, use \code{p}
-to print the address of the list:\preformatted{p R_PreciousList
+\code{static} qualifier) so that you can call \code{root_precious_list()}, or
+run R though a debugger like \code{gdb} or \code{lldb}.
+
+If you choose to use a debugger, use \code{p} to print the address of
+the list:\preformatted{p R_PreciousList
 #> (SEXP) $0 = 0x000000010107cf58
 }