view release on metacpan or  search on metacpan

Jasmin.pm  view on Meta::CPAN

}

=back

=cut

#-----------------------------------------------------------------------------

=item B::OP::JVMJasminPost

Currently, there is no post processing done on plain OPs.

=cut

sub B::OP::JVMJasminPost {
  my ($op, $level) = @_;
  my $name = $op->name();

}
#-----------------------------------------------------------------------------

=item B::LISTOP::JVMJasminPre

Pre-processing on LISTOPs requires that any we recursively call
C<WalkOPTree>, since LISTOPs can have children.

The following LISTOPs are currently supported:

=over

=cut

sub B::LISTOP::JVMJasminPre {
  my ($op, $level) = @_;
  my $name = $op->name();

  if ($name eq "leave") {

=item leave

A "leave" LISTOP will be the parent of a number of OPs.  Therefore, we
 process all the sub-OPs I<in order> on the pre-processing step.

=cut

    if ($op->flags &  &OPf_KIDS) {
      for (my $kid = $op->first; $$kid; $kid = $kid->sibling) {
        WalkOPTree($kid, $level + 1);
      }
    }

  } elsif ($name eq "print") {

=item print

For a "print" LISTOP, we need to process the kids in reverse order, save
pushing the C<LIST_MARK>, which must happen first (the "print"
post-processing depends on the mark being there).  As in many instances,
Perl appears to its own stack like a queue at times, and this causes
problems, since we are using the JVM operand stack.  In other words, for a
"print" LISTOP, the Perl stack looks like this (left is top):

LIST_MARK, "1", "2\n"

However, this would print the string "12\n", not "2\n1".  It's as if Perl
first finds the mark, and then processes from the mark to the end of the
stack as a queue!  (This behavior is probably documented somewhere else, but
I just discovered it serendipitously (perhaps I should read documentation
more :)).  So, to process a "print" statement, we grab the "pushmark" OP
first, process that, and then call C<WalkOPTree> recursively in I<reverse>
for the rest of the sub-OPs.

=cut

    if ($op->flags &  &OPf_KIDS) {
      my $pushmark = $op->first;

      # "pushmark" has to be the first OP for "print"

      croak("expected a \"pushmark\" command but got: " . $pushmark->name())
        if ($pushmark->name() ne "pushmark");

      WalkOPTree($pushmark, $level + 1);

      my @args = ();
      for (my $arg = $pushmark->sibling; $$arg; $arg = $arg->sibling) {
        unshift(@args, $arg);
      }
      foreach my $arg (@args) {
        WalkOPTree($arg, $level + 1);
      }
    }
  } elsif ($name eq "list") {

=item list

On a "list" LISTOP, there is no need to "pushmark" (I think :).  When the
"list" LISTOP completes (at least from analyzing perl -Dts output) the mark
simply disappears.  It doesn't appear to be there for any other operation
but the "list" LISTOP itself.  If this isn't correct, this code will need to
be corrected.

In addition, the list is reversed on the JVM operand stack, just as is done
with the "print" LISTOP.

No post-processing is needed (I think :), because the "list" LISTOP just
sets up arguments for another OP.

=cut

    if ($op->flags &  &OPf_KIDS) {
      my $pushmark = $op->first;

      croak("expected a \"pushmark\" command but got: " . $pushmark->name())
        if ($pushmark->name() ne "pushmark");

      # Note we ignore the pushmark itself, and reverse the list on the
      # stack--- This may be a problem.  I don't know where else "list" is
      # used.  I found this behavior worked for stuff such as:
      #      print qw/H e l l o W o r l d/, "\n";