source: CIVL/examples/contracts/contractsMPI/civl_mpi_collectives/allgather-bad_ensures.c

1.23 v1.23.0
Last change on this file was ea777aa, checked in by Alex Wilton <awilton@…>, 3 years ago

Moved examples, include, build_default.properties, common.xml, and README out from dev.civl.com into the root of the repo.

git-svn-id: svn://vsl.cis.udel.edu/civl/trunk@5704 fb995dde-84ed-4084-dfe6-e5aef3e2452c

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