1 | //probe.c |
---|
2 | #include "mpiP.h" |
---|
3 | |
---|
4 | static int mpi_match_send(void *r, void *tag) |
---|
5 | { |
---|
6 | return( *((int *)tag) == MPI_ANY_TAG || |
---|
7 | *((int *)tag) == ((Req *)r)->tag ); |
---|
8 | } |
---|
9 | |
---|
10 | FC_FUNC(mpi_iprobe, MPI_IPROBE)(int * source, int * tag, int * comm, |
---|
11 | int * flag, int *status, int * ierr) |
---|
12 | { |
---|
13 | *ierr = MPI_Iprobe(*source, *tag, *comm, flag, mpi_c_status(status)); |
---|
14 | } |
---|
15 | |
---|
16 | /* Iprobe |
---|
17 | * Search for existing message, return status about it |
---|
18 | */ |
---|
19 | |
---|
20 | int MPI_Iprobe(int source, int tag, MPI_Comm comm, int *flag, |
---|
21 | MPI_Status *status) |
---|
22 | |
---|
23 | { |
---|
24 | pListitem match; |
---|
25 | Comm *mycomm; |
---|
26 | Req *sreq; |
---|
27 | |
---|
28 | mycomm=mpi_handle_to_ptr(comm); /* mycomm=(Comm *)comm; */ |
---|
29 | |
---|
30 | #ifdef INFO |
---|
31 | fflush(stdout); |
---|
32 | fprintf(stderr,"MPI_IProbev: Comm=%d tag=%d count=%d type=%d\n", |
---|
33 | mycomm->num,tag,count,datatype); |
---|
34 | #endif |
---|
35 | |
---|
36 | |
---|
37 | if (source!=0 && source!=MPI_ANY_SOURCE) |
---|
38 | { |
---|
39 | fprintf(stderr,"MPI_Irecv: bad source %d\n",source); |
---|
40 | abort(); |
---|
41 | } |
---|
42 | |
---|
43 | match=AP_list_search_func(mycomm->sendlist,mpi_match_send,&tag); |
---|
44 | |
---|
45 | *flag= (match==NULL ? 0:1 ); |
---|
46 | |
---|
47 | if (*flag) |
---|
48 | { |
---|
49 | sreq=(Req *)AP_listitem_data(match); |
---|
50 | |
---|
51 | if (status!=MPI_STATUS_IGNORE) |
---|
52 | { |
---|
53 | status->MPI_SOURCE=0 ; |
---|
54 | status->MPI_TAG= sreq->tag; |
---|
55 | } |
---|
56 | } |
---|
57 | |
---|
58 | return(MPI_SUCCESS); |
---|
59 | } |
---|
60 | |
---|
61 | |
---|
62 | //probe: wait for message, and return status |
---|
63 | // (either message will immediately be available, or deadlock. |
---|
64 | |
---|
65 | FC_FUNC(mpi_probe,MPI_PROBE)(int *source, int *tag, int *comm, int *status, |
---|
66 | int *ierr) |
---|
67 | { |
---|
68 | *ierr=MPI_Probe(*source,*tag,*comm,mpi_c_status(status)); |
---|
69 | } |
---|
70 | |
---|
71 | |
---|
72 | |
---|
73 | int MPI_Probe(int source, int tag, MPI_Comm comm, MPI_Status *status) |
---|
74 | { |
---|
75 | |
---|
76 | int flag; |
---|
77 | |
---|
78 | MPI_Iprobe(source,tag,comm,&flag,status); |
---|
79 | |
---|
80 | if (!flag) |
---|
81 | { |
---|
82 | fprintf(stderr,"MPI_Probe: no existing match, deadlock\n"); |
---|
83 | abort(); |
---|
84 | } |
---|
85 | |
---|
86 | return(MPI_SUCCESS); |
---|
87 | } |
---|
88 | |
---|