| … | |
… | |
| 55 | } |
55 | } |
| 56 | |
56 | |
| 57 | sub out_next { |
57 | sub out_next { |
| 58 | my ($op) = @_; |
58 | my ($op) = @_; |
| 59 | |
59 | |
| 60 | my $ppaddr = ppaddr $op->type; |
|
|
| 61 | |
|
|
| 62 | $source .= " PL_op = (OP *)${$op->next}L;\n"; |
60 | $source .= " PL_op = (OP *)${$op->next}L;\n"; |
| 63 | $source .= " goto op_${$op->next};\n"; |
61 | $source .= " goto op_${$op->next};\n"; |
| 64 | } |
62 | } |
| 65 | |
63 | |
| 66 | sub op_nextstate { |
64 | sub op_nextstate { |
| … | |
… | |
| 71 | $source .= " FREETMPS;\n"; |
69 | $source .= " FREETMPS;\n"; |
| 72 | |
70 | |
| 73 | out_next $op; |
71 | out_next $op; |
| 74 | } |
72 | } |
| 75 | |
73 | |
|
|
74 | sub op_pushmark { |
|
|
75 | my ($op) = @_; |
|
|
76 | |
|
|
77 | $source .= " PUSHMARK (PL_stack_sp);\n"; |
|
|
78 | |
|
|
79 | out_next $op; |
|
|
80 | } |
|
|
81 | |
| 76 | sub op_const { |
82 | sub op_const { |
| 77 | my ($op) = @_; |
83 | my ($op) = @_; |
| 78 | |
84 | |
| 79 | $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; |
85 | $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; |
| 80 | |
86 | |
| 81 | out_next $op; |
87 | out_next $op; |
| 82 | } |
88 | } |
| 83 | |
89 | |
| 84 | *op_gv = \&op_const; |
90 | *op_gv = \&op_const; |
|
|
91 | |
|
|
92 | sub op_stringify { |
|
|
93 | my ($op) = @_; |
|
|
94 | |
|
|
95 | $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n"; |
|
|
96 | |
|
|
97 | out_next $op; |
|
|
98 | } |
|
|
99 | |
|
|
100 | # pattern const+ (or general push1) |
|
|
101 | # pattern pushmark return(?) |
|
|
102 | # pattern pushmark gv rv2av pushmark padsv+o.รค. aassign |
|
|
103 | |
|
|
104 | # pattern const method_named |
|
|
105 | sub xop_method_named { |
|
|
106 | my ($op) = @_; |
|
|
107 | |
|
|
108 | my $ppaddr = ppaddr $op->type; |
|
|
109 | |
|
|
110 | $source .= <<EOF; |
|
|
111 | { |
|
|
112 | dSP; |
|
|
113 | |
|
|
114 | if (SvROK (TOPm1s) && SvOBJECT (SvRV (TOPm1s))) |
|
|
115 | { |
|
|
116 | static SV *last_stash, SV *last_res; |
|
|
117 | SV *stash = SvSTASH (SvRV (TOPm1s)); |
|
|
118 | |
|
|
119 | // simple polymorphic inline cache |
|
|
120 | if (stash == last_stash) |
|
|
121 | { |
|
|
122 | dTARGET; |
|
|
123 | SETTARG (last_res); |
|
|
124 | } |
|
|
125 | else |
|
|
126 | { |
|
|
127 | PUTBACK; |
|
|
128 | ((PPFUNC)${ppaddr}L)(aTHX);\n"; |
|
|
129 | SPAGAIN; |
|
|
130 | |
|
|
131 | last_stash = stash; |
|
|
132 | last_res = TOPs; |
|
|
133 | } |
|
|
134 | } |
|
|
135 | } |
|
|
136 | EOF |
|
|
137 | |
|
|
138 | out_next $op; |
|
|
139 | } |
| 85 | |
140 | |
| 86 | sub entersub { |
141 | sub entersub { |
| 87 | my ($cv) = @_; |
142 | my ($cv) = @_; |
| 88 | |
143 | |
| 89 | my %opsseen; |
144 | my %opsseen; |
| … | |
… | |
| 115 | |
170 | |
| 116 | local $source; |
171 | local $source; |
| 117 | |
172 | |
| 118 | $source = "typedef OP *(*PPFUNC)(pTHX);\n\n"; |
173 | $source = "typedef OP *(*PPFUNC)(pTHX);\n\n"; |
| 119 | |
174 | |
| 120 | $source .= "OP *func (pTHX)\n{\n"; |
175 | $source .= "OP *func (pTHX)\n{\n dTHX;\n"; |
| 121 | |
176 | |
| 122 | for my $op (@ops) { |
177 | for my $op (@ops) { |
| 123 | my $name = $op->name; |
178 | my $name = $op->name; |
| 124 | my $ppaddr = ppaddr $op->type; |
179 | my $ppaddr = ppaddr $op->type; |
| 125 | |
180 | |
