A colleague at work, Mark Brader, discovered a problem in Inline::C which
seems to be triggerd when perl calls a C routine, and that C routine calls
a perl routine, and the "inner" perl routine triggers a
Perl_markstack_grow.
It seems that Inline::C keeps a copy of PL_markstack_ptr++ as a pointer
rather than an offset from PL_markstack, and restores that after calling
the function. If PL_markstack doesn't move then that works; if
PL_markstack is realloced then the restored PL_markstack_ptr is unlikely
to point into the markstack.
Code & putative patch attached.
If you run perl bug x on an unpatched Inline::C you should see something
like
[EMAIL PROTECTED] inline_bug]$ perl bug xc
before markstack: 8050318 to 8050398 (32), ptr 8050320 (2)
[ 0 0 ]
after markstack: 81800d0 to 8180190 (48), ptr 81800d8 (2)
[ 0 0 ]
this
Segmentation fault
or at home, different compiler & flags used for perl
[EMAIL PROTECTED] tmp]$ perl bug x
before markstack: 0x8158b08 to 0x8158b88 (32), ptr 0x8158b10 (2)
[ 0 0 ]
after markstack: 0x8261790 to 0x8261850 (48), ptr 0x8261798 (2)
[ 0 0 ]
this
before markstack: 0x8261790 to 0x8261850 (48), ptr 0x8158b10 (-271136)
after markstack: 0x8239c68 to 0x8239d88 (72), ptr 0x8130fe8 (-271136)
is
before markstack: 0x8239c68 to 0x8239d88 (72), ptr 0x8158b10 (-230486)
after markstack: 0x8239c68 to 0x8239e18 (108), ptr 0x8158b10 (-230486)
a
before markstack: 0x8239c68 to 0x8239e18 (108), ptr 0x8158b10 (-230486)
after markstack: 0x8239c68 to 0x8239ef0 (162), ptr 0x8158b10 (-230486)
problem
before markstack: 0x8239c68 to 0x8239ef0 (162), ptr 0x8158b10 (-230486)
after markstack: 0x8239c68 to 0x823a034 (243), ptr 0x8158b10 (-230486)
If Inline::C is patched and re-run then we see
[EMAIL PROTECTED] inline_bug]$ rm -rf _Inline/; perl bug x
before markstack: 8050318 to 8050398 (32), ptr 8050320 (2)
[ 0 0 ]
after markstack: 83d68b0 to 83d6970 (48), ptr 83d68b8 (2)
[ 0 0 ]
this
before markstack: 83d68b0 to 83d6970 (48), ptr 83d68b8 (2)
[ 0 0 ]
after markstack: 83cfab0 to 83cfbd0 (72), ptr 83cfab8 (2)
[ 0 0 ]
is
before markstack: 83cfab0 to 83cfbd0 (72), ptr 83cfab8 (2)
[ 0 0 ]
after markstack: 83e32e8 to 83e3498 (108), ptr 83e32f0 (2)
[ 0 0 ]
a
before markstack: 83e32e8 to 83e3498 (108), ptr 83e32f0 (2)
[ 0 0 ]
after markstack: 83b13b0 to 83b1638 (162), ptr 83b13b8 (2)
[ 0 0 ]
problem
before markstack: 83b13b0 to 83b1638 (162), ptr 83b13b8 (2)
[ 0 0 ]
after markstack: 8244c00 to 8244fcc (243), ptr 8244c08 (2)
[ 0 0 ]
Mike
#!/usr/bin/env perl
use Inline C;
sub calledFromC {
# print "before (perl)\n";
forceMarkstackMove(@_);
# print "after (perl)\n";
}
sub foo {
my ($flag, @list) = @_;
outerCRoutine($flag);
if (@list) {
print shift(@list), "\n";
foo($flag, @list);
}
}
my $printMarkStack = @ARGV != 0;
foo($printMarkStack, qw/ this is a problem /);
__END__
__C__
void outerCRoutine(SV *flag) {
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(flag);
PUTBACK;
perl_call_pv("main::calledFromC", G_VOID);
FREETMPS;
LEAVE;
}
static void reportMarkstack(char *prefix) {
printf("%s markstack: %p to %p (%d), ptr %p (%d)\n", prefix,
PL_markstack, PL_markstack_max, (PL_markstack_max - PL_markstack),
PL_markstack_ptr, (PL_markstack_ptr - PL_markstack));
if (PL_markstack < PL_markstack_ptr) {
I32 *p;
printf("[ ");
for (p = PL_markstack; p < PL_markstack_ptr; p++) {
printf("%d ", *p);
}
printf("]\n");
}
}
/* similar to Perl_markstack_grow in scope.c with STRESS_REALLOC turned on
*/
void forceMarkstackMove(SV *flag) {
I32 oldmax = PL_markstack_max - PL_markstack;
I32 oldptr = PL_markstack_ptr - PL_markstack;
I32 newmax = oldmax * 3 / 2;
I32 *oldmemory = PL_markstack;
if (SvTRUE(flag)) reportMarkstack("before");
Renew(PL_markstack, newmax, I32);
PL_markstack_ptr = PL_markstack + oldptr; /* as it was */
PL_markstack_max = PL_markstack + newmax;
if (SvTRUE(flag)) reportMarkstack("after");
}
--- Inline/C.pm.bak 2002-10-18 15:05:48.000000000 -0400
+++ Inline/C.pm 2003-12-09 18:54:26.000000000 -0500
@@ -566,13 +566,13 @@
if ($return_type eq 'void') {
$XS .= <<END;
PREINIT:
- I32* temp;
+ I32 temp; /* MSB correction 2003-12-09 */
PPCODE:
- temp = PL_markstack_ptr++;
+ temp = PL_markstack_ptr++ - PL_markstack;
$function($arg_name_list);
- if (PL_markstack_ptr != temp) {
+ if (PL_markstack_ptr != PL_markstack + temp) {
/* truly void, because dXSARGS not invoked */
- PL_markstack_ptr = temp;
+ PL_markstack_ptr = PL_markstack + temp;
XSRETURN_EMPTY; /* return empty stack */
}
/* must have used dXSARGS; list context implied */
@@ -582,11 +582,11 @@
elsif ($listargs) {
$XS .= <<END;
PREINIT:
- I32* temp;
+ I32 temp; /* MSB correction 2003-12-09 */
CODE:
- temp = PL_markstack_ptr++;
+ temp = PL_markstack_ptr++ - PL_markstack;
RETVAL = $function($arg_name_list);
- PL_markstack_ptr = temp;
+ PL_markstack_ptr = PL_markstack + temp;
OUTPUT:
RETVAL
END
