Tools/WAD/Wad/wadpl.cxx

   1 /* -----------------------------------------------------------------------------
   2  * wadpl.cxx
   3  *
   4  *     Dynamically loadable module for Perl.
   5  *
   6  * Author(s) : David Beazley (beazley@cs.uchicago.edu)
   7  *
   8  * Copyright (C) 2000.  The University of Chicago
   9  * See the file LICENSE for information on usage and redistribution.
  10  * ----------------------------------------------------------------------------- */
  11
  12 #ifdef __cplusplus
  13 extern "C" {
  14 #endif
  15 #include "EXTERN.h"
  16 #include "perl.h"
  17 #include "XSUB.h"
  18
  19 #include "wad.h"
  20 #ifdef __cplusplus
  21 }
  22 #endif
  23
  24 #include <signal.h>
  25
  26 #include "wad_perl_handler.c"
  27
  28 /* Error message returned to perl */
  29
  30 static char message[65536];
  31 static int  global_signo = 0;
  32
  33 static void returnfunc(void) {
  34   SV     *s;
  35   s = perl_eval_pv((char*)"libwadpl::wad_handler_traceback(0)", 0);
  36   croak("%s\n%s",SvPV(s,PL_na),message);
  37   return;
  38 }
  39
  40 /* Handler function */
  41 static void handler(int signo, WadFrame *frame, char *ret) {
  42
  43   static char temp[1024];
  44   int  len = 0;
  45   char *name;
  46   char *fd;
  47   WadFrame *f;
  48   WadFrame *fline = 0;
  49   int err;
  50   char  *type;
  51
  52   if (!ret) {
  53     wad_default_callback(signo, frame, ret);
  54     return;
  55   }
  56
  57
  58   switch(signo) {
  59   case SIGSEGV:
  60     type = (char*)"Segmentation fault.";
  61     break;
  62   case SIGBUS:
  63     type = (char*)"Bus error.";
  64     break;
  65   case SIGABRT:
  66     type = (char*)"Abort.";
  67     break;
  68   case SIGFPE:
  69     type = (char*)"Math.";
  70   default:
  71     break;
  72   }
  73   strcpy(message,type);
  74   strcat(message,"\n[ C stack trace ]\n\n");
  75   fd = (char *) frame;
  76   f = (WadFrame *) fd;
  77
  78   /* Find the last exception frame */
  79   while (!f->last) {
  80     fd = fd + f->size;
  81     f = (WadFrame *) fd;
  82   }
  83   /* Now work backwards */
  84   fd = fd - f->lastsize;
  85   f = (WadFrame *) fd;
  86   while (1) {
  87     sprintf(temp,"#%-3d 0x%08x in ", f->frameno, f->pc);
  88     strcat(message,temp);
  89     strcat(message,*(fd + f->sym_off) ? fd+f->sym_off : "?");
  90     strcat(message,"()");
  91     if (strlen(SRCFILE(f))) {
  92       strcat(message," in '");
  93       strcat(message, wad_strip_dir(SRCFILE(f)));
  94       strcat(message,"'");
  95       if (f->line_number > 0) {
  96         sprintf(temp,", line %d", f->line_number);
  97         strcat(message,temp);
  98         fline = f;
  99       }
 100     } else {
 101       if (strlen(fd+f->obj_off)) {
 102         strcat(message," from '");
 103         strcat(message, wad_strip_dir(OBJFILE(f)));
 104         strcat(message,"'");
 105       }
 106     }
 107     strcat(message,"\n");
 108     if (!f->lastsize) break;
 109     fd = fd - f->lastsize;
 110     f = (WadFrame *) fd;
 111   }
 112   if (fline) {
 113     int first;
 114     int last;
 115     char *line, *c;
 116     int i;
 117     first = fline->line_number - 2;
 118     last  = fline->line_number + 2;
 119     if (first < 1) first = 1;
 120
 121     line = wad_load_source(SRCFILE(fline),first);
 122     if (line) {
 123       strcat(message,"\n");
 124       strcat(message, SRCFILE(fline));
 125       sprintf(temp,", line %d\n\n", fline->line_number);
 126       strcat(message, temp);
 127       for (i = first; i <= last; i++) {
 128         if (i == fline->line_number) strcat(message," => ");
 129         else                         strcat(message,"    ");
 130         c = strchr(line,'\n');
 131         if (c) {
 132           *c = 0;
 133           strcat(message,line);
 134           strcat(message,"\n");
 135           *c = '\n';
 136         } else {
 137           strcat(message,line);
 138           strcat(message,"\n");
 139           break;
 140         }
 141         line = c+1;
 142       }
 143       wad_release_source();
 144       strcat(message,"\n");
 145     }
 146   }
 147   wad_set_return_func(returnfunc);
 148   wad_release_trace();
 149 }
 150
 151 static void perlwadinit() {
 152   printf("WAD Enabled\n");
 153   wad_init();
 154   wad_set_callback(handler);
 155   wad_set_return("Perl_pp_entersub", 0);
 156   perl_eval_pv(wad_perl_handler, 0);
 157 }
 158
 159 /* This hack is used to auto-initialize wad regardless of whether we are
 160    used as an imported module or as a link-library for another module */
 161
 162 class wadinitializer {
 163 public:
 164   wadinitializer() {
 165     perlwadinit();
 166   }
 167 };
 168
 169 static wadinitializer wi;
 170
 171 extern "C"
 172 XS(boot_libwadpl) {
 173   dXSARGS;
 174   ST(0) = &PL_sv_yes;
 175   XSRETURN(1);
 176 }