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 #define PERL_NO_GET_CONTEXT
11 #include "EXTERN.h"
12 #include "perl.h"
13 #include "XSUB.h"
14
15 #ifdef PerlIO
16 typedef PerlIO * InputStream;
17 #else
18 typedef FILE * InputStream;
19 #endif
20
21
22 static char *svclassnames[] = {
23 "B::NULL",
24 "B::IV",
25 "B::NV",
26 "B::RV",
27 "B::PV",
28 "B::PVIV",
29 "B::PVNV",
30 "B::PVMG",
31 "B::BM",
32 "B::PVLV",
33 "B::AV",
34 "B::HV",
35 "B::CV",
36 "B::GV",
37 "B::FM",
38 "B::IO",
39 };
40
41 typedef enum {
42 OPc_NULL, /* 0 */
43 OPc_BASEOP, /* 1 */
44 OPc_UNOP, /* 2 */
45 OPc_BINOP, /* 3 */
46 OPc_LOGOP, /* 4 */
47 OPc_LISTOP, /* 5 */
48 OPc_PMOP, /* 6 */
49 OPc_SVOP, /* 7 */
50 OPc_PADOP, /* 8 */
51 OPc_PVOP, /* 9 */
52 OPc_LOOP, /* 10 */
53 OPc_COP /* 11 */
54 } opclass;
55
56 static char *opclassnames[] = {
57 "B::NULL",
58 "B::OP",
59 "B::UNOP",
60 "B::BINOP",
61 "B::LOGOP",
62 "B::LISTOP",
63 "B::PMOP",
64 "B::SVOP",
65 "B::PADOP",
66 "B::PVOP",
67 "B::LOOP",
68 "B::COP"
69 };
70
71 static size_t opsizes[] = {
72 0,
73 sizeof(OP),
74 sizeof(UNOP),
75 sizeof(BINOP),
76 sizeof(LOGOP),
77 sizeof(LISTOP),
78 sizeof(PMOP),
79 sizeof(SVOP),
80 sizeof(PADOP),
81 sizeof(PVOP),
82 sizeof(LOOP),
83 sizeof(COP)
84 };
85
86 #define MY_CXT_KEY "B::_guts" XS_VERSION
87
88 typedef struct {
89 int x_walkoptree_debug; /* Flag for walkoptree debug hook */
90 SV * x_specialsv_list[7];
91 } my_cxt_t;
92
93 START_MY_CXT
94
95 #define walkoptree_debug (MY_CXT.x_walkoptree_debug)
96 #define specialsv_list (MY_CXT.x_specialsv_list)
97
98 static opclass
cc_opclass(pTHX_ OP * o)99 cc_opclass(pTHX_ OP *o)
100 {
101 if (!o)
102 return OPc_NULL;
103
104 if (o->op_type == 0)
105 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
106
107 if (o->op_type == OP_SASSIGN)
108 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
109
110 #ifdef USE_ITHREADS
111 if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
112 o->op_type == OP_AELEMFAST || o->op_type == OP_RCATLINE)
113 return OPc_PADOP;
114 #endif
115
116 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
117 case OA_BASEOP:
118 return OPc_BASEOP;
119
120 case OA_UNOP:
121 return OPc_UNOP;
122
123 case OA_BINOP:
124 return OPc_BINOP;
125
126 case OA_LOGOP:
127 return OPc_LOGOP;
128
129 case OA_LISTOP:
130 return OPc_LISTOP;
131
132 case OA_PMOP:
133 return OPc_PMOP;
134
135 case OA_SVOP:
136 return OPc_SVOP;
137
138 case OA_PADOP:
139 return OPc_PADOP;
140
141 case OA_PVOP_OR_SVOP:
142 /*
143 * Character translations (tr///) are usually a PVOP, keeping a
144 * pointer to a table of shorts used to look up translations.
145 * Under utf8, however, a simple table isn't practical; instead,
146 * the OP is an SVOP, and the SV is a reference to a swash
147 * (i.e., an RV pointing to an HV).
148 */
149 return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
150 ? OPc_SVOP : OPc_PVOP;
151
152 case OA_LOOP:
153 return OPc_LOOP;
154
155 case OA_COP:
156 return OPc_COP;
157
158 case OA_BASEOP_OR_UNOP:
159 /*
160 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
161 * whether parens were seen. perly.y uses OPf_SPECIAL to
162 * signal whether a BASEOP had empty parens or none.
163 * Some other UNOPs are created later, though, so the best
164 * test is OPf_KIDS, which is set in newUNOP.
165 */
166 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
167
168 case OA_FILESTATOP:
169 /*
170 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
171 * the OPf_REF flag to distinguish between OP types instead of the
172 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
173 * return OPc_UNOP so that walkoptree can find our children. If
174 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
175 * (no argument to the operator) it's an OP; with OPf_REF set it's
176 * an SVOP (and op_sv is the GV for the filehandle argument).
177 */
178 return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
179 #ifdef USE_ITHREADS
180 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
181 #else
182 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
183 #endif
184 case OA_LOOPEXOP:
185 /*
186 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
187 * label was omitted (in which case it's a BASEOP) or else a term was
188 * seen. In this last case, all except goto are definitely PVOP but
189 * goto is either a PVOP (with an ordinary constant label), an UNOP
190 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
191 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
192 * get set.
193 */
194 if (o->op_flags & OPf_STACKED)
195 return OPc_UNOP;
196 else if (o->op_flags & OPf_SPECIAL)
197 return OPc_BASEOP;
198 else
199 return OPc_PVOP;
200 }
201 warn("can't determine class of operator %s, assuming BASEOP\n",
202 PL_op_name[o->op_type]);
203 return OPc_BASEOP;
204 }
205
206 static char *
cc_opclassname(pTHX_ OP * o)207 cc_opclassname(pTHX_ OP *o)
208 {
209 return opclassnames[cc_opclass(aTHX_ o)];
210 }
211
212 static SV *
make_sv_object(pTHX_ SV * arg,SV * sv)213 make_sv_object(pTHX_ SV *arg, SV *sv)
214 {
215 char *type = 0;
216 IV iv;
217 dMY_CXT;
218
219 for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
220 if (sv == specialsv_list[iv]) {
221 type = "B::SPECIAL";
222 break;
223 }
224 }
225 if (!type) {
226 type = svclassnames[SvTYPE(sv)];
227 iv = PTR2IV(sv);
228 }
229 sv_setiv(newSVrv(arg, type), iv);
230 return arg;
231 }
232
233 static SV *
make_mg_object(pTHX_ SV * arg,MAGIC * mg)234 make_mg_object(pTHX_ SV *arg, MAGIC *mg)
235 {
236 sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
237 return arg;
238 }
239
240 static SV *
cstring(pTHX_ SV * sv,bool perlstyle)241 cstring(pTHX_ SV *sv, bool perlstyle)
242 {
243 SV *sstr = newSVpvn("", 0);
244 STRLEN len;
245 char *s;
246 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
247
248 if (!SvOK(sv))
249 sv_setpvn(sstr, "0", 1);
250 else if (perlstyle && SvUTF8(sv))
251 {
252 SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
253 len = SvCUR(sv);
254 s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
255 sv_setpv(sstr,"\"");
256 while (*s)
257 {
258 if (*s == '"')
259 sv_catpv(sstr, "\\\"");
260 else if (*s == '$')
261 sv_catpv(sstr, "\\$");
262 else if (*s == '@')
263 sv_catpv(sstr, "\\@");
264 else if (*s == '\\')
265 {
266 if (strchr("nrftax\\",*(s+1)))
267 sv_catpvn(sstr, s++, 2);
268 else
269 sv_catpv(sstr, "\\\\");
270 }
271 else /* should always be printable */
272 sv_catpvn(sstr, s, 1);
273 ++s;
274 }
275 sv_catpv(sstr, "\"");
276 return sstr;
277 }
278 else
279 {
280 /* XXX Optimise? */
281 s = SvPV(sv, len);
282 sv_catpv(sstr, "\"");
283 for (; len; len--, s++)
284 {
285 /* At least try a little for readability */
286 if (*s == '"')
287 sv_catpv(sstr, "\\\"");
288 else if (*s == '\\')
289 sv_catpv(sstr, "\\\\");
290 /* trigraphs - bleagh */
291 else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?')
292 {
293 sprintf(escbuff, "\\%03o", '?');
294 sv_catpv(sstr, escbuff);
295 }
296 else if (perlstyle && *s == '$')
297 sv_catpv(sstr, "\\$");
298 else if (perlstyle && *s == '@')
299 sv_catpv(sstr, "\\@");
300 #ifdef EBCDIC
301 else if (isPRINT(*s))
302 #else
303 else if (*s >= ' ' && *s < 127)
304 #endif /* EBCDIC */
305 sv_catpvn(sstr, s, 1);
306 else if (*s == '\n')
307 sv_catpv(sstr, "\\n");
308 else if (*s == '\r')
309 sv_catpv(sstr, "\\r");
310 else if (*s == '\t')
311 sv_catpv(sstr, "\\t");
312 else if (*s == '\a')
313 sv_catpv(sstr, "\\a");
314 else if (*s == '\b')
315 sv_catpv(sstr, "\\b");
316 else if (*s == '\f')
317 sv_catpv(sstr, "\\f");
318 else if (!perlstyle && *s == '\v')
319 sv_catpv(sstr, "\\v");
320 else
321 {
322 /* Don't want promotion of a signed -1 char in sprintf args */
323 unsigned char c = (unsigned char) *s;
324 sprintf(escbuff, "\\%03o", c);
325 sv_catpv(sstr, escbuff);
326 }
327 /* XXX Add line breaks if string is long */
328 }
329 sv_catpv(sstr, "\"");
330 }
331 return sstr;
332 }
333
334 static SV *
cchar(pTHX_ SV * sv)335 cchar(pTHX_ SV *sv)
336 {
337 SV *sstr = newSVpvn("'", 1);
338 STRLEN n_a;
339 char *s = SvPV(sv, n_a);
340
341 if (*s == '\'')
342 sv_catpv(sstr, "\\'");
343 else if (*s == '\\')
344 sv_catpv(sstr, "\\\\");
345 #ifdef EBCDIC
346 else if (isPRINT(*s))
347 #else
348 else if (*s >= ' ' && *s < 127)
349 #endif /* EBCDIC */
350 sv_catpvn(sstr, s, 1);
351 else if (*s == '\n')
352 sv_catpv(sstr, "\\n");
353 else if (*s == '\r')
354 sv_catpv(sstr, "\\r");
355 else if (*s == '\t')
356 sv_catpv(sstr, "\\t");
357 else if (*s == '\a')
358 sv_catpv(sstr, "\\a");
359 else if (*s == '\b')
360 sv_catpv(sstr, "\\b");
361 else if (*s == '\f')
362 sv_catpv(sstr, "\\f");
363 else if (*s == '\v')
364 sv_catpv(sstr, "\\v");
365 else
366 {
367 /* no trigraph support */
368 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
369 /* Don't want promotion of a signed -1 char in sprintf args */
370 unsigned char c = (unsigned char) *s;
371 sprintf(escbuff, "\\%03o", c);
372 sv_catpv(sstr, escbuff);
373 }
374 sv_catpv(sstr, "'");
375 return sstr;
376 }
377
378 void
walkoptree(pTHX_ SV * opsv,char * method)379 walkoptree(pTHX_ SV *opsv, char *method)
380 {
381 dSP;
382 OP *o, *kid;
383 dMY_CXT;
384
385 if (!SvROK(opsv))
386 croak("opsv is not a reference");
387 opsv = sv_mortalcopy(opsv);
388 o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv)));
389 if (walkoptree_debug) {
390 PUSHMARK(sp);
391 XPUSHs(opsv);
392 PUTBACK;
393 perl_call_method("walkoptree_debug", G_DISCARD);
394 }
395 PUSHMARK(sp);
396 XPUSHs(opsv);
397 PUTBACK;
398 perl_call_method(method, G_DISCARD);
399 if (o && (o->op_flags & OPf_KIDS)) {
400 for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
401 /* Use the same opsv. Rely on methods not to mess it up. */
402 sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
403 walkoptree(aTHX_ opsv, method);
404 }
405 }
406 if (o && (cc_opclass(aTHX_ o) == OPc_PMOP)
407 && (kid = cPMOPo->op_pmreplroot))
408 {
409 sv_setiv(newSVrv(opsv, opclassnames[OPc_PMOP]), PTR2IV(kid));
410 walkoptree(aTHX_ opsv, method);
411 }
412 }
413
414 SV **
oplist(pTHX_ OP * o,SV ** SP)415 oplist(pTHX_ OP *o, SV **SP)
416 {
417 for(; o; o = o->op_next) {
418 SV *opsv;
419 if (o->op_seq == 0)
420 break;
421 o->op_seq = 0;
422 opsv = sv_newmortal();
423 sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
424 XPUSHs(opsv);
425 switch (o->op_type) {
426 case OP_SUBST:
427 SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
428 continue;
429 case OP_SORT:
430 if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
431 OP *kid = cLISTOPo->op_first->op_sibling; /* pass pushmark */
432 kid = kUNOP->op_first; /* pass rv2gv */
433 kid = kUNOP->op_first; /* pass leave */
434 SP = oplist(aTHX_ kid->op_next, SP);
435 }
436 continue;
437 }
438 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
439 case OA_LOGOP:
440 SP = oplist(aTHX_ cLOGOPo->op_other, SP);
441 break;
442 case OA_LOOP:
443 SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
444 SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
445 SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
446 break;
447 }
448 }
449 return SP;
450 }
451
452 typedef OP *B__OP;
453 typedef UNOP *B__UNOP;
454 typedef BINOP *B__BINOP;
455 typedef LOGOP *B__LOGOP;
456 typedef LISTOP *B__LISTOP;
457 typedef PMOP *B__PMOP;
458 typedef SVOP *B__SVOP;
459 typedef PADOP *B__PADOP;
460 typedef PVOP *B__PVOP;
461 typedef LOOP *B__LOOP;
462 typedef COP *B__COP;
463
464 typedef SV *B__SV;
465 typedef SV *B__IV;
466 typedef SV *B__PV;
467 typedef SV *B__NV;
468 typedef SV *B__PVMG;
469 typedef SV *B__PVLV;
470 typedef SV *B__BM;
471 typedef SV *B__RV;
472 typedef SV *B__FM;
473 typedef AV *B__AV;
474 typedef HV *B__HV;
475 typedef CV *B__CV;
476 typedef GV *B__GV;
477 typedef IO *B__IO;
478
479 typedef MAGIC *B__MAGIC;
480
481 MODULE = B PACKAGE = B PREFIX = B_
482
483 PROTOTYPES: DISABLE
484
485 BOOT:
486 {
487 HV *stash = gv_stashpvn("B", 1, TRUE);
488 AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
489 MY_CXT_INIT;
490 specialsv_list[0] = Nullsv;
491 specialsv_list[1] = &PL_sv_undef;
492 specialsv_list[2] = &PL_sv_yes;
493 specialsv_list[3] = &PL_sv_no;
494 specialsv_list[4] = pWARN_ALL;
495 specialsv_list[5] = pWARN_NONE;
496 specialsv_list[6] = pWARN_STD;
497 #include "defsubs.h"
498 }
499
500 #define B_main_cv() PL_main_cv
501 #define B_init_av() PL_initav
502 #define B_inc_gv() PL_incgv
503 #define B_check_av() PL_checkav_save
504 #define B_begin_av() PL_beginav_save
505 #define B_end_av() PL_endav
506 #define B_main_root() PL_main_root
507 #define B_main_start() PL_main_start
508 #define B_amagic_generation() PL_amagic_generation
509 #define B_defstash() PL_defstash
510 #define B_curstash() PL_curstash
511 #define B_dowarn() PL_dowarn
512 #define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
513 #define B_sv_undef() &PL_sv_undef
514 #define B_sv_yes() &PL_sv_yes
515 #define B_sv_no() &PL_sv_no
516 #define B_formfeed() PL_formfeed
517 #ifdef USE_ITHREADS
518 #define B_regex_padav() PL_regex_padav
519 #endif
520
521 B::AV
522 B_init_av()
523
524 B::AV
525 B_check_av()
526
527 B::AV
528 B_begin_av()
529
530 B::AV
531 B_end_av()
532
533 B::GV
534 B_inc_gv()
535
536 #ifdef USE_ITHREADS
537
538 B::AV
539 B_regex_padav()
540
541 #endif
542
543 B::CV
544 B_main_cv()
545
546 B::OP
547 B_main_root()
548
549 B::OP
550 B_main_start()
551
552 long
553 B_amagic_generation()
554
555 B::AV
556 B_comppadlist()
557
558 B::SV
559 B_sv_undef()
560
561 B::SV
562 B_sv_yes()
563
564 B::SV
565 B_sv_no()
566
567 B::HV
568 B_curstash()
569
570 B::HV
571 B_defstash()
572
573 U8
574 B_dowarn()
575
576 B::SV
577 B_formfeed()
578
579 void
580 B_warnhook()
581 CODE:
582 ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_warnhook);
583
584 void
585 B_diehook()
586 CODE:
587 ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_diehook);
588
589 MODULE = B PACKAGE = B
590
591 void
592 walkoptree(opsv, method)
593 SV * opsv
594 char * method
595 CODE:
596 walkoptree(aTHX_ opsv, method);
597
598 int
599 walkoptree_debug(...)
600 CODE:
601 dMY_CXT;
602 RETVAL = walkoptree_debug;
603 if (items > 0 && SvTRUE(ST(1)))
604 walkoptree_debug = 1;
605 OUTPUT:
606 RETVAL
607
608 #define address(sv) PTR2IV(sv)
609
610 IV
611 address(sv)
612 SV * sv
613
614 B::SV
615 svref_2object(sv)
616 SV * sv
617 CODE:
618 if (!SvROK(sv))
619 croak("argument is not a reference");
620 RETVAL = (SV*)SvRV(sv);
621 OUTPUT:
622 RETVAL
623
624 void
opnumber(name)625 opnumber(name)
626 char * name
627 CODE:
628 {
629 int i;
630 IV result = -1;
631 ST(0) = sv_newmortal();
632 if (strncmp(name,"pp_",3) == 0)
633 name += 3;
634 for (i = 0; i < PL_maxo; i++)
635 {
636 if (strcmp(name, PL_op_name[i]) == 0)
637 {
638 result = i;
639 break;
640 }
641 }
642 sv_setiv(ST(0),result);
643 }
644
645 void
646 ppname(opnum)
647 int opnum
648 CODE:
649 ST(0) = sv_newmortal();
650 if (opnum >= 0 && opnum < PL_maxo) {
651 sv_setpvn(ST(0), "pp_", 3);
652 sv_catpv(ST(0), PL_op_name[opnum]);
653 }
654
655 void
656 hash(sv)
657 SV * sv
658 CODE:
659 char *s;
660 STRLEN len;
661 U32 hash = 0;
662 char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */
663 s = SvPV(sv, len);
664 PERL_HASH(hash, s, len);
665 sprintf(hexhash, "0x%"UVxf, (UV)hash);
666 ST(0) = sv_2mortal(newSVpv(hexhash, 0));
667
668 #define cast_I32(foo) (I32)foo
669 IV
670 cast_I32(i)
671 IV i
672
673 void
674 minus_c()
675 CODE:
676 PL_minus_c = TRUE;
677
678 void
679 save_BEGINs()
680 CODE:
681 PL_savebegin = TRUE;
682
683 SV *
684 cstring(sv)
685 SV * sv
686 CODE:
687 RETVAL = cstring(aTHX_ sv, 0);
688 OUTPUT:
689 RETVAL
690
691 SV *
692 perlstring(sv)
693 SV * sv
694 CODE:
695 RETVAL = cstring(aTHX_ sv, 1);
696 OUTPUT:
697 RETVAL
698
699 SV *
700 cchar(sv)
701 SV * sv
702 CODE:
703 RETVAL = cchar(aTHX_ sv);
704 OUTPUT:
705 RETVAL
706
707 void
708 threadsv_names()
709 PPCODE:
710 #ifdef USE_5005THREADS
711 int i;
712 STRLEN len = strlen(PL_threadsv_names);
713
714 EXTEND(sp, len);
715 for (i = 0; i < len; i++)
716 PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
717 #endif
718
719
720 #define OP_next(o) o->op_next
721 #define OP_sibling(o) o->op_sibling
722 #define OP_desc(o) PL_op_desc[o->op_type]
723 #define OP_targ(o) o->op_targ
724 #define OP_type(o) o->op_type
725 #define OP_seq(o) o->op_seq
726 #define OP_flags(o) o->op_flags
727 #define OP_private(o) o->op_private
728
729 MODULE = B PACKAGE = B::OP PREFIX = OP_
730
731 size_t
732 OP_size(o)
733 B::OP o
734 CODE:
735 RETVAL = opsizes[cc_opclass(aTHX_ o)];
736 OUTPUT:
737 RETVAL
738
739 B::OP
740 OP_next(o)
741 B::OP o
742
743 B::OP
744 OP_sibling(o)
745 B::OP o
746
747 char *
748 OP_name(o)
749 B::OP o
750 CODE:
751 RETVAL = PL_op_name[o->op_type];
752 OUTPUT:
753 RETVAL
754
755
756 void
757 OP_ppaddr(o)
758 B::OP o
759 PREINIT:
760 int i;
761 SV *sv = sv_newmortal();
762 CODE:
763 sv_setpvn(sv, "PL_ppaddr[OP_", 13);
764 sv_catpv(sv, PL_op_name[o->op_type]);
765 for (i=13; (STRLEN)i < SvCUR(sv); ++i)
766 SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
767 sv_catpv(sv, "]");
768 ST(0) = sv;
769
770 char *
771 OP_desc(o)
772 B::OP o
773
774 PADOFFSET
775 OP_targ(o)
776 B::OP o
777
778 U16
779 OP_type(o)
780 B::OP o
781
782 U16
783 OP_seq(o)
784 B::OP o
785
786 U8
787 OP_flags(o)
788 B::OP o
789
790 U8
791 OP_private(o)
792 B::OP o
793
794 void
795 OP_oplist(o)
796 B::OP o
797 PPCODE:
798 SP = oplist(aTHX_ o, SP);
799
800 #define UNOP_first(o) o->op_first
801
802 MODULE = B PACKAGE = B::UNOP PREFIX = UNOP_
803
804 B::OP
805 UNOP_first(o)
806 B::UNOP o
807
808 #define BINOP_last(o) o->op_last
809
810 MODULE = B PACKAGE = B::BINOP PREFIX = BINOP_
811
812 B::OP
813 BINOP_last(o)
814 B::BINOP o
815
816 #define LOGOP_other(o) o->op_other
817
818 MODULE = B PACKAGE = B::LOGOP PREFIX = LOGOP_
819
820 B::OP
821 LOGOP_other(o)
822 B::LOGOP o
823
824 MODULE = B PACKAGE = B::LISTOP PREFIX = LISTOP_
825
826 U32
827 LISTOP_children(o)
828 B::LISTOP o
829 OP * kid = NO_INIT
830 int i = NO_INIT
831 CODE:
832 i = 0;
833 for (kid = o->op_first; kid; kid = kid->op_sibling)
834 i++;
835 RETVAL = i;
836 OUTPUT:
837 RETVAL
838
839 #define PMOP_pmreplroot(o) o->op_pmreplroot
840 #define PMOP_pmreplstart(o) o->op_pmreplstart
841 #define PMOP_pmnext(o) o->op_pmnext
842 #define PMOP_pmregexp(o) PM_GETRE(o)
843 #ifdef USE_ITHREADS
844 #define PMOP_pmoffset(o) o->op_pmoffset
845 #define PMOP_pmstashpv(o) o->op_pmstashpv
846 #else
847 #define PMOP_pmstash(o) o->op_pmstash
848 #endif
849 #define PMOP_pmflags(o) o->op_pmflags
850 #define PMOP_pmpermflags(o) o->op_pmpermflags
851 #define PMOP_pmdynflags(o) o->op_pmdynflags
852
853 MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
854
855 void
856 PMOP_pmreplroot(o)
857 B::PMOP o
858 OP * root = NO_INIT
859 CODE:
860 ST(0) = sv_newmortal();
861 root = o->op_pmreplroot;
862 /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
863 if (o->op_type == OP_PUSHRE) {
864 #ifdef USE_ITHREADS
865 sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
866 #else
867 sv_setiv(newSVrv(ST(0), root ?
868 svclassnames[SvTYPE((SV*)root)] : "B::SV"),
869 PTR2IV(root));
870 #endif
871 }
872 else {
873 sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
874 }
875
876 B::OP
877 PMOP_pmreplstart(o)
878 B::PMOP o
879
880 B::PMOP
881 PMOP_pmnext(o)
882 B::PMOP o
883
884 #ifdef USE_ITHREADS
885
886 IV
887 PMOP_pmoffset(o)
888 B::PMOP o
889
890 char*
891 PMOP_pmstashpv(o)
892 B::PMOP o
893
894 #else
895
896 B::HV
897 PMOP_pmstash(o)
898 B::PMOP o
899
900 #endif
901
902 U32
903 PMOP_pmflags(o)
904 B::PMOP o
905
906 U32
907 PMOP_pmpermflags(o)
908 B::PMOP o
909
910 U8
911 PMOP_pmdynflags(o)
912 B::PMOP o
913
914 void
915 PMOP_precomp(o)
916 B::PMOP o
917 REGEXP * rx = NO_INIT
918 CODE:
919 ST(0) = sv_newmortal();
920 rx = PM_GETRE(o);
921 if (rx)
922 sv_setpvn(ST(0), rx->precomp, rx->prelen);
923
924 #define SVOP_sv(o) cSVOPo->op_sv
925 #define SVOP_gv(o) ((GV*)cSVOPo->op_sv)
926
927 MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_
928
929 B::SV
930 SVOP_sv(o)
931 B::SVOP o
932
933 B::GV
934 SVOP_gv(o)
935 B::SVOP o
936
937 #define PADOP_padix(o) o->op_padix
938 #define PADOP_sv(o) (o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
939 #define PADOP_gv(o) ((o->op_padix \
940 && SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
941 ? (GV*)PAD_SVl(o->op_padix) : Nullgv)
942
943 MODULE = B PACKAGE = B::PADOP PREFIX = PADOP_
944
945 PADOFFSET
946 PADOP_padix(o)
947 B::PADOP o
948
949 B::SV
950 PADOP_sv(o)
951 B::PADOP o
952
953 B::GV
954 PADOP_gv(o)
955 B::PADOP o
956
957 MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_
958
959 void
960 PVOP_pv(o)
961 B::PVOP o
962 CODE:
963 /*
964 * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
965 * whereas other PVOPs point to a null terminated string.
966 */
967 if (o->op_type == OP_TRANS &&
968 (o->op_private & OPpTRANS_COMPLEMENT) &&
969 !(o->op_private & OPpTRANS_DELETE))
970 {
971 short* tbl = (short*)o->op_pv;
972 short entries = 257 + tbl[256];
973 ST(0) = sv_2mortal(newSVpv(o->op_pv, entries * sizeof(short)));
974 }
975 else if (o->op_type == OP_TRANS) {
976 ST(0) = sv_2mortal(newSVpv(o->op_pv, 256 * sizeof(short)));
977 }
978 else
979 ST(0) = sv_2mortal(newSVpv(o->op_pv, 0));
980
981 #define LOOP_redoop(o) o->op_redoop
982 #define LOOP_nextop(o) o->op_nextop
983 #define LOOP_lastop(o) o->op_lastop
984
985 MODULE = B PACKAGE = B::LOOP PREFIX = LOOP_
986
987
988 B::OP
989 LOOP_redoop(o)
990 B::LOOP o
991
992 B::OP
993 LOOP_nextop(o)
994 B::LOOP o
995
996 B::OP
997 LOOP_lastop(o)
998 B::LOOP o
999
1000 #define COP_label(o) o->cop_label
1001 #define COP_stashpv(o) CopSTASHPV(o)
1002 #define COP_stash(o) CopSTASH(o)
1003 #define COP_file(o) CopFILE(o)
1004 #define COP_filegv(o) CopFILEGV(o)
1005 #define COP_cop_seq(o) o->cop_seq
1006 #define COP_arybase(o) o->cop_arybase
1007 #define COP_line(o) CopLINE(o)
1008 #define COP_warnings(o) o->cop_warnings
1009 #define COP_io(o) o->cop_io
1010
1011 MODULE = B PACKAGE = B::COP PREFIX = COP_
1012
1013 char *
1014 COP_label(o)
1015 B::COP o
1016
1017 char *
1018 COP_stashpv(o)
1019 B::COP o
1020
1021 B::HV
1022 COP_stash(o)
1023 B::COP o
1024
1025 char *
1026 COP_file(o)
1027 B::COP o
1028
1029 B::GV
1030 COP_filegv(o)
1031 B::COP o
1032
1033
1034 U32
1035 COP_cop_seq(o)
1036 B::COP o
1037
1038 I32
1039 COP_arybase(o)
1040 B::COP o
1041
1042 U32
1043 COP_line(o)
1044 B::COP o
1045
1046 B::SV
1047 COP_warnings(o)
1048 B::COP o
1049
1050 B::SV
1051 COP_io(o)
1052 B::COP o
1053
1054 MODULE = B PACKAGE = B::SV
1055
1056 U32
1057 SvTYPE(sv)
1058 B::SV sv
1059
1060 #define object_2svref(sv) sv
1061 #define SVREF SV *
1062
1063 SVREF
1064 object_2svref(sv)
1065 B::SV sv
1066
1067 MODULE = B PACKAGE = B::SV PREFIX = Sv
1068
1069 U32
1070 SvREFCNT(sv)
1071 B::SV sv
1072
1073 U32
1074 SvFLAGS(sv)
1075 B::SV sv
1076
1077 U32
1078 SvPOK(sv)
1079 B::SV sv
1080
1081 U32
1082 SvROK(sv)
1083 B::SV sv
1084
1085 U32
1086 SvMAGICAL(sv)
1087 B::SV sv
1088
1089 MODULE = B PACKAGE = B::IV PREFIX = Sv
1090
1091 IV
1092 SvIV(sv)
1093 B::IV sv
1094
1095 IV
1096 SvIVX(sv)
1097 B::IV sv
1098
1099 UV
1100 SvUVX(sv)
1101 B::IV sv
1102
1103
1104 MODULE = B PACKAGE = B::IV
1105
1106 #define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
1107
1108 int
1109 needs64bits(sv)
1110 B::IV sv
1111
1112 void
1113 packiv(sv)
1114 B::IV sv
1115 CODE:
1116 if (sizeof(IV) == 8) {
1117 U32 wp[2];
1118 IV iv = SvIVX(sv);
1119 /*
1120 * The following way of spelling 32 is to stop compilers on
1121 * 32-bit architectures from moaning about the shift count
1122 * being >= the width of the type. Such architectures don't
1123 * reach this code anyway (unless sizeof(IV) > 8 but then
1124 * everything else breaks too so I'm not fussed at the moment).
1125 */
1126 #ifdef UV_IS_QUAD
1127 wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1128 #else
1129 wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1130 #endif
1131 wp[1] = htonl(iv & 0xffffffff);
1132 ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
1133 } else {
1134 U32 w = htonl((U32)SvIVX(sv));
1135 ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
1136 }
1137
1138 MODULE = B PACKAGE = B::NV PREFIX = Sv
1139
1140 NV
1141 SvNV(sv)
1142 B::NV sv
1143
1144 NV
1145 SvNVX(sv)
1146 B::NV sv
1147
1148 MODULE = B PACKAGE = B::RV PREFIX = Sv
1149
1150 B::SV
1151 SvRV(sv)
1152 B::RV sv
1153
1154 MODULE = B PACKAGE = B::PV PREFIX = Sv
1155
1156 char*
1157 SvPVX(sv)
1158 B::PV sv
1159
1160 B::SV
1161 SvRV(sv)
1162 B::PV sv
1163 CODE:
1164 if( SvROK(sv) ) {
1165 RETVAL = SvRV(sv);
1166 }
1167 else {
1168 croak( "argument is not SvROK" );
1169 }
1170 OUTPUT:
1171 RETVAL
1172
1173 void
1174 SvPV(sv)
1175 B::PV sv
1176 CODE:
1177 ST(0) = sv_newmortal();
1178 if( SvPOK(sv) ) {
1179 sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
1180 SvFLAGS(ST(0)) |= SvUTF8(sv);
1181 }
1182 else {
1183 /* XXX for backward compatibility, but should fail */
1184 /* croak( "argument is not SvPOK" ); */
1185 sv_setpvn(ST(0), NULL, 0);
1186 }
1187
1188 void
1189 SvPVBM(sv)
1190 B::PV sv
1191 CODE:
1192 ST(0) = sv_newmortal();
1193 sv_setpvn(ST(0), SvPVX(sv),
1194 SvCUR(sv) + (SvTYPE(sv) == SVt_PVBM ? 257 : 0));
1195
1196
1197 STRLEN
1198 SvLEN(sv)
1199 B::PV sv
1200
1201 STRLEN
1202 SvCUR(sv)
1203 B::PV sv
1204
1205 MODULE = B PACKAGE = B::PVMG PREFIX = Sv
1206
1207 void
1208 SvMAGIC(sv)
1209 B::PVMG sv
1210 MAGIC * mg = NO_INIT
1211 PPCODE:
1212 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
1213 XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
1214
1215 MODULE = B PACKAGE = B::PVMG
1216
1217 B::HV
1218 SvSTASH(sv)
1219 B::PVMG sv
1220
1221 #define MgMOREMAGIC(mg) mg->mg_moremagic
1222 #define MgPRIVATE(mg) mg->mg_private
1223 #define MgTYPE(mg) mg->mg_type
1224 #define MgFLAGS(mg) mg->mg_flags
1225 #define MgOBJ(mg) mg->mg_obj
1226 #define MgLENGTH(mg) mg->mg_len
1227 #define MgREGEX(mg) PTR2IV(mg->mg_obj)
1228
1229 MODULE = B PACKAGE = B::MAGIC PREFIX = Mg
1230
1231 B::MAGIC
1232 MgMOREMAGIC(mg)
1233 B::MAGIC mg
1234 CODE:
1235 if( MgMOREMAGIC(mg) ) {
1236 RETVAL = MgMOREMAGIC(mg);
1237 }
1238 else {
1239 XSRETURN_UNDEF;
1240 }
1241 OUTPUT:
1242 RETVAL
1243
1244 U16
1245 MgPRIVATE(mg)
1246 B::MAGIC mg
1247
1248 char
1249 MgTYPE(mg)
1250 B::MAGIC mg
1251
1252 U8
1253 MgFLAGS(mg)
1254 B::MAGIC mg
1255
1256 B::SV
1257 MgOBJ(mg)
1258 B::MAGIC mg
1259
1260 IV
1261 MgREGEX(mg)
1262 B::MAGIC mg
1263 CODE:
1264 if( mg->mg_type == 'r' ) {
1265 RETVAL = MgREGEX(mg);
1266 }
1267 else {
1268 croak( "REGEX is only meaningful on r-magic" );
1269 }
1270 OUTPUT:
1271 RETVAL
1272
1273 SV*
1274 precomp(mg)
1275 B::MAGIC mg
1276 CODE:
1277 if (mg->mg_type == 'r') {
1278 REGEXP* rx = (REGEXP*)mg->mg_obj;
1279 if( rx )
1280 RETVAL = newSVpvn( rx->precomp, rx->prelen );
1281 }
1282 else {
1283 croak( "precomp is only meaningful on r-magic" );
1284 }
1285 OUTPUT:
1286 RETVAL
1287
1288 I32
1289 MgLENGTH(mg)
1290 B::MAGIC mg
1291
1292 void
1293 MgPTR(mg)
1294 B::MAGIC mg
1295 CODE:
1296 ST(0) = sv_newmortal();
1297 if (mg->mg_ptr){
1298 if (mg->mg_len >= 0){
1299 sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
1300 } else if (mg->mg_len == HEf_SVKEY) {
1301 ST(0) = make_sv_object(aTHX_
1302 sv_newmortal(), (SV*)mg->mg_ptr);
1303 }
1304 }
1305
1306 MODULE = B PACKAGE = B::PVLV PREFIX = Lv
1307
1308 U32
1309 LvTARGOFF(sv)
1310 B::PVLV sv
1311
1312 U32
1313 LvTARGLEN(sv)
1314 B::PVLV sv
1315
1316 char
1317 LvTYPE(sv)
1318 B::PVLV sv
1319
1320 B::SV
1321 LvTARG(sv)
1322 B::PVLV sv
1323
1324 MODULE = B PACKAGE = B::BM PREFIX = Bm
1325
1326 I32
1327 BmUSEFUL(sv)
1328 B::BM sv
1329
1330 U16
1331 BmPREVIOUS(sv)
1332 B::BM sv
1333
1334 U8
1335 BmRARE(sv)
1336 B::BM sv
1337
1338 void
1339 BmTABLE(sv)
1340 B::BM sv
1341 STRLEN len = NO_INIT
1342 char * str = NO_INIT
1343 CODE:
1344 str = SvPV(sv, len);
1345 /* Boyer-Moore table is just after string and its safety-margin \0 */
1346 ST(0) = sv_2mortal(newSVpvn(str + len + 1, 256));
1347
1348 MODULE = B PACKAGE = B::GV PREFIX = Gv
1349
1350 void
1351 GvNAME(gv)
1352 B::GV gv
1353 CODE:
1354 ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
1355
1356 bool
1357 is_empty(gv)
1358 B::GV gv
1359 CODE:
1360 RETVAL = GvGP(gv) == Null(GP*);
1361 OUTPUT:
1362 RETVAL
1363
1364 void*
1365 GvGP(gv)
1366 B::GV gv
1367
1368 B::HV
1369 GvSTASH(gv)
1370 B::GV gv
1371
1372 B::SV
1373 GvSV(gv)
1374 B::GV gv
1375
1376 B::IO
1377 GvIO(gv)
1378 B::GV gv
1379
1380 B::FM
1381 GvFORM(gv)
1382 B::GV gv
1383 CODE:
1384 RETVAL = (SV*)GvFORM(gv);
1385 OUTPUT:
1386 RETVAL
1387
1388 B::AV
1389 GvAV(gv)
1390 B::GV gv
1391
1392 B::HV
1393 GvHV(gv)
1394 B::GV gv
1395
1396 B::GV
1397 GvEGV(gv)
1398 B::GV gv
1399
1400 B::CV
1401 GvCV(gv)
1402 B::GV gv
1403
1404 U32
1405 GvCVGEN(gv)
1406 B::GV gv
1407
1408 U32
1409 GvLINE(gv)
1410 B::GV gv
1411
1412 char *
1413 GvFILE(gv)
1414 B::GV gv
1415
1416 B::GV
1417 GvFILEGV(gv)
1418 B::GV gv
1419
1420 MODULE = B PACKAGE = B::GV
1421
1422 U32
1423 GvREFCNT(gv)
1424 B::GV gv
1425
1426 U8
1427 GvFLAGS(gv)
1428 B::GV gv
1429
1430 MODULE = B PACKAGE = B::IO PREFIX = Io
1431
1432 long
1433 IoLINES(io)
1434 B::IO io
1435
1436 long
1437 IoPAGE(io)
1438 B::IO io
1439
1440 long
1441 IoPAGE_LEN(io)
1442 B::IO io
1443
1444 long
1445 IoLINES_LEFT(io)
1446 B::IO io
1447
1448 char *
1449 IoTOP_NAME(io)
1450 B::IO io
1451
1452 B::GV
1453 IoTOP_GV(io)
1454 B::IO io
1455
1456 char *
1457 IoFMT_NAME(io)
1458 B::IO io
1459
1460 B::GV
1461 IoFMT_GV(io)
1462 B::IO io
1463
1464 char *
1465 IoBOTTOM_NAME(io)
1466 B::IO io
1467
1468 B::GV
1469 IoBOTTOM_GV(io)
1470 B::IO io
1471
1472 short
1473 IoSUBPROCESS(io)
1474 B::IO io
1475
1476 bool
1477 IsSTD(io,name)
1478 B::IO io
1479 char* name
1480 PREINIT:
1481 PerlIO* handle = 0;
1482 CODE:
1483 if( strEQ( name, "stdin" ) ) {
1484 handle = PerlIO_stdin();
1485 }
1486 else if( strEQ( name, "stdout" ) ) {
1487 handle = PerlIO_stdout();
1488 }
1489 else if( strEQ( name, "stderr" ) ) {
1490 handle = PerlIO_stderr();
1491 }
1492 else {
1493 croak( "Invalid value '%s'", name );
1494 }
1495 RETVAL = handle == IoIFP(io);
1496 OUTPUT:
1497 RETVAL
1498
1499 MODULE = B PACKAGE = B::IO
1500
1501 char
1502 IoTYPE(io)
1503 B::IO io
1504
1505 U8
1506 IoFLAGS(io)
1507 B::IO io
1508
1509 MODULE = B PACKAGE = B::AV PREFIX = Av
1510
1511 SSize_t
1512 AvFILL(av)
1513 B::AV av
1514
1515 SSize_t
1516 AvMAX(av)
1517 B::AV av
1518
1519 #define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1520
1521 IV
1522 AvOFF(av)
1523 B::AV av
1524
1525 void
1526 AvARRAY(av)
1527 B::AV av
1528 PPCODE:
1529 if (AvFILL(av) >= 0) {
1530 SV **svp = AvARRAY(av);
1531 I32 i;
1532 for (i = 0; i <= AvFILL(av); i++)
1533 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
1534 }
1535
1536 void
1537 AvARRAYelt(av, idx)
1538 B::AV av
1539 int idx
1540 PPCODE:
1541 if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
1542 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), (AvARRAY(av)[idx])));
1543 else
1544 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
1545
1546
1547 MODULE = B PACKAGE = B::AV
1548
1549 U8
1550 AvFLAGS(av)
1551 B::AV av
1552
1553 MODULE = B PACKAGE = B::FM PREFIX = Fm
1554
1555 IV
1556 FmLINES(form)
1557 B::FM form
1558
1559 MODULE = B PACKAGE = B::CV PREFIX = Cv
1560
1561 U32
1562 CvCONST(cv)
1563 B::CV cv
1564
1565 B::HV
1566 CvSTASH(cv)
1567 B::CV cv
1568
1569 B::OP
1570 CvSTART(cv)
1571 B::CV cv
1572
1573 B::OP
1574 CvROOT(cv)
1575 B::CV cv
1576
1577 B::GV
1578 CvGV(cv)
1579 B::CV cv
1580
1581 char *
1582 CvFILE(cv)
1583 B::CV cv
1584
1585 long
1586 CvDEPTH(cv)
1587 B::CV cv
1588
1589 B::AV
1590 CvPADLIST(cv)
1591 B::CV cv
1592
1593 B::CV
1594 CvOUTSIDE(cv)
1595 B::CV cv
1596
1597 U32
1598 CvOUTSIDE_SEQ(cv)
1599 B::CV cv
1600
1601 void
1602 CvXSUB(cv)
1603 B::CV cv
1604 CODE:
1605 ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv))));
1606
1607
1608 void
1609 CvXSUBANY(cv)
1610 B::CV cv
1611 CODE:
1612 ST(0) = CvCONST(cv) ?
1613 make_sv_object(aTHX_ sv_newmortal(),CvXSUBANY(cv).any_ptr) :
1614 sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
1615
1616 MODULE = B PACKAGE = B::CV
1617
1618 U16
1619 CvFLAGS(cv)
1620 B::CV cv
1621
1622 MODULE = B PACKAGE = B::CV PREFIX = cv_
1623
1624 B::SV
1625 cv_const_sv(cv)
1626 B::CV cv
1627
1628
1629 MODULE = B PACKAGE = B::HV PREFIX = Hv
1630
1631 STRLEN
1632 HvFILL(hv)
1633 B::HV hv
1634
1635 STRLEN
1636 HvMAX(hv)
1637 B::HV hv
1638
1639 I32
1640 HvKEYS(hv)
1641 B::HV hv
1642
1643 I32
1644 HvRITER(hv)
1645 B::HV hv
1646
1647 char *
1648 HvNAME(hv)
1649 B::HV hv
1650
1651 B::PMOP
1652 HvPMROOT(hv)
1653 B::HV hv
1654
1655 void
1656 HvARRAY(hv)
1657 B::HV hv
1658 PPCODE:
1659 if (HvKEYS(hv) > 0) {
1660 SV *sv;
1661 char *key;
1662 I32 len;
1663 (void)hv_iterinit(hv);
1664 EXTEND(sp, HvKEYS(hv) * 2);
1665 while ((sv = hv_iternextsv(hv, &key, &len))) {
1666 PUSHs(newSVpvn(key, len));
1667 PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
1668 }
1669 }
1670