Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Chained goto &sub drops data too early. #7545

Closed
p5pRT opened this issue Oct 19, 2004 · 8 comments
Closed

Chained goto &sub drops data too early. #7545

p5pRT opened this issue Oct 19, 2004 · 8 comments

Comments

@p5pRT
Copy link

p5pRT commented Oct 19, 2004

Migrated from rt.perl.org#32039 (status was 'resolved')

Searchable as RT32039$

@p5pRT
Copy link
Author

p5pRT commented Oct 19, 2004

From henrik@gulbra.net

The introduction of patch 22373 in perl v5.8.4 was intended to clean up
values in @​_ when goto &foo is used for tail recursion. Unfortunately,
it turns out to have an unwanted side effect, as illustrated by the
following test​:

  sub a { @​_=("Hello!"); goto &b; }
  sub b { goto &c; }
  sub c { for $x (@​_) { print "\"$x\"\n"; } }
  a();

Before patch 22373, this prints "Hello!" as expected, but in v5.8.4 and
v5.8.5 it will print an empty "", since the string is deleted when we
leave the scope of sub b. This breaks goto &foo for an autoloaded foo.

One way to restore the original behavior is to temporarily increase the
reference count of all values in @​_ while they pass the scope boundary,
as shown in the attached patch. I'm not overly familiar with the perl
core and this looks like an evil workaround to me, so feel free to think
of something better...

/Henrik

@p5pRT
Copy link
Author

p5pRT commented Oct 19, 2004

From henrik@gulbra.net

pp_ctl.c.patch
--- pp_ctl.c.original	Wed Jun 23 14:46:58 2004
+++ pp_ctl.c	Tue Oct 19 11:54:12 2004
@@ -2120,6 +2120,7 @@
 	    SV** mark;
 	    I32 items = 0;
 	    I32 oldsave;
+	    I32 index;
 
 	retry:
 	    if (!CvROOT(cv) && !CvXSUB(cv)) {
@@ -2166,6 +2167,11 @@
 		SvREFCNT_dec(GvAV(PL_defgv));
 		GvAV(PL_defgv) = cx->blk_sub.savearray;
 #endif /* USE_5005THREADS */
+
+		/* Keep all @_ values alive till next sub. */
+		for(index=1; index<=items; index++)
+		    SvREFCNT_inc(mark[index]);
+ 
 		/* abandon @_ if it got reified */
 		if (AvREAL(av)) {
 		    oldav = av;	/* delay until return */
@@ -2198,6 +2204,11 @@
 
 	    /* Now do some callish stuff. */
 	    SAVETMPS;
+
+	    /* New scope: undo the temporary SvREFCNT_inc. */
+	    for (index=1; index<=items; index++)
+		SAVEFREESV(mark[index]);
+
 	    /* For reified @_, delay freeing till return from new sub */
 	    if (oldav)
 		SAVEFREESV((SV*)oldav);

@p5pRT
Copy link
Author

p5pRT commented Oct 19, 2004

From henrik@gulbra.net


Flags​:
  category=
  severity=


Site configuration information for perl v5.8.5​:

Configured by root at Tue Aug 10 06​:49​:49 UTC 2004.

Summary of my perl5 (revision 5 version 8 subversion 5) configuration​:
  Platform​:
  osname=freebsd, osvers=5.2-current, archname=i386-freebsd-64int
  uname='freebsd freebsd.org 5.2-current freebsd 5.2-current #0​: mon aug 9 23​:46​:42 pdt 2004 kris@​freebsd.org​:usrsrcsysmagickernelpath i386 '
  config_args='-sde -Dprefix=/usr/local -Darchlib=/usr/local/lib/perl5/5.8.5/mach -Dprivlib=/usr/local/lib/perl5/5.8.5 -Dman3dir=/usr/local/lib/perl5/5.8.5/perl/man/man3 -Dman1dir=/usr/local/man/man1 -Dsitearch=/usr/local/lib/perl5/site_perl/5.8.5/mach -Dsitelib=/usr/local/lib/perl5/site_perl/5.8.5 -Dscriptdir=/usr/local/bin -Dsiteman3dir=/usr/local/lib/perl5/5.8.5/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Ui_malloc -Ui_iconv -Uinstallusrbinperl -Dcc=cc -Doptimize=-O -pipe -Duseshrplib -Dccflags=-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.5/BSDPAN" -Ud_dosuid -Ui_gdbm -Dusethreads=n -Dusemymalloc=y -Duse64bitint'
  hint=recommended, useposix=true, d_sigaction=define
  usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
  useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
  use64bitint=define use64bitall=undef uselongdouble=undef
  usemymalloc=y, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.5/BSDPAN" -DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -I/usr/local/include',
  optimize='-O -pipe ',
  cppflags='-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.5/BSDPAN" -DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -I/usr/local/include'
  ccversion='', gccversion='3.4.2 [FreeBSD] 20040728', gccosandvers=''
  intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
  ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=4, prototype=define
  Linker and Libraries​:
  ld='cc', ldflags ='-Wl,-E -L/usr/local/lib'
  libpth=/usr/lib /usr/local/lib
  libs=-lm -lcrypt -lutil -lc
  perllibs=-lm -lcrypt -lutil -lc
  libc=, so=so, useshrplib=true, libperl=libperl.so
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' -Wl,-R/usr/local/lib/perl5/5.8.5/mach/CORE'
  cccdlflags='-DPIC -fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches​:
 


@​INC for perl v5.8.5​:
  /usr/local/lib/perl5/site_perl/5.8.5/mach
  /usr/local/lib/perl5/site_perl/5.8.5
  /usr/local/lib/perl5/site_perl
  /usr/local/lib/perl5/5.8.5/BSDPAN
  /usr/local/lib/perl5/5.8.5/mach
  /usr/local/lib/perl5/5.8.5
  .


Environment for perl v5.8.5​:
  HOME=/home/henrik
  LANG=en_US.ISO8859-15
  LANGUAGE (unset)
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/sbin​:/bin​:/usr/sbin​:/usr/bin​:/usr/games​:/usr/local/sbin​:/usr/local/bin​:/usr/X11R6/bin​:/home/henrik/bin
  PERL_BADLANG (unset)
  SHELL=/bin/sh

@p5pRT
Copy link
Author

p5pRT commented Oct 23, 2004

From @iabyn

On Tue, Oct 19, 2004 at 10​:36​:48AM -0000, Henrik Gulbrandsen wrote​:

The introduction of patch 22373 in perl v5.8.4 was intended to clean up
values in @​_ when goto &foo is used for tail recursion. Unfortunately,
it turns out to have an unwanted side effect, as illustrated by the
following test​:

sub a \{ @&#8203;\_=\("Hello\!"\); goto &b; \}
sub b \{ goto &c; \}
sub c \{ for $x \(@&#8203;\_\) \{ print "\\"$x\\"\\n"; \} \}
a\(\);

Before patch 22373, this prints "Hello!" as expected, but in v5.8.4 and
v5.8.5 it will print an empty "", since the string is deleted when we
leave the scope of sub b. This breaks goto &foo for an autoloaded foo.

Yes, this was my mistake, thanks for pointing it out!

One way to restore the original behavior is to temporarily increase the
reference count of all values in @​_ while they pass the scope boundary,
as shown in the attached patch. I'm not overly familiar with the perl
core and this looks like an evil workaround to me, so feel free to think
of something better...

Thanks for this. However, I went away for a bit and thought of something
better :-)

The problem revolves around what to do with a reified @​_ - free it
immediately and it frees everything on the stack. Prior to 5.8.4 the
solution was to add @​_ to the tmps stack so it gets freed at the end;
but doing goto &self in a loop caused the tmps stack to fill up with old
@​_'s. My fix in 5.8.4 was to add it to the savestack instead, but as
you've noticed, this frees it too soon.

My new scheme is to simply transfer the reifiedness of the old @​_ to the
new @​_ then ditch the old @​_ (without decrementing the refcnt of its
elements). The new @​_ then takes on the ownership of the elements.

In the case where the new sub is an XS, the elements are mortalised
instead.

Dave.

--
Counsellor Troi states something other than the blindingly obvious.
  -- Things That Never Happen in "Star Trek" #16

Change 23418 by davem@​davem-splatty on 2004/10/23 21​:50​:19

  [perl #32039] Chained goto &sub drops data too early.
 
  Change 22373 to stop a memory leak in goto &foo intead caused
  the elements of @​_ to be freed too early. This revised fix
  just transfers the reifiedness of the old @​_ to the new @​_

Affected files ...

... //depot/perl/pp_ctl.c#407 edit
... //depot/perl/t/op/goto.t#25 edit

Differences ...

==== //depot/perl/pp_ctl.c#407 (text) ====

@​@​ -2248,7 +2248,6 @​@​
  char *label;
  int do_dump = (PL_op->op_type == OP_DUMP);
  static char must_have_label[] = "goto must have label";
- AV *oldav = Nullav;

  label = 0;
  if (PL_op->op_flags & OPf_STACKED) {
@​@​ -2263,6 +2262,7 @​@​
  SV** mark;
  I32 items = 0;
  I32 oldsave;
+ bool reified = 0;

  retry​:
  if (!CvROOT(cv) && !CvXSUB(cv)) {
@​@​ -2304,16 +2304,16 @​@​
  Copy(AvARRAY(av), SP + 1, items, SV*);
  SvREFCNT_dec(GvAV(PL_defgv));
  GvAV(PL_defgv) = cx->blk_sub.savearray;
+ CLEAR_ARGARRAY(av);
  /* abandon @​_ if it got reified */
  if (AvREAL(av)) {
- oldav = av; /* delay until return */
+ reified = 1;
+ SvREFCNT_dec(av);
  av = newAV();
  av_extend(av, items-1);
  AvFLAGS(av) = AVf_REIFY;
  PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
  }
- else
- CLEAR_ARGARRAY(av);
  }
  else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
  AV* av;
@​@​ -2332,11 +2332,13 @​@​

  /* Now do some callish stuff. */
  SAVETMPS;
- /* For reified @​_, delay freeing till return from new sub */
- if (oldav)
- SAVEFREESV((SV*)oldav);
  SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
  if (CvXSUB(cv)) {
+ if (reified) {
+ I32 index;
+ for (index=0; index<items; index++)
+ sv_2mortal(SP[-index]);
+ }
#ifdef PERL_XSUB_OLDSTYLE
  if (CvOLDSTYLE(cv)) {
  I32 (*fp3)(int,int,int);
@​@​ -2415,6 +2417,11 @​@​
  Copy(mark,AvARRAY(av),items,SV*);
  AvFILLp(av) = items - 1;
  assert(!AvREAL(av));
+ if (reified) {
+ /* transfer 'ownership' of refcnts to new @​_ */
+ AvREAL_on(av);
+ AvREIFY_off(av);
+ }
  while (items--) {
  if (*mark)
  SvTEMP_off(*mark);

==== //depot/perl/t/op/goto.t#25 (xtext) ====

@​@​ -7,7 +7,7 @​@​
  @​INC = qw(. ../lib);
}

-print "1..46\n";
+print "1..47\n";

require "test.pl";

@​@​ -407,4 +407,12 @​@​
print "not " unless recurse1(500) == 500;
print "ok 46 - recursive goto &foo\n";

+# [perl #32039] Chained goto &sub drops data too early.
+
+sub a32039 { @​_=("foo"); goto &b32039; }
+sub b32039 { goto &c32039; }
+sub c32039 { print $_[0] eq 'foo' ? "" : "not ", "ok 47 - chained &goto\n" }
+a32039();
+
+

@p5pRT
Copy link
Author

p5pRT commented Oct 23, 2004

The RT System itself - Status changed from 'new' to 'open'

@p5pRT p5pRT closed this as completed Oct 23, 2004
@p5pRT
Copy link
Author

p5pRT commented Oct 23, 2004

@iabyn - Status changed from 'open' to 'resolved'

@p5pRT
Copy link
Author

p5pRT commented Oct 25, 2004

From @davidnicol

I am a little surprised that we don't (can't?) re-use the existing @​_ .

On Sun, 24 Oct 2004 00​:28​:46 +0100, Dave Mitchell <davem@​iabyn.com> wrote​:

My new scheme is to simply transfer the reifiedness of the old @​_ to the
new @​_ then ditch the old @​_ (without decrementing the refcnt of its
elements). The new @​_ then takes on the ownership of the elements.

@p5pRT
Copy link
Author

p5pRT commented Oct 25, 2004

From @iabyn

On Mon, Oct 25, 2004 at 10​:56​:32AM -0500, David Nicol wrote​:

I am a little surprised that we don't (can't?) re-use the existing @​_ .

because then the following wouldn't work​:

  sub f { $rf = \@​_; g(2) }
  sub g { print "f(@​$rf) g(@​_)\n" }
  f(1);

$ perl585 /tmp/p
f(1) g(2)

--
A major Starfleet emergency breaks out near the Enterprise, but
fortunately some other ships in the area are able to deal with it to
everyone's satisfaction.
  -- Things That Never Happen in "Star Trek" #13

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant