This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
instead of unions use double cast for data pointer <-> function pointer
[perl5.git] / perl.h
1 /*    perl.h
2  *
3  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4  *    2000, 2001, 2002, 2003, 2004, 2005 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 #if defined(DGUX)
26 #include <sys/fcntl.h>
27 #endif
28
29 #ifdef VOIDUSED
30 #   undef VOIDUSED
31 #endif 
32 #define VOIDUSED 1
33
34 #ifdef PERL_MICRO
35 #   include "uconfig.h"
36 #else
37 #   include "config.h"
38 #endif
39
40 /* See L<perlguts/"The Perl API"> for detailed notes on
41  * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
42
43 /* Note that from here --> to <-- the same logic is
44  * repeated in makedef.pl, so be certain to update
45  * both places when editing. */
46
47 #ifdef PERL_IMPLICIT_SYS
48 /* PERL_IMPLICIT_SYS implies PerlMemShared != PerlMem
49    so use slab allocator to avoid lots of MUTEX overhead
50  */
51 #  ifndef PL_OP_SLAB_ALLOC
52 #    define PL_OP_SLAB_ALLOC
53 #  endif
54 #endif
55
56 #ifdef USE_ITHREADS
57 #  if !defined(MULTIPLICITY)
58 #    define MULTIPLICITY
59 #  endif
60 #endif
61
62 #if defined(MULTIPLICITY)
63 #  ifndef PERL_IMPLICIT_CONTEXT
64 #    define PERL_IMPLICIT_CONTEXT
65 #  endif
66 #endif
67
68 #ifdef PERL_GLOBAL_STRUCT_PRIVATE
69 #  ifndef PERL_GLOBAL_STRUCT
70 #    define PERL_GLOBAL_STRUCT
71 #  endif
72 #endif
73 #ifdef PERL_GLOBAL_STRUCT
74 #  ifndef MULTIPLICITY
75 #    define MULTIPLICITY
76 #  endif
77 #endif
78
79 /* undef WIN32 when building on Cygwin (for libwin32) - gph */
80 #ifdef __CYGWIN__
81 #   undef WIN32
82 #   undef _WIN32
83 #endif
84
85 #if defined(__SYMBIAN32__) || (defined(__VC32__) && defined(WINS))
86 #   ifndef SYMBIAN
87 #       define SYMBIAN
88 #   endif
89 #endif
90
91 #ifdef SYMBIAN
92 #  include "symbian/symbian_proto.h"
93 #endif
94
95 /* Any stack-challenged places.  The limit varies (and often
96  * is configurable), but using more than a kilobyte of stack
97  * is usually dubious in these systems. */
98 #if defined(EPOC) || defined(SYMBIAN)
99 /* EPOC/Symbian: need to work around the SDK features. *
100  * On WINS: MS VC5 generates calls to _chkstk,         *
101  * if a "large" stack frame is allocated.              *
102  * gcc on MARM does not generate calls like these.     */
103 #   define USE_HEAP_INSTEAD_OF_STACK
104 #endif
105
106 #/* Use the reentrant APIs like localtime_r and getpwent_r */
107 /* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
108 #if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN)
109 #   define USE_REENTRANT_API
110 #endif
111
112 /* <--- here ends the logic shared by perl.h and makedef.pl */
113
114 /*
115  * PERL_DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned)
116  * (The -DPERL_DARWIN comes from the hints/darwin.sh.)
117  * __bsdi__ for BSD/OS
118  */
119 #if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(PERL_DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44)
120 #   ifndef BSDish
121 #       define BSDish
122 #   endif
123 #endif
124
125 #ifdef PERL_GLOBAL_STRUCT
126 #  ifndef PERL_GET_VARS
127 #    ifdef PERL_GLOBAL_STRUCT_PRIVATE
128        extern struct perl_vars* Perl_GetVarsPrivate();
129 #      define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */
130 #      ifndef PERLIO_FUNCS_CONST
131 #        define PERLIO_FUNCS_CONST /* Can't have these lying around. */
132 #      endif
133 #    else
134 #      define PERL_GET_VARS() PL_VarsPtr
135 #    endif
136 #  endif
137 #endif
138
139 #define pVAR    register struct perl_vars* my_vars PERL_UNUSED_DECL
140
141 #ifdef PERL_GLOBAL_STRUCT
142 #  define dVAR          pVAR    = (struct perl_vars*)PERL_GET_VARS()
143 #else
144 #  define dVAR          dNOOP
145 #endif
146
147 #ifdef PERL_IMPLICIT_CONTEXT
148 #  ifndef MULTIPLICITY
149 #    define MULTIPLICITY
150 #  endif
151 #  define pTHX  register PerlInterpreter *my_perl PERL_UNUSED_DECL
152 #  define aTHX  my_perl
153 #  ifdef PERL_GLOBAL_STRUCT
154 #    define dTHXa(a)    dVAR; pTHX = (PerlInterpreter*)a
155 #  else
156 #    define dTHXa(a)    pTHX = (PerlInterpreter*)a
157 #  endif
158 #  ifdef PERL_GLOBAL_STRUCT
159 #    define dTHX                dVAR; pTHX = PERL_GET_THX
160 #  else
161 #    define dTHX                pTHX = PERL_GET_THX
162 #  endif
163 #  define pTHX_         pTHX,
164 #  define aTHX_         aTHX,
165 #  define pTHX_1        2
166 #  define pTHX_2        3
167 #  define pTHX_3        4
168 #  define pTHX_4        5
169 #  define pTHX_5        6
170 #  define pTHX_6        7
171 #  define pTHX_7        8
172 #  define pTHX_8        9
173 #  define pTHX_9        10
174 #endif
175
176 #define STATIC static
177 #define CPERLscope(x) x
178 #define CPERLarg void
179 #define CPERLarg_
180 #define _CPERLarg
181 #define PERL_OBJECT_THIS
182 #define _PERL_OBJECT_THIS
183 #define PERL_OBJECT_THIS_
184 #define CALL_FPTR(fptr) (*fptr)
185
186 #define CALLRUNOPS  CALL_FPTR(PL_runops)
187 #define CALLREGCOMP CALL_FPTR(PL_regcompp)
188 #define CALLREGEXEC CALL_FPTR(PL_regexecp)
189 #define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start)
190 #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
191 #define CALLREGFREE CALL_FPTR(PL_regfree)
192
193 #if defined(SYMBIAN) && defined(__GNUC__)
194 #  ifdef __cplusplus
195 #    define PERL_UNUSED_DECL
196 #  else
197 #    define PERL_UNUSED_DECL __attribute__((unused))
198 #  endif
199 #endif
200
201 #ifndef PERL_UNUSED_DECL
202 #  ifdef HASATTRIBUTE_UNUSED
203 #    define PERL_UNUSED_DECL __attribute__unused__
204 #  else
205 #    define PERL_UNUSED_DECL
206 #  endif
207 #endif
208  
209 /* gcc -Wall:
210  * for silencing unused variables that are actually used most of the time,
211  * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs
212  */
213 #define PERL_UNUSED_VAR(var) ((void)var)
214
215 #define NOOP (void)0
216 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
217
218 #ifndef pTHX
219 #  define pTHX          void
220 #  define pTHX_
221 #  define aTHX
222 #  define aTHX_
223 #  define dTHXa(a)      dNOOP
224 #  define dTHX          dNOOP
225 #  define pTHX_1        1       
226 #  define pTHX_2        2
227 #  define pTHX_3        3
228 #  define pTHX_4        4
229 #  define pTHX_5        5
230 #  define pTHX_6        6
231 #  define pTHX_7        7
232 #  define pTHX_8        8
233 #  define pTHX_9        9
234 #endif
235
236 #ifndef dVAR
237 #  define dVAR          dNOOP
238 #endif
239
240 /* these are only defined for compatibility; should not be used internally */
241 #if !defined(pTHXo) && !defined(PERL_CORE)
242 #  define pTHXo         pTHX
243 #  define pTHXo_        pTHX_
244 #  define aTHXo         aTHX
245 #  define aTHXo_        aTHX_
246 #  define dTHXo         dTHX
247 #  define dTHXoa(x)     dTHXa(x)
248 #endif
249
250 #ifndef pTHXx
251 #  define pTHXx         register PerlInterpreter *my_perl
252 #  define pTHXx_        pTHXx,
253 #  define aTHXx         my_perl
254 #  define aTHXx_        aTHXx,
255 #  define dTHXx         dTHX
256 #endif
257
258 /* Under PERL_IMPLICIT_SYS (used in Windows for fork emulation)
259  * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...).
260  * dTHXs is therefore needed for all functions using PerlIO_foo(). */
261 #ifdef PERL_IMPLICIT_SYS
262 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
263 #    define dTHXs               dVAR; dTHX
264 #  else
265 #    define dTHXs               dTHX
266 #  endif
267 #else
268 #  ifdef PERL_GLOBAL_STRUCT_PRIVATE
269 #    define dTHXs               dVAR
270 #  else
271 #    define dTHXs               dNOOP
272 #  endif
273 #endif
274
275 #undef START_EXTERN_C
276 #undef END_EXTERN_C
277 #undef EXTERN_C
278 #ifdef __cplusplus
279 #  define START_EXTERN_C extern "C" {
280 #  define END_EXTERN_C }
281 #  define EXTERN_C extern "C"
282 #else
283 #  define START_EXTERN_C
284 #  define END_EXTERN_C
285 #  define EXTERN_C extern
286 #endif
287
288 /* Some platforms require marking function declarations
289  * for them to be exportable.  Used in perlio.h, proto.h
290  * is handled either by the makedef.pl or by defining the
291  * PERL_CALLCONV to be something special.  See also the
292  * definition of XS() in XSUB.h. */
293 #ifndef PERL_EXPORT_C
294 #  define PERL_EXPORT_C extern
295 #endif
296 #ifndef PERL_XS_EXPORT_C
297 #  define PERL_XS_EXPORT_C
298 #endif
299
300 #ifdef OP_IN_REGISTER
301 #  ifdef __GNUC__
302 #    define stringify_immed(s) #s
303 #    define stringify(s) stringify_immed(s)
304 register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
305 #  endif
306 #endif
307
308 #if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
309 #  if !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
310 #    define PERL_GCC_BRACE_GROUPS_FORBIDDEN
311 #  endif
312 #endif
313
314 /*
315  * STMT_START { statements; } STMT_END;
316  * can be used as a single statement, as in
317  * if (x) STMT_START { ... } STMT_END; else ...
318  *
319  * Trying to select a version that gives no warnings...
320  */
321 #if !(defined(STMT_START) && defined(STMT_END))
322 # if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
323 #   define STMT_START   (void)( /* gcc supports "({ STATEMENTS; })" */
324 #   define STMT_END     )
325 # else
326    /* Now which other defined()s do we need here ??? */
327 #  if (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
328 #   define STMT_START   if (1)
329 #   define STMT_END     else (void)0
330 #  else
331 #   define STMT_START   do
332 #   define STMT_END     while (0)
333 #  endif
334 # endif
335 #endif
336
337 #define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
338 #define WITH_THR(s) WITH_THX(s)
339
340 /*
341  * SOFT_CAST can be used for args to prototyped functions to retain some
342  * type checking; it only casts if the compiler does not know prototypes.
343  */
344 #if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE)
345 #define SOFT_CAST(type) 
346 #else
347 #define SOFT_CAST(type) (type)
348 #endif
349
350 #ifndef BYTEORDER  /* Should never happen -- byteorder is in config.h */
351 #   define BYTEORDER 0x1234
352 #endif
353
354 /* Overall memory policy? */
355 #ifndef CONSERVATIVE
356 #   define LIBERAL 1
357 #endif
358
359 #if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90
360 #define ASCIIish
361 #else
362 #undef  ASCIIish
363 #endif
364
365 /*
366  * The following contortions are brought to you on behalf of all the
367  * standards, semi-standards, de facto standards, not-so-de-facto standards
368  * of the world, as well as all the other botches anyone ever thought of.
369  * The basic theory is that if we work hard enough here, the rest of the
370  * code can be a lot prettier.  Well, so much for theory.  Sorry, Henry...
371  */
372
373 /* define this once if either system, instead of cluttering up the src */
374 #if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(NETWARE)
375 #define DOSISH 1
376 #endif
377
378 #if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE) || defined(SYMBIAN)
379 # define STANDARD_C 1
380 #endif
381
382 #if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO)
383 # define DONT_DECLARE_STD 1
384 #endif
385
386 #if defined(HASVOLATILE) || defined(STANDARD_C)
387 #   ifdef __cplusplus
388 #       define VOL              /* to temporarily suppress warnings */
389 #   else
390 #       define VOL volatile
391 #   endif
392 #else
393 #   define VOL
394 #endif
395
396 #define TAINT           (PL_tainted = TRUE)
397 #define TAINT_NOT       (PL_tainted = FALSE)
398 #define TAINT_IF(c)     if (c) { PL_tainted = TRUE; }
399 #define TAINT_ENV()     if (PL_tainting) { taint_env(); }
400 #define TAINT_PROPER(s) if (PL_tainting) { taint_proper(Nullch, s); }
401
402 /* XXX All process group stuff is handled in pp_sys.c.  Should these
403    defines move there?  If so, I could simplify this a lot. --AD  9/96.
404 */
405 /* Process group stuff changed from traditional BSD to POSIX.
406    perlfunc.pod documents the traditional BSD-style syntax, so we'll
407    try to preserve that, if possible.
408 */
409 #ifdef HAS_SETPGID
410 #  define BSD_SETPGRP(pid, pgrp)        setpgid((pid), (pgrp))
411 #else
412 #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
413 #    define BSD_SETPGRP(pid, pgrp)      setpgrp((pid), (pgrp))
414 #  else
415 #    ifdef HAS_SETPGRP2  /* DG/UX */
416 #      define BSD_SETPGRP(pid, pgrp)    setpgrp2((pid), (pgrp))
417 #    endif
418 #  endif
419 #endif
420 #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
421 #  define HAS_SETPGRP  /* Well, effectively it does . . . */
422 #endif
423
424 /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
425     our life easier :-) so we'll try it.
426 */
427 #ifdef HAS_GETPGID
428 #  define BSD_GETPGRP(pid)              getpgid((pid))
429 #else
430 #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
431 #    define BSD_GETPGRP(pid)            getpgrp((pid))
432 #  else
433 #    ifdef HAS_GETPGRP2  /* DG/UX */
434 #      define BSD_GETPGRP(pid)          getpgrp2((pid))
435 #    endif
436 #  endif
437 #endif
438 #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
439 #  define HAS_GETPGRP  /* Well, effectively it does . . . */
440 #endif
441
442 /* These are not exact synonyms, since setpgrp() and getpgrp() may
443    have different behaviors, but perl.h used to define USE_BSDPGRP
444    (prior to 5.003_05) so some extension might depend on it.
445 */
446 #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
447 #  ifndef USE_BSDPGRP
448 #    define USE_BSDPGRP
449 #  endif
450 #endif
451
452 /* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that
453    pthread.h must be included before all other header files.
454 */
455 #if defined(USE_ITHREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD)
456 #  include <pthread.h>
457 #endif
458
459 #ifndef _TYPES_         /* If types.h defines this it's easy. */
460 #   ifndef major                /* Does everyone's types.h define this? */
461 #       include <sys/types.h>
462 #   endif
463 #endif
464
465 #ifdef __cplusplus
466 #  ifndef I_STDARG
467 #    define I_STDARG 1
468 #  endif
469 #endif
470
471 #ifdef I_STDARG
472 #  include <stdarg.h>
473 #else
474 #  ifdef I_VARARGS
475 #    include <varargs.h>
476 #  endif
477 #endif
478
479 #ifdef USE_NEXT_CTYPE
480
481 #if NX_CURRENT_COMPILER_RELEASE >= 500
482 #  include <bsd/ctypes.h>
483 #else
484 #  if NX_CURRENT_COMPILER_RELEASE >= 400
485 #    include <objc/NXCType.h>
486 #  else /*  NX_CURRENT_COMPILER_RELEASE < 400 */
487 #    include <appkit/NXCType.h>
488 #  endif /*  NX_CURRENT_COMPILER_RELEASE >= 400 */
489 #endif /*  NX_CURRENT_COMPILER_RELEASE >= 500 */
490
491 #else /* !USE_NEXT_CTYPE */
492 #include <ctype.h>
493 #endif /* USE_NEXT_CTYPE */
494
495 #ifdef METHOD   /* Defined by OSF/1 v3.0 by ctype.h */
496 #undef METHOD
497 #endif
498
499 #ifdef PERL_MICRO
500 #   define NO_LOCALE
501 #endif
502
503 #ifdef I_LOCALE
504 #   include <locale.h>
505 #endif
506
507 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
508 #   define USE_LOCALE
509 #   if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
510        && defined(HAS_STRXFRM)
511 #       define USE_LOCALE_COLLATE
512 #   endif
513 #   if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE)
514 #       define USE_LOCALE_CTYPE
515 #   endif
516 #   if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC)
517 #       define USE_LOCALE_NUMERIC
518 #   endif
519 #endif /* !NO_LOCALE && HAS_SETLOCALE */
520
521 #include <setjmp.h>
522
523 #ifdef I_SYS_PARAM
524 #   ifdef PARAM_NEEDS_TYPES
525 #       include <sys/types.h>
526 #   endif
527 #   include <sys/param.h>
528 #endif
529
530 /* Use all the "standard" definitions? */
531 #if defined(STANDARD_C) && defined(I_STDLIB)
532 #   include <stdlib.h>
533 #endif
534
535 /* If this causes problems, set i_unistd=undef in the hint file.  */
536 #ifdef I_UNISTD
537 #   include <unistd.h>
538 #endif
539
540 #ifdef SYMBIAN
541 #   undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */
542 #endif
543
544 #if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO)
545 int syscall(int, ...);
546 #endif
547
548 #if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO) && !defined(PERL_MICRO)
549 int usleep(unsigned int);
550 #endif
551
552 #ifdef PERL_MICRO /* Last chance to export Perl_my_swap */
553 #  define MYSWAP
554 #endif
555
556 #ifdef PERL_CORE
557
558 /* macros for correct constant construction */
559 # if INTSIZE >= 2
560 #  define U16_CONST(x) ((U16)x##U)
561 # else
562 #  define U16_CONST(x) ((U16)x##UL)
563 # endif
564
565 # if INTSIZE >= 4
566 #  define U32_CONST(x) ((U32)x##U)
567 # else
568 #  define U32_CONST(x) ((U32)x##UL)
569 # endif
570
571 # ifdef HAS_QUAD
572 #  if INTSIZE >= 8
573 #   define U64_CONST(x) ((U64)x##U)
574 #  elif LONGSIZE >= 8
575 #   define U64_CONST(x) ((U64)x##UL)
576 #  elif QUADKIND == QUAD_IS_LONG_LONG
577 #   define U64_CONST(x) ((U64)x##ULL)
578 #  else /* best guess we can make */
579 #   define U64_CONST(x) ((U64)x##UL)
580 #  endif
581 # endif
582
583 /* byte-swapping functions for big-/little-endian conversion */
584 # define _swab_16_(x) ((U16)( \
585          (((U16)(x) & U16_CONST(0x00ff)) << 8) | \
586          (((U16)(x) & U16_CONST(0xff00)) >> 8) ))
587
588 # define _swab_32_(x) ((U32)( \
589          (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \
590          (((U32)(x) & U32_CONST(0x0000ff00)) <<  8) | \
591          (((U32)(x) & U32_CONST(0x00ff0000)) >>  8) | \
592          (((U32)(x) & U32_CONST(0xff000000)) >> 24) ))
593
594 # ifdef HAS_QUAD
595 #  define _swab_64_(x) ((U64)( \
596           (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \
597           (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \
598           (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \
599           (((U64)(x) & U64_CONST(0x00000000ff000000)) <<  8) | \
600           (((U64)(x) & U64_CONST(0x000000ff00000000)) >>  8) | \
601           (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \
602           (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \
603           (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) ))
604 # endif
605
606 /*----------------------------------------------------------------------------*/
607 # if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678  /*     little-endian     */
608 /*----------------------------------------------------------------------------*/
609 #  define my_htole16(x)         (x)
610 #  define my_letoh16(x)         (x)
611 #  define my_htole32(x)         (x)
612 #  define my_letoh32(x)         (x)
613 #  define my_htobe16(x)         _swab_16_(x)
614 #  define my_betoh16(x)         _swab_16_(x)
615 #  define my_htobe32(x)         _swab_32_(x)
616 #  define my_betoh32(x)         _swab_32_(x)
617 #  ifdef HAS_QUAD
618 #   define my_htole64(x)        (x)
619 #   define my_letoh64(x)        (x)
620 #   define my_htobe64(x)        _swab_64_(x)
621 #   define my_betoh64(x)        _swab_64_(x)
622 #  endif
623 #  define my_htoles(x)          (x)
624 #  define my_letohs(x)          (x)
625 #  define my_htolei(x)          (x)
626 #  define my_letohi(x)          (x)
627 #  define my_htolel(x)          (x)
628 #  define my_letohl(x)          (x)
629 #  if SHORTSIZE == 1
630 #   define my_htobes(x)         (x)
631 #   define my_betohs(x)         (x)
632 #  elif SHORTSIZE == 2
633 #   define my_htobes(x)         _swab_16_(x)
634 #   define my_betohs(x)         _swab_16_(x)
635 #  elif SHORTSIZE == 4
636 #   define my_htobes(x)         _swab_32_(x)
637 #   define my_betohs(x)         _swab_32_(x)
638 #  elif SHORTSIZE == 8
639 #   define my_htobes(x)         _swab_64_(x)
640 #   define my_betohs(x)         _swab_64_(x)
641 #  else
642 #   define PERL_NEED_MY_HTOBES
643 #   define PERL_NEED_MY_BETOHS
644 #  endif
645 #  if INTSIZE == 1
646 #   define my_htobei(x)         (x)
647 #   define my_betohi(x)         (x)
648 #  elif INTSIZE == 2
649 #   define my_htobei(x)         _swab_16_(x)
650 #   define my_betohi(x)         _swab_16_(x)
651 #  elif INTSIZE == 4
652 #   define my_htobei(x)         _swab_32_(x)
653 #   define my_betohi(x)         _swab_32_(x)
654 #  elif INTSIZE == 8
655 #   define my_htobei(x)         _swab_64_(x)
656 #   define my_betohi(x)         _swab_64_(x)
657 #  else
658 #   define PERL_NEED_MY_HTOBEI
659 #   define PERL_NEED_MY_BETOHI
660 #  endif
661 #  if LONGSIZE == 1
662 #   define my_htobel(x)         (x)
663 #   define my_betohl(x)         (x)
664 #  elif LONGSIZE == 2
665 #   define my_htobel(x)         _swab_16_(x)
666 #   define my_betohl(x)         _swab_16_(x)
667 #  elif LONGSIZE == 4
668 #   define my_htobel(x)         _swab_32_(x)
669 #   define my_betohl(x)         _swab_32_(x)
670 #  elif LONGSIZE == 8
671 #   define my_htobel(x)         _swab_64_(x)
672 #   define my_betohl(x)         _swab_64_(x)
673 #  else
674 #   define PERL_NEED_MY_HTOBEL
675 #   define PERL_NEED_MY_BETOHL
676 #  endif
677 #  define my_htolen(p,n)        NOOP
678 #  define my_letohn(p,n)        NOOP
679 #  define my_htoben(p,n)        my_swabn(p,n)
680 #  define my_betohn(p,n)        my_swabn(p,n)
681 /*----------------------------------------------------------------------------*/
682 # elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321  /*     big-endian      */
683 /*----------------------------------------------------------------------------*/
684 #  define my_htobe16(x)         (x)
685 #  define my_betoh16(x)         (x)
686 #  define my_htobe32(x)         (x)
687 #  define my_betoh32(x)         (x)
688 #  define my_htole16(x)         _swab_16_(x)
689 #  define my_letoh16(x)         _swab_16_(x)
690 #  define my_htole32(x)         _swab_32_(x)
691 #  define my_letoh32(x)         _swab_32_(x)
692 #  ifdef HAS_QUAD
693 #   define my_htobe64(x)        (x)
694 #   define my_betoh64(x)        (x)
695 #   define my_htole64(x)        _swab_64_(x)
696 #   define my_letoh64(x)        _swab_64_(x)
697 #  endif
698 #  define my_htobes(x)          (x)
699 #  define my_betohs(x)          (x)
700 #  define my_htobei(x)          (x)
701 #  define my_betohi(x)          (x)
702 #  define my_htobel(x)          (x)
703 #  define my_betohl(x)          (x)
704 #  if SHORTSIZE == 1
705 #   define my_htoles(x)         (x)
706 #   define my_letohs(x)         (x)
707 #  elif SHORTSIZE == 2
708 #   define my_htoles(x)         _swab_16_(x)
709 #   define my_letohs(x)         _swab_16_(x)
710 #  elif SHORTSIZE == 4
711 #   define my_htoles(x)         _swab_32_(x)
712 #   define my_letohs(x)         _swab_32_(x)
713 #  elif SHORTSIZE == 8
714 #   define my_htoles(x)         _swab_64_(x)
715 #   define my_letohs(x)         _swab_64_(x)
716 #  else
717 #   define PERL_NEED_MY_HTOLES
718 #   define PERL_NEED_MY_LETOHS
719 #  endif
720 #  if INTSIZE == 1
721 #   define my_htolei(x)         (x)
722 #   define my_letohi(x)         (x)
723 #  elif INTSIZE == 2
724 #   define my_htolei(x)         _swab_16_(x)
725 #   define my_letohi(x)         _swab_16_(x)
726 #  elif INTSIZE == 4
727 #   define my_htolei(x)         _swab_32_(x)
728 #   define my_letohi(x)         _swab_32_(x)
729 #  elif INTSIZE == 8
730 #   define my_htolei(x)         _swab_64_(x)
731 #   define my_letohi(x)         _swab_64_(x)
732 #  else
733 #   define PERL_NEED_MY_HTOLEI
734 #   define PERL_NEED_MY_LETOHI
735 #  endif
736 #  if LONGSIZE == 1
737 #   define my_htolel(x)         (x)
738 #   define my_letohl(x)         (x)
739 #  elif LONGSIZE == 2
740 #   define my_htolel(x)         _swab_16_(x)
741 #   define my_letohl(x)         _swab_16_(x)
742 #  elif LONGSIZE == 4
743 #   define my_htolel(x)         _swab_32_(x)
744 #   define my_letohl(x)         _swab_32_(x)
745 #  elif LONGSIZE == 8
746 #   define my_htolel(x)         _swab_64_(x)
747 #   define my_letohl(x)         _swab_64_(x)
748 #  else
749 #   define PERL_NEED_MY_HTOLEL
750 #   define PERL_NEED_MY_LETOHL
751 #  endif
752 #  define my_htolen(p,n)        my_swabn(p,n)
753 #  define my_letohn(p,n)        my_swabn(p,n)
754 #  define my_htoben(p,n)        NOOP
755 #  define my_betohn(p,n)        NOOP
756 /*----------------------------------------------------------------------------*/
757 # else /*                       all other byte-orders                         */
758 /*----------------------------------------------------------------------------*/
759 #  define PERL_NEED_MY_HTOLE16
760 #  define PERL_NEED_MY_LETOH16
761 #  define PERL_NEED_MY_HTOBE16
762 #  define PERL_NEED_MY_BETOH16
763 #  define PERL_NEED_MY_HTOLE32
764 #  define PERL_NEED_MY_LETOH32
765 #  define PERL_NEED_MY_HTOBE32
766 #  define PERL_NEED_MY_BETOH32
767 #  ifdef HAS_QUAD
768 #   define PERL_NEED_MY_HTOLE64
769 #   define PERL_NEED_MY_LETOH64
770 #   define PERL_NEED_MY_HTOBE64
771 #   define PERL_NEED_MY_BETOH64
772 #  endif
773 #  define PERL_NEED_MY_HTOLES
774 #  define PERL_NEED_MY_LETOHS
775 #  define PERL_NEED_MY_HTOBES
776 #  define PERL_NEED_MY_BETOHS
777 #  define PERL_NEED_MY_HTOLEI
778 #  define PERL_NEED_MY_LETOHI
779 #  define PERL_NEED_MY_HTOBEI
780 #  define PERL_NEED_MY_BETOHI
781 #  define PERL_NEED_MY_HTOLEL
782 #  define PERL_NEED_MY_LETOHL
783 #  define PERL_NEED_MY_HTOBEL
784 #  define PERL_NEED_MY_BETOHL
785 /*----------------------------------------------------------------------------*/
786 # endif /*                     end of byte-order macros                       */
787 /*----------------------------------------------------------------------------*/
788
789 /* The old value was hard coded at 1008. (4096-16) seems to be a bit faster,
790    at least on FreeBSD.  YMMV, so experiment.  */
791 #ifndef PERL_ARENA_SIZE
792 #define PERL_ARENA_SIZE 4080
793 #endif
794
795 #endif /* PERL_CORE */
796
797 /* Cannot include embed.h here on Win32 as win32.h has not 
798    yet been included and defines some config variables e.g. HAVE_INTERP_INTERN
799  */
800 #if !defined(PERL_FOR_X2P) && !(defined(WIN32)||defined(VMS))
801 #  include "embed.h"
802 #endif
803
804 #define MEM_SIZE Size_t
805
806 /* Round all values passed to malloc up, by default to a multiple of
807    sizeof(size_t)
808 */
809 #ifndef PERL_STRLEN_ROUNDUP_QUANTUM
810 #define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size
811 #endif
812
813 #if defined(STANDARD_C) && defined(I_STDDEF)
814 #   include <stddef.h>
815 #   define STRUCT_OFFSET(s,m)  offsetof(s,m)
816 #else
817 #   define STRUCT_OFFSET(s,m)  (Size_t)(&(((s *)0)->m))
818 #endif
819
820 #ifndef SYMBIAN
821 #  if defined(I_STRING) || defined(__cplusplus)
822 #     include <string.h>
823 #  else
824 #     include <strings.h>
825 #  endif
826 #endif
827
828 /* This comes after <stdlib.h> so we don't try to change the standard
829  * library prototypes; we'll use our own in proto.h instead. */
830
831 #ifdef MYMALLOC
832 #  ifdef PERL_POLLUTE_MALLOC
833 #   ifndef PERL_EXTMALLOC_DEF
834 #    define Perl_malloc         malloc
835 #    define Perl_calloc         calloc
836 #    define Perl_realloc        realloc
837 #    define Perl_mfree          free
838 #   endif
839 #  else
840 #    define EMBEDMYMALLOC       /* for compatibility */
841 #  endif
842
843 #  define safemalloc  Perl_malloc
844 #  define safecalloc  Perl_calloc
845 #  define saferealloc Perl_realloc
846 #  define safefree    Perl_mfree
847 #  define CHECK_MALLOC_TOO_LATE_FOR_(code)      STMT_START {            \
848         if (!PL_tainting && MallocCfg_ptr[MallocCfg_cfg_env_read])      \
849                 code;                                                   \
850     } STMT_END
851 #  define CHECK_MALLOC_TOO_LATE_FOR(ch)                         \
852         CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch))
853 #  define panic_write2(s)               write(2, s, strlen(s))
854 #  define CHECK_MALLOC_TAINT(newval)                            \
855         CHECK_MALLOC_TOO_LATE_FOR_(                             \
856                 if (newval) {                                   \
857                   panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\
858                   exit(1); })
859 #  define MALLOC_CHECK_TAINT(argc,argv,env)     STMT_START {    \
860         if (doing_taint(argc,argv,env)) {                       \
861                 MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1;      \
862     }} STMT_END;
863 #else  /* MYMALLOC */
864 #  define safemalloc  safesysmalloc
865 #  define safecalloc  safesyscalloc
866 #  define saferealloc safesysrealloc
867 #  define safefree    safesysfree
868 #  define CHECK_MALLOC_TOO_LATE_FOR(ch)         ((void)0)
869 #  define CHECK_MALLOC_TAINT(newval)            ((void)0)
870 #  define MALLOC_CHECK_TAINT(argc,argv,env)
871 #endif /* MYMALLOC */
872
873 #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)
874 #define TOO_LATE_FOR(ch)        TOO_LATE_FOR_(ch, "")
875 #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}")
876 #define MALLOC_CHECK_TAINT2(argc,argv)  MALLOC_CHECK_TAINT(argc,argv,NULL)
877
878 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
879 #define strchr index
880 #define strrchr rindex
881 #endif
882
883 #ifdef I_MEMORY
884 #  include <memory.h>
885 #endif
886
887 #ifdef HAS_MEMCPY
888 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
889 #    ifndef memcpy
890         extern char * memcpy (char*, char*, int);
891 #    endif
892 #  endif
893 #else
894 #   ifndef memcpy
895 #       ifdef HAS_BCOPY
896 #           define memcpy(d,s,l) bcopy(s,d,l)
897 #       else
898 #           define memcpy(d,s,l) my_bcopy(s,d,l)
899 #       endif
900 #   endif
901 #endif /* HAS_MEMCPY */
902
903 #ifdef HAS_MEMSET
904 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
905 #    ifndef memset
906         extern char *memset (char*, int, int);
907 #    endif
908 #  endif
909 #else
910 #  undef  memset
911 #  define memset(d,c,l) my_memset(d,c,l)
912 #endif /* HAS_MEMSET */
913
914 #if !defined(HAS_MEMMOVE) && !defined(memmove)
915 #   if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
916 #       define memmove(d,s,l) bcopy(s,d,l)
917 #   else
918 #       if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
919 #           define memmove(d,s,l) memcpy(d,s,l)
920 #       else
921 #           define memmove(d,s,l) my_bcopy(s,d,l)
922 #       endif
923 #   endif
924 #endif
925
926 #if defined(mips) && defined(ultrix) && !defined(__STDC__)
927 #   undef HAS_MEMCMP
928 #endif
929
930 #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
931 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
932 #    ifndef memcmp
933         extern int memcmp (char*, char*, int);
934 #    endif
935 #  endif
936 #  ifdef BUGGY_MSC
937 #    pragma function(memcmp)
938 #  endif
939 #else
940 #   ifndef memcmp
941 #       define memcmp   my_memcmp
942 #   endif
943 #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
944
945 #ifndef memzero
946 #   ifdef HAS_MEMSET
947 #       define memzero(d,l) memset(d,0,l)
948 #   else
949 #       ifdef HAS_BZERO
950 #           define memzero(d,l) bzero(d,l)
951 #       else
952 #           define memzero(d,l) my_bzero(d,l)
953 #       endif
954 #   endif
955 #endif
956
957 #ifndef PERL_MICRO
958 #ifndef memchr
959 #   ifndef HAS_MEMCHR
960 #       define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1)
961 #   endif
962 #endif
963 #endif
964
965 #ifndef HAS_BCMP
966 #   ifndef bcmp
967 #       define bcmp(s1,s2,l) memcmp(s1,s2,l)
968 #   endif
969 #endif /* !HAS_BCMP */
970
971 #ifdef I_NETINET_IN
972 #   include <netinet/in.h>
973 #endif
974
975 #ifdef I_ARPA_INET
976 #   include <arpa/inet.h>
977 #endif
978
979 #if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
980 /* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
981  * (the neo-BSD seem to do this).  */
982 #   undef SF_APPEND
983 #endif
984
985 #ifdef I_SYS_STAT
986 #   include <sys/stat.h>
987 #endif
988
989 /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
990    like UTekV) are broken, sometimes giving false positives.  Undefine
991    them here and let the code below set them to proper values.
992
993    The ghs macro stands for GreenHills Software C-1.8.5 which
994    is the C compiler for sysV88 and the various derivatives.
995    This header file bug is corrected in gcc-2.5.8 and later versions.
996    --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94.  */
997
998 #if defined(uts) || (defined(m88k) && defined(ghs))
999 #   undef S_ISDIR
1000 #   undef S_ISCHR
1001 #   undef S_ISBLK
1002 #   undef S_ISREG
1003 #   undef S_ISFIFO
1004 #   undef S_ISLNK
1005 #endif
1006
1007 #ifdef I_TIME
1008 #   include <time.h>
1009 #endif
1010
1011 #ifdef I_SYS_TIME
1012 #   ifdef I_SYS_TIME_KERNEL
1013 #       define KERNEL
1014 #   endif
1015 #   include <sys/time.h>
1016 #   ifdef I_SYS_TIME_KERNEL
1017 #       undef KERNEL
1018 #   endif
1019 #endif
1020
1021 #if defined(HAS_TIMES) && defined(I_SYS_TIMES)
1022 #    include <sys/times.h>
1023 #endif
1024
1025 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
1026 #   undef HAS_STRERROR
1027 #endif
1028
1029 #include <errno.h>
1030
1031 #if defined(WIN32) && defined(PERL_IMPLICIT_SYS)
1032 #  define WIN32SCK_IS_STDSCK            /* don't pull in custom wsock layer */
1033 #endif
1034
1035 /* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one.
1036  * This is important for using IPv6. 
1037  * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be
1038  * a bad idea since it breaks send() and recv(). */
1039 #if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X)
1040 #   define _SOCKADDR_LEN
1041 #endif
1042
1043 #if defined(HAS_SOCKET) && !defined(VMS) && !defined(WIN32) /* VMS/WIN32 handle sockets via vmsish.h/win32.h */
1044 # include <sys/socket.h>
1045 # if defined(USE_SOCKS) && defined(I_SOCKS)
1046 #   if !defined(INCLUDE_PROTOTYPES)
1047 #       define INCLUDE_PROTOTYPES /* for <socks.h> */
1048 #       define PERL_SOCKS_NEED_PROTOTYPES
1049 #   endif
1050 #   include <socks.h>
1051 #   ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
1052 #       undef INCLUDE_PROTOTYPES
1053 #       undef PERL_SOCKS_NEED_PROTOTYPES
1054 #   endif
1055 # endif
1056 # ifdef I_NETDB
1057 #  ifdef NETWARE
1058 #   include<stdio.h>
1059 #  endif
1060 #  include <netdb.h>
1061 # endif
1062 # ifndef ENOTSOCK
1063 #  ifdef I_NET_ERRNO
1064 #   include <net/errno.h>
1065 #  endif
1066 # endif
1067 #endif
1068
1069 /* sockatmark() is so new (2001) that many places might have it hidden
1070  * behind some -D_BLAH_BLAH_SOURCE guard.  The __THROW magic is required
1071  * e.g. in Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */
1072 #if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO)
1073 # if defined(__THROW) && defined(__GLIBC__)
1074 int sockatmark(int) __THROW;
1075 # else
1076 int sockatmark(int);
1077 # endif
1078 #endif
1079
1080 #ifdef SETERRNO
1081 # undef SETERRNO  /* SOCKS might have defined this */
1082 #endif
1083
1084 #ifdef VMS
1085 #   define SETERRNO(errcode,vmserrcode) \
1086         STMT_START {                    \
1087             set_errno(errcode);         \
1088             set_vaxc_errno(vmserrcode); \
1089         } STMT_END
1090 #   define LIB_INVARG           LIB$_INVARG
1091 #   define RMS_DIR              RMS$_DIR
1092 #   define RMS_FAC              RMS$_FAC
1093 #   define RMS_FEX              RMS$_FEX
1094 #   define RMS_FNF              RMS$_FNF
1095 #   define RMS_IFI              RMS$_IFI
1096 #   define RMS_ISI              RMS$_ISI
1097 #   define RMS_PRV              RMS$_PRV
1098 #   define SS_ACCVIO            SS$_ACCVIO
1099 #   define SS_DEVOFFLINE        SS$_DEVOFFLINE
1100 #   define SS_IVCHAN            SS$_IVCHAN
1101 #   define SS_NORMAL            SS$_NORMAL
1102 #else
1103 #   define SETERRNO(errcode,vmserrcode) (errno = (errcode))
1104 #   define LIB_INVARG           0
1105 #   define RMS_DIR              0
1106 #   define RMS_FAC              0
1107 #   define RMS_FEX              0
1108 #   define RMS_FNF              0
1109 #   define RMS_IFI              0
1110 #   define RMS_ISI              0
1111 #   define RMS_PRV              0
1112 #   define SS_ACCVIO            0
1113 #   define SS_DEVOFFLINE        0
1114 #   define SS_IVCHAN            0
1115 #   define SS_NORMAL            0
1116 #endif
1117
1118 #define ERRSV GvSV(PL_errgv)
1119 #define DEFSV GvSV(PL_defgv)
1120 #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
1121
1122 #define ERRHV GvHV(PL_errgv)    /* XXX unused, here for compatibility */
1123
1124 #ifndef errno
1125         extern int errno;     /* ANSI allows errno to be an lvalue expr.
1126                                * For example in multithreaded environments
1127                                * something like this might happen:
1128                                * extern int *_errno(void);
1129                                * #define errno (*_errno()) */
1130 #endif
1131
1132 #ifdef HAS_STRERROR
1133 #       ifdef VMS
1134         char *strerror (int,...);
1135 #       else
1136 #ifndef DONT_DECLARE_STD
1137         char *strerror (int);
1138 #endif
1139 #       endif
1140 #       ifndef Strerror
1141 #           define Strerror strerror
1142 #       endif
1143 #else
1144 #    ifdef HAS_SYS_ERRLIST
1145         extern int sys_nerr;
1146         extern char *sys_errlist[];
1147 #       ifndef Strerror
1148 #           define Strerror(e) \
1149                 ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
1150 #       endif
1151 #   endif
1152 #endif
1153
1154 #ifdef I_SYS_IOCTL
1155 #   ifndef _IOCTL_
1156 #       include <sys/ioctl.h>
1157 #   endif
1158 #endif
1159
1160 #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
1161 #   ifdef HAS_SOCKETPAIR
1162 #       undef HAS_SOCKETPAIR
1163 #   endif
1164 #   ifdef I_NDBM
1165 #       undef I_NDBM
1166 #   endif
1167 #endif
1168
1169 #ifndef HAS_SOCKETPAIR
1170 #   ifdef HAS_SOCKET
1171 #       define socketpair Perl_my_socketpair
1172 #   endif
1173 #endif
1174
1175 #if INTSIZE == 2
1176 #   define htoni htons
1177 #   define ntohi ntohs
1178 #else
1179 #   define htoni htonl
1180 #   define ntohi ntohl
1181 #endif
1182
1183 /* Configure already sets Direntry_t */
1184 #if defined(I_DIRENT)
1185 #   include <dirent.h>
1186     /* NeXT needs dirent + sys/dir.h */
1187 #   if  defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__))
1188 #       include <sys/dir.h>
1189 #   endif
1190 #else
1191 #   ifdef I_SYS_NDIR
1192 #       include <sys/ndir.h>
1193 #   else
1194 #       ifdef I_SYS_DIR
1195 #           ifdef hp9000s500
1196 #               include <ndir.h>        /* may be wrong in the future */
1197 #           else
1198 #               include <sys/dir.h>
1199 #           endif
1200 #       endif
1201 #   endif
1202 #endif
1203
1204 #ifdef PERL_MICRO
1205 #   ifndef DIR
1206 #      define DIR void
1207 #   endif
1208 #endif
1209
1210 #ifdef FPUTS_BOTCH
1211 /* work around botch in SunOS 4.0.1 and 4.0.2 */
1212 #   ifndef fputs
1213 #       define fputs(sv,fp) fprintf(fp,"%s",sv)
1214 #   endif
1215 #endif
1216
1217 /*
1218  * The following gobbledygook brought to you on behalf of __STDC__.
1219  * (I could just use #ifndef __STDC__, but this is more bulletproof
1220  * in the face of half-implementations.)
1221  */
1222
1223 #if defined(I_SYSMODE) && !defined(PERL_MICRO)
1224 #include <sys/mode.h>
1225 #endif
1226
1227 #ifndef S_IFMT
1228 #   ifdef _S_IFMT
1229 #       define S_IFMT _S_IFMT
1230 #   else
1231 #       define S_IFMT 0170000
1232 #   endif
1233 #endif
1234
1235 #ifndef S_ISDIR
1236 #   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
1237 #endif
1238
1239 #ifndef S_ISCHR
1240 #   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
1241 #endif
1242
1243 #ifndef S_ISBLK
1244 #   ifdef S_IFBLK
1245 #       define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
1246 #   else
1247 #       define S_ISBLK(m) (0)
1248 #   endif
1249 #endif
1250
1251 #ifndef S_ISREG
1252 #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
1253 #endif
1254
1255 #ifndef S_ISFIFO
1256 #   ifdef S_IFIFO
1257 #       define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
1258 #   else
1259 #       define S_ISFIFO(m) (0)
1260 #   endif
1261 #endif
1262
1263 #ifndef S_ISLNK
1264 #   ifdef _S_ISLNK
1265 #       define S_ISLNK(m) _S_ISLNK(m)
1266 #   else
1267 #       ifdef _S_IFLNK
1268 #           define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
1269 #       else
1270 #           ifdef S_IFLNK
1271 #               define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
1272 #           else
1273 #               define S_ISLNK(m) (0)
1274 #           endif
1275 #       endif
1276 #   endif
1277 #endif
1278
1279 #ifndef S_ISSOCK
1280 #   ifdef _S_ISSOCK
1281 #       define S_ISSOCK(m) _S_ISSOCK(m)
1282 #   else
1283 #       ifdef _S_IFSOCK
1284 #           define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
1285 #       else
1286 #           ifdef S_IFSOCK
1287 #               define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
1288 #           else
1289 #               define S_ISSOCK(m) (0)
1290 #           endif
1291 #       endif
1292 #   endif
1293 #endif
1294
1295 #ifndef S_IRUSR
1296 #   ifdef S_IREAD
1297 #       define S_IRUSR S_IREAD
1298 #       define S_IWUSR S_IWRITE
1299 #       define S_IXUSR S_IEXEC
1300 #   else
1301 #       define S_IRUSR 0400
1302 #       define S_IWUSR 0200
1303 #       define S_IXUSR 0100
1304 #   endif
1305 #endif
1306
1307 #ifndef S_IRGRP
1308 #   ifdef S_IRUSR
1309 #       define S_IRGRP (S_IRUSR>>3)
1310 #       define S_IWGRP (S_IWUSR>>3)
1311 #       define S_IXGRP (S_IXUSR>>3)
1312 #   else
1313 #       define S_IRGRP 0040
1314 #       define S_IWGRP 0020
1315 #       define S_IXGRP 0010
1316 #   endif
1317 #endif
1318
1319 #ifndef S_IROTH
1320 #   ifdef S_IRUSR
1321 #       define S_IROTH (S_IRUSR>>6)
1322 #       define S_IWOTH (S_IWUSR>>6)
1323 #       define S_IXOTH (S_IXUSR>>6)
1324 #   else
1325 #       define S_IROTH 0040
1326 #       define S_IWOTH 0020
1327 #       define S_IXOTH 0010
1328 #   endif
1329 #endif
1330
1331 #ifndef S_ISUID
1332 #   define S_ISUID 04000
1333 #endif
1334
1335 #ifndef S_ISGID
1336 #   define S_ISGID 02000
1337 #endif
1338
1339 #ifndef S_IRWXU
1340 #   define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR)
1341 #endif
1342
1343 #ifndef S_IRWXG
1344 #   define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP)
1345 #endif
1346
1347 #ifndef S_IRWXO
1348 #   define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
1349 #endif
1350
1351 /* BeOS 5.0 seems to define S_IREAD and S_IWRITE in <posix/fcntl.h>
1352  * which would get included through <sys/file.h >, but that is 3000
1353  * lines in the future.  --jhi */
1354
1355 #if !defined(S_IREAD) && !defined(__BEOS__)
1356 #   define S_IREAD S_IRUSR
1357 #endif
1358
1359 #if !defined(S_IWRITE) && !defined(__BEOS__)
1360 #   define S_IWRITE S_IWUSR
1361 #endif
1362
1363 #ifndef S_IEXEC
1364 #   define S_IEXEC S_IXUSR
1365 #endif
1366
1367 #ifdef ff_next
1368 #   undef ff_next
1369 #endif
1370
1371 #if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
1372 #   define SLOPPYDIVIDE
1373 #endif
1374
1375 #ifdef UV
1376 #undef UV
1377 #endif
1378
1379 #ifdef  SPRINTF_E_BUG
1380 #  define sprintf UTS_sprintf_wrap
1381 #endif
1382
1383 /* Configure gets this right but the UTS compiler gets it wrong.
1384    -- Hal Morris <hom00@utsglobal.com> */
1385 #ifdef UTS
1386 #  undef  UVTYPE
1387 #  define UVTYPE unsigned
1388 #endif
1389
1390 /*
1391     The IV type is supposed to be long enough to hold any integral
1392     value or a pointer.
1393     --Andy Dougherty    August 1996
1394 */
1395
1396 typedef IVTYPE IV;
1397 typedef UVTYPE UV;
1398
1399 #if defined(USE_64_BIT_INT) && defined(HAS_QUAD)
1400 #  if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX)
1401 #    define IV_MAX INT64_MAX
1402 #    define IV_MIN INT64_MIN
1403 #    define UV_MAX UINT64_MAX
1404 #    ifndef UINT64_MIN
1405 #      define UINT64_MIN 0
1406 #    endif
1407 #    define UV_MIN UINT64_MIN
1408 #  else
1409 #    define IV_MAX PERL_QUAD_MAX
1410 #    define IV_MIN PERL_QUAD_MIN
1411 #    define UV_MAX PERL_UQUAD_MAX
1412 #    define UV_MIN PERL_UQUAD_MIN
1413 #  endif
1414 #  define IV_IS_QUAD
1415 #  define UV_IS_QUAD
1416 #else
1417 #  if defined(INT32_MAX) && IVSIZE == 4
1418 #    define IV_MAX INT32_MAX
1419 #    define IV_MIN INT32_MIN
1420 #    ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */
1421 #        define UV_MAX UINT32_MAX
1422 #    else
1423 #        define UV_MAX 4294967295U
1424 #    endif
1425 #    ifndef UINT32_MIN
1426 #      define UINT32_MIN 0
1427 #    endif
1428 #    define UV_MIN UINT32_MIN
1429 #  else
1430 #    define IV_MAX PERL_LONG_MAX
1431 #    define IV_MIN PERL_LONG_MIN
1432 #    define UV_MAX PERL_ULONG_MAX
1433 #    define UV_MIN PERL_ULONG_MIN
1434 #  endif
1435 #  if IVSIZE == 8
1436 #    define IV_IS_QUAD
1437 #    define UV_IS_QUAD
1438 #    ifndef HAS_QUAD
1439 #      define HAS_QUAD
1440 #    endif
1441 #  else
1442 #    undef IV_IS_QUAD
1443 #    undef UV_IS_QUAD
1444 #    undef HAS_QUAD
1445 #  endif
1446 #endif
1447
1448 #ifndef HAS_QUAD
1449 # undef PERL_NEED_MY_HTOLE64
1450 # undef PERL_NEED_MY_LETOH64
1451 # undef PERL_NEED_MY_HTOBE64
1452 # undef PERL_NEED_MY_BETOH64
1453 #endif
1454
1455 #if defined(uts) || defined(UTS)
1456 #       undef UV_MAX
1457 #       define UV_MAX (4294967295u)
1458 #endif
1459
1460 #define IV_DIG (BIT_DIGITS(IVSIZE * 8))
1461 #define UV_DIG (BIT_DIGITS(UVSIZE * 8))
1462
1463 #ifndef NO_PERL_PRESERVE_IVUV
1464 #define PERL_PRESERVE_IVUV      /* We like our integers to stay integers. */
1465 #endif
1466
1467 /*
1468  *  The macros INT2PTR and NUM2PTR are (despite their names)
1469  *  bi-directional: they will convert int/float to or from pointers.
1470  *  However the conversion to int/float are named explicitly:
1471  *  PTR2IV, PTR2UV, PTR2NV.
1472  *
1473  *  For int conversions we do not need two casts if pointers are
1474  *  the same size as IV and UV.   Otherwise we need an explicit
1475  *  cast (PTRV) to avoid compiler warnings.
1476  */
1477 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
1478 #  define PTRV                  UV
1479 #  define INT2PTR(any,d)        (any)(d)
1480 #else
1481 #  if PTRSIZE == LONGSIZE
1482 #    define PTRV                unsigned long
1483 #  else
1484 #    define PTRV                unsigned
1485 #  endif
1486 #  define INT2PTR(any,d)        (any)(PTRV)(d)
1487 #endif
1488 #define NUM2PTR(any,d)  (any)(PTRV)(d)
1489 #define PTR2IV(p)       INT2PTR(IV,p)
1490 #define PTR2UV(p)       INT2PTR(UV,p)
1491 #define PTR2NV(p)       NUM2PTR(NV,p)
1492 #if PTRSIZE == LONGSIZE
1493 #  define PTR2ul(p)     (unsigned long)(p)
1494 #else
1495 #  define PTR2ul(p)     INT2PTR(unsigned long,p)        
1496 #endif
1497
1498 /* According to strict ANSI C89 one cannot freely cast between
1499  * data pointers and function (code) pointers.  There are at least
1500  * two ways around this.  One (used below) is to do two casts,
1501  * first the other pointer to an (unsigned) integer, and then
1502  * the integer to the other pointer.  The other way would be
1503  * to use unions to "overlay" the pointers.  For an example of
1504  * the latter technique, see union dirpu in struct xpvio in sv.h.
1505  * The only feasible use is probably temporarily storing
1506  * function pointers in a data pointer (such as a void pointer). */
1507
1508 #define DPTR2FPTR(t,p) ((t)PTR2UV(p)) /* data pointer to function pointer */
1509 #define FPTR2DPTR(t,p) ((t)PTR2UV(p)) /* function pointer to data pointer */
1510
1511 #ifdef USE_LONG_DOUBLE
1512 #  if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
1513 #      define LONG_DOUBLE_EQUALS_DOUBLE
1514 #  endif
1515 #  if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE))
1516 #     undef USE_LONG_DOUBLE /* Ouch! */
1517 #  endif
1518 #endif
1519
1520 #ifdef OVR_DBL_DIG
1521 /* Use an overridden DBL_DIG */
1522 # ifdef DBL_DIG
1523 #  undef DBL_DIG
1524 # endif
1525 # define DBL_DIG OVR_DBL_DIG
1526 #else
1527 /* The following is all to get DBL_DIG, in order to pick a nice
1528    default value for printing floating point numbers in Gconvert
1529    (see config.h). (It also has other uses, such as figuring out if
1530    a given precision of printing can be done with a double instead of
1531    a long double - Allen).
1532 */
1533 #ifdef I_LIMITS
1534 #include <limits.h>
1535 #endif
1536 #ifdef I_FLOAT
1537 #include <float.h>
1538 #endif
1539 #ifndef HAS_DBL_DIG
1540 #define DBL_DIG 15   /* A guess that works lots of places */
1541 #endif
1542 #endif
1543 #ifdef I_FLOAT
1544 #include <float.h>
1545 #endif
1546 #ifndef HAS_DBL_DIG
1547 #define DBL_DIG 15   /* A guess that works lots of places */
1548 #endif
1549
1550 #ifdef OVR_LDBL_DIG
1551 /* Use an overridden LDBL_DIG */
1552 # ifdef LDBL_DIG
1553 #  undef LDBL_DIG
1554 # endif
1555 # define LDBL_DIG OVR_LDBL_DIG
1556 #else
1557 /* The following is all to get LDBL_DIG, in order to pick a nice
1558    default value for printing floating point numbers in Gconvert.
1559    (see config.h)
1560 */
1561 # ifdef I_LIMITS
1562 #   include <limits.h>
1563 # endif
1564 # ifdef I_FLOAT
1565 #  include <float.h>
1566 # endif
1567 # ifndef HAS_LDBL_DIG
1568 #  if LONG_DOUBLESIZE == 10
1569 #   define LDBL_DIG 18 /* assume IEEE */
1570 #  else
1571 #   if LONG_DOUBLESIZE == 12
1572 #    define LDBL_DIG 18 /* gcc? */
1573 #   else
1574 #    if LONG_DOUBLESIZE == 16
1575 #     define LDBL_DIG 33 /* assume IEEE */
1576 #    else
1577 #     if LONG_DOUBLESIZE == DOUBLESIZE
1578 #      define LDBL_DIG DBL_DIG /* bummer */
1579 #     endif
1580 #    endif
1581 #   endif
1582 #  endif
1583 # endif
1584 #endif
1585
1586 /*
1587  * This is for making sure we have a good DBL_MAX value, if possible,
1588  * either for usage as NV_MAX or for usage in figuring out if we can
1589  * fit a given long double into a double, if bug-fixing makes it
1590  * necessary to do so. - Allen <allens@cpan.org>
1591  */
1592
1593 #ifdef I_LIMITS
1594 #  include <limits.h>
1595 #endif
1596
1597 #ifdef I_VALUES
1598 #  if !(defined(DBL_MIN) && defined(DBL_MAX) && defined(I_LIMITS))
1599 #    include <values.h>
1600 #    if defined(MAXDOUBLE) && !defined(DBL_MAX)
1601 #      define DBL_MAX MAXDOUBLE
1602 #    endif
1603 #    if defined(MINDOUBLE) && !defined(DBL_MIN)
1604 #      define DBL_MIN MINDOUBLE
1605 #    endif
1606 #  endif
1607 #endif /* defined(I_VALUES) */
1608
1609 typedef NVTYPE NV;
1610
1611 #ifdef I_IEEEFP
1612 #   include <ieeefp.h>
1613 #endif
1614
1615 #ifdef USE_LONG_DOUBLE
1616 #   ifdef I_SUNMATH
1617 #       include <sunmath.h>
1618 #   endif
1619 #   define NV_DIG LDBL_DIG
1620 #   ifdef LDBL_MANT_DIG
1621 #       define NV_MANT_DIG LDBL_MANT_DIG
1622 #   endif
1623 #   ifdef LDBL_MIN
1624 #       define NV_MIN LDBL_MIN
1625 #   endif
1626 #   ifdef LDBL_MAX
1627 #       define NV_MAX LDBL_MAX
1628 #   endif
1629 #   ifdef LDBL_MIN_10_EXP
1630 #       define NV_MIN_10_EXP LDBL_MIN_10_EXP
1631 #   endif
1632 #   ifdef LDBL_MAX_10_EXP
1633 #       define NV_MAX_10_EXP LDBL_MAX_10_EXP
1634 #   endif
1635 #   ifdef LDBL_EPSILON
1636 #       define NV_EPSILON LDBL_EPSILON
1637 #   endif
1638 #   ifdef LDBL_MAX
1639 #       define NV_MAX LDBL_MAX
1640 /* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */
1641 #   else
1642 #       ifdef HUGE_VALL
1643 #           define NV_MAX HUGE_VALL
1644 #       else
1645 #           ifdef HUGE_VAL
1646 #               define NV_MAX ((NV)HUGE_VAL)
1647 #           endif
1648 #       endif
1649 #   endif
1650 #   ifdef HAS_SQRTL
1651 #       define Perl_cos cosl
1652 #       define Perl_sin sinl
1653 #       define Perl_sqrt sqrtl
1654 #       define Perl_exp expl
1655 #       define Perl_log logl
1656 #       define Perl_atan2 atan2l
1657 #       define Perl_pow powl
1658 #       define Perl_floor floorl
1659 #       define Perl_ceil ceill
1660 #       define Perl_fmod fmodl
1661 #   endif
1662 /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
1663 #   ifdef HAS_MODFL
1664 #       define Perl_modf(x,y) modfl(x,y)
1665 /* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no
1666    prototype in <math.h> */
1667 #       ifndef HAS_MODFL_PROTO
1668 EXTERN_C long double modfl(long double, long double *);
1669 #       endif
1670 #   else
1671 #       if defined(HAS_AINTL) && defined(HAS_COPYSIGNL)
1672         extern long double Perl_my_modfl(long double x, long double *ip);
1673 #           define Perl_modf(x,y) Perl_my_modfl(x,y)
1674 #       endif
1675 #   endif
1676 #   ifdef HAS_FREXPL
1677 #       define Perl_frexp(x,y) frexpl(x,y)
1678 #   else
1679 #       if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
1680         extern long double Perl_my_frexpl(long double x, int *e);
1681 #           define Perl_frexp(x,y) Perl_my_frexpl(x,y)
1682 #       endif
1683 #   endif
1684 #   ifndef Perl_isnan
1685 #       ifdef HAS_ISNANL
1686 #           define Perl_isnan(x) isnanl(x)
1687 #       endif
1688 #   endif
1689 #   ifndef Perl_isinf
1690 #       ifdef HAS_FINITEL
1691 #           define Perl_isinf(x) !(finitel(x)||Perl_isnan(x))
1692 #       endif
1693 #   endif
1694 #else
1695 #   define NV_DIG DBL_DIG
1696 #   ifdef DBL_MANT_DIG
1697 #       define NV_MANT_DIG DBL_MANT_DIG
1698 #   endif
1699 #   ifdef DBL_MIN
1700 #       define NV_MIN DBL_MIN
1701 #   endif
1702 #   ifdef DBL_MAX
1703 #       define NV_MAX DBL_MAX
1704 #   endif
1705 #   ifdef DBL_MIN_10_EXP
1706 #       define NV_MIN_10_EXP DBL_MIN_10_EXP
1707 #   endif
1708 #   ifdef DBL_MAX_10_EXP
1709 #       define NV_MAX_10_EXP DBL_MAX_10_EXP
1710 #   endif
1711 #   ifdef DBL_EPSILON
1712 #       define NV_EPSILON DBL_EPSILON
1713 #   endif
1714 #   ifdef DBL_MAX               /* XXX Does DBL_MAX imply having DBL_MIN? */
1715 #       define NV_MAX DBL_MAX
1716 #       define NV_MIN DBL_MIN
1717 #   else
1718 #       ifdef HUGE_VAL
1719 #           define NV_MAX HUGE_VAL
1720 #       endif
1721 #   endif
1722 #   define Perl_cos cos
1723 #   define Perl_sin sin
1724 #   define Perl_sqrt sqrt
1725 #   define Perl_exp exp
1726 #   define Perl_log log
1727 #   define Perl_atan2 atan2
1728 #   define Perl_pow pow
1729 #   define Perl_floor floor
1730 #   define Perl_ceil ceil
1731 #   define Perl_fmod fmod
1732 #   define Perl_modf(x,y) modf(x,y)
1733 #   define Perl_frexp(x,y) frexp(x,y)
1734 #endif
1735
1736 /* rumor has it that Win32 has _fpclass() */
1737
1738 /* SGI has fpclassl... but not with the same result values,
1739  * and it's via a typedef (not via #define), so will need to redo Configure
1740  * to use. Not worth the trouble, IMO, at least until the below is used
1741  * more places. Also has fp_class_l, BTW, via fp_class.h. Feel free to check
1742  * with me for the SGI manpages, SGI testing, etcetera, if you want to
1743  * try getting this to work with IRIX. - Allen <allens@cpan.org> */
1744
1745 #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL))
1746 #    ifdef I_IEEFP
1747 #        include <ieeefp.h>
1748 #    endif
1749 #    ifdef I_FP
1750 #        include <fp.h>
1751 #    endif
1752 #    if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL)
1753 #        define Perl_fp_class()         fpclassl(x)
1754 #    else
1755 #        define Perl_fp_class()         fpclass(x)
1756 #    endif
1757 #    define Perl_fp_class_snan(x)       (Perl_fp_class(x)==FP_CLASS_SNAN)
1758 #    define Perl_fp_class_qnan(x)       (Perl_fp_class(x)==FP_CLASS_QNAN)
1759 #    define Perl_fp_class_nan(x)        (Perl_fp_class(x)==FP_CLASS_SNAN||Perl_fp_class(x)==FP_CLASS_QNAN)
1760 #    define Perl_fp_class_ninf(x)       (Perl_fp_class(x)==FP_CLASS_NINF)
1761 #    define Perl_fp_class_pinf(x)       (Perl_fp_class(x)==FP_CLASS_PINF)
1762 #    define Perl_fp_class_inf(x)        (Perl_fp_class(x)==FP_CLASS_NINF||Perl_fp_class(x)==FP_CLASS_PINF)
1763 #    define Perl_fp_class_nnorm(x)      (Perl_fp_class(x)==FP_CLASS_NNORM)
1764 #    define Perl_fp_class_pnorm(x)      (Perl_fp_class(x)==FP_CLASS_PNORM)
1765 #    define Perl_fp_class_norm(x)       (Perl_fp_class(x)==FP_CLASS_NNORM||Perl_fp_class(x)==FP_CLASS_PNORM)
1766 #    define Perl_fp_class_ndenorm(x)    (Perl_fp_class(x)==FP_CLASS_NDENORM)
1767 #    define Perl_fp_class_pdenorm(x)    (Perl_fp_class(x)==FP_CLASS_PDENORM)
1768 #    define Perl_fp_class_denorm(x)     (Perl_fp_class(x)==FP_CLASS_NDENORM||Perl_fp_class(x)==FP_CLASS_PDENORM)
1769 #    define Perl_fp_class_nzero(x)      (Perl_fp_class(x)==FP_CLASS_NZERO)
1770 #    define Perl_fp_class_pzero(x)      (Perl_fp_class(x)==FP_CLASS_PZERO)
1771 #    define Perl_fp_class_zero(x)       (Perl_fp_class(x)==FP_CLASS_NZERO||Perl_fp_class(x)==FP_CLASS_PZERO)
1772 #endif
1773
1774 #if !defined(Perl_fp_class) && defined(HAS_FP_CLASS) && !defined(PERL_MICRO)
1775 #    include <math.h>
1776 #    if !defined(FP_SNAN) && defined(I_FP_CLASS)
1777 #        include <fp_class.h>
1778 #    endif
1779 #    define Perl_fp_class(x)            fp_class(x)
1780 #    define Perl_fp_class_snan(x)       (fp_class(x)==FP_SNAN)
1781 #    define Perl_fp_class_qnan(x)       (fp_class(x)==FP_QNAN)
1782 #    define Perl_fp_class_nan(x)        (fp_class(x)==FP_SNAN||fp_class(x)==FP_QNAN)
1783 #    define Perl_fp_class_ninf(x)       (fp_class(x)==FP_NEG_INF)
1784 #    define Perl_fp_class_pinf(x)       (fp_class(x)==FP_POS_INF)
1785 #    define Perl_fp_class_inf(x)        (fp_class(x)==FP_NEG_INF||fp_class(x)==FP_POS_INF)
1786 #    define Perl_fp_class_nnorm(x)      (fp_class(x)==FP_NEG_NORM)
1787 #    define Perl_fp_class_pnorm(x)      (fp_class(x)==FP_POS_NORM)
1788 #    define Perl_fp_class_norm(x)       (fp_class(x)==FP_NEG_NORM||fp_class(x)==FP_POS_NORM)
1789 #    define Perl_fp_class_ndenorm(x)    (fp_class(x)==FP_NEG_DENORM)
1790 #    define Perl_fp_class_pdenorm(x)    (fp_class(x)==FP_POS_DENORM)
1791 #    define Perl_fp_class_denorm(x)     (fp_class(x)==FP_NEG_DENORM||fp_class(x)==FP_POS_DENORM)
1792 #    define Perl_fp_class_nzero(x)      (fp_class(x)==FP_NEG_ZERO)
1793 #    define Perl_fp_class_pzero(x)      (fp_class(x)==FP_POS_ZERO)
1794 #    define Perl_fp_class_zero(x)       (fp_class(x)==FP_NEG_ZERO||fp_class(x)==FP_POS_ZERO)
1795 #endif
1796
1797 #if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY)
1798 #    include <math.h>
1799 #    define Perl_fp_class(x)            fpclassify(x)
1800 #    define Perl_fp_class_nan(x)        (fp_classify(x)==FP_SNAN||fp_classify(x)==FP_QNAN)
1801 #    define Perl_fp_class_inf(x)        (fp_classify(x)==FP_INFINITE)
1802 #    define Perl_fp_class_norm(x)       (fp_classify(x)==FP_NORMAL)
1803 #    define Perl_fp_class_denorm(x)     (fp_classify(x)==FP_SUBNORMAL)
1804 #    define Perl_fp_class_zero(x)       (fp_classify(x)==FP_ZERO)
1805 #endif
1806
1807 #if !defined(Perl_fp_class) && defined(HAS_CLASS)
1808 #    include <math.h>
1809 #    ifndef _cplusplus
1810 #        define Perl_fp_class(x)        class(x)
1811 #    else
1812 #        define Perl_fp_class(x)        _class(x)
1813 #    endif
1814 #    define Perl_fp_class_snan(x)       (Perl_fp_class(x)==FP_NANS)
1815 #    define Perl_fp_class_qnan(x)       (Perl_fp_class(x)==FP_NANQ)
1816 #    define Perl_fp_class_nan(x)        (Perl_fp_class(x)==FP_SNAN||Perl_fp_class(x)==FP_QNAN)
1817 #    define Perl_fp_class_ninf(x)       (Perl_fp_class(x)==FP_MINUS_INF)
1818 #    define Perl_fp_class_pinf(x)       (Perl_fp_class(x)==FP_PLUS_INF)
1819 #    define Perl_fp_class_inf(x)        (Perl_fp_class(x)==FP_MINUS_INF||Perl_fp_class(x)==FP_PLUS_INF)
1820 #    define Perl_fp_class_nnorm(x)      (Perl_fp_class(x)==FP_MINUS_NORM)
1821 #    define Perl_fp_class_pnorm(x)      (Perl_fp_class(x)==FP_PLUS_NORM)
1822 #    define Perl_fp_class_norm(x)       (Perl_fp_class(x)==FP_MINUS_NORM||Perl_fp_class(x)==FP_PLUS_NORM)
1823 #    define Perl_fp_class_ndenorm(x)    (Perl_fp_class(x)==FP_MINUS_DENORM)
1824 #    define Perl_fp_class_pdenorm(x)    (Perl_fp_class(x)==FP_PLUS_DENORM)
1825 #    define Perl_fp_class_denorm(x)     (Perl_fp_class(x)==FP_MINUS_DENORM||Perl_fp_class(x)==FP_PLUS_DENORM)
1826 #    define Perl_fp_class_nzero(x)      (Perl_fp_class(x)==FP_MINUS_ZERO)
1827 #    define Perl_fp_class_pzero(x)      (Perl_fp_class(x)==FP_PLUS_ZERO)
1828 #    define Perl_fp_class_zero(x)       (Perl_fp_class(x)==FP_MINUS_ZERO||Perl_fp_class(x)==FP_PLUS_ZERO)
1829 #endif
1830
1831 /* rumor has it that Win32 has _isnan() */
1832
1833 #ifndef Perl_isnan
1834 #   ifdef HAS_ISNAN
1835 #       define Perl_isnan(x) isnan((NV)x)
1836 #   else
1837 #       ifdef Perl_fp_class_nan
1838 #           define Perl_isnan(x) Perl_fp_class_nan(x)
1839 #       else
1840 #           ifdef HAS_UNORDERED
1841 #               define Perl_isnan(x) unordered((x), 0.0)
1842 #           else
1843 #               define Perl_isnan(x) ((x)!=(x))
1844 #           endif
1845 #       endif
1846 #   endif
1847 #endif
1848
1849 #ifdef UNDER_CE
1850 int isnan(double d);
1851 #endif
1852
1853 #ifndef Perl_isinf
1854 #   ifdef HAS_ISINF
1855 #       define Perl_isinf(x) isinf((NV)x)
1856 #   else
1857 #       ifdef Perl_fp_class_inf
1858 #           define Perl_isinf(x) Perl_fp_class_inf(x)
1859 #       else
1860 #           define Perl_isinf(x) ((x)==NV_INF)
1861 #       endif
1862 #   endif
1863 #endif
1864
1865 #ifndef Perl_isfinite
1866 #   ifdef HAS_FINITE
1867 #       define Perl_isfinite(x) finite((NV)x)
1868 #   else
1869 #       ifdef HAS_ISFINITE
1870 #           define Perl_isfinite(x) isfinite(x)
1871 #       else
1872 #           ifdef Perl_fp_class_finite
1873 #               define Perl_isfinite(x) Perl_fp_class_finite(x)
1874 #           else
1875 #               define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x))
1876 #           endif
1877 #       endif
1878 #   endif
1879 #endif
1880
1881 /* The default is to use Perl's own atof() implementation (in numeric.c).
1882  * Usually that is the one to use but for some platforms (e.g. UNICOS)
1883  * it is however best to use the native implementation of atof.
1884  * You can experiment with using your native one by -DUSE_PERL_ATOF=0.
1885  * Some good tests to try out with either setting are t/base/num.t,
1886  * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles
1887  * you may need to be using a different function than atof! */
1888
1889 #ifndef USE_PERL_ATOF
1890 #   ifndef _UNICOS
1891 #       define USE_PERL_ATOF
1892 #   endif
1893 #else
1894 #   if USE_PERL_ATOF == 0
1895 #       undef USE_PERL_ATOF
1896 #   endif
1897 #endif
1898
1899 #ifdef USE_PERL_ATOF
1900 #   define Perl_atof(s) Perl_my_atof(s)
1901 #   define Perl_atof2(s, n) Perl_my_atof2(aTHX_ (s), &(n))
1902 #else
1903 #   define Perl_atof(s) (NV)atof(s)
1904 #   define Perl_atof2(s, n) ((n) = atof(s))
1905 #endif
1906
1907 /* Previously these definitions used hardcoded figures.
1908  * It is hoped these formula are more portable, although
1909  * no data one way or another is presently known to me.
1910  * The "PERL_" names are used because these calculated constants
1911  * do not meet the ANSI requirements for LONG_MAX, etc., which
1912  * need to be constants acceptable to #if - kja
1913  *    define PERL_LONG_MAX        2147483647L
1914  *    define PERL_LONG_MIN        (-LONG_MAX - 1)
1915  *    define PERL ULONG_MAX       4294967295L
1916  */
1917
1918 #ifdef I_LIMITS  /* Needed for cast_xxx() functions below. */
1919 #  include <limits.h>
1920 #endif
1921 /* Included values.h above if necessary; still including limits.h down here,
1922  * despite doing above, because math.h might have overriden... XXX - Allen */
1923
1924 /*
1925  * Try to figure out max and min values for the integral types.  THE CORRECT
1926  * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE.  The
1927  * following hacks are used if neither limits.h or values.h provide them:
1928  * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0
1929  *              for types <  int:  (unsigned TYPE)~(unsigned)0
1930  *      The argument to ~ must be unsigned so that later signed->unsigned
1931  *      conversion can't modify the value's bit pattern (e.g. -0 -> +0),
1932  *      and it must not be smaller than int because ~ does integral promotion.
1933  * <type>_MAX: (<type>) (U<type>_MAX >> 1)
1934  * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>.
1935  *      The latter is a hack which happens to work on some machines but
1936  *      does *not* catch any random system, or things like integer types
1937  *      with NaN if that is possible.
1938  *
1939  * All of the types are explicitly cast to prevent accidental loss of
1940  * numeric range, and in the hope that they will be less likely to confuse
1941  * over-eager optimizers.
1942  *
1943  */
1944
1945 #define PERL_UCHAR_MIN ((unsigned char)0)
1946
1947 #ifdef UCHAR_MAX
1948 #  define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
1949 #else
1950 #  ifdef MAXUCHAR
1951 #    define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
1952 #  else
1953 #    define PERL_UCHAR_MAX       ((unsigned char)~(unsigned)0)
1954 #  endif
1955 #endif
1956
1957 /*
1958  * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be
1959  * ambiguous. It may be equivalent to (signed char) or (unsigned char)
1960  * depending on local options. Until Configure detects this (or at least
1961  * detects whether the "signed" keyword is available) the CHAR ranges
1962  * will not be included. UCHAR functions normally.
1963  *                                                           - kja
1964  */
1965
1966 #define PERL_USHORT_MIN ((unsigned short)0)
1967
1968 #ifdef USHORT_MAX
1969 #  define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
1970 #else
1971 #  ifdef MAXUSHORT
1972 #    define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
1973 #  else
1974 #    ifdef USHRT_MAX
1975 #      define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
1976 #    else
1977 #      define PERL_USHORT_MAX       ((unsigned short)~(unsigned)0)
1978 #    endif
1979 #  endif
1980 #endif
1981
1982 #ifdef SHORT_MAX
1983 #  define PERL_SHORT_MAX ((short)SHORT_MAX)
1984 #else
1985 #  ifdef MAXSHORT    /* Often used in <values.h> */
1986 #    define PERL_SHORT_MAX ((short)MAXSHORT)
1987 #  else
1988 #    ifdef SHRT_MAX
1989 #      define PERL_SHORT_MAX ((short)SHRT_MAX)
1990 #    else
1991 #      define PERL_SHORT_MAX      ((short) (PERL_USHORT_MAX >> 1))
1992 #    endif
1993 #  endif
1994 #endif
1995
1996 #ifdef SHORT_MIN
1997 #  define PERL_SHORT_MIN ((short)SHORT_MIN)
1998 #else
1999 #  ifdef MINSHORT
2000 #    define PERL_SHORT_MIN ((short)MINSHORT)
2001 #  else
2002 #    ifdef SHRT_MIN
2003 #      define PERL_SHORT_MIN ((short)SHRT_MIN)
2004 #    else
2005 #      define PERL_SHORT_MIN        (-PERL_SHORT_MAX - ((3 & -1) == 3))
2006 #    endif
2007 #  endif
2008 #endif
2009
2010 #ifdef UINT_MAX
2011 #  define PERL_UINT_MAX ((unsigned int)UINT_MAX)
2012 #else
2013 #  ifdef MAXUINT
2014 #    define PERL_UINT_MAX ((unsigned int)MAXUINT)
2015 #  else
2016 #    define PERL_UINT_MAX       (~(unsigned int)0)
2017 #  endif
2018 #endif
2019
2020 #define PERL_UINT_MIN ((unsigned int)0)
2021
2022 #ifdef INT_MAX
2023 #  define PERL_INT_MAX ((int)INT_MAX)
2024 #else
2025 #  ifdef MAXINT    /* Often used in <values.h> */
2026 #    define PERL_INT_MAX ((int)MAXINT)
2027 #  else
2028 #    define PERL_INT_MAX        ((int)(PERL_UINT_MAX >> 1))
2029 #  endif
2030 #endif
2031
2032 #ifdef INT_MIN
2033 #  define PERL_INT_MIN ((int)INT_MIN)
2034 #else
2035 #  ifdef MININT
2036 #    define PERL_INT_MIN ((int)MININT)
2037 #  else
2038 #    define PERL_INT_MIN        (-PERL_INT_MAX - ((3 & -1) == 3))
2039 #  endif
2040 #endif
2041
2042 #ifdef ULONG_MAX
2043 #  define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
2044 #else
2045 #  ifdef MAXULONG
2046 #    define PERL_ULONG_MAX ((unsigned long)MAXULONG)
2047 #  else
2048 #    define PERL_ULONG_MAX       (~(unsigned long)0)
2049 #  endif
2050 #endif
2051
2052 #define PERL_ULONG_MIN ((unsigned long)0L)
2053
2054 #ifdef LONG_MAX
2055 #  define PERL_LONG_MAX ((long)LONG_MAX)
2056 #else
2057 #  ifdef MAXLONG    /* Often used in <values.h> */
2058 #    define PERL_LONG_MAX ((long)MAXLONG)
2059 #  else
2060 #    define PERL_LONG_MAX        ((long) (PERL_ULONG_MAX >> 1))
2061 #  endif
2062 #endif
2063
2064 #ifdef LONG_MIN
2065 #  define PERL_LONG_MIN ((long)LONG_MIN)
2066 #else
2067 #  ifdef MINLONG
2068 #    define PERL_LONG_MIN ((long)MINLONG)
2069 #  else
2070 #    define PERL_LONG_MIN        (-PERL_LONG_MAX - ((3 & -1) == 3))
2071 #  endif
2072 #endif
2073
2074 #ifdef UV_IS_QUAD
2075
2076 #    define PERL_UQUAD_MAX      (~(UV)0)
2077 #    define PERL_UQUAD_MIN      ((UV)0)
2078 #    define PERL_QUAD_MAX       ((IV) (PERL_UQUAD_MAX >> 1))
2079 #    define PERL_QUAD_MIN       (-PERL_QUAD_MAX - ((3 & -1) == 3))
2080
2081 #endif
2082
2083 #ifdef MYMALLOC
2084 #  include "malloc_ctl.h"
2085 #endif
2086
2087 struct RExC_state_t;
2088
2089 typedef MEM_SIZE STRLEN;
2090
2091 typedef struct op OP;
2092 typedef struct cop COP;
2093 typedef struct unop UNOP;
2094 typedef struct binop BINOP;
2095 typedef struct listop LISTOP;
2096 typedef struct logop LOGOP;
2097 typedef struct pmop PMOP;
2098 typedef struct svop SVOP;
2099 typedef struct padop PADOP;
2100 typedef struct pvop PVOP;
2101 typedef struct loop LOOP;
2102
2103 typedef struct interpreter PerlInterpreter;
2104
2105 /* Amdahl's <ksync.h> has struct sv */
2106 /* SGI's <sys/sema.h> has struct sv */
2107 #if defined(UTS) || defined(__sgi)
2108 #   define STRUCT_SV perl_sv
2109 #else
2110 #   define STRUCT_SV sv
2111 #endif
2112 typedef struct STRUCT_SV SV;
2113 typedef struct av AV;
2114 typedef struct hv HV;
2115 typedef struct cv CV;
2116 typedef struct regexp REGEXP;
2117 typedef struct gp GP;
2118 typedef struct gv GV;
2119 typedef struct io IO;
2120 typedef struct context PERL_CONTEXT;
2121 typedef struct block BLOCK;
2122
2123 typedef struct magic MAGIC;
2124 typedef struct xpv XPV;
2125 typedef struct xpviv XPVIV;
2126 typedef struct xpvuv XPVUV;
2127 typedef struct xpvnv XPVNV;
2128 typedef struct xpvmg XPVMG;
2129 typedef struct xpvlv XPVLV;
2130 typedef struct xpvav XPVAV;
2131 typedef struct xpvhv XPVHV;
2132 typedef struct xpvgv XPVGV;
2133 typedef struct xpvcv XPVCV;
2134 typedef struct xpvbm XPVBM;
2135 typedef struct xpvfm XPVFM;
2136 typedef struct xpvio XPVIO;
2137 typedef struct mgvtbl MGVTBL;
2138 typedef union any ANY;
2139 typedef struct ptr_tbl_ent PTR_TBL_ENT_t;
2140 typedef struct ptr_tbl PTR_TBL_t;
2141 typedef struct clone_params CLONE_PARAMS;
2142
2143 #include "handy.h"
2144
2145 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
2146 #   if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO)
2147 #       define USE_64_BIT_RAWIO /* implicit */
2148 #   endif
2149 #endif
2150
2151 /* Notice the use of HAS_FSEEKO: now we are obligated to always use
2152  * fseeko/ftello if possible.  Don't go #defining ftell to ftello yourself,
2153  * however, because operating systems like to do that themself. */
2154 #ifndef FSEEKSIZE
2155 #   ifdef HAS_FSEEKO
2156 #       define FSEEKSIZE LSEEKSIZE
2157 #   else
2158 #       define FSEEKSIZE LONGSIZE
2159 #   endif
2160 #endif
2161
2162 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO)
2163 #   if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO)
2164 #       define USE_64_BIT_STDIO /* implicit */
2165 #   endif
2166 #endif
2167
2168 #ifdef USE_64_BIT_RAWIO
2169 #   ifdef HAS_OFF64_T
2170 #       undef Off_t
2171 #       define Off_t off64_t
2172 #       undef LSEEKSIZE
2173 #       define LSEEKSIZE 8
2174 #   endif
2175 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that
2176  * will trigger defines like the ones below.  Some 64-bit environments,
2177  * however, do not.  Therefore we have to explicitly mix and match. */
2178 #   if defined(USE_OPEN64)
2179 #       define open open64
2180 #   endif
2181 #   if defined(USE_LSEEK64)
2182 #       define lseek lseek64
2183 #   else
2184 #       if defined(USE_LLSEEK)
2185 #           define lseek llseek
2186 #       endif
2187 #   endif
2188 #   if defined(USE_STAT64)
2189 #       define stat stat64
2190 #   endif
2191 #   if defined(USE_FSTAT64)
2192 #       define fstat fstat64
2193 #   endif
2194 #   if defined(USE_LSTAT64)
2195 #       define lstat lstat64
2196 #   endif
2197 #   if defined(USE_FLOCK64)
2198 #       define flock flock64
2199 #   endif
2200 #   if defined(USE_LOCKF64)
2201 #       define lockf lockf64
2202 #   endif
2203 #   if defined(USE_FCNTL64)
2204 #       define fcntl fcntl64
2205 #   endif
2206 #   if defined(USE_TRUNCATE64)
2207 #       define truncate truncate64
2208 #   endif
2209 #   if defined(USE_FTRUNCATE64)
2210 #       define ftruncate ftruncate64
2211 #   endif
2212 #endif
2213
2214 #ifdef USE_64_BIT_STDIO
2215 #   ifdef HAS_FPOS64_T
2216 #       undef Fpos_t
2217 #       define Fpos_t fpos64_t
2218 #   endif
2219 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that
2220  * will trigger defines like the ones below.  Some 64-bit environments,
2221  * however, do not. */
2222 #   if defined(USE_FOPEN64)
2223 #       define fopen fopen64
2224 #   endif
2225 #   if defined(USE_FSEEK64)
2226 #       define fseek fseek64 /* don't do fseeko here, see perlio.c */
2227 #   endif
2228 #   if defined(USE_FTELL64)
2229 #       define ftell ftell64 /* don't do ftello here, see perlio.c */
2230 #   endif
2231 #   if defined(USE_FSETPOS64)
2232 #       define fsetpos fsetpos64
2233 #   endif
2234 #   if defined(USE_FGETPOS64)
2235 #       define fgetpos fgetpos64
2236 #   endif
2237 #   if defined(USE_TMPFILE64)
2238 #       define tmpfile tmpfile64
2239 #   endif
2240 #   if defined(USE_FREOPEN64)
2241 #       define freopen freopen64
2242 #   endif
2243 #endif
2244
2245 #if defined(OS2) || defined(MACOS_TRADITIONAL)
2246 #  include "iperlsys.h"
2247 #endif
2248
2249 #if defined(__OPEN_VM)
2250 #   include "vmesa/vmesaish.h"
2251 #   define ISHISH "vmesa"
2252 #endif
2253
2254 #ifdef DOSISH
2255 #   if defined(OS2)
2256 #       include "os2ish.h"
2257 #   else
2258 #       include "dosish.h"
2259 #   endif
2260 #   define ISHISH "dos"
2261 #endif
2262
2263 #if defined(VMS)
2264 #   include "vmsish.h"
2265 #   include "embed.h"
2266 #   define ISHISH "vms"
2267 #endif
2268
2269 #if defined(PLAN9)
2270 #   include "./plan9/plan9ish.h"
2271 #   define ISHISH "plan9"
2272 #endif
2273
2274 #if defined(MPE)
2275 #  include "mpeix/mpeixish.h"
2276 #  define ISHISH "mpeix"
2277 #endif
2278
2279 #if defined(__VOS__)
2280 #   ifdef __GNUC__
2281 #     include "./vos/vosish.h"
2282 #   else
2283 #     include "vos/vosish.h"
2284 #   endif
2285 #   define ISHISH "vos"
2286 #endif
2287
2288 #if defined(EPOC)
2289 #   include "epocish.h"
2290 #   define ISHISH "epoc"
2291 #endif
2292
2293 #ifdef SYMBIAN
2294 #   include "symbian/symbianish.h"
2295 #   include "embed.h"
2296 #   define ISHISH "symbian"
2297 #endif
2298
2299 #if defined(MACOS_TRADITIONAL)
2300 #   include "macos/macish.h"
2301 #   ifndef NO_ENVIRON_ARRAY
2302 #       define NO_ENVIRON_ARRAY
2303 #   endif
2304 #   define ISHISH "macos classic"
2305 #endif
2306
2307 #if defined(__BEOS__)
2308 #   include "beos/beosish.h"
2309 #   define ISHISH "beos"
2310 #endif
2311
2312 #ifndef ISHISH
2313 #   include "unixish.h"
2314 #   define ISHISH "unix"
2315 #endif
2316
2317 #ifndef NO_ENVIRON_ARRAY
2318 #  define USE_ENVIRON_ARRAY
2319 #endif
2320
2321 /*
2322  * initialise to avoid floating-point exceptions from overflow, etc
2323  */
2324 #ifndef PERL_FPU_INIT
2325 #  ifdef HAS_FPSETMASK
2326 #    if HAS_FLOATINGPOINT_H
2327 #      include <floatingpoint.h>
2328 #    endif
2329 #    define PERL_FPU_INIT fpsetmask(0);
2330 #  else
2331 #    if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
2332 #      define PERL_FPU_INIT       PL_sigfpe_saved = signal(SIGFPE, SIG_IGN);
2333 #      define PERL_FPU_PRE_EXEC   { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
2334 #      define PERL_FPU_POST_EXEC    rsignal_restore(SIGFPE, &xfpe); }
2335 #    else
2336 #      define PERL_FPU_INIT
2337
2338 #    endif
2339 #  endif
2340 #endif
2341 #ifndef PERL_FPU_PRE_EXEC
2342 #  define PERL_FPU_PRE_EXEC   {
2343 #  define PERL_FPU_POST_EXEC  }
2344 #endif
2345
2346 #ifndef PERL_SYS_INIT3
2347 #  define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
2348 #endif
2349
2350 #ifndef PERL_WRITE_MSG_TO_CONSOLE
2351 #  define PERL_WRITE_MSG_TO_CONSOLE(io, msg, len) PerlIO_write(io, msg, len)
2352 #endif
2353
2354 #ifndef MAXPATHLEN
2355 #  ifdef PATH_MAX
2356 #    ifdef _POSIX_PATH_MAX
2357 #       if PATH_MAX > _POSIX_PATH_MAX
2358 /* POSIX 1990 (and pre) was ambiguous about whether PATH_MAX
2359  * included the null byte or not.  Later amendments of POSIX,
2360  * XPG4, the Austin Group, and the Single UNIX Specification
2361  * all explicitly include the null byte in the PATH_MAX.
2362  * Ditto for _POSIX_PATH_MAX. */
2363 #         define MAXPATHLEN PATH_MAX
2364 #       else
2365 #         define MAXPATHLEN _POSIX_PATH_MAX
2366 #       endif
2367 #    else
2368 #      define MAXPATHLEN (PATH_MAX+1)
2369 #    endif
2370 #  else
2371 #    ifdef _POSIX_PATH_MAX
2372 #       define MAXPATHLEN _POSIX_PATH_MAX
2373 #    else
2374 #       define MAXPATHLEN 1024  /* Err on the large side. */
2375 #    endif
2376 #  endif
2377 #endif
2378
2379 /* USE_5005THREADS needs to be after unixish.h as <pthread.h> includes
2380  * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
2381  * this results in many functions being undeclared which bothers C++
2382  * May make sense to have threads after "*ish.h" anyway
2383  */
2384
2385 #if defined(USE_ITHREADS)
2386 #  ifdef NETWARE
2387 #   include <nw5thread.h>
2388 #  else
2389 #  ifdef FAKE_THREADS
2390 #    include "fakethr.h"
2391 #  else
2392 #    ifdef WIN32
2393 #      include <win32thread.h>
2394 #    else
2395 #      ifdef OS2
2396 #        include "os2thread.h"
2397 #      else
2398 #        ifdef I_MACH_CTHREADS
2399 #          include <mach/cthreads.h>
2400 #          if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC)
2401 #            define MUTEX_INIT_CALLS_MALLOC
2402 #          endif
2403 typedef cthread_t       perl_os_thread;
2404 typedef mutex_t         perl_mutex;
2405 typedef condition_t     perl_cond;
2406 typedef void *          perl_key;
2407 #        else /* Posix threads */
2408 #          ifdef I_PTHREAD
2409 #            include <pthread.h>
2410 #          endif
2411 typedef pthread_t       perl_os_thread;
2412 typedef pthread_mutex_t perl_mutex;
2413 typedef pthread_cond_t  perl_cond;
2414 typedef pthread_key_t   perl_key;
2415 #        endif /* I_MACH_CTHREADS */
2416 #      endif /* OS2 */
2417 #    endif /* WIN32 */
2418 #  endif /* FAKE_THREADS */
2419 #endif  /* NETWARE */
2420 #endif /* USE_ITHREADS */
2421
2422 #if defined(WIN32)
2423 #  include "win32.h"
2424 #endif
2425
2426 #ifdef NETWARE
2427 #  include "netware.h"
2428 #endif
2429
2430 #define STATUS_UNIX     PL_statusvalue
2431 #ifdef VMS
2432 #   define STATUS_NATIVE        PL_statusvalue_vms
2433 #   define STATUS_NATIVE_EXPORT \
2434         (((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) | (VMSISH_HUSHED ? 0x10000000 : 0))
2435 #   define STATUS_NATIVE_SET(n)                                         \
2436         STMT_START {                                                    \
2437             PL_statusvalue_vms = (n);                                   \
2438             if ((I32)PL_statusvalue_vms == -1)                          \
2439                 PL_statusvalue = -1;                                    \
2440             else if (PL_statusvalue_vms & STS$M_SUCCESS)                \
2441                 PL_statusvalue = 0;                                     \
2442             else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0)        \
2443                 PL_statusvalue = 1 << 8;                                \
2444             else                                                        \
2445                 PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8;    \
2446         } STMT_END
2447 #   ifdef VMSISH_STATUS
2448 #       define STATUS_CURRENT   (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX)
2449 #   else
2450 #       define STATUS_CURRENT   STATUS_UNIX
2451 #   endif
2452 #   define STATUS_UNIX_SET(n)                           \
2453         STMT_START {                                    \
2454             PL_statusvalue = (n);                               \
2455             if (PL_statusvalue != -1) {                 \
2456                 PL_statusvalue &= 0xFFFF;                       \
2457                 PL_statusvalue_vms = PL_statusvalue ? 44 : 1;   \
2458             }                                           \
2459             else PL_statusvalue_vms = -1;                       \
2460         } STMT_END
2461 #   define STATUS_ALL_SUCCESS   (PL_statusvalue = 0, PL_statusvalue_vms = 1)
2462 #   define STATUS_ALL_FAILURE   (PL_statusvalue = 1, PL_statusvalue_vms = 44)
2463 #else
2464 #   define STATUS_NATIVE        PL_statusvalue_posix
2465 #   define STATUS_NATIVE_EXPORT STATUS_NATIVE
2466 #   if defined(WCOREDUMP)
2467 #       define STATUS_NATIVE_SET(n)                        \
2468             STMT_START {                                   \
2469                 PL_statusvalue_posix = (n);                \
2470                 if (PL_statusvalue_posix == -1)            \
2471                     PL_statusvalue = -1;                   \
2472                 else {                                     \
2473                     PL_statusvalue =                       \
2474                         (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) |  \
2475                         (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0) | \
2476                         (WIFSIGNALED(PL_statusvalue_posix) && WCOREDUMP(PL_statusvalue_posix) ? 0x80 : 0);  \
2477                 }                                          \
2478             } STMT_END
2479 #   elif defined(WIFEXITED)
2480 #       define STATUS_NATIVE_SET(n)                        \
2481             STMT_START {                                   \
2482                 PL_statusvalue_posix = (n);                \
2483                 if (PL_statusvalue_posix == -1)            \
2484                     PL_statusvalue = -1;                   \
2485                 else {                                     \
2486                     PL_statusvalue =                       \
2487                         (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) |  \
2488                         (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0);  \
2489                 }                                          \
2490             } STMT_END
2491 #   else
2492 #       define STATUS_NATIVE_SET(n)                        \
2493             STMT_START {                                   \
2494                 PL_statusvalue_posix = (n);                \
2495                 if (PL_statusvalue_posix == -1)            \
2496                     PL_statusvalue = -1;                   \
2497                 else {                                     \
2498                     PL_statusvalue =                       \
2499                         PL_statusvalue_posix & 0xFFFF;     \
2500                 }                                          \
2501             } STMT_END
2502 #   endif
2503 #   define STATUS_UNIX_SET(n)           \
2504         STMT_START {                    \
2505             PL_statusvalue = (n);               \
2506             PL_statusvalue_posix = PL_statusvalue;       \
2507             if (PL_statusvalue != -1)   \
2508                 PL_statusvalue &= 0xFFFF;       \
2509         } STMT_END
2510 #   define STATUS_CURRENT STATUS_UNIX
2511 #   define STATUS_ALL_SUCCESS   (PL_statusvalue = 0, PL_statusvalue_posix = 0)
2512 #   define STATUS_ALL_FAILURE   (PL_statusvalue = 1, PL_statusvalue_posix = 1)
2513 #endif
2514
2515 /* flags in PL_exit_flags for nature of exit() */
2516 #define PERL_EXIT_EXPECTED      0x01
2517 #define PERL_EXIT_DESTRUCT_END  0x02  /* Run END in perl_destruct */
2518
2519 #ifndef MEMBER_TO_FPTR
2520 #  define MEMBER_TO_FPTR(name)          name
2521 #endif
2522
2523 /* format to use for version numbers in file/directory names */
2524 /* XXX move to Configure? */
2525 #ifndef PERL_FS_VER_FMT
2526 #  define PERL_FS_VER_FMT       "%d.%d.%d"
2527 #endif
2528
2529 /* This defines a way to flush all output buffers.  This may be a
2530  * performance issue, so we allow people to disable it.  Also, if
2531  * we are using stdio, there are broken implementations of fflush(NULL)
2532  * out there, Solaris being the most prominent.
2533  */
2534 #ifndef PERL_FLUSHALL_FOR_CHILD
2535 # if defined(USE_PERLIO) || defined(FFLUSH_NULL) || defined(USE_SFIO)
2536 #  define PERL_FLUSHALL_FOR_CHILD       PerlIO_flush((PerlIO*)NULL)
2537 # else
2538 #  ifdef FFLUSH_ALL
2539 #   define PERL_FLUSHALL_FOR_CHILD      my_fflush_all()
2540 #  else
2541 #   define PERL_FLUSHALL_FOR_CHILD      NOOP
2542 #  endif
2543 # endif
2544 #endif
2545
2546 #ifndef PERL_WAIT_FOR_CHILDREN
2547 #  define PERL_WAIT_FOR_CHILDREN        NOOP
2548 #endif
2549
2550 /* the traditional thread-unsafe notion of "current interpreter". */
2551 #ifndef PERL_SET_INTERP
2552 #  define PERL_SET_INTERP(i)            (PL_curinterp = (PerlInterpreter*)(i))
2553 #endif
2554
2555 #ifndef PERL_GET_INTERP
2556 #  define PERL_GET_INTERP               (PL_curinterp)
2557 #endif
2558
2559 #if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
2560 #  ifdef MULTIPLICITY
2561 #    define PERL_GET_THX                ((PerlInterpreter *)PERL_GET_CONTEXT)
2562 #  endif
2563 #  define PERL_SET_THX(t)               PERL_SET_CONTEXT(t)
2564 #endif
2565
2566 /*  This replaces the previous %_ "hack" by the "%-p" hack
2567     All that is required is that the perl source does not
2568     use "%-p" or "%-<number>p" format.  These format will
2569     still work in perl code.   RMB 2005/05/17
2570 */
2571 #ifndef SVf
2572 #  define SVf "-p"
2573 #endif
2574
2575 #ifndef SVf_precision
2576 #  define SVf_precision(n) "-" n "p"
2577 #endif
2578
2579 #ifndef SVf32
2580 #  define SVf32 SVf_precision("32")
2581 #endif
2582
2583 #ifndef SVf256
2584 #  define SVf256 SVf_precision("256")
2585 #endif
2586  
2587 #ifndef UVf
2588 #  define UVf UVuf
2589 #endif
2590
2591 #ifndef DieNull
2592 #  define DieNull Perl_vdie(aTHX_ Nullch, Null(va_list *))
2593 #endif
2594
2595 /* In case Configure was not used (we are using a "canned config"
2596  * such as Win32, or a cross-compilation setup, for example) try going
2597  * by the gcc major and minor versions.  One useful URL is
2598  * http://www.ohse.de/uwe/articles/gcc-attributes.html,
2599  * but contrary to this information warn_unused_result seems
2600  * not to be in gcc 3.3.5, at least. --jhi */
2601 #if defined __GNUC__
2602 #  if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
2603 #    define HASATTRIBUTE_FORMAT
2604 #  endif
2605 #  if __GNUC__ >= 3 /* 3.0 -> */
2606 #    define HASATTRIBUTE_MALLOC
2607 #  endif
2608 #  if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */
2609 #    define HASATTRIBUTE_NONNULL
2610 #  endif
2611 #  if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */
2612 #    define HASATTRIBUTE_NORETURN
2613 #  endif
2614 #  if __GNUC__ >= 3 /* gcc 3.0 -> */
2615 #    define HASATTRIBUTE_PURE
2616 #  endif
2617 #  if __GNUC__ >= 3 /* gcc 3.0 -> */ /* XXX Verify this version */
2618 #    define HASATTRIBUTE_UNUSED
2619 #  endif
2620 #  if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
2621 #    define HASATTRIBUTE_WARN_UNUSED_RESULT
2622 #  endif
2623 #endif
2624
2625
2626 #ifdef HASATTRIBUTE_FORMAT
2627 #  define __attribute__format__(x,y,z)      __attribute__((format(x,y,z)))
2628 #endif
2629 #ifdef HASATTRIBUTE_MALLOC
2630 #  define __attribute__malloc__             __attribute__((malloc))
2631 #endif
2632 #ifdef HASATTRIBUTE_NONNULL
2633 #  define __attribute__nonnull__(a)         __attribute__((nonnull(a)))
2634 #endif
2635 #ifdef HASATTRIBUTE_NORETURN
2636 #  define __attribute__noreturn__           __attribute__((noreturn))
2637 #endif
2638 #ifdef HASATTRIBUTE_PURE
2639 #  define __attribute__pure__               __attribute__((pure))
2640 #endif
2641 #ifdef HASATTRIBUTE_UNUSED
2642 #  define __attribute__unused__             __attribute__((unused))
2643 #endif
2644 #ifdef HASATTRIBUTE_WARN_UNUSED_RESULT
2645 #  define __attribute__warn_unused_result__ __attribute__((warn_unused_result))
2646 #endif
2647
2648 /* If we haven't defined the attributes yet, define them to blank. */
2649 #ifndef __attribute__format__
2650 #  define __attribute__format__(x,y,z)
2651 #endif
2652 #ifndef __attribute__malloc__
2653 #  define __attribute__malloc__
2654 #endif
2655 #ifndef __attribute__nonnull__
2656 #  define __attribute__nonnull__(a)
2657 #endif
2658 #ifndef __attribute__noreturn__
2659 #  define __attribute__noreturn__
2660 #endif
2661 #ifndef __attribute__pure__
2662 #  define __attribute__pure__
2663 #endif
2664 #ifndef __attribute__unused__
2665 #  define __attribute__unused__
2666 #endif
2667 #ifndef __attribute__warn_unused_result__
2668 #  define __attribute__warn_unused_result__
2669 #endif
2670
2671 /* For functions that are marked as __attribute__noreturn__, it's not
2672    appropriate to call return.  In either case, include the lint directive.
2673  */
2674 #ifdef HASATTRIBUTE_NORETURN
2675 #  define NORETURN_FUNCTION_END /* NOT REACHED */
2676 #else
2677 #  define NORETURN_FUNCTION_END /* NOT REACHED */ return 0
2678 #endif
2679
2680 /* Some unistd.h's give a prototype for pause() even though
2681    HAS_PAUSE ends up undefined.  This causes the #define
2682    below to be rejected by the compiler.  Sigh.
2683 */
2684 #ifdef HAS_PAUSE
2685 #define Pause   pause
2686 #else
2687 #define Pause() sleep((32767<<16)+32767)
2688 #endif
2689
2690 #ifndef IOCPARM_LEN
2691 #   ifdef IOCPARM_MASK
2692         /* on BSDish systes we're safe */
2693 #       define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
2694 #   else
2695         /* otherwise guess at what's safe */
2696 #       define IOCPARM_LEN(x)   256
2697 #   endif
2698 #endif
2699
2700 #if defined(__CYGWIN__)
2701 /* USEMYBINMODE
2702  *   This symbol, if defined, indicates that the program should
2703  *   use the routine my_binmode(FILE *fp, char iotype, int mode) to insure
2704  *   that a file is in "binary" mode -- that is, that no translation
2705  *   of bytes occurs on read or write operations.
2706  */
2707 #  define USEMYBINMODE /**/
2708 #  include <io.h> /* for setmode() prototype */
2709 #  define my_binmode(fp, iotype, mode) \
2710             (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE)
2711 #endif
2712
2713 #ifdef __CYGWIN__
2714 void init_os_extras(void);
2715 #endif
2716
2717 #ifdef UNION_ANY_DEFINITION
2718 UNION_ANY_DEFINITION;
2719 #else
2720 union any {
2721     void*       any_ptr;
2722     I32         any_i32;
2723     IV          any_iv;
2724     long        any_long;
2725     bool        any_bool;
2726     void        (*any_dptr) (void*);
2727     void        (*any_dxptr) (pTHX_ void*);
2728 };
2729 #endif
2730
2731 typedef I32 (*filter_t) (pTHX_ int, SV *, int);
2732
2733 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
2734 #define FILTER_DATA(idx)           (AvARRAY(PL_rsfp_filters)[idx])
2735 #define FILTER_ISREADER(idx)       (idx >= AvFILLp(PL_rsfp_filters))
2736
2737 #if defined(_AIX) && !defined(_AIX43)
2738 #if defined(USE_REENTRANT) || defined(_REENTRANT) || defined(_THREAD_SAFE)
2739 /* We cannot include <crypt.h> to get the struct crypt_data
2740  * because of setkey prototype problems when threading */
2741 typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
2742     /* From OSF, Not needed in AIX
2743        char C[28], D[28];
2744     */
2745     char E[48];
2746     char KS[16][48];
2747     char block[66];
2748     char iobuf[16];
2749 } CRYPTD;
2750 #endif /* threading */
2751 #endif /* AIX */
2752
2753 #if !defined(OS2) && !defined(MACOS_TRADITIONAL)
2754 #  include "iperlsys.h"
2755 #endif
2756
2757 /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0.
2758  * Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT*
2759  * defined by Configure, despite their names being similar to the
2760  * other defines like USE_ITHREADS.  Configure in fact knows nothing
2761  * about the randomised hashes.  Therefore to enable/disable the hash
2762  * randomisation defines use the Configure -Accflags=... instead. */
2763 #if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT)
2764 #  define USE_HASH_SEED
2765 #endif
2766
2767 #include "regexp.h"
2768 #include "sv.h"
2769 #include "util.h"
2770 #include "form.h"
2771 #include "gv.h"
2772 #include "pad.h"
2773 #include "cv.h"
2774 #include "opnames.h"
2775 #include "op.h"
2776 #include "cop.h"
2777 #include "av.h"
2778 #include "hv.h"
2779 #include "mg.h"
2780 #include "scope.h"
2781 #include "warnings.h"
2782 #include "utf8.h"
2783
2784 /* Current curly descriptor */
2785 typedef struct curcur CURCUR;
2786 struct curcur {
2787     int         parenfloor;     /* how far back to strip paren data */
2788     int         cur;            /* how many instances of scan we've matched */
2789     int         min;            /* the minimal number of scans to match */
2790     int         max;            /* the maximal number of scans to match */
2791     int         minmod;         /* whether to work our way up or down */
2792     regnode *   scan;           /* the thing to match */
2793     regnode *   next;           /* what has to match after it */
2794     char *      lastloc;        /* where we started matching this scan */
2795     CURCUR *    oldcc;          /* current curly before we started this one */
2796 };
2797
2798 typedef struct _sublex_info SUBLEXINFO;
2799 struct _sublex_info {
2800     I32 super_state;    /* lexer state to save */
2801     I32 sub_inwhat;     /* "lex_inwhat" to use */
2802     OP *sub_op;         /* "lex_op" to use */
2803     char *super_bufptr; /* PL_bufptr that was */
2804     char *super_bufend; /* PL_bufend that was */
2805 };
2806
2807 typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
2808
2809 struct scan_data_t;             /* Used in S_* functions in regcomp.c */
2810 struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */
2811
2812 typedef I32 CHECKPOINT;
2813
2814 struct ptr_tbl_ent {
2815     struct ptr_tbl_ent*         next;
2816     void*                       oldval;
2817     void*                       newval;
2818 };
2819
2820 struct ptr_tbl {
2821     struct ptr_tbl_ent**        tbl_ary;
2822     UV                          tbl_max;
2823     UV                          tbl_items;
2824 };
2825
2826 #if defined(iAPX286) || defined(M_I286) || defined(I80286)
2827 #   define I286
2828 #endif
2829
2830 #if defined(htonl) && !defined(HAS_HTONL)
2831 #define HAS_HTONL
2832 #endif
2833 #if defined(htons) && !defined(HAS_HTONS)
2834 #define HAS_HTONS
2835 #endif
2836 #if defined(ntohl) && !defined(HAS_NTOHL)
2837 #define HAS_NTOHL
2838 #endif
2839 #if defined(ntohs) && !defined(HAS_NTOHS)
2840 #define HAS_NTOHS
2841 #endif
2842 #ifndef HAS_HTONL
2843 #if (BYTEORDER & 0xffff) != 0x4321
2844 #define HAS_HTONS
2845 #define HAS_HTONL
2846 #define HAS_NTOHS
2847 #define HAS_NTOHL
2848 #define MYSWAP
2849 #define htons my_swap
2850 #define htonl my_htonl
2851 #define ntohs my_swap
2852 #define ntohl my_ntohl
2853 #endif
2854 #else
2855 #if (BYTEORDER & 0xffff) == 0x4321
2856 #undef HAS_HTONS
2857 #undef HAS_HTONL
2858 #undef HAS_NTOHS
2859 #undef HAS_NTOHL
2860 #endif
2861 #endif
2862
2863 /*
2864  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
2865  * -DWS
2866  */
2867 #if BYTEORDER != 0x1234
2868 # define HAS_VTOHL
2869 # define HAS_VTOHS
2870 # define HAS_HTOVL
2871 # define HAS_HTOVS
2872 # if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
2873 #  define vtohl(x)      ((((x)&0xFF)<<24)       \
2874                         +(((x)>>24)&0xFF)       \
2875                         +(((x)&0x0000FF00)<<8)  \
2876                         +(((x)&0x00FF0000)>>8)  )
2877 #  define vtohs(x)      ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
2878 #  define htovl(x)      vtohl(x)
2879 #  define htovs(x)      vtohs(x)
2880 # endif
2881         /* otherwise default to functions in util.c */
2882 #ifndef htovs
2883 short htovs(short n);
2884 short vtohs(short n);
2885 long htovl(long n);
2886 long vtohl(long n);
2887 #endif
2888 #endif
2889
2890 /* *MAX Plus 1. A floating point value.
2891    Hopefully expressed in a way that dodgy floating point can't mess up.
2892    >> 2 rather than 1, so that value is safely less than I32_MAX after 1
2893    is added to it
2894    May find that some broken compiler will want the value cast to I32.
2895    [after the shift, as signed >> may not be as secure as unsigned >>]
2896 */
2897 #define I32_MAX_P1 (2.0 * (1 + (((U32)I32_MAX) >> 1)))
2898 #define U32_MAX_P1 (4.0 * (1 + ((U32_MAX) >> 2)))
2899 /* For compilers that can't correctly cast NVs over 0x7FFFFFFF (or
2900    0x7FFFFFFFFFFFFFFF) to an unsigned integer. In the future, sizeof(UV)
2901    may be greater than sizeof(IV), so don't assume that half max UV is max IV.
2902 */
2903 #define U32_MAX_P1_HALF (2.0 * (1 + ((U32_MAX) >> 2)))
2904
2905 #define UV_MAX_P1 (4.0 * (1 + ((UV_MAX) >> 2)))
2906 #define IV_MAX_P1 (2.0 * (1 + (((UV)IV_MAX) >> 1)))
2907 #define UV_MAX_P1_HALF (2.0 * (1 + ((UV_MAX) >> 2)))
2908
2909 /* This may look like unnecessary jumping through hoops, but converting
2910    out of range floating point values to integers *is* undefined behaviour,
2911    and it is starting to bite.
2912 */
2913 #ifndef CAST_INLINE
2914 #define I_32(what) (cast_i32((NV)(what)))
2915 #define U_32(what) (cast_ulong((NV)(what)))
2916 #define I_V(what) (cast_iv((NV)(what)))
2917 #define U_V(what) (cast_uv((NV)(what)))
2918 #else
2919 #define I_32(n) ((n) < I32_MAX_P1 ? ((n) < I32_MIN ? I32_MIN : (I32) (n)) \
2920                   : ((n) < U32_MAX_P1 ? (I32)(U32) (n) \
2921                      : ((n) > 0 ? (I32) U32_MAX : 0 /* NaN */)))
2922 #define U_32(n) ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \
2923                   : ((n) < U32_MAX_P1 ? (U32) (n) \
2924                      : ((n) > 0 ? U32_MAX : 0 /* NaN */)))
2925 #define I_V(n) ((n) < IV_MAX_P1 ? ((n) < IV_MIN ? IV_MIN : (IV) (n)) \
2926                   : ((n) < UV_MAX_P1 ? (IV)(UV) (n) \
2927                      : ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */)))
2928 #define U_V(n) ((n) < 0.0 ? ((n) < IV_MIN ? (UV) IV_MIN : (UV)(IV) (n)) \
2929                   : ((n) < UV_MAX_P1 ? (UV) (n) \
2930                      : ((n) > 0 ? UV_MAX : 0 /* NaN */)))
2931 #endif
2932
2933 #define U_S(what) ((U16)U_32(what))
2934 #define U_I(what) ((unsigned int)U_32(what))
2935 #define U_L(what) U_32(what)
2936
2937 /* These do not care about the fractional part, only about the range. */
2938 #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX)
2939 #define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX)
2940
2941 /* Used with UV/IV arguments: */
2942                                         /* XXXX: need to speed it up */
2943 #define CLUMP_2UV(iv)   ((iv) < 0 ? 0 : (UV)(iv))
2944 #define CLUMP_2IV(uv)   ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv))
2945
2946 #ifndef MAXSYSFD
2947 #   define MAXSYSFD 2
2948 #endif
2949
2950 #ifndef __cplusplus
2951 #if !(defined(UNDER_CE) || defined(SYMBIAN))
2952 Uid_t getuid (void);
2953 Uid_t geteuid (void);
2954 Gid_t getgid (void);
2955 Gid_t getegid (void);
2956 #endif
2957 #endif
2958
2959 #ifndef Perl_debug_log
2960 #  define Perl_debug_log        PerlIO_stderr()
2961 #endif
2962
2963 #ifndef Perl_error_log
2964 #  define Perl_error_log        (PL_stderrgv                    \
2965                                  && isGV(PL_stderrgv)           \
2966                                  && GvIOp(PL_stderrgv)          \
2967                                  && IoOFP(GvIOp(PL_stderrgv))   \
2968                                  ? IoOFP(GvIOp(PL_stderrgv))    \
2969                                  : PerlIO_stderr())
2970 #endif
2971
2972
2973 #define DEBUG_p_FLAG            0x00000001 /*      1 */
2974 #define DEBUG_s_FLAG            0x00000002 /*      2 */
2975 #define DEBUG_l_FLAG            0x00000004 /*      4 */
2976 #define DEBUG_t_FLAG            0x00000008 /*      8 */
2977 #define DEBUG_o_FLAG            0x00000010 /*     16 */
2978 #define DEBUG_c_FLAG            0x00000020 /*     32 */
2979 #define DEBUG_P_FLAG            0x00000040 /*     64 */
2980 #define DEBUG_m_FLAG            0x00000080 /*    128 */
2981 #define DEBUG_f_FLAG            0x00000100 /*    256 */
2982 #define DEBUG_r_FLAG            0x00000200 /*    512 */
2983 #define DEBUG_x_FLAG            0x00000400 /*   1024 */
2984 #define DEBUG_u_FLAG            0x00000800 /*   2048 */
2985                                            /*  spare */
2986 #define DEBUG_H_FLAG            0x00002000 /*   8192 */
2987 #define DEBUG_X_FLAG            0x00004000 /*  16384 */
2988 #define DEBUG_D_FLAG            0x00008000 /*  32768 */
2989 #define DEBUG_S_FLAG            0x00010000 /*  65536 */
2990 #define DEBUG_T_FLAG            0x00020000 /* 131072 */
2991 #define DEBUG_R_FLAG            0x00040000 /* 262144 */
2992 #define DEBUG_J_FLAG            0x00080000 /* 524288 */
2993 #define DEBUG_v_FLAG            0x00100000 /*1048576 */
2994 #define DEBUG_C_FLAG            0x00200000 /*2097152 */
2995 #define DEBUG_A_FLAG            0x00400000 /*4194304 */
2996 #define DEBUG_q_FLAG            0x00800000 /*8388608 */
2997 #define DEBUG_MASK              0x00FFEFFF /* mask of all the standard flags */
2998
2999 #define DEBUG_DB_RECURSE_FLAG   0x40000000
3000 #define DEBUG_TOP_FLAG          0x80000000 /* XXX what's this for ??? Signal
3001                                               that something was done? */
3002
3003 #  define DEBUG_p_TEST_ (PL_debug & DEBUG_p_FLAG)
3004 #  define DEBUG_s_TEST_ (PL_debug & DEBUG_s_FLAG)
3005 #  define DEBUG_l_TEST_ (PL_debug & DEBUG_l_FLAG)
3006 #  define DEBUG_t_TEST_ (PL_debug & DEBUG_t_FLAG)
3007 #  define DEBUG_o_TEST_ (PL_debug & DEBUG_o_FLAG)
3008 #  define DEBUG_c_TEST_ (PL_debug & DEBUG_c_FLAG)
3009 #  define DEBUG_P_TEST_ (PL_debug & DEBUG_P_FLAG)
3010 #  define DEBUG_m_TEST_ (PL_debug & DEBUG_m_FLAG)
3011 #  define DEBUG_f_TEST_ (PL_debug & DEBUG_f_FLAG)
3012 #  define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG)
3013 #  define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG)
3014 #  define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG)
3015 #  define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG)
3016 #  define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG)
3017 #  define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG)
3018 #  define DEBUG_S_TEST_ (PL_debug & DEBUG_S_FLAG)
3019 #  define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG)
3020 #  define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
3021 #  define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
3022 #  define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG)
3023 #  define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG)
3024 #  define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG)
3025 #  define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
3026 #  define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
3027
3028 #ifdef DEBUGGING
3029
3030 #  define DEBUG_p_TEST DEBUG_p_TEST_
3031 #  define DEBUG_s_TEST DEBUG_s_TEST_
3032 #  define DEBUG_l_TEST DEBUG_l_TEST_
3033 #  define DEBUG_t_TEST DEBUG_t_TEST_
3034 #  define DEBUG_o_TEST DEBUG_o_TEST_
3035 #  define DEBUG_c_TEST DEBUG_c_TEST_
3036 #  define DEBUG_P_TEST DEBUG_P_TEST_
3037 #  define DEBUG_m_TEST DEBUG_m_TEST_
3038 #  define DEBUG_f_TEST DEBUG_f_TEST_
3039 #  define DEBUG_r_TEST DEBUG_r_TEST_
3040 #  define DEBUG_x_TEST DEBUG_x_TEST_
3041 #  define DEBUG_u_TEST DEBUG_u_TEST_
3042 #  define DEBUG_H_TEST DEBUG_H_TEST_
3043 #  define DEBUG_X_TEST DEBUG_X_TEST_
3044 #  define DEBUG_Xv_TEST DEBUG_Xv_TEST_
3045 #  define DEBUG_D_TEST DEBUG_D_TEST_
3046 #  define DEBUG_S_TEST DEBUG_S_TEST_
3047 #  define DEBUG_T_TEST DEBUG_T_TEST_
3048 #  define DEBUG_R_TEST DEBUG_R_TEST_
3049 #  define DEBUG_J_TEST DEBUG_J_TEST_
3050 #  define DEBUG_v_TEST DEBUG_v_TEST_
3051 #  define DEBUG_C_TEST DEBUG_C_TEST_
3052 #  define DEBUG_A_TEST DEBUG_A_TEST_
3053 #  define DEBUG_q_TEST DEBUG_q_TEST_
3054
3055 #  define PERL_DEB(a)                  a
3056 #  define PERL_DEBUG(a) if (PL_debug)  a
3057 #  define DEBUG_p(a) if (DEBUG_p_TEST) a
3058 #  define DEBUG_s(a) if (DEBUG_s_TEST) a
3059 #  define DEBUG_l(a) if (DEBUG_l_TEST) a
3060 #  define DEBUG_t(a) if (DEBUG_t_TEST) a
3061 #  define DEBUG_o(a) if (DEBUG_o_TEST) a
3062 #  define DEBUG_c(a) if (DEBUG_c_TEST) a
3063 #  define DEBUG_P(a) if (DEBUG_P_TEST) a
3064
3065      /* Temporarily turn off memory debugging in case the a
3066       * does memory allocation, either directly or indirectly. */
3067 #  define DEBUG_m(a)  \
3068     STMT_START {                                                        \
3069         if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \
3070     } STMT_END
3071
3072 #  define DEBUG__(t, a) \
3073         STMT_START { \
3074                 if (t) STMT_START {a;} STMT_END; \
3075         } STMT_END
3076
3077 #  define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
3078 #  define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
3079 #  define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
3080 #  define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
3081 #  define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
3082 #  define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a)
3083 #  define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
3084 #  define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a)
3085
3086 #  define DEBUG_S(a)
3087
3088 #  define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a)
3089 #  define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
3090 #  define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a)
3091 #  define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a)
3092 #  define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a)
3093 #  define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
3094
3095 #else /* DEBUGGING */
3096
3097 #  define DEBUG_p_TEST (0)
3098 #  define DEBUG_s_TEST (0)
3099 #  define DEBUG_l_TEST (0)
3100 #  define DEBUG_t_TEST (0)
3101 #  define DEBUG_o_TEST (0)
3102 #  define DEBUG_c_TEST (0)
3103 #  define DEBUG_P_TEST (0)
3104 #  define DEBUG_m_TEST (0)
3105 #  define DEBUG_f_TEST (0)
3106 #  define DEBUG_r_TEST (0)
3107 #  define DEBUG_x_TEST (0)
3108 #  define DEBUG_u_TEST (0)
3109 #  define DEBUG_H_TEST (0)
3110 #  define DEBUG_X_TEST (0)
3111 #  define DEBUG_Xv_TEST (0)
3112 #  define DEBUG_D_TEST (0)
3113 #  define DEBUG_S_TEST (0)
3114 #  define DEBUG_T_TEST (0)
3115 #  define DEBUG_R_TEST (0)
3116 #  define DEBUG_J_TEST (0)
3117 #  define DEBUG_v_TEST (0)
3118 #  define DEBUG_C_TEST (0)
3119 #  define DEBUG_A_TEST (0)
3120 #  define DEBUG_q_TEST (0)
3121
3122 #  define PERL_DEB(a)
3123 #  define PERL_DEBUG(a)
3124 #  define DEBUG_p(a)
3125 #  define DEBUG_s(a)
3126 #  define DEBUG_l(a)
3127 #  define DEBUG_t(a)
3128 #  define DEBUG_o(a)
3129 #  define DEBUG_c(a)
3130 #  define DEBUG_P(a)
3131 #  define DEBUG_m(a)
3132 #  define DEBUG_f(a)
3133 #  define DEBUG_r(a)
3134 #  define DEBUG_x(a)
3135 #  define DEBUG_u(a)
3136 #  define DEBUG_H(a)
3137 #  define DEBUG_X(a)
3138 #  define DEBUG_Xv(a)
3139 #  define DEBUG_D(a)
3140 #  define DEBUG_S(a)
3141 #  define DEBUG_T(a)
3142 #  define DEBUG_R(a)
3143 #  define DEBUG_v(a)
3144 #  define DEBUG_C(a)
3145 #  define DEBUG_A(a)
3146 #  define DEBUG_q(a)
3147 #endif /* DEBUGGING */
3148
3149
3150 #define DEBUG_SCOPE(where) \
3151     DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n",  \
3152                     where, PL_scopestack_ix, __FILE__, __LINE__)));
3153
3154
3155
3156
3157 /* These constants should be used in preference to raw characters
3158  * when using magic. Note that some perl guts still assume
3159  * certain character properties of these constants, namely that
3160  * isUPPER() and toLOWER() may do useful mappings.
3161  *
3162  * Update the magic_names table in dump.c when adding/amending these
3163  */
3164
3165 #define PERL_MAGIC_sv             '\0' /* Special scalar variable */
3166 #define PERL_MAGIC_overload       'A' /* %OVERLOAD hash */
3167 #define PERL_MAGIC_overload_elem  'a' /* %OVERLOAD hash element */
3168 #define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */
3169 #define PERL_MAGIC_bm             'B' /* Boyer-Moore (fast string search) */
3170 #define PERL_MAGIC_regdata        'D' /* Regex match position data
3171                                         (@+ and @- vars) */
3172 #define PERL_MAGIC_regdatum       'd' /* Regex match position data element */
3173 #define PERL_MAGIC_env            'E' /* %ENV hash */
3174 #define PERL_MAGIC_envelem        'e' /* %ENV hash element */
3175 #define PERL_MAGIC_fm             'f' /* Formline ('compiled' format) */
3176 #define PERL_MAGIC_regex_global   'g' /* m//g target / study()ed string */
3177 #define PERL_MAGIC_isa            'I' /* @ISA array */
3178 #define PERL_MAGIC_isaelem        'i' /* @ISA array element */
3179 #define PERL_MAGIC_nkeys          'k' /* scalar(keys()) lvalue */
3180 #define PERL_MAGIC_dbfile         'L' /* Debugger %_<filename */
3181 #define PERL_MAGIC_dbline         'l' /* Debugger %_<filename element */
3182 #define PERL_MAGIC_mutex          'm' /* for lock op */
3183 #define PERL_MAGIC_shared         'N' /* Shared between threads */
3184 #define PERL_MAGIC_shared_scalar  'n' /* Shared between threads */
3185 #define PERL_MAGIC_collxfrm       'o' /* Locale transformation */
3186 #define PERL_MAGIC_tied           'P' /* Tied array or hash */
3187 #define PERL_MAGIC_tiedelem       'p' /* Tied array or hash element */
3188 #define PERL_MAGIC_tiedscalar     'q' /* Tied scalar or handle */
3189 #define PERL_MAGIC_qr             'r' /* precompiled qr// regex */
3190 #define PERL_MAGIC_sig            'S' /* %SIG hash */
3191 #define PERL_MAGIC_sigelem        's' /* %SIG hash element */
3192 #define PERL_MAGIC_taint          't' /* Taintedness */
3193 #define PERL_MAGIC_uvar           'U' /* Available for use by extensions */
3194 #define PERL_MAGIC_uvar_elem      'u' /* Reserved for use by extensions */
3195 #define PERL_MAGIC_vec            'v' /* vec() lvalue */
3196 #define PERL_MAGIC_vstring        'V' /* SV was vstring literal */
3197 #define PERL_MAGIC_utf8           'w' /* Cached UTF-8 information */
3198 #define PERL_MAGIC_substr         'x' /* substr() lvalue */
3199 #define PERL_MAGIC_defelem        'y' /* Shadow "foreach" iterator variable /
3200                                         smart parameter vivification */
3201 #define PERL_MAGIC_glob           '*' /* GV (typeglob) */
3202 #define PERL_MAGIC_arylen         '#' /* Array length ($#ary) */
3203 #define PERL_MAGIC_pos            '.' /* pos() lvalue */
3204 #define PERL_MAGIC_backref        '<' /* for weak ref data */
3205 #define PERL_MAGIC_symtab         ':' /* extra data for symbol tables */
3206 #define PERL_MAGIC_rhash          '%' /* extra data for restricted hashes */
3207 #define PERL_MAGIC_arylen_p       '@' /* to move arylen out of XPVAV */
3208 #define PERL_MAGIC_ext            '~' /* Available for use by extensions */
3209
3210
3211 #ifndef assert  /* <assert.h> might have been included somehow */
3212 #define assert(what)    PERL_DEB(                                       \
3213         ((what) ? ((void) 0) :                                          \
3214             (Perl_croak(aTHX_ "Assertion %s failed: file \"" __FILE__   \
3215                         "\", line %d", STRINGIFY(what), __LINE__),      \
3216             PerlProc_exit(1),                                           \
3217             (void) 0)))
3218 #endif
3219
3220 struct ufuncs {
3221     I32 (*uf_val)(pTHX_ IV, SV*);
3222     I32 (*uf_set)(pTHX_ IV, SV*);
3223     IV uf_index;
3224 };
3225
3226 /* In pre-5.7-Perls the PERL_MAGIC_uvar magic didn't get the thread context.
3227  * XS code wanting to be backward compatible can do something
3228  * like the following:
3229
3230 #ifndef PERL_MG_UFUNC
3231 #define PERL_MG_UFUNC(name,ix,sv) I32 name(IV ix, SV *sv)
3232 #endif
3233
3234 static PERL_MG_UFUNC(foo_get, index, val)
3235 {
3236     sv_setsv(val, ...);
3237     return TRUE;
3238 }
3239
3240 -- Doug MacEachern
3241
3242 */
3243
3244 #ifndef PERL_MG_UFUNC
3245 #define PERL_MG_UFUNC(name,ix,sv) I32 name(pTHX_ IV ix, SV *sv)
3246 #endif
3247
3248 /* Fix these up for __STDC__ */
3249 #ifndef DONT_DECLARE_STD
3250 char *mktemp (char*);
3251 #ifndef atof
3252 double atof (const char*);
3253 #endif
3254 #endif
3255
3256 #ifndef STANDARD_C
3257 /* All of these are in stdlib.h or time.h for ANSI C */
3258 Time_t time();
3259 struct tm *gmtime(), *localtime();
3260 #if defined(OEMVS) || defined(__OPEN_VM)
3261 char *(strchr)(), *(strrchr)();
3262 char *(strcpy)(), *(strcat)();
3263 #else
3264 char *strchr(), *strrchr();
3265 char *strcpy(), *strcat();
3266 #endif
3267 #endif /* ! STANDARD_C */
3268
3269
3270 #ifdef I_MATH
3271 #    include <math.h>
3272 #else
3273 START_EXTERN_C
3274             double exp (double);
3275             double log (double);
3276             double log10 (double);
3277             double sqrt (double);
3278             double frexp (double,int*);
3279             double ldexp (double,int);
3280             double modf (double,double*);
3281             double sin (double);
3282             double cos (double);
3283             double atan2 (double,double);
3284             double pow (double,double);
3285 END_EXTERN_C
3286 #endif
3287
3288 #if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(LDBL_INFINITY)
3289 #  define NV_INF LDBL_INFINITY
3290 #endif
3291 #if !defined(NV_INF) && defined(DBL_INFINITY)
3292 #  define NV_INF (NV)DBL_INFINITY
3293 #endif
3294 #if !defined(NV_INF) && defined(INFINITY)
3295 #  define NV_INF (NV)INFINITY
3296 #endif
3297 #if !defined(NV_INF) && defined(INF)
3298 #  define NV_INF (NV)INF
3299 #endif
3300 #if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
3301 #  define NV_INF (NV)HUGE_VALL
3302 #endif
3303 #if !defined(NV_INF) && defined(HUGE_VAL)
3304 #  define NV_INF (NV)HUGE_VAL
3305 #endif
3306
3307 #if !defined(NV_NAN) && defined(USE_LONG_DOUBLE)
3308 #   if !defined(NV_NAN) && defined(LDBL_NAN)
3309 #       define NV_NAN LDBL_NAN
3310 #   endif
3311 #   if !defined(NV_NAN) && defined(LDBL_QNAN)
3312 #       define NV_NAN LDBL_QNAN
3313 #   endif
3314 #   if !defined(NV_NAN) && defined(LDBL_SNAN)
3315 #       define NV_NAN LDBL_SNAN
3316 #   endif
3317 #endif
3318 #if !defined(NV_NAN) && defined(DBL_NAN)
3319 #  define NV_NAN (NV)DBL_NAN
3320 #endif
3321 #if !defined(NV_NAN) && defined(DBL_QNAN)
3322 #  define NV_NAN (NV)DBL_QNAN
3323 #endif
3324 #if !defined(NV_NAN) && defined(DBL_SNAN)
3325 #  define NV_NAN (NV)DBL_SNAN
3326 #endif
3327 #if !defined(NV_NAN) && defined(QNAN)
3328 #  define NV_NAN (NV)QNAN
3329 #endif
3330 #if !defined(NV_NAN) && defined(SNAN)
3331 #  define NV_NAN (NV)SNAN
3332 #endif
3333 #if !defined(NV_NAN) && defined(NAN)
3334 #  define NV_NAN (NV)NAN
3335 #endif
3336
3337 #ifndef __cplusplus
3338 #  if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */
3339 char *crypt ();       /* Maybe more hosts will need the unprototyped version */
3340 #  else
3341 #    if !defined(WIN32) && !defined(VMS)
3342 #ifndef crypt
3343 char *crypt (const char*, const char*);
3344 #endif
3345 #    endif /* !WIN32 */
3346 #  endif /* !NeXT && !__NeXT__ */
3347 #  ifndef DONT_DECLARE_STD
3348 #    ifndef getenv
3349 char *getenv (const char*);
3350 #    endif /* !getenv */
3351 #    if !defined(HAS_LSEEK_PROTO) && !defined(EPOC) && !defined(__hpux)
3352 #      ifdef _FILE_OFFSET_BITS
3353 #        if _FILE_OFFSET_BITS == 64
3354 Off_t lseek (int,Off_t,int);
3355 #        endif
3356 #      endif
3357 #    endif
3358 #  endif /* !DONT_DECLARE_STD */
3359 #ifndef getlogin
3360 char *getlogin (void);
3361 #endif
3362 #endif /* !__cplusplus */
3363
3364 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
3365 #define UNLINK unlnk
3366 I32 unlnk (char*);
3367 #else
3368 #define UNLINK PerlLIO_unlink
3369 #endif
3370
3371 /* some versions of glibc are missing the setresuid() proto */
3372 #if defined(HAS_SETRESUID) && !defined(HAS_SETRESUID_PROTO)
3373 int setresuid(uid_t ruid, uid_t euid, uid_t suid);
3374 #endif
3375 /* some versions of glibc are missing the setresgid() proto */
3376 #if defined(HAS_SETRESGID) && !defined(HAS_SETRESGID_PROTO)
3377 int setresgid(gid_t rgid, gid_t egid, gid_t sgid);
3378 #endif
3379
3380 #ifndef HAS_SETREUID
3381 #  ifdef HAS_SETRESUID
3382 #    define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
3383 #    define HAS_SETREUID
3384 #  endif
3385 #endif
3386 #ifndef HAS_SETREGID
3387 #  ifdef HAS_SETRESGID
3388 #    define setregid(r,e) setresgid(r,e,(Gid_t)-1)
3389 #    define HAS_SETREGID
3390 #  endif
3391 #endif
3392
3393 /* Sighandler_t defined in iperlsys.h */
3394
3395 #ifdef HAS_SIGACTION
3396 typedef struct sigaction Sigsave_t;
3397 #else
3398 typedef Sighandler_t Sigsave_t;
3399 #endif
3400
3401 #define SCAN_DEF 0
3402 #define SCAN_TR 1
3403 #define SCAN_REPL 2
3404
3405 #ifdef DEBUGGING
3406 # ifndef register
3407 #  define register
3408 # endif
3409 # define RUNOPS_DEFAULT Perl_runops_debug
3410 #else
3411 # define RUNOPS_DEFAULT Perl_runops_standard
3412 #endif
3413
3414 #ifdef MYMALLOC
3415 #  ifdef MUTEX_INIT_CALLS_MALLOC
3416 #    define MALLOC_INIT                                 \
3417         STMT_START {                                    \
3418                 PL_malloc_mutex = NULL;                 \
3419                 MUTEX_INIT(&PL_malloc_mutex);           \
3420         } STMT_END
3421 #    define MALLOC_TERM                                 \
3422         STMT_START {                                    \
3423                 perl_mutex tmp = PL_malloc_mutex;       \
3424                 PL_malloc_mutex = NULL;                 \
3425                 MUTEX_DESTROY(&tmp);                    \
3426         } STMT_END
3427 #  else
3428 #    define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
3429 #    define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
3430 #  endif
3431 #else
3432 #  define MALLOC_INIT
3433 #  define MALLOC_TERM
3434 #endif
3435
3436
3437 typedef int (CPERLscope(*runops_proc_t)) (pTHX);
3438 typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);
3439 typedef int  (CPERLscope(*thrhook_proc_t)) (pTHX);
3440 typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
3441
3442 /* _ (for $_) must be first in the following list (DEFSV requires it) */
3443 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
3444
3445 /* NeXT has problems with crt0.o globals */
3446 #if defined(__DYNAMIC__) && \
3447     (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN))
3448 #  if defined(NeXT) || defined(__NeXT)
3449 #    include <mach-o/dyld.h>
3450 #    define environ (*environ_pointer)
3451 EXT char *** environ_pointer;
3452 #  else
3453 #    if defined(PERL_DARWIN) && defined(PERL_CORE)
3454 #      include <crt_externs.h>  /* for the env array */
3455 #      define environ (*_NSGetEnviron())
3456 #    endif
3457 #  endif
3458 #else
3459    /* VMS and some other platforms don't use the environ array */
3460 #  ifdef USE_ENVIRON_ARRAY
3461 #    if !defined(DONT_DECLARE_STD) || \
3462         (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
3463         defined(__sgi) || \
3464         defined(__DGUX)
3465 extern char **  environ;        /* environment variables supplied via exec */
3466 #    endif
3467 #  endif
3468 #endif
3469
3470 START_EXTERN_C
3471
3472 /* handy constants */
3473 EXTCONST char PL_warn_uninit[]
3474   INIT("Use of uninitialized value%s%s%s");
3475 EXTCONST char PL_warn_nosemi[]
3476   INIT("Semicolon seems to be missing");
3477 EXTCONST char PL_warn_reserved[]
3478   INIT("Unquoted string \"%s\" may clash with future reserved word");
3479 EXTCONST char PL_warn_nl[]
3480   INIT("Unsuccessful %s on filename containing newline");
3481 EXTCONST char PL_no_wrongref[]
3482   INIT("Can't use %s ref as %s ref");
3483 EXTCONST char PL_no_symref[]
3484   INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
3485 EXTCONST char PL_no_symref_sv[]
3486   INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use");
3487 EXTCONST char PL_no_usym[]
3488   INIT("Can't use an undefined value as %s reference");
3489 EXTCONST char PL_no_aelem[]
3490   INIT("Modification of non-creatable array value attempted, subscript %d");
3491 EXTCONST char PL_no_helem_sv[]
3492   INIT("Modification of non-creatable hash value attempted, subscript \""SVf"\"");
3493 EXTCONST char PL_no_modify[]
3494   INIT("Modification of a read-only value attempted");
3495 EXTCONST char PL_no_mem[]
3496   INIT("Out of memory!\n");
3497 EXTCONST char PL_no_security[]
3498   INIT("Insecure dependency in %s%s");
3499 EXTCONST char PL_no_sock_func[]
3500   INIT("Unsupported socket function \"%s\" called");
3501 EXTCONST char PL_no_dir_func[]
3502   INIT("Unsupported directory function \"%s\" called");
3503 EXTCONST char PL_no_func[]
3504   INIT("The %s function is unimplemented");
3505 EXTCONST char PL_no_myglob[]
3506   INIT("\"my\" variable %s can't be in a package");
3507 EXTCONST char PL_no_localize_ref[]
3508   INIT("Can't localize through a reference");
3509 #ifdef PERL_MALLOC_WRAP
3510 EXTCONST char PL_memory_wrap[]
3511   INIT("panic: memory wrap");
3512 #endif
3513
3514 EXTCONST char PL_uuemap[65]
3515   INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
3516
3517
3518 #ifdef DOINIT
3519 EXTCONST char* const PL_sig_name[] = { SIG_NAME };
3520 EXTCONST int         PL_sig_num[]  = { SIG_NUM };
3521 #else
3522 EXTCONST char* const PL_sig_name[];
3523 EXTCONST int         PL_sig_num[];
3524 #endif
3525
3526 /* fast conversion and case folding tables */
3527
3528 #ifdef DOINIT
3529 #ifdef EBCDIC
3530 EXTCONST unsigned char PL_fold[] = { /* fast EBCDIC case folding table */
3531     0,      1,      2,      3,      4,      5,      6,      7,
3532     8,      9,      10,     11,     12,     13,     14,     15,
3533     16,     17,     18,     19,     20,     21,     22,     23,
3534     24,     25,     26,     27,     28,     29,     30,     31,
3535     32,     33,     34,     35,     36,     37,     38,     39,
3536     40,     41,     42,     43,     44,     45,     46,     47,
3537     48,     49,     50,     51,     52,     53,     54,     55,
3538     56,     57,     58,     59,     60,     61,     62,     63,
3539     64,     65,     66,     67,     68,     69,     70,     71,
3540     72,     73,     74,     75,     76,     77,     78,     79,
3541     80,     81,     82,     83,     84,     85,     86,     87,
3542     88,     89,     90,     91,     92,     93,     94,     95,
3543     96,     97,     98,     99,     100,    101,    102,    103,
3544     104,    105,    106,    107,    108,    109,    110,    111,
3545     112,    113,    114,    115,    116,    117,    118,    119,
3546     120,    121,    122,    123,    124,    125,    126,    127,
3547     128,    'A',    'B',    'C',    'D',    'E',    'F',    'G',
3548     'H',    'I',    138,    139,    140,    141,    142,    143,
3549     144,    'J',    'K',    'L',    'M',    'N',    'O',    'P',
3550     'Q',    'R',    154,    155,    156,    157,    158,    159,
3551     160,    161,    'S',    'T',    'U',    'V',    'W',    'X',
3552     'Y',    'Z',    170,    171,    172,    173,    174,    175,
3553     176,    177,    178,    179,    180,    181,    182,    183,
3554     184,    185,    186,    187,    188,    189,    190,    191,
3555     192,    'a',    'b',    'c',    'd',    'e',    'f',    'g',
3556     'h',    'i',    202,    203,    204,    205,    206,    207,
3557     208,    'j',    'k',    'l',    'm',    'n',    'o',    'p',
3558     'q',    'r',    218,    219,    220,    221,    222,    223,
3559     224,    225,    's',    't',    'u',    'v',    'w',    'x',
3560     'y',    'z',    234,    235,    236,    237,    238,    239,
3561     240,    241,    242,    243,    244,    245,    246,    247,
3562     248,    249,    250,    251,    252,    253,    254,    255
3563 };
3564 #else   /* ascii rather than ebcdic */
3565 EXTCONST  unsigned char PL_fold[] = {
3566         0,      1,      2,      3,      4,      5,      6,      7,
3567         8,      9,      10,     11,     12,     13,     14,     15,
3568         16,     17,     18,     19,     20,     21,     22,     23,
3569         24,     25,     26,     27,     28,     29,     30,     31,
3570         32,     33,     34,     35,     36,     37,     38,     39,
3571         40,     41,     42,     43,     44,     45,     46,     47,
3572         48,     49,     50,     51,     52,     53,     54,     55,
3573         56,     57,     58,     59,     60,     61,     62,     63,
3574         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
3575         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
3576         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
3577         'x',    'y',    'z',    91,     92,     93,     94,     95,
3578         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
3579         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
3580         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
3581         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
3582         128,    129,    130,    131,    132,    133,    134,    135,
3583         136,    137,    138,    139,    140,    141,    142,    143,
3584         144,    145,    146,    147,    148,    149,    150,    151,
3585         152,    153,    154,    155,    156,    157,    158,    159,
3586         160,    161,    162,    163,    164,    165,    166,    167,
3587         168,    169,    170,    171,    172,    173,    174,    175,
3588         176,    177,    178,    179,    180,    181,    182,    183,
3589         184,    185,    186,    187,    188,    189,    190,    191,
3590         192,    193,    194,    195,    196,    197,    198,    199,
3591         200,    201,    202,    203,    204,    205,    206,    207,
3592         208,    209,    210,    211,    212,    213,    214,    215,
3593         216,    217,    218,    219,    220,    221,    222,    223,    
3594         224,    225,    226,    227,    228,    229,    230,    231,
3595         232,    233,    234,    235,    236,    237,    238,    239,
3596         240,    241,    242,    243,    244,    245,    246,    247,
3597         248,    249,    250,    251,    252,    253,    254,    255
3598 };
3599 #endif  /* !EBCDIC */
3600 #else
3601 EXTCONST unsigned char PL_fold[];
3602 #endif
3603
3604 #ifndef PERL_GLOBAL_STRUCT /* or perlvars.h */
3605 #ifdef DOINIT
3606 EXT unsigned char PL_fold_locale[] = { /* Unfortunately not EXTCONST. */
3607         0,      1,      2,      3,      4,      5,      6,      7,
3608         8,      9,      10,     11,     12,     13,     14,     15,
3609         16,     17,     18,     19,     20,     21,     22,     23,
3610         24,     25,     26,     27,     28,     29,     30,     31,
3611         32,     33,     34,     35,     36,     37,     38,     39,
3612         40,     41,     42,     43,     44,     45,     46,     47,
3613         48,     49,     50,     51,     52,     53,     54,     55,
3614         56,     57,     58,     59,     60,     61,     62,     63,
3615         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
3616         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
3617         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
3618         'x',    'y',    'z',    91,     92,     93,     94,     95,
3619         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
3620         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
3621         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
3622         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
3623         128,    129,    130,    131,    132,    133,    134,    135,
3624         136,    137,    138,    139,    140,    141,    142,    143,
3625         144,    145,    146,    147,    148,    149,    150,    151,
3626         152,    153,    154,    155,    156,    157,    158,    159,
3627         160,    161,    162,    163,    164,    165,    166,    167,
3628         168,    169,    170,    171,    172,    173,    174,    175,
3629         176,    177,    178,    179,    180,    181,    182,    183,
3630         184,    185,    186,    187,    188,    189,    190,    191,
3631         192,    193,    194,    195,    196,    197,    198,    199,
3632         200,    201,    202,    203,    204,    205,    206,    207,
3633         208,    209,    210,    211,    212,    213,    214,    215,
3634         216,    217,    218,    219,    220,    221,    222,    223,    
3635         224,    225,    226,    227,    228,    229,    230,    231,
3636         232,    233,    234,    235,    236,    237,    238,    239,
3637         240,    241,    242,    243,    244,    245,    246,    247,
3638         248,    249,    250,    251,    252,    253,    254,    255
3639 };
3640 #else
3641 EXT unsigned char PL_fold_locale[]; /* Unfortunately not EXTCONST. */
3642 #endif
3643 #endif /* !PERL_GLOBAL_STRUCT */
3644
3645 #ifdef DOINIT
3646 #ifdef EBCDIC
3647 EXTCONST unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */
3648     1,      2,      84,     151,    154,    155,    156,    157,
3649     165,    246,    250,    3,      158,    7,      18,     29,
3650     40,     51,     62,     73,     85,     96,     107,    118,
3651     129,    140,    147,    148,    149,    150,    152,    153,
3652     255,      6,      8,      9,     10,     11,     12,     13,
3653      14,     15,     24,     25,     26,     27,     28,    226,
3654      29,     30,     31,     32,     33,     43,     44,     45,
3655      46,     47,     48,     49,     50,     76,     77,     78,
3656      79,     80,     81,     82,     83,     84,     85,     86,
3657      87,     94,     95,    234,    181,    233,    187,    190,
3658     180,     96,     97,     98,     99,    100,    101,    102,
3659     104,    112,    182,    174,    236,    232,    229,    103,
3660     228,    226,    114,    115,    116,    117,    118,    119,
3661     120,    121,    122,    235,    176,    230,    194,    162,
3662     130,    131,    132,    133,    134,    135,    136,    137,
3663     138,    139,    201,    205,    163,    217,    220,    224,
3664     5,      248,    227,    244,    242,    255,    241,    231,
3665     240,    253,    16,     197,    19,     20,     21,     187,
3666     23,     169,    210,    245,    237,    249,    247,    239,
3667     168,    252,    34,     196,    36,     37,     38,     39,
3668     41,     42,     251,    254,    238,    223,    221,    213,
3669     225,    177,    52,     53,     54,     55,     56,     57,
3670     58,     59,     60,     61,     63,     64,     65,     66,
3671     67,     68,     69,     70,     71,     72,     74,     75,
3672     205,    208,    186,    202,    200,    218,    198,    179,
3673     178,    214,    88,     89,     90,     91,     92,     93,
3674     217,    166,    170,    207,    199,    209,    206,    204,
3675     160,    212,    105,    106,    108,    109,    110,    111,
3676     203,    113,    216,    215,    192,    175,    193,    243,
3677     172,    161,    123,    124,    125,    126,    127,    128,
3678     222,    219,    211,    195,    188,    193,    185,    184,
3679     191,    183,    141,    142,    143,    144,    145,    146
3680 };
3681 #else  /* ascii rather than ebcdic */
3682 EXTCONST unsigned char PL_freq[] = {    /* letter frequencies for mixed English/C */
3683         1,      2,      84,     151,    154,    155,    156,    157,
3684         165,    246,    250,    3,      158,    7,      18,     29,
3685         40,     51,     62,     73,     85,     96,     107,    118,
3686         129,    140,    147,    148,    149,    150,    152,    153,
3687         255,    182,    224,    205,    174,    176,    180,    217,
3688         233,    232,    236,    187,    235,    228,    234,    226,
3689         222,    219,    211,    195,    188,    193,    185,    184,
3690         191,    183,    201,    229,    181,    220,    194,    162,
3691         163,    208,    186,    202,    200,    218,    198,    179,
3692         178,    214,    166,    170,    207,    199,    209,    206,
3693         204,    160,    212,    216,    215,    192,    175,    173,
3694         243,    172,    161,    190,    203,    189,    164,    230,
3695         167,    248,    227,    244,    242,    255,    241,    231,
3696         240,    253,    169,    210,    245,    237,    249,    247,
3697         239,    168,    252,    251,    254,    238,    223,    221,
3698         213,    225,    177,    197,    171,    196,    159,    4,
3699         5,      6,      8,      9,      10,     11,     12,     13,
3700         14,     15,     16,     17,     19,     20,     21,     22,
3701         23,     24,     25,     26,     27,     28,     30,     31,
3702         32,     33,     34,     35,     36,     37,     38,     39,
3703         41,     42,     43,     44,     45,     46,     47,     48,
3704         49,     50,     52,     53,     54,     55,     56,     57,
3705         58,     59,     60,     61,     63,     64,     65,     66,
3706         67,     68,     69,     70,     71,     72,     74,     75,
3707         76,     77,     78,     79,     80,     81,     82,     83,
3708         86,     87,     88,     89,     90,     91,     92,     93,
3709         94,     95,     97,     98,     99,     100,    101,    102,
3710         103,    104,    105,    106,    108,    109,    110,    111,
3711         112,    113,    114,    115,    116,    117,    119,    120,
3712         121,    122,    123,    124,    125,    126,    127,    128,
3713         130,    131,    132,    133,    134,    135,    136,    137,
3714         138,    139,    141,    142,    143,    144,    145,    146
3715 };
3716 #endif
3717 #else
3718 EXTCONST unsigned char PL_freq[];
3719 #endif
3720
3721 #ifdef DEBUGGING
3722 #ifdef DOINIT
3723 EXTCONST char* const PL_block_type[] = {
3724         "NULL",
3725         "SUB",
3726         "EVAL",
3727         "LOOP",
3728         "SUBST",
3729         "BLOCK",
3730 };
3731 #else
3732 EXTCONST char* PL_block_type[];
3733 #endif
3734 #endif
3735
3736 END_EXTERN_C
3737
3738 /*****************************************************************************/
3739 /* This lexer/parser stuff is currently global since yacc is hard to reenter */
3740 /*****************************************************************************/
3741 /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
3742
3743 #ifdef __Lynx__
3744 /* LynxOS defines these in scsi.h which is included via ioctl.h */
3745 #ifdef FORMAT
3746 #undef FORMAT
3747 #endif
3748 #ifdef SPACE
3749 #undef SPACE
3750 #endif
3751 #endif
3752
3753 /* Win32 defines a type 'WORD' in windef.h. This conflicts with the enumerator
3754  * 'WORD' defined in perly.h. The yytokentype enum is only a debugging aid, so
3755  * it's not really needed.
3756  */
3757 #if defined(WIN32)
3758 #  define YYTOKENTYPE
3759 #endif
3760 #include "perly.h"
3761
3762 #define LEX_NOTPARSING          11      /* borrowed from toke.c */
3763
3764 typedef enum {
3765     XOPERATOR,
3766     XTERM,
3767     XREF,
3768     XSTATE,
3769     XBLOCK,
3770     XATTRBLOCK,
3771     XATTRTERM,
3772     XTERMBLOCK,
3773     XTERMORDORDOR /* evil hack */
3774     /* update exp_name[] in toke.c if adding to this enum */
3775 } expectation;
3776
3777 enum {          /* pass one of these to get_vtbl */
3778     want_vtbl_sv,
3779     want_vtbl_env,
3780     want_vtbl_envelem,
3781     want_vtbl_sig,
3782     want_vtbl_sigelem,
3783     want_vtbl_pack,
3784     want_vtbl_packelem,
3785     want_vtbl_dbline,
3786     want_vtbl_isa,
3787     want_vtbl_isaelem,
3788     want_vtbl_arylen,
3789     want_vtbl_glob,
3790     want_vtbl_mglob,
3791     want_vtbl_nkeys,
3792     want_vtbl_taint,
3793     want_vtbl_substr,
3794     want_vtbl_vec,
3795     want_vtbl_pos,
3796     want_vtbl_bm,
3797     want_vtbl_fm,
3798     want_vtbl_uvar,
3799     want_vtbl_defelem,
3800     want_vtbl_regexp,
3801     want_vtbl_collxfrm,
3802     want_vtbl_amagic,
3803     want_vtbl_amagicelem,
3804     want_vtbl_regdata,
3805     want_vtbl_regdatum,
3806     want_vtbl_backref,
3807     want_vtbl_utf8,
3808     want_vtbl_symtab
3809 };
3810
3811                                 /* Note: the lowest 8 bits are reserved for
3812                                    stuffing into op->op_private */
3813 #define HINT_PRIVATE_MASK       0x000000ff
3814 #define HINT_INTEGER            0x00000001 /* integer pragma */
3815 #define HINT_STRICT_REFS        0x00000002 /* strict pragma */
3816 #define HINT_LOCALE             0x00000004 /* locale pragma */
3817 #define HINT_BYTES              0x00000008 /* bytes pragma */
3818 /* #define HINT_notused10       0x00000010 */
3819                                 /* Note: 20,40,80 used for NATIVE_HINTS */
3820                                 /* currently defined by vms/vmsish.h */
3821
3822 #define HINT_BLOCK_SCOPE        0x00000100
3823 #define HINT_STRICT_SUBS        0x00000200 /* strict pragma */
3824 #define HINT_STRICT_VARS        0x00000400 /* strict pragma */
3825
3826 /* The HINT_NEW_* constants are used by the overload pragma */
3827 #define HINT_NEW_INTEGER        0x00001000
3828 #define HINT_NEW_FLOAT          0x00002000
3829 #define HINT_NEW_BINARY         0x00004000
3830 #define HINT_NEW_STRING         0x00008000
3831 #define HINT_NEW_RE             0x00010000
3832 #define HINT_LOCALIZE_HH        0x00020000 /* %^H needs to be copied */
3833
3834 #define HINT_RE_TAINT           0x00100000 /* re pragma */
3835 #define HINT_RE_EVAL            0x00200000 /* re pragma */
3836
3837 #define HINT_FILETEST_ACCESS    0x00400000 /* filetest pragma */
3838 #define HINT_UTF8               0x00800000 /* utf8 pragma */
3839
3840 /* assertions pragma */
3841 #define HINT_ASSERTING          0x01000000
3842 #define HINT_ASSERTIONSSEEN     0x02000000
3843
3844 /* The following are stored in $sort::hints, not in PL_hints */
3845 #define HINT_SORT_SORT_BITS     0x000000FF /* allow 256 different ones */
3846 #define HINT_SORT_QUICKSORT     0x00000001
3847 #define HINT_SORT_MERGESORT     0x00000002
3848 #define HINT_SORT_STABLE        0x00000100 /* sort styles (currently one) */
3849
3850 /* Various states of the input record separator SV (rs) */
3851 #define RsSNARF(sv)   (! SvOK(sv))
3852 #define RsSIMPLE(sv)  (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))
3853 #define RsPARA(sv)    (SvPOK(sv) && ! SvCUR(sv))
3854 #define RsRECORD(sv)  (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
3855
3856 /* A struct for keeping various DEBUGGING related stuff,
3857  * neatly packed.  Currently only scratch variables for
3858  * constructing debug output are included.  Needed always,
3859  * not just when DEBUGGING, though, because of the re extension. c*/
3860 struct perl_debug_pad {
3861   SV pad[3];
3862 };
3863
3864 #define PERL_DEBUG_PAD(i)       &(PL_debug_pad.pad[i])
3865 #define PERL_DEBUG_PAD_ZERO(i)  (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, \
3866         (((XPV*) SvANY(PERL_DEBUG_PAD(i)))->xpv_cur = 0), \
3867         PERL_DEBUG_PAD(i))
3868
3869 /* Enable variables which are pointers to functions */
3870 typedef void (CPERLscope(*peep_t))(pTHX_ OP* o);
3871 typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm);
3872 typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg,
3873                                       char* strend, char* strbeg, I32 minend,
3874                                       SV* screamer, void* data, U32 flags);
3875 typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv,
3876                                                 char *strpos, char *strend,
3877                                                 U32 flags,
3878                                                 struct re_scream_pos_data_s *d);
3879 typedef SV*     (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog);
3880 typedef void    (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r);
3881
3882 typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*);
3883 typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*);
3884 typedef void (*SVFUNC_t) (pTHX_ SV*);
3885 typedef I32  (*SVCOMPARE_t) (pTHX_ SV*, SV*);
3886 typedef void (*XSINIT_t) (pTHX);
3887 typedef void (*ATEXIT_t) (pTHX_ void*);
3888 typedef void (*XSUBADDR_t) (pTHX_ CV *);
3889
3890 /* Set up PERLVAR macros for populating structs */
3891 #define PERLVAR(var,type) type var;
3892 #define PERLVARA(var,n,type) type var[n];
3893 #define PERLVARI(var,type,init) type var;
3894 #define PERLVARIC(var,type,init) type var;
3895 #define PERLVARISC(var,init) const char var[sizeof(init)];
3896
3897 typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
3898 typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
3899
3900 /* Interpreter exitlist entry */
3901 typedef struct exitlistentry {
3902     void (*fn) (pTHX_ void*);
3903     void *ptr;
3904 } PerlExitListEntry;
3905
3906 /* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */
3907 /* These have to be before perlvars.h */
3908 #if !defined(HAS_SIGACTION) && defined(VMS)
3909 #  define  FAKE_PERSISTENT_SIGNAL_HANDLERS
3910 #endif
3911 /* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */
3912 #if defined(KILL_BY_SIGPRC)
3913 #  define  FAKE_DEFAULT_SIGNAL_HANDLERS
3914 #endif
3915
3916 #ifdef PERL_GLOBAL_STRUCT
3917 struct perl_vars {
3918 #  include "perlvars.h"
3919 };
3920
3921 #  ifdef PERL_CORE
3922 #    ifndef PERL_GLOBAL_STRUCT_PRIVATE
3923 EXT struct perl_vars PL_Vars;
3924 EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
3925 #      undef PERL_GET_VARS
3926 #      define PERL_GET_VARS() PL_VarsPtr
3927 #    endif /* !PERL_GLOBAL_STRUCT_PRIVATE */
3928 #  else /* PERL_CORE */
3929 #    if !defined(__GNUC__) || !defined(WIN32)
3930 EXT
3931 #    endif /* WIN32 */
3932 struct perl_vars *PL_VarsPtr;
3933 #    define PL_Vars (*((PL_VarsPtr) \
3934                        ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX))))
3935 #  endif /* PERL_CORE */
3936 #endif /* PERL_GLOBAL_STRUCT */
3937
3938 #if defined(MULTIPLICITY)
3939 /* If we have multiple interpreters define a struct
3940    holding variables which must be per-interpreter
3941    If we don't have threads anything that would have
3942    be per-thread is per-interpreter.
3943 */
3944
3945 struct interpreter {
3946 #  include "thrdvar.h"
3947 #  include "intrpvar.h"
3948 /*
3949  * The following is a buffer where new variables must
3950  * be defined to maintain binary compatibility with previous versions
3951  */
3952 PERLVARA(object_compatibility,30,       char)
3953 };
3954
3955 #else
3956 struct interpreter {
3957     char broiled;
3958 };
3959 #endif /* MULTIPLICITY */
3960
3961 typedef void *Thread;
3962
3963 /* Done with PERLVAR macros for now ... */
3964 #undef PERLVAR
3965 #undef PERLVARA
3966 #undef PERLVARI
3967 #undef PERLVARIC
3968 #undef PERLVARISC
3969
3970 struct tempsym; /* defined in pp_pack.c */
3971
3972 #include "thread.h"
3973 #include "pp.h"
3974
3975 #ifndef PERL_CALLCONV
3976 #  define PERL_CALLCONV
3977 #endif
3978 #undef PERL_CKDEF
3979 #undef PERL_PPDEF
3980 #define PERL_CKDEF(s)   PERL_CALLCONV OP *s (pTHX_ OP *o);
3981 #define PERL_PPDEF(s)   PERL_CALLCONV OP *s (pTHX);
3982
3983 #include "proto.h"
3984
3985 /* this has structure inits, so it cannot be included before here */
3986 #include "opcode.h"
3987
3988 /* The following must follow proto.h as #defines mess up syntax */
3989
3990 #if !defined(PERL_FOR_X2P)
3991 #  include "embedvar.h"
3992 #endif
3993
3994 /* Now include all the 'global' variables
3995  * If we don't have threads or multiple interpreters
3996  * these include variables that would have been their struct-s
3997  */
3998
3999 #define PERLVAR(var,type) EXT type PL_##var;
4000 #define PERLVARA(var,n,type) EXT type PL_##var[n];
4001 #define PERLVARI(var,type,init) EXT type  PL_##var INIT(init);
4002 #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
4003 #define PERLVARISC(var,init) EXTCONST char PL_##var[sizeof(init)] INIT(init);
4004
4005 #if !defined(MULTIPLICITY)
4006 START_EXTERN_C
4007 #  include "intrpvar.h"
4008 #  include "thrdvar.h"
4009 END_EXTERN_C
4010 #endif
4011
4012 #if defined(WIN32)
4013 /* Now all the config stuff is setup we can include embed.h */
4014 #  include "embed.h"
4015 #endif
4016
4017 #ifndef PERL_GLOBAL_STRUCT
4018 START_EXTERN_C
4019
4020 #  include "perlvars.h"
4021
4022 END_EXTERN_C
4023 #endif
4024
4025 #undef PERLVAR
4026 #undef PERLVARA
4027 #undef PERLVARI
4028 #undef PERLVARIC
4029
4030 START_EXTERN_C
4031
4032 #ifdef DOINIT
4033 #  define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {a,b,c,d,e,f,g}
4034 #else
4035 #  define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
4036 #endif
4037
4038 MGVTBL_SET(
4039     PL_vtbl_sv,
4040     MEMBER_TO_FPTR(Perl_magic_get),
4041     MEMBER_TO_FPTR(Perl_magic_set),
4042     MEMBER_TO_FPTR(Perl_magic_len),
4043     NULL,
4044     NULL,
4045     NULL,
4046     NULL
4047 );
4048
4049 MGVTBL_SET(
4050     PL_vtbl_env,
4051     NULL,
4052     MEMBER_TO_FPTR(Perl_magic_set_all_env),
4053     NULL,
4054     MEMBER_TO_FPTR(Perl_magic_clear_all_env),
4055     NULL,
4056     NULL,
4057     NULL
4058 );
4059
4060 MGVTBL_SET(
4061     PL_vtbl_envelem,
4062     NULL,
4063     MEMBER_TO_FPTR(Perl_magic_setenv),
4064     NULL,
4065     MEMBER_TO_FPTR(Perl_magic_clearenv),
4066     NULL,
4067     NULL,
4068     NULL
4069 );
4070
4071 MGVTBL_SET(
4072     PL_vtbl_sig,
4073     NULL,
4074     NULL,
4075     NULL,
4076     NULL,
4077     NULL,
4078     NULL,
4079     NULL
4080 );
4081
4082 #ifdef PERL_MICRO
4083 MGVTBL_SET(
4084     PL_vtbl_sigelem,
4085     NULL, NULL, NULL, NULL, NULL, NULL, NULL
4086 );
4087
4088 #else
4089 MGVTBL_SET(
4090     PL_vtbl_sigelem,
4091     MEMBER_TO_FPTR(Perl_magic_getsig),
4092     MEMBER_TO_FPTR(Perl_magic_setsig),
4093     NULL,
4094     MEMBER_TO_FPTR(Perl_magic_clearsig),
4095     NULL,
4096     NULL,
4097     NULL
4098 );
4099 #endif
4100
4101 MGVTBL_SET(
4102     PL_vtbl_pack,
4103     NULL,
4104     NULL,
4105     MEMBER_TO_FPTR(Perl_magic_sizepack),
4106     MEMBER_TO_FPTR(Perl_magic_wipepack),
4107     NULL,
4108     NULL,
4109     NULL
4110 );
4111
4112 MGVTBL_SET(
4113     PL_vtbl_packelem,
4114     MEMBER_TO_FPTR(Perl_magic_getpack),
4115     MEMBER_TO_FPTR(Perl_magic_setpack),
4116     NULL,
4117     MEMBER_TO_FPTR(Perl_magic_clearpack),
4118     NULL,
4119     NULL,
4120     NULL
4121 );
4122
4123 MGVTBL_SET(
4124     PL_vtbl_dbline,
4125     NULL,
4126     MEMBER_TO_FPTR(Perl_magic_setdbline),
4127     NULL,
4128     NULL,
4129     NULL,
4130     NULL,
4131     NULL
4132 );
4133
4134 MGVTBL_SET(
4135     PL_vtbl_isa,
4136     NULL,
4137     MEMBER_TO_FPTR(Perl_magic_setisa),
4138     NULL,
4139     MEMBER_TO_FPTR(Perl_magic_setisa),
4140     NULL,
4141     NULL,
4142     NULL
4143 );
4144
4145 MGVTBL_SET(
4146     PL_vtbl_isaelem,
4147     NULL,
4148     MEMBER_TO_FPTR(Perl_magic_setisa),
4149     NULL,
4150     NULL,
4151     NULL,
4152     NULL,
4153     NULL
4154 );
4155
4156 MGVTBL_SET(
4157     PL_vtbl_arylen,
4158     MEMBER_TO_FPTR(Perl_magic_getarylen),
4159     MEMBER_TO_FPTR(Perl_magic_setarylen),
4160     NULL,
4161     NULL,
4162     NULL,
4163     NULL,
4164     NULL
4165 );
4166
4167 MGVTBL_SET(
4168     PL_vtbl_glob,
4169     MEMBER_TO_FPTR(Perl_magic_getglob),
4170     MEMBER_TO_FPTR(Perl_magic_setglob),
4171     NULL,
4172     NULL,
4173     NULL,
4174     NULL,
4175     NULL
4176 );
4177
4178 MGVTBL_SET(
4179     PL_vtbl_mglob,
4180     NULL,
4181     MEMBER_TO_FPTR(Perl_magic_setmglob),
4182     NULL,
4183     NULL,
4184     NULL,
4185     NULL,
4186     NULL
4187 );
4188
4189 MGVTBL_SET(
4190     PL_vtbl_nkeys,
4191     MEMBER_TO_FPTR(Perl_magic_getnkeys),
4192     MEMBER_TO_FPTR(Perl_magic_setnkeys),
4193     NULL,
4194     NULL,
4195     NULL,
4196     NULL,
4197     NULL
4198 );
4199
4200 MGVTBL_SET(
4201     PL_vtbl_taint,
4202     MEMBER_TO_FPTR(Perl_magic_gettaint),
4203     MEMBER_TO_FPTR(Perl_magic_settaint),
4204     NULL,
4205     NULL,
4206     NULL,
4207     NULL,
4208     NULL
4209 );
4210
4211 MGVTBL_SET(
4212     PL_vtbl_substr,
4213     MEMBER_TO_FPTR(Perl_magic_getsubstr),
4214     MEMBER_TO_FPTR(Perl_magic_setsubstr),
4215     NULL,
4216     NULL,
4217     NULL,
4218     NULL,
4219     NULL
4220 );
4221
4222 MGVTBL_SET(
4223     PL_vtbl_vec,
4224     MEMBER_TO_FPTR(Perl_magic_getvec),
4225     MEMBER_TO_FPTR(Perl_magic_setvec),
4226     NULL,
4227     NULL,
4228     NULL,
4229     NULL,
4230     NULL
4231 );
4232
4233 MGVTBL_SET(
4234     PL_vtbl_pos,
4235     MEMBER_TO_FPTR(Perl_magic_getpos),
4236     MEMBER_TO_FPTR(Perl_magic_setpos),
4237     NULL,
4238     NULL,
4239     NULL,
4240     NULL,
4241     NULL
4242 );
4243
4244 MGVTBL_SET(
4245     PL_vtbl_bm,
4246     NULL,
4247     MEMBER_TO_FPTR(Perl_magic_setbm),
4248     NULL,
4249     NULL,
4250     NULL,
4251     NULL,
4252     NULL
4253 );
4254
4255 MGVTBL_SET(
4256     PL_vtbl_fm,
4257     NULL,
4258     MEMBER_TO_FPTR(Perl_magic_setfm),
4259     NULL,
4260     NULL,
4261     NULL,
4262     NULL,
4263     NULL
4264 );
4265
4266 MGVTBL_SET(
4267     PL_vtbl_uvar,
4268     MEMBER_TO_FPTR(Perl_magic_getuvar),
4269     MEMBER_TO_FPTR(Perl_magic_setuvar),
4270     NULL,
4271     NULL,
4272     NULL,
4273     NULL,
4274     NULL
4275 );
4276
4277 MGVTBL_SET(
4278     PL_vtbl_defelem,
4279     MEMBER_TO_FPTR(Perl_magic_getdefelem),
4280     MEMBER_TO_FPTR(Perl_magic_setdefelem),
4281     NULL,
4282     NULL,
4283     NULL,
4284     NULL,
4285     NULL
4286 );
4287
4288 MGVTBL_SET(
4289     PL_vtbl_regexp,
4290     NULL,
4291     MEMBER_TO_FPTR(Perl_magic_setregexp),
4292     NULL,
4293     NULL,
4294     MEMBER_TO_FPTR(Perl_magic_freeregexp),
4295     NULL,
4296     NULL
4297 );
4298
4299 MGVTBL_SET(
4300     PL_vtbl_regdata,
4301     NULL,
4302     NULL,
4303     MEMBER_TO_FPTR(Perl_magic_regdata_cnt),
4304     NULL,
4305     NULL,
4306     NULL,
4307     NULL
4308 );
4309
4310 MGVTBL_SET(
4311     PL_vtbl_regdatum,
4312     MEMBER_TO_FPTR(Perl_magic_regdatum_get),
4313     MEMBER_TO_FPTR(Perl_magic_regdatum_set),
4314     NULL,
4315     NULL,
4316     NULL,
4317     NULL,
4318     NULL
4319 );
4320
4321 MGVTBL_SET(
4322     PL_vtbl_amagic,
4323     NULL,
4324     MEMBER_TO_FPTR(Perl_magic_setamagic),
4325     NULL,
4326     NULL,
4327     MEMBER_TO_FPTR(Perl_magic_setamagic),
4328     NULL,
4329     NULL
4330 );
4331
4332 MGVTBL_SET(
4333     PL_vtbl_amagicelem,
4334     NULL,
4335     MEMBER_TO_FPTR(Perl_magic_setamagic),
4336     NULL,
4337     NULL,
4338     MEMBER_TO_FPTR(Perl_magic_setamagic),
4339     NULL,
4340     NULL
4341 );
4342
4343 MGVTBL_SET(
4344     PL_vtbl_backref,
4345     NULL,
4346     NULL,
4347     NULL,
4348     NULL,
4349     MEMBER_TO_FPTR(Perl_magic_killbackrefs),
4350     NULL,
4351     NULL
4352 );
4353
4354 MGVTBL_SET(
4355     PL_vtbl_ovrld,
4356     NULL,
4357     NULL,
4358     NULL,
4359     NULL,
4360     MEMBER_TO_FPTR(Perl_magic_freeovrld),
4361     NULL,
4362     NULL
4363 );
4364
4365 MGVTBL_SET(
4366     PL_vtbl_utf8,
4367     NULL,
4368     MEMBER_TO_FPTR(Perl_magic_setutf8),
4369     NULL,
4370     NULL,
4371     NULL,
4372     NULL,
4373     NULL
4374 );
4375 #ifdef USE_LOCALE_COLLATE
4376 MGVTBL_SET(
4377     PL_vtbl_collxfrm,
4378     NULL,
4379     MEMBER_TO_FPTR(Perl_magic_setcollxfrm),
4380     NULL,
4381     NULL,
4382     NULL,
4383     NULL,
4384     NULL
4385 );
4386 #endif
4387
4388
4389 enum {
4390   fallback_amg,        abs_amg,
4391   bool__amg,   nomethod_amg,
4392   string_amg,  numer_amg,
4393   add_amg,     add_ass_amg,
4394   subtr_amg,   subtr_ass_amg,
4395   mult_amg,    mult_ass_amg,
4396   div_amg,     div_ass_amg,
4397   modulo_amg,  modulo_ass_amg,
4398   pow_amg,     pow_ass_amg,
4399   lshift_amg,  lshift_ass_amg,
4400   rshift_amg,  rshift_ass_amg,
4401   band_amg,    band_ass_amg,
4402   bor_amg,     bor_ass_amg,
4403   bxor_amg,    bxor_ass_amg,
4404   lt_amg,      le_amg,
4405   gt_amg,      ge_amg,
4406   eq_amg,      ne_amg,
4407   ncmp_amg,    scmp_amg,
4408   slt_amg,     sle_amg,
4409   sgt_amg,     sge_amg,
4410   seq_amg,     sne_amg,
4411   not_amg,     compl_amg,
4412   inc_amg,     dec_amg,
4413   atan2_amg,   cos_amg,
4414   sin_amg,     exp_amg,
4415   log_amg,     sqrt_amg,
4416   repeat_amg,   repeat_ass_amg,
4417   concat_amg,  concat_ass_amg,
4418   copy_amg,    neg_amg,
4419   to_sv_amg,   to_av_amg,
4420   to_hv_amg,   to_gv_amg,
4421   to_cv_amg,   iter_amg,
4422   int_amg,      DESTROY_amg,
4423   max_amg_code
4424   /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
4425 };
4426
4427 #define NofAMmeth max_amg_code
4428 #define AMG_id2name(id) (PL_AMG_names[id]+1)
4429
4430 #ifdef DOINIT
4431 EXTCONST char * const PL_AMG_names[NofAMmeth] = {
4432   /* Names kept in the symbol table.  fallback => "()", the rest has
4433      "(" prepended.  The only other place in perl which knows about
4434      this convention is AMG_id2name (used for debugging output and
4435      'nomethod' only), the only other place which has it hardwired is
4436      overload.pm.  */
4437   "()",         "(abs",                 /* "fallback" should be the first. */
4438   "(bool",      "(nomethod",
4439   "(\"\"",      "(0+",
4440   "(+",         "(+=",
4441   "(-",         "(-=",
4442   "(*",         "(*=",
4443   "(/",         "(/=",
4444   "(%",         "(%=",
4445   "(**",        "(**=",
4446   "(<<",        "(<<=",
4447   "(>>",        "(>>=",
4448   "(&",         "(&=",
4449   "(|",         "(|=",
4450   "(^",         "(^=",
4451   "(<",         "(<=",
4452   "(>",         "(>=",
4453   "(==",        "(!=",
4454   "(<=>",       "(cmp",
4455   "(lt",        "(le",
4456   "(gt",        "(ge",
4457   "(eq",        "(ne",
4458   "(!",         "(~",
4459   "(++",        "(--",
4460   "(atan2",     "(cos",
4461   "(sin",       "(exp",
4462   "(log",       "(sqrt",
4463   "(x",         "(x=",
4464   "(.",         "(.=",
4465   "(=",         "(neg",
4466   "(${}",       "(@{}",
4467   "(%{}",       "(*{}",
4468   "(&{}",       "(<>",
4469   "(int",       "DESTROY",
4470 };
4471 #else
4472 EXTCONST char * PL_AMG_names[NofAMmeth];
4473 #endif /* def INITAMAGIC */
4474
4475 END_EXTERN_C
4476
4477 struct am_table {
4478   U32 was_ok_sub;
4479   long was_ok_am;
4480   U32 flags;
4481   CV* table[NofAMmeth];
4482   long fallback;
4483 };
4484 struct am_table_short {
4485   U32 was_ok_sub;
4486   long was_ok_am;
4487   U32 flags;
4488 };
4489 typedef struct am_table AMT;
4490 typedef struct am_table_short AMTS;
4491
4492 #define AMGfallNEVER    1
4493 #define AMGfallNO       2
4494 #define AMGfallYES      3
4495
4496 #define AMTf_AMAGIC             1
4497 #define AMTf_OVERLOADED         2
4498 #define AMT_AMAGIC(amt)         ((amt)->flags & AMTf_AMAGIC)
4499 #define AMT_AMAGIC_on(amt)      ((amt)->flags |= AMTf_AMAGIC)
4500 #define AMT_AMAGIC_off(amt)     ((amt)->flags &= ~AMTf_AMAGIC)
4501 #define AMT_OVERLOADED(amt)     ((amt)->flags & AMTf_OVERLOADED)
4502 #define AMT_OVERLOADED_on(amt)  ((amt)->flags |= AMTf_OVERLOADED)
4503 #define AMT_OVERLOADED_off(amt) ((amt)->flags &= ~AMTf_OVERLOADED)
4504
4505 #define StashHANDLER(stash,meth)        gv_handler((stash),CAT2(meth,_amg))
4506
4507 /*
4508  * some compilers like to redefine cos et alia as faster
4509  * (and less accurate?) versions called F_cos et cetera (Quidquid
4510  * latine dictum sit, altum viditur.)  This trick collides with
4511  * the Perl overloading (amg).  The following #defines fool both.
4512  */
4513
4514 #ifdef _FASTMATH
4515 #   ifdef atan2
4516 #       define F_atan2_amg  atan2_amg
4517 #   endif
4518 #   ifdef cos
4519 #       define F_cos_amg    cos_amg
4520 #   endif
4521 #   ifdef exp
4522 #       define F_exp_amg    exp_amg
4523 #   endif
4524 #   ifdef log
4525 #       define F_log_amg    log_amg
4526 #   endif
4527 #   ifdef pow
4528 #       define F_pow_amg    pow_amg
4529 #   endif
4530 #   ifdef sin
4531 #       define F_sin_amg    sin_amg
4532 #   endif
4533 #   ifdef sqrt
4534 #       define F_sqrt_amg   sqrt_amg
4535 #   endif
4536 #endif /* _FASTMATH */
4537
4538 #define PERLDB_ALL              (PERLDBf_SUB    | PERLDBf_LINE  |       \
4539                                  PERLDBf_NOOPT  | PERLDBf_INTER |       \
4540                                  PERLDBf_SUBLINE| PERLDBf_SINGLE|       \
4541                                  PERLDBf_NAMEEVAL| PERLDBf_NAMEANON )
4542                                         /* No _NONAME, _GOTO, _ASSERTION */
4543 #define PERLDBf_SUB             0x01    /* Debug sub enter/exit */
4544 #define PERLDBf_LINE            0x02    /* Keep line # */
4545 #define PERLDBf_NOOPT           0x04    /* Switch off optimizations */
4546 #define PERLDBf_INTER           0x08    /* Preserve more data for
4547                                            later inspections  */
4548 #define PERLDBf_SUBLINE         0x10    /* Keep subr source lines */
4549 #define PERLDBf_SINGLE          0x20    /* Start with single-step on */
4550 #define PERLDBf_NONAME          0x40    /* For _SUB: no name of the subr */
4551 #define PERLDBf_GOTO            0x80    /* Report goto: call DB::goto */
4552 #define PERLDBf_NAMEEVAL        0x100   /* Informative names for evals */
4553 #define PERLDBf_NAMEANON        0x200   /* Informative names for anon subs */
4554 #define PERLDBf_ASSERTION       0x400   /* Debug assertion subs enter/exit */
4555
4556 #define PERLDB_SUB      (PL_perldb && (PL_perldb & PERLDBf_SUB))
4557 #define PERLDB_LINE     (PL_perldb && (PL_perldb & PERLDBf_LINE))
4558 #define PERLDB_NOOPT    (PL_perldb && (PL_perldb & PERLDBf_NOOPT))
4559 #define PERLDB_INTER    (PL_perldb && (PL_perldb & PERLDBf_INTER))
4560 #define PERLDB_SUBLINE  (PL_perldb && (PL_perldb & PERLDBf_SUBLINE))
4561 #define PERLDB_SINGLE   (PL_perldb && (PL_perldb & PERLDBf_SINGLE))
4562 #define PERLDB_SUB_NN   (PL_perldb && (PL_perldb & (PERLDBf_NONAME)))
4563 #define PERLDB_GOTO     (PL_perldb && (PL_perldb & PERLDBf_GOTO))
4564 #define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL))
4565 #define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
4566 #define PERLDB_ASSERTION (PL_perldb && (PL_perldb & PERLDBf_ASSERTION))
4567
4568 #ifdef USE_LOCALE_NUMERIC
4569
4570 #define SET_NUMERIC_STANDARD() \
4571         set_numeric_standard();
4572
4573 #define SET_NUMERIC_LOCAL() \
4574         set_numeric_local();
4575
4576 #define IN_LOCALE_RUNTIME       (PL_curcop->op_private & HINT_LOCALE)
4577 #define IN_LOCALE_COMPILETIME   (PL_hints & HINT_LOCALE)
4578
4579 #define IN_LOCALE \
4580         (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
4581
4582 #define STORE_NUMERIC_LOCAL_SET_STANDARD() \
4583         bool was_local = PL_numeric_local && IN_LOCALE; \
4584         if (was_local) SET_NUMERIC_STANDARD();
4585
4586 #define STORE_NUMERIC_STANDARD_SET_LOCAL() \
4587         bool was_standard = PL_numeric_standard && IN_LOCALE; \
4588         if (was_standard) SET_NUMERIC_LOCAL();
4589
4590 #define RESTORE_NUMERIC_LOCAL() \
4591         if (was_local) SET_NUMERIC_LOCAL();
4592
4593 #define RESTORE_NUMERIC_STANDARD() \
4594         if (was_standard) SET_NUMERIC_STANDARD();
4595
4596 #define Atof                            my_atof
4597
4598 #else /* !USE_LOCALE_NUMERIC */
4599
4600 #define SET_NUMERIC_STANDARD()          /**/
4601 #define SET_NUMERIC_LOCAL()             /**/
4602 #define IS_NUMERIC_RADIX(a, b)          (0)
4603 #define STORE_NUMERIC_LOCAL_SET_STANDARD()      /**/
4604 #define STORE_NUMERIC_STANDARD_SET_LOCAL()      /**/
4605 #define RESTORE_NUMERIC_LOCAL()         /**/
4606 #define RESTORE_NUMERIC_STANDARD()      /**/
4607 #define Atof                            my_atof
4608 #define IN_LOCALE_RUNTIME               0
4609
4610 #endif /* !USE_LOCALE_NUMERIC */
4611
4612 #if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG
4613 #    ifdef __hpux
4614 #        define strtoll __strtoll       /* secret handshake */
4615 #    endif
4616 #    ifdef WIN64
4617 #        define strtoll _strtoi64       /* secret handshake */
4618 #    endif
4619 #   if !defined(Strtol) && defined(HAS_STRTOLL)
4620 #       define Strtol   strtoll
4621 #   endif
4622 #    if !defined(Strtol) && defined(HAS_STRTOQ)
4623 #       define Strtol   strtoq
4624 #    endif
4625 /* is there atoq() anywhere? */
4626 #endif
4627 #if !defined(Strtol) && defined(HAS_STRTOL)
4628 #   define Strtol       strtol
4629 #endif
4630 #ifndef Atol
4631 /* It would be more fashionable to use Strtol() to define atol()
4632  * (as is done for Atoul(), see below) but for backward compatibility
4633  * we just assume atol(). */
4634 #   if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_ATOLL)
4635 #    ifdef WIN64
4636 #       define atoll    _atoi64         /* secret handshake */
4637 #    endif
4638 #       define Atol     atoll
4639 #   else
4640 #       define Atol     atol
4641 #   endif
4642 #endif
4643
4644 #if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG
4645 #    ifdef __hpux
4646 #        define strtoull __strtoull     /* secret handshake */
4647 #    endif
4648 #    ifdef WIN64
4649 #        define strtoull _strtoui64     /* secret handshake */
4650 #    endif
4651 #    if !defined(Strtoul) && defined(HAS_STRTOULL)
4652 #       define Strtoul  strtoull
4653 #    endif
4654 #    if !defined(Strtoul) && defined(HAS_STRTOUQ)
4655 #       define Strtoul  strtouq
4656 #    endif
4657 /* is there atouq() anywhere? */
4658 #endif
4659 #if !defined(Strtoul) && defined(HAS_STRTOUL)
4660 #   define Strtoul      strtoul
4661 #endif
4662 #if !defined(Strtoul) && defined(HAS_STRTOL) /* Last resort. */
4663 #   define Strtoul(s, e, b)     strchr((s), '-') ? ULONG_MAX : (unsigned long)strtol((s), (e), (b))
4664 #endif
4665 #ifndef Atoul
4666 #   define Atoul(s)     Strtoul(s, (char **)NULL, 10)
4667 #endif
4668
4669
4670 /* if these never got defined, they need defaults */
4671 #ifndef PERL_SET_CONTEXT
4672 #  define PERL_SET_CONTEXT(i)           PERL_SET_INTERP(i)
4673 #endif
4674
4675 #ifndef PERL_GET_CONTEXT
4676 #  define PERL_GET_CONTEXT              PERL_GET_INTERP
4677 #endif
4678
4679 #ifndef PERL_GET_THX
4680 #  define PERL_GET_THX                  ((void*)NULL)
4681 #endif
4682
4683 #ifndef PERL_SET_THX
4684 #  define PERL_SET_THX(t)               NOOP
4685 #endif
4686
4687 #ifndef PERL_SCRIPT_MODE
4688 #define PERL_SCRIPT_MODE "r"
4689 #endif
4690
4691 /*
4692  * Some operating systems are stingy with stack allocation,
4693  * so perl may have to guard against stack overflow.
4694  */
4695 #ifndef PERL_STACK_OVERFLOW_CHECK
4696 #define PERL_STACK_OVERFLOW_CHECK()  NOOP
4697 #endif
4698
4699 /*
4700  * Some nonpreemptive operating systems find it convenient to
4701  * check for asynchronous conditions after each op execution.
4702  * Keep this check simple, or it may slow down execution
4703  * massively.
4704  */
4705
4706 #ifndef PERL_MICRO
4707 #       ifndef PERL_ASYNC_CHECK
4708 #               define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals()
4709 #       endif
4710 #endif
4711
4712 #ifndef PERL_ASYNC_CHECK
4713 #   define PERL_ASYNC_CHECK()  NOOP
4714 #endif
4715
4716 /*
4717  * On some operating systems, a memory allocation may succeed,
4718  * but put the process too close to the system's comfort limit.
4719  * In this case, PERL_ALLOC_CHECK frees the pointer and sets
4720  * it to NULL.
4721  */
4722 #ifndef PERL_ALLOC_CHECK
4723 #define PERL_ALLOC_CHECK(p)  NOOP
4724 #endif
4725
4726 /*
4727  * nice_chunk and nice_chunk size need to be set
4728  * and queried under the protection of sv_mutex
4729  */
4730 #define offer_nice_chunk(chunk, chunk_size) STMT_START {  \
4731        void *new_chunk;                                   \
4732        U32 new_chunk_size;                                \
4733        LOCK_SV_MUTEX;                                     \
4734        new_chunk = (void *)(chunk);                       \
4735        new_chunk_size = (chunk_size);                     \
4736        if (new_chunk_size > PL_nice_chunk_size) {         \
4737            if (PL_nice_chunk) Safefree(PL_nice_chunk);    \
4738            PL_nice_chunk = (char *) new_chunk;            \
4739            PL_nice_chunk_size = new_chunk_size;           \
4740        } else {                                           \
4741            Safefree(chunk);                               \
4742        }                                                  \
4743        UNLOCK_SV_MUTEX;                                   \
4744    } STMT_END
4745
4746 #ifdef HAS_SEM
4747 #   include <sys/ipc.h>
4748 #   include <sys/sem.h>
4749 #   ifndef HAS_UNION_SEMUN      /* Provide the union semun. */
4750     union semun {
4751         int             val;
4752         struct semid_ds *buf;
4753         unsigned short  *array;
4754     };
4755 #   endif
4756 #   ifdef USE_SEMCTL_SEMUN
4757 #       ifdef IRIX32_SEMUN_BROKEN_BY_GCC
4758             union gccbug_semun {
4759                 int             val;
4760                 struct semid_ds *buf;
4761                 unsigned short  *array;
4762                 char            __dummy[5];
4763             };
4764 #           define semun gccbug_semun
4765 #       endif
4766 #       define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
4767 #   else
4768 #       ifdef USE_SEMCTL_SEMID_DS
4769 #           ifdef EXTRA_F_IN_SEMUN_BUF
4770 #               define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buff)
4771 #           else
4772 #               define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
4773 #           endif
4774 #       endif
4775 #   endif
4776 #endif
4777
4778 /*
4779  * Boilerplate macros for initializing and accessing interpreter-local
4780  * data from C.  All statics in extensions should be reworked to use
4781  * this, if you want to make the extension thread-safe.  See ext/re/re.xs
4782  * for an example of the use of these macros, and perlxs.pod for more.
4783  *
4784  * Code that uses these macros is responsible for the following:
4785  * 1. #define MY_CXT_KEY to a unique string, e.g.
4786  *    "DynaLoader::_guts" XS_VERSION
4787  * 2. Declare a typedef named my_cxt_t that is a structure that contains
4788  *    all the data that needs to be interpreter-local.
4789  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4790  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4791  *    (typically put in the BOOT: section).
4792  * 5. Use the members of the my_cxt_t structure everywhere as
4793  *    MY_CXT.member.
4794  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4795  *    access MY_CXT.
4796  */
4797
4798 #if defined(PERL_IMPLICIT_CONTEXT)
4799
4800 /* This must appear in all extensions that define a my_cxt_t structure,
4801  * right after the definition (i.e. at file scope).  The non-threads
4802  * case below uses it to declare the data as static. */
4803 #define START_MY_CXT
4804
4805 /* Fetches the SV that keeps the per-interpreter data. */
4806 #define dMY_CXT_SV \
4807         SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,             \
4808                                   sizeof(MY_CXT_KEY)-1, TRUE)
4809
4810 /* This declaration should be used within all functions that use the
4811  * interpreter-local data. */
4812 #define dMY_CXT \
4813         dMY_CXT_SV;                                                     \
4814         my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*, SvUV(my_cxt_sv))
4815
4816 /* Creates and zeroes the per-interpreter data.
4817  * (We allocate my_cxtp in a Perl SV so that it will be released when
4818  * the interpreter goes away.) */
4819 #define MY_CXT_INIT \
4820         dMY_CXT_SV;                                                     \
4821         /* newSV() allocates one more than needed */                    \
4822         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4823         Zero(my_cxtp, 1, my_cxt_t);                                     \
4824         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4825
4826 /* Clones the per-interpreter data. */
4827 #define MY_CXT_CLONE \
4828         dMY_CXT_SV;                                                     \
4829         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4830         Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4831         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4832
4833 /* This macro must be used to access members of the my_cxt_t structure.
4834  * e.g. MYCXT.some_data */
4835 #define MY_CXT          (*my_cxtp)
4836
4837 /* Judicious use of these macros can reduce the number of times dMY_CXT
4838  * is used.  Use is similar to pTHX, aTHX etc. */
4839 #define pMY_CXT         my_cxt_t *my_cxtp
4840 #define pMY_CXT_        pMY_CXT,
4841 #define _pMY_CXT        ,pMY_CXT
4842 #define aMY_CXT         my_cxtp
4843 #define aMY_CXT_        aMY_CXT,
4844 #define _aMY_CXT        ,aMY_CXT
4845
4846 #else /* USE_ITHREADS */
4847
4848 #define START_MY_CXT    static my_cxt_t my_cxt;
4849 #define dMY_CXT_SV      dNOOP
4850 #define dMY_CXT         dNOOP
4851 #define MY_CXT_INIT     NOOP
4852 #define MY_CXT_CLONE    NOOP
4853 #define MY_CXT          my_cxt
4854
4855 #define pMY_CXT         void
4856 #define pMY_CXT_
4857 #define _pMY_CXT
4858 #define aMY_CXT
4859 #define aMY_CXT_
4860 #define _aMY_CXT
4861
4862 #endif /* !defined(USE_ITHREADS) */
4863
4864 #ifdef I_FCNTL
4865 #  include <fcntl.h>
4866 #endif
4867
4868 #ifdef __Lynx__
4869 #  include <fcntl.h>
4870 #endif
4871
4872 #ifdef I_SYS_FILE
4873 #  include <sys/file.h>
4874 #endif
4875
4876 #if defined(HAS_FLOCK) && !defined(HAS_FLOCK_PROTO)
4877 int flock(int fd, int op);
4878 #endif
4879
4880 #ifndef O_RDONLY
4881 /* Assume UNIX defaults */
4882 #    define O_RDONLY    0000
4883 #    define O_WRONLY    0001
4884 #    define O_RDWR      0002
4885 #    define O_CREAT     0100
4886 #endif
4887
4888 #ifndef O_BINARY
4889 #  define O_BINARY 0
4890 #endif
4891
4892 #ifndef O_TEXT
4893 #  define O_TEXT 0
4894 #endif
4895
4896 #if O_TEXT != O_BINARY
4897     /* If you have different O_TEXT and O_BINARY and you are a CLRF shop,
4898      * that is, you are somehow DOSish. */
4899 #   if defined(__BEOS__) || defined(__VOS__) || defined(__CYGWIN__)
4900     /* BeOS has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect;
4901      * BeOS is always UNIXoid (LF), not DOSish (CRLF). */
4902     /* VOS has O_TEXT != O_BINARY, and they have effect,
4903      * but VOS always uses LF, never CRLF. */
4904     /* If you have O_TEXT different from your O_BINARY but you still are
4905      * not a CRLF shop. */
4906 #       undef PERLIO_USING_CRLF
4907 #   else
4908     /* If you really are DOSish. */
4909 #      define PERLIO_USING_CRLF 1
4910 #   endif
4911 #endif
4912
4913 #ifdef IAMSUID
4914
4915 #ifdef I_SYS_STATVFS
4916 #   if defined(PERL_SCO) && !defined(_SVID3)
4917 #       define _SVID3
4918 #   endif
4919 #   include <sys/statvfs.h>     /* for f?statvfs() */
4920 #endif
4921 #ifdef I_SYS_MOUNT
4922 #   include <sys/mount.h>       /* for *BSD f?statfs() */
4923 #endif
4924 #ifdef I_MNTENT
4925 #   include <mntent.h>          /* for getmntent() */
4926 #endif
4927 #ifdef I_SYS_STATFS
4928 #   include <sys/statfs.h>      /* for some statfs() */
4929 #endif
4930 #ifdef I_SYS_VFS
4931 #  ifdef __sgi
4932 #    define sv IRIX_sv          /* kludge: IRIX has an sv of its own */
4933 #  endif
4934 #    include <sys/vfs.h>        /* for some statfs() */
4935 #  ifdef __sgi
4936 #    undef IRIX_sv
4937 #  endif
4938 #endif
4939 #ifdef I_USTAT
4940 #   include <ustat.h>           /* for ustat() */
4941 #endif
4942
4943 #if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID)
4944 #    define PERL_MOUNT_NOSUID MOUNT_NOSUID
4945 #endif
4946 #if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
4947 #    define PERL_MOUNT_NOSUID MNT_NOSUID
4948 #endif
4949 #if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
4950 #   define PERL_MOUNT_NOSUID MS_NOSUID
4951 #endif
4952 #if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
4953 #   define PERL_MOUNT_NOSUID M_NOSUID
4954 #endif
4955
4956 #if !defined(PERL_MOUNT_NOEXEC) && defined(MOUNT_NOEXEC)
4957 #    define PERL_MOUNT_NOEXEC MOUNT_NOEXEC
4958 #endif
4959 #if !defined(PERL_MOUNT_NOEXEC) && defined(MNT_NOEXEC)
4960 #    define PERL_MOUNT_NOEXEC MNT_NOEXEC
4961 #endif
4962 #if !defined(PERL_MOUNT_NOEXEC) && defined(MS_NOEXEC)
4963 #   define PERL_MOUNT_NOEXEC MS_NOEXEC
4964 #endif
4965 #if !defined(PERL_MOUNT_NOEXEC) && defined(M_NOEXEC)
4966 #   define PERL_MOUNT_NOEXEC M_NOEXEC
4967 #endif
4968
4969 #endif /* IAMSUID */
4970
4971 #ifdef I_LIBUTIL
4972 #   include <libutil.h>         /* setproctitle() in some FreeBSDs */
4973 #endif
4974
4975 #ifndef EXEC_ARGV_CAST
4976 #define EXEC_ARGV_CAST(x) x
4977 #endif
4978
4979 #define IS_NUMBER_IN_UV               0x01 /* number within UV range (maybe not
4980                                               int).  value returned in pointed-
4981                                               to UV */
4982 #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */
4983 #define IS_NUMBER_NOT_INT             0x04 /* saw . or E notation */
4984 #define IS_NUMBER_NEG                 0x08 /* leading minus sign */
4985 #define IS_NUMBER_INFINITY            0x10 /* this is big */
4986 #define IS_NUMBER_NAN                 0x20 /* this is not */
4987
4988 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
4989
4990 /* Input flags: */
4991 #define PERL_SCAN_ALLOW_UNDERSCORES   0x01 /* grok_??? accept _ in numbers */
4992 #define PERL_SCAN_DISALLOW_PREFIX     0x02 /* grok_??? reject 0x in hex etc */
4993 #define PERL_SCAN_SILENT_ILLDIGIT     0x04 /* grok_??? not warn about illegal digits */
4994 /* Output flags: */
4995 #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */
4996
4997 /* to let user control profiling */
4998 #ifdef PERL_GPROF_CONTROL
4999 extern void moncontrol(int);
5000 #define PERL_GPROF_MONCONTROL(x) moncontrol(x)
5001 #else
5002 #define PERL_GPROF_MONCONTROL(x)
5003 #endif
5004
5005 #ifdef UNDER_CE
5006 #include "wince.h"
5007 #endif
5008
5009 /* ISO 6429 NEL - C1 control NExt Line */
5010 /* See http://www.unicode.org/unicode/reports/tr13/ */
5011 #ifdef EBCDIC   /* In EBCDIC NEL is just an alias for LF */
5012 #   if '^' == 95        /* CP 1047: MVS OpenEdition - OS/390 - z/OS */
5013 #       define NEXT_LINE_CHAR   0x15
5014 #   else                /* CDRA */
5015 #       define NEXT_LINE_CHAR   0x25
5016 #   endif
5017 #else
5018 #   define NEXT_LINE_CHAR       0x85
5019 #endif
5020
5021 /* The UTF-8 bytes of the Unicode LS and PS, U+2028 and U+2029 */
5022 #define UNICODE_LINE_SEPA_0     0xE2
5023 #define UNICODE_LINE_SEPA_1     0x80
5024 #define UNICODE_LINE_SEPA_2     0xA8
5025 #define UNICODE_PARA_SEPA_0     0xE2
5026 #define UNICODE_PARA_SEPA_1     0x80
5027 #define UNICODE_PARA_SEPA_2     0xA9
5028
5029 #ifndef PIPESOCK_MODE
5030 #  define PIPESOCK_MODE
5031 #endif
5032
5033 #ifndef SOCKET_OPEN_MODE
5034 #  define SOCKET_OPEN_MODE      PIPESOCK_MODE
5035 #endif
5036
5037 #ifndef PIPE_OPEN_MODE
5038 #  define PIPE_OPEN_MODE        PIPESOCK_MODE
5039 #endif
5040
5041 #define PERL_MAGIC_UTF8_CACHESIZE       2
5042
5043 #define PERL_UNICODE_STDIN_FLAG                 0x0001
5044 #define PERL_UNICODE_STDOUT_FLAG                0x0002
5045 #define PERL_UNICODE_STDERR_FLAG                0x0004
5046 #define PERL_UNICODE_IN_FLAG                    0x0008
5047 #define PERL_UNICODE_OUT_FLAG                   0x0010
5048 #define PERL_UNICODE_ARGV_FLAG                  0x0020
5049 #define PERL_UNICODE_LOCALE_FLAG                0x0040
5050 #define PERL_UNICODE_WIDESYSCALLS_FLAG          0x0080 /* for Sarathy */
5051
5052 #define PERL_UNICODE_STD_FLAG           \
5053         (PERL_UNICODE_STDIN_FLAG        | \
5054          PERL_UNICODE_STDOUT_FLAG       | \
5055          PERL_UNICODE_STDERR_FLAG)
5056
5057 #define PERL_UNICODE_INOUT_FLAG         \
5058         (PERL_UNICODE_IN_FLAG   | \