perl.h

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