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