View file File name : stkcheck.sl Content :% Copyright (C) 2012-2017,2018 John E. Davis % % This file is part of the S-Lang Library and may be distributed under the % terms of the GNU General Public License. See the file COPYING for % more information. %--------------------------------------------------------------------------- % This file adds BOS/EOS hooks to the interpreter to help debug stack problems. % To use it, put the following at the top of a problematic file: % % require ("stkcheck"); % enable_stack_check (); % % To check only portions of a file, surround the suspect functions by: % % enable_stack_check (); % . % . % disable_stack_check (); % _boseos_info = 0; private variable Stack = Struct_Type[512]; private variable Stack_Depth = 0; private variable Output_Hook = NULL; private variable Output_Hook_Args = NULL; define stkcheck_set_output_hook () { if (_NARGS == 0) { Output_Hook = NULL; Output_Hook_Args = NULL; return; } Output_Hook_Args = __pop_list (_NARGS-1); Output_Hook = (); } private define output () { variable args = __pop_list (_NARGS); variable str = sprintf (__push_list (args)); if (Output_Hook != NULL) return (@Output_Hook)(__push_list (Output_Hook_Args), str); () = fprintf (stderr, __push_list (args)); } private define bos_handler (file, line) { if (Stack_Depth >= length (Stack)) throw StackOverflowError, "BOS stack overflow"; variable s = struct { file, line, depth }; s.file = file; s.line = line; s.depth = _stkdepth (); Stack[Stack_Depth] = s; Stack_Depth++; } private define eos_handler () { if (Stack_Depth <= 0) return; %throw StackUnderflowError, "BOS stack depth underflow"; Stack_Depth--; variable s = Stack[Stack_Depth]; variable depth = _stkdepth (); if (depth != s.depth) { if (depth < s.depth) ; else { output ("%s:%d: %d object(s) left on the stack\n", s.file, s.line, depth-s.depth); if ((s.file == "***string***") && (Stack_Depth > 0)) { s = Stack[Stack_Depth-1]; output (" called from %s:%d\n", s.file, s.line); } } } } define enable_stack_check () { ()=_set_bos_handler (&bos_handler); ()=_set_eos_handler (&eos_handler); Stack_Depth = 0; _boseos_info = 1; } define disable_stack_check () { ()=_set_bos_handler (NULL); ()=_set_eos_handler (NULL); Stack_Depth = 0; _boseos_info = 0; } #ifexists _jed_version private define output_to_buffer (buf, str) { variable cbuf = whatbuf (); setbuf (buf); insert (str); setbuf (cbuf); } if (BATCH == 0) stkcheck_set_output_hook (&output_to_buffer, "*traceback*"); #endif provide ("stkcheck");