1 #if 0
2 <<'SKIP';
3 #endif
4 /*
5 ----------------------------------------------------------------------
6 
7     ppport.h -- Perl/Pollution/Portability Version 3.20
8 
9     Automatically created by Devel::PPPort running under perl 5.016003.
10 
11     Version 3.x, Copyright (c) 2004-2010, Marcus Holland-Moritz.
12 
13     Version 2.x, Copyright (C) 2001, Paul Marquess.
14 
15     Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
16 
17     This program is free software; you can redistribute it and/or
18     modify it under the same terms as Perl itself.
19 
20 ----------------------------------------------------------------------
21 
22 SKIP
23 if (@ARGV && $ARGV[0] eq '--unstrip') {
24   eval { require Devel::PPPort };
25   $@ and die "Cannot require Devel::PPPort, please install.\n";
26   if (eval $Devel::PPPort::VERSION < 3.2) {
27     die "ppport.h was originally generated with Devel::PPPort 3.2.\n"
28       . "Your Devel::PPPort is only version $Devel::PPPort::VERSION.\n"
29       . "Please install a newer version, or --unstrip will not work.\n";
30   }
31   Devel::PPPort::WriteFile($0);
32   exit 0;
33 }
34 print <<END;
35 
36 Sorry, but this is a stripped version of $0.
37 
38 To be able to use its original script and doc functionality,
39 please try to regenerate this file using:
40 
41   $^X $0 --unstrip
42 
43 END
44 __DATA__*/
45 #ifndef _P_P_PORTABILITY_H_
46 #define _P_P_PORTABILITY_H_
47 #ifndef DPPP_NAMESPACE
48 #define DPPP_NAMESPACE DPPP_
49 #endif
50 #define DPPP_CAT2(x,y) CAT2(x,y)
51 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
52 #ifndef PERL_REVISION
53 #if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
54 #define PERL_PATCHLEVEL_H_IMPLICIT
55 #include <patchlevel.h>
56 #endif
57 #if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
58 #include <could_not_find_Perl_patchlevel.h>
59 #endif
60 #ifndef PERL_REVISION
61 #define PERL_REVISION (5)
62 #define PERL_VERSION PATCHLEVEL
63 #define PERL_SUBVERSION SUBVERSION
64 #endif
65 #endif
66 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
67 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
68 #if PERL_REVISION != 5
69 #error ppport.h only works with Perl version 5
70 #endif
71 #ifndef dTHR
72 #define dTHR dNOOP
73 #endif
74 #ifndef dTHX
75 #define dTHX dNOOP
76 #endif
77 #ifndef dTHXa
78 #define dTHXa(x) dNOOP
79 #endif
80 #ifndef pTHX
81 #define pTHX void
82 #endif
83 #ifndef pTHX_
84 #define pTHX_
85 #endif
86 #ifndef aTHX
87 #define aTHX
88 #endif
89 #ifndef aTHX_
90 #define aTHX_
91 #endif
92 #if (PERL_BCDVERSION < 0x5006000)
93 #ifdef USE_THREADS
94 #define aTHXR thr
95 #define aTHXR_ thr,
96 #else
97 #define aTHXR
98 #define aTHXR_
99 #endif
100 #define dTHXR dTHR
101 #else
102 #define aTHXR aTHX
103 #define aTHXR_ aTHX_
104 #define dTHXR dTHX
105 #endif
106 #ifndef dTHXoa
107 #define dTHXoa(x) dTHXa(x)
108 #endif
109 #ifdef I_LIMITS
110 #include <limits.h>
111 #endif
112 #ifndef PERL_UCHAR_MIN
113 #define PERL_UCHAR_MIN ((unsigned char)0)
114 #endif
115 #ifndef PERL_UCHAR_MAX
116 #ifdef UCHAR_MAX
117 #define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
118 #else
119 #ifdef MAXUCHAR
120 #define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
121 #else
122 #define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
123 #endif
124 #endif
125 #endif
126 #ifndef PERL_USHORT_MIN
127 #define PERL_USHORT_MIN ((unsigned short)0)
128 #endif
129 #ifndef PERL_USHORT_MAX
130 #ifdef USHORT_MAX
131 #define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
132 #else
133 #ifdef MAXUSHORT
134 #define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
135 #else
136 #ifdef USHRT_MAX
137 #define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
138 #else
139 #define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
140 #endif
141 #endif
142 #endif
143 #endif
144 #ifndef PERL_SHORT_MAX
145 #ifdef SHORT_MAX
146 #define PERL_SHORT_MAX ((short)SHORT_MAX)
147 #else
148 #ifdef MAXSHORT
149 #define PERL_SHORT_MAX ((short)MAXSHORT)
150 #else
151 #ifdef SHRT_MAX
152 #define PERL_SHORT_MAX ((short)SHRT_MAX)
153 #else
154 #define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
155 #endif
156 #endif
157 #endif
158 #endif
159 #ifndef PERL_SHORT_MIN
160 #ifdef SHORT_MIN
161 #define PERL_SHORT_MIN ((short)SHORT_MIN)
162 #else
163 #ifdef MINSHORT
164 #define PERL_SHORT_MIN ((short)MINSHORT)
165 #else
166 #ifdef SHRT_MIN
167 #define PERL_SHORT_MIN ((short)SHRT_MIN)
168 #else
169 #define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
170 #endif
171 #endif
172 #endif
173 #endif
174 #ifndef PERL_UINT_MAX
175 #ifdef UINT_MAX
176 #define PERL_UINT_MAX ((unsigned int)UINT_MAX)
177 #else
178 #ifdef MAXUINT
179 #define PERL_UINT_MAX ((unsigned int)MAXUINT)
180 #else
181 #define PERL_UINT_MAX (~(unsigned int)0)
182 #endif
183 #endif
184 #endif
185 #ifndef PERL_UINT_MIN
186 #define PERL_UINT_MIN ((unsigned int)0)
187 #endif
188 #ifndef PERL_INT_MAX
189 #ifdef INT_MAX
190 #define PERL_INT_MAX ((int)INT_MAX)
191 #else
192 #ifdef MAXINT
193 #define PERL_INT_MAX ((int)MAXINT)
194 #else
195 #define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
196 #endif
197 #endif
198 #endif
199 #ifndef PERL_INT_MIN
200 #ifdef INT_MIN
201 #define PERL_INT_MIN ((int)INT_MIN)
202 #else
203 #ifdef MININT
204 #define PERL_INT_MIN ((int)MININT)
205 #else
206 #define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
207 #endif
208 #endif
209 #endif
210 #ifndef PERL_ULONG_MAX
211 #ifdef ULONG_MAX
212 #define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
213 #else
214 #ifdef MAXULONG
215 #define PERL_ULONG_MAX ((unsigned long)MAXULONG)
216 #else
217 #define PERL_ULONG_MAX (~(unsigned long)0)
218 #endif
219 #endif
220 #endif
221 #ifndef PERL_ULONG_MIN
222 #define PERL_ULONG_MIN ((unsigned long)0L)
223 #endif
224 #ifndef PERL_LONG_MAX
225 #ifdef LONG_MAX
226 #define PERL_LONG_MAX ((long)LONG_MAX)
227 #else
228 #ifdef MAXLONG
229 #define PERL_LONG_MAX ((long)MAXLONG)
230 #else
231 #define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
232 #endif
233 #endif
234 #endif
235 #ifndef PERL_LONG_MIN
236 #ifdef LONG_MIN
237 #define PERL_LONG_MIN ((long)LONG_MIN)
238 #else
239 #ifdef MINLONG
240 #define PERL_LONG_MIN ((long)MINLONG)
241 #else
242 #define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
243 #endif
244 #endif
245 #endif
246 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
247 #ifndef PERL_UQUAD_MAX
248 #ifdef ULONGLONG_MAX
249 #define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
250 #else
251 #ifdef MAXULONGLONG
252 #define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
253 #else
254 #define PERL_UQUAD_MAX (~(unsigned long long)0)
255 #endif
256 #endif
257 #endif
258 #ifndef PERL_UQUAD_MIN
259 #define PERL_UQUAD_MIN ((unsigned long long)0L)
260 #endif
261 #ifndef PERL_QUAD_MAX
262 #ifdef LONGLONG_MAX
263 #define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
264 #else
265 #ifdef MAXLONGLONG
266 #define PERL_QUAD_MAX ((long long)MAXLONGLONG)
267 #else
268 #define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
269 #endif
270 #endif
271 #endif
272 #ifndef PERL_QUAD_MIN
273 #ifdef LONGLONG_MIN
274 #define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
275 #else
276 #ifdef MINLONGLONG
277 #define PERL_QUAD_MIN ((long long)MINLONGLONG)
278 #else
279 #define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
280 #endif
281 #endif
282 #endif
283 #endif
284 #ifdef HAS_QUAD
285 #ifdef cray
286 #ifndef IVTYPE
287 #define IVTYPE int
288 #endif
289 #ifndef IV_MIN
290 #define IV_MIN PERL_INT_MIN
291 #endif
292 #ifndef IV_MAX
293 #define IV_MAX PERL_INT_MAX
294 #endif
295 #ifndef UV_MIN
296 #define UV_MIN PERL_UINT_MIN
297 #endif
298 #ifndef UV_MAX
299 #define UV_MAX PERL_UINT_MAX
300 #endif
301 #ifdef INTSIZE
302 #ifndef IVSIZE
303 #define IVSIZE INTSIZE
304 #endif
305 #endif
306 #else
307 #if defined(convex) || defined(uts)
308 #ifndef IVTYPE
309 #define IVTYPE long long
310 #endif
311 #ifndef IV_MIN
312 #define IV_MIN PERL_QUAD_MIN
313 #endif
314 #ifndef IV_MAX
315 #define IV_MAX PERL_QUAD_MAX
316 #endif
317 #ifndef UV_MIN
318 #define UV_MIN PERL_UQUAD_MIN
319 #endif
320 #ifndef UV_MAX
321 #define UV_MAX PERL_UQUAD_MAX
322 #endif
323 #ifdef LONGLONGSIZE
324 #ifndef IVSIZE
325 #define IVSIZE LONGLONGSIZE
326 #endif
327 #endif
328 #else
329 #ifndef IVTYPE
330 #define IVTYPE long
331 #endif
332 #ifndef IV_MIN
333 #define IV_MIN PERL_LONG_MIN
334 #endif
335 #ifndef IV_MAX
336 #define IV_MAX PERL_LONG_MAX
337 #endif
338 #ifndef UV_MIN
339 #define UV_MIN PERL_ULONG_MIN
340 #endif
341 #ifndef UV_MAX
342 #define UV_MAX PERL_ULONG_MAX
343 #endif
344 #ifdef LONGSIZE
345 #ifndef IVSIZE
346 #define IVSIZE LONGSIZE
347 #endif
348 #endif
349 #endif
350 #endif
351 #ifndef IVSIZE
352 #define IVSIZE 8
353 #endif
354 #ifndef PERL_QUAD_MIN
355 #define PERL_QUAD_MIN IV_MIN
356 #endif
357 #ifndef PERL_QUAD_MAX
358 #define PERL_QUAD_MAX IV_MAX
359 #endif
360 #ifndef PERL_UQUAD_MIN
361 #define PERL_UQUAD_MIN UV_MIN
362 #endif
363 #ifndef PERL_UQUAD_MAX
364 #define PERL_UQUAD_MAX UV_MAX
365 #endif
366 #else
367 #ifndef IVTYPE
368 #define IVTYPE long
369 #endif
370 #ifndef IV_MIN
371 #define IV_MIN PERL_LONG_MIN
372 #endif
373 #ifndef IV_MAX
374 #define IV_MAX PERL_LONG_MAX
375 #endif
376 #ifndef UV_MIN
377 #define UV_MIN PERL_ULONG_MIN
378 #endif
379 #ifndef UV_MAX
380 #define UV_MAX PERL_ULONG_MAX
381 #endif
382 #endif
383 #ifndef IVSIZE
384 #ifdef LONGSIZE
385 #define IVSIZE LONGSIZE
386 #else
387 #define IVSIZE 4
388 #endif
389 #endif
390 #ifndef UVTYPE
391 #define UVTYPE unsigned IVTYPE
392 #endif
393 #ifndef UVSIZE
394 #define UVSIZE IVSIZE
395 #endif
396 #ifndef sv_setuv
397 #define sv_setuv(sv, uv) \
398 STMT_START { \
399 UV TeMpUv = uv; \
400 if (TeMpUv <= IV_MAX) \
401 sv_setiv(sv, TeMpUv); \
402 else \
403 sv_setnv(sv, (double)TeMpUv); \
404 } STMT_END
405 #endif
406 #ifndef newSVuv
407 #define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
408 #endif
409 #ifndef sv_2uv
410 #define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
411 #endif
412 #ifndef SvUVX
413 #define SvUVX(sv) ((UV)SvIVX(sv))
414 #endif
415 #ifndef SvUVXx
416 #define SvUVXx(sv) SvUVX(sv)
417 #endif
418 #ifndef SvUV
419 #define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
420 #endif
421 #ifndef SvUVx
422 #define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
423 #endif
424 #ifndef sv_uv
425 #define sv_uv(sv) SvUVx(sv)
426 #endif
427 #if !defined(SvUOK) && defined(SvIOK_UV)
428 #define SvUOK(sv) SvIOK_UV(sv)
429 #endif
430 #ifndef XST_mUV
431 #define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
432 #endif
433 #ifndef XSRETURN_UV
434 #define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
435 #endif
436 #ifndef PUSHu
437 #define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
438 #endif
439 #ifndef XPUSHu
440 #define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
441 #endif
442 #ifdef HAS_MEMCMP
443 #ifndef memNE
444 #define memNE(s1,s2,l) (memcmp(s1,s2,l))
445 #endif
446 #ifndef memEQ
447 #define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
448 #endif
449 #else
450 #ifndef memNE
451 #define memNE(s1,s2,l) (bcmp(s1,s2,l))
452 #endif
453 #ifndef memEQ
454 #define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
455 #endif
456 #endif
457 #ifndef memEQs
458 #define memEQs(s1, l, s2) \
459 (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
460 #endif
461 #ifndef memNEs
462 #define memNEs(s1, l, s2) !memEQs(s1, l, s2)
463 #endif
464 #ifndef MoveD
465 #define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
466 #endif
467 #ifndef CopyD
468 #define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
469 #endif
470 #ifdef HAS_MEMSET
471 #ifndef ZeroD
472 #define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
473 #endif
474 #else
475 #ifndef ZeroD
476 #define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
477 #endif
478 #endif
479 #ifndef PoisonWith
480 #define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
481 #endif
482 #ifndef PoisonNew
483 #define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
484 #endif
485 #ifndef PoisonFree
486 #define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
487 #endif
488 #ifndef Poison
489 #define Poison(d,n,t) PoisonFree(d,n,t)
490 #endif
491 #ifndef Newx
492 #define Newx(v,n,t) New(0,v,n,t)
493 #endif
494 #ifndef Newxc
495 #define Newxc(v,n,t,c) Newc(0,v,n,t,c)
496 #endif
497 #ifndef Newxz
498 #define Newxz(v,n,t) Newz(0,v,n,t)
499 #endif
500 #ifndef PERL_UNUSED_DECL
501 #ifdef HASATTRIBUTE
502 #if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
503 #define PERL_UNUSED_DECL
504 #else
505 #define PERL_UNUSED_DECL __attribute__((unused))
506 #endif
507 #else
508 #define PERL_UNUSED_DECL
509 #endif
510 #endif
511 #ifndef PERL_UNUSED_ARG
512 #if defined(lint) && defined(S_SPLINT_S)
513 #include <note.h>
514 #define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
515 #else
516 #define PERL_UNUSED_ARG(x) ((void)x)
517 #endif
518 #endif
519 #ifndef PERL_UNUSED_VAR
520 #define PERL_UNUSED_VAR(x) ((void)x)
521 #endif
522 #ifndef PERL_UNUSED_CONTEXT
523 #ifdef USE_ITHREADS
524 #define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
525 #else
526 #define PERL_UNUSED_CONTEXT
527 #endif
528 #endif
529 #ifndef NOOP
530 #define NOOP (void)0
531 #endif
532 #ifndef dNOOP
533 #define dNOOP extern int  Perl___notused PERL_UNUSED_DECL
534 #endif
535 #ifndef NVTYPE
536 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
537 #define NVTYPE long double
538 #else
539 #define NVTYPE double
540 #endif
541 typedef NVTYPE NV;
542 #endif
543 #ifndef INT2PTR
544 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
545 #define PTRV UV
546 #define INT2PTR(any,d) (any)(d)
547 #else
548 #if PTRSIZE == LONGSIZE
549 #define PTRV unsigned long
550 #else
551 #define PTRV unsigned
552 #endif
553 #define INT2PTR(any,d) (any)(PTRV)(d)
554 #endif
555 #endif
556 #ifndef PTR2ul
557 #if PTRSIZE == LONGSIZE
558 #define PTR2ul(p) (unsigned long)(p)
559 #else
560 #define PTR2ul(p) INT2PTR(unsigned long,p)
561 #endif
562 #endif
563 #ifndef PTR2nat
564 #define PTR2nat(p) (PTRV)(p)
565 #endif
566 #ifndef NUM2PTR
567 #define NUM2PTR(any,d) (any)PTR2nat(d)
568 #endif
569 #ifndef PTR2IV
570 #define PTR2IV(p) INT2PTR(IV,p)
571 #endif
572 #ifndef PTR2UV
573 #define PTR2UV(p) INT2PTR(UV,p)
574 #endif
575 #ifndef PTR2NV
576 #define PTR2NV(p) NUM2PTR(NV,p)
577 #endif
578 #undef START_EXTERN_C
579 #undef END_EXTERN_C
580 #undef EXTERN_C
581 #ifdef __cplusplus
582 #define START_EXTERN_C extern "C" {
583 #define END_EXTERN_C }
584 #define EXTERN_C extern "C"
585 #else
586 #define START_EXTERN_C
587 #define END_EXTERN_C
588 #define EXTERN_C extern
589 #endif
590 #if defined(PERL_GCC_PEDANTIC)
591 #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
592 #define PERL_GCC_BRACE_GROUPS_FORBIDDEN
593 #endif
594 #endif
595 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
596 #ifndef PERL_USE_GCC_BRACE_GROUPS
597 #define PERL_USE_GCC_BRACE_GROUPS
598 #endif
599 #endif
600 #undef STMT_START
601 #undef STMT_END
602 #ifdef PERL_USE_GCC_BRACE_GROUPS
603 #define STMT_START (void)(
604 #define STMT_END )
605 #else
606 #if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
607 #define STMT_START if (1)
608 #define STMT_END else (void)0
609 #else
610 #define STMT_START do
611 #define STMT_END while (0)
612 #endif
613 #endif
614 #ifndef boolSV
615 #define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
616 #endif
617 #ifndef DEFSV
618 #define DEFSV GvSV(PL_defgv)
619 #endif
620 #ifndef SAVE_DEFSV
621 #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
622 #endif
623 #ifndef DEFSV_set
624 #define DEFSV_set(sv) (DEFSV = (sv))
625 #endif
626 #ifndef AvFILLp
627 #define AvFILLp AvFILL
628 #endif
629 #ifndef ERRSV
630 #define ERRSV get_sv("@",FALSE)
631 #endif
632 #ifndef gv_stashpvn
633 #define gv_stashpvn(str,len,create) gv_stashpv(str,create)
634 #endif
635 #ifndef get_cv
636 #define get_cv perl_get_cv
637 #endif
638 #ifndef get_sv
639 #define get_sv perl_get_sv
640 #endif
641 #ifndef get_av
642 #define get_av perl_get_av
643 #endif
644 #ifndef get_hv
645 #define get_hv perl_get_hv
646 #endif
647 #ifndef dUNDERBAR
648 #define dUNDERBAR dNOOP
649 #endif
650 #ifndef UNDERBAR
651 #define UNDERBAR DEFSV
652 #endif
653 #ifndef dAX
654 #define dAX I32 ax = MARK - PL_stack_base + 1
655 #endif
656 #ifndef dITEMS
657 #define dITEMS I32 items = SP - MARK
658 #endif
659 #ifndef dXSTARG
660 #define dXSTARG SV * targ = sv_newmortal()
661 #endif
662 #ifndef dAXMARK
663 #define dAXMARK I32 ax = POPMARK; \
664 register SV ** const mark = PL_stack_base + ax++
665 #endif
666 #ifndef XSprePUSH
667 #define XSprePUSH (sp = PL_stack_base + ax - 1)
668 #endif
669 #if (PERL_BCDVERSION < 0x5005000)
670 #undef XSRETURN
671 #define XSRETURN(off) \
672 STMT_START { \
673 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
674 return; \
675 } STMT_END
676 #endif
677 #ifndef XSPROTO
678 #define XSPROTO(name) void name(pTHX_ CV* cv)
679 #endif
680 #ifndef SVfARG
681 #define SVfARG(p) ((void*)(p))
682 #endif
683 #ifndef PERL_ABS
684 #define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
685 #endif
686 #ifndef dVAR
687 #define dVAR dNOOP
688 #endif
689 #ifndef SVf
690 #define SVf "_"
691 #endif
692 #ifndef UTF8_MAXBYTES
693 #define UTF8_MAXBYTES UTF8_MAXLEN
694 #endif
695 #ifndef CPERLscope
696 #define CPERLscope(x) x
697 #endif
698 #ifndef PERL_HASH
699 #define PERL_HASH(hash,str,len) \
700 STMT_START { \
701 const char *s_PeRlHaSh = str; \
702 I32 i_PeRlHaSh = len; \
703 U32 hash_PeRlHaSh = 0; \
704 while (i_PeRlHaSh--) \
705 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
706 (hash) = hash_PeRlHaSh; \
707 } STMT_END
708 #endif
709 #ifndef PERLIO_FUNCS_DECL
710 #ifdef PERLIO_FUNCS_CONST
711 #define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
712 #define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
713 #else
714 #define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
715 #define PERLIO_FUNCS_CAST(funcs) (funcs)
716 #endif
717 #endif
718 #if (PERL_BCDVERSION < 0x5009003)
719 #ifdef ARGSproto
720 typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
721 #else
722 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
723 #endif
724 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
725 #endif
726 #ifndef isPSXSPC
727 #define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
728 #endif
729 #ifndef isBLANK
730 #define isBLANK(c) ((c) == ' ' || (c) == '\t')
731 #endif
732 #ifdef EBCDIC
733 #ifndef isALNUMC
734 #define isALNUMC(c) isalnum(c)
735 #endif
736 #ifndef isASCII
737 #define isASCII(c) isascii(c)
738 #endif
739 #ifndef isCNTRL
740 #define isCNTRL(c) iscntrl(c)
741 #endif
742 #ifndef isGRAPH
743 #define isGRAPH(c) isgraph(c)
744 #endif
745 #ifndef isPRINT
746 #define isPRINT(c) isprint(c)
747 #endif
748 #ifndef isPUNCT
749 #define isPUNCT(c) ispunct(c)
750 #endif
751 #ifndef isXDIGIT
752 #define isXDIGIT(c) isxdigit(c)
753 #endif
754 #else
755 #if (PERL_BCDVERSION < 0x5010000)
756 #undef isPRINT
757 #endif
758 #ifndef isALNUMC
759 #define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
760 #endif
761 #ifndef isASCII
762 #define isASCII(c) ((U8) (c) <= 127)
763 #endif
764 #ifndef isCNTRL
765 #define isCNTRL(c) ((U8) (c) < ' ' || (c) == 127)
766 #endif
767 #ifndef isGRAPH
768 #define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
769 #endif
770 #ifndef isPRINT
771 #define isPRINT(c) (((c) >= 32 && (c) < 127))
772 #endif
773 #ifndef isPUNCT
774 #define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
775 #endif
776 #ifndef isXDIGIT
777 #define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
778 #endif
779 #endif
780 #ifndef PERL_SIGNALS_UNSAFE_FLAG
781 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
782 #if (PERL_BCDVERSION < 0x5008000)
783 #define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
784 #else
785 #define D_PPP_PERL_SIGNALS_INIT 0
786 #endif
787 #if defined(NEED_PL_signals)
788 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
789 #elif defined(NEED_PL_signals_GLOBAL)
790 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
791 #else
792 extern U32 DPPP_(my_PL_signals);
793 #endif
794 #define PL_signals DPPP_(my_PL_signals)
795 #endif
796 #if (PERL_BCDVERSION <= 0x5005005)
797 #define PL_ppaddr ppaddr
798 #define PL_no_modify no_modify
799 #endif
800 #if (PERL_BCDVERSION <= 0x5004005)
801 #define PL_DBsignal DBsignal
802 #define PL_DBsingle DBsingle
803 #define PL_DBsub DBsub
804 #define PL_DBtrace DBtrace
805 #define PL_Sv Sv
806 #define PL_bufend bufend
807 #define PL_bufptr bufptr
808 #define PL_compiling compiling
809 #define PL_copline copline
810 #define PL_curcop curcop
811 #define PL_curstash curstash
812 #define PL_debstash debstash
813 #define PL_defgv defgv
814 #define PL_diehook diehook
815 #define PL_dirty dirty
816 #define PL_dowarn dowarn
817 #define PL_errgv errgv
818 #define PL_error_count error_count
819 #define PL_expect expect
820 #define PL_hexdigit hexdigit
821 #define PL_hints hints
822 #define PL_in_my in_my
823 #define PL_laststatval laststatval
824 #define PL_lex_state lex_state
825 #define PL_lex_stuff lex_stuff
826 #define PL_linestr linestr
827 #define PL_na na
828 #define PL_perl_destruct_level perl_destruct_level
829 #define PL_perldb perldb
830 #define PL_rsfp_filters rsfp_filters
831 #define PL_rsfp rsfp
832 #define PL_stack_base stack_base
833 #define PL_stack_sp stack_sp
834 #define PL_statcache statcache
835 #define PL_stdingv stdingv
836 #define PL_sv_arenaroot sv_arenaroot
837 #define PL_sv_no sv_no
838 #define PL_sv_undef sv_undef
839 #define PL_sv_yes sv_yes
840 #define PL_tainted tainted
841 #define PL_tainting tainting
842 #define PL_tokenbuf tokenbuf
843 #endif
844 #if (PERL_BCDVERSION >= 0x5009005)
845 #ifdef DPPP_PL_parser_NO_DUMMY
846 #define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
847 (croak("panic: PL_parser == NULL in %s:%d", \
848 __FILE__, __LINE__), (yy_parser *) NULL))->var)
849 #else
850 #ifdef DPPP_PL_parser_NO_DUMMY_WARNING
851 #define D_PPP_parser_dummy_warning(var)
852 #else
853 #define D_PPP_parser_dummy_warning(var) \
854 warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
855 #endif
856 #define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
857 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
858 #if defined(NEED_PL_parser)
859 static yy_parser DPPP_(dummy_PL_parser);
860 #elif defined(NEED_PL_parser_GLOBAL)
861 yy_parser DPPP_(dummy_PL_parser);
862 #else
863 extern yy_parser DPPP_(dummy_PL_parser);
864 #endif
865 #endif
866 #define PL_expect D_PPP_my_PL_parser_var(expect)
867 #define PL_copline D_PPP_my_PL_parser_var(copline)
868 #define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
869 #define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
870 #define PL_linestr D_PPP_my_PL_parser_var(linestr)
871 #define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
872 #define PL_bufend D_PPP_my_PL_parser_var(bufend)
873 #define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
874 #define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
875 #define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
876 #define PL_in_my D_PPP_my_PL_parser_var(in_my)
877 #define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
878 #define PL_error_count D_PPP_my_PL_parser_var(error_count)
879 #else
880 #define PL_parser ((void *) 1)
881 #endif
882 #ifndef mPUSHs
883 #define mPUSHs(s) PUSHs(sv_2mortal(s))
884 #endif
885 #ifndef PUSHmortal
886 #define PUSHmortal PUSHs(sv_newmortal())
887 #endif
888 #ifndef mPUSHp
889 #define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
890 #endif
891 #ifndef mPUSHn
892 #define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
893 #endif
894 #ifndef mPUSHi
895 #define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
896 #endif
897 #ifndef mPUSHu
898 #define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
899 #endif
900 #ifndef mXPUSHs
901 #define mXPUSHs(s) XPUSHs(sv_2mortal(s))
902 #endif
903 #ifndef XPUSHmortal
904 #define XPUSHmortal XPUSHs(sv_newmortal())
905 #endif
906 #ifndef mXPUSHp
907 #define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
908 #endif
909 #ifndef mXPUSHn
910 #define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
911 #endif
912 #ifndef mXPUSHi
913 #define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
914 #endif
915 #ifndef mXPUSHu
916 #define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
917 #endif
918 #ifndef call_sv
919 #define call_sv perl_call_sv
920 #endif
921 #ifndef call_pv
922 #define call_pv perl_call_pv
923 #endif
924 #ifndef call_argv
925 #define call_argv perl_call_argv
926 #endif
927 #ifndef call_method
928 #define call_method perl_call_method
929 #endif
930 #ifndef eval_sv
931 #define eval_sv perl_eval_sv
932 #endif
933 #ifndef PERL_LOADMOD_DENY
934 #define PERL_LOADMOD_DENY 0x1
935 #endif
936 #ifndef PERL_LOADMOD_NOIMPORT
937 #define PERL_LOADMOD_NOIMPORT 0x2
938 #endif
939 #ifndef PERL_LOADMOD_IMPORT_OPS
940 #define PERL_LOADMOD_IMPORT_OPS 0x4
941 #endif
942 #ifndef G_METHOD
943 #define G_METHOD 64
944 #ifdef call_sv
945 #undef call_sv
946 #endif
947 #if (PERL_BCDVERSION < 0x5006000)
948 #define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
949 (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
950 #else
951 #define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
952 (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
953 #endif
954 #endif
955 #ifndef eval_pv
956 #if defined(NEED_eval_pv)
957 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
958 static
959 #else
960 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
961 #endif
962 #ifdef eval_pv
963 #undef eval_pv
964 #endif
965 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
966 #define Perl_eval_pv DPPP_(my_eval_pv)
967 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
968 SV*
DPPP_(my_eval_pv)969 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
970 {
971 dSP;
972 SV* sv = newSVpv(p, 0);
973 PUSHMARK(sp);
974 eval_sv(sv, G_SCALAR);
975 SvREFCNT_dec(sv);
976 SPAGAIN;
977 sv = POPs;
978 PUTBACK;
979 if (croak_on_error && SvTRUE(GvSV(errgv)))
980 croak(SvPVx(GvSV(errgv), na));
981 return sv;
982 }
983 #endif
984 #endif
985 #ifndef vload_module
986 #if defined(NEED_vload_module)
987 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
988 static
989 #else
990 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
991 #endif
992 #ifdef vload_module
993 #undef vload_module
994 #endif
995 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
996 #define Perl_vload_module DPPP_(my_vload_module)
997 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
998 void
DPPP_(my_vload_module)999 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
1000 {
1001 dTHR;
1002 dVAR;
1003 OP *veop, *imop;
1004 OP * const modname = newSVOP(OP_CONST, 0, name);
1005 SvREADONLY_off(((SVOP*)modname)->op_sv);
1006 modname->op_private |= OPpCONST_BARE;
1007 if (ver) {
1008 veop = newSVOP(OP_CONST, 0, ver);
1009 }
1010 else
1011 veop = NULL;
1012 if (flags & PERL_LOADMOD_NOIMPORT) {
1013 imop = sawparens(newNULLLIST());
1014 }
1015 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
1016 imop = va_arg(*args, OP*);
1017 }
1018 else {
1019 SV *sv;
1020 imop = NULL;
1021 sv = va_arg(*args, SV*);
1022 while (sv) {
1023 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
1024 sv = va_arg(*args, SV*);
1025 }
1026 }
1027 {
1028 const line_t ocopline = PL_copline;
1029 COP * const ocurcop = PL_curcop;
1030 const int oexpect = PL_expect;
1031 #if (PERL_BCDVERSION >= 0x5004000)
1032 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
1033 veop, modname, imop);
1034 #else
1035 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
1036 modname, imop);
1037 #endif
1038 PL_expect = oexpect;
1039 PL_copline = ocopline;
1040 PL_curcop = ocurcop;
1041 }
1042 }
1043 #endif
1044 #endif
1045 #ifndef load_module
1046 #if defined(NEED_load_module)
1047 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
1048 static
1049 #else
1050 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
1051 #endif
1052 #ifdef load_module
1053 #undef load_module
1054 #endif
1055 #define load_module DPPP_(my_load_module)
1056 #define Perl_load_module DPPP_(my_load_module)
1057 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
1058 void
DPPP_(my_load_module)1059 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
1060 {
1061 va_list args;
1062 va_start(args, ver);
1063 vload_module(flags, name, ver, &args);
1064 va_end(args);
1065 }
1066 #endif
1067 #endif
1068 #ifndef newRV_inc
1069 #define newRV_inc(sv) newRV(sv)
1070 #endif
1071 #ifndef newRV_noinc
1072 #if defined(NEED_newRV_noinc)
1073 static SV * DPPP_(my_newRV_noinc)(SV *sv);
1074 static
1075 #else
1076 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
1077 #endif
1078 #ifdef newRV_noinc
1079 #undef newRV_noinc
1080 #endif
1081 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
1082 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
1083 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
1084 SV *
DPPP_(my_newRV_noinc)1085 DPPP_(my_newRV_noinc)(SV *sv)
1086 {
1087 SV *rv = (SV *)newRV(sv);
1088 SvREFCNT_dec(sv);
1089 return rv;
1090 }
1091 #endif
1092 #endif
1093 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
1094 #if defined(NEED_newCONSTSUB)
1095 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
1096 static
1097 #else
1098 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
1099 #endif
1100 #ifdef newCONSTSUB
1101 #undef newCONSTSUB
1102 #endif
1103 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
1104 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
1105 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
1106 #define D_PPP_PL_copline PL_copline
1107 void
DPPP_(my_newCONSTSUB)1108 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
1109 {
1110 U32 oldhints = PL_hints;
1111 HV *old_cop_stash = PL_curcop->cop_stash;
1112 HV *old_curstash = PL_curstash;
1113 line_t oldline = PL_curcop->cop_line;
1114 PL_curcop->cop_line = D_PPP_PL_copline;
1115 PL_hints &= ~HINT_BLOCK_SCOPE;
1116 if (stash)
1117 PL_curstash = PL_curcop->cop_stash = stash;
1118 newSUB(
1119 #if (PERL_BCDVERSION < 0x5003022)
1120 start_subparse(),
1121 #elif (PERL_BCDVERSION == 0x5003022)
1122 start_subparse(0),
1123 #else
1124 start_subparse(FALSE, 0),
1125 #endif
1126 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
1127 newSVOP(OP_CONST, 0, &PL_sv_no),
1128 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
1129 );
1130 PL_hints = oldhints;
1131 PL_curcop->cop_stash = old_cop_stash;
1132 PL_curstash = old_curstash;
1133 PL_curcop->cop_line = oldline;
1134 }
1135 #endif
1136 #endif
1137 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
1138 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
1139 #ifndef START_MY_CXT
1140 #define START_MY_CXT
1141 #if (PERL_BCDVERSION < 0x5004068)
1142 #define dMY_CXT_SV \
1143 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
1144 #else
1145 #define dMY_CXT_SV \
1146 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
1147 sizeof(MY_CXT_KEY)-1, TRUE)
1148 #endif
1149 #define dMY_CXT \
1150 dMY_CXT_SV; \
1151 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
1152 #define MY_CXT_INIT \
1153 dMY_CXT_SV; \
1154 \
1155 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
1156 Zero(my_cxtp, 1, my_cxt_t); \
1157 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
1158 #define MY_CXT (*my_cxtp)
1159 #define pMY_CXT my_cxt_t *my_cxtp
1160 #define pMY_CXT_ pMY_CXT,
1161 #define _pMY_CXT ,pMY_CXT
1162 #define aMY_CXT my_cxtp
1163 #define aMY_CXT_ aMY_CXT,
1164 #define _aMY_CXT ,aMY_CXT
1165 #endif
1166 #ifndef MY_CXT_CLONE
1167 #define MY_CXT_CLONE \
1168 dMY_CXT_SV; \
1169 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
1170 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
1171 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
1172 #endif
1173 #else
1174 #ifndef START_MY_CXT
1175 #define START_MY_CXT static my_cxt_t my_cxt;
1176 #define dMY_CXT_SV dNOOP
1177 #define dMY_CXT dNOOP
1178 #define MY_CXT_INIT NOOP
1179 #define MY_CXT my_cxt
1180 #define pMY_CXT void
1181 #define pMY_CXT_
1182 #define _pMY_CXT
1183 #define aMY_CXT
1184 #define aMY_CXT_
1185 #define _aMY_CXT
1186 #endif
1187 #ifndef MY_CXT_CLONE
1188 #define MY_CXT_CLONE NOOP
1189 #endif
1190 #endif
1191 #ifndef IVdf
1192 #if IVSIZE == LONGSIZE
1193 #define IVdf "ld"
1194 #define UVuf "lu"
1195 #define UVof "lo"
1196 #define UVxf "lx"
1197 #define UVXf "lX"
1198 #else
1199 #if IVSIZE == INTSIZE
1200 #define IVdf "d"
1201 #define UVuf "u"
1202 #define UVof "o"
1203 #define UVxf "x"
1204 #define UVXf "X"
1205 #endif
1206 #endif
1207 #endif
1208 #ifndef NVef
1209 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
1210 defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
1211 #define NVef PERL_PRIeldbl
1212 #define NVff PERL_PRIfldbl
1213 #define NVgf PERL_PRIgldbl
1214 #else
1215 #define NVef "e"
1216 #define NVff "f"
1217 #define NVgf "g"
1218 #endif
1219 #endif
1220 #ifndef SvREFCNT_inc
1221 #ifdef PERL_USE_GCC_BRACE_GROUPS
1222 #define SvREFCNT_inc(sv) \
1223 ({ \
1224 SV * const _sv = (SV*)(sv); \
1225 if (_sv) \
1226 (SvREFCNT(_sv))++; \
1227 _sv; \
1228 })
1229 #else
1230 #define SvREFCNT_inc(sv) \
1231 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
1232 #endif
1233 #endif
1234 #ifndef SvREFCNT_inc_simple
1235 #ifdef PERL_USE_GCC_BRACE_GROUPS
1236 #define SvREFCNT_inc_simple(sv) \
1237 ({ \
1238 if (sv) \
1239 (SvREFCNT(sv))++; \
1240 (SV *)(sv); \
1241 })
1242 #else
1243 #define SvREFCNT_inc_simple(sv) \
1244 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
1245 #endif
1246 #endif
1247 #ifndef SvREFCNT_inc_NN
1248 #ifdef PERL_USE_GCC_BRACE_GROUPS
1249 #define SvREFCNT_inc_NN(sv) \
1250 ({ \
1251 SV * const _sv = (SV*)(sv); \
1252 SvREFCNT(_sv)++; \
1253 _sv; \
1254 })
1255 #else
1256 #define SvREFCNT_inc_NN(sv) \
1257 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
1258 #endif
1259 #endif
1260 #ifndef SvREFCNT_inc_void
1261 #ifdef PERL_USE_GCC_BRACE_GROUPS
1262 #define SvREFCNT_inc_void(sv) \
1263 ({ \
1264 SV * const _sv = (SV*)(sv); \
1265 if (_sv) \
1266 (void)(SvREFCNT(_sv)++); \
1267 })
1268 #else
1269 #define SvREFCNT_inc_void(sv) \
1270 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
1271 #endif
1272 #endif
1273 #ifndef SvREFCNT_inc_simple_void
1274 #define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
1275 #endif
1276 #ifndef SvREFCNT_inc_simple_NN
1277 #define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
1278 #endif
1279 #ifndef SvREFCNT_inc_void_NN
1280 #define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
1281 #endif
1282 #ifndef SvREFCNT_inc_simple_void_NN
1283 #define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
1284 #endif
1285 #ifndef newSV_type
1286 #if defined(NEED_newSV_type)
1287 static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
1288 static
1289 #else
1290 extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
1291 #endif
1292 #ifdef newSV_type
1293 #undef newSV_type
1294 #endif
1295 #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
1296 #define Perl_newSV_type DPPP_(my_newSV_type)
1297 #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
1298 SV*
DPPP_(my_newSV_type)1299 DPPP_(my_newSV_type)(pTHX_ svtype const t)
1300 {
1301 SV* const sv = newSV(0);
1302 sv_upgrade(sv, t);
1303 return sv;
1304 }
1305 #endif
1306 #endif
1307 #if (PERL_BCDVERSION < 0x5006000)
1308 #define D_PPP_CONSTPV_ARG(x) ((char *) (x))
1309 #else
1310 #define D_PPP_CONSTPV_ARG(x) (x)
1311 #endif
1312 #ifndef newSVpvn
1313 #define newSVpvn(data,len) ((data) \
1314 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
1315 : newSV(0))
1316 #endif
1317 #ifndef newSVpvn_utf8
1318 #define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
1319 #endif
1320 #ifndef SVf_UTF8
1321 #define SVf_UTF8 0
1322 #endif
1323 #ifndef newSVpvn_flags
1324 #if defined(NEED_newSVpvn_flags)
1325 static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
1326 static
1327 #else
1328 extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
1329 #endif
1330 #ifdef newSVpvn_flags
1331 #undef newSVpvn_flags
1332 #endif
1333 #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
1334 #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
1335 #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
1336 SV *
DPPP_(my_newSVpvn_flags)1337 DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
1338 {
1339 SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
1340 SvFLAGS(sv) |= (flags & SVf_UTF8);
1341 return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
1342 }
1343 #endif
1344 #endif
1345 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
1346 #define NEED_sv_2pv_flags
1347 #endif
1348 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
1349 #define NEED_sv_2pv_flags_GLOBAL
1350 #endif
1351 #ifndef sv_2pv_nolen
1352 #define sv_2pv_nolen(sv) SvPV_nolen(sv)
1353 #endif
1354 #ifdef SvPVbyte
1355 #if (PERL_BCDVERSION < 0x5007000)
1356 #if defined(NEED_sv_2pvbyte)
1357 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
1358 static
1359 #else
1360 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
1361 #endif
1362 #ifdef sv_2pvbyte
1363 #undef sv_2pvbyte
1364 #endif
1365 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
1366 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
1367 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
1368 char *
DPPP_(my_sv_2pvbyte)1369 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
1370 {
1371 sv_utf8_downgrade(sv,0);
1372 return SvPV(sv,*lp);
1373 }
1374 #endif
1375 #undef SvPVbyte
1376 #define SvPVbyte(sv, lp) \
1377 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
1378 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
1379 #endif
1380 #else
1381 #define SvPVbyte SvPV
1382 #define sv_2pvbyte sv_2pv
1383 #endif
1384 #ifndef sv_2pvbyte_nolen
1385 #define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
1386 #endif
1387 #ifndef SV_IMMEDIATE_UNREF
1388 #define SV_IMMEDIATE_UNREF 0
1389 #endif
1390 #ifndef SV_GMAGIC
1391 #define SV_GMAGIC 0
1392 #endif
1393 #ifndef SV_COW_DROP_PV
1394 #define SV_COW_DROP_PV 0
1395 #endif
1396 #ifndef SV_UTF8_NO_ENCODING
1397 #define SV_UTF8_NO_ENCODING 0
1398 #endif
1399 #ifndef SV_NOSTEAL
1400 #define SV_NOSTEAL 0
1401 #endif
1402 #ifndef SV_CONST_RETURN
1403 #define SV_CONST_RETURN 0
1404 #endif
1405 #ifndef SV_MUTABLE_RETURN
1406 #define SV_MUTABLE_RETURN 0
1407 #endif
1408 #ifndef SV_SMAGIC
1409 #define SV_SMAGIC 0
1410 #endif
1411 #ifndef SV_HAS_TRAILING_NUL
1412 #define SV_HAS_TRAILING_NUL 0
1413 #endif
1414 #ifndef SV_COW_SHARED_HASH_KEYS
1415 #define SV_COW_SHARED_HASH_KEYS 0
1416 #endif
1417 #if (PERL_BCDVERSION < 0x5007002)
1418 #if defined(NEED_sv_2pv_flags)
1419 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
1420 static
1421 #else
1422 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
1423 #endif
1424 #ifdef sv_2pv_flags
1425 #undef sv_2pv_flags
1426 #endif
1427 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
1428 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
1429 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
1430 char *
DPPP_(my_sv_2pv_flags)1431 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
1432 {
1433 STRLEN n_a = (STRLEN) flags;
1434 return sv_2pv(sv, lp ? lp : &n_a);
1435 }
1436 #endif
1437 #if defined(NEED_sv_pvn_force_flags)
1438 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
1439 static
1440 #else
1441 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
1442 #endif
1443 #ifdef sv_pvn_force_flags
1444 #undef sv_pvn_force_flags
1445 #endif
1446 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
1447 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
1448 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
1449 char *
DPPP_(my_sv_pvn_force_flags)1450 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
1451 {
1452 STRLEN n_a = (STRLEN) flags;
1453 return sv_pvn_force(sv, lp ? lp : &n_a);
1454 }
1455 #endif
1456 #endif
1457 #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
1458 #define DPPP_SVPV_NOLEN_LP_ARG &PL_na
1459 #else
1460 #define DPPP_SVPV_NOLEN_LP_ARG 0
1461 #endif
1462 #ifndef SvPV_const
1463 #define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
1464 #endif
1465 #ifndef SvPV_mutable
1466 #define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
1467 #endif
1468 #ifndef SvPV_flags
1469 #define SvPV_flags(sv, lp, flags) \
1470 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1471 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
1472 #endif
1473 #ifndef SvPV_flags_const
1474 #define SvPV_flags_const(sv, lp, flags) \
1475 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1476 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
1477 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
1478 #endif
1479 #ifndef SvPV_flags_const_nolen
1480 #define SvPV_flags_const_nolen(sv, flags) \
1481 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1482 ? SvPVX_const(sv) : \
1483 (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
1484 #endif
1485 #ifndef SvPV_flags_mutable
1486 #define SvPV_flags_mutable(sv, lp, flags) \
1487 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1488 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
1489 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
1490 #endif
1491 #ifndef SvPV_force
1492 #define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
1493 #endif
1494 #ifndef SvPV_force_nolen
1495 #define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
1496 #endif
1497 #ifndef SvPV_force_mutable
1498 #define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
1499 #endif
1500 #ifndef SvPV_force_nomg
1501 #define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
1502 #endif
1503 #ifndef SvPV_force_nomg_nolen
1504 #define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
1505 #endif
1506 #ifndef SvPV_force_flags
1507 #define SvPV_force_flags(sv, lp, flags) \
1508 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
1509 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
1510 #endif
1511 #ifndef SvPV_force_flags_nolen
1512 #define SvPV_force_flags_nolen(sv, flags) \
1513 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
1514 ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
1515 #endif
1516 #ifndef SvPV_force_flags_mutable
1517 #define SvPV_force_flags_mutable(sv, lp, flags) \
1518 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
1519 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
1520 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
1521 #endif
1522 #ifndef SvPV_nolen
1523 #define SvPV_nolen(sv) \
1524 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1525 ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
1526 #endif
1527 #ifndef SvPV_nolen_const
1528 #define SvPV_nolen_const(sv) \
1529 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1530 ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
1531 #endif
1532 #ifndef SvPV_nomg
1533 #define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
1534 #endif
1535 #ifndef SvPV_nomg_const
1536 #define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
1537 #endif
1538 #ifndef SvPV_nomg_const_nolen
1539 #define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
1540 #endif
1541 #ifndef SvPV_renew
1542 #define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
1543 SvPV_set((sv), (char *) saferealloc( \
1544 (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
1545 } STMT_END
1546 #endif
1547 #ifndef SvMAGIC_set
1548 #define SvMAGIC_set(sv, val) \
1549 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
1550 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
1551 #endif
1552 #if (PERL_BCDVERSION < 0x5009003)
1553 #ifndef SvPVX_const
1554 #define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
1555 #endif
1556 #ifndef SvPVX_mutable
1557 #define SvPVX_mutable(sv) (0 + SvPVX(sv))
1558 #endif
1559 #ifndef SvRV_set
1560 #define SvRV_set(sv, val) \
1561 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
1562 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
1563 #endif
1564 #else
1565 #ifndef SvPVX_const
1566 #define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
1567 #endif
1568 #ifndef SvPVX_mutable
1569 #define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
1570 #endif
1571 #ifndef SvRV_set
1572 #define SvRV_set(sv, val) \
1573 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
1574 ((sv)->sv_u.svu_rv = (val)); } STMT_END
1575 #endif
1576 #endif
1577 #ifndef SvSTASH_set
1578 #define SvSTASH_set(sv, val) \
1579 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
1580 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
1581 #endif
1582 #if (PERL_BCDVERSION < 0x5004000)
1583 #ifndef SvUV_set
1584 #define SvUV_set(sv, val) \
1585 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
1586 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
1587 #endif
1588 #else
1589 #ifndef SvUV_set
1590 #define SvUV_set(sv, val) \
1591 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
1592 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
1593 #endif
1594 #endif
1595 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
1596 #if defined(NEED_vnewSVpvf)
1597 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
1598 static
1599 #else
1600 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
1601 #endif
1602 #ifdef vnewSVpvf
1603 #undef vnewSVpvf
1604 #endif
1605 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
1606 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
1607 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
1608 SV *
DPPP_(my_vnewSVpvf)1609 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
1610 {
1611 register SV *sv = newSV(0);
1612 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
1613 return sv;
1614 }
1615 #endif
1616 #endif
1617 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
1618 #define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
1619 #endif
1620 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
1621 #define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
1622 #endif
1623 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
1624 #if defined(NEED_sv_catpvf_mg)
1625 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
1626 static
1627 #else
1628 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
1629 #endif
1630 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
1631 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
1632 void
DPPP_(my_sv_catpvf_mg)1633 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
1634 {
1635 va_list args;
1636 va_start(args, pat);
1637 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
1638 SvSETMAGIC(sv);
1639 va_end(args);
1640 }
1641 #endif
1642 #endif
1643 #ifdef PERL_IMPLICIT_CONTEXT
1644 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
1645 #if defined(NEED_sv_catpvf_mg_nocontext)
1646 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
1647 static
1648 #else
1649 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
1650 #endif
1651 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
1652 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
1653 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
1654 void
DPPP_(my_sv_catpvf_mg_nocontext)1655 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
1656 {
1657 dTHX;
1658 va_list args;
1659 va_start(args, pat);
1660 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
1661 SvSETMAGIC(sv);
1662 va_end(args);
1663 }
1664 #endif
1665 #endif
1666 #endif
1667 #ifndef sv_catpvf_mg
1668 #ifdef PERL_IMPLICIT_CONTEXT
1669 #define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
1670 #else
1671 #define sv_catpvf_mg Perl_sv_catpvf_mg
1672 #endif
1673 #endif
1674 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
1675 #define sv_vcatpvf_mg(sv, pat, args) \
1676 STMT_START { \
1677 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
1678 SvSETMAGIC(sv); \
1679 } STMT_END
1680 #endif
1681 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
1682 #if defined(NEED_sv_setpvf_mg)
1683 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
1684 static
1685 #else
1686 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
1687 #endif
1688 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
1689 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
1690 void
DPPP_(my_sv_setpvf_mg)1691 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
1692 {
1693 va_list args;
1694 va_start(args, pat);
1695 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
1696 SvSETMAGIC(sv);
1697 va_end(args);
1698 }
1699 #endif
1700 #endif
1701 #ifdef PERL_IMPLICIT_CONTEXT
1702 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
1703 #if defined(NEED_sv_setpvf_mg_nocontext)
1704 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
1705 static
1706 #else
1707 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
1708 #endif
1709 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
1710 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
1711 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
1712 void
DPPP_(my_sv_setpvf_mg_nocontext)1713 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
1714 {
1715 dTHX;
1716 va_list args;
1717 va_start(args, pat);
1718 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
1719 SvSETMAGIC(sv);
1720 va_end(args);
1721 }
1722 #endif
1723 #endif
1724 #endif
1725 #ifndef sv_setpvf_mg
1726 #ifdef PERL_IMPLICIT_CONTEXT
1727 #define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
1728 #else
1729 #define sv_setpvf_mg Perl_sv_setpvf_mg
1730 #endif
1731 #endif
1732 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
1733 #define sv_vsetpvf_mg(sv, pat, args) \
1734 STMT_START { \
1735 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
1736 SvSETMAGIC(sv); \
1737 } STMT_END
1738 #endif
1739 #ifndef newSVpvn_share
1740 #if defined(NEED_newSVpvn_share)
1741 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
1742 static
1743 #else
1744 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
1745 #endif
1746 #ifdef newSVpvn_share
1747 #undef newSVpvn_share
1748 #endif
1749 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
1750 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
1751 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
1752 SV *
DPPP_(my_newSVpvn_share)1753 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
1754 {
1755 SV *sv;
1756 if (len < 0)
1757 len = -len;
1758 if (!hash)
1759 PERL_HASH(hash, (char*) src, len);
1760 sv = newSVpvn((char *) src, len);
1761 sv_upgrade(sv, SVt_PVIV);
1762 SvIVX(sv) = hash;
1763 SvREADONLY_on(sv);
1764 SvPOK_on(sv);
1765 return sv;
1766 }
1767 #endif
1768 #endif
1769 #ifndef SvSHARED_HASH
1770 #define SvSHARED_HASH(sv) (0 + SvUVX(sv))
1771 #endif
1772 #ifndef HvNAME_get
1773 #define HvNAME_get(hv) HvNAME(hv)
1774 #endif
1775 #ifndef HvNAMELEN_get
1776 #define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
1777 #endif
1778 #ifndef GvSVn
1779 #define GvSVn(gv) GvSV(gv)
1780 #endif
1781 #ifndef isGV_with_GP
1782 #define isGV_with_GP(gv) isGV(gv)
1783 #endif
1784 #ifndef gv_fetchpvn_flags
1785 #define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
1786 #endif
1787 #ifndef gv_fetchsv
1788 #define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
1789 #endif
1790 #ifndef get_cvn_flags
1791 #define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
1792 #endif
1793 #ifndef WARN_ALL
1794 #define WARN_ALL 0
1795 #endif
1796 #ifndef WARN_CLOSURE
1797 #define WARN_CLOSURE 1
1798 #endif
1799 #ifndef WARN_DEPRECATED
1800 #define WARN_DEPRECATED 2
1801 #endif
1802 #ifndef WARN_EXITING
1803 #define WARN_EXITING 3
1804 #endif
1805 #ifndef WARN_GLOB
1806 #define WARN_GLOB 4
1807 #endif
1808 #ifndef WARN_IO
1809 #define WARN_IO 5
1810 #endif
1811 #ifndef WARN_CLOSED
1812 #define WARN_CLOSED 6
1813 #endif
1814 #ifndef WARN_EXEC
1815 #define WARN_EXEC 7
1816 #endif
1817 #ifndef WARN_LAYER
1818 #define WARN_LAYER 8
1819 #endif
1820 #ifndef WARN_NEWLINE
1821 #define WARN_NEWLINE 9
1822 #endif
1823 #ifndef WARN_PIPE
1824 #define WARN_PIPE 10
1825 #endif
1826 #ifndef WARN_UNOPENED
1827 #define WARN_UNOPENED 11
1828 #endif
1829 #ifndef WARN_MISC
1830 #define WARN_MISC 12
1831 #endif
1832 #ifndef WARN_NUMERIC
1833 #define WARN_NUMERIC 13
1834 #endif
1835 #ifndef WARN_ONCE
1836 #define WARN_ONCE 14
1837 #endif
1838 #ifndef WARN_OVERFLOW
1839 #define WARN_OVERFLOW 15
1840 #endif
1841 #ifndef WARN_PACK
1842 #define WARN_PACK 16
1843 #endif
1844 #ifndef WARN_PORTABLE
1845 #define WARN_PORTABLE 17
1846 #endif
1847 #ifndef WARN_RECURSION
1848 #define WARN_RECURSION 18
1849 #endif
1850 #ifndef WARN_REDEFINE
1851 #define WARN_REDEFINE 19
1852 #endif
1853 #ifndef WARN_REGEXP
1854 #define WARN_REGEXP 20
1855 #endif
1856 #ifndef WARN_SEVERE
1857 #define WARN_SEVERE 21
1858 #endif
1859 #ifndef WARN_DEBUGGING
1860 #define WARN_DEBUGGING 22
1861 #endif
1862 #ifndef WARN_INPLACE
1863 #define WARN_INPLACE 23
1864 #endif
1865 #ifndef WARN_INTERNAL
1866 #define WARN_INTERNAL 24
1867 #endif
1868 #ifndef WARN_MALLOC
1869 #define WARN_MALLOC 25
1870 #endif
1871 #ifndef WARN_SIGNAL
1872 #define WARN_SIGNAL 26
1873 #endif
1874 #ifndef WARN_SUBSTR
1875 #define WARN_SUBSTR 27
1876 #endif
1877 #ifndef WARN_SYNTAX
1878 #define WARN_SYNTAX 28
1879 #endif
1880 #ifndef WARN_AMBIGUOUS
1881 #define WARN_AMBIGUOUS 29
1882 #endif
1883 #ifndef WARN_BAREWORD
1884 #define WARN_BAREWORD 30
1885 #endif
1886 #ifndef WARN_DIGIT
1887 #define WARN_DIGIT 31
1888 #endif
1889 #ifndef WARN_PARENTHESIS
1890 #define WARN_PARENTHESIS 32
1891 #endif
1892 #ifndef WARN_PRECEDENCE
1893 #define WARN_PRECEDENCE 33
1894 #endif
1895 #ifndef WARN_PRINTF
1896 #define WARN_PRINTF 34
1897 #endif
1898 #ifndef WARN_PROTOTYPE
1899 #define WARN_PROTOTYPE 35
1900 #endif
1901 #ifndef WARN_QW
1902 #define WARN_QW 36
1903 #endif
1904 #ifndef WARN_RESERVED
1905 #define WARN_RESERVED 37
1906 #endif
1907 #ifndef WARN_SEMICOLON
1908 #define WARN_SEMICOLON 38
1909 #endif
1910 #ifndef WARN_TAINT
1911 #define WARN_TAINT 39
1912 #endif
1913 #ifndef WARN_THREADS
1914 #define WARN_THREADS 40
1915 #endif
1916 #ifndef WARN_UNINITIALIZED
1917 #define WARN_UNINITIALIZED 41
1918 #endif
1919 #ifndef WARN_UNPACK
1920 #define WARN_UNPACK 42
1921 #endif
1922 #ifndef WARN_UNTIE
1923 #define WARN_UNTIE 43
1924 #endif
1925 #ifndef WARN_UTF8
1926 #define WARN_UTF8 44
1927 #endif
1928 #ifndef WARN_VOID
1929 #define WARN_VOID 45
1930 #endif
1931 #ifndef WARN_ASSERTIONS
1932 #define WARN_ASSERTIONS 46
1933 #endif
1934 #ifndef packWARN
1935 #define packWARN(a) (a)
1936 #endif
1937 #ifndef ckWARN
1938 #ifdef G_WARN_ON
1939 #define ckWARN(a) (PL_dowarn & G_WARN_ON)
1940 #else
1941 #define ckWARN(a) PL_dowarn
1942 #endif
1943 #endif
1944 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
1945 #if defined(NEED_warner)
1946 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
1947 static
1948 #else
1949 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
1950 #endif
1951 #define Perl_warner DPPP_(my_warner)
1952 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
1953 void
DPPP_(my_warner)1954 DPPP_(my_warner)(U32 err, const char *pat, ...)
1955 {
1956 SV *sv;
1957 va_list args;
1958 PERL_UNUSED_ARG(err);
1959 va_start(args, pat);
1960 sv = vnewSVpvf(pat, &args);
1961 va_end(args);
1962 sv_2mortal(sv);
1963 warn("%s", SvPV_nolen(sv));
1964 }
1965 #define warner Perl_warner
1966 #define Perl_warner_nocontext Perl_warner
1967 #endif
1968 #endif
1969 #ifndef STR_WITH_LEN
1970 #define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
1971 #endif
1972 #ifndef newSVpvs
1973 #define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
1974 #endif
1975 #ifndef newSVpvs_flags
1976 #define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
1977 #endif
1978 #ifndef newSVpvs_share
1979 #define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
1980 #endif
1981 #ifndef sv_catpvs
1982 #define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
1983 #endif
1984 #ifndef sv_setpvs
1985 #define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
1986 #endif
1987 #ifndef hv_fetchs
1988 #define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
1989 #endif
1990 #ifndef hv_stores
1991 #define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
1992 #endif
1993 #ifndef gv_fetchpvs
1994 #define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
1995 #endif
1996 #ifndef gv_stashpvs
1997 #define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
1998 #endif
1999 #ifndef get_cvs
2000 #define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
2001 #endif
2002 #ifndef SvGETMAGIC
2003 #define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
2004 #endif
2005 #ifndef PERL_MAGIC_sv
2006 #define PERL_MAGIC_sv '\0'
2007 #endif
2008 #ifndef PERL_MAGIC_overload
2009 #define PERL_MAGIC_overload 'A'
2010 #endif
2011 #ifndef PERL_MAGIC_overload_elem
2012 #define PERL_MAGIC_overload_elem 'a'
2013 #endif
2014 #ifndef PERL_MAGIC_overload_table
2015 #define PERL_MAGIC_overload_table 'c'
2016 #endif
2017 #ifndef PERL_MAGIC_bm
2018 #define PERL_MAGIC_bm 'B'
2019 #endif
2020 #ifndef PERL_MAGIC_regdata
2021 #define PERL_MAGIC_regdata 'D'
2022 #endif
2023 #ifndef PERL_MAGIC_regdatum
2024 #define PERL_MAGIC_regdatum 'd'
2025 #endif
2026 #ifndef PERL_MAGIC_env
2027 #define PERL_MAGIC_env 'E'
2028 #endif
2029 #ifndef PERL_MAGIC_envelem
2030 #define PERL_MAGIC_envelem 'e'
2031 #endif
2032 #ifndef PERL_MAGIC_fm
2033 #define PERL_MAGIC_fm 'f'
2034 #endif
2035 #ifndef PERL_MAGIC_regex_global
2036 #define PERL_MAGIC_regex_global 'g'
2037 #endif
2038 #ifndef PERL_MAGIC_isa
2039 #define PERL_MAGIC_isa 'I'
2040 #endif
2041 #ifndef PERL_MAGIC_isaelem
2042 #define PERL_MAGIC_isaelem 'i'
2043 #endif
2044 #ifndef PERL_MAGIC_nkeys
2045 #define PERL_MAGIC_nkeys 'k'
2046 #endif
2047 #ifndef PERL_MAGIC_dbfile
2048 #define PERL_MAGIC_dbfile 'L'
2049 #endif
2050 #ifndef PERL_MAGIC_dbline
2051 #define PERL_MAGIC_dbline 'l'
2052 #endif
2053 #ifndef PERL_MAGIC_mutex
2054 #define PERL_MAGIC_mutex 'm'
2055 #endif
2056 #ifndef PERL_MAGIC_shared
2057 #define PERL_MAGIC_shared 'N'
2058 #endif
2059 #ifndef PERL_MAGIC_shared_scalar
2060 #define PERL_MAGIC_shared_scalar 'n'
2061 #endif
2062 #ifndef PERL_MAGIC_collxfrm
2063 #define PERL_MAGIC_collxfrm 'o'
2064 #endif
2065 #ifndef PERL_MAGIC_tied
2066 #define PERL_MAGIC_tied 'P'
2067 #endif
2068 #ifndef PERL_MAGIC_tiedelem
2069 #define PERL_MAGIC_tiedelem 'p'
2070 #endif
2071 #ifndef PERL_MAGIC_tiedscalar
2072 #define PERL_MAGIC_tiedscalar 'q'
2073 #endif
2074 #ifndef PERL_MAGIC_qr
2075 #define PERL_MAGIC_qr 'r'
2076 #endif
2077 #ifndef PERL_MAGIC_sig
2078 #define PERL_MAGIC_sig 'S'
2079 #endif
2080 #ifndef PERL_MAGIC_sigelem
2081 #define PERL_MAGIC_sigelem 's'
2082 #endif
2083 #ifndef PERL_MAGIC_taint
2084 #define PERL_MAGIC_taint 't'
2085 #endif
2086 #ifndef PERL_MAGIC_uvar
2087 #define PERL_MAGIC_uvar 'U'
2088 #endif
2089 #ifndef PERL_MAGIC_uvar_elem
2090 #define PERL_MAGIC_uvar_elem 'u'
2091 #endif
2092 #ifndef PERL_MAGIC_vstring
2093 #define PERL_MAGIC_vstring 'V'
2094 #endif
2095 #ifndef PERL_MAGIC_vec
2096 #define PERL_MAGIC_vec 'v'
2097 #endif
2098 #ifndef PERL_MAGIC_utf8
2099 #define PERL_MAGIC_utf8 'w'
2100 #endif
2101 #ifndef PERL_MAGIC_substr
2102 #define PERL_MAGIC_substr 'x'
2103 #endif
2104 #ifndef PERL_MAGIC_defelem
2105 #define PERL_MAGIC_defelem 'y'
2106 #endif
2107 #ifndef PERL_MAGIC_glob
2108 #define PERL_MAGIC_glob '*'
2109 #endif
2110 #ifndef PERL_MAGIC_arylen
2111 #define PERL_MAGIC_arylen '#'
2112 #endif
2113 #ifndef PERL_MAGIC_pos
2114 #define PERL_MAGIC_pos '.'
2115 #endif
2116 #ifndef PERL_MAGIC_backref
2117 #define PERL_MAGIC_backref '<'
2118 #endif
2119 #ifndef PERL_MAGIC_ext
2120 #define PERL_MAGIC_ext '~'
2121 #endif
2122 #ifndef sv_catpvn_nomg
2123 #define sv_catpvn_nomg sv_catpvn
2124 #endif
2125 #ifndef sv_catsv_nomg
2126 #define sv_catsv_nomg sv_catsv
2127 #endif
2128 #ifndef sv_setsv_nomg
2129 #define sv_setsv_nomg sv_setsv
2130 #endif
2131 #ifndef sv_pvn_nomg
2132 #define sv_pvn_nomg sv_pvn
2133 #endif
2134 #ifndef SvIV_nomg
2135 #define SvIV_nomg SvIV
2136 #endif
2137 #ifndef SvUV_nomg
2138 #define SvUV_nomg SvUV
2139 #endif
2140 #ifndef sv_catpv_mg
2141 #define sv_catpv_mg(sv, ptr) \
2142 STMT_START { \
2143 SV *TeMpSv = sv; \
2144 sv_catpv(TeMpSv,ptr); \
2145 SvSETMAGIC(TeMpSv); \
2146 } STMT_END
2147 #endif
2148 #ifndef sv_catpvn_mg
2149 #define sv_catpvn_mg(sv, ptr, len) \
2150 STMT_START { \
2151 SV *TeMpSv = sv; \
2152 sv_catpvn(TeMpSv,ptr,len); \
2153 SvSETMAGIC(TeMpSv); \
2154 } STMT_END
2155 #endif
2156 #ifndef sv_catsv_mg
2157 #define sv_catsv_mg(dsv, ssv) \
2158 STMT_START { \
2159 SV *TeMpSv = dsv; \
2160 sv_catsv(TeMpSv,ssv); \
2161 SvSETMAGIC(TeMpSv); \
2162 } STMT_END
2163 #endif
2164 #ifndef sv_setiv_mg
2165 #define sv_setiv_mg(sv, i) \
2166 STMT_START { \
2167 SV *TeMpSv = sv; \
2168 sv_setiv(TeMpSv,i); \
2169 SvSETMAGIC(TeMpSv); \
2170 } STMT_END
2171 #endif
2172 #ifndef sv_setnv_mg
2173 #define sv_setnv_mg(sv, num) \
2174 STMT_START { \
2175 SV *TeMpSv = sv; \
2176 sv_setnv(TeMpSv,num); \
2177 SvSETMAGIC(TeMpSv); \
2178 } STMT_END
2179 #endif
2180 #ifndef sv_setpv_mg
2181 #define sv_setpv_mg(sv, ptr) \
2182 STMT_START { \
2183 SV *TeMpSv = sv; \
2184 sv_setpv(TeMpSv,ptr); \
2185 SvSETMAGIC(TeMpSv); \
2186 } STMT_END
2187 #endif
2188 #ifndef sv_setpvn_mg
2189 #define sv_setpvn_mg(sv, ptr, len) \
2190 STMT_START { \
2191 SV *TeMpSv = sv; \
2192 sv_setpvn(TeMpSv,ptr,len); \
2193 SvSETMAGIC(TeMpSv); \
2194 } STMT_END
2195 #endif
2196 #ifndef sv_setsv_mg
2197 #define sv_setsv_mg(dsv, ssv) \
2198 STMT_START { \
2199 SV *TeMpSv = dsv; \
2200 sv_setsv(TeMpSv,ssv); \
2201 SvSETMAGIC(TeMpSv); \
2202 } STMT_END
2203 #endif
2204 #ifndef sv_setuv_mg
2205 #define sv_setuv_mg(sv, i) \
2206 STMT_START { \
2207 SV *TeMpSv = sv; \
2208 sv_setuv(TeMpSv,i); \
2209 SvSETMAGIC(TeMpSv); \
2210 } STMT_END
2211 #endif
2212 #ifndef sv_usepvn_mg
2213 #define sv_usepvn_mg(sv, ptr, len) \
2214 STMT_START { \
2215 SV *TeMpSv = sv; \
2216 sv_usepvn(TeMpSv,ptr,len); \
2217 SvSETMAGIC(TeMpSv); \
2218 } STMT_END
2219 #endif
2220 #ifndef SvVSTRING_mg
2221 #define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
2222 #endif
2223 #if (PERL_BCDVERSION < 0x5004000)
2224 #elif (PERL_BCDVERSION < 0x5008000)
2225 #define sv_magic_portable(sv, obj, how, name, namlen) \
2226 STMT_START { \
2227 SV *SvMp_sv = (sv); \
2228 char *SvMp_name = (char *) (name); \
2229 I32 SvMp_namlen = (namlen); \
2230 if (SvMp_name && SvMp_namlen == 0) \
2231 { \
2232 MAGIC *mg; \
2233 sv_magic(SvMp_sv, obj, how, 0, 0); \
2234 mg = SvMAGIC(SvMp_sv); \
2235 mg->mg_len = -42;  \
2236 mg->mg_ptr = SvMp_name; \
2237 } \
2238 else \
2239 { \
2240 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
2241 } \
2242 } STMT_END
2243 #else
2244 #define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
2245 #endif
2246 #ifdef USE_ITHREADS
2247 #ifndef CopFILE
2248 #define CopFILE(c) ((c)->cop_file)
2249 #endif
2250 #ifndef CopFILEGV
2251 #define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
2252 #endif
2253 #ifndef CopFILE_set
2254 #define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
2255 #endif
2256 #ifndef CopFILESV
2257 #define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
2258 #endif
2259 #ifndef CopFILEAV
2260 #define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
2261 #endif
2262 #ifndef CopSTASHPV
2263 #define CopSTASHPV(c) ((c)->cop_stashpv)
2264 #endif
2265 #ifndef CopSTASHPV_set
2266 #define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
2267 #endif
2268 #ifndef CopSTASH
2269 #define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
2270 #endif
2271 #ifndef CopSTASH_set
2272 #define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
2273 #endif
2274 #ifndef CopSTASH_eq
2275 #define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
2276 || (CopSTASHPV(c) && HvNAME(hv) \
2277 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
2278 #endif
2279 #else
2280 #ifndef CopFILEGV
2281 #define CopFILEGV(c) ((c)->cop_filegv)
2282 #endif
2283 #ifndef CopFILEGV_set
2284 #define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
2285 #endif
2286 #ifndef CopFILE_set
2287 #define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
2288 #endif
2289 #ifndef CopFILESV
2290 #define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
2291 #endif
2292 #ifndef CopFILEAV
2293 #define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
2294 #endif
2295 #ifndef CopFILE
2296 #define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
2297 #endif
2298 #ifndef CopSTASH
2299 #define CopSTASH(c) ((c)->cop_stash)
2300 #endif
2301 #ifndef CopSTASH_set
2302 #define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
2303 #endif
2304 #ifndef CopSTASHPV
2305 #define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
2306 #endif
2307 #ifndef CopSTASHPV_set
2308 #define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
2309 #endif
2310 #ifndef CopSTASH_eq
2311 #define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
2312 #endif
2313 #endif
2314 #ifndef IN_PERL_COMPILETIME
2315 #define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
2316 #endif
2317 #ifndef IN_LOCALE_RUNTIME
2318 #define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
2319 #endif
2320 #ifndef IN_LOCALE_COMPILETIME
2321 #define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
2322 #endif
2323 #ifndef IN_LOCALE
2324 #define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
2325 #endif
2326 #ifndef IS_NUMBER_IN_UV
2327 #define IS_NUMBER_IN_UV 0x01
2328 #endif
2329 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
2330 #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
2331 #endif
2332 #ifndef IS_NUMBER_NOT_INT
2333 #define IS_NUMBER_NOT_INT 0x04
2334 #endif
2335 #ifndef IS_NUMBER_NEG
2336 #define IS_NUMBER_NEG 0x08
2337 #endif
2338 #ifndef IS_NUMBER_INFINITY
2339 #define IS_NUMBER_INFINITY 0x10
2340 #endif
2341 #ifndef IS_NUMBER_NAN
2342 #define IS_NUMBER_NAN 0x20
2343 #endif
2344 #ifndef GROK_NUMERIC_RADIX
2345 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
2346 #endif
2347 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
2348 #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
2349 #endif
2350 #ifndef PERL_SCAN_SILENT_ILLDIGIT
2351 #define PERL_SCAN_SILENT_ILLDIGIT 0x04
2352 #endif
2353 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
2354 #define PERL_SCAN_ALLOW_UNDERSCORES 0x01
2355 #endif
2356 #ifndef PERL_SCAN_DISALLOW_PREFIX
2357 #define PERL_SCAN_DISALLOW_PREFIX 0x02
2358 #endif
2359 #ifndef grok_numeric_radix
2360 #if defined(NEED_grok_numeric_radix)
2361 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
2362 static
2363 #else
2364 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
2365 #endif
2366 #ifdef grok_numeric_radix
2367 #undef grok_numeric_radix
2368 #endif
2369 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
2370 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
2371 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
2372 bool
DPPP_(my_grok_numeric_radix)2373 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
2374 {
2375 #ifdef USE_LOCALE_NUMERIC
2376 #ifdef PL_numeric_radix_sv
2377 if (PL_numeric_radix_sv && IN_LOCALE) {
2378 STRLEN len;
2379 char* radix = SvPV(PL_numeric_radix_sv, len);
2380 if (*sp + len <= send && memEQ(*sp, radix, len)) {
2381 *sp += len;
2382 return TRUE;
2383 }
2384 }
2385 #else
2386 #include <locale.h>
2387 dTHR;
2388 struct lconv *lc = localeconv();
2389 char *radix = lc->decimal_point;
2390 if (radix && IN_LOCALE) {
2391 STRLEN len = strlen(radix);
2392 if (*sp + len <= send && memEQ(*sp, radix, len)) {
2393 *sp += len;
2394 return TRUE;
2395 }
2396 }
2397 #endif
2398 #endif
2399 if (*sp < send && **sp == '.') {
2400 ++*sp;
2401 return TRUE;
2402 }
2403 return FALSE;
2404 }
2405 #endif
2406 #endif
2407 #ifndef grok_number
2408 #if defined(NEED_grok_number)
2409 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
2410 static
2411 #else
2412 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
2413 #endif
2414 #ifdef grok_number
2415 #undef grok_number
2416 #endif
2417 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
2418 #define Perl_grok_number DPPP_(my_grok_number)
2419 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
2420 int
DPPP_(my_grok_number)2421 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
2422 {
2423 const char *s = pv;
2424 const char *send = pv + len;
2425 const UV max_div_10 = UV_MAX / 10;
2426 const char max_mod_10 = UV_MAX % 10;
2427 int numtype = 0;
2428 int sawinf = 0;
2429 int sawnan = 0;
2430 while (s < send && isSPACE(*s))
2431 s++;
2432 if (s == send) {
2433 return 0;
2434 } else if (*s == '-') {
2435 s++;
2436 numtype = IS_NUMBER_NEG;
2437 }
2438 else if (*s == '+')
2439 s++;
2440 if (s == send)
2441 return 0;
2442 if (isDIGIT(*s)) {
2443 UV value = *s - '0';
2444 if (++s < send) {
2445 int digit = *s - '0';
2446 if (digit >= 0 && digit <= 9) {
2447 value = value * 10 + digit;
2448 if (++s < send) {
2449 digit = *s - '0';
2450 if (digit >= 0 && digit <= 9) {
2451 value = value * 10 + digit;
2452 if (++s < send) {
2453 digit = *s - '0';
2454 if (digit >= 0 && digit <= 9) {
2455 value = value * 10 + digit;
2456 if (++s < send) {
2457 digit = *s - '0';
2458 if (digit >= 0 && digit <= 9) {
2459 value = value * 10 + digit;
2460 if (++s < send) {
2461 digit = *s - '0';
2462 if (digit >= 0 && digit <= 9) {
2463 value = value * 10 + digit;
2464 if (++s < send) {
2465 digit = *s - '0';
2466 if (digit >= 0 && digit <= 9) {
2467 value = value * 10 + digit;
2468 if (++s < send) {
2469 digit = *s - '0';
2470 if (digit >= 0 && digit <= 9) {
2471 value = value * 10 + digit;
2472 if (++s < send) {
2473 digit = *s - '0';
2474 if (digit >= 0 && digit <= 9) {
2475 value = value * 10 + digit;
2476 if (++s < send) {
2477 digit = *s - '0';
2478 while (digit >= 0 && digit <= 9
2479 && (value < max_div_10
2480 || (value == max_div_10
2481 && digit <= max_mod_10))) {
2482 value = value * 10 + digit;
2483 if (++s < send)
2484 digit = *s - '0';
2485 else
2486 break;
2487 }
2488 if (digit >= 0 && digit <= 9
2489 && (s < send)) {
2490 do {
2491 s++;
2492 } while (s < send && isDIGIT(*s));
2493 numtype |=
2494 IS_NUMBER_GREATER_THAN_UV_MAX;
2495 goto skip_value;
2496 }
2497 }
2498 }
2499 }
2500 }
2501 }
2502 }
2503 }
2504 }
2505 }
2506 }
2507 }
2508 }
2509 }
2510 }
2511 }
2512 }
2513 }
2514 numtype |= IS_NUMBER_IN_UV;
2515 if (valuep)
2516 *valuep = value;
2517 skip_value:
2518 if (GROK_NUMERIC_RADIX(&s, send)) {
2519 numtype |= IS_NUMBER_NOT_INT;
2520 while (s < send && isDIGIT(*s))
2521 s++;
2522 }
2523 }
2524 else if (GROK_NUMERIC_RADIX(&s, send)) {
2525 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV;
2526 if (s < send && isDIGIT(*s)) {
2527 do {
2528 s++;
2529 } while (s < send && isDIGIT(*s));
2530 if (valuep) {
2531 *valuep = 0;
2532 }
2533 }
2534 else
2535 return 0;
2536 } else if (*s == 'I' || *s == 'i') {
2537 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
2538 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
2539 s++; if (s < send && (*s == 'I' || *s == 'i')) {
2540 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
2541 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
2542 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
2543 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
2544 s++;
2545 }
2546 sawinf = 1;
2547 } else if (*s == 'N' || *s == 'n') {
2548 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
2549 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
2550 s++;
2551 sawnan = 1;
2552 } else
2553 return 0;
2554 if (sawinf) {
2555 numtype &= IS_NUMBER_NEG;
2556 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
2557 } else if (sawnan) {
2558 numtype &= IS_NUMBER_NEG;
2559 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
2560 } else if (s < send) {
2561 if (*s == 'e' || *s == 'E') {
2562 numtype &= IS_NUMBER_NEG;
2563 numtype |= IS_NUMBER_NOT_INT;
2564 s++;
2565 if (s < send && (*s == '-' || *s == '+'))
2566 s++;
2567 if (s < send && isDIGIT(*s)) {
2568 do {
2569 s++;
2570 } while (s < send && isDIGIT(*s));
2571 }
2572 else
2573 return 0;
2574 }
2575 }
2576 while (s < send && isSPACE(*s))
2577 s++;
2578 if (s >= send)
2579 return numtype;
2580 if (len == 10 && memEQ(pv, "0 but true", 10)) {
2581 if (valuep)
2582 *valuep = 0;
2583 return IS_NUMBER_IN_UV;
2584 }
2585 return 0;
2586 }
2587 #endif
2588 #endif
2589 #ifndef grok_bin
2590 #if defined(NEED_grok_bin)
2591 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
2592 static
2593 #else
2594 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
2595 #endif
2596 #ifdef grok_bin
2597 #undef grok_bin
2598 #endif
2599 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
2600 #define Perl_grok_bin DPPP_(my_grok_bin)
2601 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
2602 UV
DPPP_(my_grok_bin)2603 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
2604 {
2605 const char *s = start;
2606 STRLEN len = *len_p;
2607 UV value = 0;
2608 NV value_nv = 0;
2609 const UV max_div_2 = UV_MAX / 2;
2610 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
2611 bool overflowed = FALSE;
2612 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
2613 if (len >= 1) {
2614 if (s[0] == 'b') {
2615 s++;
2616 len--;
2617 }
2618 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
2619 s+=2;
2620 len-=2;
2621 }
2622 }
2623 }
2624 for (; len-- && *s; s++) {
2625 char bit = *s;
2626 if (bit == '0' || bit == '1') {
2627 redo:
2628 if (!overflowed) {
2629 if (value <= max_div_2) {
2630 value = (value << 1) | (bit - '0');
2631 continue;
2632 }
2633 warn("Integer overflow in binary number");
2634 overflowed = TRUE;
2635 value_nv = (NV) value;
2636 }
2637 value_nv *= 2.0;
2638 value_nv += (NV)(bit - '0');
2639 continue;
2640 }
2641 if (bit == '_' && len && allow_underscores && (bit = s[1])
2642 && (bit == '0' || bit == '1'))
2643 {
2644 --len;
2645 ++s;
2646 goto redo;
2647 }
2648 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
2649 warn("Illegal binary digit '%c' ignored", *s);
2650 break;
2651 }
2652 if ( ( overflowed && value_nv > 4294967295.0)
2653 #if UVSIZE > 4
2654 || (!overflowed && value > 0xffffffff )
2655 #endif
2656 ) {
2657 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
2658 }
2659 *len_p = s - start;
2660 if (!overflowed) {
2661 *flags = 0;
2662 return value;
2663 }
2664 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
2665 if (result)
2666 *result = value_nv;
2667 return UV_MAX;
2668 }
2669 #endif
2670 #endif
2671 #ifndef grok_hex
2672 #if defined(NEED_grok_hex)
2673 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
2674 static
2675 #else
2676 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
2677 #endif
2678 #ifdef grok_hex
2679 #undef grok_hex
2680 #endif
2681 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
2682 #define Perl_grok_hex DPPP_(my_grok_hex)
2683 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
2684 UV
DPPP_(my_grok_hex)2685 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
2686 {
2687 const char *s = start;
2688 STRLEN len = *len_p;
2689 UV value = 0;
2690 NV value_nv = 0;
2691 const UV max_div_16 = UV_MAX / 16;
2692 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
2693 bool overflowed = FALSE;
2694 const char *xdigit;
2695 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
2696 if (len >= 1) {
2697 if (s[0] == 'x') {
2698 s++;
2699 len--;
2700 }
2701 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
2702 s+=2;
2703 len-=2;
2704 }
2705 }
2706 }
2707 for (; len-- && *s; s++) {
2708 xdigit = strchr((char *) PL_hexdigit, *s);
2709 if (xdigit) {
2710 redo:
2711 if (!overflowed) {
2712 if (value <= max_div_16) {
2713 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
2714 continue;
2715 }
2716 warn("Integer overflow in hexadecimal number");
2717 overflowed = TRUE;
2718 value_nv = (NV) value;
2719 }
2720 value_nv *= 16.0;
2721 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
2722 continue;
2723 }
2724 if (*s == '_' && len && allow_underscores && s[1]
2725 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
2726 {
2727 --len;
2728 ++s;
2729 goto redo;
2730 }
2731 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
2732 warn("Illegal hexadecimal digit '%c' ignored", *s);
2733 break;
2734 }
2735 if ( ( overflowed && value_nv > 4294967295.0)
2736 #if UVSIZE > 4
2737 || (!overflowed && value > 0xffffffff )
2738 #endif
2739 ) {
2740 warn("Hexadecimal number > 0xffffffff non-portable");
2741 }
2742 *len_p = s - start;
2743 if (!overflowed) {
2744 *flags = 0;
2745 return value;
2746 }
2747 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
2748 if (result)
2749 *result = value_nv;
2750 return UV_MAX;
2751 }
2752 #endif
2753 #endif
2754 #ifndef grok_oct
2755 #if defined(NEED_grok_oct)
2756 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
2757 static
2758 #else
2759 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
2760 #endif
2761 #ifdef grok_oct
2762 #undef grok_oct
2763 #endif
2764 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
2765 #define Perl_grok_oct DPPP_(my_grok_oct)
2766 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
2767 UV
DPPP_(my_grok_oct)2768 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
2769 {
2770 const char *s = start;
2771 STRLEN len = *len_p;
2772 UV value = 0;
2773 NV value_nv = 0;
2774 const UV max_div_8 = UV_MAX / 8;
2775 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
2776 bool overflowed = FALSE;
2777 for (; len-- && *s; s++) {
2778 int digit = *s - '0';
2779 if (digit >= 0 && digit <= 7) {
2780 redo:
2781 if (!overflowed) {
2782 if (value <= max_div_8) {
2783 value = (value << 3) | digit;
2784 continue;
2785 }
2786 warn("Integer overflow in octal number");
2787 overflowed = TRUE;
2788 value_nv = (NV) value;
2789 }
2790 value_nv *= 8.0;
2791 value_nv += (NV)digit;
2792 continue;
2793 }
2794 if (digit == ('_' - '0') && len && allow_underscores
2795 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
2796 {
2797 --len;
2798 ++s;
2799 goto redo;
2800 }
2801 if (digit == 8 || digit == 9) {
2802 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
2803 warn("Illegal octal digit '%c' ignored", *s);
2804 }
2805 break;
2806 }
2807 if ( ( overflowed && value_nv > 4294967295.0)
2808 #if UVSIZE > 4
2809 || (!overflowed && value > 0xffffffff )
2810 #endif
2811 ) {
2812 warn("Octal number > 037777777777 non-portable");
2813 }
2814 *len_p = s - start;
2815 if (!overflowed) {
2816 *flags = 0;
2817 return value;
2818 }
2819 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
2820 if (result)
2821 *result = value_nv;
2822 return UV_MAX;
2823 }
2824 #endif
2825 #endif
2826 #if !defined(my_snprintf)
2827 #if defined(NEED_my_snprintf)
2828 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
2829 static
2830 #else
2831 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
2832 #endif
2833 #define my_snprintf DPPP_(my_my_snprintf)
2834 #define Perl_my_snprintf DPPP_(my_my_snprintf)
2835 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
2836 int
DPPP_(my_my_snprintf)2837 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
2838 {
2839 dTHX;
2840 int retval;
2841 va_list ap;
2842 va_start(ap, format);
2843 #ifdef HAS_VSNPRINTF
2844 retval = vsnprintf(buffer, len, format, ap);
2845 #else
2846 retval = vsprintf(buffer, format, ap);
2847 #endif
2848 va_end(ap);
2849 if (retval < 0 || (len > 0 && (Size_t)retval >= len))
2850 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
2851 return retval;
2852 }
2853 #endif
2854 #endif
2855 #if !defined(my_sprintf)
2856 #if defined(NEED_my_sprintf)
2857 static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
2858 static
2859 #else
2860 extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
2861 #endif
2862 #define my_sprintf DPPP_(my_my_sprintf)
2863 #define Perl_my_sprintf DPPP_(my_my_sprintf)
2864 #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
2865 int
DPPP_(my_my_sprintf)2866 DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
2867 {
2868 va_list args;
2869 va_start(args, pat);
2870 vsprintf(buffer, pat, args);
2871 va_end(args);
2872 return strlen(buffer);
2873 }
2874 #endif
2875 #endif
2876 #ifdef NO_XSLOCKS
2877 #ifdef dJMPENV
2878 #define dXCPT dJMPENV; int rEtV = 0
2879 #define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
2880 #define XCPT_TRY_END JMPENV_POP;
2881 #define XCPT_CATCH if (rEtV != 0)
2882 #define XCPT_RETHROW JMPENV_JUMP(rEtV)
2883 #else
2884 #define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
2885 #define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
2886 #define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
2887 #define XCPT_CATCH if (rEtV != 0)
2888 #define XCPT_RETHROW Siglongjmp(top_env, rEtV)
2889 #endif
2890 #endif
2891 #if !defined(my_strlcat)
2892 #if defined(NEED_my_strlcat)
2893 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
2894 static
2895 #else
2896 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
2897 #endif
2898 #define my_strlcat DPPP_(my_my_strlcat)
2899 #define Perl_my_strlcat DPPP_(my_my_strlcat)
2900 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
2901 Size_t
DPPP_(my_my_strlcat)2902 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
2903 {
2904 Size_t used, length, copy;
2905 used = strlen(dst);
2906 length = strlen(src);
2907 if (size > 0 && used < size - 1) {
2908 copy = (length >= size - used) ? size - used - 1 : length;
2909 memcpy(dst + used, src, copy);
2910 dst[used + copy] = '\0';
2911 }
2912 return used + length;
2913 }
2914 #endif
2915 #endif
2916 #if !defined(my_strlcpy)
2917 #if defined(NEED_my_strlcpy)
2918 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
2919 static
2920 #else
2921 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
2922 #endif
2923 #define my_strlcpy DPPP_(my_my_strlcpy)
2924 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
2925 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
2926 Size_t
DPPP_(my_my_strlcpy)2927 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
2928 {
2929 Size_t length, copy;
2930 length = strlen(src);
2931 if (size > 0) {
2932 copy = (length >= size) ? size - 1 : length;
2933 memcpy(dst, src, copy);
2934 dst[copy] = '\0';
2935 }
2936 return length;
2937 }
2938 #endif
2939 #endif
2940 #ifndef PERL_PV_ESCAPE_QUOTE
2941 #define PERL_PV_ESCAPE_QUOTE 0x0001
2942 #endif
2943 #ifndef PERL_PV_PRETTY_QUOTE
2944 #define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
2945 #endif
2946 #ifndef PERL_PV_PRETTY_ELLIPSES
2947 #define PERL_PV_PRETTY_ELLIPSES 0x0002
2948 #endif
2949 #ifndef PERL_PV_PRETTY_LTGT
2950 #define PERL_PV_PRETTY_LTGT 0x0004
2951 #endif
2952 #ifndef PERL_PV_ESCAPE_FIRSTCHAR
2953 #define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
2954 #endif
2955 #ifndef PERL_PV_ESCAPE_UNI
2956 #define PERL_PV_ESCAPE_UNI 0x0100
2957 #endif
2958 #ifndef PERL_PV_ESCAPE_UNI_DETECT
2959 #define PERL_PV_ESCAPE_UNI_DETECT 0x0200
2960 #endif
2961 #ifndef PERL_PV_ESCAPE_ALL
2962 #define PERL_PV_ESCAPE_ALL 0x1000
2963 #endif
2964 #ifndef PERL_PV_ESCAPE_NOBACKSLASH
2965 #define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
2966 #endif
2967 #ifndef PERL_PV_ESCAPE_NOCLEAR
2968 #define PERL_PV_ESCAPE_NOCLEAR 0x4000
2969 #endif
2970 #ifndef PERL_PV_ESCAPE_RE
2971 #define PERL_PV_ESCAPE_RE 0x8000
2972 #endif
2973 #ifndef PERL_PV_PRETTY_NOCLEAR
2974 #define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
2975 #endif
2976 #ifndef PERL_PV_PRETTY_DUMP
2977 #define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
2978 #endif
2979 #ifndef PERL_PV_PRETTY_REGPROP
2980 #define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
2981 #endif
2982 #ifndef pv_escape
2983 #if defined(NEED_pv_escape)
2984 static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
2985 static
2986 #else
2987 extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
2988 #endif
2989 #ifdef pv_escape
2990 #undef pv_escape
2991 #endif
2992 #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
2993 #define Perl_pv_escape DPPP_(my_pv_escape)
2994 #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
2995 char *
DPPP_(my_pv_escape)2996 DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
2997 const STRLEN count, const STRLEN max,
2998 STRLEN * const escaped, const U32 flags)
2999 {
3000 const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
3001 const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
3002 char octbuf[32] = "%123456789ABCDF";
3003 STRLEN wrote = 0;
3004 STRLEN chsize = 0;
3005 STRLEN readsize = 1;
3006 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
3007 bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
3008 #endif
3009 const char *pv = str;
3010 const char * const end = pv + count;
3011 octbuf[0] = esc;
3012 if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
3013 sv_setpvs(dsv, "");
3014 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
3015 if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
3016 isuni = 1;
3017 #endif
3018 for (; pv < end && (!max || wrote < max) ; pv += readsize) {
3019 const UV u =
3020 #if defined(is_utf8_string) && defined(utf8_to_uvchr)
3021 isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
3022 #endif
3023 (U8)*pv;
3024 const U8 c = (U8)u & 0xFF;
3025 if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
3026 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
3027 chsize = my_snprintf(octbuf, sizeof octbuf,
3028 "%"UVxf, u);
3029 else
3030 chsize = my_snprintf(octbuf, sizeof octbuf,
3031 "%cx{%"UVxf"}", esc, u);
3032 } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
3033 chsize = 1;
3034 } else {
3035 if (c == dq || c == esc || !isPRINT(c)) {
3036 chsize = 2;
3037 switch (c) {
3038 case '\\' :
3039 case '%' : if (c == esc)
3040 octbuf[1] = esc;
3041 else
3042 chsize = 1;
3043 break;
3044 case '\v' : octbuf[1] = 'v'; break;
3045 case '\t' : octbuf[1] = 't'; break;
3046 case '\r' : octbuf[1] = 'r'; break;
3047 case '\n' : octbuf[1] = 'n'; break;
3048 case '\f' : octbuf[1] = 'f'; break;
3049 case '"' : if (dq == '"')
3050 octbuf[1] = '"';
3051 else
3052 chsize = 1;
3053 break;
3054 default: chsize = my_snprintf(octbuf, sizeof octbuf,
3055 pv < end && isDIGIT((U8)*(pv+readsize))
3056 ? "%c%03o" : "%c%o", esc, c);
3057 }
3058 } else {
3059 chsize = 1;
3060 }
3061 }
3062 if (max && wrote + chsize > max) {
3063 break;
3064 } else if (chsize > 1) {
3065 sv_catpvn(dsv, octbuf, chsize);
3066 wrote += chsize;
3067 } else {
3068 char tmp[2];
3069 my_snprintf(tmp, sizeof tmp, "%c", c);
3070 sv_catpvn(dsv, tmp, 1);
3071 wrote++;
3072 }
3073 if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
3074 break;
3075 }
3076 if (escaped != NULL)
3077 *escaped= pv - str;
3078 return SvPVX(dsv);
3079 }
3080 #endif
3081 #endif
3082 #ifndef pv_pretty
3083 #if defined(NEED_pv_pretty)
3084 static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
3085 static
3086 #else
3087 extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
3088 #endif
3089 #ifdef pv_pretty
3090 #undef pv_pretty
3091 #endif
3092 #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
3093 #define Perl_pv_pretty DPPP_(my_pv_pretty)
3094 #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
3095 char *
DPPP_(my_pv_pretty)3096 DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
3097 const STRLEN max, char const * const start_color, char const * const end_color,
3098 const U32 flags)
3099 {
3100 const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
3101 STRLEN escaped;
3102 if (!(flags & PERL_PV_PRETTY_NOCLEAR))
3103 sv_setpvs(dsv, "");
3104 if (dq == '"')
3105 sv_catpvs(dsv, "\"");
3106 else if (flags & PERL_PV_PRETTY_LTGT)
3107 sv_catpvs(dsv, "<");
3108 if (start_color != NULL)
3109 sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
3110 pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
3111 if (end_color != NULL)
3112 sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
3113 if (dq == '"')
3114 sv_catpvs(dsv, "\"");
3115 else if (flags & PERL_PV_PRETTY_LTGT)
3116 sv_catpvs(dsv, ">");
3117 if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
3118 sv_catpvs(dsv, "...");
3119 return SvPVX(dsv);
3120 }
3121 #endif
3122 #endif
3123 #ifndef pv_display
3124 #if defined(NEED_pv_display)
3125 static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
3126 static
3127 #else
3128 extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
3129 #endif
3130 #ifdef pv_display
3131 #undef pv_display
3132 #endif
3133 #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
3134 #define Perl_pv_display DPPP_(my_pv_display)
3135 #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
3136 char *
DPPP_(my_pv_display)3137 DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
3138 {
3139 pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
3140 if (len > cur && pv[cur] == '\0')
3141 sv_catpvs(dsv, "\\0");
3142 return SvPVX(dsv);
3143 }
3144 #endif
3145 #endif
3146 #endif
3147