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