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