coding my life

昨日の続きで、リストと配列の実装を追います。今日はpush/popとshift/unshiftです。

まずは push/pop。配列の末尾に追加(push)、末尾から削除(pop)するものです。

array.c:95 bool apush(ar,val) register ARRAY * ar; STR * val; { return astore(ar,++(ar->ary_fill),val); }

store に処理を任せてますね。要素数を一個増やして末尾に追加。 次はpop。

array.c:103

STR * apop(ar) register ARRAY * ar; { STR * retval; if (ar->ary_fill < 0) return Nullstr; retval = ar->ary_array[ar->ary_fill]; ar->ary_array[ar->ary_fill--] = Nullstr; return retval; }

要素数を一個減らして末尾を Nullstr で埋めて、それまで入ってた奴を戻すと。

さて次は配列の先頭を操作するshift/unshift。まずは先頭から一つ取り出す shift。

STR * ashift(ar) register ARRAY * ar; { STR * retval; 　 if (ar->ary_fill < 0) return Nullstr; retval = ar->ary_array[0]; bcopy((char<em>)(ar->ary_array+1),(char</em>)ar->ary_array, ar->ary_fill * sizeof(STR *)); ar->ary_array[ar->ary_fill--] = Nullstr; return retval; }

配列1つめから末尾までのデータを先頭にコピーして、 要素数を一つへらしつつ最後の要素に Nullstrを入れると。

次は先頭に追加するunshift。

array.c:116

aunshift(ar,num) register ARRAY * ar; register int num; { register int i; register STR * * sstr, * * dstr; 　 if (num <= 0) return; astore(ar,ar->ary_fill+num,(STR *)0); // maybe extend array sstr = ar->ary_array + ar->ary_fill; dstr = sstr + num; for (i = ar->ary_fill; i >= 0; i--) { * dstr-- = * sstr--; } bzero((char *)(ar->ary_array), num * sizeof(STR *)); }

ダミー要素を末尾に store を利用して追加した上で、 既存の要素ポインタを一個づつずらして言ってます。 引数が num であることからどうも aunshift 自体は要素を追加するわけではなくて、 先頭に追加する要素分だけスペースを空けるだけのようです。

というわけで aunshift が呼ばれている部分を見てみます。 呼び出し元はやはり arg.c の eval でした。

arg.c:2059

case O_UNSHIFT: ary = arg[2].arg_ptr.arg_stab->stab_array; if (arg[1].arg_flags & AF_SPECIAL) do_unshift(arg,ary); else { str = str_new(0); // must copy the STR str_sset(str,sarg[1]); aunshift(ary,1); astore(ary,0,str); } value = (double)(ary->ary_fill + 1); break;

if AF_SPECIAL else のほうで aunshift で一つスペースを空けた上で、 ゼロ番目にastore しています。AF_SPECIALのほうでやってる do_unshift は配列を指定されたときかな？

do_unshift は同じく arg.c の中にありました。

arg.c:827

do_unshift(arg,ary) register ARG * arg; register ARRAY * ary; { STR * * tmpary; // must not be register register STR ** elem; register STR * str = &str_no; register int i; 　 (void)eval(arg[1].arg_ptr.arg_arg,&tmpary); i = 0; for (elem = tmpary+1; * elem; elem++) i++; aunshift(ary,i); i = 0; for (elem = tmpary+1; * elem; elem++) { str = str_new(0); str_sset(str,* elem); astore(ary,i++,str); } safefree((char*)tmpary); }

どうもそんな雰囲気です。最初に eval して配列を取得した上でその要素だけ指定された配列の先頭に aunshift、astore してます。

AF_SPECIAL というのが何かよくわかりません。arg の内容が問題です。

そろそろ eval の引数を詳しく見た方がいいかもしれません。また今度やります。

Perl学習の続き。今日は「はじめてのPerl」第3章、「リストと配列」の前半をやりました。

• 3.1 配列の要素にアクセスする
• 3.2 配列の特別なインデクス
• 3.3 リストリテラル
  • 3.3.1 qw ショートカット
• 3.4 リスト代入
  • 3.4.1 pop演算子とpush演算子
  • 3.4.2 shift演算子とunshift演算子
• 3.5 配列を文字列の中に展開する
• 3.6 foreach 制御構造
• 3.7 Perl お気に入りのデフォルト: $_
  • 3.7.1 reverse演算子
  • 3.7.2 sort演算子

ひっかかったこと

• push/pop と unshift/shift の違い
• foreach で受ける変数は要素そのもので(参照?)、代入すると配列の要素自体が変更される
• デフォルト変数 $_ はどこでいじられてるのか。内部表現

というわけで、とりあえず配列の内部表現を見てみようとまた Perl 1.0 のソースを見ます。

今回は簡単で、 array.h と array.c にまとまっているようです。

array.h (コメントは溝口)

struct atbl { STR **ary_array; // 配列要素のスカラ? int ary_max; // 配列の最大インデックス番号? int ary_fill; // 配列の要素数? }; STR *afetch(); bool astore(); bool adelete(); STR *apop(); STR *ashift(); bool apush(); long alen(); ARRAY *anew();

atbl は perl.h で typedef struct atbl ARRAY; と定義されています。

では配列の作成をしてるらしい anew を見ます。

array.c:69

ARRAY * anew() { register ARRAY * ar = (ARRAY *)safemalloc(sizeof(ARRAY)); 　 ar->ary_array = (STR * *) safemalloc(5 * sizeof(STR *)); ar->ary_fill = -1; ar->ary_max = 4; bzero((char *)ar->ary_array, 5 * sizeof(STR *)); return ar; }

要素のバッファを多少余分にとって確保してることがわかります。ary_max を見ると4個分？1個は末尾マーカーかな？

safemalloc は util.c で定義されてて、引数チェックと、メモリが確保できなかったときの異常終了をしています。bzero は perl.h で #define bzero(s,l) memset(s,0,l); されてます。

配列からの取得は afetch

array.c:16

STR * afetch(ar,key) register ARRAY *ar; int key; { if (key < 0 || key > ar->ary_max) return Nullstr; return ar->ary_array[key]; }

key が取得したい要素のインデックス番号。ここでみると数値を期待してますね。範囲外の要素は undef (Nullstr) を返すようです。

次、要素をいれるっぽい astore

array.c:26

bool astore(ar,key,val) register ARRAY * ar; int key; STR *val; { bool retval; 　 if (key < 0) return FALSE; if (key > ar->ary_max) { int newmax = key + ar->ary_max / 5; 　 ar->ary_array = (STR * *)saferealloc((char *)ar->ary_array, (newmax+1) * sizeof(STR *)); bzero((char *)&ar->ary_array[ar->ary_max+1], (newmax - ar->ary_max) * sizeof(STR *)); ar->ary_max = newmax; } if (key > ar->ary_fill) ar->ary_fill = key; retval = (ar->ary_array[key] != Nullstr); if (retval) str_free(ar->ary_array[key]); ar->ary_array[key] = val; return retval; }

オーソドックス。

配列の要素数以上のkeyにstoreされると、要素の枠を追加で確保して、要素数(ary_fill)、最大インデックス(ary_max)を更新した上で、上書きされる要素をstr_freeし、最後に上書きする。上書きがあった場合は1を返すようです。

要素枠の追加時は、既存の最大要素数の5分の1だけバッファを用意して、連続追加でもパフォーマンスが落ちないようにしてるみたいですね。

さて、ここまではわかりましたが、eval のなかからここまでどうやって呼ばれるんでしょう。あと配列の作成、解放のタイミングも気になります。

それらは奥が深そうなので、いったん気になるまま置いておいて、明日は pop / shift の違いと foreach, デフォルト変数周り、あとざっと reverse, sort も実装を見ようと思います。

「Perl学習はじめました」でハマった以下の文字列比較に eq ではなく == を使ったコードがなぜ期待したとおりに動かなかったのか、調べてみました。

use strict; while(1) { my $input = <STDIN>; chomp $input; last if $input == 'quit'; print $input; }

まず == は数値を期待していて、ここに文字列をわたすと Perl の文字列から数値への変換ルールで入力文字列が(だいたい) 0 になり、同様に 'quit' も数値変換されて 0 になるため 0 == 0 として必ず while を抜けるのは理解できました。

で、いい機会なので実装がどうなってるのかを見ようと思って Perl 5.8.8 のソースコードを見てみました。でも、O_SEQ というのが eq の opname だということ、 O_EQ というのが == の opname だということまではわかったのですが、そのバイトコードを処理する実装を見つけられませんでした。

そこで Perl 1.0 のソースコードなら単純だろうと当たりをつけて、このサイトから Perl 1.0 のソースコードをダウンロードして、いろいろ調べてみます。

• perl1 Downloads

でいろいろ追っかけると以下のような流れでバイトコードを実行してるみたいです。

• main (perly.c)
• cmd_execute (cmd.c)
• eval (eval.c)

というわけで見つけた実装

まず文字列比較の eq

arg.c:1782 case O_SEQ: tmps = str_get(sarg[1]); value = (double) strEQ(tmps,str_get(sarg[2])); handy.h:20 #define strEQ(s1,s2) (!strcmp(s1,s2))

というわけで単純に strcmp してました。

次、数値比較の ==

arg.c:1508 case O_EQ: value = str_gnum(sarg[1]); value = (double)(value == str_gnum(sarg[2]));

perl.h:56 #define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str)))

str.c:83 double str_2num(str) register STR *str; { if (!str) return 0.0; if (str->str_len && str->str_pok) str->str_nval = atof(str->str_ptr); else str->str_nval = 0.0; str->str_nok = 1; #ifdef DEBUGGING if (debug & 32) fprintf(stderr,"0x%lx num(%g)\n",str,str->str_nval); #endif return str->str_nval; }

ふむ。文字列を atof で double に変換しちゃうということで。なるほどねー

Perl 5.8 での実装が見つけられなかったのがちょっと悔しいけど、これからまた「はじめてのPerl」の続きをします。

ちなみに STR 型は str.h で定義されてました。でも最近のは utf-8 フラグとかいろいろ拡張されてるらしいので、あまり意味ないかもしれないなあ。

struct string { char * str_ptr; /* pointer to malloced string * / double str_nval; /* numeric value, if any * / int str_len; /* allocated size * / int str_cur; /* length of str_ptr as a C string * / union { STR * str_next; /* while free, link to next free str * / STAB * str_magic; /* while in use, ptr to magic stab, if any * / } str_link; char str_pok; /* state of str_ptr * / char str_nok; /* state of str_nval * / };

YAPC::Asia 2008 に参加することにしたのですが、Perlを使ったことがほぼないので会社にあった「はじめてのPerl」を見ながらイチからやることにしました。あと1週間しかないけど。

というわけで最初にハマったこと。

• while ループを抜けるのは last らしい。
• use strict はみんなつけてるみたいだからとりあえずつけてみた
• use strict にすると変数への代入で怒られるのでよく知らないまま my つけてみた
• <STDIN>から読み込んで "quit" なら終了というのを書いてみたけど何を入れても終わっちゃうなあ
• chomp を <STDIN> に対してやったら怒られた。ファイルハンドルよく分からない

use strict; while(1) { my $input = <STDIN>; chomp $input; last if $input == 'quit'; print $input; }

2008-05-08 12:02 追記

$input == 'quit' が悪いとの指摘をいただきました。 == じゃなくて eq を使えとのこと。 ということで以下にしたら思い通りに quit のときだけ終了するようになりました。 指摘していただいたみなさん、ありがとうございます > @kimuchi @fuktommy @tokuhirom @kuzuha

use strict; while(1) { my $input = <STDIN>; chomp $input; last if $input eq 'quit'; print $input; }

eq は文字列比較用の演算子で、== は数値比較用の演算子らしいです。 最初はC言語的に strcmp しないといけないのかなとか思ってました。(strcmpあるのか知らない)

「初めてのPerl」本の目次をざっと見たけどこの辺の記述がなさそうだったので、本家サイトのドキュメンテーションから文字列の比較と演算子のあたりを調べようとおもいます。

• Documentation perl.com