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.9 by root, Fri Mar 10 01:55:12 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
147sub out_gotonext {
148 if (${$op->next}) {
149 $source .= " assert ((\"$op_name\", nextop == (OP *)${$op->next}));\n";
150 $source .= " goto op_${$op->next};\n";
151 } else {
152 $source .= " return 0;\n";
153 }
154}
155
96sub out_next { 156sub out_next {
97 my ($op) = @_;
98
99 $source .= " nextop = (OP *)${$op->next}L;\n"; 157 $source .= " nextop = (OP *)${$op->next}L;\n";
100 $source .= " goto op_${$op->next};\n";
101}
102 158
103sub callop { 159 out_gotonext;
104 my ($op) = @_; 160}
105 161
106 my $name = $op->name; 162sub out_linear {
107 163 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";#d#
164 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
108 $name eq "entersub" 165 if ($op_name eq "entersub") {
109 ? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)" 166 $source .= <<EOF;
110 : "Perl_pp_$name (aTHX)" 167 while (nextop != (OP *)${$op->next}L)
168 {
169 PERL_ASYNC_CHECK ();
170 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX);
171 }
172EOF
173 }
174
175 out_gotonext;
111} 176}
112 177
113sub op_nextstate { 178sub op_nextstate {
114 my ($op) = @_;
115
116 $source .= " PL_curcop = (COP *)nextop;\n"; 179 $source .= " PL_curcop = (COP *)nextop;\n";
117 $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";
118 $source .= " FREETMPS;\n"; 181 $source .= " FREETMPS;\n";
119 182
120 out_next $op; 183 out_next;
121} 184}
122 185
123sub op_pushmark { 186sub op_pushmark {
124 my ($op) = @_;
125
126 $source .= " PUSHMARK (PL_stack_sp);\n"; 187 $source .= " PUSHMARK (PL_stack_sp);\n";
127 188
128 out_next $op; 189 out_next;
129} 190}
130 191
131sub op_const { 192if ($Config{useithreads} ne "define") {
132 my ($op) = @_; 193 # disable optimisations on ithreads
133 194
195 *op_const = sub {
134 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; 196 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
135 197
136 out_next $op; 198 out_next;
137} 199 };
138 200
139*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}
140 250
141sub op_stringify { 251sub op_stringify {
142 my ($op) = @_;
143
144 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n"; 252 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n";
145 253
146 out_next $op; 254 out_next;
147} 255}
148 256
149sub op_and { 257sub op_and {
150 my ($op) = @_;
151
152 $source .= <<EOF; 258 $source .= <<EOF;
153 { 259 {
154 dSP; 260 dSP;
261
155 if (SvTRUE (TOPs)) 262 if (SvTRUE (TOPs))
156 { 263 {
157 --SP; 264 --SP;
158 PUTBACK; 265 PUTBACK;
159 nextop = (OP *)${$op->other}L; 266 nextop = (OP *)${$op->other}L;
160 goto op_${$op->other}; 267 goto op_${$op->other};
161 } 268 }
162
163 nextop = (OP *)${$op->next}L;
164 goto op_${$op->next};
165 } 269 }
166EOF 270EOF
271
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;
167} 291}
168 292
169sub op_padsv { 293sub op_padsv {
170 my ($op) = @_;
171
172 my $flags = $op->flags; 294 my $flags = $op->flags;
173 my $target = $op->targ; 295 my $target = $op->targ;
174 296
175 $source .= <<EOF; 297 $source .= <<EOF;
176 { 298 {
… …
188 } 310 }
189 $source .= <<EOF; 311 $source .= <<EOF;
190 } 312 }
191EOF 313EOF
192 314
193 out_next $op; 315 out_next;
194} 316}
195 317
196# pattern const+ (or general push1) 318# pattern const+ (or general push1)
197# pattern pushmark return(?) 319# pattern pushmark return(?)
198# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign 320# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign
199 321
200# pattern const method_named 322# pattern const method_named
201sub op_method_named { 323sub op_method_named {
202 my ($op) = @_;
203
204 $source .= <<EOF; 324 $source .= <<EOF;
205 { 325 {
206 static HV *last_stash; 326 static HV *last_stash;
207 static SV *last_res; 327 static SV *last_res;
208 328
… …
236 nextop = Perl_pp_method_named (aTHX); 356 nextop = Perl_pp_method_named (aTHX);
237 } 357 }
238 } 358 }
239EOF 359EOF
240 360
241 out_next $op; 361 out_next;
242} 362}
243 363
244sub cv2c { 364sub cv2c {
245 my ($cv) = @_; 365 my ($cv) = @_;
246 366
247 my %opsseen; 367 my %opsseen;
248 my @ops;
249 my @todo = $cv->START; 368 my @todo = $cv->START;
250 369
251 while (my $op = shift @todo) { 370 while (my $op = shift @todo) {
252 for (; $$op; $op = $op->next) { 371 for (; $$op; $op = $op->next) {
253 last if $opsseen{$$op}++; 372 last if $opsseen{$$op}++;
… …
272 } 391 }
273 392
274 local $source = <<EOF; 393 local $source = <<EOF;
275#define PERL_NO_GET_CONTEXT 394#define PERL_NO_GET_CONTEXT
276 395
396//#define NDEBUG 1
277#include <assert.h> 397#include <assert.h>
278 398
279#include "EXTERN.h" 399#include "EXTERN.h"
280#include "perl.h" 400#include "perl.h"
281#include "XSUB.h" 401#include "XSUB.h"
282 402
283/*typedef OP *(*PPFUNC)(pTHX);*/
284
285OP *%%%FUNC%%% (pTHX) 403OP *%%%FUNC%%% (pTHX)
286{ 404{
287 register OP *nextop = (OP *)${$ops[0]}L; 405 register OP *nextop = (OP *)${$ops[0]}L;
288EOF 406EOF
289 407
290 for my $op (@ops) { 408 while (@ops) {
409 $op = shift @ops;
291 my $name = $op->name; 410 $op_name = $op->name;
292 my $ppaddr = ppaddr $op->type;
293 411
294 $source .= "op_$$op: /* $name */\n"; 412 $source .= "op_$$op: /* $op_name */\n";
295 #$source .= "fprintf (stderr, \"$$op in op $name\\n\");\n";#d# 413 #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d#
296 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d# 414 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
297 415
298 unless (exists $flag{noasync}{$name}) { 416 unless (exists $flag{noasync}{$op_name}) {
299 $source .= " PERL_ASYNC_CHECK ();\n"; 417 $source .= " PERL_ASYNC_CHECK ();\n";
300 } 418 }
301 419
302 if (my $can = __PACKAGE__->can ("op_$name")) { 420 if (my $can = __PACKAGE__->can ("op_$op_name")) {
303 $can->($op); 421 $can->($op);
422 } elsif (exists $flag{unsafe}{$op_name}) {
423 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";
424 $source .= " return nextop;\n";
304 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) { 425 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$op_name}) {
305 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 426 $source .= " assert ((\"$op_name\", nextop == (OP *)$$op));\n";
306 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 427 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
307 $source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n"; 428 $source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n";
308 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d# 429 $source .= " assert ((\"$op_name\", nextop == (OP *)${$op->next}));\n";
309 $source .= " goto op_${$op->next};\n"; 430 $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 { 431 } else {
314 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d# 432 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 } 433 }
328 } 434 }
329 435
330 $source .= "}\n"; 436 $source .= "}\n";
331 #warn $source; 437 #warn $source;

Diff Legend

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