*** empty log message ***
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@953 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley
parent
bdb267863f
commit
f675cd2e3d
7 changed files with 265 additions and 0 deletions
|
|
@ -83,6 +83,7 @@ extern void wad_signalhandler(int, siginfo_t *, void *);
|
|||
extern void wad_signal_init();
|
||||
extern void wad_set_return(const char *name, long value);
|
||||
extern void wad_set_return_value(long value);
|
||||
extern void wad_set_return_func(void (*f)(void));
|
||||
|
||||
extern int wad_elf_check(WadObjectFile *wo);
|
||||
extern void wad_elf_debug(WadObjectFile *wo);
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ LIBS =
|
|||
#PYINCLUDE = -I/usr/local/include/python2.0
|
||||
PYINCLUDE = -I/usr/local/include/python1.5
|
||||
TCLINCLUDE = -I/usr/local/include
|
||||
PERLINCLUDE = -I/usr/local/lib/perl5/5.6.0/sun4-solaris/CORE
|
||||
|
||||
all::
|
||||
CC -Kpic -c $(OPT) $(INCLUDE) main.cxx
|
||||
|
|
@ -28,6 +29,13 @@ tcl::
|
|||
cp wad.so libwadtcl.so
|
||||
cp libwadtcl.so ..
|
||||
|
||||
perl::
|
||||
makehandler.py
|
||||
cc -c $(OPT) $(INCLUDE) $(SRCS)
|
||||
CC -Kpic -c $(INCLUDE) $(PERLINCLUDE) wadpl.cxx
|
||||
CC -G $(OBJS) wadpl.o -o libwadpl.so $(LIBS)
|
||||
cp libwadpl.so ..
|
||||
|
||||
linux::
|
||||
g++ -fpic -c -DWAD_LINUX $(INCLUDE) main.cxx
|
||||
gcc -g -c -DWAD_LINUX $(INCLUDE) $(SRCS)
|
||||
|
|
|
|||
8
Tools/WAD/Wad/libwadpl.pm
Normal file
8
Tools/WAD/Wad/libwadpl.pm
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
package libwadpl;
|
||||
require Exporter;
|
||||
require DynaLoader;
|
||||
@ISA = qw(Exporter DynaLoader);
|
||||
package libwadpl;
|
||||
bootstrap libwadpl;
|
||||
@EXPORT = qw( );
|
||||
1;
|
||||
20
Tools/WAD/Wad/makehandler.py
Executable file
20
Tools/WAD/Wad/makehandler.py
Executable file
|
|
@ -0,0 +1,20 @@
|
|||
#!/usr/local/bin/python
|
||||
import string
|
||||
f = open("wadhandler.pl")
|
||||
data = f.read()
|
||||
f.close()
|
||||
|
||||
data = string.replace(data,"\\", "\\\\")
|
||||
data = string.replace(data,"\"", "\\\"")
|
||||
data = string.replace(data,"\n", "\\n\\\n")
|
||||
|
||||
f = open("wad_perl_handler.c","w")
|
||||
|
||||
f.write("static char wad_perl_handler[] = \"")
|
||||
f.write(data)
|
||||
f.write("\";\n");
|
||||
f.close()
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -31,12 +31,18 @@ void wad_set_callback(void (*s)(int,WadFrame *,char *ret)) {
|
|||
static int nlr_levels = 0;
|
||||
static volatile int *volatile nlr_p = &nlr_levels;
|
||||
static long nlr_value = 0;
|
||||
static void (*nlr_func)(void) = 0;
|
||||
|
||||
/* Set the return value from another module */
|
||||
void wad_set_return_value(long value) {
|
||||
nlr_value = value;
|
||||
}
|
||||
|
||||
/* Set the return function */
|
||||
void wad_set_return_func(void(*f)(void)) {
|
||||
nlr_func = f;
|
||||
}
|
||||
|
||||
#ifdef WAD_SOLARIS
|
||||
static void nonlocalret() {
|
||||
long a;
|
||||
|
|
@ -62,6 +68,12 @@ static void nonlocalret() {
|
|||
asm("or %o0, %lo(nlr_value), %o0");
|
||||
asm("ld [%o0], %i0");
|
||||
|
||||
/* If there is a non-local return function. We're going to go ahead
|
||||
and transfer control to it */
|
||||
|
||||
if (nlr_func)
|
||||
(*nlr_func)();
|
||||
|
||||
asm("jmp %i7 + 8");
|
||||
asm("restore");
|
||||
asm(".size _returnsignal,(.-_returnsignal)");
|
||||
|
|
@ -75,6 +87,10 @@ static void nonlocalret() {
|
|||
(*nlr_p)--;
|
||||
asm("leave");
|
||||
}
|
||||
|
||||
if (nlr_func)
|
||||
(*nlr_func)();
|
||||
|
||||
asm("movl nlr_value, %eax");
|
||||
asm("leave");
|
||||
asm("ret");
|
||||
|
|
@ -99,6 +115,8 @@ void wad_signalhandler(int sig, siginfo_t *si, void *vcontext) {
|
|||
char *framedata;
|
||||
char *retname = 0;
|
||||
|
||||
nlr_func = 0;
|
||||
|
||||
wad_object_init();
|
||||
|
||||
context = (ucontext_t *) vcontext;
|
||||
|
|
|
|||
36
Tools/WAD/Wad/wadhandler.pl
Normal file
36
Tools/WAD/Wad/wadhandler.pl
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
package libwadpl;
|
||||
sub wad_handler_traceback {
|
||||
package DB;
|
||||
my $es = "";
|
||||
($pack,$file,$line) = caller(1);
|
||||
|
||||
for ($i = 2; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
|
||||
@a = ();
|
||||
for $arg (@args) {
|
||||
$_ = "$arg";
|
||||
s/([\'\\])/\\$1/g;
|
||||
s/([^\0]*)/'$1'/
|
||||
unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
|
||||
s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
|
||||
s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
|
||||
push(@a, $_);
|
||||
}
|
||||
$w = $w ? '@ = ' : '$ = ';
|
||||
$a = $h ? '(' . join(', ', @a) . ')' : '';
|
||||
$e =~ s/\n\s*\;\s*\Z// if $e;
|
||||
$e =~ s/[\\\']/\\$1/g if $e;
|
||||
if ($r) {
|
||||
$s = "require '$e'";
|
||||
} elsif (defined $r) {
|
||||
$s = "eval '$e'";
|
||||
} elsif ($s eq '(eval)') {
|
||||
$s = "eval {...}";
|
||||
}
|
||||
$f = "file `$f'" unless $f eq '-e';
|
||||
$mess = "$w$s$a called from $f line $l\n";
|
||||
$es = $mess . $es;
|
||||
|
||||
}
|
||||
$es = "Signal at $file line $line\n" . $es;
|
||||
return $es;
|
||||
}
|
||||
174
Tools/WAD/Wad/wadpl.cxx
Normal file
174
Tools/WAD/Wad/wadpl.cxx
Normal file
|
|
@ -0,0 +1,174 @@
|
|||
/* -----------------------------------------------------------------------------
|
||||
* wadpl.cxx
|
||||
*
|
||||
* Dynamically loadable module for Perl.
|
||||
*
|
||||
* Author(s) : David Beazley (beazley@cs.uchicago.edu)
|
||||
*
|
||||
* Copyright (C) 2000. The University of Chicago
|
||||
* See the file LICENSE for information on usage and redistribution.
|
||||
* ----------------------------------------------------------------------------- */
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
|
||||
#include "wad.h"
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#include <signal.h>
|
||||
|
||||
#include "wad_perl_handler.c"
|
||||
|
||||
/* Error message returned to perl */
|
||||
|
||||
static char message[65536];
|
||||
static int global_signo = 0;
|
||||
|
||||
static void returnfunc(void) {
|
||||
SV *s;
|
||||
s = perl_eval_pv("libwadpl::wad_handler_traceback(0)", 0);
|
||||
croak("%s\n%s",SvPV(s,PL_na),message);
|
||||
return;
|
||||
}
|
||||
|
||||
/* Handler function */
|
||||
static void handler(int signo, WadFrame *frame, char *ret) {
|
||||
|
||||
static char temp[1024];
|
||||
int len = 0;
|
||||
char *name;
|
||||
char *fd;
|
||||
WadFrame *f;
|
||||
WadFrame *fline = 0;
|
||||
int err;
|
||||
char *type;
|
||||
|
||||
if (!ret) {
|
||||
wad_default_callback(signo, frame, ret);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
switch(signo) {
|
||||
case SIGSEGV:
|
||||
type = "Segmentation fault.";
|
||||
break;
|
||||
case SIGBUS:
|
||||
type = "Bus error.";
|
||||
break;
|
||||
case SIGABRT:
|
||||
type = "Abort.";
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
strcpy(message,type);
|
||||
strcat(message,"\n[ C stack trace ]\n\n");
|
||||
fd = (char *) frame;
|
||||
f = (WadFrame *) fd;
|
||||
|
||||
/* Find the last exception frame */
|
||||
while (!f->last) {
|
||||
fd = fd + f->size;
|
||||
f = (WadFrame *) fd;
|
||||
}
|
||||
/* Now work backwards */
|
||||
fd = fd - f->lastsize;
|
||||
f = (WadFrame *) fd;
|
||||
while (1) {
|
||||
sprintf(temp,"#%-3d 0x%08x in ", f->frameno, f->pc);
|
||||
strcat(message,temp);
|
||||
strcat(message,*(fd + f->sym_off) ? fd+f->sym_off : "?");
|
||||
strcat(message,"()");
|
||||
if (strlen(SRCFILE(f))) {
|
||||
strcat(message," in '");
|
||||
strcat(message, wad_strip_dir(SRCFILE(f)));
|
||||
strcat(message,"'");
|
||||
if (f->line_number > 0) {
|
||||
sprintf(temp,", line %d", f->line_number);
|
||||
strcat(message,temp);
|
||||
fline = f;
|
||||
}
|
||||
} else {
|
||||
if (strlen(fd+f->obj_off)) {
|
||||
strcat(message," from '");
|
||||
strcat(message, wad_strip_dir(OBJFILE(f)));
|
||||
strcat(message,"'");
|
||||
}
|
||||
}
|
||||
strcat(message,"\n");
|
||||
if (!f->lastsize) break;
|
||||
fd = fd - f->lastsize;
|
||||
f = (WadFrame *) fd;
|
||||
}
|
||||
if (fline) {
|
||||
int first;
|
||||
int last;
|
||||
char *line, *c;
|
||||
int i;
|
||||
first = fline->line_number - 2;
|
||||
last = fline->line_number + 2;
|
||||
if (first < 1) first = 1;
|
||||
|
||||
line = wad_load_source(SRCFILE(fline),first);
|
||||
if (line) {
|
||||
strcat(message,"\n");
|
||||
strcat(message, SRCFILE(fline));
|
||||
sprintf(temp,", line %d\n\n", fline->line_number);
|
||||
strcat(message, temp);
|
||||
for (i = first; i <= last; i++) {
|
||||
if (i == fline->line_number) strcat(message," => ");
|
||||
else strcat(message," ");
|
||||
c = strchr(line,'\n');
|
||||
if (c) {
|
||||
*c = 0;
|
||||
strcat(message,line);
|
||||
strcat(message,"\n");
|
||||
*c = '\n';
|
||||
} else {
|
||||
strcat(message,line);
|
||||
strcat(message,"\n");
|
||||
break;
|
||||
}
|
||||
line = c+1;
|
||||
}
|
||||
wad_release_source();
|
||||
strcat(message,"\n");
|
||||
}
|
||||
}
|
||||
wad_set_return_func(returnfunc);
|
||||
wad_release_trace();
|
||||
}
|
||||
|
||||
static void perlwadinit() {
|
||||
printf("WAD Enabled\n");
|
||||
wad_init();
|
||||
wad_set_callback(handler);
|
||||
wad_set_return("Perl_pp_entersub", 0);
|
||||
perl_eval_pv(wad_perl_handler, 0);
|
||||
}
|
||||
|
||||
/* This hack is used to auto-initialize wad regardless of whether we are
|
||||
used as an imported module or as a link-library for another module */
|
||||
|
||||
class wadinitializer {
|
||||
public:
|
||||
wadinitializer() {
|
||||
perlwadinit();
|
||||
}
|
||||
};
|
||||
|
||||
static wadinitializer wi;
|
||||
|
||||
extern "C"
|
||||
XS(boot_libwadpl) {
|
||||
dXSARGS;
|
||||
ST(0) = &PL_sv_yes;
|
||||
XSRETURN(1);
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue