ドキドキPerl1.0探検隊

はじめに

こんにちはid:anatofuzです. これはPerl Advent Calendar 2018 1日目の記事です.

なぜ僕が初日を担当しているかというと以下のような経緯です.

...というわけで id:kfly8 さんの思惑で(?)トップバッターになりました. よろしくお願いします.

さて,初日なのですが, 当初の予定通りPerl1.0を動かす話にしようかな...とは思ったのですが 実際の所Perl1.0に関しては謎のPerlハッカーがメンテナンスを行っており, 現在難なくビルドする事が可能です.

以前はbitbcketにchastaiさんという方がリポジトリを上げていましたが,アカウントごと消えてしまい, 現在僕がforkしたリポジトリgithubにあげています.

github.com

この「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
  • いろいろ聞かれますが大体画面に出てる通りにエンターを押し続ければなんとかなります.

    • installしたい場合は書かれてるとおりにpathを設定してください.
    • 実はここに書いたコンパイラオプションは使われないという悲しさがあるので, コンパイラオプションは一旦無視して進めます
  • 次に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におけるYACCperl.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_assignstr_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ではstrsarg[2]を比較しています. それぞれに何が入っているのでしょうか.

(lldb) p str
(STR *) $10 = 0x0000000100500060
(lldb) p sarg[2]
(STR *) $12 = 0x0000000100500130

strsarg[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" で代入する $hogestr であり, なおかつ今から代入する事を意味しています.

つまり 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 , sstrsarg[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までトーク応募が可能なようなので, みなさんぜひ応募しましょう.

明日は@yumlonneさんで「他の言語っぽくperlを使う話」です! お楽しみに!!!