?? cc.pm
字號(hào):
my $op = shift;
# XXX Preserve original label name for "real" labels?
return sprintf("lab_%x", $$op);
}
sub write_label {
my $op = shift;
push_runtime(sprintf(" %s:", label($op)));
}
sub loadop {
my $op = shift;
my $opsym = $op->save;
runtime("PL_op = $opsym;") unless $know_op;
return $opsym;
}
sub doop {
my $op = shift;
my $ppname = $op->ppaddr;
my $sym = loadop($op);
runtime("DOOP($ppname);");
$know_op = 1;
return $sym;
}
sub gimme {
my $op = shift;
my $flags = $op->flags;
return (($flags & OPf_KNOW) ? ($flags & OPf_LIST) : "dowantarray()");
}
#
# Code generation for PP code
#
sub pp_null {
my $op = shift;
return $op->next;
}
sub pp_stub {
my $op = shift;
my $gimme = gimme($op);
if ($gimme != 1) {
# XXX Change to push a constant sv_undef Stackobj onto @stack
write_back_stack();
runtime("if ($gimme != G_ARRAY) XPUSHs(&PL_sv_undef);");
}
return $op->next;
}
sub pp_unstack {
my $op = shift;
@stack = ();
runtime("PP_UNSTACK;");
return $op->next;
}
sub pp_and {
my $op = shift;
my $next = $op->next;
unshift(@bblock_todo, $next);
if (@stack >= 1) {
my $bool = pop_bool();
write_back_stack();
runtime(sprintf("if (!$bool) goto %s;", label($next)));
} else {
runtime(sprintf("if (!%s) goto %s;", top_bool(), label($next)),
"*sp--;");
}
return $op->other;
}
sub pp_or {
my $op = shift;
my $next = $op->next;
reload_lexicals();
unshift(@bblock_todo, $next);
if (@stack >= 1) {
my $obj = pop @stack;
write_back_stack();
runtime(sprintf("if (%s) { XPUSHs(%s); goto %s; }",
$obj->as_numeric, $obj->as_sv, label($next)));
} else {
runtime(sprintf("if (%s) goto %s;", top_bool(), label($next)),
"*sp--;");
}
return $op->other;
}
sub pp_cond_expr {
my $op = shift;
my $false = $op->false;
unshift(@bblock_todo, $false);
reload_lexicals();
my $bool = pop_bool();
write_back_stack();
runtime(sprintf("if (!$bool) goto %s;", label($false)));
return $op->true;
}
sub pp_padsv {
my $op = shift;
my $ix = $op->targ;
push(@stack, $pad[$ix]);
if ($op->flags & OPf_MOD) {
my $private = $op->private;
if ($private & OPpLVAL_INTRO) {
runtime("SAVECLEARSV(PL_curpad[$ix]);");
} elsif ($private & OPpDEREF) {
runtime(sprintf("vivify_ref(PL_curpad[%d], %d);",
$ix, $private & OPpDEREF));
$pad[$ix]->invalidate;
}
}
return $op->next;
}
sub pp_const {
my $op = shift;
my $sv = $op->sv;
my $obj = $constobj{$$sv};
if (!defined($obj)) {
$obj = $constobj{$$sv} = new B::Stackobj::Const ($sv);
}
push(@stack, $obj);
return $op->next;
}
sub pp_nextstate {
my $op = shift;
$curcop->load($op);
@stack = ();
debug(sprintf("%s:%d\n", $op->filegv->SV->PV, $op->line)) if $debug_lineno;
runtime("TAINT_NOT;") unless $omit_taint;
runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;");
if ($freetmps_each_bblock || $freetmps_each_loop) {
$need_freetmps = 1;
} else {
runtime("FREETMPS;");
}
return $op->next;
}
sub pp_dbstate {
my $op = shift;
$curcop->invalidate; # XXX?
return default_pp($op);
}
sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
sub pp_bless { $curcop->write_back; default_pp(@_) }
sub pp_repeat { $curcop->write_back; default_pp(@_) }
# The following subs need $curcop->write_back if we decide to support arybase:
# pp_pos, pp_substr, pp_index, pp_rindex, pp_aslice, pp_lslice, pp_splice
sub pp_sort { $curcop->write_back; default_pp(@_) }
sub pp_caller { $curcop->write_back; default_pp(@_) }
sub pp_reset { $curcop->write_back; default_pp(@_) }
sub pp_gv {
my $op = shift;
my $gvsym = $op->gv->save;
write_back_stack();
runtime("XPUSHs((SV*)$gvsym);");
return $op->next;
}
sub pp_gvsv {
my $op = shift;
my $gvsym = $op->gv->save;
write_back_stack();
if ($op->private & OPpLVAL_INTRO) {
runtime("XPUSHs(save_scalar($gvsym));");
} else {
runtime("XPUSHs(GvSV($gvsym));");
}
return $op->next;
}
sub pp_aelemfast {
my $op = shift;
my $gvsym = $op->gv->save;
my $ix = $op->private;
my $flag = $op->flags & OPf_MOD;
write_back_stack();
runtime("svp = av_fetch(GvAV($gvsym), $ix, $flag);",
"PUSHs(svp ? *svp : &PL_sv_undef);");
return $op->next;
}
sub int_binop {
my ($op, $operator) = @_;
if ($op->flags & OPf_STACKED) {
my $right = pop_int();
if (@stack >= 1) {
my $left = top_int();
$stack[-1]->set_int(&$operator($left, $right));
} else {
runtime(sprintf("sv_setiv(TOPs, %s);",&$operator("TOPi", $right)));
}
} else {
my $targ = $pad[$op->targ];
my $right = new B::Pseudoreg ("IV", "riv");
my $left = new B::Pseudoreg ("IV", "liv");
runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int));
$targ->set_int(&$operator($$left, $$right));
push(@stack, $targ);
}
return $op->next;
}
sub INTS_CLOSED () { 0x1 }
sub INT_RESULT () { 0x2 }
sub NUMERIC_RESULT () { 0x4 }
sub numeric_binop {
my ($op, $operator, $flags) = @_;
my $force_int = 0;
$force_int ||= ($flags & INT_RESULT);
$force_int ||= ($flags & INTS_CLOSED && @stack >= 2
&& valid_int($stack[-2]) && valid_int($stack[-1]));
if ($op->flags & OPf_STACKED) {
my $right = pop_numeric();
if (@stack >= 1) {
my $left = top_numeric();
if ($force_int) {
$stack[-1]->set_int(&$operator($left, $right));
} else {
$stack[-1]->set_numeric(&$operator($left, $right));
}
} else {
if ($force_int) {
runtime(sprintf("sv_setiv(TOPs, %s);",
&$operator("TOPi", $right)));
} else {
runtime(sprintf("sv_setnv(TOPs, %s);",
&$operator("TOPn", $right)));
}
}
} else {
my $targ = $pad[$op->targ];
$force_int ||= ($targ->{type} == T_INT);
if ($force_int) {
my $right = new B::Pseudoreg ("IV", "riv");
my $left = new B::Pseudoreg ("IV", "liv");
runtime(sprintf("$$right = %s; $$left = %s;",
pop_numeric(), pop_numeric));
$targ->set_int(&$operator($$left, $$right));
} else {
my $right = new B::Pseudoreg ("double", "rnv");
my $left = new B::Pseudoreg ("double", "lnv");
runtime(sprintf("$$right = %s; $$left = %s;",
pop_numeric(), pop_numeric));
$targ->set_numeric(&$operator($$left, $$right));
}
push(@stack, $targ);
}
return $op->next;
}
sub sv_binop {
my ($op, $operator, $flags) = @_;
if ($op->flags & OPf_STACKED) {
my $right = pop_sv();
if (@stack >= 1) {
my $left = top_sv();
if ($flags & INT_RESULT) {
$stack[-1]->set_int(&$operator($left, $right));
} elsif ($flags & NUMERIC_RESULT) {
$stack[-1]->set_numeric(&$operator($left, $right));
} else {
# XXX Does this work?
runtime(sprintf("sv_setsv($left, %s);",
&$operator($left, $right)));
$stack[-1]->invalidate;
}
} else {
my $f;
if ($flags & INT_RESULT) {
} elsif ($flags & NUMERIC_RESULT) {
$f = "sv_setnv";
} else {
$f = "sv_setsv";
}
runtime(sprintf("%s(TOPs, %s);", $f, &$operator("TOPs", $right)));
}
} else {
my $targ = $pad[$op->targ];
runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv));
if ($flags & INT_RESULT) {
$targ->set_int(&$operator("left", "right"));
} elsif ($flags & NUMERIC_RESULT) {
$targ->set_numeric(&$operator("left", "right"));
} else {
# XXX Does this work?
runtime(sprintf("sv_setsv(%s, %s);",
$targ->as_sv, &$operator("left", "right")));
$targ->invalidate;
}
push(@stack, $targ);
}
return $op->next;
}
sub bool_int_binop {
my ($op, $operator) = @_;
my $right = new B::Pseudoreg ("IV", "riv");
my $left = new B::Pseudoreg ("IV", "liv");
runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int()));
my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
$bool->set_int(&$operator($$left, $$right));
push(@stack, $bool);
return $op->next;
}
sub bool_numeric_binop {
my ($op, $operator) = @_;
my $right = new B::Pseudoreg ("double", "rnv");
my $left = new B::Pseudoreg ("double", "lnv");
runtime(sprintf("$$right = %s; $$left = %s;",
pop_numeric(), pop_numeric()));
my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
$bool->set_numeric(&$operator($$left, $$right));
push(@stack, $bool);
return $op->next;
}
sub bool_sv_binop {
my ($op, $operator) = @_;
runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv()));
my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
$bool->set_numeric(&$operator("left", "right"));
push(@stack, $bool);
return $op->next;
}
sub infix_op {
my $opname = shift;
return sub { "$_[0] $opname $_[1]" }
}
sub prefix_op {
my $opname = shift;
return sub { sprintf("%s(%s)", $opname, join(", ", @_)) }
}
my $plus_op = infix_op("+");
my $minus_op = infix_op("-");
my $multiply_op = infix_op("*");
my $divide_op = infix_op("/");
my $modulo_op = infix_op("%");
my $lshift_op = infix_op("<<");
my $rshift_op = infix_op(">>");
my $ncmp_op = sub { "($_[0] > $_[1] ? 1 : ($_[0] < $_[1]) ? -1 : 0)" };
my $scmp_op = prefix_op("sv_cmp");
my $seq_op = prefix_op("sv_eq");
my $sne_op = prefix_op("!sv_eq");
my $slt_op = sub { "sv_cmp($_[0], $_[1]) < 0" };
my $sgt_op = sub { "sv_cmp($_[0], $_[1]) > 0" };
my $sle_op = sub { "sv_cmp($_[0], $_[1]) <= 0" };
my $sge_op = sub { "sv_cmp($_[0], $_[1]) >= 0" };
my $eq_op = infix_op("==");
my $ne_op = infix_op("!=");
my $lt_op = infix_op("<");
my $gt_op = infix_op(">");
my $le_op = infix_op("<=");
my $ge_op = infix_op(">=");
#
# XXX The standard perl PP code has extra handling for
# some special case arguments of these operators.
#
sub pp_add { numeric_binop($_[0], $plus_op, INTS_CLOSED) }
sub pp_subtract { numeric_binop($_[0], $minus_op, INTS_CLOSED) }
sub pp_multiply { numeric_binop($_[0], $multiply_op, INTS_CLOSED) }
sub pp_divide { numeric_binop($_[0], $divide_op) }
sub pp_modulo { int_binop($_[0], $modulo_op) } # differs from perl's
sub pp_ncmp { numeric_binop($_[0], $ncmp_op, INT_RESULT) }
sub pp_left_shift { int_binop($_[0], $lshift_op) }
sub pp_right_shift { int_binop($_[0], $rshift_op) }
sub pp_i_add { int_binop($_[0], $plus_op) }
sub pp_i_subtract { int_binop($_[0], $minus_op) }
sub pp_i_multiply { int_binop($_[0], $multiply_op) }
sub pp_i_divide { int_binop($_[0], $divide_op) }
sub pp_i_modulo { int_binop($_[0], $modulo_op) }
sub pp_eq { bool_numeric_binop($_[0], $eq_op) }
sub pp_ne { bool_numeric_binop($_[0], $ne_op) }
sub pp_lt { bool_numeric_binop($_[0], $lt_op) }
sub pp_gt { bool_numeric_binop($_[0], $gt_op) }
sub pp_le { bool_numeric_binop($_[0], $le_op) }
sub pp_ge { bool_numeric_binop($_[0], $ge_op) }
sub pp_i_eq { bool_int_binop($_[0], $eq_op) }
sub pp_i_ne { bool_int_binop($_[0], $ne_op) }
sub pp_i_lt { bool_int_binop($_[0], $lt_op) }
sub pp_i_gt { bool_int_binop($_[0], $gt_op) }
sub pp_i_le { bool_int_binop($_[0], $le_op) }
sub pp_i_ge { bool_int_binop($_[0], $ge_op) }
sub pp_scmp { sv_binop($_[0], $scmp_op, INT_RESULT) }
sub pp_slt { bool_sv_binop($_[0], $slt_op) }
sub pp_sgt { bool_sv_binop($_[0], $sgt_op) }
sub pp_sle { bool_sv_binop($_[0], $sle_op) }
sub pp_sge { bool_sv_binop($_[0], $sge_op) }
sub pp_seq { bool_sv_binop($_[0], $seq_op) }
sub pp_sne { bool_sv_binop($_[0], $sne_op) }
}
sub pp_sassign {
my $op = shift;
my $backwards = $op->private & OPpASSIGN_BACKWARDS;
my ($dst, $src);
if (@stack >= 2) {
$dst = pop @stack;
$src = pop @stack;
($src, $dst) = ($dst, $src) if $backwards;
my $type = $src->{type};
if ($type == T_INT) {
$dst->set_int($src->as_int);
} elsif ($type == T_DOUBLE) {
$dst->set_numeric($src->as_numeric);
} else {
$dst->set_sv($src->as_sv);
}
push(@stack, $dst);
} elsif (@stack == 1) {
if ($backwards) {
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -