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