| 1 | // How to get rid of BOUNDS ?
|
|---|
| 2 | /************************** source code **************************/
|
|---|
| 3 | #include<mpi.h>
|
|---|
| 4 | #include<civl-mpi.cvh>
|
|---|
| 5 | #include<civlc.cvh>
|
|---|
| 6 | #include<string.h>
|
|---|
| 7 | #include<stdio.h>
|
|---|
| 8 |
|
|---|
| 9 | #define DATA_LIMIT 1024
|
|---|
| 10 | #pragma CIVL ACSL
|
|---|
| 11 | /*@
|
|---|
| 12 | @ \mpi_collective(comm, P2P):
|
|---|
| 13 | @ requires 0 <= root && root < \mpi_comm_size;
|
|---|
| 14 | @ requires \mpi_agree(root) && \mpi_agree(count * \mpi_extent(datatype));
|
|---|
| 15 | @ requires 0 <= count && 0 <= count * \mpi_extent(datatype);
|
|---|
| 16 | @ requires \mpi_valid(buf, count, datatype);
|
|---|
| 17 | @ ensures \mpi_agree(\mpi_region(buf, count, datatype));
|
|---|
| 18 | @ behavior nonroot:
|
|---|
| 19 | @ assumes \mpi_comm_rank != root;
|
|---|
| 20 | @ assigns \mpi_region(buf, count, datatype);
|
|---|
| 21 | @ waitsfor root;
|
|---|
| 22 | @*/
|
|---|
| 23 | int broadcast(void * buf, int count,
|
|---|
| 24 | MPI_Datatype datatype, int root, MPI_Comm comm) {
|
|---|
| 25 | int nprocs, rank;
|
|---|
| 26 | int tag = 999;
|
|---|
| 27 |
|
|---|
| 28 | MPI_Comm_size(comm, &nprocs);
|
|---|
| 29 | MPI_Comm_rank(comm, &rank);
|
|---|
| 30 | if (rank == root) {
|
|---|
| 31 | for (int i = 0; i < nprocs; i++)
|
|---|
| 32 | if (i != root)
|
|---|
| 33 | MPI_Send(buf, count, datatype, i, tag, comm);
|
|---|
| 34 | } else
|
|---|
| 35 | MPI_Recv(buf, count, datatype, root, tag, comm,
|
|---|
| 36 | MPI_STATUS_IGNORE);
|
|---|
| 37 | return 0;
|
|---|
| 38 | }
|
|---|
| 39 |
|
|---|
| 40 |
|
|---|
| 41 | /*@
|
|---|
| 42 | @ \mpi_collective(comm, P2P) :
|
|---|
| 43 | @ requires \mpi_agree(root) && \mpi_agree(sendcount * \mpi_extent(sendtype));
|
|---|
| 44 | @ requires sendcount * \mpi_extent(sendtype) >= 0;
|
|---|
| 45 | @ requires recvcount * \mpi_extent(recvtype) >= 0;
|
|---|
| 46 | @ requires 0 <= root && root < \mpi_comm_size;
|
|---|
| 47 | @ behavior imroot_not_inplace:
|
|---|
| 48 | @ assumes \mpi_comm_rank == root && sendbuf != MPI_IN_PLACE;
|
|---|
| 49 | @ requires \mpi_valid(sendbuf, sendcount, sendtype);
|
|---|
| 50 | @ requires \mpi_valid(recvbuf, recvcount * \mpi_comm_size, recvtype);
|
|---|
| 51 | @ requires recvcount * \mpi_extent(recvtype) == sendcount * \mpi_extent(sendtype);
|
|---|
| 52 | @ assigns \mpi_region(recvbuf, recvcount * \mpi_comm_size, recvtype);
|
|---|
| 53 | @ ensures \mpi_equals(\mpi_region(\mpi_offset(recvbuf, root * recvcount, recvtype), recvcount, recvtype),
|
|---|
| 54 | @ \mpi_region(sendbuf, sendcount, sendtype));
|
|---|
| 55 | @ waitsfor (0 .. \mpi_comm_size-1);
|
|---|
| 56 | @ behavior imroot_inplace:
|
|---|
| 57 | @ assumes \mpi_comm_rank == root && sendbuf == MPI_IN_PLACE;
|
|---|
| 58 | @ requires \mpi_valid(recvbuf, recvcount * \mpi_comm_size, recvtype);
|
|---|
| 59 | @ assigns \nothing;
|
|---|
| 60 | @ waitsfor (0 .. \mpi_comm_size-1);
|
|---|
| 61 | @ behavior not_root:
|
|---|
| 62 | @ assumes \mpi_comm_rank != root;
|
|---|
| 63 | @ requires \mpi_valid(sendbuf, sendcount, sendtype);
|
|---|
| 64 | @ requires \on(root, recvcount * \mpi_extent(recvtype)) == sendcount * \mpi_extent(sendtype);
|
|---|
| 65 | @ assigns \nothing;
|
|---|
| 66 | @ ensures \mpi_equals(\mpi_region(sendbuf, sendcount, sendtype),
|
|---|
| 67 | @ \mpi_region(\mpi_offset(\on(root, recvbuf), \mpi_comm_rank * sendcount, sendtype), sendcount, sendtype));
|
|---|
| 68 | @*/
|
|---|
| 69 | int gather(void* sendbuf, int sendcount, MPI_Datatype sendtype,
|
|---|
| 70 | void* recvbuf, int recvcount, MPI_Datatype recvtype,
|
|---|
| 71 | int root, MPI_Comm comm){
|
|---|
| 72 | int rank, nprocs;
|
|---|
| 73 | MPI_Status status;
|
|---|
| 74 | int tag = 998;
|
|---|
| 75 |
|
|---|
| 76 | MPI_Comm_rank(comm, &rank);
|
|---|
| 77 | MPI_Comm_size(comm, &nprocs);
|
|---|
| 78 | if(root == rank) {
|
|---|
| 79 | if(sendbuf != MPI_IN_PLACE) {
|
|---|
| 80 | void *ptr;
|
|---|
| 81 |
|
|---|
| 82 | ptr = $mpi_pointer_add(recvbuf, root * recvcount, recvtype);
|
|---|
| 83 | memcpy(ptr, sendbuf, recvcount * sizeofDatatype(recvtype));
|
|---|
| 84 | }
|
|---|
| 85 | } else
|
|---|
| 86 | MPI_Send(sendbuf, sendcount, sendtype, root, tag, comm);
|
|---|
| 87 | if(rank == root) {
|
|---|
| 88 | int real_recvcount;
|
|---|
| 89 | int offset;
|
|---|
| 90 |
|
|---|
| 91 | for(int i=0; i<nprocs; i++) {
|
|---|
| 92 | if(i != root) {
|
|---|
| 93 | void * ptr;
|
|---|
| 94 |
|
|---|
| 95 | offset = i * recvcount;
|
|---|
| 96 | ptr = $mpi_pointer_add(recvbuf, offset, recvtype);
|
|---|
| 97 | MPI_Recv(ptr, recvcount, recvtype, i, tag, comm,
|
|---|
| 98 | &status);
|
|---|
| 99 | }
|
|---|
| 100 | }
|
|---|
| 101 | }
|
|---|
| 102 | return 0;
|
|---|
| 103 | }
|
|---|
| 104 |
|
|---|
| 105 |
|
|---|
| 106 | /*@ \mpi_collective(comm, P2P):
|
|---|
| 107 | @ requires \mpi_agree(sendcount * \mpi_extent(sendtype));
|
|---|
| 108 | @ requires sendcount >= 0 && sendcount * \mpi_extent(sendtype) * \mpi_comm_size >= 0;
|
|---|
| 109 | @ requires recvcount >= 0 && recvcount * \mpi_extent(recvtype) * \mpi_comm_size >= 0;
|
|---|
| 110 | @ requires \mpi_valid(recvbuf, recvcount * \mpi_comm_size, recvtype);
|
|---|
| 111 | @ requires \mpi_extent(recvtype) * recvcount == \mpi_extent(sendtype) * sendcount;
|
|---|
| 112 | @ assigns \mpi_region(recvbuf, recvcount * \mpi_comm_size, recvtype);
|
|---|
| 113 | @ ensures \mpi_agree(\mpi_region(recvbuf, recvcount * \mpi_comm_size, recvtype));
|
|---|
| 114 | @ behavior not_inplace:
|
|---|
| 115 | @ assumes sendbuf != MPI_IN_PLACE;
|
|---|
| 116 | @ requires \mpi_valid(sendbuf, sendcount, sendtype);
|
|---|
| 117 | @ ensures \mpi_equals(\mpi_region(sendbuf, sendcount, sendtype),
|
|---|
| 118 | @ \mpi_region(
|
|---|
| 119 | @ \mpi_offset(recvbuf, \mpi_comm_rank * recvcount, recvtype),
|
|---|
| 120 | @ recvcount, recvtype));
|
|---|
| 121 | @ behavior inplace:
|
|---|
| 122 | @ assumes sendbuf == MPI_IN_PLACE;
|
|---|
| 123 | @ requires \mpi_agree(sendbuf == MPI_IN_PLACE);
|
|---|
| 124 | @ ensures \mpi_equals(\old(\mpi_region(
|
|---|
| 125 | @ \mpi_offset(recvbuf, \mpi_comm_rank * recvcount, recvtype),
|
|---|
| 126 | @ recvcount, recvtype)),
|
|---|
| 127 | @ \mpi_region(
|
|---|
| 128 | @ \mpi_offset(recvbuf, \mpi_comm_rank * recvcount, recvtype),
|
|---|
| 129 | @ recvcount, recvtype));
|
|---|
| 130 | @
|
|---|
| 131 | @*/
|
|---|
| 132 | int allgather(void *sendbuf, int sendcount, MPI_Datatype sendtype,
|
|---|
| 133 | void *recvbuf, int recvcount, MPI_Datatype recvtype,
|
|---|
| 134 | MPI_Comm comm){
|
|---|
| 135 | int place;
|
|---|
| 136 | int nprocs;
|
|---|
| 137 |
|
|---|
| 138 | MPI_Comm_rank(comm, &place);
|
|---|
| 139 | MPI_Comm_size(comm, &nprocs);
|
|---|
| 140 | if (sendbuf != MPI_IN_PLACE) {
|
|---|
| 141 | gather(sendbuf, sendcount, sendtype,
|
|---|
| 142 | recvbuf, recvcount, recvtype,
|
|---|
| 143 | 0, comm);
|
|---|
| 144 | } else {
|
|---|
| 145 | void * buf;
|
|---|
| 146 |
|
|---|
| 147 | if (place == 1)
|
|---|
| 148 | buf = MPI_IN_PLACE;
|
|---|
| 149 | else
|
|---|
| 150 | buf = $mpi_pointer_add(recvbuf, recvcount * place, recvtype);
|
|---|
| 151 | printf("%p, rank = %d\n", buf, place);
|
|---|
| 152 | gather(buf, recvcount, recvtype,
|
|---|
| 153 | recvbuf, recvcount, recvtype,
|
|---|
| 154 | 0, comm);
|
|---|
| 155 | }
|
|---|
| 156 | broadcast(recvbuf, recvcount*nprocs, recvtype, 0, comm);
|
|---|
| 157 | return 0;
|
|---|
| 158 | }
|
|---|