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

Comparing Faster/Faster.pm (file contents):
Revision 1.6 by root, Fri Mar 10 00:11:44 2006 UTC vs.
Revision 1.10 by root, Fri Mar 10 02:03:50 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_gotonext {
101 my ($op) = @_;
102
103 if (${$op->next}) { 148 if (${$op->next}) {
104 $source .= " nextop = (OP *)${$op->next}L;\n"; 149 $source .= " assert ((\"$op_name\", nextop == (OP *)${$op->next}));\n";
105 $source .= " goto op_${$op->next};\n"; 150 $source .= " goto op_${$op->next};\n";
106 } else { 151 } else {
107 $source .= " return 0;\n"; 152 $source .= " return 0;\n";
108 } 153 }
109} 154}
110 155
111sub callop { 156sub out_next {
112 my ($op) = @_; 157 $source .= " nextop = (OP *)${$op->next}L;\n";
113 158
114 my $name = $op->name; 159 out_gotonext;
160}
115 161
162sub out_linear {
163 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";#d#
164 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
116 $name eq "entersub" 165 if ($op_name eq "entersub") {
117 ? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)" 166 $source .= <<EOF;
118 : $name eq "mapstart" 167 while (nextop != (OP *)${$op->next}L)
119 ? "Perl_pp_grepstart (aTHX)" 168 {
120 : "Perl_pp_$name (aTHX)" 169 PERL_ASYNC_CHECK ();
170 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
171 }
172EOF
173 }
174
175 out_gotonext;
121} 176}
122 177
123sub op_nextstate { 178sub op_nextstate {
124 my ($op) = @_;
125
126 $source .= " PL_curcop = (COP *)nextop;\n"; 179 $source .= " PL_curcop = (COP *)nextop;\n";
127 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n"; 180 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n";
128 $source .= " FREETMPS;\n"; 181 $source .= " FREETMPS;\n";
129 182
130 out_next $op; 183 out_next;
131} 184}
132 185
133sub op_pushmark { 186sub op_pushmark {
134 my ($op) = @_;
135
136 $source .= " PUSHMARK (PL_stack_sp);\n"; 187 $source .= " PUSHMARK (PL_stack_sp);\n";
137 188
138 out_next $op; 189 out_next;
139} 190}
140 191
141sub op_const { 192if ($Config{useithreads} ne "define") {
142 my ($op) = @_; 193 # disable optimisations on ithreads
143 194
195 *op_const = sub {
144 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; 196 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
145 197
146 out_next $op; 198 out_next;
147} 199 };
148 200
149*op_gv = \&op_const; 201 *op_gv = \&op_const;
202
203 *op_aelemfast = sub {
204 my $targ = $op->targ;
205 my $private = $op->private;
206
207 $source .= " {\n";
208
209 if ($op->flags & B::OPf_SPECIAL) {
210 $source .= " AV *av = (AV*)PAD_SV((PADOFFSET)$targ);\n";
211 } else {
212 $source .= " AV *av = GvAV ((GV *)${$op->sv}L);\n";
213 }
214
215 if ($op->flags & B::OPf_MOD) {
216 $source .= " SV *sv = *av_fetch (av, $private, 1);\n";
217 } else {
218 $source .= " SV **svp = av_fetch (av, $private, 0); SV *sv = svp ? *svp : &PL_sv_undef;\n";
219 }
220
221 if (!($op->flags & B::OPf_MOD)) {
222 $source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
223 }
224
225 $source .= " dSP;\n";
226 $source .= " XPUSHs (sv);\n";
227 $source .= " PUTBACK;\n";
228 $source .= " }\n";
229
230 out_next;
231 };
232
233 *op_gvsv = sub {
234 $source .= " {\n";
235 $source .= " dSP;\n";
236 $source .= " EXTEND (SP, 1);\n";
237
238 if ($op->private & B::OPpLVAL_INTRO) {
239 $source .= " PUSHs (save_scalar ((GV *)${$op->sv}L));\n";
240 } else {
241 $source .= " PUSHs (GvSV ((GV *)${$op->sv}L));\n";
242 }
243
244 $source .= " PUTBACK;\n";
245 $source .= " }\n";
246
247 out_next;
248 };
249}
150 250
151sub op_stringify { 251sub op_stringify {
152 my ($op) = @_;
153
154 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n"; 252 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n";
155 253
156 out_next $op; 254 out_next;
157} 255}
158 256
159sub op_and { 257sub op_and {
160 my ($op) = @_;
161
162 $source .= <<EOF; 258 $source .= <<EOF;
163 { 259 {
164 dSP; 260 dSP;
165 261
166 if (SvTRUE (TOPs)) 262 if (SvTRUE (TOPs))
… …
171 goto op_${$op->other}; 267 goto op_${$op->other};
172 } 268 }
173 } 269 }
174EOF 270EOF
175 271
176 out_next $op; 272 out_next;
273}
274
275sub op_or {
276 $source .= <<EOF;
277 {
278 dSP;
279
280 if (!SvTRUE (TOPs))
281 {
282 --SP;
283 PUTBACK;
284 nextop = (OP *)${$op->other}L;
285 goto op_${$op->other};
286 }
287 }
288EOF
289
290 out_next;
177} 291}
178 292
179sub op_padsv { 293sub op_padsv {
180 my ($op) = @_;
181
182 my $flags = $op->flags; 294 my $flags = $op->flags;
183 my $target = $op->targ; 295 my $target = $op->targ;
184 296
185 $source .= <<EOF; 297 $source .= <<EOF;
186 { 298 {
… …
198 } 310 }
199 $source .= <<EOF; 311 $source .= <<EOF;
200 } 312 }
201EOF 313EOF
202 314
203 out_next $op; 315 out_next;
204}
205
206sub op_aelemfast {
207 my ($op) = @_;
208
209 my $targ = $op->targ;
210 my $private = $op->private;
211
212 $source .= " {\n";
213
214 if ($op->flags & B::OPf_SPECIAL) {
215 $source .= " AV *av = (AV*)PAD_SV((PADOFFSET)$targ);\n";
216 } else {
217 $source .= " AV *av = GvAV ((GV *)${$op->sv}L);\n";
218 }
219
220 if ($op->flags & B::OPf_MOD) {
221 $source .= " SV *sv = *av_fetch (av, $private, 1);\n";
222 } else {
223 $source .= " SV **svp = av_fetch (av, $private, 0); SV *sv = svp ? *svp : &PL_sv_undef;\n";
224 }
225
226 if (!($op->flags & B::OPf_MOD)) {
227 $source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
228 }
229
230 $source .= " dSP;\n";
231 $source .= " XPUSHs (sv);\n";
232 $source .= " PUTBACK;\n";
233 $source .= " }\n";
234
235 out_next $op;
236} 316}
237 317
238# pattern const+ (or general push1) 318# pattern const+ (or general push1)
239# pattern pushmark return(?) 319# pattern pushmark return(?)
240# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign 320# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign
241 321
242# pattern const method_named 322# pattern const method_named
243sub op_method_named { 323sub op_method_named {
244 my ($op) = @_;
245
246 $source .= <<EOF; 324 $source .= <<EOF;
247 { 325 {
248 static HV *last_stash; 326 static HV *last_stash;
249 static SV *last_res; 327 static SV *last_res;
250 328
251 SV *obj = *(PL_stack_base + TOPMARK + 1); 329 SV *obj = *(PL_stack_base + TOPMARK + 1);
252 330
331 printf ("todo: PL_subgeneration or somesuch\\n");
253 if (SvROK (obj) && SvOBJECT (SvRV (obj))) 332 if (SvROK (obj) && SvOBJECT (SvRV (obj)))
254 { 333 {
255 dSP; 334 dSP;
256 HV *stash = SvSTASH (SvRV (obj)); 335 HV *stash = SvSTASH (SvRV (obj));
257 336
… …
278 nextop = Perl_pp_method_named (aTHX); 357 nextop = Perl_pp_method_named (aTHX);
279 } 358 }
280 } 359 }
281EOF 360EOF
282 361
283 out_next $op; 362 out_next;
284} 363}
285 364
286sub cv2c { 365sub cv2c {
287 my ($cv) = @_; 366 my ($cv) = @_;
288 367
289 my %opsseen; 368 my %opsseen;
290 my @ops;
291 my @todo = $cv->START; 369 my @todo = $cv->START;
292 370
293 while (my $op = shift @todo) { 371 while (my $op = shift @todo) {
294 for (; $$op; $op = $op->next) { 372 for (; $$op; $op = $op->next) {
295 last if $opsseen{$$op}++; 373 last if $opsseen{$$op}++;
… …
314 } 392 }
315 393
316 local $source = <<EOF; 394 local $source = <<EOF;
317#define PERL_NO_GET_CONTEXT 395#define PERL_NO_GET_CONTEXT
318 396
397//#define NDEBUG 1
319#include <assert.h> 398#include <assert.h>
320 399
321#include "EXTERN.h" 400#include "EXTERN.h"
322#include "perl.h" 401#include "perl.h"
323#include "XSUB.h" 402#include "XSUB.h"
324 403
325/*typedef OP *(*PPFUNC)(pTHX);*/
326
327OP *%%%FUNC%%% (pTHX) 404OP *%%%FUNC%%% (pTHX)
328{ 405{
329 register OP *nextop = (OP *)${$ops[0]}L; 406 register OP *nextop = (OP *)${$ops[0]}L;
330EOF 407EOF
331 408
332 for my $op (@ops) { 409 while (@ops) {
410 $op = shift @ops;
333 my $name = $op->name; 411 $op_name = $op->name;
334 my $ppaddr = ppaddr $op->type;
335 412
336 $source .= "op_$$op: /* $name */\n"; 413 $source .= "op_$$op: /* $op_name */\n";
337 #$source .= "fprintf (stderr, \"$$op in op $name\\n\");\n";#d# 414 #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d#
338 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d# 415 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
339 416
340 unless (exists $flag{noasync}{$name}) { 417 unless (exists $flag{noasync}{$op_name}) {
341 $source .= " PERL_ASYNC_CHECK ();\n"; 418 $source .= " PERL_ASYNC_CHECK ();\n";
342 } 419 }
343 420
344 if (my $can = __PACKAGE__->can ("op_$name")) { 421 if (my $can = __PACKAGE__->can ("op_$op_name")) {
345 $can->($op); 422 $can->($op);
346 } elsif (exists $flag{unsafe}{$name}) { 423 } elsif (exists $flag{unsafe}{$op_name}) {
347 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 424 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";
348 $source .= " PL_op = nextop; return " . (callop $op) . ";\n"; 425 $source .= " return nextop;\n";
349 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) { 426 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$op_name}) {
350 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 427 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";
351 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 428 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
352 $source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n"; 429 $source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n";
353 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d# 430 $source .= " assert ((\"$op_name\", nextop == (OP *)${$op->next}));\n";
354 $source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n"; 431 $source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n";
355 } else { 432 } else {
356 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 433 out_linear;
357 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
358 if ($name eq "entersub") {
359 $source .= <<EOF;
360while (nextop != (OP *)${$op->next})
361 {
362 PERL_ASYNC_CHECK ();
363 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
364 }
365EOF
366 }
367 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
368 $source .= ${$op->next} ? " goto op_${$op->next};\n" : " return 0;\n";
369 } 434 }
370 } 435 }
371 436
372 $source .= "}\n"; 437 $source .= "}\n";
373 #warn $source; 438 #warn $source;

Diff Legend

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