Get contents of R symbol table

symbol_table.R

# get_symbols() returns all symbols that are registered in R's symbol table.
#
# new_symbols() returns all symbols that have been added since the last time
# new_symbols() was run. If you want to test whether your code causes the symbol
# table to grow, run new_symbols(), then run your code, then run new_symbols()
# again.

get_symbols <- inline::cfunction(
  includes = "
    #define HSIZE   49157 /* The size of the hash table for symbols */
    extern SEXP* R_SymbolTable;
  ",
  body = "
    int symbol_count = 0;
    SEXP s;
    int j;
    for (j = 0; j < HSIZE; j++) {
      for (s = R_SymbolTable[j]; s != R_NilValue; s = CDR(s)) {
        if (CAR(s) != R_NilValue) {
          symbol_count++;
        }
      }
    }
  
  
    SEXP result = PROTECT(Rf_allocVector(STRSXP, symbol_count));
    symbol_count = 0;
    for (j = 0; j < HSIZE; j++) {
      for (s = R_SymbolTable[j]; s != R_NilValue; s = CDR(s)) {
        if (CAR(s) != R_NilValue) {
          SET_STRING_ELT(result, symbol_count, PRINTNAME(CAR(s)));
          symbol_count++;
        }
      }
    }
  
    UNPROTECT(1);
    return result;
  "
)

# Test it out
get_symbols()



# new_symbols() returns a character vector of symbols that have been added since
# the last time it was run.
last_symbols <- get_symbols()
new_symbols <- function() {
  cur_symbols <- get_symbols()
  res <- setdiff(cur_symbols, last_symbols)
  last_symbols <<- cur_symbols
  res
}

# Example

# The first couple times it's run, R might do something that adds symbols, like
# load the compiler package. Run it a bunch of times until it returns
# character(0).
new_symbols()
new_symbols()
new_symbols()
# character(0)


# After R stops loading things, add a new symbol and test if it's detected.
abcdefg <- 1
new_symbols()
#> [1] "abcdefg"

symbol_table_linux.R

# This is an attempt to get the symbol table on Linux as well as Mac. Seems to
# work in some Linuxes, like with RD on wch1/r-debug, but not others, like R on
# Ubuntu. On yet others, like rstudio.cloud, it crashes.

gen_includes <- function() {
  if (Sys.info()[['sysname']] == 'Darwin') {

    return("
      #define HSIZE   49157 /* The size of the hash table for symbols, from Defn.h */
      extern SEXP* R_SymbolTable;
    ")

  } else if (Sys.info()[['sysname']] == 'Linux') {

    # File with process info /proc/1234/maps
    process_map_file <- file.path("/proc", Sys.getpid(), "maps")

    lib_r_entries <- readLines(process_map_file)
    lib_r_entries <- lib_r_entries[grep("libR\\.so$", lib_r_entries)]

    # Like "/usr/lib/R/lib/libR.so"
    lib_r_path <- sub(".* ", "", lib_r_entries[1])

    # The memory offset
    mem_offset <- sub("-.*", "", lib_r_entries)
    # Just use first one (hopefully this works on all platforms)
    mem_offset <- paste0("0x", mem_offset[1])

    # (Un-offsetted) Memory address for R_SymbolTable
    address <- system2("nm", c("-a", lib_r_path), stdout = TRUE)
    if (length(address) == 0) {
      stop("Sorry, can't find address of R_SymbolTable on this platform ",
           "because symbols have been stripped from ", lib_r_path, ".")
    }
    address <- address[grep("R_SymbolTable", address)]
    address <- sub("([0-9a-z]+).*", "\\1", address, perl = TRUE)
    address <- paste0("0x", address)

    return(sprintf("
      #define HSIZE   49157 /* The size of the hash table for symbols, from Defn.h */
      SEXP* R_SymbolTable = *((SEXP**) (%s + %s));",
      address,
      mem_offset
    ))
  }

  stop("Sorry, can't find address of R_SymbolTable on this platform ",
       " (only Mac and Linux supported).")
}

get_symbols <- inline::cfunction(
  includes = gen_includes(),
  body = "
    int symbol_count = 0;
    SEXP s;
    int j;
    for (j = 0; j < HSIZE; j++) {
      for (s = R_SymbolTable[j]; s != R_NilValue; s = CDR(s)) {
        if (CAR(s) != R_NilValue) {
          symbol_count++;
        }
      }
    }
  
    SEXP result = PROTECT(Rf_allocVector(STRSXP, symbol_count));
    symbol_count = 0;
    for (j = 0; j < HSIZE; j++) {
      for (s = R_SymbolTable[j]; s != R_NilValue; s = CDR(s)) {
        if (CAR(s) != R_NilValue) {
          SET_STRING_ELT(result, symbol_count, PRINTNAME(CAR(s)));
          symbol_count++;
        }
      }
    }
  
    UNPROTECT(1);
    return result;
  "
)

get_symbols()

zz-app.R

# Shiny app that shows growth of symbol table

library(shiny)

ui <- fluidPage(
  titlePanel("Symbol table demo app"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30)
    ),
    mainPanel(
      plotOutput("distPlot"),
      verbatimTextOutput("symbols")
    )
  )
)

server <- function(input, output) {
  output$distPlot <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })

  
  # Code for showing new symbols
  last_symbols <- character(0)
  cur_symbols <- character(0)

  output$symbols <- renderText({
    invalidateLater(1000)
    last_symbols <<- cur_symbols
    cur_symbols <<- get_symbols()

    # Only update the text when there are new symbols
    if (length(last_symbols) == length(cur_symbols)) {
      req(FALSE, cancelOutput = TRUE)
    }

    new_symbols <- setdiff(cur_symbols, last_symbols)
    paste0(
      Sys.time(), "\n",
      "Total symbols: ", length(cur_symbols), "\n",
      "New symbols:   ", length(new_symbols), "\n",
      "<Displaying up 200 new symbols>\n\n",
      paste(head(new_symbols, 200), collapse = "\n")
    )
  })
}

shinyApp(ui = ui, server = server)