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