From 64620e570f04c1f2e1add2025a595fa0eae323b4 Mon Sep 17 00:00:00 2001 From: Steffen Mueller Date: Sun, 13 Feb 2011 23:30:56 +0100 Subject: [PATCH] Add targetable method This does the same thing for a simple output map as the make_targetable function in ExtUtils::ParseXS::Utilities does for all output maps. The latter function is intended to be superseded by this new method. --- .../lib/ExtUtils/Typemaps/OutputMap.pm | 80 ++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm index 5aca32c..e60c7e6 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm @@ -92,6 +92,86 @@ sub cleaned_code { return $code; } +=head2 targetable + +This is an obscure optimization that used to live in C +directly. + +In a nutshell, this will check whether the output code +involves calling C, C, C, C or C +to set the special C<$arg> placeholder to a new value +B. If that is the case, the code is +eligible for using the C-related macros to optimize this. +Thus the name of the method: C. + +If the optimization can not be applied, this returns undef. +If it can be applied, this method returns a hash reference containing +the following information: + + type: Any of the characters i, u, n, p + with_size: Bool indicating whether this is the sv_setpvn variant + what: The code that actually evaluates to the output scalar + what_size: If "with_size", this has the string length (as code, not constant) + +=cut + +sub targetable { + my $self = shift; + return $self->{targetable} if exists $self->{targetable}; + + our $bal; # ()-balanced + $bal = qr[ + (?: + (?>[^()]+) + | + \( (??{ $bal }) \) + )* + ]x; + + # matches variations on (SV*) + my $sv_cast = qr[ + (?: + \( \s* SV \s* \* \s* \) \s* + )? + ]x; + + my $size = qr[ # Third arg (to setpvn) + , \s* (??{ $bal }) + ]x; + + my $code = $self->code; + + # We can still bootstrap compile 're', because in code re.pm is + # available to miniperl, and does not attempt to load the XS code. + use re 'eval'; + + my ($type, $with_size, $arg, $sarg) = + ($code =~ + m[^ + \s+ + sv_set([iunp])v(n)? # Type, is_setpvn + \s* + \( \s* + $sv_cast \$arg \s* , \s* + ( (??{ $bal }) ) # Set from + ( (??{ $size }) )? # Possible sizeof set-from + \) \s* ; \s* $ + ]x + ); + + my $rv = undef; + if ($type) { + $rv = { + type => $type, + with_size => $with_size, + what => $arg, + what_size => $sarg, + }; + } + $self->{targetable} = $rv; + return $rv; +} + =head1 SEE ALSO L -- 1.8.3.1