xrprof-0.3.1/0000755000175000017500000000000014003613066012014 5ustar aaronaaronxrprof-0.3.1/NEWS.md0000664000175000017500000000174114003613066013117 0ustar aaronaaron# xrprof 0.3.1 * The `-o` option can now be used to write the output directly to a file instead of standard output. * Fixes poor error handling when reading memory on Linux. (#15 by @jimhester) * Fixes incomplete support for `prefix` in the Makefile. (#16 by @eddelbuettel) * Git is no longer required to build from generated tarballs. (#17) # xrprof 0.3.0 * `xrprof` can now be built and run on Windows. (#3) * Experimental support for "mixed-mode" profiling of both R and C/C++ stacks on Linux with `-m`. This also introduces a dependency on `libunwind`. Note that the exact output format is not fixed and may change in the future. (#8) * Various performance improvements. # xrprof 0.2.0 * `libelf` is now required. * Support for profiling R processes running in Docker containers. (#6) * Support for profiling R when built without `libR.so`. (#7) * Fixes a memory leak. # xrprof 0.1 * Initial public release. `xrprof` is an external sampling profiler for R on Linux. xrprof-0.3.1/Makefile0000664000175000017500000000376214003613066013466 0ustar aaronaaronVERSION = 0.3.1 CFLAGS = -O2 -Wall -fPIC -mno-ms-bitfields -g LIBS = -lelf -lunwind-ptrace -lunwind-generic BIN = xrprof BINOBJ = src/xrprof.o OBJ = src/cursor.o \ src/locate.o \ src/memory.o \ src/process.o SHLIB = libxrprof.so all: $(BIN) clean: $(RM) $(BIN) $(BINOBJ) $(OBJ) $(SHLIB) cd tests && $(MAKE) clean $(BIN): $(OBJ) $(BINOBJ) $(CC) $(LDFLAGS) -o $@ $^ $(LIBS) shlib: $(SHLIB) $(SHLIB): $(OBJ) $(CC) $(LDFLAGS) -shared -o $@ $^ src/cursor.o: src/cursor.c src/cursor.h src/rdefs.h src/locate.h src/memory.h $(CC) $(CFLAGS) -c -o $@ $< src/locate.o: src/locate.c src/locate.h src/memory.h $(CC) $(CFLAGS) -c -o $@ $< src/memory.o: src/memory.c src/memory.h src/rdefs.h $(CC) $(CFLAGS) -c -o $@ $< src/process.o: src/process.c $(CC) $(CFLAGS) -c -o $@ $< src/xrprof.o: src/xrprof.c src/cursor.h $(CC) $(CFLAGS) -c -o $@ $< test: $(BIN) cd tests && $(MAKE) "BIN=../$(BIN)" # Mostly compatible with https://www.gnu.org/prep/standards/html_node/Makefile-Conventions.html INSTALL = install prefix ?= /usr/local bindir = $(prefix)/bin datadir = $(prefix)/share includedir = $(prefix)/include libdir = $(prefix)/lib install: $(INSTALL) -d $(DESTDIR)$(bindir) $(INSTALL) -T -m 0755 $(BIN) $(DESTDIR)$(bindir)/$(BIN) $(INSTALL) -d $(DESTDIR)$(datadir)/man/man1 $(INSTALL) -T -m 0755 docs/$(BIN).1 $(DESTDIR)$(datadir)/man/man1/$(BIN).1 setcap cap_sys_ptrace=eip $(DESTDIR)$(bindir)/$(BIN) || exit 0 install-shlib: $(INSTALL) -d $(DESTDIR)$(libdir) $(INSTALL) -T -m 0644 $(SHLIB) $(DESTDIR)$(libdir)/$(SHLIB) PACKAGE = $(BIN) DISTDIR = $(PACKAGE)-$(VERSION) dist: $(INSTALL) -d $(DISTDIR) $(RM) -r $(DISTDIR)/* $(INSTALL) -d $(DISTDIR)/src cp src/*.c src/*.h $(DISTDIR)/src $(INSTALL) -d $(DISTDIR)/docs cp docs/* $(DISTDIR)/docs cp Makefile README.md NEWS.md $(DISTDIR)/ tar -czf $(DISTDIR).tar.gz $(DISTDIR) $(RM) -r $(DISTDIR) sha256sum $(DISTDIR).tar.gz > $(DISTDIR).tar.gz.sha256 distclean: $(RM) $(BIN) $(BINOBJ) $(OBJ) $(SHLIB) .PHONY: all clean test install dist distclean xrprof-0.3.1/README.md0000664000175000017500000001161214003613066013276 0ustar aaronaaron# xrprof ![GitHub Actions CI Status](https://github.com/atheriel/xrprof/workflows/CI/badge.svg) [![travis-ci build status](https://travis-ci.org/atheriel/xrprof.svg?branch=master)](https://travis-ci.org/atheriel/xrprof) `xrprof` (formerly `rtrace`) is an external sampling profiler for R on Linux and Windows. Many R users will be familiar with using the built-in sampling profiler `Rprof()` to generate data on what their code is doing, and there are several excellent tools to facilitate understanding these samples (or serve as a front-end), including the [**profvis**](https://rstudio.github.io/profvis/) package. However, the reach of `Rprof()` and related tools is limited: the profiler is "internal", in the sense that it must be manually switched on to work, either during interactive work (for example, to profile an individual function), or perhaps by modifying the script to include `Rprof()` calls before running it again. In contrast, `xrprof` can be used to profile code that is *already running*: ```console $ Rscript myscript.R & # sudo may be required. $ xrprof -p -F 50 > Rprof.out ``` External sampling profilers have proven extremely useful for diagnosing and fixing performance issues (or other bugs) in production environments. This project joins a large list similar tools for other languages, such as `perf` (the Linux system profiler), `jstack` (for Java), `rbspy` (for Ruby), `Pyflame` (for Python), `VSPerfCmd` for C#/.NET, and many others. ## Building ### On Linux `xrprof` depends on libelf and libunwind, so you must have their headers to compile the program. For example, on Debian-based systems (including Ubuntu), you can install these with ```console $ sudo apt-get install libelf-dev libunwind-dev ``` A simple `Makefile` is provided. Build the binary with ```console $ make ``` To install the profiler to your system, use ```console $ sudo make install ``` This will install the binary to `/usr/local/bin` and use `setcap` to mark it for use without `sudo`. The `install` target supports `prefix` and `DESTDIR`. ### On Windows You must have a build environment set up. For R users, the best option is to use R's own [Rtools for Windows](https://cran.r-project.org/bin/windows/Rtools/) (which is also used to install packages from source). You can then launch "Rtools MinGW 64-bit" from the Start Menu and navigate to the source directory; then run ```console $ make -f Makefile.win ``` The resulting `xrprof.exe` program can be run from `cmd.exe` or PowerShell. ## Usage The profiler has a simple interface: Usage: xrprof [-F ] [-d ] -p The `Rprof.out` format is written to standard output and errors or other messages are written to standard error. On Windows, R's process ID (PID) can be looked up in Task Manager. Along with the sampling profiler itself, there is also a `stackcollapse-Rprof.R` script in `tools/` that converts the `Rprof.out` format to one that can be understood by Brendan Gregg's [FlameGraph](http://www.brendangregg.com/flamegraphs.html) tool. You can use this to produce graphs like the one below: ```shell $ stackcollapse-Rprof.R Rprof.out | flamegraph.pl > Rprof.svg ``` ![Example FlameGraph](example-flamegraph.svg) ## Running Under Docker A public Docker image is available at `atheriel/xrprof`. Since `xrprof` reads the memory of other running programs, it must be run as a privileged container in the host PID namespace. For example: ```console $ docker run --privileged --pid=host -it atheriel/xrprof -p ``` ## Okay, How Does it Work? Much like other sampling profilers, the program uses Linux's `ptrace` system calls to attach to running R processes and a mix of `ptrace` and `process_vm_readv` to read the memory contents of that process, following pointers along the way. The R-specific aspect of this is to locate and decode the `R_GlobalContext` structure inside of the R interpreter that stores information on the currently executing R code. In order to defeat address space randomization, `xrprof` will search through the ELF files loaded into memory (at `/proc//maps`) for the symbols required, either in the executable itself or in `libR.so` (if it appears R has been compiled to use it). `xrprof` is mount-namespace-aware, so it supports profiling R processes running inside Docker containers. On Windows, `xrprof` makes use of APIs like `ReadProcessMemory()`, `NtSuspendProcess()`, and `SymFromName()` to achieve the analogous result. ## Credits The project was inspired by Julia Evan's blog posts on writing [`rbspy`](https://rbspy.github.io/) and later by my discovery of Evan Klitzke's work (and writing) on [Pyflame](https://github.com/uber/pyflame). ## License This project contains portions of the source code of R itself, which is copyright the R Core Developers and licensed under the GPLv2. The remaining code is copyright its authors and also available under the same license, GPLv2. xrprof-0.3.1/docs/0000755000175000017500000000000014003613066012744 5ustar aaronaaronxrprof-0.3.1/docs/xrprof.10000664000175000017500000000315414003613066014353 0ustar aaronaaron.TH XRPROF 1 2020-01-11 .SH NAME xrprof \- profile R programs .SH SYNOPSIS .B xrprof .RB [ -h ] .RB [ -m ] .RB [ -F .IR FREQ ] .RB [ -d .IR DURATION ] .RB [ -o .IR FILE ] .B -p .I PID .SH DESCRIPTION A sampling profiler for .BR R (1) programs. .B xrprof writes to standard output the .I Rprof.out format widely used by existing R-based tools. .SH OPTIONS Malformed arguments will fall back on the defaults, if possible. .TP .B \-h Print usage and exit. .TP .BR \-p " " \fIPID\fR Specify the pid of the target R program. .TP .BR \-F " " \fIFREQ\fR Set the sampling frequency, in Hertz. The default is 1 Hz, i.e. one sample per second, and the maximum is 1000 Hz (though far fewer samples are usually required). .TP .BR \-d " " \fIDURATION\fR Set the duration for .B xrprof to take samples before exiting (provided the target program runs that long). The default is to last up to one hour. .TP .BR \-o " " \fIFILE\fR Write output to .I FILE instead of standard output. .TP .B \-m Run in \*(lqmixed mode\*(rq, where samples are drawn from both the R-level and native C/C++ stacks and collated together. .SH EXAMPLES Sample from an existing R program for 5 seconds at a useful frequency: .PP .EX $ xrprof -F 50 -d 5 -p `pidof R` .EE .PP Start a new R program in the background and then start the profiler, writing samples to the file .I Rprof.out in the current directory: .PP .EX $ Rscript myprogram.R & $ xrprof -F 50 -p $! > Rprof.out .EE .SH EXIT STATUS .TP .B 0 Successful program execution. .TP .B 1 A fatal error ocurred during sampling. .SH AUTHORS .B xrprof was written by Aaron Jacobs. .SH SEE ALSO .BR R (1), .BR Rscript (1) xrprof-0.3.1/src/0000755000175000017500000000000014003613066012603 5ustar aaronaaronxrprof-0.3.1/src/memory.h0000664000175000017500000000063114003613066014266 0ustar aaronaaron#ifndef XRPROF_MEMORY_H #define XRPROF_MEMORY_H #include "process.h" /* for phandle */ #include "rdefs.h" /* for RCNTXT, SEXP */ ssize_t copy_address(phandle pid, void *addr, void *data, size_t len); int copy_context(phandle pid, void *addr, RCNTXT *data); int copy_sexp(phandle pid, void *addr, SEXP data); int copy_char(phandle pid, void *addr, char *data, size_t max_len); #endif /* XRPROF_MEMORY_H */ xrprof-0.3.1/src/process.c0000664000175000017500000000704614003613066014436 0ustar aaronaaron#include /* for fprintf */ #include "process.h" #ifdef __linux #include #include #include int proc_create(phandle *out, void *data) { pid_t *pid = (pid_t *) data; *out = *pid; if (ptrace(PTRACE_SEIZE, *out, NULL, NULL)) { perror("fatal: Failed to attach to remote process"); return -1; } return 0; } int proc_suspend(phandle pid) { if (ptrace(PTRACE_INTERRUPT, pid, NULL, NULL)) { perror("fatal: Failed to interrupt remote process"); return -1; } int wstatus; if (waitpid(pid, &wstatus, 0) < 0) { perror("fatal: Failed to obtain remote process status information"); return -1; } if (WIFEXITED(wstatus)) { fprintf(stderr, "Process %d finished.\n", pid); return -2; } else if (WIFSTOPPED(wstatus) && WSTOPSIG(wstatus) == SIGCHLD) { /* Try again. */ ptrace(PTRACE_CONT, pid, NULL, NULL); return proc_suspend(pid); } else if (WIFSTOPPED(wstatus) && WSTOPSIG(wstatus) != SIGTRAP) { fprintf(stderr, "fatal: Unexpected stop signal in remote process: %d.\n", WSTOPSIG(wstatus)); return -1; } else if (!WIFSTOPPED(wstatus)) { fprintf(stderr, "fatal: Unexpected remote process status: %d.\n", WSTOPSIG(wstatus)); return -1; } return 0; } int proc_resume(phandle pid) { if (ptrace(PTRACE_CONT, pid, NULL, NULL)) { perror("fatal: Failed to continue remote process"); return -1; } return 0; } int proc_destroy(phandle pid) { /* We don't actually care if this succeeds or not. */ ptrace(PTRACE_DETACH, pid, NULL, NULL); return 0; } #elif defined(__WIN32) #include /* for pid_t */ #include #include /* The internal APIs that everyone seems to use from ntdll: https://stackoverflow.com/questions/11010165/how-to-suspend-resume-a-process-in-windows/11010508#11010508 https://github.com/benfred/remoteprocess/blob/cdbf4aa23f48b48f949da3dadfc5878ab6e94f53/src/windows/mod.rs#L43 */ LONG NtSuspendProcess(IN HANDLE ProcessHandle); LONG NtResumeProcess(IN HANDLE ProcessHandle); int proc_create(phandle *out, void *data) { pid_t pid = *((pid_t *) data); *out = OpenProcess(PROCESS_VM_READ | PROCESS_SUSPEND_RESUME | PROCESS_QUERY_INFORMATION, FALSE, pid); if (!*out) { fprintf(stderr, "error: Failed to open process %I64d: %ld.\n", pid, GetLastError()); return -1; } return 0; } int proc_suspend(phandle pid) { NTSTATUS ret = NtSuspendProcess(pid); if (ret == 0XC000010A) { fprintf(stderr, "Process finished.\n"); return -2; } if (ret == 0XC0000002) { /* Running under Wine. */ fprintf(stderr, "warning: Process cannot be suspended/resumed (%#lX).\n", ret); return 0; } if (ret != 0) { fprintf(stderr, "error: Failed to suspend process: %ld (%#lX).\n", RtlNtStatusToDosError(ret), ret); return -1; } return 0; } int proc_resume(phandle pid) { NTSTATUS ret = NtResumeProcess(pid); if (ret == 0XC0000002) { /* Running under Wine. */ fprintf(stderr, "warning: Process cannot be suspended/resumed (%#lX).\n", ret); return 0; } if (ret != 0) { fprintf(stderr, "error: Failed to resume process: %ld (%#lX).\n", RtlNtStatusToDosError(ret), ret); return -1; } return 0; } int proc_destroy(phandle pid) { BOOL ret = CloseHandle(pid); if (ret == FALSE) { fprintf(stderr, "Failed to close process handle: %ld.\n", GetLastError()); return -1; } return 0; } #else #error "No support for non-Linux platforms." #endif xrprof-0.3.1/src/rtrace.c0000644000175000017500000001176714003613066014243 0ustar aaronaaron#include /* for errno */ #include /* for LONG_MIN, LONG_MAX */ #include #include #include #include /* for uintptr_t */ #include #include #include #include #include #include /* for timespec */ #include "cursor.h" #define MAX_STACK_DEPTH 100 #define DEFAULT_FREQ 1 #define MAX_FREQ 1000 #define DEFAULT_DURATION 3600 // One hour. static volatile int should_trace = 1; void handle_sigint(int _sig) { should_trace = 0; } void usage(const char *name) { // TODO: Add a long help message. printf("Usage: %s [-v] [-F ] [-d ] -p \n", name); return; } int main(int argc, char **argv) { pid_t pid = -1; int freq = DEFAULT_FREQ; float duration = DEFAULT_DURATION; int verbose = 0; int opt; while ((opt = getopt(argc, argv, "hvF:d:p:")) != -1) { switch (opt) { case 'h': usage(argv[0]); return 0; break; case 'v': verbose++; break; case 'p': pid = strtol(optarg, NULL, 10); if ((errno == ERANGE && (pid == LONG_MAX || pid == LONG_MIN)) || (errno != 0 && pid == 0)) { perror("strtol"); return 1; } if (pid < 0) { fprintf(stderr, "fatal: Cannot accept negative pids as input.\n"); return 1; } break; case 'F': freq = strtol(optarg, NULL, 10); if (freq <= 0) { freq = DEFAULT_FREQ; fprintf(stderr, "warning: Invalid frequency argument, falling back on the default %d.\n", freq); } else if (freq > MAX_FREQ) { freq = MAX_FREQ; fprintf(stderr, "warning: Frequency cannot exceed %d, using that instead.\n", freq); } break; case 'd': duration = strtof(optarg, NULL); if (errno != 0 && duration == 0) { perror("warning: Failed to decode duration argument"); } if (duration <= 0) { duration = DEFAULT_DURATION; fprintf(stderr, "warning: Invalid duration argument, failling back on the default %.0f.\n", duration); } break; default: /* '?' */ usage(argv[0]); return 1; break; } } // A PID is required. if (pid == -1) { usage(argv[0]); return 1; } struct timespec sleep_spec; sleep_spec.tv_sec = freq == 1 ? 1 : 0; sleep_spec.tv_nsec = freq == 1 ? 0 : 1000000000 / freq; int code = 0; /* First, check that we can attach to the process. */ struct rstack_cursor *cursor = rstack_create(pid); if (!cursor) { fprintf(stderr, "fatal: Failed to initialize R stack cursor.\n"); code++; goto done; } if (ptrace(PTRACE_SEIZE, pid, NULL, NULL)) { perror("fatal: Failed to attach to remote process"); return 1; } /* Stop the tracee and read the R stack information. */ // Allow the user to stop the tracing with Ctrl-C. signal(SIGINT, handle_sigint); float elapsed = 0; // Write the Rprof.out header. printf("sample.interval=%d\n", 1000000 / freq); while (should_trace && elapsed <= duration) { if (ptrace(PTRACE_INTERRUPT, pid, NULL, NULL)) { perror("fatal: Failed to interrupt remote process"); code++; goto done; } int wstatus; if (waitpid(pid, &wstatus, 0) < 0) { perror("fatal: Failed to obtain remote process status information"); code++; goto done; } if (WIFEXITED(wstatus)) { fprintf(stderr, "Process %d finished.\n", pid); break; } else if (WIFSTOPPED(wstatus) && WSTOPSIG(wstatus) == SIGCHLD) { ptrace(PTRACE_CONT, pid, NULL, NULL); continue; } else if (WIFSTOPPED(wstatus) && WSTOPSIG(wstatus) != SIGTRAP) { fprintf(stderr, "fatal: Unexpected stop signal in remote process: %d.\n", WSTOPSIG(wstatus)); code++; goto done; } else if (!WIFSTOPPED(wstatus)) { fprintf(stderr, "fatal: Unexpected remote process status: %d.\n", WSTOPSIG(wstatus)); code++; goto done; } int ret; char rsym[256]; if ((ret = rstack_init(cursor)) < 0) { code++; fprintf(stderr, "fatal: Failed to initialize R stack cursor: %d.\n", ret); goto done; } do { rsym[0] = '\0'; if ((ret = rstack_get_fun_name(cursor, rsym, sizeof(rsym))) < 0) { code++; goto done; } else if (ret == 0) { printf("\"\" "); } else { printf("\"%s\" ", rsym); } } while ((ret = rstack_step(cursor)) > 0); if (ret < 0) { code++; fprintf(stderr, "fatal: Failed to step R stack cursor: %d.\n", ret); goto done; } printf("\n"); if (ptrace(PTRACE_CONT, pid, NULL, NULL)) { perror("fatal: Failed to continue remote process"); code++; goto done; } if (nanosleep(&sleep_spec, NULL) < 0) { break; // Interupted. } elapsed = elapsed + 1.0 / freq; } done: ptrace(PTRACE_DETACH, pid, NULL, NULL); rstack_destroy(cursor); return code; } xrprof-0.3.1/src/cursor.h0000664000175000017500000000061714003613066014277 0ustar aaronaaron#ifndef XRPROF_CURSOR_H #define XRPROF_CURSOR_H #include "process.h" struct xrprof_cursor; struct xrprof_cursor *xrprof_create(phandle pid); void xrprof_destroy(struct xrprof_cursor *cursor); int xrprof_init(struct xrprof_cursor *cursor); int xrprof_get_fun_name(struct xrprof_cursor *cursor, char *buff, size_t len); int xrprof_step(struct xrprof_cursor *cursor); #endif /* XRPROF_CURSOR_H */ xrprof-0.3.1/src/locate.c0000664000175000017500000002304214003613066014221 0ustar aaronaaron#include /* for fprintf */ #include "locate.h" #include "memory.h" #ifdef __linux #include /* for open */ #include /* for ptrdiff_t */ #include /* for malloc */ #include /* for strstr, strndup */ #include #include #include #define MAX_LIBR_PATH_LEN 128 static int find_libR(pid_t pid, char **path, uintptr_t *addr) { char maps_file[32]; snprintf(maps_file, sizeof(maps_file), "/proc/%d/maps", pid); FILE *file = fopen(maps_file, "r"); if (!file) { char msg[51]; // 19 for the message + 32 for the buffer above. snprintf(msg, 51, "error: Cannot open %s", maps_file); perror(msg); return -1; } *path = NULL; char buffer[1024]; uintptr_t start = 0; while (fgets(buffer, sizeof(buffer), file)) { if (!start) { /* Extract the process's own code address. */ start = (uintptr_t) strtoul(buffer, NULL, 16); } if (strstr(buffer, "libR.so")) { /* Extract the address. */ *addr = (uintptr_t) strtoul(buffer, NULL, 16); /* Prefix the path with the process's view of the filesystem, which might be affected by a namespace (as in the case of a container). */ *path = calloc(MAX_LIBR_PATH_LEN, 1); snprintf(*path, MAX_LIBR_PATH_LEN, "/proc/%d/root%s", pid, strstr(buffer, "/")); /* Remove the trailing '\n'. */ char *linebreak = strstr(*path, "\n"); if (linebreak) { *linebreak = '\0'; } break; } } fclose(file); /* Either (1) this R program does not use libR.so, or (2) it's not actually an R program. */ if (!*path) { *addr = start; return -1; } return 0; } int locate_libR_globals(phandle pid, struct libR_globals *out) { /* Open the same libR.so in the tracer so we can determine the symbol offsets to read memory at in the tracee. */ if (elf_version(EV_CURRENT) == EV_NONE) { fprintf(stderr, "error: Can't set the ELF version. %s\n", elf_errmsg(elf_errno())); return -1; } char *path = NULL; uintptr_t remote = 0; if (find_libR(pid, &path, &remote) < 0) { /* Try finding the symbols in the executable directly. */ path = calloc(MAX_LIBR_PATH_LEN, 1); snprintf(path, MAX_LIBR_PATH_LEN, "/proc/%d/exe", pid); } /* if (verbose) fprintf(stderr, "Found %s at %p in pid %d.\n", path, */ /* (void *) addr, pid); */ int fd = open(path, O_RDONLY); if (fd < 0) { char msg[64]; snprintf(msg, 64, "error: Cannot open %s", path); perror(msg); free(path); return -1; } Elf *elf = elf_begin(fd, ELF_C_READ_MMAP, NULL); if (elf == NULL) { fprintf(stderr, "error: %s is not a valid ELF file. %s\n", path, elf_errmsg(elf_errno())); close(fd); free(path); return -1; } /* TODO: 32-bit support? */ Elf64_Ehdr *ehdr = elf64_getehdr(elf); if (!ehdr) { fprintf(stderr, "error: %s is not a valid 64-bit ELF file. %s\n", path, elf_errmsg(elf_errno())); elf_end(elf); close(fd); free(path); return -1; } Elf64_Shdr shdr; Elf_Scn *scn = NULL; while ((scn = elf_nextscn(elf, scn)) != NULL) { gelf_getshdr(scn, &shdr); if (shdr.sh_type == SHT_DYNSYM) { break; } } if (!scn) { fprintf(stderr, "error: Can't find the symbol table in %s.\n", path); elf_end(elf); close(fd); free(path); return -1; } Elf_Data *data = elf_getdata(scn, NULL); Elf64_Sym sym; char *symbol; uintptr_t value; ssize_t bytes; for (int i = 0; i < shdr.sh_size / shdr.sh_entsize; i++) { gelf_getsym(data, i, &sym); symbol = elf_strptr(elf, shdr.sh_link, sym.st_name); if (strncmp("R_GlobalContext", symbol, 15) == 0) { /* The R_GlobalContext value will change, so we only want the address to read the value from. */ out->context_addr = remote + sym.st_value; } else if (strncmp("R_DoubleColonSymbol", symbol, 19) == 0) { /* copy_address() will print its own errors. */ bytes = copy_address(pid, (void *)remote + sym.st_value, &value, sizeof(uintptr_t)); out->doublecolon = bytes < sizeof(uintptr_t) ? 0 : value; } else if (strncmp("R_TripleColonSymbol", symbol, 19) == 0) { bytes = copy_address(pid, (void *)remote + sym.st_value, &value, sizeof(uintptr_t)); out->triplecolon = bytes < sizeof(uintptr_t) ? 0 : value; } else if (strncmp("R_DollarSymbol", symbol, 14) == 0) { bytes = copy_address(pid, (void *)remote + sym.st_value, &value, sizeof(uintptr_t)); out->dollar = bytes < sizeof(uintptr_t) ? 0 : value; } else if (strncmp("R_BracketSymbol", symbol, 15) == 0) { bytes = copy_address(pid, (void *)remote + sym.st_value, &value, sizeof(uintptr_t)); out->bracket = bytes < sizeof(uintptr_t) ? 0 : value; } } elf_end(elf); close(fd); free(path); if (!out->doublecolon || !out->triplecolon || !out->dollar || !out->bracket || !out->context_addr) { fprintf(stderr, "error: Failed to locate required R global variables in process %d's memory. Are you sure it is an R program?\n", pid); return -1; } return 0; } #elif defined(__WIN32) #include #include /* for EnumProcessModules */ #include /* for SymInitialize, SymLoadModuleEx, etc */ int locate_libR_globals(phandle pid, struct libR_globals *out) { if (proc_suspend(pid) < 0) { return -1; } /* TODO: Should we use TRUE here to force loading symbols from all modules? */ if (!SymInitialize(pid, NULL, FALSE)) { fprintf(stderr, "error: Failed to load remote process symbols: %ld.\n", GetLastError()); return -1; } HMODULE mods[1024]; DWORD mod_bytes; if (!EnumProcessModules(pid, mods, sizeof(mods), &mod_bytes)) { fprintf(stderr, "error: Failed to enumerate remote process modules: %ld.\n", GetLastError()); goto error; } int entries = mod_bytes / sizeof(HMODULE); TCHAR mpath[256]; DWORD64 base; for (int i = 0; i < entries; i++ ) { if (!GetModuleFileNameEx(pid, mods[i], mpath, sizeof(mpath) / sizeof(TCHAR))) { fprintf(stderr, "error: Failed to get remote process module: %ld.\n", GetLastError()); goto error; } /* A module that looks like R. */ if (!strstr(mpath, "R.dll")) { continue; } base = SymLoadModuleEx(pid, NULL, mpath, NULL, (DWORD64) mods[i], 0, NULL, 0); if (!base) { fprintf(stderr, "error: Failed to load symbols for %s (0x%p): %ld.\n", mpath, mods[i], GetLastError()); goto error; } uintptr_t value; ssize_t bytes; /* This is actually the crazy structure SymFromName uses. */ struct { SYMBOL_INFO info; char buf[MAX_SYM_NAME]; } info; info.info.SizeOfStruct = sizeof(SYMBOL_INFO); info.info.ModBase = base; info.info.MaxNameLen = MAX_SYM_NAME - 1; char *sym; sym = "R_GlobalContext"; if (!SymFromName(pid, sym, &info.info)) { if (GetLastError() != 123) { fprintf(stderr, "error: Failed to lookup symbol: %ld.\n", GetLastError()); goto error; } } else { out->context_addr = info.info.Address; } sym = "R_DoubleColonSymbol"; if (!SymFromName(pid, sym, &info.info)) { if (GetLastError() != 123) { fprintf(stderr, "error: Failed to lookup symbol: %ld.\n", GetLastError()); goto error; } } else { /* copy_address() will print its own errors. */ bytes = copy_address(pid, (void *) info.info.Address, &value, sizeof(uintptr_t)); out->doublecolon = bytes < sizeof(uintptr_t) ? 0 : value; } sym = "R_TripleColonSymbol"; if (!SymFromName(pid, sym, &info.info)) { if (GetLastError() != 123) { fprintf(stderr, "error: Failed to lookup symbol: %ld.\n", GetLastError()); goto error; } } else { bytes = copy_address(pid, (void *) info.info.Address, &value, sizeof(uintptr_t)); out->triplecolon = bytes < sizeof(uintptr_t) ? 0 : value; } sym = "R_DollarSymbol"; if (!SymFromName(pid, sym, &info.info)) { if (GetLastError() != 123) { fprintf(stderr, "error: Failed to lookup symbol: %ld.\n", GetLastError()); goto error; } } else { bytes = copy_address(pid, (void *) info.info.Address, &value, sizeof(uintptr_t)); out->dollar = bytes < sizeof(uintptr_t) ? 0 : value; } sym = "R_BracketSymbol"; if (!SymFromName(pid, sym, &info.info)) { if (GetLastError() != 123) { fprintf(stderr, "error: Failed to lookup symbol: %ld.\n", GetLastError()); goto error; } } else { bytes = copy_address(pid, (void *) info.info.Address, &value, sizeof(uintptr_t)); out->bracket = bytes < sizeof(uintptr_t) ? 0 : value; } if (!SymUnloadModule64(pid, base)) { fprintf(stderr, "error: Failed to unload symbols for %s (0x%p): %ld.\n", mpath, mods[i], GetLastError()); goto error; } } if (!out->doublecolon || !out->triplecolon || !out->dollar || !out->bracket || !out->context_addr) { fprintf(stderr, "error: Failed to locate required R global variables in \ remote process's memory. Are you sure it is an R program?\n"); goto error; } SymCleanup(pid); return proc_resume(pid); error: SymCleanup(pid); proc_resume(pid); return -1; } #else #error "No support for non-Linux platforms." #endif xrprof-0.3.1/src/rdefs.h0000664000175000017500000001236114003613066014064 0ustar aaronaaron#ifndef XRPROF_RDEFS_H #define XRPROF_RDEFS_H #include #include /* Extracted from Rinternals.h and Defn.h. License header reproduced below. * * R : A Computer Language for Statistical Data Analysis * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka * Copyright (C) 1999-2017 The R Core Team. * * This header file is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation; either version 2.1 of the License, or * (at your option) any later version. * * This file is part of R. R is distributed under the terms of the * GNU General Public License, either Version 2, June 1991 or Version 3, * June 2007. See doc/COPYRIGHTS for details of the copyright status of R. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, a copy is available at * https://www.R-project.org/Licenses/ */ /* From Rinternals.h: */ typedef unsigned int SEXPTYPE; #define SYMSXP 1 #define LANGSXP 6 typedef struct SEXPREC *SEXP; struct sxpinfo_struct { SEXPTYPE type : 5; /* We don't need any of the other fields at the moment. */ #ifdef R344_COMPAT unsigned int pad : 27; #else /* This header changed from 32 bits to 64 after R 3.4.4. */ unsigned long long pad : 59; #endif }; /* TODO: Should be int on 32-bit platforms, if we support them. */ typedef ptrdiff_t R_xlen_t; typedef int R_len_t; struct vecsxp_struct { #ifdef R344_COMPAT R_len_t length; R_len_t truelength; #else /* Long vectors after R 3.4.4. */ R_xlen_t length; R_xlen_t truelength; #endif }; struct symsxp_struct { struct SEXPREC *pname; struct SEXPREC *value; struct SEXPREC *internal; }; struct listsxp_struct { struct SEXPREC *carval; struct SEXPREC *cdrval; struct SEXPREC *tagval; }; #define SEXPREC_HEADER \ struct sxpinfo_struct sxpinfo; \ struct SEXPREC *attrib; \ struct SEXPREC *gengc_next_node, *gengc_prev_node typedef struct SEXPREC { SEXPREC_HEADER; union { /* We only need symbols and lists right now. */ struct symsxp_struct symsxp; struct listsxp_struct listsxp; } u; } SEXPREC; typedef struct VECTOR_SEXPREC { SEXPREC_HEADER; struct vecsxp_struct vecsxp; } VECTOR_SEXPREC, *VECSEXP; typedef union { VECTOR_SEXPREC s; double align; } SEXPREC_ALIGN; #define TYPEOF(x) ((x)->sxpinfo.type) #define CAR(x) ((x)->u.listsxp.carval) #define CDR(x) ((x)->u.listsxp.cdrval) #define PRINTNAME(x) ((x)->u.symsxp.pname) #define STDVEC_DATAPTR(x) ((void *) (((SEXPREC_ALIGN *) (x)) + 1)) /* From gnuwin32/fixed/h/psignal.h */ #ifdef __WIN32 typedef int sigset_t; typedef struct { jmp_buf jmpbuf; int mask_was_saved; sigset_t saved_mask; } sigjmp_buf[1]; #endif /* From Defn.h: */ #undef BC_INT_STACK #define JMP_BUF sigjmp_buf typedef struct { int tag; union { int ival; double dval; SEXP sxpval; } u; } R_bcstack_t; /* Evaluation Context Structure */ typedef struct RCNTXT { struct RCNTXT *nextcontext; /* The next context up the chain */ int callflag; /* The context "type" */ JMP_BUF cjmpbuf; /* C stack and register information */ int cstacktop; /* Top of the pointer protection stack */ int evaldepth; /* evaluation depth at inception */ SEXP promargs; /* Promises supplied to closure */ SEXP callfun; /* The closure called */ SEXP sysparent; /* environment the closure was called from */ SEXP call; /* The call that effected this context*/ SEXP cloenv; /* The environment */ SEXP conexit; /* Interpreted "on.exit" code */ void (*cend)(void *); /* C "on.exit" thunk */ void *cenddata; /* data for C "on.exit" thunk */ void *vmax; /* top of R_alloc stack */ int intsusp; /* interrupts are suspended */ int gcenabled; /* R_GCEnabled value */ int bcintactive; /* R_BCIntActive value */ SEXP bcbody; /* R_BCbody value */ void* bcpc; /* R_BCpc value */ SEXP handlerstack; /* condition handler stack */ SEXP restartstack; /* stack of available restarts */ struct RPRSTACK *prstack; /* stack of pending promises */ R_bcstack_t *nodestack; #ifdef BC_INT_STACK IStackval *intstack; #endif SEXP srcref; /* The source line in effect */ int browserfinish; /* should browser finish this context without stopping */ SEXP returnValue; /* only set during on.exit calls */ struct RCNTXT *jumptarget; /* target for a continuing jump */ int jumpmask; /* associated LONGJMP argument */ } RCNTXT, *context; enum { CTXT_TOPLEVEL = 0, CTXT_NEXT = 1, CTXT_BREAK = 2, CTXT_LOOP = 3, CTXT_FUNCTION = 4, CTXT_CCODE = 8, CTXT_RETURN = 12, CTXT_BROWSER = 16, CTXT_GENERIC = 20, CTXT_RESTART = 32, CTXT_BUILTIN = 64, CTXT_UNWIND = 128 }; #endif /* XRPROF_RDEFS_H */ xrprof-0.3.1/src/xrprof.c0000664000175000017500000001726514003613066014304 0ustar aaronaaron#include /* for errno */ #include /* for LONG_MIN, LONG_MAX */ #include #include #include #include /* for uintptr_t */ #include #include #include /* for timespec */ #ifdef __MINGW #include /* for nanosleep */ #endif #ifdef __linux #define HAVE_LIBUNWIND #include #endif #include "cursor.h" #include "process.h" #define MAX_STACK_DEPTH 100 #define DEFAULT_FREQ 1 #define MAX_FREQ 1000 #define DEFAULT_DURATION 3600 // One hour. static volatile int should_trace = 1; int install_ctrl_c_handler(); #ifdef __unix #include void handle_sigint(int _sig) { should_trace = 0; } int install_ctrl_c_handler() { signal(SIGINT, handle_sigint); return 0; } #elif defined(__WIN32) #include /* for BOOL, DWORD, SetConsoleCtrlHandler, TRUE */ BOOL handle_signal(DWORD signal) { if (signal == CTRL_C_EVENT) { should_trace = 0; } return TRUE; } int install_ctrl_c_handler() { if (!SetConsoleCtrlHandler(handle_signal, TRUE)) { fprintf(stderr, "error: Could not set console control handler.\n"); return -1; } return 0; } #else int install_ctrl_c_handler() { return 0; } #endif void usage(const char *name) { // TODO: Add a long help message. printf("Usage: %s [-v] [-m] [-F ] [-d ] [-o file] -p \n", name); return; } int main(int argc, char **argv) { pid_t pid = -1; int freq = DEFAULT_FREQ; float duration = DEFAULT_DURATION; int verbose = 0; FILE *outfile = stdout; #ifdef HAVE_LIBUNWIND int mixed_mode = 0; #endif int opt; while ((opt = getopt(argc, argv, "hvmF:d:o:p:")) != -1) { switch (opt) { case 'h': usage(argv[0]); return 0; break; case 'v': verbose++; break; case 'm': #ifdef HAVE_LIBUNWIND mixed_mode = 1; #else /* TODO: We should probably warn the user. */ #endif break; case 'p': pid = strtol(optarg, NULL, 10); if ((errno == ERANGE && (pid == LONG_MAX || pid == LONG_MIN)) || (errno != 0 && pid == 0)) { perror("strtol"); return 1; } if (pid < 0) { fprintf(stderr, "fatal: Cannot accept negative pids as input.\n"); return 1; } break; case 'F': freq = strtol(optarg, NULL, 10); if (freq <= 0) { freq = DEFAULT_FREQ; fprintf(stderr, "warning: Invalid frequency argument, falling back on the default %d.\n", freq); } else if (freq > MAX_FREQ) { freq = MAX_FREQ; fprintf(stderr, "warning: Frequency cannot exceed %d, using that instead.\n", freq); } break; case 'd': duration = strtof(optarg, NULL); if (errno != 0 && duration == 0) { perror("warning: Failed to decode duration argument"); } if (duration <= 0) { duration = DEFAULT_DURATION; fprintf(stderr, "warning: Invalid duration argument, failling back on the default %.0f.\n", duration); } break; case 'o': outfile = fopen(optarg, "w"); if (!outfile) { perror("fatal: Failed to open output file"); return 1; } break; default: /* '?' */ usage(argv[0]); return 1; break; } } // A PID is required. if (pid == -1) { usage(argv[0]); return 1; } struct timespec sleep_spec; sleep_spec.tv_sec = freq == 1 ? 1 : 0; sleep_spec.tv_nsec = freq == 1 ? 0 : 1000000000 / freq; phandle proc; int code = 0; /* First, check that we can attach to the process. */ if ((code = proc_create(&proc, (void *) &pid)) < 0) { return -code; } struct xrprof_cursor *cursor = xrprof_create(proc); if (!cursor) { fprintf(stderr, "fatal: Failed to initialize R stack cursor.\n"); code++; goto done; } #ifdef HAVE_LIBUNWIND unw_addr_space_t uw_as; void *uw_cxt; unw_cursor_t uw_cursor; if (mixed_mode) { uw_as = unw_create_addr_space(&_UPT_accessors, 0); unw_set_caching_policy(uw_as, UNW_CACHE_GLOBAL); uw_cxt = _UPT_create(proc); } #endif /* Stop the tracee and read the R stack information. */ // Allow the user to stop the tracing with Ctrl-C. if ((code = install_ctrl_c_handler()) < 0) { return -code; } float elapsed = 0; // Write the Rprof.out header. fprintf(outfile, "sample.interval=%d\n", 1000000 / freq); while (should_trace && elapsed <= duration) { if ((code = proc_suspend(proc)) < 0) { if (code == -2) { code = 0; break; } code = -code; goto done; } int ret; char rsym[256]; if ((ret = xrprof_init(cursor)) < 0) { code++; fprintf(stderr, "fatal: Failed to initialize R stack cursor: %d.\n", ret); goto done; } #ifdef HAVE_LIBUNWIND if (mixed_mode && unw_init_remote(&uw_cursor, uw_as, uw_cxt) != 0) { perror("fatal: Failed to initialize libunwind cursor."); code++; goto done; } else if (mixed_mode) { char sym[256]; unw_word_t offset, ip; unw_proc_info_t info; do { sym[0] = '\0'; if ((ret = unw_get_proc_info(&uw_cursor, &info)) < 0) { code++; fprintf(stderr, "fatal: Failed to get proc info via libunwind: %d.\n", ret); goto done; } if ((ret = unw_get_reg(&uw_cursor, UNW_REG_IP, &ip)) < 0) { code++; fprintf(stderr, "fatal: Failed to get IP register via libunwind: %d.\n", ret); goto done; } if ((ret = unw_get_proc_name(&uw_cursor, sym, sizeof(sym), &offset)) < 0) { if (ret == -UNW_EUNSPEC || ret == -UNW_ENOINFO) { fprintf(outfile, "\"\" ", ip); continue; } else if (ret != -UNW_ENOINFO) { code++; fprintf(stderr, "fatal: Failed to get proc symbol via libunwind: %d.\n", ret); goto done; } /* Symbol is truncated but otherwise fine. */ } /* We're not actually in the named procedure, but nearby. TODO: The printed address is wrong; it does not account for ASLR. */ if (ip > info.end_ip) { fprintf(outfile, "\"\" ", ip); continue; } /* TODO: Not sure what's going on here. */ if (strncmp(sym, "do_Rprof", 8) == 0) { continue; } /* Look for the first eval call and jump into the R stack. */ if (strncmp(sym, "Rf_eval", 7) == 0) { break; } /* Bail if we get to what looks like the REPL loop. */ if (strncmp(sym, "Rf_ReplIteration", 16) == 0) { break; } fprintf(outfile, "\"\" ", sym); } while ((ret = unw_step(&uw_cursor)) > 0); if (ret < 0) { code++; fprintf(stderr, "fatal: Failed to step libunwind cursor: %d.\n", ret); goto done; } } #endif do { rsym[0] = '\0'; if ((ret = xrprof_get_fun_name(cursor, rsym, sizeof(rsym))) < 0) { code++; goto done; } else if (ret == 0) { fprintf(outfile, "\"\" "); } else { fprintf(outfile, "\"%s\" ", rsym); } } while ((ret = xrprof_step(cursor)) > 0); if (ret < 0) { code++; fprintf(stderr, "fatal: Failed to step R stack cursor: %d.\n", ret); goto done; } fprintf(outfile, "\n"); if ((code = proc_resume(proc)) < 0) { code = -code; goto done; } if (nanosleep(&sleep_spec, NULL) < 0) { break; // Interupted. } elapsed = elapsed + 1.0 / freq; } done: proc_destroy(proc); xrprof_destroy(cursor); return code; } xrprof-0.3.1/src/process.h0000664000175000017500000000060714003613066014437 0ustar aaronaaron#ifndef XRPROF_PROCESS_H #define XRPROF_PROCESS_H #ifdef __WIN32 typedef void * phandle; #elif defined(__unix) #include /* for pid_t */ typedef pid_t phandle; #else #error "No support for this platform." #endif int proc_create(phandle *out, void *data); int proc_suspend(phandle pid); int proc_resume(phandle pid); int proc_destroy(phandle pid); #endif /* XRPROF_PROCESS_H */ xrprof-0.3.1/src/memory.c0000664000175000017500000000466314003613066014272 0ustar aaronaaron#ifdef __linux #define _GNU_SOURCE /* for process_vm_readv */ #endif #include /* for fprintf, perror, stderr */ #include "memory.h" #include "rdefs.h" #ifdef __linux #include /* for iovec, process_vm_readv */ /* No-op on Linux. */ int phandle_init(phandle *out, void *data) { pid_t pid = *((pid_t *) data); *out = pid; return 0; } ssize_t copy_address(phandle pid, void *addr, void *data, size_t len) { struct iovec local[1]; local[0].iov_base = data; local[0].iov_len = len; struct iovec remote[1]; remote[0].iov_base = addr; remote[0].iov_len = len; ssize_t bytes = process_vm_readv(pid, local, 1, remote, 1, 0); if (bytes < 0) { perror("error: Failed to read memory in the remote process"); } else if (bytes < len) { fprintf(stderr, "error: Partial read of memory in remote process.\n"); } return bytes; } #elif defined(__WIN32) #include /* for ReadProcessMemory, GetLastError */ ssize_t copy_address(phandle pid, void *addr, void *data, size_t len) { if (!ReadProcessMemory(pid, addr, data, len, NULL)) { fprintf(stderr, "error: Failed to read memory in the remote process: %ld.\n", GetLastError()); return -1; } return len; } #else #error "No support for this platform." #endif int copy_context(phandle pid, void *addr, RCNTXT *data) { if (!addr) { return -1; } size_t len = sizeof(RCNTXT); ssize_t bytes = copy_address(pid, addr, data, len); if (bytes < len) { return -2; } return 0; } int copy_sexp(phandle pid, void *addr, SEXP data) { if (!addr) { return -1; } size_t len = sizeof(SEXPREC); ssize_t bytes = copy_address(pid, addr, data, len); if (bytes < len) { return -2; } return 0; } int copy_char(phandle pid, void *addr, char *data, size_t max_len) { if (!addr) { return -1; } SEXPREC_ALIGN vec; size_t len; ssize_t bytes; void *str_addr = STDVEC_DATAPTR(addr); /* We need to do this is two passes. First, we read the VECSEXP data to get the length of the data, and then we use that length and the data pointer address to read the actual character array. */ len = sizeof(SEXPREC_ALIGN); bytes = copy_address(pid, addr, &vec, len); if (bytes < len) { return -2; } len = vec.s.vecsxp.length + 1 > max_len ? max_len : vec.s.vecsxp.length + 1; data[len] = '\0'; bytes = copy_address(pid, str_addr, data, len); if (bytes < len) { return -2; } return 0; } xrprof-0.3.1/src/cursor.c0000664000175000017500000001120614003613066014266 0ustar aaronaaron#include /* for malloc, free */ #include /* for fprintf */ #include "cursor.h" #include "rdefs.h" #include "locate.h" #include "memory.h" struct xrprof_cursor { void *rcxt_ptr; RCNTXT *cptr; struct libR_globals globals; phandle pid; int depth; }; struct xrprof_cursor *xrprof_create(phandle pid) { /* Find the symbols and addresses we need. */ struct libR_globals globals; if (locate_libR_globals(pid, &globals) < 0) return NULL; struct xrprof_cursor *out = malloc(sizeof(struct xrprof_cursor)); out->rcxt_ptr = NULL; out->cptr = malloc(sizeof(RCNTXT)); out->pid = pid; out->globals = globals; out->depth = 0; return out; } void xrprof_destroy(struct xrprof_cursor *cursor) { if (!cursor) { return; } if (cursor->cptr) { free(cursor->cptr); } return free(cursor); } #define MAX_SYM_LEN 128 int xrprof_get_fun_name(struct xrprof_cursor *cursor, char *buff, size_t len) { SEXPREC call, fun, cdr, lhs, rhs; char lname[MAX_SYM_LEN], rname[MAX_SYM_LEN]; size_t written; if (!cursor || !cursor->cptr) { return -1; } /* We're at the top level. */ if (cursor->cptr->callflag == CTXT_TOPLEVEL) { return 0; } int ret = copy_sexp(cursor->pid, (void *) cursor->cptr->call, &call); if (ret < 0) { fprintf(stderr, "error: Could not read SEXP for current call.\n"); return ret; } /* Adapted from R's eval.c code for Rprof. */ if (cursor->cptr->callflag & (CTXT_FUNCTION | CTXT_BUILTIN | CTXT_CCODE) && TYPEOF(&call) == LANGSXP) { ret = copy_sexp(cursor->pid, (void *) CAR(&call), &fun); if (ret < 0) { fprintf(stderr, "error: Unexpected R structure: current call lang item has no CAR.\n"); return ret; } if (TYPEOF(&fun) == SYMSXP) { copy_char(cursor->pid, (void *) PRINTNAME(&fun), rname, MAX_SYM_LEN); written = snprintf(buff, len, "%s", rname); } else if (TYPEOF(&fun) == LANGSXP) { copy_sexp(cursor->pid, (void *) CDR(&fun), &cdr); copy_sexp(cursor->pid, (void *) CAR(&cdr), &lhs); copy_sexp(cursor->pid, (void *) CDR(&cdr), &cdr); copy_sexp(cursor->pid, (void *) CAR(&cdr), &rhs); if ((uintptr_t) CAR(&fun) == cursor->globals.doublecolon && TYPEOF(&lhs) == SYMSXP && TYPEOF(&rhs) == SYMSXP) { copy_char(cursor->pid, (void *) PRINTNAME(&lhs), lname, MAX_SYM_LEN); copy_char(cursor->pid, (void *) PRINTNAME(&rhs), rname, MAX_SYM_LEN); written = snprintf(buff, len, "%s::%s", lname, rname); } else if ((uintptr_t) CAR(&fun) == cursor->globals.triplecolon && TYPEOF(&lhs) == SYMSXP && TYPEOF(&rhs) == SYMSXP) { copy_char(cursor->pid, (void *) PRINTNAME(&lhs), lname, MAX_SYM_LEN); copy_char(cursor->pid, (void *) PRINTNAME(&rhs), rname, MAX_SYM_LEN); written = snprintf(buff, len, "%s:::%s", lname, rname); } else if ((uintptr_t) CAR(&fun) == cursor->globals.dollar && TYPEOF(&lhs) == SYMSXP && TYPEOF(&rhs) == SYMSXP) { copy_char(cursor->pid, (void *) PRINTNAME(&lhs), lname, MAX_SYM_LEN); copy_char(cursor->pid, (void *) PRINTNAME(&rhs), rname, MAX_SYM_LEN); written = snprintf(buff, len, "%s$%s", lname, rname); } else { /* fprintf(stderr, "CAR(fun)=%p; lhs=%p; rhs=%p\n", */ /* (void *) CAR(fun), (void *) lhs, (void *) rhs); */ written = snprintf(buff, len, ""); } } else { written = snprintf(buff, len, ""); } } else { /* fprintf(stderr, "TYPEOF(call)=%d; callflag=%d\n", TYPEOF(call), */ /* cptr->callflag); */ written = snprintf(buff, len, ""); } /* Function name may be too long for the buffer. */ if (written >= len) { return -2; } return 1; } int xrprof_init(struct xrprof_cursor *cursor) { uintptr_t context_ptr; ssize_t bytes = copy_address(cursor->pid, (void *)cursor->globals.context_addr, &context_ptr, sizeof(uintptr_t)); if (bytes < sizeof(uintptr_t)) { /* copy_address() will have already printed an error. */ return -1; } cursor->rcxt_ptr = (void *) context_ptr; cursor->depth = 0; int ret = copy_context(cursor->pid, (void *) context_ptr, cursor->cptr); if (ret < 0) { return ret; } return 0; } int xrprof_step(struct xrprof_cursor *cursor) { if (!cursor || !cursor->cptr) { return -1; } /* We're at the top level. */ if (cursor->cptr->callflag == CTXT_TOPLEVEL) { return 0; } cursor->rcxt_ptr = cursor->cptr->nextcontext; cursor->depth++; copy_context(cursor->pid, cursor->rcxt_ptr, cursor->cptr); if (!cursor->cptr) { return -2; } return cursor->depth; } xrprof-0.3.1/src/locate.h0000664000175000017500000000053414003613066014227 0ustar aaronaaron#ifndef XRPROF_LOCATE_H #define XRPROF_LOCATE_H #include /* for uintptr_t */ #include "process.h" struct libR_globals { uintptr_t context_addr; uintptr_t doublecolon; uintptr_t triplecolon; uintptr_t dollar; uintptr_t bracket; }; int locate_libR_globals(phandle pid, struct libR_globals *out); #endif /* XRPROF_LOCATE_H */