Commit b734aa4a authored by Thomas Jahns's avatar Thomas Jahns 🤸

Make exchanger selectable via environment variable.

* Setting XT_CONFIG_DEFAULT_EXCHANGE_METHOD allows for an adjusted default.
parent b9cad586
......@@ -94,6 +94,18 @@ void xt_config_set_exchange_method(Xt_config config, int method);
*/
int xt_config_get_exchange_method(Xt_config config);
/**
* map exchanger name string to method id from \a Xt_exchangers
* @param[in] name string that is supposed to match the part of the
* corresponding enum after xt_exchanger_
* @return for the string "irecv_send", the value of
* xt_exchanger_irecv_send will be returned, for strings matching no
* known exchanger, -1 will be returned
*/
int
xt_exchanger_id_by_name(const char *name);
#endif
/*
......
......@@ -48,6 +48,8 @@
#include <config.h>
#endif
#include <string.h>
#include <mpi.h>
#include <xt/xt_config.h>
......@@ -60,7 +62,7 @@
#include "core/core.h"
#include "core/ppm_xfuncs.h"
const struct Xt_config_ xt_default_config = {
struct Xt_config_ xt_default_config = {
.exchanger_new = xt_exchanger_mix_isend_irecv_new,
};
......@@ -76,22 +78,35 @@ void xt_config_delete(Xt_config config)
free(config);
}
static struct {
static const struct {
char name[20];
Xt_exchanger_new f;
int code;
} exchanger_table[] = {
{ xt_exchanger_irecv_send_new, xt_exchanger_irecv_send },
{ xt_exchanger_irecv_isend_new, xt_exchanger_irecv_isend },
{ xt_exchanger_irecv_isend_packed_new, xt_exchanger_irecv_isend_packed },
{ xt_exchanger_mix_isend_irecv_new, xt_exchanger_mix_isend_irecv },
{ xt_exchanger_neigh_alltoall_new, xt_exchanger_neigh_alltoall },
{ "irecv_send",
xt_exchanger_irecv_send_new, xt_exchanger_irecv_send },
{ "irecv_isend",
xt_exchanger_irecv_isend_new, xt_exchanger_irecv_isend },
{ "irecv_isend_packed",
xt_exchanger_irecv_isend_packed_new, xt_exchanger_irecv_isend_packed },
{ "mix_irecv_isend",
xt_exchanger_mix_isend_irecv_new, xt_exchanger_mix_isend_irecv },
{ "neigh_alltoall",
xt_exchanger_neigh_alltoall_new, xt_exchanger_neigh_alltoall },
};
enum {
num_exchanger = sizeof (exchanger_table) / sizeof (exchanger_table[0]),
};
int
xt_exchanger_id_by_name(const char *name)
{
for (size_t i = 0; i < num_exchanger; ++i)
if (!strcmp(name, exchanger_table[i].name))
return exchanger_table[i].code;
return -1;
}
int xt_config_get_exchange_method(Xt_config config)
{
......@@ -121,7 +136,16 @@ void xt_config_set_exchange_method(Xt_config config, int method)
Xt_abort(Xt_default_comm, buf, "xt_config.c", __LINE__);
}
void
xt_config_defaults_init(void)
{
const char *config_env = getenv("XT_CONFIG_DEFAULT_EXCHANGE_METHOD");
if (config_env) {
int exchanger_id = xt_exchanger_id_by_name(config_env);
if (exchanger_id != -1)
xt_config_set_exchange_method(&xt_default_config, exchanger_id);
}
}
/*
* Local Variables:
......
......@@ -46,7 +46,8 @@
! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
MODULE xt_config_f
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_int
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_int, &
c_char, c_null_char
IMPLICIT NONE
PRIVATE
! note: this type must not be extended to contain any other
......@@ -72,6 +73,7 @@ MODULE xt_config_f
PUBLIC :: xt_config_new, xt_config_delete
PUBLIC :: xt_config_f2c
PUBLIC :: xt_exchanger_id_by_name
PUBLIC :: xt_config_get_exchange_method, xt_config_set_exchange_method
INTEGER, PUBLIC, PARAMETER :: &
xt_exchanger_irecv_send = 0, &
......@@ -137,6 +139,29 @@ CONTAINS
method = INT(xt_config_get_exchange_method_c(config%cptr))
END FUNCTION xt_config_get_exchange_method
FUNCTION xt_exchanger_id_by_name(name) RESULT(exchanger_id)
CHARACTER(len=*), INTENT(in) :: name
INTEGER :: exchanger_id
INTERFACE
FUNCTION xt_exchanger_id_by_name_c(name) RESULT(exchanger_id) &
BIND(c, name='xt_exchanger_id_by_name')
IMPORT :: c_char, c_int
CHARACTER(len=1, kind=c_char), INTENT(in) :: name(*)
INTEGER(c_int) :: exchanger_id
END FUNCTION xt_exchanger_id_by_name_c
END INTERFACE
INTEGER(c_int) :: c_id
CHARACTER(len=1) :: name_c(LEN(name)+1)
INTEGER :: i, nlen
nlen = LEN(name)
DO i = 1, nlen
name_c(i) = name(i:i)
END DO
name_c(nlen+1) = c_null_char
c_id = xt_exchanger_id_by_name_c(name_c)
exchanger_id = INT(c_id)
END FUNCTION xt_exchanger_id_by_name
END MODULE xt_config_f
!
! Local Variables:
......
......@@ -58,7 +58,10 @@ struct Xt_config_ {
Xt_exchanger_new exchanger_new;
};
extern const struct Xt_config_ xt_default_config;
extern struct Xt_config_ xt_default_config;
void
xt_config_defaults_init(void);
/*
* Local Variables:
......
......@@ -49,6 +49,7 @@
#include <stdlib.h>
#include "core/core.h"
#include "xt_config_internal.h"
#include "xt_idxlist_internal.h"
#include "xt_idxstripes_internal.h"
#include "xt_idxsection_internal.h"
......@@ -70,6 +71,7 @@ xt_initialize(MPI_Comm default_comm)
{
Xt_default_comm = default_comm;
xt_mpi_init();
xt_config_defaults_init();
xt_idxempty_init();
xt_idxstripes_initialize();
xt_idxsection_initialize();
......
......@@ -56,6 +56,7 @@ MODULE yaxt
xt_pos_ext, OPERATOR(/=), OPERATOR(==), &
xt_set_abort_handler => set_abort_handler, xt_restore_default_abort_hndl
USE xt_config_f, ONLY: xt_config, xt_config_new, xt_config_delete, &
xt_exchanger_id_by_name, &
xt_config_get_exchange_method, xt_config_set_exchange_method, &
xt_exchanger_irecv_send, xt_exchanger_irecv_isend, &
xt_exchanger_irecv_isend_packed, xt_exchanger_mix_isend_irecv, &
......@@ -179,6 +180,7 @@ MODULE yaxt
xt_redist_a_exchange
PUBLIC :: xt_config, xt_config_new, xt_config_delete, &
xt_exchanger_id_by_name, &
xt_config_get_exchange_method, xt_config_set_exchange_method, &
xt_exchanger_irecv_send, xt_exchanger_irecv_isend, &
xt_exchanger_irecv_isend_packed, xt_exchanger_mix_isend_irecv, &
......
......@@ -144,7 +144,7 @@ static Xt_exchanger_new *parse_options(int *argc, char ***argv)
switch (opt) {
case 'm':
{
int exchanger_new_id = exchanger_id_by_name(optarg);
int exchanger_new_id = xt_exchanger_id_by_name(optarg);
if (exchanger_new_id == -1)
{
fprintf(stderr, "Unknown exchanger constructor requested: %s\n",
......
......@@ -258,26 +258,6 @@ wrap_a_exchange1(Xt_redist redist, const void *src_data_p, void *dst_data_p)
check_wait_request(&request);
}
int
exchanger_id_by_name(const char *name)
{
int exchanger_new;
if (!strcmp(name, "irecv_isend"))
exchanger_new = xt_exchanger_irecv_isend;
else if (!strcmp(name, "irecv_isend_packed"))
exchanger_new = xt_exchanger_irecv_isend_packed;
else if (!strcmp(name, "irecv_send"))
exchanger_new = xt_exchanger_irecv_send;
else if (!strcmp(name, "mix_irecv_isend"))
exchanger_new = xt_exchanger_mix_isend_irecv;
else if (!strcmp(name, "neigh_alltoall"))
exchanger_new = xt_exchanger_neigh_alltoall;
else
exchanger_new = -1;
return exchanger_new;
}
Xt_config
redist_exchanger_option(int *argc, char ***argv)
{
......@@ -287,7 +267,7 @@ redist_exchanger_option(int *argc, char ***argv)
switch (opt) {
case 'm':
{
int exchanger_id = exchanger_id_by_name(optarg);
int exchanger_id = xt_exchanger_id_by_name(optarg);
if (exchanger_id != -1)
xt_config_set_exchange_method(config, exchanger_id);
else {
......
......@@ -167,9 +167,6 @@ check_wait_request_(Xt_request *request, const char *file, int line);
#define check_wait_request(request) \
check_wait_request_(request, __FILE__, __LINE__)
int
exchanger_id_by_name(const char *name);
Xt_config
redist_exchanger_option(int *argc, char ***argv);
......
......@@ -57,7 +57,7 @@ MODULE test_redist_common
xt_request, xt_request_wait, xt_request_test, xt_is_null, &
xt_redist_get_num_recv_msg, xt_redist_get_num_send_msg, &
xi => xt_int_kind, xt_config, xt_config_new, &
xt_config_set_exchange_method
xt_config_set_exchange_method, xt_exchanger_id_by_name
#ifdef __PGI
! PGI up to at least 15.4 has a bug that prevents proper import of
! multiply extended generics. This is a separate bug from the one exhibited
......@@ -579,19 +579,10 @@ CONTAINS
FUNCTION redist_exchanger_option() RESULT(config)
TYPE(xt_config) :: config
INTEGER :: i, j, num_cmd_args, arg_len
INTEGER(c_int) :: exchanger_id
INTEGER :: i, num_cmd_args, arg_len
INTEGER :: exchanger_id
INTEGER, PARAMETER :: max_opt_arg_len = 80
CHARACTER(max_opt_arg_len) :: optarg
CHARACTER(len=1, kind=c_char) :: optarg_c(max_opt_arg_len+1)
INTERFACE
FUNCTION exchanger_id_by_name(name) RESULT(exchanger_id) &
BIND(c, name='exchanger_id_by_name')
IMPORT :: c_char, c_int
CHARACTER(len=1, kind=c_char), INTENT(in) :: name(*)
INTEGER(c_int) :: exchanger_id
END FUNCTION exchanger_id_by_name
END INTERFACE
config = xt_config_new()
num_cmd_args = COMMAND_ARGUMENT_COUNT()
i = 1
......@@ -602,17 +593,13 @@ CONTAINS
IF (arg_len > max_opt_arg_len) &
CALL test_abort('incorrect argument to command-line option -s', &
filename, __LINE__)
DO j = 1, arg_len
optarg_c(j) = optarg(j:j)
END DO
optarg_c(arg_len+1) = c_null_char
exchanger_id = exchanger_id_by_name(optarg_c)
IF (exchanger_id == -1_c_int) THEN
exchanger_id = xt_exchanger_id_by_name(optarg)
IF (exchanger_id == -1) THEN
WRITE (0, *) 'arg to -m: ', optarg(1:arg_len)
CALL test_abort('incorrect argument to command-line option -m', &
filename, __LINE__)
END IF
CALL xt_config_set_exchange_method(config, INT(exchanger_id))
CALL xt_config_set_exchange_method(config, exchanger_id)
i = i + 2
ELSE
WRITE (0, *) 'unexpected command-line argument parsing error: ', &
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment