r-print-value-from-c

r-print.c

#include <R_ext/Parse.h>

const char* r_print_value(SEXP x) {
  // Assign `x` into the global environment under the name `.debug`
  Rf_defineVar(Rf_install(".debug"), x, R_GlobalEnv);

  // This is the R code that we want to run to print `.debug` and then capture all its printed output
  const char* command = "paste0(capture.output(print(.debug)), collapse = '\n')";
  SEXP command_sexp = PROTECT(Rf_allocVector(STRSXP, 1));
  SET_STRING_ELT(command_sexp, 0, Rf_mkCharCE(command, CE_UTF8));

  // Parse that command into an actual R expression we can evaluate
  // (This is a little fiddly because `R_ParseVector()` returns a vector of expressions,
  // but we know we only expect to get exactly 1 expression back)
  ParseStatus status;
  SEXP expressions = PROTECT(R_ParseVector(command_sexp, -1, &status, R_NilValue));
  if (status != PARSE_OK) {
    Rf_error("failed");
  }
  if (Rf_xlength(expressions) != 1) {
    Rf_error("expected a single expression");
  }
  SEXP command_expr = VECTOR_ELT(expressions, 0);

  // Ok, now evaluate the R code `command` from above in the global env, where `.debug` exists
  SEXP output = Rf_eval(command_expr, R_GlobalEnv);
  R_PreserveObject(output);

  // We expect the result to be a character vector of length 1 containing the captured output
  SEXP elt = STRING_ELT(output, 0);
  const char* v_elt = CHAR(elt);

  UNPROTECT(2);
  return v_elt;
}

another thought, arbitrary code execution in the R_CurrentEnv() (assuming it worked correctly) - i.e. call r_execute_and_capture("1 + 1")

const char* r_execute_and_capture(const char* x) {
  char command[500];
  snprintf(command, 500, "base::paste0(utils::capture.output(base::print(%s)), collapse = '\n')", x);
  SEXP command_sexp = PROTECT(Rf_allocVector(STRSXP, 1));
  SET_STRING_ELT(command_sexp, 0, Rf_mkCharCE(command, CE_UTF8));

  // Parse that command into an actual R expression we can evaluate
  // (This is a little fiddly because `R_ParseVector()` returns a vector of expressions,
  // but we know we only expect to get exactly 1 expression back)
  ParseStatus status;
  SEXP expressions = PROTECT(R_ParseVector(command_sexp, -1, &status, R_NilValue));
  if (status != PARSE_OK) {
    Rf_error("failed");
  }
  if (Rf_xlength(expressions) != 1) {
    Rf_error("expected a single expression");
  }
  SEXP command_expr = VECTOR_ELT(expressions, 0);

  // Ok, now evaluate the R code `command` from above in the global env, where `.debug` exists
  // TODO: Want to eval this in a try catch so errors dont propagate to the R console
  SEXP output = Rf_eval(command_expr, R_GetCurrentEnv());
  R_PreserveObject(output);

  // We expect the result to be a character vector of length 1 containing the captured output
  SEXP elt = STRING_ELT(output, 0);
  const char* v_elt = CHAR(elt);

  UNPROTECT(2);
  return v_elt;
}

Thanks so much for this, Davis! @hturner and I used this today and it was super great.

Just to build on this, here is what we did in order to get this to work with Devel R.

We created a C file, named zzz.c in src/main/zzz.c, and also had to have the following header files in the below order. Then we also had to add a line to the (already existing) makefile, Makefile.in in src/main/Makefile.in, where we added a line zzz.c under SOURCES_C = \.

Then we did the regular debug stuff:

1. Sys.getpid()
2. Copy pid into LLDB debugger
3. Add breakpoint in C code
4. Run code to trigger breakpoints
5. Run call r_execute_and_capture(a) to see output.

Thanks again for your help with this!

#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <Defn.h>
#include <Internal.h>
#include <Rinternals.h>
#include <R_ext/Parse.h>

const char* r_print_value(SEXP x) {
  // Assign `x` into the global environment under the name `.debug`
  Rf_defineVar(Rf_install(".debug"), x, R_GlobalEnv);

  // This is the R code that we want to run to print `.debug` and then capture all its printed output
  const char* command = "paste0(capture.output(print(.debug)), collapse = '\n')";
  SEXP command_sexp = PROTECT(Rf_allocVector(STRSXP, 1));
  SET_STRING_ELT(command_sexp, 0, Rf_mkCharCE(command, CE_UTF8));

  // Parse that command into an actual R expression we can evaluate
  // (This is a little fiddly because `R_ParseVector()` returns a vector of expressions,
  // but we know we only expect to get exactly 1 expression back)
  ParseStatus status;
  SEXP expressions = PROTECT(R_ParseVector(command_sexp, -1, &status, R_NilValue));
  if (status != PARSE_OK) {
    Rf_error("failed");
  }
  if (Rf_xlength(expressions) != 1) {
    Rf_error("expected a single expression");
  }
  SEXP command_expr = VECTOR_ELT(expressions, 0);

  // Ok, now evaluate the R code `command` from above in the global env, where `.debug` exists
  SEXP output = Rf_eval(command_expr, R_GlobalEnv);
  R_PreserveObject(output);

  // We expect the result to be a character vector of length 1 containing the captured output
  SEXP elt = STRING_ELT(output, 0);
  const char* v_elt = CHAR(elt);

  UNPROTECT(2);
  return v_elt;
}

const char* r_execute_and_capture(const char* x) {
  char command[500];
  snprintf(command, 500, "base::paste0(utils::capture.output(base::print(%s)), collapse = '\n')", x);
  SEXP command_sexp = PROTECT(Rf_allocVector(STRSXP, 1));
  SET_STRING_ELT(command_sexp, 0, Rf_mkCharCE(command, CE_UTF8));

  // Parse that command into an actual R expression we can evaluate
  // (This is a little fiddly because `R_ParseVector()` returns a vector of expressions,
  // but we know we only expect to get exactly 1 expression back)
  ParseStatus status;
  SEXP expressions = PROTECT(R_ParseVector(command_sexp, -1, &status, R_NilValue));
  if (status != PARSE_OK) {
    Rf_error("failed");
  }
  if (Rf_xlength(expressions) != 1) {
    Rf_error("expected a single expression");
  }
  SEXP command_expr = VECTOR_ELT(expressions, 0);

  // Ok, now evaluate the R code `command` from above in the global env, where `.debug` exists
  // TODO: Want to eval this in a try catch so errors dont propagate to the R console
  SEXP output = Rf_eval(command_expr, R_GetCurrentEnv());
  R_PreserveObject(output);

  // We expect the result to be a character vector of length 1 containing the captured output
  SEXP elt = STRING_ELT(output, 0);
  const char* v_elt = CHAR(elt);

  UNPROTECT(2);
  return v_elt;
}

#
# ${R_HOME}/src/main/Makefile

VPATH = @srcdir@
srcdir = @srcdir@
top_srcdir = @top_srcdir@

top_builddir = ../..
subdir = src/main
# next is needed for shared BLAS
R_HOME=$(top_builddir)

include $(top_builddir)/Makeconf

SOURCES_C = \
	CommandLineArgs.c \
	Rdynload.c Renviron.c RNG.c \
	agrep.c altclasses.c altrep.c apply.c arithmetic.c array.c attrib.c \
	bind.c builtin.c \
	character.c clippath.c coerce.c \
	colors.c complex.c connections.c context.c cum.c \
	dcf.c datetime.c debug.c deparse.c devices.c \
	dotcode.c dounzip.c dstruct.c duplicate.c \
	edit.c engine.c envir.c errors.c eval.c \
	flexiblas.c format.c \
	gevents.c gram.c gram-ex.c graphics.c grep.c \
	identical.c inlined.c inspect.c internet.c iosupport.c \
	lapack.c list.c localecharset.c logic.c \
	machine.c main.c mapply.c mask.c match.c memory.c \
	names.c \
	objects.c options.c \
	paste.c patterns.c platform.c plot.c plot3d.c plotmath.c \
	print.c printarray.c printvector.c printutils.c qsort.c \
	radixsort.c random.c raw.c registration.c relop.c rlocale.c \
	saveload.c scan.c seq.c serialize.c sort.c source.c split.c \
	sprintf.c startup.c subassign.c subscript.c subset.c summary.c sysutils.c \
	times.c \
	unique.c util.c \
	version.c \
	g_alab_her.c g_cntrlify.c g_fontdb.c g_her_glyph.c \
	zzz.c

SOURCES_F =  xxxpr.f

## If the substitutes are needed, the corresponding objects are put by
## configure in @LIBOBJS@ @ALLOCA@
EXTRA_SOURCES_C = \
	Rmain.c alloca.c mkdtemp.c strdup.c strncasecmp.c

DEPENDS = $(SOURCES_C:.c=.d) $(EXTRA_SOURCES_C:.c=.d)
SOURCES = $(SOURCES_C) $(SOURCES_F)
OBJECTS = $(SOURCES_C:.c=.o) $(SOURCES_F:.f=.o) @LIBOBJS@ @ALLOCA@
HEADERS = \
	RBufferUtils.h Rcomplex.h Rstrptime.h \
	arithmetic.h \
	basedecl.h \
	contour-common.h \
	datetime.h \
	duplicate.h \
	gzio.h \
	machar.c \
	qsort-body.c \
	rlocale_data.h rlocale_tolower.h rlocale_toupper.h rlocale_widths.h \
	split-incl.c \
	unzip.h \
	valid_utf8.h \
	xspline.c \
	g_cntrlify.h g_control.h g_extern.h g_her_metr.h g_jis.h


distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
DISTFILES = Makefile.in Makefile.win \
	$(HEADERS) \
	$(SOURCES_C) \
	$(EXTRA_SOURCES_C) \
	$(SOURCES_F) \
	gram.y

TRE_CPPFLAGS = @BUILD_TRE_TRUE@ -I$(top_srcdir)/src/extra
XDR_CPPFLAGS = @BUILD_XDR_TRUE@ -I$(top_srcdir)/src/extra/xdr
@BUILD_XDR_FALSE@XDR_CPPFLAGS = @TIRPC_CPPFLAGS@

## platform.c needs $(CURL_CPPFLAGS).
ALL_CPPFLAGS = $(TRE_CPPFLAGS) $(XDR_CPPFLAGS) $(R_XTRA_CPPFLAGS) \
  $(CURL_CPPFLAGS) $(CPPFLAGS) -I$(top_srcdir)/src/nmath $(DEFS)
@WANT_R_SHLIB_TRUE@ALL_CFLAGS = $(ALL_CFLAGS_LO)
@WANT_R_SHLIB_TRUE@ALL_FFLAGS = $(ALL_FFLAGS_LO)
@WANT_R_SHLIB_FALSE@ALL_FFLAGS = $(ALL_FFLAGS_PIE)


## use an explicit library: there might be an unsatisfactory -lintl around
R_TRE = @BUILD_TRE_TRUE@ ../extra/tre/libtre.a
R_XDR = @BUILD_XDR_TRUE@ ../extra/xdr/libxdr.a
R_LIBINTL = @BUILD_LIBINTL_TRUE@ ../extra/intl/libintl.a
R_TZONE = @BUILD_TZONE_TRUE@ ../extra/tzone/libtz.a

MAIN_LIBS = ../unix/libunix.a ../appl/libappl.a ../nmath/libnmath.a
MAIN_OBJS = `ls ../unix/*.o ../appl/*.o ../nmath/*.o`
EXTRA_STATIC_LIBS = $(R_TRE) $(R_XDR) $(R_LIBINTL) $(R_TZONE)
STATIC_LIBS = $(MAIN_LIBS) $(EXTRA_STATIC_LIBS)

EXTRA_LIBS = $(BLAS_LIBS) $(FLIBS) @R_XTRA_LIBS@ @LIBINTL@ $(READLINE_LIBS) $(LIBS) @BUILD_NEW_ACCELERATE_TRUE@ -framework Accelerate

R_binary = R.bin
R_bin_OBJECTS = Rmain.o @WANT_R_SHLIB_FALSE@$(OBJECTS)
@WANT_R_SHLIB_FALSE@R_bin_LDADD = $(MAIN_OBJS) $(EXTRA_STATIC_LIBS) $(EXTRA_LIBS)
## Linked against -lRblas because -lR is and otherwise ld complains.
@WANT_R_SHLIB_TRUE@R_bin_LDADD = -lR @BLAS_SHLIB_TRUE@-lRblas
## This should depend on MAIN_OBJS not MAIN_LIBS, but we can't use that.
## There is also a dependence on libRblas when that is internal and static.
@WANT_R_SHLIB_FALSE@R_bin_DEPENDENCIES = $(MAIN_LIBS) $(EXTRA_STATIC_LIBS)@USE_EXPORTFILES_TRUE@ $(top_builddir)/etc/R.exp

libR_la = libR$(R_DYLIB_EXT)
libR_la_OBJECTS = $(OBJECTS)
libR_la_LIBADD =  $(MAIN_OBJS) $(EXTRA_STATIC_LIBS) $(EXTRA_LIBS) @WANT_R_SHLIB_TRUE@ @USE_EXPORTFILES_TRUE@ -Wl,-bE:$(top_builddir)/etc/R.exp
libR_la_DEPENDENCIES = $(STATIC_LIBS) $(R_TZONE) @WANT_R_SHLIB_TRUE@ @USE_EXPORTFILES_TRUE@ $(top_builddir)/etc/R.exp

## The next is needed for macOS only at present
LIBR_LDFLAGS = @LIBR_LDFLAGS@


all: R

Makefile: $(srcdir)/Makefile.in \
  $(top_builddir)/config.status \
  ../include/config.h \
  ../include/Rversion.h \
  $(SOURCES_C) $(EXTRA_SOURCES_C)
	@cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@

Makedeps: Makefile $(DEPENDS)
	@cat $(DEPENDS) >> Makefile
	@touch $@

## This target has been changed to ensure that R.bin and libR get
## installed in the build tree if necessary, even if the corresponding
## objects are not re-made.
## Note that dependencies in the test Makefiles used to depend on these objects,
## so copy-if-change is used.
R: Makedeps
@WANT_R_SHLIB_TRUE@	@$(MAKE) install-lib-local
@WANT_R_STATIC_TRUE@	@$(MAKE) install-static-local
	@$(MAKE) install-bin-local


## is this portable?  Documented as GNU extension.
../include/config.h ../include/Rversion.h:
	(cd $(@D); $(MAKE) $(@F))

$(R_binary): $(R_bin_OBJECTS) $(R_bin_DEPENDENCIES)
	$(MAIN_LINK) -o $@ $(R_bin_OBJECTS) $(R_bin_LDADD)

libR.a: $(OBJECTS) $(STATIC_LIBS)
	-@mkdir libs
	@(cd libs; for l in $(STATIC_LIBS); do $(AR) -x ../$$l; done)
	@rm -Rf $@
	$(AR) -cr $@ $(OBJECTS) libs/*o
	$(RANLIB) $@
	@rm -Rf libs

install-bin-local: $(R_binary)
	@$(MAKE) DESTDIR="" rhome="$(abs_top_builddir)" install-bin

install-static-local: libR.a
	@$(MAKE) DESTDIR="" rhome="$(abs_top_builddir)" install-static

$(top_builddir)/etc/R.exp: $(OBJECTS) $(MAIN_LIBS)
	@$(SHELL) $(top_srcdir)/tools/ldAIX4 -o $@ $(OBJECTS) $(MAIN_LIBS)

## is this portable?  Documented as GNU extension.
$(MAIN_LIBS):
	(cd $(@D); $(MAKE) $(@F))

../extra/intl/libintl.a:
	(cd $(@D); $(MAKE))


libR: $(libR_la)

$(libR_la): $(libR_la_OBJECTS) $(libR_la_DEPENDENCIES)
	$(DYLIB_LINK) $(LIBR_LDFLAGS) -o $@ $(libR_la_OBJECTS) $(libR_la_LIBADD)

install-lib-local: $(libR_la)
	@$(MAKE) DESTDIR="" rhome="$(abs_top_builddir)" install-lib


# suppress #line directives
YFLAGS=-l

$(srcdir)/gram.c: @MAINTAINER_MODE_TRUE@ $(srcdir)/gram.y
	@$(ECHO) "re-making gram.c"
	$(YACC) $(YFLAGS) $(srcdir)/gram.y
	$(SHELL) $(top_srcdir)/tools/move-if-change y.tab.c $(srcdir)/gram.c

install: installdirs
	@$(MAKE) install-bin
	@if test -f $(libR_la); then $(MAKE) install-lib; fi
@WANT_R_STATIC_TRUE@	@$(MAKE) install-static
## may not need $(rhome)/lib if not static/shared libR, external blas and lapack.
installdirs:
	@$(MKINSTALLDIRS) "$(DESTDIR)$(Rexecbindir2)"
install-bin: installdirs
	@$(SHELL) $(top_srcdir)/tools/copy-if-change $(R_binary) "$(DESTDIR)$(Rexecbindir2)/R"
install-lib: installdirs
	@$(MKINSTALLDIRS) "$(DESTDIR)$(Rexeclibdir)"
	@$(SHELL) $(top_srcdir)/tools/copy-if-change $(libR_la) "$(DESTDIR)$(Rexeclibdir)/$(libR_la)"
install-static: installdirs
	@$(MKINSTALLDIRS) "$(DESTDIR)$(Rexeclibdir)"
	@$(SHELL) $(top_srcdir)/tools/copy-if-change libR.a "$(DESTDIR)$(Rexeclibdir)/libR.a"
install-strip: installdirs
	@${INSTALL_PROGRAM} -s $(R_binary) "$(DESTDIR)$(Rexecbindir2)/R"
	@if test -f $(libR_la); then $(MAKE) install-lib; fi
	@if test -n "$(STRIP_SHARED_LIB)"; then \
	  if test -f $(libR_la); then $(STRIP_SHARED_LIB) "$(DESTDIR)$(Rexeclibdir)/$(libR_la)"; fi; \
	fi
@WANT_R_STATIC_TRUE@	@$(MAKE) install-strip-static
install-strip-static: installdirs
	@$(MAKE) install-static
	@if test -n "$(STRIP_STATIC_LIB)"; then \
	  if test -f libR.a; then $(STRIP_STATIC_LIB) "$(DESTDIR)$(Rexeclibdir)/libR.a"; fi; \
	fi
uninstall:
	@rm -f "$(DESTDIR)$(Rexecbindir)/exec/$(R_ARCH)/R" "$(DESTDIR)$(Rexecbindir)/R.bin"
	@rm -f "$(DESTDIR)$(Rexeclibdir)/libR$(R_DYLIB_EXT)"
	@rm -f "$(DESTDIR)$(Rexeclibdir)/libR.a"

mostlyclean: clean
clean:
	@-rm -f $(top_builddir)/etc/R.exp
	@-rm -Rf .libs _libs
	@-rm -f *core Makedeps *.d *.o *.lo *.la *$(R_DYLIB_EXT) \
	  $(R_binary) libR.a
distclean: clean
	@-rm -f Makefile
maintainer-clean: distclean
	@$(ECHO) "This command is intended for maintainers to use; it"
	@$(ECHO) "deletes files that may need special rules to rebuild"
	@-rm -f $(srcdir)/gram.c $(srcdir)/gramLatex.c $(srcdir)/gramRd.c

tags: TAGS
TAGS: $(SOURCES) $(EXTRA_SOURCES_C) $(HEADERS)
	etags $(SOURCES) $(EXTRA_SOURCES_C) $(HEADERS)

## Unused targets
info dvi check:

distdir: $(DISTFILES)
	@for f in $(DISTFILES); do \
	  test -f $(distdir)/$${f} \
	    || ln $(srcdir)/$${f} $(distdir)/$${f} 2>/dev/null \
	    || cp -p $(srcdir)/$${f} $(distdir)/$${f}; \
	done

## Automagically generated dependencies: