• TechTalk.jp - 日本の技術系プレゼンテーション参加者のためのハブサイト

今後、セミナーとかイベントで撮ったり公開した動画はそっちの方に投稿すると思います。 こっちはプログラミング関係のブログとして残します。

www 上の日本語で書かれている perl 情報は本当に玉石混合で困ってたので、このサイトが内容充実しつつ "perl" で検索して最初の3つぐらいになったら素敵だとおもいます。というわけで支援。

YAPC::Asia 2008 のスケジュールページからリンクされている、セッション詳細情報のページにも埋め込みされています。

A Standard That Is Meant To Be Broken, 本当に! - Larry Wall

※ この動画はi-revoの堂前さん・川合さんが撮影されたものを id:lopnor さんにテープから吸い出していただいたものを公開用にエンコードしました。ありがとうございました！

DeNA room (Day 1) 7セッション

※ cog の動画だけ、撮影機材のトラブルでうまくとれなかったので Xacti で撮った動画になっています。スライドが見づらくて申し訳ないです。

DeNA room (Day 2) 8セッション

講堂とArchTypeルームでのセッション動画は、動画撮影チームでとりまとめて編集・エンコードをしているところです。

ちょっとトラブルもあったので１〜２週間かかるかもしれませんが、でき次第随時公開出来ると思います。

2008-05-19 17:18 追記

公式サイトのニュースでも告知がでましたー

• http://conferences.yapcasia.org/ya2008/news/160

bool do_open(stab,name) STAB * stab; register char * name; { FILE * fp; int len = strlen(name); register STIO * stio = stab->stab_io; 　 while (len && isspace(name[len-1])) name[--len] = '\0'; if (!stio) stio = stab->stab_io = stio_new(); if (stio->fp) { if (stio->type == '|') pclose(stio->fp); else if (stio->type != '-') fclose(stio->fp); stio->fp = Nullfp; } stio->type = * name; if (* name == '|') { for (name++; isspace(* name); name++) ; fp = popen(name,"w"); } else if (* name == '>' && name[1] == '>') { for (name += 2; isspace(* name); name++) ; fp = fopen(name,"a"); } else if (* name == '>') { for (name++; isspace(* name); name++) ; if (strEQ(name,"-")) { fp = stdout; stio->type = '-'; } else fp = fopen(name,"w"); } else { if (* name == '<') { for (name++; isspace(* name); name++) ; if (strEQ(name,"-")) { fp = stdin; stio->type = '-'; } else fp = fopen(name,"r"); } else if (name[len-1] == '|') { name[--len] = '\0'; while (len && isspace(name[len-1])) name[--len] = '\0'; for (; isspace(* name); name++) ; fp = popen(name,"r"); stio->type = '|'; } else { stio->type = '<'; for (; isspace(* name); name++) ; if (strEQ(name,"-")) { fp = stdin; stio->type = '-'; } else fp = fopen(name,"r"); } } if (!fp) return FALSE; if (stio->type != '|' && stio->type != '-') { if (fstat(fileno(fp),&statbuf) < 0) { fclose(fp); return FALSE; } if ((statbuf.st_mode & S_IFMT) != S_IFREG && (statbuf.st_mode & S_IFMT) != S_IFCHR) { fclose(fp); return FALSE; } } stio->fp = fp; return TRUE; }

まとめ

• ファイルがすでに開かれてたらいったん閉じる
• open 引数の記号列でfopen時の書き込み・追記などを制御する。記号列とファイル名の間にはスペースを入れてもいい。
  • | 書き換え
  • >> 追記
  • > 書き換え (但しファイル名が - の場合は標準出力)
  • < 読み込み (但しファイル名が - の場合は標準出力)
• 引数の末尾が | で終わっている場合は popen
• 記号列自体がない場合はファイル名が指定された読み込みと同じ扱い

2008-05-18 1:13 追記

おもいっきり誤読してた。

• | 書き込みモードで popen
• 末尾が | の場合は読み込み専用モードで popen

まずは 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 の引数を詳しく見た方がいいかもしれません。また今度やります。

• 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 も実装を見ようと思います。

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 * / };