return objsym($start);
}
-# 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
my $OP_THREADSV = opnumber('threadsv');
'NULL';
}
+# This pair is needed becase B::FAKEOP::save doesn't scalar dereference
+# $op->next and $op->sibling
+
+{
+ # For 5.9 the hard coded text is 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.
+
+ # For 5.8:
+ # 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 $static = $] > 5.009 ? '0, 1, 0' : sprintf "%u", 65535;
+ sub B::OP::_save_common_middle {
+ my $op = shift;
+ sprintf ("%s, %u, %u, $static, 0x%x, 0x%x",
+ $op->fake_ppaddr, $op->targ, $op->type, $op->flags, $op->private);
+ }
+}
+
+sub B::OP::_save_common {
+ my $op = shift;
+ return sprintf("s\\_%x, s\\_%x, %s",
+ ${$op->next}, ${$op->sibling}, $op->_save_common_middle);
+}
+
sub B::OP::save {
my ($op, $level) = @_;
my $sym = objsym($op);
$init->add(sprintf("(void)find_threadsv(%s);",
cstring($threadsv_names[$op->targ])));
}
- $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->flags, $op->private));
+ $opsect->add($op->_save_common);
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, $op_os, 0x%x, 0x%x",
- $op->next, $op->sibling, $op->fake_ppaddr, $op->targ,
- $op->type, $op->flags, $op->private));
+ $opsect->add(sprintf("%s, %s, %s",
+ $op->next, $op->sibling, $op->_save_common_middle));
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, $op_os, 0x%x, 0x%x, s\\_%x",
- ${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op->flags,
- $op->private, ${$op->first}));
+ $unopsect->add(sprintf("%s, s\\_%x", $op->_save_common, ${$op->first}));
my $ix = $unopsect->index;
$init->add(sprintf("unop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_ppaddr;
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $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->flags,
- $op->private, ${$op->first}, ${$op->last}));
+ $binopsect->add(sprintf("%s, s\\_%x, s\\_%x",
+ $op->_save_common, ${$op->first}, ${$op->last}));
my $ix = $binopsect->index;
$init->add(sprintf("binop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_ppaddr;
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $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->flags,
- $op->private, ${$op->first}, ${$op->last}));
+ $listopsect->add(sprintf("%s, s\\_%x, s\\_%x",
+ $op->_save_common, ${$op->first}, ${$op->last}));
my $ix = $listopsect->index;
$init->add(sprintf("listop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_ppaddr;
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $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->flags,
- $op->private, ${$op->first}, ${$op->other}));
+ $logopsect->add(sprintf("%s, s\\_%x, s\\_%x",
+ $op->_save_common, ${$op->first}, ${$op->other}));
my $ix = $logopsect->index;
$init->add(sprintf("logop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_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, $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->flags,
- $op->private, ${$op->first}, ${$op->last},
+ $loopsect->add(sprintf("%s, s\\_%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x",
+ $op->_save_common, ${$op->first}, ${$op->last},
${$op->redoop}, ${$op->nextop},
${$op->lastop}));
my $ix = $loopsect->index;
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $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->flags,
- $op->private, cstring($op->pv)));
+ $pvopsect->add(sprintf("%s, %s", $op->_save_common, cstring($op->pv)));
my $ix = $pvopsect->index;
$init->add(sprintf("pvop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_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, $op_os, 0x%x, 0x%x, %s",
- ${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op->flags,
- $op->private,
- ( $is_const_addr ? $svsym : 'Nullsv' )));
+ $svopsect->add(sprintf("%s, %s", $op->_save_common,
+ ( $is_const_addr ? $svsym : 'Nullsv' )));
my $ix = $svopsect->index;
$init->add(sprintf("svop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_ppaddr;
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $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->flags,
- $op->private,$op->padix));
+ $padopsect->add(sprintf("%s, %d",
+ $op->_save_common, $op->padix));
my $ix = $padopsect->index;
$init->add(sprintf("padop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_ppaddr;
$warn_sv = $warnings->save;
}
- $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->flags,
- $op->private, cstring($op->label), $op->cop_seq,
+ $copsect->add(sprintf("%s, %s, NULL, NULL, %u, %d, %u, %s",
+ $op->_save_common, cstring($op->label), $op->cop_seq,
$op->arybase, $op->line,
( $optimize_warn_sv ? $warn_sv : 'NULL' )));
my $ix = $copsect->index;
# 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, $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->flags, $op->private,
- ${$op->first}, ${$op->last},
+ $pmopsect->add(sprintf("%s, s\\_%x, s\\_%x, %s, %s, 0, %u, 0x%x, 0x%x, 0x%x",
+ $op->_save_common, ${$op->first}, ${$op->last},
$replrootfield, $replstartfield,
( $ithreads ? $op->pmoffset : 0 ),
$op->pmflags, $op->pmpermflags, $op->pmdynflags ));
"(?(#seq)?)#noise#arg(?([#targarg])?)"],
"debug" =>
["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
- . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n"
+ . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n" .
+ ($] > 5.009 ? '' : "\top_seq\t\t#seqnum\n")
. "\top_flags\t#flagval\n\top_private\t#privval\n"
. "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
. "(?(\top_sv\t\t#svaddr\n)?)",
push @$targ, $ar;
push @todo, [$op->pmreplstart, $ar];
} elsif ($name =~ /^enter(loop|iter)$/) {
- $labels{${$op->nextop}} = "NEXT";
- $labels{${$op->lastop}} = "LAST";
- $labels{${$op->redoop}} = "REDO";
+ if ($] > 5.009) {
+ $labels{${$op->nextop}} = "NEXT";
+ $labels{${$op->lastop}} = "LAST";
+ $labels{${$op->redoop}} = "REDO";
+ } else {
+ $labels{$op->nextop->seq} = "NEXT";
+ $labels{$op->lastop->seq} = "LAST";
+ $labels{$op->redoop->seq} = "REDO";
+ }
}
}
}
}
$h{seq} = $h{hyphseq} = seq($op);
$h{seq} = "" if $h{seq} eq "-";
- $h{opt} = $op->opt;
- $h{static} = $op->static;
+ if ($] > 5.009) {
+ $h{opt} = $op->opt;
+ $h{static} = $op->static;
+ $h{label} = $labels{$$op};
+ } else {
+ $h{seqnum} = $op->seq;
+ $h{label} = $labels{$op->seq};
+ }
$h{next} = $op->next;
$h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
$h{nextaddr} = sprintf("%#x", $ {$op->next});
$h{privval} = $op->private;
$h{private} = private_flags($h{name}, $op->private);
$h{addr} = sprintf("%#x", $$op);
- $h{label} = $labels{$$op};
$h{typenum} = $op->type;
$h{noise} = $linenoise[$op->type];
# a little code at the end of the module, and compute the base sequence
# number for the user's program as being a small offset later, so all we
# have to worry about are changes in the offset.
-
+
+# [For 5.8.x and earlier perl is generating sequence numbers for all ops,
+# and using them to reference labels]
+
+
# When you say "perl -MO=Concise -e '$a'", the output should look like:
# 4 <@> leave[t1] vKP/REFC ->(end)
The sequence number of the OP. Note that this is a sequence number
generated by B::Concise.
+=item B<#seqnum>
+
+5.8.x and earlier only. 5.9 and later do not provide this.
+
+The real sequence number of the OP, as a regular number and not adjusted
+to be relative to the start of the real program. (This will generally be
+a fairly large number because all of B<B::Concise> is compiled before
+your program is).
+
=item B<#opt>
Whether or not the op has been optimised by the peephole optimiser.
+Only available in 5.9 and later.
+
=item B<#static>
Whether or not the op is statically defined. This flag is used by the
B::C compiler backend and indicates that the op should not be freed.
+Only available in 5.9 and later.
+
=item B<#sibaddr>
The address of the OP's next youngest sibling, in hexidecimal.
projects / p5sagit/p5-mst-13.2.git / commitdiff