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