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