This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Some simple tests for the POSIX::isXXX() functions.
[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
ece599bd 449#define B_check_av() PL_checkav_save
059a8bb7
JH
450#define B_begin_av() PL_beginav_save
451#define B_end_av() PL_endav
3280af22
NIS
452#define B_main_root() PL_main_root
453#define B_main_start() PL_main_start
56eca212 454#define B_amagic_generation() PL_amagic_generation
3280af22
NIS
455#define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
456#define B_sv_undef() &PL_sv_undef
457#define B_sv_yes() &PL_sv_yes
458#define B_sv_no() &PL_sv_no
9d2bbe64
MB
459#ifdef USE_ITHREADS
460#define B_regex_padav() PL_regex_padav
461#endif
a8a597b2 462
31d7d75a
NIS
463B::AV
464B_init_av()
465
059a8bb7 466B::AV
ece599bd
RGS
467B_check_av()
468
469B::AV
059a8bb7
JH
470B_begin_av()
471
472B::AV
473B_end_av()
474
9d2bbe64
MB
475#ifdef USE_ITHREADS
476
477B::AV
478B_regex_padav()
479
480#endif
481
a8a597b2
MB
482B::CV
483B_main_cv()
484
485B::OP
486B_main_root()
487
488B::OP
489B_main_start()
490
56eca212
GS
491long
492B_amagic_generation()
493
a8a597b2
MB
494B::AV
495B_comppadlist()
496
497B::SV
498B_sv_undef()
499
500B::SV
501B_sv_yes()
502
503B::SV
504B_sv_no()
505
506MODULE = B PACKAGE = B
507
508
509void
510walkoptree(opsv, method)
511 SV * opsv
512 char * method
cea2e8a9
GS
513 CODE:
514 walkoptree(aTHX_ opsv, method);
a8a597b2
MB
515
516int
517walkoptree_debug(...)
518 CODE:
89ca4ac7 519 dMY_CXT;
a8a597b2
MB
520 RETVAL = walkoptree_debug;
521 if (items > 0 && SvTRUE(ST(1)))
522 walkoptree_debug = 1;
523 OUTPUT:
524 RETVAL
525
56431972 526#define address(sv) PTR2IV(sv)
a8a597b2
MB
527
528IV
529address(sv)
530 SV * sv
531
532B::SV
533svref_2object(sv)
534 SV * sv
535 CODE:
536 if (!SvROK(sv))
537 croak("argument is not a reference");
538 RETVAL = (SV*)SvRV(sv);
539 OUTPUT:
0cc1d052
NIS
540 RETVAL
541
542void
543opnumber(name)
544char * name
545CODE:
546{
547 int i;
548 IV result = -1;
549 ST(0) = sv_newmortal();
550 if (strncmp(name,"pp_",3) == 0)
551 name += 3;
552 for (i = 0; i < PL_maxo; i++)
553 {
554 if (strcmp(name, PL_op_name[i]) == 0)
555 {
556 result = i;
557 break;
558 }
559 }
560 sv_setiv(ST(0),result);
561}
a8a597b2
MB
562
563void
564ppname(opnum)
565 int opnum
566 CODE:
567 ST(0) = sv_newmortal();
3280af22 568 if (opnum >= 0 && opnum < PL_maxo) {
a8a597b2 569 sv_setpvn(ST(0), "pp_", 3);
22c35a8c 570 sv_catpv(ST(0), PL_op_name[opnum]);
a8a597b2
MB
571 }
572
573void
574hash(sv)
575 SV * sv
576 CODE:
577 char *s;
578 STRLEN len;
579 U32 hash = 0;
faccc32b 580 char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */
a8a597b2 581 s = SvPV(sv, len);
c32d3395 582 PERL_HASH(hash, s, len);
faccc32b 583 sprintf(hexhash, "0x%"UVxf, (UV)hash);
a8a597b2
MB
584 ST(0) = sv_2mortal(newSVpv(hexhash, 0));
585
586#define cast_I32(foo) (I32)foo
587IV
588cast_I32(i)
589 IV i
590
591void
592minus_c()
593 CODE:
3280af22 594 PL_minus_c = TRUE;
a8a597b2 595
059a8bb7
JH
596void
597save_BEGINs()
598 CODE:
aefff11f 599 PL_savebegin = TRUE;
059a8bb7 600
a8a597b2
MB
601SV *
602cstring(sv)
603 SV * sv
cea2e8a9 604 CODE:
52ad86de
JH
605 RETVAL = cstring(aTHX_ sv, 0);
606 OUTPUT:
607 RETVAL
608
609SV *
610perlstring(sv)
611 SV * sv
612 CODE:
613 RETVAL = cstring(aTHX_ sv, 1);
cea2e8a9
GS
614 OUTPUT:
615 RETVAL
a8a597b2
MB
616
617SV *
618cchar(sv)
619 SV * sv
cea2e8a9
GS
620 CODE:
621 RETVAL = cchar(aTHX_ sv);
622 OUTPUT:
623 RETVAL
a8a597b2
MB
624
625void
626threadsv_names()
627 PPCODE:
4d1ff10f 628#ifdef USE_5005THREADS
a8a597b2 629 int i;
533c011a 630 STRLEN len = strlen(PL_threadsv_names);
a8a597b2
MB
631
632 EXTEND(sp, len);
633 for (i = 0; i < len; i++)
79cb57f6 634 PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
a8a597b2
MB
635#endif
636
637
638#define OP_next(o) o->op_next
639#define OP_sibling(o) o->op_sibling
22c35a8c 640#define OP_desc(o) PL_op_desc[o->op_type]
a8a597b2
MB
641#define OP_targ(o) o->op_targ
642#define OP_type(o) o->op_type
643#define OP_seq(o) o->op_seq
644#define OP_flags(o) o->op_flags
645#define OP_private(o) o->op_private
646
647MODULE = B PACKAGE = B::OP PREFIX = OP_
648
649B::OP
650OP_next(o)
651 B::OP o
652
653B::OP
654OP_sibling(o)
655 B::OP o
656
657char *
3f872cb9
GS
658OP_name(o)
659 B::OP o
660 CODE:
8063af02
DM
661 RETVAL = PL_op_name[o->op_type];
662 OUTPUT:
663 RETVAL
3f872cb9
GS
664
665
8063af02 666void
a8a597b2
MB
667OP_ppaddr(o)
668 B::OP o
dc333d64
GS
669 PREINIT:
670 int i;
671 SV *sv = sv_newmortal();
a8a597b2 672 CODE:
dc333d64
GS
673 sv_setpvn(sv, "PL_ppaddr[OP_", 13);
674 sv_catpv(sv, PL_op_name[o->op_type]);
7c436af3 675 for (i=13; (STRLEN)i < SvCUR(sv); ++i)
dc333d64
GS
676 SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
677 sv_catpv(sv, "]");
678 ST(0) = sv;
a8a597b2
MB
679
680char *
681OP_desc(o)
682 B::OP o
683
7934575e 684PADOFFSET
a8a597b2
MB
685OP_targ(o)
686 B::OP o
687
688U16
689OP_type(o)
690 B::OP o
691
692U16
693OP_seq(o)
694 B::OP o
695
696U8
697OP_flags(o)
698 B::OP o
699
700U8
701OP_private(o)
702 B::OP o
703
704#define UNOP_first(o) o->op_first
705
706MODULE = B PACKAGE = B::UNOP PREFIX = UNOP_
707
708B::OP
709UNOP_first(o)
710 B::UNOP o
711
712#define BINOP_last(o) o->op_last
713
714MODULE = B PACKAGE = B::BINOP PREFIX = BINOP_
715
716B::OP
717BINOP_last(o)
718 B::BINOP o
719
720#define LOGOP_other(o) o->op_other
721
722MODULE = B PACKAGE = B::LOGOP PREFIX = LOGOP_
723
724B::OP
725LOGOP_other(o)
726 B::LOGOP o
727
a8a597b2
MB
728MODULE = B PACKAGE = B::LISTOP PREFIX = LISTOP_
729
c03c2844
SM
730U32
731LISTOP_children(o)
732 B::LISTOP o
733 OP * kid = NO_INIT
734 int i = NO_INIT
735 CODE:
c03c2844
SM
736 i = 0;
737 for (kid = o->op_first; kid; kid = kid->op_sibling)
738 i++;
8063af02
DM
739 RETVAL = i;
740 OUTPUT:
741 RETVAL
c03c2844 742
a8a597b2
MB
743#define PMOP_pmreplroot(o) o->op_pmreplroot
744#define PMOP_pmreplstart(o) o->op_pmreplstart
745#define PMOP_pmnext(o) o->op_pmnext
aaa362c4 746#define PMOP_pmregexp(o) PM_GETRE(o)
9d2bbe64
MB
747#ifdef USE_ITHREADS
748#define PMOP_pmoffset(o) o->op_pmoffset
749#endif
a8a597b2
MB
750#define PMOP_pmflags(o) o->op_pmflags
751#define PMOP_pmpermflags(o) o->op_pmpermflags
9d2bbe64 752#define PMOP_pmdynflags(o) o->op_pmdynflags
a8a597b2
MB
753
754MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
755
756void
757PMOP_pmreplroot(o)
758 B::PMOP o
759 OP * root = NO_INIT
760 CODE:
761 ST(0) = sv_newmortal();
762 root = o->op_pmreplroot;
763 /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
764 if (o->op_type == OP_PUSHRE) {
9d2bbe64
MB
765#ifdef USE_ITHREADS
766 sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
767#else
a8a597b2
MB
768 sv_setiv(newSVrv(ST(0), root ?
769 svclassnames[SvTYPE((SV*)root)] : "B::SV"),
56431972 770 PTR2IV(root));
9d2bbe64 771#endif
a8a597b2
MB
772 }
773 else {
56431972 774 sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
a8a597b2
MB
775 }
776
777B::OP
778PMOP_pmreplstart(o)
779 B::PMOP o
780
781B::PMOP
782PMOP_pmnext(o)
783 B::PMOP o
784
9d2bbe64
MB
785#ifdef USE_ITHREADS
786
787IV
788PMOP_pmoffset(o)
789 B::PMOP o
790
791#endif
792
6e21dc91 793U32
a8a597b2
MB
794PMOP_pmflags(o)
795 B::PMOP o
796
6e21dc91 797U32
a8a597b2
MB
798PMOP_pmpermflags(o)
799 B::PMOP o
800
9d2bbe64
MB
801U8
802PMOP_pmdynflags(o)
803 B::PMOP o
804
a8a597b2
MB
805void
806PMOP_precomp(o)
807 B::PMOP o
808 REGEXP * rx = NO_INIT
809 CODE:
810 ST(0) = sv_newmortal();
aaa362c4 811 rx = PM_GETRE(o);
a8a597b2
MB
812 if (rx)
813 sv_setpvn(ST(0), rx->precomp, rx->prelen);
814
ac33dcd1
JH
815#define SVOP_sv(o) cSVOPo->op_sv
816#define SVOP_gv(o) ((GV*)cSVOPo->op_sv)
a8a597b2
MB
817
818MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_
819
a8a597b2
MB
820B::SV
821SVOP_sv(o)
822 B::SVOP o
823
f22444f5 824B::GV
065a1863
GS
825SVOP_gv(o)
826 B::SVOP o
827
7934575e
GS
828#define PADOP_padix(o) o->op_padix
829#define PADOP_sv(o) (o->op_padix ? PL_curpad[o->op_padix] : Nullsv)
830#define PADOP_gv(o) ((o->op_padix \
831 && SvTYPE(PL_curpad[o->op_padix]) == SVt_PVGV) \
832 ? (GV*)PL_curpad[o->op_padix] : Nullgv)
a8a597b2 833
7934575e
GS
834MODULE = B PACKAGE = B::PADOP PREFIX = PADOP_
835
836PADOFFSET
837PADOP_padix(o)
838 B::PADOP o
839
840B::SV
841PADOP_sv(o)
842 B::PADOP o
a8a597b2
MB
843
844B::GV
7934575e
GS
845PADOP_gv(o)
846 B::PADOP o
a8a597b2
MB
847
848MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_
849
850void
851PVOP_pv(o)
852 B::PVOP o
853 CODE:
854 /*
bec89253 855 * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
a8a597b2
MB
856 * whereas other PVOPs point to a null terminated string.
857 */
bec89253
RH
858 if (o->op_type == OP_TRANS &&
859 (o->op_private & OPpTRANS_COMPLEMENT) &&
860 !(o->op_private & OPpTRANS_DELETE))
861 {
862 short* tbl = (short*)o->op_pv;
863 short entries = 257 + tbl[256];
864 ST(0) = sv_2mortal(newSVpv(o->op_pv, entries * sizeof(short)));
865 }
866 else if (o->op_type == OP_TRANS) {
867 ST(0) = sv_2mortal(newSVpv(o->op_pv, 256 * sizeof(short)));
868 }
869 else
870 ST(0) = sv_2mortal(newSVpv(o->op_pv, 0));
a8a597b2
MB
871
872#define LOOP_redoop(o) o->op_redoop
873#define LOOP_nextop(o) o->op_nextop
874#define LOOP_lastop(o) o->op_lastop
875
876MODULE = B PACKAGE = B::LOOP PREFIX = LOOP_
877
878
879B::OP
880LOOP_redoop(o)
881 B::LOOP o
882
883B::OP
884LOOP_nextop(o)
885 B::LOOP o
886
887B::OP
888LOOP_lastop(o)
889 B::LOOP o
890
891#define COP_label(o) o->cop_label
11faa288
GS
892#define COP_stashpv(o) CopSTASHPV(o)
893#define COP_stash(o) CopSTASH(o)
57843af0 894#define COP_file(o) CopFILE(o)
a8a597b2
MB
895#define COP_cop_seq(o) o->cop_seq
896#define COP_arybase(o) o->cop_arybase
57843af0 897#define COP_line(o) CopLINE(o)
b295d113 898#define COP_warnings(o) o->cop_warnings
a8a597b2
MB
899
900MODULE = B PACKAGE = B::COP PREFIX = COP_
901
902char *
903COP_label(o)
904 B::COP o
905
11faa288
GS
906char *
907COP_stashpv(o)
908 B::COP o
909
a8a597b2
MB
910B::HV
911COP_stash(o)
912 B::COP o
913
57843af0
GS
914char *
915COP_file(o)
a8a597b2
MB
916 B::COP o
917
918U32
919COP_cop_seq(o)
920 B::COP o
921
922I32
923COP_arybase(o)
924 B::COP o
925
926U16
927COP_line(o)
928 B::COP o
929
b295d113
TH
930B::SV
931COP_warnings(o)
932 B::COP o
933
a8a597b2
MB
934MODULE = B PACKAGE = B::SV PREFIX = Sv
935
936U32
937SvREFCNT(sv)
938 B::SV sv
939
940U32
941SvFLAGS(sv)
942 B::SV sv
943
944MODULE = B PACKAGE = B::IV PREFIX = Sv
945
946IV
947SvIV(sv)
948 B::IV sv
949
950IV
951SvIVX(sv)
952 B::IV sv
953
0ca04487
VB
954UV
955SvUVX(sv)
956 B::IV sv
957
958
a8a597b2
MB
959MODULE = B PACKAGE = B::IV
960
961#define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
962
963int
964needs64bits(sv)
965 B::IV sv
966
967void
968packiv(sv)
969 B::IV sv
970 CODE:
971 if (sizeof(IV) == 8) {
972 U32 wp[2];
973 IV iv = SvIVX(sv);
974 /*
975 * The following way of spelling 32 is to stop compilers on
976 * 32-bit architectures from moaning about the shift count
977 * being >= the width of the type. Such architectures don't
978 * reach this code anyway (unless sizeof(IV) > 8 but then
979 * everything else breaks too so I'm not fussed at the moment).
980 */
42718184
RB
981#ifdef UV_IS_QUAD
982 wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
983#else
984 wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
985#endif
a8a597b2 986 wp[1] = htonl(iv & 0xffffffff);
79cb57f6 987 ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
a8a597b2
MB
988 } else {
989 U32 w = htonl((U32)SvIVX(sv));
79cb57f6 990 ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
a8a597b2
MB
991 }
992
993MODULE = B PACKAGE = B::NV PREFIX = Sv
994
76ef7183 995NV
a8a597b2
MB
996SvNV(sv)
997 B::NV sv
998
76ef7183 999NV
a8a597b2
MB
1000SvNVX(sv)
1001 B::NV sv
1002
1003MODULE = B PACKAGE = B::RV PREFIX = Sv
1004
1005B::SV
1006SvRV(sv)
1007 B::RV sv
1008
1009MODULE = B PACKAGE = B::PV PREFIX = Sv
1010
0b40bd6d
RH
1011char*
1012SvPVX(sv)
1013 B::PV sv
1014
b326da91
MB
1015B::SV
1016SvRV(sv)
1017 B::PV sv
1018 CODE:
1019 if( SvROK(sv) ) {
1020 RETVAL = SvRV(sv);
1021 }
1022 else {
1023 croak( "argument is not SvROK" );
1024 }
1025 OUTPUT:
1026 RETVAL
1027
a8a597b2
MB
1028void
1029SvPV(sv)
1030 B::PV sv
1031 CODE:
b326da91 1032 ST(0) = sv_newmortal();
9d2bbe64 1033 if( SvPOK(sv) ) {
b326da91
MB
1034 sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
1035 SvFLAGS(ST(0)) |= SvUTF8(sv);
1036 }
1037 else {
1038 /* XXX for backward compatibility, but should fail */
1039 /* croak( "argument is not SvPOK" ); */
1040 sv_setpvn(ST(0), NULL, 0);
1041 }
a8a597b2 1042
445a12f6
DM
1043STRLEN
1044SvLEN(sv)
1045 B::PV sv
1046
1047STRLEN
1048SvCUR(sv)
1049 B::PV sv
1050
a8a597b2
MB
1051MODULE = B PACKAGE = B::PVMG PREFIX = Sv
1052
1053void
1054SvMAGIC(sv)
1055 B::PVMG sv
1056 MAGIC * mg = NO_INIT
1057 PPCODE:
1058 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
cea2e8a9 1059 XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
a8a597b2
MB
1060
1061MODULE = B PACKAGE = B::PVMG
1062
1063B::HV
1064SvSTASH(sv)
1065 B::PVMG sv
1066
1067#define MgMOREMAGIC(mg) mg->mg_moremagic
1068#define MgPRIVATE(mg) mg->mg_private
1069#define MgTYPE(mg) mg->mg_type
1070#define MgFLAGS(mg) mg->mg_flags
1071#define MgOBJ(mg) mg->mg_obj
88b39979 1072#define MgLENGTH(mg) mg->mg_len
bde7177d 1073#define MgREGEX(mg) PTR2IV(mg->mg_obj)
a8a597b2
MB
1074
1075MODULE = B PACKAGE = B::MAGIC PREFIX = Mg
1076
1077B::MAGIC
1078MgMOREMAGIC(mg)
1079 B::MAGIC mg
1080
1081U16
1082MgPRIVATE(mg)
1083 B::MAGIC mg
1084
1085char
1086MgTYPE(mg)
1087 B::MAGIC mg
1088
1089U8
1090MgFLAGS(mg)
1091 B::MAGIC mg
1092
1093B::SV
1094MgOBJ(mg)
1095 B::MAGIC mg
b326da91
MB
1096 CODE:
1097 if( mg->mg_type != 'r' ) {
1098 RETVAL = MgOBJ(mg);
1099 }
1100 else {
1101 croak( "OBJ is not meaningful on r-magic" );
1102 }
1103 OUTPUT:
1104 RETVAL
1105
9d2bbe64
MB
1106IV
1107MgREGEX(mg)
1108 B::MAGIC mg
1109 CODE:
1110 if( mg->mg_type == 'r' ) {
1111 RETVAL = MgREGEX(mg);
1112 }
1113 else {
1114 croak( "REGEX is only meaningful on r-magic" );
1115 }
1116 OUTPUT:
1117 RETVAL
1118
b326da91
MB
1119SV*
1120precomp(mg)
1121 B::MAGIC mg
1122 CODE:
1123 if (mg->mg_type == 'r') {
1124 REGEXP* rx = (REGEXP*)mg->mg_obj;
1125 if( rx )
1126 RETVAL = newSVpvn( rx->precomp, rx->prelen );
1127 }
1128 else {
1129 croak( "precomp is only meaningful on r-magic" );
1130 }
1131 OUTPUT:
1132 RETVAL
a8a597b2 1133
88b39979
VB
1134I32
1135MgLENGTH(mg)
1136 B::MAGIC mg
1137
a8a597b2
MB
1138void
1139MgPTR(mg)
1140 B::MAGIC mg
1141 CODE:
1142 ST(0) = sv_newmortal();
88b39979
VB
1143 if (mg->mg_ptr){
1144 if (mg->mg_len >= 0){
1145 sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
1146 } else {
1147 if (mg->mg_len == HEf_SVKEY)
1148 sv_setsv(ST(0),newRV((SV*)mg->mg_ptr));
1149 }
1150 }
a8a597b2
MB
1151
1152MODULE = B PACKAGE = B::PVLV PREFIX = Lv
1153
1154U32
1155LvTARGOFF(sv)
1156 B::PVLV sv
1157
1158U32
1159LvTARGLEN(sv)
1160 B::PVLV sv
1161
1162char
1163LvTYPE(sv)
1164 B::PVLV sv
1165
1166B::SV
1167LvTARG(sv)
1168 B::PVLV sv
1169
1170MODULE = B PACKAGE = B::BM PREFIX = Bm
1171
1172I32
1173BmUSEFUL(sv)
1174 B::BM sv
1175
1176U16
1177BmPREVIOUS(sv)
1178 B::BM sv
1179
1180U8
1181BmRARE(sv)
1182 B::BM sv
1183
1184void
1185BmTABLE(sv)
1186 B::BM sv
1187 STRLEN len = NO_INIT
1188 char * str = NO_INIT
1189 CODE:
1190 str = SvPV(sv, len);
1191 /* Boyer-Moore table is just after string and its safety-margin \0 */
79cb57f6 1192 ST(0) = sv_2mortal(newSVpvn(str + len + 1, 256));
a8a597b2
MB
1193
1194MODULE = B PACKAGE = B::GV PREFIX = Gv
1195
1196void
1197GvNAME(gv)
1198 B::GV gv
1199 CODE:
79cb57f6 1200 ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
a8a597b2 1201
87d7fd28
GS
1202bool
1203is_empty(gv)
1204 B::GV gv
1205 CODE:
1206 RETVAL = GvGP(gv) == Null(GP*);
1207 OUTPUT:
1208 RETVAL
1209
a8a597b2
MB
1210B::HV
1211GvSTASH(gv)
1212 B::GV gv
1213
1214B::SV
1215GvSV(gv)
1216 B::GV gv
1217
1218B::IO
1219GvIO(gv)
1220 B::GV gv
1221
1222B::CV
1223GvFORM(gv)
1224 B::GV gv
1225
1226B::AV
1227GvAV(gv)
1228 B::GV gv
1229
1230B::HV
1231GvHV(gv)
1232 B::GV gv
1233
1234B::GV
1235GvEGV(gv)
1236 B::GV gv
1237
1238B::CV
1239GvCV(gv)
1240 B::GV gv
1241
1242U32
1243GvCVGEN(gv)
1244 B::GV gv
1245
1246U16
1247GvLINE(gv)
1248 B::GV gv
1249
b195d487
GS
1250char *
1251GvFILE(gv)
1252 B::GV gv
1253
a8a597b2
MB
1254B::GV
1255GvFILEGV(gv)
1256 B::GV gv
1257
1258MODULE = B PACKAGE = B::GV
1259
1260U32
1261GvREFCNT(gv)
1262 B::GV gv
1263
1264U8
1265GvFLAGS(gv)
1266 B::GV gv
1267
1268MODULE = B PACKAGE = B::IO PREFIX = Io
1269
1270long
1271IoLINES(io)
1272 B::IO io
1273
1274long
1275IoPAGE(io)
1276 B::IO io
1277
1278long
1279IoPAGE_LEN(io)
1280 B::IO io
1281
1282long
1283IoLINES_LEFT(io)
1284 B::IO io
1285
1286char *
1287IoTOP_NAME(io)
1288 B::IO io
1289
1290B::GV
1291IoTOP_GV(io)
1292 B::IO io
1293
1294char *
1295IoFMT_NAME(io)
1296 B::IO io
1297
1298B::GV
1299IoFMT_GV(io)
1300 B::IO io
1301
1302char *
1303IoBOTTOM_NAME(io)
1304 B::IO io
1305
1306B::GV
1307IoBOTTOM_GV(io)
1308 B::IO io
1309
1310short
1311IoSUBPROCESS(io)
1312 B::IO io
1313
b326da91
MB
1314bool
1315IsSTD(io,name)
1316 B::IO io
1317 char* name
1318 PREINIT:
1319 PerlIO* handle = 0;
1320 CODE:
1321 if( strEQ( name, "stdin" ) ) {
1322 handle = PerlIO_stdin();
1323 }
1324 else if( strEQ( name, "stdout" ) ) {
1325 handle = PerlIO_stdout();
1326 }
1327 else if( strEQ( name, "stderr" ) ) {
1328 handle = PerlIO_stderr();
1329 }
1330 else {
1331 croak( "Invalid value '%s'", name );
1332 }
1333 RETVAL = handle == IoIFP(io);
1334 OUTPUT:
1335 RETVAL
1336
a8a597b2
MB
1337MODULE = B PACKAGE = B::IO
1338
1339char
1340IoTYPE(io)
1341 B::IO io
1342
1343U8
1344IoFLAGS(io)
1345 B::IO io
1346
1347MODULE = B PACKAGE = B::AV PREFIX = Av
1348
1349SSize_t
1350AvFILL(av)
1351 B::AV av
1352
1353SSize_t
1354AvMAX(av)
1355 B::AV av
1356
1357#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1358
1359IV
1360AvOFF(av)
1361 B::AV av
1362
1363void
1364AvARRAY(av)
1365 B::AV av
1366 PPCODE:
1367 if (AvFILL(av) >= 0) {
1368 SV **svp = AvARRAY(av);
1369 I32 i;
1370 for (i = 0; i <= AvFILL(av); i++)
cea2e8a9 1371 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
a8a597b2
MB
1372 }
1373
1374MODULE = B PACKAGE = B::AV
1375
1376U8
1377AvFLAGS(av)
1378 B::AV av
1379
1380MODULE = B PACKAGE = B::CV PREFIX = Cv
1381
1382B::HV
1383CvSTASH(cv)
1384 B::CV cv
1385
1386B::OP
1387CvSTART(cv)
1388 B::CV cv
1389
1390B::OP
1391CvROOT(cv)
1392 B::CV cv
1393
1394B::GV
1395CvGV(cv)
1396 B::CV cv
1397
57843af0
GS
1398char *
1399CvFILE(cv)
1400 B::CV cv
1401
a8a597b2
MB
1402long
1403CvDEPTH(cv)
1404 B::CV cv
1405
1406B::AV
1407CvPADLIST(cv)
1408 B::CV cv
1409
1410B::CV
1411CvOUTSIDE(cv)
1412 B::CV cv
1413
1414void
1415CvXSUB(cv)
1416 B::CV cv
1417 CODE:
56431972 1418 ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv))));
a8a597b2
MB
1419
1420
1421void
1422CvXSUBANY(cv)
1423 B::CV cv
1424 CODE:
b326da91
MB
1425 ST(0) = CvCONST(cv) ?
1426 make_sv_object(aTHX_ sv_newmortal(),CvXSUBANY(cv).any_ptr) :
1427 sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
a8a597b2 1428
5cfd8ad4
VB
1429MODULE = B PACKAGE = B::CV
1430
6aaf4108 1431U16
5cfd8ad4
VB
1432CvFLAGS(cv)
1433 B::CV cv
1434
de3f1649
JT
1435MODULE = B PACKAGE = B::CV PREFIX = cv_
1436
1437B::SV
1438cv_const_sv(cv)
1439 B::CV cv
1440
5cfd8ad4 1441
a8a597b2
MB
1442MODULE = B PACKAGE = B::HV PREFIX = Hv
1443
1444STRLEN
1445HvFILL(hv)
1446 B::HV hv
1447
1448STRLEN
1449HvMAX(hv)
1450 B::HV hv
1451
1452I32
1453HvKEYS(hv)
1454 B::HV hv
1455
1456I32
1457HvRITER(hv)
1458 B::HV hv
1459
1460char *
1461HvNAME(hv)
1462 B::HV hv
1463
1464B::PMOP
1465HvPMROOT(hv)
1466 B::HV hv
1467
1468void
1469HvARRAY(hv)
1470 B::HV hv
1471 PPCODE:
1472 if (HvKEYS(hv) > 0) {
1473 SV *sv;
1474 char *key;
1475 I32 len;
1476 (void)hv_iterinit(hv);
1477 EXTEND(sp, HvKEYS(hv) * 2);
8063af02 1478 while ((sv = hv_iternextsv(hv, &key, &len))) {
79cb57f6 1479 PUSHs(newSVpvn(key, len));
cea2e8a9 1480 PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
a8a597b2
MB
1481 }
1482 }