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