#
package B::C::Section;
-our $VERSION = '1.01';
+our $VERSION = '1.04';
use B ();
use base B::Section;
return objsym($start);
}
-# Current workaround/fix for op_free() trying to free statically
-# defined OPs is to set op_seq = -1 and check for that in op_free().
-# Instead of hardwiring -1 in place of $op->seq, we use $op_seq
-# so that it can be changed back easily if necessary. In fact, to
-# stop compilers from moaning about a U16 being initialised with an
-# uncast -1 (the printf format is %d so we can't tweak it), we have
-# to "know" that op_seq is a U16 and use 65535. Ugh.
-my $op_seq = 65535;
+# Set the values for op_opt and op_static in each op. The value of
+# op_opt is irrelevant, and the value of op_static needs to be 1 to tell
+# op_free that this is a statically defined op and that is shouldn't be
+# freed.
+my $op_os = "0, 1, 0";
# Look this up here so we can do just a number compare
# rather than looking up the name of every BASEOP in B::OP
$init->add(sprintf("(void)find_threadsv(%s);",
cstring($threadsv_names[$op->targ])));
}
- $opsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x",
+ $opsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr, $op->targ,
- $type, $op_seq, $op->flags, $op->private));
+ $type, $op->flags, $op->private));
my $ix = $opsect->index;
$init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_ppaddr;
sub B::FAKEOP::save {
my ($op, $level) = @_;
- $opsect->add(sprintf("%s, %s, %s, %u, %u, %u, 0x%x, 0x%x",
+ $opsect->add(sprintf("%s, %s, %s, %u, %u, $op_os, 0x%x, 0x%x",
$op->next, $op->sibling, $op->fake_ppaddr, $op->targ,
- $op->type, $op_seq, $op->flags, $op->private));
+ $op->type, $op->flags, $op->private));
my $ix = $opsect->index;
$init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_ppaddr;
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $unopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x",
+ $unopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}));
my $ix = $unopsect->index;
$init->add(sprintf("unop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $binopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+ $binopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}, ${$op->last}));
my $ix = $binopsect->index;
$init->add(sprintf("binop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $listopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+ $listopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}, ${$op->last}));
my $ix = $listopsect->index;
$init->add(sprintf("listop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $logopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+ $logopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}, ${$op->other}));
my $ix = $logopsect->index;
$init->add(sprintf("logop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
#warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n",
# peekop($op->redoop), peekop($op->nextop),
# peekop($op->lastop)); # debug
- $loopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x",
+ $loopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}, ${$op->last},
${$op->redoop}, ${$op->nextop},
${$op->lastop}));
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+ $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, %s",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, cstring($op->pv)));
my $ix = $pvopsect->index;
$init->add(sprintf("pvop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
my $sv = $op->sv;
my $svsym = '(SV*)' . $sv->save;
my $is_const_addr = $svsym =~ m/Null|\&/;
- $svopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+ $svopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, %s",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private,
( $is_const_addr ? $svsym : 'Nullsv' )));
my $ix = $svopsect->index;
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $padopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %d",
+ $padopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, %d",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private,$op->padix));
my $ix = $padopsect->index;
$init->add(sprintf("padop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
$warn_sv = $warnings->save;
}
- $copsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s, NULL, NULL, %u, %d, %u, %s",
+ $copsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, %s, NULL, NULL, %u, %d, %u, %s",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, cstring($op->label), $op->cop_seq,
$op->arybase, $op->line,
( $optimize_warn_sv ? $warn_sv : 'NULL' )));
# pmnext handling is broken in perl itself, I think. Bad op_pmnext
# fields aren't noticed in perl's runtime (unless you try reset) but we
# segfault when trying to dereference it to find op->op_pmnext->op_type
- $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %s, %s, 0, %u, 0x%x, 0x%x, 0x%x",
+ $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x, %s, %s, 0, %u, 0x%x, 0x%x, 0x%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr, $op->targ,
- $op->type, $op_seq, $op->flags, $op->private,
+ $op->type, $op->flags, $op->private,
${$op->first}, ${$op->last},
$replrootfield, $replstartfield,
( $ithreads ? $op->pmoffset : 0 ),
$cvstashname, $cvname); # debug
}
$pv = '' unless defined $pv; # Avoid use of undef warnings
- $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, \"\", %d, s\\_%x, (CV*)s\\_%x, 0x%x",
+ $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, \"\", %d, s\\_%x, (CV*)s\\_%x, 0x%x, 0x%x",
$xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
$cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
- $$padlist, ${$cv->OUTSIDE}, $cv->CvFLAGS));
+ $$padlist, ${$cv->OUTSIDE}, $cv->CvFLAGS,
+ $cv->OUTSIDE_SEQ));
if (${$cv->OUTSIDE} == ${main_cv()}){
$init->add(sprintf("CvOUTSIDE(s\\_%x)=PL_main_cv;",$$cv));
AV * xcv_padlist;
CV * xcv_outside;
cv_flags_t xcv_flags;
+ U32 xcv_outside_seq; /* the COP sequence (at the point of our
+ * compilation) in the lexically enclosing
+ * sub */
} XPVCV_or_similar;
#define ANYINIT(i) i
#else
}
EOT
}
+ else {
+ print <<EOT;
+ if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) {/* $0 */
+ tmpsv = GvSV(tmpgv);
+ sv_setpv(tmpsv, argv[0]);
+ SvSETMAGIC(tmpsv);
+ }
+EOT
+ }
print <<'EOT';
if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) {/* $^X */
my $sym;
my $ref;
no strict 'vars';
- local(*glob);
$prefix = '' unless defined $prefix;
while (($sym, $ref) = each %$symref)
{
+ local(*glob);
*glob = $ref;
if ($sym =~ /::$/)
{