ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.pm
(Generate patch)

Comparing Faster/Faster.pm (file contents):
Revision 1.4 by root, Thu Mar 9 22:32:17 2006 UTC vs.
Revision 1.7 by root, Fri Mar 10 00:13:15 2006 UTC

… …
54 entertry unsafe 54 entertry unsafe
55 substconst unsafe 55 substconst unsafe
56 formline unsafe 56 formline unsafe
57 grepstart unsafe 57 grepstart unsafe
58 require unsafe 58 require unsafe
59 match unsafe todo
60 subst unsafe todo
61 entereval unsafe todo
62 mapstart unsafe todo
59 63
60 pushmark noasync 64 pushmark noasync
61 padsv noasync 65 padsv noasync
62 entersub noasync 66 entersub noasync
63 aassign noasync 67 aassign noasync
… …
94} 98}
95 99
96sub out_next { 100sub out_next {
97 my ($op) = @_; 101 my ($op) = @_;
98 102
103 if (${$op->next}) {
99 $source .= " nextop = (OP *)${$op->next}L;\n"; 104 $source .= " nextop = (OP *)${$op->next}L;\n";
100 $source .= " goto op_${$op->next};\n"; 105 $source .= " goto op_${$op->next};\n";
106 } else {
107 $source .= " return 0;\n";
108 }
101} 109}
102 110
103sub callop { 111sub callop {
104 my ($op) = @_; 112 my ($op) = @_;
105 113
106 my $name = $op->name; 114 my $name = $op->name;
107 115
108 $name eq "entersub" 116 $name eq "entersub"
109 ? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)" 117 ? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)"
118 : $name eq "mapstart"
119 ? "Perl_pp_grepstart (aTHX)"
110 : "Perl_pp_$name (aTHX)" 120 : "Perl_pp_$name (aTHX)"
111} 121}
112 122
113sub op_nextstate { 123sub op_nextstate {
114 my ($op) = @_; 124 my ($op) = @_;
115 125
… …
150 my ($op) = @_; 160 my ($op) = @_;
151 161
152 $source .= <<EOF; 162 $source .= <<EOF;
153 { 163 {
154 dSP; 164 dSP;
165
155 if (SvTRUE (TOPs)) 166 if (SvTRUE (TOPs))
156 { 167 {
157 --SP; 168 --SP;
158 PUTBACK; 169 PUTBACK;
159 nextop = (OP *)${$op->other}L; 170 nextop = (OP *)${$op->other}L;
160 goto op_${$op->other}; 171 goto op_${$op->other};
161 } 172 }
162
163 nextop = (OP *)${$op->next}L;
164 goto op_${$op->next};
165 } 173 }
166EOF 174EOF
175
176 out_next $op;
177}
178
179sub op_or {
180 my ($op) = @_;
181
182 $source .= <<EOF;
183 {
184 dSP;
185
186 if (!SvTRUE (TOPs))
187 {
188 --SP;
189 PUTBACK;
190 nextop = (OP *)${$op->other}L;
191 goto op_${$op->other};
192 }
193 }
194EOF
195
196 out_next $op;
167} 197}
168 198
169sub op_padsv { 199sub op_padsv {
170 my ($op) = @_; 200 my ($op) = @_;
171 201
… …
187 } 217 }
188 } 218 }
189 $source .= <<EOF; 219 $source .= <<EOF;
190 } 220 }
191EOF 221EOF
222
223 out_next $op;
224}
225
226sub op_aelemfast {
227 my ($op) = @_;
228
229 my $targ = $op->targ;
230 my $private = $op->private;
231
232 $source .= " {\n";
233
234 if ($op->flags & B::OPf_SPECIAL) {
235 $source .= " AV *av = (AV*)PAD_SV((PADOFFSET)$targ);\n";
236 } else {
237 $source .= " AV *av = GvAV ((GV *)${$op->sv}L);\n";
238 }
239
240 if ($op->flags & B::OPf_MOD) {
241 $source .= " SV *sv = *av_fetch (av, $private, 1);\n";
242 } else {
243 $source .= " SV **svp = av_fetch (av, $private, 0); SV *sv = svp ? *svp : &PL_sv_undef;\n";
244 }
245
246 if (!($op->flags & B::OPf_MOD)) {
247 $source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
248 }
249
250 $source .= " dSP;\n";
251 $source .= " XPUSHs (sv);\n";
252 $source .= " PUTBACK;\n";
253 $source .= " }\n";
192 254
193 out_next $op; 255 out_next $op;
194} 256}
195 257
196# pattern const+ (or general push1) 258# pattern const+ (or general push1)
… …
299 $source .= " PERL_ASYNC_CHECK ();\n"; 361 $source .= " PERL_ASYNC_CHECK ();\n";
300 } 362 }
301 363
302 if (my $can = __PACKAGE__->can ("op_$name")) { 364 if (my $can = __PACKAGE__->can ("op_$name")) {
303 $can->($op); 365 $can->($op);
366 } elsif (exists $flag{unsafe}{$name}) {
367 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
368 $source .= " PL_op = nextop; return " . (callop $op) . ";\n";
304 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) { 369 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) {
305 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 370 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
306 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 371 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
307 $source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n"; 372 $source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n";
308 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d# 373 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
309 $source .= " goto op_${$op->next};\n"; 374 $source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n";
310 } elsif (exists $flag{unsafe}{$name}) {
311 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
312 $source .= " PL_op = nextop; return " . (callop $op) . ";\n";
313 } else { 375 } else {
314 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 376 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
315 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 377 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
316 if ($name eq "entersub") { 378 if ($name eq "entersub") {
317 $source .= <<EOF; 379 $source .= <<EOF;
… …
321 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); 383 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
322 } 384 }
323EOF 385EOF
324 } 386 }
325 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d# 387 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
326 $source .= " goto op_${$op->next};\n"; 388 $source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n";
327 } 389 }
328 } 390 }
329 391
330 $source .= "}\n"; 392 $source .= "}\n";
331 #warn $source; 393 #warn $source;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines