1 /* Copyright (c) 2007-2017. The SimGrid Team. All rights reserved. */
3 /* This program is free software; you can redistribute it and/or modify it
4 * under the terms of the license (GNU LGPL) which comes with this package. */
6 #include <simgrid/s4u/host.hpp>
10 XBT_LOG_NEW_DEFAULT_SUBCATEGORY(smpi_pmpi, smpi, "Logging specific to SMPI (pmpi)");
12 //this function need to be here because of the calls to smpi_bench
13 void TRACE_smpi_set_category(const char *category)
15 //need to end bench otherwise categories for execution tasks are wrong
17 TRACE_internal_smpi_set_category (category);
18 //begin bench after changing process's category
22 /* PMPI User level calls */
23 extern "C" { // Obviously, the C MPI interface should use the C linkage
25 int PMPI_Init(int *argc, char ***argv)
27 // PMPI_Init is call only one time by only by SMPI process
29 MPI_Initialized(&already_init);
30 if(already_init == 0){
31 smpi_process_init(argc, argv);
32 smpi_process_mark_as_initialized();
33 int rank = smpi_process_index();
34 TRACE_smpi_init(rank);
35 TRACE_smpi_computing_init(rank);
36 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
37 extra->type = TRACING_INIT;
38 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
39 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
51 int rank = smpi_process_index();
52 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
53 extra->type = TRACING_FINALIZE;
54 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
56 smpi_process_finalize();
58 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
59 TRACE_smpi_finalize(smpi_process_index());
60 smpi_process_destroy();
64 int PMPI_Finalized(int* flag)
66 *flag=smpi_process_finalized();
70 int PMPI_Get_version (int *version,int *subversion){
71 *version = MPI_VERSION;
72 *subversion= MPI_SUBVERSION;
76 int PMPI_Get_library_version (char *version,int *len){
78 snprintf(version,MPI_MAX_LIBRARY_VERSION_STRING,"SMPI Version %d.%d. Copyright The Simgrid Team 2007-2015",
79 SIMGRID_VERSION_MAJOR, SIMGRID_VERSION_MINOR);
80 *len = strlen(version) > MPI_MAX_LIBRARY_VERSION_STRING ? MPI_MAX_LIBRARY_VERSION_STRING : strlen(version);
85 int PMPI_Init_thread(int *argc, char ***argv, int required, int *provided)
87 if (provided != nullptr) {
88 *provided = MPI_THREAD_SINGLE;
90 return MPI_Init(argc, argv);
93 int PMPI_Query_thread(int *provided)
95 if (provided == nullptr) {
98 *provided = MPI_THREAD_SINGLE;
103 int PMPI_Is_thread_main(int *flag)
105 if (flag == nullptr) {
108 *flag = smpi_process_index() == 0;
113 int PMPI_Abort(MPI_Comm comm, int errorcode)
116 smpi_process_destroy();
117 // FIXME: should kill all processes in comm instead
118 simcall_process_kill(SIMIX_process_self());
124 return smpi_mpi_wtime();
127 extern double sg_maxmin_precision;
130 return sg_maxmin_precision;
133 int PMPI_Address(void *location, MPI_Aint * address)
135 if (address==nullptr) {
138 *address = reinterpret_cast<MPI_Aint>(location);
143 int PMPI_Get_address(void *location, MPI_Aint * address)
145 return PMPI_Address(location, address);
148 int PMPI_Type_free(MPI_Datatype * datatype)
150 /* Free a predefined datatype is an error according to the standard, and should be checked for */
151 if (*datatype == MPI_DATATYPE_NULL) {
154 Datatype::unref(*datatype);
159 int PMPI_Type_size(MPI_Datatype datatype, int *size)
161 if (datatype == MPI_DATATYPE_NULL) {
163 } else if (size == nullptr) {
166 *size = static_cast<int>(datatype->size());
171 int PMPI_Type_size_x(MPI_Datatype datatype, MPI_Count *size)
173 if (datatype == MPI_DATATYPE_NULL) {
175 } else if (size == nullptr) {
178 *size = static_cast<MPI_Count>(datatype->size());
183 int PMPI_Type_get_extent(MPI_Datatype datatype, MPI_Aint * lb, MPI_Aint * extent)
185 if (datatype == MPI_DATATYPE_NULL) {
187 } else if (lb == nullptr || extent == nullptr) {
190 return datatype->extent(lb, extent);
194 int PMPI_Type_get_true_extent(MPI_Datatype datatype, MPI_Aint * lb, MPI_Aint * extent)
196 return PMPI_Type_get_extent(datatype, lb, extent);
199 int PMPI_Type_extent(MPI_Datatype datatype, MPI_Aint * extent)
201 if (datatype == MPI_DATATYPE_NULL) {
203 } else if (extent == nullptr) {
206 *extent = datatype->get_extent();
211 int PMPI_Type_lb(MPI_Datatype datatype, MPI_Aint * disp)
213 if (datatype == MPI_DATATYPE_NULL) {
215 } else if (disp == nullptr) {
218 *disp = datatype->lb();
223 int PMPI_Type_ub(MPI_Datatype datatype, MPI_Aint * disp)
225 if (datatype == MPI_DATATYPE_NULL) {
227 } else if (disp == nullptr) {
230 *disp = datatype->ub();
235 int PMPI_Type_dup(MPI_Datatype datatype, MPI_Datatype *newtype){
236 int retval = MPI_SUCCESS;
237 if (datatype == MPI_DATATYPE_NULL) {
240 *newtype = new Datatype(datatype, &retval);
241 //error when duplicating, free the new datatype
242 if(retval!=MPI_SUCCESS){
243 Datatype::unref(*newtype);
244 *newtype = MPI_DATATYPE_NULL;
250 int PMPI_Op_create(MPI_User_function * function, int commute, MPI_Op * op)
252 if (function == nullptr || op == nullptr) {
255 *op = new Op(function, (commute!=0));
260 int PMPI_Op_free(MPI_Op * op)
264 } else if (*op == MPI_OP_NULL) {
273 int PMPI_Group_free(MPI_Group * group)
275 if (group == nullptr) {
278 if(*group != MPI_COMM_WORLD->group() && *group != MPI_GROUP_EMPTY)
279 Group::unref(*group);
280 *group = MPI_GROUP_NULL;
285 int PMPI_Group_size(MPI_Group group, int *size)
287 if (group == MPI_GROUP_NULL) {
288 return MPI_ERR_GROUP;
289 } else if (size == nullptr) {
292 *size = group->size();
297 int PMPI_Group_rank(MPI_Group group, int *rank)
299 if (group == MPI_GROUP_NULL) {
300 return MPI_ERR_GROUP;
301 } else if (rank == nullptr) {
304 *rank = group->rank(smpi_process_index());
309 int PMPI_Group_translate_ranks(MPI_Group group1, int n, int *ranks1, MPI_Group group2, int *ranks2)
311 if (group1 == MPI_GROUP_NULL || group2 == MPI_GROUP_NULL) {
312 return MPI_ERR_GROUP;
314 for (int i = 0; i < n; i++) {
315 if(ranks1[i]==MPI_PROC_NULL){
316 ranks2[i]=MPI_PROC_NULL;
318 int index = group1->index(ranks1[i]);
319 ranks2[i] = group2->rank(index);
326 int PMPI_Group_compare(MPI_Group group1, MPI_Group group2, int *result)
328 if (group1 == MPI_GROUP_NULL || group2 == MPI_GROUP_NULL) {
329 return MPI_ERR_GROUP;
330 } else if (result == nullptr) {
333 *result = group1->compare(group2);
338 int PMPI_Group_union(MPI_Group group1, MPI_Group group2, MPI_Group * newgroup)
341 if (group1 == MPI_GROUP_NULL || group2 == MPI_GROUP_NULL) {
342 return MPI_ERR_GROUP;
343 } else if (newgroup == nullptr) {
346 return group1->group_union(group2, newgroup);
350 int PMPI_Group_intersection(MPI_Group group1, MPI_Group group2, MPI_Group * newgroup)
353 if (group1 == MPI_GROUP_NULL || group2 == MPI_GROUP_NULL) {
354 return MPI_ERR_GROUP;
355 } else if (newgroup == nullptr) {
358 return group1->intersection(group2,newgroup);
362 int PMPI_Group_difference(MPI_Group group1, MPI_Group group2, MPI_Group * newgroup)
364 if (group1 == MPI_GROUP_NULL || group2 == MPI_GROUP_NULL) {
365 return MPI_ERR_GROUP;
366 } else if (newgroup == nullptr) {
369 return group1->difference(group2,newgroup);
373 int PMPI_Group_incl(MPI_Group group, int n, int *ranks, MPI_Group * newgroup)
375 if (group == MPI_GROUP_NULL) {
376 return MPI_ERR_GROUP;
377 } else if (newgroup == nullptr) {
380 return group->incl(n, ranks, newgroup);
384 int PMPI_Group_excl(MPI_Group group, int n, int *ranks, MPI_Group * newgroup)
386 if (group == MPI_GROUP_NULL) {
387 return MPI_ERR_GROUP;
388 } else if (newgroup == nullptr) {
393 if (group != MPI_COMM_WORLD->group()
394 && group != MPI_COMM_SELF->group() && group != MPI_GROUP_EMPTY)
397 } else if (n == group->size()) {
398 *newgroup = MPI_GROUP_EMPTY;
401 return group->excl(n,ranks,newgroup);
406 int PMPI_Group_range_incl(MPI_Group group, int n, int ranges[][3], MPI_Group * newgroup)
408 if (group == MPI_GROUP_NULL) {
409 return MPI_ERR_GROUP;
410 } else if (newgroup == nullptr) {
414 *newgroup = MPI_GROUP_EMPTY;
417 return group->range_incl(n,ranges,newgroup);
422 int PMPI_Group_range_excl(MPI_Group group, int n, int ranges[][3], MPI_Group * newgroup)
424 if (group == MPI_GROUP_NULL) {
425 return MPI_ERR_GROUP;
426 } else if (newgroup == nullptr) {
431 if (group != MPI_COMM_WORLD->group() && group != MPI_COMM_SELF->group() &&
432 group != MPI_GROUP_EMPTY)
436 return group->range_excl(n,ranges,newgroup);
441 int PMPI_Comm_rank(MPI_Comm comm, int *rank)
443 if (comm == MPI_COMM_NULL) {
445 } else if (rank == nullptr) {
448 *rank = comm->rank();
453 int PMPI_Comm_size(MPI_Comm comm, int *size)
455 if (comm == MPI_COMM_NULL) {
457 } else if (size == nullptr) {
460 *size = comm->size();
465 int PMPI_Comm_get_name (MPI_Comm comm, char* name, int* len)
467 if (comm == MPI_COMM_NULL) {
469 } else if (name == nullptr || len == nullptr) {
472 comm->get_name(name, len);
477 int PMPI_Comm_group(MPI_Comm comm, MPI_Group * group)
479 if (comm == MPI_COMM_NULL) {
481 } else if (group == nullptr) {
484 *group = comm->group();
485 if (*group != MPI_COMM_WORLD->group() && *group != MPI_GROUP_NULL && *group != MPI_GROUP_EMPTY)
491 int PMPI_Comm_compare(MPI_Comm comm1, MPI_Comm comm2, int *result)
493 if (comm1 == MPI_COMM_NULL || comm2 == MPI_COMM_NULL) {
495 } else if (result == nullptr) {
498 if (comm1 == comm2) { /* Same communicators means same groups */
501 *result = comm1->group()->compare(comm2->group());
502 if (*result == MPI_IDENT) {
503 *result = MPI_CONGRUENT;
510 int PMPI_Comm_dup(MPI_Comm comm, MPI_Comm * newcomm)
512 if (comm == MPI_COMM_NULL) {
514 } else if (newcomm == nullptr) {
517 return comm->dup(newcomm);
521 int PMPI_Comm_create(MPI_Comm comm, MPI_Group group, MPI_Comm * newcomm)
523 if (comm == MPI_COMM_NULL) {
525 } else if (group == MPI_GROUP_NULL) {
526 return MPI_ERR_GROUP;
527 } else if (newcomm == nullptr) {
529 } else if(group->rank(smpi_process_index())==MPI_UNDEFINED){
530 *newcomm= MPI_COMM_NULL;
534 *newcomm = new Comm(group, nullptr);
539 int PMPI_Comm_free(MPI_Comm * comm)
541 if (comm == nullptr) {
543 } else if (*comm == MPI_COMM_NULL) {
546 Comm::destroy(*comm);
547 *comm = MPI_COMM_NULL;
552 int PMPI_Comm_disconnect(MPI_Comm * comm)
554 /* TODO: wait until all communication in comm are done */
555 if (comm == nullptr) {
557 } else if (*comm == MPI_COMM_NULL) {
560 Comm::destroy(*comm);
561 *comm = MPI_COMM_NULL;
566 int PMPI_Comm_split(MPI_Comm comm, int color, int key, MPI_Comm* comm_out)
571 if (comm_out == nullptr) {
572 retval = MPI_ERR_ARG;
573 } else if (comm == MPI_COMM_NULL) {
574 retval = MPI_ERR_COMM;
576 *comm_out = comm->split(color, key);
577 retval = MPI_SUCCESS;
584 int PMPI_Comm_create_group(MPI_Comm comm, MPI_Group group, int, MPI_Comm* comm_out)
589 if (comm_out == nullptr) {
590 retval = MPI_ERR_ARG;
591 } else if (comm == MPI_COMM_NULL) {
592 retval = MPI_ERR_COMM;
594 retval = MPI_Comm_create(comm, group, comm_out);
601 int PMPI_Send_init(void *buf, int count, MPI_Datatype datatype, int dst, int tag, MPI_Comm comm, MPI_Request * request)
606 if (request == nullptr) {
607 retval = MPI_ERR_ARG;
608 } else if (comm == MPI_COMM_NULL) {
609 retval = MPI_ERR_COMM;
610 } else if (!datatype->is_valid()) {
611 retval = MPI_ERR_TYPE;
612 } else if (dst == MPI_PROC_NULL) {
613 retval = MPI_SUCCESS;
615 *request = Request::send_init(buf, count, datatype, dst, tag, comm);
616 retval = MPI_SUCCESS;
619 if (retval != MPI_SUCCESS && request != nullptr)
620 *request = MPI_REQUEST_NULL;
624 int PMPI_Recv_init(void *buf, int count, MPI_Datatype datatype, int src, int tag, MPI_Comm comm, MPI_Request * request)
629 if (request == nullptr) {
630 retval = MPI_ERR_ARG;
631 } else if (comm == MPI_COMM_NULL) {
632 retval = MPI_ERR_COMM;
633 } else if (!datatype->is_valid()) {
634 retval = MPI_ERR_TYPE;
635 } else if (src == MPI_PROC_NULL) {
636 retval = MPI_SUCCESS;
638 *request = Request::recv_init(buf, count, datatype, src, tag, comm);
639 retval = MPI_SUCCESS;
642 if (retval != MPI_SUCCESS && request != nullptr)
643 *request = MPI_REQUEST_NULL;
647 int PMPI_Ssend_init(void* buf, int count, MPI_Datatype datatype, int dst, int tag, MPI_Comm comm, MPI_Request* request)
652 if (request == nullptr) {
653 retval = MPI_ERR_ARG;
654 } else if (comm == MPI_COMM_NULL) {
655 retval = MPI_ERR_COMM;
656 } else if (!datatype->is_valid()) {
657 retval = MPI_ERR_TYPE;
658 } else if (dst == MPI_PROC_NULL) {
659 retval = MPI_SUCCESS;
661 *request = Request::ssend_init(buf, count, datatype, dst, tag, comm);
662 retval = MPI_SUCCESS;
665 if (retval != MPI_SUCCESS && request != nullptr)
666 *request = MPI_REQUEST_NULL;
670 int PMPI_Start(MPI_Request * request)
675 if (request == nullptr || *request == MPI_REQUEST_NULL) {
676 retval = MPI_ERR_REQUEST;
679 retval = MPI_SUCCESS;
685 int PMPI_Startall(int count, MPI_Request * requests)
689 if (requests == nullptr) {
690 retval = MPI_ERR_ARG;
692 retval = MPI_SUCCESS;
693 for (int i = 0; i < count; i++) {
694 if(requests[i] == MPI_REQUEST_NULL) {
695 retval = MPI_ERR_REQUEST;
698 if(retval != MPI_ERR_REQUEST) {
699 Request::startall(count, requests);
706 int PMPI_Request_free(MPI_Request * request)
711 if (*request == MPI_REQUEST_NULL) {
712 retval = MPI_ERR_ARG;
714 Request::unref(request);
715 retval = MPI_SUCCESS;
721 int PMPI_Irecv(void *buf, int count, MPI_Datatype datatype, int src, int tag, MPI_Comm comm, MPI_Request * request)
727 if (request == nullptr) {
728 retval = MPI_ERR_ARG;
729 } else if (comm == MPI_COMM_NULL) {
730 retval = MPI_ERR_COMM;
731 } else if (src == MPI_PROC_NULL) {
732 *request = MPI_REQUEST_NULL;
733 retval = MPI_SUCCESS;
734 } else if (src!=MPI_ANY_SOURCE && (src >= comm->group()->size() || src <0)){
735 retval = MPI_ERR_RANK;
736 } else if ((count < 0) || (buf==nullptr && count > 0)) {
737 retval = MPI_ERR_COUNT;
738 } else if (!datatype->is_valid()) {
739 retval = MPI_ERR_TYPE;
740 } else if(tag<0 && tag != MPI_ANY_TAG){
741 retval = MPI_ERR_TAG;
744 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
745 int src_traced = comm->group()->index(src);
747 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
748 extra->type = TRACING_IRECV;
749 extra->src = src_traced;
752 extra->datatype1 = encode_datatype(datatype, &known);
753 int dt_size_send = 1;
755 dt_size_send = datatype->size();
756 extra->send_size = count*dt_size_send;
757 TRACE_smpi_ptp_in(rank, src_traced, rank, __FUNCTION__, extra);
759 *request = Request::irecv(buf, count, datatype, src, tag, comm);
760 retval = MPI_SUCCESS;
762 TRACE_smpi_ptp_out(rank, src_traced, rank, __FUNCTION__);
766 if (retval != MPI_SUCCESS && request != nullptr)
767 *request = MPI_REQUEST_NULL;
772 int PMPI_Isend(void *buf, int count, MPI_Datatype datatype, int dst, int tag, MPI_Comm comm, MPI_Request * request)
777 if (request == nullptr) {
778 retval = MPI_ERR_ARG;
779 } else if (comm == MPI_COMM_NULL) {
780 retval = MPI_ERR_COMM;
781 } else if (dst == MPI_PROC_NULL) {
782 *request = MPI_REQUEST_NULL;
783 retval = MPI_SUCCESS;
784 } else if (dst >= comm->group()->size() || dst <0){
785 retval = MPI_ERR_RANK;
786 } else if ((count < 0) || (buf==nullptr && count > 0)) {
787 retval = MPI_ERR_COUNT;
788 } else if (!datatype->is_valid()) {
789 retval = MPI_ERR_TYPE;
790 } else if(tag<0 && tag != MPI_ANY_TAG){
791 retval = MPI_ERR_TAG;
793 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
794 int dst_traced = comm->group()->index(dst);
795 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
796 extra->type = TRACING_ISEND;
798 extra->dst = dst_traced;
800 extra->datatype1 = encode_datatype(datatype, &known);
801 int dt_size_send = 1;
803 dt_size_send = datatype->size();
804 extra->send_size = count*dt_size_send;
805 TRACE_smpi_ptp_in(rank, rank, dst_traced, __FUNCTION__, extra);
806 TRACE_smpi_send(rank, rank, dst_traced, tag, count*datatype->size());
808 *request = Request::isend(buf, count, datatype, dst, tag, comm);
809 retval = MPI_SUCCESS;
811 TRACE_smpi_ptp_out(rank, rank, dst_traced, __FUNCTION__);
815 if (retval != MPI_SUCCESS && request!=nullptr)
816 *request = MPI_REQUEST_NULL;
820 int PMPI_Issend(void* buf, int count, MPI_Datatype datatype, int dst, int tag, MPI_Comm comm, MPI_Request* request)
825 if (request == nullptr) {
826 retval = MPI_ERR_ARG;
827 } else if (comm == MPI_COMM_NULL) {
828 retval = MPI_ERR_COMM;
829 } else if (dst == MPI_PROC_NULL) {
830 *request = MPI_REQUEST_NULL;
831 retval = MPI_SUCCESS;
832 } else if (dst >= comm->group()->size() || dst <0){
833 retval = MPI_ERR_RANK;
834 } else if ((count < 0)|| (buf==nullptr && count > 0)) {
835 retval = MPI_ERR_COUNT;
836 } else if (!datatype->is_valid()) {
837 retval = MPI_ERR_TYPE;
838 } else if(tag<0 && tag != MPI_ANY_TAG){
839 retval = MPI_ERR_TAG;
841 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
842 int dst_traced = comm->group()->index(dst);
843 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
844 extra->type = TRACING_ISSEND;
846 extra->dst = dst_traced;
848 extra->datatype1 = encode_datatype(datatype, &known);
849 int dt_size_send = 1;
851 dt_size_send = datatype->size();
852 extra->send_size = count*dt_size_send;
853 TRACE_smpi_ptp_in(rank, rank, dst_traced, __FUNCTION__, extra);
854 TRACE_smpi_send(rank, rank, dst_traced, tag, count*datatype->size());
856 *request = Request::issend(buf, count, datatype, dst, tag, comm);
857 retval = MPI_SUCCESS;
859 TRACE_smpi_ptp_out(rank, rank, dst_traced, __FUNCTION__);
863 if (retval != MPI_SUCCESS && request!=nullptr)
864 *request = MPI_REQUEST_NULL;
868 int PMPI_Recv(void *buf, int count, MPI_Datatype datatype, int src, int tag, MPI_Comm comm, MPI_Status * status)
873 if (comm == MPI_COMM_NULL) {
874 retval = MPI_ERR_COMM;
875 } else if (src == MPI_PROC_NULL) {
876 smpi_empty_status(status);
877 status->MPI_SOURCE = MPI_PROC_NULL;
878 retval = MPI_SUCCESS;
879 } else if (src!=MPI_ANY_SOURCE && (src >= comm->group()->size() || src <0)){
880 retval = MPI_ERR_RANK;
881 } else if ((count < 0) || (buf==nullptr && count > 0)) {
882 retval = MPI_ERR_COUNT;
883 } else if (!datatype->is_valid()) {
884 retval = MPI_ERR_TYPE;
885 } else if(tag<0 && tag != MPI_ANY_TAG){
886 retval = MPI_ERR_TAG;
888 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
889 int src_traced = comm->group()->index(src);
890 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
891 extra->type = TRACING_RECV;
892 extra->src = src_traced;
895 extra->datatype1 = encode_datatype(datatype, &known);
896 int dt_size_send = 1;
898 dt_size_send = datatype->size();
899 extra->send_size = count * dt_size_send;
900 TRACE_smpi_ptp_in(rank, src_traced, rank, __FUNCTION__, extra);
902 Request::recv(buf, count, datatype, src, tag, comm, status);
903 retval = MPI_SUCCESS;
905 // the src may not have been known at the beginning of the recv (MPI_ANY_SOURCE)
906 if (status != MPI_STATUS_IGNORE) {
907 src_traced = comm->group()->index(status->MPI_SOURCE);
908 if (!TRACE_smpi_view_internals()) {
909 TRACE_smpi_recv(rank, src_traced, rank, tag);
912 TRACE_smpi_ptp_out(rank, src_traced, rank, __FUNCTION__);
919 int PMPI_Send(void *buf, int count, MPI_Datatype datatype, int dst, int tag, MPI_Comm comm)
925 if (comm == MPI_COMM_NULL) {
926 retval = MPI_ERR_COMM;
927 } else if (dst == MPI_PROC_NULL) {
928 retval = MPI_SUCCESS;
929 } else if (dst >= comm->group()->size() || dst <0){
930 retval = MPI_ERR_RANK;
931 } else if ((count < 0) || (buf == nullptr && count > 0)) {
932 retval = MPI_ERR_COUNT;
933 } else if (!datatype->is_valid()) {
934 retval = MPI_ERR_TYPE;
935 } else if(tag < 0 && tag != MPI_ANY_TAG){
936 retval = MPI_ERR_TAG;
938 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
939 int dst_traced = comm->group()->index(dst);
940 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
941 extra->type = TRACING_SEND;
943 extra->dst = dst_traced;
945 extra->datatype1 = encode_datatype(datatype, &known);
946 int dt_size_send = 1;
948 dt_size_send = datatype->size();
950 extra->send_size = count*dt_size_send;
951 TRACE_smpi_ptp_in(rank, rank, dst_traced, __FUNCTION__, extra);
952 if (!TRACE_smpi_view_internals()) {
953 TRACE_smpi_send(rank, rank, dst_traced, tag,count*datatype->size());
956 Request::send(buf, count, datatype, dst, tag, comm);
957 retval = MPI_SUCCESS;
959 TRACE_smpi_ptp_out(rank, rank, dst_traced, __FUNCTION__);
966 int PMPI_Ssend(void* buf, int count, MPI_Datatype datatype, int dst, int tag, MPI_Comm comm) {
971 if (comm == MPI_COMM_NULL) {
972 retval = MPI_ERR_COMM;
973 } else if (dst == MPI_PROC_NULL) {
974 retval = MPI_SUCCESS;
975 } else if (dst >= comm->group()->size() || dst <0){
976 retval = MPI_ERR_RANK;
977 } else if ((count < 0) || (buf==nullptr && count > 0)) {
978 retval = MPI_ERR_COUNT;
979 } else if (!datatype->is_valid()){
980 retval = MPI_ERR_TYPE;
981 } else if(tag<0 && tag != MPI_ANY_TAG){
982 retval = MPI_ERR_TAG;
984 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
985 int dst_traced = comm->group()->index(dst);
986 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
987 extra->type = TRACING_SSEND;
989 extra->dst = dst_traced;
991 extra->datatype1 = encode_datatype(datatype, &known);
992 int dt_size_send = 1;
994 dt_size_send = datatype->size();
996 extra->send_size = count*dt_size_send;
997 TRACE_smpi_ptp_in(rank, rank, dst_traced, __FUNCTION__, extra);
998 TRACE_smpi_send(rank, rank, dst_traced, tag,count*datatype->size());
1000 Request::ssend(buf, count, datatype, dst, tag, comm);
1001 retval = MPI_SUCCESS;
1003 TRACE_smpi_ptp_out(rank, rank, dst_traced, __FUNCTION__);
1010 int PMPI_Sendrecv(void *sendbuf, int sendcount, MPI_Datatype sendtype, int dst, int sendtag, void *recvbuf,
1011 int recvcount, MPI_Datatype recvtype, int src, int recvtag, MPI_Comm comm, MPI_Status * status)
1017 if (comm == MPI_COMM_NULL) {
1018 retval = MPI_ERR_COMM;
1019 } else if (!sendtype->is_valid() || !recvtype->is_valid()) {
1020 retval = MPI_ERR_TYPE;
1021 } else if (src == MPI_PROC_NULL || dst == MPI_PROC_NULL) {
1022 smpi_empty_status(status);
1023 status->MPI_SOURCE = MPI_PROC_NULL;
1024 retval = MPI_SUCCESS;
1025 }else if (dst >= comm->group()->size() || dst <0 ||
1026 (src!=MPI_ANY_SOURCE && (src >= comm->group()->size() || src <0))){
1027 retval = MPI_ERR_RANK;
1028 } else if ((sendcount < 0 || recvcount<0) ||
1029 (sendbuf==nullptr && sendcount > 0) || (recvbuf==nullptr && recvcount>0)) {
1030 retval = MPI_ERR_COUNT;
1031 } else if((sendtag<0 && sendtag != MPI_ANY_TAG)||(recvtag<0 && recvtag != MPI_ANY_TAG)){
1032 retval = MPI_ERR_TAG;
1035 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1036 int dst_traced = comm->group()->index(dst);
1037 int src_traced = comm->group()->index(src);
1038 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
1039 extra->type = TRACING_SENDRECV;
1040 extra->src = src_traced;
1041 extra->dst = dst_traced;
1043 extra->datatype1 = encode_datatype(sendtype, &known);
1044 int dt_size_send = 1;
1046 dt_size_send = sendtype->size();
1047 extra->send_size = sendcount*dt_size_send;
1048 extra->datatype2 = encode_datatype(recvtype, &known);
1049 int dt_size_recv = 1;
1051 dt_size_recv = recvtype->size();
1052 extra->recv_size = recvcount*dt_size_recv;
1054 TRACE_smpi_ptp_in(rank, src_traced, dst_traced, __FUNCTION__, extra);
1055 TRACE_smpi_send(rank, rank, dst_traced, sendtag,sendcount*sendtype->size());
1057 Request::sendrecv(sendbuf, sendcount, sendtype, dst, sendtag, recvbuf, recvcount, recvtype, src, recvtag, comm,
1059 retval = MPI_SUCCESS;
1061 TRACE_smpi_ptp_out(rank, src_traced, dst_traced, __FUNCTION__);
1062 TRACE_smpi_recv(rank, src_traced, rank, recvtag);
1069 int PMPI_Sendrecv_replace(void* buf, int count, MPI_Datatype datatype, int dst, int sendtag, int src, int recvtag,
1070 MPI_Comm comm, MPI_Status* status)
1073 if (!datatype->is_valid()) {
1074 return MPI_ERR_TYPE;
1075 } else if (count < 0) {
1076 return MPI_ERR_COUNT;
1078 int size = datatype->get_extent() * count;
1079 void* recvbuf = xbt_new0(char, size);
1080 retval = MPI_Sendrecv(buf, count, datatype, dst, sendtag, recvbuf, count, datatype, src, recvtag, comm, status);
1081 if(retval==MPI_SUCCESS){
1082 Datatype::copy(recvbuf, count, datatype, buf, count, datatype);
1090 int PMPI_Test(MPI_Request * request, int *flag, MPI_Status * status)
1094 if (request == nullptr || flag == nullptr) {
1095 retval = MPI_ERR_ARG;
1096 } else if (*request == MPI_REQUEST_NULL) {
1098 smpi_empty_status(status);
1099 retval = MPI_SUCCESS;
1101 int rank = ((*request)->comm() != MPI_COMM_NULL) ? smpi_process_index() : -1;
1103 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
1104 extra->type = TRACING_TEST;
1105 TRACE_smpi_testing_in(rank, extra);
1107 *flag = Request::test(request,status);
1109 TRACE_smpi_testing_out(rank);
1110 retval = MPI_SUCCESS;
1116 int PMPI_Testany(int count, MPI_Request requests[], int *index, int *flag, MPI_Status * status)
1121 if (index == nullptr || flag == nullptr) {
1122 retval = MPI_ERR_ARG;
1124 *flag = Request::testany(count, requests, index, status);
1125 retval = MPI_SUCCESS;
1131 int PMPI_Testall(int count, MPI_Request* requests, int* flag, MPI_Status* statuses)
1136 if (flag == nullptr) {
1137 retval = MPI_ERR_ARG;
1139 *flag = Request::testall(count, requests, statuses);
1140 retval = MPI_SUCCESS;
1146 int PMPI_Probe(int source, int tag, MPI_Comm comm, MPI_Status* status) {
1150 if (status == nullptr) {
1151 retval = MPI_ERR_ARG;
1152 } else if (comm == MPI_COMM_NULL) {
1153 retval = MPI_ERR_COMM;
1154 } else if (source == MPI_PROC_NULL) {
1155 smpi_empty_status(status);
1156 status->MPI_SOURCE = MPI_PROC_NULL;
1157 retval = MPI_SUCCESS;
1159 Request::probe(source, tag, comm, status);
1160 retval = MPI_SUCCESS;
1166 int PMPI_Iprobe(int source, int tag, MPI_Comm comm, int* flag, MPI_Status* status) {
1170 if ((flag == nullptr) || (status == nullptr)) {
1171 retval = MPI_ERR_ARG;
1172 } else if (comm == MPI_COMM_NULL) {
1173 retval = MPI_ERR_COMM;
1174 } else if (source == MPI_PROC_NULL) {
1176 smpi_empty_status(status);
1177 status->MPI_SOURCE = MPI_PROC_NULL;
1178 retval = MPI_SUCCESS;
1180 Request::iprobe(source, tag, comm, flag, status);
1181 retval = MPI_SUCCESS;
1187 int PMPI_Wait(MPI_Request * request, MPI_Status * status)
1193 smpi_empty_status(status);
1195 if (request == nullptr) {
1196 retval = MPI_ERR_ARG;
1197 } else if (*request == MPI_REQUEST_NULL) {
1198 retval = MPI_SUCCESS;
1201 int rank = (request!=nullptr && (*request)->comm() != MPI_COMM_NULL) ? smpi_process_index() : -1;
1203 int src_traced = (*request)->src();
1204 int dst_traced = (*request)->dst();
1205 int tag_traced= (*request)->tag();
1206 MPI_Comm comm = (*request)->comm();
1207 int is_wait_for_receive = ((*request)->flags() & RECV);
1208 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
1209 extra->type = TRACING_WAIT;
1210 TRACE_smpi_ptp_in(rank, src_traced, dst_traced, __FUNCTION__, extra);
1212 Request::wait(request, status);
1213 retval = MPI_SUCCESS;
1215 //the src may not have been known at the beginning of the recv (MPI_ANY_SOURCE)
1216 TRACE_smpi_ptp_out(rank, src_traced, dst_traced, __FUNCTION__);
1217 if (is_wait_for_receive) {
1218 if(src_traced==MPI_ANY_SOURCE)
1219 src_traced = (status!=MPI_STATUS_IGNORE) ?
1220 comm->group()->rank(status->MPI_SOURCE) :
1222 TRACE_smpi_recv(rank, src_traced, dst_traced, tag_traced);
1230 int PMPI_Waitany(int count, MPI_Request requests[], int *index, MPI_Status * status)
1232 if (index == nullptr)
1236 //save requests information for tracing
1244 savedvalstype* savedvals=nullptr;
1246 savedvals = xbt_new0(savedvalstype, count);
1248 for (int i = 0; i < count; i++) {
1249 MPI_Request req = requests[i]; //already received requests are no longer valid
1251 savedvals[i]=(savedvalstype){req->src(), req->dst(), (req->flags() & RECV), req->tag(), req->comm()};
1254 int rank_traced = smpi_process_index();
1255 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
1256 extra->type = TRACING_WAITANY;
1257 extra->send_size=count;
1258 TRACE_smpi_ptp_in(rank_traced, -1, -1, __FUNCTION__,extra);
1260 *index = Request::waitany(count, requests, status);
1262 if(*index!=MPI_UNDEFINED){
1263 int src_traced = savedvals[*index].src;
1264 //the src may not have been known at the beginning of the recv (MPI_ANY_SOURCE)
1265 int dst_traced = savedvals[*index].dst;
1266 int is_wait_for_receive = savedvals[*index].recv;
1267 if (is_wait_for_receive) {
1268 if(savedvals[*index].src==MPI_ANY_SOURCE)
1269 src_traced = (status != MPI_STATUSES_IGNORE)
1270 ? savedvals[*index].comm->group()->rank(status->MPI_SOURCE)
1271 : savedvals[*index].src;
1272 TRACE_smpi_recv(rank_traced, src_traced, dst_traced, savedvals[*index].tag);
1274 TRACE_smpi_ptp_out(rank_traced, src_traced, dst_traced, __FUNCTION__);
1276 xbt_free(savedvals);
1282 int PMPI_Waitall(int count, MPI_Request requests[], MPI_Status status[])
1285 //save information from requests
1294 savedvalstype* savedvals=xbt_new0(savedvalstype, count);
1296 for (int i = 0; i < count; i++) {
1297 MPI_Request req = requests[i];
1298 if(req!=MPI_REQUEST_NULL){
1299 savedvals[i]=(savedvalstype){req->src(), req->dst(), (req->flags() & RECV), req->tag(), 1, req->comm()};
1301 savedvals[i].valid=0;
1304 int rank_traced = smpi_process_index();
1305 instr_extra_data extra = xbt_new0(s_instr_extra_data_t,1);
1306 extra->type = TRACING_WAITALL;
1307 extra->send_size=count;
1308 TRACE_smpi_ptp_in(rank_traced, -1, -1, __FUNCTION__,extra);
1310 int retval =Request::waitall(count, requests, status);
1312 for (int i = 0; i < count; i++) {
1313 if(savedvals[i].valid){
1314 //the src may not have been known at the beginning of the recv (MPI_ANY_SOURCE)
1315 int src_traced = savedvals[i].src;
1316 int dst_traced = savedvals[i].dst;
1317 int is_wait_for_receive = savedvals[i].recv;
1318 if (is_wait_for_receive) {
1319 if(src_traced==MPI_ANY_SOURCE)
1320 src_traced = (status!=MPI_STATUSES_IGNORE) ?
1321 savedvals[i].comm->group()->rank(status[i].MPI_SOURCE) : savedvals[i].src;
1322 TRACE_smpi_recv(rank_traced, src_traced, dst_traced,savedvals[i].tag);
1326 TRACE_smpi_ptp_out(rank_traced, -1, -1, __FUNCTION__);
1327 xbt_free(savedvals);
1333 int PMPI_Waitsome(int incount, MPI_Request requests[], int *outcount, int *indices, MPI_Status status[])
1338 if (outcount == nullptr) {
1339 retval = MPI_ERR_ARG;
1341 *outcount = Request::waitsome(incount, requests, indices, status);
1342 retval = MPI_SUCCESS;
1348 int PMPI_Testsome(int incount, MPI_Request requests[], int* outcount, int* indices, MPI_Status status[])
1353 if (outcount == nullptr) {
1354 retval = MPI_ERR_ARG;
1356 *outcount = Request::testsome(incount, requests, indices, status);
1357 retval = MPI_SUCCESS;
1364 int PMPI_Bcast(void *buf, int count, MPI_Datatype datatype, int root, MPI_Comm comm)
1370 if (comm == MPI_COMM_NULL) {
1371 retval = MPI_ERR_COMM;
1372 } else if (!datatype->is_valid()) {
1373 retval = MPI_ERR_ARG;
1375 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1376 int root_traced = comm->group()->index(root);
1378 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1379 extra->type = TRACING_BCAST;
1380 extra->root = root_traced;
1382 extra->datatype1 = encode_datatype(datatype, &known);
1383 int dt_size_send = 1;
1385 dt_size_send = datatype->size();
1386 extra->send_size = count * dt_size_send;
1387 TRACE_smpi_collective_in(rank, root_traced, __FUNCTION__, extra);
1388 if (comm->size() > 1)
1389 mpi_coll_bcast_fun(buf, count, datatype, root, comm);
1390 retval = MPI_SUCCESS;
1392 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1398 int PMPI_Barrier(MPI_Comm comm)
1404 if (comm == MPI_COMM_NULL) {
1405 retval = MPI_ERR_COMM;
1407 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1408 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1409 extra->type = TRACING_BARRIER;
1410 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1412 mpi_coll_barrier_fun(comm);
1413 retval = MPI_SUCCESS;
1415 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1422 int PMPI_Gather(void *sendbuf, int sendcount, MPI_Datatype sendtype,void *recvbuf, int recvcount, MPI_Datatype recvtype,
1423 int root, MPI_Comm comm)
1429 if (comm == MPI_COMM_NULL) {
1430 retval = MPI_ERR_COMM;
1431 } else if ((( sendbuf != MPI_IN_PLACE) && (sendtype == MPI_DATATYPE_NULL)) ||
1432 ((comm->rank() == root) && (recvtype == MPI_DATATYPE_NULL))){
1433 retval = MPI_ERR_TYPE;
1434 } else if ((( sendbuf != MPI_IN_PLACE) && (sendcount <0)) || ((comm->rank() == root) && (recvcount <0))){
1435 retval = MPI_ERR_COUNT;
1438 char* sendtmpbuf = static_cast<char*>(sendbuf);
1439 int sendtmpcount = sendcount;
1440 MPI_Datatype sendtmptype = sendtype;
1441 if( (comm->rank() == root) && (sendbuf == MPI_IN_PLACE )) {
1443 sendtmptype=recvtype;
1445 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1446 int root_traced = comm->group()->index(root);
1447 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1448 extra->type = TRACING_GATHER;
1449 extra->root = root_traced;
1451 extra->datatype1 = encode_datatype(sendtmptype, &known);
1452 int dt_size_send = 1;
1454 dt_size_send = sendtmptype->size();
1455 extra->send_size = sendtmpcount * dt_size_send;
1456 extra->datatype2 = encode_datatype(recvtype, &known);
1457 int dt_size_recv = 1;
1458 if ((comm->rank() == root) && known == 0)
1459 dt_size_recv = recvtype->size();
1460 extra->recv_size = recvcount * dt_size_recv;
1462 TRACE_smpi_collective_in(rank, root_traced, __FUNCTION__, extra);
1464 mpi_coll_gather_fun(sendtmpbuf, sendtmpcount, sendtmptype, recvbuf, recvcount, recvtype, root, comm);
1466 retval = MPI_SUCCESS;
1467 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1474 int PMPI_Gatherv(void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int *recvcounts, int *displs,
1475 MPI_Datatype recvtype, int root, MPI_Comm comm)
1481 if (comm == MPI_COMM_NULL) {
1482 retval = MPI_ERR_COMM;
1483 } else if ((( sendbuf != MPI_IN_PLACE) && (sendtype == MPI_DATATYPE_NULL)) ||
1484 ((comm->rank() == root) && (recvtype == MPI_DATATYPE_NULL))){
1485 retval = MPI_ERR_TYPE;
1486 } else if (( sendbuf != MPI_IN_PLACE) && (sendcount <0)){
1487 retval = MPI_ERR_COUNT;
1488 } else if (recvcounts == nullptr || displs == nullptr) {
1489 retval = MPI_ERR_ARG;
1491 char* sendtmpbuf = static_cast<char*>(sendbuf);
1492 int sendtmpcount = sendcount;
1493 MPI_Datatype sendtmptype = sendtype;
1494 if( (comm->rank() == root) && (sendbuf == MPI_IN_PLACE )) {
1496 sendtmptype=recvtype;
1499 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1500 int root_traced = comm->group()->index(root);
1502 int size = comm->size();
1503 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1504 extra->type = TRACING_GATHERV;
1505 extra->num_processes = size;
1506 extra->root = root_traced;
1508 extra->datatype1 = encode_datatype(sendtmptype, &known);
1509 int dt_size_send = 1;
1511 dt_size_send = sendtype->size();
1512 extra->send_size = sendtmpcount * dt_size_send;
1513 extra->datatype2 = encode_datatype(recvtype, &known);
1514 int dt_size_recv = 1;
1516 dt_size_recv = recvtype->size();
1517 if ((comm->rank() == root)) {
1518 extra->recvcounts = xbt_new(int, size);
1519 for (i = 0; i < size; i++) // copy data to avoid bad free
1520 extra->recvcounts[i] = recvcounts[i] * dt_size_recv;
1522 TRACE_smpi_collective_in(rank, root_traced, __FUNCTION__, extra);
1524 smpi_mpi_gatherv(sendtmpbuf, sendtmpcount, sendtmptype, recvbuf, recvcounts, displs, recvtype, root, comm);
1525 retval = MPI_SUCCESS;
1526 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1533 int PMPI_Allgather(void *sendbuf, int sendcount, MPI_Datatype sendtype,
1534 void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm)
1540 if (comm == MPI_COMM_NULL) {
1541 retval = MPI_ERR_COMM;
1542 } else if ((( sendbuf != MPI_IN_PLACE) && (sendtype == MPI_DATATYPE_NULL)) ||
1543 (recvtype == MPI_DATATYPE_NULL)){
1544 retval = MPI_ERR_TYPE;
1545 } else if ((( sendbuf != MPI_IN_PLACE) && (sendcount <0)) ||
1547 retval = MPI_ERR_COUNT;
1549 if(sendbuf == MPI_IN_PLACE) {
1550 sendbuf=static_cast<char*>(recvbuf)+recvtype->get_extent()*recvcount*comm->rank();
1551 sendcount=recvcount;
1554 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1555 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1556 extra->type = TRACING_ALLGATHER;
1558 extra->datatype1 = encode_datatype(sendtype, &known);
1559 int dt_size_send = 1;
1561 dt_size_send = sendtype->size();
1562 extra->send_size = sendcount * dt_size_send;
1563 extra->datatype2 = encode_datatype(recvtype, &known);
1564 int dt_size_recv = 1;
1566 dt_size_recv = recvtype->size();
1567 extra->recv_size = recvcount * dt_size_recv;
1569 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1571 mpi_coll_allgather_fun(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm);
1572 retval = MPI_SUCCESS;
1573 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1579 int PMPI_Allgatherv(void *sendbuf, int sendcount, MPI_Datatype sendtype,
1580 void *recvbuf, int *recvcounts, int *displs, MPI_Datatype recvtype, MPI_Comm comm)
1586 if (comm == MPI_COMM_NULL) {
1587 retval = MPI_ERR_COMM;
1588 } else if (((sendbuf != MPI_IN_PLACE) && (sendtype == MPI_DATATYPE_NULL)) || (recvtype == MPI_DATATYPE_NULL)) {
1589 retval = MPI_ERR_TYPE;
1590 } else if (( sendbuf != MPI_IN_PLACE) && (sendcount <0)){
1591 retval = MPI_ERR_COUNT;
1592 } else if (recvcounts == nullptr || displs == nullptr) {
1593 retval = MPI_ERR_ARG;
1596 if(sendbuf == MPI_IN_PLACE) {
1597 sendbuf=static_cast<char*>(recvbuf)+recvtype->get_extent()*displs[comm->rank()];
1598 sendcount=recvcounts[comm->rank()];
1601 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1603 int size = comm->size();
1604 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1605 extra->type = TRACING_ALLGATHERV;
1606 extra->num_processes = size;
1608 extra->datatype1 = encode_datatype(sendtype, &known);
1609 int dt_size_send = 1;
1611 dt_size_send = sendtype->size();
1612 extra->send_size = sendcount * dt_size_send;
1613 extra->datatype2 = encode_datatype(recvtype, &known);
1614 int dt_size_recv = 1;
1616 dt_size_recv = recvtype->size();
1617 extra->recvcounts = xbt_new(int, size);
1618 for (i = 0; i < size; i++) // copy data to avoid bad free
1619 extra->recvcounts[i] = recvcounts[i] * dt_size_recv;
1621 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1623 mpi_coll_allgatherv_fun(sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, comm);
1624 retval = MPI_SUCCESS;
1625 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1632 int PMPI_Scatter(void *sendbuf, int sendcount, MPI_Datatype sendtype,
1633 void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm)
1639 if (comm == MPI_COMM_NULL) {
1640 retval = MPI_ERR_COMM;
1641 } else if (((comm->rank() == root) && (!sendtype->is_valid())) ||
1642 ((recvbuf != MPI_IN_PLACE) && (!recvtype->is_valid()))) {
1643 retval = MPI_ERR_TYPE;
1644 } else if ((sendbuf == recvbuf) ||
1645 ((comm->rank()==root) && sendcount>0 && (sendbuf == nullptr))){
1646 retval = MPI_ERR_BUFFER;
1649 if (recvbuf == MPI_IN_PLACE) {
1650 recvtype = sendtype;
1651 recvcount = sendcount;
1653 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1654 int root_traced = comm->group()->index(root);
1655 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1656 extra->type = TRACING_SCATTER;
1657 extra->root = root_traced;
1659 extra->datatype1 = encode_datatype(sendtype, &known);
1660 int dt_size_send = 1;
1661 if ((comm->rank() == root) && known == 0)
1662 dt_size_send = sendtype->size();
1663 extra->send_size = sendcount * dt_size_send;
1664 extra->datatype2 = encode_datatype(recvtype, &known);
1665 int dt_size_recv = 1;
1667 dt_size_recv = recvtype->size();
1668 extra->recv_size = recvcount * dt_size_recv;
1669 TRACE_smpi_collective_in(rank, root_traced, __FUNCTION__, extra);
1671 mpi_coll_scatter_fun(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm);
1672 retval = MPI_SUCCESS;
1673 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1680 int PMPI_Scatterv(void *sendbuf, int *sendcounts, int *displs,
1681 MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm)
1687 if (comm == MPI_COMM_NULL) {
1688 retval = MPI_ERR_COMM;
1689 } else if (sendcounts == nullptr || displs == nullptr) {
1690 retval = MPI_ERR_ARG;
1691 } else if (((comm->rank() == root) && (sendtype == MPI_DATATYPE_NULL)) ||
1692 ((recvbuf != MPI_IN_PLACE) && (recvtype == MPI_DATATYPE_NULL))) {
1693 retval = MPI_ERR_TYPE;
1695 if (recvbuf == MPI_IN_PLACE) {
1696 recvtype = sendtype;
1697 recvcount = sendcounts[comm->rank()];
1699 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1700 int root_traced = comm->group()->index(root);
1702 int size = comm->size();
1703 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1704 extra->type = TRACING_SCATTERV;
1705 extra->num_processes = size;
1706 extra->root = root_traced;
1708 extra->datatype1 = encode_datatype(sendtype, &known);
1709 int dt_size_send = 1;
1711 dt_size_send = sendtype->size();
1712 if ((comm->rank() == root)) {
1713 extra->sendcounts = xbt_new(int, size);
1714 for (i = 0; i < size; i++) // copy data to avoid bad free
1715 extra->sendcounts[i] = sendcounts[i] * dt_size_send;
1717 extra->datatype2 = encode_datatype(recvtype, &known);
1718 int dt_size_recv = 1;
1720 dt_size_recv = recvtype->size();
1721 extra->recv_size = recvcount * dt_size_recv;
1722 TRACE_smpi_collective_in(rank, root_traced, __FUNCTION__, extra);
1724 smpi_mpi_scatterv(sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount, recvtype, root, comm);
1726 retval = MPI_SUCCESS;
1727 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1734 int PMPI_Reduce(void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm)
1740 if (comm == MPI_COMM_NULL) {
1741 retval = MPI_ERR_COMM;
1742 } else if (!datatype->is_valid() || op == MPI_OP_NULL) {
1743 retval = MPI_ERR_ARG;
1745 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1746 int root_traced = comm->group()->index(root);
1747 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1748 extra->type = TRACING_REDUCE;
1750 extra->datatype1 = encode_datatype(datatype, &known);
1751 int dt_size_send = 1;
1753 dt_size_send = datatype->size();
1754 extra->send_size = count * dt_size_send;
1755 extra->root = root_traced;
1757 TRACE_smpi_collective_in(rank, root_traced, __FUNCTION__, extra);
1759 mpi_coll_reduce_fun(sendbuf, recvbuf, count, datatype, op, root, comm);
1761 retval = MPI_SUCCESS;
1762 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1769 int PMPI_Reduce_local(void *inbuf, void *inoutbuf, int count, MPI_Datatype datatype, MPI_Op op){
1773 if (!datatype->is_valid() || op == MPI_OP_NULL) {
1774 retval = MPI_ERR_ARG;
1776 if(op!=MPI_OP_NULL) op->apply( inbuf, inoutbuf, &count, datatype);
1777 retval = MPI_SUCCESS;
1783 int PMPI_Allreduce(void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
1789 if (comm == MPI_COMM_NULL) {
1790 retval = MPI_ERR_COMM;
1791 } else if (!datatype->is_valid()) {
1792 retval = MPI_ERR_TYPE;
1793 } else if (op == MPI_OP_NULL) {
1794 retval = MPI_ERR_OP;
1797 char* sendtmpbuf = static_cast<char*>(sendbuf);
1798 if( sendbuf == MPI_IN_PLACE ) {
1799 sendtmpbuf = static_cast<char*>(xbt_malloc(count*datatype->get_extent()));
1800 Datatype::copy(recvbuf, count, datatype,sendtmpbuf, count, datatype);
1802 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1803 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1804 extra->type = TRACING_ALLREDUCE;
1806 extra->datatype1 = encode_datatype(datatype, &known);
1807 int dt_size_send = 1;
1809 dt_size_send = datatype->size();
1810 extra->send_size = count * dt_size_send;
1812 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1814 mpi_coll_allreduce_fun(sendtmpbuf, recvbuf, count, datatype, op, comm);
1816 if( sendbuf == MPI_IN_PLACE )
1817 xbt_free(sendtmpbuf);
1819 retval = MPI_SUCCESS;
1820 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1827 int PMPI_Scan(void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
1833 if (comm == MPI_COMM_NULL) {
1834 retval = MPI_ERR_COMM;
1835 } else if (!datatype->is_valid()) {
1836 retval = MPI_ERR_TYPE;
1837 } else if (op == MPI_OP_NULL) {
1838 retval = MPI_ERR_OP;
1840 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1841 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1842 extra->type = TRACING_SCAN;
1844 extra->datatype1 = encode_datatype(datatype, &known);
1845 int dt_size_send = 1;
1847 dt_size_send = datatype->size();
1848 extra->send_size = count * dt_size_send;
1850 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1852 smpi_mpi_scan(sendbuf, recvbuf, count, datatype, op, comm);
1854 retval = MPI_SUCCESS;
1855 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1862 int PMPI_Exscan(void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm){
1867 if (comm == MPI_COMM_NULL) {
1868 retval = MPI_ERR_COMM;
1869 } else if (!datatype->is_valid()) {
1870 retval = MPI_ERR_TYPE;
1871 } else if (op == MPI_OP_NULL) {
1872 retval = MPI_ERR_OP;
1874 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1875 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1876 extra->type = TRACING_EXSCAN;
1878 extra->datatype1 = encode_datatype(datatype, &known);
1879 int dt_size_send = 1;
1881 dt_size_send = datatype->size();
1882 extra->send_size = count * dt_size_send;
1883 void* sendtmpbuf = sendbuf;
1884 if (sendbuf == MPI_IN_PLACE) {
1885 sendtmpbuf = static_cast<void*>(xbt_malloc(count * datatype->size()));
1886 memcpy(sendtmpbuf, recvbuf, count * datatype->size());
1888 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1890 smpi_mpi_exscan(sendtmpbuf, recvbuf, count, datatype, op, comm);
1891 retval = MPI_SUCCESS;
1892 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1893 if (sendbuf == MPI_IN_PLACE)
1894 xbt_free(sendtmpbuf);
1901 int PMPI_Reduce_scatter(void *sendbuf, void *recvbuf, int *recvcounts, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
1906 if (comm == MPI_COMM_NULL) {
1907 retval = MPI_ERR_COMM;
1908 } else if (!datatype->is_valid()) {
1909 retval = MPI_ERR_TYPE;
1910 } else if (op == MPI_OP_NULL) {
1911 retval = MPI_ERR_OP;
1912 } else if (recvcounts == nullptr) {
1913 retval = MPI_ERR_ARG;
1915 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1917 int size = comm->size();
1918 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1919 extra->type = TRACING_REDUCE_SCATTER;
1920 extra->num_processes = size;
1922 extra->datatype1 = encode_datatype(datatype, &known);
1923 int dt_size_send = 1;
1925 dt_size_send = datatype->size();
1926 extra->send_size = 0;
1927 extra->recvcounts = xbt_new(int, size);
1929 for (i = 0; i < size; i++) { // copy data to avoid bad free
1930 extra->recvcounts[i] = recvcounts[i] * dt_size_send;
1931 totalcount += recvcounts[i];
1933 void* sendtmpbuf = sendbuf;
1934 if (sendbuf == MPI_IN_PLACE) {
1935 sendtmpbuf = static_cast<void*>(xbt_malloc(totalcount * datatype->size()));
1936 memcpy(sendtmpbuf, recvbuf, totalcount * datatype->size());
1939 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1941 mpi_coll_reduce_scatter_fun(sendtmpbuf, recvbuf, recvcounts, datatype, op, comm);
1942 retval = MPI_SUCCESS;
1943 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1945 if (sendbuf == MPI_IN_PLACE)
1946 xbt_free(sendtmpbuf);
1953 int PMPI_Reduce_scatter_block(void *sendbuf, void *recvbuf, int recvcount,
1954 MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
1959 if (comm == MPI_COMM_NULL) {
1960 retval = MPI_ERR_COMM;
1961 } else if (!datatype->is_valid()) {
1962 retval = MPI_ERR_TYPE;
1963 } else if (op == MPI_OP_NULL) {
1964 retval = MPI_ERR_OP;
1965 } else if (recvcount < 0) {
1966 retval = MPI_ERR_ARG;
1968 int count = comm->size();
1970 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1971 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1972 extra->type = TRACING_REDUCE_SCATTER;
1973 extra->num_processes = count;
1975 extra->datatype1 = encode_datatype(datatype, &known);
1976 int dt_size_send = 1;
1978 dt_size_send = datatype->size();
1979 extra->send_size = 0;
1980 extra->recvcounts = xbt_new(int, count);
1981 for (int i = 0; i < count; i++) // copy data to avoid bad free
1982 extra->recvcounts[i] = recvcount * dt_size_send;
1983 void* sendtmpbuf = sendbuf;
1984 if (sendbuf == MPI_IN_PLACE) {
1985 sendtmpbuf = static_cast<void*>(xbt_malloc(recvcount * count * datatype->size()));
1986 memcpy(sendtmpbuf, recvbuf, recvcount * count * datatype->size());
1989 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1991 int* recvcounts = static_cast<int*>(xbt_malloc(count * sizeof(int)));
1992 for (int i = 0; i < count; i++)
1993 recvcounts[i] = recvcount;
1994 mpi_coll_reduce_scatter_fun(sendtmpbuf, recvbuf, recvcounts, datatype, op, comm);
1995 xbt_free(recvcounts);
1996 retval = MPI_SUCCESS;
1998 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2000 if (sendbuf == MPI_IN_PLACE)
2001 xbt_free(sendtmpbuf);
2008 int PMPI_Alltoall(void* sendbuf, int sendcount, MPI_Datatype sendtype, void* recvbuf, int recvcount,
2009 MPI_Datatype recvtype, MPI_Comm comm)
2014 if (comm == MPI_COMM_NULL) {
2015 retval = MPI_ERR_COMM;
2016 } else if ((sendbuf != MPI_IN_PLACE && sendtype == MPI_DATATYPE_NULL) || recvtype == MPI_DATATYPE_NULL) {
2017 retval = MPI_ERR_TYPE;
2019 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
2020 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
2021 extra->type = TRACING_ALLTOALL;
2023 void* sendtmpbuf = static_cast<char*>(sendbuf);
2024 int sendtmpcount = sendcount;
2025 MPI_Datatype sendtmptype = sendtype;
2026 if (sendbuf == MPI_IN_PLACE) {
2027 sendtmpbuf = static_cast<void*>(xbt_malloc(recvcount * comm->size() * recvtype->size()));
2028 memcpy(sendtmpbuf, recvbuf, recvcount * comm->size() * recvtype->size());
2029 sendtmpcount = recvcount;
2030 sendtmptype = recvtype;
2034 extra->datatype1 = encode_datatype(sendtmptype, &known);
2036 extra->send_size = sendtmpcount * sendtmptype->size();
2038 extra->send_size = sendtmpcount;
2039 extra->datatype2 = encode_datatype(recvtype, &known);
2041 extra->recv_size = recvcount * recvtype->size();
2043 extra->recv_size = recvcount;
2045 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
2047 retval = mpi_coll_alltoall_fun(sendtmpbuf, sendtmpcount, sendtmptype, recvbuf, recvcount, recvtype, comm);
2049 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2051 if (sendbuf == MPI_IN_PLACE)
2052 xbt_free(sendtmpbuf);
2059 int PMPI_Alltoallv(void* sendbuf, int* sendcounts, int* senddisps, MPI_Datatype sendtype, void* recvbuf,
2060 int* recvcounts, int* recvdisps, MPI_Datatype recvtype, MPI_Comm comm)
2066 if (comm == MPI_COMM_NULL) {
2067 retval = MPI_ERR_COMM;
2068 } else if (sendtype == MPI_DATATYPE_NULL || recvtype == MPI_DATATYPE_NULL) {
2069 retval = MPI_ERR_TYPE;
2070 } else if ((sendbuf != MPI_IN_PLACE && (sendcounts == nullptr || senddisps == nullptr)) || recvcounts == nullptr ||
2071 recvdisps == nullptr) {
2072 retval = MPI_ERR_ARG;
2074 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
2076 int size = comm->size();
2077 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
2078 extra->type = TRACING_ALLTOALLV;
2079 extra->send_size = 0;
2080 extra->recv_size = 0;
2081 extra->recvcounts = xbt_new(int, size);
2082 extra->sendcounts = xbt_new(int, size);
2084 int dt_size_recv = 1;
2085 extra->datatype2 = encode_datatype(recvtype, &known);
2086 dt_size_recv = recvtype->size();
2088 void* sendtmpbuf = static_cast<char*>(sendbuf);
2089 int* sendtmpcounts = sendcounts;
2090 int* sendtmpdisps = senddisps;
2091 MPI_Datatype sendtmptype = sendtype;
2093 for (i = 0; i < size; i++) { // copy data to avoid bad free
2094 extra->recv_size += recvcounts[i] * dt_size_recv;
2095 extra->recvcounts[i] = recvcounts[i] * dt_size_recv;
2096 if (((recvdisps[i] + recvcounts[i]) * dt_size_recv) > maxsize)
2097 maxsize = (recvdisps[i] + recvcounts[i]) * dt_size_recv;
2100 if (sendbuf == MPI_IN_PLACE) {
2101 sendtmpbuf = static_cast<void*>(xbt_malloc(maxsize));
2102 memcpy(sendtmpbuf, recvbuf, maxsize);
2103 sendtmpcounts = static_cast<int*>(xbt_malloc(size * sizeof(int)));
2104 memcpy(sendtmpcounts, recvcounts, size * sizeof(int));
2105 sendtmpdisps = static_cast<int*>(xbt_malloc(size * sizeof(int)));
2106 memcpy(sendtmpdisps, recvdisps, size * sizeof(int));
2107 sendtmptype = recvtype;
2110 extra->datatype1 = encode_datatype(sendtmptype, &known);
2111 int dt_size_send = 1;
2112 dt_size_send = sendtmptype->size();
2114 for (i = 0; i < size; i++) { // copy data to avoid bad free
2115 extra->send_size += sendtmpcounts[i] * dt_size_send;
2116 extra->sendcounts[i] = sendtmpcounts[i] * dt_size_send;
2118 extra->num_processes = size;
2119 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
2120 retval = mpi_coll_alltoallv_fun(sendtmpbuf, sendtmpcounts, sendtmpdisps, sendtmptype, recvbuf, recvcounts,
2121 recvdisps, recvtype, comm);
2122 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2124 if (sendbuf == MPI_IN_PLACE) {
2125 xbt_free(sendtmpbuf);
2126 xbt_free(sendtmpcounts);
2127 xbt_free(sendtmpdisps);
2136 int PMPI_Get_processor_name(char *name, int *resultlen)
2138 strncpy(name, SIMIX_host_self()->cname(), strlen(SIMIX_host_self()->cname()) < MPI_MAX_PROCESSOR_NAME - 1
2139 ? strlen(SIMIX_host_self()->cname()) + 1
2140 : MPI_MAX_PROCESSOR_NAME - 1);
2141 *resultlen = strlen(name) > MPI_MAX_PROCESSOR_NAME ? MPI_MAX_PROCESSOR_NAME : strlen(name);
2146 int PMPI_Get_count(MPI_Status * status, MPI_Datatype datatype, int *count)
2148 if (status == nullptr || count == nullptr) {
2150 } else if (!datatype->is_valid()) {
2151 return MPI_ERR_TYPE;
2153 size_t size = datatype->size();
2157 } else if (status->count % size != 0) {
2158 return MPI_UNDEFINED;
2160 *count = smpi_mpi_get_count(status, datatype);
2166 int PMPI_Type_contiguous(int count, MPI_Datatype old_type, MPI_Datatype* new_type) {
2167 if (old_type == MPI_DATATYPE_NULL) {
2168 return MPI_ERR_TYPE;
2169 } else if (count<0){
2170 return MPI_ERR_COUNT;
2172 return Datatype::create_contiguous(count, old_type, 0, new_type);
2176 int PMPI_Type_commit(MPI_Datatype* datatype) {
2177 if (datatype == nullptr || *datatype == MPI_DATATYPE_NULL) {
2178 return MPI_ERR_TYPE;
2180 (*datatype)->commit();
2185 int PMPI_Type_vector(int count, int blocklen, int stride, MPI_Datatype old_type, MPI_Datatype* new_type) {
2186 if (old_type == MPI_DATATYPE_NULL) {
2187 return MPI_ERR_TYPE;
2188 } else if (count<0 || blocklen<0){
2189 return MPI_ERR_COUNT;
2191 return Datatype::create_vector(count, blocklen, stride, old_type, new_type);
2195 int PMPI_Type_hvector(int count, int blocklen, MPI_Aint stride, MPI_Datatype old_type, MPI_Datatype* new_type) {
2196 if (old_type == MPI_DATATYPE_NULL) {
2197 return MPI_ERR_TYPE;
2198 } else if (count<0 || blocklen<0){
2199 return MPI_ERR_COUNT;
2201 return Datatype::create_hvector(count, blocklen, stride, old_type, new_type);
2205 int PMPI_Type_create_hvector(int count, int blocklen, MPI_Aint stride, MPI_Datatype old_type, MPI_Datatype* new_type) {
2206 return MPI_Type_hvector(count, blocklen, stride, old_type, new_type);
2209 int PMPI_Type_indexed(int count, int* blocklens, int* indices, MPI_Datatype old_type, MPI_Datatype* new_type) {
2210 if (old_type == MPI_DATATYPE_NULL) {
2211 return MPI_ERR_TYPE;
2212 } else if (count<0){
2213 return MPI_ERR_COUNT;
2215 return Datatype::create_indexed(count, blocklens, indices, old_type, new_type);
2219 int PMPI_Type_create_indexed(int count, int* blocklens, int* indices, MPI_Datatype old_type, MPI_Datatype* new_type) {
2220 if (old_type == MPI_DATATYPE_NULL) {
2221 return MPI_ERR_TYPE;
2222 } else if (count<0){
2223 return MPI_ERR_COUNT;
2225 return Datatype::create_indexed(count, blocklens, indices, old_type, new_type);
2229 int PMPI_Type_create_indexed_block(int count, int blocklength, int* indices, MPI_Datatype old_type,
2230 MPI_Datatype* new_type)
2232 if (old_type == MPI_DATATYPE_NULL) {
2233 return MPI_ERR_TYPE;
2234 } else if (count<0){
2235 return MPI_ERR_COUNT;
2237 int* blocklens=static_cast<int*>(xbt_malloc(blocklength*count*sizeof(int)));
2238 for (int i = 0; i < count; i++)
2239 blocklens[i]=blocklength;
2240 int retval = Datatype::create_indexed(count, blocklens, indices, old_type, new_type);
2241 xbt_free(blocklens);
2246 int PMPI_Type_hindexed(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype old_type, MPI_Datatype* new_type)
2248 if (old_type == MPI_DATATYPE_NULL) {
2249 return MPI_ERR_TYPE;
2250 } else if (count<0){
2251 return MPI_ERR_COUNT;
2253 return Datatype::create_hindexed(count, blocklens, indices, old_type, new_type);
2257 int PMPI_Type_create_hindexed(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype old_type,
2258 MPI_Datatype* new_type) {
2259 return PMPI_Type_hindexed(count, blocklens,indices,old_type,new_type);
2262 int PMPI_Type_create_hindexed_block(int count, int blocklength, MPI_Aint* indices, MPI_Datatype old_type,
2263 MPI_Datatype* new_type) {
2264 if (old_type == MPI_DATATYPE_NULL) {
2265 return MPI_ERR_TYPE;
2266 } else if (count<0){
2267 return MPI_ERR_COUNT;
2269 int* blocklens=(int*)xbt_malloc(blocklength*count*sizeof(int));
2270 for (int i = 0; i < count; i++)
2271 blocklens[i] = blocklength;
2272 int retval = Datatype::create_hindexed(count, blocklens, indices, old_type, new_type);
2273 xbt_free(blocklens);
2278 int PMPI_Type_struct(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype* old_types, MPI_Datatype* new_type) {
2280 return MPI_ERR_COUNT;
2282 return Datatype::create_struct(count, blocklens, indices, old_types, new_type);
2286 int PMPI_Type_create_struct(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype* old_types,
2287 MPI_Datatype* new_type) {
2288 return PMPI_Type_struct(count, blocklens, indices, old_types, new_type);
2291 int PMPI_Error_class(int errorcode, int* errorclass) {
2292 // assume smpi uses only standard mpi error codes
2293 *errorclass=errorcode;
2297 int PMPI_Initialized(int* flag) {
2298 *flag=smpi_process_initialized();
2302 /* The topo part of MPI_COMM_WORLD should always be nullptr. When other topologies will be implemented, not only should we
2303 * check if the topology is nullptr, but we should check if it is the good topology type (so we have to add a
2304 * MPIR_Topo_Type field, and replace the MPI_Topology field by an union)*/
2306 int PMPI_Cart_create(MPI_Comm comm_old, int ndims, int* dims, int* periodic, int reorder, MPI_Comm* comm_cart) {
2307 if (comm_old == MPI_COMM_NULL){
2308 return MPI_ERR_COMM;
2309 } else if (ndims < 0 || (ndims > 0 && (dims == nullptr || periodic == nullptr)) || comm_cart == nullptr) {
2312 new Topo_Cart(comm_old, ndims, dims, periodic, reorder, comm_cart);
2317 int PMPI_Cart_rank(MPI_Comm comm, int* coords, int* rank) {
2318 if(comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2319 return MPI_ERR_TOPOLOGY;
2321 if (coords == nullptr) {
2324 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2325 if (topo==nullptr) {
2328 return topo->rank(coords, rank);
2331 int PMPI_Cart_shift(MPI_Comm comm, int direction, int displ, int* source, int* dest) {
2332 if(comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2333 return MPI_ERR_TOPOLOGY;
2335 if (source == nullptr || dest == nullptr || direction < 0 ) {
2338 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2339 if (topo==nullptr) {
2342 return topo->shift(direction, displ, source, dest);
2345 int PMPI_Cart_coords(MPI_Comm comm, int rank, int maxdims, int* coords) {
2346 if(comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2347 return MPI_ERR_TOPOLOGY;
2349 if (rank < 0 || rank >= comm->size()) {
2350 return MPI_ERR_RANK;
2355 if(coords == nullptr) {
2358 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2359 if (topo==nullptr) {
2362 return topo->coords(rank, maxdims, coords);
2365 int PMPI_Cart_get(MPI_Comm comm, int maxdims, int* dims, int* periods, int* coords) {
2366 if(comm == nullptr || comm->topo() == nullptr) {
2367 return MPI_ERR_TOPOLOGY;
2369 if(maxdims <= 0 || dims == nullptr || periods == nullptr || coords == nullptr) {
2372 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2373 if (topo==nullptr) {
2376 return topo->get(maxdims, dims, periods, coords);
2379 int PMPI_Cartdim_get(MPI_Comm comm, int* ndims) {
2380 if (comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2381 return MPI_ERR_TOPOLOGY;
2383 if (ndims == nullptr) {
2386 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2387 if (topo==nullptr) {
2390 return topo->dim_get(ndims);
2393 int PMPI_Dims_create(int nnodes, int ndims, int* dims) {
2394 if(dims == nullptr) {
2397 if (ndims < 1 || nnodes < 1) {
2398 return MPI_ERR_DIMS;
2400 return Dims_create(nnodes, ndims, dims);
2403 int PMPI_Cart_sub(MPI_Comm comm, int* remain_dims, MPI_Comm* comm_new) {
2404 if(comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2405 return MPI_ERR_TOPOLOGY;
2407 if (comm_new == nullptr) {
2410 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2411 if (topo==nullptr) {
2414 MPIR_Cart_Topology cart = topo->sub(remain_dims, comm_new);
2420 int PMPI_Type_create_resized(MPI_Datatype oldtype,MPI_Aint lb, MPI_Aint extent, MPI_Datatype *newtype){
2421 if (oldtype == MPI_DATATYPE_NULL) {
2422 return MPI_ERR_TYPE;
2424 int blocks[3] = {1, 1, 1};
2425 MPI_Aint disps[3] = {lb, 0, lb + extent};
2426 MPI_Datatype types[3] = {MPI_LB, oldtype, MPI_UB};
2428 *newtype = new Type_Struct(oldtype->size(), lb, lb + extent, DT_FLAG_DERIVED, 3, blocks, disps, types);
2430 (*newtype)->addflag(~DT_FLAG_COMMITED);
2434 int PMPI_Win_create( void *base, MPI_Aint size, int disp_unit, MPI_Info info, MPI_Comm comm, MPI_Win *win){
2437 if (comm == MPI_COMM_NULL) {
2438 retval= MPI_ERR_COMM;
2439 }else if ((base == nullptr && size != 0) || disp_unit <= 0 || size < 0 ){
2440 retval= MPI_ERR_OTHER;
2442 *win = new Win( base, size, disp_unit, info, comm);
2443 retval = MPI_SUCCESS;
2449 int PMPI_Win_free( MPI_Win* win){
2452 if (win == nullptr || *win == MPI_WIN_NULL) {
2453 retval = MPI_ERR_WIN;
2462 int PMPI_Win_set_name(MPI_Win win, char * name)
2464 if (win == MPI_WIN_NULL) {
2465 return MPI_ERR_TYPE;
2466 } else if (name == nullptr) {
2469 win->set_name(name);
2474 int PMPI_Win_get_name(MPI_Win win, char * name, int* len)
2476 if (win == MPI_WIN_NULL) {
2478 } else if (name == nullptr) {
2481 win->get_name(name, len);
2486 int PMPI_Win_get_group(MPI_Win win, MPI_Group * group){
2487 if (win == MPI_WIN_NULL) {
2490 win->get_group(group);
2496 int PMPI_Win_fence( int assert, MPI_Win win){
2499 if (win == MPI_WIN_NULL) {
2500 retval = MPI_ERR_WIN;
2502 int rank = smpi_process_index();
2503 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2504 retval = win->fence(assert);
2505 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2511 int PMPI_Get( void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank,
2512 MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Win win){
2515 if (win == MPI_WIN_NULL) {
2516 retval = MPI_ERR_WIN;
2517 } else if (target_rank == MPI_PROC_NULL) {
2518 retval = MPI_SUCCESS;
2519 } else if (target_rank <0){
2520 retval = MPI_ERR_RANK;
2521 } else if (target_disp <0){
2522 retval = MPI_ERR_ARG;
2523 } else if ((origin_count < 0 || target_count < 0) ||
2524 (origin_addr==nullptr && origin_count > 0)){
2525 retval = MPI_ERR_COUNT;
2526 } else if ((!origin_datatype->is_valid()) || (!target_datatype->is_valid())) {
2527 retval = MPI_ERR_TYPE;
2529 int rank = smpi_process_index();
2531 win->get_group(&group);
2532 int src_traced = group->index(target_rank);
2533 TRACE_smpi_ptp_in(rank, src_traced, rank, __FUNCTION__, nullptr);
2535 retval = win->get( origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count,
2538 TRACE_smpi_ptp_out(rank, src_traced, rank, __FUNCTION__);
2544 int PMPI_Put( void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank,
2545 MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Win win){
2548 if (win == MPI_WIN_NULL) {
2549 retval = MPI_ERR_WIN;
2550 } else if (target_rank == MPI_PROC_NULL) {
2551 retval = MPI_SUCCESS;
2552 } else if (target_rank <0){
2553 retval = MPI_ERR_RANK;
2554 } else if (target_disp <0){
2555 retval = MPI_ERR_ARG;
2556 } else if ((origin_count < 0 || target_count < 0) ||
2557 (origin_addr==nullptr && origin_count > 0)){
2558 retval = MPI_ERR_COUNT;
2559 } else if ((!origin_datatype->is_valid()) || (!target_datatype->is_valid())) {
2560 retval = MPI_ERR_TYPE;
2562 int rank = smpi_process_index();
2564 win->get_group(&group);
2565 int dst_traced = group->index(target_rank);
2566 TRACE_smpi_ptp_in(rank, rank, dst_traced, __FUNCTION__, nullptr);
2567 TRACE_smpi_send(rank, rank, dst_traced, SMPI_RMA_TAG, origin_count*origin_datatype->size());
2569 retval = win->put( origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count,
2572 TRACE_smpi_ptp_out(rank, rank, dst_traced, __FUNCTION__);
2578 int PMPI_Accumulate( void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank,
2579 MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Op op, MPI_Win win){
2582 if (win == MPI_WIN_NULL) {
2583 retval = MPI_ERR_WIN;
2584 } else if (target_rank == MPI_PROC_NULL) {
2585 retval = MPI_SUCCESS;
2586 } else if (target_rank <0){
2587 retval = MPI_ERR_RANK;
2588 } else if (target_disp <0){
2589 retval = MPI_ERR_ARG;
2590 } else if ((origin_count < 0 || target_count < 0) ||
2591 (origin_addr==nullptr && origin_count > 0)){
2592 retval = MPI_ERR_COUNT;
2593 } else if ((!origin_datatype->is_valid()) ||
2594 (!target_datatype->is_valid())) {
2595 retval = MPI_ERR_TYPE;
2596 } else if (op == MPI_OP_NULL) {
2597 retval = MPI_ERR_OP;
2599 int rank = smpi_process_index();
2601 win->get_group(&group);
2602 int src_traced = group->index(target_rank);
2603 TRACE_smpi_ptp_in(rank, src_traced, rank, __FUNCTION__, nullptr);
2605 retval = win->accumulate( origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count,
2606 target_datatype, op);
2608 TRACE_smpi_ptp_out(rank, src_traced, rank, __FUNCTION__);
2614 int PMPI_Win_post(MPI_Group group, int assert, MPI_Win win){
2617 if (win == MPI_WIN_NULL) {
2618 retval = MPI_ERR_WIN;
2619 } else if (group==MPI_GROUP_NULL){
2620 retval = MPI_ERR_GROUP;
2622 int rank = smpi_process_index();
2623 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2624 retval = win->post(group,assert);
2625 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2631 int PMPI_Win_start(MPI_Group group, int assert, MPI_Win win){
2634 if (win == MPI_WIN_NULL) {
2635 retval = MPI_ERR_WIN;
2636 } else if (group==MPI_GROUP_NULL){
2637 retval = MPI_ERR_GROUP;
2639 int rank = smpi_process_index();
2640 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2641 retval = win->start(group,assert);
2642 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2648 int PMPI_Win_complete(MPI_Win win){
2651 if (win == MPI_WIN_NULL) {
2652 retval = MPI_ERR_WIN;
2654 int rank = smpi_process_index();
2655 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2657 retval = win->complete();
2659 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2665 int PMPI_Win_wait(MPI_Win win){
2668 if (win == MPI_WIN_NULL) {
2669 retval = MPI_ERR_WIN;
2671 int rank = smpi_process_index();
2672 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2674 retval = win->wait();
2676 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2682 int PMPI_Alloc_mem(MPI_Aint size, MPI_Info info, void *baseptr){
2683 void *ptr = xbt_malloc(size);
2685 return MPI_ERR_NO_MEM;
2687 *static_cast<void**>(baseptr) = ptr;
2692 int PMPI_Free_mem(void *baseptr){
2697 int PMPI_Type_set_name(MPI_Datatype datatype, char * name)
2699 if (datatype == MPI_DATATYPE_NULL) {
2700 return MPI_ERR_TYPE;
2701 } else if (name == nullptr) {
2704 datatype->set_name(name);
2709 int PMPI_Type_get_name(MPI_Datatype datatype, char * name, int* len)
2711 if (datatype == MPI_DATATYPE_NULL) {
2712 return MPI_ERR_TYPE;
2713 } else if (name == nullptr) {
2716 datatype->get_name(name, len);
2721 MPI_Datatype PMPI_Type_f2c(MPI_Fint datatype){
2722 return static_cast<MPI_Datatype>(F2C::f2c(datatype));
2725 MPI_Fint PMPI_Type_c2f(MPI_Datatype datatype){
2726 return datatype->c2f();
2729 MPI_Group PMPI_Group_f2c(MPI_Fint group){
2730 return Group::f2c(group);
2733 MPI_Fint PMPI_Group_c2f(MPI_Group group){
2734 return group->c2f();
2737 MPI_Request PMPI_Request_f2c(MPI_Fint request){
2738 return static_cast<MPI_Request>(Request::f2c(request));
2741 MPI_Fint PMPI_Request_c2f(MPI_Request request) {
2742 return request->c2f();
2745 MPI_Win PMPI_Win_f2c(MPI_Fint win){
2746 return static_cast<MPI_Win>(Win::f2c(win));
2749 MPI_Fint PMPI_Win_c2f(MPI_Win win){
2753 MPI_Op PMPI_Op_f2c(MPI_Fint op){
2754 return static_cast<MPI_Op>(Op::f2c(op));
2757 MPI_Fint PMPI_Op_c2f(MPI_Op op){
2761 MPI_Comm PMPI_Comm_f2c(MPI_Fint comm){
2762 return static_cast<MPI_Comm>(Comm::f2c(comm));
2765 MPI_Fint PMPI_Comm_c2f(MPI_Comm comm){
2769 MPI_Info PMPI_Info_f2c(MPI_Fint info){
2770 return static_cast<MPI_Info>(Info::f2c(info));
2773 MPI_Fint PMPI_Info_c2f(MPI_Info info){
2777 int PMPI_Keyval_create(MPI_Copy_function* copy_fn, MPI_Delete_function* delete_fn, int* keyval, void* extra_state) {
2778 return smpi_comm_keyval_create(copy_fn, delete_fn, keyval, extra_state);
2781 int PMPI_Keyval_free(int* keyval) {
2782 return smpi_comm_keyval_free(keyval);
2785 int PMPI_Attr_delete(MPI_Comm comm, int keyval) {
2786 if(keyval == MPI_TAG_UB||keyval == MPI_HOST||keyval == MPI_IO ||keyval == MPI_WTIME_IS_GLOBAL||keyval == MPI_APPNUM
2787 ||keyval == MPI_UNIVERSE_SIZE||keyval == MPI_LASTUSEDCODE)
2789 else if (comm==MPI_COMM_NULL)
2790 return MPI_ERR_COMM;
2792 return comm->attr_delete(keyval);
2795 int PMPI_Attr_get(MPI_Comm comm, int keyval, void* attr_value, int* flag) {
2797 static int zero = 0;
2798 static int tag_ub = 1000000;
2799 static int last_used_code = MPI_ERR_LASTCODE;
2801 if (comm==MPI_COMM_NULL){
2803 return MPI_ERR_COMM;
2811 *static_cast<int**>(attr_value) = &zero;
2813 case MPI_UNIVERSE_SIZE:
2815 *static_cast<int**>(attr_value) = &smpi_universe_size;
2817 case MPI_LASTUSEDCODE:
2819 *static_cast<int**>(attr_value) = &last_used_code;
2823 *static_cast<int**>(attr_value) = &tag_ub;
2825 case MPI_WTIME_IS_GLOBAL:
2827 *static_cast<int**>(attr_value) = &one;
2830 return comm->attr_get(keyval, attr_value, flag);
2834 int PMPI_Attr_put(MPI_Comm comm, int keyval, void* attr_value) {
2835 if(keyval == MPI_TAG_UB||keyval == MPI_HOST||keyval == MPI_IO ||keyval == MPI_WTIME_IS_GLOBAL||keyval == MPI_APPNUM
2836 ||keyval == MPI_UNIVERSE_SIZE||keyval == MPI_LASTUSEDCODE)
2838 else if (comm==MPI_COMM_NULL)
2839 return MPI_ERR_COMM;
2841 return comm->attr_put(keyval, attr_value);
2844 int PMPI_Comm_get_attr (MPI_Comm comm, int comm_keyval, void *attribute_val, int *flag)
2846 return PMPI_Attr_get(comm, comm_keyval, attribute_val,flag);
2849 int PMPI_Comm_set_attr (MPI_Comm comm, int comm_keyval, void *attribute_val)
2851 return PMPI_Attr_put(comm, comm_keyval, attribute_val);
2854 int PMPI_Comm_delete_attr (MPI_Comm comm, int comm_keyval)
2856 return PMPI_Attr_delete(comm, comm_keyval);
2859 int PMPI_Comm_create_keyval(MPI_Comm_copy_attr_function* copy_fn, MPI_Comm_delete_attr_function* delete_fn, int* keyval,
2862 return PMPI_Keyval_create(copy_fn, delete_fn, keyval, extra_state);
2865 int PMPI_Comm_free_keyval(int* keyval) {
2866 return PMPI_Keyval_free(keyval);
2869 int PMPI_Type_get_attr (MPI_Datatype type, int type_keyval, void *attribute_val, int* flag)
2871 if (type==MPI_DATATYPE_NULL)
2872 return MPI_ERR_TYPE;
2874 return type->attr_get(type_keyval, attribute_val, flag);
2877 int PMPI_Type_set_attr (MPI_Datatype type, int type_keyval, void *attribute_val)
2879 if (type==MPI_DATATYPE_NULL)
2880 return MPI_ERR_TYPE;
2882 return type->attr_put(type_keyval, attribute_val);
2885 int PMPI_Type_delete_attr (MPI_Datatype type, int type_keyval)
2887 if (type==MPI_DATATYPE_NULL)
2888 return MPI_ERR_TYPE;
2890 return type->attr_delete(type_keyval);
2893 int PMPI_Type_create_keyval(MPI_Type_copy_attr_function* copy_fn, MPI_Type_delete_attr_function* delete_fn, int* keyval,
2896 return Datatype::keyval_create(copy_fn, delete_fn, keyval, extra_state);
2899 int PMPI_Type_free_keyval(int* keyval) {
2900 return Datatype::keyval_free(keyval);
2903 int PMPI_Info_create( MPI_Info *info){
2904 if (info == nullptr)
2910 int PMPI_Info_set( MPI_Info info, char *key, char *value){
2911 if (info == nullptr || key == nullptr || value == nullptr)
2913 info->set(key, value);
2917 int PMPI_Info_free( MPI_Info *info){
2918 if (info == nullptr || *info==nullptr)
2921 *info=MPI_INFO_NULL;
2925 int PMPI_Info_get(MPI_Info info,char *key,int valuelen, char *value, int *flag){
2927 if (info == nullptr || key == nullptr || valuelen <0)
2929 if (value == nullptr)
2930 return MPI_ERR_INFO_VALUE;
2931 return info->get(key, valuelen, value, flag);
2934 int PMPI_Info_dup(MPI_Info info, MPI_Info *newinfo){
2935 if (info == nullptr || newinfo==nullptr)
2937 *newinfo = new Info(info);
2941 int PMPI_Info_delete(MPI_Info info, char *key){
2942 if (info == nullptr || key==nullptr)
2944 return info->remove(key);
2947 int PMPI_Info_get_nkeys( MPI_Info info, int *nkeys){
2948 if (info == nullptr || nkeys==nullptr)
2950 return info->get_nkeys(nkeys);
2953 int PMPI_Info_get_nthkey( MPI_Info info, int n, char *key){
2954 if (info == nullptr || key==nullptr || n<0 || n> MPI_MAX_INFO_KEY)
2956 return info->get_nthkey(n, key);
2959 int PMPI_Info_get_valuelen( MPI_Info info, char *key, int *valuelen, int *flag){
2961 if (info == nullptr || key == nullptr || valuelen==nullptr)
2963 return info->get_valuelen(key, valuelen, flag);
2966 int PMPI_Unpack(void* inbuf, int incount, int* position, void* outbuf, int outcount, MPI_Datatype type, MPI_Comm comm) {
2967 if(incount<0 || outcount < 0 || inbuf==nullptr || outbuf==nullptr)
2969 if(!type->is_valid())
2970 return MPI_ERR_TYPE;
2971 if(comm==MPI_COMM_NULL)
2972 return MPI_ERR_COMM;
2973 return type->unpack(inbuf, incount, position, outbuf,outcount, comm);
2976 int PMPI_Pack(void* inbuf, int incount, MPI_Datatype type, void* outbuf, int outcount, int* position, MPI_Comm comm) {
2977 if(incount<0 || outcount < 0|| inbuf==nullptr || outbuf==nullptr)
2979 if(!type->is_valid())
2980 return MPI_ERR_TYPE;
2981 if(comm==MPI_COMM_NULL)
2982 return MPI_ERR_COMM;
2983 return type->pack(inbuf, incount, outbuf,outcount,position, comm);
2986 int PMPI_Pack_size(int incount, MPI_Datatype datatype, MPI_Comm comm, int* size) {
2989 if(!datatype->is_valid())
2990 return MPI_ERR_TYPE;
2991 if(comm==MPI_COMM_NULL)
2992 return MPI_ERR_COMM;
2994 *size=incount*datatype->size();