1% Copyright (C) 2012-2017,2018 John E. Davis 2% 3% This file is part of the S-Lang Library and may be distributed under the 4% terms of the GNU General Public License. See the file COPYING for 5% more information. 6%--------------------------------------------------------------------------- 7% This file adds BOS/EOS hooks to the interpreter to help debug stack problems. 8% To use it, put the following at the top of a problematic file: 9% 10% require ("stkcheck"); 11% enable_stack_check (); 12% 13% To check only portions of a file, surround the suspect functions by: 14% 15% enable_stack_check (); 16% . 17% . 18% disable_stack_check (); 19% 20_boseos_info = 0; 21private variable Stack = Struct_Type[512]; 22private variable Stack_Depth = 0; 23 24private variable Output_Hook = NULL; 25private variable Output_Hook_Args = NULL; 26 27define stkcheck_set_output_hook () 28{ 29 if (_NARGS == 0) 30 { 31 Output_Hook = NULL; 32 Output_Hook_Args = NULL; 33 return; 34 } 35 36 Output_Hook_Args = __pop_list (_NARGS-1); 37 Output_Hook = (); 38} 39 40private define output () 41{ 42 variable args = __pop_list (_NARGS); 43 variable str = sprintf (__push_list (args)); 44 45 if (Output_Hook != NULL) 46 return (@Output_Hook)(__push_list (Output_Hook_Args), str); 47 48 () = fprintf (stderr, __push_list (args)); 49} 50 51private define bos_handler (file, line) 52{ 53 if (Stack_Depth >= length (Stack)) 54 throw StackOverflowError, "BOS stack overflow"; 55 56 variable s = struct 57 { 58 file, line, depth 59 }; 60 s.file = file; 61 s.line = line; 62 s.depth = _stkdepth (); 63 Stack[Stack_Depth] = s; 64 Stack_Depth++; 65} 66 67private define eos_handler () 68{ 69 if (Stack_Depth <= 0) 70 return; 71 %throw StackUnderflowError, "BOS stack depth underflow"; 72 Stack_Depth--; 73 variable s = Stack[Stack_Depth]; 74 variable depth = _stkdepth (); 75 if (depth != s.depth) 76 { 77 if (depth < s.depth) 78 ; 79 else 80 { 81 output ("%s:%d: %d object(s) left on the stack\n", s.file, s.line, depth-s.depth); 82 if ((s.file == "***string***") && (Stack_Depth > 0)) 83 { 84 s = Stack[Stack_Depth-1]; 85 output (" called from %s:%d\n", s.file, s.line); 86 } 87 } 88 } 89} 90 91define enable_stack_check () 92{ 93 ()=_set_bos_handler (&bos_handler); 94 ()=_set_eos_handler (&eos_handler); 95 Stack_Depth = 0; 96 _boseos_info = 1; 97} 98 99define disable_stack_check () 100{ 101 ()=_set_bos_handler (NULL); 102 ()=_set_eos_handler (NULL); 103 Stack_Depth = 0; 104 _boseos_info = 0; 105} 106 107#ifexists _jed_version 108private define output_to_buffer (buf, str) 109{ 110 variable cbuf = whatbuf (); 111 setbuf (buf); 112 insert (str); 113 setbuf (cbuf); 114} 115if (BATCH == 0) stkcheck_set_output_hook (&output_to_buffer, "*traceback*"); 116#endif 117 118provide ("stkcheck"); 119