X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/deb8d283908c7fd7002d65a4d8920b59a21fdf52..c8a8ad6adbbd82cb0a9c145b0ac9f563ad62775d:/src/smpi/smpi_mpi_dt.cpp diff --git a/src/smpi/smpi_mpi_dt.cpp b/src/smpi/smpi_mpi_dt.cpp index e948b65137..cc01776fff 100644 --- a/src/smpi/smpi_mpi_dt.cpp +++ b/src/smpi/smpi_mpi_dt.cpp @@ -1,20 +1,20 @@ /* smpi_mpi_dt.c -- MPI primitives to handle datatypes */ -/* Copyright (c) 2009-2015. The SimGrid Team. - * All rights reserved. */ +/* Copyright (c) 2009-2017. The SimGrid Team. All rights reserved. */ /* This program is free software; you can redistribute it and/or modify it * under the terms of the license (GNU LGPL) which comes with this package. */ -#include -#include -#include -#include +#include "mc/mc.h" #include "private.h" +#include "simgrid/modelchecker.h" #include "smpi_mpi_dt_private.h" -#include "mc/mc.h" #include "xbt/replay.h" +#include +#include +#include +#include +#include #include -#include "simgrid/modelchecker.h" XBT_LOG_NEW_DEFAULT_SUBCATEGORY(smpi_mpi_dt, smpi, "Logging specific to SMPI (datatype)"); @@ -188,15 +188,15 @@ int smpi_datatype_dup(MPI_Datatype datatype, MPI_Datatype* new_t) if(datatype->attributes !=nullptr){ (*new_t)->attributes = xbt_dict_new_homogeneous(nullptr); xbt_dict_cursor_t cursor = nullptr; - int* key; + char* key; int flag; void* value_in; void* value_out; xbt_dict_foreach (datatype->attributes, cursor, key, value_in) { - smpi_type_key_elem elem = static_cast( - xbt_dict_get_or_null_ext(smpi_type_keyvals, reinterpret_cast(key), sizeof(int))); + smpi_type_key_elem elem = + static_cast(xbt_dict_get_or_null_ext(smpi_type_keyvals, key, sizeof(int))); if (elem != nullptr && elem->copy_fn != MPI_NULL_COPY_FN) { - ret = elem->copy_fn(datatype, *key, nullptr, value_in, &value_out, &flag); + ret = elem->copy_fn(datatype, atoi(key), nullptr, value_in, &value_out, &flag); if (ret != MPI_SUCCESS) { smpi_datatype_unuse(*new_t); *new_t = MPI_DATATYPE_NULL; @@ -204,7 +204,7 @@ int smpi_datatype_dup(MPI_Datatype datatype, MPI_Datatype* new_t) return ret; } if (flag) - xbt_dict_set_ext((*new_t)->attributes, reinterpret_cast(key), sizeof(int), value_out, nullptr); + xbt_dict_set_ext((*new_t)->attributes, key, sizeof(int), value_out, nullptr); } } } @@ -293,12 +293,12 @@ int smpi_datatype_copy(void *sendbuf, int sendcount, MPI_Datatype sendtype, * - block_length - the width or height of blocked matrix * - count - the number of rows of matrix */ -void serialize_vector( const void *noncontiguous_vector, void *contiguous_vector, int count, void *type) +void serialize_vector( void* noncontiguous_vector, void *contiguous_vector, int count, void *type) { s_smpi_mpi_vector_t* type_c = reinterpret_cast(type); int i; char* contiguous_vector_char = static_cast(contiguous_vector); - const char* noncontiguous_vector_char = static_cast(noncontiguous_vector); + char* noncontiguous_vector_char = static_cast(noncontiguous_vector); for (i = 0; i < type_c->block_count * count; i++) { if (type_c->old_type->sizeof_substruct == 0) @@ -325,12 +325,12 @@ void serialize_vector( const void *noncontiguous_vector, void *contiguous_vector * - block_length - the width or height of blocked matrix * - count - the number of rows of matrix */ -void unserialize_vector( const void *contiguous_vector, void *noncontiguous_vector, int count, void *type, MPI_Op op) +void unserialize_vector( void* contiguous_vector, void *noncontiguous_vector, int count, void *type, MPI_Op op) { s_smpi_mpi_vector_t* type_c = reinterpret_cast(type); int i; - const char* contiguous_vector_char = static_cast(contiguous_vector); + char* contiguous_vector_char = static_cast(contiguous_vector); char* noncontiguous_vector_char = static_cast(noncontiguous_vector); for (i = 0; i < type_c->block_count * count; i++) { @@ -401,12 +401,12 @@ void smpi_datatype_free(MPI_Datatype* type){ if((*type)->attributes !=nullptr){ xbt_dict_cursor_t cursor = nullptr; - int* key; + char* key; void * value; int flag; xbt_dict_foreach((*type)->attributes, cursor, key, value){ smpi_type_key_elem elem = - static_cast(xbt_dict_get_or_null_ext(smpi_type_keyvals, reinterpret_cast(key), sizeof(int))); + static_cast(xbt_dict_get_or_null_ext(smpi_type_keyvals, key, sizeof(int))); if(elem!=nullptr && elem->delete_fn!=nullptr) elem->delete_fn(*type,*key, value, &flag); } @@ -424,8 +424,9 @@ void smpi_datatype_free(MPI_Datatype* type){ void smpi_datatype_use(MPI_Datatype type){ - if(type != MPI_DATATYPE_NULL) - type->in_use++; + if(type == MPI_DATATYPE_NULL) + return; + type->in_use++; if(type->sizeof_substruct!=0){ static_cast((type)->substruct)->subtype_use(&type); @@ -467,11 +468,11 @@ void smpi_datatype_unuse(MPI_Datatype type) * - block_length - the width or height of blocked matrix * - count - the number of rows of matrix */ -void serialize_contiguous( const void *noncontiguous_hvector, void *contiguous_hvector, int count, void *type) +void serialize_contiguous( void* noncontiguous_hvector, void *contiguous_hvector, int count, void *type) { s_smpi_mpi_contiguous_t* type_c = reinterpret_cast(type); char* contiguous_vector_char = static_cast(contiguous_hvector); - const char* noncontiguous_vector_char = static_cast(noncontiguous_hvector)+type_c->lb; + char* noncontiguous_vector_char = static_cast(noncontiguous_hvector)+type_c->lb; memcpy(contiguous_vector_char, noncontiguous_vector_char, count* type_c->block_count * type_c->size_oldtype); } /* Copies contiguous data into noncontiguous memory. @@ -482,10 +483,10 @@ void serialize_contiguous( const void *noncontiguous_hvector, void *contiguous_h * - block_length - the width or height of blocked matrix * - count - the number of rows of matrix */ -void unserialize_contiguous(const void *contiguous_vector, void *noncontiguous_vector, int count, void *type, MPI_Op op) +void unserialize_contiguous(void* contiguous_vector, void *noncontiguous_vector, int count, void *type, MPI_Op op) { s_smpi_mpi_contiguous_t* type_c = reinterpret_cast(type); - const char* contiguous_vector_char = static_cast(contiguous_vector); + char* contiguous_vector_char = static_cast(contiguous_vector); char* noncontiguous_vector_char = static_cast(noncontiguous_vector)+type_c->lb; int n= count* type_c->block_count; smpi_op_apply(op, contiguous_vector_char, noncontiguous_vector_char, &n, &type_c->old_type); @@ -580,12 +581,12 @@ void use_vector(MPI_Datatype* d){ * - block_length - the width or height of blocked matrix * - count - the number of rows of matrix */ -void serialize_hvector( const void *noncontiguous_hvector, void *contiguous_hvector, int count, void *type) +void serialize_hvector( void* noncontiguous_hvector, void *contiguous_hvector, int count, void *type) { s_smpi_mpi_hvector_t* type_c = reinterpret_cast(type); int i; char* contiguous_vector_char = static_cast(contiguous_hvector); - const char* noncontiguous_vector_char = static_cast(noncontiguous_hvector); + char* noncontiguous_vector_char = static_cast(noncontiguous_hvector); for (i = 0; i < type_c->block_count * count; i++) { if (type_c->old_type->sizeof_substruct == 0) @@ -610,12 +611,12 @@ void serialize_hvector( const void *noncontiguous_hvector, void *contiguous_hvec * - block_length - the width or height of blocked matrix * - count - the number of rows of matrix */ -void unserialize_hvector( const void *contiguous_vector, void *noncontiguous_vector, int count, void *type, MPI_Op op) +void unserialize_hvector( void* contiguous_vector, void *noncontiguous_vector, int count, void *type, MPI_Op op) { s_smpi_mpi_hvector_t* type_c = reinterpret_cast(type); int i; - const char* contiguous_vector_char = static_cast(contiguous_vector); + char* contiguous_vector_char = static_cast(contiguous_vector); char* noncontiguous_vector_char = static_cast(noncontiguous_vector); for (i = 0; i < type_c->block_count * count; i++) { @@ -697,14 +698,13 @@ int smpi_datatype_hvector(int count, int blocklen, MPI_Aint stride, MPI_Datatype * - block_indices - indices of each data, in element * - count - the number of rows of matrix */ -void serialize_indexed( const void *noncontiguous_indexed, void *contiguous_indexed, int count, void *type) +void serialize_indexed( void* noncontiguous_indexed, void *contiguous_indexed, int count, void *type) { s_smpi_mpi_indexed_t* type_c = reinterpret_cast(type); - int i,j; char* contiguous_indexed_char = static_cast(contiguous_indexed); - const char* noncontiguous_indexed_char = static_cast(noncontiguous_indexed)+type_c->block_indices[0] * type_c->size_oldtype; - for(j=0; jblock_count; i++) { + char* noncontiguous_indexed_char = static_cast(noncontiguous_indexed)+type_c->block_indices[0] * type_c->size_oldtype; + for (int j = 0; j < count; j++) { + for (int i = 0; i < type_c->block_count; i++) { if (type_c->old_type->sizeof_substruct == 0) memcpy(contiguous_indexed_char, noncontiguous_indexed_char, type_c->block_lengths[i] * type_c->size_oldtype); else @@ -716,11 +716,11 @@ void serialize_indexed( const void *noncontiguous_indexed, void *contiguous_inde contiguous_indexed_char += type_c->block_lengths[i]*type_c->size_oldtype; if (iblock_count-1) noncontiguous_indexed_char = - static_cast(noncontiguous_indexed) + type_c->block_indices[i+1]*smpi_datatype_get_extent(type_c->old_type); + static_cast(noncontiguous_indexed) + type_c->block_indices[i+1]*smpi_datatype_get_extent(type_c->old_type); else noncontiguous_indexed_char += type_c->block_lengths[i]*smpi_datatype_get_extent(type_c->old_type); } - noncontiguous_indexed=static_cast(noncontiguous_indexed_char); + noncontiguous_indexed=static_cast< void*>(noncontiguous_indexed_char); } } /* Copies contiguous data into noncontiguous memory. @@ -731,15 +731,14 @@ void serialize_indexed( const void *noncontiguous_indexed, void *contiguous_inde * - block_indices - indices of each data, in element * - count - the number of rows of matrix */ -void unserialize_indexed( const void *contiguous_indexed, void *noncontiguous_indexed, int count, void *type, MPI_Op op) +void unserialize_indexed( void* contiguous_indexed, void *noncontiguous_indexed, int count, void *type, MPI_Op op) { s_smpi_mpi_indexed_t* type_c = reinterpret_cast(type); - int i,j; - const char* contiguous_indexed_char = static_cast(contiguous_indexed); + char* contiguous_indexed_char = static_cast(contiguous_indexed); char* noncontiguous_indexed_char = static_cast(noncontiguous_indexed)+type_c->block_indices[0]*smpi_datatype_get_extent(type_c->old_type); - for(j=0; jblock_count; i++) { + for (int j = 0; j < count; j++) { + for (int i = 0; i < type_c->block_count; i++) { if (type_c->old_type->sizeof_substruct == 0) smpi_op_apply(op, contiguous_indexed_char, noncontiguous_indexed_char, &type_c->block_lengths[i], &type_c->old_type); @@ -784,8 +783,7 @@ s_smpi_mpi_indexed_t* smpi_datatype_indexed_create( int* block_lengths, int* blo new_t->base.subtype_use = &use_indexed; new_t->block_lengths= xbt_new(int, block_count); new_t->block_indices= xbt_new(int, block_count); - int i; - for(i=0;iblock_lengths[i]=block_lengths[i]; new_t->block_indices[i]=block_indices[i]; } @@ -798,8 +796,6 @@ s_smpi_mpi_indexed_t* smpi_datatype_indexed_create( int* block_lengths, int* blo int smpi_datatype_indexed(int count, int* blocklens, int* indices, MPI_Datatype old_type, MPI_Datatype* new_type) { - int i; - int retval; int size = 0; bool contiguous=true; MPI_Aint lb = 0; @@ -809,8 +805,8 @@ int smpi_datatype_indexed(int count, int* blocklens, int* indices, MPI_Datatype ub=indices[0]*smpi_datatype_get_extent(old_type) + blocklens[0]*smpi_datatype_ub(old_type); } - for(i=0; i< count; i++){ - if (blocklens[i]<0) + for (int i = 0; i < count; i++) { + if (blocklens[i] < 0) return MPI_ERR_ARG; size += blocklens[i]; @@ -835,8 +831,7 @@ int smpi_datatype_indexed(int count, int* blocklens, int* indices, MPI_Datatype smpi_datatype_create(new_type, size * smpi_datatype_size(old_type), lb, ub, sizeof(s_smpi_mpi_contiguous_t), subtype, DT_FLAG_DATA|DT_FLAG_CONTIGUOUS); } - retval=MPI_SUCCESS; - return retval; + return MPI_SUCCESS; } /* Hindexed Implementation - Indexed with indices in bytes */ @@ -848,14 +843,13 @@ int smpi_datatype_indexed(int count, int* blocklens, int* indices, MPI_Datatype * - block_indices - indices of each data, in bytes * - count - the number of rows of matrix */ -void serialize_hindexed( const void *noncontiguous_hindexed, void *contiguous_hindexed, int count, void *type) +void serialize_hindexed( void* noncontiguous_hindexed, void *contiguous_hindexed, int count, void *type) { s_smpi_mpi_hindexed_t* type_c = reinterpret_cast(type); - int i,j; char* contiguous_hindexed_char = static_cast(contiguous_hindexed); - const char* noncontiguous_hindexed_char = static_cast(noncontiguous_hindexed)+ type_c->block_indices[0]; - for(j=0; jblock_count; i++) { + char* noncontiguous_hindexed_char = static_cast(noncontiguous_hindexed)+ type_c->block_indices[0]; + for (int j = 0; j < count; j++) { + for (int i = 0; i < type_c->block_count; i++) { if (type_c->old_type->sizeof_substruct == 0) memcpy(contiguous_hindexed_char, noncontiguous_hindexed_char, type_c->block_lengths[i] * type_c->size_oldtype); else @@ -866,11 +860,11 @@ void serialize_hindexed( const void *noncontiguous_hindexed, void *contiguous_hi contiguous_hindexed_char += type_c->block_lengths[i]*type_c->size_oldtype; if (iblock_count-1) - noncontiguous_hindexed_char = static_cast(noncontiguous_hindexed) + type_c->block_indices[i+1]; + noncontiguous_hindexed_char = static_cast(noncontiguous_hindexed) + type_c->block_indices[i+1]; else noncontiguous_hindexed_char += type_c->block_lengths[i]*smpi_datatype_get_extent(type_c->old_type); } - noncontiguous_hindexed=reinterpret_cast(noncontiguous_hindexed_char); + noncontiguous_hindexed=static_cast(noncontiguous_hindexed_char); } } /* Copies contiguous data into noncontiguous memory. @@ -881,16 +875,15 @@ void serialize_hindexed( const void *noncontiguous_hindexed, void *contiguous_hi * - block_indices - indices of each data, in bytes * - count - the number of rows of matrix */ -void unserialize_hindexed( const void *contiguous_hindexed, void *noncontiguous_hindexed, int count, void *type, +void unserialize_hindexed( void* contiguous_hindexed, void *noncontiguous_hindexed, int count, void *type, MPI_Op op) { s_smpi_mpi_hindexed_t* type_c = reinterpret_cast(type); - int i,j; - const char* contiguous_hindexed_char = static_cast(contiguous_hindexed); + char* contiguous_hindexed_char = static_cast(contiguous_hindexed); char* noncontiguous_hindexed_char = static_cast(noncontiguous_hindexed)+ type_c->block_indices[0]; - for(j=0; jblock_count; i++) { + for (int j = 0; j < count; j++) { + for (int i = 0; i < type_c->block_count; i++) { if (type_c->old_type->sizeof_substruct == 0) smpi_op_apply(op, contiguous_hindexed_char, noncontiguous_hindexed_char, &type_c->block_lengths[i], &type_c->old_type); @@ -906,7 +899,7 @@ void unserialize_hindexed( const void *contiguous_hindexed, void *noncontiguous_ else noncontiguous_hindexed_char += type_c->block_lengths[i]*smpi_datatype_get_extent(type_c->old_type); } - noncontiguous_hindexed=reinterpret_cast(noncontiguous_hindexed_char); + noncontiguous_hindexed=static_cast(noncontiguous_hindexed_char); } } @@ -947,8 +940,6 @@ s_smpi_mpi_hindexed_t* smpi_datatype_hindexed_create( int* block_lengths, MPI_Ai int smpi_datatype_hindexed(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype old_type, MPI_Datatype* new_type) { - int i; - int retval; int size = 0; bool contiguous=true; MPI_Aint lb = 0; @@ -957,8 +948,8 @@ int smpi_datatype_hindexed(int count, int* blocklens, MPI_Aint* indices, MPI_Dat lb=indices[0] + smpi_datatype_lb(old_type); ub=indices[0] + blocklens[0]*smpi_datatype_ub(old_type); } - for(i=0; i< count; i++){ - if (blocklens[i]<0) + for (int i = 0; i < count; i++) { + if (blocklens[i] < 0) return MPI_ERR_ARG; size += blocklens[i]; @@ -982,8 +973,7 @@ int smpi_datatype_hindexed(int count, int* blocklens, MPI_Aint* indices, MPI_Dat smpi_datatype_create(new_type, size * smpi_datatype_size(old_type), 0,size * smpi_datatype_size(old_type), 1, subtype, DT_FLAG_DATA|DT_FLAG_CONTIGUOUS); } - retval=MPI_SUCCESS; - return retval; + return MPI_SUCCESS; } /* struct Implementation - Indexed with indices in bytes */ @@ -996,14 +986,13 @@ int smpi_datatype_hindexed(int count, int* blocklens, MPI_Aint* indices, MPI_Dat * - block_length - the width or height of blocked matrix * - count - the number of rows of matrix */ -void serialize_struct( const void *noncontiguous_struct, void *contiguous_struct, int count, void *type) +void serialize_struct( void* noncontiguous_struct, void *contiguous_struct, int count, void *type) { s_smpi_mpi_struct_t* type_c = reinterpret_cast(type); - int i,j; char* contiguous_struct_char = static_cast(contiguous_struct); - const char* noncontiguous_struct_char = static_cast(noncontiguous_struct)+ type_c->block_indices[0]; - for(j=0; jblock_count; i++) { + char* noncontiguous_struct_char = static_cast(noncontiguous_struct)+ type_c->block_indices[0]; + for (int j = 0; j < count; j++) { + for (int i = 0; i < type_c->block_count; i++) { if (type_c->old_types[i]->sizeof_substruct == 0) memcpy(contiguous_struct_char, noncontiguous_struct_char, type_c->block_lengths[i] * smpi_datatype_size(type_c->old_types[i])); @@ -1016,11 +1005,11 @@ void serialize_struct( const void *noncontiguous_struct, void *contiguous_struct contiguous_struct_char += type_c->block_lengths[i]*smpi_datatype_size(type_c->old_types[i]); if (iblock_count-1) - noncontiguous_struct_char = static_cast(noncontiguous_struct) + type_c->block_indices[i+1]; + noncontiguous_struct_char = static_cast(noncontiguous_struct) + type_c->block_indices[i+1]; else //let's hope this is MPI_UB ? noncontiguous_struct_char += type_c->block_lengths[i]*smpi_datatype_get_extent(type_c->old_types[i]); } - noncontiguous_struct=reinterpret_cast(noncontiguous_struct_char); + noncontiguous_struct=static_cast(noncontiguous_struct_char); } } @@ -1032,15 +1021,14 @@ void serialize_struct( const void *noncontiguous_struct, void *contiguous_struct * - block_length - the width or height of blocked matrix * - count - the number of rows of matrix */ -void unserialize_struct( const void *contiguous_struct, void *noncontiguous_struct, int count, void *type, MPI_Op op) +void unserialize_struct( void* contiguous_struct, void *noncontiguous_struct, int count, void *type, MPI_Op op) { s_smpi_mpi_struct_t* type_c = reinterpret_cast(type); - int i,j; - const char* contiguous_struct_char = static_cast(contiguous_struct); + char* contiguous_struct_char = static_cast(contiguous_struct); char* noncontiguous_struct_char = static_cast(noncontiguous_struct)+ type_c->block_indices[0]; - for(j=0; jblock_count; i++) { + for (int j = 0; j < count; j++) { + for (int i = 0; i < type_c->block_count; i++) { if (type_c->old_types[i]->sizeof_substruct == 0) smpi_op_apply(op, contiguous_struct_char, noncontiguous_struct_char, &type_c->block_lengths[i], & type_c->old_types[i]); @@ -1061,8 +1049,7 @@ void unserialize_struct( const void *contiguous_struct, void *noncontiguous_stru } void free_struct(MPI_Datatype* type){ - int i=0; - for (i = 0; i < reinterpret_cast((*type)->substruct)->block_count; i++) + for (int i = 0; i < reinterpret_cast((*type)->substruct)->block_count; i++) smpi_datatype_unuse(reinterpret_cast((*type)->substruct)->old_types[i]); if((*type)->in_use==0){ xbt_free(reinterpret_cast((*type)->substruct)->block_lengths); @@ -1072,8 +1059,7 @@ void free_struct(MPI_Datatype* type){ } void use_struct(MPI_Datatype* type){ - int i=0; - for (i = 0; i < reinterpret_cast((*type)->substruct)->block_count; i++) + for (int i = 0; i < reinterpret_cast((*type)->substruct)->block_count; i++) smpi_datatype_use(reinterpret_cast((*type)->substruct)->old_types[i]); } @@ -1090,8 +1076,7 @@ s_smpi_mpi_struct_t* smpi_datatype_struct_create( int* block_lengths, MPI_Aint* new_t->block_lengths= xbt_new(int, block_count); new_t->block_indices= xbt_new(MPI_Aint, block_count); new_t->old_types= xbt_new(MPI_Datatype, block_count); - int i; - for(i=0;iblock_lengths[i]=block_lengths[i]; new_t->block_indices[i]=block_indices[i]; new_t->old_types[i]=old_types[i]; @@ -1103,7 +1088,6 @@ s_smpi_mpi_struct_t* smpi_datatype_struct_create( int* block_lengths, MPI_Aint* int smpi_datatype_struct(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype* old_types, MPI_Datatype* new_type) { - int i; size_t size = 0; bool contiguous=true; size = 0; @@ -1115,7 +1099,7 @@ int smpi_datatype_struct(int count, int* blocklens, MPI_Aint* indices, MPI_Datat } bool forced_lb=false; bool forced_ub=false; - for(i=0; i< count; i++){ + for (int i = 0; i < count; i++) { if (blocklens[i]<0) return MPI_ERR_ARG; if (old_types[i]->sizeof_substruct != 0) @@ -1159,6 +1143,7 @@ void smpi_datatype_commit(MPI_Datatype *datatype) typedef struct s_smpi_mpi_op { MPI_User_function *func; bool is_commute; + bool is_fortran_op; } s_smpi_mpi_op_t; #define MAX_OP(a, b) (b) = (a) < (b) ? (b) : (a) @@ -1184,332 +1169,157 @@ typedef struct s_smpi_mpi_op { } \ } +#define APPLY_OP_LOOP(dtype, type, op) \ + if (*datatype == dtype) {\ + APPLY_FUNC(a, b, length, type, op)\ + } else \ + + +#define APPLY_BASIC_OP_LOOP(op)\ +APPLY_OP_LOOP(MPI_CHAR, char,op)\ +APPLY_OP_LOOP(MPI_SHORT, short,op)\ +APPLY_OP_LOOP(MPI_INT, int,op)\ +APPLY_OP_LOOP(MPI_LONG, long,op)\ +APPLY_OP_LOOP(MPI_LONG_LONG, long long,op)\ +APPLY_OP_LOOP(MPI_SIGNED_CHAR, signed char,op)\ +APPLY_OP_LOOP(MPI_UNSIGNED_CHAR, unsigned char,op)\ +APPLY_OP_LOOP(MPI_UNSIGNED_SHORT, unsigned short,op)\ +APPLY_OP_LOOP(MPI_UNSIGNED, unsigned int,op)\ +APPLY_OP_LOOP(MPI_UNSIGNED_LONG, unsigned long,op)\ +APPLY_OP_LOOP(MPI_UNSIGNED_LONG_LONG, unsigned long long,op)\ +APPLY_OP_LOOP(MPI_WCHAR, wchar_t,op)\ +APPLY_OP_LOOP(MPI_BYTE, int8_t,op)\ +APPLY_OP_LOOP(MPI_INT8_T, int8_t,op)\ +APPLY_OP_LOOP(MPI_INT16_T, int16_t,op)\ +APPLY_OP_LOOP(MPI_INT32_T, int32_t,op)\ +APPLY_OP_LOOP(MPI_INT64_T, int64_t,op)\ +APPLY_OP_LOOP(MPI_UINT8_T, uint8_t,op)\ +APPLY_OP_LOOP(MPI_UINT16_T, uint16_t,op)\ +APPLY_OP_LOOP(MPI_UINT32_T, uint32_t,op)\ +APPLY_OP_LOOP(MPI_UINT64_T, uint64_t,op)\ +APPLY_OP_LOOP(MPI_AINT, MPI_Aint,op)\ +APPLY_OP_LOOP(MPI_OFFSET, MPI_Offset,op)\ +APPLY_OP_LOOP(MPI_INTEGER1, int,op)\ +APPLY_OP_LOOP(MPI_INTEGER2, int16_t,op)\ +APPLY_OP_LOOP(MPI_INTEGER4, int32_t,op)\ +APPLY_OP_LOOP(MPI_INTEGER8, int64_t,op) + +#define APPLY_BOOL_OP_LOOP(op)\ +APPLY_OP_LOOP(MPI_C_BOOL, bool,op) + +#define APPLY_FLOAT_OP_LOOP(op)\ +APPLY_OP_LOOP(MPI_FLOAT, float,op)\ +APPLY_OP_LOOP(MPI_DOUBLE, double,op)\ +APPLY_OP_LOOP(MPI_LONG_DOUBLE, long double,op)\ +APPLY_OP_LOOP(MPI_REAL, float,op)\ +APPLY_OP_LOOP(MPI_REAL4, float,op)\ +APPLY_OP_LOOP(MPI_REAL8, float,op)\ +APPLY_OP_LOOP(MPI_REAL16, double,op) + +#define APPLY_COMPLEX_OP_LOOP(op)\ +APPLY_OP_LOOP(MPI_C_FLOAT_COMPLEX, float _Complex,op)\ +APPLY_OP_LOOP(MPI_C_DOUBLE_COMPLEX, double _Complex,op)\ +APPLY_OP_LOOP(MPI_C_LONG_DOUBLE_COMPLEX, long double _Complex,op) + +#define APPLY_PAIR_OP_LOOP(op)\ +APPLY_OP_LOOP(MPI_FLOAT_INT, float_int,op)\ +APPLY_OP_LOOP(MPI_LONG_INT, long_int,op)\ +APPLY_OP_LOOP(MPI_DOUBLE_INT, double_int,op)\ +APPLY_OP_LOOP(MPI_SHORT_INT, short_int,op)\ +APPLY_OP_LOOP(MPI_2INT, int_int,op)\ +APPLY_OP_LOOP(MPI_2FLOAT, float_float,op)\ +APPLY_OP_LOOP(MPI_2DOUBLE, double_double,op)\ +APPLY_OP_LOOP(MPI_LONG_DOUBLE_INT, long_double_int,op)\ +APPLY_OP_LOOP(MPI_2LONG, long_long,op) + +#define APPLY_END_OP_LOOP(op)\ + {\ + xbt_die("Failed to apply " #op " to type %s", (*datatype)->name);\ + } + + static void max_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, MAX_OP) - } else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, MAX_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, MAX_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, MAX_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, MAX_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, MAX_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, MAX_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, MAX_OP) - } else if (*datatype == MPI_FLOAT) { - APPLY_FUNC(a, b, length, float, MAX_OP) - } else if (*datatype == MPI_DOUBLE) { - APPLY_FUNC(a, b, length, double, MAX_OP) - } else if (*datatype == MPI_LONG_DOUBLE) { - APPLY_FUNC(a, b, length, long double, MAX_OP) - } else { - xbt_die("Failed to apply MAX_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(MAX_OP) + APPLY_FLOAT_OP_LOOP(MAX_OP) + APPLY_END_OP_LOOP(MAX_OP) } static void min_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, MIN_OP) - } else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, MIN_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, MIN_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, MIN_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, MIN_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, MIN_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, MIN_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, MIN_OP) - } else if (*datatype == MPI_FLOAT) { - APPLY_FUNC(a, b, length, float, MIN_OP) - } else if (*datatype == MPI_DOUBLE) { - APPLY_FUNC(a, b, length, double, MIN_OP) - } else if (*datatype == MPI_LONG_DOUBLE) { - APPLY_FUNC(a, b, length, long double, MIN_OP) - } else { - xbt_die("Failed to apply MIN_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(MIN_OP) + APPLY_FLOAT_OP_LOOP(MIN_OP) + APPLY_END_OP_LOOP(MIN_OP) } static void sum_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, SUM_OP) - } else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, SUM_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, SUM_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, SUM_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, SUM_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, SUM_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, SUM_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, SUM_OP) - } else if (*datatype == MPI_FLOAT) { - APPLY_FUNC(a, b, length, float, SUM_OP) - } else if (*datatype == MPI_DOUBLE) { - APPLY_FUNC(a, b, length, double, SUM_OP) - } else if (*datatype == MPI_LONG_DOUBLE) { - APPLY_FUNC(a, b, length, long double, SUM_OP) - } else if (*datatype == MPI_C_FLOAT_COMPLEX) { - APPLY_FUNC(a, b, length, float _Complex, SUM_OP) - } else if (*datatype == MPI_C_DOUBLE_COMPLEX) { - APPLY_FUNC(a, b, length, double _Complex, SUM_OP) - } else if (*datatype == MPI_C_LONG_DOUBLE_COMPLEX) { - APPLY_FUNC(a, b, length, long double _Complex, SUM_OP) - } else { - xbt_die("Failed to apply SUM_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(SUM_OP) + APPLY_FLOAT_OP_LOOP(SUM_OP) + APPLY_COMPLEX_OP_LOOP(SUM_OP) + APPLY_END_OP_LOOP(SUM_OP) } static void prod_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, PROD_OP) - } else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, PROD_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, PROD_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, PROD_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, PROD_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, PROD_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, PROD_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, PROD_OP) - } else if (*datatype == MPI_FLOAT) { - APPLY_FUNC(a, b, length, float, PROD_OP) - } else if (*datatype == MPI_DOUBLE) { - APPLY_FUNC(a, b, length, double, PROD_OP) - } else if (*datatype == MPI_LONG_DOUBLE) { - APPLY_FUNC(a, b, length, long double, PROD_OP) - } else if (*datatype == MPI_C_FLOAT_COMPLEX) { - APPLY_FUNC(a, b, length, float _Complex, PROD_OP) - } else if (*datatype == MPI_C_DOUBLE_COMPLEX) { - APPLY_FUNC(a, b, length, double _Complex, PROD_OP) - } else if (*datatype == MPI_C_LONG_DOUBLE_COMPLEX) { - APPLY_FUNC(a, b, length, long double _Complex, PROD_OP) - } else { - xbt_die("Failed to apply PROD_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(PROD_OP) + APPLY_FLOAT_OP_LOOP(PROD_OP) + APPLY_COMPLEX_OP_LOOP(PROD_OP) + APPLY_END_OP_LOOP(PROD_OP) } static void land_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, LAND_OP) - } else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, LAND_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, LAND_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, LAND_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, LAND_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, LAND_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, LAND_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, LAND_OP) - } else if (*datatype == MPI_C_BOOL) { - APPLY_FUNC(a, b, length, bool, LAND_OP) - } else { - xbt_die("Failed to apply LAND_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(LAND_OP) + APPLY_BOOL_OP_LOOP(LAND_OP) + APPLY_END_OP_LOOP(LAND_OP) } static void lor_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, LOR_OP) - } else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, LOR_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, LOR_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, LOR_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, LOR_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, LOR_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, LOR_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, LOR_OP) - } else if (*datatype == MPI_C_BOOL) { - APPLY_FUNC(a, b, length, bool, LOR_OP) - } else { - xbt_die("Failed to apply LOR_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(LOR_OP) + APPLY_BOOL_OP_LOOP(LOR_OP) + APPLY_END_OP_LOOP(LOR_OP) } static void lxor_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, LXOR_OP) - } else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, LXOR_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, LXOR_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, LXOR_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, LXOR_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, LXOR_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, LXOR_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, LXOR_OP) - } else if (*datatype == MPI_C_BOOL) { - APPLY_FUNC(a, b, length, bool, LXOR_OP) - } else { - xbt_die("Failed to apply LXOR_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(LXOR_OP) + APPLY_BOOL_OP_LOOP(LXOR_OP) + APPLY_END_OP_LOOP(LXOR_OP) } static void band_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, BAND_OP) - }else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, BAND_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, BAND_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, BAND_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, BAND_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, BAND_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, BAND_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, BAND_OP) - } else if (*datatype == MPI_BYTE) { - APPLY_FUNC(a, b, length, uint8_t, BAND_OP) - } else { - xbt_die("Failed to apply BAND_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(BAND_OP) + APPLY_BOOL_OP_LOOP(BAND_OP) + APPLY_END_OP_LOOP(BAND_OP) } static void bor_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, BOR_OP) - } else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, BOR_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, BOR_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, BOR_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, BOR_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, BOR_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, BOR_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, BOR_OP) - } else if (*datatype == MPI_BYTE) { - APPLY_FUNC(a, b, length, uint8_t, BOR_OP) - } else { - xbt_die("Failed to apply BOR_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(BOR_OP) + APPLY_BOOL_OP_LOOP(BOR_OP) + APPLY_END_OP_LOOP(BOR_OP) } static void bxor_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_CHAR) { - APPLY_FUNC(a, b, length, char, BXOR_OP) - } else if (*datatype == MPI_SHORT) { - APPLY_FUNC(a, b, length, short, BXOR_OP) - } else if (*datatype == MPI_INT) { - APPLY_FUNC(a, b, length, int, BXOR_OP) - } else if (*datatype == MPI_LONG) { - APPLY_FUNC(a, b, length, long, BXOR_OP) - } else if (*datatype == MPI_UNSIGNED_SHORT) { - APPLY_FUNC(a, b, length, unsigned short, BXOR_OP) - } else if (*datatype == MPI_UNSIGNED) { - APPLY_FUNC(a, b, length, unsigned int, BXOR_OP) - } else if (*datatype == MPI_UNSIGNED_LONG) { - APPLY_FUNC(a, b, length, unsigned long, BXOR_OP) - } else if (*datatype == MPI_UNSIGNED_CHAR) { - APPLY_FUNC(a, b, length, unsigned char, BXOR_OP) - } else if (*datatype == MPI_BYTE) { - APPLY_FUNC(a, b, length, uint8_t, BXOR_OP) - } else { - xbt_die("Failed to apply BXOR_OP to type %s", (*datatype)->name); - } + APPLY_BASIC_OP_LOOP(BXOR_OP) + APPLY_BOOL_OP_LOOP(BXOR_OP) + APPLY_END_OP_LOOP(BXOR_OP) } static void minloc_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_FLOAT_INT) { - APPLY_FUNC(a, b, length, float_int, MINLOC_OP) - } else if (*datatype == MPI_LONG_INT) { - APPLY_FUNC(a, b, length, long_int, MINLOC_OP) - } else if (*datatype == MPI_DOUBLE_INT) { - APPLY_FUNC(a, b, length, double_int, MINLOC_OP) - } else if (*datatype == MPI_SHORT_INT) { - APPLY_FUNC(a, b, length, short_int, MINLOC_OP) - } else if (*datatype == MPI_2LONG) { - APPLY_FUNC(a, b, length, long_long, MINLOC_OP) - } else if (*datatype == MPI_2INT) { - APPLY_FUNC(a, b, length, int_int, MINLOC_OP) - } else if (*datatype == MPI_LONG_DOUBLE_INT) { - APPLY_FUNC(a, b, length, long_double_int, MINLOC_OP) - } else if (*datatype == MPI_2FLOAT) { - APPLY_FUNC(a, b, length, float_float, MINLOC_OP) - } else if (*datatype == MPI_2DOUBLE) { - APPLY_FUNC(a, b, length, double_double, MINLOC_OP) - } else { - xbt_die("Failed to apply MINLOC_OP to type %s", (*datatype)->name); - } + APPLY_PAIR_OP_LOOP(MINLOC_OP) + APPLY_END_OP_LOOP(MINLOC_OP) } static void maxloc_func(void *a, void *b, int *length, MPI_Datatype * datatype) { - if (*datatype == MPI_FLOAT_INT) { - APPLY_FUNC(a, b, length, float_int, MAXLOC_OP) - } else if (*datatype == MPI_LONG_INT) { - APPLY_FUNC(a, b, length, long_int, MAXLOC_OP) - } else if (*datatype == MPI_DOUBLE_INT) { - APPLY_FUNC(a, b, length, double_int, MAXLOC_OP) - } else if (*datatype == MPI_SHORT_INT) { - APPLY_FUNC(a, b, length, short_int, MAXLOC_OP) - } else if (*datatype == MPI_2LONG) { - APPLY_FUNC(a, b, length, long_long, MAXLOC_OP) - } else if (*datatype == MPI_2INT) { - APPLY_FUNC(a, b, length, int_int, MAXLOC_OP) - } else if (*datatype == MPI_LONG_DOUBLE_INT) { - APPLY_FUNC(a, b, length, long_double_int, MAXLOC_OP) - } else if (*datatype == MPI_2FLOAT) { - APPLY_FUNC(a, b, length, float_float, MAXLOC_OP) - } else if (*datatype == MPI_2DOUBLE) { - APPLY_FUNC(a, b, length, double_double, MAXLOC_OP) - } else { - xbt_die("Failed to apply MAXLOC_OP to type %s", (*datatype)->name); - } + APPLY_PAIR_OP_LOOP(MAXLOC_OP) + APPLY_END_OP_LOOP(MAXLOC_OP) } static void replace_func(void *a, void *b, int *length, MPI_Datatype * datatype) @@ -1518,7 +1328,7 @@ static void replace_func(void *a, void *b, int *length, MPI_Datatype * datatype) } #define CREATE_MPI_OP(name, func) \ - static s_smpi_mpi_op_t mpi_##name = { &(func) /* func */, true }; \ + static s_smpi_mpi_op_t mpi_##name = { &(func) /* func */, true, false }; \ MPI_Op name = &mpi_##name; CREATE_MPI_OP(MPI_MAX, max_func); @@ -1537,10 +1347,10 @@ CREATE_MPI_OP(MPI_REPLACE, replace_func); MPI_Op smpi_op_new(MPI_User_function * function, bool commute) { - MPI_Op op; - op = xbt_new(s_smpi_mpi_op_t, 1); + MPI_Op op = xbt_new(s_smpi_mpi_op_t, 1); op->func = function; op-> is_commute = commute; + op-> is_fortran_op = false; return op; } @@ -1554,7 +1364,13 @@ void smpi_op_destroy(MPI_Op op) xbt_free(op); } -void smpi_op_apply(MPI_Op op, const void *invec, void *inoutvec, int *len, MPI_Datatype * datatype) +void smpi_op_set_fortran(MPI_Op op) +{ + //tell that we were created from fortran, so we need to translate the type to fortran when called + op->is_fortran_op = true; +} + +void smpi_op_apply(MPI_Op op, void *invec, void *inoutvec, int *len, MPI_Datatype * datatype) { if(op==MPI_OP_NULL) return; @@ -1564,8 +1380,16 @@ void smpi_op_apply(MPI_Op op, const void *invec, void *inoutvec, int *len, MPI_D smpi_switch_data_segment(smpi_process_index()); } - if(!smpi_process_get_replaying()) - op->func(const_cast(invec), inoutvec, len, datatype); + if(!smpi_process_get_replaying()){ + if(! op->is_fortran_op) + op->func(invec, inoutvec, len, datatype); + else{ + int tmp = smpi_type_c2f(*datatype); + /* Unfortunately, the C and Fortran version of the MPI standard do not agree on the type here, + thus the reinterpret_cast. */ + op->func(invec, inoutvec, len, reinterpret_cast(&tmp) ); + } + } } int smpi_type_attr_delete(MPI_Datatype type, int keyval){