はじめに
こんにちはid:anatofuzです. これはPerl Advent Calendar 2018 1日目の記事です.
なぜ僕が初日を担当しているかというと以下のような経緯です.
Perlアドベントカレンダーday 2,3,4,5が空いているのでそれぞれPerl2,Perl3,Perl4,Perl5.0を動かす話を乗せれば良いんですか
— 八雲アナグラ (@AnaTofuZ) 2018年11月2日
day 1 お譲りしますよ!?
— kobaken (@kfly8) 2018年11月3日
空けてしまいました(悪人)
— kobaken (@kfly8) 2018年11月3日
...というわけで id:kfly8 さんの思惑で(?)トップバッターになりました. よろしくお願いします.
さて,初日なのですが, 当初の予定通りPerl1.0を動かす話にしようかな...とは思ったのですが 実際の所Perl1.0に関しては謎のPerlハッカーがメンテナンスを行っており, 現在難なくビルドする事が可能です.
以前はbitbcketにchastaiさんという方がリポジトリを上げていましたが,アカウントごと消えてしまい, 現在僕がforkしたリポジトリをgithubにあげています.
この「Renovation of Perl 1.0」はほぼPerl1.0の動きを維持しているので, 当時のLarryが書いたコードの雰囲気を読むことが出来ます.
実際にどのような修正で現代にPerl1.0が蘇ったかは,またの機会にお話するとして,今回はPerl1.0の動作を見ていこうと思います.
プログラミング言語処理系を読んでみよう
Perl1.0はC言語で書かれています. 動作を見るには実際に書かれたCプログラムを読むのが1番ですね. Cで書かれているので,このプログラムを読むとすると, Cのファイルをvimなどのエディタで開き,どういう処理をしているか先頭から見る……という技を想像するでしょうか.
初見のプログラム, ましてやPerlなどのちょっと大規模なプログラムの場合ソースコードをただ眺めても動きが見えない事があります.
こういう時は,Cコンパイラにデバッグオプションを付けてbuildする事で, gdbなどのデバッガでデバッグを可能にし, デバッガを利用してトレースしながら読むのがおすすめです.
ではPerl1.0のトレースをしてみましょう.
トレース準備
今回の動作環境は次の通りです
clangとlldbを使うのは,MacOSのデフォルトコンパイラがLLVMというコンパイラ基盤をバックエンドとしたclangであり, LLVMプロジェクトのデフォルトデバッガがlldbだからです.
linux環境の方の場合は, 同様にllvm/clangとlldbをお使いになるか, gcc/gdbなどをお使いになると同様の事が可能です.
- まずはPerl1.0のソースをcloneしましょう.
$ git clone git@github.com:AnaTofuZ/Perl-1.0.git
$ cd Perl-1.0
- 次に
Configure
を実行します.これはmakedependやMakefileを環境に合わせて作成するものです.
$ ./Configure
いろいろ聞かれますが大体画面に出てる通りにエンターを押し続ければなんとかなります.
次にMakefileをエディタで開きます.
- この際にCコンパイラがデバッグ出来るようにgオプションを, トレースをする為に最適化を無効にするO0をつけます.
- MakefileのCFLAGSを次の様に修正します.
CFLAGS = -W -Wall -Wformat=2 -Wshadow -O0 -g
- ここまで出来たらmakeしましょう
$ make
- ここまでするとカレントディレクトリに
perl
というバイナリが生成されています- 試しに
lldb ./perl
と入力しl main
などでmain関数が見れるか確認します
- 試しに
~/w/p/a/Perl-1.0 » lldb ./perl (lldb) target create "./perl" Current executable set to './perl' (x86_64). (lldb) l main File: /Users/anatofuz/workspace/perl/adventcal/Perl-1.0/./perly.c 65 #define TMPPATH "/tmp/perl-eXXXXXX" 66 char *e_tmpname; 67 FILE *e_fp = Nullfp; 68 ARG *l(); 69 70 main(argc,argv,env) 71 register int argc; 72 register char **argv; 73 register char **env; 74 { 75 register STR *str;
- この表示が出れば完了です!
- オブジェクトファイルなどは余計なので
make clean
してみましょう
Perl1.0のトレース
ではPerl1.0のトレース環境が整ったのでPerl1.0を読んでいましょう. 今回ターゲットにするのはスカラー型の代入 です.
配列まで追いたい気持ちもありますが, ちょっと長くなるので今回はスカラ変数だけ見てみます. いやハッシュやリファレンスは?とお思いの方もいらっしゃると思いますが,この当時のハッシュは試験段階としての運用であり, リファレンスはそもそも存在しません.
という訳で,今回Perl1.0に実行してもらうコードは次のようなものです.
$hoge = "hello"; print "$hoge\n"; # hello
これは $hoge
に helloをいれ出力する例ですね.
代入なので, 実はprintは読みません.
試しに実行してみましょう
$./perl examle/test.pl
hello
無事出力されましたね! では実際にトレースしていきましょう
main関数を見る
では実際にスカラ変数の代入が行われている箇所を見ていきましょう.
lldbでデバッグするバイナリに引数を与えるには --
を使います.
~/w/p/a/Perl-1.0 » lldb -- ./perl examle/test.pl (lldb) target create "./perl" Current executable set to './perl' (x86_64). (lldb) settings set -- target.run-args "examle/test.pl"
target.run-args
として example/test.pl
が設定されている事がわかります.
では, 実際に先程のhelloが出力されるか確認しましょう.
lldbでデバッグ対象を実行するには process launch
を使います.
(lldb) process launch Process 44366 launched: './perl' (x86_64) hello Process 44366 exited with status = 0 (0x00000000)
無事出力されましたね!!
まずはとりあえず, Perl1.0の実装はC言語なのでmain関数から見てみましょう. デバッガで関数で動きを止めるには,break pointを関数にかけます.
この時,すでに1回走らせているので, 再び動かす r
で動かします.
(lldb) b main Breakpoint 1: where = perl`main + 29 at perly.c:78, address = 0x0000000100018dbd (lldb) r Process 44906 launched: './perl' (x86_64) Process 44906 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 1.1 frame #0: 0x0000000100018dbd perl`main(argc=2, argv=0x00007ffeefbff478, env=0x00007ffeefbff490) at perly.c:78 75 register STR *str; 76 register char *s; 77 -> 78 uid = (int)getuid(); 79 euid = (int)geteuid(); 80 linestr = str_new(80); 81 str = str_make("-I/usr/lib/perl "); /* first used for -I flags */ Target 0: (perl) stopped.
すると次の様な表示で止まると思います. これがPerl1.0のCのmain関数となっています.
frame情報の部分を読んでみると, Perl1.0のmain関数はperly.cというファイルの78行目で書かれている事がわかります.
lldbなどのデバッガでは ->
が書かれている場所が,次に実行する関数を意味します.
その右の数字はソースコードの行数です.
ここの75,76行目では register
というキーワードが使われています.
これは「できるだけ実マシンのレジスタにこの変数をマッピングしてくれ!!!!!!!!!!!」というお気持ちです.C++の世界ではC++11から非推奨になったらしいです.
さて,ここに出ているmain関数を読んでみると
「とりあえずuidとeuidを保存して -I/usr/lib/perl
をオブジェクトとして生成し, strに保存している」
みたいな事がわかります.
この str_make
関数で生成するオブジェクトはSTRという構造体ですが, これがPerl1.0におけるスカラ変数の正体です.
では, 関数実行を進めて, 与えられたPerlプログラムファイルを読み取り, スカラ変数を生成する所まで行ってみましょう.
関数実行を進めるには n
を押します.
init_eval
ひたすら n
していくと突然 init_eval
などという如何にもevalの準備をしていそうな関数が登場します
(lldb) Process 45227 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step over frame #0: 0x000000010001929d perl`main(argc=1, argv=0x00007ffeefbff480, env=0x00007ffeefbff490) at perly.c:160 157 158 str_set(&str_no,No); 159 str_set(&str_yes,Yes); -> 160 init_eval(); 161 162 /* open script */ 163 Target 0: (perl) stopped.
->
が指す関数の中に入るには step
とタイプします
(lldb) Process 46172 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step over frame #0: 0x000000010001929d perl`main(argc=1, argv=0x00007ffeefbff480, env=0x00007ffeefbff490) at perly.c:160 157 158 str_set(&str_no,No); 159 str_set(&str_yes,Yes); -> 160 init_eval(); 161 162 /* open script */ 163 Target 0: (perl) stopped. (lldb) step Process 46172 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step in frame #0: 0x00000001000051fb perl`init_eval at arg.c:1235 1232 register int i; 1233 1234 #define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2)) -> 1235 opargs[O_ITEM] = A(1,0,0); 1236 opargs[O_ITEM2] = A(0,0,0); 1237 opargs[O_ITEM3] = A(0,0,0); 1238 opargs[O_CONCAT] = A(1,1,0); Target 0: (perl) stopped.
すると init_eval
の中に入る事が出来ます.
init_eval
では 配列 opargs
にマクロAを利用して値を初期化している様に見えます.
では何が代入されるのでしょうか.
O_ITEM
などはマクロの様です. このマクロは arg.h
で定義されています
#define O_NULL 0 #define O_ITEM 1 #define O_ITEM2 2 #define O_ITEM3 3 #define O_CONCAT 4 #define O_MATCH 5 #define O_NMATCH 6 #define O_SUBST 7
なるほど O_ITEM
は1の様です.
では, この代入の前後で値がどの様に変わるか見てみましょう.
変数を見るには p
を使います
(lldb) step Process 46426 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step in frame #0: 0x00000001000051fb perl`init_eval at arg.c:1235 1232 register int i; 1233 1234 #define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2)) -> 1235 opargs[O_ITEM] = A(1,0,0); 1236 opargs[O_ITEM2] = A(0,0,0); 1237 opargs[O_ITEM3] = A(0,0,0); 1238 opargs[O_CONCAT] = A(1,1,0); Target 0: (perl) stopped. (lldb) p opargs[1] (char) $2 = '\0'
代入前は0が入っているようです.
(lldb) n Process 46426 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step over frame #0: 0x00000001000051ff perl`init_eval at arg.c:1236 1233 1234 #define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2)) 1235 opargs[O_ITEM] = A(1,0,0); -> 1236 opargs[O_ITEM2] = A(0,0,0); 1237 opargs[O_ITEM3] = A(0,0,0); 1238 opargs[O_CONCAT] = A(1,1,0); 1239 opargs[O_MATCH] = A(1,0,0); Target 0: (perl) stopped. (lldb) p opargs[1] (char) $3 = '\x01'
一つ進めると \x01
が代入されている事がわかります.
この O_ITEM
などは実はPerl1.0のオペタイプと呼ばれるものです.
これはPerlが実行するPerlVMのアセンブリの様なものです.
完全なバイトコードインタプリタとなったPerl5と比較すると粒度がほぼPerlの文法と対応しています. 例えば次のようなオペタイプが存在します.
#define O_PUSH 42 #define O_POP 43 #define O_SHIFT 44
Perl1.0ではこのオペタイプに対応した番号で並んでいる配列opnameが存在します. このopnameにはオペタイプの名前が入っています.
char *opname[] = { "NULL", "ITEM", "ITEM2", "ITEM3", "CONCAT", "MATCH", "NMATCH", "SUBST", "NSUBST", "ASSIGN", "MULTIPLY", "DIVIDE", "MODULO", "ADD",
この opname
などは実際にPerlが与えられたプログラムを解釈する eval
という関数で利用します.
yaccのぞき見
Perl1.0が与えられたプログラムをオペタイプに分解して解釈していそう.ということまでは探検しました. では, Perl1.0はプログラムをどの様に分解しているのでしょうか.
実はこの分解に関してはPerl5と同じyaccと呼ばれるプログラムを利用しています. yaccとはコンパイラコンパイラとも言われ, コンパイラの構文解析というフェーズを担当し,プログラムがどのような表現になっているか木構造に変換してくれます.
自然言語処理の文脈では構文解析などと呼ばれるフェーズですね.
Perl1.0におけるYACCは perl.y
というファイルで定義されています.
ちょっと読んでみると
char *tokename[] = { "256", "word", "append","open","write","select","close","loopctl", "using","format","do","shift","push","pop","chop", "while","until","if","unless","else","elsif","continue","split","sprintf", "for", "eof", "tell", "seek", "stat", "function(no args)","function(1 arg)","function(2 args)","function(3 args)","array function", "join", "sub", "file test", "format lines", "register","array_length", "array", "s","pattern", "string","y", "print", "unary operation", "..", "||", "&&", "==","!=", "EQ", "NE", "<=",">=", "LT", "GT", "LE", "GE", "<<",">>", "=~","!~", "unary -", "++", "--", "???" }; %}
以下にもトークンっぽいものが定義されていますが, 実はこれはyacc側では利用しません. yaccで利用するトークンは次のものです.
%token <cval> WORD %token <ival> APPEND OPEN WRITE SELECT CLOSE LOOPEX %token <ival> USING FORMAT DO SHIFT PUSH POP CHOP %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT SPRINTF %token <ival> FOR FEOF TELL SEEK STAT_ %token <ival> FUNC0 FUNC1 FUNC2 FUNC3 STABFUN %token <ival> JOIN SUB FILETEST %token <formval> FORMLIST %token <stabval> REG ARYLEN ARY %token <arg> SUBST PATTERN %token <arg> RSTRING TRANS %type <ival> prog decl format %type <cmdval> block lineseq line loop cond sideff nexpr else %type <arg> expr sexpr term %type <arg> condmod loopmod cexpr %type <arg> texpr print %type <cval> label %type <compval> compblock %nonassoc <ival> PRINT %left ',' %nonassoc <ival> UNIOP %right '=' %right '?' ':' %nonassoc DOTDOT %left OROR %left ANDAND %left '|' '^' %left '&' %nonassoc EQ NE SEQ SNE %nonassoc '<' '>' LE GE SLT SGT SLE SGE %nonassoc FILETEST %left LS RS %left '+' '-' '.' %left '*' '/' '%' 'x' %left MATCH NMATCH_ %right '!' '~' UMINUS %nonassoc INC DEC %left '('
トークンはいろいろありますが, 今回見てみたいのは代入で使われてそうな =
とprint
ですね.
=
のトークンが来た場合の処理を見てみると, この辺りが気になります.
sexpr : sexpr '=' sexpr { $1 = listish($1); if ($1->arg_type == O_LIST) $3 = listish($3); $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg,1)); } | sexpr '*' '=' sexpr { $$ = l(make_op(O_MULTIPLY, 2, $1, $4, Nullarg,0)); }
ここの文法規則sexprはおそらくS-expression,つまりS式っぽいリストを理解するという意味でしょう.
とすると, ここでは代入する際に =
の左側がリストであるならば, listish
に=
の右側の値を入れています.
そして, make_op
という関数でオペタイプ O_ASSIGN
を生成しています.
ということは, 「O_ASSIGN
だったら xxをする.」処理がPerl1.0のコードのどこかに書かれており,おそらくそこで代入が行われている事がわかります.
スカラ変数の代入
ではどこで代入が行われているのでしょう.
ヒントは O_ASSIGN
でした.まずはこれでソースコードをgrepしてみます.
~/w/p/a/Perl-1.0 » grep -n O_ASSIGN *.c arg.c:1243: opargs[O_ASSIGN] = A(1,1,0); arg.c:1629: case O_ASSIGN: perl.c:2279: (yyval.arg) = l(make_op(O_ASSIGN, 2, (yyvsp[-2].arg), (yyvsp[0].arg), Nullarg,1)); } perly.c:1476: else if (arg->arg_type == O_ASSIGN && perly.c:1947: (type == O_ASSIGN && perly.c:2503: cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$_ =" */
結構な箇所で呼ばれている様です.
この中でperly.cで書かれている箇所は, make_op
に関する関数や, make_op
自身で呼ばれています.
ここでは, 与えられたプログラムから, $hoge = "hello"
の "hello"
に対応する文字列の構造体を生成しています.
構文解析の際にオブジェクトを生成するのはRubyなどでも同様です.
実際に生成された構造体から, 変数$hoge
に代入が行われているのはおそらく arg.c
のcase文でしょう.
ではarg.cを見てみます
case O_ASSIGN: if (arg[2].arg_flags & AF_SPECIAL) do_assign(str,arg); else { if (str != sarg[2]) str_sset(str, sarg[2]); STABSET(str); } break;
お,以下にもな do_assign
や str_sset
が呼ばれていますね!
このcase文はevalという関数の中にあるのでlldbでeval関数を確認してみましょう
関数を読むには l
を使います
(lldb) l eval File: /Users/anatofuz/workspace/perl/adventcal/Perl-1.0/arg.c 1360 static int (*ihand)(); 1361 static int (*qhand)(); 1362 #endif 1363 1364 STR * 1365 eval(arg,retary) 1366 register ARG *arg; 1367 STR ***retary; /* where to return an array to, null if nowhere */ 1368 { 1369 register STR *str; 1370 register int anum;
ではcase文が出てくるまで進めましょう.実はlldbは直前のコマンドを繰り返すのでそのままEnterを押します
(lldb) l 1371 register int optype; 1372 register int maxarg; 1373 double value; 1374 STR *quicksarg[5]; 1375 register STR **sarg = quicksarg; 1376 register char *tmps; 1377 char *tmps2; 1378 int argflags; 1379 long tmplong; 1380 FILE *fp; 1381 STR *tmpstr; (lldb) 1382 FCMD *form; 1383 STAB *stab; 1384 ARRAY *ary; 1385 bool assigning = FALSE; 1386 1387 if (!arg) 1388 return &str_no; 1389 str = arg->arg_ptr.arg_str; 1390 optype = arg->arg_type; 1391 maxarg = arg->arg_len; 1392 if (maxarg > 3 || retary) { (lldb) 1393 sarg = (STR **)safemalloc((maxarg+2) * sizeof(STR*)); 1394 } 1395 #ifdef DEBUGGING 1396 if (debug & 8) { 1397 deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg); 1398 } 1399 debname[dlevel] = opname[optype][0]; 1400 debdelim[dlevel++] = ':'; 1401 #endif 1402 for (anum = 1; anum <= maxarg; anum++) { 1403 argflags = arg[anum].arg_flags; (lldb) 1404 if (argflags & AF_SPECIAL) 1405 continue; 1406 re_eval: 1407 switch (arg[anum].arg_type) { 1408 default: 1409 sarg[anum] = &str_no; 1410 #ifdef DEBUGGING 1411 tmps = "NULL"; 1412 #endif 1413 break; 1414 case A_EXPR: (lldb)
case文は 1407行目のswitchから始まっているようです.
ここを見ると arg[anum].arg_type
にオペタイプの番号が格納されており, これに応じて命令を実行する仕組みになっている様です.
この arg
とは ARG
というPerl1.0の構造体の配列となっています.
では, O_ASSIGN
の処理にbreak pointをかけてみましょう.
O_ASSIGN
は1629行からでした.実は行にbreakpointを書ける事が可能です.
(lldb) b 1629 Breakpoint 2: where = perl`eval + 4556 at arg.c:1630, address = 0x00000001000065ac (lldb) c Process 47700 resuming Process 47700 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = breakpoint 2.1 frame #0: 0x00000001000065ac perl`eval(arg=0x0000000100500280, retary=0x0000000000000000) at arg.c:1630 1627 str = arg->arg_ptr.arg_str; 1628 break; 1629 case O_ASSIGN: -> 1630 if (arg[2].arg_flags & AF_SPECIAL) 1631 do_assign(str,arg); 1632 else { 1633 if (str != sarg[2]) Target 0: (perl) stopped. (lldb)
O_ASSIGN
で止まりましたね!
(lldb) n Process 47768 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step over frame #0: 0x00000001000065d5 perl`eval(arg=0x0000000100500170, retary=0x0000000000000000) at arg.c:1633 1630 if (arg[2].arg_flags & AF_SPECIAL) 1631 do_assign(str,arg); 1632 else { -> 1633 if (str != sarg[2]) 1634 str_sset(str, sarg[2]); 1635 STABSET(str); 1636 } Target 0: (perl) stopped.
ifの条件はfalseになり, elseに落ちました.
elseではstr
と sarg[2]
を比較しています.
それぞれに何が入っているのでしょうか.
(lldb) p str (STR *) $10 = 0x0000000100500060 (lldb) p sarg[2] (STR *) $12 = 0x0000000100500130
str
も sarg[2]
もSTR型へのポインタのようです.
中身を確認したいのでデリファレンスを意味する *
を先頭につけて...
(lldb) p *str (STR) $11 = { str_ptr = 0x0000000000000000 <no value available> str_nval = 0 str_len = 0 str_cur = 0 str_link = { str_next = 0x0000000000000000 str_magic = 0x0000000000000000 } str_pok = '\0' str_nok = '\0' } (lldb) p *sarg[2] (STR) $13 = { str_ptr = 0x0000000100500160 "hello" str_nval = 0 str_len = 10 str_cur = 5 str_link = { str_next = 0x0000000000000000 str_magic = 0x0000000000000000 } str_pok = '\x01' str_nok = '\0' }
なるほど! sarg[2]
は "hello"
へのポインタが str_ptr
として入っているようです.
(lldb) p *sarg[2]->str_ptr (char) $15 = 'h' (lldb) p sarg[2]->str_ptr (char *) $16 = 0x0000000100500160 "hello"
そこだけ見てみると, char型のポインタとなっています. char型ポインタはCで文字列を扱う際の方法ですね.
ここで解ることはPerl1.0のスカラ変数 STRは文字列をcharのポインタとして握っているという事です.
*str
はメンバの値が初期値です.これは $hoge = "hello"
で代入する $hoge
が str
であり, なおかつ今から代入する事を意味しています.
つまり str
が今回では $hoge
という事です.
その為代入する str_sset
を実行するはずです.
(lldb) n Process 47865 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step over frame #0: 0x00000001000065ed perl`eval(arg=0x00000001002025b0, retary=0x0000000000000000) at arg.c:1634 1631 do_assign(str,arg); 1632 else { 1633 if (str != sarg[2]) -> 1634 str_sset(str, sarg[2]); 1635 STABSET(str); 1636 } 1637 break; Target 0: (perl) stopped.
if文の判定の結果 str_sset
に落ちている事がわかりますね!
では, この関数の中に入ってみましょう. s
で入って...
(lldb) s Process 47865 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step in frame #0: 0x00000001000139d0 perl`str_sset(dstr=0x00000001002024a0, sstr=0x0000000100202570) at str.c:132 129 STR *dstr; 130 register STR *sstr; 131 { -> 132 if (!sstr) 133 str_nset(dstr,No,0); 134 else if (sstr->str_nok) 135 str_numset(dstr,sstr->str_nval); Target 0: (perl) stopped.
str_sset
に入りました. str_sset
は2引数を取り, dstr
が先程のstr
, sstr
が sarg[2]
です.
stepで実行していきましょう.
(lldb) s Process 47865 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step in frame #0: 0x00000001000139f8 perl`str_sset(dstr=0x00000001002024a0, sstr=0x0000000100202570) at str.c:134 131 { 132 if (!sstr) 133 str_nset(dstr,No,0); -> 134 else if (sstr->str_nok) 135 str_numset(dstr,sstr->str_nval); 136 else if (sstr->str_pok) 137 str_nset(dstr,sstr->str_ptr,sstr->str_cur); Target 0: (perl) stopped. (lldb) s Process 47865 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step in frame #0: 0x0000000100013a20 perl`str_sset(dstr=0x00000001002024a0, sstr=0x0000000100202570) at str.c:136 133 str_nset(dstr,No,0); 134 else if (sstr->str_nok) 135 str_numset(dstr,sstr->str_nval); -> 136 else if (sstr->str_pok) 137 str_nset(dstr,sstr->str_ptr,sstr->str_cur); 138 else 139 str_nset(dstr,"",0); Target 0: (perl) stopped. (lldb) s Process 47865 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step in frame #0: 0x0000000100013a2e perl`str_sset(dstr=0x00000001002024a0, sstr=0x0000000100202570) at str.c:137 134 else if (sstr->str_nok) 135 str_numset(dstr,sstr->str_nval); 136 else if (sstr->str_pok) -> 137 str_nset(dstr,sstr->str_ptr,sstr->str_cur); 138 else 139 str_nset(dstr,"",0); 140 }
見ていくと, 今回はstr_nset
を実行するようです.
(lldb) s Process 47865 stopped * thread #1, queue = 'com.apple.main-thread', stop reason = step in frame #0: 0x0000000100013a93 perl`str_nset(str=0x00000001002024a0, ptr="hello", len=5) at str.c:147 144 register char *ptr; 145 register int len; 146 { -> 147 GROWSTR(&(str->str_ptr), &(str->str_len), len + 1); 148 bcopy(ptr,str->str_ptr,len); 149 str->str_cur = len; 150 *(str->str_ptr+str->str_cur) = '\0'; Target 0: (perl) stopped. (lldb) l 151 str->str_nok = 0; /* invalidate number */ 152 str->str_pok = 1; /* validate pointer */ 153 } 154 155 str_set(str,ptr) 156 register STR *str; 157 register char *ptr; (lldb)
str_nset
は上に示しています.
見てみると GROWSTR
という謎マクロを実行し, bcopyでメモリ内のバイトコピーを行い,
長さを設定, その後文字列の末尾にCのヌル文字 \0
を代入している様です.
このGROWSTR
とは perl.h:#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
であり, growstrを実行してくれるマクロの様です.
growstrは次の通りになっています.
/* grow a static string to at least a certain length */ void growstr(strptr,curlen,newlen) char **strptr; int *curlen; int newlen; { if (newlen > *curlen) { /* need more room? */ if (*curlen) *strptr = saferealloc(*strptr,(MEM_SIZE)newlen); else *strptr = safemalloc((MEM_SIZE)newlen); *curlen = newlen; } }
ここから見ると, 条件によってreallocやmallocを安全に実行してくれる君の様です.
さて,ここまでの探検でわかったことは「Perl1.0の文字列の代入は,STR型のchar型文字列をbcopyしている」ということですね!
ちなみにbcopyはすでにmemcpyに置き換えられており, 実際にこのPerl1.0でもbcopyはmemcpyの別名としてマクロになっています.
終わりに
さて, ドキドキPerl1.0探検隊, いかがだったでしょうか. 今回は変数の代入にフォーカスを絞ってみてみましたが, 意外とPerl1.0から頑張って書かれているようです. 流石Larry Wallですね...
ちなみにこういった話をひょっとするとYAPC::Tokyoでするかもしれません. なんと12/3までトーク応募が可能なようなので, みなさんぜひ応募しましょう.