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

main
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.8 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#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 @*/
23int 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 @*/
69int 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 @*/
132int 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}
Note: See TracBrowser for help on using the repository browser.