1 /* Copyright (c) 2010. The SimGrid Team.
2 * All rights reserved. */
4 /* This program is free software; you can redistribute it and/or modify it
5 * under the terms of the license (GNU LGPL) which comes with this package. */
16 static xbt_dynar_t comm_lookup = NULL;
17 static xbt_dynar_t group_lookup = NULL;
18 static xbt_dict_t request_lookup = NULL;
19 static xbt_dynar_t datatype_lookup = NULL;
20 static xbt_dynar_t op_lookup = NULL;
22 #define KEY_SIZE (sizeof(int) * 2 + 1)
24 static int new_comm(MPI_Comm comm) {
25 xbt_dynar_push(comm_lookup, &comm);
26 return (int)xbt_dynar_length(comm_lookup) - 1;
29 static void free_comm(int comm) {
30 xbt_dynar_remove_at(comm_lookup, comm, NULL);
33 static MPI_Comm get_comm(int comm) {
36 } else if(comm_lookup && comm >= 0 && comm < (int)xbt_dynar_length(comm_lookup)) {
37 return *(MPI_Comm*)xbt_dynar_get_ptr(comm_lookup, comm);
42 static int new_group(MPI_Group group) {
43 xbt_dynar_push(group_lookup, &group);
44 return (int)xbt_dynar_length(group_lookup) - 1;
47 static MPI_Group get_group(int group) {
49 return MPI_GROUP_EMPTY;
50 } else if(group_lookup && group >= 0 && group < (int)xbt_dynar_length(group_lookup)) {
51 return *(MPI_Group*)xbt_dynar_get_ptr(group_lookup, group);
56 static char* get_key(char* key, int id) {
57 snprintf(key, KEY_SIZE, "%x", id);
61 static int new_request(MPI_Request req) {
62 static int request_id = INT_MIN;
65 xbt_dict_set(request_lookup, get_key(key, request_id), req, NULL);
69 static MPI_Request find_request(int req) {
72 return (MPI_Request)xbt_dict_get(request_lookup, get_key(key, req));
75 static int new_datatype(MPI_Datatype datatype) {
76 xbt_dynar_push(datatype_lookup, &datatype);
77 return (int)xbt_dynar_length(datatype_lookup) - 1;
80 static MPI_Datatype get_datatype(int datatype) {
82 ? *(MPI_Datatype*)xbt_dynar_get_ptr(datatype_lookup, datatype)
86 static void free_datatype(int datatype) {
87 xbt_dynar_remove_at(datatype_lookup, datatype, NULL);
90 static int new_op(MPI_Op op) {
91 xbt_dynar_push(op_lookup, &op);
92 return (int)xbt_dynar_length(op_lookup) - 1;
95 static MPI_Op get_op(int op) {
97 ? *(MPI_Op*)xbt_dynar_get_ptr(op_lookup, op)
101 void mpi_init_(int* ierr) {
103 comm_lookup = xbt_dynar_new(sizeof(MPI_Comm), NULL);
104 new_comm(MPI_COMM_WORLD);
105 group_lookup = xbt_dynar_new(sizeof(MPI_Group), NULL);
107 request_lookup = xbt_dict_new_homogeneous(NULL);
109 datatype_lookup = xbt_dynar_new(sizeof(MPI_Datatype), NULL);
110 new_datatype(MPI_BYTE);
111 new_datatype(MPI_CHAR);
112 new_datatype(MPI_INT);
113 new_datatype(MPI_INT);
114 new_datatype(MPI_INT8_T);
115 new_datatype(MPI_INT16_T);
116 new_datatype(MPI_INT32_T);
117 new_datatype(MPI_INT64_T);
118 new_datatype(MPI_FLOAT);
119 new_datatype(MPI_FLOAT);
120 new_datatype(MPI_DOUBLE);
121 new_datatype(MPI_DOUBLE);
122 new_datatype(MPI_C_FLOAT_COMPLEX);
123 new_datatype(MPI_C_DOUBLE_COMPLEX);
124 new_datatype(MPI_2INT);
125 new_datatype(MPI_UINT8_T);
126 new_datatype(MPI_UINT16_T);
127 new_datatype(MPI_UINT32_T);
128 new_datatype(MPI_UINT64_T);
129 new_datatype(MPI_2FLOAT);
130 new_datatype(MPI_2DOUBLE);
133 op_lookup = xbt_dynar_new(sizeof(MPI_Op), NULL);
147 /* smpif2c is responsible for generating a call with the final arguments */
148 *ierr = MPI_Init(NULL, NULL);
151 void mpi_finalize_(int* ierr) {
152 *ierr = MPI_Finalize();
153 xbt_dynar_free(&op_lookup);
155 xbt_dynar_free(&datatype_lookup);
156 datatype_lookup = NULL;
157 xbt_dict_free(&request_lookup);
158 request_lookup = NULL;
159 xbt_dynar_free(&comm_lookup);
163 void mpi_abort_(int* comm, int* errorcode, int* ierr) {
164 *ierr = MPI_Abort(get_comm(*comm), *errorcode);
167 void mpi_comm_rank_(int* comm, int* rank, int* ierr) {
168 *ierr = MPI_Comm_rank(get_comm(*comm), rank);
171 void mpi_comm_size_(int* comm, int* size, int* ierr) {
172 *ierr = MPI_Comm_size(get_comm(*comm), size);
175 double mpi_wtime_(void) {
179 double mpi_wtick_(void) {
183 void mpi_comm_dup_(int* comm, int* newcomm, int* ierr) {
186 *ierr = MPI_Comm_dup(get_comm(*comm), &tmp);
187 if(*ierr == MPI_SUCCESS) {
188 *newcomm = new_comm(tmp);
192 void mpi_comm_create_(int* comm, int* group, int* newcomm, int* ierr) {
195 *ierr = MPI_Comm_create(get_comm(*comm),get_group(*group), &tmp);
196 if(*ierr == MPI_SUCCESS) {
197 *newcomm = new_comm(tmp);
202 void mpi_comm_free_(int* comm, int* ierr) {
203 MPI_Comm tmp = get_comm(*comm);
205 *ierr = MPI_Comm_free(&tmp);
207 if(*ierr == MPI_SUCCESS) {
212 void mpi_comm_split_(int* comm, int* color, int* key, int* comm_out, int* ierr) {
215 *ierr = MPI_Comm_split(get_comm(*comm), *color, *key, &tmp);
216 if(*ierr == MPI_SUCCESS) {
217 *comm_out = new_comm(tmp);
221 void mpi_group_incl_(int* group, int* n, int* ranks, int* group_out, int* ierr) {
224 *ierr = MPI_Group_incl(get_group(*group), *n, ranks, &tmp);
225 if(*ierr == MPI_SUCCESS) {
226 *group_out = new_group(tmp);
230 void mpi_comm_group_(int* comm, int* group_out, int* ierr) {
233 *ierr = MPI_Comm_group(get_comm(*comm), &tmp);
234 if(*ierr == MPI_SUCCESS) {
235 *group_out = new_group(tmp);
240 void mpi_initialized_(int* flag, int* ierr){
241 *ierr = MPI_Initialized(flag);
244 void mpi_send_init_(void *buf, int* count, int* datatype, int* dst, int* tag,
245 int* comm, int* request, int* ierr) {
248 *ierr = MPI_Send_init(buf, *count, get_datatype(*datatype), *dst, *tag,
249 get_comm(*comm), &req);
250 if(*ierr == MPI_SUCCESS) {
251 *request = new_request(req);
255 void mpi_isend_(void *buf, int* count, int* datatype, int* dst,
256 int* tag, int* comm, int* request, int* ierr) {
259 *ierr = MPI_Isend(buf, *count, get_datatype(*datatype), *dst, *tag,
260 get_comm(*comm), &req);
261 if(*ierr == MPI_SUCCESS) {
262 *request = new_request(req);
266 void mpi_irsend_(void *buf, int* count, int* datatype, int* dst,
267 int* tag, int* comm, int* request, int* ierr) {
270 *ierr = MPI_Irsend(buf, *count, get_datatype(*datatype), *dst, *tag,
271 get_comm(*comm), &req);
272 if(*ierr == MPI_SUCCESS) {
273 *request = new_request(req);
277 void mpi_send_(void* buf, int* count, int* datatype, int* dst,
278 int* tag, int* comm, int* ierr) {
279 *ierr = MPI_Send(buf, *count, get_datatype(*datatype), *dst, *tag,
283 void mpi_rsend_(void* buf, int* count, int* datatype, int* dst,
284 int* tag, int* comm, int* ierr) {
285 *ierr = MPI_Rsend(buf, *count, get_datatype(*datatype), *dst, *tag,
289 void mpi_sendrecv_(void* sendbuf, int* sendcount, int* sendtype, int* dst,
290 int* sendtag, void *recvbuf, int* recvcount,
291 int* recvtype, int* src, int* recvtag,
292 int* comm, MPI_Status* status, int* ierr) {
293 *ierr = MPI_Sendrecv(sendbuf, *sendcount, get_datatype(*sendtype), *dst,
294 *sendtag, recvbuf, *recvcount,get_datatype(*recvtype), *src, *recvtag,
295 get_comm(*comm), status);
298 void mpi_recv_init_(void *buf, int* count, int* datatype, int* src, int* tag,
299 int* comm, int* request, int* ierr) {
302 *ierr = MPI_Recv_init(buf, *count, get_datatype(*datatype), *src, *tag,
303 get_comm(*comm), &req);
304 if(*ierr == MPI_SUCCESS) {
305 *request = new_request(req);
309 void mpi_irecv_(void *buf, int* count, int* datatype, int* src, int* tag,
310 int* comm, int* request, int* ierr) {
313 *ierr = MPI_Irecv(buf, *count, get_datatype(*datatype), *src, *tag,
314 get_comm(*comm), &req);
315 if(*ierr == MPI_SUCCESS) {
316 *request = new_request(req);
320 void mpi_recv_(void* buf, int* count, int* datatype, int* src,
321 int* tag, int* comm, MPI_Status* status, int* ierr) {
322 *ierr = MPI_Recv(buf, *count, get_datatype(*datatype), *src, *tag,
323 get_comm(*comm), status);
326 void mpi_start_(int* request, int* ierr) {
327 MPI_Request req = find_request(*request);
329 *ierr = MPI_Start(&req);
332 void mpi_startall_(int* count, int* requests, int* ierr) {
336 reqs = xbt_new(MPI_Request, *count);
337 for(i = 0; i < *count; i++) {
338 reqs[i] = find_request(requests[i]);
340 *ierr = MPI_Startall(*count, reqs);
344 void mpi_wait_(int* request, MPI_Status* status, int* ierr) {
345 MPI_Request req = find_request(*request);
347 *ierr = MPI_Wait(&req, status);
350 void mpi_waitany_(int* count, int* requests, int* index, MPI_Status* status, int* ierr) {
354 reqs = xbt_new(MPI_Request, *count);
355 for(i = 0; i < *count; i++) {
356 reqs[i] = find_request(requests[i]);
358 *ierr = MPI_Waitany(*count, reqs, index, status);
362 void mpi_waitall_(int* count, int* requests, MPI_Status* status, int* ierr) {
366 reqs = xbt_new(MPI_Request, *count);
367 for(i = 0; i < *count; i++) {
368 reqs[i] = find_request(requests[i]);
370 *ierr = MPI_Waitall(*count, reqs, status);
374 void mpi_barrier_(int* comm, int* ierr) {
375 *ierr = MPI_Barrier(get_comm(*comm));
378 void mpi_bcast_(void *buf, int* count, int* datatype, int* root, int* comm, int* ierr) {
379 *ierr = MPI_Bcast(buf, *count, get_datatype(*datatype), *root, get_comm(*comm));
382 void mpi_reduce_(void* sendbuf, void* recvbuf, int* count,
383 int* datatype, int* op, int* root, int* comm, int* ierr) {
384 *ierr = MPI_Reduce(sendbuf, recvbuf, *count,
385 get_datatype(*datatype), get_op(*op), *root, get_comm(*comm));
388 void mpi_allreduce_(void* sendbuf, void* recvbuf, int* count, int* datatype,
389 int* op, int* comm, int* ierr) {
390 *ierr = MPI_Allreduce(sendbuf, recvbuf, *count, get_datatype(*datatype),
391 get_op(*op), get_comm(*comm));
394 void mpi_reduce_scatter_(void* sendbuf, void* recvbuf, int* recvcounts, int* datatype,
395 int* op, int* comm, int* ierr) {
396 *ierr = MPI_Reduce_scatter(sendbuf, recvbuf, recvcounts, get_datatype(*datatype),
397 get_op(*op), get_comm(*comm));
400 void mpi_scatter_(void* sendbuf, int* sendcount, int* sendtype,
401 void* recvbuf, int* recvcount, int* recvtype,
402 int* root, int* comm, int* ierr) {
403 *ierr = MPI_Scatter(sendbuf, *sendcount, get_datatype(*sendtype),
404 recvbuf, *recvcount, get_datatype(*recvtype), *root, get_comm(*comm));
408 void mpi_scatterv_(void* sendbuf, int* sendcounts, int* displs, int* sendtype,
409 void* recvbuf, int* recvcount, int* recvtype,
410 int* root, int* comm, int* ierr) {
411 *ierr = MPI_Scatterv(sendbuf, sendcounts, displs, get_datatype(*sendtype),
412 recvbuf, *recvcount, get_datatype(*recvtype), *root, get_comm(*comm));
415 void mpi_gather_(void* sendbuf, int* sendcount, int* sendtype,
416 void* recvbuf, int* recvcount, int* recvtype,
417 int* root, int* comm, int* ierr) {
418 *ierr = MPI_Gather(sendbuf, *sendcount, get_datatype(*sendtype),
419 recvbuf, *recvcount, get_datatype(*recvtype), *root, get_comm(*comm));
422 void mpi_gatherv_(void* sendbuf, int* sendcount, int* sendtype,
423 void* recvbuf, int* recvcounts, int* displs, int* recvtype,
424 int* root, int* comm, int* ierr) {
425 *ierr = MPI_Gatherv(sendbuf, *sendcount, get_datatype(*sendtype),
426 recvbuf, recvcounts, displs, get_datatype(*recvtype), *root, get_comm(*comm));
429 void mpi_allgather_(void* sendbuf, int* sendcount, int* sendtype,
430 void* recvbuf, int* recvcount, int* recvtype,
431 int* comm, int* ierr) {
432 *ierr = MPI_Allgather(sendbuf, *sendcount, get_datatype(*sendtype),
433 recvbuf, *recvcount, get_datatype(*recvtype), get_comm(*comm));
436 void mpi_allgatherv_(void* sendbuf, int* sendcount, int* sendtype,
437 void* recvbuf, int* recvcounts,int* displs, int* recvtype,
438 int* comm, int* ierr) {
439 *ierr = MPI_Allgatherv(sendbuf, *sendcount, get_datatype(*sendtype),
440 recvbuf, recvcounts, displs, get_datatype(*recvtype), get_comm(*comm));
443 void mpi_scan_(void* sendbuf, void* recvbuf, int* count, int* datatype,
444 int* op, int* comm, int* ierr) {
445 *ierr = MPI_Scan(sendbuf, recvbuf, *count, get_datatype(*datatype),
446 get_op(*op), get_comm(*comm));
449 void mpi_alltoall_(void* sendbuf, int* sendcount, int* sendtype,
450 void* recvbuf, int* recvcount, int* recvtype, int* comm, int* ierr) {
451 *ierr = MPI_Alltoall(sendbuf, *sendcount, get_datatype(*sendtype),
452 recvbuf, *recvcount, get_datatype(*recvtype), get_comm(*comm));
455 void mpi_alltoallv_(void* sendbuf, int* sendcounts, int* senddisps, int* sendtype,
456 void* recvbuf, int* recvcounts, int* recvdisps, int* recvtype, int* comm, int* ierr) {
457 *ierr = MPI_Alltoallv(sendbuf, sendcounts, senddisps, get_datatype(*sendtype),
458 recvbuf, recvcounts, recvdisps, get_datatype(*recvtype), get_comm(*comm));
461 void mpi_test_ (int * request, int *flag, MPI_Status * status, int* ierr){
462 MPI_Request req = find_request(*request);
463 *ierr= MPI_Test(&req, flag, status);
467 void mpi_testall_ (int* count, int * requests, int *flag, MPI_Status * statuses, int* ierr){
470 reqs = xbt_new(MPI_Request, *count);
471 for(i = 0; i < *count; i++) {
472 reqs[i] = find_request(requests[i]);
474 *ierr= MPI_Testall(*count, reqs, flag, statuses);
478 void mpi_get_processor_name_(char *name, int *resultlen, int* ierr){
479 *ierr = MPI_Get_processor_name(name, resultlen);
482 void mpi_get_count_(MPI_Status * status, int* datatype, int *count, int* ierr){
483 *ierr = MPI_Get_count(status, get_datatype(*datatype), count);
486 void mpi_attr_get_(int* comm, int* keyval, void* attr_value, int* flag, int* ierr ){
487 *ierr = MPI_Attr_get(get_comm(*comm), *keyval, attr_value, flag);
490 void mpi_type_extent_(int* datatype, MPI_Aint * extent, int* ierr){
491 *ierr= MPI_Type_extent(get_datatype(*datatype), extent);
494 void mpi_type_commit_(int* datatype, int* ierr){
495 MPI_Datatype tmp= get_datatype(*datatype);
496 *ierr= MPI_Type_commit(&tmp);
499 void mpi_type_vector_(int* count, int* blocklen, int* stride, int* old_type, int* newtype, int* ierr){
501 *ierr= MPI_Type_vector(*count, *blocklen, *stride, get_datatype(*old_type), &tmp);
502 if(*ierr == MPI_SUCCESS) {
503 *newtype = new_datatype(tmp);
507 void mpi_type_create_vector_(int* count, int* blocklen, int* stride, int* old_type, int* newtype, int* ierr){
509 *ierr= MPI_Type_vector(*count, *blocklen, *stride, get_datatype(*old_type), &tmp);
510 if(*ierr == MPI_SUCCESS) {
511 *newtype = new_datatype(tmp);
515 void mpi_type_hvector_(int* count, int* blocklen, MPI_Aint* stride, int* old_type, int* newtype, int* ierr){
517 *ierr= MPI_Type_hvector (*count, *blocklen, *stride, get_datatype(*old_type), &tmp);
518 if(*ierr == MPI_SUCCESS) {
519 *newtype = new_datatype(tmp);
523 void mpi_type_create_hvector_(int* count, int* blocklen, MPI_Aint* stride, int* old_type, int* newtype, int* ierr){
525 *ierr= MPI_Type_hvector(*count, *blocklen, *stride, get_datatype(*old_type), &tmp);
526 if(*ierr == MPI_SUCCESS) {
527 *newtype = new_datatype(tmp);
531 void mpi_type_free_(int* datatype, int* ierr){
532 MPI_Datatype tmp= get_datatype(*datatype);
533 *ierr= MPI_Type_free (&tmp);
534 if(*ierr == MPI_SUCCESS) {
535 free_datatype(*datatype);
539 void mpi_type_ub_(int* datatype, MPI_Aint * disp, int* ierr){
540 *ierr= MPI_Type_ub(get_datatype(*datatype), disp);
543 void mpi_type_lb_(int* datatype, MPI_Aint * extent, int* ierr){
544 *ierr= MPI_Type_extent(get_datatype(*datatype), extent);
547 void mpi_type_size_(int* datatype, int *size, int* ierr)
549 *ierr = MPI_Type_size(get_datatype(*datatype), size);
552 void mpi_error_string_(int* errorcode, char* string, int* resultlen, int* ierr){
553 *ierr = MPI_Error_string(*errorcode, string, resultlen);
556 void mpi_win_fence_( int* assert, int* win, int* ierr){
557 *ierr = MPI_Win_fence(* assert, *(MPI_Win*)win);
560 void mpi_win_free_( int* win, int* ierr){
561 *ierr = MPI_Win_free( (MPI_Win*)win);
564 void mpi_win_create_( int *base, MPI_Aint* size, int* disp_unit, int* info, int* comm, int *win, int* ierr){
565 *ierr = MPI_Win_create( (void*)base, *size, *disp_unit, *(MPI_Info*)info, get_comm(*comm),(MPI_Win*)win);
568 void mpi_info_create_( int *info, int* ierr){
569 *ierr = MPI_Info_create( (MPI_Info *)info);
572 void mpi_info_set_( int *info, char *key, char *value, int* ierr){
573 *ierr = MPI_Info_set( (MPI_Info *)info, key, value);
576 void mpi_info_free_(int* info, int* ierr){
577 *ierr = MPI_Info_free((MPI_Info *) info);
580 void mpi_get_( int *origin_addr, int* origin_count, int* origin_datatype, int *target_rank,
581 MPI_Aint* target_disp, int *target_count, int* target_datatype, int* win, int* ierr){
582 *ierr = MPI_Get( (void*)origin_addr,*origin_count, get_datatype(*origin_datatype),*target_rank,
583 *target_disp, *target_count,get_datatype(*target_datatype), *(MPI_Win *)win);