//======================= int_div.cvl ====================== $system[civlc] void $assert(_Bool expr, ...); int $int_div(int numerator, int denominator) { $assert(denominator != 0, "Possible division by zero"); if (numerator == 0) return 0; if (numerator >= 0) { if (denominator >= 0) return numerator / denominator; else return -(numerator / (-denominator)); } else { if (denominator >= 0) return -((-numerator) / denominator); else return (-numerator) / (-denominator); } } //======================== civlc.cvh ======================= typedef struct $proc $proc; typedef struct $scope $scope; /*@ depends_on \nothing; @*/ $system[civlc] void $assert(_Bool expr, ...); /*@ depends_on \nothing; @*/ $system[civlc] void $assume(_Bool expr); /*@ pure; @ depends_on \nothing; @*/ $system[civlc] void $elaborate(int x); /*@ depends_on \nothing; @*/ $system[civlc] void $assert(_Bool expr, ...); /*@ depends_on \nothing; @*/ $system[civlc] void $assume(_Bool expr); /*@ pure; @ depends_on \nothing; @*/ $system[civlc] void $elaborate(int x); //========================= stdio.h ======================== $system[stdio] int printf(char* restrict format, ...); //======================== civlc.cvh ======================= /*@ depends_on \nothing; @*/ $system[civlc] void $assert(_Bool expr, ...); /*@ depends_on \nothing; @*/ $system[civlc] void $assume(_Bool expr); /*@ pure; @ depends_on \nothing; @*/ $system[civlc] void $elaborate(int x); //======================= bundle.cvh ======================= typedef struct $bundle $bundle; /*@ pure; @*/ $system[bundle] $bundle $bundle_pack(void* ptr, int size); $system[bundle] void $bundle_unpack($bundle bundle, void* ptr); //===================== concurrency.cvh ==================== typedef struct $gbarrier* $gbarrier; typedef struct $barrier* $barrier; /*@ requires size >= 0; @ depends_on \nothing; @ executes_when $true; @ assigns \nothing; @*/ $system[concurrency] $gbarrier $gbarrier_create($scope scope, int size); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] void $gbarrier_destroy($gbarrier barrier); /*@ depends_on \nothing; @ assigns \nothing; @ executes_when $true; @*/ $system[concurrency] $barrier $barrier_create($scope scope, $gbarrier gbarrier, int place); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] void $barrier_destroy($barrier barrier); typedef struct $collect_record $collect_record; typedef struct $gcollect_checker* $gcollect_checker; typedef struct $collect_checker* $collect_checker; /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] $gcollect_checker $gcollect_checker_create($scope scope); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] int $gcollect_checker_destroy($gcollect_checker checker); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] $collect_checker $collect_checker_create($scope scope, $gcollect_checker gchecker); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] void $collect_checker_destroy($collect_checker checker); //========================== mpi.h ========================= typedef enum $anon_enum_0{ MPI_CHAR, MPI_CHARACTER, MPI_SIGNED_CHAR, MPI_UNSIGNED_CHAR, MPI_BYTE, MPI_WCHAR, MPI_SHORT, MPI_UNSIGNED_SHORT, MPI_INT, MPI_INT16_T, MPI_INT32_T, MPI_INT64_T, MPI_INT8_T, MPI_INTEGER, MPI_INTEGER1, MPI_INTEGER16, MPI_INTEGER2, MPI_INTEGER4, MPI_INTEGER8, MPI_UNSIGNED, MPI_LONG, MPI_UNSIGNED_LONG, MPI_FLOAT, MPI_DOUBLE, MPI_LONG_DOUBLE, MPI_LONG_LONG_INT, MPI_UNSIGNED_LONG_LONG, MPI_LONG_LONG, MPI_PACKED, MPI_LB, MPI_UB, MPI_UINT16_T, MPI_UINT32_T, MPI_UINT64_T, MPI_UINT8_T, MPI_FLOAT_INT, MPI_DOUBLE_INT, MPI_LONG_INT, MPI_SHORT_INT, MPI_2INT, MPI_LONG_DOUBLE_INT, MPI_AINT, MPI_OFFSET, MPI_2DOUBLE_PRECISION, MPI_2INTEGER, MPI_2REAL, MPI_C_BOOL, MPI_C_COMPLEX, MPI_C_DOUBLE_COMPLEX, MPI_C_FLOAT_COMPLEX, MPI_C_LONG_DOUBLE_COMPLEX, MPI_COMPLEX, MPI_COMPLEX16, MPI_COMPLEX32, MPI_COMPLEX4, MPI_COMPLEX8, MPI_REAL, MPI_REAL16, MPI_REAL2, MPI_REAL4, MPI_REAL8 } MPI_Datatype; typedef struct MPI_Comm MPI_Comm; typedef struct MPI_Status{ int MPI_SOURCE; int MPI_TAG; int MPI_ERROR; int size; } MPI_Status; int MPI_Send(void*, int, MPI_Datatype, int, int, MPI_Comm); int MPI_Recv(void*, int, MPI_Datatype, int, int, MPI_Comm, MPI_Status*); int MPI_Get_count(MPI_Status*, MPI_Datatype, int*); int MPI_Comm_size(MPI_Comm, int*); int MPI_Comm_rank(MPI_Comm, int*); //======================== comm.cvh ======================== typedef struct $message{ int source; int dest; int tag; $bundle data; int size; } $message; typedef struct $queue $queue; typedef struct $gcomm* $gcomm; typedef struct $comm* $comm; /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f $message $message_pack(int source, int dest, int tag, void* data, int size); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_source($message message); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_tag($message message); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_dest($message message); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_size($message message); /*@ depends_on \write(buf); @ executes_when $true; @*/ $atomic_f void $message_unpack($message message, void* buf, int size); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] $gcomm $gcomm_create($scope scope, int size); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] int $gcomm_destroy($gcomm gcomm, void* junkMsgs); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] $comm $comm_create($scope scope, $gcomm gcomm, int place); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] void $comm_destroy($comm comm); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $system[comm] int $comm_size($comm comm); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $comm_place($comm comm); /*@ depends_on \write(comm); @ executes_when $true; @*/ $system[comm] void $comm_enqueue($comm comm, $message message); /*@ depends_on \write(comm); @*/ $system[comm] $message $comm_dequeue($comm comm, int source, int tag); //====================== civl-mpi.cvh ====================== typedef enum _mpi_sys_status_{ __UNINIT, __INIT, __FINALIZED } $mpi_sys_status; typedef struct MPI_Comm MPI_Comm; typedef struct MPI_Status MPI_Status; typedef struct $mpi_gcomm $mpi_gcomm; int sizeofDatatype(MPI_Datatype); $system[mpi] void $mpi_set_status($mpi_sys_status newStatus); $system[mpi] $mpi_sys_status $mpi_get_status(void); $mpi_gcomm $mpi_gcomm_create($scope, int); void $mpi_gcomm_destroy($mpi_gcomm); MPI_Comm $mpi_comm_create($scope, $mpi_gcomm, int); void $mpi_comm_destroy(MPI_Comm); int $mpi_init(void); int $mpi_finalize(void); int $mpi_send(void*, int, MPI_Datatype, int, int, MPI_Comm); int $mpi_recv(void*, int, MPI_Datatype, int, int, MPI_Comm, MPI_Status*); $system[mpi] void $mpi_assert_consistent_basetype(void* buf, MPI_Datatype datatype); //========================= mpi.cvl ======================== struct MPI_Comm{ $comm p2p; $comm col; $collect_checker collect_checker; $barrier barrier; int gcommIndex; }; int MPI_Comm_size(MPI_Comm comm, int* size) { $mpi_sys_status curr_status; curr_status = $mpi_get_status(); $assert(curr_status == __INIT, "MPI_Comm_size() cannot be invoked without MPI_Init() being called before.\n"); *size = $comm_size(comm.p2p); return 0; } int MPI_Comm_rank(MPI_Comm comm, int* rank) { $mpi_sys_status curr_status; curr_status = $mpi_get_status(); $assert(curr_status == __INIT, "MPI_Comm_rank() cannot be invoked without MPI_Init() being called before.\n"); *rank = $comm_place(comm.p2p); return 0; } int MPI_Send(void* buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm) { $mpi_sys_status curr_status; curr_status = $mpi_get_status(); $assert(curr_status == __INIT, "MPI_Send() cannot be invoked without MPI_Init() being called before.\n"); $mpi_assert_consistent_basetype(buf, datatype); int $sef$0 = $mpi_send(buf, count, datatype, dest, tag, comm); return $sef$0; } int MPI_Recv(void* buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Status* status) { $mpi_sys_status curr_status; curr_status = $mpi_get_status(); $assert(curr_status == __INIT, "MPI_Recv() cannot be invoked without MPI_Init() being called before.\n"); $mpi_assert_consistent_basetype(buf, datatype); int $sef$1 = $mpi_recv(buf, count, datatype, source, tag, comm, status); return $sef$1; } int MPI_Get_count(MPI_Status* status, MPI_Datatype datatype, int* count) { $mpi_sys_status curr_status; curr_status = $mpi_get_status(); $assert(curr_status == __INIT, "MPI_Get_count() cannot be invoked without MPI_Init() being called before.\n"); int $sef$2 = sizeofDatatype(datatype); *count = $int_div((status)->size, $sef$2); return 0; } //======================== civlc.cvh ======================= /*@ depends_on \nothing; @*/ $system[civlc] void $assert(_Bool expr, ...); /*@ depends_on \nothing; @*/ $system[civlc] void $assume(_Bool expr); /*@ pure; @ depends_on \nothing; @*/ $system[civlc] void $elaborate(int x); //======================= bundle.cvh ======================= /*@ pure; @*/ $system[bundle] $bundle $bundle_pack(void* ptr, int size); $system[bundle] void $bundle_unpack($bundle bundle, void* ptr); //===================== concurrency.cvh ==================== /*@ requires size >= 0; @ depends_on \nothing; @ executes_when $true; @ assigns \nothing; @*/ $system[concurrency] $gbarrier $gbarrier_create($scope scope, int size); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] void $gbarrier_destroy($gbarrier barrier); /*@ depends_on \nothing; @ assigns \nothing; @ executes_when $true; @*/ $system[concurrency] $barrier $barrier_create($scope scope, $gbarrier gbarrier, int place); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] void $barrier_destroy($barrier barrier); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] $gcollect_checker $gcollect_checker_create($scope scope); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] int $gcollect_checker_destroy($gcollect_checker checker); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] $collect_checker $collect_checker_create($scope scope, $gcollect_checker gchecker); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] void $collect_checker_destroy($collect_checker checker); //========================= seq.cvh ======================== $system[seq] void $seq_init(void* array, int count, void* value); //===================== concurrency.cvl ==================== struct $gbarrier{ int nprocs; $proc proc_map[]; _Bool in_barrier[]; int num_in_barrier; }; struct $barrier{ int place; $gbarrier gbarrier; }; struct $collect_record{ $bundle entries; _Bool marks[]; int numMarked; }; struct $gcollect_checker{ int length; $collect_record records[]; }; struct $collect_checker{ $gcollect_checker checker; }; //======================== civlc.cvh ======================= /*@ depends_on \nothing; @*/ $system[civlc] void $assert(_Bool expr, ...); /*@ depends_on \nothing; @*/ $system[civlc] void $assume(_Bool expr); /*@ pure; @ depends_on \nothing; @*/ $system[civlc] void $elaborate(int x); //======================= bundle.cvh ======================= /*@ pure; @*/ $system[bundle] $bundle $bundle_pack(void* ptr, int size); $system[bundle] void $bundle_unpack($bundle bundle, void* ptr); //===================== concurrency.cvh ==================== /*@ requires size >= 0; @ depends_on \nothing; @ executes_when $true; @ assigns \nothing; @*/ $system[concurrency] $gbarrier $gbarrier_create($scope scope, int size); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] void $gbarrier_destroy($gbarrier barrier); /*@ depends_on \nothing; @ assigns \nothing; @ executes_when $true; @*/ $system[concurrency] $barrier $barrier_create($scope scope, $gbarrier gbarrier, int place); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] void $barrier_destroy($barrier barrier); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] $gcollect_checker $gcollect_checker_create($scope scope); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] int $gcollect_checker_destroy($gcollect_checker checker); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] $collect_checker $collect_checker_create($scope scope, $gcollect_checker gchecker); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[concurrency] void $collect_checker_destroy($collect_checker checker); //======================== comm.cvh ======================== /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f $message $message_pack(int source, int dest, int tag, void* data, int size); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_source($message message); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_tag($message message); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_dest($message message); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_size($message message); /*@ depends_on \write(buf); @ executes_when $true; @*/ $atomic_f void $message_unpack($message message, void* buf, int size); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] $gcomm $gcomm_create($scope scope, int size); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] int $gcomm_destroy($gcomm gcomm, void* junkMsgs); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] $comm $comm_create($scope scope, $gcomm gcomm, int place); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] void $comm_destroy($comm comm); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $system[comm] int $comm_size($comm comm); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $comm_place($comm comm); /*@ depends_on \write(comm); @ executes_when $true; @*/ $system[comm] void $comm_enqueue($comm comm, $message message); /*@ depends_on \write(comm); @*/ $system[comm] $message $comm_dequeue($comm comm, int source, int tag); //========================== mpi.h ========================= int MPI_Send(void*, int, MPI_Datatype, int, int, MPI_Comm); int MPI_Recv(void*, int, MPI_Datatype, int, int, MPI_Comm, MPI_Status*); int MPI_Get_count(MPI_Status*, MPI_Datatype, int*); int MPI_Comm_size(MPI_Comm, int*); int MPI_Comm_rank(MPI_Comm, int*); //====================== civl-mpi.cvh ====================== int sizeofDatatype(MPI_Datatype); $system[mpi] void $mpi_set_status($mpi_sys_status newStatus); $system[mpi] $mpi_sys_status $mpi_get_status(void); $mpi_gcomm $mpi_gcomm_create($scope, int); void $mpi_gcomm_destroy($mpi_gcomm); MPI_Comm $mpi_comm_create($scope, $mpi_gcomm, int); void $mpi_comm_destroy(MPI_Comm); int $mpi_init(void); int $mpi_finalize(void); int $mpi_send(void*, int, MPI_Datatype, int, int, MPI_Comm); int $mpi_recv(void*, int, MPI_Datatype, int, int, MPI_Comm, MPI_Status*); $system[mpi] void $mpi_assert_consistent_basetype(void* buf, MPI_Datatype datatype); //========================= seq.cvh ======================== $system[seq] void $seq_init(void* array, int count, void* value); //====================== civl-mpi.cvl ====================== char* getCoroutineName(int tag); struct $mpi_gcomm{ $gcomm p2p; $gcomm col; $gcollect_checker collect_checker; $gbarrier gbarrier; }; int sizeofDatatype(MPI_Datatype datatype) { switch (datatype) { case MPI_INT: return sizeof(int); case MPI_2INT: return sizeof(int) * 2; case MPI_FLOAT: return sizeof(float); case MPI_DOUBLE: return sizeof(double); case MPI_CHAR: return sizeof(char); case MPI_BYTE: return sizeof(char); case MPI_SHORT: return sizeof(short); case MPI_LONG: return sizeof(long); case MPI_LONG_DOUBLE: return sizeof(long double); case MPI_LONG_LONG_INT: return sizeof(long long); case MPI_LONG_LONG: return sizeof(long long); case MPI_UNSIGNED_LONG_LONG: return sizeof(unsigned long long); default: $assert(0, "Unreachable"); } } $mpi_gcomm $mpi_gcomm_create($scope scope, int size) { $mpi_gcomm result; result.p2p = $gcomm_create(scope, size); result.col = $gcomm_create(scope, size); result.collect_checker = $gcollect_checker_create(scope); result.gbarrier = $gbarrier_create(scope, size); return result; } void $mpi_gcomm_destroy($mpi_gcomm gc) { int numJunkRecord; int numJunkMsg; $message junkMsgs[]; $seq_init(&(junkMsgs), 0, (void*)0); numJunkMsg = $gcomm_destroy(gc.p2p, &(junkMsgs)); { int i = 0; for (; i < numJunkMsg; i = i + 1) { int src; int dest; int tag; src = $message_source(junkMsgs[i]); dest = $message_dest(junkMsgs[i]); tag = $message_tag(junkMsgs[i]); $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); } } numJunkMsg = $gcomm_destroy(gc.col, &(junkMsgs)); { int i = 0; for (; i < numJunkMsg; i = i + 1) { int src; int tag; char* routine; src = $message_source(junkMsgs[i]); tag = $message_tag(junkMsgs[i]); routine = getCoroutineName(tag); $assert($false, "MPI message leak: There is a message sent by rank %d for collective routine %s that is never received.", src, routine); } } numJunkRecord = $gcollect_checker_destroy(gc.collect_checker); $gbarrier_destroy(gc.gbarrier); $assert(numJunkRecord == 0, "MPI collective routines are called inappropriately because there are %d collective records still remaining the collective routine checker.", numJunkRecord); } MPI_Comm $mpi_comm_create($scope scope, $mpi_gcomm gc, int rank) { MPI_Comm result; result.p2p = $comm_create(scope, gc.p2p, rank); result.col = $comm_create(scope, gc.col, rank); result.collect_checker = $collect_checker_create(scope, gc.collect_checker); result.barrier = $barrier_create(scope, gc.gbarrier, rank); result.gcommIndex = 0; return result; } void $mpi_comm_destroy(MPI_Comm comm) { $mpi_sys_status curr_status; curr_status = $mpi_get_status(); if (comm.gcommIndex == 0) $assert(curr_status == __FINALIZED, "Process terminates without calling MPI_Finalize() first."); $comm_destroy(comm.p2p); $comm_destroy(comm.col); $collect_checker_destroy(comm.collect_checker); $barrier_destroy(comm.barrier); } int $mpi_init(void) { $mpi_set_status(__INIT); return 0; } int $mpi_finalize(void) { $mpi_set_status(__FINALIZED); return 0; } int $mpi_send(void* buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm) { if (dest >= 0) { int $sef$3 = sizeofDatatype(datatype); int size = count * $sef$3; int place = $comm_place(comm.p2p); $message out = $message_pack(place, dest, tag, buf, size); $comm_enqueue(comm.p2p, out); } return 0; } int $mpi_recv(void* buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Status* status) { if ((source >= 0) || (source == (-1))) { $message in; int place = $comm_place(comm.p2p); $elaborate(source); in = $comm_dequeue(comm.p2p, source, tag); int $sef$4 = sizeofDatatype(datatype); int size = count * $sef$4; $message_unpack(in, buf, size); if (status != (void*)0) { (status)->size = $message_size(in); (status)->MPI_SOURCE = $message_source(in); (status)->MPI_TAG = $message_tag(in); (status)->MPI_ERROR = 0; } } return 0; } char* getCoroutineName(int tag) { switch (tag) { case 9999: return "MPI_Bcast"; case 9998: return "MPI_Reduce"; case 9997: return "MPI_Allreduce"; case 9996: return "MPI_Gather"; case 9995: return "MPI_Scatter"; case 9994: return "MPI_Gatherv"; case 9993: return "MPI_Scatterv"; case 9992: return "MPI_Allgather"; case 9991: return "MPI_Reduce_scatter"; case 9990: return "MPI_Alltoall"; case 9989: return "MPI_Alltoallv"; case 9988: return "MPI_Alltoallw"; case 9987: return "MPI_Barrier"; case 9986: return "MPI_Commdup"; case 9985: return "MPI_Commfree"; default: $assert($false, "Internal Error: Unexpected MPI routine tag:%d.\n", tag); } } //======================== civlc.cvh ======================= /*@ depends_on \nothing; @*/ $system[civlc] void $assert(_Bool expr, ...); /*@ depends_on \nothing; @*/ $system[civlc] void $assume(_Bool expr); /*@ pure; @ depends_on \nothing; @*/ $system[civlc] void $elaborate(int x); //======================= bundle.cvh ======================= /*@ pure; @*/ $system[bundle] $bundle $bundle_pack(void* ptr, int size); $system[bundle] void $bundle_unpack($bundle bundle, void* ptr); //======================== comm.cvh ======================== /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f $message $message_pack(int source, int dest, int tag, void* data, int size); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_source($message message); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_tag($message message); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_dest($message message); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $message_size($message message); /*@ depends_on \write(buf); @ executes_when $true; @*/ $atomic_f void $message_unpack($message message, void* buf, int size); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] $gcomm $gcomm_create($scope scope, int size); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] int $gcomm_destroy($gcomm gcomm, void* junkMsgs); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] $comm $comm_create($scope scope, $gcomm gcomm, int place); /*@ depends_on \nothing; @ executes_when $true; @*/ $system[comm] void $comm_destroy($comm comm); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $system[comm] int $comm_size($comm comm); /*@ pure; @ depends_on \nothing; @ executes_when $true; @*/ $atomic_f int $comm_place($comm comm); /*@ depends_on \write(comm); @ executes_when $true; @*/ $system[comm] void $comm_enqueue($comm comm, $message message); /*@ depends_on \write(comm); @*/ $system[comm] $message $comm_dequeue($comm comm, int source, int tag); //======================== comm.cvl ======================== struct $queue{ int length; $message messages[]; }; struct $gcomm{ int nprocs; $proc procs[]; _Bool isInit[]; $queue buf[][]; }; struct $comm{ int place; $gcomm gcomm; }; $message $message_pack(int source, int dest, int tag, void* data, int size) { $message result; result.source = source; result.dest = dest; result.tag = tag; result.data = $bundle_pack(data, size); result.size = size; return result; } int $message_source($message message) { return message.source; } int $message_tag($message message) { return message.tag; } int $message_dest($message message) { return message.dest; } int $message_size($message message) { return message.size; } void $message_unpack($message message, void* buf, int size) { $bundle_unpack(message.data, buf); $assert(message.size <= size, "Message of size %d exceeds the specified size %d.", message.size, size); } int $comm_place($comm comm) { return (comm)->place; } //======================== civlc.cvh ======================= /*@ depends_on \nothing; @*/ $system[civlc] void $assert(_Bool expr, ...); /*@ depends_on \nothing; @*/ $system[civlc] void $assume(_Bool expr); /*@ pure; @ depends_on \nothing; @*/ $system[civlc] void $elaborate(int x); /*@ depends_on \nothing; @*/ $system[civlc] void $assert(_Bool expr, ...); /*@ depends_on \nothing; @*/ $system[civlc] void $assume(_Bool expr); /*@ pure; @ depends_on \nothing; @*/ $system[civlc] void $elaborate(int x); //======================= bundle.cvh ======================= /*@ pure; @*/ $system[bundle] $bundle $bundle_pack(void* ptr, int size); $system[bundle] void $bundle_unpack($bundle bundle, void* ptr); //========================= seq.cvh ======================== $system[seq] void $seq_init(void* array, int count, void* value); //======================== civlc.cvh ======================= /*@ depends_on \nothing; @*/ $system[civlc] void $assert(_Bool expr, ...); /*@ depends_on \nothing; @*/ $system[civlc] void $assume(_Bool expr); /*@ pure; @ depends_on \nothing; @*/ $system[civlc] void $elaborate(int x); //========================= stdio.h ======================== $system[stdio] int printf(char* restrict format, ...); //========================== mpi.h ========================= int MPI_Send(void*, int, MPI_Datatype, int, int, MPI_Comm); int MPI_Recv(void*, int, MPI_Datatype, int, int, MPI_Comm, MPI_Status*); int MPI_Get_count(MPI_Status*, MPI_Datatype, int*); int MPI_Comm_size(MPI_Comm, int*); int MPI_Comm_rank(MPI_Comm, int*); //======================= sum_array.c ====================== $input int _gen_argc; $input char _gen_argv[10][]; $input long NB = 20; $input long N; //===================== MPITransformer ===================== $input int _mpi_nprocs; $input int _mpi_nprocs_lo = 1; //======================= sum_array.c ====================== $input int _mpi_nprocs_hi = 8; //===================== MPITransformer ===================== $assume((_mpi_nprocs_lo <= _mpi_nprocs) && (_mpi_nprocs <= _mpi_nprocs_hi)); $mpi_gcomm _mpi_gcomm = $mpi_gcomm_create($here, _mpi_nprocs); $mpi_gcomm _mpi_gcomms[]; $seq_init(&(_mpi_gcomms), 1, &(_mpi_gcomm)); void _mpi_process(int _mpi_rank) { $mpi_sys_status _mpi_status = __UNINIT; $assert(_mpi_status == __UNINIT); MPI_Comm MPI_COMM_WORLD = $mpi_comm_create($here, _mpi_gcomm, _mpi_rank); $system[sum_array] void $assume(_Bool expression); $assume((0 < _gen_argc) && (_gen_argc < 10)); $assume((0 < N) && (N <= NB)); double oracle; void master(void); void slave(void); int _gen_main(int argc, char** argv) { int myrank; $mpi_init(); MPI_Comm_rank(MPI_COMM_WORLD, &(myrank)); if (!myrank) master(); else slave(); $mpi_finalize(); return 0; } void master(void) { float array[N]; double mysum; double tmpsum; unsigned long long step; unsigned long long i; int size; MPI_Status status; for (i = 0; i < N; i = i + 1) array[i] = i + 1; oracle = 0.0; for (i = 0; i < N; i = i + 1) oracle = oracle + (array[i]); MPI_Comm_size(MPI_COMM_WORLD, &(size)); if (size != 1) step = $int_div(N, size - 1); else step = N; for (i = 0; i < (size - 1); i = i + 1) MPI_Send(array + (i * step), step, MPI_FLOAT, i + 1, 100, MPI_COMM_WORLD); { i = (size - 1) * step; mysum = 0; for (; i < N; i = i + 1) mysum = mysum + (array[i]); } for (i = 1; i < size; ) { MPI_Recv(&(tmpsum), 1, MPI_DOUBLE, -1, 101, MPI_COMM_WORLD, &(status)); mysum = mysum + tmpsum; i = i + 1; } $assert(oracle == mysum, "The sum of %d array elements is %f but the expected one is %f.\n", N, mysum, oracle); printf("%lf\n", mysum); } void slave(void) { float array[N]; double sum; unsigned long long i; int count; MPI_Status status; MPI_Recv(array, N, MPI_FLOAT, 0, 100, MPI_COMM_WORLD, &(status)); MPI_Get_count(&(status), MPI_FLOAT, &(count)); { i = 0; sum = 0; for (; i < count; i = i + 1) sum = sum + (array[i]); } MPI_Send(&(sum), 1, MPI_DOUBLE, 0, 101, MPI_COMM_WORLD); } { char* _gen_argv_tmp[10]; { int i = 0; for (; i < 10; i = i + 1) _gen_argv_tmp[i] = &(_gen_argv[i][0]); } _gen_main(_gen_argc, &(_gen_argv_tmp[0])); } $mpi_comm_destroy(MPI_COMM_WORLD); } int main() { $parfor (int i: 0 .. _mpi_nprocs - 1) _mpi_process(i); $mpi_gcomm_destroy(_mpi_gcomm); }