| … | |
… | |
| 28 | our $source; |
28 | our $source; |
| 29 | our $label_next; |
29 | our $label_next; |
| 30 | our $label_last; |
30 | our $label_last; |
| 31 | our $label_redo; |
31 | our $label_redo; |
| 32 | |
32 | |
|
|
33 | my %flag; |
|
|
34 | |
|
|
35 | for (split /\n/, <<EOF) { |
|
|
36 | leavesub unsafe |
|
|
37 | leavesublv unsafe |
|
|
38 | return unsafe |
|
|
39 | flip unsafe |
|
|
40 | goto unsafe |
|
|
41 | last unsafe |
|
|
42 | redo unsafe |
|
|
43 | next unsafe |
|
|
44 | eval unsafe |
|
|
45 | leaveeval unsafe |
|
|
46 | entertry unsafe |
|
|
47 | substconst unsafe |
|
|
48 | formline unsafe |
|
|
49 | grepstart unsafe |
|
|
50 | EOF |
|
|
51 | my (undef, $op, @flags) = split /\s+/; |
|
|
52 | |
|
|
53 | undef $flag{$_}{$op} |
|
|
54 | for ("known", @flags); |
|
|
55 | } |
|
|
56 | |
|
|
57 | sub out_next { |
|
|
58 | my ($op) = @_; |
|
|
59 | |
|
|
60 | my $ppaddr = ppaddr $op->type; |
|
|
61 | |
|
|
62 | $source .= " PL_op = (OP *)${$op->next}L;\n"; |
|
|
63 | $source .= " goto op_${$op->next};\n"; |
|
|
64 | } |
|
|
65 | |
|
|
66 | sub op_nextstate { |
|
|
67 | my ($op) = @_; |
|
|
68 | |
|
|
69 | $source .= " PL_curcop = (COP *)PL_op;\n"; |
|
|
70 | $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n"; |
|
|
71 | $source .= " FREETMPS;\n"; |
|
|
72 | |
|
|
73 | out_next $op; |
|
|
74 | } |
|
|
75 | |
|
|
76 | sub op_const { |
|
|
77 | my ($op) = @_; |
|
|
78 | |
|
|
79 | $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; |
|
|
80 | |
|
|
81 | out_next $op; |
|
|
82 | } |
|
|
83 | |
|
|
84 | *op_gv = \&op_const; |
|
|
85 | |
| 33 | sub entersub { |
86 | sub entersub { |
| 34 | my ($cv) = @_; |
87 | my ($cv) = @_; |
| 35 | |
88 | |
| 36 | my %opsseen; |
89 | my %opsseen; |
| 37 | my @ops; |
90 | my @ops; |
| … | |
… | |
| 58 | # } |
111 | # } |
| 59 | } |
112 | } |
| 60 | } |
113 | } |
| 61 | } |
114 | } |
| 62 | |
115 | |
|
|
116 | local $source; |
|
|
117 | |
|
|
118 | $source = "typedef OP *(*PPFUNC)(pTHX);\n\n"; |
|
|
119 | |
|
|
120 | $source .= "OP *func (pTHX)\n{\n"; |
|
|
121 | |
| 63 | for (@ops) { |
122 | for my $op (@ops) { |
| 64 | printf "%s\n", $_->name; |
123 | my $name = $op->name; |
|
|
124 | my $ppaddr = ppaddr $op->type; |
|
|
125 | |
|
|
126 | $source .= "op_$$op: /* $name */\n"; |
|
|
127 | |
|
|
128 | if (my $can = __PACKAGE__->can ("op_$name")) { |
|
|
129 | $can->($op); |
|
|
130 | } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) { |
|
|
131 | $source .= " PL_op = ((PPFUNC)${ppaddr}L)(aTHX);\n"; |
|
|
132 | $source .= " if (PL_op == (OP *)${$op->other}L) goto op_${$op->other};\n"; |
|
|
133 | $source .= " goto op_${$op->next};\n"; |
|
|
134 | } elsif (exists $flag{unsafe}{$name}) { |
|
|
135 | $source .= " return ((PPFUNC)${ppaddr}L)(aTHX);\n"; |
|
|
136 | } else { |
|
|
137 | $source .= " PL_op = ((PPFUNC)${ppaddr}L)(aTHX);\n"; |
|
|
138 | $source .= " goto op_${$op->next};\n"; |
|
|
139 | } |
| 65 | } |
140 | } |
| 66 | # walklines(\@lines, 0); |
141 | |
|
|
142 | $source .= "}\n"; |
|
|
143 | |
|
|
144 | print <<EOF; |
|
|
145 | #include "EXTERN.h" |
|
|
146 | #include "perl.h" |
|
|
147 | #include "XSUB.h" |
|
|
148 | EOF |
|
|
149 | print $source; |
| 67 | } |
150 | } |
| 68 | |
151 | |
| 69 | hook_entersub; |
152 | hook_entersub; |
| 70 | |
153 | |
| 71 | 1; |
154 | 1; |
| 72 | |
155 | |
| 73 | =back |
156 | =back |
| 74 | |
157 | |
|
|
158 | =head1 LIMITATIONS |
|
|
159 | |
|
|
160 | Tainting and debugging will disable Faster. |
|
|
161 | |
| 75 | =head1 AUTHOR |
162 | =head1 AUTHOR |
| 76 | |
163 | |
| 77 | Marc Lehmann <schmorp@schmorp.de> |
164 | Marc Lehmann <schmorp@schmorp.de> |
| 78 | http://home.schmorp.de/ |
165 | http://home.schmorp.de/ |
| 79 | |
166 | |
