CbCによるPerl6処理系 |
Takahiro Shimizu, Shinji Kono
琉球大学
|
__code
と書く事で宣言出来る.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);
}
src/core/interp.c
で定義しており, この中の関数 MVM_interp_run
で命令に応じた処理を実行するOP
で宣言されたブロックがそれぞれオペコードに対応する処理となっている.GET_REG
などのマクロを用いてMoarVMのレジスタにアクセスする.cur_op
は次のオペコード列が登録されており, マクロ NEXT
で決められた方法で次のオペコードに遷移する.DISPATCH(NEXT_OP) {
OP(const_i64):
GET_REG(cur_op, 0).i64 = MVM_BC_get_I64(cur_op, 2);
cur_op += 10;
goto NEXT;
}
NEXT_OP
マクロを介して計算を行う.MVM_CGOTO
フラグが立っている場合はCのラベルgotoを利用し, 使えない場合はswitch文を利用して遷移する.#define NEXT_OP (op = *(MVMuint16 *)(cur_op), cur_op += 2, op)
#if MVM_CGOTO
#define DISPATCH(op)
#define OP(name) OP_ ## name
#define NEXT *LABELS[NEXT_OP]
#else
#define DISPATCH(op) switch (op)
#define OP(name) case MVM_OP_ ## name
#define NEXT runloop
#endif
LABELS
にアクセスし, ラベル情報を取得するstatic const void * const LABELS[] = {
&&OP_no_op,
&&OP_const_i8,
&&OP_const_i16,
&&OP_const_i32,
&&OP_const_i64,
&&OP_const_n32,
&&OP_const_n64,
&&OP_const_s,
&&OP_set,
&&OP_extend_u8,
&&OP_extend_u16,
&&OP_extend_u32,
&&OP_extend_i8,
&&OP_extend_i16,
cbc_next
というCodeGearから参照し, 以降はこのCodeGearの遷移として処理が継続される.#define NEXT_OP(i) (i->op = *(MVMuint16 *)(i
->cur_op), i->cur_op += 2, i->op)
#define DISPATCH(op) {goto (CODES[op])(i);}
#define OP(name) OP_ ## name
#define NEXT(i) CODES[NEXT_OP(i)](i)
static int tracing_enabled = 0;
_code cbc_next(INTERP i){
goto NEXT(i);
}
__code (* CODES[])(INTERP) = {
cbc_no_op,
cbc_const_i8,
cbc_const_i16,
cbc_const_i32,
cbc_const_i64,
cbc_const_n32,
cbc_const_n64,
cbc_const_s,
cbc_set,
cbc_extend_u8,
cbc_extend_u16,
typedef struct interp {
MVMuint16 op;
MVMuint8 *cur_op;
MVMuint8 *bytecode_start;
MVMRegister *reg_base;
/* Points to the current compilation unit
. */
MVMCompUnit *cu;
/* The current call site we’re
constructing. */
MVMCallsite *cur_callsite;
MVMThreadContext *tc;
} INTER,*INTERP;
OP(.*)
の(.*)
の部分をCodeGearの名前として先頭に cbc_
をつけた上で設定する.NEXT
を次のCodeGearにアクセスする為に cbc_next
に修正する.__code cbc_no_op(INTERP i){
goto cbc_next(i);
}
__code cbc_const_i8(INTERP i){
goto cbc_const_i16(i);
}
__code cbc_const_i16(INTERP i){
goto cbc_const_i32(i);
}
__code cbc_const_i32(INTERP i){
MVM_exception_throw_adhoc(i->tc, "const_iX NYI");
goto cbc_const_i64(i);
}
__code cbc_const_i64(INTERP i){
GET_REG(i->cur_op, 0,i).i64 = MVM_BC_get_I64(i->cur_op, 2);
i->cur_op += 10;
goto cbc_next(i);
}
__code cbc_pushcompsc(INTERP i){
MVMObject * sc;
sc = GET_REG(i->cur_op, 0,i).o;
if (REPR(sc)->ID != MVM_REPR_ID_SCRef)
MVM_exception_throw_adhoc(i->tc, "Can only push an SCRef with pushcompsc");
if (MVM_is_null(i->tc, i->tc->compiling_scs)) {
MVMROOT(i->tc, sc, {
i->tc->compiling_scs = MVM_repr_alloc_init(i->tc, i->tc->instance->boot_types.BOOTArray);
});
}
MVM_repr_unshift_o(i->tc, i->tc->compiling_scs, sc);
i->cur_op += 2;
goto cbc_next(i);
}
:=
を利用した束縛で行う, ++
演算子が使用できないなどの違いがあるsub add_test(int $n) {
my $sum := 0;
while nqp::isgt_i($n,1) {
$sum := nqp::add_i($sum,$n);
$n := nqp::sub_i($n,1);
}
return $sum;
}
say(add_test(10));
cbc_next
というCodeGearで行う(gdb) b cbc_next
Breakpoint 2 at 0x7ffff7560288: file src/core
/cbc-interp.cbc, line 61.
(gdb) command 2
Type commands for breakpoint(s) 2, one per
line.
End with a line saying just "end".
>p CODES[*(MVMuint16 *)i->cur_op]
>p *(MVMuint16 *)i->cur_op
>c
>end
dalmore gdb --args ../../MoarVM_Original/
MoarVM/moar --libpath=src/vm/moar/stage0
gen/moar/stage1/nqp
(gdb) b dummy
Function "dummy" not defined.
Make breakpoint pending on future shared
library load? (y or [n]) y
Breakpoint 1 (dummy) pending.
(gdb) command 1
Type commands for breakpoint(s) 1, one per
line.
End with a line saying just "end".
>up
>p *(MVMuint16 *)(cur_op)
>c
>end
Breakpoint 1, dummy () at src/core/interp.c
:46
46 }
#1 0x00007ffff75608fe in MVM_interp_run (tc=0
x604a20,
initial_invoke=0x7ffff76c7168 <
toplevel_initial_invoke>, invoke_data
=0x67ff10)
at src/core/interp.c:119
119 goto NEXT;
$1 = 159
Breakpoint 1, dummy () at src/core/interp.c
:46
46 }
#1 0x00007ffff75689da in MVM_interp_run (tc=0
x604a20,
initial_invoke=0x7ffff76c7168 <
toplevel_initial_invoke>, invoke_data
=0x67ff10)
at src/core/interp.c:1169
1169 goto NEXT;
$2 = 162
100 MVM_STATIC_INLINE MVMint64 MVM_BC_get_I64(const MVMuint8 *cur_op, int offset) {
101 const MVMuint8 *const where = cur_op + offset;
102 #ifdef MVM_CAN_UNALIGNED_INT64
103 return *(MVMint64 *)where;
104 #else
105 MVMint64 temp;
106 memmove(&temp, where, sizeof(MVMint64));
107 return temp;
108 #endif
109 }
131 : 131
139 : 139
140 : 140
144 : 144
558 : 558
391 : 391
749 : 749
53 : 53
*54 : 8
--cbc
を与えることによりCbCで動き, そうでない場合は通常のCで記述された箇所で実行される#! nqp
my $count := 100_000_000;
my $i := 0;
while ++$i <= $count {
}
#! nqp
sub fib($n) {
$n < 2 ?? $n !! fib($n-1) + fib($n - 2);
}
my $N := 29;
my $t0 := nqp::time_n();
my $z := fib($N);
my $t1 := nqp::time_n();
say("fib($N) = " ~ fib($N));
say("time = " ~ ($t1-$t0));