projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
ByteLoader mark 2
[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
89cc_opclass(OP *o)
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 *
191cc_opclassname(OP *o)
192{
193 return opclassnames[cc_opclass(o)];
194}
195
196static SV *
197make_sv_object(SV *arg, SV *sv)
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 *
217make_mg_object(SV *arg, MAGIC *mg)
218{
219 sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg);
220 return arg;
221}
222
223static SV *
224cstring(SV *sv)
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 *
277cchar(SV *sv)
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
317walkoptree(SV *opsv, char *method)
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. */
340 sv_setiv(newSVrv(opsv, cc_opclassname(kid)), (IV)kid);
341 walkoptree(opsv, method);
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
434
435int
436walkoptree_debug(...)
437 CODE:
438 RETVAL = walkoptree_debug;
439 if (items > 0 && SvTRUE(ST(1)))
440 walkoptree_debug = 1;
441 OUTPUT:
442 RETVAL
443
444int
445byteload_fh(fp)
51aa15f3 446 InputStream fp
a8a597b2 447 CODE:
448 byteload_fh(fp);
449 RETVAL = 1;
450 OUTPUT:
451 RETVAL
452
453void
454byteload_string(str)
455 char * str
456
457#define address(sv) (IV)sv
458
459IV
460address(sv)
461 SV * sv
462
463B::SV
464svref_2object(sv)
465 SV * sv
466 CODE:
467 if (!SvROK(sv))
468 croak("argument is not a reference");
469 RETVAL = (SV*)SvRV(sv);
470 OUTPUT:
0cc1d052 471 RETVAL
472
473void
474opnumber(name)
475char * name
476CODE:
477{
478 int i;
479 IV result = -1;
480 ST(0) = sv_newmortal();
481 if (strncmp(name,"pp_",3) == 0)
482 name += 3;
483 for (i = 0; i < PL_maxo; i++)
484 {
485 if (strcmp(name, PL_op_name[i]) == 0)
486 {
487 result = i;
488 break;
489 }
490 }
491 sv_setiv(ST(0),result);
492}
a8a597b2 493
494void
495ppname(opnum)
496 int opnum
497 CODE:
498 ST(0) = sv_newmortal();
3280af22 499 if (opnum >= 0 && opnum < PL_maxo) {
a8a597b2 500 sv_setpvn(ST(0), "pp_", 3);
22c35a8c 501 sv_catpv(ST(0), PL_op_name[opnum]);
a8a597b2 502 }
503
504void
505hash(sv)
506 SV * sv
507 CODE:
508 char *s;
509 STRLEN len;
510 U32 hash = 0;
cf86991c 511 char hexhash[19]; /* must fit "0xffffffff" plus trailing \0 */
a8a597b2 512 s = SvPV(sv, len);
cf86991c 513 PERL_HASH(hash, s, len);
a8a597b2 514 sprintf(hexhash, "0x%x", hash);
515 ST(0) = sv_2mortal(newSVpv(hexhash, 0));
516
517#define cast_I32(foo) (I32)foo
518IV
519cast_I32(i)
520 IV i
521
522void
523minus_c()
524 CODE:
3280af22 525 PL_minus_c = TRUE;
a8a597b2 526
527SV *
528cstring(sv)
529 SV * sv
530
531SV *
532cchar(sv)
533 SV * sv
534
535void
536threadsv_names()
537 PPCODE:
538#ifdef USE_THREADS
539 int i;
533c011a 540 STRLEN len = strlen(PL_threadsv_names);
a8a597b2 541
542 EXTEND(sp, len);
543 for (i = 0; i < len; i++)
79cb57f6 544 PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
a8a597b2 545#endif
546
547
548#define OP_next(o) o->op_next
549#define OP_sibling(o) o->op_sibling
22c35a8c 550#define OP_desc(o) PL_op_desc[o->op_type]
a8a597b2 551#define OP_targ(o) o->op_targ
552#define OP_type(o) o->op_type
553#define OP_seq(o) o->op_seq
554#define OP_flags(o) o->op_flags
555#define OP_private(o) o->op_private
556
557MODULE = B PACKAGE = B::OP PREFIX = OP_
558
559B::OP
560OP_next(o)
561 B::OP o
562
563B::OP
564OP_sibling(o)
565 B::OP o
566
567char *
568OP_ppaddr(o)
569 B::OP o
570 CODE:
571 ST(0) = sv_newmortal();
572 sv_setpvn(ST(0), "pp_", 3);
22c35a8c 573 sv_catpv(ST(0), PL_op_name[o->op_type]);
a8a597b2 574
575char *
576OP_desc(o)
577 B::OP o
578
579U16
580OP_targ(o)
581 B::OP o
582
583U16
584OP_type(o)
585 B::OP o
586
587U16
588OP_seq(o)
589 B::OP o
590
591U8
592OP_flags(o)
593 B::OP o
594
595U8
596OP_private(o)
597 B::OP o
598
599#define UNOP_first(o) o->op_first
600
601MODULE = B PACKAGE = B::UNOP PREFIX = UNOP_
602
603B::OP
604UNOP_first(o)
605 B::UNOP o
606
607#define BINOP_last(o) o->op_last
608
609MODULE = B PACKAGE = B::BINOP PREFIX = BINOP_
610
611B::OP
612BINOP_last(o)
613 B::BINOP o
614
615#define LOGOP_other(o) o->op_other
616
617MODULE = B PACKAGE = B::LOGOP PREFIX = LOGOP_
618
619B::OP
620LOGOP_other(o)
621 B::LOGOP o
622
623#define CONDOP_true(o) o->op_true
624#define CONDOP_false(o) o->op_false
625
626MODULE = B PACKAGE = B::CONDOP PREFIX = CONDOP_
627
628B::OP
629CONDOP_true(o)
630 B::CONDOP o
631
632B::OP
633CONDOP_false(o)
634 B::CONDOP o
635
636#define LISTOP_children(o) o->op_children
637
638MODULE = B PACKAGE = B::LISTOP PREFIX = LISTOP_
639
640U32
641LISTOP_children(o)
642 B::LISTOP o
643
644#define PMOP_pmreplroot(o) o->op_pmreplroot
645#define PMOP_pmreplstart(o) o->op_pmreplstart
646#define PMOP_pmnext(o) o->op_pmnext
647#define PMOP_pmregexp(o) o->op_pmregexp
648#define PMOP_pmflags(o) o->op_pmflags
649#define PMOP_pmpermflags(o) o->op_pmpermflags
650
651MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
652
653void
654PMOP_pmreplroot(o)
655 B::PMOP o
656 OP * root = NO_INIT
657 CODE:
658 ST(0) = sv_newmortal();
659 root = o->op_pmreplroot;
660 /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
661 if (o->op_type == OP_PUSHRE) {
662 sv_setiv(newSVrv(ST(0), root ?
663 svclassnames[SvTYPE((SV*)root)] : "B::SV"),
664 (IV)root);
665 }
666 else {
667 sv_setiv(newSVrv(ST(0), cc_opclassname(root)), (IV)root);
668 }
669
670B::OP
671PMOP_pmreplstart(o)
672 B::PMOP o
673
674B::PMOP
675PMOP_pmnext(o)
676 B::PMOP o
677
678U16
679PMOP_pmflags(o)
680 B::PMOP o
681
682U16
683PMOP_pmpermflags(o)
684 B::PMOP o
685
686void
687PMOP_precomp(o)
688 B::PMOP o
689 REGEXP * rx = NO_INIT
690 CODE:
691 ST(0) = sv_newmortal();
692 rx = o->op_pmregexp;
693 if (rx)
694 sv_setpvn(ST(0), rx->precomp, rx->prelen);
695
696#define SVOP_sv(o) o->op_sv
697
698MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_
699
700
701B::SV
702SVOP_sv(o)
703 B::SVOP o
704
705#define GVOP_gv(o) o->op_gv
706
707MODULE = B PACKAGE = B::GVOP PREFIX = GVOP_
708
709
710B::GV
711GVOP_gv(o)
712 B::GVOP o
713
714MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_
715
716void
717PVOP_pv(o)
718 B::PVOP o
719 CODE:
720 /*
721 * OP_TRANS uses op_pv to point to a table of 256 shorts
722 * whereas other PVOPs point to a null terminated string.
723 */
724 ST(0) = sv_2mortal(newSVpv(o->op_pv, (o->op_type == OP_TRANS) ?
725 256 * sizeof(short) : 0));
726
727#define LOOP_redoop(o) o->op_redoop
728#define LOOP_nextop(o) o->op_nextop
729#define LOOP_lastop(o) o->op_lastop
730
731MODULE = B PACKAGE = B::LOOP PREFIX = LOOP_
732
733
734B::OP
735LOOP_redoop(o)
736 B::LOOP o
737
738B::OP
739LOOP_nextop(o)
740 B::LOOP o
741
742B::OP
743LOOP_lastop(o)
744 B::LOOP o
745
746#define COP_label(o) o->cop_label
747#define COP_stash(o) o->cop_stash
748#define COP_filegv(o) o->cop_filegv
749#define COP_cop_seq(o) o->cop_seq
750#define COP_arybase(o) o->cop_arybase
751#define COP_line(o) o->cop_line
b295d113 752#define COP_warnings(o) o->cop_warnings
a8a597b2 753
754MODULE = B PACKAGE = B::COP PREFIX = COP_
755
756char *
757COP_label(o)
758 B::COP o
759
760B::HV
761COP_stash(o)
762 B::COP o
763
764B::GV
765COP_filegv(o)
766 B::COP o
767
768U32
769COP_cop_seq(o)
770 B::COP o
771
772I32
773COP_arybase(o)
774 B::COP o
775
776U16
777COP_line(o)
778 B::COP o
779
b295d113 780B::SV
781COP_warnings(o)
782 B::COP o
783
a8a597b2 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);
79cb57f6 828 ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
a8a597b2 829 } else {
830 U32 w = htonl((U32)SvIVX(sv));
79cb57f6 831 ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
a8a597b2 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
88b39979 880#define MgLENGTH(mg) mg->mg_len
a8a597b2 881
882MODULE = B PACKAGE = B::MAGIC PREFIX = Mg
883
884B::MAGIC
885MgMOREMAGIC(mg)
886 B::MAGIC mg
887
888U16
889MgPRIVATE(mg)
890 B::MAGIC mg
891
892char
893MgTYPE(mg)
894 B::MAGIC mg
895
896U8
897MgFLAGS(mg)
898 B::MAGIC mg
899
900B::SV
901MgOBJ(mg)
902 B::MAGIC mg
903
88b39979 904I32
905MgLENGTH(mg)
906 B::MAGIC mg
907
a8a597b2 908void
909MgPTR(mg)
910 B::MAGIC mg
911 CODE:
912 ST(0) = sv_newmortal();
88b39979 913 if (mg->mg_ptr){
914 if (mg->mg_len >= 0){
915 sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
916 } else {
917 if (mg->mg_len == HEf_SVKEY)
918 sv_setsv(ST(0),newRV((SV*)mg->mg_ptr));
919 }
920 }
a8a597b2 921
922MODULE = B PACKAGE = B::PVLV PREFIX = Lv
923
924U32
925LvTARGOFF(sv)
926 B::PVLV sv
927
928U32
929LvTARGLEN(sv)
930 B::PVLV sv
931
932char
933LvTYPE(sv)
934 B::PVLV sv
935
936B::SV
937LvTARG(sv)
938 B::PVLV sv
939
940MODULE = B PACKAGE = B::BM PREFIX = Bm
941
942I32
943BmUSEFUL(sv)
944 B::BM sv
945
946U16
947BmPREVIOUS(sv)
948 B::BM sv
949
950U8
951BmRARE(sv)
952 B::BM sv
953
954void
955BmTABLE(sv)
956 B::BM sv
957 STRLEN len = NO_INIT
958 char * str = NO_INIT
959 CODE:
960 str = SvPV(sv, len);
961 /* Boyer-Moore table is just after string and its safety-margin \0 */
79cb57f6 962 ST(0) = sv_2mortal(newSVpvn(str + len + 1, 256));
a8a597b2 963
964MODULE = B PACKAGE = B::GV PREFIX = Gv
965
966void
967GvNAME(gv)
968 B::GV gv
969 CODE:
79cb57f6 970 ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
a8a597b2 971
972B::HV
973GvSTASH(gv)
974 B::GV gv
975
976B::SV
977GvSV(gv)
978 B::GV gv
979
980B::IO
981GvIO(gv)
982 B::GV gv
983
984B::CV
985GvFORM(gv)
986 B::GV gv
987
988B::AV
989GvAV(gv)
990 B::GV gv
991
992B::HV
993GvHV(gv)
994 B::GV gv
995
996B::GV
997GvEGV(gv)
998 B::GV gv
999
1000B::CV
1001GvCV(gv)
1002 B::GV gv
1003
1004U32
1005GvCVGEN(gv)
1006 B::GV gv
1007
1008U16
1009GvLINE(gv)
1010 B::GV gv
1011
1012B::GV
1013GvFILEGV(gv)
1014 B::GV gv
1015
1016MODULE = B PACKAGE = B::GV
1017
1018U32
1019GvREFCNT(gv)
1020 B::GV gv
1021
1022U8
1023GvFLAGS(gv)
1024 B::GV gv
1025
1026MODULE = B PACKAGE = B::IO PREFIX = Io
1027
1028long
1029IoLINES(io)
1030 B::IO io
1031
1032long
1033IoPAGE(io)
1034 B::IO io
1035
1036long
1037IoPAGE_LEN(io)
1038 B::IO io
1039
1040long
1041IoLINES_LEFT(io)
1042 B::IO io
1043
1044char *
1045IoTOP_NAME(io)
1046 B::IO io
1047
1048B::GV
1049IoTOP_GV(io)
1050 B::IO io
1051
1052char *
1053IoFMT_NAME(io)
1054 B::IO io
1055
1056B::GV
1057IoFMT_GV(io)
1058 B::IO io
1059
1060char *
1061IoBOTTOM_NAME(io)
1062 B::IO io
1063
1064B::GV
1065IoBOTTOM_GV(io)
1066 B::IO io
1067
1068short
1069IoSUBPROCESS(io)
1070 B::IO io
1071
1072MODULE = B PACKAGE = B::IO
1073
1074char
1075IoTYPE(io)
1076 B::IO io
1077
1078U8
1079IoFLAGS(io)
1080 B::IO io
1081
1082MODULE = B PACKAGE = B::AV PREFIX = Av
1083
1084SSize_t
1085AvFILL(av)
1086 B::AV av
1087
1088SSize_t
1089AvMAX(av)
1090 B::AV av
1091
1092#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1093
1094IV
1095AvOFF(av)
1096 B::AV av
1097
1098void
1099AvARRAY(av)
1100 B::AV av
1101 PPCODE:
1102 if (AvFILL(av) >= 0) {
1103 SV **svp = AvARRAY(av);
1104 I32 i;
1105 for (i = 0; i <= AvFILL(av); i++)
1106 XPUSHs(make_sv_object(sv_newmortal(), svp[i]));
1107 }
1108
1109MODULE = B PACKAGE = B::AV
1110
1111U8
1112AvFLAGS(av)
1113 B::AV av
1114
1115MODULE = B PACKAGE = B::CV PREFIX = Cv
1116
1117B::HV
1118CvSTASH(cv)
1119 B::CV cv
1120
1121B::OP
1122CvSTART(cv)
1123 B::CV cv
1124
1125B::OP
1126CvROOT(cv)
1127 B::CV cv
1128
1129B::GV
1130CvGV(cv)
1131 B::CV cv
1132
1133B::GV
1134CvFILEGV(cv)
1135 B::CV cv
1136
1137long
1138CvDEPTH(cv)
1139 B::CV cv
1140
1141B::AV
1142CvPADLIST(cv)
1143 B::CV cv
1144
1145B::CV
1146CvOUTSIDE(cv)
1147 B::CV cv
1148
1149void
1150CvXSUB(cv)
1151 B::CV cv
1152 CODE:
1153 ST(0) = sv_2mortal(newSViv((IV)CvXSUB(cv)));
1154
1155
1156void
1157CvXSUBANY(cv)
1158 B::CV cv
1159 CODE:
1160 ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
1161
5cfd8ad4 1162MODULE = B PACKAGE = B::CV
1163
1164U8
1165CvFLAGS(cv)
1166 B::CV cv
1167
1168
a8a597b2 1169MODULE = B PACKAGE = B::HV PREFIX = Hv
1170
1171STRLEN
1172HvFILL(hv)
1173 B::HV hv
1174
1175STRLEN
1176HvMAX(hv)
1177 B::HV hv
1178
1179I32
1180HvKEYS(hv)
1181 B::HV hv
1182
1183I32
1184HvRITER(hv)
1185 B::HV hv
1186
1187char *
1188HvNAME(hv)
1189 B::HV hv
1190
1191B::PMOP
1192HvPMROOT(hv)
1193 B::HV hv
1194
1195void
1196HvARRAY(hv)
1197 B::HV hv
1198 PPCODE:
1199 if (HvKEYS(hv) > 0) {
1200 SV *sv;
1201 char *key;
1202 I32 len;
1203 (void)hv_iterinit(hv);
1204 EXTEND(sp, HvKEYS(hv) * 2);
1205 while (sv = hv_iternextsv(hv, &key, &len)) {
79cb57f6 1206 PUSHs(newSVpvn(key, len));
a8a597b2 1207 PUSHs(make_sv_object(sv_newmortal(), sv));
1208 }
1209 }
Unnamed repository; edit this file to name it for gitweb.