| … | |
… | |
| 68 | our $op; |
68 | our $op; |
| 69 | our $op_name; |
69 | our $op_name; |
| 70 | our @op_loop; |
70 | our @op_loop; |
| 71 | our %op_regcomp; |
71 | our %op_regcomp; |
| 72 | |
72 | |
| 73 | my %flag; |
73 | my %f_unsafe = map +($_ => undef), qw( |
|
|
74 | leavesub leavesublv return |
|
|
75 | goto last redo next |
|
|
76 | eval flip leaveeval entertry |
|
|
77 | formline grepstart mapstart |
|
|
78 | substcont entereval require |
|
|
79 | ); |
| 74 | |
80 | |
| 75 | # complex flag steting is no longer required, rewrite this ugly code |
|
|
| 76 | for (split /\n/, <<EOF) { |
|
|
| 77 | leavesub unsafe |
|
|
| 78 | leavesublv unsafe |
|
|
| 79 | return unsafe |
|
|
| 80 | flip unsafe |
|
|
| 81 | goto unsafe |
|
|
| 82 | last unsafe |
|
|
| 83 | redo unsafe |
|
|
| 84 | next unsafe |
|
|
| 85 | eval unsafe |
|
|
| 86 | leaveeval unsafe |
|
|
| 87 | entertry unsafe |
|
|
| 88 | formline unsafe |
|
|
| 89 | grepstart unsafe |
|
|
| 90 | mapstart unsafe |
|
|
| 91 | substcont unsafe |
|
|
| 92 | entereval unsafe noasync todo |
|
|
| 93 | require unsafe |
|
|
| 94 | |
|
|
| 95 | mapstart noasync |
|
|
| 96 | grepstart noasync |
|
|
| 97 | match noasync |
|
|
| 98 | |
|
|
| 99 | last noasync |
|
|
| 100 | next noasync |
|
|
| 101 | redo noasync |
|
|
| 102 | seq noasync |
|
|
| 103 | pushmark noasync extend=0 |
81 | # pushmark extend=0 |
| 104 | padsv noasync extend=1 |
82 | # padsv extend=1 |
| 105 | padav noasync extend=1 |
83 | # padav extend=1 |
| 106 | padhv noasync extend=1 |
84 | # padhv extend=1 |
| 107 | padany noasync extend=1 |
85 | # padany extend=1 |
| 108 | entersub noasync |
86 | # const extend=1 |
| 109 | aassign noasync |
87 | |
| 110 | sassign noasync |
88 | my %f_noasync = map +($_ => undef), qw( |
| 111 | rv2av noasync |
89 | mapstart grepstart match entereval |
| 112 | rv2cv noasync |
90 | enteriter entersub leaveloop |
| 113 | rv2gv noasync |
91 | |
| 114 | rv2hv noasync |
92 | pushmark nextstate |
| 115 | refgen noasync |
93 | |
| 116 | nextstate noasync |
94 | const stub unstack |
| 117 | gv noasync |
95 | last next redo seq |
| 118 | gvsv noasync |
96 | padsv padav padhv padany |
| 119 | add noasync |
97 | aassign sassign orassign |
| 120 | subtract noasync |
98 | rv2av rv2cv rv2gv rv2hv refgen |
| 121 | multiply noasync |
99 | gv gvsv |
| 122 | divide noasync |
100 | add subtract multiply divide |
| 123 | complement noasync |
101 | complement cond_expr and or not |
| 124 | cond_expr noasync |
102 | defined |
| 125 | and noasync |
|
|
| 126 | or noasync |
|
|
| 127 | not noasync |
|
|
| 128 | defined noasync |
|
|
| 129 | method_named noasync |
103 | method_named |
| 130 | preinc noasync |
104 | preinc postinc predec postdec |
| 131 | postinc noasync |
105 | aelem aelemfast helem delete exists |
| 132 | predec noasync |
106 | pushre subst list join split concat |
| 133 | postdec noasync |
107 | length substr stringify ord |
| 134 | stub noasync |
108 | push pop shift unshift |
| 135 | unstack noasync |
109 | eq ne gt lt ge le |
| 136 | leaveloop noasync |
110 | regcomp regcreset regcmaybe |
| 137 | aelem noasync |
111 | ); |
| 138 | aelemfast noasync |
|
|
| 139 | helem noasync |
|
|
| 140 | delete noasync |
|
|
| 141 | exists noasync |
|
|
| 142 | pushre noasync |
|
|
| 143 | subst noasync |
|
|
| 144 | const noasync extend=1 |
|
|
| 145 | list noasync |
|
|
| 146 | join noasync |
|
|
| 147 | split noasync |
|
|
| 148 | concat noasync |
|
|
| 149 | push noasync |
|
|
| 150 | pop noasync |
|
|
| 151 | shift noasync |
|
|
| 152 | unshift noasync |
|
|
| 153 | length noasync |
|
|
| 154 | substr noasync |
|
|
| 155 | stringify noasync |
|
|
| 156 | eq noasync |
|
|
| 157 | ne noasync |
|
|
| 158 | gt noasync |
|
|
| 159 | lt noasync |
|
|
| 160 | ge noasync |
|
|
| 161 | le noasync |
|
|
| 162 | enteriter noasync |
|
|
| 163 | ord noasync |
|
|
| 164 | orassign noasync |
|
|
| 165 | regcomp noasync |
|
|
| 166 | regcreset noasync |
|
|
| 167 | regcmaybe noasync |
|
|
| 168 | |
|
|
| 169 | iter async |
|
|
| 170 | EOF |
|
|
| 171 | my (undef, $op, @flags) = split /\s+/; |
|
|
| 172 | |
|
|
| 173 | undef $flag{$_}{$op} |
|
|
| 174 | for ("known", @flags); |
|
|
| 175 | } |
|
|
| 176 | |
112 | |
| 177 | my %callop = ( |
113 | my %callop = ( |
| 178 | entersub => "(PL_ppaddr [OP_ENTERSUB]) (aTHX)", |
114 | entersub => "(PL_ppaddr [OP_ENTERSUB]) (aTHX)", |
| 179 | mapstart => "Perl_pp_grepstart (aTHX)", |
115 | mapstart => "Perl_pp_grepstart (aTHX)", |
| 180 | ); |
116 | ); |
| … | |
… | |
| 509 | $source .= "op_$$op: /* $op_name */\n"; |
445 | $source .= "op_$$op: /* $op_name */\n"; |
| 510 | #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d# |
446 | #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d# |
| 511 | #$source .= "{ dSP; sv_dump (TOPs); }\n";#d# |
447 | #$source .= "{ dSP; sv_dump (TOPs); }\n";#d# |
| 512 | |
448 | |
| 513 | $source .= " PERL_ASYNC_CHECK ();\n" |
449 | $source .= " PERL_ASYNC_CHECK ();\n" |
| 514 | unless exists $flag{noasync}{$op_name}; |
450 | unless exists $f_noasync{$op_name}; |
| 515 | |
451 | |
| 516 | if (my $can = __PACKAGE__->can ("op_$op_name")) { |
452 | if (my $can = __PACKAGE__->can ("op_$op_name")) { |
| 517 | # handcrafted replacement |
453 | # handcrafted replacement |
| 518 | $can->($op); |
454 | $can->($op); |
| 519 | |
455 | |
| 520 | } elsif (exists $flag{unsafe}{$op_name}) { |
456 | } elsif (exists $f_unsafe{$op_name}) { |
| 521 | # unsafe, return to interpreter |
457 | # unsafe, return to interpreter |
| 522 | assert "nextop == (OP *)$$op"; |
458 | assert "nextop == (OP *)$$op"; |
| 523 | $source .= " return nextop;\n"; |
459 | $source .= " return nextop;\n"; |
| 524 | |
460 | |
| 525 | } elsif ("LOGOP" eq B::class $op) { |
461 | } elsif ("LOGOP" eq B::class $op) { |
