This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Sort the Perl_ math wrappers for easier eyeballing.
[perl5.git] / perl.h
1 /*    perl.h
2  *
3  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
4  *    2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
5  *
6  *    You may distribute under the terms of either the GNU General Public
7  *    License or the Artistic License, as specified in the README file.
8  *
9  */
10
11 #ifndef H_PERL
12 #define H_PERL 1
13
14 #ifdef PERL_FOR_X2P
15 /*
16  * This file is being used for x2p stuff.
17  * Above symbol is defined via -D in 'x2p/Makefile.SH'
18  * Decouple x2p stuff from some of perls more extreme eccentricities.
19  */
20 #undef MULTIPLICITY
21 #undef USE_STDIO
22 #define USE_STDIO
23 #endif /* PERL_FOR_X2P */
24
25 #ifdef PERL_MICRO
26 #   include "uconfig.h"
27 #else
28 #   include "config.h"
29 #endif
30
31 #if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || defined(_STDC_C99)
32 #  define HAS_C99 1
33 #endif
34
35 /* See L<perlguts/"The Perl API"> for detailed notes on
36  * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
37
38 /* Note that from here --> to <-- the same logic is
39  * repeated in makedef.pl, so be certain to update
40  * both places when editing. */
41
42 #ifdef USE_ITHREADS
43 #  if !defined(MULTIPLICITY)
44 #    define MULTIPLICITY
45 #  endif
46 #endif
47
48 #ifdef PERL_GLOBAL_STRUCT_PRIVATE
49 #  ifndef PERL_GLOBAL_STRUCT
50 #    define PERL_GLOBAL_STRUCT
51 #  endif
52 #endif
53
54 #ifdef PERL_GLOBAL_STRUCT
55 #  ifndef MULTIPLICITY
56 #    define MULTIPLICITY
57 #  endif
58 #endif
59
60 #ifdef MULTIPLICITY
61 #  ifndef PERL_IMPLICIT_CONTEXT
62 #    define PERL_IMPLICIT_CONTEXT
63 #  endif
64 #endif
65
66 /* undef WIN32 when building on Cygwin (for libwin32) - gph */
67 #ifdef __CYGWIN__
68 #   undef WIN32
69 #   undef _WIN32
70 #endif
71
72 #if defined(__SYMBIAN32__) || (defined(__VC32__) && defined(WINS))
73 #   ifndef SYMBIAN
74 #       define SYMBIAN
75 #   endif
76 #endif
77
78 #ifdef __SYMBIAN32__
79 #  include "symbian/symbian_proto.h"
80 #endif
81
82 /* Any stack-challenged places.  The limit varies (and often
83  * is configurable), but using more than a kilobyte of stack
84  * is usually dubious in these systems. */
85 #if defined(__SYMBIAN32__)
86 /* Symbian: need to work around the SDK features. *
87  * On WINS: MS VC5 generates calls to _chkstk,         *
88  * if a "large" stack frame is allocated.              *
89  * gcc on MARM does not generate calls like these.     */
90 #   define USE_HEAP_INSTEAD_OF_STACK
91 #endif
92
93 /* Use the reentrant APIs like localtime_r and getpwent_r */
94 /* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
95 #if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN)
96 #   define USE_REENTRANT_API
97 #endif
98
99 /* <--- here ends the logic shared by perl.h and makedef.pl */
100
101 /* Microsoft Visual C++ 6.0 needs special treatment in numerous places */
102 #if defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1200 && _MSC_VER < 1300
103 #  define USING_MSVC6
104 #endif
105
106 #undef START_EXTERN_C
107 #undef END_EXTERN_C
108 #undef EXTERN_C
109 #ifdef __cplusplus
110 #  define START_EXTERN_C extern "C" {
111 #  define END_EXTERN_C }
112 #  define EXTERN_C extern "C"
113 #else
114 #  define START_EXTERN_C
115 #  define END_EXTERN_C
116 #  define EXTERN_C extern
117 #endif
118
119 /* Fallback definitions in case we don't have definitions from config.h.
120    This should only matter for systems that don't use Configure and
121    haven't been modified to define PERL_STATIC_INLINE yet.
122 */
123 #if !defined(PERL_STATIC_INLINE)
124 #  ifdef HAS_STATIC_INLINE
125 #    define PERL_STATIC_INLINE static inline
126 #  else
127 #    define PERL_STATIC_INLINE static
128 #  endif
129 #endif
130
131 #ifdef PERL_GLOBAL_STRUCT
132 #  ifndef PERL_GET_VARS
133 #    ifdef PERL_GLOBAL_STRUCT_PRIVATE
134        EXTERN_C struct perl_vars* Perl_GetVarsPrivate();
135 #      define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */
136 #      ifndef PERLIO_FUNCS_CONST
137 #        define PERLIO_FUNCS_CONST /* Can't have these lying around. */
138 #      endif
139 #    else
140 #      define PERL_GET_VARS() PL_VarsPtr
141 #    endif
142 #  endif
143 #endif
144
145 #define pVAR    struct perl_vars* my_vars PERL_UNUSED_DECL
146
147 #ifdef PERL_GLOBAL_STRUCT
148 #  define dVAR          pVAR    = (struct perl_vars*)PERL_GET_VARS()
149 #else
150 #  define dVAR          dNOOP
151 #endif
152
153 #ifdef PERL_IMPLICIT_CONTEXT
154 #  ifndef MULTIPLICITY
155 #    define MULTIPLICITY
156 #  endif
157 #  define tTHX  PerlInterpreter*
158 #  define pTHX  tTHX my_perl PERL_UNUSED_DECL
159 #  define aTHX  my_perl
160 #  define aTHXa(a) aTHX = (tTHX)a
161 #  ifdef PERL_GLOBAL_STRUCT
162 #    define dTHXa(a)    dVAR; pTHX = (tTHX)a
163 #  else
164 #    define dTHXa(a)    pTHX = (tTHX)a
165 #  endif
166 #  ifdef PERL_GLOBAL_STRUCT
167 #    define dTHX                dVAR; pTHX = PERL_GET_THX
168 #  else
169 #    define dTHX                pTHX = PERL_GET_THX
170 #  endif
171 #  define pTHX_         pTHX,
172 #  define aTHX_         aTHX,
173 #  define pTHX_1        2
174 #  define pTHX_2        3
175 #  define pTHX_3        4
176 #  define pTHX_4        5
177 #  define pTHX_5        6
178 #  define pTHX_6        7
179 #  define pTHX_7        8
180 #  define pTHX_8        9
181 #  define pTHX_9        10
182 #  define pTHX_12       13
183 #  if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL)
184 #    define PERL_TRACK_MEMPOOL
185 #  endif
186 #else
187 #  undef PERL_TRACK_MEMPOOL
188 #endif
189
190 #define STATIC static
191
192 #ifndef PERL_CORE
193 /* Do not use these macros. They were part of PERL_OBJECT, which was an
194  * implementation of multiplicity using C++ objects. They have been left
195  * here solely for the sake of XS code which has incorrectly
196  * cargo-culted them.
197  */
198 #define CPERLscope(x) x
199 #define CPERLarg void
200 #define CPERLarg_
201 #define _CPERLarg
202 #define PERL_OBJECT_THIS
203 #define _PERL_OBJECT_THIS
204 #define PERL_OBJECT_THIS_
205 #define CALL_FPTR(fptr) (*fptr)
206 #define MEMBER_TO_FPTR(name) name
207 #endif /* !PERL_CORE */
208
209 #define CALLRUNOPS  PL_runops
210
211 #define CALLREGCOMP(sv, flags) Perl_pregcomp(aTHX_ (sv),(flags))
212
213 #define CALLREGCOMP_ENG(prog, sv, flags) (prog)->comp(aTHX_ sv, flags)
214 #define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,sv,data,flags) \
215     RX_ENGINE(prog)->exec(aTHX_ (prog),(stringarg),(strend), \
216         (strbeg),(minend),(sv),(data),(flags))
217 #define CALLREG_INTUIT_START(prog,sv,strbeg,strpos,strend,flags,data) \
218     RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strbeg), (strpos), \
219         (strend),(flags),(data))
220 #define CALLREG_INTUIT_STRING(prog) \
221     RX_ENGINE(prog)->checkstr(aTHX_ (prog))
222
223 #define CALLREGFREE(prog) \
224     Perl_pregfree(aTHX_ (prog))
225
226 #define CALLREGFREE_PVT(prog) \
227     if(prog) RX_ENGINE(prog)->free(aTHX_ (prog))
228
229 #define CALLREG_NUMBUF_FETCH(rx,paren,usesv)                                \
230     RX_ENGINE(rx)->numbered_buff_FETCH(aTHX_ (rx),(paren),(usesv))
231
232 #define CALLREG_NUMBUF_STORE(rx,paren,value) \
233     RX_ENGINE(rx)->numbered_buff_STORE(aTHX_ (rx),(paren),(value))
234
235 #define CALLREG_NUMBUF_LENGTH(rx,sv,paren)                              \
236     RX_ENGINE(rx)->numbered_buff_LENGTH(aTHX_ (rx),(sv),(paren))
237
238 #define CALLREG_NAMED_BUFF_FETCH(rx, key, flags) \
239     RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH))
240
241 #define CALLREG_NAMED_BUFF_STORE(rx, key, value, flags) \
242     RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE))
243
244 #define CALLREG_NAMED_BUFF_DELETE(rx, key, flags) \
245     RX_ENGINE(rx)->named_buff(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE))
246
247 #define CALLREG_NAMED_BUFF_CLEAR(rx, flags) \
248     RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR))
249
250 #define CALLREG_NAMED_BUFF_EXISTS(rx, key, flags) \
251     RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS))
252
253 #define CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags) \
254     RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY))
255
256 #define CALLREG_NAMED_BUFF_NEXTKEY(rx, lastkey, flags) \
257     RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY))
258
259 #define CALLREG_NAMED_BUFF_SCALAR(rx, flags) \
260     RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR))
261
262 #define CALLREG_NAMED_BUFF_COUNT(rx) \
263     RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT)
264
265 #define CALLREG_NAMED_BUFF_ALL(rx, flags) \
266     RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, flags)
267
268 #define CALLREG_PACKAGE(rx) \
269     RX_ENGINE(rx)->qr_package(aTHX_ (rx))
270
271 #if defined(USE_ITHREADS)
272 #define CALLREGDUPE(prog,param) \
273     Perl_re_dup(aTHX_ (prog),(param))
274
275 #define CALLREGDUPE_PVT(prog,param) \
276     (prog ? RX_ENGINE(prog)->dupe(aTHX_ (prog),(param)) \
277           : (REGEXP *)NULL)
278 #endif
279
280
281
282
283
284 /*
285  * Because of backward compatibility reasons the PERL_UNUSED_DECL
286  * cannot be changed from postfix to PERL_UNUSED_DECL(x).  Sigh.
287  *
288  * Note that there are C compilers such as MetroWerks CodeWarrior
289  * which do not have an "inlined" way (like the gcc __attribute__) of
290  * marking unused variables (they need e.g. a #pragma) and therefore
291  * cpp macros like PERL_UNUSED_DECL cannot work for this purpose, even
292  * if it were PERL_UNUSED_DECL(x), which it cannot be (see above).
293  *
294  */
295
296 #if defined(__SYMBIAN32__) && defined(__GNUC__)
297 #  ifdef __cplusplus
298 #    define PERL_UNUSED_DECL
299 #  else
300 #    define PERL_UNUSED_DECL __attribute__((unused))
301 #  endif
302 #endif
303
304 #ifndef PERL_UNUSED_DECL
305 #  if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
306 #    define PERL_UNUSED_DECL __attribute__unused__
307 #  else
308 #    define PERL_UNUSED_DECL
309 #  endif
310 #endif
311
312 /* gcc -Wall:
313  * for silencing unused variables that are actually used most of the time,
314  * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs,
315  * or variables/arguments that are used only in certain configurations.
316  */
317 #ifndef PERL_UNUSED_ARG
318 #  if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
319 #    include <note.h>
320 #    define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
321 #  else
322 #    define PERL_UNUSED_ARG(x) ((void)sizeof(x))
323 #  endif
324 #endif
325 #ifndef PERL_UNUSED_VAR
326 #  define PERL_UNUSED_VAR(x) ((void)sizeof(x))
327 #endif
328
329 #if defined(USE_ITHREADS) || defined(PERL_GLOBAL_STRUCT)
330 #  define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
331 #else
332 #  define PERL_UNUSED_CONTEXT
333 #endif
334
335 /* gcc (-ansi) -pedantic doesn't allow gcc statement expressions,
336  * g++ allows them but seems to have problems with them
337  * (insane errors ensue).
338  * g++ does not give insane errors now (RMB 2008-01-30, gcc 4.2.2).
339  */
340 #if defined(PERL_GCC_PEDANTIC) || \
341     (defined(__GNUC__) && defined(__cplusplus) && \
342         ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 2))))
343 #  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
344 #    define PERL_GCC_BRACE_GROUPS_FORBIDDEN
345 #  endif
346 #endif
347
348 /* Use PERL_UNUSED_RESULT() to suppress the warnings about unused results
349  * of function calls, e.g. PERL_UNUSED_RESULT(foo(a, b)).
350  *
351  * The main reason for this is that the combination of gcc -Wunused-result
352  * (part of -Wall) and the __attribute__((warn_unused_result)) cannot
353  * be silenced with casting to void.  This causes trouble when the system
354  * header files use the attribute.
355  *
356  * Use PERL_UNUSED_RESULT sparingly, though, since usually the warning
357  * is there for a good reason: you might lose success/failure information,
358  * or leak resources, or changes in resources.
359  *
360  * But sometimes you just want to ignore the return value, e.g. on
361  * codepaths soon ending up in abort, or in "best effort" attempts,
362  * or in situations where there is no good way to handle failures.
363  *
364  * Sometimes PERL_UNUSED_RESULT might not be the most natural way:
365  * another possibility is that you can capture the return value
366  * and use PERL_UNUSED_VAR on that.
367  *
368  * The __typeof__() is used instead of typeof() since typeof() is not
369  * available under strict C89, and because of compilers masquerading
370  * as gcc (clang and icc), we want exactly the gcc extension
371  * __typeof__ and nothing else.
372  */
373 #ifndef PERL_UNUSED_RESULT
374 #  if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
375 #    define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
376 #  else
377 #    define PERL_UNUSED_RESULT(v) ((void)(v))
378 #  endif
379 #endif
380
381 /* on gcc (and clang), specify that a warning should be temporarily
382  * ignored; e.g.
383  *
384  *    GCC_DIAG_IGNORE(-Wmultichar);
385  *    char b = 'ab';
386  *    GCC_DIAG_RESTORE;
387  *
388  * based on http://dbp-consulting.com/tutorials/SuppressingGCCWarnings.html
389  *
390  * Note that "pragma GCC diagnostic push/pop" was added in GCC 4.6, Mar 2011;
391  * clang only pretends to be GCC 4.2, but still supports push/pop.
392  *
393  * Note on usage: on non-gcc (or lookalike, like clang) compilers
394  * one cannot use these at file (global) level without warnings
395  * since they are defined as empty, which leads into the terminating
396  * semicolon being left alone on a line:
397  * ;
398  * which makes compilers mildly cranky.  Therefore at file level one
399  * should use the GCC_DIAG_IGNORE and GCC_DIAG_RESTORE_FILE *without*
400  * the semicolons.
401  *
402  * (A dead-on-arrival solution would be to try to define the macros as
403  * NOOP or dNOOP, those don't work both inside functions and outside.)
404  */
405
406 #if defined(__clang__) || defined(__clang) || \
407        (defined( __GNUC__) && ((__GNUC__ * 100) + __GNUC_MINOR__) >= 406)
408 #  define GCC_DIAG_PRAGMA(x) _Pragma (#x)
409 /* clang has "clang diagnostic" pragmas, but also understands gcc. */
410 #  define GCC_DIAG_IGNORE(x) _Pragma("GCC diagnostic push") \
411                              GCC_DIAG_PRAGMA(GCC diagnostic ignored #x)
412 #  define GCC_DIAG_RESTORE   _Pragma("GCC diagnostic pop")
413 #else
414 #  define GCC_DIAG_IGNORE(w)
415 #  define GCC_DIAG_RESTORE
416 #endif
417
418 #define NOOP /*EMPTY*/(void)0
419 /* cea2e8a9dd23747f accidentally lost the comment originally from the first
420    check in of thread.h, explaining why we need dNOOP at all:  */
421 /* Rats: if dTHR is just blank then the subsequent ";" throws an error */
422 /* Declaring a *function*, instead of a variable, ensures that we don't rely
423    on being able to suppress "unused" warnings.  */
424 #ifdef __cplusplus
425 #define dNOOP (void)0
426 #else
427 #define dNOOP extern int Perl___notused(void)
428 #endif
429
430 #ifndef pTHX
431 /* Don't bother defining tTHX ; using it outside
432  * code guarded by PERL_IMPLICIT_CONTEXT is an error.
433  */
434 #  define pTHX          void
435 #  define pTHX_
436 #  define aTHX
437 #  define aTHX_
438 #  define aTHXa(a)      NOOP
439 #  define dTHXa(a)      dNOOP
440 #  define dTHX          dNOOP
441 #  define pTHX_1        1       
442 #  define pTHX_2        2
443 #  define pTHX_3        3
444 #  define pTHX_4        4
445 #  define pTHX_5        5
446 #  define pTHX_6        6
447 #  define pTHX_7        7
448 #  define pTHX_8        8
449 #  define pTHX_9        9
450 #  define pTHX_12       12
451 #endif
452
453 #ifndef dVAR
454 #  define dVAR          dNOOP
455 #endif
456
457 /* these are only defined for compatibility; should not be used internally */
458 #if !defined(pTHXo) && !defined(PERL_CORE)
459 #  define pTHXo         pTHX
460 #  define pTHXo_        pTHX_
461 #  define aTHXo         aTHX
462 #  define aTHXo_        aTHX_
463 #  define dTHXo         dTHX
464 #  define dTHXoa(x)     dTHXa(x)
465 #endif
466
467 #ifndef pTHXx
468 #  define pTHXx         PerlInterpreter *my_perl
469 #  define pTHXx_        pTHXx,
470 #  define aTHXx         my_perl
471 #  define aTHXx_        aTHXx,
472 #  define dTHXx         dTHX
473 #endif
474
475 /* Under PERL_IMPLICIT_SYS (used in Windows for fork emulation)
476  * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...).
477  * dTHXs is therefore needed for all functions using PerlIO_foo(). */
478 #ifdef PERL_IMPLICIT_SYS
479 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
480 #    define dTHXs               dVAR; dTHX
481 #  else
482 #    define dTHXs               dTHX
483 #  endif
484 #else
485 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
486 #    define dTHXs               dVAR
487 #  else
488 #    define dTHXs               dNOOP
489 #  endif
490 #endif
491
492 /* Some platforms require marking function declarations
493  * for them to be exportable.  Used in perlio.h, proto.h
494  * is handled either by the makedef.pl or by defining the
495  * PERL_CALLCONV to be something special.  See also the
496  * definition of XS() in XSUB.h. */
497 #ifndef PERL_EXPORT_C
498 #  ifdef __cplusplus
499 #    define PERL_EXPORT_C extern "C"
500 #  else
501 #    define PERL_EXPORT_C extern
502 #  endif
503 #endif
504 #ifndef PERL_XS_EXPORT_C
505 #  ifdef __cplusplus
506 #    define PERL_XS_EXPORT_C extern "C"
507 #  else
508 #    define PERL_XS_EXPORT_C
509 #  endif
510 #endif
511
512 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
513 #  ifndef PERL_USE_GCC_BRACE_GROUPS
514 #    define PERL_USE_GCC_BRACE_GROUPS
515 #  endif
516 #endif
517
518 /*
519  * STMT_START { statements; } STMT_END;
520  * can be used as a single statement, as in
521  * if (x) STMT_START { ... } STMT_END; else ...
522  *
523  * Trying to select a version that gives no warnings...
524  */
525 #if !(defined(STMT_START) && defined(STMT_END))
526 # ifdef PERL_USE_GCC_BRACE_GROUPS
527 #   define STMT_START   (void)( /* gcc supports "({ STATEMENTS; })" */
528 #   define STMT_END     )
529 # else
530 #   define STMT_START   do
531 #   define STMT_END     while (0)
532 # endif
533 #endif
534
535 #ifndef BYTEORDER  /* Should never happen -- byteorder is in config.h */
536 #   define BYTEORDER 0x1234
537 #endif
538
539 /* Overall memory policy? */
540 #ifndef CONSERVATIVE
541 #   define LIBERAL 1
542 #endif
543
544 #if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90
545 #define ASCIIish
546 #else
547 #undef  ASCIIish
548 #endif
549
550 /*
551  * The following contortions are brought to you on behalf of all the
552  * standards, semi-standards, de facto standards, not-so-de-facto standards
553  * of the world, as well as all the other botches anyone ever thought of.
554  * The basic theory is that if we work hard enough here, the rest of the
555  * code can be a lot prettier.  Well, so much for theory.  Sorry, Henry...
556  */
557
558 /* define this once if either system, instead of cluttering up the src */
559 #if defined(MSDOS) || defined(WIN32) || defined(NETWARE)
560 #define DOSISH 1
561 #endif
562
563 #if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(NETWARE) || defined(__SYMBIAN32__)
564 # define STANDARD_C 1
565 #endif
566
567 #if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
568 # define DONT_DECLARE_STD 1
569 #endif
570
571 #if defined(HASVOLATILE) || defined(STANDARD_C)
572 #       define VOL volatile
573 #else
574 #   define VOL
575 #endif
576
577 /* By compiling a perl with -DNO_TAINT_SUPPORT or -DSILENT_NO_TAINT_SUPPORT,
578  * you get a perl without taint support, but doubtlessly with a lesser
579  * degree of support. Do not do so unless you know exactly what it means
580  * technically, have a good reason to do so, and know exactly how the
581  * perl will be used. perls with -DSILENT_NO_TAINT_SUPPORT are considered
582  * a potential security risk due to flat out ignoring the security-relevant
583  * taint flags. This being said, a perl without taint support compiled in
584  * has marginal run-time performance benefits.
585  * SILENT_NO_TAINT_SUPPORT implies NO_TAINT_SUPPORT.
586  * SILENT_NO_TAINT_SUPPORT is the same as NO_TAINT_SUPPORT except it
587  * silently ignores -t/-T instead of throwing an exception.
588  *
589  * DANGER! Using NO_TAINT_SUPPORT or SILENT_NO_TAINT_SUPPORT
590  *         voids your nonexistent warranty!
591  */
592 #if defined(SILENT_NO_TAINT_SUPPORT) && !defined(NO_TAINT_SUPPORT)
593 #  define NO_TAINT_SUPPORT 1
594 #endif
595
596 /* NO_TAINT_SUPPORT can be set to transform virtually all taint-related
597  * operations into no-ops for a very modest speed-up. Enable only if you
598  * know what you're doing: tests and CPAN modules' tests are bound to fail.
599  */
600 #ifdef NO_TAINT_SUPPORT
601 #   define TAINT                NOOP
602 #   define TAINT_NOT            NOOP
603 #   define TAINT_IF(c)          NOOP
604 #   define TAINT_ENV()          NOOP
605 #   define TAINT_PROPER(s)      NOOP
606 #   define TAINT_set(s)         NOOP
607 #   define TAINT_get            0
608 #   define TAINTING_get         0
609 #   define TAINTING_set(s)      NOOP
610 #   define TAINT_WARN_get       0
611 #   define TAINT_WARN_set(s)    NOOP
612 #else
613 #   define TAINT                (PL_tainted = TRUE)
614 #   define TAINT_NOT    (PL_tainted = FALSE)
615 #   define TAINT_IF(c)  if (UNLIKELY(c)) { PL_tainted = TRUE; }
616 #   define TAINT_ENV()  if (UNLIKELY(PL_tainting)) { taint_env(); }
617 #   define TAINT_PROPER(s)      if (UNLIKELY(PL_tainting)) { taint_proper(NULL, s); }
618 #   define TAINT_set(s)         (PL_tainted = (s))
619 #   define TAINT_get            (PL_tainted)
620 #   define TAINTING_get         (PL_tainting)
621 #   define TAINTING_set(s)      (PL_tainting = (s))
622 #   define TAINT_WARN_get       (PL_taint_warn)
623 #   define TAINT_WARN_set(s)    (PL_taint_warn = (s))
624 #endif
625
626 /* flags used internally only within pp_subst and pp_substcont */
627 #ifdef PERL_CORE
628 #  define SUBST_TAINT_STR      1        /* string tainted */
629 #  define SUBST_TAINT_PAT      2        /* pattern tainted */
630 #  define SUBST_TAINT_REPL     4        /* replacement tainted */
631 #  define SUBST_TAINT_RETAINT  8        /* use re'taint' in scope */
632 #  define SUBST_TAINT_BOOLRET 16        /* return is boolean (don't taint) */
633 #endif
634
635 /* XXX All process group stuff is handled in pp_sys.c.  Should these
636    defines move there?  If so, I could simplify this a lot. --AD  9/96.
637 */
638 /* Process group stuff changed from traditional BSD to POSIX.
639    perlfunc.pod documents the traditional BSD-style syntax, so we'll
640    try to preserve that, if possible.
641 */
642 #ifdef HAS_SETPGID
643 #  define BSD_SETPGRP(pid, pgrp)        setpgid((pid), (pgrp))
644 #else
645 #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
646 #    define BSD_SETPGRP(pid, pgrp)      setpgrp((pid), (pgrp))
647 #  else
648 #    ifdef HAS_SETPGRP2  /* DG/UX */
649 #      define BSD_SETPGRP(pid, pgrp)    setpgrp2((pid), (pgrp))
650 #    endif
651 #  endif
652 #endif
653 #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
654 #  define HAS_SETPGRP  /* Well, effectively it does . . . */
655 #endif
656
657 /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
658     our life easier :-) so we'll try it.
659 */
660 #ifdef HAS_GETPGID
661 #  define BSD_GETPGRP(pid)              getpgid((pid))
662 #else
663 #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
664 #    define BSD_GETPGRP(pid)            getpgrp((pid))
665 #  else
666 #    ifdef HAS_GETPGRP2  /* DG/UX */
667 #      define BSD_GETPGRP(pid)          getpgrp2((pid))
668 #    endif
669 #  endif
670 #endif
671 #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
672 #  define HAS_GETPGRP  /* Well, effectively it does . . . */
673 #endif
674
675 /* These are not exact synonyms, since setpgrp() and getpgrp() may
676    have different behaviors, but perl.h used to define USE_BSDPGRP
677    (prior to 5.003_05) so some extension might depend on it.
678 */
679 #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
680 #  ifndef USE_BSDPGRP
681 #    define USE_BSDPGRP
682 #  endif
683 #endif
684
685 /* HP-UX 10.X CMA (Common Multithreaded Architecture) insists that
686    pthread.h must be included before all other header files.
687 */
688 #if defined(USE_ITHREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD)
689 #  include <pthread.h>
690 #endif
691
692 #include <sys/types.h>
693
694 #ifdef __cplusplus
695 #  ifndef I_STDARG
696 #    define I_STDARG 1
697 #  endif
698 #endif
699
700 #ifdef I_STDARG
701 #  include <stdarg.h>
702 #else
703 #  ifdef I_VARARGS
704 #    include <varargs.h>
705 #  endif
706 #endif
707
708 #ifdef I_STDINT
709 # include <stdint.h>
710 #endif
711
712 #include <ctype.h>
713
714 #ifdef METHOD   /* Defined by OSF/1 v3.0 by ctype.h */
715 #undef METHOD
716 #endif
717
718 #ifdef PERL_MICRO
719 #   define NO_LOCALE
720 #endif
721
722 #ifdef I_LOCALE
723 #   include <locale.h>
724 #endif
725
726 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
727 #   define USE_LOCALE
728 #   define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
729                                    capability */
730 #   if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
731        && defined(HAS_STRXFRM)
732 #       define USE_LOCALE_COLLATE
733 #   endif
734 #   if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE)
735 #       define USE_LOCALE_CTYPE
736 #   endif
737 #   if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC)
738 #       define USE_LOCALE_NUMERIC
739 #   endif
740 #   if !defined(NO_LOCALE_MESSAGES) && defined(LC_MESSAGES)
741 #       define USE_LOCALE_MESSAGES
742 #   endif
743 #   if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY)
744 #       define USE_LOCALE_MONETARY
745 #   endif
746 #   if !defined(NO_LOCALE_TIME) && defined(LC_TIME)
747 #       define USE_LOCALE_TIME
748 #   endif
749 #   ifndef WIN32    /* No wrapper except on Windows */
750 #       define my_setlocale(a,b) setlocale(a,b)
751 #   endif
752 #endif /* !NO_LOCALE && HAS_SETLOCALE */
753
754 #include <setjmp.h>
755
756 #ifdef I_SYS_PARAM
757 #   ifdef PARAM_NEEDS_TYPES
758 #       include <sys/types.h>
759 #   endif
760 #   include <sys/param.h>
761 #endif
762
763 /* On BSD-derived systems, <sys/param.h> defines BSD to a year-month
764    value something like 199306.  This may be useful if no more-specific
765    feature test is available.
766 */
767 #if defined(BSD)
768 #   ifndef BSDish
769 #       define BSDish
770 #   endif
771 #endif
772
773 /* Use all the "standard" definitions? */
774 #if defined(STANDARD_C) && defined(I_STDLIB)
775 #   include <stdlib.h>
776 #endif
777
778 /* If this causes problems, set i_unistd=undef in the hint file.  */
779 #ifdef I_UNISTD
780 #   include <unistd.h>
781 #endif
782
783 /* for WCOREDUMP */
784 #ifdef I_SYS_WAIT
785 #   include <sys/wait.h>
786 #endif
787
788 #ifdef __SYMBIAN32__
789 #   undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */
790 #endif
791
792 #if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO)
793 EXTERN_C int syscall(int, ...);
794 #endif
795
796 #if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO)
797 EXTERN_C int usleep(unsigned int);
798 #endif
799
800 #ifdef PERL_CORE
801
802 /* macros for correct constant construction */
803 # if INTSIZE >= 2
804 #  define U16_CONST(x) ((U16)x##U)
805 # else
806 #  define U16_CONST(x) ((U16)x##UL)
807 # endif
808
809 # if INTSIZE >= 4
810 #  define U32_CONST(x) ((U32)x##U)
811 # else
812 #  define U32_CONST(x) ((U32)x##UL)
813 # endif
814
815 # ifdef HAS_QUAD
816 #  if INTSIZE >= 8
817 #   define U64_CONST(x) ((U64)x##U)
818 #  elif LONGSIZE >= 8
819 #   define U64_CONST(x) ((U64)x##UL)
820 #  elif QUADKIND == QUAD_IS_LONG_LONG
821 #   define U64_CONST(x) ((U64)x##ULL)
822 #  elif QUADKIND == QUAD_IS___INT64
823 #   define U64_CONST(x) ((U64)x##UI64)
824 #  else /* best guess we can make */
825 #   define U64_CONST(x) ((U64)x##UL)
826 #  endif
827 # endif
828
829 /* byte-swapping functions for big-/little-endian conversion */
830 # define _swab_16_(x) ((U16)( \
831          (((U16)(x) & U16_CONST(0x00ff)) << 8) | \
832          (((U16)(x) & U16_CONST(0xff00)) >> 8) ))
833
834 # define _swab_32_(x) ((U32)( \
835          (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \
836          (((U32)(x) & U32_CONST(0x0000ff00)) <<  8) | \
837          (((U32)(x) & U32_CONST(0x00ff0000)) >>  8) | \
838          (((U32)(x) & U32_CONST(0xff000000)) >> 24) ))
839
840 # ifdef HAS_QUAD
841 #  define _swab_64_(x) ((U64)( \
842           (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \
843           (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \
844           (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \
845           (((U64)(x) & U64_CONST(0x00000000ff000000)) <<  8) | \
846           (((U64)(x) & U64_CONST(0x000000ff00000000)) >>  8) | \
847           (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \
848           (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \
849           (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) ))
850 # endif
851
852 /* The old value was hard coded at 1008. (4096-16) seems to be a bit faster,
853    at least on FreeBSD.  YMMV, so experiment.  */
854 #ifndef PERL_ARENA_SIZE
855 #define PERL_ARENA_SIZE 4080
856 #endif
857
858 /* Maximum level of recursion */
859 #ifndef PERL_SUB_DEPTH_WARN
860 #define PERL_SUB_DEPTH_WARN 100
861 #endif
862
863 #endif /* PERL_CORE */
864
865 /* We no longer default to creating a new SV for GvSV.
866    Do this before embed.  */
867 #ifndef PERL_CREATE_GVSV
868 #  ifndef PERL_DONT_CREATE_GVSV
869 #    define PERL_DONT_CREATE_GVSV
870 #  endif
871 #endif
872
873 #if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
874 #define PERL_USES_PL_PIDSTATUS
875 #endif
876
877 #if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(__SYMBIAN32__)
878 #define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
879 #endif
880
881 #define MEM_SIZE Size_t
882
883 /* Round all values passed to malloc up, by default to a multiple of
884    sizeof(size_t)
885 */
886 #ifndef PERL_STRLEN_ROUNDUP_QUANTUM
887 #define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size
888 #endif
889
890 /* sv_grow() will expand strings by at least a certain percentage of
891    the previously *used* length to avoid excessive calls to realloc().
892    The default is 25% of the current length.
893 */
894 #ifndef PERL_STRLEN_EXPAND_SHIFT
895 #  define PERL_STRLEN_EXPAND_SHIFT 2
896 #endif
897
898 #if defined(STANDARD_C) && defined(I_STDDEF) && !defined(PERL_GCC_PEDANTIC)
899 #   include <stddef.h>
900 #   define STRUCT_OFFSET(s,m)  offsetof(s,m)
901 #else
902 #   define STRUCT_OFFSET(s,m)  (Size_t)(&(((s *)0)->m))
903 #endif
904
905 /* ptrdiff_t is C11, so undef it under pedantic builds */
906 #ifdef PERL_GCC_PEDANTIC
907 #   undef HAS_PTRDIFF_T
908 #endif
909
910 #ifndef __SYMBIAN32__
911 #  if defined(I_STRING) || defined(__cplusplus)
912 #     include <string.h>
913 #  else
914 #     include <strings.h>
915 #  endif
916 #endif
917
918 /* This comes after <stdlib.h> so we don't try to change the standard
919  * library prototypes; we'll use our own in proto.h instead. */
920
921 #ifdef MYMALLOC
922 #  ifdef PERL_POLLUTE_MALLOC
923 #   ifndef PERL_EXTMALLOC_DEF
924 #    define Perl_malloc         malloc
925 #    define Perl_calloc         calloc
926 #    define Perl_realloc        realloc
927 #    define Perl_mfree          free
928 #   endif
929 #  else
930 #    define EMBEDMYMALLOC       /* for compatibility */
931 #  endif
932
933 #  define safemalloc  Perl_malloc
934 #  define safecalloc  Perl_calloc
935 #  define saferealloc Perl_realloc
936 #  define safefree    Perl_mfree
937 #  define CHECK_MALLOC_TOO_LATE_FOR_(code)      STMT_START {            \
938         if (!PL_tainting && MallocCfg_ptr[MallocCfg_cfg_env_read])      \
939                 code;                                                   \
940     } STMT_END
941 #  define CHECK_MALLOC_TOO_LATE_FOR(ch)                         \
942         CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch))
943 #  define panic_write2(s)               write(2, s, strlen(s))
944 #  define CHECK_MALLOC_TAINT(newval)                            \
945         CHECK_MALLOC_TOO_LATE_FOR_(                             \
946                 if (newval) {                                   \
947                   PERL_UNUSED_RESULT(panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n"));\
948                   exit(1); })
949 #  define MALLOC_CHECK_TAINT(argc,argv,env)     STMT_START {    \
950         if (doing_taint(argc,argv,env)) {                       \
951                 MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1;      \
952     }} STMT_END;
953 #else  /* MYMALLOC */
954 #  define safemalloc  safesysmalloc
955 #  define safecalloc  safesyscalloc
956 #  define saferealloc safesysrealloc
957 #  define safefree    safesysfree
958 #  define CHECK_MALLOC_TOO_LATE_FOR(ch)         ((void)0)
959 #  define CHECK_MALLOC_TAINT(newval)            ((void)0)
960 #  define MALLOC_CHECK_TAINT(argc,argv,env)
961 #endif /* MYMALLOC */
962
963 /* diag_listed_as: "-T" is on the #! line, it must also be used on the command line */
964 #define TOO_LATE_FOR_(ch,what)  Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what)
965 #define TOO_LATE_FOR(ch)        TOO_LATE_FOR_(ch, "")
966 #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}")
967 #define MALLOC_CHECK_TAINT2(argc,argv)  MALLOC_CHECK_TAINT(argc,argv,NULL)
968
969 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
970 #define strchr index
971 #define strrchr rindex
972 #endif
973
974 #ifdef I_MEMORY
975 #  include <memory.h>
976 #endif
977
978 #ifdef HAS_MEMCPY
979 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
980 #    ifndef memcpy
981         extern char * memcpy (char*, char*, int);
982 #    endif
983 #  endif
984 #else
985 #   ifndef memcpy
986 #       ifdef HAS_BCOPY
987 #           define memcpy(d,s,l) bcopy(s,d,l)
988 #       else
989 #           define memcpy(d,s,l) my_bcopy(s,d,l)
990 #       endif
991 #   endif
992 #endif /* HAS_MEMCPY */
993
994 #ifdef HAS_MEMSET
995 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
996 #    ifndef memset
997         extern char *memset (char*, int, int);
998 #    endif
999 #  endif
1000 #else
1001 #  undef  memset
1002 #  define memset(d,c,l) my_memset(d,c,l)
1003 #endif /* HAS_MEMSET */
1004
1005 #if !defined(HAS_MEMMOVE) && !defined(memmove)
1006 #   if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
1007 #       define memmove(d,s,l) bcopy(s,d,l)
1008 #   else
1009 #       if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
1010 #           define memmove(d,s,l) memcpy(d,s,l)
1011 #       else
1012 #           define memmove(d,s,l) my_bcopy(s,d,l)
1013 #       endif
1014 #   endif
1015 #endif
1016
1017 #if defined(mips) && defined(ultrix) && !defined(__STDC__)
1018 #   undef HAS_MEMCMP
1019 #endif
1020
1021 #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
1022 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
1023 #    ifndef memcmp
1024         extern int memcmp (char*, char*, int);
1025 #    endif
1026 #  endif
1027 #else
1028 #   ifndef memcmp
1029 #       define memcmp   my_memcmp
1030 #   endif
1031 #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
1032
1033 #ifndef memzero
1034 #   ifdef HAS_MEMSET
1035 #       define memzero(d,l) memset(d,0,l)
1036 #   else
1037 #       ifdef HAS_BZERO
1038 #           define memzero(d,l) bzero(d,l)
1039 #       else
1040 #           define memzero(d,l) my_bzero(d,l)
1041 #       endif
1042 #   endif
1043 #endif
1044
1045 #ifndef PERL_MICRO
1046 #ifndef memchr
1047 #   ifndef HAS_MEMCHR
1048 #       define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1)
1049 #   endif
1050 #endif
1051 #endif
1052
1053 #ifndef HAS_BCMP
1054 #   ifndef bcmp
1055 #       define bcmp(s1,s2,l) memcmp(s1,s2,l)
1056 #   endif
1057 #endif /* !HAS_BCMP */
1058
1059 #ifdef I_NETINET_IN
1060 #   include <netinet/in.h>
1061 #endif
1062
1063 #ifdef I_ARPA_INET
1064 #   include <arpa/inet.h>
1065 #endif
1066
1067 #ifdef I_SYS_STAT
1068 #   include <sys/stat.h>
1069 #endif
1070
1071 /* Microsoft VC's sys/stat.h defines all S_Ixxx macros except S_IFIFO.
1072    This definition should ideally go into win32/win32.h, but S_IFIFO is
1073    used later here in perl.h before win32/win32.h is being included. */
1074 #if !defined(S_IFIFO) && defined(_S_IFIFO)
1075 #   define S_IFIFO _S_IFIFO
1076 #endif
1077
1078 /* The stat macros for Unisoft System V/88 (and derivatives
1079    like UTekV) are broken, sometimes giving false positives.  Undefine
1080    them here and let the code below set them to proper values.
1081
1082    The ghs macro stands for GreenHills Software C-1.8.5 which
1083    is the C compiler for sysV88 and the various derivatives.
1084    This header file bug is corrected in gcc-2.5.8 and later versions.
1085    --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94.  */
1086
1087 #if defined(m88k) && defined(ghs)
1088 #   undef S_ISDIR
1089 #   undef S_ISCHR
1090 #   undef S_ISBLK
1091 #   undef S_ISREG
1092 #   undef S_ISFIFO
1093 #   undef S_ISLNK
1094 #endif
1095
1096 #ifdef I_TIME
1097 #   include <time.h>
1098 #endif
1099
1100 #ifdef I_SYS_TIME
1101 #   ifdef I_SYS_TIME_KERNEL
1102 #       define KERNEL
1103 #   endif
1104 #   include <sys/time.h>
1105 #   ifdef I_SYS_TIME_KERNEL
1106 #       undef KERNEL
1107 #   endif
1108 #endif
1109
1110 #if defined(HAS_TIMES) && defined(I_SYS_TIMES)
1111 #    include <sys/times.h>
1112 #endif
1113
1114 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
1115 #   undef HAS_STRERROR
1116 #endif
1117
1118 #include <errno.h>
1119
1120 #if defined(WIN32) && defined(PERL_IMPLICIT_SYS)
1121 #  define WIN32SCK_IS_STDSCK            /* don't pull in custom wsock layer */
1122 #endif
1123
1124 /* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one.
1125  * This is important for using IPv6.
1126  * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be
1127  * a bad idea since it breaks send() and recv(). */
1128 #if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X)
1129 #   define _SOCKADDR_LEN
1130 #endif
1131
1132 #if defined(HAS_SOCKET) && !defined(WIN32) /* WIN32 handles sockets via win32.h */
1133 # include <sys/socket.h>
1134 # if defined(USE_SOCKS) && defined(I_SOCKS)
1135 #   if !defined(INCLUDE_PROTOTYPES)
1136 #       define INCLUDE_PROTOTYPES /* for <socks.h> */
1137 #       define PERL_SOCKS_NEED_PROTOTYPES
1138 #   endif
1139 #   include <socks.h>
1140 #   ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
1141 #       undef INCLUDE_PROTOTYPES
1142 #       undef PERL_SOCKS_NEED_PROTOTYPES
1143 #   endif
1144 # endif
1145 # ifdef I_NETDB
1146 #  ifdef NETWARE
1147 #   include<stdio.h>
1148 #  endif
1149 #  include <netdb.h>
1150 # endif
1151 # ifndef ENOTSOCK
1152 #  ifdef I_NET_ERRNO
1153 #   include <net/errno.h>
1154 #  endif
1155 # endif
1156 #endif
1157
1158 /* sockatmark() is so new (2001) that many places might have it hidden
1159  * behind some -D_BLAH_BLAH_SOURCE guard.  The __THROW magic is required
1160  * e.g. in Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */
1161 #if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO)
1162 # if defined(__THROW) && defined(__GLIBC__)
1163 int sockatmark(int) __THROW;
1164 # else
1165 int sockatmark(int);
1166 # endif
1167 #endif
1168
1169 #if defined(__osf__) && defined(__cplusplus) && !defined(_XOPEN_SOURCE_EXTENDED) /* Tru64 "cxx" (C++), see hints/dec_osf.sh for why the _XOPEN_SOURCE_EXTENDED cannot be defined. */
1170 EXTERN_C int fchdir(int);
1171 EXTERN_C int flock(int, int);
1172 EXTERN_C int fseeko(FILE *, off_t, int);
1173 EXTERN_C off_t ftello(FILE *);
1174 #endif
1175
1176 #if defined(__SUNPRO_CC) /* SUNWspro CC (C++) */
1177 EXTERN_C char *crypt(const char *, const char *);
1178 EXTERN_C char **environ;
1179 #endif
1180
1181 #if defined(__cplusplus)
1182 #  if defined(BSDish)
1183 EXTERN_C char **environ;
1184 #  elif defined(__CYGWIN__)
1185 EXTERN_C char *crypt(const char *, const char *);
1186 #endif
1187 #endif
1188
1189 #ifdef SETERRNO
1190 # undef SETERRNO  /* SOCKS might have defined this */
1191 #endif
1192
1193 #ifdef VMS
1194 #   define SETERRNO(errcode,vmserrcode) \
1195         STMT_START {                    \
1196             set_errno(errcode);         \
1197             set_vaxc_errno(vmserrcode); \
1198         } STMT_END
1199 #   define dSAVEDERRNO    int saved_errno; unsigned saved_vms_errno
1200 #   define dSAVE_ERRNO    int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno
1201 #   define SAVE_ERRNO     ( saved_errno = errno, saved_vms_errno = vaxc$errno )
1202 #   define RESTORE_ERRNO  SETERRNO(saved_errno, saved_vms_errno)
1203
1204 #   define LIB_INVARG           LIB$_INVARG
1205 #   define RMS_DIR              RMS$_DIR
1206 #   define RMS_FAC              RMS$_FAC
1207 #   define RMS_FEX              RMS$_FEX
1208 #   define RMS_FNF              RMS$_FNF
1209 #   define RMS_IFI              RMS$_IFI
1210 #   define RMS_ISI              RMS$_ISI
1211 #   define RMS_PRV              RMS$_PRV
1212 #   define SS_ACCVIO            SS$_ACCVIO
1213 #   define SS_DEVOFFLINE        SS$_DEVOFFLINE
1214 #   define SS_IVCHAN            SS$_IVCHAN
1215 #   define SS_NORMAL            SS$_NORMAL
1216 #   define SS_NOPRIV            SS$_NOPRIV
1217 #else
1218 #   define LIB_INVARG           0
1219 #   define RMS_DIR              0
1220 #   define RMS_FAC              0
1221 #   define RMS_FEX              0
1222 #   define RMS_FNF              0
1223 #   define RMS_IFI              0
1224 #   define RMS_ISI              0
1225 #   define RMS_PRV              0
1226 #   define SS_ACCVIO            0
1227 #   define SS_DEVOFFLINE        0
1228 #   define SS_IVCHAN            0
1229 #   define SS_NORMAL            0
1230 #   define SS_NOPRIV            0
1231 #endif
1232
1233 #ifdef WIN32
1234 #   define dSAVEDERRNO  int saved_errno; DWORD saved_win32_errno
1235 #   define dSAVE_ERRNO  int saved_errno = errno; DWORD saved_win32_errno = GetLastError()
1236 #   define SAVE_ERRNO   ( saved_errno = errno, saved_win32_errno = GetLastError() )
1237 #   define RESTORE_ERRNO ( errno = saved_errno, SetLastError(saved_win32_errno) )
1238 #endif
1239
1240 #ifdef OS2
1241 #   define dSAVEDERRNO  int saved_errno; unsigned long saved_os2_errno
1242 #   define dSAVE_ERRNO  int saved_errno = errno; unsigned long saved_os2_errno = Perl_rc
1243 #   define SAVE_ERRNO   ( saved_errno = errno, saved_os2_errno = Perl_rc )
1244 #   define RESTORE_ERRNO ( errno = saved_errno, Perl_rc = saved_os2_errno )
1245 #endif
1246
1247 #ifndef SETERRNO
1248 #   define SETERRNO(errcode,vmserrcode) (errno = (errcode))
1249 #endif
1250
1251 #ifndef dSAVEDERRNO
1252 #   define dSAVEDERRNO    int saved_errno
1253 #   define dSAVE_ERRNO    int saved_errno = errno
1254 #   define SAVE_ERRNO     (saved_errno = errno)
1255 #   define RESTORE_ERRNO  (errno = saved_errno)
1256 #endif
1257
1258 #define ERRSV GvSVn(PL_errgv)
1259
1260 #define CLEAR_ERRSV() STMT_START {                                      \
1261     if (!GvSV(PL_errgv)) {                                              \
1262         sv_setpvs(GvSV(gv_add_by_type(PL_errgv, SVt_PV)), "");          \
1263     } else if (SvREADONLY(GvSV(PL_errgv))) {                            \
1264         SvREFCNT_dec(GvSV(PL_errgv));                                   \
1265         GvSV(PL_errgv) = newSVpvs("");                                  \
1266     } else {                                                            \
1267         SV *const errsv = GvSV(PL_errgv);                               \
1268         sv_setpvs(errsv, "");                                           \
1269         if (SvMAGICAL(errsv)) {                                         \
1270             mg_free(errsv);                                             \
1271         }                                                               \
1272         SvPOK_only(errsv);                                              \
1273     }                                                                   \
1274     } STMT_END
1275
1276
1277 #ifdef PERL_CORE
1278 # define DEFSV (0 + GvSVn(PL_defgv))
1279 # define DEFSV_set(sv) \
1280     (SvREFCNT_dec(GvSV(PL_defgv)), GvSV(PL_defgv) = SvREFCNT_inc(sv))
1281 # define SAVE_DEFSV                \
1282     (                               \
1283         save_gp(PL_defgv, 0),        \
1284         GvINTRO_off(PL_defgv),        \
1285         SAVEGENERICSV(GvSV(PL_defgv)), \
1286         GvSV(PL_defgv) = NULL           \
1287     )
1288 #else
1289 # define DEFSV GvSVn(PL_defgv)
1290 # define DEFSV_set(sv) (GvSV(PL_defgv) = (sv))
1291 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
1292 #endif
1293
1294 #ifndef errno
1295         extern int errno;     /* ANSI allows errno to be an lvalue expr.
1296                                * For example in multithreaded environments
1297                                * something like this might happen:
1298                                * extern int *_errno(void);
1299                                * #define errno (*_errno()) */
1300 #endif
1301
1302 #define UNKNOWN_ERRNO_MSG "(unknown)"
1303
1304 #ifdef HAS_STRERROR
1305 #   ifndef DONT_DECLARE_STD
1306 #       ifdef VMS
1307         char *strerror (int,...);
1308 #       else
1309         char *strerror (int);
1310 #       endif
1311 #    endif
1312 #    ifndef Strerror
1313 #       define Strerror strerror
1314 #    endif
1315 #else
1316 #    ifdef HAS_SYS_ERRLIST
1317         extern int sys_nerr;
1318         extern char *sys_errlist[];
1319 #       ifndef Strerror
1320 #           define Strerror(e) \
1321                 ((e) < 0 || (e) >= sys_nerr ? UNKNOWN_ERRNO_MSG : sys_errlist[e])
1322 #       endif
1323 #   endif
1324 #endif
1325
1326 #ifdef I_SYS_IOCTL
1327 #   ifndef _IOCTL_
1328 #       include <sys/ioctl.h>
1329 #   endif
1330 #endif
1331
1332 #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
1333 #   ifdef HAS_SOCKETPAIR
1334 #       undef HAS_SOCKETPAIR
1335 #   endif
1336 #   ifdef I_NDBM
1337 #       undef I_NDBM
1338 #   endif
1339 #endif
1340
1341 #ifndef HAS_SOCKETPAIR
1342 #   ifdef HAS_SOCKET
1343 #       define socketpair Perl_my_socketpair
1344 #   endif
1345 #endif
1346
1347 #if INTSIZE == 2
1348 #   define htoni htons
1349 #   define ntohi ntohs
1350 #else
1351 #   define htoni htonl
1352 #   define ntohi ntohl
1353 #endif
1354
1355 /* Configure already sets Direntry_t */
1356 #if defined(I_DIRENT)
1357 #   include <dirent.h>
1358 #else
1359 #   ifdef I_SYS_NDIR
1360 #       include <sys/ndir.h>
1361 #   else
1362 #       ifdef I_SYS_DIR
1363 #           ifdef hp9000s500
1364 #               include <ndir.h>        /* may be wrong in the future */
1365 #           else
1366 #               include <sys/dir.h>
1367 #           endif
1368 #       endif
1369 #   endif
1370 #endif
1371
1372 /*
1373  * The following gobbledygook brought to you on behalf of __STDC__.
1374  * (I could just use #ifndef __STDC__, but this is more bulletproof
1375  * in the face of half-implementations.)
1376  */
1377
1378 #if defined(I_SYSMODE)
1379 #include <sys/mode.h>
1380 #endif
1381
1382 #ifndef S_IFMT
1383 #   ifdef _S_IFMT
1384 #       define S_IFMT _S_IFMT
1385 #   else
1386 #       define S_IFMT 0170000
1387 #   endif
1388 #endif
1389
1390 #ifndef S_ISDIR
1391 #   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
1392 #endif
1393
1394 #ifndef S_ISCHR
1395 #   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
1396 #endif
1397
1398 #ifndef S_ISBLK
1399 #   ifdef S_IFBLK
1400 #       define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
1401 #   else
1402 #       define S_ISBLK(m) (0)
1403 #   endif
1404 #endif
1405
1406 #ifndef S_ISREG
1407 #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
1408 #endif
1409
1410 #ifndef S_ISFIFO
1411 #   ifdef S_IFIFO
1412 #       define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
1413 #   else
1414 #       define S_ISFIFO(m) (0)
1415 #   endif
1416 #endif
1417
1418 #ifndef S_ISLNK
1419 #   ifdef _S_ISLNK
1420 #       define S_ISLNK(m) _S_ISLNK(m)
1421 #   else
1422 #       ifdef _S_IFLNK
1423 #           define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
1424 #       else
1425 #           ifdef S_IFLNK
1426 #               define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
1427 #           else
1428 #               define S_ISLNK(m) (0)
1429 #           endif
1430 #       endif
1431 #   endif
1432 #endif
1433
1434 #ifndef S_ISSOCK
1435 #   ifdef _S_ISSOCK
1436 #       define S_ISSOCK(m) _S_ISSOCK(m)
1437 #   else
1438 #       ifdef _S_IFSOCK
1439 #           define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
1440 #       else
1441 #           ifdef S_IFSOCK
1442 #               define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
1443 #           else
1444 #               define S_ISSOCK(m) (0)
1445 #           endif
1446 #       endif
1447 #   endif
1448 #endif
1449
1450 #ifndef S_IRUSR
1451 #   ifdef S_IREAD
1452 #       define S_IRUSR S_IREAD
1453 #       define S_IWUSR S_IWRITE
1454 #       define S_IXUSR S_IEXEC
1455 #   else
1456 #       define S_IRUSR 0400
1457 #       define S_IWUSR 0200
1458 #       define S_IXUSR 0100
1459 #   endif
1460 #endif
1461
1462 #ifndef S_IRGRP
1463 #   ifdef S_IRUSR
1464 #       define S_IRGRP (S_IRUSR>>3)
1465 #       define S_IWGRP (S_IWUSR>>3)
1466 #       define S_IXGRP (S_IXUSR>>3)
1467 #   else
1468 #       define S_IRGRP 0040
1469 #       define S_IWGRP 0020
1470 #       define S_IXGRP 0010
1471 #   endif
1472 #endif
1473
1474 #ifndef S_IROTH
1475 #   ifdef S_IRUSR
1476 #       define S_IROTH (S_IRUSR>>6)
1477 #       define S_IWOTH (S_IWUSR>>6)
1478 #       define S_IXOTH (S_IXUSR>>6)
1479 #   else
1480 #       define S_IROTH 0040
1481 #       define S_IWOTH 0020
1482 #       define S_IXOTH 0010
1483 #   endif
1484 #endif
1485
1486 #ifndef S_ISUID
1487 #   define S_ISUID 04000
1488 #endif
1489
1490 #ifndef S_ISGID
1491 #   define S_ISGID 02000
1492 #endif
1493
1494 #ifndef S_IRWXU
1495 #   define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR)
1496 #endif
1497
1498 #ifndef S_IRWXG
1499 #   define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP)
1500 #endif
1501
1502 #ifndef S_IRWXO
1503 #   define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
1504 #endif
1505
1506 /* Haiku R1 seems to define S_IREAD and S_IWRITE in <posix/fcntl.h>
1507  * which would get included through <sys/file.h >, but that is 3000
1508  * lines in the future.  --jhi */
1509
1510 #if !defined(S_IREAD) && !defined(__HAIKU__)
1511 #   define S_IREAD S_IRUSR
1512 #endif
1513
1514 #if !defined(S_IWRITE) && !defined(__HAIKU__)
1515 #   define S_IWRITE S_IWUSR
1516 #endif
1517
1518 #ifndef S_IEXEC
1519 #   define S_IEXEC S_IXUSR
1520 #endif
1521
1522 #if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
1523 #   define SLOPPYDIVIDE
1524 #endif
1525
1526 #ifdef UV
1527 #undef UV
1528 #endif
1529
1530 /* For the times when you want the return value of sprintf, and you want it
1531    to be the length. Can't have a thread variable passed in, because C89 has
1532    no varargs macros.
1533 */
1534 #ifdef SPRINTF_RETURNS_STRLEN
1535 #  define my_sprintf sprintf
1536 #else
1537 #  define my_sprintf Perl_my_sprintf
1538 #endif
1539
1540 /*
1541  * If we have v?snprintf() and the C99 variadic macros, we can just
1542  * use just the v?snprintf().  It is nice to try to trap the buffer
1543  * overflow, however, so if we are DEBUGGING, and we cannot use the
1544  * gcc statement expressions, then use the function wrappers which try
1545  * to trap the overflow.  If we can use the gcc statement expressions,
1546  * we can try that even with the version that uses the C99 variadic
1547  * macros.
1548  */
1549
1550 /* Note that we do not check against snprintf()/vsnprintf() returning
1551  * negative values because that is non-standard behaviour and we use
1552  * snprintf/vsnprintf only iff HAS_VSNPRINTF has been defined, and
1553  * that should be true only if the snprintf()/vsnprintf() are true
1554  * to the standard. */
1555
1556 #define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len >= (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END
1557
1558 #if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
1559 #  ifdef PERL_USE_GCC_BRACE_GROUPS
1560 #      define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; })
1561 #      define PERL_MY_SNPRINTF_GUARDED
1562 #  else
1563 #    define my_snprintf(buffer, max, ...) snprintf(buffer, max, __VA_ARGS__)
1564 #  endif
1565 #else
1566 #  define my_snprintf  Perl_my_snprintf
1567 #  define PERL_MY_SNPRINTF_GUARDED
1568 #endif
1569
1570 #if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
1571 #  ifdef PERL_USE_GCC_BRACE_GROUPS
1572 #      define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; })
1573 #      define PERL_MY_VSNPRINTF_GUARDED
1574 #  else
1575 #    define my_vsnprintf(buffer, max, ...) vsnprintf(buffer, max, __VA_ARGS__)
1576 #  endif
1577 #else
1578 #  define my_vsnprintf Perl_my_vsnprintf
1579 #  define PERL_MY_VSNPRINTF_GUARDED
1580 #endif
1581
1582 /* You will definitely need to use the PERL_MY_SNPRINTF_POST_GUARD()
1583  * or PERL_MY_VSNPRINTF_POST_GUARD() if you otherwise decide to ignore
1584  * the result of my_snprintf() or my_vsnprintf().  (No, you should not
1585  * completely ignore it: otherwise you cannot know whether your output
1586  * was too long.)
1587  *
1588  * int len = my_sprintf(buf, max, ...);
1589  * PERL_MY_SNPRINTF_POST_GUARD(len, max);
1590  *
1591  * The trick is that in certain platforms [a] the my_sprintf() already
1592  * contains the sanity check, while in certain platforms [b] it needs
1593  * to be done as a separate step.  The POST_GUARD is that step-- in [a]
1594  * platforms the POST_GUARD actually does nothing since the check has
1595  * already been done.  Watch out for the max being the same in both calls.
1596  *
1597  * If you actually use the snprintf/vsnprintf return value already,
1598  * you assumedly are checking its validity somehow.  But you can
1599  * insert the POST_GUARD() also in that case. */
1600
1601 #ifndef PERL_MY_SNPRINTF_GUARDED
1602 #  define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, snprintf)
1603 #else
1604 #  define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len)
1605 #endif
1606
1607 #ifndef  PERL_MY_VSNPRINTF_GUARDED
1608 #  define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, vsnprintf)
1609 #else
1610 #  define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len)
1611 #endif
1612
1613 #ifdef HAS_STRLCAT
1614 #  define my_strlcat    strlcat
1615 #else
1616 #  define my_strlcat    Perl_my_strlcat
1617 #endif
1618
1619 #ifdef HAS_STRLCPY
1620 #  define my_strlcpy    strlcpy
1621 #else
1622 #  define my_strlcpy    Perl_my_strlcpy
1623 #endif
1624
1625 /*
1626     The IV type is supposed to be long enough to hold any integral
1627     value or a pointer.
1628     --Andy Dougherty    August 1996
1629 */
1630
1631 typedef IVTYPE IV;
1632 typedef UVTYPE UV;
1633
1634 #if defined(USE_64_BIT_INT) && defined(HAS_QUAD)
1635 #  if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX)
1636 #    define IV_MAX INT64_MAX
1637 #    define IV_MIN INT64_MIN
1638 #    define UV_MAX UINT64_MAX
1639 #    ifndef UINT64_MIN
1640 #      define UINT64_MIN 0
1641 #    endif
1642 #    define UV_MIN UINT64_MIN
1643 #  else
1644 #    define IV_MAX PERL_QUAD_MAX
1645 #    define IV_MIN PERL_QUAD_MIN
1646 #    define UV_MAX PERL_UQUAD_MAX
1647 #    define UV_MIN PERL_UQUAD_MIN
1648 #  endif
1649 #  define IV_IS_QUAD
1650 #  define UV_IS_QUAD
1651 #else
1652 #  if defined(INT32_MAX) && IVSIZE == 4
1653 #    define IV_MAX INT32_MAX
1654 #    define IV_MIN INT32_MIN
1655 #    ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */
1656 #        define UV_MAX UINT32_MAX
1657 #    else
1658 #        define UV_MAX 4294967295U
1659 #    endif
1660 #    ifndef UINT32_MIN
1661 #      define UINT32_MIN 0
1662 #    endif
1663 #    define UV_MIN UINT32_MIN
1664 #  else
1665 #    define IV_MAX PERL_LONG_MAX
1666 #    define IV_MIN PERL_LONG_MIN
1667 #    define UV_MAX PERL_ULONG_MAX
1668 #    define UV_MIN PERL_ULONG_MIN
1669 #  endif
1670 #  if IVSIZE == 8
1671 #    define IV_IS_QUAD
1672 #    define UV_IS_QUAD
1673 #    ifndef HAS_QUAD
1674 #      define HAS_QUAD
1675 #    endif
1676 #  else
1677 #    undef IV_IS_QUAD
1678 #    undef UV_IS_QUAD
1679 #if !defined(PERL_CORE) || defined(USING_MSVC6)
1680 /* We think that removing this decade-old undef this will cause too much
1681    breakage on CPAN for too little gain. (See RT #119753)
1682    However, we do need HAS_QUAD in the core for use by the drand48 code,
1683    but not for Win32 VC6 because it has poor __int64 support. */
1684 #    undef HAS_QUAD
1685 #endif
1686 #  endif
1687 #endif
1688
1689 #define Size_t_MAX (~(Size_t)0)
1690 #define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1)
1691
1692 #define IV_DIG (BIT_DIGITS(IVSIZE * 8))
1693 #define UV_DIG (BIT_DIGITS(UVSIZE * 8))
1694
1695 #ifndef NO_PERL_PRESERVE_IVUV
1696 #define PERL_PRESERVE_IVUV      /* We like our integers to stay integers. */
1697 #endif
1698
1699 /*
1700  *  The macros INT2PTR and NUM2PTR are (despite their names)
1701  *  bi-directional: they will convert int/float to or from pointers.
1702  *  However the conversion to int/float are named explicitly:
1703  *  PTR2IV, PTR2UV, PTR2NV.
1704  *
1705  *  For int conversions we do not need two casts if pointers are
1706  *  the same size as IV and UV.   Otherwise we need an explicit
1707  *  cast (PTRV) to avoid compiler warnings.
1708  */
1709 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
1710 #  define PTRV                  UV
1711 #  define INT2PTR(any,d)        (any)(d)
1712 #else
1713 #  if PTRSIZE == LONGSIZE
1714 #    define PTRV                unsigned long
1715 #    define PTR2ul(p)           (unsigned long)(p)
1716 #  else
1717 #    define PTRV                unsigned
1718 #  endif
1719 #endif
1720
1721 #ifndef INT2PTR
1722 #  define INT2PTR(any,d)        (any)(PTRV)(d)
1723 #endif
1724
1725 #ifndef PTR2ul
1726 #  define PTR2ul(p)     INT2PTR(unsigned long,p)        
1727 #endif
1728
1729 #define NUM2PTR(any,d)  (any)(PTRV)(d)
1730 #define PTR2IV(p)       INT2PTR(IV,p)
1731 #define PTR2UV(p)       INT2PTR(UV,p)
1732 #define PTR2NV(p)       NUM2PTR(NV,p)
1733 #define PTR2nat(p)      (PTRV)(p)       /* pointer to integer of PTRSIZE */
1734
1735 /* According to strict ANSI C89 one cannot freely cast between
1736  * data pointers and function (code) pointers.  There are at least
1737  * two ways around this.  One (used below) is to do two casts,
1738  * first the other pointer to an (unsigned) integer, and then
1739  * the integer to the other pointer.  The other way would be
1740  * to use unions to "overlay" the pointers.  For an example of
1741  * the latter technique, see union dirpu in struct xpvio in sv.h.
1742  * The only feasible use is probably temporarily storing
1743  * function pointers in a data pointer (such as a void pointer). */
1744
1745 #define DPTR2FPTR(t,p) ((t)PTR2nat(p))  /* data pointer to function pointer */
1746 #define FPTR2DPTR(t,p) ((t)PTR2nat(p))  /* function pointer to data pointer */
1747
1748 #ifdef USE_LONG_DOUBLE
1749 #  if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
1750 #      define LONG_DOUBLE_EQUALS_DOUBLE
1751 #  endif
1752 #  if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE))
1753 #     undef USE_LONG_DOUBLE /* Ouch! */
1754 #  endif
1755 #endif
1756
1757 #ifdef OVR_DBL_DIG
1758 /* Use an overridden DBL_DIG */
1759 # ifdef DBL_DIG
1760 #  undef DBL_DIG
1761 # endif
1762 # define DBL_DIG OVR_DBL_DIG
1763 #else
1764 /* The following is all to get DBL_DIG, in order to pick a nice
1765    default value for printing floating point numbers in Gconvert
1766    (see config.h). (It also has other uses, such as figuring out if
1767    a given precision of printing can be done with a double instead of
1768    a long double - Allen).
1769 */
1770 #ifdef I_LIMITS
1771 #include <limits.h>
1772 #endif
1773 #ifdef I_FLOAT
1774 #include <float.h>
1775 #endif
1776 #ifndef HAS_DBL_DIG
1777 #define DBL_DIG 15   /* A guess that works lots of places */
1778 #endif
1779 #endif
1780
1781 #ifdef OVR_LDBL_DIG
1782 /* Use an overridden LDBL_DIG */
1783 # ifdef LDBL_DIG
1784 #  undef LDBL_DIG
1785 # endif
1786 # define LDBL_DIG OVR_LDBL_DIG
1787 #else
1788 /* The following is all to get LDBL_DIG, in order to pick a nice
1789    default value for printing floating point numbers in Gconvert.
1790    (see config.h)
1791 */
1792 # ifdef I_LIMITS
1793 #   include <limits.h>
1794 # endif
1795 # ifdef I_FLOAT
1796 #  include <float.h>
1797 # endif
1798 # ifndef HAS_LDBL_DIG
1799 #  if LONG_DOUBLESIZE == 10
1800 #   define LDBL_DIG 18 /* assume IEEE */
1801 #  else
1802 #   if LONG_DOUBLESIZE == 12
1803 #    define LDBL_DIG 18 /* gcc? */
1804 #   else
1805 #    if LONG_DOUBLESIZE == 16
1806 #     define LDBL_DIG 33 /* assume IEEE */
1807 #    else
1808 #     if LONG_DOUBLESIZE == DOUBLESIZE
1809 #      define LDBL_DIG DBL_DIG /* bummer */
1810 #     endif
1811 #    endif
1812 #   endif
1813 #  endif
1814 # endif
1815 #endif
1816
1817 /*
1818  * This is for making sure we have a good DBL_MAX value, if possible,
1819  * either for usage as NV_MAX or for usage in figuring out if we can
1820  * fit a given long double into a double, if bug-fixing makes it
1821  * necessary to do so. - Allen <allens@cpan.org>
1822  */
1823
1824 #ifdef I_LIMITS
1825 #  include <limits.h>
1826 #endif
1827
1828 #ifdef I_VALUES
1829 #  if !(defined(DBL_MIN) && defined(DBL_MAX) && defined(I_LIMITS))
1830 #    include <values.h>
1831 #    if defined(MAXDOUBLE) && !defined(DBL_MAX)
1832 #      define DBL_MAX MAXDOUBLE
1833 #    endif
1834 #    if defined(MINDOUBLE) && !defined(DBL_MIN)
1835 #      define DBL_MIN MINDOUBLE
1836 #    endif
1837 #  endif
1838 #endif /* defined(I_VALUES) */
1839
1840 typedef NVTYPE NV;
1841
1842 #ifdef I_IEEEFP
1843 #   include <ieeefp.h>
1844 #endif
1845
1846 #ifdef USE_LONG_DOUBLE
1847 #   ifdef I_SUNMATH
1848 #       include <sunmath.h>
1849 #   endif
1850 #   define NV_DIG LDBL_DIG
1851 #   ifdef LDBL_MANT_DIG
1852 #       define NV_MANT_DIG LDBL_MANT_DIG
1853 #   endif
1854 #   ifdef LDBL_MIN
1855 #       define NV_MIN LDBL_MIN
1856 #   endif
1857 #   ifdef LDBL_MAX
1858 #       define NV_MAX LDBL_MAX
1859 #   endif
1860 #   ifdef LDBL_MIN_EXP
1861 #       define NV_MIN_EXP LDBL_MIN_EXP
1862 #   endif
1863 #   ifdef LDBL_MAX_EXP
1864 #       define NV_MAX_EXP LDBL_MAX_EXP
1865 #   endif
1866 #   ifdef LDBL_MIN_10_EXP
1867 #       define NV_MIN_10_EXP LDBL_MIN_10_EXP
1868 #   endif
1869 #   ifdef LDBL_MAX_10_EXP
1870 #       define NV_MAX_10_EXP LDBL_MAX_10_EXP
1871 #   endif
1872 #   ifdef LDBL_EPSILON
1873 #       define NV_EPSILON LDBL_EPSILON
1874 #   endif
1875 #   ifdef LDBL_MAX
1876 #       define NV_MAX LDBL_MAX
1877 /* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */
1878 #   else
1879 #       ifdef HUGE_VALL
1880 #           define NV_MAX HUGE_VALL
1881 #       else
1882 #           ifdef HUGE_VAL
1883 #               define NV_MAX ((NV)HUGE_VAL)
1884 #           endif
1885 #       endif
1886 #   endif
1887 #   ifdef HAS_SQRTL
1888 #       define Perl_acos acosl
1889 #       define Perl_asin asinl
1890 #       define Perl_atan atanl
1891 #       define Perl_atan2 atan2l
1892 #       define Perl_ceil ceill
1893 #       define Perl_cos cosl
1894 #       define Perl_cosh coshl
1895 #       define Perl_exp expl
1896 #       define Perl_floor floorl
1897 #       define Perl_fmod fmodl
1898 #       define Perl_log logl
1899 #       define Perl_log10 log10l
1900 #       define Perl_pow powl
1901 #       define Perl_sin sinl
1902 #       define Perl_sinh sinhl
1903 #       define Perl_sqrt sqrtl
1904 #       define Perl_tan tanl
1905 #       define Perl_tanh tanhl
1906 #   endif
1907 /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
1908 #   ifdef HAS_MODFL
1909 #       define Perl_modf(x,y) modfl(x,y)
1910 /* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no
1911    prototype in <math.h> */
1912 #       ifndef HAS_MODFL_PROTO
1913 EXTERN_C long double modfl(long double, long double *);
1914 #       endif
1915 #   elif (defined(HAS_TRUNCL) || defined(HAS_AINTL)) && defined(HAS_COPYSIGNL)
1916         extern long double Perl_my_modfl(long double x, long double *ip);
1917 #           define Perl_modf(x,y) Perl_my_modfl(x,y)
1918 #   endif
1919 #   ifdef HAS_FREXPL
1920 #       define Perl_frexp(x,y) frexpl(x,y)
1921 #   else
1922 #       if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
1923         extern long double Perl_my_frexpl(long double x, int *e);
1924 #           define Perl_frexp(x,y) Perl_my_frexpl(x,y)
1925 #       endif
1926 #   endif
1927 #   ifdef HAS_LDEXPL
1928 #       define Perl_ldexp(x, y) ldexpl(x,y)
1929 #   else
1930 #       if defined(HAS_SCALBNL) && FLT_RADIX == 2
1931 #           define Perl_ldexp(x,y) scalbnl(x,y)
1932 #       endif
1933 #   endif
1934 #   ifndef Perl_isnan
1935 #       if defined(HAS_ISNANL) && !(defined(isnan) && HAS_C99)
1936 #           define Perl_isnan(x) isnanl(x)
1937 #       endif
1938 #   endif
1939 #   ifndef Perl_isinf
1940 #       if defined(HAS_ISINFL) && !(defined(isinf) && HAS_C99)
1941 #           define Perl_isinf(x) isinfl(x)
1942 #       elif defined(LDBL_MAX)
1943 #           define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX)
1944 #       endif
1945 #   endif
1946 #   if !defined(Perl_isfinite) && !(defined(isfinite) && HAS_C99)
1947 #     ifdef HAS_ISFINITEL
1948 #       define Perl_isfinite(x) isfinitel(x)
1949 #     elif defined(HAS_FINITEL)
1950 #       define Perl_isfinite(x) finitel(x)
1951 #     elif defined(LDBL_MAX)
1952 #       define Perl_isfinite(x) ((x) <= LDBL_MAX && (x) >= -LDBL_MAX)
1953 #     endif
1954 #   endif
1955 #else
1956 #   define NV_DIG DBL_DIG
1957 #   ifdef DBL_MANT_DIG
1958 #       define NV_MANT_DIG DBL_MANT_DIG
1959 #   endif
1960 #   ifdef DBL_MIN
1961 #       define NV_MIN DBL_MIN
1962 #   endif
1963 #   ifdef DBL_MAX
1964 #       define NV_MAX DBL_MAX
1965 #   endif
1966 #   ifdef DBL_MIN_EXP
1967 #       define NV_MIN_EXP DBL_MIN_EXP
1968 #   endif
1969 #   ifdef DBL_MAX_EXP
1970 #       define NV_MAX_EXP DBL_MAX_EXP
1971 #   endif
1972 #   ifdef DBL_MIN_10_EXP
1973 #       define NV_MIN_10_EXP DBL_MIN_10_EXP
1974 #   endif
1975 #   ifdef DBL_MAX_10_EXP
1976 #       define NV_MAX_10_EXP DBL_MAX_10_EXP
1977 #   endif
1978 #   ifdef DBL_EPSILON
1979 #       define NV_EPSILON DBL_EPSILON
1980 #   endif
1981 #   ifdef DBL_MAX               /* XXX Does DBL_MAX imply having DBL_MIN? */
1982 #       define NV_MAX DBL_MAX
1983 #       define NV_MIN DBL_MIN
1984 #   else
1985 #       ifdef HUGE_VAL
1986 #           define NV_MAX HUGE_VAL
1987 #       endif
1988 #   endif
1989
1990 #   define Perl_acos acos
1991 #   define Perl_asin asin
1992 #   define Perl_atan atan
1993 #   define Perl_atan2 atan2
1994 #   define Perl_ceil ceil
1995 #   define Perl_cos cos
1996 #   define Perl_cosh cosh
1997 #   define Perl_exp exp
1998 #   define Perl_floor floor
1999 #   define Perl_fmod fmod
2000 #   define Perl_log log
2001 #   define Perl_log10 log10
2002 #   define Perl_pow pow
2003 #   define Perl_sin sin
2004 #   define Perl_sinh sinh
2005 #   define Perl_sqrt sqrt
2006 #   define Perl_tan tan
2007 #   define Perl_tanh tanh
2008
2009 #   define Perl_modf(x,y) modf(x,y)
2010 #   define Perl_frexp(x,y) frexp(x,y)
2011 #   define Perl_ldexp(x,y) ldexp(x,y)
2012
2013 #   ifndef Perl_isnan
2014 #       ifdef HAS_ISNAN
2015 #           define Perl_isnan(x) isnan(x)
2016 #       endif
2017 #   endif
2018 #   ifndef Perl_isinf
2019 #       if defined(HAS_ISINF)
2020 #           define Perl_isinf(x) isinf(x)
2021 #       elif defined(DBL_MAX)
2022 #           define Perl_isinf(x) ((x) > DBL_MAX || (x) < -DBL_MAX)
2023 #       endif
2024 #   endif
2025 #   ifndef Perl_isfinite
2026 #     ifdef HAS_ISFINITE
2027 #       define Perl_isfinite(x) isfinite(x)
2028 #     elif defined(HAS_FINITE)
2029 #       define Perl_isfinite(x) finite(x)
2030 #     elif defined(DBL_MAX)
2031 #       define Perl_isfinite(x) ((x) <= DBL_MAX && (x) >= -DBL_MAX)
2032 #     endif
2033 #   endif
2034 #endif
2035
2036 /* fpclassify(): C99.  It is supposed to be a macro that switches on
2037 * the sizeof() of its argument, so there's no need for e.g. fpclassifyl().*/
2038 #if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY)
2039 #    include <math.h>
2040 #    if defined(FP_INFINITE) && defined(FP_NAN)
2041 #        define Perl_fp_class(x)        fpclassify(x)
2042 #        define Perl_fp_class_inf(x)    (Perl_fp_class(x)==FP_INFINITE)
2043 #        define Perl_fp_class_nan(x)    (Perl_fp_class(x)==FP_NAN)
2044 #        define Perl_fp_class_norm(x)   (Perl_fp_class(x)==FP_NORMAL)
2045 #        define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL)
2046 #        define Perl_fp_class_zero(x)   (Perl_fp_class(x)==FP_ZERO)
2047 #    elif defined(FP_PLUS_INF) && defined(FP_QNAN)
2048 /* Some versions of HP-UX (10.20) have (only) fpclassify() but which is
2049  * actually not the C99 fpclassify, with its own set of return defines. */
2050 #        define Perl_fp_class(x)        fpclassify(x)
2051 #        define Perl_fp_class_pinf(x)   (Perl_fp_class(x)==FP_PLUS_INF)
2052 #        define Perl_fp_class_ninf(x)   (Perl_fp_class(x)==FP_MINUS_INF)
2053 #        define Perl_fp_class_snan(x)   (Perl_fp_class(x)==FP_SNAN)
2054 #        define Perl_fp_class_qnan(x)   (Perl_fp_class(x)==FP_QNAN)
2055 #        define Perl_fp_class_pnorm(x)  (Perl_fp_class(x)==FP_PLUS_NORM)
2056 #        define Perl_fp_class_nnorm(x)  (Perl_fp_class(x)==FP_MINUS_NORM)
2057 #        define Perl_fp_class_pdenorm(x)        (Perl_fp_class(x)==FP_PLUS_DENORM)
2058 #        define Perl_fp_class_ndenorm(x)        (Perl_fp_class(x)==FP_MINUS_DENORM)
2059 #        define Perl_fp_class_pzero(x)  (Perl_fp_class(x)==FP_PLUS_ZERO)
2060 #        define Perl_fp_class_nzero(x)  (Perl_fp_class(x)==FP_MINUS_ZERO)
2061 #    else
2062 #        undef Perl_fp_class /* Unknown set of defines */
2063 #    endif
2064 #endif
2065
2066 /* fp_classify(): Legacy: VMS, maybe Unicos? The values, however,
2067  * are identical to the C99 fpclassify(). */
2068 #if !defined(Perl_fp_class) && defined(HAS_FP_CLASSIFY)
2069 #    include <math.h>
2070 #    ifdef __VMS
2071      /* FP_INFINITE and others are here rather than in math.h as C99 stipulates */
2072 #        include <fp.h>
2073      /* oh, and the isnormal macro has a typo in it! */
2074 #    undef isnormal
2075 #    define isnormal(x) Perl_fp_class_norm(x)
2076 #    endif
2077 #    if defined(FP_INFINITE) && defined(FP_NAN)
2078 #        define Perl_fp_class(x)        fp_classify(x)
2079 #        define Perl_fp_class_inf(x)    (Perl_fp_class(x)==FP_INFINITE)
2080 #        define Perl_fp_class_nan(x)    (Perl_fp_class(x)==FP_NAN)
2081 #        define Perl_fp_class_norm(x)   (Perl_fp_class(x)==FP_NORMAL)
2082 #        define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL)
2083 #        define Perl_fp_class_zero(x)   (Perl_fp_class(x)==FP_ZERO)
2084 #    else
2085 #        undef Perl_fp_class /* Unknown set of defines */
2086 #    endif
2087 #endif
2088
2089 /* Feel free to check with me for the SGI manpages, SGI testing,
2090  * etcetera, if you want to try getting this to work with IRIX.
2091  *
2092  * - Allen <allens@cpan.org> */
2093
2094 /* fpclass(): SysV, at least Solaris and some versions of IRIX. */
2095 #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL))
2096 /* Solaris and IRIX have fpclass/fpclassl, but they are using
2097  * an enum typedef, not cpp symbols, and Configure doesn't detect that.
2098  * Define some symbols also as cpp symbols so we can detect them. */
2099 #    if defined(__sun) || defined(__irix__) /* XXX Configure test instead */
2100 #     define FP_PINF FP_PINF
2101 #     define FP_QNAN FP_QNAN
2102 #    endif
2103 #    include <math.h>
2104 #    ifdef I_IEEFP
2105 #        include <ieeefp.h>
2106 #    endif
2107 #    ifdef I_FP
2108 #        include <fp.h>
2109 #    endif
2110 #    if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL)
2111 #        define Perl_fp_class(x)        fpclassl(x)
2112 #    else
2113 #        define Perl_fp_class(x)        fpclass(x)
2114 #    endif
2115 #    if defined(FP_CLASS_PINF) && defined(FP_CLASS_SNAN)
2116 #        define Perl_fp_class_snan(x)   (Perl_fp_class(x)==FP_CLASS_SNAN)
2117 #        define Perl_fp_class_qnan(x)   (Perl_fp_class(x)==FP_CLASS_QNAN)
2118 #        define Perl_fp_class_ninf(x)   (Perl_fp_class(x)==FP_CLASS_NINF)
2119 #        define Perl_fp_class_pinf(x)   (Perl_fp_class(x)==FP_CLASS_PINF)
2120 #        define Perl_fp_class_nnorm(x)  (Perl_fp_class(x)==FP_CLASS_NNORM)
2121 #        define Perl_fp_class_pnorm(x)  (Perl_fp_class(x)==FP_CLASS_PNORM)
2122 #        define Perl_fp_class_ndenorm(x)        (Perl_fp_class(x)==FP_CLASS_NDENORM)
2123 #        define Perl_fp_class_pdenorm(x)        (Perl_fp_class(x)==FP_CLASS_PDENORM)
2124 #        define Perl_fp_class_nzero(x)  (Perl_fp_class(x)==FP_CLASS_NZERO)
2125 #        define Perl_fp_class_pzero(x)  (Perl_fp_class(x)==FP_CLASS_PZERO)
2126 #    elif defined(FP_PINF) && defined(FP_QNAN)
2127 #        define Perl_fp_class_snan(x)   (Perl_fp_class(x)==FP_SNAN)
2128 #        define Perl_fp_class_qnan(x)   (Perl_fp_class(x)==FP_QNAN)
2129 #        define Perl_fp_class_ninf(x)   (Perl_fp_class(x)==FP_NINF)
2130 #        define Perl_fp_class_pinf(x)   (Perl_fp_class(x)==FP_PINF)
2131 #        define Perl_fp_class_nnorm(x)  (Perl_fp_class(x)==FP_NNORM)
2132 #        define Perl_fp_class_pnorm(x)  (Perl_fp_class(x)==FP_PNORM)
2133 #        define Perl_fp_class_ndenorm(x)        (Perl_fp_class(x)==FP_NDENORM)
2134 #        define Perl_fp_class_pdenorm(x)        (Perl_fp_class(x)==FP_PDENORM)
2135 #        define Perl_fp_class_nzero(x)  (Perl_fp_class(x)==FP_NZERO)
2136 #        define Perl_fp_class_pzero(x)  (Perl_fp_class(x)==FP_PZERO)
2137 #    else
2138 #        undef Perl_fp_class /* Unknown set of defines */
2139 #    endif
2140 #endif
2141
2142 /* fp_class(): Legacy: at least Tru64, some versions of IRIX. */
2143 #if !defined(Perl_fp_class) && (defined(HAS_FP_CLASS)||defined(HAS_FP_CLASSL))
2144 #    include <math.h>
2145 #    if !defined(FP_SNAN) && defined(I_FP_CLASS)
2146 #        include <fp_class.h>
2147 #    endif
2148 #    if defined(FP_POS_INF) && defined(FP_QNAN)
2149 #        ifdef __irix__ /* XXX Configure test instead */
2150 #            ifdef USE_LONG_DOUBLE
2151 #                define Perl_fp_class(x)        fp_class_l(x)
2152 #            else
2153 #                define Perl_fp_class(x)        fp_class_d(x)
2154 #            endif
2155 #        else
2156 #            if defined(USE_LONG_DOUBLE) && defined(HAS_FP_CLASSL)
2157 #                define Perl_fp_class(x)        fp_classl(x)
2158 #            else
2159 #                define Perl_fp_class(x)        fp_class(x)
2160 #            endif
2161 #        endif
2162 #        if defined(FP_POS_INF) && defined(FP_QNAN)
2163 #            define Perl_fp_class_snan(x)       (Perl_fp_class(x)==FP_SNAN)
2164 #            define Perl_fp_class_qnan(x)       (Perl_fp_class(x)==FP_QNAN)
2165 #            define Perl_fp_class_ninf(x)       (Perl_fp_class(x)==FP_NEG_INF)
2166 #            define Perl_fp_class_pinf(x)       (Perl_fp_class(x)==FP_POS_INF)
2167 #            define Perl_fp_class_nnorm(x)      (Perl_fp_class(x)==FP_NEG_NORM)
2168 #            define Perl_fp_class_pnorm(x)      (Perl_fp_class(x)==FP_POS_NORM)
2169 #            define Perl_fp_class_ndenorm(x)    (Perl_fp_class(x)==FP_NEG_DENORM)
2170 #            define Perl_fp_class_pdenorm(x)    (Perl_fp_class(x)==FP_POS_DENORM)
2171 #            define Perl_fp_class_nzero(x)      (Perl_fp_class(x)==FP_NEG_ZERO)
2172 #            define Perl_fp_class_pzero(x)      (Perl_fp_class(x)==FP_POS_ZERO)
2173 #        else
2174 #            undef Perl_fp_class /* Unknown set of defines */
2175 #        endif
2176 #    endif
2177 #endif
2178
2179 /* class(), _class(): Legacy: AIX. */
2180 #if !defined(Perl_fp_class) && defined(HAS_CLASS)
2181 #    include <math.h>
2182 #    if defined(FP_PLUS_NORM) && defined(FP_PLUS_INF)
2183 #        ifndef _cplusplus
2184 #            define Perl_fp_class(x)    class(x)
2185 #        else
2186 #            define Perl_fp_class(x)    _class(x)
2187 #        endif
2188 #        if defined(FP_PLUS_INF) && defined(FP_NANQ)
2189 #            define Perl_fp_class_snan(x)       (Perl_fp_class(x)==FP_NANS)
2190 #            define Perl_fp_class_qnan(x)       (Perl_fp_class(x)==FP_NANQ)
2191 #            define Perl_fp_class_ninf(x)       (Perl_fp_class(x)==FP_MINUS_INF)
2192 #            define Perl_fp_class_pinf(x)       (Perl_fp_class(x)==FP_PLUS_INF)
2193 #            define Perl_fp_class_nnorm(x)      (Perl_fp_class(x)==FP_MINUS_NORM)
2194 #            define Perl_fp_class_pnorm(x)      (Perl_fp_class(x)==FP_PLUS_NORM)
2195 #            define Perl_fp_class_ndenorm(x)    (Perl_fp_class(x)==FP_MINUS_DENORM)
2196 #            define Perl_fp_class_pdenorm(x)    (Perl_fp_class(x)==FP_PLUS_DENORM)
2197 #            define Perl_fp_class_nzero(x)      (Perl_fp_class(x)==FP_MINUS_ZERO)
2198 #            define Perl_fp_class_pzero(x)      (Perl_fp_class(x)==FP_PLUS_ZERO)
2199 #        else
2200 #            undef Perl_fp_class /* Unknown set of defines */
2201 #        endif
2202 #    endif
2203 #endif
2204
2205 /* Win32: _fpclass(), _isnan(), _finite(). */
2206 #ifdef WIN32
2207 #  ifndef Perl_isnan
2208 #    define Perl_isnan(x) _isnan(x)
2209 #  endif
2210 #  ifndef Perl_isfinite
2211 #    define Perl_isfinite(x) _finite(x)
2212 #  endif
2213 #  ifndef Perl_fp_class_snan
2214 /* No simple way to #define Perl_fp_class because _fpclass()
2215  * returns a set of bits. */
2216 #    define Perl_fp_class_snan(x) (_fpclass(x) & _FPCLASS_SNAN)
2217 #    define Perl_fp_class_qnan(x) (_fpclass(x) & _FPCLASS_QNAN)
2218 #    define Perl_fp_class_nan(x) (_fpclass(x) & (_FPCLASS_SNAN|_FPCLASS_QNAN))
2219 #    define Perl_fp_class_ninf(x) (_fpclass(x) & _FPCLASS_NINF))
2220 #    define Perl_fp_class_pinf(x) (_fpclass(x) & _FPCLASS_PINF))
2221 #    define Perl_fp_class_inf(x) (_fpclass(x) & (_FPCLASS_NINF|_FPCLASS_PINF))
2222 #    define Perl_fp_class_nnorm(x) (_fpclass(x) & _FPCLASS_NN)
2223 #    define Perl_fp_class_pnorm(x) (_fpclass(x) & _FPCLASS_PN)
2224 #    define Perl_fp_class_norm(x) (_fpclass(x) & (_FPCLASS_NN|_FPCLASS_PN))
2225 #    define Perl_fp_class_ndenorm(x) (_fpclass(x) & _FPCLASS_ND)
2226 #    define Perl_fp_class_pdenorm(x) (_fpclass(x) & _FPCLASS_PD)
2227 #    define Perl_fp_class_denorm(x) (_fpclass(x) & (_FPCLASS_ND|_FPCLASS_PD))
2228 #    define Perl_fp_class_nzero(x) (_fpclass(x) & _FPCLASS_NZ)
2229 #    define Perl_fp_class_pzero(x) (_fpclass(x) & _FPCLASS_PZ)
2230 #    define Perl_fp_class_zero(x) (_fpclass(x) & (_FPCLASS_NZ|_FPCLASS_PZ))
2231 #  endif
2232 #endif
2233
2234 #if !defined(Perl_fp_class_inf) && \
2235   defined(Perl_fp_class_pinf) && defined(Perl_fp_class_ninf)
2236 #  define Perl_fp_class_inf(x) \
2237     (Perl_fp_class_pinf(x) || Perl_fp_class_ninf(x))
2238 #endif
2239
2240 #if !defined(Perl_fp_class_nan) && \
2241   defined(Perl_fp_class_snan) && defined(Perl_fp_class_qnan)
2242 #  define Perl_fp_class_nan(x) \
2243     (Perl_fp_class_snan(x) || Perl_fp_class_qnan(x))
2244 #endif
2245
2246 #if !defined(Perl_fp_class_zero) && \
2247   defined(Perl_fp_class_pzero) && defined(Perl_fp_class_nzero)
2248 #  define Perl_fp_class_zero(x) \
2249     (Perl_fp_class_pzero(x) || Perl_fp_class_nzero(x))
2250 #endif
2251
2252 #if !defined(Perl_fp_class_norm) && \
2253   defined(Perl_fp_class_pnorm) && defined(Perl_fp_class_nnorm)
2254 #  define Perl_fp_class_norm(x) \
2255     (Perl_fp_class_pnorm(x) || Perl_fp_class_nnorm(x))
2256 #endif
2257
2258 #if !defined(Perl_fp_class_denorm) && \
2259   defined(Perl_fp_class_pdenorm) && defined(Perl_fp_class_ndenorm)
2260 #  define Perl_fp_class_denorm(x) \
2261     (Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x))
2262 #endif
2263
2264 #ifdef UNDER_CE
2265 int isnan(double d);
2266 #endif
2267
2268 #ifndef Perl_isnan
2269 #   ifdef Perl_fp_class_nan
2270 #       define Perl_isnan(x) Perl_fp_class_nan(x)
2271 #   else
2272 #       ifdef HAS_UNORDERED
2273 #           define Perl_isnan(x) unordered((x), 0.0)
2274 #       else
2275 #           define Perl_isnan(x) ((x)!=(x))
2276 #       endif
2277 #   endif
2278 #endif
2279
2280 #ifndef Perl_isinf
2281 #   ifdef Perl_fp_class_inf
2282 #       define Perl_isinf(x) Perl_fp_class_inf(x)
2283 #   endif
2284 #endif
2285
2286 #ifndef Perl_isfinite
2287 #   if defined(HAS_ISFINITE) && !defined(isfinite)
2288 #     define Perl_isfinite(x) isfinite((double)x)
2289 #   elif defined(HAS_FINITE)
2290 #       define Perl_isfinite(x) finite((double)x)
2291 #   elif defined(Perl_fp_class_finite)
2292 #     define Perl_isfinite(x) Perl_fp_class_finite(x)
2293 #   else
2294 /* NaN*0 is NaN, [+-]Inf*0 is NaN, zero for anything else. */
2295 #     define Perl_isfinite(x) (((x) * 0) == 0)
2296 #   endif
2297 #endif
2298
2299 #ifndef Perl_isinf
2300 #   if defined(Perl_isfinite) && defined(Perl_isnan)
2301 #       define Perl_isinf(x) !(Perl_isfinite(x)||Perl_isnan(x))
2302 #   endif
2303 #endif
2304
2305 /* The default is to use Perl's own atof() implementation (in numeric.c).
2306  * Usually that is the one to use but for some platforms (e.g. UNICOS)
2307  * it is however best to use the native implementation of atof.
2308  * You can experiment with using your native one by -DUSE_PERL_ATOF=0.
2309  * Some good tests to try out with either setting are t/base/num.t,
2310  * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles
2311  * you may need to be using a different function than atof! */
2312
2313 #ifndef USE_PERL_ATOF
2314 #   ifndef _UNICOS
2315 #       define USE_PERL_ATOF
2316 #   endif
2317 #else
2318 #   if USE_PERL_ATOF == 0
2319 #       undef USE_PERL_ATOF
2320 #   endif
2321 #endif
2322
2323 #ifdef USE_PERL_ATOF
2324 #   define Perl_atof(s) Perl_my_atof(s)
2325 #   define Perl_atof2(s, n) Perl_my_atof2(aTHX_ (s), &(n))
2326 #else
2327 #   define Perl_atof(s) (NV)atof(s)
2328 #   define Perl_atof2(s, n) ((n) = atof(s))
2329 #endif
2330
2331 /* Previously these definitions used hardcoded figures.
2332  * It is hoped these formula are more portable, although
2333  * no data one way or another is presently known to me.
2334  * The "PERL_" names are used because these calculated constants
2335  * do not meet the ANSI requirements for LONG_MAX, etc., which
2336  * need to be constants acceptable to #if - kja
2337  *    define PERL_LONG_MAX        2147483647L
2338  *    define PERL_LONG_MIN        (-LONG_MAX - 1)
2339  *    define PERL ULONG_MAX       4294967295L
2340  */
2341
2342 #ifdef I_LIMITS  /* Needed for cast_xxx() functions below. */
2343 #  include <limits.h>
2344 #endif
2345 /* Included values.h above if necessary; still including limits.h down here,
2346  * despite doing above, because math.h might have overridden... XXX - Allen */
2347
2348 /*
2349  * Try to figure out max and min values for the integral types.  THE CORRECT
2350  * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE.  The
2351  * following hacks are used if neither limits.h or values.h provide them:
2352  * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0
2353  *              for types <  int:  (unsigned TYPE)~(unsigned)0
2354  *      The argument to ~ must be unsigned so that later signed->unsigned
2355  *      conversion can't modify the value's bit pattern (e.g. -0 -> +0),
2356  *      and it must not be smaller than int because ~ does integral promotion.
2357  * <type>_MAX: (<type>) (U<type>_MAX >> 1)
2358  * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>.
2359  *      The latter is a hack which happens to work on some machines but
2360  *      does *not* catch any random system, or things like integer types
2361  *      with NaN if that is possible.
2362  *
2363  * All of the types are explicitly cast to prevent accidental loss of
2364  * numeric range, and in the hope that they will be less likely to confuse
2365  * over-eager optimizers.
2366  *
2367  */
2368
2369 #define PERL_UCHAR_MIN ((unsigned char)0)
2370
2371 #ifdef UCHAR_MAX
2372 #  define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
2373 #else
2374 #  ifdef MAXUCHAR
2375 #    define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
2376 #  else
2377 #    define PERL_UCHAR_MAX       ((unsigned char)~(unsigned)0)
2378 #  endif
2379 #endif
2380
2381 /*
2382  * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be
2383  * ambiguous. It may be equivalent to (signed char) or (unsigned char)
2384  * depending on local options. Until Configure detects this (or at least
2385  * detects whether the "signed" keyword is available) the CHAR ranges
2386  * will not be included. UCHAR functions normally.
2387  *                                                           - kja
2388  */
2389
2390 #define PERL_USHORT_MIN ((unsigned short)0)
2391
2392 #ifdef USHORT_MAX
2393 #  define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
2394 #else
2395 #  ifdef MAXUSHORT
2396 #    define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
2397 #  else
2398 #    ifdef USHRT_MAX
2399 #      define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
2400 #    else
2401 #      define PERL_USHORT_MAX       ((unsigned short)~(unsigned)0)
2402 #    endif
2403 #  endif
2404 #endif
2405
2406 #ifdef SHORT_MAX
2407 #  define PERL_SHORT_MAX ((short)SHORT_MAX)
2408 #else
2409 #  ifdef MAXSHORT    /* Often used in <values.h> */
2410 #    define PERL_SHORT_MAX ((short)MAXSHORT)
2411 #  else
2412 #    ifdef SHRT_MAX
2413 #      define PERL_SHORT_MAX ((short)SHRT_MAX)
2414 #    else
2415 #      define PERL_SHORT_MAX      ((short) (PERL_USHORT_MAX >> 1))
2416 #    endif
2417 #  endif
2418 #endif
2419
2420 #ifdef SHORT_MIN
2421 #  define PERL_SHORT_MIN ((short)SHORT_MIN)
2422 #else
2423 #  ifdef MINSHORT
2424 #    define PERL_SHORT_MIN ((short)MINSHORT)
2425 #  else
2426 #    ifdef SHRT_MIN
2427 #      define PERL_SHORT_MIN ((short)SHRT_MIN)
2428 #    else
2429 #      define PERL_SHORT_MIN        (-PERL_SHORT_MAX - ((3 & -1) == 3))
2430 #    endif
2431 #  endif
2432 #endif
2433
2434 #ifdef UINT_MAX
2435 #  define PERL_UINT_MAX ((unsigned int)UINT_MAX)
2436 #else
2437 #  ifdef MAXUINT
2438 #    define PERL_UINT_MAX ((unsigned int)MAXUINT)
2439 #  else
2440 #    define PERL_UINT_MAX       (~(unsigned int)0)
2441 #  endif
2442 #endif
2443
2444 #define PERL_UINT_MIN ((unsigned int)0)
2445
2446 #ifdef INT_MAX
2447 #  define PERL_INT_MAX ((int)INT_MAX)
2448 #else
2449 #  ifdef MAXINT    /* Often used in <values.h> */
2450 #    define PERL_INT_MAX ((int)MAXINT)
2451 #  else
2452 #    define PERL_INT_MAX        ((int)(PERL_UINT_MAX >> 1))
2453 #  endif
2454 #endif
2455
2456 #ifdef INT_MIN
2457 #  define PERL_INT_MIN ((int)INT_MIN)
2458 #else
2459 #  ifdef MININT
2460 #    define PERL_INT_MIN ((int)MININT)
2461 #  else
2462 #    define PERL_INT_MIN        (-PERL_INT_MAX - ((3 & -1) == 3))
2463 #  endif
2464 #endif
2465
2466 #ifdef ULONG_MAX
2467 #  define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
2468 #else
2469 #  ifdef MAXULONG
2470 #    define PERL_ULONG_MAX ((unsigned long)MAXULONG)
2471 #  else
2472 #    define PERL_ULONG_MAX       (~(unsigned long)0)
2473 #  endif
2474 #endif
2475
2476 #define PERL_ULONG_MIN ((unsigned long)0L)
2477
2478 #ifdef LONG_MAX
2479 #  define PERL_LONG_MAX ((long)LONG_MAX)
2480 #else
2481 #  ifdef MAXLONG    /* Often used in <values.h> */
2482 #    define PERL_LONG_MAX ((long)MAXLONG)
2483 #  else
2484 #    define PERL_LONG_MAX        ((long) (PERL_ULONG_MAX >> 1))
2485 #  endif
2486 #endif
2487
2488 #ifdef LONG_MIN
2489 #  define PERL_LONG_MIN ((long)LONG_MIN)
2490 #else
2491 #  ifdef MINLONG
2492 #    define PERL_LONG_MIN ((long)MINLONG)
2493 #  else
2494 #    define PERL_LONG_MIN        (-PERL_LONG_MAX - ((3 & -1) == 3))
2495 #  endif
2496 #endif
2497
2498 #ifdef UV_IS_QUAD
2499
2500 #    define PERL_UQUAD_MAX      (~(UV)0)
2501 #    define PERL_UQUAD_MIN      ((UV)0)
2502 #    define PERL_QUAD_MAX       ((IV) (PERL_UQUAD_MAX >> 1))
2503 #    define PERL_QUAD_MIN       (-PERL_QUAD_MAX - ((3 & -1) == 3))
2504
2505 #endif
2506
2507 typedef MEM_SIZE STRLEN;
2508
2509 typedef struct op OP;
2510 typedef struct cop COP;
2511 typedef struct unop UNOP;
2512 typedef struct binop BINOP;
2513 typedef struct listop LISTOP;
2514 typedef struct logop LOGOP;
2515 typedef struct pmop PMOP;
2516 typedef struct svop SVOP;
2517 typedef struct padop PADOP;
2518 typedef struct pvop PVOP;
2519 typedef struct loop LOOP;
2520
2521 #ifdef PERL_CORE
2522 typedef struct opslab OPSLAB;
2523 typedef struct opslot OPSLOT;
2524 #endif
2525
2526 typedef struct block_hooks BHK;
2527 typedef struct custom_op XOP;
2528
2529 typedef struct interpreter PerlInterpreter;
2530
2531 /* SGI's <sys/sema.h> has struct sv */
2532 #if defined(__sgi)
2533 #   define STRUCT_SV perl_sv
2534 #else
2535 #   define STRUCT_SV sv
2536 #endif
2537 typedef struct STRUCT_SV SV;
2538 typedef struct av AV;
2539 typedef struct hv HV;
2540 typedef struct cv CV;
2541 typedef struct p5rx REGEXP;
2542 typedef struct gp GP;
2543 typedef struct gv GV;
2544 typedef struct io IO;
2545 typedef struct context PERL_CONTEXT;
2546 typedef struct block BLOCK;
2547
2548 typedef struct magic MAGIC;
2549 typedef struct xpv XPV;
2550 typedef struct xpviv XPVIV;
2551 typedef struct xpvuv XPVUV;
2552 typedef struct xpvnv XPVNV;
2553 typedef struct xpvmg XPVMG;
2554 typedef struct xpvlv XPVLV;
2555 typedef struct xpvinvlist XINVLIST;
2556 typedef struct xpvav XPVAV;
2557 typedef struct xpvhv XPVHV;
2558 typedef struct xpvgv XPVGV;
2559 typedef struct xpvcv XPVCV;
2560 typedef struct xpvbm XPVBM;
2561 typedef struct xpvfm XPVFM;
2562 typedef struct xpvio XPVIO;
2563 typedef struct mgvtbl MGVTBL;
2564 typedef union any ANY;
2565 typedef struct ptr_tbl_ent PTR_TBL_ENT_t;
2566 typedef struct ptr_tbl PTR_TBL_t;
2567 typedef struct clone_params CLONE_PARAMS;
2568
2569 /* a pad or name pad is currently just an AV; but that might change,
2570  * so hide the type.  */
2571 typedef struct padlist PADLIST;
2572 typedef AV PAD;
2573 typedef AV PADNAMELIST;
2574 typedef SV PADNAME;
2575
2576 /* enable PERL_NEW_COPY_ON_WRITE by default */
2577 #if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW)
2578 #  define PERL_NEW_COPY_ON_WRITE
2579 #endif
2580
2581 #if defined(PERL_OLD_COPY_ON_WRITE) || defined(PERL_NEW_COPY_ON_WRITE)
2582 # if defined(PERL_OLD_COPY_ON_WRITE) && defined(PERL_NEW_COPY_ON_WRITE)
2583 #  error PERL_OLD_COPY_ON_WRITE and PERL_NEW_COPY_ON_WRITE are exclusive
2584 # else
2585 #  define PERL_ANY_COW
2586 # endif
2587 #else
2588 # define PERL_SAWAMPERSAND
2589 #endif
2590
2591 #include "handy.h"
2592
2593 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
2594 #   if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO)
2595 #       define USE_64_BIT_RAWIO /* implicit */
2596 #   endif
2597 #endif
2598
2599 /* Notice the use of HAS_FSEEKO: now we are obligated to always use
2600  * fseeko/ftello if possible.  Don't go #defining ftell to ftello yourself,
2601  * however, because operating systems like to do that themself. */
2602 #ifndef FSEEKSIZE
2603 #   ifdef HAS_FSEEKO
2604 #       define FSEEKSIZE LSEEKSIZE
2605 #   else
2606 #       define FSEEKSIZE LONGSIZE
2607 #   endif
2608 #endif
2609
2610 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO)
2611 #   if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO)
2612 #       define USE_64_BIT_STDIO /* implicit */
2613 #   endif
2614 #endif
2615
2616 #ifdef USE_64_BIT_RAWIO
2617 #   ifdef HAS_OFF64_T
2618 #       undef Off_t
2619 #       define Off_t off64_t
2620 #       undef LSEEKSIZE
2621 #       define LSEEKSIZE 8
2622 #   endif
2623 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that
2624  * will trigger defines like the ones below.  Some 64-bit environments,
2625  * however, do not.  Therefore we have to explicitly mix and match. */
2626 #   if defined(USE_OPEN64)
2627 #       define open open64
2628 #   endif
2629 #   if defined(USE_LSEEK64)
2630 #       define lseek lseek64
2631 #   else
2632 #       if defined(USE_LLSEEK)
2633 #           define lseek llseek
2634 #       endif
2635 #   endif
2636 #   if defined(USE_STAT64)
2637 #       define stat stat64
2638 #   endif
2639 #   if defined(USE_FSTAT64)
2640 #       define fstat fstat64
2641 #   endif
2642 #   if defined(USE_LSTAT64)
2643 #       define lstat lstat64
2644 #   endif
2645 #   if defined(USE_FLOCK64)
2646 #       define flock flock64
2647 #   endif
2648 #   if defined(USE_LOCKF64)
2649 #       define lockf lockf64
2650 #   endif
2651 #   if defined(USE_FCNTL64)
2652 #       define fcntl fcntl64
2653 #   endif
2654 #   if defined(USE_TRUNCATE64)
2655 #       define truncate truncate64
2656 #   endif
2657 #   if defined(USE_FTRUNCATE64)
2658 #       define ftruncate ftruncate64
2659 #   endif
2660 #endif
2661
2662 #ifdef USE_64_BIT_STDIO
2663 #   ifdef HAS_FPOS64_T
2664 #       undef Fpos_t
2665 #       define Fpos_t fpos64_t
2666 #   endif
2667 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that
2668  * will trigger defines like the ones below.  Some 64-bit environments,
2669  * however, do not. */
2670 #   if defined(USE_FOPEN64)
2671 #       define fopen fopen64
2672 #   endif
2673 #   if defined(USE_FSEEK64)
2674 #       define fseek fseek64 /* don't do fseeko here, see perlio.c */
2675 #   endif
2676 #   if defined(USE_FTELL64)
2677 #       define ftell ftell64 /* don't do ftello here, see perlio.c */
2678 #   endif
2679 #   if defined(USE_FSETPOS64)
2680 #       define fsetpos fsetpos64
2681 #   endif
2682 #   if defined(USE_FGETPOS64)
2683 #       define fgetpos fgetpos64
2684 #   endif
2685 #   if defined(USE_TMPFILE64)
2686 #       define tmpfile tmpfile64
2687 #   endif
2688 #   if defined(USE_FREOPEN64)
2689 #       define freopen freopen64
2690 #   endif
2691 #endif
2692
2693 #if defined(OS2)
2694 #  include "iperlsys.h"
2695 #endif
2696
2697 #ifdef DOSISH
2698 #   if defined(OS2)
2699 #       include "os2ish.h"
2700 #   else
2701 #       include "dosish.h"
2702 #   endif
2703 #elif defined(VMS)
2704 #   include "vmsish.h"
2705 #elif defined(PLAN9)
2706 #   include "./plan9/plan9ish.h"
2707 #elif defined(__VOS__)
2708 #   ifdef __GNUC__
2709 #     include "./vos/vosish.h"
2710 #   else
2711 #     include "vos/vosish.h"
2712 #   endif
2713 #elif defined(__SYMBIAN32__)
2714 #   include "symbian/symbianish.h"
2715 #elif defined(__HAIKU__)
2716 #   include "haiku/haikuish.h"
2717 #else
2718 #   include "unixish.h"
2719 #endif
2720
2721 /* NSIG logic from Configure --> */
2722 /* Strange style to avoid deeply-nested #if/#else/#endif */
2723 #ifndef NSIG
2724 #  ifdef _NSIG
2725 #    define NSIG (_NSIG)
2726 #  endif
2727 #endif
2728
2729 #ifndef NSIG
2730 #  ifdef SIGMAX
2731 #    define NSIG (SIGMAX+1)
2732 #  endif
2733 #endif
2734
2735 #ifndef NSIG
2736 #  ifdef SIG_MAX
2737 #    define NSIG (SIG_MAX+1)
2738 #  endif
2739 #endif
2740
2741 #ifndef NSIG
2742 #  ifdef _SIG_MAX
2743 #    define NSIG (_SIG_MAX+1)
2744 #  endif
2745 #endif
2746
2747 #ifndef NSIG
2748 #  ifdef MAXSIG
2749 #    define NSIG (MAXSIG+1)
2750 #  endif
2751 #endif
2752
2753 #ifndef NSIG
2754 #  ifdef MAX_SIG
2755 #    define NSIG (MAX_SIG+1)
2756 #  endif
2757 #endif
2758
2759 #ifndef NSIG
2760 #  ifdef SIGARRAYSIZE
2761 #    define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */
2762 #  endif
2763 #endif
2764
2765 #ifndef NSIG
2766 #  ifdef _sys_nsig
2767 #    define NSIG (_sys_nsig) /* Solaris 2.5 */
2768 #  endif
2769 #endif
2770
2771 /* Default to some arbitrary number that's big enough to get most
2772    of the common signals.
2773 */
2774 #ifndef NSIG
2775 #    define NSIG 50
2776 #endif
2777 /* <-- NSIG logic from Configure */
2778
2779 #ifndef NO_ENVIRON_ARRAY
2780 #  define USE_ENVIRON_ARRAY
2781 #endif
2782
2783 /*
2784  * initialise to avoid floating-point exceptions from overflow, etc
2785  */
2786 #ifndef PERL_FPU_INIT
2787 #  ifdef HAS_FPSETMASK
2788 #    if HAS_FLOATINGPOINT_H
2789 #      include <floatingpoint.h>
2790 #    endif
2791 /* Some operating systems have this as a macro, which in turn expands to a comma
2792    expression, and the last sub-expression is something that gets calculated,
2793    and then they have the gall to warn that a value computed is not used. Hence
2794    cast to void.  */
2795 #    define PERL_FPU_INIT (void)fpsetmask(0)
2796 #  else
2797 #    if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
2798 #      define PERL_FPU_INIT       PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN)
2799 #      define PERL_FPU_PRE_EXEC   { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
2800 #      define PERL_FPU_POST_EXEC    rsignal_restore(SIGFPE, &xfpe); }
2801 #    else
2802 #      define PERL_FPU_INIT
2803
2804 #    endif
2805 #  endif
2806 #endif
2807 #ifndef PERL_FPU_PRE_EXEC
2808 #  define PERL_FPU_PRE_EXEC   {
2809 #  define PERL_FPU_POST_EXEC  }
2810 #endif
2811
2812 #ifndef PERL_SYS_INIT3_BODY
2813 #  define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp)
2814 #endif
2815
2816 /*
2817 =head1 Miscellaneous Functions
2818
2819 =for apidoc Am|void|PERL_SYS_INIT|int *argc|char*** argv
2820 Provides system-specific tune up of the C runtime environment necessary to
2821 run Perl interpreters.  This should be called only once, before creating
2822 any Perl interpreters.
2823
2824 =for apidoc Am|void|PERL_SYS_INIT3|int *argc|char*** argv|char*** env
2825 Provides system-specific tune up of the C runtime environment necessary to
2826 run Perl interpreters.  This should be called only once, before creating
2827 any Perl interpreters.
2828
2829 =for apidoc Am|void|PERL_SYS_TERM|
2830 Provides system-specific clean up of the C runtime environment after
2831 running Perl interpreters.  This should be called only once, after
2832 freeing any remaining Perl interpreters.
2833
2834 =cut
2835  */
2836
2837 #define PERL_SYS_INIT(argc, argv)       Perl_sys_init(argc, argv)
2838 #define PERL_SYS_INIT3(argc, argv, env) Perl_sys_init3(argc, argv, env)
2839 #define PERL_SYS_TERM()                 Perl_sys_term()
2840
2841 #ifndef PERL_WRITE_MSG_TO_CONSOLE
2842 #  define PERL_WRITE_MSG_TO_CONSOLE(io, msg, len) PerlIO_write(io, msg, len)
2843 #endif
2844
2845 #ifndef MAXPATHLEN
2846 #  ifdef PATH_MAX
2847 #    ifdef _POSIX_PATH_MAX
2848 #       if PATH_MAX > _POSIX_PATH_MAX
2849 /* POSIX 1990 (and pre) was ambiguous about whether PATH_MAX
2850  * included the null byte or not.  Later amendments of POSIX,
2851  * XPG4, the Austin Group, and the Single UNIX Specification
2852  * all explicitly include the null byte in the PATH_MAX.
2853  * Ditto for _POSIX_PATH_MAX. */
2854 #         define MAXPATHLEN PATH_MAX
2855 #       else
2856 #         define MAXPATHLEN _POSIX_PATH_MAX
2857 #       endif
2858 #    else
2859 #      define MAXPATHLEN (PATH_MAX+1)
2860 #    endif
2861 #  else
2862 #    define MAXPATHLEN 1024     /* Err on the large side. */
2863 #  endif
2864 #endif
2865
2866 /* In case Configure was not used (we are using a "canned config"
2867  * such as Win32, or a cross-compilation setup, for example) try going
2868  * by the gcc major and minor versions.  One useful URL is
2869  * http://www.ohse.de/uwe/articles/gcc-attributes.html,
2870  * but contrary to this information warn_unused_result seems
2871  * not to be in gcc 3.3.5, at least. --jhi
2872  * Also, when building extensions with an installed perl, this allows
2873  * the user to upgrade gcc and get the right attributes, rather than
2874  * relying on the list generated at Configure time.  --AD
2875  * Set these up now otherwise we get confused when some of the <*thread.h>
2876  * includes below indirectly pull in <perlio.h> (which needs to know if we
2877  * have HASATTRIBUTE_FORMAT).
2878  */
2879
2880 #ifndef PERL_MICRO
2881 #if defined __GNUC__ && !defined(__INTEL_COMPILER)
2882 #  if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */
2883 #    define HASATTRIBUTE_DEPRECATED
2884 #  endif
2885 #  if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
2886 #    define HASATTRIBUTE_FORMAT
2887 #    if defined __MINGW32__
2888 #      define PRINTF_FORMAT_NULL_OK
2889 #    endif
2890 #  endif
2891 #  if __GNUC__ >= 3 /* 3.0 -> */
2892 #    define HASATTRIBUTE_MALLOC
2893 #  endif
2894 #  if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */
2895 #    define HASATTRIBUTE_NONNULL
2896 #  endif
2897 #  if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */
2898 #    define HASATTRIBUTE_NORETURN
2899 #  endif
2900 #  if __GNUC__ >= 3 /* gcc 3.0 -> */
2901 #    define HASATTRIBUTE_PURE
2902 #  endif
2903 #  if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
2904 #    define HASATTRIBUTE_UNUSED
2905 #  endif
2906 #  if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus)
2907 #    define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */
2908 #  endif
2909 #  if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
2910 #    define HASATTRIBUTE_WARN_UNUSED_RESULT
2911 #  endif
2912 #endif
2913 #endif /* #ifndef PERL_MICRO */
2914
2915 /* USE_5005THREADS needs to be after unixish.h as <pthread.h> includes
2916  * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
2917  * this results in many functions being undeclared which bothers C++
2918  * May make sense to have threads after "*ish.h" anyway
2919  */
2920
2921 #if defined(USE_ITHREADS)
2922 #  ifdef NETWARE
2923 #   include <nw5thread.h>
2924 #  else
2925 #    ifdef WIN32
2926 #      include <win32thread.h>
2927 #    else
2928 #      ifdef OS2
2929 #        include "os2thread.h"
2930 #      else
2931 #        ifdef I_MACH_CTHREADS
2932 #          include <mach/cthreads.h>
2933 typedef cthread_t       perl_os_thread;
2934 typedef mutex_t         perl_mutex;
2935 typedef condition_t     perl_cond;
2936 typedef void *          perl_key;
2937 #        else /* Posix threads */
2938 #          ifdef I_PTHREAD
2939 #            include <pthread.h>
2940 #          endif
2941 typedef pthread_t       perl_os_thread;
2942 typedef pthread_mutex_t perl_mutex;
2943 typedef pthread_cond_t  perl_cond;
2944 typedef pthread_key_t   perl_key;
2945 #        endif /* I_MACH_CTHREADS */
2946 #      endif /* OS2 */
2947 #    endif /* WIN32 */
2948 #  endif /* NETWARE */
2949 #endif /* USE_ITHREADS */
2950
2951 #if defined(WIN32)
2952 #  include "win32.h"
2953 #endif
2954
2955 #ifdef NETWARE
2956 #  include "netware.h"
2957 #endif
2958
2959 #define STATUS_UNIX     PL_statusvalue
2960 #ifdef VMS
2961 #   define STATUS_NATIVE        PL_statusvalue_vms
2962 /*
2963  * vaxc$errno is only guaranteed to be valid if errno == EVMSERR, otherwise
2964  * its contents can not be trusted.  Unfortunately, Perl seems to check
2965  * it on exit, so it when PL_statusvalue_vms is updated, vaxc$errno should
2966  * be updated also.
2967  */
2968 #  include <stsdef.h>
2969 #  include <ssdef.h>
2970 /* Presume this because if VMS changes it, it will require a new
2971  * set of APIs for waiting on children for binary compatibility.
2972  */
2973 #  define child_offset_bits (8)
2974 #  ifndef C_FAC_POSIX
2975 #  define C_FAC_POSIX 0x35A000
2976 #  endif
2977
2978 /*  STATUS_EXIT - validates and returns a NATIVE exit status code for the
2979  * platform from the existing UNIX or Native status values.
2980  */
2981
2982 #   define STATUS_EXIT \
2983         (((I32)PL_statusvalue_vms == -1 ? SS$_ABORT : PL_statusvalue_vms) | \
2984            (VMSISH_HUSHED ? STS$M_INHIB_MSG : 0))
2985
2986
2987 /* STATUS_NATIVE_CHILD_SET - Calculate UNIX status that matches the child
2988  * exit code and shifts the UNIX value over the correct number of bits to
2989  * be a child status.  Usually the number of bits is 8, but that could be
2990  * platform dependent.  The NATIVE status code is presumed to have either
2991  * from a child process.
2992  */
2993
2994 /* This is complicated.  The child processes return a true native VMS
2995    status which must be saved.  But there is an assumption in Perl that
2996    the UNIX child status has some relationship to errno values, so
2997    Perl tries to translate it to text in some of the tests.
2998    In order to get the string translation correct, for the error, errno
2999    must be EVMSERR, but that generates a different text message
3000    than what the test programs are expecting.  So an errno value must
3001    be derived from the native status value when an error occurs.
3002    That will hide the true native status message.  With this version of
3003    perl, the true native child status can always be retrieved so that
3004    is not a problem.  But in this case, Pl_statusvalue and errno may
3005    have different values in them.
3006  */
3007
3008 #   define STATUS_NATIVE_CHILD_SET(n) \
3009         STMT_START {                                                    \
3010             I32 evalue = (I32)n;                                        \
3011             if (evalue == EVMSERR) {                                    \
3012               PL_statusvalue_vms = vaxc$errno;                          \
3013               PL_statusvalue = evalue;                                  \
3014             } else {                                                    \
3015               PL_statusvalue_vms = evalue;                              \
3016               if (evalue == -1) {                                       \
3017                 PL_statusvalue = -1;                                    \
3018                 PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \
3019               } else                                                    \
3020                 PL_statusvalue = Perl_vms_status_to_unix(evalue, 1);    \
3021               set_vaxc_errno(evalue);                                   \
3022               if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX)    \
3023                   set_errno(EVMSERR);                                   \
3024               else set_errno(Perl_vms_status_to_unix(evalue, 0));       \
3025               PL_statusvalue = PL_statusvalue << child_offset_bits;     \
3026             }                                                           \
3027         } STMT_END
3028
3029 #   ifdef VMSISH_STATUS
3030 #       define STATUS_CURRENT   (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX)
3031 #   else
3032 #       define STATUS_CURRENT   STATUS_UNIX
3033 #   endif
3034
3035   /* STATUS_UNIX_SET - takes a UNIX/POSIX errno value and attempts to update
3036    * the NATIVE status to an equivalent value.  Can not be used to translate
3037    * exit code values as exit code values are not guaranteed to have any
3038    * relationship at all to errno values.
3039    * This is used when Perl is forcing errno to have a specific value.
3040    */
3041 #   define STATUS_UNIX_SET(n)                           \
3042         STMT_START {                                    \
3043             I32 evalue = (I32)n;                        \
3044             PL_statusvalue = evalue;                    \
3045             if (PL_statusvalue != -1) {                 \
3046                 if (PL_statusvalue != EVMSERR) {        \
3047                   PL_statusvalue &= 0xFFFF;             \
3048                   if (MY_POSIX_EXIT)                    \
3049                     PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\
3050                   else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \
3051                 }                                       \
3052                 else {                                  \
3053                   PL_statusvalue_vms = vaxc$errno;      \
3054                 }                                       \
3055             }                                           \
3056             else PL_statusvalue_vms = SS$_ABORT;        \
3057             set_vaxc_errno(PL_statusvalue_vms);         \
3058         } STMT_END
3059
3060   /* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets
3061    * the NATIVE error status based on it.
3062    *
3063    * When in the default mode to comply with the Perl VMS documentation,
3064    * 0 is a success and any other code sets the NATIVE status to a failure
3065    * code of SS$_ABORT.
3066    *
3067    * In the new POSIX EXIT mode, native status will be set so that the
3068    * actual exit code will can be retrieved by the calling program or
3069    * shell.
3070    *
3071    * If the exit code is not clearly a UNIX parent or child exit status,
3072    * it will be passed through as a VMS status.
3073    */
3074
3075 #   define STATUS_UNIX_EXIT_SET(n)                      \
3076         STMT_START {                                    \
3077             I32 evalue = (I32)n;                        \
3078             PL_statusvalue = evalue;                    \
3079             if (MY_POSIX_EXIT) { \
3080               if (evalue <= 0xFF00) {           \
3081                   if (evalue > 0xFF)                    \
3082                     evalue = (evalue >> child_offset_bits) & 0xFF; \
3083                   PL_statusvalue_vms =          \
3084                     (C_FAC_POSIX | (evalue << 3 ) |     \
3085                     ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \
3086               } else /* forgive them Perl, for they have sinned */ \
3087                 PL_statusvalue_vms = evalue; \
3088             } else { \
3089               if (evalue == 0)                  \
3090                 PL_statusvalue_vms = SS$_NORMAL;        \
3091               else if (evalue <= 0xFF00) \
3092                 PL_statusvalue_vms = SS$_ABORT; \
3093               else { /* forgive them Perl, for they have sinned */ \
3094                   if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \
3095                   else PL_statusvalue_vms = vaxc$errno; \
3096                   /* And obviously used a VMS status value instead of UNIX */ \
3097                   PL_statusvalue = EVMSERR;             \
3098               } \
3099               set_vaxc_errno(PL_statusvalue_vms);       \
3100             }                                           \
3101         } STMT_END
3102
3103
3104   /* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code
3105    * and sets the NATIVE error status based on it.  This special case
3106    * is needed to maintain compatibility with past VMS behavior.
3107    *
3108    * In the default mode on VMS, this number is passed through as
3109    * both the NATIVE and UNIX status.  Which makes it different
3110    * that the STATUS_UNIX_EXIT_SET.
3111    *
3112    * In the new POSIX EXIT mode, native status will be set so that the
3113    * actual exit code will can be retrieved by the calling program or
3114    * shell.
3115    *
3116    * A POSIX exit code is from 0 to 255.  If the exit code is higher
3117    * than this, it needs to be assumed that it is a VMS exit code and
3118    * passed through.
3119    */
3120
3121 #   define STATUS_EXIT_SET(n)                           \
3122         STMT_START {                                    \
3123             I32 evalue = (I32)n;                        \
3124             PL_statusvalue = evalue;                    \
3125             if (MY_POSIX_EXIT)                          \
3126                 if (evalue > 255) PL_statusvalue_vms = evalue; else {   \
3127                   PL_statusvalue_vms = \
3128                     (C_FAC_POSIX | (evalue << 3 ) |     \
3129                      ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \
3130             else                                        \
3131                 PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \
3132             set_vaxc_errno(PL_statusvalue_vms);         \
3133         } STMT_END
3134
3135
3136  /* This macro forces a success status */
3137 #   define STATUS_ALL_SUCCESS   \
3138         (PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL)
3139
3140  /* This macro forces a failure status */
3141 #   define STATUS_ALL_FAILURE   (PL_statusvalue = 1, \
3142      vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \
3143         (C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT)
3144
3145 #else
3146 #   define STATUS_NATIVE        PL_statusvalue_posix
3147 #   if defined(WCOREDUMP)
3148 #       define STATUS_NATIVE_CHILD_SET(n)                  \
3149             STMT_START {                                   \
3150                 PL_statusvalue_posix = (n);                \
3151                 if (PL_statusvalue_posix == -1)            \
3152                     PL_statusvalue = -1;                   \
3153                 else {                                     \
3154                     PL_statusvalue =                       \
3155                         (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) |  \
3156                         (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0) | \
3157                         (WIFSIGNALED(PL_statusvalue_posix) && WCOREDUMP(PL_statusvalue_posix) ? 0x80 : 0);  \
3158                 }                                          \
3159             } STMT_END
3160 #   elif defined(WIFEXITED)
3161 #       define STATUS_NATIVE_CHILD_SET(n)                  \
3162             STMT_START {                                   \
3163                 PL_statusvalue_posix = (n);                \
3164                 if (PL_statusvalue_posix == -1)            \
3165                     PL_statusvalue = -1;                   \
3166                 else {                                     \
3167                     PL_statusvalue =                       \
3168                         (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) |  \
3169                         (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0);  \
3170                 }                                          \
3171             } STMT_END
3172 #   else
3173 #       define STATUS_NATIVE_CHILD_SET(n)                  \
3174             STMT_START {                                   \
3175                 PL_statusvalue_posix = (n);                \
3176                 if (PL_statusvalue_posix == -1)            \
3177                     PL_statusvalue = -1;                   \
3178                 else {                                     \
3179                     PL_statusvalue =                       \
3180                         PL_statusvalue_posix & 0xFFFF;     \
3181                 }                                          \
3182             } STMT_END
3183 #   endif
3184 #   define STATUS_UNIX_SET(n)           \
3185         STMT_START {                    \
3186             PL_statusvalue = (n);               \
3187             if (PL_statusvalue != -1)   \
3188                 PL_statusvalue &= 0xFFFF;       \
3189         } STMT_END
3190 #   define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n)
3191 #   define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n)
3192 #   define STATUS_CURRENT STATUS_UNIX
3193 #   define STATUS_EXIT STATUS_UNIX
3194 #   define STATUS_ALL_SUCCESS   (PL_statusvalue = 0, PL_statusvalue_posix = 0)
3195 #   define STATUS_ALL_FAILURE   (PL_statusvalue = 1, PL_statusvalue_posix = 1)
3196 #endif
3197
3198 /* flags in PL_exit_flags for nature of exit() */
3199 #define PERL_EXIT_EXPECTED      0x01
3200 #define PERL_EXIT_DESTRUCT_END  0x02  /* Run END in perl_destruct */
3201 #define PERL_EXIT_WARN          0x04  /* Warn if Perl_my_exit() or Perl_my_failure_exit() called */
3202 #define PERL_EXIT_ABORT         0x08  /* Call abort() if Perl_my_exit() or Perl_my_failure_exit() called */
3203
3204 #ifndef PERL_CORE
3205 /* format to use for version numbers in file/directory names */
3206 /* XXX move to Configure? */
3207 /* This was only ever used for the current version, and that can be done at
3208    compile time, as PERL_FS_VERSION, so should we just delete it?  */
3209 #  ifndef PERL_FS_VER_FMT
3210 #    define PERL_FS_VER_FMT     "%d.%d.%d"
3211 #  endif
3212 #endif
3213
3214 #ifndef PERL_FS_VERSION
3215 #  define PERL_FS_VERSION       PERL_VERSION_STRING
3216 #endif
3217
3218 /* This defines a way to flush all output buffers.  This may be a
3219  * performance issue, so we allow people to disable it.  Also, if
3220  * we are using stdio, there are broken implementations of fflush(NULL)
3221  * out there, Solaris being the most prominent.
3222  */
3223 #ifndef PERL_FLUSHALL_FOR_CHILD
3224 # if defined(USE_PERLIO) || defined(FFLUSH_NULL)
3225 #  define PERL_FLUSHALL_FOR_CHILD       PerlIO_flush((PerlIO*)NULL)
3226 # else
3227 #  ifdef FFLUSH_ALL
3228 #   define PERL_FLUSHALL_FOR_CHILD      my_fflush_all()
3229 #  else
3230 #   define PERL_FLUSHALL_FOR_CHILD      NOOP
3231 #  endif
3232 # endif
3233 #endif
3234
3235 #ifndef PERL_WAIT_FOR_CHILDREN
3236 #  define PERL_WAIT_FOR_CHILDREN        NOOP
3237 #endif
3238
3239 /* the traditional thread-unsafe notion of "current interpreter". */
3240 #ifndef PERL_SET_INTERP
3241 #  define PERL_SET_INTERP(i)            (PL_curinterp = (PerlInterpreter*)(i))
3242 #endif
3243
3244 #ifndef PERL_GET_INTERP
3245 #  define PERL_GET_INTERP               (PL_curinterp)
3246 #endif
3247
3248 #if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
3249 #  ifdef MULTIPLICITY
3250 #    define PERL_GET_THX                ((PerlInterpreter *)PERL_GET_CONTEXT)
3251 #  endif
3252 #  define PERL_SET_THX(t)               PERL_SET_CONTEXT(t)
3253 #endif
3254
3255 /*
3256     This replaces the previous %_ "hack" by the "%p" hacks.
3257     All that is required is that the perl source does not
3258     use "%-p" or "%-<number>p" or "%<number>p" formats.
3259     These formats will still work in perl code.
3260     See comments in sv.c for further details.
3261
3262     Robin Barker 2005-07-14
3263
3264     No longer use %1p for VDf = %vd.  RMB 2007-10-19
3265 */
3266
3267 #ifndef SVf_
3268 #  define SVf_(n) "-" STRINGIFY(n) "p"
3269 #endif
3270
3271 #ifndef SVf
3272 #  define SVf "-p"
3273 #endif
3274
3275 #ifndef SVf32
3276 #  define SVf32 SVf_(32)
3277 #endif
3278
3279 #ifndef SVf256
3280 #  define SVf256 SVf_(256)
3281 #endif
3282
3283 #define SVfARG(p) ((void*)(p))
3284
3285 #ifndef HEKf
3286 #  define HEKf "2p"
3287 #endif
3288
3289 /* Not ideal, but we cannot easily include a number in an already-numeric
3290  * format sequence. */
3291 #ifndef HEKf256
3292 #  define HEKf256 "3p"
3293 #endif
3294
3295 #define HEKfARG(p) ((void*)(p))
3296
3297 /* Takes three arguments: is_utf8, length, str */
3298 #ifndef UTF8f
3299 #  define UTF8f "d%" UVuf "%4p"
3300 #endif
3301 #define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p)
3302
3303 #ifdef PERL_CORE
3304 /* not used; but needed for backward compatibility with XS code? - RMB */
3305 #  undef UVf
3306 #else
3307 #  ifndef UVf
3308 #    define UVf UVuf
3309 #  endif
3310 #endif
3311
3312 #ifdef HASATTRIBUTE_DEPRECATED
3313 #  define __attribute__deprecated__         __attribute__((deprecated))
3314 #endif
3315 #ifdef HASATTRIBUTE_FORMAT
3316 #  define __attribute__format__(x,y,z)      __attribute__((format(x,y,z)))
3317 #endif
3318 #ifdef HASATTRIBUTE_MALLOC
3319 #  define __attribute__malloc__             __attribute__((__malloc__))
3320 #endif
3321 #ifdef HASATTRIBUTE_NONNULL
3322 #  define __attribute__nonnull__(a)         __attribute__((nonnull(a)))
3323 #endif
3324 #ifdef HASATTRIBUTE_NORETURN
3325 #  define __attribute__noreturn__           __attribute__((noreturn))
3326 #endif
3327 #ifdef HASATTRIBUTE_PURE
3328 #  define __attribute__pure__               __attribute__((pure))
3329 #endif
3330 #ifdef HASATTRIBUTE_UNUSED
3331 #  define __attribute__unused__             __attribute__((unused))
3332 #endif
3333 #ifdef HASATTRIBUTE_WARN_UNUSED_RESULT
3334 #  define __attribute__warn_unused_result__ __attribute__((warn_unused_result))
3335 #endif
3336
3337 /* If we haven't defined the attributes yet, define them to blank. */
3338 #ifndef __attribute__deprecated__
3339 #  define __attribute__deprecated__
3340 #endif
3341 #ifndef __attribute__format__
3342 #  define __attribute__format__(x,y,z)
3343 #endif
3344 #ifndef __attribute__malloc__
3345 #  define __attribute__malloc__
3346 #endif
3347 #ifndef __attribute__nonnull__
3348 #  define __attribute__nonnull__(a)
3349 #endif
3350 #ifndef __attribute__noreturn__
3351 #  define __attribute__noreturn__
3352 #endif
3353 #ifndef __attribute__pure__
3354 #  define __attribute__pure__
3355 #endif
3356 #ifndef __attribute__unused__
3357 #  define __attribute__unused__
3358 #endif
3359 #ifndef __attribute__warn_unused_result__
3360 #  define __attribute__warn_unused_result__
3361 #endif
3362
3363 #if defined(DEBUGGING) && defined(I_ASSERT)
3364 #  include <assert.h>
3365 #endif
3366
3367 /* For functions that are marked as __attribute__noreturn__, it's not
3368    appropriate to call return.  In either case, include the lint directive.
3369  */
3370 #ifdef HASATTRIBUTE_NORETURN
3371 #  define NORETURN_FUNCTION_END NOT_REACHED; /* NOTREACHED */
3372 #else
3373 #  define NORETURN_FUNCTION_END NOT_REACHED; /* NOTREACHED */ return 0
3374 #endif
3375
3376 /* Some OS warn on NULL format to printf */
3377 #ifdef PRINTF_FORMAT_NULL_OK
3378 #  define __attribute__format__null_ok__(x,y,z)  __attribute__format__(x,y,z)
3379 #else
3380 #  define __attribute__format__null_ok__(x,y,z)
3381 #endif
3382
3383 #ifdef HAS_BUILTIN_EXPECT
3384 #  define EXPECT(expr,val)                  __builtin_expect(expr,val)
3385 #else
3386 #  define EXPECT(expr,val)                  (expr)
3387 #endif
3388 #define LIKELY(cond)                        EXPECT(cBOOL(cond),TRUE)
3389 #define UNLIKELY(cond)                      EXPECT(cBOOL(cond),FALSE)
3390 #ifdef HAS_BUILTIN_CHOOSE_EXPR
3391 /* placeholder */
3392 #endif
3393
3394
3395 #ifndef __has_builtin
3396 #  define __has_builtin(x) 0 /* not a clang style compiler */
3397 #endif
3398
3399 /* ASSUME is like assert(), but it has a benefit in a release build. It is a
3400    hint to a compiler about a statement of fact in a function call free
3401    expression, which allows the compiler to generate better machine code.
3402    In a debug build, ASSUME(x) is a synonym for assert(x). ASSUME(0) means
3403    the control path is unreachable. In a for loop, ASSUME can be used to hint
3404    that a loop will run atleast X times. ASSUME is based off MSVC's __assume
3405    intrinsic function, see its documents for more details.
3406 */
3407
3408 #ifndef DEBUGGING
3409 #  if __has_builtin(__builtin_unreachable) \
3410      || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5 || __GNUC__ > 5) /* 4.5 -> */
3411 #    define ASSUME(x) ((x) ? (void) 0 : __builtin_unreachable())
3412 #  elif defined(_MSC_VER)
3413 #    define ASSUME(x) __assume(x)
3414 #  elif defined(__ARMCC_VERSION) /* untested */
3415 #    define ASSUME(x) __promise(x)
3416 #  else
3417 /* a random compiler might define assert to its own special optimization token
3418    so pass it through to C lib as a last resort */
3419 #    define ASSUME(x) assert(x)
3420 #  endif
3421 #else
3422 #  define ASSUME(x) assert(x)
3423 #endif
3424
3425 #define NOT_REACHED ASSUME(0)
3426
3427 /* Some unistd.h's give a prototype for pause() even though
3428    HAS_PAUSE ends up undefined.  This causes the #define
3429    below to be rejected by the compiler.  Sigh.
3430 */
3431 #ifdef HAS_PAUSE
3432 #define Pause   pause
3433 #else
3434 #define Pause() sleep((32767<<16)+32767)
3435 #endif
3436
3437 #ifndef IOCPARM_LEN
3438 #   ifdef IOCPARM_MASK
3439         /* on BSDish systems we're safe */
3440 #       define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
3441 #   else
3442 #       if defined(_IOC_SIZE) && defined(__GLIBC__)
3443         /* on Linux systems we're safe; except when we're not [perl #38223] */
3444 #           define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x))
3445 #       else
3446         /* otherwise guess at what's safe */
3447 #           define IOCPARM_LEN(x)       256
3448 #       endif
3449 #   endif
3450 #endif
3451
3452 #if defined(__CYGWIN__)
3453 /* USEMYBINMODE
3454  *   This symbol, if defined, indicates that the program should
3455  *   use the routine my_binmode(FILE *fp, char iotype, int mode) to insure
3456  *   that a file is in "binary" mode -- that is, that no translation
3457  *   of bytes occurs on read or write operations.
3458  */
3459 #  define USEMYBINMODE /**/
3460 #  include <io.h> /* for setmode() prototype */
3461 #  define my_binmode(fp, iotype, mode) \
3462             (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE)
3463 #endif
3464
3465 #ifdef __CYGWIN__
3466 void init_os_extras(void);
3467 #endif
3468
3469 #ifdef UNION_ANY_DEFINITION
3470 UNION_ANY_DEFINITION;
3471 #else
3472 union any {
3473     void*       any_ptr;
3474     I32         any_i32;
3475     U32         any_u32;
3476     IV          any_iv;
3477     UV          any_uv;
3478     long        any_long;
3479     bool        any_bool;
3480     void        (*any_dptr) (void*);
3481     void        (*any_dxptr) (pTHX_ void*);
3482 };
3483 #endif
3484
3485 typedef I32 (*filter_t) (pTHX_ int, SV *, int);
3486
3487 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
3488 #define FILTER_DATA(idx) \
3489             (PL_parser ? AvARRAY(PL_parser->rsfp_filters)[idx] : NULL)
3490 #define FILTER_ISREADER(idx) \
3491             (PL_parser && PL_parser->rsfp_filters \
3492                 && idx >= AvFILLp(PL_parser->rsfp_filters))
3493 #define PERL_FILTER_EXISTS(i) \
3494             (PL_parser && PL_parser->rsfp_filters \
3495                 && (i) <= av_tindex(PL_parser->rsfp_filters))
3496
3497 #if defined(_AIX) && !defined(_AIX43)
3498 #if defined(USE_REENTRANT) || defined(_REENTRANT) || defined(_THREAD_SAFE)
3499 /* We cannot include <crypt.h> to get the struct crypt_data
3500  * because of setkey prototype problems when threading */
3501 typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
3502     /* From OSF, Not needed in AIX
3503        char C[28], D[28];
3504     */
3505     char E[48];
3506     char KS[16][48];
3507     char block[66];
3508     char iobuf[16];
3509 } CRYPTD;
3510 #endif /* threading */
3511 #endif /* AIX */
3512
3513 #if !defined(OS2)
3514 #  include "iperlsys.h"
3515 #endif
3516
3517 #ifdef __LIBCATAMOUNT__
3518 #undef HAS_PASSWD  /* unixish.h but not unixish enough. */
3519 #undef HAS_GROUP
3520 #define FAKE_BIT_BUCKET
3521 #endif
3522
3523 /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0.
3524  * Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT*
3525  * defined by Configure, despite their names being similar to the
3526  * other defines like USE_ITHREADS.  Configure in fact knows nothing
3527  * about the randomised hashes.  Therefore to enable/disable the hash
3528  * randomisation defines use the Configure -Accflags=... instead. */
3529 #if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT)
3530 #  define USE_HASH_SEED
3531 #endif
3532
3533 /* Win32 defines a type 'WORD' in windef.h. This conflicts with the enumerator
3534  * 'WORD' defined in perly.h. The yytokentype enum is only a debugging aid, so
3535  * it's not really needed.
3536  */
3537 #if defined(WIN32)
3538 #  define YYTOKENTYPE
3539 #endif
3540 #include "perly.h"
3541
3542
3543 /* macros to define bit-fields in structs. */
3544 #ifndef PERL_BITFIELD8
3545 #  define PERL_BITFIELD8 unsigned
3546 #endif
3547 #ifndef PERL_BITFIELD16
3548 #  define PERL_BITFIELD16 unsigned
3549 #endif
3550 #ifndef PERL_BITFIELD32
3551 #  define PERL_BITFIELD32 unsigned
3552 #endif
3553
3554 #include "sv.h"
3555 #include "regexp.h"
3556 #include "util.h"
3557 #include "form.h"
3558 #include "gv.h"
3559 #include "pad.h"
3560 #include "cv.h"
3561 #include "opnames.h"
3562 #include "op.h"
3563 #include "hv.h"
3564 #include "cop.h"
3565 #include "av.h"
3566 #include "mg.h"
3567 #include "scope.h"
3568 #include "warnings.h"
3569 #include "utf8.h"
3570
3571 /* these would be in doio.h if there was such a file */
3572 #define my_stat()  my_stat_flags(SV_GMAGIC)
3573 #define my_lstat() my_lstat_flags(SV_GMAGIC)
3574
3575 /* defined in sv.c, but also used in [ach]v.c */
3576 #undef _XPV_HEAD
3577 #undef _XPVMG_HEAD
3578 #undef _XPVCV_COMMON
3579
3580 typedef struct _sublex_info SUBLEXINFO;
3581 struct _sublex_info {
3582     U8 super_state;     /* lexer state to save */
3583     U16 sub_inwhat;     /* "lex_inwhat" to use */
3584     OP *sub_op;         /* "lex_op" to use */
3585     SV *repl;           /* replacement of s/// or y/// */
3586 };
3587
3588 #include "parser.h"
3589
3590 typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
3591
3592 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
3593
3594 /* These have to be predeclared, as they are used in proto.h which is #included
3595  * before their definitions in regcomp.h. */
3596
3597 struct scan_data_t;
3598 typedef struct regnode_charclass regnode_charclass;
3599
3600 struct regnode_charclass_class;
3601
3602 /* A hopefully less confusing name.  The sub-classes are all Posix classes only
3603  * used under /l matching */
3604 typedef struct regnode_charclass_class regnode_charclass_posixl;
3605
3606 typedef struct regnode_ssc regnode_ssc;
3607 typedef struct RExC_state_t RExC_state_t;
3608 struct _reg_trie_data;
3609
3610 #endif
3611
3612 struct ptr_tbl_ent {
3613     struct ptr_tbl_ent*         next;
3614     const void*                 oldval;
3615     void*                       newval;
3616 };
3617
3618 struct ptr_tbl {
3619     struct ptr_tbl_ent**        tbl_ary;
3620     UV                          tbl_max;
3621     UV                          tbl_items;
3622     struct ptr_tbl_arena        *tbl_arena;
3623     struct ptr_tbl_ent          *tbl_arena_next;
3624     struct ptr_tbl_ent          *tbl_arena_end;
3625 };
3626
3627 #if defined(htonl) && !defined(HAS_HTONL)
3628 #define HAS_HTONL
3629 #endif
3630 #if defined(htons) && !defined(HAS_HTONS)
3631 #define HAS_HTONS
3632 #endif
3633 #if defined(ntohl) && !defined(HAS_NTOHL)
3634 #define HAS_NTOHL
3635 #endif
3636 #if defined(ntohs) && !defined(HAS_NTOHS)
3637 #define HAS_NTOHS
3638 #endif
3639 #ifndef HAS_HTONL
3640 #define HAS_HTONS
3641 #define HAS_HTONL
3642 #define HAS_NTOHS
3643 #define HAS_NTOHL
3644 #  if (BYTEORDER & 0xffff) == 0x4321
3645 /* Big endian system, so ntohl, ntohs, htonl and htons do not need to
3646    re-order their values. However, to behave identically to the alternative
3647    implementations, they should truncate to the correct size.  */
3648 #    define ntohl(x)    ((x)&0xFFFFFFFF)
3649 #    define htonl(x)    ntohl(x)
3650 #    define ntohs(x)    ((x)&0xFFFF)
3651 #    define htons(x)    ntohs(x)
3652 #  elif BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
3653
3654 /* Note that we can't straight out declare our own htonl and htons because
3655    the Win32 build process forcibly undefines HAS_HTONL etc for its miniperl,
3656    to avoid the overhead of initialising the socket subsystem, but the headers
3657    that *declare* the various functions are still seen. If we declare our own
3658    htonl etc they will clash with the declarations in the Win32 headers.  */
3659
3660 PERL_STATIC_INLINE U32
3661 my_swap32(const U32 x) {
3662     return ((x & 0xFF) << 24) | ((x >> 24) & 0xFF)      
3663         | ((x & 0x0000FF00) << 8) | ((x & 0x00FF0000) >> 8);
3664 }
3665
3666 PERL_STATIC_INLINE U16
3667 my_swap16(const U16 x) {
3668     return ((x & 0xFF) << 8) | ((x >> 8) & 0xFF);
3669 }
3670
3671 #    define htonl(x)    my_swap32(x)
3672 #    define ntohl(x)    my_swap32(x)
3673 #    define ntohs(x)    my_swap16(x)
3674 #    define htons(x)    my_swap16(x)
3675 #  else
3676 #    error "Unsupported byteorder"
3677 /* The C pre-processor doesn't let us return the value of BYTEORDER as part of
3678    the error message. Please check the value of the macro BYTEORDER, as defined
3679    in config.h. The values of BYTEORDER we expect are
3680
3681             big endian  little endian
3682    32 bit       0x4321  0x1234
3683    64 bit   0x87654321  0x12345678
3684
3685    If you have a system with a different byte order, please see
3686    pod/perlhack.pod for how to submit a patch to add supporting code.
3687 */
3688 #  endif
3689 #endif
3690
3691 /*
3692  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
3693  * -DWS
3694  */
3695 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
3696 /* Little endian system, so vtohl, vtohs, htovl and htovs do not need to
3697    re-order their values. However, to behave identically to the alternative
3698    implementations, they should truncate to the correct size.  */
3699 #  define vtohl(x)      ((x)&0xFFFFFFFF)
3700 #  define vtohs(x)      ((x)&0xFFFF)
3701 #  define htovl(x)      vtohl(x)
3702 #  define htovs(x)      vtohs(x)
3703 #elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
3704 #  define vtohl(x)      ((((x)&0xFF)<<24)       \
3705                         +(((x)>>24)&0xFF)       \
3706                         +(((x)&0x0000FF00)<<8)  \
3707                         +(((x)&0x00FF0000)>>8)  )
3708 #  define vtohs(x)      ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
3709 #  define htovl(x)      vtohl(x)
3710 #  define htovs(x)      vtohs(x)
3711 #else
3712 #  error "Unsupported byteorder"
3713 /* If you have need for current perl on PDP-11 or similar, and can help test
3714    that blead keeps working on a mixed-endian system, then see
3715    pod/perlhack.pod for how to submit patches to things working again.  */
3716 #endif
3717
3718 /* *MAX Plus 1. A floating point value.
3719    Hopefully expressed in a way that dodgy floating point can't mess up.
3720    >> 2 rather than 1, so that value is safely less than I32_MAX after 1
3721    is added to it
3722    May find that some broken compiler will want the value cast to I32.
3723    [after the shift, as signed >> may not be as secure as unsigned >>]
3724 */
3725 #define I32_MAX_P1 (2.0 * (1 + (((U32)I32_MAX) >> 1)))
3726 #define U32_MAX_P1 (4.0 * (1 + ((U32_MAX) >> 2)))
3727 /* For compilers that can't correctly cast NVs over 0x7FFFFFFF (or
3728    0x7FFFFFFFFFFFFFFF) to an unsigned integer. In the future, sizeof(UV)
3729    may be greater than sizeof(IV), so don't assume that half max UV is max IV.
3730 */
3731 #define U32_MAX_P1_HALF (2.0 * (1 + ((U32_MAX) >> 2)))
3732
3733 #define UV_MAX_P1 (4.0 * (1 + ((UV_MAX) >> 2)))
3734 #define IV_MAX_P1 (2.0 * (1 + (((UV)IV_MAX) >> 1)))
3735 #define UV_MAX_P1_HALF (2.0 * (1 + ((UV_MAX) >> 2)))
3736
3737 /* This may look like unnecessary jumping through hoops, but converting
3738    out of range floating point values to integers *is* undefined behaviour,
3739    and it is starting to bite.
3740 */
3741 #ifndef CAST_INLINE
3742 #define I_32(what) (cast_i32((NV)(what)))
3743 #define U_32(what) (cast_ulong((NV)(what)))
3744 #define I_V(what) (cast_iv((NV)(what)))
3745 #define U_V(what) (cast_uv((NV)(what)))
3746 #else
3747 #define I_32(n) ((n) < I32_MAX_P1 ? ((n) < I32_MIN ? I32_MIN : (I32) (n)) \
3748                   : ((n) < U32_MAX_P1 ? (I32)(U32) (n) \
3749                      : ((n) > 0 ? (I32) U32_MAX : 0 /* NaN */)))
3750 #define U_32(n) ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \
3751                   : ((n) < U32_MAX_P1 ? (U32) (n) \
3752                      : ((n) > 0 ? U32_MAX : 0 /* NaN */)))
3753 #define I_V(n) (LIKELY((n) < IV_MAX_P1) ? (UNLIKELY((n) < IV_MIN) ? IV_MIN : (IV) (n)) \
3754                   : (LIKELY((n) < UV_MAX_P1) ? (IV)(UV) (n) \
3755                      : ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */)))
3756 #define U_V(n) ((n) < 0.0 ? (UNLIKELY((n) < IV_MIN) ? (UV) IV_MIN : (UV)(IV) (n)) \
3757                   : (LIKELY((n) < UV_MAX_P1) ? (UV) (n) \
3758                      : ((n) > 0 ? UV_MAX : 0 /* NaN */)))
3759 #endif
3760
3761 #define U_S(what) ((U16)U_32(what))
3762 #define U_I(what) ((unsigned int)U_32(what))
3763 #define U_L(what) U_32(what)
3764
3765 #ifdef HAS_SIGNBIT
3766 #  define Perl_signbit signbit
3767 #endif
3768
3769 /* These do not care about the fractional part, only about the range. */
3770 #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX)
3771 #define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX)
3772
3773 /* Used with UV/IV arguments: */
3774                                         /* XXXX: need to speed it up */
3775 #define CLUMP_2UV(iv)   ((iv) < 0 ? 0 : (UV)(iv))
3776 #define CLUMP_2IV(uv)   ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv))
3777
3778 #ifndef MAXSYSFD
3779 #   define MAXSYSFD 2
3780 #endif
3781
3782 #ifndef __cplusplus
3783 #if !(defined(WIN32) || defined(UNDER_CE) || defined(SYMBIAN))
3784 Uid_t getuid (void);
3785 Uid_t geteuid (void);
3786 Gid_t getgid (void);
3787 Gid_t getegid (void);
3788 #endif
3789 #endif
3790
3791 #ifndef Perl_debug_log
3792 #  define Perl_debug_log        PerlIO_stderr()
3793 #endif
3794
3795 #ifndef Perl_error_log
3796 #  define Perl_error_log        (PL_stderrgv                    \
3797                                  && isGV(PL_stderrgv)           \
3798                                  && GvIOp(PL_stderrgv)          \
3799                                  && IoOFP(GvIOp(PL_stderrgv))   \
3800                                  ? IoOFP(GvIOp(PL_stderrgv))    \
3801                                  : PerlIO_stderr())
3802 #endif
3803
3804
3805 #define DEBUG_p_FLAG            0x00000001 /*      1 */
3806 #define DEBUG_s_FLAG            0x00000002 /*      2 */
3807 #define DEBUG_l_FLAG            0x00000004 /*      4 */
3808 #define DEBUG_t_FLAG            0x00000008 /*      8 */
3809 #define DEBUG_o_FLAG            0x00000010 /*     16 */
3810 #define DEBUG_c_FLAG            0x00000020 /*     32 */
3811 #define DEBUG_P_FLAG            0x00000040 /*     64 */
3812 #define DEBUG_m_FLAG            0x00000080 /*    128 */
3813 #define DEBUG_f_FLAG            0x00000100 /*    256 */
3814 #define DEBUG_r_FLAG            0x00000200 /*    512 */
3815 #define DEBUG_x_FLAG            0x00000400 /*   1024 */
3816 #define DEBUG_u_FLAG            0x00000800 /*   2048 */
3817 /* U is reserved for Unofficial, exploratory hacking */
3818 #define DEBUG_U_FLAG            0x00001000 /*   4096 */
3819 #define DEBUG_H_FLAG            0x00002000 /*   8192 */
3820 #define DEBUG_X_FLAG            0x00004000 /*  16384 */
3821 #define DEBUG_D_FLAG            0x00008000 /*  32768 */
3822 #define DEBUG_S_FLAG            0x00010000 /*  65536 */
3823 #define DEBUG_T_FLAG            0x00020000 /* 131072 */
3824 #define DEBUG_R_FLAG            0x00040000 /* 262144 */
3825 #define DEBUG_J_FLAG            0x00080000 /* 524288 */
3826 #define DEBUG_v_FLAG            0x00100000 /*1048576 */
3827 #define DEBUG_C_FLAG            0x00200000 /*2097152 */
3828 #define DEBUG_A_FLAG            0x00400000 /*4194304 */
3829 #define DEBUG_q_FLAG            0x00800000 /*8388608 */
3830 #define DEBUG_M_FLAG            0x01000000 /*16777216*/
3831 #define DEBUG_B_FLAG            0x02000000 /*33554432*/
3832 #define DEBUG_L_FLAG            0x04000000 /*67108864*/
3833 #define DEBUG_MASK              0x07FFEFFF /* mask of all the standard flags */
3834
3835 #define DEBUG_DB_RECURSE_FLAG   0x40000000
3836 #define DEBUG_TOP_FLAG          0x80000000 /* XXX what's this for ??? Signal
3837                                               that something was done? */
3838
3839 #  define DEBUG_p_TEST_ (PL_debug & DEBUG_p_FLAG)
3840 #  define DEBUG_s_TEST_ (PL_debug & DEBUG_s_FLAG)
3841 #  define DEBUG_l_TEST_ (PL_debug & DEBUG_l_FLAG)
3842 #  define DEBUG_t_TEST_ (PL_debug & DEBUG_t_FLAG)
3843 #  define DEBUG_o_TEST_ (PL_debug & DEBUG_o_FLAG)
3844 #  define DEBUG_c_TEST_ (PL_debug & DEBUG_c_FLAG)
3845 #  define DEBUG_P_TEST_ (PL_debug & DEBUG_P_FLAG)
3846 #  define DEBUG_m_TEST_ (PL_debug & DEBUG_m_FLAG)
3847 #  define DEBUG_f_TEST_ (PL_debug & DEBUG_f_FLAG)
3848 #  define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG)
3849 #  define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG)
3850 #  define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG)
3851 #  define DEBUG_U_TEST_ (PL_debug & DEBUG_U_FLAG)
3852 #  define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG)
3853 #  define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG)
3854 #  define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG)
3855 #  define DEBUG_S_TEST_ (PL_debug & DEBUG_S_FLAG)
3856 #  define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG)
3857 #  define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
3858 #  define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
3859 #  define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG)
3860 #  define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG)
3861 #  define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG)
3862 #  define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
3863 #  define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG)
3864 #  define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG)
3865 #  define DEBUG_L_TEST_ (PL_debug & DEBUG_L_FLAG)
3866 #  define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
3867 #  define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_)
3868 #  define DEBUG_Pv_TEST_ (DEBUG_P_TEST_ && DEBUG_v_TEST_)
3869
3870 #ifdef DEBUGGING
3871
3872 #  define DEBUG_p_TEST DEBUG_p_TEST_
3873 #  define DEBUG_s_TEST DEBUG_s_TEST_
3874 #  define DEBUG_l_TEST DEBUG_l_TEST_
3875 #  define DEBUG_t_TEST DEBUG_t_TEST_
3876 #  define DEBUG_o_TEST DEBUG_o_TEST_
3877 #  define DEBUG_c_TEST DEBUG_c_TEST_
3878 #  define DEBUG_P_TEST DEBUG_P_TEST_
3879 #  define DEBUG_m_TEST DEBUG_m_TEST_
3880 #  define DEBUG_f_TEST DEBUG_f_TEST_
3881 #  define DEBUG_r_TEST DEBUG_r_TEST_
3882 #  define DEBUG_x_TEST DEBUG_x_TEST_
3883 #  define DEBUG_u_TEST DEBUG_u_TEST_
3884 #  define DEBUG_U_TEST DEBUG_U_TEST_
3885 #  define DEBUG_H_TEST DEBUG_H_TEST_
3886 #  define DEBUG_X_TEST DEBUG_X_TEST_
3887 #  define DEBUG_D_TEST DEBUG_D_TEST_
3888 #  define DEBUG_S_TEST DEBUG_S_TEST_
3889 #  define DEBUG_T_TEST DEBUG_T_TEST_
3890 #  define DEBUG_R_TEST DEBUG_R_TEST_
3891 #  define DEBUG_J_TEST DEBUG_J_TEST_
3892 #  define DEBUG_v_TEST DEBUG_v_TEST_
3893 #  define DEBUG_C_TEST DEBUG_C_TEST_
3894 #  define DEBUG_A_TEST DEBUG_A_TEST_
3895 #  define DEBUG_q_TEST DEBUG_q_TEST_
3896 #  define DEBUG_M_TEST DEBUG_M_TEST_
3897 #  define DEBUG_B_TEST DEBUG_B_TEST_
3898 #  define DEBUG_L_TEST DEBUG_L_TEST_
3899 #  define DEBUG_Xv_TEST DEBUG_Xv_TEST_
3900 #  define DEBUG_Uv_TEST DEBUG_Uv_TEST_
3901 #  define DEBUG_Pv_TEST DEBUG_Pv_TEST_
3902
3903 #  define PERL_DEB(a)                  a
3904 #  define PERL_DEBUG(a) if (PL_debug)  a
3905 #  define DEBUG_p(a) if (DEBUG_p_TEST) a
3906 #  define DEBUG_s(a) if (DEBUG_s_TEST) a
3907 #  define DEBUG_l(a) if (DEBUG_l_TEST) a
3908 #  define DEBUG_t(a) if (DEBUG_t_TEST) a
3909 #  define DEBUG_o(a) if (DEBUG_o_TEST) a
3910 #  define DEBUG_c(a) if (DEBUG_c_TEST) a
3911 #  define DEBUG_P(a) if (DEBUG_P_TEST) a
3912
3913      /* Temporarily turn off memory debugging in case the a
3914       * does memory allocation, either directly or indirectly. */
3915 #  define DEBUG_m(a)  \
3916     STMT_START {                                                        \
3917         if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \
3918     } STMT_END
3919
3920 #  define DEBUG__(t, a) \
3921         STMT_START { \
3922                 if (t) STMT_START {a;} STMT_END; \
3923         } STMT_END
3924
3925 #  define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
3926 #ifndef PERL_EXT_RE_BUILD
3927 #  define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
3928 #else
3929 #  define DEBUG_r(a) STMT_START {a;} STMT_END
3930 #endif /* PERL_EXT_RE_BUILD */
3931 #  define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
3932 #  define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
3933 #  define DEBUG_U(a) DEBUG__(DEBUG_U_TEST, a)
3934 #  define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
3935 #  define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a)
3936 #  define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a)
3937 #  define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
3938 #  define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a)
3939 #  define DEBUG_Pv(a) DEBUG__(DEBUG_Pv_TEST, a)
3940
3941 #  define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a)
3942 #  define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a)
3943 #  define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
3944 #  define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a)
3945 #  define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a)
3946 #  define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a)
3947 #  define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
3948 #  define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a)
3949 #  define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a)
3950 #  define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a)
3951
3952 #else /* DEBUGGING */
3953
3954 #  define DEBUG_p_TEST (0)
3955 #  define DEBUG_s_TEST (0)
3956 #  define DEBUG_l_TEST (0)
3957 #  define DEBUG_t_TEST (0)
3958 #  define DEBUG_o_TEST (0)
3959 #  define DEBUG_c_TEST (0)
3960 #  define DEBUG_P_TEST (0)
3961 #  define DEBUG_m_TEST (0)
3962 #  define DEBUG_f_TEST (0)
3963 #  define DEBUG_r_TEST (0)
3964 #  define DEBUG_x_TEST (0)
3965 #  define DEBUG_u_TEST (0)
3966 #  define DEBUG_U_TEST (0)
3967 #  define DEBUG_H_TEST (0)
3968 #  define DEBUG_X_TEST (0)
3969 #  define DEBUG_D_TEST (0)
3970 #  define DEBUG_S_TEST (0)
3971 #  define DEBUG_T_TEST (0)
3972 #  define DEBUG_R_TEST (0)
3973 #  define DEBUG_J_TEST (0)
3974 #  define DEBUG_v_TEST (0)
3975 #  define DEBUG_C_TEST (0)
3976 #  define DEBUG_A_TEST (0)
3977 #  define DEBUG_q_TEST (0)
3978 #  define DEBUG_M_TEST (0)
3979 #  define DEBUG_B_TEST (0)
3980 #  define DEBUG_L_TEST (0)
3981 #  define DEBUG_Xv_TEST (0)
3982 #  define DEBUG_Uv_TEST (0)
3983 #  define DEBUG_Pv_TEST (0)
3984
3985 #  define PERL_DEB(a)
3986 #  define PERL_DEBUG(a)
3987 #  define DEBUG_p(a)
3988 #  define DEBUG_s(a)
3989 #  define DEBUG_l(a)
3990 #  define DEBUG_t(a)
3991 #  define DEBUG_o(a)
3992 #  define DEBUG_c(a)
3993 #  define DEBUG_P(a)
3994 #  define DEBUG_m(a)
3995 #  define DEBUG_f(a)
3996 #  define DEBUG_r(a)
3997 #  define DEBUG_x(a)
3998 #  define DEBUG_u(a)
3999 #  define DEBUG_U(a)
4000 #  define DEBUG_H(a)
4001 #  define DEBUG_X(a)
4002 #  define DEBUG_D(a)
4003 #  define DEBUG_S(a)
4004 #  define DEBUG_T(a)
4005 #  define DEBUG_R(a)
4006 #  define DEBUG_v(a)
4007 #  define DEBUG_C(a)
4008 #  define DEBUG_A(a)
4009 #  define DEBUG_q(a)
4010 #  define DEBUG_M(a)
4011 #  define DEBUG_B(a)
4012 #  define DEBUG_L(a)
4013 #  define DEBUG_Xv(a)
4014 #  define DEBUG_Uv(a)
4015 #  define DEBUG_Pv(a)
4016 #endif /* DEBUGGING */
4017
4018
4019 #define DEBUG_SCOPE(where) \
4020     DEBUG_l( \
4021     Perl_deb(aTHX_ "%s scope %ld (savestack=%ld) at %s:%d\n",   \
4022                     where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \
4023                     __FILE__, __LINE__));
4024
4025 /* Keep the old croak based assert for those who want it, and as a fallback if
4026    the platform is so heretically non-ANSI that it can't assert.  */
4027
4028 #define Perl_assert(what)       PERL_DEB(                               \
4029         ((what) ? ((void) 0) :                                          \
4030             (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \
4031                         "\", line %d", STRINGIFY(what), __LINE__),      \
4032             (void) 0)))
4033
4034 /* assert() gets defined if DEBUGGING (and I_ASSERT).
4035  * If no DEBUGGING, the <assert.h> has not been included. */
4036 #ifndef assert
4037 #  define assert(what)  Perl_assert(what)
4038 #endif
4039 #ifdef DEBUGGING
4040 #  define assert_(what) assert(what),
4041 #else
4042 #  define assert_(what)
4043 #endif
4044
4045 struct ufuncs {
4046     I32 (*uf_val)(pTHX_ IV, SV*);
4047     I32 (*uf_set)(pTHX_ IV, SV*);
4048     IV uf_index;
4049 };
4050
4051 /* In pre-5.7-Perls the PERL_MAGIC_uvar magic didn't get the thread context.
4052  * XS code wanting to be backward compatible can do something
4053  * like the following:
4054
4055 #ifndef PERL_MG_UFUNC
4056 #define PERL_MG_UFUNC(name,ix,sv) I32 name(IV ix, SV *sv)
4057 #endif
4058
4059 static PERL_MG_UFUNC(foo_get, index, val)
4060 {
4061     sv_setsv(val, ...);
4062     return TRUE;
4063 }
4064
4065 -- Doug MacEachern
4066
4067 */
4068
4069 #ifndef PERL_MG_UFUNC
4070 #define PERL_MG_UFUNC(name,ix,sv) I32 name(pTHX_ IV ix, SV *sv)
4071 #endif
4072
4073 /* Fix these up for __STDC__ */
4074 #ifndef DONT_DECLARE_STD
4075 char *mktemp (char*);
4076 #ifndef atof
4077 double atof (const char*);
4078 #endif
4079 #endif
4080
4081 #ifndef STANDARD_C
4082 /* All of these are in stdlib.h or time.h for ANSI C */
4083 Time_t time();
4084 struct tm *gmtime(), *localtime();
4085 #if defined(OEMVS)
4086 char *(strchr)(), *(strrchr)();
4087 char *(strcpy)(), *(strcat)();
4088 #else
4089 char *strchr(), *strrchr();
4090 char *strcpy(), *strcat();
4091 #endif
4092 #endif /* ! STANDARD_C */
4093
4094
4095 #ifdef I_MATH
4096 #    include <math.h>
4097 #    ifdef __VMS
4098      /* isfinite and others are here rather than in math.h as C99 stipulates */
4099 #        include <fp.h>
4100 #    endif
4101 #else
4102 START_EXTERN_C
4103             double exp (double);
4104             double log (double);
4105             double log10 (double);
4106             double sqrt (double);
4107             double frexp (double,int*);
4108             double ldexp (double,int);
4109             double modf (double,double*);
4110             double sin (double);
4111             double cos (double);
4112             double atan2 (double,double);
4113             double pow (double,double);
4114 END_EXTERN_C
4115 #endif
4116
4117 #ifdef WIN32
4118 #  if !defined(NV_INF) && defined(HUGE_VAL)
4119 #    define NV_INF HUGE_VAL
4120 #  endif
4121 #  ifndef NV_NAN
4122 #    define NV_NAN (NV_INF-NV_INF)
4123 #  endif
4124 #endif
4125
4126 /* If you are thinking of using HUGE_VAL for infinity, or using
4127  * <math.h> functions to generate NV_INF (e.g. exp(1e9), log(-1.0)),
4128  * stop.  Neither will work portably: HUGE_VAL can be just DBL_MAX,
4129  * and the math functions might be just generating DBL_MAX, or even
4130  * zero.  */
4131
4132 #if !defined(NV_INF) && defined(USE_LONG_DOUBLE)
4133 #  if !defined(NV_INF) && defined(LDBL_INFINITY)
4134 #    define NV_INF LDBL_INFINITY
4135 #  endif
4136 #  if !defined(NV_INF) && defined(INFINITYL)
4137 #    define NV_INF INFINITYL
4138 #  endif
4139 #endif
4140 #if !defined(NV_INF) && defined(DBL_INFINITY)
4141 #  define NV_INF (NV)DBL_INFINITY
4142 #endif
4143 #if !defined(NV_INF) && defined(INFINITY)
4144 #  define NV_INF (NV)INFINITY
4145 #endif
4146 #if !defined(NV_INF) && defined(INF)
4147 #  define NV_INF (NV)INF
4148 #endif
4149 #if !defined(NV_INF)
4150 #  if INTSIZE == 4
4151 /* At this point we assume the IEEE 754 floating point (and of course,
4152  * we also assume a floating point format that can encode an infinity).
4153  * We will coerce an int32 (which will encode the infinity) into
4154  * a 32-bit float, which will then be cast into NV.
4155  *
4156  * Note that we intentionally use a float and 32-bit int, instead of
4157  * shifting a small integer into a full IV, and from that into a full
4158  * NV, because:
4159  *
4160  * (1) an IV might not be wide enough to cover all the bits of an NV.
4161  * (2) the exponent part (including the infinity and nan bits) of a NV
4162  *     might be wider than just 16 bits.
4163  *
4164  * Below the NV_NAN logic has similar __PL_nan_u fallback, the only
4165  * difference being the int32 constant being coerced. */
4166 #    define __PL_inf_float_int32 0x7F800000
4167 static const union { unsigned int __i; float __f; } __PL_inf_u =
4168     { __PL_inf_float_int32 };
4169 #    define NV_INF ((NV)(__PL_inf_u.__f))
4170 #  endif
4171 #endif
4172 #if !defined(NV_INF)
4173 #  define NV_INF ((NV)1.0/0.0) /* Some compilers will warn. */
4174 #endif
4175
4176 #if !defined(NV_NAN) && defined(USE_LONG_DOUBLE)
4177 #   if !defined(NV_NAN) && defined(LDBL_NAN)
4178 #       define NV_NAN LDBL_NAN
4179 #   endif
4180 #   if !defined(NV_NAN) && defined(NANL)
4181 #       define NV_NAN NANL
4182 #   endif
4183 #   if !defined(NV_NAN) && defined(LDBL_QNAN)
4184 #       define NV_NAN LDBL_QNAN
4185 #   endif
4186 #   if !defined(NV_NAN) && defined(LDBL_SNAN)
4187 #       define NV_NAN LDBL_SNAN
4188 #   endif
4189 #endif
4190 #if !defined(NV_NAN) && defined(DBL_NAN)
4191 #  define NV_NAN (NV)DBL_NAN
4192 #endif
4193 #if !defined(NV_NAN) && defined(DBL_QNAN)
4194 #  define NV_NAN (NV)DBL_QNAN
4195 #endif
4196 #if !defined(NV_NAN) && defined(DBL_SNAN)
4197 #  define NV_NAN (NV)DBL_SNAN
4198 #endif
4199 #if !defined(NV_NAN) && defined(NAN)
4200 #  define NV_NAN (NV)NAN
4201 #endif
4202 #if !defined(NV_NAN) && defined(QNAN)
4203 #  define NV_NAN (NV)QNAN
4204 #endif
4205 #if !defined(NV_NAN) && defined(SNAN)
4206 #  define NV_NAN (NV)SNAN
4207 #endif
4208 #if !defined(NV_NAN)
4209 #  if INTSIZE == 4
4210 /* See the discussion near __PL_inf_u. */
4211 #    define __PL_nan_float_int32 0x7FC00000
4212 static const union { unsigned int __i; float __f; } __PL_nan_u =
4213     { __PL_nan_float_int32 };
4214 #    define NV_NAN ((NV)(__PL_nan_u.__f))
4215 #  endif
4216 #endif
4217 #if !defined(NV_NAN)
4218 #  define NV_NAN ((NV)0.0/0.0) /* Some compilers will warn. */
4219 #endif
4220
4221 #ifndef __cplusplus
4222 #  if !defined(WIN32) && !defined(VMS)
4223 #ifndef crypt
4224 char *crypt (const char*, const char*);
4225 #endif
4226 #  endif /* !WIN32 */
4227 #  ifndef DONT_DECLARE_STD
4228 #    ifndef getenv
4229 char *getenv (const char*);
4230 #    endif /* !getenv */
4231 #    if !defined(HAS_LSEEK_PROTO) && !defined(__hpux)
4232 #      ifdef _FILE_OFFSET_BITS
4233 #        if _FILE_OFFSET_BITS == 64
4234 Off_t lseek (int,Off_t,int);
4235 #        endif
4236 #      endif
4237 #    endif
4238 #  endif /* !DONT_DECLARE_STD */
4239 #  ifndef WIN32
4240 #    ifndef getlogin
4241 char *getlogin (void);
4242 #    endif
4243 #  endif /* !WIN32 */
4244 #endif /* !__cplusplus */
4245
4246 /* Fixme on VMS.  This needs to be a run-time, not build time options */
4247 /* Also rename() is affected by this */
4248 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
4249 #define UNLINK unlnk
4250 I32 unlnk (pTHX_ const char*);
4251 #else
4252 #define UNLINK PerlLIO_unlink
4253 #endif
4254
4255 /* some versions of glibc are missing the setresuid() proto */
4256 #if defined(HAS_SETRESUID) && !defined(HAS_SETRESUID_PROTO)
4257 int setresuid(uid_t ruid, uid_t euid, uid_t suid);
4258 #endif
4259 /* some versions of glibc are missing the setresgid() proto */
4260 #if defined(HAS_SETRESGID) && !defined(HAS_SETRESGID_PROTO)
4261 int setresgid(gid_t rgid, gid_t egid, gid_t sgid);
4262 #endif
4263
4264 #ifndef HAS_SETREUID
4265 #  ifdef HAS_SETRESUID
4266 #    define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
4267 #    define HAS_SETREUID
4268 #  endif
4269 #endif
4270 #ifndef HAS_SETREGID
4271 #  ifdef HAS_SETRESGID
4272 #    define setregid(r,e) setresgid(r,e,(Gid_t)-1)
4273 #    define HAS_SETREGID
4274 #  endif
4275 #endif
4276
4277 /* Sighandler_t defined in iperlsys.h */
4278
4279 #ifdef HAS_SIGACTION
4280 typedef struct sigaction Sigsave_t;
4281 #else
4282 typedef Sighandler_t Sigsave_t;
4283 #endif
4284
4285 #define SCAN_DEF 0
4286 #define SCAN_TR 1
4287 #define SCAN_REPL 2
4288
4289 #ifdef DEBUGGING
4290 # ifndef register
4291 #  define register
4292 # endif
4293 # define RUNOPS_DEFAULT Perl_runops_debug
4294 #else
4295 # define RUNOPS_DEFAULT Perl_runops_standard
4296 #endif
4297
4298 #if defined(USE_PERLIO)
4299 EXTERN_C void PerlIO_teardown(void);
4300 # ifdef USE_ITHREADS
4301 #  define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex)
4302 #  define PERLIO_TERM                           \
4303         STMT_START {                            \
4304                 PerlIO_teardown();              \
4305                 MUTEX_DESTROY(&PL_perlio_mutex);\
4306         } STMT_END
4307 # else
4308 #  define PERLIO_INIT
4309 #  define PERLIO_TERM   PerlIO_teardown()
4310 # endif
4311 #else
4312 #  define PERLIO_INIT
4313 #  define PERLIO_TERM
4314 #endif
4315
4316 #ifdef MYMALLOC
4317 #  ifdef MUTEX_INIT_CALLS_MALLOC
4318 #    define MALLOC_INIT                                 \
4319         STMT_START {                                    \
4320                 PL_malloc_mutex = NULL;                 \
4321                 MUTEX_INIT(&PL_malloc_mutex);           \
4322         } STMT_END
4323 #    define MALLOC_TERM                                 \
4324         STMT_START {                                    \
4325                 perl_mutex tmp = PL_malloc_mutex;       \
4326                 PL_malloc_mutex = NULL;                 \
4327                 MUTEX_DESTROY(&tmp);                    \
4328         } STMT_END
4329 #  else
4330 #    define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
4331 #    define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
4332 #  endif
4333 #else
4334 #  define MALLOC_INIT
4335 #  define MALLOC_TERM
4336 #endif
4337
4338 #if defined(PERL_IMPLICIT_CONTEXT)
4339
4340 struct perl_memory_debug_header;
4341 struct perl_memory_debug_header {
4342   tTHX  interpreter;
4343 #  if defined(PERL_POISON) || defined(PERL_DEBUG_READONLY_COW)
4344   MEM_SIZE size;
4345 #  endif
4346   struct perl_memory_debug_header *prev;
4347   struct perl_memory_debug_header *next;
4348 #  ifdef PERL_DEBUG_READONLY_COW
4349   bool readonly;
4350 #  endif
4351 };
4352
4353 #elif defined(PERL_DEBUG_READONLY_COW)
4354
4355 struct perl_memory_debug_header;
4356 struct perl_memory_debug_header {
4357   MEM_SIZE size;
4358 };
4359
4360 #endif
4361
4362 #if defined (PERL_TRACK_MEMPOOL) || defined (PERL_DEBUG_READONLY_COW)
4363
4364 #  define PERL_MEMORY_DEBUG_HEADER_SIZE \
4365         (sizeof(struct perl_memory_debug_header) + \
4366         (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
4367          %MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
4368
4369 #else
4370 #  define PERL_MEMORY_DEBUG_HEADER_SIZE 0
4371 #endif
4372
4373 #ifdef PERL_TRACK_MEMPOOL
4374 # ifdef PERL_DEBUG_READONLY_COW
4375 #  define INIT_TRACK_MEMPOOL(header, interp)                    \
4376         STMT_START {                                            \
4377                 (header).interpreter = (interp);                \
4378                 (header).prev = (header).next = &(header);      \
4379                 (header).readonly = 0;                          \
4380         } STMT_END
4381 # else
4382 #  define INIT_TRACK_MEMPOOL(header, interp)                    \
4383         STMT_START {                                            \
4384                 (header).interpreter = (interp);                \
4385                 (header).prev = (header).next = &(header);      \
4386         } STMT_END
4387 # endif
4388 # else
4389 #  define INIT_TRACK_MEMPOOL(header, interp)
4390 #endif
4391
4392 #ifdef I_MALLOCMALLOC
4393 /* Needed for malloc_size(), malloc_good_size() on some systems */
4394 #  include <malloc/malloc.h>
4395 #endif
4396
4397 #ifdef MYMALLOC
4398 #  define Perl_safesysmalloc_size(where)        Perl_malloced_size(where)
4399 #else
4400 #  if defined(HAS_MALLOC_SIZE) && !defined(PERL_DEBUG_READONLY_COW)
4401 #    ifdef PERL_TRACK_MEMPOOL
4402 #       define Perl_safesysmalloc_size(where)                   \
4403             (malloc_size(((char *)(where)) - PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE)
4404 #    else
4405 #       define Perl_safesysmalloc_size(where) malloc_size(where)
4406 #    endif
4407 #  endif
4408 #  ifdef HAS_MALLOC_GOOD_SIZE
4409 #    ifdef PERL_TRACK_MEMPOOL
4410 #       define Perl_malloc_good_size(how_much)                  \
4411             (malloc_good_size((how_much) + PERL_MEMORY_DEBUG_HEADER_SIZE) - PERL_MEMORY_DEBUG_HEADER_SIZE)
4412 #    else
4413 #       define Perl_malloc_good_size(how_much) malloc_good_size(how_much)
4414 #    endif
4415 #  else
4416 /* Having this as the identity operation makes some code simpler.  */
4417 #       define Perl_malloc_good_size(how_much)  (how_much)
4418 #  endif
4419 #endif
4420
4421 typedef int (*runops_proc_t)(pTHX);
4422 typedef void (*share_proc_t) (pTHX_ SV *sv);
4423 typedef int  (*thrhook_proc_t) (pTHX);
4424 typedef OP* (*PPADDR_t[]) (pTHX);
4425 typedef bool (*destroyable_proc_t) (pTHX_ SV *sv);
4426 typedef void (*despatch_signals_proc_t) (pTHX);
4427
4428 #if defined(__DYNAMIC__) && defined(PERL_DARWIN) && defined(PERL_CORE)
4429 #  include <crt_externs.h>      /* for the env array */
4430 #  define environ (*_NSGetEnviron())
4431 #else
4432    /* VMS and some other platforms don't use the environ array */
4433 #  ifdef USE_ENVIRON_ARRAY
4434 #    if !defined(DONT_DECLARE_STD) || \
4435         (defined(__svr4__) && defined(__GNUC__) && defined(__sun)) || \
4436         defined(__sgi)
4437 extern char **  environ;        /* environment variables supplied via exec */
4438 #    endif
4439 #  endif
4440 #endif
4441
4442 #define PERL_PATCHLEVEL_H_IMPLICIT
4443 #include "patchlevel.h"
4444 #undef PERL_PATCHLEVEL_H_IMPLICIT
4445
4446 #define PERL_VERSION_STRING     STRINGIFY(PERL_REVISION) "." \
4447                                 STRINGIFY(PERL_VERSION) "." \
4448                                 STRINGIFY(PERL_SUBVERSION)
4449
4450 #define PERL_API_VERSION_STRING STRINGIFY(PERL_API_REVISION) "." \
4451                                 STRINGIFY(PERL_API_VERSION) "." \
4452                                 STRINGIFY(PERL_API_SUBVERSION)
4453
4454 START_EXTERN_C
4455
4456 /* handy constants */
4457 EXTCONST char PL_warn_uninit[]
4458   INIT("Use of uninitialized value%s%s%s");
4459 EXTCONST char PL_warn_uninit_sv[]
4460   INIT("Use of uninitialized value%" SVf "%s%s");
4461 EXTCONST char PL_warn_nosemi[]
4462   INIT("Semicolon seems to be missing");
4463 EXTCONST char PL_warn_reserved[]
4464   INIT("Unquoted string \"%s\" may clash with future reserved word");
4465 EXTCONST char PL_warn_nl[]
4466   INIT("Unsuccessful %s on filename containing newline");
4467 EXTCONST char PL_no_wrongref[]
4468   INIT("Can't use %s ref as %s ref");
4469 /* The core no longer needs these here. If you require the string constant,
4470    please inline a copy into your own code.  */
4471 EXTCONST char PL_no_symref[] __attribute__deprecated__
4472   INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
4473 EXTCONST char PL_no_symref_sv[] __attribute__deprecated__
4474   INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use");
4475 EXTCONST char PL_no_usym[]
4476   INIT("Can't use an undefined value as %s reference");
4477 EXTCONST char PL_no_aelem[]
4478   INIT("Modification of non-creatable array value attempted, subscript %d");
4479 EXTCONST char PL_no_helem_sv[]
4480   INIT("Modification of non-creatable hash value attempted, subscript \"%" SVf "\"");
4481 EXTCONST char PL_no_modify[]
4482   INIT("Modification of a read-only value attempted");
4483 EXTCONST char PL_no_mem[sizeof("Out of memory!\n")]
4484   INIT("Out of memory!\n");
4485 EXTCONST char PL_no_security[]
4486   INIT("Insecure dependency in %s%s");
4487 EXTCONST char PL_no_sock_func[]
4488   INIT("Unsupported socket function \"%s\" called");
4489 EXTCONST char PL_no_dir_func[]
4490   INIT("Unsupported directory function \"%s\" called");
4491 EXTCONST char PL_no_func[]
4492   INIT("The %s function is unimplemented");
4493 EXTCONST char PL_no_myglob[]
4494   INIT("\"%s\" variable %s can't be in a package");
4495 EXTCONST char PL_no_localize_ref[]
4496   INIT("Can't localize through a reference");
4497 EXTCONST char PL_memory_wrap[]
4498   INIT("panic: memory wrap");
4499
4500 EXTCONST char PL_Yes[]
4501   INIT("1");
4502 EXTCONST char PL_No[]
4503   INIT("");
4504 EXTCONST char PL_hexdigit[]
4505   INIT("0123456789abcdef0123456789ABCDEF");
4506
4507 /* This is constant on most architectures, a global on OS/2 */
4508 #ifndef OS2
4509 EXTCONST char PL_sh_path[]
4510   INIT(SH_PATH); /* full path of shell */
4511 #endif
4512
4513 #ifdef CSH
4514 EXTCONST char PL_cshname[]
4515   INIT(CSH);
4516 #  define PL_cshlen     (sizeof(CSH "") - 1)
4517 #endif
4518
4519 /* These are baked at compile time into any shared perl library.
4520    In future releases this will allow us in main() to sanity test the
4521    library we're linking against.  */
4522
4523 EXTCONST U8 PL_revision
4524   INIT(PERL_REVISION);
4525 EXTCONST U8 PL_version
4526   INIT(PERL_VERSION);
4527 EXTCONST U8 PL_subversion
4528   INIT(PERL_SUBVERSION);
4529
4530 EXTCONST char PL_uuemap[65]
4531   INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
4532
4533 #ifdef DOINIT
4534 EXTCONST char PL_uudmap[256] =
4535 #  ifdef PERL_MICRO
4536 #    include "uuudmap.h"
4537 #  else
4538 #    include "uudmap.h"
4539 #  endif
4540 ;
4541 EXTCONST char PL_bitcount[256] =
4542 #  ifdef PERL_MICRO
4543 #    include "ubitcount.h"
4544 #else
4545 #    include "bitcount.h"
4546 #  endif
4547 ;
4548 EXTCONST char* const PL_sig_name[] = { SIG_NAME };
4549 EXTCONST int         PL_sig_num[]  = { SIG_NUM };
4550 #else
4551 EXTCONST char PL_uudmap[256];
4552 EXTCONST char PL_bitcount[256];
4553 EXTCONST char* const PL_sig_name[];
4554 EXTCONST int         PL_sig_num[];
4555 #endif
4556
4557 /* fast conversion and case folding tables.  The folding tables complement the
4558  * fold, so that 'a' maps to 'A' and 'A' maps to 'a', ignoring more complicated
4559  * folds such as outside the range or to multiple characters. */
4560
4561 #ifdef DOINIT
4562 #ifndef EBCDIC
4563
4564 /* The EBCDIC fold table depends on the code page, and hence is found in
4565  * utfebcdic.h */
4566
4567 EXTCONST  unsigned char PL_fold[] = {
4568         0,      1,      2,      3,      4,      5,      6,      7,
4569         8,      9,      10,     11,     12,     13,     14,     15,
4570         16,     17,     18,     19,     20,     21,     22,     23,
4571         24,     25,     26,     27,     28,     29,     30,     31,
4572         32,     33,     34,     35,     36,     37,     38,     39,
4573         40,     41,     42,     43,     44,     45,     46,     47,
4574         48,     49,     50,     51,     52,     53,     54,     55,
4575         56,     57,     58,     59,     60,     61,     62,     63,
4576         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
4577         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
4578         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
4579         'x',    'y',    'z',    91,     92,     93,     94,     95,
4580         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
4581         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
4582         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
4583         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
4584         128,    129,    130,    131,    132,    133,    134,    135,
4585         136,    137,    138,    139,    140,    141,    142,    143,
4586         144,    145,    146,    147,    148,    149,    150,    151,
4587         152,    153,    154,    155,    156,    157,    158,    159,
4588         160,    161,    162,    163,    164,    165,    166,    167,
4589         168,    169,    170,    171,    172,    173,    174,    175,
4590         176,    177,    178,    179,    180,    181,    182,    183,
4591         184,    185,    186,    187,    188,    189,    190,    191,
4592         192,    193,    194,    195,    196,    197,    198,    199,
4593         200,    201,    202,    203,    204,    205,    206,    207,
4594         208,    209,    210,    211,    212,    213,    214,    215,
4595         216,    217,    218,    219,    220,    221,    222,    223,    
4596         224,    225,    226,    227,    228,    229,    230,    231,
4597         232,    233,    234,    235,    236,    237,    238,    239,
4598         240,    241,    242,    243,    244,    245,    246,    247,
4599         248,    249,    250,    251,    252,    253,    254,    255
4600 };
4601 EXTCONST  unsigned char PL_fold_latin1[] = {
4602     /* Full latin1 complement folding, except for three problematic code points:
4603      *  Micro sign (181 = 0xB5) and y with diearesis (255 = 0xFF) have their
4604      *  fold complements outside the Latin1 range, so can't match something
4605      *  that isn't in utf8.
4606      *  German lower case sharp s (223 = 0xDF) folds to two characters, 'ss',
4607      *  not one, so can't be represented in this table.
4608      *
4609      * All have to be specially handled */
4610         0,      1,      2,      3,      4,      5,      6,      7,
4611         8,      9,      10,     11,     12,     13,     14,     15,
4612         16,     17,     18,     19,     20,     21,     22,     23,
4613         24,     25,     26,     27,     28,     29,     30,     31,
4614         32,     33,     34,     35,     36,     37,     38,     39,
4615         40,     41,     42,     43,     44,     45,     46,     47,
4616         48,     49,     50,     51,     52,     53,     54,     55,
4617         56,     57,     58,     59,     60,     61,     62,     63,
4618         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
4619         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
4620         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
4621         'x',    'y',    'z',    91,     92,     93,     94,     95,
4622         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
4623         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
4624         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
4625         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
4626         128,    129,    130,    131,    132,    133,    134,    135,
4627         136,    137,    138,    139,    140,    141,    142,    143,
4628         144,    145,    146,    147,    148,    149,    150,    151,
4629         152,    153,    154,    155,    156,    157,    158,    159,
4630         160,    161,    162,    163,    164,    165,    166,    167,
4631         168,    169,    170,    171,    172,    173,    174,    175,
4632         176,    177,    178,    179,    180,    181 /*micro */, 182,    183,
4633         184,    185,    186,    187,    188,    189,    190,    191,
4634         192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32,
4635         200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32,
4636         208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215,
4637         216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223 /* ss */,
4638         224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32,
4639         232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32,
4640         240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247,
4641         248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32,
4642         255 /* y with diaeresis */
4643 };
4644
4645 /* If these tables are accessed through ebcdic, the access will be converted to
4646  * latin1 first */
4647 EXTCONST  unsigned char PL_latin1_lc[] = {  /* lowercasing */
4648         0,      1,      2,      3,      4,      5,      6,      7,
4649         8,      9,      10,     11,     12,     13,     14,     15,
4650         16,     17,     18,     19,     20,     21,     22,     23,
4651         24,     25,     26,     27,     28,     29,     30,     31,
4652         32,     33,     34,     35,     36,     37,     38,     39,
4653         40,     41,     42,     43,     44,     45,     46,     47,
4654         48,     49,     50,     51,     52,     53,     54,     55,
4655         56,     57,     58,     59,     60,     61,     62,     63,
4656         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
4657         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
4658         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
4659         'x',    'y',    'z',    91,     92,     93,     94,     95,
4660         96,     97,     98,     99,     100,    101,    102,    103,
4661         104,    105,    106,    107,    108,    109,    110,    111,
4662         112,    113,    114,    115,    116,    117,    118,    119,
4663         120,    121,    122,    123,    124,    125,    126,    127,
4664         128,    129,    130,    131,    132,    133,    134,    135,
4665         136,    137,    138,    139,    140,    141,    142,    143,
4666         144,    145,    146,    147,    148,    149,    150,    151,
4667         152,    153,    154,    155,    156,    157,    158,    159,
4668         160,    161,    162,    163,    164,    165,    166,    167,
4669         168,    169,    170,    171,    172,    173,    174,    175,
4670         176,    177,    178,    179,    180,    181,    182,    183,
4671         184,    185,    186,    187,    188,    189,    190,    191,
4672         192+32, 193+32, 194+32, 195+32, 196+32, 197+32, 198+32, 199+32,
4673         200+32, 201+32, 202+32, 203+32, 204+32, 205+32, 206+32, 207+32,
4674         208+32, 209+32, 210+32, 211+32, 212+32, 213+32, 214+32, 215,
4675         216+32, 217+32, 218+32, 219+32, 220+32, 221+32, 222+32, 223,    
4676         224,    225,    226,    227,    228,    229,    230,    231,
4677         232,    233,    234,    235,    236,    237,    238,    239,
4678         240,    241,    242,    243,    244,    245,    246,    247,
4679         248,    249,    250,    251,    252,    253,    254,    255
4680 };
4681
4682 /* upper and title case of latin1 characters, modified so that the three tricky
4683  * ones are mapped to 255 (which is one of the three) */
4684 EXTCONST  unsigned char PL_mod_latin1_uc[] = {
4685         0,      1,      2,      3,      4,      5,      6,      7,
4686         8,      9,      10,     11,     12,     13,     14,     15,
4687         16,     17,     18,     19,     20,     21,     22,     23,
4688         24,     25,     26,     27,     28,     29,     30,     31,
4689         32,     33,     34,     35,     36,     37,     38,     39,
4690         40,     41,     42,     43,     44,     45,     46,     47,
4691         48,     49,     50,     51,     52,     53,     54,     55,
4692         56,     57,     58,     59,     60,     61,     62,     63,
4693         64,     65,     66,     67,     68,     69,     70,     71,
4694         72,     73,     74,     75,     76,     77,     78,     79,
4695         80,     81,     82,     83,     84,     85,     86,     87,
4696         88,     89,     90,     91,     92,     93,     94,     95,
4697         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
4698         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
4699         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
4700         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
4701         128,    129,    130,    131,    132,    133,    134,    135,
4702         136,    137,    138,    139,    140,    141,    142,    143,
4703         144,    145,    146,    147,    148,    149,    150,    151,
4704         152,    153,    154,    155,    156,    157,    158,    159,
4705         160,    161,    162,    163,    164,    165,    166,    167,
4706         168,    169,    170,    171,    172,    173,    174,    175,
4707         176,    177,    178,    179,    180,    255 /*micro*/,  182,    183,
4708         184,    185,    186,    187,    188,    189,    190,    191,
4709         192,    193,    194,    195,    196,    197,    198,    199,
4710         200,    201,    202,    203,    204,    205,    206,    207,
4711         208,    209,    210,    211,    212,    213,    214,    215,
4712         216,    217,    218,    219,    220,    221,    222,    255 /*sharp s*/,        
4713         224-32, 225-32, 226-32, 227-32, 228-32, 229-32, 230-32, 231-32,
4714         232-32, 233-32, 234-32, 235-32, 236-32, 237-32, 238-32, 239-32,
4715         240-32, 241-32, 242-32, 243-32, 244-32, 245-32, 246-32, 247,
4716         248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, 255
4717 };
4718 #endif  /* !EBCDIC, but still in DOINIT */
4719 #else   /* ! DOINIT */
4720 #   ifndef EBCDIC
4721 EXTCONST unsigned char PL_fold[];
4722 EXTCONST unsigned char PL_fold_latin1[];
4723 EXTCONST unsigned char PL_mod_latin1_uc[];
4724 EXTCONST unsigned char PL_latin1_lc[];
4725 #   endif
4726 #endif
4727
4728 #ifndef PERL_GLOBAL_STRUCT /* or perlvars.h */
4729 #ifdef DOINIT
4730 EXT unsigned char PL_fold_locale[] = { /* Unfortunately not EXTCONST. */
4731         0,      1,      2,      3,      4,      5,      6,      7,
4732         8,      9,      10,     11,     12,     13,     14,     15,
4733         16,     17,     18,     19,     20,     21,     22,     23,
4734         24,     25,     26,     27,     28,     29,     30,     31,
4735         32,     33,     34,     35,     36,     37,     38,     39,
4736         40,     41,     42,     43,     44,     45,     46,     47,
4737         48,     49,     50,     51,     52,     53,     54,     55,
4738         56,     57,     58,     59,     60,     61,     62,     63,
4739         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
4740         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
4741         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
4742         'x',    'y',    'z',    91,     92,     93,     94,     95,
4743         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
4744         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
4745         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
4746         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
4747         128,    129,    130,    131,    132,    133,    134,    135,
4748         136,    137,    138,    139,    140,    141,    142,    143,
4749         144,    145,    146,    147,    148,    149,    150,    151,
4750         152,    153,    154,    155,    156,    157,    158,    159,
4751         160,    161,    162,    163,    164,    165,    166,    167,
4752         168,    169,    170,    171,    172,    173,    174,    175,
4753         176,    177,    178,    179,    180,    181,    182,    183,
4754         184,    185,    186,    187,    188,    189,    190,    191,
4755         192,    193,    194,    195,    196,    197,    198,    199,
4756         200,    201,    202,    203,    204,    205,    206,    207,
4757         208,    209,    210,    211,    212,    213,    214,    215,
4758         216,    217,    218,    219,    220,    221,    222,    223,    
4759         224,    225,    226,    227,    228,    229,    230,    231,
4760         232,    233,    234,    235,    236,    237,    238,    239,
4761         240,    241,    242,    243,    244,    245,    246,    247,
4762         248,    249,    250,    251,    252,    253,    254,    255
4763 };
4764 #else
4765 EXT unsigned char PL_fold_locale[]; /* Unfortunately not EXTCONST. */
4766 #endif
4767 #endif /* !PERL_GLOBAL_STRUCT */
4768
4769 #ifdef DOINIT
4770 #ifdef EBCDIC
4771 EXTCONST unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */
4772     1,      2,      84,     151,    154,    155,    156,    157,
4773     165,    246,    250,    3,      158,    7,      18,     29,
4774     40,     51,     62,     73,     85,     96,     107,    118,
4775     129,    140,    147,    148,    149,    150,    152,    153,
4776     255,      6,      8,      9,     10,     11,     12,     13,
4777      14,     15,     24,     25,     26,     27,     28,    226,
4778      29,     30,     31,     32,     33,     43,     44,     45,
4779      46,     47,     48,     49,     50,     76,     77,     78,
4780      79,     80,     81,     82,     83,     84,     85,     86,
4781      87,     94,     95,    234,    181,    233,    187,    190,
4782     180,     96,     97,     98,     99,    100,    101,    102,
4783     104,    112,    182,    174,    236,    232,    229,    103,
4784     228,    226,    114,    115,    116,    117,    118,    119,
4785     120,    121,    122,    235,    176,    230,    194,    162,
4786     130,    131,    132,    133,    134,    135,    136,    137,
4787     138,    139,    201,    205,    163,    217,    220,    224,
4788     5,      248,    227,    244,    242,    255,    241,    231,
4789     240,    253,    16,     197,    19,     20,     21,     187,
4790     23,     169,    210,    245,    237,    249,    247,    239,
4791     168,    252,    34,     196,    36,     37,     38,     39,
4792     41,     42,     251,    254,    238,    223,    221,    213,
4793     225,    177,    52,     53,     54,     55,     56,     57,
4794     58,     59,     60,     61,     63,     64,     65,     66,
4795     67,     68,     69,     70,     71,     72,     74,     75,
4796     205,    208,    186,    202,    200,    218,    198,    179,
4797     178,    214,    88,     89,     90,     91,     92,     93,
4798     217,    166,    170,    207,    199,    209,    206,    204,
4799     160,    212,    105,    106,    108,    109,    110,    111,
4800     203,    113,    216,    215,    192,    175,    193,    243,
4801     172,    161,    123,    124,    125,    126,    127,    128,
4802     222,    219,    211,    195,    188,    193,    185,    184,
4803     191,    183,    141,    142,    143,    144,    145,    146
4804 };
4805 #else  /* ascii rather than ebcdic */
4806 EXTCONST unsigned char PL_freq[] = {    /* letter frequencies for mixed English/C */
4807         1,      2,      84,     151,    154,    155,    156,    157,
4808         165,    246,    250,    3,      158,    7,      18,     29,
4809         40,     51,     62,     73,     85,     96,     107,    118,
4810         129,    140,    147,    148,    149,    150,    152,    153,
4811         255,    182,    224,    205,    174,    176,    180,    217,
4812         233,    232,    236,    187,    235,    228,    234,    226,
4813         222,    219,    211,    195,    188,    193,    185,    184,
4814         191,    183,    201,    229,    181,    220,    194,    162,
4815         163,    208,    186,    202,    200,    218,    198,    179,
4816         178,    214,    166,    170,    207,    199,    209,    206,
4817         204,    160,    212,    216,    215,    192,    175,    173,
4818         243,    172,    161,    190,    203,    189,    164,    230,
4819         167,    248,    227,    244,    242,    255,    241,    231,
4820         240,    253,    169,    210,    245,    237,    249,    247,
4821         239,    168,    252,    251,    254,    238,    223,    221,
4822         213,    225,    177,    197,    171,    196,    159,    4,
4823         5,      6,      8,      9,      10,     11,     12,     13,
4824         14,     15,     16,     17,     19,     20,     21,     22,
4825         23,     24,     25,     26,     27,     28,     30,     31,
4826         32,     33,     34,     35,     36,     37,     38,     39,
4827         41,     42,     43,     44,     45,     46,     47,     48,
4828         49,     50,     52,     53,     54,     55,     56,     57,
4829         58,     59,     60,     61,     63,     64,     65,     66,
4830         67,     68,     69,     70,     71,     72,     74,     75,
4831         76,     77,     78,     79,     80,     81,     82,     83,
4832         86,     87,     88,     89,     90,     91,     92,     93,
4833         94,     95,     97,     98,     99,     100,    101,    102,
4834         103,    104,    105,    106,    108,    109,    110,    111,
4835         112,    113,    114,    115,    116,    117,    119,    120,
4836         121,    122,    123,    124,    125,    126,    127,    128,
4837         130,    131,    132,    133,    134,    135,    136,    137,
4838         138,    139,    141,    142,    143,    144,    145,    146
4839 };
4840 #endif
4841 #else
4842 EXTCONST unsigned char PL_freq[];
4843 #endif
4844
4845 /* Although only used for debugging, these constants must be available in
4846  * non-debugging builds too, since they're used in ext/re/re_exec.c,
4847  * which has DEBUGGING enabled always */
4848 #ifdef DOINIT
4849 EXTCONST char* const PL_block_type[] = {
4850         "NULL",
4851         "WHEN",
4852         "BLOCK",
4853         "GIVEN",
4854         "LOOP_FOR",
4855         "LOOP_PLAIN",
4856         "LOOP_LAZYSV",
4857         "LOOP_LAZYIV",
4858         "SUB",
4859         "FORMAT",
4860         "EVAL",
4861         "SUBST"
4862 };
4863 #else
4864 EXTCONST char* PL_block_type[];
4865 #endif
4866
4867 /* These are all the compile time options that affect binary compatibility.
4868    Other compile time options that are binary compatible are in perl.c
4869    Both are combined for the output of perl -V
4870    However, this string will be embedded in any shared perl library, which will
4871    allow us add a comparison check in perlmain.c in the near future.  */
4872 #ifdef DOINIT
4873 EXTCONST char PL_bincompat_options[] =
4874 #  ifdef DEBUG_LEAKING_SCALARS
4875                              " DEBUG_LEAKING_SCALARS"
4876 #  endif
4877 #  ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
4878                              " DEBUG_LEAKING_SCALARS_FORK_DUMP"
4879 #  endif
4880 #  ifdef FCRYPT
4881                              " FCRYPT"
4882 #  endif
4883 #  ifdef HAS_TIMES
4884                              " HAS_TIMES"
4885 #  endif
4886 #  ifdef HAVE_INTERP_INTERN
4887                              " HAVE_INTERP_INTERN"
4888 #  endif
4889 #  ifdef MULTIPLICITY