3f628d65a8
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@1227 626c5289-ae23-0410-ae9c-e8d60b6d4f22
122 lines
3.1 KiB
C
122 lines
3.1 KiB
C
/* -----------------------------------------------------------------------------
|
|
* wadtcl.c
|
|
*
|
|
* Dynamically loadable Tcl module for wad.
|
|
*
|
|
* Author(s) : David Beazley (beazley@cs.uchicago.edu)
|
|
*
|
|
* Copyright (C) 2000. The University of Chicago.
|
|
*
|
|
* This library is free software; you can redistribute it and/or
|
|
* modify it under the terms of the GNU Lesser General Public
|
|
* License as published by the Free Software Foundation; either
|
|
* version 2.1 of the License, or (at your option) any later version.
|
|
*
|
|
* This library is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
* Lesser General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU Lesser General Public
|
|
* License along with this library; if not, write to the Free Software
|
|
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
*
|
|
* See the file COPYING for a complete copy of the LGPL.
|
|
* ----------------------------------------------------------------------------- */
|
|
|
|
#include <tcl.h>
|
|
#include "wad.h"
|
|
#include <signal.h>
|
|
|
|
static char cvs[] = "$Header$";
|
|
|
|
/* Handler function */
|
|
static void handler(int signo, WadFrame *frame, char *ret) {
|
|
static char message[65536];
|
|
static char temp[1024];
|
|
int len = 0;
|
|
char *name;
|
|
WadFrame *f;
|
|
WadFrame *fline = 0;
|
|
char *srcstr= 0;
|
|
Tcl_Interp *interp;
|
|
int err;
|
|
char *type;
|
|
|
|
if (!ret) {
|
|
wad_default_callback(signo, frame, ret);
|
|
return;
|
|
}
|
|
|
|
strcpy(message,"[ C stack trace ]\n\n");
|
|
switch(signo) {
|
|
case SIGSEGV:
|
|
type = (char*)"Segmentation fault.";
|
|
break;
|
|
case SIGBUS:
|
|
type = (char*)"Bus error.";
|
|
break;
|
|
case SIGABRT:
|
|
type = (char*)"Abort.";
|
|
break;
|
|
case SIGFPE:
|
|
type = (char*)"Floating point exception.";
|
|
break;
|
|
default:
|
|
type = (char*)"Unknown.";
|
|
break;
|
|
}
|
|
|
|
f = frame;
|
|
/* Find the last exception frame */
|
|
while (!f->last) {
|
|
f= f->next;
|
|
}
|
|
/* Now work backwards */
|
|
f = f->prev;
|
|
while (f) {
|
|
strcat(message, f->debug_str);
|
|
if (f->debug_srcstr) srcstr = f->debug_srcstr;
|
|
f = f->prev;
|
|
}
|
|
if (srcstr) {
|
|
strcat(message,"\n");
|
|
strcat(message, srcstr);
|
|
strcat(message,"\n");
|
|
}
|
|
|
|
if (wad_heap_overflow) {
|
|
write(2, "WAD: Heap overflow detected.\n", 30);
|
|
wad_default_callback(signo, frame, ret);
|
|
}
|
|
|
|
/* Note: if the heap is blown, there is a very good chance that this
|
|
function will not succeed and we'll dump core. However, the check
|
|
above should dump a stack trace to stderr just in case we don't make it
|
|
back. */
|
|
|
|
/* Try to get the Tcl interpreter through magic */
|
|
if (ret) {
|
|
interp = (Tcl_Interp *) wad_steal_outarg(frame,ret,1,&err);
|
|
if (err == 0) {
|
|
Tcl_SetResult(interp,type,TCL_STATIC);
|
|
Tcl_AddErrorInfo(interp,message);
|
|
}
|
|
}
|
|
}
|
|
|
|
void tclwadinit() {
|
|
printf("WAD Enabled\n");
|
|
wad_init();
|
|
wad_set_callback(handler);
|
|
wad_set_return("TclExecuteByteCode", TCL_ERROR);
|
|
wad_set_return("EvalObjv", TCL_ERROR);
|
|
}
|
|
|
|
int Wad_Init(Tcl_Interp *interp) {
|
|
return TCL_OK;
|
|
}
|
|
|
|
int Wadtcl_Init(Tcl_Interp *interp) {
|
|
return TCL_OK;
|
|
}
|