| [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] | 6 | int $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 ===================
|
|---|
| 32 | int $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 =======================
|
|---|
| 56 | typedef 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] | 61 | typedef unsigned long size_t;
|
|---|
| [f65e51c] | 62 | typedef struct $proc $proc;
|
|---|
| [7cdceea] | 63 | typedef 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 =========================
|
|---|
| 81 | typedef 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] | 165 | typedef 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] | 175 | typedef struct _gbarrier* $gbarrier;
|
|---|
| 176 | typedef 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] | 198 | typedef struct _message{
|
|---|
| [f65e51c] | 199 | int source;
|
|---|
| 200 | int dest;
|
|---|
| 201 | int tag;
|
|---|
| 202 | $bundle data;
|
|---|
| 203 | int size;
|
|---|
| [7d856cc] | 204 | } $message;
|
|---|
| [c3bddc1] | 205 | typedef struct _queue $queue;
|
|---|
| 206 | typedef struct _gcomm* $gcomm;
|
|---|
| 207 | typedef 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 ======================
|
|---|
| 271 | typedef struct _gcollator* $gcollator;
|
|---|
| 272 | typedef struct _collator* $collator;
|
|---|
| 273 | typedef 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 ======================
|
|---|
| 277 | typedef struct $mpi_gcomm $mpi_gcomm;
|
|---|
| [dba07d0] | 278 | $mpi_gcomm $mpi_gcomm_create($scope, int);
|
|---|
| 279 | void $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] | 286 | struct _gbarrier{
|
|---|
| [f65e51c] | 287 | int nprocs;
|
|---|
| 288 | $proc proc_map[];
|
|---|
| 289 | _Bool in_barrier[];
|
|---|
| 290 | int num_in_barrier;
|
|---|
| [7d856cc] | 291 | };
|
|---|
| [c3bddc1] | 292 | struct _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 ======================
|
|---|
| 319 | char* $mpi_coroutine_name(int tag);
|
|---|
| 320 | struct $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 | }
|
|---|
| 334 | void $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 | }
|
|---|
| 367 | char* $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 ========================
|
|---|
| 404 | struct _queue{
|
|---|
| 405 | int length;
|
|---|
| 406 | $message messages[];
|
|---|
| 407 | };
|
|---|
| 408 | struct _gcomm{
|
|---|
| 409 | int nprocs;
|
|---|
| 410 | $proc procs[];
|
|---|
| 411 | _Bool isInit[];
|
|---|
| 412 | $queue buf[][];
|
|---|
| 413 | };
|
|---|
| 414 | struct _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 | }
|
|---|
| 432 | int $message_source($message message) {
|
|---|
| 433 | return message.source;
|
|---|
| 434 | }
|
|---|
| 435 | int $message_tag($message message) {
|
|---|
| 436 | return message.tag;
|
|---|
| 437 | }
|
|---|
| 438 | int $message_dest($message message) {
|
|---|
| 439 | return message.dest;
|
|---|
| 440 | }
|
|---|
| 441 | int $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 ======================
|
|---|
| 503 | struct _gcollator{
|
|---|
| 504 | int nprocs;
|
|---|
| 505 | $proc procs[];
|
|---|
| 506 | int queue_length;
|
|---|
| 507 | $gcollate_state queue[];
|
|---|
| 508 | _Bool entered[];
|
|---|
| 509 | };
|
|---|
| 510 | struct _collator{
|
|---|
| 511 | int place;
|
|---|
| 512 | $gcollator gcollator;
|
|---|
| 513 | };
|
|---|
| 514 | struct _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] | 545 | void _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] | 800 | int 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 | }
|
|---|