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

Comparing Faster/Faster.pm (file contents):
Revision 1.7 by root, Fri Mar 10 00:13:15 2006 UTC vs.
Revision 1.8 by root, Fri Mar 10 01:51:14 2006 UTC

… …
35 35
36our $source; 36our $source;
37our $label_next; 37our $label_next;
38our $label_last; 38our $label_last;
39our $label_redo; 39our $label_redo;
40
41my @ops;
42my $op;
43my $op_name;
40 44
41my %flag; 45my %flag;
42 46
43for (split /\n/, <<EOF) { 47for (split /\n/, <<EOF) {
44 leavesub unsafe 48 leavesub unsafe
… …
54 entertry unsafe 58 entertry unsafe
55 substconst unsafe 59 substconst unsafe
56 formline unsafe 60 formline unsafe
57 grepstart unsafe 61 grepstart unsafe
58 require unsafe 62 require unsafe
59 match unsafe todo 63 match unsafe noasync todo
60 subst unsafe todo 64 subst unsafe noasync todo
61 entereval unsafe todo 65 entereval unsafe noasync todo
62 mapstart unsafe todo 66 mapstart unsafe noasync todo
63 67
68 mapwhile noasync
69 grepwhile noasync
70
71 seq noasync
64 pushmark noasync 72 pushmark noasync
65 padsv noasync 73 padsv noasync extend=1
74 padav noasync extend=1
75 padhv noasync extend=1
76 padany noasync extend=1
66 entersub noasync 77 entersub noasync
67 aassign noasync 78 aassign noasync
68 sassign noasync 79 sassign noasync
69 rv2av noasync 80 rv2av noasync
81 rv2cv noasync
82 rv2gv noasync
83 rv2hv noasync
84 refgen noasync
70 nextstate noasync 85 nextstate noasync
71 gv noasync 86 gv noasync
72 gvsv noasync 87 gvsv noasync
73 add noasync 88 add noasync
74 subtract noasync 89 subtract noasync
… …
77 complement noasync 92 complement noasync
78 cond_expr noasync 93 cond_expr noasync
79 and noasync 94 and noasync
80 or noasync 95 or noasync
81 not noasync 96 not noasync
97 defined noasync
82 method_named noasync 98 method_named noasync
83 preinc noasync 99 preinc noasync
84 postinc noasync 100 postinc noasync
85 predec noasync 101 predec noasync
86 postdec noasync 102 postdec noasync
87 stub noasync 103 stub noasync
88 unstack noasync 104 unstack noasync
89 leaveloop noasync 105 leaveloop noasync
90 shift noasync
91 aelemA noasync 106 aelem noasync
92 aelemfast noasync 107 aelemfast noasync
108 helem noasync
109 pushre noasync
110 const noasync extend=1
111 list noasync
112 join noasync
113 split noasync
114 concat noasync
115 push noasync
116 pop noasync
117 shift noasync
118 unshift noasync
119 require noasync
120 length noasync
121 substr noasync
122 stringify noasync
123 eq noasync
124 ne noasync
125 gt noasync
126 lt noasync
127 ge noasync
128 le noasync
129 enteriter noasync
130
131 iter async
93EOF 132EOF
94 my (undef, $op, @flags) = split /\s+/; 133 my (undef, $op, @flags) = split /\s+/;
95 134
96 undef $flag{$_}{$op} 135 undef $flag{$_}{$op}
97 for ("known", @flags); 136 for ("known", @flags);
98} 137}
99 138
139sub callop {
140 $op_name eq "entersub"
141 ? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)"
142 : $op_name eq "mapstart"
143 ? "Perl_pp_grepstart (aTHX)"
144 : "Perl_pp_$op_name (aTHX)"
145}
146
100sub out_next { 147sub out_next {
101 my ($op) = @_;
102
103 if (${$op->next}) { 148 if (${$op->next}) {
104 $source .= " nextop = (OP *)${$op->next}L;\n"; 149 $source .= " nextop = (OP *)${$op->next}L;\n";
150 $source .= " assert ((\"$op_name\", nextop == (OP *)${$op->next}));\n";
105 $source .= " goto op_${$op->next};\n"; 151 $source .= " goto op_${$op->next};\n";
106 } else { 152 } else {
107 $source .= " return 0;\n"; 153 $source .= " return 0;\n";
108 } 154 }
109} 155}
110 156
111sub callop { 157sub out_linear {
112 my ($op) = @_; 158 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";#d#
113 159 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
114 my $name = $op->name;
115
116 $name eq "entersub" 160 if ($op_name eq "entersub") {
117 ? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)" 161 $source .= <<EOF;
118 : $name eq "mapstart" 162 while (nextop != (OP *)${$op->next}L)
119 ? "Perl_pp_grepstart (aTHX)" 163 {
120 : "Perl_pp_$name (aTHX)" 164 PERL_ASYNC_CHECK ();
165 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
166 }
167EOF
168 }
169
170 out_next;
121} 171}
122 172
123sub op_nextstate { 173sub op_nextstate {
124 my ($op) = @_;
125
126 $source .= " PL_curcop = (COP *)nextop;\n"; 174 $source .= " PL_curcop = (COP *)nextop;\n";
127 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n"; 175 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n";
128 $source .= " FREETMPS;\n"; 176 $source .= " FREETMPS;\n";
129 177
130 out_next $op; 178 out_next;
131} 179}
132 180
133sub op_pushmark { 181sub op_pushmark {
134 my ($op) = @_;
135
136 $source .= " PUSHMARK (PL_stack_sp);\n"; 182 $source .= " PUSHMARK (PL_stack_sp);\n";
137 183
138 out_next $op; 184 out_next;
139} 185}
140 186
141sub op_const { 187if ($Config{useithreads} ne "define") {
142 my ($op) = @_; 188 # disable optimisations on ithreads
143 189
190 *op_const = sub {
144 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; 191 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
145 192
146 out_next $op; 193 out_next;
147} 194 };
148 195
149*op_gv = \&op_const; 196 *op_gv = \&op_const;
197
198 *op_aelemfast = sub {
199 my $targ = $op->targ;
200 my $private = $op->private;
201
202 $source .= " {\n";
203
204 if ($op->flags & B::OPf_SPECIAL) {
205 $source .= " AV *av = (AV*)PAD_SV((PADOFFSET)$targ);\n";
206 } else {
207 $source .= " AV *av = GvAV ((GV *)${$op->sv}L);\n";
208 }
209
210 if ($op->flags & B::OPf_MOD) {
211 $source .= " SV *sv = *av_fetch (av, $private, 1);\n";
212 } else {
213 $source .= " SV **svp = av_fetch (av, $private, 0); SV *sv = svp ? *svp : &PL_sv_undef;\n";
214 }
215
216 if (!($op->flags & B::OPf_MOD)) {
217 $source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
218 }
219
220 $source .= " dSP;\n";
221 $source .= " XPUSHs (sv);\n";
222 $source .= " PUTBACK;\n";
223 $source .= " }\n";
224
225 out_next;
226 };
227
228 *op_gvsv = sub {
229 $source .= " {\n";
230 $source .= " dSP;\n";
231 $source .= " EXTEND (SP, 1);\n";
232
233 if ($op->private & B::OPpLVAL_INTRO) {
234 $source .= " PUSHs (save_scalar ((GV *)${$op->sv}L));\n";
235 } else {
236 $source .= " PUSHs (GvSV ((GV *)${$op->sv}L));\n";
237 }
238
239 $source .= " PUTBACK;\n";
240 $source .= " }\n";
241
242 out_next;
243 };
244}
150 245
151sub op_stringify { 246sub op_stringify {
152 my ($op) = @_;
153
154 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n"; 247 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n";
155 248
156 out_next $op; 249 out_next;
157} 250}
158 251
159sub op_and { 252sub op_and {
160 my ($op) = @_;
161
162 $source .= <<EOF; 253 $source .= <<EOF;
163 { 254 {
164 dSP; 255 dSP;
165 256
166 if (SvTRUE (TOPs)) 257 if (SvTRUE (TOPs))
… …
171 goto op_${$op->other}; 262 goto op_${$op->other};
172 } 263 }
173 } 264 }
174EOF 265EOF
175 266
176 out_next $op; 267 out_next;
177} 268}
178 269
179sub op_or { 270sub op_or {
180 my ($op) = @_;
181
182 $source .= <<EOF; 271 $source .= <<EOF;
183 { 272 {
184 dSP; 273 dSP;
185 274
186 if (!SvTRUE (TOPs)) 275 if (!SvTRUE (TOPs))
… …
191 goto op_${$op->other}; 280 goto op_${$op->other};
192 } 281 }
193 } 282 }
194EOF 283EOF
195 284
196 out_next $op; 285 out_next;
197} 286}
198 287
199sub op_padsv { 288sub op_padsv {
200 my ($op) = @_;
201
202 my $flags = $op->flags; 289 my $flags = $op->flags;
203 my $target = $op->targ; 290 my $target = $op->targ;
204 291
205 $source .= <<EOF; 292 $source .= <<EOF;
206 { 293 {
… …
218 } 305 }
219 $source .= <<EOF; 306 $source .= <<EOF;
220 } 307 }
221EOF 308EOF
222 309
223 out_next $op; 310 out_next;
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";
254
255 out_next $op;
256} 311}
257 312
258# pattern const+ (or general push1) 313# pattern const+ (or general push1)
259# pattern pushmark return(?) 314# pattern pushmark return(?)
260# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign 315# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign
261 316
262# pattern const method_named 317# pattern const method_named
263sub op_method_named { 318sub op_method_named {
264 my ($op) = @_;
265
266 $source .= <<EOF; 319 $source .= <<EOF;
267 { 320 {
268 static HV *last_stash; 321 static HV *last_stash;
269 static SV *last_res; 322 static SV *last_res;
270 323
… …
298 nextop = Perl_pp_method_named (aTHX); 351 nextop = Perl_pp_method_named (aTHX);
299 } 352 }
300 } 353 }
301EOF 354EOF
302 355
303 out_next $op; 356 out_next;
304} 357}
305 358
306sub cv2c { 359sub cv2c {
307 my ($cv) = @_; 360 my ($cv) = @_;
308 361
309 my %opsseen; 362 my %opsseen;
310 my @ops;
311 my @todo = $cv->START; 363 my @todo = $cv->START;
312 364
313 while (my $op = shift @todo) { 365 while (my $op = shift @todo) {
314 for (; $$op; $op = $op->next) { 366 for (; $$op; $op = $op->next) {
315 last if $opsseen{$$op}++; 367 last if $opsseen{$$op}++;
… …
334 } 386 }
335 387
336 local $source = <<EOF; 388 local $source = <<EOF;
337#define PERL_NO_GET_CONTEXT 389#define PERL_NO_GET_CONTEXT
338 390
391//#define NDEBUG 1
339#include <assert.h> 392#include <assert.h>
340 393
341#include "EXTERN.h" 394#include "EXTERN.h"
342#include "perl.h" 395#include "perl.h"
343#include "XSUB.h" 396#include "XSUB.h"
344 397
345/*typedef OP *(*PPFUNC)(pTHX);*/
346
347OP *%%%FUNC%%% (pTHX) 398OP *%%%FUNC%%% (pTHX)
348{ 399{
349 register OP *nextop = (OP *)${$ops[0]}L; 400 register OP *nextop = (OP *)${$ops[0]}L;
350EOF 401EOF
351 402
352 for my $op (@ops) { 403 while (@ops) {
404 $op = shift @ops;
353 my $name = $op->name; 405 $op_name = $op->name;
354 my $ppaddr = ppaddr $op->type;
355 406
356 $source .= "op_$$op: /* $name */\n"; 407 $source .= "op_$$op: /* $op_name */\n";
357 #$source .= "fprintf (stderr, \"$$op in op $name\\n\");\n";#d# 408 #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d#
358 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d# 409 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
359 410
360 unless (exists $flag{noasync}{$name}) { 411 unless (exists $flag{noasync}{$op_name}) {
361 $source .= " PERL_ASYNC_CHECK ();\n"; 412 $source .= " PERL_ASYNC_CHECK ();\n";
362 } 413 }
363 414
364 if (my $can = __PACKAGE__->can ("op_$name")) { 415 if (my $can = __PACKAGE__->can ("op_$op_name")) {
365 $can->($op); 416 $can->($op);
366 } elsif (exists $flag{unsafe}{$name}) { 417 } elsif (exists $flag{unsafe}{$op_name}) {
367 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 418 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";
368 $source .= " PL_op = nextop; return " . (callop $op) . ";\n"; 419 $source .= " PL_op = nextop; return " . (callop $op) . ";\n";
369 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) { 420 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$op_name}) {
370 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 421 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";
371 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 422 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
372 $source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n"; 423 $source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n";
373 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d# 424 $source .= " assert ((\"$op_name\", nextop == (OP *)${$op->next}));\n";
374 $source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n"; 425 $source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n";
375 } else { 426 } else {
376 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 427 out_linear;
377 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
378 if ($name eq "entersub") {
379 $source .= <<EOF;
380while (nextop != (OP *)${$op->next})
381 {
382 PERL_ASYNC_CHECK ();
383 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
384 }
385EOF
386 }
387 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
388 $source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n";
389 } 428 }
390 } 429 }
391 430
392 $source .= "}\n"; 431 $source .= "}\n";
393 #warn $source; 432 #warn $source;

Diff Legend

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