This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Devel::PPPort 3.00.
[perl5.git] / ext / Devel / PPPort / PPPort.xs
CommitLineData
adfe19db
MHM
1/*******************************************************************************
2*
3* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
4*
5********************************************************************************
6*
7* Perl/Pollution/Portability
8*
9********************************************************************************
10*
11* $Revision: 7 $
12* $Author: mhx $
13* $Date: 2004/08/13 12:49:19 +0200 $
14*
15********************************************************************************
16*
17* Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz.
18* Version 2.x, Copyright (C) 2001, Paul Marquess.
19* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
20*
21* This program is free software; you can redistribute it and/or
22* modify it under the same terms as Perl itself.
23*
24*******************************************************************************/
25
26/* ========== BEGIN XSHEAD ================================================== */
27
28
29
30/* =========== END XSHEAD =================================================== */
0a7c7f4f
JH
31
32#include "EXTERN.h"
33#include "perl.h"
34#include "XSUB.h"
35
adfe19db
MHM
36/* ========== BEGIN XSINIT ================================================== */
37
38/* ---- from parts/inc/call ---- */
39#define NEED_eval_pv
40
41/* ---- from parts/inc/grok ---- */
42#define NEED_grok_number
43#define NEED_grok_numeric_radix
44#define NEED_grok_bin
45#define NEED_grok_hex
46#define NEED_grok_oct
47
48/* ---- from parts/inc/newCONSTSUB ---- */
0a7c7f4f 49#define NEED_newCONSTSUB
adfe19db
MHM
50
51/* ---- from parts/inc/newRV ---- */
52#define NEED_newRV_noinc
53
54/* ---- from parts/inc/SvPV ---- */
55#define NEED_sv_2pv_nolen
56#define NEED_sv_2pvbyte
57
58/* =========== END XSINIT =================================================== */
59
0a7c7f4f
JH
60#include "ppport.h"
61
adfe19db
MHM
62/* ========== BEGIN XSMISC ================================================== */
63
64/* ---- from parts/inc/MY_CXT ---- */
44284200 65#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
0a7c7f4f
JH
66
67typedef struct {
adfe19db
MHM
68 /* Put Global Data in here */
69 int dummy;
0a7c7f4f
JH
70} my_cxt_t;
71
72START_MY_CXT
73
adfe19db
MHM
74/* ---- from parts/inc/newCONSTSUB ---- */
75void call_newCONSTSUB_1(void)
0a7c7f4f 76{
adfe19db
MHM
77#ifdef PERL_NO_GET_CONTEXT
78 dTHX;
79#endif
44284200 80 newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
0a7c7f4f
JH
81}
82
adfe19db
MHM
83extern void call_newCONSTSUB_2(void);
84extern void call_newCONSTSUB_3(void);
85
86/* =========== END XSMISC =================================================== */
0a7c7f4f 87
44284200 88MODULE = Devel::PPPort PACKAGE = Devel::PPPort
0a7c7f4f
JH
89
90BOOT:
adfe19db
MHM
91 /* ---- from parts/inc/MY_CXT ---- */
92 {
93 MY_CXT_INIT;
94 /* If any of the fields in the my_cxt_t struct need
95 * to be initialised, do it here.
96 */
97 MY_CXT.dummy = 42;
98 }
99
100
101##----------------------------------------------------------------------
102## XSUBs from parts/inc/call
103##----------------------------------------------------------------------
104
105I32
106G_SCALAR()
107 CODE:
108 RETVAL = G_SCALAR;
109 OUTPUT:
110 RETVAL
111
112I32
113G_ARRAY()
114 CODE:
115 RETVAL = G_ARRAY;
116 OUTPUT:
117 RETVAL
118
119I32
120G_DISCARD()
121 CODE:
122 RETVAL = G_DISCARD;
123 OUTPUT:
124 RETVAL
125
126void
127eval_sv(sv, flags)
128 SV* sv
129 I32 flags
130 PREINIT:
131 I32 i;
132 PPCODE:
133 PUTBACK;
134 i = eval_sv(sv, flags);
135 SPAGAIN;
136 EXTEND(SP, 1);
137 PUSHs(sv_2mortal(newSViv(i)));
138
139void
140eval_pv(p, croak_on_error)
141 char* p
142 I32 croak_on_error
143 PPCODE:
144 PUTBACK;
145 EXTEND(SP, 1);
146 PUSHs(eval_pv(p, croak_on_error));
147
148void
149call_sv(sv, flags, ...)
150 SV* sv
151 I32 flags
152 PREINIT:
153 I32 i;
154 PPCODE:
155 for (i=0; i<items-2; i++)
156 ST(i) = ST(i+2); /* pop first two args */
157 PUSHMARK(SP);
158 SP += items - 2;
159 PUTBACK;
160 i = call_sv(sv, flags);
161 SPAGAIN;
162 EXTEND(SP, 1);
163 PUSHs(sv_2mortal(newSViv(i)));
164
0a7c7f4f 165void
adfe19db
MHM
166call_pv(subname, flags, ...)
167 char* subname
168 I32 flags
169 PREINIT:
170 I32 i;
171 PPCODE:
172 for (i=0; i<items-2; i++)
173 ST(i) = ST(i+2); /* pop first two args */
174 PUSHMARK(SP);
175 SP += items - 2;
176 PUTBACK;
177 i = call_pv(subname, flags);
178 SPAGAIN;
179 EXTEND(SP, 1);
180 PUSHs(sv_2mortal(newSViv(i)));
0a7c7f4f
JH
181
182void
adfe19db
MHM
183call_argv(subname, flags, ...)
184 char* subname
185 I32 flags
186 PREINIT:
187 I32 i;
188 char *args[8];
189 PPCODE:
190 if (items > 8) /* play safe */
191 XSRETURN_UNDEF;
192 for (i=2; i<items; i++)
193 args[i-2] = SvPV_nolen(ST(i));
194 args[items-2] = NULL;
195 PUTBACK;
196 i = call_argv(subname, flags, args);
197 SPAGAIN;
198 EXTEND(SP, 1);
199 PUSHs(sv_2mortal(newSViv(i)));
0a7c7f4f
JH
200
201void
adfe19db
MHM
202call_method(methname, flags, ...)
203 char* methname
204 I32 flags
205 PREINIT:
206 I32 i;
207 PPCODE:
208 for (i=0; i<items-2; i++)
209 ST(i) = ST(i+2); /* pop first two args */
210 PUSHMARK(SP);
211 SP += items - 2;
212 PUTBACK;
213 i = call_method(methname, flags);
214 SPAGAIN;
215 EXTEND(SP, 1);
216 PUSHs(sv_2mortal(newSViv(i)));
217
218##----------------------------------------------------------------------
219## XSUBs from parts/inc/cop
220##----------------------------------------------------------------------
221
222char *
223CopSTASHPV()
224 CODE:
225 RETVAL = CopSTASHPV(PL_curcop);
226 OUTPUT:
227 RETVAL
228
229char *
230CopFILE()
231 CODE:
232 RETVAL = CopFILE(PL_curcop);
233 OUTPUT:
234 RETVAL
235
236##----------------------------------------------------------------------
237## XSUBs from parts/inc/grok
238##----------------------------------------------------------------------
239
240UV
241grok_number(string)
242 SV *string
243 PREINIT:
244 const char *pv;
245 STRLEN len;
246 CODE:
247 pv = SvPV(string, len);
248 if (!grok_number(pv, len, &RETVAL))
249 XSRETURN_UNDEF;
250 OUTPUT:
251 RETVAL
252
253UV
254grok_bin(string)
255 SV *string
256 PREINIT:
257 char *pv;
258 I32 flags;
259 STRLEN len;
260 CODE:
261 pv = SvPV(string, len);
262 RETVAL = grok_bin(pv, &len, &flags, NULL);
263 OUTPUT:
264 RETVAL
265
266UV
267grok_hex(string)
268 SV *string
269 PREINIT:
270 char *pv;
271 I32 flags;
272 STRLEN len;
273 CODE:
274 pv = SvPV(string, len);
275 RETVAL = grok_hex(pv, &len, &flags, NULL);
276 OUTPUT:
277 RETVAL
278
279UV
280grok_oct(string)
281 SV *string
282 PREINIT:
283 char *pv;
284 I32 flags;
285 STRLEN len;
286 CODE:
287 pv = SvPV(string, len);
288 RETVAL = grok_oct(pv, &len, &flags, NULL);
289 OUTPUT:
290 RETVAL
291
292UV
293Perl_grok_number(string)
294 SV *string
295 PREINIT:
296 const char *pv;
297 STRLEN len;
298 CODE:
299 pv = SvPV(string, len);
300 if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
301 XSRETURN_UNDEF;
302 OUTPUT:
303 RETVAL
304
305UV
306Perl_grok_bin(string)
307 SV *string
308 PREINIT:
309 char *pv;
310 I32 flags;
311 STRLEN len;
312 CODE:
313 pv = SvPV(string, len);
314 RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
315 OUTPUT:
316 RETVAL
317
318UV
319Perl_grok_hex(string)
320 SV *string
321 PREINIT:
322 char *pv;
323 I32 flags;
324 STRLEN len;
325 CODE:
326 pv = SvPV(string, len);
327 RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
328 OUTPUT:
329 RETVAL
330
331UV
332Perl_grok_oct(string)
333 SV *string
334 PREINIT:
335 char *pv;
336 I32 flags;
337 STRLEN len;
338 CODE:
339 pv = SvPV(string, len);
340 RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
341 OUTPUT:
342 RETVAL
343
344##----------------------------------------------------------------------
345## XSUBs from parts/inc/limits
346##----------------------------------------------------------------------
347
348IV
349iv_size()
350 CODE:
351 RETVAL = IVSIZE == sizeof(IV);
352 OUTPUT:
353 RETVAL
354
355IV
356uv_size()
357 CODE:
358 RETVAL = UVSIZE == sizeof(UV);
359 OUTPUT:
360 RETVAL
361
362IV
363iv_type()
364 CODE:
365 RETVAL = sizeof(IVTYPE) == sizeof(IV);
366 OUTPUT:
367 RETVAL
368
369IV
370uv_type()
371 CODE:
372 RETVAL = sizeof(UVTYPE) == sizeof(UV);
373 OUTPUT:
374 RETVAL
375
376##----------------------------------------------------------------------
377## XSUBs from parts/inc/magic
378##----------------------------------------------------------------------
379
380void
381sv_catpv_mg(sv, string)
382 SV *sv;
383 char *string;
384 CODE:
385 sv_catpv_mg(sv, string);
386
387void
388sv_catpvn_mg(sv, sv2)
389 SV *sv;
390 SV *sv2;
391 PREINIT:
392 char *str;
393 STRLEN len;
394 CODE:
395 str = SvPV(sv2, len);
396 sv_catpvn_mg(sv, str, len);
397
398void
399sv_catsv_mg(sv, sv2)
400 SV *sv;
401 SV *sv2;
402 CODE:
403 sv_catsv_mg(sv, sv2);
404
405void
406sv_setiv_mg(sv, iv)
407 SV *sv;
408 IV iv;
409 CODE:
410 sv_setiv_mg(sv, iv);
411
412void
413sv_setnv_mg(sv, nv)
414 SV *sv;
415 NV nv;
416 CODE:
417 sv_setnv_mg(sv, nv);
418
419void
420sv_setpv_mg(sv, pv)
421 SV *sv;
422 char *pv;
423 CODE:
424 sv_setpv_mg(sv, pv);
425
426void
427sv_setpvn_mg(sv, sv2)
428 SV *sv;
429 SV *sv2;
430 PREINIT:
431 char *str;
432 STRLEN len;
433 CODE:
434 str = SvPV(sv2, len);
435 sv_setpvn_mg(sv, str, len);
436
437void
438sv_setsv_mg(sv, sv2)
439 SV *sv;
440 SV *sv2;
441 CODE:
442 sv_setsv_mg(sv, sv2);
443
444void
445sv_setuv_mg(sv, uv)
446 SV *sv;
447 UV uv;
448 CODE:
449 sv_setuv_mg(sv, uv);
450
451void
452sv_usepvn_mg(sv, sv2)
453 SV *sv;
454 SV *sv2;
455 PREINIT:
456 char *str, *copy;
457 STRLEN len;
458 CODE:
459 str = SvPV(sv2, len);
460 New(42, copy, len+1, char);
461 Copy(str, copy, len+1, char);
462 sv_usepvn_mg(sv, copy, len);
463
464##----------------------------------------------------------------------
465## XSUBs from parts/inc/misc
466##----------------------------------------------------------------------
0a7c7f4f
JH
467
468int
adfe19db
MHM
469gv_stashpvn(name, create)
470 char *name
471 I32 create
0a7c7f4f 472 CODE:
adfe19db 473 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
0a7c7f4f 474 OUTPUT:
adfe19db 475 RETVAL
0a7c7f4f
JH
476
477int
adfe19db
MHM
478get_sv(name, create)
479 char *name
480 I32 create
0a7c7f4f 481 CODE:
adfe19db
MHM
482 RETVAL = get_sv(name, create) != NULL;
483 OUTPUT:
484 RETVAL
485
486int
487get_av(name, create)
488 char *name
489 I32 create
490 CODE:
491 RETVAL = get_av(name, create) != NULL;
492 OUTPUT:
493 RETVAL
494
495int
496get_hv(name, create)
497 char *name
498 I32 create
499 CODE:
500 RETVAL = get_hv(name, create) != NULL;
501 OUTPUT:
502 RETVAL
503
504int
505get_cv(name, create)
506 char *name
507 I32 create
508 CODE:
509 RETVAL = get_cv(name, create) != NULL;
0a7c7f4f 510 OUTPUT:
adfe19db
MHM
511 RETVAL
512
513void
514newSVpvn()
515 PPCODE:
516 XPUSHs(newSVpvn("test", 4));
517 XPUSHs(newSVpvn("test", 2));
518 XPUSHs(newSVpvn("test", 0));
519 XPUSHs(newSVpvn(NULL, 2));
520 XPUSHs(newSVpvn(NULL, 0));
521 XSRETURN(5);
0a7c7f4f
JH
522
523SV *
adfe19db 524PL_sv_undef()
0a7c7f4f 525 CODE:
adfe19db 526 RETVAL = newSVsv(&PL_sv_undef);
0a7c7f4f 527 OUTPUT:
adfe19db 528 RETVAL
0a7c7f4f
JH
529
530SV *
adfe19db 531PL_sv_yes()
0a7c7f4f 532 CODE:
adfe19db 533 RETVAL = newSVsv(&PL_sv_yes);
0a7c7f4f 534 OUTPUT:
adfe19db 535 RETVAL
0a7c7f4f
JH
536
537SV *
adfe19db 538PL_sv_no()
0a7c7f4f 539 CODE:
adfe19db 540 RETVAL = newSVsv(&PL_sv_no);
0a7c7f4f 541 OUTPUT:
adfe19db 542 RETVAL
0a7c7f4f
JH
543
544int
adfe19db
MHM
545PL_na(string)
546 char *string
0a7c7f4f 547 CODE:
0a7c7f4f
JH
548 PL_na = strlen(string);
549 RETVAL = PL_na;
0a7c7f4f 550 OUTPUT:
adfe19db 551 RETVAL
0a7c7f4f
JH
552
553SV*
adfe19db 554boolSV(value)
0a7c7f4f
JH
555 int value
556 CODE:
adfe19db 557 RETVAL = newSVsv(boolSV(value));
0a7c7f4f 558 OUTPUT:
adfe19db 559 RETVAL
0a7c7f4f
JH
560
561SV*
adfe19db 562DEFSV()
0a7c7f4f 563 CODE:
0a7c7f4f 564 RETVAL = newSVsv(DEFSV);
0a7c7f4f 565 OUTPUT:
adfe19db 566 RETVAL
0a7c7f4f
JH
567
568int
adfe19db 569ERRSV()
0a7c7f4f 570 CODE:
0a7c7f4f 571 RETVAL = SvTRUE(ERRSV);
0a7c7f4f 572 OUTPUT:
adfe19db
MHM
573 RETVAL
574
575SV*
576UNDERBAR()
577 CODE:
578 {
579 dUNDERBAR;
580 RETVAL = newSVsv(UNDERBAR);
581 }
582 OUTPUT:
583 RETVAL
584
585##----------------------------------------------------------------------
586## XSUBs from parts/inc/mPUSH
587##----------------------------------------------------------------------
588
589void
590mPUSHp()
591 PPCODE:
592 EXTEND(SP, 3);
593 mPUSHp("one", 3);
594 mPUSHp("two", 3);
595 mPUSHp("three", 5);
596 XSRETURN(3);
597
598void
599mPUSHn()
600 PPCODE:
601 EXTEND(SP, 3);
602 mPUSHn(0.5);
603 mPUSHn(-0.25);
604 mPUSHn(0.125);
605 XSRETURN(3);
606
607void
608mPUSHi()
609 PPCODE:
610 EXTEND(SP, 3);
611 mPUSHi(-1);
612 mPUSHi(2);
613 mPUSHi(-3);
614 XSRETURN(3);
615
616void
617mPUSHu()
618 PPCODE:
619 EXTEND(SP, 3);
620 mPUSHu(1);
621 mPUSHu(2);
622 mPUSHu(3);
623 XSRETURN(3);
624
625void
626mXPUSHp()
627 PPCODE:
628 mXPUSHp("one", 3);
629 mXPUSHp("two", 3);
630 mXPUSHp("three", 5);
631 XSRETURN(3);
632
633void
634mXPUSHn()
635 PPCODE:
636 mXPUSHn(0.5);
637 mXPUSHn(-0.25);
638 mXPUSHn(0.125);
639 XSRETURN(3);
640
641void
642mXPUSHi()
643 PPCODE:
644 mXPUSHi(-1);
645 mXPUSHi(2);
646 mXPUSHi(-3);
647 XSRETURN(3);
648
649void
650mXPUSHu()
651 PPCODE:
652 mXPUSHu(1);
653 mXPUSHu(2);
654 mXPUSHu(3);
655 XSRETURN(3);
656
657##----------------------------------------------------------------------
658## XSUBs from parts/inc/MY_CXT
659##----------------------------------------------------------------------
0a7c7f4f
JH
660
661int
adfe19db 662MY_CXT_1()
0a7c7f4f 663 CODE:
0a7c7f4f 664 dMY_CXT;
adfe19db
MHM
665 RETVAL = MY_CXT.dummy == 42;
666 ++MY_CXT.dummy;
0a7c7f4f 667 OUTPUT:
adfe19db 668 RETVAL
0a7c7f4f
JH
669
670int
adfe19db 671MY_CXT_2()
0a7c7f4f 672 CODE:
0a7c7f4f 673 dMY_CXT;
adfe19db
MHM
674 RETVAL = MY_CXT.dummy == 43;
675 OUTPUT:
676 RETVAL
677
678##----------------------------------------------------------------------
679## XSUBs from parts/inc/newCONSTSUB
680##----------------------------------------------------------------------
681
682void
683call_newCONSTSUB_1()
684
685void
686call_newCONSTSUB_2()
687
688void
689call_newCONSTSUB_3()
690
691##----------------------------------------------------------------------
692## XSUBs from parts/inc/newRV
693##----------------------------------------------------------------------
694
695U32
696newRV_inc_REFCNT()
697 PREINIT:
698 SV *sv, *rv;
699 CODE:
700 sv = newSViv(42);
701 rv = newRV_inc(sv);
702 SvREFCNT_dec(sv);
703 RETVAL = SvREFCNT(sv);
704 sv_2mortal(rv);
0a7c7f4f 705 OUTPUT:
adfe19db 706 RETVAL
0a7c7f4f 707
adfe19db
MHM
708U32
709newRV_noinc_REFCNT()
710 PREINIT:
711 SV *sv, *rv;
712 CODE:
713 sv = newSViv(42);
714 rv = newRV_noinc(sv);
715 RETVAL = SvREFCNT(sv);
716 sv_2mortal(rv);
717 OUTPUT:
718 RETVAL
719
720##----------------------------------------------------------------------
721## XSUBs from parts/inc/SvPV
722##----------------------------------------------------------------------
723
724IV
725SvPVbyte(sv)
726 SV *sv
727 PREINIT:
728 STRLEN len;
729 const char *str;
730 CODE:
731 str = SvPVbyte(sv, len);
732 RETVAL = strEQ(str, "mhx") ? len : -1;
733 OUTPUT:
734 RETVAL
735
736IV
737SvPV_nolen(sv)
738 SV *sv
739 PREINIT:
740 const char *str;
741 CODE:
742 str = SvPV_nolen(sv);
743 RETVAL = strEQ(str, "mhx") ? 3 : 0;
744 OUTPUT:
745 RETVAL
746
747##----------------------------------------------------------------------
748## XSUBs from parts/inc/threads
749##----------------------------------------------------------------------
750
751IV
752no_THX_arg(sv)
753 SV *sv
754 CODE:
755 RETVAL = 1 + sv_2iv(sv);
756 OUTPUT:
757 RETVAL
758
759void
760with_THX_arg(error)
761 char *error
762 PPCODE:
763 Perl_croak(aTHX_ "%s", error);
764
765##----------------------------------------------------------------------
766## XSUBs from parts/inc/uv
767##----------------------------------------------------------------------
768
769SV *
770sv_setuv(uv)
771 UV uv
772 CODE:
773 RETVAL = newSViv(1);
774 sv_setuv(RETVAL, uv);
775 OUTPUT:
776 RETVAL
777
778SV *
779newSVuv(uv)
780 UV uv
781 CODE:
782 RETVAL = newSVuv(uv);
783 OUTPUT:
784 RETVAL
785
786UV
787sv_2uv(sv)
788 SV *sv
789 CODE:
790 RETVAL = sv_2uv(sv);
791 OUTPUT:
792 RETVAL
793
794UV
795SvUVx(sv)
796 SV *sv
797 CODE:
798 sv--;
799 RETVAL = SvUVx(++sv);
800 OUTPUT:
801 RETVAL
802
803void
804XSRETURN_UV()
805 PPCODE:
806 XSRETURN_UV(42);