| Current File : //usr/share/slsh/stkcheck.sl |
% 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");