This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Unicode::Normalize 0.23.
[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
6e6a1aef 892#define COP_io(o) o->cop_io
a8a597b2
MB
893
894MODULE = B PACKAGE = B::COP PREFIX = COP_
895
896char *
897COP_label(o)
898 B::COP o
899
11faa288
GS
900char *
901COP_stashpv(o)
902 B::COP o
903
a8a597b2
MB
904B::HV
905COP_stash(o)
906 B::COP o
907
57843af0
GS
908char *
909COP_file(o)
a8a597b2
MB
910 B::COP o
911
912U32
913COP_cop_seq(o)
914 B::COP o
915
916I32
917COP_arybase(o)
918 B::COP o
919
920U16
921COP_line(o)
922 B::COP o
923
b295d113
TH
924B::SV
925COP_warnings(o)
926 B::COP o
927
6e6a1aef
RGS
928B::SV
929COP_io(o)
930 B::COP o
931
a8a597b2
MB
932MODULE = B PACKAGE = B::SV PREFIX = Sv
933
934U32
935SvREFCNT(sv)
936 B::SV sv
937
938U32
939SvFLAGS(sv)
940 B::SV sv
941
942MODULE = B PACKAGE = B::IV PREFIX = Sv
943
944IV
945SvIV(sv)
946 B::IV sv
947
948IV
949SvIVX(sv)
950 B::IV sv
951
0ca04487
VB
952UV
953SvUVX(sv)
954 B::IV sv
955
956
a8a597b2
MB
957MODULE = B PACKAGE = B::IV
958
959#define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
960
961int
962needs64bits(sv)
963 B::IV sv
964
965void
966packiv(sv)
967 B::IV sv
968 CODE:
969 if (sizeof(IV) == 8) {
970 U32 wp[2];
971 IV iv = SvIVX(sv);
972 /*
973 * The following way of spelling 32 is to stop compilers on
974 * 32-bit architectures from moaning about the shift count
975 * being >= the width of the type. Such architectures don't
976 * reach this code anyway (unless sizeof(IV) > 8 but then
977 * everything else breaks too so I'm not fussed at the moment).
978 */
42718184
RB
979#ifdef UV_IS_QUAD
980 wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
981#else
982 wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
983#endif
a8a597b2 984 wp[1] = htonl(iv & 0xffffffff);
79cb57f6 985 ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
a8a597b2
MB
986 } else {
987 U32 w = htonl((U32)SvIVX(sv));
79cb57f6 988 ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
a8a597b2
MB
989 }
990
991MODULE = B PACKAGE = B::NV PREFIX = Sv
992
76ef7183 993NV
a8a597b2
MB
994SvNV(sv)
995 B::NV sv
996
76ef7183 997NV
a8a597b2
MB
998SvNVX(sv)
999 B::NV sv
1000
1001MODULE = B PACKAGE = B::RV PREFIX = Sv
1002
1003B::SV
1004SvRV(sv)
1005 B::RV sv
1006
1007MODULE = B PACKAGE = B::PV PREFIX = Sv
1008
0b40bd6d
RH
1009char*
1010SvPVX(sv)
1011 B::PV sv
1012
b326da91
MB
1013B::SV
1014SvRV(sv)
1015 B::PV sv
1016 CODE:
1017 if( SvROK(sv) ) {
1018 RETVAL = SvRV(sv);
1019 }
1020 else {
1021 croak( "argument is not SvROK" );
1022 }
1023 OUTPUT:
1024 RETVAL
1025
a8a597b2
MB
1026void
1027SvPV(sv)
1028 B::PV sv
1029 CODE:
b326da91 1030 ST(0) = sv_newmortal();
9d2bbe64 1031 if( SvPOK(sv) ) {
b326da91
MB
1032 sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
1033 SvFLAGS(ST(0)) |= SvUTF8(sv);
1034 }
1035 else {
1036 /* XXX for backward compatibility, but should fail */
1037 /* croak( "argument is not SvPOK" ); */
1038 sv_setpvn(ST(0), NULL, 0);
1039 }
a8a597b2 1040
445a12f6
DM
1041STRLEN
1042SvLEN(sv)
1043 B::PV sv
1044
1045STRLEN
1046SvCUR(sv)
1047 B::PV sv
1048
a8a597b2
MB
1049MODULE = B PACKAGE = B::PVMG PREFIX = Sv
1050
1051void
1052SvMAGIC(sv)
1053 B::PVMG sv
1054 MAGIC * mg = NO_INIT
1055 PPCODE:
1056 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
cea2e8a9 1057 XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
a8a597b2
MB
1058
1059MODULE = B PACKAGE = B::PVMG
1060
1061B::HV
1062SvSTASH(sv)
1063 B::PVMG sv
1064
1065#define MgMOREMAGIC(mg) mg->mg_moremagic
1066#define MgPRIVATE(mg) mg->mg_private
1067#define MgTYPE(mg) mg->mg_type
1068#define MgFLAGS(mg) mg->mg_flags
1069#define MgOBJ(mg) mg->mg_obj
88b39979 1070#define MgLENGTH(mg) mg->mg_len
bde7177d 1071#define MgREGEX(mg) PTR2IV(mg->mg_obj)
a8a597b2
MB
1072
1073MODULE = B PACKAGE = B::MAGIC PREFIX = Mg
1074
1075B::MAGIC
1076MgMOREMAGIC(mg)
1077 B::MAGIC mg
c5f0f3aa
RGS
1078 CODE:
1079 if( MgMOREMAGIC(mg) ) {
1080 RETVAL = MgMOREMAGIC(mg);
1081 }
1082 else {
1083 XSRETURN_UNDEF;
1084 }
1085 OUTPUT:
1086 RETVAL
a8a597b2
MB
1087
1088U16
1089MgPRIVATE(mg)
1090 B::MAGIC mg
1091
1092char
1093MgTYPE(mg)
1094 B::MAGIC mg
1095
1096U8
1097MgFLAGS(mg)
1098 B::MAGIC mg
1099
1100B::SV
1101MgOBJ(mg)
1102 B::MAGIC mg
b326da91
MB
1103 CODE:
1104 if( mg->mg_type != 'r' ) {
1105 RETVAL = MgOBJ(mg);
1106 }
1107 else {
1108 croak( "OBJ is not meaningful on r-magic" );
1109 }
1110 OUTPUT:
1111 RETVAL
1112
9d2bbe64
MB
1113IV
1114MgREGEX(mg)
1115 B::MAGIC mg
1116 CODE:
1117 if( mg->mg_type == 'r' ) {
1118 RETVAL = MgREGEX(mg);
1119 }
1120 else {
1121 croak( "REGEX is only meaningful on r-magic" );
1122 }
1123 OUTPUT:
1124 RETVAL
1125
b326da91
MB
1126SV*
1127precomp(mg)
1128 B::MAGIC mg
1129 CODE:
1130 if (mg->mg_type == 'r') {
1131 REGEXP* rx = (REGEXP*)mg->mg_obj;
1132 if( rx )
1133 RETVAL = newSVpvn( rx->precomp, rx->prelen );
1134 }
1135 else {
1136 croak( "precomp is only meaningful on r-magic" );
1137 }
1138 OUTPUT:
1139 RETVAL
a8a597b2 1140
88b39979
VB
1141I32
1142MgLENGTH(mg)
1143 B::MAGIC mg
1144
a8a597b2
MB
1145void
1146MgPTR(mg)
1147 B::MAGIC mg
1148 CODE:
1149 ST(0) = sv_newmortal();
88b39979
VB
1150 if (mg->mg_ptr){
1151 if (mg->mg_len >= 0){
1152 sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
1153 } else {
1154 if (mg->mg_len == HEf_SVKEY)
1155 sv_setsv(ST(0),newRV((SV*)mg->mg_ptr));
1156 }
1157 }
a8a597b2
MB
1158
1159MODULE = B PACKAGE = B::PVLV PREFIX = Lv
1160
1161U32
1162LvTARGOFF(sv)
1163 B::PVLV sv
1164
1165U32
1166LvTARGLEN(sv)
1167 B::PVLV sv
1168
1169char
1170LvTYPE(sv)
1171 B::PVLV sv
1172
1173B::SV
1174LvTARG(sv)
1175 B::PVLV sv
1176
1177MODULE = B PACKAGE = B::BM PREFIX = Bm
1178
1179I32
1180BmUSEFUL(sv)
1181 B::BM sv
1182
1183U16
1184BmPREVIOUS(sv)
1185 B::BM sv
1186
1187U8
1188BmRARE(sv)
1189 B::BM sv
1190
1191void
1192BmTABLE(sv)
1193 B::BM sv
1194 STRLEN len = NO_INIT
1195 char * str = NO_INIT
1196 CODE:
1197 str = SvPV(sv, len);
1198 /* Boyer-Moore table is just after string and its safety-margin \0 */
79cb57f6 1199 ST(0) = sv_2mortal(newSVpvn(str + len + 1, 256));
a8a597b2
MB
1200
1201MODULE = B PACKAGE = B::GV PREFIX = Gv
1202
1203void
1204GvNAME(gv)
1205 B::GV gv
1206 CODE:
79cb57f6 1207 ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
a8a597b2 1208
87d7fd28
GS
1209bool
1210is_empty(gv)
1211 B::GV gv
1212 CODE:
1213 RETVAL = GvGP(gv) == Null(GP*);
1214 OUTPUT:
1215 RETVAL
1216
a8a597b2
MB
1217B::HV
1218GvSTASH(gv)
1219 B::GV gv
1220
1221B::SV
1222GvSV(gv)
1223 B::GV gv
1224
1225B::IO
1226GvIO(gv)
1227 B::GV gv
1228
1229B::CV
1230GvFORM(gv)
1231 B::GV gv
1232
1233B::AV
1234GvAV(gv)
1235 B::GV gv
1236
1237B::HV
1238GvHV(gv)
1239 B::GV gv
1240
1241B::GV
1242GvEGV(gv)
1243 B::GV gv
1244
1245B::CV
1246GvCV(gv)
1247 B::GV gv
1248
1249U32
1250GvCVGEN(gv)
1251 B::GV gv
1252
1253U16
1254GvLINE(gv)
1255 B::GV gv
1256
b195d487
GS
1257char *
1258GvFILE(gv)
1259 B::GV gv
1260
a8a597b2
MB
1261B::GV
1262GvFILEGV(gv)
1263 B::GV gv
1264
1265MODULE = B PACKAGE = B::GV
1266
1267U32
1268GvREFCNT(gv)
1269 B::GV gv
1270
1271U8
1272GvFLAGS(gv)
1273 B::GV gv
1274
1275MODULE = B PACKAGE = B::IO PREFIX = Io
1276
1277long
1278IoLINES(io)
1279 B::IO io
1280
1281long
1282IoPAGE(io)
1283 B::IO io
1284
1285long
1286IoPAGE_LEN(io)
1287 B::IO io
1288
1289long
1290IoLINES_LEFT(io)
1291 B::IO io
1292
1293char *
1294IoTOP_NAME(io)
1295 B::IO io
1296
1297B::GV
1298IoTOP_GV(io)
1299 B::IO io
1300
1301char *
1302IoFMT_NAME(io)
1303 B::IO io
1304
1305B::GV
1306IoFMT_GV(io)
1307 B::IO io
1308
1309char *
1310IoBOTTOM_NAME(io)
1311 B::IO io
1312
1313B::GV
1314IoBOTTOM_GV(io)
1315 B::IO io
1316
1317short
1318IoSUBPROCESS(io)
1319 B::IO io
1320
b326da91
MB
1321bool
1322IsSTD(io,name)
1323 B::IO io
1324 char* name
1325 PREINIT:
1326 PerlIO* handle = 0;
1327 CODE:
1328 if( strEQ( name, "stdin" ) ) {
1329 handle = PerlIO_stdin();
1330 }
1331 else if( strEQ( name, "stdout" ) ) {
1332 handle = PerlIO_stdout();
1333 }
1334 else if( strEQ( name, "stderr" ) ) {
1335 handle = PerlIO_stderr();
1336 }
1337 else {
1338 croak( "Invalid value '%s'", name );
1339 }
1340 RETVAL = handle == IoIFP(io);
1341 OUTPUT:
1342 RETVAL
1343
a8a597b2
MB
1344MODULE = B PACKAGE = B::IO
1345
1346char
1347IoTYPE(io)
1348 B::IO io
1349
1350U8
1351IoFLAGS(io)
1352 B::IO io
1353
1354MODULE = B PACKAGE = B::AV PREFIX = Av
1355
1356SSize_t
1357AvFILL(av)
1358 B::AV av
1359
1360SSize_t
1361AvMAX(av)
1362 B::AV av
1363
1364#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1365
1366IV
1367AvOFF(av)
1368 B::AV av
1369
1370void
1371AvARRAY(av)
1372 B::AV av
1373 PPCODE:
1374 if (AvFILL(av) >= 0) {
1375 SV **svp = AvARRAY(av);
1376 I32 i;
1377 for (i = 0; i <= AvFILL(av); i++)
cea2e8a9 1378 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
a8a597b2
MB
1379 }
1380
1381MODULE = B PACKAGE = B::AV
1382
1383U8
1384AvFLAGS(av)
1385 B::AV av
1386
1387MODULE = B PACKAGE = B::CV PREFIX = Cv
1388
1389B::HV
1390CvSTASH(cv)
1391 B::CV cv
1392
1393B::OP
1394CvSTART(cv)
1395 B::CV cv
1396
1397B::OP
1398CvROOT(cv)
1399 B::CV cv
1400
1401B::GV
1402CvGV(cv)
1403 B::CV cv
1404
57843af0
GS
1405char *
1406CvFILE(cv)
1407 B::CV cv
1408
a8a597b2
MB
1409long
1410CvDEPTH(cv)
1411 B::CV cv
1412
1413B::AV
1414CvPADLIST(cv)
1415 B::CV cv
1416
1417B::CV
1418CvOUTSIDE(cv)
1419 B::CV cv
1420
a3985cdc
DM
1421U32
1422CvOUTSIDE_SEQ(cv)
1423 B::CV cv
1424
a8a597b2
MB
1425void
1426CvXSUB(cv)
1427 B::CV cv
1428 CODE:
56431972 1429 ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv))));
a8a597b2
MB
1430
1431
1432void
1433CvXSUBANY(cv)
1434 B::CV cv
1435 CODE:
b326da91
MB
1436 ST(0) = CvCONST(cv) ?
1437 make_sv_object(aTHX_ sv_newmortal(),CvXSUBANY(cv).any_ptr) :
1438 sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
a8a597b2 1439
5cfd8ad4
VB
1440MODULE = B PACKAGE = B::CV
1441
6aaf4108 1442U16
5cfd8ad4
VB
1443CvFLAGS(cv)
1444 B::CV cv
1445
de3f1649
JT
1446MODULE = B PACKAGE = B::CV PREFIX = cv_
1447
1448B::SV
1449cv_const_sv(cv)
1450 B::CV cv
1451
5cfd8ad4 1452
a8a597b2
MB
1453MODULE = B PACKAGE = B::HV PREFIX = Hv
1454
1455STRLEN
1456HvFILL(hv)
1457 B::HV hv
1458
1459STRLEN
1460HvMAX(hv)
1461 B::HV hv
1462
1463I32
1464HvKEYS(hv)
1465 B::HV hv
1466
1467I32
1468HvRITER(hv)
1469 B::HV hv
1470
1471char *
1472HvNAME(hv)
1473 B::HV hv
1474
1475B::PMOP
1476HvPMROOT(hv)
1477 B::HV hv
1478
1479void
1480HvARRAY(hv)
1481 B::HV hv
1482 PPCODE:
1483 if (HvKEYS(hv) > 0) {
1484 SV *sv;
1485 char *key;
1486 I32 len;
1487 (void)hv_iterinit(hv);
1488 EXTEND(sp, HvKEYS(hv) * 2);
8063af02 1489 while ((sv = hv_iternextsv(hv, &key, &len))) {
79cb57f6 1490 PUSHs(newSVpvn(key, len));
cea2e8a9 1491 PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
a8a597b2
MB
1492 }
1493 }