PageRenderTime 50ms CodeModel.GetById 16ms RepoModel.GetById 0ms app.codeStats 0ms

/tags/rel-1.3.35/Tools/WAD/Tcl/wadtcl.c

#
C | 122 lines | 77 code | 12 blank | 33 comment | 9 complexity | 770f01ea7e87effc95dcec5f376a2285 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. #include <tcl.h>
  27. #include "wad.h"
  28. #include <signal.h>
  29. static char cvs[] = "$Id: wadtcl.c 10001 2007-10-17 21:33:57Z wsfulton $";
  30. /* Handler function */
  31. static void handler(int signo, WadFrame *frame, char *ret) {
  32. static char message[65536];
  33. static char temp[1024];
  34. int len = 0;
  35. char *name;
  36. WadFrame *f;
  37. WadFrame *fline = 0;
  38. char *srcstr= 0;
  39. Tcl_Interp *interp;
  40. int err;
  41. char *type;
  42. if (!ret) {
  43. wad_default_callback(signo, frame, ret);
  44. return;
  45. }
  46. strcpy(message,"[ C stack trace ]\n\n");
  47. switch(signo) {
  48. case SIGSEGV:
  49. type = (char*)"Segmentation fault.";
  50. break;
  51. case SIGBUS:
  52. type = (char*)"Bus error.";
  53. break;
  54. case SIGABRT:
  55. type = (char*)"Abort.";
  56. break;
  57. case SIGFPE:
  58. type = (char*)"Floating point exception.";
  59. break;
  60. default:
  61. type = (char*)"Unknown.";
  62. break;
  63. }
  64. f = frame;
  65. /* Find the last exception frame */
  66. while (!f->last) {
  67. f= f->next;
  68. }
  69. /* Now work backwards */
  70. f = f->prev;
  71. while (f) {
  72. strcat(message, f->debug_str);
  73. if (f->debug_srcstr) srcstr = f->debug_srcstr;
  74. f = f->prev;
  75. }
  76. if (srcstr) {
  77. strcat(message,"\n");
  78. strcat(message, srcstr);
  79. strcat(message,"\n");
  80. }
  81. if (wad_heap_overflow) {
  82. write(2, "WAD: Heap overflow detected.\n", 30);
  83. wad_default_callback(signo, frame, ret);
  84. }
  85. /* Note: if the heap is blown, there is a very good chance that this
  86. function will not succeed and we'll dump core. However, the check
  87. above should dump a stack trace to stderr just in case we don't make it
  88. back. */
  89. /* Try to get the Tcl interpreter through magic */
  90. if (ret) {
  91. interp = (Tcl_Interp *) wad_steal_outarg(frame,ret,1,&err);
  92. if (err == 0) {
  93. Tcl_SetResult(interp,type,TCL_STATIC);
  94. Tcl_AddErrorInfo(interp,message);
  95. }
  96. }
  97. }
  98. void tclwadinit() {
  99. printf("WAD Enabled\n");
  100. wad_init();
  101. wad_set_callback(handler);
  102. wad_set_return("TclExecuteByteCode", TCL_ERROR);
  103. wad_set_return("EvalObjv", TCL_ERROR);
  104. }
  105. int Wad_Init(Tcl_Interp *interp) {
  106. return TCL_OK;
  107. }
  108. int Wadtcl_Init(Tcl_Interp *interp) {
  109. return TCL_OK;
  110. }