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