Luc Beaudoin asks:
> Does anyone out there have tools for detecting the source of user stack
> overflow. [text deleted] Particularly useful would be a utility
> which, for every item currently on the stack, keeps track of which
> procedure left the item there. Given such a utility, one could ask it
> who is responsible for the Nth item on the stack.
This isn't easy. Here's my first attempt at such a utility "view_stack".
It redefines sysPUSH/S/Q and sysCALL/S/Q in an attempt to discover who
did what and when. Give it a whirl, but bear in mind you will pay a
heavy efficiency cost !
To use this code, simply load it up before any other code. After this,
any code compiled with -pop_debugging- set to -true- will experience
a massive slowdown. However, at any point in your code you can call
-view_stack()-
which will tell you who put each item on the stack.
I've tested this on a few small examples only -- but it worked OK on
them. Let me know if this works for you.
There are some problems -- the view_stack code works by using the pdnargs
of procedures. When the pdnargs is wrong (e.g. class_apply( vector_key) )
you will get slightly incorrect attributions.
Steve
-- view_stack.p ---------------------------------------------------------
section;
if isdefined( "view_stack" ) then
mishap( 'Loading this code twice -- bad juju', [] )
endif;
lvars table = {};
lvars table_size = table.datalength;
lconstant unknown = '<unknown>';
define lconstant procedure note( p, n ); lvars p, n;
;;; Do we need to expand the table? Make it a fast check.
if n fi_> table_size then
;;; printf( 'Extending table\n', [] );
{%
table.explode;
;;; extend the table enough and add 8 for luck.
repeat n - table_size + 8 times
unknown
endrepeat
%} -> table;
table.datalength -> table_size;
endif;
;;; Update table. Make it as fast as possible.
p -> fast_subscrv( n, table );
enddefine;
lvars peeked;
define lconstant procedure peek();
lvars p = caller( 1 );
unless p then
unknown -> p;
endunless;
lvars n = stacklength();
note( p, n );
n -> peeked;
enddefine;
define lconstant procedure invoke( p ); lvars procedure p;
lvars before = stacklength();
false -> peeked;
p();
lvars after = stacklength();
lvars lo = peeked or ( before - pdnargs( p ) );
lvars i;
for i from lo + 1 to after do
note( p, i )
endfor;
enddefine;
define lconstant invoke_any( x ); lvars x;
if x.isprocedure then
chain( x, invoke )
else
lvars L = stacklength();
note( caller( 1 ) or unknown, L );
chain( x, x.datakey.class_apply, invoke );
endif;
enddefine;
;;; It is vital that -view_stack- is defined before sysPUSH/Q/S gets
;;; hacked around. Otherwise it goes and stomps all over the carefully
;;; collected data!
define constant procedure view_stack();
dlocal pop_pr_quotes = false; ;;; -unknown- is a string.
;;; Print out values to a limited number of chars. I choose 40
;;; arbitrarily as this is a hacky initial version.
define lconstant procedure abbreviate( x ); lvars x;
lvars n_ch = 0;
define dlocal cucharout( ch ); lvars ch;
ch;
n_ch + 1 -> n_ch;
if n_ch >= 40 then
' ...'.explode; ;;; put elipsis on stack.
exitto( abbreviate )
endif
enddefine;
consstring(#| pr( x ) |#)
enddefine;
lvars cpy = consvector( stacklength() );
cpy.explode;
lvars n, k = 0;
for n from cpy.datalength by -1 to 1 do
k + 1 -> k;
lvars culprit =
if n > table_size then
'<unknown>'
else
table( n )
endif;
lvars value = abbreviate( cpy( n ) );
printf( '(%p)\t%p\t put \t %p\n', [% k, culprit, value %] )
endfor;
enddefine;
vars vm_list = [sysPUSH sysPUSHQ sysPUSHS sysCALL sysCALLQ sysCALLS];
applist( vm_list, sysunprotect );
constant procedure (
sys_sysPUSH = sysPUSH,
sys_sysPUSHQ = sysPUSHQ,
sys_sysPUSHS = sysPUSHS,
sys_sysCALL = sysCALL,
sys_sysCALLQ = sysCALLQ,
sys_sysCALLS = sysCALLS
);
define sysPUSH( x ); lvars x;
sys_sysPUSH( x );
if pop_debugging == true then
sys_sysCALLQ( peek );
endif;
enddefine;
define sysPUSHQ( x ); lvars x;
sys_sysPUSHQ( x );
if pop_debugging == true then
sys_sysCALLQ( peek );
endif;
enddefine;
define sysPUSHS( x ); lvars x;
sys_sysPUSHS( x );
if pop_debugging == true then
sys_sysCALLQ( peek );
endif;
enddefine;
define sysCALL( x ); lvars x;
if pop_debugging == true then
sys_sysPUSH( x );
sys_sysCALLQ( invoke_any )
else
sys_sysCALL( x );
endif;
enddefine;
define sysCALLQ( x ); lvars x;
if pop_debugging == true then
if x.isprocedure then
sys_sysPUSHQ( x );
sys_sysCALLQ( invoke_any )
else
sys_sysPUSHQ( x );
sysCALL( x.datakey.class_apply )
endif;
else
sys_sysCALLQ( x );
endif;
enddefine;
define sysCALLS( x ); lvars x;
if pop_debugging == true then
sys_sysPUSHS( x );
sys_sysCALLQ( invoke_any )
else
sys_sysCALLS( x );
endif;
enddefine;
applist( vm_list, sysprotect );
endsection;
/*
;;; Example
true -> pop_debugging;
vars data = {a b c d e};
define busy();
lvars i;
for i from 1 to 10 do i endfor;
erasenum( 9 );
enddefine;
define doit();
busy();
lvars i;
for i from 1 to 3 do
subscrv( i, data )
endfor;
enddefine;
false -> pop_debugging;
;;; The output.
: doit(); view_stack() =>
(1) <procedure subscrv> put c
(2) <procedure subscrv> put b
(3) <procedure subscrv> put a
(4) <procedure busy> put 1
** 1 a b c
*/
|