source: CIVL/examples/backend/mpiSumarray.cvl@ 1e0789d

1.23 2.0 acw/focus-triggers main test-branch
Last change on this file since 1e0789d was 6b88ea3, checked in by Manchun Zheng <zmanchun@…>, 10 years ago

made $comm_create a civl-c function instead of system function;
fixed purely local analysis for it.

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

  • Property mode set to 100644
File size: 28.3 KB
Line 
1//======================= int_div.cvl ======================
2$system[civlc] void $assert(_Bool expr, ...);
3int $int_div(int numerator, int denominator)
4{
5 $assert(denominator != 0, "Possible division by zero");
6 if (numerator == 0)
7 return 0;
8 if (numerator >= 0)
9 {
10 if (denominator >= 0)
11 return numerator / denominator;
12 else
13 return -(numerator / (-denominator));
14 }
15 else
16 {
17 if (denominator >= 0)
18 return -((-numerator) / denominator);
19 else
20 return (-numerator) / (-denominator);
21 }
22}
23//======================== civlc.cvh =======================
24typedef struct $proc $proc;
25typedef struct $scope $scope;
26/*@ depends_on \nothing;
27 @*/
28$system[civlc] void $assert(_Bool expr, ...);
29/*@ depends_on \nothing;
30 @*/
31$system[civlc] void $assume(_Bool expr);
32/*@ pure;
33 @ depends_on \nothing;
34 @*/
35$system[civlc] void $elaborate(int x);
36/*@ depends_on \nothing;
37 @*/
38$system[civlc] void* $malloc($scope s, int size);
39/*@ depends_on \nothing;
40 @*/
41$system[civlc] void $assert(_Bool expr, ...);
42/*@ depends_on \nothing;
43 @*/
44$system[civlc] void $assume(_Bool expr);
45/*@ pure;
46 @ depends_on \nothing;
47 @*/
48$system[civlc] void $elaborate(int x);
49/*@ depends_on \nothing;
50 @*/
51$system[civlc] void* $malloc($scope s, int size);
52//========================= stdio.h ========================
53$system[stdio] int printf(char* restrict format, ...);
54//======================== civlc.cvh =======================
55/*@ depends_on \nothing;
56 @*/
57$system[civlc] void $assert(_Bool expr, ...);
58/*@ depends_on \nothing;
59 @*/
60$system[civlc] void $assume(_Bool expr);
61/*@ pure;
62 @ depends_on \nothing;
63 @*/
64$system[civlc] void $elaborate(int x);
65/*@ depends_on \nothing;
66 @*/
67$system[civlc] void* $malloc($scope s, int size);
68//======================= bundle.cvh =======================
69typedef struct $bundle $bundle;
70/*@ pure;
71 @*/
72$system[bundle] $bundle $bundle_pack(void* ptr, int size);
73$system[bundle] void $bundle_unpack($bundle bundle, void* ptr);
74//===================== concurrency.cvh ====================
75typedef struct $gbarrier* $gbarrier;
76typedef struct $barrier* $barrier;
77/*@ requires size >= 0;
78 @ depends_on \nothing;
79 @ executes_when $true;
80 @ assigns \nothing;
81 @*/
82$system[concurrency] $gbarrier $gbarrier_create($scope scope, int size);
83/*@ depends_on \nothing;
84 @ executes_when $true;
85 @*/
86$system[concurrency] void $gbarrier_destroy($gbarrier barrier);
87/*@ depends_on \nothing;
88 @ assigns \nothing;
89 @ executes_when $true;
90 @*/
91$system[concurrency] $barrier $barrier_create($scope scope, $gbarrier gbarrier, int place);
92/*@ depends_on \nothing;
93 @ executes_when $true;
94 @*/
95$system[concurrency] void $barrier_destroy($barrier barrier);
96typedef struct $collect_record $collect_record;
97typedef struct $gcollect_checker* $gcollect_checker;
98typedef struct $collect_checker* $collect_checker;
99/*@ depends_on \nothing;
100 @ executes_when $true;
101 @*/
102$system[concurrency] $gcollect_checker $gcollect_checker_create($scope scope);
103/*@ depends_on \nothing;
104 @ executes_when $true;
105 @*/
106$system[concurrency] int $gcollect_checker_destroy($gcollect_checker checker);
107/*@ depends_on \nothing;
108 @ executes_when $true;
109 @*/
110$system[concurrency] $collect_checker $collect_checker_create($scope scope, $gcollect_checker gchecker);
111/*@ depends_on \nothing;
112 @ executes_when $true;
113 @*/
114$system[concurrency] void $collect_checker_destroy($collect_checker checker);
115//========================== mpi.h =========================
116typedef enum $anon_enum_0{
117 MPI_CHAR,
118 MPI_CHARACTER,
119 MPI_SIGNED_CHAR,
120 MPI_UNSIGNED_CHAR,
121 MPI_BYTE,
122 MPI_WCHAR,
123 MPI_SHORT,
124 MPI_UNSIGNED_SHORT,
125 MPI_INT,
126 MPI_INT16_T,
127 MPI_INT32_T,
128 MPI_INT64_T,
129 MPI_INT8_T,
130 MPI_INTEGER,
131 MPI_INTEGER1,
132 MPI_INTEGER16,
133 MPI_INTEGER2,
134 MPI_INTEGER4,
135 MPI_INTEGER8,
136 MPI_UNSIGNED,
137 MPI_LONG,
138 MPI_UNSIGNED_LONG,
139 MPI_FLOAT,
140 MPI_DOUBLE,
141 MPI_LONG_DOUBLE,
142 MPI_LONG_LONG_INT,
143 MPI_UNSIGNED_LONG_LONG,
144 MPI_LONG_LONG,
145 MPI_PACKED,
146 MPI_LB,
147 MPI_UB,
148 MPI_UINT16_T,
149 MPI_UINT32_T,
150 MPI_UINT64_T,
151 MPI_UINT8_T,
152 MPI_FLOAT_INT,
153 MPI_DOUBLE_INT,
154 MPI_LONG_INT,
155 MPI_SHORT_INT,
156 MPI_2INT,
157 MPI_LONG_DOUBLE_INT,
158 MPI_AINT,
159 MPI_OFFSET,
160 MPI_2DOUBLE_PRECISION,
161 MPI_2INTEGER,
162 MPI_2REAL,
163 MPI_C_BOOL,
164 MPI_C_COMPLEX,
165 MPI_C_DOUBLE_COMPLEX,
166 MPI_C_FLOAT_COMPLEX,
167 MPI_C_LONG_DOUBLE_COMPLEX,
168 MPI_COMPLEX,
169 MPI_COMPLEX16,
170 MPI_COMPLEX32,
171 MPI_COMPLEX4,
172 MPI_COMPLEX8,
173 MPI_REAL,
174 MPI_REAL16,
175 MPI_REAL2,
176 MPI_REAL4,
177 MPI_REAL8
178} MPI_Datatype;
179typedef struct MPI_Comm MPI_Comm;
180typedef struct MPI_Status{
181 int MPI_SOURCE;
182 int MPI_TAG;
183 int MPI_ERROR;
184 int size;
185} MPI_Status;
186//======================== comm.cvh ========================
187typedef struct $message{
188 int source;
189 int dest;
190 int tag;
191 $bundle data;
192 int size;
193} $message;
194typedef struct $queue $queue;
195typedef struct $gcomm* $gcomm;
196typedef struct $comm* $comm;
197/*@ pure;
198 @ depends_on \nothing;
199 @ executes_when $true;
200 @*/
201$atomic_f $message $message_pack(int source, int dest, int tag, void* data, int size);
202/*@ pure;
203 @ depends_on \nothing;
204 @ executes_when $true;
205 @*/
206$atomic_f int $message_source($message message);
207/*@ pure;
208 @ depends_on \nothing;
209 @ executes_when $true;
210 @*/
211$atomic_f int $message_tag($message message);
212/*@ pure;
213 @ depends_on \nothing;
214 @ executes_when $true;
215 @*/
216$atomic_f int $message_dest($message message);
217/*@ pure;
218 @ depends_on \nothing;
219 @ executes_when $true;
220 @*/
221$atomic_f int $message_size($message message);
222/*@ depends_on \write(buf);
223 @ executes_when $true;
224 @*/
225$atomic_f void $message_unpack($message message, void* buf, int size);
226/*@ depends_on \nothing;
227 @ executes_when $true;
228 @*/
229$system[comm] $gcomm $gcomm_create($scope scope, int size);
230/*@ depends_on \nothing;
231 @ executes_when $true;
232 @*/
233$system[comm] int $gcomm_destroy($gcomm gcomm, void* junkMsgs);
234/*@ depends_on \nothing;
235 @ reads gcomm;
236 @ assigns gcomm;
237 @*/
238$atomic_f $comm $comm_create($scope scope, $gcomm gcomm, int place);
239/*@ depends_on \nothing;
240 @ executes_when $true;
241 @*/
242$system[comm] void $comm_destroy($comm comm);
243/*@ pure;
244 @ depends_on \nothing;
245 @ executes_when $true;
246 @*/
247$system[comm] int $comm_size($comm comm);
248/*@ pure;
249 @ depends_on \nothing;
250 @ executes_when $true;
251 @*/
252$atomic_f int $comm_place($comm comm);
253/*@ depends_on \write(comm);
254 @ executes_when $true;
255 @*/
256$system[comm] void $comm_enqueue($comm comm, $message message);
257/*@ depends_on \write(comm);
258 @*/
259$system[comm] $message $comm_dequeue($comm comm, int source, int tag);
260//====================== civl-mpi.cvh ======================
261typedef enum _mpi_state_{
262 _MPI_UNINIT,
263 _MPI_INIT,
264 _MPI_FINALIZED
265} $mpi_state;
266typedef struct MPI_Comm MPI_Comm;
267typedef struct MPI_Status MPI_Status;
268typedef struct $mpi_gcomm $mpi_gcomm;
269int sizeofDatatype(MPI_Datatype);
270$mpi_gcomm $mpi_gcomm_create($scope, int);
271void $mpi_gcomm_destroy($mpi_gcomm);
272MPI_Comm $mpi_comm_create($scope, $mpi_gcomm, int);
273void $mpi_comm_destroy(MPI_Comm, $mpi_state);
274int $mpi_send(void*, int, MPI_Datatype, int, int, MPI_Comm);
275int $mpi_recv(void*, int, MPI_Datatype, int, int, MPI_Comm, MPI_Status*);
276$system[mpi] void $mpi_assert_consistent_basetype(void* buf, MPI_Datatype datatype);
277//========================= mpi.cvl ========================
278struct MPI_Comm{
279 $comm p2p;
280 $comm col;
281 $collect_checker collect_checker;
282 $barrier barrier;
283 int gcommIndex;
284};
285//======================== civlc.cvh =======================
286/*@ depends_on \nothing;
287 @*/
288$system[civlc] void $assert(_Bool expr, ...);
289/*@ depends_on \nothing;
290 @*/
291$system[civlc] void $assume(_Bool expr);
292/*@ pure;
293 @ depends_on \nothing;
294 @*/
295$system[civlc] void $elaborate(int x);
296/*@ depends_on \nothing;
297 @*/
298$system[civlc] void* $malloc($scope s, int size);
299//======================= bundle.cvh =======================
300/*@ pure;
301 @*/
302$system[bundle] $bundle $bundle_pack(void* ptr, int size);
303$system[bundle] void $bundle_unpack($bundle bundle, void* ptr);
304//===================== concurrency.cvh ====================
305/*@ requires size >= 0;
306 @ depends_on \nothing;
307 @ executes_when $true;
308 @ assigns \nothing;
309 @*/
310$system[concurrency] $gbarrier $gbarrier_create($scope scope, int size);
311/*@ depends_on \nothing;
312 @ executes_when $true;
313 @*/
314$system[concurrency] void $gbarrier_destroy($gbarrier barrier);
315/*@ depends_on \nothing;
316 @ assigns \nothing;
317 @ executes_when $true;
318 @*/
319$system[concurrency] $barrier $barrier_create($scope scope, $gbarrier gbarrier, int place);
320/*@ depends_on \nothing;
321 @ executes_when $true;
322 @*/
323$system[concurrency] void $barrier_destroy($barrier barrier);
324/*@ depends_on \nothing;
325 @ executes_when $true;
326 @*/
327$system[concurrency] $gcollect_checker $gcollect_checker_create($scope scope);
328/*@ depends_on \nothing;
329 @ executes_when $true;
330 @*/
331$system[concurrency] int $gcollect_checker_destroy($gcollect_checker checker);
332/*@ depends_on \nothing;
333 @ executes_when $true;
334 @*/
335$system[concurrency] $collect_checker $collect_checker_create($scope scope, $gcollect_checker gchecker);
336/*@ depends_on \nothing;
337 @ executes_when $true;
338 @*/
339$system[concurrency] void $collect_checker_destroy($collect_checker checker);
340//========================= seq.cvh ========================
341$system[seq] void $seq_init(void* array, int count, void* value);
342//===================== concurrency.cvl ====================
343struct $gbarrier{
344 int nprocs;
345 $proc proc_map[];
346 _Bool in_barrier[];
347 int num_in_barrier;
348};
349struct $barrier{
350 int place;
351 $gbarrier gbarrier;
352};
353struct $collect_record{
354 $bundle entries;
355 _Bool marks[];
356 int numMarked;
357};
358struct $gcollect_checker{
359 int length;
360 $collect_record records[];
361};
362struct $collect_checker{
363 $gcollect_checker checker;
364};
365//======================== civlc.cvh =======================
366/*@ depends_on \nothing;
367 @*/
368$system[civlc] void $assert(_Bool expr, ...);
369/*@ depends_on \nothing;
370 @*/
371$system[civlc] void $assume(_Bool expr);
372/*@ pure;
373 @ depends_on \nothing;
374 @*/
375$system[civlc] void $elaborate(int x);
376/*@ depends_on \nothing;
377 @*/
378$system[civlc] void* $malloc($scope s, int size);
379//======================= bundle.cvh =======================
380/*@ pure;
381 @*/
382$system[bundle] $bundle $bundle_pack(void* ptr, int size);
383$system[bundle] void $bundle_unpack($bundle bundle, void* ptr);
384//===================== concurrency.cvh ====================
385/*@ requires size >= 0;
386 @ depends_on \nothing;
387 @ executes_when $true;
388 @ assigns \nothing;
389 @*/
390$system[concurrency] $gbarrier $gbarrier_create($scope scope, int size);
391/*@ depends_on \nothing;
392 @ executes_when $true;
393 @*/
394$system[concurrency] void $gbarrier_destroy($gbarrier barrier);
395/*@ depends_on \nothing;
396 @ assigns \nothing;
397 @ executes_when $true;
398 @*/
399$system[concurrency] $barrier $barrier_create($scope scope, $gbarrier gbarrier, int place);
400/*@ depends_on \nothing;
401 @ executes_when $true;
402 @*/
403$system[concurrency] void $barrier_destroy($barrier barrier);
404/*@ depends_on \nothing;
405 @ executes_when $true;
406 @*/
407$system[concurrency] $gcollect_checker $gcollect_checker_create($scope scope);
408/*@ depends_on \nothing;
409 @ executes_when $true;
410 @*/
411$system[concurrency] int $gcollect_checker_destroy($gcollect_checker checker);
412/*@ depends_on \nothing;
413 @ executes_when $true;
414 @*/
415$system[concurrency] $collect_checker $collect_checker_create($scope scope, $gcollect_checker gchecker);
416/*@ depends_on \nothing;
417 @ executes_when $true;
418 @*/
419$system[concurrency] void $collect_checker_destroy($collect_checker checker);
420//======================== comm.cvh ========================
421/*@ pure;
422 @ depends_on \nothing;
423 @ executes_when $true;
424 @*/
425$atomic_f $message $message_pack(int source, int dest, int tag, void* data, int size);
426/*@ pure;
427 @ depends_on \nothing;
428 @ executes_when $true;
429 @*/
430$atomic_f int $message_source($message message);
431/*@ pure;
432 @ depends_on \nothing;
433 @ executes_when $true;
434 @*/
435$atomic_f int $message_tag($message message);
436/*@ pure;
437 @ depends_on \nothing;
438 @ executes_when $true;
439 @*/
440$atomic_f int $message_dest($message message);
441/*@ pure;
442 @ depends_on \nothing;
443 @ executes_when $true;
444 @*/
445$atomic_f int $message_size($message message);
446/*@ depends_on \write(buf);
447 @ executes_when $true;
448 @*/
449$atomic_f void $message_unpack($message message, void* buf, int size);
450/*@ depends_on \nothing;
451 @ executes_when $true;
452 @*/
453$system[comm] $gcomm $gcomm_create($scope scope, int size);
454/*@ depends_on \nothing;
455 @ executes_when $true;
456 @*/
457$system[comm] int $gcomm_destroy($gcomm gcomm, void* junkMsgs);
458/*@ depends_on \nothing;
459 @ reads gcomm;
460 @ assigns gcomm;
461 @*/
462$atomic_f $comm $comm_create($scope scope, $gcomm gcomm, int place);
463/*@ depends_on \nothing;
464 @ executes_when $true;
465 @*/
466$system[comm] void $comm_destroy($comm comm);
467/*@ pure;
468 @ depends_on \nothing;
469 @ executes_when $true;
470 @*/
471$system[comm] int $comm_size($comm comm);
472/*@ pure;
473 @ depends_on \nothing;
474 @ executes_when $true;
475 @*/
476$atomic_f int $comm_place($comm comm);
477/*@ depends_on \write(comm);
478 @ executes_when $true;
479 @*/
480$system[comm] void $comm_enqueue($comm comm, $message message);
481/*@ depends_on \write(comm);
482 @*/
483$system[comm] $message $comm_dequeue($comm comm, int source, int tag);
484//====================== civl-mpi.cvh ======================
485int sizeofDatatype(MPI_Datatype);
486$mpi_gcomm $mpi_gcomm_create($scope, int);
487void $mpi_gcomm_destroy($mpi_gcomm);
488MPI_Comm $mpi_comm_create($scope, $mpi_gcomm, int);
489void $mpi_comm_destroy(MPI_Comm, $mpi_state);
490int $mpi_send(void*, int, MPI_Datatype, int, int, MPI_Comm);
491int $mpi_recv(void*, int, MPI_Datatype, int, int, MPI_Comm, MPI_Status*);
492$system[mpi] void $mpi_assert_consistent_basetype(void* buf, MPI_Datatype datatype);
493//========================= seq.cvh ========================
494$system[seq] void $seq_init(void* array, int count, void* value);
495//====================== civl-mpi.cvl ======================
496char* getCoroutineName(int tag);
497struct $mpi_gcomm{
498 $gcomm p2p;
499 $gcomm col;
500 $gcollect_checker collect_checker;
501 $gbarrier gbarrier;
502};
503int sizeofDatatype(MPI_Datatype datatype)
504{
505 switch (datatype)
506 {
507 case MPI_INT:
508 return sizeof(int);
509 case MPI_2INT:
510 return sizeof(int) * 2;
511 case MPI_FLOAT:
512 return sizeof(float);
513 case MPI_DOUBLE:
514 return sizeof(double);
515 case MPI_CHAR:
516 return sizeof(char);
517 case MPI_BYTE:
518 return sizeof(char);
519 case MPI_SHORT:
520 return sizeof(short);
521 case MPI_LONG:
522 return sizeof(long);
523 case MPI_LONG_DOUBLE:
524 return sizeof(long double);
525 case MPI_LONG_LONG_INT:
526 return sizeof(long long);
527 case MPI_LONG_LONG:
528 return sizeof(long long);
529 case MPI_UNSIGNED_LONG_LONG:
530 return sizeof(unsigned long long);
531 default:
532 $assert(0, "Unreachable");
533 }
534}
535$mpi_gcomm $mpi_gcomm_create($scope scope, int size)
536{
537 $mpi_gcomm result;
538 result.p2p = $gcomm_create(scope, size);
539 result.col = $gcomm_create(scope, size);
540 result.collect_checker = $gcollect_checker_create(scope);
541 result.gbarrier = $gbarrier_create(scope, size);
542 return result;
543}
544void $mpi_gcomm_destroy($mpi_gcomm gc)
545{
546 int numJunkRecord;
547 int numJunkMsg;
548 $message junkMsgs[];
549 $seq_init(&(junkMsgs), 0, (void*)0);
550 numJunkMsg = $gcomm_destroy(gc.p2p, &(junkMsgs));
551 {
552 int i = 0;
553 for (; i < numJunkMsg; i = i + 1)
554 {
555 int src;
556 int dest;
557 int tag;
558 src = $message_source(junkMsgs[i]);
559 dest = $message_dest(junkMsgs[i]);
560 tag = $message_tag(junkMsgs[i]);
561 $assert($false, "MPI message leak: There is a message from rank %d to rank %d with tag %d has been sent but is never received in point-to-point communication.", src, dest, tag);
562 }
563 }
564 numJunkMsg = $gcomm_destroy(gc.col, &(junkMsgs));
565 {
566 int i = 0;
567 for (; i < numJunkMsg; i = i + 1)
568 {
569 int src;
570 int tag;
571 char* routine;
572 src = $message_source(junkMsgs[i]);
573 tag = $message_tag(junkMsgs[i]);
574 routine = getCoroutineName(tag);
575 $assert($false, "MPI message leak: There is a message sent by rank %d for collective routine %s that is never received.", src, routine);
576 }
577 }
578 numJunkRecord = $gcollect_checker_destroy(gc.collect_checker);
579 $gbarrier_destroy(gc.gbarrier);
580 $assert(numJunkRecord == 0, "MPI collective routines are called inappropriately because there are %d collective records still remaining the collective routine checker.", numJunkRecord);
581}
582MPI_Comm $mpi_comm_create($scope scope, $mpi_gcomm gc, int rank)
583{
584 MPI_Comm result;
585 result.p2p = $comm_create(scope, gc.p2p, rank);
586 result.col = $comm_create(scope, gc.col, rank);
587 result.collect_checker = $collect_checker_create(scope, gc.collect_checker);
588 result.barrier = $barrier_create(scope, gc.gbarrier, rank);
589 result.gcommIndex = 0;
590 return result;
591}
592void $mpi_comm_destroy(MPI_Comm comm, $mpi_state mpi_state)
593{
594 if (comm.gcommIndex == 0)
595 $assert(mpi_state == _MPI_FINALIZED, "Process terminates without calling MPI_Finalize() first.");
596 $comm_destroy(comm.p2p);
597 $comm_destroy(comm.col);
598 $collect_checker_destroy(comm.collect_checker);
599 $barrier_destroy(comm.barrier);
600}
601int $mpi_send(void* buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm)
602{
603 if (dest >= 0)
604 {
605 int $sef$0 = sizeofDatatype(datatype);
606 int size = count * $sef$0;
607 int place = $comm_place(comm.p2p);
608 $message out = $message_pack(place, dest, tag, buf, size);
609 $comm_enqueue(comm.p2p, out);
610 }
611 return 0;
612}
613int $mpi_recv(void* buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Status* status)
614{
615 if ((source >= 0) || (source == (-1)))
616 {
617 $message in;
618 int place = $comm_place(comm.p2p);
619 int deterministicTag;
620 $assert((tag == (-2)) || (tag >= 0), "Illegal MPI message receive tag %d.\n", tag);
621 deterministicTag = tag < 0 ? -2 : tag;
622 $elaborate(source);
623 in = $comm_dequeue(comm.p2p, source, deterministicTag);
624 int $sef$1 = sizeofDatatype(datatype);
625 int size = count * $sef$1;
626 $message_unpack(in, buf, size);
627 if (status != (void*)0)
628 {
629 (status)->size = $message_size(in);
630 (status)->MPI_SOURCE = $message_source(in);
631 (status)->MPI_TAG = $message_tag(in);
632 (status)->MPI_ERROR = 0;
633 }
634 }
635 return 0;
636}
637char* getCoroutineName(int tag)
638{
639 switch (tag)
640 {
641 case 9999:
642 return "MPI_Bcast";
643 case 9998:
644 return "MPI_Reduce";
645 case 9997:
646 return "MPI_Allreduce";
647 case 9996:
648 return "MPI_Gather";
649 case 9995:
650 return "MPI_Scatter";
651 case 9994:
652 return "MPI_Gatherv";
653 case 9993:
654 return "MPI_Scatterv";
655 case 9992:
656 return "MPI_Allgather";
657 case 9991:
658 return "MPI_Reduce_scatter";
659 case 9990:
660 return "MPI_Alltoall";
661 case 9989:
662 return "MPI_Alltoallv";
663 case 9988:
664 return "MPI_Alltoallw";
665 case 9987:
666 return "MPI_Barrier";
667 case 9986:
668 return "MPI_Commdup";
669 case 9985:
670 return "MPI_Commfree";
671 default:
672 $assert($false, "Internal Error: Unexpected MPI routine tag:%d.\n", tag);
673 }
674}
675//======================== civlc.cvh =======================
676/*@ depends_on \nothing;
677 @*/
678$system[civlc] void $assert(_Bool expr, ...);
679/*@ depends_on \nothing;
680 @*/
681$system[civlc] void $assume(_Bool expr);
682/*@ pure;
683 @ depends_on \nothing;
684 @*/
685$system[civlc] void $elaborate(int x);
686/*@ depends_on \nothing;
687 @*/
688$system[civlc] void* $malloc($scope s, int size);
689//======================= bundle.cvh =======================
690/*@ pure;
691 @*/
692$system[bundle] $bundle $bundle_pack(void* ptr, int size);
693$system[bundle] void $bundle_unpack($bundle bundle, void* ptr);
694//======================== comm.cvh ========================
695/*@ pure;
696 @ depends_on \nothing;
697 @ executes_when $true;
698 @*/
699$atomic_f $message $message_pack(int source, int dest, int tag, void* data, int size);
700/*@ pure;
701 @ depends_on \nothing;
702 @ executes_when $true;
703 @*/
704$atomic_f int $message_source($message message);
705/*@ pure;
706 @ depends_on \nothing;
707 @ executes_when $true;
708 @*/
709$atomic_f int $message_tag($message message);
710/*@ pure;
711 @ depends_on \nothing;
712 @ executes_when $true;
713 @*/
714$atomic_f int $message_dest($message message);
715/*@ pure;
716 @ depends_on \nothing;
717 @ executes_when $true;
718 @*/
719$atomic_f int $message_size($message message);
720/*@ depends_on \write(buf);
721 @ executes_when $true;
722 @*/
723$atomic_f void $message_unpack($message message, void* buf, int size);
724/*@ depends_on \nothing;
725 @ executes_when $true;
726 @*/
727$system[comm] $gcomm $gcomm_create($scope scope, int size);
728/*@ depends_on \nothing;
729 @ executes_when $true;
730 @*/
731$system[comm] int $gcomm_destroy($gcomm gcomm, void* junkMsgs);
732/*@ depends_on \nothing;
733 @ reads gcomm;
734 @ assigns gcomm;
735 @*/
736$atomic_f $comm $comm_create($scope scope, $gcomm gcomm, int place);
737/*@ depends_on \nothing;
738 @ executes_when $true;
739 @*/
740$system[comm] void $comm_destroy($comm comm);
741/*@ pure;
742 @ depends_on \nothing;
743 @ executes_when $true;
744 @*/
745$system[comm] int $comm_size($comm comm);
746/*@ pure;
747 @ depends_on \nothing;
748 @ executes_when $true;
749 @*/
750$atomic_f int $comm_place($comm comm);
751/*@ depends_on \write(comm);
752 @ executes_when $true;
753 @*/
754$system[comm] void $comm_enqueue($comm comm, $message message);
755/*@ depends_on \write(comm);
756 @*/
757$system[comm] $message $comm_dequeue($comm comm, int source, int tag);
758//======================== comm.cvl ========================
759struct $queue{
760 int length;
761 $message messages[];
762};
763struct $gcomm{
764 int nprocs;
765 $proc procs[];
766 _Bool isInit[];
767 $queue buf[][];
768};
769struct $comm{
770 int place;
771 $gcomm gcomm;
772};
773/*@ depends_on \nothing;
774 @ reads gcomm;
775 @ assigns gcomm;
776 @*/
777$atomic_f $comm $comm_create($scope scope, $gcomm gcomm, int place)
778{
779 $comm comm = ($comm)($malloc(scope, sizeof(struct $comm)));
780 (gcomm)->procs[place] = $self;
781 (gcomm)->isInit[place] = $true;
782 (comm)->gcomm = gcomm;
783 (comm)->place = place;
784 return comm;
785}
786$message $message_pack(int source, int dest, int tag, void* data, int size)
787{
788 $message result;
789 result.source = source;
790 result.dest = dest;
791 result.tag = tag;
792 result.data = $bundle_pack(data, size);
793 result.size = size;
794 return result;
795}
796int $message_source($message message)
797{
798 return message.source;
799}
800int $message_tag($message message)
801{
802 return message.tag;
803}
804int $message_dest($message message)
805{
806 return message.dest;
807}
808int $message_size($message message)
809{
810 return message.size;
811}
812void $message_unpack($message message, void* buf, int size)
813{
814 $bundle_unpack(message.data, buf);
815 $assert(message.size <= size, "Message of size %d exceeds the specified size %d.", message.size, size);
816}
817int $comm_place($comm comm)
818{
819 return (comm)->place;
820}
821//======================== civlc.cvh =======================
822/*@ depends_on \nothing;
823 @*/
824$system[civlc] void $assert(_Bool expr, ...);
825/*@ depends_on \nothing;
826 @*/
827$system[civlc] void $assume(_Bool expr);
828/*@ pure;
829 @ depends_on \nothing;
830 @*/
831$system[civlc] void $elaborate(int x);
832/*@ depends_on \nothing;
833 @*/
834$system[civlc] void* $malloc($scope s, int size);
835/*@ depends_on \nothing;
836 @*/
837$system[civlc] void $assert(_Bool expr, ...);
838/*@ depends_on \nothing;
839 @*/
840$system[civlc] void $assume(_Bool expr);
841/*@ pure;
842 @ depends_on \nothing;
843 @*/
844$system[civlc] void $elaborate(int x);
845/*@ depends_on \nothing;
846 @*/
847$system[civlc] void* $malloc($scope s, int size);
848//======================= bundle.cvh =======================
849/*@ pure;
850 @*/
851$system[bundle] $bundle $bundle_pack(void* ptr, int size);
852$system[bundle] void $bundle_unpack($bundle bundle, void* ptr);
853//========================= seq.cvh ========================
854$system[seq] void $seq_init(void* array, int count, void* value);
855//======================== civlc.cvh =======================
856/*@ depends_on \nothing;
857 @*/
858$system[civlc] void $assert(_Bool expr, ...);
859/*@ depends_on \nothing;
860 @*/
861$system[civlc] void $assume(_Bool expr);
862/*@ pure;
863 @ depends_on \nothing;
864 @*/
865$system[civlc] void $elaborate(int x);
866/*@ depends_on \nothing;
867 @*/
868$system[civlc] void* $malloc($scope s, int size);
869//========================= stdio.h ========================
870$system[stdio] int printf(char* restrict format, ...);
871//======================= sum_array.c ======================
872$input int _civl_argc;
873$input char _civl_argv[_civl_argc][];
874$input long NB = 20;
875$input long N;
876//===================== MPITransformer =====================
877$input int _mpi_nprocs;
878$input int _mpi_nprocs_lo = 1;
879//======================= sum_array.c ======================
880$input int _mpi_nprocs_hi = 8;
881//===================== MPITransformer =====================
882$assume((_mpi_nprocs_lo <= _mpi_nprocs) && (_mpi_nprocs <= _mpi_nprocs_hi));
883$mpi_gcomm _mpi_gcomm = $mpi_gcomm_create($here, _mpi_nprocs);
884$mpi_gcomm _mpi_gcomms[];
885$seq_init(&(_mpi_gcomms), 1, &(_mpi_gcomm));
886void _mpi_process(int _mpi_rank)
887{
888 MPI_Comm MPI_COMM_WORLD = $mpi_comm_create($here, _mpi_gcomm, _mpi_rank);
889 $mpi_state _mpi_state = _MPI_UNINIT;
890 int $mpi_init(void)
891 {
892 $assert(_mpi_state == _MPI_UNINIT, "Process can only call MPI_Init() at most once.");
893 _mpi_state = _MPI_INIT;
894 return 0;
895 }
896 int MPI_Finalize(void)
897 {
898 $assert(_mpi_state == _MPI_INIT, "Process can only call MPI_Finalize() after the MPI enviroment is created and before cleaned.");
899 _mpi_state = _MPI_FINALIZED;
900 return 0;
901 }
902 int MPI_Comm_size(MPI_Comm comm, int* size)
903 {
904 $assert(_mpi_state == _MPI_INIT, "MPI_Comm_size() cannot be invoked without MPI_Init() being called before.\n");
905 *size = $comm_size(comm.p2p);
906 return 0;
907 }
908 int MPI_Comm_rank(MPI_Comm comm, int* rank)
909 {
910 $assert(_mpi_state == _MPI_INIT, "MPI_Comm_rank() cannot be invoked without MPI_Init() being called before.\n");
911 *rank = $comm_place(comm.p2p);
912 return 0;
913 }
914 int MPI_Send(void* buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm)
915 {
916 $assert(_mpi_state == _MPI_INIT, "MPI_Send() cannot be invoked without MPI_Init() being called before.\n");
917 $mpi_assert_consistent_basetype(buf, datatype);
918 int $sef$2 = $mpi_send(buf, count, datatype, dest, tag, comm);
919 return $sef$2;
920 }
921 int MPI_Recv(void* buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Status* status)
922 {
923 $assert(_mpi_state == _MPI_INIT, "MPI_Recv() cannot be invoked without MPI_Init() being called before.\n");
924 $mpi_assert_consistent_basetype(buf, datatype);
925 int $sef$3 = $mpi_recv(buf, count, datatype, source, tag, comm, status);
926 return $sef$3;
927 }
928 int MPI_Get_count(MPI_Status* status, MPI_Datatype datatype, int* count)
929 {
930 $assert(_mpi_state == _MPI_INIT, "MPI_Get_count() cannot be invoked without MPI_Init() being called before.\n");
931 int $sef$4 = sizeofDatatype(datatype);
932 *count = $int_div((status)->size, $sef$4);
933 return 0;
934 }
935 $assume((0 < N) && (N <= NB));
936 double oracle;
937 void master(void);
938 void slave(void);
939 int _civl_main(int argc, char** argv)
940 {
941 int myrank;
942 $mpi_init();
943 MPI_Comm_rank(MPI_COMM_WORLD, &(myrank));
944 if (!myrank)
945 master();
946 else
947 slave();
948 MPI_Finalize();
949 return 0;
950 }
951 void master(void)
952 {
953 float array[N];
954 double mysum;
955 double tmpsum;
956 unsigned long long step;
957 unsigned long long i;
958 int size;
959 MPI_Status status;
960 for (i = 0; i < N; i = i + 1)
961 array[i] = i + 1;
962 oracle = 0.0;
963 for (i = 0; i < N; i = i + 1)
964 oracle = oracle + (array[i]);
965 MPI_Comm_size(MPI_COMM_WORLD, &(size));
966 if (size != 1)
967 step = $int_div(N, size - 1);
968 else
969 step = N;
970 for (i = 0; i < (size - 1); i = i + 1)
971 MPI_Send(array + (i * step), step, MPI_FLOAT, i + 1, 100, MPI_COMM_WORLD);
972 {
973 i = (size - 1) * step;
974 mysum = 0;
975 for (; i < N; i = i + 1)
976 mysum = mysum + (array[i]);
977 }
978 for (i = 1; i < size; )
979 {
980 MPI_Recv(&(tmpsum), 1, MPI_DOUBLE, -1, 101, MPI_COMM_WORLD, &(status));
981 mysum = mysum + tmpsum;
982 i = i + 1;
983 }
984 $assert(oracle == mysum, "The sum of %d array elements is %f but the expected one is %f.\n", N, mysum, oracle);
985 printf("%lf\n", mysum);
986 }
987 void slave(void)
988 {
989 float array[N];
990 double sum;
991 unsigned long long i;
992 int count;
993 MPI_Status status;
994 MPI_Recv(array, N, MPI_FLOAT, 0, 100, MPI_COMM_WORLD, &(status));
995 MPI_Get_count(&(status), MPI_FLOAT, &(count));
996 {
997 i = 0;
998 sum = 0;
999 for (; i < count; i = i + 1)
1000 sum = sum + (array[i]);
1001 }
1002 MPI_Send(&(sum), 1, MPI_DOUBLE, 0, 101, MPI_COMM_WORLD);
1003 }
1004 {
1005 _civl_main(_civl_argc, (char*[_civl_argc]) $lambda (int i) _civl_argv[i]);
1006 }
1007 $mpi_comm_destroy(MPI_COMM_WORLD, _mpi_state);
1008}
1009int main()
1010{
1011 $parfor (int i: 0 .. _mpi_nprocs - 1)
1012 _mpi_process(i);
1013 $mpi_gcomm_destroy(_mpi_gcomm);
1014}
1015
Note: See TracBrowser for help on using the repository browser.