source: CIVL/examples/backend/mpiSumarray.cvl@ c2d9687

1.23 2.0 main test-branch
Last change on this file since c2d9687 was 53d9ac1, checked in by Ziqing Luo <ziqing@…>, 10 years ago

fixed beackendTest/mpiSumarray , the probelm is the explicitly included headers are not updated

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

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