This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[win32] various cleanups so that B can be built as "just another extension"
[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
10#include "EXTERN.h"
11#include "perl.h"
12#include "XSUB.h"
13#include "INTERN.h"
a8a597b2
MB
14
15static char *svclassnames[] = {
16 "B::NULL",
17 "B::IV",
18 "B::NV",
19 "B::RV",
20 "B::PV",
21 "B::PVIV",
22 "B::PVNV",
23 "B::PVMG",
24 "B::BM",
25 "B::PVLV",
26 "B::AV",
27 "B::HV",
28 "B::CV",
29 "B::GV",
30 "B::FM",
31 "B::IO",
32};
33
34typedef enum {
35 OPc_NULL, /* 0 */
36 OPc_BASEOP, /* 1 */
37 OPc_UNOP, /* 2 */
38 OPc_BINOP, /* 3 */
39 OPc_LOGOP, /* 4 */
40 OPc_CONDOP, /* 5 */
41 OPc_LISTOP, /* 6 */
42 OPc_PMOP, /* 7 */
43 OPc_SVOP, /* 8 */
44 OPc_GVOP, /* 9 */
45 OPc_PVOP, /* 10 */
46 OPc_CVOP, /* 11 */
47 OPc_LOOP, /* 12 */
48 OPc_COP /* 13 */
49} opclass;
50
51static char *opclassnames[] = {
52 "B::NULL",
53 "B::OP",
54 "B::UNOP",
55 "B::BINOP",
56 "B::LOGOP",
57 "B::CONDOP",
58 "B::LISTOP",
59 "B::PMOP",
60 "B::SVOP",
61 "B::GVOP",
62 "B::PVOP",
63 "B::CVOP",
64 "B::LOOP",
65 "B::COP"
66};
67
68static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */
69
70static opclass
71cc_opclass(OP *o)
72{
73 if (!o)
74 return OPc_NULL;
75
76 if (o->op_type == 0)
77 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
78
79 if (o->op_type == OP_SASSIGN)
80 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
81
82 switch (opargs[o->op_type] & OA_CLASS_MASK) {
83 case OA_BASEOP:
84 return OPc_BASEOP;
85
86 case OA_UNOP:
87 return OPc_UNOP;
88
89 case OA_BINOP:
90 return OPc_BINOP;
91
92 case OA_LOGOP:
93 return OPc_LOGOP;
94
95 case OA_CONDOP:
96 return OPc_CONDOP;
97
98 case OA_LISTOP:
99 return OPc_LISTOP;
100
101 case OA_PMOP:
102 return OPc_PMOP;
103
104 case OA_SVOP:
105 return OPc_SVOP;
106
107 case OA_GVOP:
108 return OPc_GVOP;
109
110 case OA_PVOP:
111 return OPc_PVOP;
112
113 case OA_LOOP:
114 return OPc_LOOP;
115
116 case OA_COP:
117 return OPc_COP;
118
119 case OA_BASEOP_OR_UNOP:
120 /*
121 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
122 * whether bare parens were seen. perly.y uses OPf_SPECIAL to
123 * signal whether an OP or an UNOP was chosen.
124 * Frederic.Chauveau@pasteur.fr says we need to check for OPf_KIDS too.
125 */
126 return ((o->op_flags & OPf_SPECIAL) ? OPc_BASEOP :
127 (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP);
128
129 case OA_FILESTATOP:
130 /*
131 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
132 * the OPf_REF flag to distinguish between OP types instead of the
133 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
134 * return OPc_UNOP so that walkoptree can find our children. If
135 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
136 * (no argument to the operator) it's an OP; with OPf_REF set it's
137 * a GVOP (and op_gv is the GV for the filehandle argument).
138 */
139 return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
140 (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP);
141
142 case OA_LOOPEXOP:
143 /*
144 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
145 * label was omitted (in which case it's a BASEOP) or else a term was
146 * seen. In this last case, all except goto are definitely PVOP but
147 * goto is either a PVOP (with an ordinary constant label), an UNOP
148 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
149 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
150 * get set.
151 */
152 if (o->op_flags & OPf_STACKED)
153 return OPc_UNOP;
154 else if (o->op_flags & OPf_SPECIAL)
155 return OPc_BASEOP;
156 else
157 return OPc_PVOP;
158 }
159 warn("can't determine class of operator %s, assuming BASEOP\n",
160 op_name[o->op_type]);
161 return OPc_BASEOP;
162}
163
164static char *
165cc_opclassname(OP *o)
166{
167 return opclassnames[cc_opclass(o)];
168}
169
170static SV *
171make_sv_object(SV *arg, SV *sv)
172{
173 char *type = 0;
174 IV iv;
175
176 for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
177 if (sv == specialsv_list[iv]) {
178 type = "B::SPECIAL";
179 break;
180 }
181 }
182 if (!type) {
183 type = svclassnames[SvTYPE(sv)];
184 iv = (IV)sv;
185 }
186 sv_setiv(newSVrv(arg, type), iv);
187 return arg;
188}
189
190static SV *
191make_mg_object(SV *arg, MAGIC *mg)
192{
193 sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg);
194 return arg;
195}
196
197static SV *
198cstring(SV *sv)
199{
200 SV *sstr = newSVpv("", 0);
201 STRLEN len;
202 char *s;
203
204 if (!SvOK(sv))
205 sv_setpvn(sstr, "0", 1);
206 else
207 {
208 /* XXX Optimise? */
209 s = SvPV(sv, len);
210 sv_catpv(sstr, "\"");
211 for (; len; len--, s++)
212 {
213 /* At least try a little for readability */
214 if (*s == '"')
215 sv_catpv(sstr, "\\\"");
216 else if (*s == '\\')
217 sv_catpv(sstr, "\\\\");
218 else if (*s >= ' ' && *s < 127) /* XXX not portable */
219 sv_catpvn(sstr, s, 1);
220 else if (*s == '\n')
221 sv_catpv(sstr, "\\n");
222 else if (*s == '\r')
223 sv_catpv(sstr, "\\r");
224 else if (*s == '\t')
225 sv_catpv(sstr, "\\t");
226 else if (*s == '\a')
227 sv_catpv(sstr, "\\a");
228 else if (*s == '\b')
229 sv_catpv(sstr, "\\b");
230 else if (*s == '\f')
231 sv_catpv(sstr, "\\f");
232 else if (*s == '\v')
233 sv_catpv(sstr, "\\v");
234 else
235 {
236 /* no trigraph support */
237 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
238 /* Don't want promotion of a signed -1 char in sprintf args */
239 unsigned char c = (unsigned char) *s;
240 sprintf(escbuff, "\\%03o", c);
241 sv_catpv(sstr, escbuff);
242 }
243 /* XXX Add line breaks if string is long */
244 }
245 sv_catpv(sstr, "\"");
246 }
247 return sstr;
248}
249
250static SV *
251cchar(SV *sv)
252{
253 SV *sstr = newSVpv("'", 0);
254 char *s = SvPV(sv, na);
255
256 if (*s == '\'')
257 sv_catpv(sstr, "\\'");
258 else if (*s == '\\')
259 sv_catpv(sstr, "\\\\");
260 else if (*s >= ' ' && *s < 127) /* XXX not portable */
261 sv_catpvn(sstr, s, 1);
262 else if (*s == '\n')
263 sv_catpv(sstr, "\\n");
264 else if (*s == '\r')
265 sv_catpv(sstr, "\\r");
266 else if (*s == '\t')
267 sv_catpv(sstr, "\\t");
268 else if (*s == '\a')
269 sv_catpv(sstr, "\\a");
270 else if (*s == '\b')
271 sv_catpv(sstr, "\\b");
272 else if (*s == '\f')
273 sv_catpv(sstr, "\\f");
274 else if (*s == '\v')
275 sv_catpv(sstr, "\\v");
276 else
277 {
278 /* no trigraph support */
279 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
280 /* Don't want promotion of a signed -1 char in sprintf args */
281 unsigned char c = (unsigned char) *s;
282 sprintf(escbuff, "\\%03o", c);
283 sv_catpv(sstr, escbuff);
284 }
285 sv_catpv(sstr, "'");
286 return sstr;
287}
288
a8a597b2
MB
289#ifdef INDIRECT_BGET_MACROS
290void freadpv(U32 len, void *data)
291{
292 New(666, pv.xpv_pv, len, char);
293 fread(pv.xpv_pv, 1, len, (FILE*)data);
294 pv.xpv_len = len;
295 pv.xpv_cur = len - 1;
296}
297
298void byteload_fh(FILE *fp)
299{
300 struct bytestream bs;
301 bs.data = fp;
302 bs.fgetc = (int(*) _((void*)))fgetc;
303 bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread;
304 bs.freadpv = freadpv;
305 byterun(bs);
306}
307
308static int fgetc_fromstring(void *data)
309{
310 char **strp = (char **)data;
311 return *(*strp)++;
312}
313
314static int fread_fromstring(char *argp, size_t elemsize, size_t nelem,
315 void *data)
316{
317 char **strp = (char **)data;
318 size_t len = elemsize * nelem;
319
320 memcpy(argp, *strp, len);
321 *strp += len;
322 return (int)len;
323}
324
325static void freadpv_fromstring(U32 len, void *data)
326{
327 char **strp = (char **)data;
328
329 New(666, pv.xpv_pv, len, char);
330 memcpy(pv.xpv_pv, *strp, len);
331 pv.xpv_len = len;
332 pv.xpv_cur = len - 1;
333 *strp += len;
334}
335
336void byteload_string(char *str)
337{
338 struct bytestream bs;
339 bs.data = &str;
340 bs.fgetc = fgetc_fromstring;
341 bs.fread = fread_fromstring;
342 bs.freadpv = freadpv_fromstring;
343 byterun(bs);
344}
345#else
346void byteload_fh(FILE *fp)
347{
348 byterun(fp);
349}
350
351void byteload_string(char *str)
352{
353 croak("Must compile with -DINDIRECT_BGET_MACROS for byteload_string");
354}
355#endif /* INDIRECT_BGET_MACROS */
356
357void
358walkoptree(SV *opsv, char *method)
359{
360 dSP;
361 OP *o;
362
363 if (!SvROK(opsv))
364 croak("opsv is not a reference");
365 opsv = sv_mortalcopy(opsv);
366 o = (OP*)SvIV((SV*)SvRV(opsv));
367 if (walkoptree_debug) {
368 PUSHMARK(sp);
369 XPUSHs(opsv);
370 PUTBACK;
371 perl_call_method("walkoptree_debug", G_DISCARD);
372 }
373 PUSHMARK(sp);
374 XPUSHs(opsv);
375 PUTBACK;
376 perl_call_method(method, G_DISCARD);
377 if (o && (o->op_flags & OPf_KIDS)) {
378 OP *kid;
379 for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
380 /* Use the same opsv. Rely on methods not to mess it up. */
381 sv_setiv(newSVrv(opsv, cc_opclassname(kid)), (IV)kid);
382 walkoptree(opsv, method);
383 }
384 }
385}
386
387typedef OP *B__OP;
388typedef UNOP *B__UNOP;
389typedef BINOP *B__BINOP;
390typedef LOGOP *B__LOGOP;
391typedef CONDOP *B__CONDOP;
392typedef LISTOP *B__LISTOP;
393typedef PMOP *B__PMOP;
394typedef SVOP *B__SVOP;
395typedef GVOP *B__GVOP;
396typedef PVOP *B__PVOP;
397typedef LOOP *B__LOOP;
398typedef COP *B__COP;
399
400typedef SV *B__SV;
401typedef SV *B__IV;
402typedef SV *B__PV;
403typedef SV *B__NV;
404typedef SV *B__PVMG;
405typedef SV *B__PVLV;
406typedef SV *B__BM;
407typedef SV *B__RV;
408typedef AV *B__AV;
409typedef HV *B__HV;
410typedef CV *B__CV;
411typedef GV *B__GV;
412typedef IO *B__IO;
413
414typedef MAGIC *B__MAGIC;
415
416MODULE = B PACKAGE = B PREFIX = B_
417
418PROTOTYPES: DISABLE
419
420BOOT:
421 INIT_SPECIALSV_LIST;
422
423#define B_main_cv() main_cv
424#define B_main_root() main_root
425#define B_main_start() main_start
426#define B_comppadlist() (main_cv ? CvPADLIST(main_cv) : CvPADLIST(compcv))
427#define B_sv_undef() &sv_undef
428#define B_sv_yes() &sv_yes
429#define B_sv_no() &sv_no
430
431B::CV
432B_main_cv()
433
434B::OP
435B_main_root()
436
437B::OP
438B_main_start()
439
440B::AV
441B_comppadlist()
442
443B::SV
444B_sv_undef()
445
446B::SV
447B_sv_yes()
448
449B::SV
450B_sv_no()
451
452MODULE = B PACKAGE = B
453
454
455void
456walkoptree(opsv, method)
457 SV * opsv
458 char * method
459
460int
461walkoptree_debug(...)
462 CODE:
463 RETVAL = walkoptree_debug;
464 if (items > 0 && SvTRUE(ST(1)))
465 walkoptree_debug = 1;
466 OUTPUT:
467 RETVAL
468
469int
470byteload_fh(fp)
471 FILE * fp
472 CODE:
473 byteload_fh(fp);
474 RETVAL = 1;
475 OUTPUT:
476 RETVAL
477
478void
479byteload_string(str)
480 char * str
481
482#define address(sv) (IV)sv
483
484IV
485address(sv)
486 SV * sv
487
488B::SV
489svref_2object(sv)
490 SV * sv
491 CODE:
492 if (!SvROK(sv))
493 croak("argument is not a reference");
494 RETVAL = (SV*)SvRV(sv);
495 OUTPUT:
496 RETVAL
497
498void
499ppname(opnum)
500 int opnum
501 CODE:
502 ST(0) = sv_newmortal();
503 if (opnum >= 0 && opnum < maxo) {
504 sv_setpvn(ST(0), "pp_", 3);
505 sv_catpv(ST(0), op_name[opnum]);
506 }
507
508void
509hash(sv)
510 SV * sv
511 CODE:
512 char *s;
513 STRLEN len;
514 U32 hash = 0;
515 char hexhash[11]; /* must fit "0xffffffff" plus trailing \0 */
516 s = SvPV(sv, len);
517 while (len--)
518 hash = hash * 33 + *s++;
519 sprintf(hexhash, "0x%x", hash);
520 ST(0) = sv_2mortal(newSVpv(hexhash, 0));
521
522#define cast_I32(foo) (I32)foo
523IV
524cast_I32(i)
525 IV i
526
527void
528minus_c()
529 CODE:
530 minus_c = TRUE;
531
532SV *
533cstring(sv)
534 SV * sv
535
536SV *
537cchar(sv)
538 SV * sv
539
540void
541threadsv_names()
542 PPCODE:
543#ifdef USE_THREADS
544 int i;
545 STRLEN len = strlen(threadsv_names);
546
547 EXTEND(sp, len);
548 for (i = 0; i < len; i++)
549 PUSHs(sv_2mortal(newSVpv(&threadsv_names[i], 1)));
550#endif
551
552
553#define OP_next(o) o->op_next
554#define OP_sibling(o) o->op_sibling
555#define OP_desc(o) op_desc[o->op_type]
556#define OP_targ(o) o->op_targ
557#define OP_type(o) o->op_type
558#define OP_seq(o) o->op_seq
559#define OP_flags(o) o->op_flags
560#define OP_private(o) o->op_private
561
562MODULE = B PACKAGE = B::OP PREFIX = OP_
563
564B::OP
565OP_next(o)
566 B::OP o
567
568B::OP
569OP_sibling(o)
570 B::OP o
571
572char *
573OP_ppaddr(o)
574 B::OP o
575 CODE:
576 ST(0) = sv_newmortal();
577 sv_setpvn(ST(0), "pp_", 3);
578 sv_catpv(ST(0), op_name[o->op_type]);
579
580char *
581OP_desc(o)
582 B::OP o
583
584U16
585OP_targ(o)
586 B::OP o
587
588U16
589OP_type(o)
590 B::OP o
591
592U16
593OP_seq(o)
594 B::OP o
595
596U8
597OP_flags(o)
598 B::OP o
599
600U8
601OP_private(o)
602 B::OP o
603
604#define UNOP_first(o) o->op_first
605
606MODULE = B PACKAGE = B::UNOP PREFIX = UNOP_
607
608B::OP
609UNOP_first(o)
610 B::UNOP o
611
612#define BINOP_last(o) o->op_last
613
614MODULE = B PACKAGE = B::BINOP PREFIX = BINOP_
615
616B::OP
617BINOP_last(o)
618 B::BINOP o
619
620#define LOGOP_other(o) o->op_other
621
622MODULE = B PACKAGE = B::LOGOP PREFIX = LOGOP_
623
624B::OP
625LOGOP_other(o)
626 B::LOGOP o
627
628#define CONDOP_true(o) o->op_true
629#define CONDOP_false(o) o->op_false
630
631MODULE = B PACKAGE = B::CONDOP PREFIX = CONDOP_
632
633B::OP
634CONDOP_true(o)
635 B::CONDOP o
636
637B::OP
638CONDOP_false(o)
639 B::CONDOP o
640
641#define LISTOP_children(o) o->op_children
642
643MODULE = B PACKAGE = B::LISTOP PREFIX = LISTOP_
644
645U32
646LISTOP_children(o)
647 B::LISTOP o
648
649#define PMOP_pmreplroot(o) o->op_pmreplroot
650#define PMOP_pmreplstart(o) o->op_pmreplstart
651#define PMOP_pmnext(o) o->op_pmnext
652#define PMOP_pmregexp(o) o->op_pmregexp
653#define PMOP_pmflags(o) o->op_pmflags
654#define PMOP_pmpermflags(o) o->op_pmpermflags
655
656MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
657
658void
659PMOP_pmreplroot(o)
660 B::PMOP o
661 OP * root = NO_INIT
662 CODE:
663 ST(0) = sv_newmortal();
664 root = o->op_pmreplroot;
665 /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
666 if (o->op_type == OP_PUSHRE) {
667 sv_setiv(newSVrv(ST(0), root ?
668 svclassnames[SvTYPE((SV*)root)] : "B::SV"),
669 (IV)root);
670 }
671 else {
672 sv_setiv(newSVrv(ST(0), cc_opclassname(root)), (IV)root);
673 }
674
675B::OP
676PMOP_pmreplstart(o)
677 B::PMOP o
678
679B::PMOP
680PMOP_pmnext(o)
681 B::PMOP o
682
683U16
684PMOP_pmflags(o)
685 B::PMOP o
686
687U16
688PMOP_pmpermflags(o)
689 B::PMOP o
690
691void
692PMOP_precomp(o)
693 B::PMOP o
694 REGEXP * rx = NO_INIT
695 CODE:
696 ST(0) = sv_newmortal();
697 rx = o->op_pmregexp;
698 if (rx)
699 sv_setpvn(ST(0), rx->precomp, rx->prelen);
700
701#define SVOP_sv(o) o->op_sv
702
703MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_
704
705
706B::SV
707SVOP_sv(o)
708 B::SVOP o
709
710#define GVOP_gv(o) o->op_gv
711
712MODULE = B PACKAGE = B::GVOP PREFIX = GVOP_
713
714
715B::GV
716GVOP_gv(o)
717 B::GVOP o
718
719MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_
720
721void
722PVOP_pv(o)
723 B::PVOP o
724 CODE:
725 /*
726 * OP_TRANS uses op_pv to point to a table of 256 shorts
727 * whereas other PVOPs point to a null terminated string.
728 */
729 ST(0) = sv_2mortal(newSVpv(o->op_pv, (o->op_type == OP_TRANS) ?
730 256 * sizeof(short) : 0));
731
732#define LOOP_redoop(o) o->op_redoop
733#define LOOP_nextop(o) o->op_nextop
734#define LOOP_lastop(o) o->op_lastop
735
736MODULE = B PACKAGE = B::LOOP PREFIX = LOOP_
737
738
739B::OP
740LOOP_redoop(o)
741 B::LOOP o
742
743B::OP
744LOOP_nextop(o)
745 B::LOOP o
746
747B::OP
748LOOP_lastop(o)
749 B::LOOP o
750
751#define COP_label(o) o->cop_label
752#define COP_stash(o) o->cop_stash
753#define COP_filegv(o) o->cop_filegv
754#define COP_cop_seq(o) o->cop_seq
755#define COP_arybase(o) o->cop_arybase
756#define COP_line(o) o->cop_line
757
758MODULE = B PACKAGE = B::COP PREFIX = COP_
759
760char *
761COP_label(o)
762 B::COP o
763
764B::HV
765COP_stash(o)
766 B::COP o
767
768B::GV
769COP_filegv(o)
770 B::COP o
771
772U32
773COP_cop_seq(o)
774 B::COP o
775
776I32
777COP_arybase(o)
778 B::COP o
779
780U16
781COP_line(o)
782 B::COP o
783
784MODULE = B PACKAGE = B::SV PREFIX = Sv
785
786U32
787SvREFCNT(sv)
788 B::SV sv
789
790U32
791SvFLAGS(sv)
792 B::SV sv
793
794MODULE = B PACKAGE = B::IV PREFIX = Sv
795
796IV
797SvIV(sv)
798 B::IV sv
799
800IV
801SvIVX(sv)
802 B::IV sv
803
804MODULE = B PACKAGE = B::IV
805
806#define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
807
808int
809needs64bits(sv)
810 B::IV sv
811
812void
813packiv(sv)
814 B::IV sv
815 CODE:
816 if (sizeof(IV) == 8) {
817 U32 wp[2];
818 IV iv = SvIVX(sv);
819 /*
820 * The following way of spelling 32 is to stop compilers on
821 * 32-bit architectures from moaning about the shift count
822 * being >= the width of the type. Such architectures don't
823 * reach this code anyway (unless sizeof(IV) > 8 but then
824 * everything else breaks too so I'm not fussed at the moment).
825 */
826 wp[0] = htonl(((U32)iv) >> (sizeof(IV)*4));
827 wp[1] = htonl(iv & 0xffffffff);
828 ST(0) = sv_2mortal(newSVpv((char *)wp, 8));
829 } else {
830 U32 w = htonl((U32)SvIVX(sv));
831 ST(0) = sv_2mortal(newSVpv((char *)&w, 4));
832 }
833
834MODULE = B PACKAGE = B::NV PREFIX = Sv
835
836double
837SvNV(sv)
838 B::NV sv
839
840double
841SvNVX(sv)
842 B::NV sv
843
844MODULE = B PACKAGE = B::RV PREFIX = Sv
845
846B::SV
847SvRV(sv)
848 B::RV sv
849
850MODULE = B PACKAGE = B::PV PREFIX = Sv
851
852void
853SvPV(sv)
854 B::PV sv
855 CODE:
856 ST(0) = sv_newmortal();
857 sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
858
859MODULE = B PACKAGE = B::PVMG PREFIX = Sv
860
861void
862SvMAGIC(sv)
863 B::PVMG sv
864 MAGIC * mg = NO_INIT
865 PPCODE:
866 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
867 XPUSHs(make_mg_object(sv_newmortal(), mg));
868
869MODULE = B PACKAGE = B::PVMG
870
871B::HV
872SvSTASH(sv)
873 B::PVMG sv
874
875#define MgMOREMAGIC(mg) mg->mg_moremagic
876#define MgPRIVATE(mg) mg->mg_private
877#define MgTYPE(mg) mg->mg_type
878#define MgFLAGS(mg) mg->mg_flags
879#define MgOBJ(mg) mg->mg_obj
880
881MODULE = B PACKAGE = B::MAGIC PREFIX = Mg
882
883B::MAGIC
884MgMOREMAGIC(mg)
885 B::MAGIC mg
886
887U16
888MgPRIVATE(mg)
889 B::MAGIC mg
890
891char
892MgTYPE(mg)
893 B::MAGIC mg
894
895U8
896MgFLAGS(mg)
897 B::MAGIC mg
898
899B::SV
900MgOBJ(mg)
901 B::MAGIC mg
902
903void
904MgPTR(mg)
905 B::MAGIC mg
906 CODE:
907 ST(0) = sv_newmortal();
908 if (mg->mg_ptr)
909 sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
910
911MODULE = B PACKAGE = B::PVLV PREFIX = Lv
912
913U32
914LvTARGOFF(sv)
915 B::PVLV sv
916
917U32
918LvTARGLEN(sv)
919 B::PVLV sv
920
921char
922LvTYPE(sv)
923 B::PVLV sv
924
925B::SV
926LvTARG(sv)
927 B::PVLV sv
928
929MODULE = B PACKAGE = B::BM PREFIX = Bm
930
931I32
932BmUSEFUL(sv)
933 B::BM sv
934
935U16
936BmPREVIOUS(sv)
937 B::BM sv
938
939U8
940BmRARE(sv)
941 B::BM sv
942
943void
944BmTABLE(sv)
945 B::BM sv
946 STRLEN len = NO_INIT
947 char * str = NO_INIT
948 CODE:
949 str = SvPV(sv, len);
950 /* Boyer-Moore table is just after string and its safety-margin \0 */
951 ST(0) = sv_2mortal(newSVpv(str + len + 1, 256));
952
953MODULE = B PACKAGE = B::GV PREFIX = Gv
954
955void
956GvNAME(gv)
957 B::GV gv
958 CODE:
959 ST(0) = sv_2mortal(newSVpv(GvNAME(gv), GvNAMELEN(gv)));
960
961B::HV
962GvSTASH(gv)
963 B::GV gv
964
965B::SV
966GvSV(gv)
967 B::GV gv
968
969B::IO
970GvIO(gv)
971 B::GV gv
972
973B::CV
974GvFORM(gv)
975 B::GV gv
976
977B::AV
978GvAV(gv)
979 B::GV gv
980
981B::HV
982GvHV(gv)
983 B::GV gv
984
985B::GV
986GvEGV(gv)
987 B::GV gv
988
989B::CV
990GvCV(gv)
991 B::GV gv
992
993U32
994GvCVGEN(gv)
995 B::GV gv
996
997U16
998GvLINE(gv)
999 B::GV gv
1000
1001B::GV
1002GvFILEGV(gv)
1003 B::GV gv
1004
1005MODULE = B PACKAGE = B::GV
1006
1007U32
1008GvREFCNT(gv)
1009 B::GV gv
1010
1011U8
1012GvFLAGS(gv)
1013 B::GV gv
1014
1015MODULE = B PACKAGE = B::IO PREFIX = Io
1016
1017long
1018IoLINES(io)
1019 B::IO io
1020
1021long
1022IoPAGE(io)
1023 B::IO io
1024
1025long
1026IoPAGE_LEN(io)
1027 B::IO io
1028
1029long
1030IoLINES_LEFT(io)
1031 B::IO io
1032
1033char *
1034IoTOP_NAME(io)
1035 B::IO io
1036
1037B::GV
1038IoTOP_GV(io)
1039 B::IO io
1040
1041char *
1042IoFMT_NAME(io)
1043 B::IO io
1044
1045B::GV
1046IoFMT_GV(io)
1047 B::IO io
1048
1049char *
1050IoBOTTOM_NAME(io)
1051 B::IO io
1052
1053B::GV
1054IoBOTTOM_GV(io)
1055 B::IO io
1056
1057short
1058IoSUBPROCESS(io)
1059 B::IO io
1060
1061MODULE = B PACKAGE = B::IO
1062
1063char
1064IoTYPE(io)
1065 B::IO io
1066
1067U8
1068IoFLAGS(io)
1069 B::IO io
1070
1071MODULE = B PACKAGE = B::AV PREFIX = Av
1072
1073SSize_t
1074AvFILL(av)
1075 B::AV av
1076
1077SSize_t
1078AvMAX(av)
1079 B::AV av
1080
1081#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1082
1083IV
1084AvOFF(av)
1085 B::AV av
1086
1087void
1088AvARRAY(av)
1089 B::AV av
1090 PPCODE:
1091 if (AvFILL(av) >= 0) {
1092 SV **svp = AvARRAY(av);
1093 I32 i;
1094 for (i = 0; i <= AvFILL(av); i++)
1095 XPUSHs(make_sv_object(sv_newmortal(), svp[i]));
1096 }
1097
1098MODULE = B PACKAGE = B::AV
1099
1100U8
1101AvFLAGS(av)
1102 B::AV av
1103
1104MODULE = B PACKAGE = B::CV PREFIX = Cv
1105
1106B::HV
1107CvSTASH(cv)
1108 B::CV cv
1109
1110B::OP
1111CvSTART(cv)
1112 B::CV cv
1113
1114B::OP
1115CvROOT(cv)
1116 B::CV cv
1117
1118B::GV
1119CvGV(cv)
1120 B::CV cv
1121
1122B::GV
1123CvFILEGV(cv)
1124 B::CV cv
1125
1126long
1127CvDEPTH(cv)
1128 B::CV cv
1129
1130B::AV
1131CvPADLIST(cv)
1132 B::CV cv
1133
1134B::CV
1135CvOUTSIDE(cv)
1136 B::CV cv
1137
1138void
1139CvXSUB(cv)
1140 B::CV cv
1141 CODE:
1142 ST(0) = sv_2mortal(newSViv((IV)CvXSUB(cv)));
1143
1144
1145void
1146CvXSUBANY(cv)
1147 B::CV cv
1148 CODE:
1149 ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
1150
1151MODULE = B PACKAGE = B::HV PREFIX = Hv
1152
1153STRLEN
1154HvFILL(hv)
1155 B::HV hv
1156
1157STRLEN
1158HvMAX(hv)
1159 B::HV hv
1160
1161I32
1162HvKEYS(hv)
1163 B::HV hv
1164
1165I32
1166HvRITER(hv)
1167 B::HV hv
1168
1169char *
1170HvNAME(hv)
1171 B::HV hv
1172
1173B::PMOP
1174HvPMROOT(hv)
1175 B::HV hv
1176
1177void
1178HvARRAY(hv)
1179 B::HV hv
1180 PPCODE:
1181 if (HvKEYS(hv) > 0) {
1182 SV *sv;
1183 char *key;
1184 I32 len;
1185 (void)hv_iterinit(hv);
1186 EXTEND(sp, HvKEYS(hv) * 2);
1187 while (sv = hv_iternextsv(hv, &key, &len)) {
1188 PUSHs(newSVpv(key, len));
1189 PUSHs(make_sv_object(sv_newmortal(), sv));
1190 }
1191 }