develooper Front page | perl.perl5.porters | Postings from February 2006

[perl #38644] MULTICALL causes segfaults with very large return stacks

Thread Previous
From:
Tassilo von Parseval
Date:
February 27, 2006 02:37
Subject:
[perl #38644] MULTICALL causes segfaults with very large return stacks
Message ID:
rt-3.0.11-38644-130666.5.31900859720047@perl.org
# New Ticket Created by  Tassilo von Parseval 
# Please include the string:  [perl #38644]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org/rt3/Ticket/Display.html?id=38644 >



This is a bug report for perl from tassilo.von.parseval@rwth-aachen.de,
generated with the help of perlbug 1.35 running under perl v5.8.7.


-----------------------------------------------------------------
[Please enter your report here]

Hi,

sorry for the rather longish post, but some context is required here.

After experiencing the strangest segfaults in the past few days with an XSUB,
I believe that it is caused by the fairly recent MULTICALL API that seems to
barf when the return stack is very large. I am using multicall.h from
List::Util for that so this is not a report against the inbuilt mechanism in
5.9.4.

The XSUB in question is supposed to do the equivalent to this:

    # partition a list based on code-reference
    sub part_pp(&@) {
        my ($code, @list) = @_;
        my @parts;
        push @{ $parts[ $code->($_) ] }, $_  for @list;
        return @parts;
    }

The problems I experience are with pathological cases, such as this one:

    my @part = part { 1_000_000 } 1 .. 100_000;

which ought to return the list

    ( (undef) x 1_000_000, [ 1 .. 100_000 ] )

The XSUB that segfaults with that case is this:

void
part_ary (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    I32 count = 0;
    SV **args = &PL_stack_base[ax];
    CV *cv;
    
    AV **tmp = NULL;
    int last = 0;
    
    if (items == 1)
        XSRETURN_EMPTY;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for(i = 1 ; i < items ; ++i) {
        int idx;
        GvSV(PL_defgv) = args[i];
        MULTICALL;
        idx = SvIV(*PL_stack_sp);

        if (idx < 0 && (idx += last) < 0)
            croak("Modification of non-creatable array value attempted, subscript %i", idx);

        if (idx >= last) {
            int oldlast = last;
            last = idx + 1;
            Renew(tmp, last, AV*);
            Zero(tmp + oldlast, last - oldlast, AV*);
        }
        if (!tmp[idx])
            tmp[idx] = newAV();
        av_push(tmp[idx], args[i]);
    }
    POP_MULTICALL;

    EXTEND(SP, last);
    for (i = 0; i < last; ++i) {
        if (!tmp[i]) {
#line 1319
            ST(i) = &PL_sv_undef;
            continue;
        }
        ST(i) = newRV_noinc((SV*)tmp[i]);
    }
    
    Safefree(tmp);
    XSRETURN(last);
}

valgrind reports on a debugging-enabled 5.8.7 (not the one below I used for
perlbug; but they all segfault):

==4056== Invalid write of size 4
==4056==    at 0x1C01D913: XS_List__MoreUtils_part_ary (MoreUtils.xs:1319)
==4056==    by 0x1B9B941F: Perl_pp_entersub (pp_hot.c:2888)
==4056==    by 0x1B993CE1: Perl_runops_debug (dump.c:1452)
==4056==    by 0x1B92F117: S_run_body (perl.c:2000)
==4056==    by 0x1B92EB32: perl_run (perl.c:1919)
==4056==    by 0x8049404: main (perlmain.c:98)
==4056==  Address 0x1C107AD8 is 0 bytes after a block of size 524272 alloc'd
==4056==    at 0x1B90459D: malloc (vg_replace_malloc.c:130)
==4056==    by 0x1B9943EE: Perl_safesysmalloc (util.c:78)
==4056==    by 0x1B9A9F4F: Perl_av_extend (av.c:136)
==4056==    by 0x1B9EF4C1: Perl_stack_grow (scope.c:63)
==4056==    by 0x1B9F770E: Perl_pp_flop (pp_ctl.c:1062)
==4056==    by 0x1B993CE1: Perl_runops_debug (dump.c:1452)
==4056==    by 0x1B968D1B: Perl_gen_constant_list (op.c:2143)
==4056==    by 0x1B96560D: Perl_list (op.c:959)
==4056==    by 0x1B976752: Perl_ck_subr (op.c:6236)
==4056==    by 0x1B9696D6: Perl_newUNOP (op.c:2349)
==4056==    by 0x1B961B84: Perl_yyparse (perly.y:475)
==4056==    by 0x1B92E7EC: S_parse_body (perl.c:1844)

It's interesting to note that the segfault disappears when calling

    part { 1_000_000 } 1 .. 1_000_000;

that is, when the stack is already large enough due to the number of arguments
passed into the XSUB. In general, this segfault seems to be rather sensitive to 
the parameters. For this:

    part { 1_000_000 } 1 .. 10_000;

I get 

    Assertion *relem failed: file "pp_hot.c", line 1057

Via binary-search I found that the biggest input list triggering this assertion is 
1 .. 32610. Also, when using the gdb, the segfault happens later:

(gdb) set args -Mblib -MList::MoreUtils -e 'my @part = List::MoreUtils::part_ary { 1_000_000 } 1 .. 100_000;'
(gdb) run
Starting program: /usr/local/bin/perl5.8.7db -Mblib -MList::MoreUtils -e 'my @part = List::MoreUtils::part_ary { 1_000_000 } 1 .. 100_000;'
[Thread debugging using libthread_db enabled]
[New Thread 16384 (LWP 4262)]

Program received signal SIGSEGV, Segmentation fault.
[Switching to Thread 16384 (LWP 4262)]
0x402c09c0 in malloc_trim () from /lib/libc.so.6
(gdb) bt
#0  0x402c09c0 in malloc_trim () from /lib/libc.so.6
#1  0x402c0da1 in free () from /lib/libc.so.6
#2  0x400a38f5 in Perl_safesysfree (where=0x405ed008) at util.c:155
#3  0x4043d995 in XS_List__MoreUtils_part_ary (my_perl=0x804c498, cv=0x8109138) at MoreUtils.xs:1325
#4  0x400c8420 in Perl_pp_entersub (my_perl=0x804c498) at pp_hot.c:2888
#5  0x400a2ce2 in Perl_runops_debug (my_perl=0x804c498) at dump.c:1452
#6  0x4003e118 in S_run_body (my_perl=0x804c498, oldscope=1) at perl.c:2000
#7  0x4003db33 in perl_run (my_perl=0x804c498) at perl.c:1919
#8  0x08049405 in main (argc=5, argv=0xbffff794, env=0xbffff7ac) at perlmain.c:98
(gdb)

MoreUtils.xs:1325 is:

#line 1325
    Safefree(tmp);
    XSRETURN(last);

The fact that MULTICALL is responsible for this (and not bugs in my XSUB), is
hinted at by an equivalent XSUB avoiding MULTICALL:

int getidx (pTHX_ SV *code, SV *val) {
    int idx;
    dSP;
    ENTER;
    SAVETMPS;
    SAVESPTR(GvSV(PL_defgv));
    GvSV(PL_defgv) = val;
    
    PUSHMARK(SP);
    call_sv(code, G_SCALAR);
    SPAGAIN;
    
    idx = POPi;
    PUTBACK;
    FREETMPS;
    LEAVE;
    return idx;
}

void
part_nomulti (code,...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    register int i;
    int max;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    I32 count = 0;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    AV **tmp = NULL;
    int last = 0;

    if (items == 1)
        XSRETURN_EMPTY;

    for(i = 1 ; i < items ; ++i) {
        int idx = getidx(aTHX_ code, args[i]);

        if (idx < 0 && (idx += last) < 0)
            croak("Modification of non-creatable array value attempted, subscript %i", idx);

        if (idx >= last) {
            int oldlast = last;
            last = idx + 1;
            Renew(tmp, last, AV*);
            Zero(tmp + oldlast, last - oldlast, AV*);
        }
        if (!tmp[idx])
            tmp[idx] = newAV();
        av_push(tmp[idx], args[i]);
    }
    EXTEND(SP, last);
    for (i = 0; i < last; ++i) {
        if (!tmp[i]) {
            ST(i) = &PL_sv_undef;
            continue;
        }
        ST(i) = newRV_noinc((SV*)tmp[i]);
    }

    XSRETURN(last);
}

I haven't been able to come up with parameters that would make that dump core.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=medium
---
Site configuration information for perl v5.8.7:

Configured by Debian Project at Thu Dec 15 17:30:10 UTC 2005.

Summary of my perl5 (revision 5 version 8 subversion 7) configuration:
  Platform:
    osname=linux, osvers=2.6.14.3, archname=i486-linux-gnu-thread-multi
    uname='linux ninsei 2.6.14.3 #1 smp preempt mon nov 28 19:51:50 pst 2005 i686 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i486-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.7 -Dsitearch=/usr/local/lib/perl/5.8.7 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.7 -Dd_dosuid -des'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion='', gccversion='4.0.3 20051201 (prerelease) (Debian 4.0.2-5)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.3.5.so, so=so, useshrplib=true, libperl=libperl.so.5.8.7
    gnulibc_version='2.3.5'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    SPRINTF0 - fixes for sprintf formatting issues - CVE-2005-3962

---
@INC for perl v5.8.7:
    /etc/perl
    /usr/local/lib/perl/5.8.7
    /usr/local/share/perl/5.8.7
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.8
    /usr/share/perl/5.8
    /usr/local/lib/site_perl
    /usr/local/lib/perl/5.8.4
    /usr/local/share/perl/5.8.4
    .

---
Environment for perl v5.8.7:
    HOME=/home/ethan
    LANG=C
    LANGUAGE=en_DE:en_US:en_GB:en
    LC_CTYPE=de_DE@euro
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/local/bin:/usr/bin:/bin:/usr/X11R6/bin:/home/ethan/bin:/usr/games:/usr/local/mpich-1.2.5/ch_p4/bin:/usr/local/teTeX/bin/i686-pc-linux-gnu
    PERL_BADLANG (unset)
    SHELL=/bin/bash


Thread Previous


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About