/tags/wad-0-2-1/SWIG/Tools/WAD/Tcl/wadtcl.c
C | 118 lines | 74 code | 11 blank | 33 comment | 9 complexity | 108e5ab8b29effb0c1e8fe080daf48a7 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
1/* ----------------------------------------------------------------------------- 2 * wadtcl.c 3 * 4 * Dynamically loadable Tcl module for wad. 5 * 6 * Author(s) : David Beazley (beazley@cs.uchicago.edu) 7 * 8 * Copyright (C) 2000. The University of Chicago. 9 * 10 * This library is free software; you can redistribute it and/or 11 * modify it under the terms of the GNU Lesser General Public 12 * License as published by the Free Software Foundation; either 13 * version 2.1 of the License, or (at your option) any later version. 14 * 15 * This library is distributed in the hope that it will be useful, 16 * but WITHOUT ANY WARRANTY; without even the implied warranty of 17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 * Lesser General Public License for more details. 19 * 20 * You should have received a copy of the GNU Lesser General Public 21 * License along with this library; if not, write to the Free Software 22 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23 * 24 * See the file COPYING for a complete copy of the LGPL. 25 * ----------------------------------------------------------------------------- */ 26 27#include <tcl.h> 28#include "wad.h" 29#include <signal.h> 30 31static char cvs[] = "$Header$"; 32 33/* Handler function */ 34static void handler(int signo, WadFrame *frame, char *ret) { 35 static char message[65536]; 36 static char temp[1024]; 37 int len = 0; 38 char *name; 39 WadFrame *f; 40 WadFrame *fline = 0; 41 char *srcstr= 0; 42 Tcl_Interp *interp; 43 int err; 44 char *type; 45 46 if (!ret) { 47 wad_default_callback(signo, frame, ret); 48 return; 49 } 50 51 strcpy(message,"[ C stack trace ]\n\n"); 52 switch(signo) { 53 case SIGSEGV: 54 type = (char*)"Segmentation fault."; 55 break; 56 case SIGBUS: 57 type = (char*)"Bus error."; 58 break; 59 case SIGABRT: 60 type = (char*)"Abort."; 61 break; 62 case SIGFPE: 63 type = (char*)"Floating point exception."; 64 break; 65 default: 66 type = (char*)"Unknown."; 67 break; 68 } 69 70 f = frame; 71 /* Find the last exception frame */ 72 while (!f->last) { 73 f= f->next; 74 } 75 /* Now work backwards */ 76 f = f->prev; 77 while (f) { 78 strcat(message, f->debug_str); 79 if (f->debug_srcstr) srcstr = f->debug_srcstr; 80 f = f->prev; 81 } 82 if (srcstr) { 83 strcat(message,"\n"); 84 strcat(message, srcstr); 85 strcat(message,"\n"); 86 } 87 88 if (wad_heap_overflow) { 89 write(2, "WAD: Heap overflow detected.\n", 30); 90 wad_default_callback(signo, frame, ret); 91 } 92 93 /* Note: if the heap is blown, there is a very good chance that this 94 function will not succeed and we'll dump core. However, the check 95 above should dump a stack trace to stderr just in case we don't make it 96 back. */ 97 98 /* Try to get the Tcl interpreter through magic */ 99 if (ret) { 100 interp = (Tcl_Interp *) wad_steal_outarg(frame,ret,1,&err); 101 if (err == 0) { 102 Tcl_SetResult(interp,type,TCL_STATIC); 103 Tcl_AddErrorInfo(interp,message); 104 } 105 } 106} 107 108void tclwadinit() { 109 printf("WAD Enabled\n"); 110 wad_init(); 111 wad_set_callback(handler); 112 wad_set_return("TclExecuteByteCode", TCL_ERROR); 113 wad_set_return("EvalObjv", TCL_ERROR); 114} 115 116int Wad_Init(Tcl_Interp *interp) { 117 return TCL_OK; 118}