継続を基本とするC言語CbCのご紹介

この記事は琉大情報工学科(知能情報コース) Advent Calendar 2018 の16日目の記事です.

どうせなのでCasl2のエミュレーターでも書くかという気になりましたが,今日はドラゴンボールを見てしまったのでエミュレーターは途中までとなりました.ご了承下さい.

さて今日は一部界隈でまことしやかに盛り上がっている謎の言語CbCことContinuation Based Cについての話です. ただしCbCは沼なので間違えている可能性があります.サイレント修正される可能性がありますがご了承下さい.

Continuation Based Cとは

Continuation Based C(以下CbC)とは継続を基本としたC言語の下位言語です. C言語での関数呼び出しやfor文などのループ文をコードから消滅させ, 状態遷移単位でコードを書くことが出来る言語です. 応用例としては世界最速のgrepやGearsOS, Perl6処理系のCbCMoarVMなどが存在します.

現在はgcc及びllvm/clang上に実装した2種類が存在します.

C言語を使ってプログラミングをする場合,メモリのアロケートやエラーハンドリングなどを記述していく必要があります. しかしこの処理は複雑かつエラーを発生させやすい為,通常の処理と分離して記述することが望ましいとされます. これらの処理をMetaComputationと呼びます. しかしC言語を使ったプログラミングである程度規模が大きいものを行おうとすると,これらの処理と通常の計算処理を分離して記述することは非常に難しいとされます.

CbCでは,関数の代わりにCodeSegmentとDataSegmentを基本単位として導入する事で,これらをやりやすくします.

CodeSegment

CbCでは関数の代わりにCodeSegmentを利用します.

CodeSegmentは関数よりも小さく,ステートメントよりも大きい単位となっています. CodeSegmentを利用したCbCではループ文を持ちません. これはCodeSegmentがコンパイラにおける基本ブロックと呼ばれる単位に該当する為です.

CodeSegmentはCの関数の代わりに __code と書くことで宣言出来ます. これは __code という型が有るわけではなく, CbCプログラマからはCodeSegmentである事を示す指示子の様な役割を果たします.

__code 自体はCbCコンパイラではvoid型として扱います.

CodeSegmentからCodeSegmentへはCのgoto文を利用して遷移します. この遷移はCの関数呼び出しとは異なり,callなどの命令を利用せずjmpを利用した軽量継続で行います. 実際にコード例を見てみましょう.

extern int printf(const char*,...);
  int main (){
     int data = 0;
     goto cg1(&data);
  }
  __code cg1(int *datap){
(*datap)++;
    goto cg2(datap);
}
__code cg2(int *datap){
    (*datap)++;
    printf("%d\n",*datap);
}

このコードはmain関数で設定した data = 0 をcg1と言うCodeSegmentに入力として渡します. この時点ではCの世界からCbCの世界に突入する段階ですので, cg1自体はcallで呼び出されます.

cg1では受け取ったdataのアドレスからdataをインクリメントし data = 1 にします. インクリメントの後 cg2 に軽量継続します. cg2では同様にdataをインクリメントし, printするという流れです.

#include <stdio.h>

__code fact(int n, int result,__code (*print)()) {
    if (n > 0) {
        result *= n;
        n--;
        goto fact(n,result,print);
    } else {
        goto (*print)(result);
    }
}

__code print_result(int result){
    printf("result is %d\n",result);
}

int main(int argc, char** argv){
    goto fact(20,0,print_result);
}

他には上記のような階上を求めるコードも書くことが可能です. fact(int n, int result,__code (*print)()) の引数として __code のCodeSegment自体を渡しています.

この様にCodeSegmentの引数にはCodeSegment自体もいれることが可能です. この引数の事をDataSegmentもしくはInterfaceと呼びます. なぜ引数ではなくDataSegmentと呼称するかについては後述します.

軽量継続とは

先程から何回か出ている軽量継続とは何でしょうか. 軽量継続ではなく,継続とはSchemaなどの処理系には実装されています.

Wikipediaによると

継続は、前の状態を引き継ぐこと。持続、保持。 計算機科学における継続(けいぞく、continuation)とは、プログラムの実行においてある時点において評価されていない残りのプログラム(the rest of the program)を意味するものであり、手続き(procedure)として表現される

https://ja.wikipedia.org/wiki/%E7%B6%99%E7%B6%9A

詳しくは http://practical-scheme.net/docs/cont-j.html

つまり,CbCではCレベルで次の処理の命令をよりSchemaなどの関数型言語のように記述することが出来るインターフェイスを提供します. この際にSchemaなどでは,現在の位置などを環境として保存する必要がありますが, CbCの場合そのあたりを保存しない為軽量な継続,つまり軽量継続と読んでいます.

うれしいところ

Cで軽量継続を使えると何が嬉しいのでしょうか. それはCの関数呼び出しがコストがかかる事がまず挙げられます.

Cの関数呼び出しでは, 呼び出し側は引数を積み上げ,戻り番地のセーブを行い, 呼び出される方は局所変数を保存したり,スタックやフレームポインタを押し上げるなどの処理が必要となります. これらを一切行わず,プログラムカウンタを変更するのみのjmp命令にCbCのgotoを利用したCodeSegmentは変換する事が可能です.

その為CodeSegmentを直接指定してgotoするなどの処理が書けるようになり,煩わしいfor文やcase-switch文をなくすことが可能です

Cでも末尾再帰と呼ばれる方法を利用すればこの方法が可能であり,実際CbCは内部的に末尾再帰アルゴリズムを用いて最適化しています.

その為, CodeSegmentのDataSegment部分を同じにする事で,全ての命令がjmp命令にコンパイルされます. jmp命令になるということは,CodeSegment間の引き渡しで引数がレジスタに乗ったまま移動されるということです.最高ですね.

つまりCodeSegmentの引数は入力のみではなく入出力としての意味を持つ為,引数ではなくData SegmentやInterfaceという呼び方をしています.

FizzBuzz

試しにFizzBuzzを書いてみます

#define __environment _CbC_environment
#define __return _CbC_return

#include <stdio.h>
#include <string.h>
#include <stdlib.h>

__code fizzbuzz(int,int,char*,__code(),void*);
__code say2(int,int,char*,__code(),void*);
__code fizz(int,int,char*,__code(),void*);
__code buzz(int,int,char*,__code(),void*);

int main(void){
    int n = 100;
    fizzbuzz(1,n,"",__return,__environment);
    return 0;
}

__code fizzbuzz(int i,int n,char* ret_result,__code(*return1)(),void *return1env) {
    if ( i <= n ) {
        goto fizz(i,n,ret_result,return1,return1env);
    } else {
        goto return1(0,return1env);
    }
}


__code fizz(int i,int n,char* ret_result,__code(*return1)(),void *return1env) {
    if (i % 3 == 0){
        ret_result = "fizz";
    } else {
        ret_result = "";
    }
    goto buzz(i,n,ret_result,return1,return1env);
}

__code buzz(int i,int n,char* ret_result,__code(*result1)(),void *return1env) {
    char *result;
    result = (char *)malloc(15);
    if (i % 5 == 0){
        snprintf(result,9,"%s%s",ret_result,"buzz");
    } else {
        snprintf(result,8,"%s",ret_result);
    }
    goto say2(i,n,result,result1,return1env);
}

__code say2(int i,int n,char* ret_result,__code(*return1)(),void *return1env) {
    if ( ret_result[0] == '\0'){
        printf("%i : %i\n" ,i,i);
    } else {
        printf("%i:%s\n",i,ret_result);
    }
    goto fizzbuzz(i+1,n,"",return1,return1env);
}

CbCっぽく書くコツはDataSegmentをそろえる事です.

これを-Sをつけてアセンブラを見てみましょう.

cbclang -S fizzbuzz.cbc

 .section  __TEXT,__text,regular,pure_instructions
    .macosx_version_min 10, 14
    .globl    _main..ret0             ## -- Begin function main..ret0
    .p2align  4, 0x90
_main..ret0:                            ## @main..ret0
    .cfi_startproc
## %bb.0:                               ## %entry
    pushq    %rbp
    .cfi_def_cfa_offset 16
    .cfi_offset %rbp, -16
    movq (%rsi), %rax
    movl %edi, (%rax)
    movq 8(%rsi), %rax
    movq (%rax), %rbp
    movq 8(%rax), %rsi
    movq 16(%rax), %rsp
    jmpq *%rsi
    .cfi_endproc
                                        ## -- End function
    .globl    _main                   ## -- Begin function main
    .p2align  4, 0x90
_main:                                  ## @main
    .cfi_startproc
## %bb.0:                               ## %entry
    pushq    %rbp
    .cfi_def_cfa_offset 16
    .cfi_offset %rbp, -16
    movq %rsp, %rbp
    .cfi_def_cfa_register %rbp
    pushq    %r15
    pushq    %r14
    pushq    %r13
    pushq    %r12
    pushq    %rbx
    subq $264, %rsp              ## imm = 0x108
    .cfi_offset %rbx, -56
    .cfi_offset %r12, -48
    .cfi_offset %r13, -40
    .cfi_offset %r14, -32
    .cfi_offset %r15, -24
    leaq -208(%rbp), %rax
    leaq -252(%rbp), %rcx
    leaq _main..ret0(%rip), %rdx
    movq ___stack_chk_guard@GOTPCREL(%rip), %rsi
    movq (%rsi), %rsi
    movq %rsi, -48(%rbp)
    movl $0, -212(%rbp)
    movl $100, -216(%rbp)
    movl -216(%rbp), %esi
    movq %rdx, -224(%rbp)
    movq -224(%rbp), %rdx
    movq %rdx, -232(%rbp)
    movq -232(%rbp), %rdx
    movq %rcx, -248(%rbp)
    movq %rax, -240(%rbp)
    movq -240(%rbp), %rax
    movq %rax, %rcx
    movq %rbp, %rdi
    movq %rdi, (%rax)
    movq %rsp, %rdi
    movq %rdi, 16(%rax)
    leaq LBB1_8(%rip), %rax
    movq %rax, 8(%rcx)
    movl %esi, -268(%rbp)        ## 4-byte Spill
    movq %rdx, -280(%rbp)        ## 8-byte Spill
    #EH_SjLj_Setup LBB1_8
## %bb.6:                               ## %entry
    xorl %eax, %eax
    movl %eax, -284(%rbp)        ## 4-byte Spill
LBB1_7:                                 ## %entry
    movl -284(%rbp), %eax        ## 4-byte Reload
    movq -240(%rbp), %rcx
    movq %rcx, %rdx
    movq %rbp, %rsi
    movq %rsi, (%rcx)
    movq %rsp, %rsi
    movq %rsi, 16(%rcx)
    leaq LBB1_11(%rip), %rcx
    movq %rcx, 8(%rdx)
    movl %eax, -288(%rbp)        ## 4-byte Spill
    #EH_SjLj_Setup LBB1_11
## %bb.9:                               ## %entry
    xorl %eax, %eax
    movl %eax, -292(%rbp)        ## 4-byte Spill
LBB1_10:                                ## %entry
    movl -292(%rbp), %eax        ## 4-byte Reload
    cmpl $0, %eax
    je   LBB1_2
## %bb.1:                               ## %if.then
    movl -252(%rbp), %eax
    movl %eax, -212(%rbp)
    jmp  LBB1_3
LBB1_2:                                 ## %if.end
    leaq -248(%rbp), %rax
    movq %rax, -264(%rbp)
    movq -264(%rbp), %rax
    leaq L_.str(%rip), %rdx
    movl $1, %edi
    movl -268(%rbp), %esi        ## 4-byte Reload
    movq -280(%rbp), %rcx        ## 8-byte Reload
    movq %rax, %r8
    callq    _fizzbuzz
    subq $8, %rsp
    movl $0, -212(%rbp)
LBB1_3:                                 ## %return
    movl -212(%rbp), %eax
    movq ___stack_chk_guard@GOTPCREL(%rip), %rcx
    movq (%rcx), %rcx
    movq -48(%rbp), %rdx
    cmpq %rdx, %rcx
    movl %eax, -296(%rbp)        ## 4-byte Spill
    jne  LBB1_5
## %bb.4:                               ## %SP_return
    movl -296(%rbp), %eax        ## 4-byte Reload
    addq $264, %rsp              ## imm = 0x108
    popq %rbx
    popq %r12
    popq %r13
    popq %r14
    popq %r15
    popq %rbp
    retq
LBB1_5:                                 ## %CallStackCheckFailBlk
    callq    ___stack_chk_fail
LBB1_8:                                 ## Block address taken
                                        ## %entry
    movl $1, %eax
    movl %eax, -284(%rbp)        ## 4-byte Spill
    jmp  LBB1_7
LBB1_11:                                ## Block address taken
                                        ## %entry
    movl $1, %eax
    movl %eax, -292(%rbp)        ## 4-byte Spill
    jmp  LBB1_10
    .cfi_endproc
                                        ## -- End function
    .globl    _fizzbuzz               ## -- Begin function fizzbuzz
    .p2align  4, 0x90
_fizzbuzz:                              ## @fizzbuzz
    .cfi_startproc
## %bb.0:                               ## %entry
    pushq    %rbp
    .cfi_def_cfa_offset 16
    .cfi_offset %rbp, -16
    movq %rsp, %rbp
    .cfi_def_cfa_register %rbp
    subq $48, %rsp
    cmpl %esi, %edi
    movl %esi, -4(%rbp)          ## 4-byte Spill
    movq %r8, -16(%rbp)          ## 8-byte Spill
    movq %rcx, -24(%rbp)         ## 8-byte Spill
    movq %rdx, -32(%rbp)         ## 8-byte Spill
    movl %edi, -36(%rbp)         ## 4-byte Spill
    jg   LBB2_2
## %bb.1:                               ## %if.then
    movl -36(%rbp), %edi         ## 4-byte Reload
    movl -4(%rbp), %esi          ## 4-byte Reload
    movq -32(%rbp), %rdx         ## 8-byte Reload
    movq -24(%rbp), %rcx         ## 8-byte Reload
    movq -16(%rbp), %r8          ## 8-byte Reload
    addq $48, %rsp
    popq %rbp
    jmp  _fizz                   ## TAILCALL
LBB2_2:                                 ## %if.else
    xorl %eax, %eax
    movb %al, %cl
    movl %eax, %edi
    movq -16(%rbp), %rsi         ## 8-byte Reload
    movb %cl, %al
    movq -24(%rbp), %rdx         ## 8-byte Reload
    callq    *%rdx
    addq $48, %rsp
    popq %rbp
    retq $8
    .cfi_endproc
                                        ## -- End function
    .globl    _fizz                   ## -- Begin function fizz
    .p2align  4, 0x90
_fizz:                                  ## @fizz
    .cfi_startproc
## %bb.0:                               ## %entry
    subq $56, %rsp
    .cfi_def_cfa_offset 64
    leaq L_.str.1(%rip), %rax
    movl $3, %edx
    movq %rax, 48(%rsp)          ## 8-byte Spill
    movl %edi, %eax
    movl %edx, 44(%rsp)          ## 4-byte Spill
    cltd
    movl 44(%rsp), %r9d          ## 4-byte Reload
    idivl    %r9d
    cmpl $0, %edx
    movq 48(%rsp), %r10          ## 8-byte Reload
    movl %esi, 40(%rsp)          ## 4-byte Spill
    movq %r8, 32(%rsp)           ## 8-byte Spill
    movq %rcx, 24(%rsp)          ## 8-byte Spill
    movl %edi, 20(%rsp)          ## 4-byte Spill
    movq %r10, 8(%rsp)           ## 8-byte Spill
    je   LBB3_2
## %bb.1:                               ## %if.else
    leaq L_.str(%rip), %rax
    movq %rax, 8(%rsp)           ## 8-byte Spill
    jmp  LBB3_2
LBB3_2:                                 ## %if.end
    movq 8(%rsp), %rax           ## 8-byte Reload
    movl 20(%rsp), %edi          ## 4-byte Reload
    movl 40(%rsp), %esi          ## 4-byte Reload
    movq %rax, %rdx
    movq 24(%rsp), %rcx          ## 8-byte Reload
    movq 32(%rsp), %r8           ## 8-byte Reload
    addq $56, %rsp
    jmp  _buzz                   ## TAILCALL
    .cfi_endproc
                                        ## -- End function
    .globl    _buzz                   ## -- Begin function buzz
    .p2align  4, 0x90
_buzz:                                  ## @buzz
    .cfi_startproc
## %bb.0:                               ## %entry
    pushq    %rbp
    .cfi_def_cfa_offset 16
    .cfi_offset %rbp, -16
    movq %rsp, %rbp
    .cfi_def_cfa_register %rbp
    subq $64, %rsp
    movl $15, %eax
    movl %eax, %r9d
    movl %edi, -4(%rbp)          ## 4-byte Spill
    movq %r9, %rdi
    movl %esi, -8(%rbp)          ## 4-byte Spill
    movq %r8, -16(%rbp)          ## 8-byte Spill
    movq %rcx, -24(%rbp)         ## 8-byte Spill
    movq %rdx, -32(%rbp)         ## 8-byte Spill
    callq    _malloc
    movl $5, %esi
    movl -4(%rbp), %r10d         ## 4-byte Reload
    movq %rax, -40(%rbp)         ## 8-byte Spill
    movl %r10d, %eax
    cltd
    idivl    %esi
    cmpl $0, %edx
    jne  LBB4_2
## %bb.1:                               ## %if.then
    movl $9, %eax
    movl %eax, %esi
    xorl %edx, %edx
    movl $15, %eax
    movl %eax, %ecx
    leaq L_.str.2(%rip), %r8
    leaq L_.str.3(%rip), %rdi
    movq -40(%rbp), %r9          ## 8-byte Reload
    movq %rdi, -48(%rbp)         ## 8-byte Spill
    movq %r9, %rdi
    movq -32(%rbp), %r9          ## 8-byte Reload
    movq -48(%rbp), %r10         ## 8-byte Reload
    movq %r10, (%rsp)
    movb $0, %al
    callq    ___snprintf_chk
    movl %eax, -52(%rbp)         ## 4-byte Spill
    jmp  LBB4_3
LBB4_2:                                 ## %if.else
    movl $8, %eax
    movl %eax, %esi
    xorl %edx, %edx
    movl $15, %eax
    movl %eax, %ecx
    leaq L_.str.4(%rip), %r8
    movq -40(%rbp), %rdi         ## 8-byte Reload
    movq -32(%rbp), %r9          ## 8-byte Reload
    movb $0, %al
    callq    ___snprintf_chk
    movl %eax, -56(%rbp)         ## 4-byte Spill
LBB4_3:                                 ## %if.end
    movl -4(%rbp), %edi          ## 4-byte Reload
    movl -8(%rbp), %esi          ## 4-byte Reload
    movq -40(%rbp), %rdx         ## 8-byte Reload
    movq -24(%rbp), %rcx         ## 8-byte Reload
    movq -16(%rbp), %r8          ## 8-byte Reload
    addq $64, %rsp
    popq %rbp
    jmp  _say2                   ## TAILCALL
    .cfi_endproc
                                        ## -- End function
    .globl    _say2                   ## -- Begin function say2
    .p2align  4, 0x90
_say2:                                  ## @say2
    .cfi_startproc
## %bb.0:                               ## %entry
    pushq    %rbp
    .cfi_def_cfa_offset 16
    .cfi_offset %rbp, -16
    movq %rsp, %rbp
    .cfi_def_cfa_register %rbp
    subq $64, %rsp
    movsbl   (%rdx), %eax
    cmpl $0, %eax
    movl %esi, -4(%rbp)          ## 4-byte Spill
    movq %r8, -16(%rbp)          ## 8-byte Spill
    movq %rcx, -24(%rbp)         ## 8-byte Spill
    movq %rdx, -32(%rbp)         ## 8-byte Spill
    movl %edi, -36(%rbp)         ## 4-byte Spill
    jne  LBB5_2
## %bb.1:                               ## %if.then
    leaq L_.str.5(%rip), %rdi
    movl -36(%rbp), %esi         ## 4-byte Reload
    movl -36(%rbp), %edx         ## 4-byte Reload
    movb $0, %al
    callq    _printf
    movl %eax, -40(%rbp)         ## 4-byte Spill
    jmp  LBB5_3
LBB5_2:                                 ## %if.else
    leaq L_.str.6(%rip), %rdi
    movl -36(%rbp), %esi         ## 4-byte Reload
    movq -32(%rbp), %rdx         ## 8-byte Reload
    movb $0, %al
    callq    _printf
    movl %eax, -44(%rbp)         ## 4-byte Spill
LBB5_3:                                 ## %if.end
    movl -36(%rbp), %eax         ## 4-byte Reload
    incl %eax
    leaq L_.str(%rip), %rdx
    movl %eax, %edi
    movl -4(%rbp), %esi          ## 4-byte Reload
    movq -24(%rbp), %rcx         ## 8-byte Reload
    movq -16(%rbp), %r8          ## 8-byte Reload
    addq $64, %rsp
    popq %rbp
    jmp  _fizzbuzz               ## TAILCALL
    .cfi_endproc
                                        ## -- End function
    .section  __TEXT,__cstring,cstring_literals
L_.str:                                 ## @.str
    .space    1

L_.str.1:                               ## @.str.1
    .asciz    "fizz"

L_.str.2:                               ## @.str.2
    .asciz    "%s%s"

L_.str.3:                               ## @.str.3
    .asciz    "buzz"

L_.str.4:                               ## @.str.4
    .asciz    "%s"

L_.str.5:                               ## @.str.5
    .asciz    "%i : %i\n"

L_.str.6:                               ## @.str.6
    .asciz    "%i:%s\n"


.subsections_via_symbols

実際にCodeSegment同士はjmpで,mallocなどの関数呼び出しのみcallになっている事がわかります

~/w/c/S/cbc-sandbox » grep jmp fizzbuzz.s
    jmpq    *%rsi
    jmp LBB1_3
    jmp LBB1_7
    jmp LBB1_10
    jmp _fizz                   ## TAILCALL
    jmp LBB3_2
    jmp _buzz                   ## TAILCALL
    jmp LBB4_3
    jmp _say2                   ## TAILCALL
    jmp LBB5_3
    jmp _fizzbuzz               ## TAILCALL
~/w/c/S/cbc-sandbox » grep call fizzbuzz.s
    callq   _fizzbuzz
    callq   ___stack_chk_fail
    callq   *%rdx
    callq   _malloc
    callq   ___snprintf_chk
    callq   ___snprintf_chk
    callq   _printf
    callq   _printf

試すには

試すには gccはこちら

clangはこちらを見ていただくと出来ます.

なおclangが容量をすごく取りますが,現状Mac os Mojaveではclangしかビルド出来ません...助けてくれ...

Perl入学式第2回目をPerl6で解いてみる(Part1)

皆さんこんにちは.最近はようやく寒くなってきた沖縄からid:anatofuzです.

そういえばYAPC::Tokyoのチケットはまだ売っている様です.皆さん行きましょう.

yapcjapan.org

今日は雰囲気でPerl6でPerl入学式第2回の構文基礎を書いていこうと思います

Perl6とは

Perl6とはPerlっぽい別言語です. Python2とPython3の関係ではないので注意しましょう.

とは言え,最初にエイヤッとした言語デザイナーがLarryWallでもありますし, 幾つかのSyntaxはPerlに似ています.

Hello,World!

print "Hello, World!\n"; このように書いたものを, hello.plとして保存します printは, 端末に文字を出力します \nは改行を表します 最後に;を忘れずに!

Perl6ではprintもありますが,よく使うのはsayです.

say "Hello,World!";

ちなみに他にこういうやり方もあります

"Hello,World!\n".print;

これはMuクラスに生えているprintメソッドを利用した場合です. https://docs.perl6.org/routine/print

perl5までのprintはIOクラスのメソッドとなっています

print "Hello,World!\n";

もちろんsayもメソッドとして生えているので出来ます

"Hello,World!".say;

おまじない

!/usr/bin/env perl

use strict; use warnings; おまじないとして, 冒頭の3行を書くようにしよう use strict -> 厳密な書式を定めたり, 未定義の変数を警告するといった効果があります use warnings -> 望ましくない記述を警告してくれる効果があります 以下, この資料のサンプルコードではこれを「お約束」として省略します 書かれているものとして扱ってください

Perl6ではstrictやwarningsの様なものは標準で入っています. この代わりのおまじないと言えば,シェバングと次の1行が該当するでしょうか.

#!/usr/bin/env perl6
use v6;

このv6とはPerl5で仮にこのPerl6プログラムを実行した際にエラーを出してくれるというものです. Perl6的には特に害が無いです. https://docs.perl6.org/language/101-basics#v6

例えば次の様なスクリプトを書いたとしましょう.

use v6;
print "hoge\n";

2行目に関してはPerl5でもprintがあるので,実行することが可能ですが, 仮に他の処理があると予期せぬ処理をPerl5がしそうです. 現在のPerl6では普通のスクリプトの拡張子をp6, クラス定義などのモジュールになるファイルの拡張子をpm6とすることを推奨していますが,Perl5と同じplが拡張子として使われている場合もあります. このプログラムは use v6; をしているので, Perl6で実行すると次のようなエラーを出します.

~/.sandbox » perl hoge.p6
Perl v6.0.0 required--this is only v5.26.2, stopped at hoge.p6 line 1.
BEGIN failed--compilation aborted at hoge.p6 line 1.

という訳で1行読み込んで終わりました.安全性のために書いておくのがオススメです.

復習問題

Hello, Perl Entrance!という文字列を出力するhello_perl.plを書いて下さい

say "Hello, Perl Entrance!";

構文チェック

perl6では perl -c hoge.p6 とするといい感じになります.

~/.sandbox » perl6 -c hoge.p6
Syntax OK

スカラ変数

Perl6はPerl5と似ており,スカラ,配列,ハッシュの3タイプに変数が分類されます.

Perl6のドキュメントによると次の様に書かれています https://docs.perl6.org/type/Scalar

A Scalar is an internal indirection which is for most purposes invisible during ordinary use of Perl 6. It is the default container type associated with the $ sigil. A literal Scalar may be placed around a literal value by enclosing the value in $(…). This notation will appear in the output of a .perl method in certain places where it is important to note the presence of Scalars.

When a value is assigned to a $-sigiled variable, the variable will actually bind to a Scalar, which in turn will bind to the value. When a Scalar is assigned to a $-sigiled variable, the value bound to by that Scalar will be bound to the Scalar which that variable was bound to (a new one will be created if necessary.)

In addition, Scalars delegate all method calls to the value which they contain. As such, Scalars are for the most part invisible. There is, however, one important place where Scalars have a visible impact: a Scalar will shield its content from flattening by most Perl 6 core list operations.

A $-sigiled variable may be bound directly to a value with no intermediate Scalar using the binding operator :=. You can tell if this has been done by examining the output of the introspective pseudo-method .VAR:

雰囲気で理解すると,Perl6におけるスカラ型は $ で宣言した変数名と,実際の値をバインドしてくれる中間的なクラスであり,$ で宣言すると自動的に全てスカラになるということの様です.

また := を利用することで,間にスカラクラスを挟まず,ダイレクトに値を束縛することが可能です.

とは言え,基本的にはPerl5と同じ扱いですが,実際に型として利用されるのはバインドされている変数ということの様です.

これは公式ドキュメントによると次の様に見ることが可能です.

my $a = 1;
$a.^name.say;     # OUTPUT: «Int␤»
$a.VAR.^name.say; # OUTPUT: «Scalar␤»
my $b := 1;
$b.^name.say;     # OUTPUT: «Int␤»
$b.VAR.^name.say; # OUTPUT: «Int␤»

.^name で変数の型が確認できます. $a では1をスカラクラス経由でバインドしており,基底にScalarがあることがわかります.

一方 $b は1を束縛している為,アイテム化されておらず,$b そのものがIntであることがわかります.

Perl6では $ があるかないかでScalarクラスであるかどうかが変わります.

.say for (1, 2, 3);           # OUTPUT: «1␤2␤3␤», not itemized
.say for $(1, 2, 3);          # OUTPUT: «(1 2 3)␤», itemized
say (1, 2, 3).VAR ~~ Scalar;  # OUTPUT: «False␤»
say $(1, 2, 3).VAR ~~ Scalar; # OUTPUT: «True␤»

上の例を見ると $ があるかないかで変わっていることがわかりますね. この $(1,2,3) はアイテム化されているといい, $(1,2,3) でひとまとめです.

その為 $(1,2,3) は実はこうなります.

> my @hoge = $(1,2,3);
[(1 2 3)]
> say @hoge
[(1 2 3)]
> @hoge[0]
(1 2 3)
> @hoge[0][0]
1

アイテム化されている為,実は $(1,2,3) はスカラであり,その中の要素はリストなので配列のようにアクセスするというPerl5っぽい挙動を示します.

コメント

Perl6のコメントはPerl5と同じく# です

# こうするとコメント

またPerl6ではMulti-line commentも追加されました

"#`" とカッコでくくると,その間がコメントとなります.

if #`( why would I ever write an inline comment here? ) True {
    say "something stupid";
}

この例では #`の後に ( が来ているので,この中が全部コメントとなり 最終的にはif True { という感じに解釈されます.

$perl6 hoge.p6
something stupid

これは結構便利ですね!!

疲れたので続きは次回...

YAPC::Tokyo 2019に「レガシーPerlビルド 〜現代に蘇るPerl[1..5].0とPerl6〜」 で登壇します

皆様こんにちは.最近はMoarVMと格闘している id:anatofuzです.

YAPC::Tokyoに応募していたトークが通り,登壇することになりました.

yapcjapan.org

タイトルは「レガシーPerlビルド 〜現代に蘇るPerl[1..5].0とPerl6〜」です.

このトークでは以前Roppongi.pmでお話させていただいた内容をベースに次のような内容で喋ります.

みなさんが今使用しているPerlのバージョンはいくつですか?5.24?5.28?はたまたPerl6...? 互換性を大事にするPerlと言っても,みなさんが今動かしているPerlはPerl5以降のものかと思います.一部Perl4のプロジェクトがあるかもしれませんが.... でも待ってみて下さい,なにか忘れていませんか...?

そうです.Perl"5"と言うことは,Perl1からPerl4がかつて存在していたという事です.もし,Perl2.0やPerl3.0のソースコードが目の前にあったら動かしてみたくなりませんか?

このトークでは過去のPerlソースコードから,動きのしくみ,そして現代のosではどのようにすれば過去のPerlが動くのかについて解説します. バージョンごとの特性や, C言語で書かれたPerl処理系のおもしろポイントと,年代別の修正ポイントも一気に見ていきます. また, 実際にPerl1からPerl5,Perl6まで一気に走らせた場合どの様な処理速度の違いが出るのかなどについても紹介します.

対象とするのはPerl1から現在の主流であるPerl5,そしてレガシーと言いつつ最先端の(?)Rakudo Perl6です. メインはPerl5までのPerlですが,Perl6の内部構造などについてもお話するかもしれません.

という訳で具体的には以下のような事をお話しすると思います(変わるかもしれませんが...)

アジェンダ(仮)

20分で勢いよく見ていくのでご期待下さい!

ちなみにPerl[1..6]まで20分で見るので1バージョン3分くらいの勢いなので頑張っていこうな

基本的には初心者向け(Perlのビルドに初心者も何もいるのかというのは置いといて)ですが, 以下のようなパッションをお持ちの方は特に興奮すると思います.

  • Perl自体に興味が有る方
  • トリビア的に無駄な知識を入れることに興奮する
  • 今の職場で1980年代のコードを動かす必要がある
  • 上司にPerl2.0を動かすように言われた
  • 転生した先ではPerl1.0しか無かった

とう言うわけで1月26日(土)に浅草ヒューリックホール&ヒューリックカンファレンスで僕と握手!!!!!

たのしいPerl6 その1

こんにちは id:anatofuz です.これは琉大情報工学科(知能情報コース) Advent Calendar 2018 4日目の記事です.

今日は皆さん大好きなPerl6についてです.

Perl6とは

Perl6に関しては僕の卒論を見ていただけると良いかと思います

Perl6とはPerlっぽい別言語です. 誤解されることが多いですがPython2とPython3の関係ではなく,どちらかというとJavaJavascriptっぽい関係です.

当初はPerl5の次期バージョンとして開発されていましたが, 開発が進むに連れて互換性の無さや新規文法がもりもり増えてしまった事で「あれ,これPerlじゃなくね?」という事で別の言語となりました.

Perl6は設計と実装が分離しており,主要な実装はRakudoです. 現在の設計はテストスイートRoastを,実装に関してはドキュメントを見るという世界です.

ちなみにRakudoの由来は駱駝道 ( 🐫道) です.なぜ🐫かというとPerlのマスコットキャラがラクダであるからだと思います.

現在はもはやPerl6から別名にしようという動きが一部であり,「6lang」にしようという流れを得て,現在は「Raku」という別名がついています.

Perl6の入れ方

実はPerl6はPythonやPerl5の様に 「perl6っていうコマンドが一つある」 訳ではありません.

実はPerl6を実行するコマンドperl6はシェルスクリプトで.実態はmoarというバイナリにライブラリパスなどを設定して実行しているものです.

これはPerl6がNQPと呼ばれるサブセットで書かれており, このNQPをMoarVMやJVMが解釈するという構成になっている為です. つまり実際に動かすのはperl6ではなくMoarVMのバイナリmoarです. ではPerl6をinstallする際には,この辺を個別でインストール必要があるのでしょうか.

実はそんなことも無く,rakudo-starというPerl6に必要なものをひとまとめにしたツールが配布されています.

(ちなみに rakudo-starのstarはシェルなどのワイルドカード* を使ったrakudo-* の意味です)

Macの場合

macの場合は二種類あり,公式からdmgをdlしてパスを通す 方法か, brewで入れる方法があります.

brewの場合は

$ brew install rakudo-star

これで入ります.

Perl6で遊ぼう

では試しにPerl6のREPLで遊んでみましょう. Perl5とは違い, Perl6はデフォルトでperl6と打つとREPLモードになります.

$perl6
To exit type 'exit' or '^D'

落ち着いて素数を数えよう

実はPerl6には遅延評価があり,しかも数学の無限大を示すInfクラスがあります. これを組み合わせると如何のようにな配列を作れます.

> my @primes = (^∞).grep: *.is-prime;
[...]

これは ^ がrangeクラスのコンストラクタで,0から^ の右の値未満の範囲を作るという意味です.つまり0から無限大のクラスです.

これにメソッドチェーンでgrepをつなげます.grepは配列からある条件を満たす要素を出すものです.

この *.is-prime は,その中の要素が is-prime つまり素数であるならば真を返します.

そして返り値を受け取る my @primes はPerl5と同じく配列の宣言です.

> の次はPerl6のREPLが返した値ですが [...] とありますが,これは配列だが中身はまだ計算してないということです.

本当に素数が入っているか見てみましょう. Perl6で配列の要素を参照するには @array[0] などとします. これを出力するには,メソッドチェーンでsayを繋げます.

> @primes[0].say
2
> @primes[1].say
3
> @primes[2].say
5
> @primes[3].say
7
> @primes[4].say
11
> @primes[5].say
13

素数が入ってそうですね!!!

FizzBuzz

FizzBuzzはいろいろな書き方がありますがtitsukiさんの以下のページが面白いです.

qiita.com

特に面白いのが,Perl6は漸進的型付言語と呼ばれる特徴があり,型が無いようにも有るようにも振る舞う事が可能です.

その特徴を活かすと次のようなfizzbuzzがかけます

my subset Fizz of Int where * %% 3;
my subset Buzz of Int where * %% 5;
my subset FizzBuzz of Int where Fizz&Buzz;
my subset OtherNumber of Int where none Fizz|Buzz;

proto sub fizzbuzz ($) { * }
multi sub fizzbuzz (FizzBuzz) { "FuzzBuzz" }
multi sub fizzbuzz (Fizz) { "Fizz" }
multi sub fizzbuzz (Buzz) { "Buzz" }
multi sub fizzbuzz (OtherNumber $number) { $number }

fizzbuzz($_).say for 1..15;

これはsubsetでFizzの型,Buzzの型,FizzBuzzの型,それ以外の型を定義します. multi で関数に引数の型と応じた関数の内容を記述する事が出来,今回はそれを使って型でfizzbuzzをしています.面白いですね.

という訳でPerl6の話でした.結構面白いと思うのでぜひ遊んでみてはいかがでしょうか.

ついにやります! 琉大ieアドベントカレンダー

こんにちは id:anatofuz です. これは琉大情報工学科(知能情報コース )Advent Calendar 20181日目の記事です.

今日から琉大情報工学科アドベントカレンダー 開催します!!!

アドベントカレンダーとは

アドベントカレンダーとはQiitaAdventCalendarによると

元々はクリスマスまでの日数をカウントダウンするために使われていたカレンダーで、12月1日からはじまり、25個ある「窓」を毎日1つずつ開けて中に入っている小さなお菓子やプレゼントを楽しむものです。 近年、このカレンダーにならい、インターネット上において定められたテーマに従い参加者が持ち回りで自身のブログやサイトに記事を投稿する企画が多く実施されています。

という話です!!

実は日本にこれを持ち込んだのはPerlコミュニティだったりしますが...w

琉大アドベントカレンダーとは

わりと大学単位でアドベントカレンダーをする事が近年流行っているため, この流行にieも乗ってみます!!!

という事で琉大ieアドベントカレンダーまだまだ参加者募集中です!!! 現役のみなさんからOB,OG,先生や, 琉大外のみなさんまで幅広い参加お待ちしております!!!!!

adventar.org

追記 (質問)

テーマは?

特に決めてないので書きたいこと書いて下さい.LT大会と同じですね. 別に技術的な話じゃなくてもいいです.

投稿場所は?

Qiitaとかはてなブログ,Note,学科のwebpage, wordpress,Googleドキュメント,GithubPages....いろいろとアウトプットの場所はあるので活用して下さい.ペライチとか,EverNoteの共有とかでもいいとは思う

ドキドキ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を使う話」です! お楽しみに!!!