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