この記事は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を評価することはあまりしません
- Perlの場合はopcodeと呼ばれる抽象構文木に最初のコンパイルされます
- 単純にバイトコードとも呼びます
その後opcodeの命令の長さを短くしたり、 最適な命令にすり替えて、関数や演算子などの計算のopcodeに対応するppcode(push/pop code)形式にコンパイルされます
- 最終的にはこのppcodeが実行されます
バイトコードに変換するのは高速化と効率化の為です。(実際の速度などはバイトコード自体やバイトコードを解釈する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 /* $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)); }
コメントからなんとなく雰囲気がわかるかと思いますが、 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 == '=') { /* was this !=~ where !~ was meant? * warn on m:!=~\s+([/?]|[msy]\W|tr\W): */ 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の中を見て演算子を特定したところ、次の様な対応になっていました。
...確かにこう見ると ソートのときなどに順序を決定する宇宙船演算子 <=> は連鎖させることができなさそうですね。(そもそも連鎖させないとは思いますが)
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"
生成された構文木を見ると、大きく次のブロックに分割されます。
実はさらに-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をデバッグビルドする
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, /* 0 */ /* BIND was here, before INVLIST replaced it. */ SVt_IV, /* 1 */ SVt_NV, /* 2 */ /* RV was here, before it was merged with IV. */ SVt_PV, /* 3 */ SVt_INVLIST, /* 4, implemented as a PV */ SVt_PVIV, /* 5 */ SVt_PVNV, /* 6 */ SVt_PVMG, /* 7 */ SVt_REGEXP, /* 8 */ /* PVBM was here, before BIND replaced it. */ SVt_PVGV, /* 9 */ SVt_PVLV, /* 10 */ SVt_PVAV, /* 11 */ SVt_PVHV, /* 12 */ SVt_PVCV, /* 13 */ SVt_PVFM, /* 14 */ SVt_PVIO, /* 15 */ /* 16-31: Unused, though one should be reserved for a * freed sv, if the other 3 bits below the flags ones * get allocated */ SVt_LAST /* keep last in enum. used to size arrays */ } 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, $left)
さらにこのあと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回評価はされません。
例えば次の様なスクリプトを書いてみます。 (
id:tomcha0079さんが実際にはかかれたコードです! 使わせてもらいます!)
#!/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でサーバーを壊した話」です
