[Date Prev] [Date Next] [Thread Prev] [Thread Next] Date Index Thread Index Search archive:
Date:Mon Nov 27 16:51:18 1992 
Subject:Re: User stack overflow: Detecting the culprit 
From:Steve Knight 
Volume-ID:921127.08 

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
*/