CODEWITHSUNDEEP
multithreadingperl
pilcrow
pilcrow

Reputation: 58534

Distinguish one sub invocation from another

In the following fragment, how can I distinguish the second invocation instance of my sub foo from the first?

while ($whatever) {
  foo(); foo();     # foo() and foo() have the same caller package, file, and line
}

Something like a super-caller() that returned file, line and column would do the trick. I'd prefer not to use source filters.

Background, or, isn't this a bit of an XY Problem?

I have a convenience module, Local::Thread::Once, that exposes functionality like pthread_once/std::call_once in an OO-ish way and also as a subroutine attribute. These are easy enough, since there is a natural and unambiguous "once_control" or "once_flag" in either case.

However, there is additionally a procedural interface — once { ... } — that currently serializes based on the $filename and $line returned by caller. Something like this:

sub once(&) {
  my $user_routine = shift;
  my (undef, $file, $line) = caller;

  my $once_control = get_a_shared_flag_just_for_this_invocation($file, $line);

  lock($once_control);
  if (! $once_control) { $once_control++; $user_routine->(); }
  return;
}

That's not precisely how it works — the real one is more efficient — but the point, again, is that invocation is keyed off of the file and line of the caller. This works, except that it cannot distinguish two invocations on the same line.

while ($whatever) {
  once { foo(); }
  once { bar(); }                    # OK, foo() and bar() each called only once
  once { baz(); }; once { buz(); };  # :(  buz() not called, not even once
}

Note that the address of $user_routine cannot be used as an additional discriminant, since subs are copied from one ithread to another.

I can live with this problem as a documented limitation for a very contrived use case, but I'd prefer to fix it somehow.

Upvotes: 4

Views: 118

Answers (3)

tobyink
tobyink

Reputation: 13664

Devel::Callsite was written precisely for this purpose.

Upvotes: 6

mob
mob

Reputation: 118605

The optree is still so much black magic to me, but here are my observations:

  1. in walking the optree of a code reference, you encounter one B::COP structure
  2. The B::COP structure has file, line, and cop_seq properties (among others)
  3. The cop_seq property is different for different subroutine definitions

Ass-u-me-ing these are true and not a horribly incomplete model of what is happening, you can use file, line, and cop_seq as a key, or maybe even just cop_seq. Here's a proof of concept:

use B;

sub once (&) {
    my $code = shift;
    my $key = get_cop_seq($code);
    print "once called with code '$key'\n";
}

my $optreedata;
sub get_cop_seq {
    my $code = shift;
    $optreedata = "";
    B::walkoptree( B::svref_2object($code)->ROOT, "find_cop_seq" );
    return $optreedata;
}
sub B::OP::find_cop_seq {
    my $op = shift;
    if (ref $op eq 'B::COP') {
        $optreedata .= sprintf "%s:%d:%d", $op->file, $op->line, $op->cop_seq;
    }
}

sub foo { 42 }
sub bar { 19 };

once { foo };                  # this is line 26
once { bar };
once { foo }; once { bar };
once { bar } for 1..5;         # line 29

And here's the output (your results may vary):

once called with code 'super-caller2.pl:26:205'
once called with code 'super-caller2.pl:27:206'
once called with code 'super-caller2.pl:28:207'  <--- two calls for line 28
once called with code 'super-caller2.pl:28:208'    |- with different cop_seq
once called with code 'super-caller2.pl:29:209'      
once called with code 'super-caller2.pl:29:209'      
once called with code 'super-caller2.pl:29:209'  <--- but 5 calls for line 29
once called with code 'super-caller2.pl:29:209'       with the same cop_seq
once called with code 'super-caller2.pl:29:209'

Upvotes: 1

mob
mob

Reputation: 118605

I had to read this a couple of times before I understood what you are talking about. How about a "super caller" function like:

my @last_caller = ("","","",0);
sub super_caller {
    my ($pkg,$file,$line) = caller(1 + shift);
    if ($pkg eq $last_caller[0] &&
        $file eq $last_caller[1] &&
        $line eq $last_caller[2]) {
        $last_caller[3]++;
    } else {
        @last_caller = ($pkg,$file,$line,1);
    }
    return @last_caller;
}

It's like caller but the 4th element is a count of how many times we've seen this exact package, file, and line in a row.

Upvotes: 3

Related Questions