This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge B::PADOP::padix into the common B::OP accessor XS code.
[perl5.git] / ext / B / B.xs
CommitLineData
a8a597b2
MB
1/* B.xs
2 *
3 * Copyright (c) 1996 Malcolm Beattie
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
8 */
9
c5be433b 10#define PERL_NO_GET_CONTEXT
a8a597b2
MB
11#include "EXTERN.h"
12#include "perl.h"
13#include "XSUB.h"
a8a597b2 14
51aa15f3
GS
15#ifdef PerlIO
16typedef PerlIO * InputStream;
17#else
18typedef FILE * InputStream;
19#endif
20
21
27da23d5 22static const char* const svclassnames[] = {
a8a597b2 23 "B::NULL",
cecf5685
NC
24#if PERL_VERSION >= 9
25 "B::BIND",
26#endif
1cb9cd50 27 "B::IV",
b53eecb4 28 "B::NV",
4df7f6af
NC
29#if PERL_VERSION <= 10
30 "B::RV",
31#endif
a8a597b2
MB
32 "B::PV",
33 "B::PVIV",
34 "B::PVNV",
35 "B::PVMG",
cecf5685 36#if PERL_VERSION <= 8
a8a597b2 37 "B::BM",
cecf5685 38#endif
4df7f6af 39#if PERL_VERSION >= 11
5c35adbb 40 "B::REGEXP",
4df7f6af 41#endif
7252851f 42#if PERL_VERSION >= 9
4ce457a6 43 "B::GV",
7252851f 44#endif
a8a597b2
MB
45 "B::PVLV",
46 "B::AV",
47 "B::HV",
48 "B::CV",
7252851f
NC
49#if PERL_VERSION <= 8
50 "B::GV",
51#endif
a8a597b2
MB
52 "B::FM",
53 "B::IO",
54};
55
56typedef enum {
57 OPc_NULL, /* 0 */
58 OPc_BASEOP, /* 1 */
59 OPc_UNOP, /* 2 */
60 OPc_BINOP, /* 3 */
61 OPc_LOGOP, /* 4 */
1a67a97c
SM
62 OPc_LISTOP, /* 5 */
63 OPc_PMOP, /* 6 */
64 OPc_SVOP, /* 7 */
7934575e 65 OPc_PADOP, /* 8 */
1a67a97c 66 OPc_PVOP, /* 9 */
651aa52e
AE
67 OPc_LOOP, /* 10 */
68 OPc_COP /* 11 */
a8a597b2
MB
69} opclass;
70
27da23d5 71static const char* const opclassnames[] = {
a8a597b2
MB
72 "B::NULL",
73 "B::OP",
74 "B::UNOP",
75 "B::BINOP",
76 "B::LOGOP",
a8a597b2
MB
77 "B::LISTOP",
78 "B::PMOP",
79 "B::SVOP",
7934575e 80 "B::PADOP",
a8a597b2 81 "B::PVOP",
a8a597b2
MB
82 "B::LOOP",
83 "B::COP"
84};
85
27da23d5 86static const size_t opsizes[] = {
651aa52e
AE
87 0,
88 sizeof(OP),
89 sizeof(UNOP),
90 sizeof(BINOP),
91 sizeof(LOGOP),
92 sizeof(LISTOP),
93 sizeof(PMOP),
94 sizeof(SVOP),
95 sizeof(PADOP),
96 sizeof(PVOP),
97 sizeof(LOOP),
98 sizeof(COP)
99};
100
df3728a2 101#define MY_CXT_KEY "B::_guts" XS_VERSION
a8a597b2 102
89ca4ac7
JH
103typedef struct {
104 int x_walkoptree_debug; /* Flag for walkoptree debug hook */
b326da91 105 SV * x_specialsv_list[7];
89ca4ac7
JH
106} my_cxt_t;
107
108START_MY_CXT
109
110#define walkoptree_debug (MY_CXT.x_walkoptree_debug)
111#define specialsv_list (MY_CXT.x_specialsv_list)
e8edd1e6 112
a8a597b2 113static opclass
5d7488b2 114cc_opclass(pTHX_ const OP *o)
a8a597b2
MB
115{
116 if (!o)
117 return OPc_NULL;
118
119 if (o->op_type == 0)
120 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
121
122 if (o->op_type == OP_SASSIGN)
123 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
124
c60fdceb
SM
125 if (o->op_type == OP_AELEMFAST) {
126 if (o->op_flags & OPf_SPECIAL)
127 return OPc_BASEOP;
128 else
129#ifdef USE_ITHREADS
130 return OPc_PADOP;
131#else
132 return OPc_SVOP;
133#endif
134 }
135
18228111 136#ifdef USE_ITHREADS
31b49ad4 137 if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
c60fdceb 138 o->op_type == OP_RCATLINE)
18228111
GS
139 return OPc_PADOP;
140#endif
141
22c35a8c 142 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
a8a597b2
MB
143 case OA_BASEOP:
144 return OPc_BASEOP;
145
146 case OA_UNOP:
147 return OPc_UNOP;
148
149 case OA_BINOP:
150 return OPc_BINOP;
151
152 case OA_LOGOP:
153 return OPc_LOGOP;
154
a8a597b2
MB
155 case OA_LISTOP:
156 return OPc_LISTOP;
157
158 case OA_PMOP:
159 return OPc_PMOP;
160
161 case OA_SVOP:
162 return OPc_SVOP;
163
7934575e
GS
164 case OA_PADOP:
165 return OPc_PADOP;
a8a597b2 166
293d3ffa
SM
167 case OA_PVOP_OR_SVOP:
168 /*
169 * Character translations (tr///) are usually a PVOP, keeping a
170 * pointer to a table of shorts used to look up translations.
171 * Under utf8, however, a simple table isn't practical; instead,
172 * the OP is an SVOP, and the SV is a reference to a swash
173 * (i.e., an RV pointing to an HV).
174 */
175 return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
176 ? OPc_SVOP : OPc_PVOP;
a8a597b2
MB
177
178 case OA_LOOP:
179 return OPc_LOOP;
180
181 case OA_COP:
182 return OPc_COP;
183
184 case OA_BASEOP_OR_UNOP:
185 /*
186 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
45f6cd40
SM
187 * whether parens were seen. perly.y uses OPf_SPECIAL to
188 * signal whether a BASEOP had empty parens or none.
189 * Some other UNOPs are created later, though, so the best
190 * test is OPf_KIDS, which is set in newUNOP.
a8a597b2 191 */
45f6cd40 192 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
a8a597b2
MB
193
194 case OA_FILESTATOP:
195 /*
196 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
197 * the OPf_REF flag to distinguish between OP types instead of the
198 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
199 * return OPc_UNOP so that walkoptree can find our children. If
200 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
201 * (no argument to the operator) it's an OP; with OPf_REF set it's
7934575e 202 * an SVOP (and op_sv is the GV for the filehandle argument).
a8a597b2
MB
203 */
204 return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
93865851
GS
205#ifdef USE_ITHREADS
206 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
207#else
7934575e 208 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
93865851 209#endif
a8a597b2
MB
210 case OA_LOOPEXOP:
211 /*
212 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
213 * label was omitted (in which case it's a BASEOP) or else a term was
214 * seen. In this last case, all except goto are definitely PVOP but
215 * goto is either a PVOP (with an ordinary constant label), an UNOP
216 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
217 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
218 * get set.
219 */
220 if (o->op_flags & OPf_STACKED)
221 return OPc_UNOP;
222 else if (o->op_flags & OPf_SPECIAL)
223 return OPc_BASEOP;
224 else
225 return OPc_PVOP;
226 }
227 warn("can't determine class of operator %s, assuming BASEOP\n",
22c35a8c 228 PL_op_name[o->op_type]);
a8a597b2
MB
229 return OPc_BASEOP;
230}
231
232static char *
5d7488b2 233cc_opclassname(pTHX_ const OP *o)
a8a597b2 234{
27da23d5 235 return (char *)opclassnames[cc_opclass(aTHX_ o)];
a8a597b2
MB
236}
237
9496d2e5
NC
238/* FIXME - figure out how to get the typemap to assign this to ST(0), rather
239 than creating a new mortal for ST(0) then passing it in as the first
240 argument. */
a8a597b2 241static SV *
cea2e8a9 242make_sv_object(pTHX_ SV *arg, SV *sv)
a8a597b2 243{
27da23d5 244 const char *type = 0;
a8a597b2 245 IV iv;
89ca4ac7 246 dMY_CXT;
9496d2e5
NC
247
248 if (!arg)
249 arg = sv_newmortal();
250
e8edd1e6
TH
251 for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
252 if (sv == specialsv_list[iv]) {
a8a597b2
MB
253 type = "B::SPECIAL";
254 break;
255 }
256 }
257 if (!type) {
258 type = svclassnames[SvTYPE(sv)];
56431972 259 iv = PTR2IV(sv);
a8a597b2
MB
260 }
261 sv_setiv(newSVrv(arg, type), iv);
262 return arg;
263}
264
e412117e 265#if PERL_VERSION >= 9
a8a597b2 266static SV *
9496d2e5 267make_temp_object(pTHX_ SV *temp)
8e01d9a6
NC
268{
269 SV *target;
9496d2e5 270 SV *arg = sv_newmortal();
8e01d9a6
NC
271 const char *const type = svclassnames[SvTYPE(temp)];
272 const IV iv = PTR2IV(temp);
273
274 target = newSVrv(arg, type);
275 sv_setiv(target, iv);
276
277 /* Need to keep our "temp" around as long as the target exists.
278 Simplest way seems to be to hang it from magic, and let that clear
279 it up. No vtable, so won't actually get in the way of anything. */
280 sv_magicext(target, temp, PERL_MAGIC_sv, NULL, NULL, 0);
281 /* magic object has had its reference count increased, so we must drop
282 our reference. */
283 SvREFCNT_dec(temp);
284 return arg;
285}
286
287static SV *
9496d2e5 288make_warnings_object(pTHX_ STRLEN *warnings)
5c3c3f81
NC
289{
290 const char *type = 0;
291 dMY_CXT;
292 IV iv = sizeof(specialsv_list)/sizeof(SV*);
293
294 /* Counting down is deliberate. Before the split between make_sv_object
295 and make_warnings_obj there appeared to be a bug - Nullsv and pWARN_STD
296 were both 0, so you could never get a B::SPECIAL for pWARN_STD */
297
298 while (iv--) {
299 if ((SV*)warnings == specialsv_list[iv]) {
300 type = "B::SPECIAL";
301 break;
302 }
303 }
304 if (type) {
9496d2e5 305 SV *arg = sv_newmortal();
5c3c3f81 306 sv_setiv(newSVrv(arg, type), iv);
8e01d9a6 307 return arg;
5c3c3f81
NC
308 } else {
309 /* B assumes that warnings are a regular SV. Seems easier to keep it
310 happy by making them into a regular SV. */
9496d2e5 311 return make_temp_object(aTHX_ newSVpvn((char *)(warnings + 1), *warnings));
8e01d9a6
NC
312 }
313}
314
315static SV *
9496d2e5 316make_cop_io_object(pTHX_ COP *cop)
8e01d9a6 317{
8b850bd5
NC
318 SV *const value = newSV(0);
319
33972ad6 320 Perl_emulate_cop_io(aTHX_ cop, value);
8b850bd5
NC
321
322 if(SvOK(value)) {
23098a26 323 return make_sv_object(aTHX_ NULL, value);
8e01d9a6 324 } else {
8b850bd5 325 SvREFCNT_dec(value);
9496d2e5 326 return make_sv_object(aTHX_ NULL, NULL);
5c3c3f81 327 }
5c3c3f81 328}
e412117e 329#endif
5c3c3f81
NC
330
331static SV *
9496d2e5 332make_mg_object(pTHX_ MAGIC *mg)
a8a597b2 333{
9496d2e5 334 SV *arg = sv_newmortal();
56431972 335 sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
a8a597b2
MB
336 return arg;
337}
338
339static SV *
52ad86de 340cstring(pTHX_ SV *sv, bool perlstyle)
a8a597b2 341{
09e97b95 342 SV *sstr;
a8a597b2
MB
343
344 if (!SvOK(sv))
09e97b95
NC
345 return newSVpvs_flags("0", SVs_TEMP);
346
347 sstr = newSVpvs_flags("\"", SVs_TEMP);
348
349 if (perlstyle && SvUTF8(sv)) {
d79a7a3d 350 SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
5d7488b2
AL
351 const STRLEN len = SvCUR(sv);
352 const char *s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
d79a7a3d
RGS
353 while (*s)
354 {
355 if (*s == '"')
6beb30a6 356 sv_catpvs(sstr, "\\\"");
d79a7a3d 357 else if (*s == '$')
6beb30a6 358 sv_catpvs(sstr, "\\$");
d79a7a3d 359 else if (*s == '@')
6beb30a6 360 sv_catpvs(sstr, "\\@");
d79a7a3d
RGS
361 else if (*s == '\\')
362 {
363 if (strchr("nrftax\\",*(s+1)))
364 sv_catpvn(sstr, s++, 2);
365 else
6beb30a6 366 sv_catpvs(sstr, "\\\\");
d79a7a3d
RGS
367 }
368 else /* should always be printable */
369 sv_catpvn(sstr, s, 1);
370 ++s;
371 }
d79a7a3d 372 }
a8a597b2
MB
373 else
374 {
375 /* XXX Optimise? */
5d7488b2
AL
376 STRLEN len;
377 const char *s = SvPV(sv, len);
a8a597b2
MB
378 for (; len; len--, s++)
379 {
380 /* At least try a little for readability */
381 if (*s == '"')
6beb30a6 382 sv_catpvs(sstr, "\\\"");
a8a597b2 383 else if (*s == '\\')
6beb30a6 384 sv_catpvs(sstr, "\\\\");
b326da91 385 /* trigraphs - bleagh */
5d7488b2 386 else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') {
47bf35fa 387 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", '?');
b326da91 388 }
52ad86de 389 else if (perlstyle && *s == '$')
6beb30a6 390 sv_catpvs(sstr, "\\$");
52ad86de 391 else if (perlstyle && *s == '@')
6beb30a6 392 sv_catpvs(sstr, "\\@");
ce561ef2
JH
393#ifdef EBCDIC
394 else if (isPRINT(*s))
395#else
396 else if (*s >= ' ' && *s < 127)
397#endif /* EBCDIC */
a8a597b2
MB
398 sv_catpvn(sstr, s, 1);
399 else if (*s == '\n')
6beb30a6 400 sv_catpvs(sstr, "\\n");
a8a597b2 401 else if (*s == '\r')
6beb30a6 402 sv_catpvs(sstr, "\\r");
a8a597b2 403 else if (*s == '\t')
6beb30a6 404 sv_catpvs(sstr, "\\t");
a8a597b2 405 else if (*s == '\a')
6beb30a6 406 sv_catpvs(sstr, "\\a");
a8a597b2 407 else if (*s == '\b')
6beb30a6 408 sv_catpvs(sstr, "\\b");
a8a597b2 409 else if (*s == '\f')
6beb30a6 410 sv_catpvs(sstr, "\\f");
52ad86de 411 else if (!perlstyle && *s == '\v')
6beb30a6 412 sv_catpvs(sstr, "\\v");
a8a597b2
MB
413 else
414 {
a8a597b2 415 /* Don't want promotion of a signed -1 char in sprintf args */
5d7488b2 416 const unsigned char c = (unsigned char) *s;
47bf35fa 417 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", c);
a8a597b2
MB
418 }
419 /* XXX Add line breaks if string is long */
420 }
a8a597b2 421 }
09e97b95 422 sv_catpvs(sstr, "\"");
a8a597b2
MB
423 return sstr;
424}
425
426static SV *
cea2e8a9 427cchar(pTHX_ SV *sv)
a8a597b2 428{
422d053b 429 SV *sstr = newSVpvs_flags("'", SVs_TEMP);
5d7488b2 430 const char *s = SvPV_nolen(sv);
422d053b
NC
431 /* Don't want promotion of a signed -1 char in sprintf args */
432 const unsigned char c = (unsigned char) *s;
a8a597b2 433
422d053b 434 if (c == '\'')
6beb30a6 435 sv_catpvs(sstr, "\\'");
422d053b 436 else if (c == '\\')
6beb30a6 437 sv_catpvs(sstr, "\\\\");
ce561ef2 438#ifdef EBCDIC
422d053b 439 else if (isPRINT(c))
ce561ef2 440#else
422d053b 441 else if (c >= ' ' && c < 127)
ce561ef2 442#endif /* EBCDIC */
a8a597b2 443 sv_catpvn(sstr, s, 1);
422d053b 444 else if (c == '\n')
6beb30a6 445 sv_catpvs(sstr, "\\n");
422d053b 446 else if (c == '\r')
6beb30a6 447 sv_catpvs(sstr, "\\r");
422d053b 448 else if (c == '\t')
6beb30a6 449 sv_catpvs(sstr, "\\t");
422d053b 450 else if (c == '\a')
6beb30a6 451 sv_catpvs(sstr, "\\a");
422d053b 452 else if (c == '\b')
6beb30a6 453 sv_catpvs(sstr, "\\b");
422d053b 454 else if (c == '\f')
6beb30a6 455 sv_catpvs(sstr, "\\f");
422d053b 456 else if (c == '\v')
6beb30a6 457 sv_catpvs(sstr, "\\v");
a8a597b2 458 else
422d053b 459 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", c);
6beb30a6 460 sv_catpvs(sstr, "'");
a8a597b2
MB
461 return sstr;
462}
463
8f3d514b
JC
464#if PERL_VERSION >= 9
465# define PMOP_pmreplstart(o) o->op_pmstashstartu.op_pmreplstart
466# define PMOP_pmreplroot(o) o->op_pmreplrootu.op_pmreplroot
467#else
468# define PMOP_pmreplstart(o) o->op_pmreplstart
469# define PMOP_pmreplroot(o) o->op_pmreplroot
470# define PMOP_pmpermflags(o) o->op_pmpermflags
471# define PMOP_pmdynflags(o) o->op_pmdynflags
472#endif
473
5d7488b2
AL
474static void
475walkoptree(pTHX_ SV *opsv, const char *method)
a8a597b2
MB
476{
477 dSP;
f3be9b72 478 OP *o, *kid;
89ca4ac7
JH
479 dMY_CXT;
480
a8a597b2
MB
481 if (!SvROK(opsv))
482 croak("opsv is not a reference");
483 opsv = sv_mortalcopy(opsv);
56431972 484 o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv)));
a8a597b2
MB
485 if (walkoptree_debug) {
486 PUSHMARK(sp);
487 XPUSHs(opsv);
488 PUTBACK;
489 perl_call_method("walkoptree_debug", G_DISCARD);
490 }
491 PUSHMARK(sp);
492 XPUSHs(opsv);
493 PUTBACK;
494 perl_call_method(method, G_DISCARD);
495 if (o && (o->op_flags & OPf_KIDS)) {
a8a597b2
MB
496 for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
497 /* Use the same opsv. Rely on methods not to mess it up. */
56431972 498 sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
cea2e8a9 499 walkoptree(aTHX_ opsv, method);
a8a597b2
MB
500 }
501 }
5464c149 502 if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
8f3d514b 503 && (kid = PMOP_pmreplroot(cPMOPo)))
f3be9b72 504 {
5464c149 505 sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
f3be9b72
RGS
506 walkoptree(aTHX_ opsv, method);
507 }
a8a597b2
MB
508}
509
5d7488b2 510static SV **
1df34986
AE
511oplist(pTHX_ OP *o, SV **SP)
512{
513 for(; o; o = o->op_next) {
514 SV *opsv;
7252851f
NC
515#if PERL_VERSION >= 9
516 if (o->op_opt == 0)
1df34986 517 break;
2814eb74 518 o->op_opt = 0;
7252851f
NC
519#else
520 if (o->op_seq == 0)
521 break;
522 o->op_seq = 0;
523#endif
1df34986
AE
524 opsv = sv_newmortal();
525 sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
526 XPUSHs(opsv);
527 switch (o->op_type) {
528 case OP_SUBST:
8f3d514b 529 SP = oplist(aTHX_ PMOP_pmreplstart(cPMOPo), SP);
1df34986
AE
530 continue;
531 case OP_SORT:
f66c782a 532 if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
1df34986
AE
533 OP *kid = cLISTOPo->op_first->op_sibling; /* pass pushmark */
534 kid = kUNOP->op_first; /* pass rv2gv */
535 kid = kUNOP->op_first; /* pass leave */
f66c782a 536 SP = oplist(aTHX_ kid->op_next, SP);
1df34986
AE
537 }
538 continue;
539 }
540 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
541 case OA_LOGOP:
542 SP = oplist(aTHX_ cLOGOPo->op_other, SP);
543 break;
544 case OA_LOOP:
545 SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
546 SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
547 SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
548 break;
549 }
550 }
551 return SP;
552}
553
a8a597b2
MB
554typedef OP *B__OP;
555typedef UNOP *B__UNOP;
556typedef BINOP *B__BINOP;
557typedef LOGOP *B__LOGOP;
a8a597b2
MB
558typedef LISTOP *B__LISTOP;
559typedef PMOP *B__PMOP;
560typedef SVOP *B__SVOP;
7934575e 561typedef PADOP *B__PADOP;
a8a597b2
MB
562typedef PVOP *B__PVOP;
563typedef LOOP *B__LOOP;
564typedef COP *B__COP;
565
566typedef SV *B__SV;
567typedef SV *B__IV;
568typedef SV *B__PV;
569typedef SV *B__NV;
570typedef SV *B__PVMG;
5c35adbb
NC
571#if PERL_VERSION >= 11
572typedef SV *B__REGEXP;
573#endif
a8a597b2
MB
574typedef SV *B__PVLV;
575typedef SV *B__BM;
576typedef SV *B__RV;
1df34986 577typedef SV *B__FM;
a8a597b2
MB
578typedef AV *B__AV;
579typedef HV *B__HV;
580typedef CV *B__CV;
581typedef GV *B__GV;
582typedef IO *B__IO;
583
584typedef MAGIC *B__MAGIC;
fd9f6265 585typedef HE *B__HE;
e412117e 586#if PERL_VERSION >= 9
fd9f6265 587typedef struct refcounted_he *B__RHE;
e412117e 588#endif
a8a597b2 589
b1826b71
NC
590#include "const-c.inc"
591
a8a597b2
MB
592MODULE = B PACKAGE = B PREFIX = B_
593
b1826b71
NC
594INCLUDE: const-xs.inc
595
a8a597b2
MB
596PROTOTYPES: DISABLE
597
598BOOT:
4c1f658f 599{
6beb30a6 600 HV *stash = gv_stashpvs("B", GV_ADD);
cbfd0a87 601 AV *export_ok = perl_get_av("B::EXPORT_OK", GV_ADD);
89ca4ac7 602 MY_CXT_INIT;
e8edd1e6
TH
603 specialsv_list[0] = Nullsv;
604 specialsv_list[1] = &PL_sv_undef;
605 specialsv_list[2] = &PL_sv_yes;
606 specialsv_list[3] = &PL_sv_no;
5c3c3f81
NC
607 specialsv_list[4] = (SV *) pWARN_ALL;
608 specialsv_list[5] = (SV *) pWARN_NONE;
609 specialsv_list[6] = (SV *) pWARN_STD;
f5ba1307 610#if PERL_VERSION <= 8
e6663653 611# define OPpPAD_STATE 0
7252851f 612#endif
4c1f658f 613}
a8a597b2 614
3280af22 615#define B_main_cv() PL_main_cv
31d7d75a 616#define B_init_av() PL_initav
651aa52e 617#define B_inc_gv() PL_incgv
ece599bd 618#define B_check_av() PL_checkav_save
e6663653
NC
619#if PERL_VERSION > 8
620# define B_unitcheck_av() PL_unitcheckav_save
621#else
622# define B_unitcheck_av() NULL
623#endif
059a8bb7
JH
624#define B_begin_av() PL_beginav_save
625#define B_end_av() PL_endav
3280af22
NIS
626#define B_main_root() PL_main_root
627#define B_main_start() PL_main_start
56eca212 628#define B_amagic_generation() PL_amagic_generation
5ce57cc0 629#define B_sub_generation() PL_sub_generation
651aa52e
AE
630#define B_defstash() PL_defstash
631#define B_curstash() PL_curstash
632#define B_dowarn() PL_dowarn
3280af22
NIS
633#define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
634#define B_sv_undef() &PL_sv_undef
635#define B_sv_yes() &PL_sv_yes
636#define B_sv_no() &PL_sv_no
1df34986 637#define B_formfeed() PL_formfeed
9d2bbe64
MB
638#ifdef USE_ITHREADS
639#define B_regex_padav() PL_regex_padav
640#endif
a8a597b2 641
31d7d75a
NIS
642B::AV
643B_init_av()
644
059a8bb7 645B::AV
ece599bd
RGS
646B_check_av()
647
e412117e
NC
648#if PERL_VERSION >= 9
649
ece599bd 650B::AV
676456c2
AG
651B_unitcheck_av()
652
e412117e
NC
653#endif
654
676456c2 655B::AV
059a8bb7
JH
656B_begin_av()
657
658B::AV
659B_end_av()
660
651aa52e
AE
661B::GV
662B_inc_gv()
663
9d2bbe64
MB
664#ifdef USE_ITHREADS
665
666B::AV
667B_regex_padav()
668
669#endif
670
a8a597b2
MB
671B::CV
672B_main_cv()
673
674B::OP
675B_main_root()
676
677B::OP
678B_main_start()
679
56eca212
GS
680long
681B_amagic_generation()
682
5ce57cc0
JJ
683long
684B_sub_generation()
685
a8a597b2
MB
686B::AV
687B_comppadlist()
688
689B::SV
690B_sv_undef()
691
692B::SV
693B_sv_yes()
694
695B::SV
696B_sv_no()
697
651aa52e
AE
698B::HV
699B_curstash()
700
701B::HV
702B_defstash()
a8a597b2 703
651aa52e
AE
704U8
705B_dowarn()
706
1df34986
AE
707B::SV
708B_formfeed()
709
651aa52e
AE
710void
711B_warnhook()
712 CODE:
9496d2e5 713 ST(0) = make_sv_object(aTHX_ NULL, PL_warnhook);
651aa52e
AE
714
715void
716B_diehook()
717 CODE:
9496d2e5 718 ST(0) = make_sv_object(aTHX_ NULL, PL_diehook);
651aa52e
AE
719
720MODULE = B PACKAGE = B
a8a597b2
MB
721
722void
723walkoptree(opsv, method)
724 SV * opsv
5d7488b2 725 const char * method
cea2e8a9
GS
726 CODE:
727 walkoptree(aTHX_ opsv, method);
a8a597b2
MB
728
729int
730walkoptree_debug(...)
731 CODE:
89ca4ac7 732 dMY_CXT;
a8a597b2
MB
733 RETVAL = walkoptree_debug;
734 if (items > 0 && SvTRUE(ST(1)))
735 walkoptree_debug = 1;
736 OUTPUT:
737 RETVAL
738
56431972 739#define address(sv) PTR2IV(sv)
a8a597b2
MB
740
741IV
742address(sv)
743 SV * sv
744
745B::SV
746svref_2object(sv)
747 SV * sv
748 CODE:
749 if (!SvROK(sv))
750 croak("argument is not a reference");
751 RETVAL = (SV*)SvRV(sv);
752 OUTPUT:
0cc1d052
NIS
753 RETVAL
754
755void
756opnumber(name)
5d7488b2 757const char * name
0cc1d052
NIS
758CODE:
759{
760 int i;
761 IV result = -1;
762 ST(0) = sv_newmortal();
763 if (strncmp(name,"pp_",3) == 0)
764 name += 3;
765 for (i = 0; i < PL_maxo; i++)
766 {
767 if (strcmp(name, PL_op_name[i]) == 0)
768 {
769 result = i;
770 break;
771 }
772 }
773 sv_setiv(ST(0),result);
774}
a8a597b2
MB
775
776void
777ppname(opnum)
778 int opnum
779 CODE:
780 ST(0) = sv_newmortal();
3280af22 781 if (opnum >= 0 && opnum < PL_maxo) {
6beb30a6 782 sv_setpvs(ST(0), "pp_");
22c35a8c 783 sv_catpv(ST(0), PL_op_name[opnum]);
a8a597b2
MB
784 }
785
786void
787hash(sv)
788 SV * sv
789 CODE:
a8a597b2
MB
790 STRLEN len;
791 U32 hash = 0;
8c5b7c71 792 const char *s = SvPVbyte(sv, len);
c32d3395 793 PERL_HASH(hash, s, len);
90b16320 794 ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "0x%"UVxf, (UV)hash));
a8a597b2
MB
795
796#define cast_I32(foo) (I32)foo
797IV
798cast_I32(i)
799 IV i
800
801void
802minus_c()
803 CODE:
3280af22 804 PL_minus_c = TRUE;
a8a597b2 805
059a8bb7
JH
806void
807save_BEGINs()
808 CODE:
aefff11f 809 PL_savebegin = TRUE;
059a8bb7 810
a8a597b2
MB
811SV *
812cstring(sv)
813 SV * sv
84556172
NC
814 ALIAS:
815 perlstring = 1
9e380ad4 816 cchar = 2
09e97b95 817 PPCODE:
9e380ad4 818 PUSHs(ix == 2 ? cchar(aTHX_ sv) : cstring(aTHX_ sv, ix));
a8a597b2
MB
819
820void
821threadsv_names()
822 PPCODE:
f5ba1307
NC
823#if PERL_VERSION <= 8
824# ifdef USE_5005THREADS
825 int i;
5d7488b2 826 const STRLEN len = strlen(PL_threadsv_names);
f5ba1307
NC
827
828 EXTEND(sp, len);
829 for (i = 0; i < len; i++)
d3d34884 830 PUSHs(newSVpvn_flags(&PL_threadsv_names[i], 1, SVs_TEMP));
f5ba1307
NC
831# endif
832#endif
a8a597b2 833
086f9b42
NC
834#define OPp 0x00000
835#define PADOFFSETp 0x10000
836#define U8p 0x20000
a78b89ef 837#define U32p 0x30000
ba7298e3
NC
838#define SVp 0x40000
839#define IVp 0x50000
086f9b42
NC
840
841#define OP_next_ix OPp | offsetof(struct op, op_next)
842#define OP_sibling_ix OPp | offsetof(struct op, op_sibling)
843#define UNOP_first_ix OPp | offsetof(struct unop, op_first)
844#define BINOP_last_ix OPp | offsetof(struct binop, op_last)
845#define LOGOP_other_ix OPp | offsetof(struct logop, op_other)
9b1961be 846#if PERL_VERSION >= 9
086f9b42
NC
847# define PMOP_pmreplstart_ix \
848 OPp | offsetof(struct pmop, op_pmstashstartu.op_pmreplstart)
9b1961be 849#else
086f9b42 850# define PMOP_pmreplstart_ix OPp | offsetof(struct pmop, op_pmreplstart)
9b1961be 851#endif
086f9b42
NC
852#define LOOP_redoop_ix OPp | offsetof(struct loop, op_redoop)
853#define LOOP_nextop_ix OPp | offsetof(struct loop, op_nextop)
854#define LOOP_lastop_ix OPp | offsetof(struct loop, op_lastop)
855
856#define OP_targ_ix PADOFFSETp | offsetof(struct op, op_targ)
857#define OP_flags_ix U8p | offsetof(struct op, op_flags)
858#define OP_private_ix U8p | offsetof(struct op, op_private)
9b1961be 859
a78b89ef
NC
860#define PMOP_pmflags_ix U32p | offsetof(struct pmop, op_pmflags)
861
657e3fc2
NC
862#ifdef USE_ITHREADS
863#define PMOP_pmoffset_ix IVp | offsetof(struct pmop, op_pmoffset)
864#endif
865
ba7298e3
NC
866# Yes, B::SV::sv and B::SV::gv really do end up generating identical code.
867#define SVOP_sv_ix SVp | offsetof(struct svop, op_sv)
868#define SVOP_gv_ix SVp | offsetof(struct svop, op_sv)
869
9488fb36
NC
870#define PADOP_padix_ix PADOFFSETp | offsetof(struct padop, op_padix)
871
a8a597b2
MB
872MODULE = B PACKAGE = B::OP PREFIX = OP_
873
651aa52e
AE
874size_t
875OP_size(o)
876 B::OP o
877 CODE:
878 RETVAL = opsizes[cc_opclass(aTHX_ o)];
879 OUTPUT:
880 RETVAL
881
9b1961be
NC
882# The type checking code in B has always been identical for all OP types,
883# irrespective of whether the action is actually defined on that OP.
884# We should fix this
086f9b42 885void
9b1961be 886next(o)
a8a597b2 887 B::OP o
9b1961be 888 ALIAS:
086f9b42
NC
889 B::OP::next = OP_next_ix
890 B::OP::sibling = OP_sibling_ix
891 B::OP::targ = OP_targ_ix
892 B::OP::flags = OP_flags_ix
893 B::OP::private = OP_private_ix
894 B::UNOP::first = UNOP_first_ix
895 B::BINOP::last = BINOP_last_ix
896 B::LOGOP::other = LOGOP_other_ix
897 B::PMOP::pmreplstart = PMOP_pmreplstart_ix
898 B::LOOP::redoop = LOOP_redoop_ix
899 B::LOOP::nextop = LOOP_nextop_ix
900 B::LOOP::lastop = LOOP_lastop_ix
a78b89ef 901 B::PMOP::pmflags = PMOP_pmflags_ix
ba7298e3
NC
902 B::SVOP::sv = SVOP_sv_ix
903 B::SVOP::gv = SVOP_gv_ix
9488fb36 904 B::PADOP::padix = PADOP_padix_ix
9b1961be
NC
905 PREINIT:
906 char *ptr;
086f9b42
NC
907 SV *ret;
908 PPCODE:
909 ptr = (ix & 0xFFFF) + (char *)o;
910 switch ((U8)(ix >> 16)) {
911 case (U8)(OPp >> 16):
912 {
913 OP *const o2 = *((OP **)ptr);
914 ret = sv_newmortal();
915 sv_setiv(newSVrv(ret, cc_opclassname(aTHX_ o2)), PTR2IV(o2));
916 break;
917 }
918 case (U8)(PADOFFSETp >> 16):
919 ret = sv_2mortal(newSVuv(*((PADOFFSET*)ptr)));
920 break;
921 case (U8)(U8p >> 16):
922 ret = sv_2mortal(newSVuv(*((U8*)ptr)));
923 break;
a78b89ef
NC
924 case (U8)(U32p >> 16):
925 ret = sv_2mortal(newSVuv(*((U32*)ptr)));
926 break;
ba7298e3
NC
927 case (U8)(SVp >> 16):
928 ret = make_sv_object(aTHX_ NULL, *((SV **)ptr));
929 break;
657e3fc2
NC
930#ifdef USE_ITHREADS
931 case (U8)(IVp >> 16):
932 ret = sv_2mortal(newSViv(*((IV*)ptr)));
933 break;
934#endif
086f9b42
NC
935 }
936 ST(0) = ret;
937 XSRETURN(1);
a8a597b2
MB
938
939char *
3f872cb9
GS
940OP_name(o)
941 B::OP o
d2b33dc1
NC
942 ALIAS:
943 desc = 1
3f872cb9 944 CODE:
d2b33dc1 945 RETVAL = (char *)(ix ? PL_op_desc : PL_op_name)[o->op_type];
8063af02
DM
946 OUTPUT:
947 RETVAL
3f872cb9 948
8063af02 949void
a8a597b2
MB
950OP_ppaddr(o)
951 B::OP o
dc333d64
GS
952 PREINIT:
953 int i;
fdbd1d64 954 SV *sv = newSVpvs_flags("PL_ppaddr[OP_", SVs_TEMP);
a8a597b2 955 CODE:
dc333d64 956 sv_catpv(sv, PL_op_name[o->op_type]);
7c436af3 957 for (i=13; (STRLEN)i < SvCUR(sv); ++i)
dc333d64 958 SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
6beb30a6 959 sv_catpvs(sv, "]");
dc333d64 960 ST(0) = sv;
a8a597b2 961
7252851f 962#if PERL_VERSION >= 9
dd8be0e4
NC
963# These 3 are all bitfields, so we can't take their addresses.
964UV
965OP_type(o)
2814eb74 966 B::OP o
dd8be0e4
NC
967 ALIAS:
968 opt = 1
969 spare = 2
970 CODE:
971 switch(ix) {
972 case 1:
973 RETVAL = o->op_opt;
974 break;
975 case 2:
976 RETVAL = o->op_spare;
977 break;
978 default:
979 RETVAL = o->op_type;
980 }
981 OUTPUT:
982 RETVAL
2814eb74 983
7252851f
NC
984#else
985
dd8be0e4
NC
986UV
987OP_type(o)
7252851f 988 B::OP o
dd8be0e4
NC
989 ALIAS:
990 seq = 1
991 CODE:
992 switch(ix) {
993 case 1:
994 RETVAL = o->op_seq;
995 break;
996 default:
997 RETVAL = o->op_type;
998 }
999 OUTPUT:
1000 RETVAL
7252851f
NC
1001
1002#endif
1003
1df34986
AE
1004void
1005OP_oplist(o)
1006 B::OP o
1007 PPCODE:
1008 SP = oplist(aTHX_ o, SP);
1009
a8a597b2
MB
1010MODULE = B PACKAGE = B::LISTOP PREFIX = LISTOP_
1011
c03c2844
SM
1012U32
1013LISTOP_children(o)
1014 B::LISTOP o
1015 OP * kid = NO_INIT
1016 int i = NO_INIT
1017 CODE:
c03c2844
SM
1018 i = 0;
1019 for (kid = o->op_first; kid; kid = kid->op_sibling)
1020 i++;
8063af02
DM
1021 RETVAL = i;
1022 OUTPUT:
016e8ce0 1023 RETVAL
a8a597b2
MB
1024
1025MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
1026
20e98b0f
NC
1027#if PERL_VERSION <= 8
1028
a8a597b2
MB
1029void
1030PMOP_pmreplroot(o)
1031 B::PMOP o
1032 OP * root = NO_INIT
1033 CODE:
1034 ST(0) = sv_newmortal();
1035 root = o->op_pmreplroot;
1036 /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
1037 if (o->op_type == OP_PUSHRE) {
20e98b0f 1038# ifdef USE_ITHREADS
9d2bbe64 1039 sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
20e98b0f 1040# else
a8a597b2
MB
1041 sv_setiv(newSVrv(ST(0), root ?
1042 svclassnames[SvTYPE((SV*)root)] : "B::SV"),
56431972 1043 PTR2IV(root));
20e98b0f 1044# endif
a8a597b2
MB
1045 }
1046 else {
56431972 1047 sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
a8a597b2
MB
1048 }
1049
20e98b0f
NC
1050#else
1051
1052void
1053PMOP_pmreplroot(o)
1054 B::PMOP o
1055 CODE:
1056 ST(0) = sv_newmortal();
1057 if (o->op_type == OP_PUSHRE) {
1058# ifdef USE_ITHREADS
1059 sv_setiv(ST(0), o->op_pmreplrootu.op_pmtargetoff);
1060# else
1061 GV *const target = o->op_pmreplrootu.op_pmtargetgv;
1062 sv_setiv(newSVrv(ST(0), target ?
1063 svclassnames[SvTYPE((SV*)target)] : "B::SV"),
1064 PTR2IV(target));
1065# endif
1066 }
1067 else {
1068 OP *const root = o->op_pmreplrootu.op_pmreplroot;
1069 sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)),
1070 PTR2IV(root));
1071 }
1072
1073#endif
1074
9d2bbe64 1075#ifdef USE_ITHREADS
016e8ce0 1076#define PMOP_pmstashpv(o) PmopSTASHPV(o);
9d2bbe64 1077
651aa52e
AE
1078char*
1079PMOP_pmstashpv(o)
1080 B::PMOP o
1081
1082#else
016e8ce0 1083#define PMOP_pmstash(o) PmopSTASH(o);
651aa52e
AE
1084
1085B::HV
1086PMOP_pmstash(o)
1087 B::PMOP o
1088
9d2bbe64
MB
1089#endif
1090
7c1f70cb 1091#if PERL_VERSION < 9
5b02c205
NC
1092#define PMOP_pmnext(o) o->op_pmnext
1093
1094B::PMOP
1095PMOP_pmnext(o)
1096 B::PMOP o
7c1f70cb
NC
1097
1098U32
1099PMOP_pmpermflags(o)
1100 B::PMOP o
1101
1102U8
1103PMOP_pmdynflags(o)
1104 B::PMOP o
1105
1106#endif
1107
a8a597b2
MB
1108void
1109PMOP_precomp(o)
1110 B::PMOP o
021d294f
NC
1111 PREINIT:
1112 dXSI32;
1113 REGEXP *rx;
a8a597b2 1114 CODE:
aaa362c4 1115 rx = PM_GETRE(o);
c737faaf 1116 ST(0) = sv_newmortal();
021d294f
NC
1117 if (rx) {
1118#if PERL_VERSION >= 9
1119 if (ix) {
1120 sv_setuv(ST(0), RX_EXTFLAGS(rx));
1121 } else
1122#endif
1123 {
1124 sv_setpvn(ST(0), RX_PRECOMP(rx), RX_PRELEN(rx));
1125 }
1126 }
c737faaf 1127
021d294f
NC
1128BOOT:
1129{
1130 CV *cv;
1131#ifdef USE_ITHREADS
1132 cv = newXS("B::PMOP::pmoffset", XS_B__OP_next, __FILE__);
1133 XSANY.any_i32 = PMOP_pmoffset_ix;
7c1f70cb 1134#endif
021d294f
NC
1135#if PERL_VERSION >= 9
1136 cv = newXS("B::PMOP::reflags", XS_B__PMOP_precomp, __FILE__);
1137 XSANY.any_i32 = 1;
1138#endif
1139}
1140
dd2155a4 1141#define PADOP_sv(o) (o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
7934575e 1142#define PADOP_gv(o) ((o->op_padix \
dd2155a4 1143 && SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
3ae1b226 1144 ? (GV*)PAD_SVl(o->op_padix) : (GV *)NULL)
a8a597b2 1145
7934575e
GS
1146MODULE = B PACKAGE = B::PADOP PREFIX = PADOP_
1147
7934575e
GS
1148B::SV
1149PADOP_sv(o)
1150 B::PADOP o
a8a597b2
MB
1151
1152B::GV
7934575e
GS
1153PADOP_gv(o)
1154 B::PADOP o
a8a597b2
MB
1155
1156MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_
1157
1158void
1159PVOP_pv(o)
1160 B::PVOP o
1161 CODE:
1162 /*
bec89253 1163 * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
a8a597b2
MB
1164 * whereas other PVOPs point to a null terminated string.
1165 */
bec89253
RH
1166 if (o->op_type == OP_TRANS &&
1167 (o->op_private & OPpTRANS_COMPLEMENT) &&
1168 !(o->op_private & OPpTRANS_DELETE))
1169 {
5d7488b2
AL
1170 const short* const tbl = (short*)o->op_pv;
1171 const short entries = 257 + tbl[256];
d3d34884 1172 ST(0) = newSVpvn_flags(o->op_pv, entries * sizeof(short), SVs_TEMP);
bec89253
RH
1173 }
1174 else if (o->op_type == OP_TRANS) {
d3d34884 1175 ST(0) = newSVpvn_flags(o->op_pv, 256 * sizeof(short), SVs_TEMP);
bec89253
RH
1176 }
1177 else
d3d34884 1178 ST(0) = newSVpvn_flags(o->op_pv, strlen(o->op_pv), SVs_TEMP);
a8a597b2 1179
4b65a919 1180#define COP_label(o) CopLABEL(o)
11faa288
GS
1181#define COP_stashpv(o) CopSTASHPV(o)
1182#define COP_stash(o) CopSTASH(o)
57843af0 1183#define COP_file(o) CopFILE(o)
1df34986 1184#define COP_filegv(o) CopFILEGV(o)
a8a597b2 1185#define COP_cop_seq(o) o->cop_seq
fc15ae8f 1186#define COP_arybase(o) CopARYBASE_get(o)
57843af0 1187#define COP_line(o) CopLINE(o)
d5ec2987 1188#define COP_hints(o) CopHINTS_get(o)
a8a597b2
MB
1189
1190MODULE = B PACKAGE = B::COP PREFIX = COP_
1191
d5b8ed54
NC
1192const char *
1193COP_label(o)
1194 B::COP o
1195
11faa288
GS
1196char *
1197COP_stashpv(o)
1198 B::COP o
1199
a8a597b2
MB
1200B::HV
1201COP_stash(o)
1202 B::COP o
1203
57843af0
GS
1204char *
1205COP_file(o)
a8a597b2
MB
1206 B::COP o
1207
1df34986
AE
1208B::GV
1209COP_filegv(o)
1210 B::COP o
1211
1212
a8a597b2
MB
1213U32
1214COP_cop_seq(o)
1215 B::COP o
1216
1217I32
1218COP_arybase(o)
1219 B::COP o
1220
8bafa735 1221U32
a8a597b2
MB
1222COP_line(o)
1223 B::COP o
1224
5c3c3f81 1225void
b295d113
TH
1226COP_warnings(o)
1227 B::COP o
5c3c3f81 1228 PPCODE:
13d356f3 1229#if PERL_VERSION >= 9
9496d2e5 1230 ST(0) = make_warnings_object(aTHX_ o->cop_warnings);
13d356f3
NC
1231#else
1232 ST(0) = make_sv_object(aTHX_ NULL, o->cop_warnings);
1233#endif
5c3c3f81 1234 XSRETURN(1);
b295d113 1235
670f1322 1236void
6e6a1aef
RGS
1237COP_io(o)
1238 B::COP o
11bcd5da 1239 PPCODE:
13d356f3 1240#if PERL_VERSION >= 9
9496d2e5 1241 ST(0) = make_cop_io_object(aTHX_ o);
13d356f3
NC
1242#else
1243 ST(0) = make_sv_object(aTHX_ NULL, o->cop_io);
1244#endif
11bcd5da 1245 XSRETURN(1);
6e6a1aef 1246
13d356f3
NC
1247#if PERL_VERSION >= 9
1248
fd9f6265
JJ
1249B::RHE
1250COP_hints_hash(o)
1251 B::COP o
1252 CODE:
20439bc7 1253 RETVAL = CopHINTHASH_get(o);
fd9f6265
JJ
1254 OUTPUT:
1255 RETVAL
1256
e412117e
NC
1257#endif
1258
1259U32
1260COP_hints(o)
1261 B::COP o
1262
651aa52e
AE
1263MODULE = B PACKAGE = B::SV
1264
de64752d
NC
1265#define MAGICAL_FLAG_BITS (SVs_GMG|SVs_SMG|SVs_RMG)
1266
651aa52e 1267U32
de64752d 1268REFCNT(sv)
651aa52e 1269 B::SV sv
de64752d
NC
1270 ALIAS:
1271 FLAGS = 0xFFFFFFFF
1272 SvTYPE = SVTYPEMASK
1273 POK = SVf_POK
1274 ROK = SVf_ROK
1275 MAGICAL = MAGICAL_FLAG_BITS
1276 CODE:
1277 RETVAL = ix ? (SvFLAGS(sv) & (U32)ix) : SvREFCNT(sv);
1278 OUTPUT:
1279 RETVAL
651aa52e 1280
9efba5c8 1281void
429a5ce7
SM
1282object_2svref(sv)
1283 B::SV sv
9efba5c8
NC
1284 PPCODE:
1285 ST(0) = sv_2mortal(newRV(sv));
1286 XSRETURN(1);
1287
a8a597b2
MB
1288MODULE = B PACKAGE = B::IV PREFIX = Sv
1289
1290IV
1291SvIV(sv)
1292 B::IV sv
1293
1294IV
1295SvIVX(sv)
1296 B::IV sv
1297
0ca04487
VB
1298UV
1299SvUVX(sv)
1300 B::IV sv
1301
1302
a8a597b2
MB
1303MODULE = B PACKAGE = B::IV
1304
1305#define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
1306
1307int
1308needs64bits(sv)
1309 B::IV sv
1310
1311void
1312packiv(sv)
1313 B::IV sv
1314 CODE:
1315 if (sizeof(IV) == 8) {
1316 U32 wp[2];
5d7488b2 1317 const IV iv = SvIVX(sv);
a8a597b2
MB
1318 /*
1319 * The following way of spelling 32 is to stop compilers on
1320 * 32-bit architectures from moaning about the shift count
1321 * being >= the width of the type. Such architectures don't
1322 * reach this code anyway (unless sizeof(IV) > 8 but then
1323 * everything else breaks too so I'm not fussed at the moment).
1324 */
42718184
RB
1325#ifdef UV_IS_QUAD
1326 wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1327#else
1328 wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1329#endif
a8a597b2 1330 wp[1] = htonl(iv & 0xffffffff);
d3d34884 1331 ST(0) = newSVpvn_flags((char *)wp, 8, SVs_TEMP);
a8a597b2
MB
1332 } else {
1333 U32 w = htonl((U32)SvIVX(sv));
d3d34884 1334 ST(0) = newSVpvn_flags((char *)&w, 4, SVs_TEMP);
a8a597b2
MB
1335 }
1336
4df7f6af 1337#if PERL_VERSION >= 11
f046b1bd
NC
1338# The input typemap checking makes no distinction between different SV types,
1339# so the XS body will generate the same C code, despite the different XS
1340# "types". So there is no change in behaviour from doing newXS like this,
1341# compared with the old approach of having a (near) duplicate XS body.
1342# We should fix the typemap checking.
4df7f6af 1343
f046b1bd
NC
1344BOOT:
1345 newXS("B::IV::RV", XS_B__PV_RV, __FILE__);
4df7f6af
NC
1346
1347#endif
1348
a8a597b2
MB
1349MODULE = B PACKAGE = B::NV PREFIX = Sv
1350
76ef7183 1351NV
a8a597b2
MB
1352SvNV(sv)
1353 B::NV sv
1354
76ef7183 1355NV
a8a597b2
MB
1356SvNVX(sv)
1357 B::NV sv
1358
809abb02
NC
1359U32
1360COP_SEQ_RANGE_LOW(sv)
1361 B::NV sv
1362
1363U32
1364COP_SEQ_RANGE_HIGH(sv)
1365 B::NV sv
1366
1367U32
1368PARENT_PAD_INDEX(sv)
1369 B::NV sv
1370
1371U32
1372PARENT_FAKELEX_FLAGS(sv)
1373 B::NV sv
1374
4df7f6af
NC
1375#if PERL_VERSION < 11
1376
a8a597b2
MB
1377MODULE = B PACKAGE = B::RV PREFIX = Sv
1378
1379B::SV
1380SvRV(sv)
1381 B::RV sv
1382
4df7f6af
NC
1383#endif
1384
a8a597b2
MB
1385MODULE = B PACKAGE = B::PV PREFIX = Sv
1386
0b40bd6d
RH
1387char*
1388SvPVX(sv)
1389 B::PV sv
1390
b326da91
MB
1391B::SV
1392SvRV(sv)
1393 B::PV sv
1394 CODE:
1395 if( SvROK(sv) ) {
1396 RETVAL = SvRV(sv);
1397 }
1398 else {
1399 croak( "argument is not SvROK" );
1400 }
1401 OUTPUT:
1402 RETVAL
1403
a8a597b2
MB
1404void
1405SvPV(sv)
1406 B::PV sv
1407 CODE:
c0b20461 1408 if( SvPOK(sv) ) {
fdbd1d64
NC
1409 STRLEN len = SvCUR(sv);
1410 const char *p = SvPVX_const(sv);
0eaead75
NC
1411#if PERL_VERSION < 10
1412 /* Before 5.10 (well 931b58fb28fa5ca7), PAD_COMPNAME_GEN was stored
1413 in SvCUR(), which meant we had to attempt this special casing
1414 to avoid tripping up over variable names in the pads. */
fdbd1d64 1415 if((SvLEN(sv) && len >= SvLEN(sv))) {
b55685ae
NC
1416 /* It claims to be longer than the space allocated for it -
1417 presuambly it's a variable name in the pad */
fdbd1d64 1418 len = strlen(p);
b55685ae 1419 }
0eaead75 1420#endif
fdbd1d64 1421 ST(0) = newSVpvn_flags(p, len, SVs_TEMP | SvUTF8(sv));
b326da91
MB
1422 }
1423 else {
1424 /* XXX for backward compatibility, but should fail */
1425 /* croak( "argument is not SvPOK" ); */
fdbd1d64 1426 ST(0) = sv_newmortal();
b326da91 1427 }
a8a597b2 1428
5a44e503
NC
1429# This used to read 257. I think that that was buggy - should have been 258.
1430# (The "\0", the flags byte, and 256 for the table. Not that anything
1431# anywhere calls this method. NWC.
651aa52e
AE
1432void
1433SvPVBM(sv)
1434 B::PV sv
1435 CODE:
fdbd1d64
NC
1436 ST(0) = newSVpvn_flags(SvPVX_const(sv),
1437 SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0),
1438 SVs_TEMP);
651aa52e
AE
1439
1440
445a12f6
DM
1441STRLEN
1442SvLEN(sv)
1443 B::PV sv
1444
1445STRLEN
1446SvCUR(sv)
1447 B::PV sv
1448
a8a597b2
MB
1449MODULE = B PACKAGE = B::PVMG PREFIX = Sv
1450
1451void
1452SvMAGIC(sv)
1453 B::PVMG sv
1454 MAGIC * mg = NO_INIT
1455 PPCODE:
1456 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
9496d2e5 1457 XPUSHs(make_mg_object(aTHX_ mg));
a8a597b2
MB
1458
1459MODULE = B PACKAGE = B::PVMG
1460
1461B::HV
1462SvSTASH(sv)
1463 B::PVMG sv
1464
5c35adbb
NC
1465MODULE = B PACKAGE = B::REGEXP
1466
1467#if PERL_VERSION >= 11
1468
1469IV
1470REGEX(sv)
07bc277f 1471 B::REGEXP sv
5c35adbb 1472 CODE:
288b8c02
NC
1473 /* FIXME - can we code this method more efficiently? */
1474 RETVAL = PTR2IV(sv);
5c35adbb
NC
1475 OUTPUT:
1476 RETVAL
1477
1478SV*
1479precomp(sv)
07bc277f 1480 B::REGEXP sv
5c35adbb 1481 CODE:
288b8c02 1482 RETVAL = newSVpvn( RX_PRECOMP(sv), RX_PRELEN(sv) );
5c35adbb
NC
1483 OUTPUT:
1484 RETVAL
1485
1486#endif
1487
a8a597b2
MB
1488#define MgMOREMAGIC(mg) mg->mg_moremagic
1489#define MgPRIVATE(mg) mg->mg_private
1490#define MgTYPE(mg) mg->mg_type
1491#define MgFLAGS(mg) mg->mg_flags
1492#define MgOBJ(mg) mg->mg_obj
88b39979 1493#define MgLENGTH(mg) mg->mg_len
bde7177d 1494#define MgREGEX(mg) PTR2IV(mg->mg_obj)
a8a597b2
MB
1495
1496MODULE = B PACKAGE = B::MAGIC PREFIX = Mg
1497
1498B::MAGIC
1499MgMOREMAGIC(mg)
1500 B::MAGIC mg
c5f0f3aa
RGS
1501 CODE:
1502 if( MgMOREMAGIC(mg) ) {
1503 RETVAL = MgMOREMAGIC(mg);
1504 }
1505 else {
1506 XSRETURN_UNDEF;
1507 }
1508 OUTPUT:
1509 RETVAL
a8a597b2
MB
1510
1511U16
1512MgPRIVATE(mg)
1513 B::MAGIC mg
1514
1515char
1516MgTYPE(mg)
1517 B::MAGIC mg
1518
1519U8
1520MgFLAGS(mg)
1521 B::MAGIC mg
1522
1523B::SV
1524MgOBJ(mg)
1525 B::MAGIC mg
b326da91 1526
9d2bbe64
MB
1527IV
1528MgREGEX(mg)
1529 B::MAGIC mg
1530 CODE:
a8248b05 1531 if(mg->mg_type == PERL_MAGIC_qr) {
9d2bbe64
MB
1532 RETVAL = MgREGEX(mg);
1533 }
1534 else {
1535 croak( "REGEX is only meaningful on r-magic" );
1536 }
1537 OUTPUT:
1538 RETVAL
1539
b326da91
MB
1540SV*
1541precomp(mg)
1542 B::MAGIC mg
1543 CODE:
a8248b05 1544 if (mg->mg_type == PERL_MAGIC_qr) {
b326da91 1545 REGEXP* rx = (REGEXP*)mg->mg_obj;
ef35129c 1546 RETVAL = Nullsv;
b326da91 1547 if( rx )
220fc49f 1548 RETVAL = newSVpvn( RX_PRECOMP(rx), RX_PRELEN(rx) );
b326da91
MB
1549 }
1550 else {
1551 croak( "precomp is only meaningful on r-magic" );
1552 }
1553 OUTPUT:
1554 RETVAL
a8a597b2 1555
88b39979
VB
1556I32
1557MgLENGTH(mg)
1558 B::MAGIC mg
1559
a8a597b2
MB
1560void
1561MgPTR(mg)
1562 B::MAGIC mg
1563 CODE:
88b39979
VB
1564 if (mg->mg_ptr){
1565 if (mg->mg_len >= 0){
fdbd1d64 1566 ST(0) = newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
651aa52e 1567 } else if (mg->mg_len == HEf_SVKEY) {
9496d2e5 1568 ST(0) = make_sv_object(aTHX_ NULL, (SV*)mg->mg_ptr);
fdbd1d64
NC
1569 } else
1570 ST(0) = sv_newmortal();
1571 } else
1572 ST(0) = sv_newmortal();
a8a597b2
MB
1573
1574MODULE = B PACKAGE = B::PVLV PREFIX = Lv
1575
1576U32
1577LvTARGOFF(sv)
1578 B::PVLV sv
1579
1580U32
1581LvTARGLEN(sv)
1582 B::PVLV sv
1583
1584char
1585LvTYPE(sv)
1586 B::PVLV sv
1587
1588B::SV
1589LvTARG(sv)
1590 B::PVLV sv
1591
1592MODULE = B PACKAGE = B::BM PREFIX = Bm
1593
1594I32
1595BmUSEFUL(sv)
1596 B::BM sv
1597
85c508c3 1598U32
a8a597b2
MB
1599BmPREVIOUS(sv)
1600 B::BM sv
1601
1602U8
1603BmRARE(sv)
1604 B::BM sv
1605
1606void
1607BmTABLE(sv)
1608 B::BM sv
1609 STRLEN len = NO_INIT
1610 char * str = NO_INIT
1611 CODE:
1612 str = SvPV(sv, len);
1613 /* Boyer-Moore table is just after string and its safety-margin \0 */
d3d34884 1614 ST(0) = newSVpvn_flags(str + len + PERL_FBM_TABLE_OFFSET, 256, SVs_TEMP);
a8a597b2
MB
1615
1616MODULE = B PACKAGE = B::GV PREFIX = Gv
1617
1618void
1619GvNAME(gv)
1620 B::GV gv
1621 CODE:
6beb30a6
NC
1622#if PERL_VERSION >= 10
1623 ST(0) = sv_2mortal(newSVhek(GvNAME_HEK(gv)));
1624#else
d3d34884 1625 ST(0) = newSVpvn_flags(GvNAME(gv), GvNAMELEN(gv), SVs_TEMP);
6beb30a6 1626#endif
a8a597b2 1627
87d7fd28
GS
1628bool
1629is_empty(gv)
1630 B::GV gv
711fbbf0
NC
1631 ALIAS:
1632 isGV_with_GP = 1
87d7fd28 1633 CODE:
711fbbf0 1634 if (ix) {
50786ba8 1635#if PERL_VERSION >= 9
711fbbf0 1636 RETVAL = isGV_with_GP(gv) ? TRUE : FALSE;
50786ba8 1637#else
711fbbf0 1638 RETVAL = TRUE; /* In 5.8 and earlier they all are. */
50786ba8 1639#endif
711fbbf0
NC
1640 } else {
1641 RETVAL = GvGP(gv) == Null(GP*);
1642 }
50786ba8 1643 OUTPUT:
711fbbf0 1644 RETVAL
50786ba8 1645
651aa52e
AE
1646void*
1647GvGP(gv)
1648 B::GV gv
1649
a8a597b2
MB
1650B::HV
1651GvSTASH(gv)
1652 B::GV gv
1653
1654B::SV
1655GvSV(gv)
1656 B::GV gv
1657
1658B::IO
1659GvIO(gv)
1660 B::GV gv
1661
1df34986 1662B::FM
a8a597b2
MB
1663GvFORM(gv)
1664 B::GV gv
1df34986
AE
1665 CODE:
1666 RETVAL = (SV*)GvFORM(gv);
1667 OUTPUT:
1668 RETVAL
a8a597b2
MB
1669
1670B::AV
1671GvAV(gv)
1672 B::GV gv
1673
1674B::HV
1675GvHV(gv)
1676 B::GV gv
1677
1678B::GV
1679GvEGV(gv)
1680 B::GV gv
1681
1682B::CV
1683GvCV(gv)
1684 B::GV gv
1685
1686U32
1687GvCVGEN(gv)
1688 B::GV gv
1689
8bafa735 1690U32
a8a597b2
MB
1691GvLINE(gv)
1692 B::GV gv
1693
b195d487
GS
1694char *
1695GvFILE(gv)
1696 B::GV gv
1697
a8a597b2
MB
1698B::GV
1699GvFILEGV(gv)
1700 B::GV gv
1701
1702MODULE = B PACKAGE = B::GV
1703
1704U32
1705GvREFCNT(gv)
1706 B::GV gv
1707
1708U8
1709GvFLAGS(gv)
1710 B::GV gv
1711
1712MODULE = B PACKAGE = B::IO PREFIX = Io
1713
1714long
1715IoLINES(io)
1716 B::IO io
1717
1718long
1719IoPAGE(io)
1720 B::IO io
1721
1722long
1723IoPAGE_LEN(io)
1724 B::IO io
1725
1726long
1727IoLINES_LEFT(io)
1728 B::IO io
1729
1730char *
1731IoTOP_NAME(io)
1732 B::IO io
1733
1734B::GV
1735IoTOP_GV(io)
1736 B::IO io
1737
1738char *
1739IoFMT_NAME(io)
1740 B::IO io
1741
1742B::GV
1743IoFMT_GV(io)
1744 B::IO io
1745
1746char *
1747IoBOTTOM_NAME(io)
1748 B::IO io
1749
1750B::GV
1751IoBOTTOM_GV(io)
1752 B::IO io
1753
04071355
NC
1754#if PERL_VERSION <= 8
1755
a8a597b2
MB
1756short
1757IoSUBPROCESS(io)
1758 B::IO io
1759
04071355
NC
1760#endif
1761
b326da91
MB
1762bool
1763IsSTD(io,name)
1764 B::IO io
5d7488b2 1765 const char* name
b326da91
MB
1766 PREINIT:
1767 PerlIO* handle = 0;
1768 CODE:
1769 if( strEQ( name, "stdin" ) ) {
1770 handle = PerlIO_stdin();
1771 }
1772 else if( strEQ( name, "stdout" ) ) {
1773 handle = PerlIO_stdout();
1774 }
1775 else if( strEQ( name, "stderr" ) ) {
1776 handle = PerlIO_stderr();
1777 }
1778 else {
1779 croak( "Invalid value '%s'", name );
1780 }
1781 RETVAL = handle == IoIFP(io);
1782 OUTPUT:
1783 RETVAL
1784
a8a597b2
MB
1785MODULE = B PACKAGE = B::IO
1786
1787char
1788IoTYPE(io)
1789 B::IO io
1790
1791U8
1792IoFLAGS(io)
1793 B::IO io
1794
1795MODULE = B PACKAGE = B::AV PREFIX = Av
1796
1797SSize_t
1798AvFILL(av)
1799 B::AV av
1800
1801SSize_t
1802AvMAX(av)
1803 B::AV av
1804
a8a597b2
MB
1805void
1806AvARRAY(av)
1807 B::AV av
1808 PPCODE:
1809 if (AvFILL(av) >= 0) {
1810 SV **svp = AvARRAY(av);
1811 I32 i;
1812 for (i = 0; i <= AvFILL(av); i++)
9496d2e5 1813 XPUSHs(make_sv_object(aTHX_ NULL, svp[i]));
a8a597b2
MB
1814 }
1815
429a5ce7
SM
1816void
1817AvARRAYelt(av, idx)
1818 B::AV av
1819 int idx
1820 PPCODE:
1821 if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
9496d2e5 1822 XPUSHs(make_sv_object(aTHX_ NULL, (AvARRAY(av)[idx])));
429a5ce7 1823 else
9496d2e5 1824 XPUSHs(make_sv_object(aTHX_ NULL, NULL));
429a5ce7 1825
edcc7c74
NC
1826#if PERL_VERSION < 9
1827
5b02c205
NC
1828#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1829
1830IV
1831AvOFF(av)
1832 B::AV av
1833
edcc7c74
NC
1834MODULE = B PACKAGE = B::AV
1835
1836U8
1837AvFLAGS(av)
1838 B::AV av
1839
1840#endif
1841
1df34986
AE
1842MODULE = B PACKAGE = B::FM PREFIX = Fm
1843
1844IV
1845FmLINES(form)
1846 B::FM form
1847
a8a597b2
MB
1848MODULE = B PACKAGE = B::CV PREFIX = Cv
1849
651aa52e
AE
1850U32
1851CvCONST(cv)
1852 B::CV cv
1853
a8a597b2
MB
1854B::HV
1855CvSTASH(cv)
1856 B::CV cv
1857
1858B::OP
1859CvSTART(cv)
1860 B::CV cv
a0da4400
NC
1861 ALIAS:
1862 ROOT = 1
bf53b3a5 1863 CODE:
a0da4400 1864 RETVAL = CvISXSUB(cv) ? NULL : ix ? CvROOT(cv) : CvSTART(cv);
d04ba589
NC
1865 OUTPUT:
1866 RETVAL
a8a597b2
MB
1867
1868B::GV
1869CvGV(cv)
1870 B::CV cv
1871
57843af0
GS
1872char *
1873CvFILE(cv)
1874 B::CV cv
1875
a8a597b2
MB
1876long
1877CvDEPTH(cv)
1878 B::CV cv
1879
1880B::AV
1881CvPADLIST(cv)
1882 B::CV cv
1883
1884B::CV
1885CvOUTSIDE(cv)
1886 B::CV cv
1887
a3985cdc
DM
1888U32
1889CvOUTSIDE_SEQ(cv)
1890 B::CV cv
1891
a8a597b2
MB
1892void
1893CvXSUB(cv)
1894 B::CV cv
1895 CODE:
d04ba589 1896 ST(0) = sv_2mortal(newSViv(CvISXSUB(cv) ? PTR2IV(CvXSUB(cv)) : 0));
a8a597b2
MB
1897
1898
1899void
1900CvXSUBANY(cv)
1901 B::CV cv
1902 CODE:
9496d2e5
NC
1903 ST(0) = CvCONST(cv)
1904 ? make_sv_object(aTHX_ NULL, (SV *)CvXSUBANY(cv).any_ptr)
1905 : sv_2mortal(newSViv(CvISXSUB(cv) ? CvXSUBANY(cv).any_iv : 0));
a8a597b2 1906
5cfd8ad4
VB
1907MODULE = B PACKAGE = B::CV
1908
6aaf4108 1909U16
5cfd8ad4
VB
1910CvFLAGS(cv)
1911 B::CV cv
1912
de3f1649
JT
1913MODULE = B PACKAGE = B::CV PREFIX = cv_
1914
1915B::SV
1916cv_const_sv(cv)
1917 B::CV cv
1918
5cfd8ad4 1919
a8a597b2
MB
1920MODULE = B PACKAGE = B::HV PREFIX = Hv
1921
1922STRLEN
1923HvFILL(hv)
1924 B::HV hv
1925
1926STRLEN
1927HvMAX(hv)
1928 B::HV hv
1929
1930I32
1931HvKEYS(hv)
1932 B::HV hv
1933
1934I32
1935HvRITER(hv)
1936 B::HV hv
1937
1938char *
1939HvNAME(hv)
1940 B::HV hv
1941
edcc7c74
NC
1942#if PERL_VERSION < 9
1943
1944B::PMOP
1945HvPMROOT(hv)
1946 B::HV hv
1947
1948#endif
1949
a8a597b2
MB
1950void
1951HvARRAY(hv)
1952 B::HV hv
1953 PPCODE:
1954 if (HvKEYS(hv) > 0) {
1955 SV *sv;
1956 char *key;
1957 I32 len;
1958 (void)hv_iterinit(hv);
1959 EXTEND(sp, HvKEYS(hv) * 2);
8063af02 1960 while ((sv = hv_iternextsv(hv, &key, &len))) {
22f1178f 1961 mPUSHp(key, len);
9496d2e5 1962 PUSHs(make_sv_object(aTHX_ NULL, sv));
a8a597b2
MB
1963 }
1964 }
fd9f6265
JJ
1965
1966MODULE = B PACKAGE = B::HE PREFIX = He
1967
1968B::SV
1969HeVAL(he)
1970 B::HE he
1971
1972U32
1973HeHASH(he)
1974 B::HE he
1975
1976B::SV
1977HeSVKEY_force(he)
1978 B::HE he
1979
1980MODULE = B PACKAGE = B::RHE PREFIX = RHE_
1981
e412117e
NC
1982#if PERL_VERSION >= 9
1983
fd9f6265
JJ
1984SV*
1985RHE_HASH(h)
1986 B::RHE h
1987 CODE:
20439bc7 1988 RETVAL = newRV( (SV*)cophh_2hv(h, 0) );
fd9f6265
JJ
1989 OUTPUT:
1990 RETVAL
e412117e
NC
1991
1992#endif