Actual source code: err.c
1: /*$Id: err.c,v 1.127 2001/04/10 19:34:27 bsmith Exp $*/
2: /*
3: Code that allows one to set the error handlers
4: */
5: #include "petsc.h" /*I "petsc.h" I*/
6: #include <stdarg.h>
7: #if defined(PETSC_HAVE_STDLIB_H)
8: #include <stdlib.h>
9: #endif
11: typedef struct _EH *EH;
12: struct _EH {
13: int cookie;
14: int (*handler)(int,char*,char*,char *,int,int,char*,void *);
15: void *ctx;
16: EH previous;
17: };
19: static EH eh = 0;
21: /*@C
22: PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
23: load the file where the error occured. Then calls the "previous" error handler.
25: Not Collective
27: Input Parameters:
28: + line - the line number of the error (indicated by __LINE__)
29: . file - the file in which the error was detected (indicated by __FILE__)
30: . dir - the directory of the file (indicated by __SDIR__)
31: . mess - an error text string, usually just printed to the screen
32: . n - the generic error number
33: . p - specific error number
34: - ctx - error handler context
36: Options Database:
37: . -on_error_emacs <machinename>
39: Level: developer
41: Notes:
42: You must put (server-start) in your .emacs file for the emacsclient software to work
44: Most users need not directly employ this routine and the other error
45: handlers, but can instead use the simplified interface SETERRQ, which has
46: the calling sequence
47: $ SETERRQ(number,p,mess)
49: Notes for experienced users:
50: Use PetscPushErrorHandler() to set the desired error handler. The
51: currently available PETSc error handlers include PetscTraceBackErrorHandler(),
52: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscStopErrorHandler()
54: Concepts: emacs^going to on error
55: Concepts: error handler^going to line in emacs
57: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
58: PetscAbortErrorHandler()
59: @*/
60: int PetscEmacsClientErrorHandler(int line,char *fun,char* file,char *dir,int n,int p,char *mess,void *ctx)
61: {
62: int ierr;
63: char command[1024];
64: FILE *fp;
67: /* Note: don't check error codes since this an error handler :-) */
68: sprintf(command,"emacsclient +%d %s/%s%sn",line,PETSC_DIR,dir,file);
69: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);
70: PetscFClose(MPI_COMM_WORLD,fp);
71: PetscPopErrorHandler(); /* remove this handler from the stack of handlers */
72: if (!eh) PetscTraceBackErrorHandler(line,fun,file,dir,n,p,mess,0);
73: else (*eh->handler)(line,fun,file,dir,n,p,mess,eh->ctx);
74: PetscFunctionReturn(ierr);
75: }
77: /*@C
78: PetscPushErrorHandler - Sets a routine to be called on detection of errors.
80: Not Collective
82: Input Parameters:
83: + handler - error handler routine
84: - ctx - optional handler context that contains information needed by the handler (for
85: example file pointers for error messages etc.)
87: Calling sequence of handler:
88: $ int handler(int line,char *func,char *file,char *dir,int n,int p,char *mess,void *ctx);
90: . line - the line number of the error (indicated by __LINE__)
91: . file - the file in which the error was detected (indicated by __FILE__)
92: . dir - the directory of the file (indicated by __SDIR__)
93: . n - the generic error number (see list defined in include/petscerror.h)
94: . p - the specific error number
95: . mess - an error text string, usually just printed to the screen
96: - ctx - the error handler context
98: Options Database Keys:
99: + -on_error_attach_debugger <noxterm,gdb or dbx>
100: - -on_error_abort
102: Level: intermediate
104: Fortran Note:
105: This routine is not supported in Fortran.
107: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
109: @*/
110: int PetscPushErrorHandler(int (*handler)(int,char *,char*,char*,int,int,char*,void*),void *ctx)
111: {
112: EH neweh;
116: PetscNew(struct _EH,&neweh);
117: if (eh) {neweh->previous = eh;}
118: else {neweh->previous = 0;}
119: neweh->handler = handler;
120: neweh->ctx = ctx;
121: eh = neweh;
122: return(0);
123: }
125: /*@C
126: PetscPopErrorHandler - Removes the latest error handler that was
127: pushed with PetscPushErrorHandler().
129: Not Collective
131: Level: intermediate
133: Fortran Note:
134: This routine is not supported in Fortran.
136: Concepts: error handler^setting
138: .seealso: PetscPushErrorHandler()
139: @*/
140: int PetscPopErrorHandler(void)
141: {
142: EH tmp;
146: if (!eh) return(0);
147: tmp = eh;
148: eh = eh->previous;
149: PetscFree(tmp);
151: return(0);
152: }
154: char PetscErrorBaseMessage[1024];
156: /*@C
157: PetscError - Routine that is called when an error has been detected,
158: usually called through the macro SETERRQ().
160: Not Collective
162: Input Parameters:
163: + line - the line number of the error (indicated by __LINE__)
164: . dir - the directory of file (indicated by __SDIR__)
165: . file - the file in which the error was detected (indicated by __FILE__)
166: . mess - an error text string, usually just printed to the screen
167: . n - the generic error number
168: . p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
169: previously detected error
170: - mess - formatted message string - aka printf
172: Level: intermediate
174: Notes:
175: Most users need not directly use this routine and the error handlers, but
176: can instead use the simplified interface SETERRQ, which has the calling
177: sequence
178: $ SETERRQ(n,mess)
180: Experienced users can set the error handler with PetscPushErrorHandler().
182: Concepts: error^setting condition
184: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler()
185: @*/
186: int PetscError(int line,char *func,char* file,char *dir,int n,int p,char *mess,...)
187: {
188: va_list Argp;
189: int ierr;
190: char buf[2048],*lbuf = 0;
191: PetscTruth ismain,isunknown;
194: /* Compose the message evaluating the print format */
195: if (mess) {
196: va_start(Argp,mess);
197: #if defined(PETSC_HAVE_VPRINTF_CHAR)
198: vsprintf(buf,mess,(char *)Argp);
199: #else
200: vsprintf(buf,mess,Argp);
201: #endif
202: va_end(Argp);
203: lbuf = buf;
204: if (p == 1) {
205: PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
206: }
207: }
209: if (!eh) PetscTraceBackErrorHandler(line,func,file,dir,n,p,lbuf,0);
210: else (*eh->handler)(line,func,file,dir,n,p,lbuf,eh->ctx);
212: /*
213: If this is called from the main() routine we call MPI_Abort() instead of
214: return to allow the parallel program to be properly shutdown.
216: Since this is in the error handler we don't check the errors below. Of course,
217: PetscStrncmp() does its own error checking which is problamatic
218: */
219: PetscStrncmp(func,"main",4,&ismain);
220: PetscStrncmp(func,"unknown",7,&isunknown);
221: if (ismain || isunknown) {
222: MPI_Abort(PETSC_COMM_WORLD,ierr);
223: }
224: PetscFunctionReturn(ierr);
225: }
227: /* -------------------------------------------------------------------------*/
229: /*@C
230: PetscIntView - Prints an array of integers; useful for debugging.
232: Collective on PetscViewer
234: Input Parameters:
235: + N - number of integers in array
236: . idx - array of integers
237: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
239: Level: intermediate
241: .seealso: PetscDoubleView()
242: @*/
243: int PetscIntView(int N,int idx[],PetscViewer viewer)
244: {
245: int j,i,n = N/20,p = N % 20,ierr;
246: PetscTruth isascii,issocket;
247: MPI_Comm comm;
250: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
253: PetscObjectGetComm((PetscObject)viewer,&comm);
255: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
256: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
257: if (isascii) {
258: for (i=0; i<n; i++) {
259: PetscViewerASCIISynchronizedPrintf(viewer,"%d:",20*i);
260: for (j=0; j<20; j++) {
261: PetscViewerASCIISynchronizedPrintf(viewer," %d",idx[i*20+j]);
262: }
263: PetscViewerASCIISynchronizedPrintf(viewer,"n");
264: }
265: if (p) {
266: PetscViewerASCIISynchronizedPrintf(viewer,"%d:",20*n);
267: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %d",idx[20*n+i]);}
268: PetscViewerASCIISynchronizedPrintf(viewer,"n");
269: }
270: PetscViewerFlush(viewer);
271: } else if (issocket) {
272: int *array,*sizes,rank,size,Ntotal,*displs;
274: MPI_Comm_rank(comm,&rank);
275: MPI_Comm_size(comm,&size);
277: if (size > 1) {
278: if (rank) {
279: MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
280: MPI_Gatherv(idx,N,MPI_INT,0,0,0,MPI_INT,0,comm);
281: } else {
282: ierr = PetscMalloc(size*sizeof(int),&sizes);
283: ierr = MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
284: Ntotal = sizes[0];
285: ierr = PetscMalloc(size*sizeof(int),&displs);
286: displs[0] = 0;
287: for (i=1; i<size; i++) {
288: Ntotal += sizes[i];
289: displs[i] = displs[i-1] + sizes[i-1];
290: }
291: PetscMalloc(Ntotal*sizeof(int),&array);
292: MPI_Gatherv(idx,N,MPI_INT,array,sizes,displs,MPI_INT,0,comm);
293: PetscViewerSocketPutInt(viewer,Ntotal,array);
294: PetscFree(sizes);
295: PetscFree(displs);
296: PetscFree(array);
297: }
298: } else {
299: PetscViewerSocketPutInt(viewer,N,idx);
300: }
301: } else {
302: SETERRQ(1,"Cannot handle that PetscViewer");
303: }
304: return(0);
305: }
307: /*@C
308: PetscDoubleView - Prints an array of doubles; useful for debugging.
310: Collective on PetscViewer
312: Input Parameters:
313: + N - number of doubles in array
314: . idx - array of doubles
315: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
317: Level: intermediate
319: .seealso: PetscIntView()
320: @*/
321: int PetscDoubleView(int N,PetscReal idx[],PetscViewer viewer)
322: {
323: int j,i,n = N/5,p = N % 5,ierr;
324: PetscTruth isascii,issocket;
325: MPI_Comm comm;
328: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
331: PetscObjectGetComm((PetscObject)viewer,&comm);
333: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
334: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
335: if (isascii) {
336: for (i=0; i<n; i++) {
337: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
338: for (j=0; j<5; j++) {
339: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
340: }
341: PetscViewerASCIISynchronizedPrintf(viewer,"n");
342: }
343: if (p) {
344: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
345: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
346: PetscViewerASCIISynchronizedPrintf(viewer,"n");
347: }
348: PetscViewerFlush(viewer);
349: } else if (issocket) {
350: int *sizes,rank,size,Ntotal,*displs;
351: PetscReal *array;
353: MPI_Comm_rank(comm,&rank);
354: MPI_Comm_size(comm,&size);
356: if (size > 1) {
357: if (rank) {
358: MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
359: MPI_Gatherv(idx,N,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
360: } else {
361: ierr = PetscMalloc(size*sizeof(int),&sizes);
362: ierr = MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
363: Ntotal = sizes[0];
364: ierr = PetscMalloc(size*sizeof(int),&displs);
365: displs[0] = 0;
366: for (i=1; i<size; i++) {
367: Ntotal += sizes[i];
368: displs[i] = displs[i-1] + sizes[i-1];
369: }
370: PetscMalloc(Ntotal*sizeof(PetscReal),&array);
371: MPI_Gatherv(idx,N,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);
372: PetscViewerSocketPutReal(viewer,Ntotal,1,array);
373: PetscFree(sizes);
374: PetscFree(displs);
375: PetscFree(array);
376: }
377: } else {
378: PetscViewerSocketPutReal(viewer,N,1,idx);
379: }
380: } else {
381: SETERRQ(1,"Cannot handle that PetscViewer");
382: }
383: return(0);
384: }
386: /*@C
387: PetscScalarView - Prints an array of scalars; useful for debugging.
389: Collective on PetscViewer
391: Input Parameters:
392: + N - number of scalars in array
393: . idx - array of scalars
394: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
396: Level: intermediate
398: .seealso: PetscIntView(), PetscDoubleView()
399: @*/
400: int PetscScalarView(int N,Scalar idx[],PetscViewer viewer)
401: {
402: int j,i,n = N/3,p = N % 3,ierr;
403: PetscTruth isascii,issocket;
404: MPI_Comm comm;
407: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
410: PetscObjectGetComm((PetscObject)viewer,&comm);
412: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
413: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
414: if (isascii) {
415: for (i=0; i<n; i++) {
416: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
417: for (j=0; j<3; j++) {
418: #if defined (PETSC_USE_COMPLEX)
419: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
420: PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
421: #else
422: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
423: #endif
424: }
425: PetscViewerASCIISynchronizedPrintf(viewer,"n");
426: }
427: if (p) {
428: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
429: for (i=0; i<p; i++) {
430: #if defined (PETSC_USE_COMPLEX)
431: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
432: PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
433: #else
434: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
435: #endif
436: }
437: PetscViewerASCIISynchronizedPrintf(viewer,"n");
438: }
439: PetscViewerFlush(viewer);
440: } else if (issocket) {
441: int *sizes,rank,size,Ntotal,*displs;
442: Scalar *array;
444: MPI_Comm_rank(comm,&rank);
445: MPI_Comm_size(comm,&size);
447: if (size > 1) {
448: if (rank) {
449: MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
450: MPI_Gatherv(idx,N,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
451: } else {
452: ierr = PetscMalloc(size*sizeof(int),&sizes);
453: ierr = MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
454: Ntotal = sizes[0];
455: ierr = PetscMalloc(size*sizeof(int),&displs);
456: displs[0] = 0;
457: for (i=1; i<size; i++) {
458: Ntotal += sizes[i];
459: displs[i] = displs[i-1] + sizes[i-1];
460: }
461: PetscMalloc(Ntotal*sizeof(Scalar),&array);
462: MPI_Gatherv(idx,N,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
463: PetscViewerSocketPutScalar(viewer,Ntotal,1,array);
464: PetscFree(sizes);
465: PetscFree(displs);
466: PetscFree(array);
467: }
468: } else {
469: PetscViewerSocketPutScalar(viewer,N,1,idx);
470: }
471: } else {
472: SETERRQ(1,"Cannot handle that PetscViewer");
473: }
474: return(0);
475: }