From 721f21bf467c84bc73a79ff7af007b2a6aa29d6f Mon Sep 17 00:00:00 2001 From: DylanKierans Date: Mon, 18 Mar 2024 17:29:03 +0100 Subject: [PATCH 1/2] Tmp files for PSOCK cluster --- R/makePSOCKcluster.R | 70 ++++++++++++++++++++++++++++++++++++++++ R/r_instrument_ll.R | 12 +++---- src/makePSOCKcluster.cpp | 38 ++++++++++++++++++++++ 3 files changed, 114 insertions(+), 6 deletions(-) create mode 100644 R/makePSOCKcluster.R create mode 100644 src/makePSOCKcluster.cpp diff --git a/R/makePSOCKcluster.R b/R/makePSOCKcluster.R new file mode 100644 index 0000000..6d35fd5 --- /dev/null +++ b/R/makePSOCKcluster.R @@ -0,0 +1,70 @@ +# Functions for makePSOCKcluster, and potential makeSOCKcluster + +insert_instrumentation_on_new_proc <- function() +{ + flag_debug <- FALSE + + func_ptrs <- get_function_list() + num_func_ptrs <- sum(get_num_functions()) + + function_exception_list <- get_function_exception_list() + function_methods_exception_list <- get_function_methods(function_exception_list) + + assign_regionRef_array_client(num_function_ptrs) + open_otf2_regionRef_sockets() + + ## Starting new here + for (func_index in 1:num_func_ptrs){ + + func_ptr <- func_ptrs[[func_index]] + func_name <- names(func_ptrs)[[func_index]] + #package_name <- names(func_ptrs)[[func_index]] + env <- environment(func_ptrs[[func_index]]) + package_name <- environmentName(env) + + ## DEBUGGING - Display current function (before checks) + if (flag_debug) { + # print("#######################################") + # print(paste0("func_index: ", func_index)) + print(func_ptr) + print(func_name) + print(env) + print(paste0("package: ", package_name, ", function: ", func_name)) + } + + flag_user_function=FALSE + if (env==.GlobalEnv){flag_user_function=TRUE} + + #if (env == NULL){ print(paste0("NULL env, func_name: ", func_name)) } + print(paste0("func_name: ", func_name)) + + ## Test if function should be skipped + if ( skip_function(func_ptr, func_name, env, function_exception_list, function_methods_exception_list)) { + print(paste0("Skipping: ", func_name)) + next; # skip to next loop + } + + ## Get otf2 regionRef + regionRef <- get_regionReg_from_array_client(func_index) + if (pkg.env$PRINT_INSTRUMENTS) { + print(paste0("INSTRUMENTING: function `", func_name,"`", + ", regionRef: ", regionRef)) + } + + ## Wrap function with debug info + insert_instrumentation(func_ptr, func_name, func_index, + regionRef, package_name, + env_is_locked=!pkg.env$UNLOCK_ENVS, + flag_user_function=flag_user_function) + + } + close_otf2_regionRef_sockets() +} + + +#if (FALSE){ + + +# ## Label as instrumented in instrumentation dataframe +# pkg.env$PROFILE_INSTRUMENTATION_DF[["function_instrumented"]][func_global_index] <- TRUE +# diff --git a/R/r_instrument_ll.R b/R/r_instrument_ll.R index 8a3099c..4f644a2 100644 --- a/R/r_instrument_ll.R +++ b/R/r_instrument_ll.R @@ -435,6 +435,12 @@ skip_function <- function(func_ptr, func_name, env, return(TRUE) } + ## 3 - Skip if primitive function - DEBUGGING (some are problematic) + if ( is.primitive(func_ptr) ) { + if (pkg.env$PRINT_SKIPS) print(paste0("SKIPPING: function `", func_name, "` is PRIMITVE function")) + return(TRUE) + } + ## Skip if function not defined in current package if ( !exists(func_name, envir = env, inherits=T)) { if (pkg.env$PRINT_SKIPS) print(paste0("SKIPPING: function `", func_name, "` DOES NOT exist in package env: ", env)) @@ -455,12 +461,6 @@ skip_function <- function(func_ptr, func_name, env, return(TRUE) } - ## 3 - Skip if primitive function - DEBUGGING (some are problematic) - if ( is.primitive(func_ptr) ) { - if (pkg.env$PRINT_SKIPS) print(paste0("SKIPPING: function `", func_name, "` is PRIMITVE function")) - return(TRUE) - } - ## 4 - Skip if not language body - DEBUGGING (symbol in na.null() was causing issues) if ( typeof(body(func_ptr)) != "language" ) { if (pkg.env$PRINT_SKIPS) print(paste0("SKIPPING: function `", func_name, "` body is type: ", typeof(body(func_ptr)))) diff --git a/src/makePSOCKcluster.cpp b/src/makePSOCKcluster.cpp new file mode 100644 index 0000000..925742c --- /dev/null +++ b/src/makePSOCKcluster.cpp @@ -0,0 +1,38 @@ +void *context; +void *regionRef_socket_client; +void *regionRef_socket_server; +int *regionReg_array; + +//int *regionReg_array = malloc(num_func * sizeof(*region_ref_vs_func_index)); +//free(regionReg_array); + +// Confirm num_functions, then send all regionRef in order +void open_otf2_regionRef_sockets_server(){ + context = zmq_ctx_new (); + regionRef_socket_server = zmq_socket (context, ZMQ_PUSH); + int rc = zmq_bind (regionRef_socket_server, "tcp://*:5558"); + + int zmq_ret = zmq_send(regionRef_socket_server, regionReg_array, num_functions*sizeof(*region_ref_vs_func_index)); +} + +RcppExport SEXP open_otf2_regionRef_sockets_clients(){ + context = zmq_ctx_new (); + regionRef_socket_client = zmq_socket (context, ZMQ_PULL); + zmq_bind (regionRef_socket_client, "tcp://localhost:5558"); + + int zmq_ret = zmq_recv(); +} + +RcppExport SEXP assign_regionRef_array_client(int num_function_ptrs){ + regionReg_array = malloc(num_function_ptrs*sizeof(*regionRef_array)); + return(R_NilValue); +} + +RcppExport SEXP get_regionRef_from_array_client(int func_index){ + return(regionRef_array[func_index]); +} + +RcppExport SEXP free_regionRef_array_client(){ + free(regionReg_array); + return(R_NilValue); +} \ No newline at end of file From 7a516781d48dfe81703bce680a12983d4f100e9e Mon Sep 17 00:00:00 2001 From: DylanKierans Date: Mon, 18 Mar 2024 17:30:03 +0100 Subject: [PATCH 2/2] Revert "Removing mpi from testing" This reverts commit 1478129e42878317517ad48b13a3781896feb631. --- .github/workflows/R-CMD-check.yaml | 13 ++++++ R/RcppExports.R | 25 ++++++++++ man/get_env.Rd | 14 ++++++ man/get_mpi_rank.Rd | 11 +++++ man/get_mpi_size.Rd | 11 +++++ man/mpi_finalize.Rd | 11 +++++ man/mpi_init.Rd | 11 +++++ man/mpi_is_init.Rd | 11 +++++ src/Makevars | 10 +++- src/RcppExports.cpp | 55 ++++++++++++++++++++++ src/rTrace.cpp | 73 ++++++++++++++++++++++++++++++ 11 files changed, 243 insertions(+), 2 deletions(-) create mode 100644 man/get_env.Rd create mode 100644 man/get_mpi_rank.Rd create mode 100644 man/get_mpi_size.Rd create mode 100644 man/mpi_finalize.Rd create mode 100644 man/mpi_init.Rd create mode 100644 man/mpi_is_init.Rd diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 53bd238..156006c 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -58,6 +58,19 @@ jobs: run: | brew install otf2 + # MANUAL OPENMPI INSTALL + - name: Install openmpi (linux) + if: runner.os == 'linux' + run: | + sudo apt-get install libopenmpi-dev + export MPI_ROOT=$(which mpicc | xargs dirname | xargs dirname) + + - name: Install openmpi (mac) + if: runner.os == 'macOS' + run: | + brew install open-mpi + export MPI_ROOT=$(which mpicc | xargs dirname | xargs dirname) + - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::rcmdcheck diff --git a/R/RcppExports.R b/R/RcppExports.R index 888b8b4..5cacb01 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -113,3 +113,28 @@ get_ppid <- function() { .Call('_rTrace_get_ppid', PACKAGE = 'rTrace') } +#' mpi_init +mpi_init <- function() { + .Call('_rTrace_mpi_init', PACKAGE = 'rTrace') +} + +#' mpi_finalize +mpi_finalize <- function() { + .Call('_rTrace_mpi_finalize', PACKAGE = 'rTrace') +} + +#' mpi_is_init +mpi_is_init <- function() { + .Call('_rTrace_mpi_is_init', PACKAGE = 'rTrace') +} + +#' get_mpi_rank +get_mpi_rank <- function() { + .Call('_rTrace_get_mpi_rank', PACKAGE = 'rTrace') +} + +#' get_mpi_size +get_mpi_size <- function() { + .Call('_rTrace_get_mpi_size', PACKAGE = 'rTrace') +} + diff --git a/man/get_env.Rd b/man/get_env.Rd new file mode 100644 index 0000000..f9bc4f8 --- /dev/null +++ b/man/get_env.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/r_utils.R +\name{get_env} +\alias{get_env} +\title{get_env} +\usage{ +get_env() +} +\value{ +Environment +} +\description{ +Get environment object for this package rTrace +} diff --git a/man/get_mpi_rank.Rd b/man/get_mpi_rank.Rd new file mode 100644 index 0000000..0fef67e --- /dev/null +++ b/man/get_mpi_rank.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{get_mpi_rank} +\alias{get_mpi_rank} +\title{get_mpi_rank} +\usage{ +get_mpi_rank() +} +\description{ +get_mpi_rank +} diff --git a/man/get_mpi_size.Rd b/man/get_mpi_size.Rd new file mode 100644 index 0000000..4065066 --- /dev/null +++ b/man/get_mpi_size.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{get_mpi_size} +\alias{get_mpi_size} +\title{get_mpi_size} +\usage{ +get_mpi_size() +} +\description{ +get_mpi_size +} diff --git a/man/mpi_finalize.Rd b/man/mpi_finalize.Rd new file mode 100644 index 0000000..9f73f23 --- /dev/null +++ b/man/mpi_finalize.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mpi_finalize} +\alias{mpi_finalize} +\title{mpi_finalize} +\usage{ +mpi_finalize() +} +\description{ +mpi_finalize +} diff --git a/man/mpi_init.Rd b/man/mpi_init.Rd new file mode 100644 index 0000000..e9d1b0e --- /dev/null +++ b/man/mpi_init.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mpi_init} +\alias{mpi_init} +\title{mpi_init} +\usage{ +mpi_init() +} +\description{ +mpi_init +} diff --git a/man/mpi_is_init.Rd b/man/mpi_is_init.Rd new file mode 100644 index 0000000..e678430 --- /dev/null +++ b/man/mpi_is_init.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{mpi_is_init} +\alias{mpi_is_init} +\title{mpi_is_init} +\usage{ +mpi_is_init() +} +\description{ +mpi_is_init +} diff --git a/src/Makevars b/src/Makevars index 303a8f2..6ce79ea 100644 --- a/src/Makevars +++ b/src/Makevars @@ -2,5 +2,11 @@ OTF2_PKG_CPPFLAGS=-I${OTF2_ROOT}/include -I. OTF2_PKG_LIBS=-L${OTF2_ROOT}/lib -L. -lotf2 -PKG_CPPFLAGS=${OTF2_PKG_CPPFLAGS} -PKG_LIBS=${OTF2_PKG_LIBS} +# mpi +#MPI_PKG_CPPFLAGS=$(mpicc -showme:compile) +#MPI_PKG_LIBS=$(mpicc -showme:link) +MPI_PKG_CPPFLAGS=-I${MPI_ROOT}/include +MPI_PKG_LIBS=-L${MPI_ROOT}/lib -lmpi + +PKG_CPPFLAGS=${OTF2_PKG_CPPFLAGS} ${MPI_PKG_CPPFLAGS} +PKG_LIBS=${OTF2_PKG_LIBS} ${MPI_PKG_LIBS} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 504119e..d25c27a 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -191,6 +191,56 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// mpi_init +RcppExport int mpi_init(); +RcppExport SEXP _rTrace_mpi_init() { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = Rcpp::wrap(mpi_init()); + return rcpp_result_gen; +END_RCPP +} +// mpi_finalize +RcppExport SEXP mpi_finalize(); +RcppExport SEXP _rTrace_mpi_finalize() { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = Rcpp::wrap(mpi_finalize()); + return rcpp_result_gen; +END_RCPP +} +// mpi_is_init +RcppExport int mpi_is_init(); +RcppExport SEXP _rTrace_mpi_is_init() { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = Rcpp::wrap(mpi_is_init()); + return rcpp_result_gen; +END_RCPP +} +// get_mpi_rank +RcppExport int get_mpi_rank(); +RcppExport SEXP _rTrace_get_mpi_rank() { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = Rcpp::wrap(get_mpi_rank()); + return rcpp_result_gen; +END_RCPP +} +// get_mpi_size +RcppExport int get_mpi_size(); +RcppExport SEXP _rTrace_get_mpi_size() { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = Rcpp::wrap(get_mpi_size()); + return rcpp_result_gen; +END_RCPP +} static const R_CallMethodDef CallEntries[] = { {"_rTrace_init_Archive", (DL_FUNC) &_rTrace_init_Archive, 2}, @@ -210,6 +260,11 @@ static const R_CallMethodDef CallEntries[] = { {"_rTrace_get_pid", (DL_FUNC) &_rTrace_get_pid, 0}, {"_rTrace_get_tid", (DL_FUNC) &_rTrace_get_tid, 0}, {"_rTrace_get_ppid", (DL_FUNC) &_rTrace_get_ppid, 0}, + {"_rTrace_mpi_init", (DL_FUNC) &_rTrace_mpi_init, 0}, + {"_rTrace_mpi_finalize", (DL_FUNC) &_rTrace_mpi_finalize, 0}, + {"_rTrace_mpi_is_init", (DL_FUNC) &_rTrace_mpi_is_init, 0}, + {"_rTrace_get_mpi_rank", (DL_FUNC) &_rTrace_get_mpi_rank, 0}, + {"_rTrace_get_mpi_size", (DL_FUNC) &_rTrace_get_mpi_size, 0}, {NULL, NULL, 0} }; diff --git a/src/rTrace.cpp b/src/rTrace.cpp index 4795cf8..1be957a 100644 --- a/src/rTrace.cpp +++ b/src/rTrace.cpp @@ -14,6 +14,10 @@ #include #include +// if (MPI) +#include + + //#define DEBUG /* Uncomment to enable verbose debug info */ //#define DUMMY_TIMESTEPS /* Uncomment for 1s timestep for each subsequent event call */ @@ -382,3 +386,72 @@ RcppExport int get_tid() { RcppExport int get_ppid() { return((int)getppid()); } + +//' mpi_init +// [[Rcpp::export]] +RcppExport int mpi_init() { + int flag; + int fake_argc = 0; + char **fake_argv = NULL; +//char **fake_argv = malloc(1*sizeof(*fake_argv)); + MPI_Init(&fake_argc, &fake_argv); + free(fake_argv); + + MPI_Initialized(&flag); + if (flag) { + Rcout << "MPI is initialized.\n"; + return(0); + } + Rcout << "MPI UNABLE to initialize.\n"; + return (-1); +} + +//' mpi_finalize +// [[Rcpp::export]] +RcppExport SEXP mpi_finalize() { + MPI_Finalize(); + return(R_NilValue); +} + +//' mpi_is_init +// [[Rcpp::export]] +RcppExport int mpi_is_init() { + int init_flag; + MPI_Initialized(&init_flag); + if (init_flag) { + Rcout << "MPI is initialized.\n"; + return(0); + } + Rcout << "MPI is NOT initialized\n"; + return (-1); +} + +//' get_mpi_rank +// [[Rcpp::export]] +RcppExport int get_mpi_rank() { + int rank, init_flag; + MPI_Initialized(&init_flag); + if (init_flag) { + Rcout << "MPI is initialized.\n"; + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + return(rank); + } + Rcout << "MPI is NOT initialized\n"; + return (-1); +} + +//' get_mpi_size +// [[Rcpp::export]] +RcppExport int get_mpi_size() { + int size, init_flag; + MPI_Initialized(&init_flag); + if (init_flag) { + Rcout << "MPI is initialized.\n"; + MPI_Comm_size(MPI_COMM_WORLD, &size); + return(size); + } + Rcout << "MPI is NOT initialized\n"; + return (-1); +} + +