Actual source code: err.c
1: /*$Id: err.c,v 1.130 2001/09/07 15:24:29 bsmith Exp $*/
2: /*
3: Code that allows one to set the error handlers
4: */
5: #include petsc.h
6: #include petscsys.h
7: #include <stdarg.h>
8: #if defined(PETSC_HAVE_STDLIB_H)
9: #include <stdlib.h>
10: #endif
12: typedef struct _EH *EH;
13: struct _EH {
14: int cookie;
15: int (*handler)(int,char*,char*,char *,int,int,char*,void *);
16: void *ctx;
17: EH previous;
18: };
20: static EH eh = 0;
24: /*@C
25: PetscEmacsClientErrorHandler - Error handler that uses the emacsclient program to
26: load the file where the error occured. Then calls the "previous" error handler.
28: Not Collective
30: Input Parameters:
31: + line - the line number of the error (indicated by __LINE__)
32: . func - the function where error is detected (indicated by __FUNCT__)
33: . file - the file in which the error was detected (indicated by __FILE__)
34: . dir - the directory of the file (indicated by __SDIR__)
35: . mess - an error text string, usually just printed to the screen
36: . n - the generic error number
37: . p - specific error number
38: - ctx - error handler context
40: Options Database Key:
41: . -on_error_emacs <machinename>
43: Level: developer
45: Notes:
46: You must put (server-start) in your .emacs file for the emacsclient software to work
48: Most users need not directly employ this routine and the other error
49: handlers, but can instead use the simplified interface SETERRQ, which has
50: the calling sequence
51: $ SETERRQ(number,p,mess)
53: Notes for experienced users:
54: Use PetscPushErrorHandler() to set the desired error handler. The
55: currently available PETSc error handlers include PetscTraceBackErrorHandler(),
56: PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscStopErrorHandler()
58: Concepts: emacs^going to on error
59: Concepts: error handler^going to line in emacs
61: .seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
62: PetscAbortErrorHandler()
63: @*/
64: int PetscEmacsClientErrorHandler(int line,char *fun,char* file,char *dir,int n,int p,char *mess,void *ctx)
65: {
66: int ierr;
67: char command[PETSC_MAX_PATH_LEN],*pdir;
68: FILE *fp;
71: /* Note: don't check error codes since this an error handler :-) */
72: PetscGetPetscDir(&pdir);
73: sprintf(command,"emacsclient +%d %s/%s%s\n",line,pdir,dir,file);
74: PetscPOpen(MPI_COMM_WORLD,(char*)ctx,command,"r",&fp);
75: PetscFClose(MPI_COMM_WORLD,fp);
76: PetscPopErrorHandler(); /* remove this handler from the stack of handlers */
77: if (!eh) PetscTraceBackErrorHandler(line,fun,file,dir,n,p,mess,0);
78: else (*eh->handler)(line,fun,file,dir,n,p,mess,eh->ctx);
79: PetscFunctionReturn(ierr);
80: }
84: /*@C
85: PetscPushErrorHandler - Sets a routine to be called on detection of errors.
87: Not Collective
89: Input Parameters:
90: + handler - error handler routine
91: - ctx - optional handler context that contains information needed by the handler (for
92: example file pointers for error messages etc.)
94: Calling sequence of handler:
95: $ int handler(int line,char *func,char *file,char *dir,int n,int p,char *mess,void *ctx);
97: + func - the function where the error occured (indicated by __FUNCT__)
98: . line - the line number of the error (indicated by __LINE__)
99: . file - the file in which the error was detected (indicated by __FILE__)
100: . dir - the directory of the file (indicated by __SDIR__)
101: . n - the generic error number (see list defined in include/petscerror.h)
102: . p - the specific error number
103: . mess - an error text string, usually just printed to the screen
104: - ctx - the error handler context
106: Options Database Keys:
107: + -on_error_attach_debugger <noxterm,gdb or dbx>
108: - -on_error_abort
110: Level: intermediate
112: .seealso: PetscPopErrorHandler(), PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), PetscTraceBackErrorHandler()
114: @*/
115: int PetscPushErrorHandler(int (*handler)(int,char *,char*,char*,int,int,char*,void*),void *ctx)
116: {
117: EH neweh;
121: PetscNew(struct _EH,&neweh);
122: if (eh) {neweh->previous = eh;}
123: else {neweh->previous = 0;}
124: neweh->handler = handler;
125: neweh->ctx = ctx;
126: eh = neweh;
127: return(0);
128: }
132: /*@C
133: PetscPopErrorHandler - Removes the latest error handler that was
134: pushed with PetscPushErrorHandler().
136: Not Collective
138: Level: intermediate
140: Concepts: error handler^setting
142: .seealso: PetscPushErrorHandler()
143: @*/
144: int PetscPopErrorHandler(void)
145: {
146: EH tmp;
150: if (!eh) return(0);
151: tmp = eh;
152: eh = eh->previous;
153: PetscFree(tmp);
155: return(0);
156: }
157:
158: char PetscErrorBaseMessage[1024];
162: /*@C
163: PetscError - Routine that is called when an error has been detected,
164: usually called through the macro SETERRQ().
166: Not Collective
168: Input Parameters:
169: + line - the line number of the error (indicated by __LINE__)
170: . func - the function where the error occured (indicated by __FUNCT__)
171: . dir - the directory of file (indicated by __SDIR__)
172: . file - the file in which the error was detected (indicated by __FILE__)
173: . mess - an error text string, usually just printed to the screen
174: . n - the generic error number
175: . p - 1 indicates the error was initially detected, 0 indicates this is a traceback from a
176: previously detected error
177: - mess - formatted message string - aka printf
179: Level: intermediate
181: Notes:
182: Most users need not directly use this routine and the error handlers, but
183: can instead use the simplified interface SETERRQ, which has the calling
184: sequence
185: $ SETERRQ(n,mess)
187: Experienced users can set the error handler with PetscPushErrorHandler().
189: Concepts: error^setting condition
191: .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ(), SETERRQ1(), SETERRQ2()
192: @*/
193: int PetscError(int line,char *func,char* file,char *dir,int n,int p,char *mess,...)
194: {
195: va_list Argp;
196: int ierr;
197: char buf[2048],*lbuf = 0;
198: PetscTruth ismain,isunknown;
200: if (!func) func = "User provided function";
201: if (!file) file = "User file";
202: if (!dir) dir = " ";
205: /* Compose the message evaluating the print format */
206: if (mess) {
207: va_start(Argp,mess);
208: #if defined(PETSC_HAVE_VPRINTF_CHAR)
209: vsprintf(buf,mess,(char *)Argp);
210: #else
211: vsprintf(buf,mess,Argp);
212: #endif
213: va_end(Argp);
214: lbuf = buf;
215: if (p == 1) {
216: PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
217: }
218: }
220: if (!eh) PetscTraceBackErrorHandler(line,func,file,dir,n,p,lbuf,0);
221: else (*eh->handler)(line,func,file,dir,n,p,lbuf,eh->ctx);
223: /*
224: If this is called from the main() routine we call MPI_Abort() instead of
225: return to allow the parallel program to be properly shutdown.
227: Since this is in the error handler we don't check the errors below. Of course,
228: PetscStrncmp() does its own error checking which is problamatic
229: */
230: PetscStrncmp(func,"main",4,&ismain);
231: PetscStrncmp(func,"unknown",7,&isunknown);
232: if (ismain || isunknown) {
233: MPI_Abort(PETSC_COMM_WORLD,ierr);
234: }
235: PetscFunctionReturn(ierr);
236: }
238: /* -------------------------------------------------------------------------*/
242: /*@C
243: PetscIntView - Prints an array of integers; useful for debugging.
245: Collective on PetscViewer
247: Input Parameters:
248: + N - number of integers in array
249: . idx - array of integers
250: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
252: Level: intermediate
254: .seealso: PetscRealView()
255: @*/
256: int PetscIntView(int N,int idx[],PetscViewer viewer)
257: {
258: int j,i,n = N/20,p = N % 20,ierr;
259: PetscTruth isascii,issocket;
260: MPI_Comm comm;
263: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
266: PetscObjectGetComm((PetscObject)viewer,&comm);
268: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
269: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
270: if (isascii) {
271: for (i=0; i<n; i++) {
272: PetscViewerASCIISynchronizedPrintf(viewer,"%d:",20*i);
273: for (j=0; j<20; j++) {
274: PetscViewerASCIISynchronizedPrintf(viewer," %d",idx[i*20+j]);
275: }
276: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
277: }
278: if (p) {
279: PetscViewerASCIISynchronizedPrintf(viewer,"%d:",20*n);
280: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %d",idx[20*n+i]);}
281: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
282: }
283: PetscViewerFlush(viewer);
284: } else if (issocket) {
285: int *array,*sizes,rank,size,Ntotal,*displs;
287: MPI_Comm_rank(comm,&rank);
288: MPI_Comm_size(comm,&size);
290: if (size > 1) {
291: if (rank) {
292: MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
293: MPI_Gatherv(idx,N,MPI_INT,0,0,0,MPI_INT,0,comm);
294: } else {
295: PetscMalloc(size*sizeof(int),&sizes);
296: MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
297: Ntotal = sizes[0];
298: PetscMalloc(size*sizeof(int),&displs);
299: displs[0] = 0;
300: for (i=1; i<size; i++) {
301: Ntotal += sizes[i];
302: displs[i] = displs[i-1] + sizes[i-1];
303: }
304: PetscMalloc(Ntotal*sizeof(int),&array);
305: MPI_Gatherv(idx,N,MPI_INT,array,sizes,displs,MPI_INT,0,comm);
306: PetscViewerSocketPutInt(viewer,Ntotal,array);
307: PetscFree(sizes);
308: PetscFree(displs);
309: PetscFree(array);
310: }
311: } else {
312: PetscViewerSocketPutInt(viewer,N,idx);
313: }
314: } else {
315: SETERRQ(1,"Cannot handle that PetscViewer");
316: }
317: return(0);
318: }
322: /*@C
323: PetscRealView - Prints an array of doubles; useful for debugging.
325: Collective on PetscViewer
327: Input Parameters:
328: + N - number of doubles in array
329: . idx - array of doubles
330: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
332: Level: intermediate
334: .seealso: PetscIntView()
335: @*/
336: int PetscRealView(int N,PetscReal idx[],PetscViewer viewer)
337: {
338: int j,i,n = N/5,p = N % 5,ierr;
339: PetscTruth isascii,issocket;
340: MPI_Comm comm;
343: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
346: PetscObjectGetComm((PetscObject)viewer,&comm);
348: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
349: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
350: if (isascii) {
351: for (i=0; i<n; i++) {
352: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*i);
353: for (j=0; j<5; j++) {
354: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*5+j]);
355: }
356: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
357: }
358: if (p) {
359: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",5*n);
360: for (i=0; i<p; i++) { PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[5*n+i]);}
361: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
362: }
363: PetscViewerFlush(viewer);
364: } else if (issocket) {
365: int *sizes,rank,size,Ntotal,*displs;
366: PetscReal *array;
368: MPI_Comm_rank(comm,&rank);
369: MPI_Comm_size(comm,&size);
371: if (size > 1) {
372: if (rank) {
373: MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
374: MPI_Gatherv(idx,N,MPI_DOUBLE,0,0,0,MPI_DOUBLE,0,comm);
375: } else {
376: PetscMalloc(size*sizeof(int),&sizes);
377: MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
378: Ntotal = sizes[0];
379: PetscMalloc(size*sizeof(int),&displs);
380: displs[0] = 0;
381: for (i=1; i<size; i++) {
382: Ntotal += sizes[i];
383: displs[i] = displs[i-1] + sizes[i-1];
384: }
385: PetscMalloc(Ntotal*sizeof(PetscReal),&array);
386: MPI_Gatherv(idx,N,MPI_DOUBLE,array,sizes,displs,MPI_DOUBLE,0,comm);
387: PetscViewerSocketPutReal(viewer,Ntotal,1,array);
388: PetscFree(sizes);
389: PetscFree(displs);
390: PetscFree(array);
391: }
392: } else {
393: PetscViewerSocketPutReal(viewer,N,1,idx);
394: }
395: } else {
396: SETERRQ(1,"Cannot handle that PetscViewer");
397: }
398: return(0);
399: }
403: /*@C
404: PetscScalarView - Prints an array of scalars; useful for debugging.
406: Collective on PetscViewer
408: Input Parameters:
409: + N - number of scalars in array
410: . idx - array of scalars
411: - viewer - location to print array, PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_STDOUT_SELF or 0
413: Level: intermediate
415: .seealso: PetscIntView(), PetscRealView()
416: @*/
417: int PetscScalarView(int N,PetscScalar idx[],PetscViewer viewer)
418: {
419: int j,i,n = N/3,p = N % 3,ierr;
420: PetscTruth isascii,issocket;
421: MPI_Comm comm;
424: if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF;
427: PetscObjectGetComm((PetscObject)viewer,&comm);
429: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
430: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_SOCKET,&issocket);
431: if (isascii) {
432: for (i=0; i<n; i++) {
433: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*i);
434: for (j=0; j<3; j++) {
435: #if defined (PETSC_USE_COMPLEX)
436: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
437: PetscRealPart(idx[i*3+j]),PetscImaginaryPart(idx[i*3+j]));
438: #else
439: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[i*3+j]);
440: #endif
441: }
442: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
443: }
444: if (p) {
445: PetscViewerASCIISynchronizedPrintf(viewer,"%2d:",3*n);
446: for (i=0; i<p; i++) {
447: #if defined (PETSC_USE_COMPLEX)
448: PetscViewerASCIISynchronizedPrintf(viewer," (%12.4e,%12.4e)",
449: PetscRealPart(idx[n*3+i]),PetscImaginaryPart(idx[n*3+i]));
450: #else
451: PetscViewerASCIISynchronizedPrintf(viewer," %12.4e",idx[3*n+i]);
452: #endif
453: }
454: PetscViewerASCIISynchronizedPrintf(viewer,"\n");
455: }
456: PetscViewerFlush(viewer);
457: } else if (issocket) {
458: int *sizes,rank,size,Ntotal,*displs;
459: PetscScalar *array;
461: MPI_Comm_rank(comm,&rank);
462: MPI_Comm_size(comm,&size);
464: if (size > 1) {
465: if (rank) {
466: MPI_Gather(&N,1,MPI_INT,0,0,MPI_INT,0,comm);
467: MPI_Gatherv(idx,N,MPIU_SCALAR,0,0,0,MPIU_SCALAR,0,comm);
468: } else {
469: PetscMalloc(size*sizeof(int),&sizes);
470: MPI_Gather(&N,1,MPI_INT,sizes,1,MPI_INT,0,comm);
471: Ntotal = sizes[0];
472: PetscMalloc(size*sizeof(int),&displs);
473: displs[0] = 0;
474: for (i=1; i<size; i++) {
475: Ntotal += sizes[i];
476: displs[i] = displs[i-1] + sizes[i-1];
477: }
478: PetscMalloc(Ntotal*sizeof(PetscScalar),&array);
479: MPI_Gatherv(idx,N,MPIU_SCALAR,array,sizes,displs,MPIU_SCALAR,0,comm);
480: PetscViewerSocketPutScalar(viewer,Ntotal,1,array);
481: PetscFree(sizes);
482: PetscFree(displs);
483: PetscFree(array);
484: }
485: } else {
486: PetscViewerSocketPutScalar(viewer,N,1,idx);
487: }
488: } else {
489: SETERRQ(1,"Cannot handle that PetscViewer");
490: }
491: return(0);
492: }