Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings
/perl5Public

Commitd6f958e

Browse files
committed
OP_SUBSTR_NIBBLE - a specialised OP_SUBSTR variant
This commit adds OP_SUBSTR_NIBBLE and associated machinery for fasthandling of the constructions: substr EXPR,0,LENGTH,''and substr EXPR,0,LENGTHWhere EXPR is a scalar lexical, the OFFSET is zero, and either thereis no REPLACEMENT or it is the empty string. LENGTH can be anythingthat OP_SUBSTR supports. These constraints allow for a very strippedback and optimised version of pp_substr.The primary motivation was for situations where a scalar, containingsome network packets or other binary data structure, is being parsedpiecemeal. Nibbling away at the scalar can be useful when you don'tknow how exactly it will be parsed and unpacked until you get started.It also means that you don't need to worry about correctly updatinga separate offset variable.This operator also turns out to be an efficient way to (destructively)break an expression up into fixed size chunks. For example, given: my $x = ''; my $str = "A"x100_000_000;This code: $x = substr($str, 0, 5, "") while ($str);is twice as fast as doing: for ($pos = 0; $pos < length($str); $pos += 5) { $x = substr($str, $pos, 5); }Compared with blead, `$y = substr($x, 0, 5)` runs 40% faster and`$y = substr($x, 0, 5, '')` runs 45% faster.
1 parentff0ce7d commitd6f958e

File tree

15 files changed

+793
-395
lines changed

15 files changed

+793
-395
lines changed

‎MANIFEST

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6436,6 +6436,7 @@ t/op/studytied.tSee if study works with tied scalars
64366436
t/op/sub.tSee if subroutines work
64376437
t/op/sub_lval.tSee if lvalue subroutines work
64386438
t/op/substr.tSee if substr works
6439+
t/op/substr_nibble.tSee if substr($x, 0, $l, '') optimisation works
64396440
t/op/substr_thr.tSee if substr works in another thread
64406441
t/op/svflags.tSee if POK is set as expected.
64416442
t/op/svleak.plTest file for svleak.t

‎ext/Opcode/Opcode.pm

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
packageOpcode 1.66;
1+
packageOpcode 1.67;
22

33
use strict;
44

@@ -322,7 +322,8 @@ invert_opset function.
322322
slt sgt sle sge seq sne scmp
323323
isa
324324
325-
substr vec stringify study pos length index rindex ord chr
325+
substr substr_nibble vec stringify study pos length index
326+
rindex ord chr
326327
327328
ucfirst lcfirst uc lc fc quotemeta trans transr chop schop
328329
chomp schomp

‎lib/B/Deparse.pm

Lines changed: 20 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
# This is based on the module of the same name by Malcolm Beattie,
88
# but essentially none of his code remains.
99

10-
packageB::Deparse 1.80;
10+
packageB::Deparse 1.81;
1111
use strict;
1212
use Carp;
1313
use Bqw(class main_root main_start main_cv svref_2object opnumber perlstring
@@ -3419,6 +3419,25 @@ sub pp_substr {
34193419
maybe_local(@_, listop(@_,"substr"))
34203420
}
34213421

3422+
subpp_substr_nibble {
3423+
my ($self,$op,$cx) =@_;
3424+
3425+
my$lex = ($op->private & OPpTARGET_MY);
3426+
3427+
my$val ='substr(' .$self->deparse($op->first->sibling,$cx)
3428+
.', 0,' .$self->deparse($op->first->sibling->sibling->sibling,$cx)
3429+
. ( (($op->private & 7) == 3) ?'' :", '')" );
3430+
3431+
if ($lex) {
3432+
my$targ =$op->targ;
3433+
my$var =$self->maybe_my($op,$cx,$self->padname($op->targ),
3434+
$self->padname_sv($targ),
3435+
0);
3436+
$val =$self->maybe_parens("$var =$val",$cx, 7);
3437+
}
3438+
$val;
3439+
}
3440+
34223441
subpp_index {
34233442
# Also handles pp_rindex.
34243443
#

‎lib/B/Deparse.t

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1757,6 +1757,14 @@ print sort(foo('bar'));
17571757
substr(my $a, 0, 0) = (foo(), bar());
17581758
$a++;
17591759
####
1760+
# 4-arg substr (non-nibble)
1761+
my $str = 'ABCD';
1762+
my $bbb = substr($str, 1, 1, '');
1763+
####
1764+
# 4-arg substr (nibble)
1765+
my $str = 'ABCD';
1766+
my $aaa = substr($str, 0, 1, '');
1767+
####
17601768
# This following line works around an unfixed bug that we are not trying to
17611769
# test for here:
17621770
# CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised

‎lib/B/Op_private.pm

Lines changed: 1 addition & 0 deletions
Some generated files are not rendered by default. Learn more aboutcustomizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp