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 Colls::bcast(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 Colls::barrier(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 Colls::gather(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 retval = Colls::gatherv(sendtmpbuf, sendtmpcount, sendtmptype, recvbuf, recvcounts, displs, recvtype, root, comm);
1525 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1532 int PMPI_Allgather(void *sendbuf, int sendcount, MPI_Datatype sendtype,
1533 void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm)
1539 if (comm == MPI_COMM_NULL) {
1540 retval = MPI_ERR_COMM;
1541 } else if ((( sendbuf != MPI_IN_PLACE) && (sendtype == MPI_DATATYPE_NULL)) ||
1542 (recvtype == MPI_DATATYPE_NULL)){
1543 retval = MPI_ERR_TYPE;
1544 } else if ((( sendbuf != MPI_IN_PLACE) && (sendcount <0)) ||
1546 retval = MPI_ERR_COUNT;
1548 if(sendbuf == MPI_IN_PLACE) {
1549 sendbuf=static_cast<char*>(recvbuf)+recvtype->get_extent()*recvcount*comm->rank();
1550 sendcount=recvcount;
1553 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1554 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1555 extra->type = TRACING_ALLGATHER;
1557 extra->datatype1 = encode_datatype(sendtype, &known);
1558 int dt_size_send = 1;
1560 dt_size_send = sendtype->size();
1561 extra->send_size = sendcount * dt_size_send;
1562 extra->datatype2 = encode_datatype(recvtype, &known);
1563 int dt_size_recv = 1;
1565 dt_size_recv = recvtype->size();
1566 extra->recv_size = recvcount * dt_size_recv;
1568 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1570 Colls::allgather(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm);
1571 retval = MPI_SUCCESS;
1572 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1578 int PMPI_Allgatherv(void *sendbuf, int sendcount, MPI_Datatype sendtype,
1579 void *recvbuf, int *recvcounts, int *displs, MPI_Datatype recvtype, MPI_Comm comm)
1585 if (comm == MPI_COMM_NULL) {
1586 retval = MPI_ERR_COMM;
1587 } else if (((sendbuf != MPI_IN_PLACE) && (sendtype == MPI_DATATYPE_NULL)) || (recvtype == MPI_DATATYPE_NULL)) {
1588 retval = MPI_ERR_TYPE;
1589 } else if (( sendbuf != MPI_IN_PLACE) && (sendcount <0)){
1590 retval = MPI_ERR_COUNT;
1591 } else if (recvcounts == nullptr || displs == nullptr) {
1592 retval = MPI_ERR_ARG;
1595 if(sendbuf == MPI_IN_PLACE) {
1596 sendbuf=static_cast<char*>(recvbuf)+recvtype->get_extent()*displs[comm->rank()];
1597 sendcount=recvcounts[comm->rank()];
1600 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1602 int size = comm->size();
1603 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1604 extra->type = TRACING_ALLGATHERV;
1605 extra->num_processes = size;
1607 extra->datatype1 = encode_datatype(sendtype, &known);
1608 int dt_size_send = 1;
1610 dt_size_send = sendtype->size();
1611 extra->send_size = sendcount * dt_size_send;
1612 extra->datatype2 = encode_datatype(recvtype, &known);
1613 int dt_size_recv = 1;
1615 dt_size_recv = recvtype->size();
1616 extra->recvcounts = xbt_new(int, size);
1617 for (i = 0; i < size; i++) // copy data to avoid bad free
1618 extra->recvcounts[i] = recvcounts[i] * dt_size_recv;
1620 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1622 Colls::allgatherv(sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, comm);
1623 retval = MPI_SUCCESS;
1624 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1631 int PMPI_Scatter(void *sendbuf, int sendcount, MPI_Datatype sendtype,
1632 void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm)
1638 if (comm == MPI_COMM_NULL) {
1639 retval = MPI_ERR_COMM;
1640 } else if (((comm->rank() == root) && (!sendtype->is_valid())) ||
1641 ((recvbuf != MPI_IN_PLACE) && (!recvtype->is_valid()))) {
1642 retval = MPI_ERR_TYPE;
1643 } else if ((sendbuf == recvbuf) ||
1644 ((comm->rank()==root) && sendcount>0 && (sendbuf == nullptr))){
1645 retval = MPI_ERR_BUFFER;
1648 if (recvbuf == MPI_IN_PLACE) {
1649 recvtype = sendtype;
1650 recvcount = sendcount;
1652 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1653 int root_traced = comm->group()->index(root);
1654 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1655 extra->type = TRACING_SCATTER;
1656 extra->root = root_traced;
1658 extra->datatype1 = encode_datatype(sendtype, &known);
1659 int dt_size_send = 1;
1660 if ((comm->rank() == root) && known == 0)
1661 dt_size_send = sendtype->size();
1662 extra->send_size = sendcount * dt_size_send;
1663 extra->datatype2 = encode_datatype(recvtype, &known);
1664 int dt_size_recv = 1;
1666 dt_size_recv = recvtype->size();
1667 extra->recv_size = recvcount * dt_size_recv;
1668 TRACE_smpi_collective_in(rank, root_traced, __FUNCTION__, extra);
1670 Colls::scatter(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm);
1671 retval = MPI_SUCCESS;
1672 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1679 int PMPI_Scatterv(void *sendbuf, int *sendcounts, int *displs,
1680 MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm)
1686 if (comm == MPI_COMM_NULL) {
1687 retval = MPI_ERR_COMM;
1688 } else if (sendcounts == nullptr || displs == nullptr) {
1689 retval = MPI_ERR_ARG;
1690 } else if (((comm->rank() == root) && (sendtype == MPI_DATATYPE_NULL)) ||
1691 ((recvbuf != MPI_IN_PLACE) && (recvtype == MPI_DATATYPE_NULL))) {
1692 retval = MPI_ERR_TYPE;
1694 if (recvbuf == MPI_IN_PLACE) {
1695 recvtype = sendtype;
1696 recvcount = sendcounts[comm->rank()];
1698 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1699 int root_traced = comm->group()->index(root);
1701 int size = comm->size();
1702 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1703 extra->type = TRACING_SCATTERV;
1704 extra->num_processes = size;
1705 extra->root = root_traced;
1707 extra->datatype1 = encode_datatype(sendtype, &known);
1708 int dt_size_send = 1;
1710 dt_size_send = sendtype->size();
1711 if ((comm->rank() == root)) {
1712 extra->sendcounts = xbt_new(int, size);
1713 for (i = 0; i < size; i++) // copy data to avoid bad free
1714 extra->sendcounts[i] = sendcounts[i] * dt_size_send;
1716 extra->datatype2 = encode_datatype(recvtype, &known);
1717 int dt_size_recv = 1;
1719 dt_size_recv = recvtype->size();
1720 extra->recv_size = recvcount * dt_size_recv;
1721 TRACE_smpi_collective_in(rank, root_traced, __FUNCTION__, extra);
1723 retval = Colls::scatterv(sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount, recvtype, root, comm);
1725 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1732 int PMPI_Reduce(void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm)
1738 if (comm == MPI_COMM_NULL) {
1739 retval = MPI_ERR_COMM;
1740 } else if (!datatype->is_valid() || op == MPI_OP_NULL) {
1741 retval = MPI_ERR_ARG;
1743 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1744 int root_traced = comm->group()->index(root);
1745 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1746 extra->type = TRACING_REDUCE;
1748 extra->datatype1 = encode_datatype(datatype, &known);
1749 int dt_size_send = 1;
1751 dt_size_send = datatype->size();
1752 extra->send_size = count * dt_size_send;
1753 extra->root = root_traced;
1755 TRACE_smpi_collective_in(rank, root_traced, __FUNCTION__, extra);
1757 Colls::reduce(sendbuf, recvbuf, count, datatype, op, root, comm);
1759 retval = MPI_SUCCESS;
1760 TRACE_smpi_collective_out(rank, root_traced, __FUNCTION__);
1767 int PMPI_Reduce_local(void *inbuf, void *inoutbuf, int count, MPI_Datatype datatype, MPI_Op op){
1771 if (!datatype->is_valid() || op == MPI_OP_NULL) {
1772 retval = MPI_ERR_ARG;
1774 op->apply(inbuf, inoutbuf, &count, datatype);
1775 retval = MPI_SUCCESS;
1781 int PMPI_Allreduce(void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
1787 if (comm == MPI_COMM_NULL) {
1788 retval = MPI_ERR_COMM;
1789 } else if (!datatype->is_valid()) {
1790 retval = MPI_ERR_TYPE;
1791 } else if (op == MPI_OP_NULL) {
1792 retval = MPI_ERR_OP;
1795 char* sendtmpbuf = static_cast<char*>(sendbuf);
1796 if( sendbuf == MPI_IN_PLACE ) {
1797 sendtmpbuf = static_cast<char*>(xbt_malloc(count*datatype->get_extent()));
1798 Datatype::copy(recvbuf, count, datatype,sendtmpbuf, count, datatype);
1800 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1801 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1802 extra->type = TRACING_ALLREDUCE;
1804 extra->datatype1 = encode_datatype(datatype, &known);
1805 int dt_size_send = 1;
1807 dt_size_send = datatype->size();
1808 extra->send_size = count * dt_size_send;
1810 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1812 Colls::allreduce(sendtmpbuf, recvbuf, count, datatype, op, comm);
1814 if( sendbuf == MPI_IN_PLACE )
1815 xbt_free(sendtmpbuf);
1817 retval = MPI_SUCCESS;
1818 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1825 int PMPI_Scan(void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
1831 if (comm == MPI_COMM_NULL) {
1832 retval = MPI_ERR_COMM;
1833 } else if (!datatype->is_valid()) {
1834 retval = MPI_ERR_TYPE;
1835 } else if (op == MPI_OP_NULL) {
1836 retval = MPI_ERR_OP;
1838 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1839 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1840 extra->type = TRACING_SCAN;
1842 extra->datatype1 = encode_datatype(datatype, &known);
1843 int dt_size_send = 1;
1845 dt_size_send = datatype->size();
1846 extra->send_size = count * dt_size_send;
1848 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1850 retval = Colls::scan(sendbuf, recvbuf, count, datatype, op, comm);
1852 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1859 int PMPI_Exscan(void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm){
1864 if (comm == MPI_COMM_NULL) {
1865 retval = MPI_ERR_COMM;
1866 } else if (!datatype->is_valid()) {
1867 retval = MPI_ERR_TYPE;
1868 } else if (op == MPI_OP_NULL) {
1869 retval = MPI_ERR_OP;
1871 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1872 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1873 extra->type = TRACING_EXSCAN;
1875 extra->datatype1 = encode_datatype(datatype, &known);
1876 int dt_size_send = 1;
1878 dt_size_send = datatype->size();
1879 extra->send_size = count * dt_size_send;
1880 void* sendtmpbuf = sendbuf;
1881 if (sendbuf == MPI_IN_PLACE) {
1882 sendtmpbuf = static_cast<void*>(xbt_malloc(count * datatype->size()));
1883 memcpy(sendtmpbuf, recvbuf, count * datatype->size());
1885 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1887 retval = Colls::exscan(sendtmpbuf, recvbuf, count, datatype, op, comm);
1889 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1890 if (sendbuf == MPI_IN_PLACE)
1891 xbt_free(sendtmpbuf);
1898 int PMPI_Reduce_scatter(void *sendbuf, void *recvbuf, int *recvcounts, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
1903 if (comm == MPI_COMM_NULL) {
1904 retval = MPI_ERR_COMM;
1905 } else if (!datatype->is_valid()) {
1906 retval = MPI_ERR_TYPE;
1907 } else if (op == MPI_OP_NULL) {
1908 retval = MPI_ERR_OP;
1909 } else if (recvcounts == nullptr) {
1910 retval = MPI_ERR_ARG;
1912 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1914 int size = comm->size();
1915 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1916 extra->type = TRACING_REDUCE_SCATTER;
1917 extra->num_processes = size;
1919 extra->datatype1 = encode_datatype(datatype, &known);
1920 int dt_size_send = 1;
1922 dt_size_send = datatype->size();
1923 extra->send_size = 0;
1924 extra->recvcounts = xbt_new(int, size);
1926 for (i = 0; i < size; i++) { // copy data to avoid bad free
1927 extra->recvcounts[i] = recvcounts[i] * dt_size_send;
1928 totalcount += recvcounts[i];
1930 void* sendtmpbuf = sendbuf;
1931 if (sendbuf == MPI_IN_PLACE) {
1932 sendtmpbuf = static_cast<void*>(xbt_malloc(totalcount * datatype->size()));
1933 memcpy(sendtmpbuf, recvbuf, totalcount * datatype->size());
1936 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1938 Colls::reduce_scatter(sendtmpbuf, recvbuf, recvcounts, datatype, op, comm);
1939 retval = MPI_SUCCESS;
1940 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1942 if (sendbuf == MPI_IN_PLACE)
1943 xbt_free(sendtmpbuf);
1950 int PMPI_Reduce_scatter_block(void *sendbuf, void *recvbuf, int recvcount,
1951 MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
1956 if (comm == MPI_COMM_NULL) {
1957 retval = MPI_ERR_COMM;
1958 } else if (!datatype->is_valid()) {
1959 retval = MPI_ERR_TYPE;
1960 } else if (op == MPI_OP_NULL) {
1961 retval = MPI_ERR_OP;
1962 } else if (recvcount < 0) {
1963 retval = MPI_ERR_ARG;
1965 int count = comm->size();
1967 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
1968 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
1969 extra->type = TRACING_REDUCE_SCATTER;
1970 extra->num_processes = count;
1972 extra->datatype1 = encode_datatype(datatype, &known);
1973 int dt_size_send = 1;
1975 dt_size_send = datatype->size();
1976 extra->send_size = 0;
1977 extra->recvcounts = xbt_new(int, count);
1978 for (int i = 0; i < count; i++) // copy data to avoid bad free
1979 extra->recvcounts[i] = recvcount * dt_size_send;
1980 void* sendtmpbuf = sendbuf;
1981 if (sendbuf == MPI_IN_PLACE) {
1982 sendtmpbuf = static_cast<void*>(xbt_malloc(recvcount * count * datatype->size()));
1983 memcpy(sendtmpbuf, recvbuf, recvcount * count * datatype->size());
1986 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
1988 int* recvcounts = static_cast<int*>(xbt_malloc(count * sizeof(int)));
1989 for (int i = 0; i < count; i++)
1990 recvcounts[i] = recvcount;
1991 Colls::reduce_scatter(sendtmpbuf, recvbuf, recvcounts, datatype, op, comm);
1992 xbt_free(recvcounts);
1993 retval = MPI_SUCCESS;
1995 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
1997 if (sendbuf == MPI_IN_PLACE)
1998 xbt_free(sendtmpbuf);
2005 int PMPI_Alltoall(void* sendbuf, int sendcount, MPI_Datatype sendtype, void* recvbuf, int recvcount,
2006 MPI_Datatype recvtype, MPI_Comm comm)
2011 if (comm == MPI_COMM_NULL) {
2012 retval = MPI_ERR_COMM;
2013 } else if ((sendbuf != MPI_IN_PLACE && sendtype == MPI_DATATYPE_NULL) || recvtype == MPI_DATATYPE_NULL) {
2014 retval = MPI_ERR_TYPE;
2016 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
2017 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
2018 extra->type = TRACING_ALLTOALL;
2020 void* sendtmpbuf = static_cast<char*>(sendbuf);
2021 int sendtmpcount = sendcount;
2022 MPI_Datatype sendtmptype = sendtype;
2023 if (sendbuf == MPI_IN_PLACE) {
2024 sendtmpbuf = static_cast<void*>(xbt_malloc(recvcount * comm->size() * recvtype->size()));
2025 memcpy(sendtmpbuf, recvbuf, recvcount * comm->size() * recvtype->size());
2026 sendtmpcount = recvcount;
2027 sendtmptype = recvtype;
2031 extra->datatype1 = encode_datatype(sendtmptype, &known);
2033 extra->send_size = sendtmpcount * sendtmptype->size();
2035 extra->send_size = sendtmpcount;
2036 extra->datatype2 = encode_datatype(recvtype, &known);
2038 extra->recv_size = recvcount * recvtype->size();
2040 extra->recv_size = recvcount;
2042 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
2044 retval = Colls::alltoall(sendtmpbuf, sendtmpcount, sendtmptype, recvbuf, recvcount, recvtype, comm);
2046 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2048 if (sendbuf == MPI_IN_PLACE)
2049 xbt_free(sendtmpbuf);
2056 int PMPI_Alltoallv(void* sendbuf, int* sendcounts, int* senddisps, MPI_Datatype sendtype, void* recvbuf,
2057 int* recvcounts, int* recvdisps, MPI_Datatype recvtype, MPI_Comm comm)
2063 if (comm == MPI_COMM_NULL) {
2064 retval = MPI_ERR_COMM;
2065 } else if (sendtype == MPI_DATATYPE_NULL || recvtype == MPI_DATATYPE_NULL) {
2066 retval = MPI_ERR_TYPE;
2067 } else if ((sendbuf != MPI_IN_PLACE && (sendcounts == nullptr || senddisps == nullptr)) || recvcounts == nullptr ||
2068 recvdisps == nullptr) {
2069 retval = MPI_ERR_ARG;
2071 int rank = comm != MPI_COMM_NULL ? smpi_process_index() : -1;
2073 int size = comm->size();
2074 instr_extra_data extra = xbt_new0(s_instr_extra_data_t, 1);
2075 extra->type = TRACING_ALLTOALLV;
2076 extra->send_size = 0;
2077 extra->recv_size = 0;
2078 extra->recvcounts = xbt_new(int, size);
2079 extra->sendcounts = xbt_new(int, size);
2081 int dt_size_recv = 1;
2082 extra->datatype2 = encode_datatype(recvtype, &known);
2083 dt_size_recv = recvtype->size();
2085 void* sendtmpbuf = static_cast<char*>(sendbuf);
2086 int* sendtmpcounts = sendcounts;
2087 int* sendtmpdisps = senddisps;
2088 MPI_Datatype sendtmptype = sendtype;
2090 for (i = 0; i < size; i++) { // copy data to avoid bad free
2091 extra->recv_size += recvcounts[i] * dt_size_recv;
2092 extra->recvcounts[i] = recvcounts[i] * dt_size_recv;
2093 if (((recvdisps[i] + recvcounts[i]) * dt_size_recv) > maxsize)
2094 maxsize = (recvdisps[i] + recvcounts[i]) * dt_size_recv;
2097 if (sendbuf == MPI_IN_PLACE) {
2098 sendtmpbuf = static_cast<void*>(xbt_malloc(maxsize));
2099 memcpy(sendtmpbuf, recvbuf, maxsize);
2100 sendtmpcounts = static_cast<int*>(xbt_malloc(size * sizeof(int)));
2101 memcpy(sendtmpcounts, recvcounts, size * sizeof(int));
2102 sendtmpdisps = static_cast<int*>(xbt_malloc(size * sizeof(int)));
2103 memcpy(sendtmpdisps, recvdisps, size * sizeof(int));
2104 sendtmptype = recvtype;
2107 extra->datatype1 = encode_datatype(sendtmptype, &known);
2108 int dt_size_send = 1;
2109 dt_size_send = sendtmptype->size();
2111 for (i = 0; i < size; i++) { // copy data to avoid bad free
2112 extra->send_size += sendtmpcounts[i] * dt_size_send;
2113 extra->sendcounts[i] = sendtmpcounts[i] * dt_size_send;
2115 extra->num_processes = size;
2116 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, extra);
2117 retval = Colls::alltoallv(sendtmpbuf, sendtmpcounts, sendtmpdisps, sendtmptype, recvbuf, recvcounts,
2118 recvdisps, recvtype, comm);
2119 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2121 if (sendbuf == MPI_IN_PLACE) {
2122 xbt_free(sendtmpbuf);
2123 xbt_free(sendtmpcounts);
2124 xbt_free(sendtmpdisps);
2133 int PMPI_Get_processor_name(char *name, int *resultlen)
2135 strncpy(name, SIMIX_host_self()->cname(), strlen(SIMIX_host_self()->cname()) < MPI_MAX_PROCESSOR_NAME - 1
2136 ? strlen(SIMIX_host_self()->cname()) + 1
2137 : MPI_MAX_PROCESSOR_NAME - 1);
2138 *resultlen = strlen(name) > MPI_MAX_PROCESSOR_NAME ? MPI_MAX_PROCESSOR_NAME : strlen(name);
2143 int PMPI_Get_count(MPI_Status * status, MPI_Datatype datatype, int *count)
2145 if (status == nullptr || count == nullptr) {
2147 } else if (!datatype->is_valid()) {
2148 return MPI_ERR_TYPE;
2150 size_t size = datatype->size();
2154 } else if (status->count % size != 0) {
2155 return MPI_UNDEFINED;
2157 *count = smpi_mpi_get_count(status, datatype);
2163 int PMPI_Type_contiguous(int count, MPI_Datatype old_type, MPI_Datatype* new_type) {
2164 if (old_type == MPI_DATATYPE_NULL) {
2165 return MPI_ERR_TYPE;
2166 } else if (count<0){
2167 return MPI_ERR_COUNT;
2169 return Datatype::create_contiguous(count, old_type, 0, new_type);
2173 int PMPI_Type_commit(MPI_Datatype* datatype) {
2174 if (datatype == nullptr || *datatype == MPI_DATATYPE_NULL) {
2175 return MPI_ERR_TYPE;
2177 (*datatype)->commit();
2182 int PMPI_Type_vector(int count, int blocklen, int stride, MPI_Datatype old_type, MPI_Datatype* new_type) {
2183 if (old_type == MPI_DATATYPE_NULL) {
2184 return MPI_ERR_TYPE;
2185 } else if (count<0 || blocklen<0){
2186 return MPI_ERR_COUNT;
2188 return Datatype::create_vector(count, blocklen, stride, old_type, new_type);
2192 int PMPI_Type_hvector(int count, int blocklen, MPI_Aint stride, MPI_Datatype old_type, MPI_Datatype* new_type) {
2193 if (old_type == MPI_DATATYPE_NULL) {
2194 return MPI_ERR_TYPE;
2195 } else if (count<0 || blocklen<0){
2196 return MPI_ERR_COUNT;
2198 return Datatype::create_hvector(count, blocklen, stride, old_type, new_type);
2202 int PMPI_Type_create_hvector(int count, int blocklen, MPI_Aint stride, MPI_Datatype old_type, MPI_Datatype* new_type) {
2203 return MPI_Type_hvector(count, blocklen, stride, old_type, new_type);
2206 int PMPI_Type_indexed(int count, int* blocklens, int* indices, MPI_Datatype old_type, MPI_Datatype* new_type) {
2207 if (old_type == MPI_DATATYPE_NULL) {
2208 return MPI_ERR_TYPE;
2209 } else if (count<0){
2210 return MPI_ERR_COUNT;
2212 return Datatype::create_indexed(count, blocklens, indices, old_type, new_type);
2216 int PMPI_Type_create_indexed(int count, int* blocklens, int* indices, MPI_Datatype old_type, MPI_Datatype* new_type) {
2217 if (old_type == MPI_DATATYPE_NULL) {
2218 return MPI_ERR_TYPE;
2219 } else if (count<0){
2220 return MPI_ERR_COUNT;
2222 return Datatype::create_indexed(count, blocklens, indices, old_type, new_type);
2226 int PMPI_Type_create_indexed_block(int count, int blocklength, int* indices, MPI_Datatype old_type,
2227 MPI_Datatype* new_type)
2229 if (old_type == MPI_DATATYPE_NULL) {
2230 return MPI_ERR_TYPE;
2231 } else if (count<0){
2232 return MPI_ERR_COUNT;
2234 int* blocklens=static_cast<int*>(xbt_malloc(blocklength*count*sizeof(int)));
2235 for (int i = 0; i < count; i++)
2236 blocklens[i]=blocklength;
2237 int retval = Datatype::create_indexed(count, blocklens, indices, old_type, new_type);
2238 xbt_free(blocklens);
2243 int PMPI_Type_hindexed(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype old_type, MPI_Datatype* new_type)
2245 if (old_type == MPI_DATATYPE_NULL) {
2246 return MPI_ERR_TYPE;
2247 } else if (count<0){
2248 return MPI_ERR_COUNT;
2250 return Datatype::create_hindexed(count, blocklens, indices, old_type, new_type);
2254 int PMPI_Type_create_hindexed(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype old_type,
2255 MPI_Datatype* new_type) {
2256 return PMPI_Type_hindexed(count, blocklens,indices,old_type,new_type);
2259 int PMPI_Type_create_hindexed_block(int count, int blocklength, MPI_Aint* indices, MPI_Datatype old_type,
2260 MPI_Datatype* new_type) {
2261 if (old_type == MPI_DATATYPE_NULL) {
2262 return MPI_ERR_TYPE;
2263 } else if (count<0){
2264 return MPI_ERR_COUNT;
2266 int* blocklens=(int*)xbt_malloc(blocklength*count*sizeof(int));
2267 for (int i = 0; i < count; i++)
2268 blocklens[i] = blocklength;
2269 int retval = Datatype::create_hindexed(count, blocklens, indices, old_type, new_type);
2270 xbt_free(blocklens);
2275 int PMPI_Type_struct(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype* old_types, MPI_Datatype* new_type) {
2277 return MPI_ERR_COUNT;
2279 return Datatype::create_struct(count, blocklens, indices, old_types, new_type);
2283 int PMPI_Type_create_struct(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype* old_types,
2284 MPI_Datatype* new_type) {
2285 return PMPI_Type_struct(count, blocklens, indices, old_types, new_type);
2288 int PMPI_Error_class(int errorcode, int* errorclass) {
2289 // assume smpi uses only standard mpi error codes
2290 *errorclass=errorcode;
2294 int PMPI_Initialized(int* flag) {
2295 *flag=smpi_process_initialized();
2299 /* The topo part of MPI_COMM_WORLD should always be nullptr. When other topologies will be implemented, not only should we
2300 * check if the topology is nullptr, but we should check if it is the good topology type (so we have to add a
2301 * MPIR_Topo_Type field, and replace the MPI_Topology field by an union)*/
2303 int PMPI_Cart_create(MPI_Comm comm_old, int ndims, int* dims, int* periodic, int reorder, MPI_Comm* comm_cart) {
2304 if (comm_old == MPI_COMM_NULL){
2305 return MPI_ERR_COMM;
2306 } else if (ndims < 0 || (ndims > 0 && (dims == nullptr || periodic == nullptr)) || comm_cart == nullptr) {
2309 new Topo_Cart(comm_old, ndims, dims, periodic, reorder, comm_cart);
2314 int PMPI_Cart_rank(MPI_Comm comm, int* coords, int* rank) {
2315 if(comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2316 return MPI_ERR_TOPOLOGY;
2318 if (coords == nullptr) {
2321 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2322 if (topo==nullptr) {
2325 return topo->rank(coords, rank);
2328 int PMPI_Cart_shift(MPI_Comm comm, int direction, int displ, int* source, int* dest) {
2329 if(comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2330 return MPI_ERR_TOPOLOGY;
2332 if (source == nullptr || dest == nullptr || direction < 0 ) {
2335 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2336 if (topo==nullptr) {
2339 return topo->shift(direction, displ, source, dest);
2342 int PMPI_Cart_coords(MPI_Comm comm, int rank, int maxdims, int* coords) {
2343 if(comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2344 return MPI_ERR_TOPOLOGY;
2346 if (rank < 0 || rank >= comm->size()) {
2347 return MPI_ERR_RANK;
2352 if(coords == nullptr) {
2355 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2356 if (topo==nullptr) {
2359 return topo->coords(rank, maxdims, coords);
2362 int PMPI_Cart_get(MPI_Comm comm, int maxdims, int* dims, int* periods, int* coords) {
2363 if(comm == nullptr || comm->topo() == nullptr) {
2364 return MPI_ERR_TOPOLOGY;
2366 if(maxdims <= 0 || dims == nullptr || periods == nullptr || coords == nullptr) {
2369 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2370 if (topo==nullptr) {
2373 return topo->get(maxdims, dims, periods, coords);
2376 int PMPI_Cartdim_get(MPI_Comm comm, int* ndims) {
2377 if (comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2378 return MPI_ERR_TOPOLOGY;
2380 if (ndims == nullptr) {
2383 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2384 if (topo==nullptr) {
2387 return topo->dim_get(ndims);
2390 int PMPI_Dims_create(int nnodes, int ndims, int* dims) {
2391 if(dims == nullptr) {
2394 if (ndims < 1 || nnodes < 1) {
2395 return MPI_ERR_DIMS;
2397 return Dims_create(nnodes, ndims, dims);
2400 int PMPI_Cart_sub(MPI_Comm comm, int* remain_dims, MPI_Comm* comm_new) {
2401 if(comm == MPI_COMM_NULL || comm->topo() == nullptr) {
2402 return MPI_ERR_TOPOLOGY;
2404 if (comm_new == nullptr) {
2407 MPIR_Cart_Topology topo = static_cast<MPIR_Cart_Topology>(comm->topo());
2408 if (topo==nullptr) {
2411 MPIR_Cart_Topology cart = topo->sub(remain_dims, comm_new);
2417 int PMPI_Type_create_resized(MPI_Datatype oldtype,MPI_Aint lb, MPI_Aint extent, MPI_Datatype *newtype){
2418 if (oldtype == MPI_DATATYPE_NULL) {
2419 return MPI_ERR_TYPE;
2421 int blocks[3] = {1, 1, 1};
2422 MPI_Aint disps[3] = {lb, 0, lb + extent};
2423 MPI_Datatype types[3] = {MPI_LB, oldtype, MPI_UB};
2425 *newtype = new Type_Struct(oldtype->size(), lb, lb + extent, DT_FLAG_DERIVED, 3, blocks, disps, types);
2427 (*newtype)->addflag(~DT_FLAG_COMMITED);
2431 int PMPI_Win_create( void *base, MPI_Aint size, int disp_unit, MPI_Info info, MPI_Comm comm, MPI_Win *win){
2434 if (comm == MPI_COMM_NULL) {
2435 retval= MPI_ERR_COMM;
2436 }else if ((base == nullptr && size != 0) || disp_unit <= 0 || size < 0 ){
2437 retval= MPI_ERR_OTHER;
2439 *win = new Win( base, size, disp_unit, info, comm);
2440 retval = MPI_SUCCESS;
2446 int PMPI_Win_free( MPI_Win* win){
2449 if (win == nullptr || *win == MPI_WIN_NULL) {
2450 retval = MPI_ERR_WIN;
2459 int PMPI_Win_set_name(MPI_Win win, char * name)
2461 if (win == MPI_WIN_NULL) {
2462 return MPI_ERR_TYPE;
2463 } else if (name == nullptr) {
2466 win->set_name(name);
2471 int PMPI_Win_get_name(MPI_Win win, char * name, int* len)
2473 if (win == MPI_WIN_NULL) {
2475 } else if (name == nullptr) {
2478 win->get_name(name, len);
2483 int PMPI_Win_get_group(MPI_Win win, MPI_Group * group){
2484 if (win == MPI_WIN_NULL) {
2487 win->get_group(group);
2493 int PMPI_Win_fence( int assert, MPI_Win win){
2496 if (win == MPI_WIN_NULL) {
2497 retval = MPI_ERR_WIN;
2499 int rank = smpi_process_index();
2500 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2501 retval = win->fence(assert);
2502 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2508 int PMPI_Get( void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank,
2509 MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Win win){
2512 if (win == MPI_WIN_NULL) {
2513 retval = MPI_ERR_WIN;
2514 } else if (target_rank == MPI_PROC_NULL) {
2515 retval = MPI_SUCCESS;
2516 } else if (target_rank <0){
2517 retval = MPI_ERR_RANK;
2518 } else if (target_disp <0){
2519 retval = MPI_ERR_ARG;
2520 } else if ((origin_count < 0 || target_count < 0) ||
2521 (origin_addr==nullptr && origin_count > 0)){
2522 retval = MPI_ERR_COUNT;
2523 } else if ((!origin_datatype->is_valid()) || (!target_datatype->is_valid())) {
2524 retval = MPI_ERR_TYPE;
2526 int rank = smpi_process_index();
2528 win->get_group(&group);
2529 int src_traced = group->index(target_rank);
2530 TRACE_smpi_ptp_in(rank, src_traced, rank, __FUNCTION__, nullptr);
2532 retval = win->get( origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count,
2535 TRACE_smpi_ptp_out(rank, src_traced, rank, __FUNCTION__);
2541 int PMPI_Put( void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank,
2542 MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Win win){
2545 if (win == MPI_WIN_NULL) {
2546 retval = MPI_ERR_WIN;
2547 } else if (target_rank == MPI_PROC_NULL) {
2548 retval = MPI_SUCCESS;
2549 } else if (target_rank <0){
2550 retval = MPI_ERR_RANK;
2551 } else if (target_disp <0){
2552 retval = MPI_ERR_ARG;
2553 } else if ((origin_count < 0 || target_count < 0) ||
2554 (origin_addr==nullptr && origin_count > 0)){
2555 retval = MPI_ERR_COUNT;
2556 } else if ((!origin_datatype->is_valid()) || (!target_datatype->is_valid())) {
2557 retval = MPI_ERR_TYPE;
2559 int rank = smpi_process_index();
2561 win->get_group(&group);
2562 int dst_traced = group->index(target_rank);
2563 TRACE_smpi_ptp_in(rank, rank, dst_traced, __FUNCTION__, nullptr);
2564 TRACE_smpi_send(rank, rank, dst_traced, SMPI_RMA_TAG, origin_count*origin_datatype->size());
2566 retval = win->put( origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count,
2569 TRACE_smpi_ptp_out(rank, rank, dst_traced, __FUNCTION__);
2575 int PMPI_Accumulate( void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank,
2576 MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Op op, MPI_Win win){
2579 if (win == MPI_WIN_NULL) {
2580 retval = MPI_ERR_WIN;
2581 } else if (target_rank == MPI_PROC_NULL) {
2582 retval = MPI_SUCCESS;
2583 } else if (target_rank <0){
2584 retval = MPI_ERR_RANK;
2585 } else if (target_disp <0){
2586 retval = MPI_ERR_ARG;
2587 } else if ((origin_count < 0 || target_count < 0) ||
2588 (origin_addr==nullptr && origin_count > 0)){
2589 retval = MPI_ERR_COUNT;
2590 } else if ((!origin_datatype->is_valid()) ||
2591 (!target_datatype->is_valid())) {
2592 retval = MPI_ERR_TYPE;
2593 } else if (op == MPI_OP_NULL) {
2594 retval = MPI_ERR_OP;
2596 int rank = smpi_process_index();
2598 win->get_group(&group);
2599 int src_traced = group->index(target_rank);
2600 TRACE_smpi_ptp_in(rank, src_traced, rank, __FUNCTION__, nullptr);
2602 retval = win->accumulate( origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count,
2603 target_datatype, op);
2605 TRACE_smpi_ptp_out(rank, src_traced, rank, __FUNCTION__);
2611 int PMPI_Win_post(MPI_Group group, int assert, MPI_Win win){
2614 if (win == MPI_WIN_NULL) {
2615 retval = MPI_ERR_WIN;
2616 } else if (group==MPI_GROUP_NULL){
2617 retval = MPI_ERR_GROUP;
2619 int rank = smpi_process_index();
2620 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2621 retval = win->post(group,assert);
2622 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2628 int PMPI_Win_start(MPI_Group group, int assert, MPI_Win win){
2631 if (win == MPI_WIN_NULL) {
2632 retval = MPI_ERR_WIN;
2633 } else if (group==MPI_GROUP_NULL){
2634 retval = MPI_ERR_GROUP;
2636 int rank = smpi_process_index();
2637 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2638 retval = win->start(group,assert);
2639 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2645 int PMPI_Win_complete(MPI_Win win){
2648 if (win == MPI_WIN_NULL) {
2649 retval = MPI_ERR_WIN;
2651 int rank = smpi_process_index();
2652 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2654 retval = win->complete();
2656 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2662 int PMPI_Win_wait(MPI_Win win){
2665 if (win == MPI_WIN_NULL) {
2666 retval = MPI_ERR_WIN;
2668 int rank = smpi_process_index();
2669 TRACE_smpi_collective_in(rank, -1, __FUNCTION__, nullptr);
2671 retval = win->wait();
2673 TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
2679 int PMPI_Alloc_mem(MPI_Aint size, MPI_Info info, void *baseptr){
2680 void *ptr = xbt_malloc(size);
2682 return MPI_ERR_NO_MEM;
2684 *static_cast<void**>(baseptr) = ptr;
2689 int PMPI_Free_mem(void *baseptr){
2694 int PMPI_Type_set_name(MPI_Datatype datatype, char * name)
2696 if (datatype == MPI_DATATYPE_NULL) {
2697 return MPI_ERR_TYPE;
2698 } else if (name == nullptr) {
2701 datatype->set_name(name);
2706 int PMPI_Type_get_name(MPI_Datatype datatype, char * name, int* len)
2708 if (datatype == MPI_DATATYPE_NULL) {
2709 return MPI_ERR_TYPE;
2710 } else if (name == nullptr) {
2713 datatype->get_name(name, len);
2718 MPI_Datatype PMPI_Type_f2c(MPI_Fint datatype){
2719 return static_cast<MPI_Datatype>(F2C::f2c(datatype));
2722 MPI_Fint PMPI_Type_c2f(MPI_Datatype datatype){
2723 return datatype->c2f();
2726 MPI_Group PMPI_Group_f2c(MPI_Fint group){
2727 return Group::f2c(group);
2730 MPI_Fint PMPI_Group_c2f(MPI_Group group){
2731 return group->c2f();
2734 MPI_Request PMPI_Request_f2c(MPI_Fint request){
2735 return static_cast<MPI_Request>(Request::f2c(request));
2738 MPI_Fint PMPI_Request_c2f(MPI_Request request) {
2739 return request->c2f();
2742 MPI_Win PMPI_Win_f2c(MPI_Fint win){
2743 return static_cast<MPI_Win>(Win::f2c(win));
2746 MPI_Fint PMPI_Win_c2f(MPI_Win win){
2750 MPI_Op PMPI_Op_f2c(MPI_Fint op){
2751 return static_cast<MPI_Op>(Op::f2c(op));
2754 MPI_Fint PMPI_Op_c2f(MPI_Op op){
2758 MPI_Comm PMPI_Comm_f2c(MPI_Fint comm){
2759 return static_cast<MPI_Comm>(Comm::f2c(comm));
2762 MPI_Fint PMPI_Comm_c2f(MPI_Comm comm){
2766 MPI_Info PMPI_Info_f2c(MPI_Fint info){
2767 return static_cast<MPI_Info>(Info::f2c(info));
2770 MPI_Fint PMPI_Info_c2f(MPI_Info info){
2774 int PMPI_Keyval_create(MPI_Copy_function* copy_fn, MPI_Delete_function* delete_fn, int* keyval, void* extra_state) {
2775 smpi_copy_fn _copy_fn;
2776 smpi_delete_fn _delete_fn;
2777 _copy_fn.comm_copy_fn = copy_fn;
2778 _delete_fn.comm_delete_fn = delete_fn;
2779 return Keyval::keyval_create<Comm>(_copy_fn, _delete_fn, keyval, extra_state);
2782 int PMPI_Keyval_free(int* keyval) {
2783 return Keyval::keyval_free<Comm>(keyval);
2786 int PMPI_Attr_delete(MPI_Comm comm, int keyval) {
2787 if(keyval == MPI_TAG_UB||keyval == MPI_HOST||keyval == MPI_IO ||keyval == MPI_WTIME_IS_GLOBAL||keyval == MPI_APPNUM
2788 ||keyval == MPI_UNIVERSE_SIZE||keyval == MPI_LASTUSEDCODE)
2790 else if (comm==MPI_COMM_NULL)
2791 return MPI_ERR_COMM;
2793 return comm->attr_delete<Comm>(keyval);
2796 int PMPI_Attr_get(MPI_Comm comm, int keyval, void* attr_value, int* flag) {
2798 static int zero = 0;
2799 static int tag_ub = 1000000;
2800 static int last_used_code = MPI_ERR_LASTCODE;
2802 if (comm==MPI_COMM_NULL){
2804 return MPI_ERR_COMM;
2812 *static_cast<int**>(attr_value) = &zero;
2814 case MPI_UNIVERSE_SIZE:
2816 *static_cast<int**>(attr_value) = &smpi_universe_size;
2818 case MPI_LASTUSEDCODE:
2820 *static_cast<int**>(attr_value) = &last_used_code;
2824 *static_cast<int**>(attr_value) = &tag_ub;
2826 case MPI_WTIME_IS_GLOBAL:
2828 *static_cast<int**>(attr_value) = &one;
2831 return comm->attr_get<Comm>(keyval, attr_value, flag);
2835 int PMPI_Attr_put(MPI_Comm comm, int keyval, void* attr_value) {
2836 if(keyval == MPI_TAG_UB||keyval == MPI_HOST||keyval == MPI_IO ||keyval == MPI_WTIME_IS_GLOBAL||keyval == MPI_APPNUM
2837 ||keyval == MPI_UNIVERSE_SIZE||keyval == MPI_LASTUSEDCODE)
2839 else if (comm==MPI_COMM_NULL)
2840 return MPI_ERR_COMM;
2842 return comm->attr_put<Comm>(keyval, attr_value);
2845 int PMPI_Comm_get_attr (MPI_Comm comm, int comm_keyval, void *attribute_val, int *flag)
2847 return PMPI_Attr_get(comm, comm_keyval, attribute_val,flag);
2850 int PMPI_Comm_set_attr (MPI_Comm comm, int comm_keyval, void *attribute_val)
2852 return PMPI_Attr_put(comm, comm_keyval, attribute_val);
2855 int PMPI_Comm_delete_attr (MPI_Comm comm, int comm_keyval)
2857 return PMPI_Attr_delete(comm, comm_keyval);
2860 int PMPI_Comm_create_keyval(MPI_Comm_copy_attr_function* copy_fn, MPI_Comm_delete_attr_function* delete_fn, int* keyval,
2863 return PMPI_Keyval_create(copy_fn, delete_fn, keyval, extra_state);
2866 int PMPI_Comm_free_keyval(int* keyval) {
2867 return PMPI_Keyval_free(keyval);
2870 int PMPI_Type_get_attr (MPI_Datatype type, int type_keyval, void *attribute_val, int* flag)
2872 if (type==MPI_DATATYPE_NULL)
2873 return MPI_ERR_TYPE;
2875 return type->attr_get<Datatype>(type_keyval, attribute_val, flag);
2878 int PMPI_Type_set_attr (MPI_Datatype type, int type_keyval, void *attribute_val)
2880 if (type==MPI_DATATYPE_NULL)
2881 return MPI_ERR_TYPE;
2883 return type->attr_put<Datatype>(type_keyval, attribute_val);
2886 int PMPI_Type_delete_attr (MPI_Datatype type, int type_keyval)
2888 if (type==MPI_DATATYPE_NULL)
2889 return MPI_ERR_TYPE;
2891 return type->attr_delete<Datatype>(type_keyval);
2894 int PMPI_Type_create_keyval(MPI_Type_copy_attr_function* copy_fn, MPI_Type_delete_attr_function* delete_fn, int* keyval,
2897 smpi_copy_fn _copy_fn;
2898 smpi_delete_fn _delete_fn;
2899 _copy_fn.type_copy_fn = copy_fn;
2900 _delete_fn.type_delete_fn = delete_fn;
2901 return Keyval::keyval_create<Datatype>(_copy_fn, _delete_fn, keyval, extra_state);
2904 int PMPI_Type_free_keyval(int* keyval) {
2905 return Keyval::keyval_free<Datatype>(keyval);
2908 int PMPI_Info_create( MPI_Info *info){
2909 if (info == nullptr)
2915 int PMPI_Info_set( MPI_Info info, char *key, char *value){
2916 if (info == nullptr || key == nullptr || value == nullptr)
2918 info->set(key, value);
2922 int PMPI_Info_free( MPI_Info *info){
2923 if (info == nullptr || *info==nullptr)
2926 *info=MPI_INFO_NULL;
2930 int PMPI_Info_get(MPI_Info info,char *key,int valuelen, char *value, int *flag){
2932 if (info == nullptr || key == nullptr || valuelen <0)
2934 if (value == nullptr)
2935 return MPI_ERR_INFO_VALUE;
2936 return info->get(key, valuelen, value, flag);
2939 int PMPI_Info_dup(MPI_Info info, MPI_Info *newinfo){
2940 if (info == nullptr || newinfo==nullptr)
2942 *newinfo = new Info(info);
2946 int PMPI_Info_delete(MPI_Info info, char *key){
2947 if (info == nullptr || key==nullptr)
2949 return info->remove(key);
2952 int PMPI_Info_get_nkeys( MPI_Info info, int *nkeys){
2953 if (info == nullptr || nkeys==nullptr)
2955 return info->get_nkeys(nkeys);
2958 int PMPI_Info_get_nthkey( MPI_Info info, int n, char *key){
2959 if (info == nullptr || key==nullptr || n<0 || n> MPI_MAX_INFO_KEY)
2961 return info->get_nthkey(n, key);
2964 int PMPI_Info_get_valuelen( MPI_Info info, char *key, int *valuelen, int *flag){
2966 if (info == nullptr || key == nullptr || valuelen==nullptr)
2968 return info->get_valuelen(key, valuelen, flag);
2971 int PMPI_Unpack(void* inbuf, int incount, int* position, void* outbuf, int outcount, MPI_Datatype type, MPI_Comm comm) {
2972 if(incount<0 || outcount < 0 || inbuf==nullptr || outbuf==nullptr)
2974 if(!type->is_valid())
2975 return MPI_ERR_TYPE;
2976 if(comm==MPI_COMM_NULL)
2977 return MPI_ERR_COMM;
2978 return type->unpack(inbuf, incount, position, outbuf,outcount, comm);
2981 int PMPI_Pack(void* inbuf, int incount, MPI_Datatype type, void* outbuf, int outcount, int* position, MPI_Comm comm) {
2982 if(incount<0 || outcount < 0|| inbuf==nullptr || outbuf==nullptr)
2984 if(!type->is_valid())
2985 return MPI_ERR_TYPE;
2986 if(comm==MPI_COMM_NULL)
2987 return MPI_ERR_COMM;
2988 return type->pack(inbuf, incount, outbuf,outcount,position, comm);
2991 int PMPI_Pack_size(int incount, MPI_Datatype datatype, MPI_Comm comm, int* size) {
2994 if(!datatype->is_valid())
2995 return MPI_ERR_TYPE;
2996 if(comm==MPI_COMM_NULL)
2997 return MPI_ERR_COMM;
2999 *size=incount*datatype->size();