1 /*
2 (C) 2004 by Argonne National Laboratory.
3 See COPYRIGHT in top-level directory.
4 */
5 #include "collchk.h"
6 #include "mpe_callstack.h"
7
8 #if ! defined( HAVE_MPI_ERR_FNS )
MPI_Add_error_class(int * errorclass)9 int MPI_Add_error_class(int *errorclass)
10 { return MPI_SUCCESS; }
11
MPI_Add_error_code(int errorclass,int * errorcode)12 int MPI_Add_error_code(int errorclass, int *errorcode)
13 { return MPI_SUCCESS; }
14
MPI_Add_error_string(int errorcode,char * string)15 int MPI_Add_error_string(int errorcode, char *string)
16 {
17 fprintf(stderr, "%s", string);
18 fflush(stderr);
19 return MPI_SUCCESS;
20 }
21
MPI_Comm_call_errhandler(MPI_Comm comm,int errorcode)22 int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode)
23 {
24 /* Wait for few seconds so others can finish printing error messages */
25 sleep(5);
26 return MPI_Abort(comm, 1);
27 }
28 #endif
29
CollChk_err_han(char * err_str,int err_code,char * call,MPI_Comm comm)30 int CollChk_err_han(char *err_str, int err_code, char *call, MPI_Comm comm)
31 {
32 int rank;
33 char msg[COLLCHK_STD_STRLEN];
34 MPE_CallStack_t cstk;
35
36 if(err_code == COLLCHK_ERR_NOT_INIT) {
37 printf("Collective Checking: %s --> %s\n", call, err_str);
38 fflush(stdout); fflush(stderr);
39 }
40 else if (strcmp(err_str, COLLCHK_NO_ERROR_STR) != 0) {
41 MPI_Comm_rank(comm, &rank);
42 sprintf(msg, "Backtrace of the callstack at rank %d:\n", rank );
43 write( STDERR_FILENO, msg, strlen(msg)+1 );
44 MPE_CallStack_init( &cstk );
45 MPE_CallStack_fancyprint( &cstk, STDERR_FILENO,
46 "\tAt ", 1, MPE_CALLSTACK_UNLIMITED );
47 sprintf(msg, "\n\nCollective Checking: %s (Rank %d) --> %s\n\n",
48 call, rank, err_str);
49 MPI_Add_error_string(err_code, msg);
50 }
51 else {
52 MPI_Add_error_string(err_code, "Error on another process");
53 sleep(1);
54 }
55
56 return MPI_Comm_call_errhandler(comm, err_code);
57 }
58