source: CIVL/examples/backend/mpiSumarray.cvl@ 04c71e3

1.23 2.0 main test-branch
Last change on this file since 04c71e3 was 6e64101, checked in by Ziqing Luo <ziqing@…>, 9 years ago

update the back-end example by letting CIVL re-print it

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

  • Property mode set to 100644
File size: 23.7 KB
RevLine 
[7cdceea]1
[7d856cc]2//======================= int_div.cvl ======================
[39c2026]3$system[civlc] void $assert(_Bool expr, ...);
[7cdceea]4$system[int_div] int $remainder(int x, int y);
5$system[int_div] int $quotient(int x, int y);
[f65e51c]6int $int_div(int numerator, int denominator) {
[7d856cc]7 $assert(denominator != 0, "Possible division by zero");
8 if (numerator == 0)
9 return 0;
[f65e51c]10 if (numerator >= 0) {
[7cdceea]11 if (denominator >= 0) {
12 int $sef$0 = $quotient(numerator, denominator);
13 return $sef$0;
14 }
15 else {
16 int $sef$1 = $quotient(numerator, -denominator);
17 return -$sef$1;
18 }
[7d856cc]19 }
[f65e51c]20 else {
[7cdceea]21 if (denominator >= 0) {
22 int $sef$2 = $quotient(-numerator, denominator);
23 return -$sef$2;
24 }
25 else {
26 int $sef$3 = $quotient(-numerator, -denominator);
27 return $sef$3;
28 }
29 }
30}
31//=================== unsigned_arith.cvl ===================
32int $signed_to_unsigned(int x, int bound) {
33 if (x >= 0) {
34 if (x < bound)
35 return x;
36 else {
37 int $sef$9 = $remainder(x, bound);
38 return $sef$9;
39 }
40 }
41 else {
42 if ((-x) <= bound)
43 return bound + x;
44 else {
45 int $sef$10 = $remainder(-x, bound);
46 return bound - $sef$10;
47 }
[7d856cc]48 }
49}
[f65e51c]50//======================= sum_array.c ======================
51$input int _civl_argc;
52$system[civlc] void $assume(_Bool expression);
53$assume(0 < _civl_argc);
54$input char _civl_argv[_civl_argc][];
[7d856cc]55//======================== civlc.cvh =======================
56typedef struct $scope $scope;
[6b88ea3]57/*@ depends_on \nothing;
[c3bddc1]58 @ executes_when $true;
[6b88ea3]59 @*/
60$system[civlc] void* $malloc($scope s, int size);
[7cdceea]61typedef unsigned long size_t;
[f65e51c]62typedef struct $proc $proc;
[7cdceea]63typedef struct $state $state;
[7d856cc]64/*@ depends_on \nothing;
[c3bddc1]65 @ executes_when $true;
[7d856cc]66 @*/
[39c2026]67$system[civlc] void $assert(_Bool expr, ...);
[7d856cc]68/*@ depends_on \nothing;
[c3bddc1]69 @ executes_when $true;
[7d856cc]70 @*/
[39c2026]71$system[civlc] void $assume(_Bool expr);
[7cdceea]72/*@ depends_on \nothing;
[c3bddc1]73 @ executes_when $true;
[dba07d0]74 @*/
75$system[civlc] void $elaborate(int x);
[7cdceea]76/*@ depends_on \access(p);
[c3bddc1]77 @ executes_when $true;
[fccb5a6]78 @*/
79$system[civlc] void $free(void* p);
[7cdceea]80//========================== mpi.h =========================
81typedef enum MPI_Datatype{
82 MPI_CHAR=0,
83 MPI_CHARACTER=1,
84 MPI_SIGNED_CHAR,
85 MPI_UNSIGNED_CHAR,
86 MPI_BYTE=2,
87 MPI_WCHAR,
88 MPI_SHORT=3,
89 MPI_UNSIGNED_SHORT,
90 MPI_INT=4,
91 MPI_INT16_T,
92 MPI_INT32_T,
93 MPI_INT64_T,
94 MPI_INT8_T,
95 MPI_INTEGER,
96 MPI_INTEGER1,
97 MPI_INTEGER16,
98 MPI_INTEGER2,
99 MPI_INTEGER4,
100 MPI_INTEGER8,
101 MPI_UNSIGNED,
102 MPI_LONG=5,
103 MPI_UNSIGNED_LONG,
104 MPI_FLOAT=9,
105 MPI_DOUBLE=10,
106 MPI_LONG_DOUBLE=11,
107 MPI_LONG_LONG_INT=6,
108 MPI_UNSIGNED_LONG_LONG=7,
109 MPI_LONG_LONG=8,
110 MPI_PACKED,
111 MPI_LB,
112 MPI_UB,
113 MPI_UINT16_T,
114 MPI_UINT32_T,
115 MPI_UINT64_T,
116 MPI_UINT8_T,
117 MPI_FLOAT_INT,
118 MPI_DOUBLE_INT,
119 MPI_LONG_INT,
120 MPI_SHORT_INT,
121 MPI_2INT=12,
122 MPI_LONG_DOUBLE_INT,
123 MPI_AINT,
124 MPI_OFFSET,
125 MPI_2DOUBLE_PRECISION,
126 MPI_2INTEGER,
127 MPI_2REAL,
128 MPI_C_BOOL,
129 MPI_C_COMPLEX,
130 MPI_C_DOUBLE_COMPLEX,
131 MPI_C_FLOAT_COMPLEX,
132 MPI_C_LONG_DOUBLE_COMPLEX,
133 MPI_COMPLEX,
134 MPI_COMPLEX16,
135 MPI_COMPLEX32,
136 MPI_COMPLEX4,
137 MPI_COMPLEX8,
138 MPI_REAL,
139 MPI_REAL16,
140 MPI_REAL2,
141 MPI_REAL4,
142 MPI_REAL8
143} MPI_Datatype;
[f65e51c]144//======================= sum_array.c ======================
145$input long NB = 20;
146$input long N;
147$assume((0 < N) && (N <= NB));
[fccb5a6]148//========================= seq.cvh ========================
[7cdceea]149/*@ depends_on \access(array);
[c3bddc1]150 @ executes_when $true;
151 @*/
152$system[seq] int $seq_length(void* array);
[7cdceea]153/*@ depends_on \access(array, value);
[c3bddc1]154 @ executes_when $true;
155 @*/
[fccb5a6]156$system[seq] void $seq_init(void* array, int count, void* value);
[7cdceea]157/*@ depends_on \access(array, values);
[c3bddc1]158 @ executes_when $true;
159 @*/
160$system[seq] void $seq_insert(void* array, int index, void* values, int count);
[7cdceea]161/*@ depends_on \access(array, values);
[c3bddc1]162 @*/
163$atomic_f void $seq_append(void* array, void* values, int count);
[7d856cc]164//======================= bundle.cvh =======================
[53d9ac1]165typedef struct _bundle $bundle;
[7cdceea]166/*@ depends_on \access(ptr);
[c3bddc1]167 @ executes_when $true;
[7d856cc]168 @*/
[39c2026]169$system[bundle] $bundle $bundle_pack(void* ptr, int size);
[7cdceea]170/*@ depends_on \access(ptr);
[c3bddc1]171 @ executes_when $true;
172 @*/
[39c2026]173$system[bundle] void $bundle_unpack($bundle bundle, void* ptr);
[7d856cc]174//===================== concurrency.cvh ====================
[c3bddc1]175typedef struct _gbarrier* $gbarrier;
176typedef struct _barrier* $barrier;
177/*@ depends_on \nothing;
[dba07d0]178 @ assigns \nothing;
[fccb5a6]179 @ reads \nothing;
[7d856cc]180 @*/
[fccb5a6]181$atomic_f $gbarrier $gbarrier_create($scope scope, int size);
[7cdceea]182/*@ depends_on \access(gbarrier);
[fccb5a6]183 @ reads \nothing;
184 @ assigns gbarrier;
[7d856cc]185 @*/
[fccb5a6]186$atomic_f void $gbarrier_destroy($gbarrier gbarrier);
[7d856cc]187/*@ depends_on \nothing;
[fccb5a6]188 @ assigns gbarrier;
189 @ reads gbarrier;
[7d856cc]190 @*/
[fccb5a6]191$atomic_f $barrier $barrier_create($scope scope, $gbarrier gbarrier, int place);
[7cdceea]192/*@ depends_on \access(barrier);
[fccb5a6]193 @ assigns barrier;
194 @ reads \nothing;
[7d856cc]195 @*/
[fccb5a6]196$atomic_f void $barrier_destroy($barrier barrier);
[7d856cc]197//======================== comm.cvh ========================
[c3bddc1]198typedef struct _message{
[f65e51c]199 int source;
200 int dest;
201 int tag;
202 $bundle data;
203 int size;
[7d856cc]204} $message;
[c3bddc1]205typedef struct _queue $queue;
206typedef struct _gcomm* $gcomm;
207typedef struct _comm* $comm;
[7cdceea]208/*@ depends_on \access(data);
[7d856cc]209 @ executes_when $true;
210 @*/
211$atomic_f $message $message_pack(int source, int dest, int tag, void* data, int size);
[7cdceea]212/*@ depends_on \nothing;
[7d856cc]213 @ executes_when $true;
214 @*/
215$atomic_f int $message_source($message message);
[7cdceea]216/*@ depends_on \nothing;
[7d856cc]217 @ executes_when $true;
218 @*/
219$atomic_f int $message_tag($message message);
[7cdceea]220/*@ depends_on \nothing;
[7d856cc]221 @ executes_when $true;
222 @*/
223$atomic_f int $message_dest($message message);
[7cdceea]224/*@ depends_on \nothing;
[7d856cc]225 @ executes_when $true;
226 @*/
227$atomic_f int $message_size($message message);
[7cdceea]228/*@ depends_on \access(buf);
[7d856cc]229 @ executes_when $true;
230 @*/
231$atomic_f void $message_unpack($message message, void* buf, int size);
232/*@ depends_on \nothing;
[fccb5a6]233 @ assigns \nothing;
234 @ reads \nothing;
[7d856cc]235 @*/
[fccb5a6]236$atomic_f $gcomm $gcomm_create($scope scope, int size);
[7cdceea]237/*@ depends_on \access(junkMsgs), \access(gcomm);
[fccb5a6]238 @ assigns junkMsgs, gcomm;
[7d856cc]239 @*/
[fccb5a6]240$atomic_f int $gcomm_destroy($gcomm gcomm, void* junkMsgs);
[7cdceea]241/*@ depends_on \nothing;
242 @ reads gcomm;
243 @ assigns gcomm;
244 @*/
[6b88ea3]245$atomic_f $comm $comm_create($scope scope, $gcomm gcomm, int place);
[7cdceea]246/*@ depends_on \access(comm);
[fccb5a6]247 @ assigns comm;
248 @ reads \nothing;
[7d856cc]249 @*/
[fccb5a6]250$atomic_f void $comm_destroy($comm comm);
[7cdceea]251/*@ depends_on \nothing;
[7d856cc]252 @*/
[c3bddc1]253$atomic_f int $comm_size($comm comm);
[7cdceea]254/*@ depends_on \nothing;
[7d856cc]255 @ executes_when $true;
256 @*/
257$atomic_f int $comm_place($comm comm);
[7cdceea]258/*@ depends_on \access(comm);
[7d856cc]259 @ executes_when $true;
260 @*/
[39c2026]261$system[comm] void $comm_enqueue($comm comm, $message message);
[7cdceea]262/*@ depends_on \access(comm);
[c3bddc1]263 @ executes_when $true;
264 @*/
[e3ed948]265$system[comm] $state_f _Bool $comm_probe($comm comm, int source, int tag);
[7cdceea]266/*@ depends_on \access(comm);
[c3bddc1]267 @ executes_when $comm_probe(comm, source, tag);
[7d856cc]268 @*/
[39c2026]269$system[comm] $message $comm_dequeue($comm comm, int source, int tag);
[7cdceea]270//======================= collate.cvh ======================
271typedef struct _gcollator* $gcollator;
272typedef struct _collator* $collator;
273typedef struct _gcollate_state* $gcollate_state;
274$atomic_f $gcollator $gcollator_create($scope scope, int nprocs);
275$atomic_f $collator $collator_create($gcollator gcollator, $scope scope, int place);
[7d856cc]276//====================== civl-mpi.cvh ======================
277typedef struct $mpi_gcomm $mpi_gcomm;
[dba07d0]278$mpi_gcomm $mpi_gcomm_create($scope, int);
279void $mpi_gcomm_destroy($mpi_gcomm);
[f65e51c]280//========================= seq.cvl ========================
281$atomic_f void $seq_append(void* array, void* values, int count) {
282 int length = $seq_length(array);
283 $seq_insert(array, length, values, count);
284}
[7d856cc]285//===================== concurrency.cvl ====================
[c3bddc1]286struct _gbarrier{
[f65e51c]287 int nprocs;
288 $proc proc_map[];
289 _Bool in_barrier[];
290 int num_in_barrier;
[7d856cc]291};
[c3bddc1]292struct _barrier{
[f65e51c]293 int place;
294 $gbarrier gbarrier;
[7d856cc]295};
[f65e51c]296$atomic_f $gbarrier $gbarrier_create($scope scope, int size) {
[c3bddc1]297 $gbarrier gbarrier = ($gbarrier)($malloc(scope, sizeof(struct _gbarrier)));
[fccb5a6]298 (gbarrier)->nprocs = size;
[6e64101]299 (gbarrier)->proc_map = (($proc[size]) $lambda (int i) $proc_null);
300 (gbarrier)->in_barrier = ((_Bool[size]) $lambda (int i) 0);
[fccb5a6]301 (gbarrier)->num_in_barrier = 0;
302 return gbarrier;
303}
[f65e51c]304$atomic_f void $gbarrier_destroy($gbarrier gbarrier) {
[fccb5a6]305 $free(gbarrier);
306}
[f65e51c]307$atomic_f $barrier $barrier_create($scope scope, $gbarrier gbarrier, int place) {
[fccb5a6]308 $assert(((gbarrier)->proc_map[place]) == $proc_null, "the place %d in the global barrier has already been taken.", place);
[c3bddc1]309 $barrier barrier = ($barrier)($malloc(scope, sizeof(struct _barrier)));
[fccb5a6]310 (barrier)->place = place;
311 (barrier)->gbarrier = gbarrier;
312 (gbarrier)->proc_map[place] = $self;
313 return barrier;
314}
[f65e51c]315$atomic_f void $barrier_destroy($barrier barrier) {
[fccb5a6]316 $free(barrier);
317}
[f65e51c]318//====================== civl-mpi.cvl ======================
319char* $mpi_coroutine_name(int tag);
320struct $mpi_gcomm{
321 $gcomm p2p;
322 $gcomm col;
323 $gcollator gcollator;
324 $gbarrier gbarrier;
325};
326$mpi_gcomm $mpi_gcomm_create($scope scope, int size) {
327 $mpi_gcomm result;
328 result.p2p = $gcomm_create(scope, size);
329 result.col = $gcomm_create(scope, size);
[7cdceea]330 result.gcollator = $gcollator_create(scope, size);
[f65e51c]331 result.gbarrier = $gbarrier_create(scope, size);
332 return result;
333}
334void $mpi_gcomm_destroy($mpi_gcomm gc) {
335 int numJunkMsg;
336 $message junkMsgs[];
337 $seq_init(&(junkMsgs), 0, (void*)0);
338 numJunkMsg = $gcomm_destroy(gc.p2p, &(junkMsgs));
339 {
340 int i = 0;
341 for (; i < numJunkMsg; i = i + 1) {
342 int src;
343 int dest;
344 int tag;
345 src = $message_source(junkMsgs[i]);
346 dest = $message_dest(junkMsgs[i]);
347 tag = $message_tag(junkMsgs[i]);
[7cdceea]348 $assert(0, "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);
[f65e51c]349 }
350 }
351 numJunkMsg = $gcomm_destroy(gc.col, &(junkMsgs));
352 {
353 int i = 0;
354 for (; i < numJunkMsg; i = i + 1) {
355 int src;
356 int tag;
357 char* routine;
358 src = $message_source(junkMsgs[i]);
359 tag = $message_tag(junkMsgs[i]);
360 routine = $mpi_coroutine_name(tag);
[7cdceea]361 $assert(0, "MPI message leak: There is a message sent by rank %d for collective routine %s that is never received.", src, routine);
[f65e51c]362 }
363 }
[7cdceea]364 $free(gc.gcollator);
[f65e51c]365 $gbarrier_destroy(gc.gbarrier);
366}
367char* $mpi_coroutine_name(int tag) {
368 switch (tag) {
369 case 9999:
370 return "MPI_Bcast";
371 case 9998:
372 return "MPI_Reduce";
373 case 9997:
374 return "MPI_Allreduce";
375 case 9996:
376 return "MPI_Gather";
377 case 9995:
378 return "MPI_Scatter";
379 case 9994:
380 return "MPI_Gatherv";
381 case 9993:
382 return "MPI_Scatterv";
383 case 9992:
384 return "MPI_Allgather";
385 case 9991:
386 return "MPI_Reduce_scatter";
387 case 9990:
388 return "MPI_Alltoall";
389 case 9989:
390 return "MPI_Alltoallv";
391 case 9988:
392 return "MPI_Alltoallw";
393 case 9987:
394 return "MPI_Barrier";
395 case 9986:
396 return "MPI_Commdup";
397 case 9985:
398 return "MPI_Commfree";
399 default:
[7cdceea]400 $assert(0, "Internal Error: Unexpected MPI routine tag:%d.\n", tag);
[f65e51c]401 }
402}
403//======================== comm.cvl ========================
404struct _queue{
405 int length;
406 $message messages[];
407};
408struct _gcomm{
409 int nprocs;
410 $proc procs[];
411 _Bool isInit[];
412 $queue buf[][];
413};
414struct _comm{
415 int place;
416 $gcomm gcomm;
417};
418$atomic_f $message $message_pack(int source, int dest, int tag, void* data, int size) {
419 $message result;
420 result.source = source;
421 result.dest = dest;
422 result.tag = tag;
[7cdceea]423 if ((data != (void*)0) && (size > 0)) {
424 result.data = $bundle_pack(data, size);
425 }
426 else
427 if (data == (void*)0)
428 $assert(size == 0, "Attempt to pack a non-zero size message with a NULL pointer");
[f65e51c]429 result.size = size;
430 return result;
431}
432int $message_source($message message) {
433 return message.source;
434}
435int $message_tag($message message) {
436 return message.tag;
437}
438int $message_dest($message message) {
439 return message.dest;
440}
441int $message_size($message message) {
442 return message.size;
443}
444$atomic_f void $message_unpack($message message, void* buf, int size) {
[7cdceea]445 if ((buf != (void*)0) && (message.size > 0)) {
446 $bundle_unpack(message.data, buf);
447 $assert(message.size <= size, "Message of size %d exceeds the specified size %d.", message.size, size);
448 }
449 else
450 if (buf == (void*)0)
451 $assert(message.size == 0, "Attempt to unpack a non-zero size message with a NULL pointer.");
[f65e51c]452}
453$atomic_f $gcomm $gcomm_create($scope scope, int size) {
[c3bddc1]454 $gcomm gcomm = ($gcomm)($malloc(scope, sizeof(struct _gcomm)));
[fccb5a6]455 $queue empty;
456 empty.length = 0;
457 $seq_init(&(empty.messages), 0, (void*)0);
458 (gcomm)->nprocs = size;
[6e64101]459 (gcomm)->procs = (($proc[size]) $lambda (int i) $proc_null);
460 (gcomm)->isInit = ((_Bool[size]) $lambda (int i) 0);
461 (gcomm)->buf = (($queue[size][size]) $lambda (int i, j) empty);
[fccb5a6]462 return gcomm;
463}
[f65e51c]464$atomic_f int $gcomm_destroy($gcomm gcomm, void* junkMsgs) {
[c3bddc1]465 int nprocs = (gcomm)->nprocs;
466 int numJunks = 0;
[f65e51c]467 if (junkMsgs != (void*)0) {
[c3bddc1]468 {
469 int i = 0;
[f65e51c]470 for (; i < nprocs; i = i + 1) {
[c3bddc1]471 int j = 0;
[f65e51c]472 for (; j < nprocs; j = j + 1) {
[c3bddc1]473 $queue queue = (gcomm)->buf[i][j];
474 if (queue.length > 0)
475 $seq_append(junkMsgs, queue.messages, queue.length);
476 }
477 }
478 }
479 numJunks = $seq_length(junkMsgs);
480 }
[fccb5a6]481 $free(gcomm);
[c3bddc1]482 return numJunks;
[fccb5a6]483}
[f65e51c]484$atomic_f $comm $comm_create($scope scope, $gcomm gcomm, int place) {
[fccb5a6]485 $assert(!((gcomm)->isInit[place]), "the place %d is already occupied in the global communicator!", place);
[c3bddc1]486 $comm comm = ($comm)($malloc(scope, sizeof(struct _comm)));
[fccb5a6]487 (gcomm)->procs[place] = $self;
[7cdceea]488 (gcomm)->isInit[place] = 1;
[fccb5a6]489 (comm)->gcomm = gcomm;
490 (comm)->place = place;
491 return comm;
492}
[f65e51c]493$atomic_f void $comm_destroy($comm comm) {
[fccb5a6]494 $free(comm);
495}
[f65e51c]496$atomic_f int $comm_place($comm comm) {
[7d856cc]497 return (comm)->place;
498}
[f65e51c]499$atomic_f int $comm_size($comm comm) {
[c3bddc1]500 return ((comm)->gcomm)->nprocs;
501}
[7cdceea]502//======================= collate.cvl ======================
503struct _gcollator{
504 int nprocs;
505 $proc procs[];
506 int queue_length;
507 $gcollate_state queue[];
508 _Bool entered[];
509};
510struct _collator{
511 int place;
512 $gcollator gcollator;
513};
514struct _gcollate_state{
515 int status[];
516 $state state;
517 $bundle attribute;
518};
519$gcollator $gcollator_create($scope scope, int nprocs) {
520 $gcollator gcollator = ($gcollator)($malloc(scope, sizeof(struct _gcollator)));
521 (gcollator)->nprocs = nprocs;
[6e64101]522 (gcollator)->procs = (($proc[nprocs]) $lambda (int i) $proc_null);
[7cdceea]523 (gcollator)->queue_length = 0;
524 $seq_init(&((gcollator)->queue), 0, (void*)0);
[6e64101]525 (gcollator)->entered = ((_Bool[nprocs]) $lambda (int i) 0);
[7cdceea]526 return gcollator;
527}
528$collator $collator_create($gcollator gcollator, $scope scope, int place) {
529 $collator collator = ($collator)($malloc(scope, sizeof(struct _collator)));
530 (collator)->place = place;
531 (collator)->gcollator = gcollator;
532 ((collator)->gcollator)->procs[place] = $self;
533 return collator;
534}
[7d856cc]535//===================== MPITransformer =====================
536$input int _mpi_nprocs;
537$input int _mpi_nprocs_lo = 1;
538//======================= sum_array.c ======================
539$input int _mpi_nprocs_hi = 8;
540//===================== MPITransformer =====================
541$assume((_mpi_nprocs_lo <= _mpi_nprocs) && (_mpi_nprocs <= _mpi_nprocs_hi));
[c3bddc1]542$scope _mpi_root = $here;
543$mpi_gcomm _mpi_gcomm;
[7d856cc]544$mpi_gcomm _mpi_gcomms[];
[f65e51c]545void _mpi_process(int _mpi_rank) {
[7cdceea]546 /*@ depends_on \access(format);
547 @ executes_when $true;
[f65e51c]548 @*/
549 $system[stdio] int printf(char* restrict format, ...);
550 typedef struct MPI_Comm MPI_Comm;
551 MPI_Comm $mpi_comm_create($scope, $mpi_gcomm, int);
[7d856cc]552 MPI_Comm MPI_COMM_WORLD = $mpi_comm_create($here, _mpi_gcomm, _mpi_rank);
[f65e51c]553 typedef struct MPI_Status{
[7cdceea]554 int MPI_SOURCE;
555 int MPI_TAG;
556 int MPI_ERROR;
557 int size;
[f65e51c]558 } MPI_Status;
559 int MPI_Send(void*, int, MPI_Datatype, int, int, MPI_Comm);
560 int MPI_Recv(void*, int, MPI_Datatype, int, int, MPI_Comm, MPI_Status*);
561 int MPI_Get_count(MPI_Status*, MPI_Datatype, int*);
562 int MPI_Comm_size(MPI_Comm, int*);
563 int MPI_Comm_rank(MPI_Comm, int*);
564 typedef enum _mpi_state{
[7cdceea]565 _MPI_UNINIT,
566 _MPI_INIT,
567 _MPI_FINALIZED
[f65e51c]568 } $mpi_state;
[6b88ea3]569 $mpi_state _mpi_state = _MPI_UNINIT;
[f65e51c]570 int $mpi_init(void) {
[6b88ea3]571 $assert(_mpi_state == _MPI_UNINIT, "Process can only call MPI_Init() at most once.");
572 _mpi_state = _MPI_INIT;
573 return 0;
574 }
[f65e51c]575 void $mpi_comm_destroy(MPI_Comm, $mpi_state);
576 int MPI_Finalize(void);
[7d856cc]577 double oracle;
578 void master(void);
579 void slave(void);
[f65e51c]580 int _civl_main(int argc, char** argv) {
[7d856cc]581 int myrank;
582 $mpi_init();
583 MPI_Comm_rank(MPI_COMM_WORLD, &(myrank));
584 if (!myrank)
585 master();
586 else
587 slave();
[6b88ea3]588 MPI_Finalize();
[7d856cc]589 return 0;
590 }
[f65e51c]591 void master(void) {
[7d856cc]592 float array[N];
593 double mysum;
594 double tmpsum;
595 unsigned long long step;
596 unsigned long long i;
597 int size;
598 MPI_Status status;
[7cdceea]599 for (i = $signed_to_unsigned(0, 4294967296); i < N; i = i + 1) {
600 unsigned long long $sef$12 = $signed_to_unsigned(1, 4294967296);
601 array[i] = i + $sef$12;
602 }
[7d856cc]603 oracle = 0.0;
[7cdceea]604 for (i = $signed_to_unsigned(0, 4294967296); i < N; i = i + 1)
[7d856cc]605 oracle = oracle + (array[i]);
606 MPI_Comm_size(MPI_COMM_WORLD, &(size));
607 if (size != 1)
[39c2026]608 step = $int_div(N, size - 1);
[7d856cc]609 else
610 step = N;
[7cdceea]611 for (i = $signed_to_unsigned(0, 4294967296); i < (size - 1); i = i + 1) {
612 unsigned long long $sef$13 = $signed_to_unsigned(1, 4294967296);
613 MPI_Send(array + (i * step), step, MPI_FLOAT, i + $sef$13, 100, MPI_COMM_WORLD);
614 }
[7d856cc]615 {
616 i = (size - 1) * step;
617 mysum = 0;
618 for (; i < N; i = i + 1)
619 mysum = mysum + (array[i]);
620 }
[7cdceea]621 for (i = $signed_to_unsigned(1, 4294967296); 1; ) {
622 unsigned long long $sef$14 = $signed_to_unsigned(size, 4294967296);
623 if (!(i < $sef$14))
624 break;
[7d856cc]625 MPI_Recv(&(tmpsum), 1, MPI_DOUBLE, -1, 101, MPI_COMM_WORLD, &(status));
626 mysum = mysum + tmpsum;
627 i = i + 1;
628 }
629 $assert(oracle == mysum, "The sum of %d array elements is %f but the expected one is %f.\n", N, mysum, oracle);
630 printf("%lf\n", mysum);
631 }
[f65e51c]632 void slave(void) {
[7d856cc]633 float array[N];
634 double sum;
635 unsigned long long i;
636 int count;
637 MPI_Status status;
638 MPI_Recv(array, N, MPI_FLOAT, 0, 100, MPI_COMM_WORLD, &(status));
639 MPI_Get_count(&(status), MPI_FLOAT, &(count));
640 {
[7cdceea]641 i = $signed_to_unsigned(0, 4294967296);
[7d856cc]642 sum = 0;
[7cdceea]643 for (; 1; i = i + 1) {
644 unsigned long long $sef$15 = $signed_to_unsigned(count, 4294967296);
645 if (!(i < $sef$15))
646 break;
[7d856cc]647 sum = sum + (array[i]);
[7cdceea]648 }
[7d856cc]649 }
650 MPI_Send(&(sum), 1, MPI_DOUBLE, 0, 101, MPI_COMM_WORLD);
651 }
[7cdceea]652 /*@ depends_on \nothing;
653 @ executes_when $true;
654 @*/
655 $atomic_f $state_f int sizeofDatatype(MPI_Datatype);
[f65e51c]656 int $mpi_send(void*, int, MPI_Datatype, int, int, MPI_Comm);
657 int $mpi_recv(void*, int, MPI_Datatype, int, int, MPI_Comm, MPI_Status*);
[7cdceea]658 /*@ depends_on \access(buf);
659 @ executes_when $true;
[f65e51c]660 @*/
661 $system[mpi] void $mpi_check_buffer(void* buf, int count, MPI_Datatype datatype);
662 struct MPI_Comm{
[7cdceea]663 $comm p2p;
664 $comm col;
665 $collator collator;
666 $barrier barrier;
667 int gcommIndex;
[f65e51c]668 };
669 int MPI_Finalize(void) {
670 $assert(_mpi_state == _MPI_INIT, "Process can only call MPI_Finalize() after the MPI enviroment is created and before cleaned.");
671 _mpi_state = _MPI_FINALIZED;
672 return 0;
673 }
674 int MPI_Comm_size(MPI_Comm comm, int* size) {
675 $assert(_mpi_state == _MPI_INIT, "MPI_Comm_size() cannot be invoked without MPI_Init() being called before.\n");
676 *size = $comm_size(comm.p2p);
677 return 0;
678 }
679 int MPI_Comm_rank(MPI_Comm comm, int* rank) {
680 $assert(_mpi_state == _MPI_INIT, "MPI_Comm_rank() cannot be invoked without MPI_Init() being called before.\n");
681 *rank = $comm_place(comm.p2p);
682 return 0;
683 }
684 int MPI_Send(void* buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm) {
685 $assert(_mpi_state == _MPI_INIT, "MPI_Send() cannot be invoked without MPI_Init() being called before.\n");
686 $mpi_check_buffer(buf, count, datatype);
[7cdceea]687 int $sef$16 = $mpi_send(buf, count, datatype, dest, tag, comm);
688 return $sef$16;
[f65e51c]689 }
690 int MPI_Recv(void* buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Status* status) {
691 $assert(_mpi_state == _MPI_INIT, "MPI_Recv() cannot be invoked without MPI_Init() being called before.\n");
[7cdceea]692 int $sef$17 = $mpi_recv(buf, count, datatype, source, tag, comm, status);
693 return $sef$17;
[f65e51c]694 }
695 int MPI_Get_count(MPI_Status* status, MPI_Datatype datatype, int* count) {
696 $assert(_mpi_state == _MPI_INIT, "MPI_Get_count() cannot be invoked without MPI_Init() being called before.\n");
[7cdceea]697 int $sef$18 = sizeofDatatype(datatype);
698 *count = $int_div((status)->size, $sef$18);
[f65e51c]699 return 0;
700 }
701 int sizeofDatatype(MPI_Datatype datatype) {
[7cdceea]702 size_t result;
[f65e51c]703 switch (datatype) {
704 case MPI_INT:
[7cdceea]705 result = sizeof(int);
706 break;
[f65e51c]707 case MPI_2INT:
[7cdceea]708 result = sizeof(int) * 2;
709 break;
[f65e51c]710 case MPI_FLOAT:
[7cdceea]711 result = sizeof(float);
712 break;
[f65e51c]713 case MPI_DOUBLE:
[7cdceea]714 result = sizeof(double);
715 break;
[f65e51c]716 case MPI_CHAR:
[7cdceea]717 result = sizeof(char);
718 break;
[f65e51c]719 case MPI_BYTE:
[7cdceea]720 result = sizeof(char);
721 break;
[f65e51c]722 case MPI_SHORT:
[7cdceea]723 result = sizeof(short);
724 break;
[f65e51c]725 case MPI_LONG:
[7cdceea]726 result = sizeof(long);
727 break;
[f65e51c]728 case MPI_LONG_DOUBLE:
[7cdceea]729 result = sizeof(long double);
730 break;
[f65e51c]731 case MPI_LONG_LONG_INT:
[7cdceea]732 result = sizeof(long long);
733 break;
[f65e51c]734 case MPI_LONG_LONG:
[7cdceea]735 result = sizeof(long long);
736 break;
[f65e51c]737 case MPI_UNSIGNED_LONG_LONG:
[7cdceea]738 result = sizeof(unsigned long long);
739 break;
[f65e51c]740 default:
741 $assert(0, "Unreachable");
742 }
[7cdceea]743 return result;
[f65e51c]744 }
745 MPI_Comm $mpi_comm_create($scope scope, $mpi_gcomm gc, int rank) {
746 MPI_Comm result;
747 result.p2p = $comm_create(scope, gc.p2p, rank);
748 result.col = $comm_create(scope, gc.col, rank);
[7cdceea]749 result.collator = $collator_create(gc.gcollator, scope, rank);
[f65e51c]750 result.barrier = $barrier_create(scope, gc.gbarrier, rank);
751 result.gcommIndex = 0;
752 return result;
753 }
754 void $mpi_comm_destroy(MPI_Comm comm, $mpi_state mpi_state) {
755 if (comm.gcommIndex == 0)
756 $assert(mpi_state == _MPI_FINALIZED, "Process terminates without calling MPI_Finalize() first.");
757 $comm_destroy(comm.p2p);
758 $comm_destroy(comm.col);
[7cdceea]759 $free(comm.collator);
[f65e51c]760 $barrier_destroy(comm.barrier);
761 }
762 int $mpi_send(void* buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm) {
[7cdceea]763 if ((dest >= 0) && (count >= 0)) {
764 int $sef$26 = sizeofDatatype(datatype);
765 int size = count * $sef$26;
[f65e51c]766 int place = $comm_place(comm.p2p);
[7cdceea]767 $message out;
768 $elaborate(dest);
769 out = $message_pack(place, dest, tag, buf, size);
[f65e51c]770 $comm_enqueue(comm.p2p, out);
771 }
772 return 0;
773 }
774 int $mpi_recv(void* buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Status* status) {
[7cdceea]775 if (((source >= 0) || (source == (-1))) && (count >= 0)) {
[f65e51c]776 $message in;
777 int place = $comm_place(comm.p2p);
778 int deterministicTag;
779 $assert((tag == (-2)) || (tag >= 0), "Illegal MPI message receive tag %d.\n", tag);
780 deterministicTag = tag < 0 ? -2 : tag;
781 $elaborate(source);
782 in = $comm_dequeue(comm.p2p, source, deterministicTag);
[7cdceea]783 int $sef$27 = sizeofDatatype(datatype);
784 int size = count * $sef$27;
[f65e51c]785 $message_unpack(in, buf, size);
786 if (status != (void*)0) {
787 (status)->size = $message_size(in);
788 (status)->MPI_SOURCE = $message_source(in);
789 (status)->MPI_TAG = $message_tag(in);
790 (status)->MPI_ERROR = 0;
791 }
792 }
793 return 0;
794 }
[7d856cc]795 {
[6e64101]796 _civl_main(_civl_argc, ((char*[_civl_argc]) $lambda (int i) _civl_argv[i]));
[7d856cc]797 }
[6b88ea3]798 $mpi_comm_destroy(MPI_COMM_WORLD, _mpi_state);
[7d856cc]799}
[f65e51c]800int main() {
[c3bddc1]801 _mpi_gcomm = $mpi_gcomm_create(_mpi_root, _mpi_nprocs);
802 $seq_init(&(_mpi_gcomms), 1, &(_mpi_gcomm));
[7d856cc]803 $parfor (int i: 0 .. _mpi_nprocs - 1)
804 _mpi_process(i);
805 $mpi_gcomm_destroy(_mpi_gcomm);
806}
Note: See TracBrowser for help on using the repository browser.