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.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
63 match unsafe noasync todo
64 subst unsafe noasync todo
65 entereval unsafe noasync todo
66 mapstart unsafe noasync todo
59 67
68 mapwhile noasync
69 grepwhile noasync
70
71 seq noasync
60 pushmark noasync 72 pushmark noasync
61 padsv noasync 73 padsv noasync extend=1
74 padav noasync extend=1
75 padhv noasync extend=1
76 padany noasync extend=1
62 entersub noasync 77 entersub noasync
63 aassign noasync 78 aassign noasync
64 sassign noasync 79 sassign noasync
65 rv2av noasync 80 rv2av noasync
81 rv2cv noasync
82 rv2gv noasync
83 rv2hv noasync
84 refgen noasync
66 nextstate noasync 85 nextstate noasync
67 gv noasync 86 gv noasync
68 gvsv noasync 87 gvsv noasync
69 add noasync 88 add noasync
70 subtract noasync 89 subtract noasync
… …
73 complement noasync 92 complement noasync
74 cond_expr noasync 93 cond_expr noasync
75 and noasync 94 and noasync
76 or noasync 95 or noasync
77 not noasync 96 not noasync
97 defined noasync
78 method_named noasync 98 method_named noasync
79 preinc noasync 99 preinc noasync
80 postinc noasync 100 postinc noasync
81 predec noasync 101 predec noasync
82 postdec noasync 102 postdec noasync
83 stub noasync 103 stub noasync
84 unstack noasync 104 unstack noasync
85 leaveloop noasync 105 leaveloop noasync
86 shift noasync
87 aelemA noasync 106 aelem noasync
88 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
89EOF 132EOF
90 my (undef, $op, @flags) = split /\s+/; 133 my (undef, $op, @flags) = split /\s+/;
91 134
92 undef $flag{$_}{$op} 135 undef $flag{$_}{$op}
93 for ("known", @flags); 136 for ("known", @flags);
94} 137}
95 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
96sub out_next { 147sub out_next {
97 my ($op) = @_; 148 if (${$op->next}) {
98
99 $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";
100 $source .= " goto op_${$op->next};\n"; 151 $source .= " goto op_${$op->next};\n";
152 } else {
153 $source .= " return 0;\n";
154 }
101} 155}
102 156
103sub callop { 157sub out_linear {
104 my ($op) = @_; 158 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";#d#
105 159 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
106 my $name = $op->name;
107
108 $name eq "entersub" 160 if ($op_name eq "entersub") {
109 ? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)" 161 $source .= <<EOF;
110 : "Perl_pp_$name (aTHX)" 162 while (nextop != (OP *)${$op->next}L)
163 {
164 PERL_ASYNC_CHECK ();
165 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
166 }
167EOF
168 }
169
170 out_next;
111} 171}
112 172
113sub op_nextstate { 173sub op_nextstate {
114 my ($op) = @_;
115
116 $source .= " PL_curcop = (COP *)nextop;\n"; 174 $source .= " PL_curcop = (COP *)nextop;\n";
117 $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";
118 $source .= " FREETMPS;\n"; 176 $source .= " FREETMPS;\n";
119 177
120 out_next $op; 178 out_next;
121} 179}
122 180
123sub op_pushmark { 181sub op_pushmark {
124 my ($op) = @_;
125
126 $source .= " PUSHMARK (PL_stack_sp);\n"; 182 $source .= " PUSHMARK (PL_stack_sp);\n";
127 183
128 out_next $op; 184 out_next;
129} 185}
130 186
131sub op_const { 187if ($Config{useithreads} ne "define") {
132 my ($op) = @_; 188 # disable optimisations on ithreads
133 189
190 *op_const = sub {
134 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; 191 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
135 192
136 out_next $op; 193 out_next;
137} 194 };
138 195
139*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}
140 245
141sub op_stringify { 246sub op_stringify {
142 my ($op) = @_;
143
144 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n"; 247 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n";
145 248
146 out_next $op; 249 out_next;
147} 250}
148 251
149sub op_and { 252sub op_and {
150 my ($op) = @_;
151
152 $source .= <<EOF; 253 $source .= <<EOF;
153 { 254 {
154 dSP; 255 dSP;
256
155 if (SvTRUE (TOPs)) 257 if (SvTRUE (TOPs))
156 { 258 {
157 --SP; 259 --SP;
158 PUTBACK; 260 PUTBACK;
159 nextop = (OP *)${$op->other}L; 261 nextop = (OP *)${$op->other}L;
160 goto op_${$op->other}; 262 goto op_${$op->other};
161 } 263 }
162
163 nextop = (OP *)${$op->next}L;
164 goto op_${$op->next};
165 } 264 }
166EOF 265EOF
266
267 out_next;
268}
269
270sub op_or {
271 $source .= <<EOF;
272 {
273 dSP;
274
275 if (!SvTRUE (TOPs))
276 {
277 --SP;
278 PUTBACK;
279 nextop = (OP *)${$op->other}L;
280 goto op_${$op->other};
281 }
282 }
283EOF
284
285 out_next;
167} 286}
168 287
169sub op_padsv { 288sub op_padsv {
170 my ($op) = @_;
171
172 my $flags = $op->flags; 289 my $flags = $op->flags;
173 my $target = $op->targ; 290 my $target = $op->targ;
174 291
175 $source .= <<EOF; 292 $source .= <<EOF;
176 { 293 {
… …
188 } 305 }
189 $source .= <<EOF; 306 $source .= <<EOF;
190 } 307 }
191EOF 308EOF
192 309
193 out_next $op; 310 out_next;
194} 311}
195 312
196# pattern const+ (or general push1) 313# pattern const+ (or general push1)
197# pattern pushmark return(?) 314# pattern pushmark return(?)
198# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign 315# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign
199 316
200# pattern const method_named 317# pattern const method_named
201sub op_method_named { 318sub op_method_named {
202 my ($op) = @_;
203
204 $source .= <<EOF; 319 $source .= <<EOF;
205 { 320 {
206 static HV *last_stash; 321 static HV *last_stash;
207 static SV *last_res; 322 static SV *last_res;
208 323
… …
236 nextop = Perl_pp_method_named (aTHX); 351 nextop = Perl_pp_method_named (aTHX);
237 } 352 }
238 } 353 }
239EOF 354EOF
240 355
241 out_next $op; 356 out_next;
242} 357}
243 358
244sub cv2c { 359sub cv2c {
245 my ($cv) = @_; 360 my ($cv) = @_;
246 361
247 my %opsseen; 362 my %opsseen;
248 my @ops;
249 my @todo = $cv->START; 363 my @todo = $cv->START;
250 364
251 while (my $op = shift @todo) { 365 while (my $op = shift @todo) {
252 for (; $$op; $op = $op->next) { 366 for (; $$op; $op = $op->next) {
253 last if $opsseen{$$op}++; 367 last if $opsseen{$$op}++;
… …
272 } 386 }
273 387
274 local $source = <<EOF; 388 local $source = <<EOF;
275#define PERL_NO_GET_CONTEXT 389#define PERL_NO_GET_CONTEXT
276 390
391//#define NDEBUG 1
277#include <assert.h> 392#include <assert.h>
278 393
279#include "EXTERN.h" 394#include "EXTERN.h"
280#include "perl.h" 395#include "perl.h"
281#include "XSUB.h" 396#include "XSUB.h"
282 397
283/*typedef OP *(*PPFUNC)(pTHX);*/
284
285OP *%%%FUNC%%% (pTHX) 398OP *%%%FUNC%%% (pTHX)
286{ 399{
287 register OP *nextop = (OP *)${$ops[0]}L; 400 register OP *nextop = (OP *)${$ops[0]}L;
288EOF 401EOF
289 402
290 for my $op (@ops) { 403 while (@ops) {
404 $op = shift @ops;
291 my $name = $op->name; 405 $op_name = $op->name;
292 my $ppaddr = ppaddr $op->type;
293 406
294 $source .= "op_$$op: /* $name */\n"; 407 $source .= "op_$$op: /* $op_name */\n";
295 #$source .= "fprintf (stderr, \"$$op in op $name\\n\");\n";#d# 408 #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d#
296 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d# 409 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
297 410
298 unless (exists $flag{noasync}{$name}) { 411 unless (exists $flag{noasync}{$op_name}) {
299 $source .= " PERL_ASYNC_CHECK ();\n"; 412 $source .= " PERL_ASYNC_CHECK ();\n";
300 } 413 }
301 414
302 if (my $can = __PACKAGE__->can ("op_$name")) { 415 if (my $can = __PACKAGE__->can ("op_$op_name")) {
303 $can->($op); 416 $can->($op);
417 } elsif (exists $flag{unsafe}{$op_name}) {
418 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";
419 $source .= " PL_op = nextop; return " . (callop $op) . ";\n";
304 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) { 420 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$op_name}) {
305 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 421 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";
306 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 422 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
307 $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";
308 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d# 424 $source .= " assert ((\"$op_name\", nextop == (OP *)${$op->next}));\n";
309 $source .= " goto op_${$op->next};\n"; 425 $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 { 426 } else {
314 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 427 out_linear;
315 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
316 if ($name eq "entersub") {
317 $source .= <<EOF;
318while (nextop != (OP *)${$op->next})
319 {
320 PERL_ASYNC_CHECK ();
321 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
322 }
323EOF
324 }
325 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
326 $source .= " goto op_${$op->next};\n";
327 } 428 }
328 } 429 }
329 430
330 $source .= "}\n"; 431 $source .= "}\n";
331 #warn $source; 432 #warn $source;

Diff Legend

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