この記事はPerl Advent Calendar 2020 と琉大 Advent Calendar 2020 の11日目の記事です。
Perl はPerl5になって長いですが、現在の最新の安定版のバージョンは5.32です。
Perl5.32で取り入れられた(厳密には5.31からですが)のおもしろ機能として連鎖比較 (Chained comparisons )が存在します。
今までPerl で数値などが特定の範囲に含まれているかどうかをif文で判定するには次の様に書く必要がありました。
if (10 < $n && $n <= 20 )
これがこう書ける様になります!!!
if ( 10 < $n <= 20 ) {...}
便利!!!!!!!!!!!!!!!!!!!!!!!!
...........というわけで、この便利な連鎖比較がどの様に実装されているかを探検してみます。
言語処理系の実装
さて今からPerl インタプリタ の実装について迫っていきますが、その前にプログラミング言語 がどのように実装されているかを確認しましょう。
言語処理の流れ
大きくプログラミング言語 は「コンパイラ 型言語」と「スクリプト言語 」に2分されることは皆さんご存知のとおりです。
実際のところコンパイラ 型言語もスクリプト言語 も大まかにやっている処理は同じです。
言語処理系(コンパイラ 、 インタプリタ )は大きく次の様な処理フローをたどります。
字句解析(トーカナイズ)
入力のプログラムを言語処理系的に意味のある字句(トーク ン)に分割します。
例えばmy $hoge = "hello"の場合は my $hoge = "hello" ;の様に分割します。
分割と同時にそのトーク ンの種類を付けていきます (変数名であるとか、 =なら代入であるなど)
主に字句解析をするプログラムのことをレキサー (Lexer)などと呼びます。
字句解析の結果のトーク ンの並びを、 言語の文法と照らし合わせた上で内部構造に変換します
変換される構造はだいたい木構造 になっています
木構造 で表現する際にいらないトーク ンなどは省く(抽象化される)ので、抽象構文木 (AST Abstract Syntax Tree)と呼ばれます
構文エラーとかはここで発見される
これを行うプログラムのことをパーサーと呼びます。
実行/コード生成
構文解析 の結果生成されたASTを元にコードを実行します
.....といいつつ最近のコンパイラ /インタプリタ は直接ASTを評価することはあまりしません
バイトコード に変換するのは高速化と効率化の為です。(実際の速度などはバイトコード 自体やバイトコード を解釈するVM の設計/実装によります)
バイトコード とはバイナリ列で表現されている一種のプログラムです。
Perl の場合はopcodeとppcodeの2種類がありますが、仮想マシン に対しての命令はopcodeに対応したppcodeです。
その為、構文木 の全体を俯瞰する場合はopcodeを中心に見て、 各仮想マシン の命令で何が行われるかはppcodeの定義を見れば良いことになります。
Ruby のISeqとは違い、 Perl はバイトコード になってるとは言え、 ほぼ抽象構文木 をそのまま実行する形で実装されています。
Perl で変換されたバイトコード はスタックマシンとして実装された仮想機械(PVM: PerlVirtualMachine)上で実行されます。
スタックマシン
perl はプログラム中の計算を巨大なスタック(リスト構造の一種)に値を出し入れすることで行います。
スタックマシンを採用している言語として、 Ruby やPython (C実装)が存在します。
普通のコンピュータ(CPU)や、 Rakuの実装であるRakudoのVM のMoarVMはレジスタ を利用したレジスタ マシンです。
スタック、レジスタ マシンともに言語処理系に付随する仮想マシン では良く使われる設計です。
perl インタプリタ では スタックポインタspを経由してスタックを操作します。
スタック関連の定義ファイルpp.h(push/popの意味らしい)を確認すると次の様なマクロが存在します。
#define POPs (*sp--)
#define POPp POPpx
#define POPpx (SvPVx_nolen(POPs))
#define TOPs (*sp)
#define TOPm1s (*(sp- 1 ))
#define TOPp1s (*(sp+ 1 ))
#define TOPp TOPpx
#define TOPpx (SvPV_nolen(TOPs))
#define TOPn (SvNV(TOPs))
#define PUSHs(s) (*++sp = (s))
#define PUSHTARG STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END
#define PUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END
POPやPUSHと言った配列操作でおなじみのマクロが出てきています。
実装を見るとPOPsは今現在のスタックの一番上の要素のポインタを返しつつ、スタックを一段下げています。
Perl におけるpopと動きが同じですね!
TOPsは現在のスタックポインタが示している要素を、 TOPm1sはminus 1の略だと思うのですが、現在のスタックポインタの位置から一段下がった箇所の要素を返しています。
perl はどのタイミングでスタックに値を積んだり取り出したりするのでしょうか。
perl インタプリタ では演算子 や組み込み関数などに対応した仮想マシン の命令が存在します。
ここでPerl のlt つまり <の実装を見てみましょう。
(文字列演算子 のltは内部ではsltと呼ばれています)
PP(pp_lt)
{
dSP;
SV *left, *right;
tryAMAGICbin_MG(lt_amg, AMGf_numeric);
right = POPs;
left = TOPs;
SETs(boolSV(
(SvIOK_notUV(left) && SvIOK_notUV(right))
? (SvIVX(left) < SvIVX(right))
: (do_ncmp(left, right) == -1)
));
RETURN;
}
注目したいのは
SV *left, *right;
right = POPs;
left = TOPs;
このブロックではleftとrightをSV型のポインタとして宣言しています。
SVとはPerl の変数などの内部構造の大本の型です。
ポインタとして宣言したrightとleftはright = POPsとleft = TOPsで初期化しています。
POPsとTOPsは先程確認した通りスタックの操作のAPI でした。
<演算子 は通常 0 < $nの様に<の左右になにか値が必要です。
perl はこの様な演算に必要な値を予めスタックに保存しておき、必要なタイミングで取り出すことで計算を行います。
<の左側の値がそのとおりleftであり、右側がrightとなります。
演算した結果はSETsマクロを使ってスタックの一番上に値を置きます。
ここでスタックに置いた値は、例えばif文で分岐するかどうかの条件などに使われます。
この様にperl 内部ではスタックを「演算して値をおく」「演算に必要なので取り出す」の様に利用します。
連鎖比較の実装を見る
ここまででperl 内部に対して知見が溜まってきたので、いよいよ連鎖比較がどの様に実装されているかを見ていきましょう。
まずはPerl5のgitリポジトリ を雑にcommit logを検索します。
とりあえずはchained comparisonsあたりで検索してみます。
$ git log --grep='chained comparisons'
commit 88c28b3819570e2ea7914875b25f0f40654c570d
Author: Dan Book <grinnz@grinnz.com>
Date: Tue Apr 28 15:18:18 2020 -0400
perlop - Add more examples for chained comparisons
The distinction between how many times an expression may be evaluated and how many times its result may be fetched is somewhat confusing. This calls out the
commit e8a86671097b355fe5e0d9da2473a926929d87c4
Author: Zefram <zefram@fysh.org>
Date: Fri Feb 7 09:30:21 2020 +0000
pod/perlop.pod: expand doc on chained comparisons
commit 02b85d3dab092d678cfc958a2dc252405333ed25
Author: Zefram <zefram@fysh.org>
Date: Wed Feb 5 07:43:14 2020 +0000
chained comparisons
この内前2つはそれぞれperlopのpodの更新のコミットであり、 連鎖比較の実装そのものの変更ではありませんでした。
commit 02b85d3dab092d678cfc958a2dc252405333ed25
Author: Zefram <zefram@fysh.org>
Date: Wed Feb 5 07:43:14 2020 +0000
chained comparisons
このコミットで連鎖比較の実装が行われています。
連鎖比較の実装のコミットを探る
というわけで上の02b85d3dab092d678cfc958a2dc252405333ed25の変更を見ていきます。
webから見たい方はGitHubから見れます
変更があったファイル一覧
$ git log -p 02b85d3dab092d678cfc958a2dc252405333ed25 --statとかで表示出来るらしいので見てみます。
$ git log -p 02b85d3dab092d678cfc958a2dc252405333ed25 --stat
commit 02b85d3dab092d678cfc958a2dc252405333ed25
Author: Zefram < zefram@fysh.org>
Date: Wed Feb 5 07:43:14 2020 +0000
chained comparisons
---
MANIFEST | 1 +
embed.fnc | 4 +
embed.h | 3 +
ext/Opcode/Opcode.pm | 4 +-
lib/B/Deparse.pm | 58 +++++
lib/B/Deparse.t | 27 ++
lib/B/Op_private.pm | 2 +
op.c | 115 +++++++++
opcode.h | 16 +-
opnames.h | 4 +-
perly.act | 772 ++++++++++++++++++++++++++++++--------------------------
perly.h | 88 +++----
perly.tab | 1790 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------------------------------------------
perly.y | 47 +++-
pod/perlop.pod | 41 ++-
pp.c | 24 ++
pp_proto.h | 2 +
proto.h | 14 ++
regen/opcodes | 3 +
t/op/cmpchain.t | 170 +++++++++++++
toke.c | 50 ++--
21 files changed, 1930 insertions( + ) , 1305 deletions( - )
結構いろいろなファイルが変更されているのがわかりますね。
lib/B以下のファイル群はPerl のBモジュール(Perl のバックエンドをいい感じにスクリプト から使えるくん)関連です。
とりあえずテストから見る
連鎖比較の実装を追う前に、そもそもどういう使用感なのかをテストから探ります。
連鎖比較のテストは t/op/cmpchain.tに記述されています。
全体で1749ものテストが存在するので、全てでは無いですが一部を取り出してみます。
実行には5.32.0を利用しています。
$ prove -v t/op/cmpchain.t
t/op/cmpchain.t ..
1..1749
ok 1 - <=> <=> non-associative
ok 2 - <=> cmp non-associative
ok 3 - <=> ~~ non-associative
ok 4 - cmp <=> non-associative
ok 5 - cmp cmp non-associative
ok 6 - cmp ~~ non-associative
ok 7 - ~~ <=> non-associative
ok 8 - ~~ cmp non-associative
ok 273 - isa ge ge non-associative
ok 274 - ge ge isa non-associative
ok 275 - == == legal
ok 276 - == != legal
ok 277 - == eq legal
ok 278 - == ne legal
ok 279 - != == legal
ok 605 - <= ge <= legal
ok 606 - <= ge >= legal
ok 607 - <= ge lt legal
ok 608 - <= ge gt legal
ok 609 - <= ge le legal
ok 610 - <= ge ge legal
ok 611 - >= < < legal
ok 612 - >= < > legal
ok 613 - >= < <= legal
ok 1724 - 5 < 7 <= 8 > 5 with side effects
ok 1725 - operand evaluation order
ok 1726 - 5 == 7 != 8 == 6
ok 1727 - 5 < 7 <= 8 > 6
ok 1728 - 5 == 7 != 8 == 6 with side effects
ok 1729 - operand evaluation order
ok 1746 - 5 == 7 != 8 == 9 with side effects
ok 1747 - operand evaluation order
ok 1748 - 5 < 7 <= 8 > 9 with side effects
ok 1749 - operand evaluation order
ok
All tests successful.
Files=1, Tests=1749, 0 wallclock secs ( 0.12 usr 0.01 sys + 0.05 cusr 0.01 csys = 0.19 CPU)
Result: PASS
テストを見ると連鎖比較は 0 < $n < 10 のような3条件以外にも 5 < 7 <= 8 > 9の様にさらに複数連鎖可能な様です。
さらに大小以外にもcmpや~~なども使えるみたいですね。(とは言え <= ge <=みたいなのを使いたいケースあるのか? みたいな気はする)
まず最初に見るのはperly.(h|tab|y)系のファイルです。
このファイルはPerl の心臓部と言ってもいいであろう構文解析 系の実装を担当しています。
Perl は構文解析 ではYacc (Bison)を利用しており、perly.yがその定義ファイル、 perly.tab及びperly.hはbisonが生成してくれるファイルです。
その為人間が変更したファイルであるperly.hの変更点を見てみましょう。
diff --git a/perly.y b/perly.y
index 0325d663c0..c90b8b41b8 100644
--- a/perly.y
+++ b/perly.y
@@ -56,7 +56,7 @@
%token <ival> GIVEN WHEN DEFAULT
%token <ival> LOOPEX DOTDOT YADAYADA
%token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
-%token <ival> RELOP EQOP MULOP ADDOP
+%token <ival> MULOP ADDOP
%token <ival> DOLSHARP DO HASHBRACK NOAMP
%token <ival> LOCAL MY REQUIRE
%token <ival> COLONATTR FORMLBRACK FORMRBRACK
@@ -76,6 +76,7 @@
%type <opval> refgen_topic formblock
%type <opval> subattrlist myattrlist myattrterm myterm
%type <opval> termbinop termunop anonymous termdo
+%type <opval> termrelop relopchain termeqop eqopchain
%type <ival> sigslurpsigil
%type <opval> sigvarname sigdefault sigscalarelem sigslurpelem
%type <opval> sigelem siglist siglistornull subsigguts subsignature optsubsignature
@@ -97,8 +98,8 @@
%left <ival> ANDAND
%left <ival> BITOROP
%left <ival> BITANDOP
-%nonassoc EQOP
-%nonassoc RELOP
+%left <ival> CHEQOP NCEQOP
+%left <ival> CHRELOP NCRELOP
%nonassoc UNIOP UNIOPSUB
%nonassoc REQUIRE
%left <ival> SHIFTOP
@@ -1028,10 +1029,10 @@ termbinop: term ASSIGNOP term /* $x = $y, $x += $y */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term SHIFTOP term /* $x >> $y, $x << $y */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
- | term RELOP term /* $x > $y, etc. */
- { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
- | term EQOP term /* $x == $y, $x eq $y */
- { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | termrelop %prec PREC_LOW /* $x > $y, etc. */
+ { $$ = $1; }
+ | termeqop %prec PREC_LOW /* $x == $y, $x cmp $y */
+ { $$ = $1; }
| term BITANDOP term /* $x & $y */
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term BITOROP term /* $x | $y */
@@ -1048,6 +1049,38 @@ termbinop: term ASSIGNOP term /* $x = $y, $x += $y */
{ $$ = bind_match($2, $1, $3); }
;
+termrelop: relopchain %prec PREC_LOW
+ { $$ = cmpchain_finish($1); }
+ | term NCRELOP term
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | termrelop NCRELOP
+ { yyerror("syntax error"); YYERROR; }
+ | termrelop CHRELOP
+ { yyerror("syntax error"); YYERROR; }
+ ;
+
+relopchain: term CHRELOP term
+ { $$ = cmpchain_start($2, $1, $3); }
+ | relopchain CHRELOP term
+ { $$ = cmpchain_extend($2, $1, $3); }
+ ;
+
+termeqop: eqopchain %prec PREC_LOW
+ { $$ = cmpchain_finish($1); }
+ | term NCEQOP term
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | termeqop NCEQOP
+ { yyerror("syntax error"); YYERROR; }
+ | termeqop CHEQOP
+ { yyerror("syntax error"); YYERROR; }
+ ;
+
+eqopchain: term CHEQOP term
+ { $$ = cmpchain_start($2, $1, $3); }
+ | eqopchain CHEQOP term
+ { $$ = cmpchain_extend($2, $1, $3); }
+ ;
+
結構いろいろ変更点がありますね。上から見ていきましょう。
@@ -56,7 +56,7 @@
%token <ival> GIVEN WHEN DEFAULT
%token <ival> LOOPEX DOTDOT YADAYADA
%token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
-%token <ival> RELOP EQOP MULOP ADDOP
+%token <ival> MULOP ADDOP
%token <ival> DOLSHARP DO HASHBRACK NOAMP
%token <ival> LOCAL MY REQUIRE
%token <ival> COLONATTR FORMLBRACK FORMRBRACK
削除されたものから今までを探る
このdiffを確認すると %token <ival> RELOP EQOP MULOP ADDOPの中のRELOPとEQOPが削除されています。
このRELOP MULOPなどは字句解析部分で生成したトーク ンであり、トーク ンが持つ値の型としてivalを宣言しています。
ivalそのものやyacc の宣言部分でI32型として宣言されています。
削除されたRELOPとEQOPが何であるかを見てみましょう。
以前のperly.y内でこのトーク ンがどの様に使われるかを定義している構文規則部分を見てみます。
yacc は次の様な規則で記述されています、また中で出てくる$1や$2などは、それぞれ文法規則にマッチした実際の値になっています。
Perl などで正規表現 マッチした後で、グループから取り出す$1の様なものと捉えれば良いでしょう。
規則 トークン 規則
{ そのケースで実行される処理 }
term RELOP term
{ $$ = newBINOP($2 , 0, scalar($1 ), scalar($3 )); }
term EQOP term
{ $$ = newBINOP($2 , 0, scalar($1 ), scalar($3 )); }
コメントからなんとなく雰囲気がわかるかと思いますが、 RELOPトーク ンは左右をtermで囲う文法で使われます。
termは変数、文字列、数値と言った実際の値などの単項式のことです。
RELOPは基本的に左右に数値を取るトーク ンのようです。
RELOPトーク ンが一体何であるかは字句解析をしているtoken.cの中で定義されています。
実際にはこのトーク ンは内部的には幾つかの演算子 の集合になっています。
perl インタプリタ は字句解析でトーク ンをいい感じに作ってくれる便利マクロを呼び出すことで、構文解析 で利用するトーク ンを作成します。
RELOPトーク ンは、 便利マクロの一種のRopに演算子 名を引数で渡すことで作成されます。
トーク ンを作る便利マクロは、連鎖比較の実装のコミットで他にEopも削除されていた為、RopとEopの解説部分を見てみます。
* Eop : equality-testing operator
* Rop : relational operator <= != gt
説明から分かる通り Eopは ==や eqなどの演算子 からトーク ンを作る便利マクロで、 Ropは大小関係などの関係性を持った演算子 からトーク ンを作る便利マクロであると言えます。
......と、こんな大事そうなトーク ンやマクロを削除してしまって良かったのでしょうか。
実は連鎖比較の実装では、演算子 の文法規則ごとまるっと入れ替えているのです。
連鎖比較で実装されたトーク ン
perly.yのdiffを眺めると実は新たに何個か追加されているトーク ンがあります。
@@ -76,6 +76,7 @@
%type <opval> refgen_topic formblock
%type <opval> subattrlist myattrlist myattrterm myterm
%type <opval> termbinop termunop anonymous termdo
+%type <opval> termrelop relopchain termeqop eqopchain
%type <ival> sigslurpsigil
%type <opval> sigvarname sigdefault sigscalarelem sigslurpelem
%type <opval> sigelem siglist siglistornull subsigguts subsignature optsubsignature
@@ -97,8 +98,8 @@
%left <ival> ANDAND
%left <ival> BITOROP
%left <ival> BITANDOP
-%nonassoc EQOP
-%nonassoc RELOP
+%left <ival> CHEQOP NCEQOP
+%left <ival> CHRELOP NCRELOP
%nonassoc UNIOP UNIOPSUB
%nonassoc REQUIRE
まず注目したいのはこの4行です。
-%nonassoc EQOP
-%nonassoc RELOP
+%left <ival> CHEQOP NCEQOP
+%left <ival> CHRELOP NCRELOP
先程確認したEQOPとRELOPはyacc の%nonassocを使って宣言されていました。
%nonassocで宣言されたものは連結することができません。 つまり今まで 0 < 10 == $nができなかったのはこの為でもあるのです。
代わりに導入されたCHEQOPとNCEQOPは%left、つまり左結合のトーク ンです。
EQOPと名前が似ている事からビビッと来たかもしれませんが、実はこれら追加されたトーク ンは削除されたトーク ンと非常に関係性が深いです。
chainingとnon-chainingトーク ン
CHQOPやNCEQOPなどはEQOPと同様に字句解析で便利関数経由で作成されます。
ではその便利関数の説明部分を見てみましょう。
* ChEop : chaining equality-testing operator
* NCEop : non-chaining comparison operator at equality precedence
* ChRop : chaining relational operator <= != gt
* NCRop : non-chaining relational operator isa
CHQOPとNCEQOPに対応しているのがChEopとNCEopです。
CHQOPはCHaining Quality OPという意味でしょうか。直訳すると連鎖している等価演算子 ですね。
NCEopはnon-chaining comparisonつまり、連鎖していない等価演算子 とのことです。
ここで疑問になるのはchainingとnon-chainingがどのようなものがあるかですね。そもそもここでのchainingってなんでしょうか。
その答えは実際にトーク ンを作成している字句解析部分から、具体的にどの演算子 が該当するのかを探し出すと答えがわかります。
ChEopではまず等価演算子 でかつchainingのものであるChEopの例を探してみましょう。
ripgrepを利用して字句解析をしているtoke.cからChEopでgrep します。
+ikoma+anatofuz$ rg ChEop
toke.c
208: * ChEop : chaining equality-testing operator
248:#define ChEop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)CHEQOP))
6344: ChEop(OP_NE);
7750: ChEop(OP_SEQ);
8039: ChEop(OP_SNE);
8874: ChEop(OP_EQ);
このOP_NE、OP_SEQ、OP_SNEとOP_EQがChEopによって作成される構文木 の要素です。名前からなんとなくわかりますが、これらの要素と対応している演算子 が知りたいですね。
演算子 とこれらOP構造体を結びつけているのは、 Perl プログラムを解析する字句解析部分です。
というわけで、字句解析からこれらの構造体が出ている箇所を探し、どの演算子 と対応しているかを確認します。
まずOP_NEを生成している箇所を見てみましょう。6344行目とあり、これはyyl_bang関数内の様です。
static int
yyl_bang(pTHX_ char *s)
{
const char tmp = *s++;
if (tmp == '=' ) {
if (*s == '~' && ckWARN(WARN_SYNTAX)) {
const char *t = s+1 ;
while (t < PL_bufend && isSPACE(*t))
++t;
if (*t == '/' || *t == '?'
|| ((*t == 'm' || *t == 's' || *t == 'y' )
&& !isWORDCHAR(t[1 ]))
|| (*t == 't' && t[1 ] == 'r' && !isWORDCHAR(t[2 ])))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"!=~ should be !~" );
}
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
s -= 2 ;
TOKEN(0 );
}
ChEop(OP_NE);
}
ChEqopは if (tmp == '=')である時に実行されトーク ンOP_NEを作成しています。....と言われてもいまいちピントこないので、このyyl_bangを呼び出している場所を確認します。
同じ様にgrep してみるとtoke.cの948行目にあります。
case '!' :
return yyl_bang(aTHX_ s + 1 );
このcase文でなんとなく解ったのではないでしょうか。そうです! OP_NEとは !=演算子 のことです。
yyl_bangのif (*s == '~' && ckWARN(WARN_SYNTAX)) {のif文は !=~のケースだった様です。
同様に探していくと以下の様に対応していることがわかりました
ちなみにeqなどはkeyqord.cファイル中でキーワードという単位で処理をしています。
NCEopでは次に等価演算子 でchainingではないNCEopのものを探してみます。
+ikoma+anatofuz$ rg NCEop toke.c
209: * NCEop : non-chaining comparison operator at equality precedence
249:#define NCEop( f ) return ( pl_yylval.ival =f, PL_expect =XTERM, PL_bufptr =s, REPORT( ( int ) NCEQOP ) )
6473: NCEop( OP_SMARTMATCH ) ;
6541: NCEop( OP_NCMP ) ;
7676: NCEop( OP_SCMP ) ;
上2行は説明とマクロの定義ですので無視します。
結果としてOP_SMARTMATCHとOP_NCMP、OP_SCMPの3種類であるようです。
これらもtoke.cの中を見て演算子 を特定したところ、次の様な対応になっていました。
OP_SMARTMATCH
OP_NCMP
OP_SCMP
...確かにこう見ると ソートのときなどに順序を決定する宇宙船演算子 <=> は連鎖させることができなさそうですね。(そもそも連鎖させないとは思いますが)
ChRop続いては等価演算子 以外の演算子 のchainingの方であるChRopを確認します。
英語での説明を確認すると
chaining relational operator <= != gt
.....みたいな演算子 のことですね。
これも先程までと同様に字句解析部分のtoke.cをripgrepで探してみます。
+ikoma+anatofuz$ rg ChRop
toke.c
210: * ChRop : chaining relational operator <= != gt
250:#define ChRop( f ) return ( pl_yylval.ival =f, PL_expect =XTERM, PL_bufptr =s, REPORT( ( int ) CHRELOP ) )
6548: ChRop( OP_LE ) ;
6557: ChRop( OP_LT ) ;
6577: ChRop( OP_GE ) ;
6586: ChRop( OP_GT ) ;
7828: ChRop( OP_SGT ) ;
7833: ChRop( OP_SGE ) ;
7981: ChRop( OP_SLT ) ;
7986: ChRop( OP_SLE ) ;
見てみるとOP_LEやOP_GTがヒットしました。
ここでOP_LEを作っている場所を、toke.cから探してみると、次の関数がヒットしました。
static int
yyl_leftpointy(pTHX_ char *s)
{
char tmp;
if (PL_expect != XOPERATOR) {
if (s[1 ] != '<' && !memchr(s,'>' , PL_bufend - s))
check_uni();
if (s[1 ] == '<' && s[2 ] != '>' )
s = scan_heredoc(s);
else
s = scan_inputsymbol(s);
PL_expect = XOPERATOR;
TOKEN(sublex_start());
}
s++;
tmp = *s++;
if (tmp == '<' ) {
if (*s == '=' && !PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
s -= 2 ;
TOKEN(0 );
}
SHop(OP_LEFT_SHIFT);
}
if (tmp == '=' ) {
tmp = *s++;
if (tmp == '>' ) {
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
s -= 3 ;
TOKEN(0 );
}
NCEop(OP_NCMP);
}
s--;
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
s -= 2 ;
TOKEN(0 );
}
ChRop(OP_LE);
}
この関数yyl_leftpointyはtoke.cの次の場所で呼び出されています。
static int
yyl_try(pTHX_ char *s)
{
char *d;
GV *gv = NULL ;
int tok;
retry :
switch (*s) {
default :
if (UTF ? isIDFIRST_utf8_safe(s, PL_bufend) : isALNUMC(*s)) {
if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
case '<' :
if (s[1 ] == '<' && (s == PL_linestart || s[-1 ] == '\n' )
&& memBEGINs(s + 2 , (STRLEN) (PL_bufend - (s + 2 )), "<<<<<" ))
{
s = vcs_conflict_marker(s + 7 );
goto retry;
}
return yyl_leftpointy(aTHX_ s);
見るとトーク ン解析中に<の記号が出てきた場合にleftpointy関数が呼ばれているようです。
Perl は<<が来ており、かつ先頭行だった場合のケースは特別扱いしており、それ以外のケースはyyl_leftpointyで解析しています。
余談ですがvcs_conflict_markerは、なんとなく関数名から分かる通り、git/hgなどのvcs でコンフリクトしたときに出てくる<<<<<<<<<<<な記号のアレです。
実際に読んでいるvcs_conflict_markerの関数を確認すると
S_vcs_conflict_marker(pTHX_ char *s)
{
lex_token_boundary();
PL_bufptr = s;
yyerror("Version control conflict marker" );
while (s < PL_bufend && *s != '\n' )
s++;
return s;
}
とあり、yyerrorの中身を見るとその通りですね。
話を先程のyyl_leftpointy(pTHX_ char *s)に戻しましょう。
まず先頭の実装は次の様になっています。
static int
yyl_leftpointy(pTHX_ char *s)
{
char tmp;
if (PL_expect != XOPERATOR) {
if (s[1 ] != '<' && !memchr(s,'>' , PL_bufend - s))
check_uni();
if (s[1 ] == '<' && s[2 ] != '>' )
s = scan_heredoc(s);
else
s = scan_inputsymbol(s);
PL_expect = XOPERATOR;
TOKEN(sublex_start());
}
s++;
PL_expect != XOPERATORがなんであるかはここだけの情報ではあまりわかりません。
とはいえ見てみると< の後に <以外の文字がきており、かつ>が読んでいる行に含まれないケースは、単項演算子 かcheck_uniで確認しているようです。
<<が来ている場合は、ヒアドキュメントなのでscan_heredocを読んでいるようです。
このif文にヒットしなかった場合はs++しているため、1文字読み進めます。
続く箇所は次のコードです。
tmp = *s++;
if (tmp == '<' ) {
if (*s == '=' && !PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
s -= 2 ;
TOKEN(0 );
}
SHop(OP_LEFT_SHIFT);
}
if (tmp == '=' ) {
tmp = *s++;
if (tmp == '>' ) {
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
s -= 3 ;
TOKEN(0 );
}
NCEop(OP_NCMP);
}
s--;
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
s -= 2 ;
TOKEN(0 );
}
ChRop(OP_LE);
}
まず読み進めた現在のトーク ンのポインタであるsが指す値ををtmpに代入して、sをインクリメントしています。
この行が実行されると、たとえば <=を解析した場合、 tmpに =という文字が代入されます。
実際に見てみると、たとえばこのif文は tmp == '<'という条件式ですので、$c=1; $c <<= 3;などの、Perl のシフト演算子 を利用しているケースです。
OP_LEは次のtmp == '='のif文中にかかっているので、つまりOP_LEの正体は<=演算子 ということになります。
なるほど確かに 0 <= $m <= 10の様に比較することができそうですので、OP_LEはchainingな演算子 ですね。
ちなみに直前の
if (tmp == '=' ) {
tmp = *s++;
if (tmp == '>' ) {
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
s -= 3 ;
TOKEN(0 );
}
NCEop(OP_NCMP);
}
この部分ですが、 if文でヒットしたところを読み進めていくと <=>のトーク ンだった場合にOP_NCMPを発行しています。
つまりこれは宇宙船演算子 <=>のことですね。
NCRop
最後にNCRopの実装を見てみましょう。.....といいつつ、実はNCRopが対応している演算子 は説明文に書いています。
NCRop : non-chaining relational operator isa
ということで、NCRopは最近追加されたisa演算子 専用のものらしいです。
実際にripgrepで探してもISAっぽいものしか見つかりません。
$ rg NCRop
toke.c
211: * NCRop : non-chaining relational operator isa
251:#define NCRop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)NCRELOP))
7943: NCRop(OP_ISA);
連鎖比較で追加された文法規則
追加されたこれらトーク ンが文法上のルールとして処理される構文解析 部分を見ていきましょう。
構文が定義されているperly.yのdiffをもう一度確認します。
yacc は{}の中にCの関数を書くことが出来るため、ここに書かれているnewBINOPなどはそれぞれCで実装された関数です。
- | term RELOP term /* $x > $y, etc. */
- { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
- | term EQOP term /* $x == $y, $x eq $y */
- { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | termrelop %prec PREC_LOW /* $x > $y, etc. */
+ { $$ = $1; }
+ | termeqop %prec PREC_LOW /* $x == $y, $x cmp $y */
+ { $$ = $1; }
term RELOP termの文法規則が削除され、代わりにtermrelop %prec PREC_LOWの文法規則が追加されています。
termrelop自体は別で定義されている文法規則です。これも見てみましょう。
termrelop: relopchain %prec PREC_LOW
{ $$ = cmpchain_finish($1 ); }
| term NCRELOP term
{ $$ = newBINOP($2 , 0, scalar($1 ), scalar($3 )); }
| termrelop NCRELOP
{ yyerror("syntax error"); YYERROR; }
| termrelop CHRELOP
{ yyerror("syntax error"); YYERROR; }
4つ定義されている文法規則の内、後ろ2つはシンタックス エラーの様です。
シンタックス エラーについては深く立ち入らないことにして、前2つを見てみましょう。
最初のrelopchain %prec PREC_LOWは別の文法規則relopchainの方を見る必要があるようです。
{}の中でこの文法規則の場合に実行される処理が記述されていますが、cmpchain_finish関数を実行しています。
名前から察すると連鎖比較の修了の際に実行される関数の様ですね。
続くterm NCRELOP termの部分は、NCRELOPが使われている事から従来の比較演算の文法規則と対応しています。
実行されるnewBINOP関数は、構文木 に新しい要素を作成する関数です。(perl の構文木 はOP構造体で表現されます)
では先程出てきたrelopchainの規則も見てみましょう。
relopchain: term CHRELOP term
{ $$ = cmpchain_start($2 , $1 , $3 ); }
| relopchain CHRELOP term
{ $$ = cmpchain_extend($2 , $1 , $3 ); }
;
relopchainの文法規則はterm CHRELOP termかrelopchain CHRELOP termの2種類です。
term CHRELOP termの方は、2 < $nの様なterm(項)に挟まる連鎖する演算子 の文法規則です。
例えば 2 < $n < 4の場合は、ここから連鎖比較が始まるのでcmpchain_start関数で連鎖比較の開始を処理していると思われます。
relopchain CHRELOP termは一番左のrelopchainが自分自身の規則となっていて、CHRELOPがきたあとにtermが再びくる文法規則。つまり、2 < $n < 4のような規則に対応しています。
このケースでは既に連鎖比較が始まっているので、cmpchain_extendで比較を拡張しています。
ということで、実際にPerl インタプリタ が連鎖比較をどうやって解釈しているかはcmpchain_startなどの関数の中身を読めば良いということになります。
では実際にPerl インタプリタ が連鎖比較を実行しているときにこれらの関数が呼ばれているかを見てみましょう。
実際のスクリプト を使ってトレースする
実際にPerl インタプリタ が先程見たcmpchain_startなどを読んでいるかは、 perl インタプリタ をCのデバッガを使ってトレースするとわかります。
ですが文法規則だけでは情報量が少なく、実際にインタプリタ がどのように評価をしているかはここでは判断できません。
なぜならPerl インタプリタ が実際に評価しているのは、構文解析 した結果作成された抽象構文木 (AST)だからです。
そのため、Perl の構文木 レベルでも必要そうな関数の目星を建てて見ましょう。
構文木 とは、言語処理系がトーク ンを解析し、構文解析 した後に生成する木構造 のことです。
この木構造 をルートから評価していくことでプログラムが実行されます。
それでは、Perl の構文木 を見てみましょう。
今回は素朴に1変数に値を代入して比較し、比較結果がtrueであればprintするスクリプト を書いてみました。
$n = 5 ;
if (1 < $n < 10 ) {
print " $n \n " ;
} else {
print "false \n " ;
}
Perl ではB::Concise を使うと構文木 が表示されます。
j <@> leave[1 ref] vKP/REFC ->(end)
1 <0> enter v ->2
2 <;> nextstate(main 1 test.pl:1) v:{ ->3
5 <2> sassign vKS/2 ->6
3 <$> const(IV 5) s ->4
- <1> ex-rv2sv sKRM*/1 ->5
4 <$> gvsv(*n) s ->5
6 <;> nextstate(main 1 test.pl:2) v:{ ->7
- <1> null vK/1 ->j
e <|> cond_expr(other->f) vK/1 ->k
- <1> null sK/1 ->e
b <|> cmpchain_and(other->c) sK/1 ->e
a <2> lt sK/2 ->b
7 <$> const(IV 1) s ->8
9 <1> cmpchain_dup sK/1 ->a
- <1> ex-rv2sv sK/1 ->9
8 <$> gvsv(*n) s ->9
d <2> lt sK/2 ->e
- <0> null s ->c
c <$> const(PVNV 10) s ->d
- <@> scope vK ->-
- <;> ex-nextstate(main 3 test.pl:3) v ->f
i <@> print vK ->j
f <0> pushmark s ->g
h <+> multiconcat("\n",-1,1)[t2] sK/STRINGIFY ->i
- <0> ex-pushmark s ->g
- <1> ex-rv2sv sK/1 ->h
g <$> gvsv(*n) s ->h
p <@> leave vKP ->j
k <0> enter v ->l
l <;> nextstate(main 5 test.pl:5) v ->m
o <@> print vK ->p
m <0> pushmark s ->n
n <$> const(PV "false\n") s ->o
オプションとして--treeを指定すると、より木構造 がわかりやすい形式で表示されます。
$ ./perl -MO=Concise,-tree test.pl
<j>leave[1 ref]-+-<1>enter
|-<2>nextstate(main 1 test.pl:1)
|-<5>sassign-+-<3>const(IV 5)
| `-ex-rv2sv---<4>gvsv(*n)
|-<6>nextstate(main 1 test.pl:2)
`-null---<e>cond_expr(other->f)-+-null---<b>cmpchain_and(other->c)-+-<a>lt-+-<7>const(IV 1)
| | `-<9>cmpchain_dup---ex-rv2sv---<8>gvsv(*n)
| `-<d>lt-+-null
| `-<c>const(PVNV 10)
|-scope-+-ex-nextstate(main 3 test.pl:3)
| `-<i>print-+-<f>pushmark
| `-<h>multiconcat("\n",-1,1)[t2]-+-ex-pushmark
| `-ex-rv2sv---<g>gvsv(*n)
`-<p>leave-+-<k>enter
|-<l>nextstate(main 5 test.pl:5)
`-<o>print-+-<m>pushmark
`-<n>const(PV "false\n")
test.pl syntax OK
B::Terse を使うと別のフォーマットで表示されます。
LISTOP (0x7ff557410228) leave [1]
OP (0x7ff5580d5f60) enter
COP (0x7ff557410268) nextstate
BINOP (0x7ff5574102c8) sassign
SVOP (0x7ff557410308) const IV (0x7ff557824bc8) 5
UNOP (0x7ff557410340) null [14]
SVOP (0x7ff557410378) gvsv GV (0x7ff557824be0) *n
COP (0x7ff5580d5fa0) nextstate
UNOP (0x7ff5580d6000) null
LOGOP (0x7ff5580d6038) cond_expr
UNOP (0x7ff5580d5708) null
LOGOP (0x7ff5580d5660) cmpchain_and
BINOP (0x7ff5580d57b8) lt
SVOP (0x7ff5574101f0) const IV (0x7ff557824c88) 1
UNOP (0x7ff5580d56d0) cmpchain_dup
UNOP (0x7ff5580d57f8) null [14]
SVOP (0x7ff5574101b8) gvsv GV (0x7ff557824be0) *n
BINOP (0x7ff5580d5740) lt
OP (0x7ff5580d56a0) null
SVOP (0x7ff5580d5780) const PVNV (0x7ff557824cb8) 10
LISTOP (0x7ff5580d61f0) scope
COP (0x7ff5580d5438) null [195]
LISTOP (0x7ff5580d5498) print
OP (0x7ff5580d54d8) pushmark
UNOP_AUX (0x7ff5580d5508) multiconcat [2]
OP (0x7ff5580d5548) null [3]
UNOP (0x7ff5580d55f0) null [14]
SVOP (0x7ff5580d5628) gvsv GV (0x7ff557824be0) *n
LISTOP (0x7ff5580d60a8) leave
OP (0x7ff5580d6078) enter
COP (0x7ff5580d60e8) nextstate
LISTOP (0x7ff5580d6148) print
OP (0x7ff5580d6188) pushmark
SVOP (0x7ff5580d61b8) const PV (0x7ff557824c70) "false\n"
生成された構文木 を見ると、大きく次のブロックに分割されます。
LISTOP (0x7ff557410228) leave [1]
OP (0x7ff5580d5f60) enter
COP (0x7ff557410268) nextstate
BINOP (0x7ff5574102c8) sassign
SVOP (0x7ff557410308) const IV (0x7ff557824bc8) 5
UNOP (0x7ff557410340) null [14]
SVOP (0x7ff557410378) gvsv GV (0x7ff557824be0) n
COP (0x7ff5580d5fa0) nextstate
UNOP (0x7ff5580d6000) null
LOGOP (0x7ff5580d6038) cond_expr
UNOP (0x7ff5580d5708) null
LOGOP (0x7ff5580d5660) cmpchain_and
BINOP (0x7ff5580d57b8) lt
SVOP (0x7ff5574101f0) const IV (0x7ff557824c88) 1
UNOP (0x7ff5580d56d0) cmpchain_dup
UNOP (0x7ff5580d57f8) null [14]
SVOP (0x7ff5574101b8) gvsv GV (0x7ff557824be0) n
BINOP (0x7ff5580d5740) lt
OP (0x7ff5580d56a0) null
SVOP (0x7ff5580d5780) const PVNV (0x7ff557824cb8) 10
LISTOP (0x7ff5580d61f0) scope
COP (0x7ff5580d5438) null [195]
LISTOP (0x7ff5580d5498) print
OP (0x7ff5580d54d8) pushmark
UNOP_AUX (0x7ff5580d5508) multiconcat [2]
OP (0x7ff5580d5548) null [3]
UNOP (0x7ff5580d55f0) null [14]
SVOP (0x7ff5580d5628) gvsv GV (0x7ff557824be0) *n
LISTOP (0x7ff5580d60a8) leave
OP (0x7ff5580d6078) enter
COP (0x7ff5580d60e8) nextstate
LISTOP (0x7ff5580d6148) print
OP (0x7ff5580d6188) pushmark
SVOP (0x7ff5580d61b8) const PV (0x7ff557824c70) "false\n"
LISTOP (0x7ff557410228) leave [1]... $n = 5 1 < $n < 10 print "$n\n"; print "false\n"; Viewer does not support full SVG 1.1
実はさらに-execオプションを付けると、Perl インタプリタ の実行順で表示されます。
$ ./perl -MO=Terse,-exec test.pl
OP (0x7fcab00b2360) enter
COP (0x7fcaafc0fa88) nextstate
SVOP (0x7fcaafc0fb28) const IV (0x7fcab00121c8) 5
SVOP (0x7fcaafc0fb98) gvsv GV (0x7fcab00121e0) *n
BINOP (0x7fcaafc0fae8) sassign
COP (0x7fcab00b23a0) nextstate
SVOP (0x7fcaafc0fa10) const IV (0x7fcab0012288) 1
SVOP (0x7fcaafc0f9d8) gvsv GV (0x7fcab00121e0) *n
UNOP (0x7fcab0017cd0) cmpchain_dup
BINOP (0x7fcab0017db8) lt
LOGOP (0x7fcab0017c60) cmpchain_and
SVOP (0x7fcab0017d80) const PVNV (0x7fcab00122b8) 10
BINOP (0x7fcab0017d40) lt
LOGOP (0x7fcab00b2438) cond_expr
OP (0x7fcab0017ad8) pushmark
SVOP (0x7fcab0017c28) gvsv GV (0x7fcab00121e0) *n
UNOP_AUX (0x7fcab0017b08) multiconcat [2]
LISTOP (0x7fcab0017a98) print
goto LISTOP (0x7fcaafc0fa48)
OP (0x7fcab00b2478) enter
COP (0x7fcab00b24e8) nextstate
OP (0x7fcab00b2588) pushmark
SVOP (0x7fcab00b25b8) const PV (0x7fcab0012270) "false\n"
LISTOP (0x7fcab00b2548) print
LISTOP (0x7fcab00b24a8) leave
LISTOP (0x7fcaafc0fa48) leave [1]
test.pl syntax OK
さらに-srcをつけると、実行したいスクリプト と合わせて表示してくれます。
$ ./perl -MO=Terse,-exec,-src test.pl
OP (0x7fc1eb81a760) enter
# 1: $n = 5;
COP (0x7fc1ea60e248) nextstate
SVOP (0x7fc1ea60e2e8) const IV (0x7fc1eb811dc8) 5
SVOP (0x7fc1ea60e358) gvsv GV (0x7fc1eb811de0) *n
BINOP (0x7fc1ea60e2a8) sassign
# 2: if (1 < $n < 10 ) {
COP (0x7fc1eb81a7a0) nextstate
SVOP (0x7fc1ea60e1d0) const IV (0x7fc1eb811e88) 1
SVOP (0x7fc1ea60e198) gvsv GV (0x7fc1eb811de0) *n
UNOP (0x7fc1eb8178d0) cmpchain_dup
BINOP (0x7fc1eb8179b8) lt
LOGOP (0x7fc1eb817860) cmpchain_and
SVOP (0x7fc1eb817980) const PVNV (0x7fc1eb811eb8) 10
BINOP (0x7fc1eb817940) lt
LOGOP (0x7fc1eb81a838) cond_expr
OP (0x7fc1eb8176d8) pushmark
SVOP (0x7fc1eb817828) gvsv GV (0x7fc1eb811de0) *n
UNOP_AUX (0x7fc1eb817708) multiconcat [2]
LISTOP (0x7fc1eb817698) print
goto LISTOP (0x7fc1ea60e208)
OP (0x7fc1eb81a878) enter
# 5: print "false\n";
COP (0x7fc1eb81a8e8) nextstate
OP (0x7fc1eb81a988) pushmark
SVOP (0x7fc1eb81a9b8) const PV (0x7fc1eb811e70) "false\n"
LISTOP (0x7fc1eb81a948) print
LISTOP (0x7fc1eb81a8a8) leave
LISTOP (0x7fc1ea60e208) leave [1]
test.pl syntax OK
こうしてみると、先程の色をつけた図となんとなく対応していそうなことがわかります。
では、上から読んでいきましょう。
まずは変数代入部分の $n = 5を見てみます。
# 1: $n = 5;
COP (0x7fc1ea60e248) nextstate
SVOP (0x7fc1ea60e2e8) const IV (0x7fc1eb811dc8) 5
SVOP (0x7fc1ea60e358) gvsv GV (0x7fc1eb811de0) *n
BINOP (0x7fc1ea60e2a8) sassign
見ると最終的に実行されるのはsassignというオペコードです。
Perl では各構文木 の構成要素として、オペコード(opcode)が存在します。
特に構文木 中で実行される関数の様な処理はPP code(push/pop code)と呼ばれる形式で表現されています。
PP codeは、Cの関数と対応している為、出てきたPP codeに対応するCの関数が実行されることがわかります。
sassignはScalar Assignのことで、Perl のスカラ変数の代入に使われます。
実際になにがなにに代入されるかというと、 $n = 5ですので、 定数の整数値であるIV (Integer Value )の5を、型グロブ(Gob Value )の*nに代入しています。
今回はmy $n = 5ではない為、レキシカルスコープが使われず、直接型グロブを操作しています。
次にif ( 1 < $n < 10)のブロックを見てみます。
# 2: if (1 < $n < 10 ) {
COP (0x7fc1eb81a7a0) nextstate
SVOP (0x7fc1ea60e1d0) const IV (0x7fc1eb811e88) 1
SVOP (0x7fc1ea60e198) gvsv GV (0x7fc1eb811de0) *n
UNOP (0x7fc1eb8178d0) cmpchain_dup
BINOP (0x7fc1eb8179b8) lt
LOGOP (0x7fc1eb817860) cmpchain_and
SVOP (0x7fc1eb817980) const PVNV (0x7fc1eb811eb8) 10
BINOP (0x7fc1eb817940) lt
LOGOP (0x7fc1eb81a838) cond_expr
OP (0x7fc1eb8176d8) pushmark
SVOP (0x7fc1eb817828) gvsv GV (0x7fc1eb811de0) *n
UNOP_AUX (0x7fc1eb817708) multiconcat [2]
LISTOP (0x7fc1eb817698) print
goto LISTOP (0x7fc1ea60e208)
実際は後半は、print文とif文の次の行に飛ぶ(elseを飛ばす)goto文の処理になっています。
if文の条件式の部分だけに絞ると、次の処理が該当します。
COP (0x7fc1eb81a7a0) nextstate
SVOP (0x7fc1ea60e1d0) const IV (0x7fc1eb811e88) 1
SVOP (0x7fc1ea60e198) gvsv GV (0x7fc1eb811de0) *n
UNOP (0x7fc1eb8178d0) cmpchain_dup
BINOP (0x7fc1eb8179b8) lt
LOGOP (0x7fc1eb817860) cmpchain_and
SVOP (0x7fc1eb817980) const PVNV (0x7fc1eb811eb8) 10
BINOP (0x7fc1eb817940) lt
雰囲気で読んでいくと、まず 1 < $nの1を定数として確保、次に$nの値を取り出します。
その後cmpchain_dupを行いltを計算します。 おそらくこのltが、1 < $nを評価している箇所ですね。
続くcmpchain_andは 1 < $n < 10なので、両方成立する必要があるためにANDの処理として連鎖比較をつなげています。
そして10を定数として取り出し、同様にltで比較しています。
構文木 レベルでは、先程出てきたcmpchain_startなどは出てきていないですが、代わりにcmpchain_dupやcmpchain_andなどが呼ばれていますね。
これは
それと実際に大小比較をしているltも気になります。
実際にこれらがどの様に動いているかを、perl インタプリタ をトレースしながら探ってみます。
perl インタプリタ のCレベルのソースコード を読むときは、実際にperl インタプリタ を動かして、トレースしながら読むのがわかりやすいです。
そのためにはまずperl をCのデバッガでデバッグ 出来るオプションを付けた状態でビルドする必要があります。
plenvでもビルドが可能ですが今回はソースコード をGitHub からcloneしてきてビルドします。
なおmacOS のBigSureではこのプルリクエストの内容 を取り込まないとビルド出来ず、次の様なエラーが出ます。
Which of these apply, if any? [darwin]
*** Unexpected product version 11.0.
***
*** Try running sw_vers and see what its ProductVersion says.
Installation failure: sh Configure -Dprefix=/Users/anatofuz/.plenv/versions/debug-32 -de -Dversiononly -DDEBUGGING=-g -Doptimize=-O0 -A'eval:scriptdir=/Users/anatofuz/.plenv/versions/debug-32/bin' at /Users/anatofuz/.plenv/plugins/perl-build/bin/perl-build line 12763.
ABORT
perl はConfigureを実行してMakefile を生成、そのMakefile を元にmakeとmake installでビルド、インストールを行います。
デバッグ ビルドする際は-DDEBUGGING=-gと、Cコンパイラ の最適化を無効化する-Doptimize=-O0を付ける必要があります。
個人的な趣味で生成したバイナリはソースコード とは別のディレクト リに置きたいので、-Dprefixでビルドした結果を置くパスを指定します。
$./Configure -DDEBUGGING=-g -Doptimize=-O0 -Dprefix=/Users/anatofuz/workspace/lang/perl/perl5-build
$make -j
$make install
ビルドが完了したら、prefixで指定したディレクト リ以下のbinディレクト リにcdします。
$cd /Users/anatofuz/workspace/lang/perl/perl5-build/bin
ビルドしたperl をCデバッガで起動します。
macOS の場合はlldb, linux の場合はgdb , もしくはlldbでperl を指定します。
今回は先程書いたプログラムを実行しているperl インタプリタ をトレースしたいので、デバッガの起動時で引数を指定する必要があります。
#lldbの場合
$lldb -- ./perl test.pl
#gdb
$gdb --args ./perl test.pl
以降のコマンドはlldbで行います。(gdb の場合は微妙に異なるところがあります)
breakpointで止める
まずは先程出てきたcmpchain_startで動きを止めてみます。
デバッガで特定の関数で処理を止めるには、 break pointを張る必要があります。
lldbでbreakpointを貼るには b 関数名と入力します。
(lldb) b cmpchain_start
Breakpoint 1: no locations (pending).
WARNING: Unable to resolve breakpoint to any actual locations.
おっと、関数が見つかりませんでした。
こういうときは焦らずPerl のCコードから関数名でgrep し、名前を探します。
$ rg cmpchain_start
perly.y
1067: { $$ = cmpchain_start($CHRELOP, $lhs, $rhs); }
1083: { $$ = cmpchain_start($CHEQOP, $lhs, $rhs); }
op.c
5490:Perl_cmpchain_start(pTHX_ I32 type, OP *left, OP *right)
proto.h
691:PERL_CALLCONV OP* Perl_cmpchain_start(pTHX_ I32 type, OP* left, OP* right)
dist/Devel-PPPort/parts/embed.fnc
1087:pR |OP* |cmpchain_start |I32 type|NULLOK OP* left \
dist/Devel-PPPort/parts/base/5031010
8:cmpchain_start # F added by devel/scanprov
embed.fnc
1105:pR |OP* |cmpchain_start |I32 type|NULLOK OP* left \
embed.h
1276:#define cmpchain_start(a,b,c) Perl_cmpchain_start(aTHX_ a,b,c)
ripgrepで検索すると、いくつかヒットしましたが、最後のマクロが怪しいです。
#define cmpchain_start(a,b,c) Perl_cmpchain_start(aTHX_ a,b,c)から察するに、cmpchain_startの正体はPerl_cmpchain_startのことでしょう。
この関数名でbreak pointを貼ってみます。
(lldb) b Perl_cmpchain_start
Breakpoint 2: where = perl`Perl_cmpchain_start + 19 at op.c:5495:10, address = 0x000000010000ede3
break pointが無事貼れました。実際にperl インタプリタ を動かして止まるかどうかを確認します。
lldbでプログラムを動かすにはprocess launchです。
(lldb) process launch
Process 99647 launched: '/Users/anatofuz/workspace/lang/perl/perl5-build/bin/perl' (x86_64)
Process 99647 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 2.1
frame #0: 0x000000010000ede3 perl`Perl_cmpchain_start(type=71, left=0x0000000100704250, right=0x0000000101011bf8) at op.c:5495:10
5492 BINOP *bop;
5493 OP *op;
5494
-> 5495 if (!left)
5496 left = newOP(OP_NULL, 0);
5497 if (!right)
5498 right = newOP(OP_NULL, 0);
Target 0: (perl) stopped.
無事止まりました!!! ここでback traceを確認してみます。
(lldb) bt
* thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 2.1
* frame #0: 0x000000010000ede3 perl`Perl_cmpchain_start(type=71, left=0x0000000100704250, right=0x0000000101011bf8) at op.c:5495:10
frame #1: 0x000000010009e0b7 perl`Perl_yyparse(gramtype=258) at perly.y:1067:43
frame #2: 0x000000010004223a perl`S_parse_body(env=0x0000000000000000, xsinit=(perl`xs_init at perlmain.c:149)) at perl.c:2557:9
frame #3: 0x0000000100040504 perl`perl_parse(my_perl=0x0000000100605d80, xsinit=(perl`xs_init at perlmain.c:149), argc=2, argv=0x00007ffeefbfe900, env=0x0000000000000000) at perl.c:1852:2
frame #4: 0x0000000100001e13 perl`main(argc=2, argv=0x00007ffeefbfe900, env=0x00007ffeefbfe918) at perlmain.c:109:10
frame #5: 0x00007fff2035a631 libdyld.dylib`start + 1
見るとmain関数を実行した後に、perl_parseが実行され、yacc で定義したPerl_yyparseが実行されています。
ここから今現在はパースの段階。つまり構文解析 中であることがわかります。
どちらかというと関心があるのは構文木 を実行しているとこですね。次はcmpchain_dupで止めてみます。
cmpchain_dup で止める
これも止めてみようとしたところ、関数が見つかりませんでした。
(lldb) b cmpchain_dup
Breakpoint 3: no locations (pending).
WARNING: Unable to resolve breakpoint to any actual locations.
これもripgrepでソースコード から探してみます。
$ rg cmpchain_dup
regen/opcodes
579:cmpchain_dup comparand shuffling ck_null 1
opcode.h
551: "cmpchain_dup",
1370: Perl_pp_cmpchain_dup,
1777: Perl_ck_null, /* cmpchain_dup */
2185: 0x00000100, /* cmpchain_dup */
2852: 0, /* cmpchain_dup */
2871: 0x0003, /* scalar, prototype, refgen, srefgen, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, pop, shift, grepstart, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, argcheck, argdefelem, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst, cmpchain_and, cmpchain_dup */
pp_proto.h
46:PERL_CALLCONV OP *Perl_pp_cmpchain_dup(pTHX);
pp.c
7186:PP(pp_cmpchain_dup)
lib/B/Op_private.pm
288:$bits{cmpchain_dup}{0} = $bf[0];
lib/B/Deparse.pm
3248: $operand->name eq "cmpchain_dup" or return "XXX";
ext/Opcode/Opcode.pm
355: cmpchain_and cmpchain_dup
なんとなく、pp.cのPP(pp_cmpchain_dup)が定義っぽい気がします。
ですがこのPPとは何でしょうか。Cの関数定義にこのようなものはないので、おそらくマクロであると推測されます。
ripgrepでPPマクロの定義を探してみます。
pp.h
11:#define PP(s) OP * Perl_##s(pTHX)
529:#define dPOPPOPssrl dPOPXssrl(POP)
530:#define dPOPPOPnnrl dPOPXnnrl(POP)
531:#define dPOPPOPiirl dPOPXiirl(POP)
pp.hに見つかりました。11行目のものがそうです。
これはマクロPP()の引数に相当するものがsになり、Cのマクロの##演算子 の効果で前後の文字列が連結されます。
例えば、PP(pp_cmpchain_and)と書かれていた場合は、 OP* Perl_pp_cmpchain_and(pTHX)の様な命名規則 の関数に展開されます。
これはOP*型の関数Perl_pp_cmpchain_andという意味になります。
展開された関数名がわかると、gdb でbreak pointを貼ることが出来ます。
実際にbreak pointを設定してみます。
(lldb) b Perl_pp_cmpchain_dup
Breakpoint 4: where = perl`Perl_pp_cmpchain_dup + 24 at pp.c:7188:5, address = 0x00000001001d8bf8
無事break pointを設定できました! 続きを実行して止まるか見てみます。
(lldb) c
Process 99647 resuming
Process 99647 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 4.1
frame #0: 0x00000001001d8bf8 perl`Perl_pp_cmpchain_dup at pp.c:7188:5
7185
7186 PP(pp_cmpchain_dup)
7187 {
-> 7188 dSP;
7189 SV *right = TOPs;
7190 SV *left = TOPm1s;
7191 TOPm1s = right;
Target 0: (perl) stopped.
無事止まりました! バックトレースを確認しましょう。
(lldb) bt
* thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 4.1
* frame #0: 0x00000001001d8bf8 perl`Perl_pp_cmpchain_dup at pp.c:7188:5
frame #1: 0x000000010016e74d perl`Perl_runops_standard at run.c:41:26
frame #2: 0x0000000100042ce1 perl`S_run_body(oldscope=1) at perl.c:2742:2
frame #3: 0x000000010004273f perl`perl_run(my_perl=0x00000001007041e0) at perl.c:2665:2
frame #4: 0x0000000100001e28 perl`main(argc=2, argv=0x00007ffeefbfe900, env=0x00007ffeefbfe918) at perlmain.c:110:9
frame #5: 0x00007fff2035a631 libdyld.dylib`start + 1
見ると先程まではmainの上はparseでしたが、parseは終了し、perl_runに移っています。
おそらくここでperl スクリプト が評価されていきます。
では、このpp_cmpchain_dupを見てみましょう。
pp_cmpchain_dup
pp_cmpchain_dup は次のような定義です。
PP(pp_cmpchain_dup)
{
dSP;
SV *right = TOPs;
SV *left = TOPm1s;
TOPm1s = right;
TOPs = left;
XPUSHs(right);
RETURN;
}
さて初手登場したdSPが最初からなんだかわかりません。
実はこれもマクロで、grep するとpp.hに次のように定義されています。
#define dSP SV **sp = PL_stack_sp
つまりdSPとは**spにPL_stack_spを代入することの様です。
ここで出てきたstackとはなんのstackなのでしょうか。
これはPerl インタプリタ が巨大なスタックを使って値をやり取りしながら計算をするというスタックマシンとして実装されていることに因んでいます。
インタプリタ 言語は基本的にはコンピューターを仮想的にソフトウェアで実装し、そのコンピューター上でアセンブラ 命令に対応するオペコードを評価してプログラムを実行するという実装方法になっています。
この仮想マシン の実装方法の1つであるスタックマシンでは、サブルーチンに必要な引数の受け渡しや、返り値の処理などを巨大なスタックに値を積んだり取り出したりして表現しています。
スタックマシンは多くのスクリプト言語 の実装で採用されている方法ですが、現実の僕たちが利用しているコンピューターのように、レジスタ と呼ばれる変数を利用した実装手法もあります。
レジスタ マシンはRaku(Perl6)などで採用されています。
Perl5もスタックマシンであるので、スタックの操作に関するAPI が多数備わっています。
PL_stack_spはスタックの先頭を示すポインタ(スタックポインタ)で、これはグローバルな変数になっています。
Perl では各オペコードの処理の度に、一度スタックポインタをローカルな変数spに代入して操作するようにしています。
続くSV *right = TOPsですが、これはSV型のポインタ変数rightにTOPsの結果を代入しています。
当然(?)TOPsもマクロです。
#define TOPs (*sp)
#define TOPm1s (*(sp-1))
#define TOPp1s (*(sp+1))
みるとスタックポインタ(sp)の操作となっています。
TOPsはスタックポインタが指す値を、TOPm1sは、スタックを1段下げたとこにある値を取り出しています。
今回はTOPsなどを使い、rightとleftに値を代入しています。
SV *right = TOPs;
SV *left = TOPm1s;
実際にnextして代入した後、これらの変数になにが入ってるかを見てみます。
(lldb) p right
(SV *) $0 = 0x0000000100824428
(lldb) p *right
(SV) $1 = {
sv_any = 0x0000000100824418
sv_refcnt = 1
sv_flags = 4353
sv_u = {
svu_pv = 0x0000000000000005 ""
svu_iv = 5
svu_uv = 5
svu_nv = 2.4703282292062327E-323
svu_rv = 0x0000000000000005
svu_array = 0x0000000000000005
svu_hash = 0x0000000000000005
svu_gp = 0x0000000000000005
svu_fp = 0x0000000000000005
}
}
普通にprintすると、rightはポインタなのでアドレスが出ます。デリファレンス してもSVであることはわかりますが、具体的な値はわかりません。
SVはPerl のすべての値の元となる構造体ですが、SV自体にはGC で利用するリファレンスカウントと、実際の値へのポインタが含まれています。
SVが握っている実際の値は、このポインタをSVが実際に持っている値の型(整数値など)でキャストすると確認することが出来ます。
具体的な値を探すには、SVの中で具体的にどういう型かを調査する必要があります。
SVの中での型を調査する際は、次のようなマクロを使います。
#define SvTYPE(sv) ((svtype)((sv)->sv_flags & SVTYPEMASK))
残念ながらlldbではマクロを呼び出せないので、マクロに対応しているものを手で書きます。
((svtype)(right)->sv_flags & 0xff)
打ってみます
(lldb) p ((svtype)(right)->sv_flags & 0xff)
(unsigned int) $2 = 1
1と出ました。この1は何かというと、sv.hで定義されているenum です。
このenum がSVの中に入れることが出来る値の型のリストとなっています。
typedef enum {
SVt_NULL,
SVt_IV,
SVt_NV,
SVt_PV,
SVt_INVLIST,
SVt_PVIV,
SVt_PVNV,
SVt_PVMG,
SVt_REGEXP,
SVt_PVGV,
SVt_PVLV,
SVt_PVAV,
SVt_PVHV,
SVt_PVCV,
SVt_PVFM,
SVt_PVIO,
SVt_LAST
} svtype;
ということなのでSVt_IVです。IVは整数値ですね。
実際の値の型はこの_以降の文字列にXPなどを加えた名前になっています。
IVの場合はXPVIVという型が実際の値を持っています。
まずsv_anyというフィールドが各型のポインタなので、これを今確認したいsvの型のポインタ型でキャストします。
(lldb) p (XPVIV*)right->sv_any
(XPVIV *) $3 = 0x0000000100824418
先頭に*をつけてデリファレンス すると中身が見れます。
(lldb) p *(XPVIV*)right->sv_any
(XPVIV) $4 = {
xmg_stash = 0x0000800900000004
xmg_u = {
xmg_magic = 0x0000000101104370
xmg_hash_index = 4312810352
}
xpv_cur = 4303504408
xpv_len_u = {
xpvlenu_len = 18695992639489
xpvlenu_rx = 0x0000110100000001
}
xiv_u = {
xivu_iv = 5
xivu_uv = 5
xivu_namehek = 0x0000000000000005
xivu_eval_seen = true
}
}
同様にleftも見ます
(lldb) p *(XPVIV*)left->sv_any
(XPVIV) $6 = {
xmg_stash = 0x0000110100000001
xmg_u = {
xmg_magic = 0x0000000000000005
xmg_hash_index = 5
}
xpv_cur = 4303504432
xpv_len_u = {
xpvlenu_len = 576760923272773633
xpvlenu_rx = 0x0801110100000001
}
xiv_u = {
xivu_iv = 1
xivu_uv = 1
xivu_namehek = 0x0000000000000001
xivu_eval_seen = true
}
}
xiv_uの中のxivu_ivが値なので、ここをみるとrightは5, leftは1が入っています。
今回実行しているスクリプト はif (1 < $n < 10 ) と指定しており、$nには5を代入しています。
つまり今は1 < $nの部分を評価しにいっており、 <から見て左のtermが1, 右のtermが$nですので、それぞれleft, rightに入っています。
雰囲気がわかったところで、再びcmpchain_dupの実装を見てみます。
PP(pp_cmpchain_dup)
{
dSP;
SV *right = TOPs;
SV *left = TOPm1s;
TOPm1s = right;
TOPs = left;
XPUSHs(right);
RETURN;
}
みるとTOPm1sとTOPsにrightとleftを代入しています。
再代入っぽいですが、よく見ると先程TOPsの結果を代入したのはrightであるので、よく見ると値の交換をしています。
Perl っぽく書くと、スタックはこの様に切り替わっています。なおスタックポインタはPerl のこの表記の場合、最後の要素($sp[-1])と思ってください。
@sp = ($left (1 ), $right (5 ));
@sp = ($sp[ 1 ] , $sp[ 0 ] );
さらにこのあとrightをXPUSHsしています。これはスタックのpushに相当しています。
#define XPUSHs(s) STMT_START { EXTEND(sp,1); *++sp = (s); } STMT_END
実際にスタックがどの様に変わるか見てみましょう。
スタックの先頭はspが握っているのでした。
そのためスタックに値をpushすると、先頭が切り替わるはずです。
(lldb) n
Process 7847 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x00000001001d8c2d perl`Perl_pp_cmpchain_dup at pp.c:7193:5
7190 SV *left = TOPm1s;
7191 TOPm1s = right;
7192 TOPs = left;
-> 7193 XPUSHs(right);
7194 RETURN;
7195 }
7196
Target 0: (perl) stopped.
(lldb) p *sp
(SV *) $15 = 0x0000000102012840
この次点でspの指す値はアドレス0x0000000102012840です。
XPUSHs実行後はどうなっているでしょうか。
(lldb) n
Process 7847 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x00000001001d8c96 perl`Perl_pp_cmpchain_dup at pp.c:7194:5
7191 TOPm1s = right;
7192 TOPs = left;
7193 XPUSHs(right);
-> 7194 RETURN;
7195 }
7196
7197 /*
Target 0: (perl) stopped.
(lldb) p *sp
(SV *) $17 = 0x0000000102012828
おっとアドレスが変わっていますね。
ここでおもむろにspの前後の値を確認してみます。
(lldb) p *(sp+1)
(SV *) $19 = 0x0000000000000000
(lldb) p *(sp-1)
(SV *) $20 = 0x0000000102012840
sp+1の場所はまだ使用していないため0x00と表示されています。反対にsp-1の場合は既にアドレスが設定されています。
しかもこの*(sp-1)のアドレスは、XPUSHs実行前のアドレスとなっています。
ということで、しっかりスタックへのpushがされているようです。
ちなみに値を見てみると、rightの値である5が入っていました。
(lldb) p *(XPVIV*)(*(sp))->sv_any
(XPVIV) $21 = {
xmg_stash = 0x0000800900000004
xmg_u = {
xmg_magic = 0x0000000101804cb0
xmg_hash_index = 4320152752
}
xpv_cur = 4328597528
xpv_len_u = {
xpvlenu_len = 18695992639489
xpvlenu_rx = 0x0000110100000001
}
xiv_u = {
xivu_iv = 5
xivu_uv = 5
xivu_namehek = 0x0000000000000005
xivu_eval_seen = true
}
}
さて、なぜわざわざ値を入れ替えた上にpushする必要があったのでしょうか。それは次に実行されるppコードを見るとわかります。
pp_ltをみる
cmpchain_dupは最後に RETURNをしていたので、nextをして次の式に移動します。
(lldb) n
Process 7847 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x000000010016e74d perl`Perl_runops_standard at run.c:41:26
38 {
39 OP *op = PL_op;
40 PERL_DTRACE_PROBE_OP(op);
-> 41 while ((PL_op = op = op->op_ppaddr(aTHX))) {
42 PERL_DTRACE_PROBE_OP(op);
43 }
44 PERL_ASYNC_CHECK();
Target 0: (perl) stopped.
backtrace的には1つ上に戻りました。
このwhile文でpp codeが評価されているようです。
sと押すと関数の中に入れるので入ってみます。
(lldb) s
Process 7847 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step in
frame #0: 0x00000001001bb0e1 perl`Perl_pp_lt at pp.c:2063:5
2060
2061 PP(pp_lt)
2062 {
-> 2063 dSP;
2064 SV *left, *right;
2065 U32 flags_and, flags_or;
2066
Target 0: (perl) stopped.
sしたところpp_ltに入りました。
pp_ltはおそらく 1 < 5を実際に評価する箇所でしょう。
nと押し続けると、スタックから値を取り出してくる箇所が出てきます。
(lldb) n
Process 7847 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x00000001001bb0e8 perl`Perl_pp_lt at pp.c:2067:5
2064 SV *left, *right;
2065 U32 flags_and, flags_or;
2066
-> 2067 tryAMAGICbin_MG(lt_amg, AMGf_numeric);
2068 right = POPs;
2069 left = TOPs;
2070 flags_and = SvFLAGS(left) & SvFLAGS(right);
Target 0: (perl) stopped.
(lldb) n
Process 7847 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x00000001001bb14d perl`Perl_pp_lt at pp.c:2068:13
2065 U32 flags_and, flags_or;
2066
2067 tryAMAGICbin_MG(lt_amg, AMGf_numeric);
-> 2068 right = POPs;
2069 left = TOPs;
2070 flags_and = SvFLAGS(left) & SvFLAGS(right);
2071 flags_or = SvFLAGS(left) | SvFLAGS(right);
次にright = POPsが実行されようとしています。
Perl のPOPと同じと考えると、right = POPsが実行されると、スタックが破壊的に変更されると思われます。
とりあえず現状のスタックを確認してみましょう。
(lldb) p *(XPVIV*)(*(sp))->sv_any
(XPVIV) $31 = {
xmg_stash = 0x0000800900000004
xmg_u = {
xmg_magic = 0x0000000101204340
xmg_hash_index = 4313858880
}
xpv_cur = 4320283672
xpv_len_u = {
xpvlenu_len = 18695992639489
xpvlenu_rx = 0x0000110100000001
}
xiv_u = {
xivu_iv = 5
xivu_uv = 5
xivu_namehek = 0x0000000000000005
xivu_eval_seen = true
}
}
(lldb) p *(XPVIV*)(*(sp-1))->sv_any
(XPVIV) $32 = {
xmg_stash = 0x0000110100000001
xmg_u = {
xmg_magic = 0x0000000000000005
xmg_hash_index = 5
}
xpv_cur = 4320283696
xpv_len_u = {
xpvlenu_len = 576760923272773633
xpvlenu_rx = 0x0801110100000001
}
xiv_u = {
xivu_iv = 1
xivu_uv = 1
xivu_namehek = 0x0000000000000001
xivu_eval_seen = true
}
}
(lldb) p *(XPVIV*)(*(sp-2))->sv_any
(XPVIV) $33 = {
xmg_stash = 0x0000800900000004
xmg_u = {
xmg_magic = 0x0000000101204340
xmg_hash_index = 4313858880
}
xpv_cur = 4320283672
xpv_len_u = {
xpvlenu_len = 18695992639489
xpvlenu_rx = 0x0000110100000001
}
xiv_u = {
xivu_iv = 5
xivu_uv = 5
xivu_namehek = 0x0000000000000005
xivu_eval_seen = true
}
}
現状は先程の最後の状況と同じですね。つまりこういう状況です。
@sp = (5, 1, 5)
ここで先頭をPOPし、TOPを代入したあとまで進めます。
(lldb) f
frame #0: 0x00000001001bb14d perl`Perl_pp_lt at pp.c:2068:13
2065 U32 flags_and, flags_or;
2066
2067 tryAMAGICbin_MG(lt_amg, AMGf_numeric);
-> 2068 right = POPs;
2069 left = TOPs;
2070 flags_and = SvFLAGS(left) & SvFLAGS(right);
2071 flags_or = SvFLAGS(left) | SvFLAGS(right);
(lldb) n
Process 9019 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x00000001001bb166 perl`Perl_pp_lt at pp.c:2069:13
2066
2067 tryAMAGICbin_MG(lt_amg, AMGf_numeric);
2068 right = POPs;
-> 2069 left = TOPs;
2070 flags_and = SvFLAGS(left) & SvFLAGS(right);
2071 flags_or = SvFLAGS(left) | SvFLAGS(right);
2072
Target 0: (perl) stopped.
(lldb) n
Process 9019 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x00000001001bb171 perl`Perl_pp_lt at pp.c:2070:17
2067 tryAMAGICbin_MG(lt_amg, AMGf_numeric);
2068 right = POPs;
2069 left = TOPs;
-> 2070 flags_and = SvFLAGS(left) & SvFLAGS(right);
2071 flags_or = SvFLAGS(left) | SvFLAGS(right);
2072
2073 SETs(boolSV(
Target 0: (perl) stopped.
(lldb)
rightとleftを確認します。
(lldb) p *(XPVIV*)(*(right)).sv_any
(XPVIV) $35 = {
xmg_stash = 0x0000800900000004
xmg_u = {
xmg_magic = 0x0000000101204340
xmg_hash_index = 4313858880
}
xpv_cur = 4320283672
xpv_len_u = {
xpvlenu_len = 18695992639489
xpvlenu_rx = 0x0000110100000001
}
xiv_u = {
xivu_iv = 5
xivu_uv = 5
xivu_namehek = 0x0000000000000005
xivu_eval_seen = true
}
}
(lldb) p *(XPVIV*)(*(left)).sv_any
(XPVIV) $36 = {
xmg_stash = 0x0000110100000001
xmg_u = {
xmg_magic = 0x0000000000000005
xmg_hash_index = 5
}
xpv_cur = 4320283696
xpv_len_u = {
xpvlenu_len = 576760923272773633
xpvlenu_rx = 0x0801110100000001
}
xiv_u = {
xivu_iv = 1
xivu_uv = 1
xivu_namehek = 0x0000000000000001
xivu_eval_seen = true
}
}
leftには1, rightには5が入っています。
そしてスタックポインタspの値を確認します。
(lldb) p *(XPVIV*)(*(sp))->sv_any
(XPVIV) $38 = {
xmg_stash = 0x0000110100000001
xmg_u = {
xmg_magic = 0x0000000000000005
xmg_hash_index = 5
}
xpv_cur = 4320283696
xpv_len_u = {
xpvlenu_len = 576760923272773633
xpvlenu_rx = 0x0801110100000001
}
xiv_u = {
xivu_iv = 1
xivu_uv = 1
xivu_namehek = 0x0000000000000001
xivu_eval_seen = true
}
}
(lldb) p *(XPVIV*)(*(sp-1))->sv_any
(XPVIV) $40 = {
xmg_stash = 0x0000800900000004
xmg_u = {
xmg_magic = 0x0000000101204340
xmg_hash_index = 4313858880
}
xpv_cur = 4320283672
xpv_len_u = {
xpvlenu_len = 18695992639489
xpvlenu_rx = 0x0000110100000001
}
xiv_u = {
xivu_iv = 5
xivu_uv = 5
xivu_namehek = 0x0000000000000005
xivu_eval_seen = true
}
}
(lldb) p *(XPVIV*)(*(sp-2))->sv_any
error: Couldn't apply expression side effects : Couldn't dematerialize a result variable: couldn't read its memory
つまり現在spとleftは同じ場所を刺しており、sp-1の箇所に5があります。
perl で書くと 現在のスタックは(5, 1)という感じでしょうか。
ちなみにfreeしていないので、spに1を足すと、rightが見れます。
(lldb) p *(XPVIV*)(*(sp+1))->sv_any
(XPVIV) $42 = {
xmg_stash = 0x0000800900000004
xmg_u = {
xmg_magic = 0x0000000101204340
xmg_hash_index = 4313858880
}
xpv_cur = 4320283672
xpv_len_u = {
xpvlenu_len = 18695992639489
xpvlenu_rx = 0x0000110100000001
}
xiv_u = {
xivu_iv = 5
xivu_uv = 5
xivu_namehek = 0x0000000000000005
xivu_eval_seen = true
}
}
ここで処理を進めてみます。
(lldb) n
Process 7847 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x00000001001bb193 perl`Perl_pp_lt at pp.c:2073:5
2070 flags_and = SvFLAGS(left) & SvFLAGS(right);
2071 flags_or = SvFLAGS(left) | SvFLAGS(right);
2072
-> 2073 SETs(boolSV(
2074 ( (flags_and & SVf_IOK) && ((flags_or & SVf_IVisUV) ==0 ) )
2075 ? (SvIVX(left) < SvIVX(right))
2076 : (flags_and & SVf_NOK)
Target 0: (perl) stopped.
(lldb) n
Process 7847 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x00000001001bb26d perl`Perl_pp_lt at pp.c:2080:5
2077 ? (SvNVX(left) < SvNVX(right))
2078 : (do_ncmp(left, right) == -1)
2079 ));
-> 2080 RETURN;
2081 }
2082
2083 PP(pp_gt)
Target 0: (perl) stopped.
なにか計算が行われ、結果をRETURNするとこになりました。
この次点でのスタックの中身を確認します。
(lldb) p *(XPVIV*)(*(sp))->sv_any
(XPVIV) $22 = {
xmg_stash = 0x0000000000000000
xmg_u = {
xmg_magic = 0x0000000000000000
xmg_hash_index = 0
}
xpv_cur = 1
xpv_len_u = {
xpvlenu_len = 0
xpvlenu_rx = 0x0000000000000000
}
xiv_u = {
xivu_iv = 1
xivu_uv = 1
xivu_namehek = 0x0000000000000001
xivu_eval_seen = true
}
}
(lldb) p *(XPVIV*)(*(sp-1))->sv_any
(XPVIV) $23 = {
xmg_stash = 0x0000800900000004
xmg_u = {
xmg_magic = 0x0000000101804cb0
xmg_hash_index = 4320152752
}
xpv_cur = 4328597528
xpv_len_u = {
xpvlenu_len = 18695992639489
xpvlenu_rx = 0x0000110100000001
}
xiv_u = {
xivu_iv = 5
xivu_uv = 5
xivu_namehek = 0x0000000000000005
xivu_eval_seen = true
}
}
stackの先頭のxivu_ivは1なので、値が変わらない様な気がしますが、よく見ると外のメンバのアドレスが異なっています。
実はこれはもともと入っていた、整数値としての1ではなく、 1 < $nがtrueだったということを示す1です。
そのため、ltの計算が行われる直前の(5, 1)というstackは(5, true)の様なstackに書き換わってしまったのです。
こう考えると、先程cmpchain_dupでrightをPUSHしていた理由がなんとなくわかるのではないでしょうか。
そうです。ltの計算をしてしまうと、1 < $nのleft, rightそれぞれがスタックから無くなってしまい、ltの計算結果が成功/失敗したかの値がスタックに入ってしまいます。
ltの計算結果が成功(true, 1)の場合、次の比較である $n < 10に進みますが、この計算をしようとした際に、スタックから$nがltの計算で落とされているので、$nの値がなんだかわからなくなってしまうのです。その為にあえて$nに該当する値をXPUSHsで再度スタックに入れて、次のltの計算で取り出せるようにしています。
連鎖比較の実装で既存のPerl インタプリタ にそこまで手を加えないようにしつつ変更する為に、こういったスタックのhackが行われています。
ちなみにこの$nが5になっていたことから分かる通り、連鎖比較では数値を求めた状態で比較が行われます。
そのため、連鎖比較の真ん中に副作用を含む関数を挟んでも、2回評価はされません。
例えば次の様なスクリプト を書いてみます。 (
#!/usr/bin/env perl
use strict ;
use warnings ;
sub increment {
my $i = shift ;
$$i ++;
}
my $a = 10 ;
my $b = 20 ;
my $c = 30 ;
if ($a < increment(\$b ) < $c ){
}
print $b ;
この場合はincrement(\$b)として$bのリファレンスを渡している為、2回評価されると$bの値は22になるはずですが、実際は1度の評価しかされないので21になっています。
おわりに
ということでデバッガを使ってPerl のインタプリタ を見てみました。
インタプリタ 、なんとなく読めそうな気がしてきますよね。
普段のスクリプト のプログラミングに飽きたら、ちょっと低レイヤー触ってみませんか?
明日はみけねこ さんで「cpanmの--test-onlyでサーバーを壊した話」です
参考資料
id:tomcha0079