perl.h

   1 /*    perl.h
   2  *
   3  *    Copyright (c) 1987-2001, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9 #ifndef H_PERL
  10 #define H_PERL 1
  11
  12 #ifdef PERL_FOR_X2P
  13 /*
  14  * This file is being used for x2p stuff.
  15  * Above symbol is defined via -D in 'x2p/Makefile.SH'
  16  * Decouple x2p stuff from some of perls more extreme eccentricities.
  17  */
  18 #undef MULTIPLICITY
  19 #undef USE_STDIO
  20 #define USE_STDIO
  21 #endif /* PERL_FOR_X2P */
  22
  23 #define VOIDUSED 1
  24 #ifdef PERL_MICRO
  25 #   include "uconfig.h"
  26 #else
  27 #   include "config.h"
  28 #endif
  29
  30 #if defined(USE_ITHREADS) && defined(USE_5005THREADS)
  31 #  include "error: USE_ITHREADS and USE_5005THREADS are incompatible"
  32 #endif
  33
  34 /* XXX This next guard can disappear if the sources are revised
  35    to use USE_5005THREADS throughout. -- A.D  1/6/2000
  36 */
  37 #if defined(USE_ITHREADS) && defined(USE_5005THREADS)
  38 #  include "error: USE_ITHREADS and USE_5005THREADS are incompatible"
  39 #endif
  40
  41 /* See L<perlguts/"The Perl API"> for detailed notes on
  42  * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
  43
  44 #ifdef USE_ITHREADS
  45 #  if !defined(MULTIPLICITY) && !defined(PERL_OBJECT)
  46 #    define MULTIPLICITY
  47 #  endif
  48 #endif
  49
  50 #ifdef USE_5005THREADS
  51 #  ifndef PERL_IMPLICIT_CONTEXT
  52 #    define PERL_IMPLICIT_CONTEXT
  53 #  endif
  54 #endif
  55
  56 #if defined(MULTIPLICITY)
  57 #  ifndef PERL_IMPLICIT_CONTEXT
  58 #    define PERL_IMPLICIT_CONTEXT
  59 #  endif
  60 #endif
  61
  62 #ifdef PERL_CAPI
  63 #  undef PERL_OBJECT
  64 #  ifndef MULTIPLICITY
  65 #    define MULTIPLICITY
  66 #  endif
  67 #  ifndef PERL_IMPLICIT_CONTEXT
  68 #    define PERL_IMPLICIT_CONTEXT
  69 #  endif
  70 #  ifndef PERL_IMPLICIT_SYS
  71 #    define PERL_IMPLICIT_SYS
  72 #  endif
  73 #endif
  74
  75 #ifdef PERL_OBJECT
  76 #  ifndef PERL_IMPLICIT_CONTEXT
  77 #    define PERL_IMPLICIT_CONTEXT
  78 #  endif
  79 #  ifndef PERL_IMPLICIT_SYS
  80 #    define PERL_IMPLICIT_SYS
  81 #  endif
  82 #endif
  83
  84 #ifdef PERL_OBJECT
  85
  86 /* PERL_OBJECT explained  - DickH and DougL @ ActiveState.com
  87
  88 Defining PERL_OBJECT turns on creation of a C++ object that
  89 contains all writable core perl global variables and functions.
  90 Stated another way, all necessary global variables and functions
  91 are members of a big C++ object. This object's class is CPerlObj.
  92 This allows a Perl Host to have multiple, independent perl
  93 interpreters in the same process space. This is very important on
  94 Win32 systems as the overhead of process creation is quite high --
  95 this could be even higher than the script compile and execute time
  96 for small scripts.
  97
  98 The perl executable implementation on Win32 is composed of perl.exe
  99 (the Perl Host) and perlX.dll. (the Perl Core). This allows the
 100 same Perl Core to easily be embedded in other applications that use
 101 the perl interpreter.
 102
 103 +-----------+
 104 | Perl Host |
 105 +-----------+
 106       ^
 107       |
 108       v
 109 +-----------+   +-----------+
 110 | Perl Core |<->| Extension |
 111 +-----------+   +-----------+ ...
 112
 113 Defining PERL_OBJECT has the following effects:
 114
 115 PERL CORE
 116 1. CPerlObj is defined (this is the PERL_OBJECT)
 117 2. all static functions that needed to access either global
 118 variables or functions needed are made member functions
 119 3. all writable static variables are made member variables
 120 4. all global variables and functions are defined as:
 121         #define var CPerlObj::PL_var
 122         #define func CPerlObj::Perl_func
 123         * these are in embed.h
 124 This necessitated renaming some local variables and functions that
 125 had the same name as a global variable or function. This was
 126 probably a _good_ thing anyway.
 127
 128
 129 EXTENSIONS
 130 1. Access to global variables and perl functions is through a
 131 pointer to the PERL_OBJECT. This pointer type is CPerlObj*. This is
 132 made transparent to extension developers by the following macros:
 133         #define var pPerl->PL_var
 134         #define func pPerl->Perl_func
 135         * these are done in objXSUB.h
 136 This requires that the extension be compiled as C++, which means
 137 that the code must be ANSI C and not K&R C. For K&R extensions,
 138 please see the C API notes located in Win32/GenCAPI.pl. This script
 139 creates a perlCAPI.lib that provides a K & R compatible C interface
 140 to the PERL_OBJECT.
 141 2. Local variables and functions cannot have the same name as perl's
 142 variables or functions since the macros will redefine these. Look for
 143 this if you get some strange error message and it does not look like
 144 the code that you had written. This often happens with variables that
 145 are local to a function.
 146
 147 PERL HOST
 148 1. The perl host is linked with perlX.lib to get perl_alloc. This
 149 function will return a pointer to CPerlObj (the PERL_OBJECT). It
 150 takes pointers to the various PerlXXX_YYY interfaces (see iperlsys.h
 151 for more information on this).
 152 2. The perl host calls the same functions as normally would be
 153 called in setting up and running a perl script, except that the
 154 functions are now member functions of the PERL_OBJECT.
 155
 156 */
 157
 158
 159 class CPerlObj;
 160
 161 #define STATIC
 162 #define CPERLscope(x)           CPerlObj::x
 163 #define CALL_FPTR(fptr)         (aTHXo->*fptr)
 164
 165 #define pTHXo                   CPerlObj *pPerl
 166 #define pTHXo_                  pTHXo,
 167 #define aTHXo                   this
 168 #define aTHXo_                  this,
 169 #define PERL_OBJECT_THIS        aTHXo
 170 #define PERL_OBJECT_THIS_       aTHXo_
 171 #define dTHXoa(a)               pTHXo = (CPerlObj*)a
 172 #define dTHXo                   pTHXo = PERL_GET_THX
 173
 174 #define pTHXx           void
 175 #define pTHXx_
 176 #define aTHXx
 177 #define aTHXx_
 178
 179 #else /* !PERL_OBJECT */
 180
 181 #ifdef PERL_IMPLICIT_CONTEXT
 182 #  ifdef USE_5005THREADS
 183 struct perl_thread;
 184 #    define pTHX        register struct perl_thread *thr
 185 #    define aTHX        thr
 186 #    define dTHR        dNOOP /* only backward compatibility */
 187 #    define dTHXa(a)    pTHX = (struct perl_thread*)a
 188 #  else
 189 #    ifndef MULTIPLICITY
 190 #      define MULTIPLICITY
 191 #    endif
 192 #    define pTHX        register PerlInterpreter *my_perl
 193 #    define aTHX        my_perl
 194 #    define dTHXa(a)    pTHX = (PerlInterpreter*)a
 195 #  endif
 196 #  define dTHX          pTHX = PERL_GET_THX
 197 #  define pTHX_         pTHX,
 198 #  define aTHX_         aTHX,
 199 #  define pTHX_1        2
 200 #  define pTHX_2        3
 201 #  define pTHX_3        4
 202 #  define pTHX_4        5
 203 #endif
 204
 205 #define STATIC static
 206 #define CPERLscope(x) x
 207 #define CPERLarg void
 208 #define CPERLarg_
 209 #define _CPERLarg
 210 #define PERL_OBJECT_THIS
 211 #define _PERL_OBJECT_THIS
 212 #define PERL_OBJECT_THIS_
 213 #define CALL_FPTR(fptr) (*fptr)
 214
 215 #endif /* PERL_OBJECT */
 216
 217 #define CALLRUNOPS  CALL_FPTR(PL_runops)
 218 #define CALLREGCOMP CALL_FPTR(PL_regcompp)
 219 #define CALLREGEXEC CALL_FPTR(PL_regexecp)
 220 #define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start)
 221 #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
 222 #define CALLREGFREE CALL_FPTR(PL_regfree)
 223
 224 #ifdef PERL_FLEXIBLE_EXCEPTIONS
 225 #  define CALLPROTECT CALL_FPTR(PL_protect)
 226 #endif
 227
 228 #ifdef HASATTRIBUTE
 229 #  define PERL_UNUSED_DECL __attribute__((unused))
 230 #else
 231 #  define PERL_UNUSED_DECL
 232 #endif
 233
 234 /* gcc -Wall:
 235  * for silencing unused variables that are actually used most of the time,
 236  * but we cannot quite get rid of, such `ax' in PPCODE+noargs xsubs
 237  */
 238 #define PERL_UNUSED_VAR(var) if (0) var = var
 239
 240 #define NOOP (void)0
 241 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
 242
 243 #ifndef pTHX
 244 #  define pTHX          void
 245 #  define pTHX_
 246 #  define aTHX
 247 #  define aTHX_
 248 #  define dTHXa(a)      dNOOP
 249 #  define dTHX          dNOOP
 250 #  define pTHX_1        1
 251 #  define pTHX_2        2
 252 #  define pTHX_3        3
 253 #  define pTHX_4        4
 254 #endif
 255
 256 #ifndef pTHXo
 257 #  define pTHXo         pTHX
 258 #  define pTHXo_        pTHX_
 259 #  define aTHXo         aTHX
 260 #  define aTHXo_        aTHX_
 261 #  define dTHXo         dTHX
 262 #  define dTHXoa(x)     dTHXa(x)
 263 #endif
 264
 265 #ifndef pTHXx
 266 #  define pTHXx         register PerlInterpreter *my_perl
 267 #  define pTHXx_        pTHXx,
 268 #  define aTHXx         my_perl
 269 #  define aTHXx_        aTHXx,
 270 #  define dTHXx         dTHX
 271 #endif
 272
 273 /* Under PERL_IMPLICIT_SYS (used in Windows for fork emulation)
 274  * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...).
 275  * dTHXs is therefore needed for all functions using PerlIO_foo(). */
 276 #ifdef PERL_IMPLICIT_SYS
 277 #  define dTHXs         dTHX
 278 #else
 279 #  define dTHXs         dNOOP
 280 #endif
 281
 282 #undef START_EXTERN_C
 283 #undef END_EXTERN_C
 284 #undef EXTERN_C
 285 #ifdef __cplusplus
 286 #  define START_EXTERN_C extern "C" {
 287 #  define END_EXTERN_C }
 288 #  define EXTERN_C extern "C"
 289 #else
 290 #  define START_EXTERN_C
 291 #  define END_EXTERN_C
 292 #  define EXTERN_C extern
 293 #endif
 294
 295 #ifdef OP_IN_REGISTER
 296 #  ifdef __GNUC__
 297 #    define stringify_immed(s) #s
 298 #    define stringify(s) stringify_immed(s)
 299 register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 300 #  endif
 301 #endif
 302
 303 /*
 304  * STMT_START { statements; } STMT_END;
 305  * can be used as a single statement, as in
 306  * if (x) STMT_START { ... } STMT_END; else ...
 307  *
 308  * Trying to select a version that gives no warnings...
 309  */
 310 #if !(defined(STMT_START) && defined(STMT_END))
 311 # if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(__cplusplus)
 312 #   define STMT_START   (void)( /* gcc supports ``({ STATEMENTS; })'' */
 313 #   define STMT_END     )
 314 # else
 315    /* Now which other defined()s do we need here ??? */
 316 #  if (VOIDFLAGS) && (defined(sun) || defined(__sun__))
 317 #   define STMT_START   if (1)
 318 #   define STMT_END     else (void)0
 319 #  else
 320 #   define STMT_START   do
 321 #   define STMT_END     while (0)
 322 #  endif
 323 # endif
 324 #endif
 325
 326 #define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
 327 #define WITH_THR(s) WITH_THX(s)
 328
 329 /*
 330  * SOFT_CAST can be used for args to prototyped functions to retain some
 331  * type checking; it only casts if the compiler does not know prototypes.
 332  */
 333 #if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE)
 334 #define SOFT_CAST(type)
 335 #else
 336 #define SOFT_CAST(type) (type)
 337 #endif
 338
 339 #ifndef BYTEORDER  /* Should never happen -- byteorder is in config.h */
 340 #   define BYTEORDER 0x1234
 341 #endif
 342
 343 /* Overall memory policy? */
 344 #ifndef CONSERVATIVE
 345 #   define LIBERAL 1
 346 #endif
 347
 348 #if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90
 349 #define ASCIIish
 350 #else
 351 #undef  ASCIIish
 352 #endif
 353
 354 /*
 355  * The following contortions are brought to you on behalf of all the
 356  * standards, semi-standards, de facto standards, not-so-de-facto standards
 357  * of the world, as well as all the other botches anyone ever thought of.
 358  * The basic theory is that if we work hard enough here, the rest of the
 359  * code can be a lot prettier.  Well, so much for theory.  Sorry, Henry...
 360  */
 361
 362 /* define this once if either system, instead of cluttering up the src */
 363 #if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(NETWARE)
 364 #define DOSISH 1
 365 #endif
 366
 367 #if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE)
 368 # define STANDARD_C 1
 369 #endif
 370
 371 #if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE)
 372 # define DONT_DECLARE_STD 1
 373 #endif
 374
 375 #if defined(HASVOLATILE) || defined(STANDARD_C)
 376 #   ifdef __cplusplus
 377 #       define VOL              // to temporarily suppress warnings
 378 #   else
 379 #       define VOL volatile
 380 #   endif
 381 #else
 382 #   define VOL
 383 #endif
 384
 385 #define TAINT           (PL_tainted = TRUE)
 386 #define TAINT_NOT       (PL_tainted = FALSE)
 387 #define TAINT_IF(c)     if (c) { PL_tainted = TRUE; }
 388 #define TAINT_ENV()     if (PL_tainting) { taint_env(); }
 389 #define TAINT_PROPER(s) if (PL_tainting) { taint_proper(Nullch, s); }
 390
 391 /* XXX All process group stuff is handled in pp_sys.c.  Should these
 392    defines move there?  If so, I could simplify this a lot. --AD  9/96.
 393 */
 394 /* Process group stuff changed from traditional BSD to POSIX.
 395    perlfunc.pod documents the traditional BSD-style syntax, so we'll
 396    try to preserve that, if possible.
 397 */
 398 #ifdef HAS_SETPGID
 399 #  define BSD_SETPGRP(pid, pgrp)        setpgid((pid), (pgrp))
 400 #else
 401 #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
 402 #    define BSD_SETPGRP(pid, pgrp)      setpgrp((pid), (pgrp))
 403 #  else
 404 #    ifdef HAS_SETPGRP2  /* DG/UX */
 405 #      define BSD_SETPGRP(pid, pgrp)    setpgrp2((pid), (pgrp))
 406 #    endif
 407 #  endif
 408 #endif
 409 #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
 410 #  define HAS_SETPGRP  /* Well, effectively it does . . . */
 411 #endif
 412
 413 /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
 414     our life easier :-) so we'll try it.
 415 */
 416 #ifdef HAS_GETPGID
 417 #  define BSD_GETPGRP(pid)              getpgid((pid))
 418 #else
 419 #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
 420 #    define BSD_GETPGRP(pid)            getpgrp((pid))
 421 #  else
 422 #    ifdef HAS_GETPGRP2  /* DG/UX */
 423 #      define BSD_GETPGRP(pid)          getpgrp2((pid))
 424 #    endif
 425 #  endif
 426 #endif
 427 #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
 428 #  define HAS_GETPGRP  /* Well, effectively it does . . . */
 429 #endif
 430
 431 /* These are not exact synonyms, since setpgrp() and getpgrp() may
 432    have different behaviors, but perl.h used to define USE_BSDPGRP
 433    (prior to 5.003_05) so some extension might depend on it.
 434 */
 435 #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
 436 #  ifndef USE_BSDPGRP
 437 #    define USE_BSDPGRP
 438 #  endif
 439 #endif
 440
 441 /* Use the reentrant APIs like localtime_r and getpwent_r */
 442 /* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
 443 #if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(WIN32)
 444 #   define USE_REENTRANT_API
 445 #endif
 446
 447 /* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that
 448    pthread.h must be included before all other header files.
 449 */
 450 #if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) \
 451     && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD)
 452 #  include <pthread.h>
 453 #endif
 454
 455 #ifndef _TYPES_         /* If types.h defines this it's easy. */
 456 #   ifndef major                /* Does everyone's types.h define this? */
 457 #       include <sys/types.h>
 458 #   endif
 459 #endif
 460
 461 #ifdef __cplusplus
 462 #  ifndef I_STDARG
 463 #    define I_STDARG 1
 464 #  endif
 465 #endif
 466
 467 #ifdef I_STDARG
 468 #  include <stdarg.h>
 469 #else
 470 #  ifdef I_VARARGS
 471 #    include <varargs.h>
 472 #  endif
 473 #endif
 474
 475 #ifdef USE_NEXT_CTYPE
 476
 477 #if NX_CURRENT_COMPILER_RELEASE >= 500
 478 #  include <bsd/ctypes.h>
 479 #else
 480 #  if NX_CURRENT_COMPILER_RELEASE >= 400
 481 #    include <objc/NXCType.h>
 482 #  else /*  NX_CURRENT_COMPILER_RELEASE < 400 */
 483 #    include <appkit/NXCType.h>
 484 #  endif /*  NX_CURRENT_COMPILER_RELEASE >= 400 */
 485 #endif /*  NX_CURRENT_COMPILER_RELEASE >= 500 */
 486
 487 #else /* !USE_NEXT_CTYPE */
 488 #include <ctype.h>
 489 #endif /* USE_NEXT_CTYPE */
 490
 491 #ifdef METHOD   /* Defined by OSF/1 v3.0 by ctype.h */
 492 #undef METHOD
 493 #endif
 494
 495 #ifdef PERL_MICRO
 496 #   define NO_LOCALE
 497 #endif
 498
 499 #ifdef I_LOCALE
 500 #   include <locale.h>
 501 #endif
 502
 503 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
 504 #   define USE_LOCALE
 505 #   if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
 506        && defined(HAS_STRXFRM)
 507 #       define USE_LOCALE_COLLATE
 508 #   endif
 509 #   if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE)
 510 #       define USE_LOCALE_CTYPE
 511 #   endif
 512 #   if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC)
 513 #       define USE_LOCALE_NUMERIC
 514 #   endif
 515 #endif /* !NO_LOCALE && HAS_SETLOCALE */
 516
 517 #include <setjmp.h>
 518
 519 #ifdef I_SYS_PARAM
 520 #   ifdef PARAM_NEEDS_TYPES
 521 #       include <sys/types.h>
 522 #   endif
 523 #   include <sys/param.h>
 524 #endif
 525
 526 /* Use all the "standard" definitions? */
 527 #if defined(STANDARD_C) && defined(I_STDLIB)
 528 #   include <stdlib.h>
 529 #endif
 530
 531 /* If this causes problems, set i_unistd=undef in the hint file.  */
 532 #ifdef I_UNISTD
 533 #   include <unistd.h>
 534 #endif
 535
 536 #if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO)
 537 int syscall(int, ...);
 538 #endif
 539
 540 #if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO)
 541 int usleep(unsigned int);
 542 #endif
 543
 544 #ifdef PERL_MICRO /* Last chance to export Perl_my_swap */
 545 #  define MYSWAP
 546 #endif
 547
 548 #if !defined(PERL_FOR_X2P) && !defined(WIN32)
 549 #  include "embed.h"
 550 #endif
 551
 552 #define MEM_SIZE Size_t
 553
 554 #if defined(STANDARD_C) && defined(I_STDDEF)
 555 #   include <stddef.h>
 556 #   define STRUCT_OFFSET(s,m)  offsetof(s,m)
 557 #else
 558 #   define STRUCT_OFFSET(s,m)  (Size_t)(&(((s *)0)->m))
 559 #endif
 560
 561 #if defined(I_STRING) || defined(__cplusplus)
 562 #   include <string.h>
 563 #else
 564 #   include <strings.h>
 565 #endif
 566
 567 /* This comes after <stdlib.h> so we don't try to change the standard
 568  * library prototypes; we'll use our own in proto.h instead. */
 569
 570 #ifdef MYMALLOC
 571 #  ifdef PERL_POLLUTE_MALLOC
 572 #   ifndef PERL_EXTMALLOC_DEF
 573 #    define Perl_malloc         malloc
 574 #    define Perl_calloc         calloc
 575 #    define Perl_realloc        realloc
 576 #    define Perl_mfree          free
 577 #   endif
 578 #  else
 579 #    define EMBEDMYMALLOC       /* for compatibility */
 580 #  endif
 581 Malloc_t Perl_malloc (MEM_SIZE nbytes);
 582 Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size);
 583 Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes);
 584 /* 'mfree' rather than 'free', since there is already a 'perl_free'
 585  * that causes clashes with case-insensitive linkers */
 586 Free_t   Perl_mfree (Malloc_t where);
 587
 588 typedef struct perl_mstats perl_mstats_t;
 589
 590 #  define safemalloc  Perl_malloc
 591 #  define safecalloc  Perl_calloc
 592 #  define saferealloc Perl_realloc
 593 #  define safefree    Perl_mfree
 594 #else  /* MYMALLOC */
 595 #  define safemalloc  safesysmalloc
 596 #  define safecalloc  safesyscalloc
 597 #  define saferealloc safesysrealloc
 598 #  define safefree    safesysfree
 599 #endif /* MYMALLOC */
 600
 601 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
 602 #define strchr index
 603 #define strrchr rindex
 604 #endif
 605
 606 #ifdef I_MEMORY
 607 #  include <memory.h>
 608 #endif
 609
 610 #ifdef HAS_MEMCPY
 611 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 612 #    ifndef memcpy
 613         extern char * memcpy (char*, char*, int);
 614 #    endif
 615 #  endif
 616 #else
 617 #   ifndef memcpy
 618 #       ifdef HAS_BCOPY
 619 #           define memcpy(d,s,l) bcopy(s,d,l)
 620 #       else
 621 #           define memcpy(d,s,l) my_bcopy(s,d,l)
 622 #       endif
 623 #   endif
 624 #endif /* HAS_MEMCPY */
 625
 626 #ifdef HAS_MEMSET
 627 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 628 #    ifndef memset
 629         extern char *memset (char*, int, int);
 630 #    endif
 631 #  endif
 632 #else
 633 #  undef  memset
 634 #  define memset(d,c,l) my_memset(d,c,l)
 635 #endif /* HAS_MEMSET */
 636
 637 #if !defined(HAS_MEMMOVE) && !defined(memmove)
 638 #   if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
 639 #       define memmove(d,s,l) bcopy(s,d,l)
 640 #   else
 641 #       if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
 642 #           define memmove(d,s,l) memcpy(d,s,l)
 643 #       else
 644 #           define memmove(d,s,l) my_bcopy(s,d,l)
 645 #       endif
 646 #   endif
 647 #endif
 648
 649 #if defined(mips) && defined(ultrix) && !defined(__STDC__)
 650 #   undef HAS_MEMCMP
 651 #endif
 652
 653 #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
 654 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 655 #    ifndef memcmp
 656         extern int memcmp (char*, char*, int);
 657 #    endif
 658 #  endif
 659 #  ifdef BUGGY_MSC
 660   #  pragma function(memcmp)
 661 #  endif
 662 #else
 663 #   ifndef memcmp
 664 #       define memcmp   my_memcmp
 665 #   endif
 666 #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
 667
 668 #ifndef memzero
 669 #   ifdef HAS_MEMSET
 670 #       define memzero(d,l) memset(d,0,l)
 671 #   else
 672 #       ifdef HAS_BZERO
 673 #           define memzero(d,l) bzero(d,l)
 674 #       else
 675 #           define memzero(d,l) my_bzero(d,l)
 676 #       endif
 677 #   endif
 678 #endif
 679
 680 #ifndef memchr
 681 #   ifndef HAS_MEMCHR
 682 #       define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1)
 683 #   endif
 684 #endif
 685
 686 #ifndef HAS_BCMP
 687 #   ifndef bcmp
 688 #       define bcmp(s1,s2,l) memcmp(s1,s2,l)
 689 #   endif
 690 #endif /* !HAS_BCMP */
 691
 692 #ifdef I_NETINET_IN
 693 #   include <netinet/in.h>
 694 #endif
 695
 696 #ifdef I_ARPA_INET
 697 #   include <arpa/inet.h>
 698 #endif
 699
 700 #if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
 701 /* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
 702  * (the neo-BSD seem to do this).  */
 703 #   undef SF_APPEND
 704 #endif
 705
 706 #ifdef I_SYS_STAT
 707 #   include <sys/stat.h>
 708 #endif
 709
 710 /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
 711    like UTekV) are broken, sometimes giving false positives.  Undefine
 712    them here and let the code below set them to proper values.
 713
 714    The ghs macro stands for GreenHills Software C-1.8.5 which
 715    is the C compiler for sysV88 and the various derivatives.
 716    This header file bug is corrected in gcc-2.5.8 and later versions.
 717    --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94.  */
 718
 719 #if defined(uts) || (defined(m88k) && defined(ghs))
 720 #   undef S_ISDIR
 721 #   undef S_ISCHR
 722 #   undef S_ISBLK
 723 #   undef S_ISREG
 724 #   undef S_ISFIFO
 725 #   undef S_ISLNK
 726 #endif
 727
 728 #ifdef I_TIME
 729 #   include <time.h>
 730 #endif
 731
 732 #ifdef I_SYS_TIME
 733 #   ifdef I_SYS_TIME_KERNEL
 734 #       define KERNEL
 735 #   endif
 736 #   include <sys/time.h>
 737 #   ifdef I_SYS_TIME_KERNEL
 738 #       undef KERNEL
 739 #   endif
 740 #endif
 741
 742 #if defined(HAS_TIMES) && defined(I_SYS_TIMES)
 743 #    include <sys/times.h>
 744 #endif
 745
 746 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
 747 #   undef HAS_STRERROR
 748 #endif
 749
 750 #include <errno.h>
 751
 752 #if defined(WIN32) && (defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI))
 753 #  define WIN32SCK_IS_STDSCK            /* don't pull in custom wsock layer */
 754 #endif
 755
 756 /* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one */
 757 #if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN)
 758 #  define _SOCKADDR_LEN
 759 #endif
 760
 761 #if defined(HAS_SOCKET) && !defined(VMS) && !defined(WIN32) /* VMS/WIN32 handle sockets via vmsish.h/win32.h */
 762 # include <sys/socket.h>
 763 # if defined(USE_SOCKS) && defined(I_SOCKS)
 764 #   if !defined(INCLUDE_PROTOTYPES)
 765 #       define INCLUDE_PROTOTYPES /* for <socks.h> */
 766 #       define PERL_SOCKS_NEED_PROTOTYPES
 767 #   endif
 768 #   ifdef USE_5005THREADS
 769 #       define PERL_USE_THREADS /* store our value */
 770 #       undef USE_5005THREADS
 771 #   endif
 772 #   include <socks.h>
 773 #   ifdef USE_5005THREADS
 774 #       undef USE_5005THREADS /* socks.h does this on its own */
 775 #   endif
 776 #   ifdef PERL_USE_THREADS
 777 #       define USE_5005THREADS /* restore our value */
 778 #       undef PERL_USE_THREADS
 779 #   endif
 780 #   ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
 781 #       undef INCLUDE_PROTOTYPES
 782 #       undef PERL_SOCKS_NEED_PROTOTYPES
 783 #   endif
 784 # endif
 785 # ifdef I_NETDB
 786 #  ifdef NETWARE
 787 #   include<stdio.h>
 788 #  endif
 789 #  include <netdb.h>
 790 # endif
 791 # ifndef ENOTSOCK
 792 #  ifdef I_NET_ERRNO
 793 #   include <net/errno.h>
 794 #  endif
 795 # endif
 796 #endif
 797
 798 /* sockatmark() is so new (2001) that many places might have it hidden
 799  * behind some -D_BLAH_BLAH_SOURCE guard. */
 800 #if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO)
 801 int sockatmark(int);
 802 #endif
 803
 804 #ifdef SETERRNO
 805 # undef SETERRNO  /* SOCKS might have defined this */
 806 #endif
 807
 808 #ifdef VMS
 809 #   define SETERRNO(errcode,vmserrcode) \
 810         STMT_START {                    \
 811             set_errno(errcode);         \
 812             set_vaxc_errno(vmserrcode); \
 813         } STMT_END
 814 #else
 815 #   define SETERRNO(errcode,vmserrcode) (errno = (errcode))
 816 #endif
 817
 818 #ifdef USE_5005THREADS
 819 #  define ERRSV (thr->errsv)
 820 #  define DEFSV THREADSV(0)
 821 #  define SAVE_DEFSV save_threadsv(0)
 822 #else
 823 #  define ERRSV GvSV(PL_errgv)
 824 #  define DEFSV GvSV(PL_defgv)
 825 #  define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
 826 #endif /* USE_5005THREADS */
 827
 828 #define ERRHV GvHV(PL_errgv)    /* XXX unused, here for compatibility */
 829
 830 #ifndef errno
 831         extern int errno;     /* ANSI allows errno to be an lvalue expr.
 832                                * For example in multithreaded environments
 833                                * something like this might happen:
 834                                * extern int *_errno(void);
 835                                * #define errno (*_errno()) */
 836 #endif
 837
 838 #ifdef HAS_STRERROR
 839 #       ifdef VMS
 840         char *strerror (int,...);
 841 #       else
 842 #ifndef DONT_DECLARE_STD
 843         char *strerror (int);
 844 #endif
 845 #       endif
 846 #       ifndef Strerror
 847 #           define Strerror strerror
 848 #       endif
 849 #else
 850 #    ifdef HAS_SYS_ERRLIST
 851         extern int sys_nerr;
 852         extern char *sys_errlist[];
 853 #       ifndef Strerror
 854 #           define Strerror(e) \
 855                 ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
 856 #       endif
 857 #   endif
 858 #endif
 859
 860 #ifdef I_SYS_IOCTL
 861 #   ifndef _IOCTL_
 862 #       include <sys/ioctl.h>
 863 #   endif
 864 #endif
 865
 866 #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
 867 #   ifdef HAS_SOCKETPAIR
 868 #       undef HAS_SOCKETPAIR
 869 #   endif
 870 #   ifdef I_NDBM
 871 #       undef I_NDBM
 872 #   endif
 873 #endif
 874
 875 #if INTSIZE == 2
 876 #   define htoni htons
 877 #   define ntohi ntohs
 878 #else
 879 #   define htoni htonl
 880 #   define ntohi ntohl
 881 #endif
 882
 883 /* Configure already sets Direntry_t */
 884 #if defined(I_DIRENT)
 885 #   include <dirent.h>
 886     /* NeXT needs dirent + sys/dir.h */
 887 #   if  defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__))
 888 #       include <sys/dir.h>
 889 #   endif
 890 #else
 891 #   ifdef I_SYS_NDIR
 892 #       include <sys/ndir.h>
 893 #   else
 894 #       ifdef I_SYS_DIR
 895 #           ifdef hp9000s500
 896 #               include <ndir.h>        /* may be wrong in the future */
 897 #           else
 898 #               include <sys/dir.h>
 899 #           endif
 900 #       endif
 901 #   endif
 902 #endif
 903
 904 #ifdef PERL_MICRO
 905 #   ifndef DIR
 906 #      define DIR void
 907 #   endif
 908 #endif
 909
 910 #ifdef FPUTS_BOTCH
 911 /* work around botch in SunOS 4.0.1 and 4.0.2 */
 912 #   ifndef fputs
 913 #       define fputs(sv,fp) fprintf(fp,"%s",sv)
 914 #   endif
 915 #endif
 916
 917 /*
 918  * The following gobbledygook brought to you on behalf of __STDC__.
 919  * (I could just use #ifndef __STDC__, but this is more bulletproof
 920  * in the face of half-implementations.)
 921  */
 922
 923 #ifdef I_SYSMODE
 924 #include <sys/mode.h>
 925 #endif
 926
 927 #ifndef S_IFMT
 928 #   ifdef _S_IFMT
 929 #       define S_IFMT _S_IFMT
 930 #   else
 931 #       define S_IFMT 0170000
 932 #   endif
 933 #endif
 934
 935 #ifndef S_ISDIR
 936 #   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
 937 #endif
 938
 939 #ifndef S_ISCHR
 940 #   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
 941 #endif
 942
 943 #ifndef S_ISBLK
 944 #   ifdef S_IFBLK
 945 #       define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
 946 #   else
 947 #       define S_ISBLK(m) (0)
 948 #   endif
 949 #endif
 950
 951 #ifndef S_ISREG
 952 #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
 953 #endif
 954
 955 #ifndef S_ISFIFO
 956 #   ifdef S_IFIFO
 957 #       define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
 958 #   else
 959 #       define S_ISFIFO(m) (0)
 960 #   endif
 961 #endif
 962
 963 #ifndef S_ISLNK
 964 #   ifdef _S_ISLNK
 965 #       define S_ISLNK(m) _S_ISLNK(m)
 966 #   else
 967 #       ifdef _S_IFLNK
 968 #           define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
 969 #       else
 970 #           ifdef S_IFLNK
 971 #               define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
 972 #           else
 973 #               define S_ISLNK(m) (0)
 974 #           endif
 975 #       endif
 976 #   endif
 977 #endif
 978
 979 #ifndef S_ISSOCK
 980 #   ifdef _S_ISSOCK
 981 #       define S_ISSOCK(m) _S_ISSOCK(m)
 982 #   else
 983 #       ifdef _S_IFSOCK
 984 #           define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
 985 #       else
 986 #           ifdef S_IFSOCK
 987 #               define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
 988 #           else
 989 #               define S_ISSOCK(m) (0)
 990 #           endif
 991 #       endif
 992 #   endif
 993 #endif
 994
 995 #ifndef S_IRUSR
 996 #   ifdef S_IREAD
 997 #       define S_IRUSR S_IREAD
 998 #       define S_IWUSR S_IWRITE
 999 #       define S_IXUSR S_IEXEC
1000 #   else
1001 #       define S_IRUSR 0400
1002 #       define S_IWUSR 0200
1003 #       define S_IXUSR 0100
1004 #   endif
1005 #endif
1006
1007 #ifndef S_IRGRP
1008 #   ifdef S_IRUSR
1009 #       define S_IRGRP (S_IRUSR>>3)
1010 #       define S_IWGRP (S_IWUSR>>3)
1011 #       define S_IXGRP (S_IXUSR>>3)
1012 #   else
1013 #       define S_IRGRP 0040
1014 #       define S_IWGRP 0020
1015 #       define S_IXGRP 0010
1016 #   endif
1017 #endif
1018
1019 #ifndef S_IROTH
1020 #   ifdef S_IRUSR
1021 #       define S_IROTH (S_IRUSR>>6)
1022 #       define S_IWOTH (S_IWUSR>>6)
1023 #       define S_IXOTH (S_IXUSR>>6)
1024 #   else
1025 #       define S_IROTH 0040
1026 #       define S_IWOTH 0020
1027 #       define S_IXOTH 0010
1028 #   endif
1029 #endif
1030
1031 #ifndef S_ISUID
1032 #   define S_ISUID 04000
1033 #endif
1034
1035 #ifndef S_ISGID
1036 #   define S_ISGID 02000
1037 #endif
1038
1039 #ifndef S_IRWXU
1040 #   define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR)
1041 #endif
1042
1043 #ifndef S_IRWXG
1044 #   define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP)
1045 #endif
1046
1047 #ifndef S_IRWXO
1048 #   define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
1049 #endif
1050
1051 #ifndef S_IREAD
1052 #   define S_IREAD S_IRUSR
1053 #endif
1054
1055 #ifndef S_IWRITE
1056 #   define S_IWRITE S_IWUSR
1057 #endif
1058
1059 #ifndef S_IEXEC
1060 #   define S_IEXEC S_IXUSR
1061 #endif
1062
1063 #ifdef ff_next
1064 #   undef ff_next
1065 #endif
1066
1067 #if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
1068 #   define SLOPPYDIVIDE
1069 #endif
1070
1071 #ifdef UV
1072 #undef UV
1073 #endif
1074
1075 #ifdef  SPRINTF_E_BUG
1076 #  define sprintf UTS_sprintf_wrap
1077 #endif
1078
1079 /* Configure gets this right but the UTS compiler gets it wrong.
1080    -- Hal Morris <hom00@utsglobal.com> */
1081 #ifdef UTS
1082 #  undef  UVTYPE
1083 #  define UVTYPE unsigned
1084 #endif
1085
1086 /*
1087     The IV type is supposed to be long enough to hold any integral
1088     value or a pointer.
1089     --Andy Dougherty    August 1996
1090 */
1091
1092 typedef IVTYPE IV;
1093 typedef UVTYPE UV;
1094
1095 #if defined(USE_64_BIT_INT) && defined(HAS_QUAD)
1096 #  if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX)
1097 #    define IV_MAX INT64_MAX
1098 #    define IV_MIN INT64_MIN
1099 #    define UV_MAX UINT64_MAX
1100 #    ifndef UINT64_MIN
1101 #      define UINT64_MIN 0
1102 #    endif
1103 #    define UV_MIN UINT64_MIN
1104 #  else
1105 #    define IV_MAX PERL_QUAD_MAX
1106 #    define IV_MIN PERL_QUAD_MIN
1107 #    define UV_MAX PERL_UQUAD_MAX
1108 #    define UV_MIN PERL_UQUAD_MIN
1109 #  endif
1110 #  define IV_IS_QUAD
1111 #  define UV_IS_QUAD
1112 #else
1113 #  if defined(INT32_MAX) && IVSIZE == 4
1114 #    define IV_MAX INT32_MAX
1115 #    define IV_MIN INT32_MIN
1116 #    ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */
1117 #        define UV_MAX UINT32_MAX
1118 #    else
1119 #        define UV_MAX 4294967295U
1120 #    endif
1121 #    ifndef UINT32_MIN
1122 #      define UINT32_MIN 0
1123 #    endif
1124 #    define UV_MIN UINT32_MIN
1125 #  else
1126 #    define IV_MAX PERL_LONG_MAX
1127 #    define IV_MIN PERL_LONG_MIN
1128 #    define UV_MAX PERL_ULONG_MAX
1129 #    define UV_MIN PERL_ULONG_MIN
1130 #  endif
1131 #  if IVSIZE == 8
1132 #    define IV_IS_QUAD
1133 #    define UV_IS_QUAD
1134 #    ifndef HAS_QUAD
1135 #      define HAS_QUAD
1136 #    endif
1137 #  else
1138 #    undef IV_IS_QUAD
1139 #    undef UV_IS_QUAD
1140 #    undef HAS_QUAD
1141 #  endif
1142 #endif
1143
1144 #if defined(uts) || defined(UTS)
1145 #       undef UV_MAX
1146 #       define UV_MAX (4294967295u)
1147 #endif
1148
1149 #define IV_DIG (BIT_DIGITS(IVSIZE * 8))
1150 #define UV_DIG (BIT_DIGITS(UVSIZE * 8))
1151
1152 #ifndef NO_PERL_PRESERVE_IVUV
1153 #define PERL_PRESERVE_IVUV      /* We like our integers to stay integers. */
1154 #endif
1155
1156 /*
1157  *  The macros INT2PTR and NUM2PTR are (despite their names)
1158  *  bi-directional: they will convert int/float to or from pointers.
1159  *  However the conversion to int/float are named explicitly:
1160  *  PTR2IV, PTR2UV, PTR2NV.
1161  *
1162  *  For int conversions we do not need two casts if pointers are
1163  *  the same size as IV and UV.   Otherwise we need an explicit
1164  *  cast (PTRV) to avoid compiler warnings.
1165  */
1166 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
1167 #  define PTRV                  UV
1168 #  define INT2PTR(any,d)        (any)(d)
1169 #else
1170 #  if PTRSIZE == LONGSIZE
1171 #    define PTRV                unsigned long
1172 #  else
1173 #    define PTRV                unsigned
1174 #  endif
1175 #  define INT2PTR(any,d)        (any)(PTRV)(d)
1176 #endif
1177 #define NUM2PTR(any,d)  (any)(PTRV)(d)
1178 #define PTR2IV(p)       INT2PTR(IV,p)
1179 #define PTR2UV(p)       INT2PTR(UV,p)
1180 #define PTR2NV(p)       NUM2PTR(NV,p)
1181 #if PTRSIZE == LONGSIZE
1182 #  define PTR2ul(p)     (unsigned long)(p)
1183 #else
1184 #  define PTR2ul(p)     INT2PTR(unsigned long,p)
1185 #endif
1186
1187 #ifdef USE_LONG_DOUBLE
1188 #  if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
1189 #      define LONG_DOUBLE_EQUALS_DOUBLE
1190 #  endif
1191 #  if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE))
1192 #     undef USE_LONG_DOUBLE /* Ouch! */
1193 #  endif
1194 #endif
1195
1196 #ifdef OVR_DBL_DIG
1197 /* Use an overridden DBL_DIG */
1198 # ifdef DBL_DIG
1199 #  undef DBL_DIG
1200 # endif
1201 # define DBL_DIG OVR_DBL_DIG
1202 #else
1203 /* The following is all to get DBL_DIG, in order to pick a nice
1204    default value for printing floating point numbers in Gconvert.
1205    (see config.h)
1206 */
1207 #ifdef I_LIMITS
1208 #include <limits.h>
1209 #endif
1210 #ifdef I_FLOAT
1211 #include <float.h>
1212 #endif
1213 #ifndef HAS_DBL_DIG
1214 #define DBL_DIG 15   /* A guess that works lots of places */
1215 #endif
1216 #endif
1217 #ifdef I_FLOAT
1218 #include <float.h>
1219 #endif
1220 #ifndef HAS_DBL_DIG
1221 #define DBL_DIG 15   /* A guess that works lots of places */
1222 #endif
1223
1224 #ifdef OVR_LDBL_DIG
1225 /* Use an overridden LDBL_DIG */
1226 # ifdef LDBL_DIG
1227 #  undef LDBL_DIG
1228 # endif
1229 # define LDBL_DIG OVR_LDBL_DIG
1230 #else
1231 /* The following is all to get LDBL_DIG, in order to pick a nice
1232    default value for printing floating point numbers in Gconvert.
1233    (see config.h)
1234 */
1235 # ifdef I_LIMITS
1236 #   include <limits.h>
1237 # endif
1238 # ifdef I_FLOAT
1239 #  include <float.h>
1240 # endif
1241 # ifndef HAS_LDBL_DIG
1242 #  if LONG_DOUBLESIZE == 10
1243 #   define LDBL_DIG 18 /* assume IEEE */
1244 #  else
1245 #   if LONG_DOUBLESIZE == 12
1246 #    define LDBL_DIG 18 /* gcc? */
1247 #   else
1248 #    if LONG_DOUBLESIZE == 16
1249 #     define LDBL_DIG 33 /* assume IEEE */
1250 #    else
1251 #     if LONG_DOUBLESIZE == DOUBLESIZE
1252 #      define LDBL_DIG DBL_DIG /* bummer */
1253 #     endif
1254 #    endif
1255 #   endif
1256 #  endif
1257 # endif
1258 #endif
1259
1260 typedef NVTYPE NV;
1261
1262 #ifdef I_IEEEFP
1263 #   include <ieeefp.h>
1264 #endif
1265
1266 #ifdef USE_LONG_DOUBLE
1267 #   ifdef I_SUNMATH
1268 #       include <sunmath.h>
1269 #   endif
1270 #   define NV_DIG LDBL_DIG
1271 #   ifdef LDBL_MANT_DIG
1272 #       define NV_MANT_DIG LDBL_MANT_DIG
1273 #   endif
1274 #   ifdef LDBL_MIN
1275 #       define NV_MIN LDBL_MIN
1276 #   endif
1277 #   ifdef LDBL_MAX
1278 #       define NV_MAX LDBL_MAX
1279 #   endif
1280 #   ifdef LDBL_MIN_10_EXP
1281 #       define NV_MIN_10_EXP LDBL_MIN_10_EXP
1282 #   endif
1283 #   ifdef LDBL_MAX_10_EXP
1284 #       define NV_MAX_10_EXP LDBL_MAX_10_EXP
1285 #   endif
1286 #   ifdef LDBL_EPSILON
1287 #       define NV_EPSILON LDBL_EPSILON
1288 #   endif
1289 #   ifdef LDBL_MAX
1290 #       define NV_MAX LDBL_MAX
1291 #       define NV_MIN LDBL_MIN
1292 #   else
1293 #       ifdef HUGE_VALL
1294 #           define NV_MAX HUGE_VALL
1295 #       else
1296 #           ifdef HUGE_VAL
1297 #               define NV_MAX ((NV)HUGE_VAL)
1298 #           endif
1299 #       endif
1300 #   endif
1301 #   ifdef HAS_SQRTL
1302 #       define Perl_cos cosl
1303 #       define Perl_sin sinl
1304 #       define Perl_sqrt sqrtl
1305 #       define Perl_exp expl
1306 #       define Perl_log logl
1307 #       define Perl_atan2 atan2l
1308 #       define Perl_pow powl
1309 #       define Perl_floor floorl
1310 #       define Perl_fmod fmodl
1311 #   endif
1312 /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
1313 #   ifdef HAS_MODFL
1314 #       define Perl_modf(x,y) modfl(x,y)
1315 #   else
1316 #       define Perl_modf(x,y) ((long double)modf((double)(x),(double*)(y)))
1317 #   endif
1318 #   ifdef HAS_FREXPL
1319 #       define Perl_frexp(x,y) frexpl(x,y)
1320 #   else
1321 #       define Perl_frexp(x,y) ((long double)frexp((double)(x),y))
1322 #   endif
1323 #   ifndef Perl_isinf
1324 #       ifdef HAS_ISNANL
1325 #           define Perl_isnan(x) isnanl(x)
1326 #       endif
1327 #   endif
1328 #   ifndef Perl_isinf
1329 #       ifdef HAS_FINITEL
1330 #           define Perl_isinf(x) !(finitel(x)||Perl_isnan(x))
1331 #       endif
1332 #   endif
1333 #else
1334 #   define NV_DIG DBL_DIG
1335 #   ifdef DBL_MANT_DIG
1336 #       define NV_MANT_DIG DBL_MANT_DIG
1337 #   endif
1338 #   ifdef DBL_MIN
1339 #       define NV_MIN DBL_MIN
1340 #   endif
1341 #   ifdef DBL_MAX
1342 #       define NV_MAX DBL_MAX
1343 #   endif
1344 #   ifdef DBL_MIN_10_EXP
1345 #       define NV_MIN_10_EXP DBL_MIN_10_EXP
1346 #   endif
1347 #   ifdef DBL_MAX_10_EXP
1348 #       define NV_MAX_10_EXP DBL_MAX_10_EXP
1349 #   endif
1350 #   ifdef DBL_EPSILON
1351 #       define NV_EPSILON DBL_EPSILON
1352 #   endif
1353 #   ifdef DBL_MAX
1354 #       define NV_MAX DBL_MAX
1355 #       define NV_MIN DBL_MIN
1356 #   else
1357 #       ifdef HUGE_VAL
1358 #           define NV_MAX HUGE_VAL
1359 #       endif
1360 #   endif
1361 #   define Perl_cos cos
1362 #   define Perl_sin sin
1363 #   define Perl_sqrt sqrt
1364 #   define Perl_exp exp
1365 #   define Perl_log log
1366 #   define Perl_atan2 atan2
1367 #   define Perl_pow pow
1368 #   define Perl_floor floor
1369 #   define Perl_fmod fmod
1370 #   define Perl_modf(x,y) modf(x,y)
1371 #   define Perl_frexp(x,y) frexp(x,y)
1372 #endif
1373
1374 /* rumor has it that Win32 has _fpclass() */
1375
1376 #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL))
1377 #    ifdef I_IEEFP
1378 #        include <ieeefp.h>
1379 #    endif
1380 #    ifdef I_FP
1381 #        include <fp.h>
1382 #    endif
1383 #    if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL)
1384 #        define Perl_fp_class()         fpclassl(x)
1385 #    else
1386 #        define Perl_fp_class()         fpclass(x)
1387 #    endif
1388 #    define Perl_fp_class_snan(x)       (Perl_fp_class(x)==FP_CLASS_SNAN)
1389 #    define Perl_fp_class_qnan(x)       (Perl_fp_class(x)==FP_CLASS_QNAN)
1390 #    define Perl_fp_class_nan(x)        (Perl_fp_class(x)==FP_CLASS_SNAN||Perl_fp_class(x)==FP_CLASS_QNAN)
1391 #    define Perl_fp_class_ninf(x)       (Perl_fp_class(x)==FP_CLASS_NINF)
1392 #    define Perl_fp_class_pinf(x)       (Perl_fp_class(x)==FP_CLASS_PINF)
1393 #    define Perl_fp_class_inf(x)        (Perl_fp_class(x)==FP_CLASS_NINF||Perl_fp_class(x)==FP_CLASS_PINF)
1394 #    define Perl_fp_class_nnorm(x)      (Perl_fp_class(x)==FP_CLASS_NNORM)
1395 #    define Perl_fp_class_pnorm(x)      (Perl_fp_class(x)==FP_CLASS_PNORM)
1396 #    define Perl_fp_class_norm(x)       (Perl_fp_class(x)==FP_CLASS_NNORM||Perl_fp_class(x)==FP_CLASS_PNORM)
1397 #    define Perl_fp_class_ndenorm(x)    (Perl_fp_class(x)==FP_CLASS_NDENORM)
1398 #    define Perl_fp_class_pdenorm(x)    (Perl_fp_class(x)==FP_CLASS_PDENORM)
1399 #    define Perl_fp_class_denorm(x)     (Perl_fp_class(x)==FP_CLASS_NDENORM||Perl_fp_class(x)==FP_CLASS_PDENORM)
1400 #    define Perl_fp_class_nzero(x)      (Perl_fp_class(x)==FP_CLASS_NZERO)
1401 #    define Perl_fp_class_pzero(x)      (Perl_fp_class(x)==FP_CLASS_PZERO)
1402 #    define Perl_fp_class_zero(x)       (Perl_fp_class(x)==FP_CLASS_NZERO||Perl_fp_class(x)==FP_CLASS_PZERO)
1403 #endif
1404
1405 #if !defined(Perl_fp_class) && defined(HAS_FP_CLASS)
1406 #    include <math.h>
1407 #    if !defined(FP_SNAN) && defined(I_FP_CLASS)
1408 #        include <fp_class.h>
1409 #    endif
1410 #    define Perl_fp_class(x)            fp_class(x)
1411 #    define Perl_fp_class_snan(x)       (fp_class(x)==FP_SNAN)
1412 #    define Perl_fp_class_qnan(x)       (fp_class(x)==FP_QNAN)
1413 #    define Perl_fp_class_nan(x)        (fp_class(x)==FP_SNAN||fp_class(x)==FP_QNAN)
1414 #    define Perl_fp_class_ninf(x)       (fp_class(x)==FP_NEG_INF)
1415 #    define Perl_fp_class_pinf(x)       (fp_class(x)==FP_POS_INF)
1416 #    define Perl_fp_class_inf(x)        (fp_class(x)==FP_NEG_INF||fp_class(x)==FP_POS_INF)
1417 #    define Perl_fp_class_nnorm(x)      (fp_class(x)==FP_NEG_NORM)
1418 #    define Perl_fp_class_pnorm(x)      (fp_class(x)==FP_POS_NORM)
1419 #    define Perl_fp_class_norm(x)       (fp_class(x)==FP_NEG_NORM||fp_class(x)==FP_POS_NORM)
1420 #    define Perl_fp_class_ndenorm(x)    (fp_class(x)==FP_NEG_DENORM)
1421 #    define Perl_fp_class_pdenorm(x)    (fp_class(x)==FP_POS_DENORM)
1422 #    define Perl_fp_class_denorm(x)     (fp_class(x)==FP_NEG_DENORM||fp_class(x)==FP_POS_DENORM)
1423 #    define Perl_fp_class_nzero(x)      (fp_class(x)==FP_NEG_ZERO)
1424 #    define Perl_fp_class_pzero(x)      (fp_class(x)==FP_POS_ZERO)
1425 #    define Perl_fp_class_zero(x)       (fp_class(x)==FP_NEG_ZERO||fp_class(x)==FP_POS_ZERO)
1426 #endif
1427
1428 #if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY)
1429 #    include <math.h>
1430 #    define Perl_fp_class(x)            fpclassify(x)
1431 #    define Perl_fp_class_nan(x)        (fp_classify(x)==FP_SNAN|FP|_fp_classify(x)==QNAN)
1432 #    define Perl_fp_class_inf(x)        (fp_classify(x)==FP_INFINITE)
1433 #    define Perl_fp_class_norm(x)       (fp_classify(x)==FP_NORMAL)
1434 #    define Perl_fp_class_denorm(x)     (fp_classify(x)==FP_SUBNORMAL)
1435 #    define Perl_fp_class_zero(x)       (fp_classify(x)==FP_ZERO)
1436 #endif
1437
1438 #if !defined(Perl_fp_class) && defined(HAS_CLASS)
1439 #    include <math.h>
1440 #    ifndef _cplusplus
1441 #        define Perl_fp_class(x)        class(x)
1442 #    else
1443 #        define Perl_fp_class(x)        _class(x)
1444 #    endif
1445 #    define Perl_fp_class_snan(x)       (Perl_fp_class(x)==FP_NANS)
1446 #    define Perl_fp_class_qnan(x)       (Perl_fp_class(x)==FP_NANQ)
1447 #    define Perl_fp_class_nan(x)        (Perl_fp_class(x)==FP_SNAN||Perl_fp_class(x)==FP_QNAN)
1448 #    define Perl_fp_class_ninf(x)       (Perl_fp_class(x)==FP_MINUS_INF)
1449 #    define Perl_fp_class_pinf(x)       (Perl_fp_class(x)==FP_PLUS_INF)
1450 #    define Perl_fp_class_inf(x)        (Perl_fp_class(x)==FP_MINUS_INF||Perl_fp_class(x)==FP_PLUS_INF)
1451 #    define Perl_fp_class_nnorm(x)      (Perl_fp_class(x)==FP_MINUS_NORM)
1452 #    define Perl_fp_class_pnorm(x)      (Perl_fp_class(x)==FP_PLUS_NORM)
1453 #    define Perl_fp_class_norm(x)       (Perl_fp_class(x)==FP_MINUS_NORM||Perl_fp_class(x)==FP_PLUS_NORM)
1454 #    define Perl_fp_class_ndenorm(x)    (Perl_fp_class(x)==FP_MINUS_DENORM)
1455 #    define Perl_fp_class_pdenorm(x)    (Perl_fp_class(x)==FP_PLUS_DENORM)
1456 #    define Perl_fp_class_denorm(x)     (Perl_fp_class(x)==FP_MINUS_DENORM||Perl_fp_class(x)==FP_PLUS_DENORM)
1457 #    define Perl_fp_class_nzero(x)      (Perl_fp_class(x)==FP_MINUS_ZERO)
1458 #    define Perl_fp_class_pzero(x)      (Perl_fp_class(x)==FP_PLUS_ZERO)
1459 #    define Perl_fp_class_zero(x)       (Perl_fp_class(x)==FP_MINUS_ZERO||Perl_fp_class(x)==FP_PLUS_ZERO)
1460 #endif
1461
1462 /* rumor has it that Win32 has _isnan() */
1463
1464 #ifndef Perl_isnan
1465 #   ifdef HAS_ISNAN
1466 #       define Perl_isnan(x) isnan((NV)x)
1467 #   else
1468 #       ifdef Perl_fp_class_nan
1469 #           define Perl_isnan(x) Perl_fp_class_nan(x)
1470 #       else
1471 #           ifdef HAS_UNORDERED
1472 #               define Perl_isnan(x) unordered((x), 0.0)
1473 #           else
1474 #               define Perl_isnan(x) ((x)!=(x))
1475 #           endif
1476 #       endif
1477 #   endif
1478 #endif
1479
1480 #ifndef Perl_isinf
1481 #   ifdef HAS_ISINF
1482 #       define Perl_isinf(x) isinf((NV)x)
1483 #   else
1484 #       ifdef Perl_fp_class_inf
1485 #           define Perl_isinf(x) Perl_fp_class_inf(x)
1486 #       else
1487 #           define Perl_isinf(x) ((x)==NV_INF)
1488 #       endif
1489 #   endif
1490 #endif
1491
1492 #ifndef Perl_isfinite
1493 #   ifdef HAS_FINITE
1494 #       define Perl_isfinite(x) finite((NV)x)
1495 #   else
1496 #       ifdef HAS_ISFINITE
1497 #           define Perl_isfinite(x) isfinite(x)
1498 #       else
1499 #           ifdef Perl_fp_class_finite
1500 #               define Perl_isfinite(x) Perl_fp_class_finite(x)
1501 #           else
1502 #               define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x))
1503 #           endif
1504 #       endif
1505 #   endif
1506 #endif
1507
1508 #define Perl_atof(s) Perl_my_atof(s)
1509 #define Perl_atof2(s, np) Perl_my_atof2(s, np)
1510
1511 /* Previously these definitions used hardcoded figures.
1512  * It is hoped these formula are more portable, although
1513  * no data one way or another is presently known to me.
1514  * The "PERL_" names are used because these calculated constants
1515  * do not meet the ANSI requirements for LONG_MAX, etc., which
1516  * need to be constants acceptable to #if - kja
1517  *    define PERL_LONG_MAX        2147483647L
1518  *    define PERL_LONG_MIN        (-LONG_MAX - 1)
1519  *    define PERL ULONG_MAX       4294967295L
1520  */
1521
1522 #ifdef I_LIMITS  /* Needed for cast_xxx() functions below. */
1523 #  include <limits.h>
1524 #else
1525 #ifdef I_VALUES
1526 #  include <values.h>
1527 #endif
1528 #endif
1529
1530 /*
1531  * Try to figure out max and min values for the integral types.  THE CORRECT
1532  * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE.  The
1533  * following hacks are used if neither limits.h or values.h provide them:
1534  * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0
1535  *              for types <  int:  (unsigned TYPE)~(unsigned)0
1536  *      The argument to ~ must be unsigned so that later signed->unsigned
1537  *      conversion can't modify the value's bit pattern (e.g. -0 -> +0),
1538  *      and it must not be smaller than int because ~ does integral promotion.
1539  * <type>_MAX: (<type>) (U<type>_MAX >> 1)
1540  * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>.
1541  *      The latter is a hack which happens to work on some machines but
1542  *      does *not* catch any random system, or things like integer types
1543  *      with NaN if that is possible.
1544  *
1545  * All of the types are explicitly cast to prevent accidental loss of
1546  * numeric range, and in the hope that they will be less likely to confuse
1547  * over-eager optimizers.
1548  *
1549  */
1550
1551 #define PERL_UCHAR_MIN ((unsigned char)0)
1552
1553 #ifdef UCHAR_MAX
1554 #  define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
1555 #else
1556 #  ifdef MAXUCHAR
1557 #    define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
1558 #  else
1559 #    define PERL_UCHAR_MAX       ((unsigned char)~(unsigned)0)
1560 #  endif
1561 #endif
1562
1563 /*
1564  * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be
1565  * ambiguous. It may be equivalent to (signed char) or (unsigned char)
1566  * depending on local options. Until Configure detects this (or at least
1567  * detects whether the "signed" keyword is available) the CHAR ranges
1568  * will not be included. UCHAR functions normally.
1569  *                                                           - kja
1570  */
1571
1572 #define PERL_USHORT_MIN ((unsigned short)0)
1573
1574 #ifdef USHORT_MAX
1575 #  define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
1576 #else
1577 #  ifdef MAXUSHORT
1578 #    define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
1579 #  else
1580 #    ifdef USHRT_MAX
1581 #      define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
1582 #    else
1583 #      define PERL_USHORT_MAX       ((unsigned short)~(unsigned)0)
1584 #    endif
1585 #  endif
1586 #endif
1587
1588 #ifdef SHORT_MAX
1589 #  define PERL_SHORT_MAX ((short)SHORT_MAX)
1590 #else
1591 #  ifdef MAXSHORT    /* Often used in <values.h> */
1592 #    define PERL_SHORT_MAX ((short)MAXSHORT)
1593 #  else
1594 #    ifdef SHRT_MAX
1595 #      define PERL_SHORT_MAX ((short)SHRT_MAX)
1596 #    else
1597 #      define PERL_SHORT_MAX      ((short) (PERL_USHORT_MAX >> 1))
1598 #    endif
1599 #  endif
1600 #endif
1601
1602 #ifdef SHORT_MIN
1603 #  define PERL_SHORT_MIN ((short)SHORT_MIN)
1604 #else
1605 #  ifdef MINSHORT
1606 #    define PERL_SHORT_MIN ((short)MINSHORT)
1607 #  else
1608 #    ifdef SHRT_MIN
1609 #      define PERL_SHORT_MIN ((short)SHRT_MIN)
1610 #    else
1611 #      define PERL_SHORT_MIN        (-PERL_SHORT_MAX - ((3 & -1) == 3))
1612 #    endif
1613 #  endif
1614 #endif
1615
1616 #ifdef UINT_MAX
1617 #  define PERL_UINT_MAX ((unsigned int)UINT_MAX)
1618 #else
1619 #  ifdef MAXUINT
1620 #    define PERL_UINT_MAX ((unsigned int)MAXUINT)
1621 #  else
1622 #    define PERL_UINT_MAX       (~(unsigned int)0)
1623 #  endif
1624 #endif
1625
1626 #define PERL_UINT_MIN ((unsigned int)0)
1627
1628 #ifdef INT_MAX
1629 #  define PERL_INT_MAX ((int)INT_MAX)
1630 #else
1631 #  ifdef MAXINT    /* Often used in <values.h> */
1632 #    define PERL_INT_MAX ((int)MAXINT)
1633 #  else
1634 #    define PERL_INT_MAX        ((int)(PERL_UINT_MAX >> 1))
1635 #  endif
1636 #endif
1637
1638 #ifdef INT_MIN
1639 #  define PERL_INT_MIN ((int)INT_MIN)
1640 #else
1641 #  ifdef MININT
1642 #    define PERL_INT_MIN ((int)MININT)
1643 #  else
1644 #    define PERL_INT_MIN        (-PERL_INT_MAX - ((3 & -1) == 3))
1645 #  endif
1646 #endif
1647
1648 #ifdef ULONG_MAX
1649 #  define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
1650 #else
1651 #  ifdef MAXULONG
1652 #    define PERL_ULONG_MAX ((unsigned long)MAXULONG)
1653 #  else
1654 #    define PERL_ULONG_MAX       (~(unsigned long)0)
1655 #  endif
1656 #endif
1657
1658 #define PERL_ULONG_MIN ((unsigned long)0L)
1659
1660 #ifdef LONG_MAX
1661 #  define PERL_LONG_MAX ((long)LONG_MAX)
1662 #else
1663 #  ifdef MAXLONG    /* Often used in <values.h> */
1664 #    define PERL_LONG_MAX ((long)MAXLONG)
1665 #  else
1666 #    define PERL_LONG_MAX        ((long) (PERL_ULONG_MAX >> 1))
1667 #  endif
1668 #endif
1669
1670 #ifdef LONG_MIN
1671 #  define PERL_LONG_MIN ((long)LONG_MIN)
1672 #else
1673 #  ifdef MINLONG
1674 #    define PERL_LONG_MIN ((long)MINLONG)
1675 #  else
1676 #    define PERL_LONG_MIN        (-PERL_LONG_MAX - ((3 & -1) == 3))
1677 #  endif
1678 #endif
1679
1680 #ifdef UV_IS_QUAD
1681
1682 #    define PERL_UQUAD_MAX      (~(UV)0)
1683 #    define PERL_UQUAD_MIN      ((UV)0)
1684 #    define PERL_QUAD_MAX       ((IV) (PERL_UQUAD_MAX >> 1))
1685 #    define PERL_QUAD_MIN       (-PERL_QUAD_MAX - ((3 & -1) == 3))
1686
1687 #endif
1688
1689 struct perl_mstats {
1690     UV *nfree;
1691     UV *ntotal;
1692     IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
1693     IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
1694     IV minbucket;
1695     /* Level 1 info */
1696     UV *bucket_mem_size;
1697     UV *bucket_available_size;
1698     UV nbuckets;
1699 };
1700 struct RExC_state_t;
1701
1702 typedef MEM_SIZE STRLEN;
1703
1704 typedef struct op OP;
1705 typedef struct cop COP;
1706 typedef struct unop UNOP;
1707 typedef struct binop BINOP;
1708 typedef struct listop LISTOP;
1709 typedef struct logop LOGOP;
1710 typedef struct pmop PMOP;
1711 typedef struct svop SVOP;
1712 typedef struct padop PADOP;
1713 typedef struct pvop PVOP;
1714 typedef struct loop LOOP;
1715
1716 typedef struct interpreter PerlInterpreter;
1717
1718 /* Amdahl's <ksync.h> has struct sv */
1719 /* SGI's <sys/sema.h> has struct sv */
1720 #if defined(UTS) || defined(__sgi)
1721 #   define STRUCT_SV perl_sv
1722 #else
1723 #   define STRUCT_SV sv
1724 #endif
1725 typedef struct STRUCT_SV SV;
1726 typedef struct av AV;
1727 typedef struct hv HV;
1728 typedef struct cv CV;
1729 typedef struct regexp REGEXP;
1730 typedef struct gp GP;
1731 typedef struct gv GV;
1732 typedef struct io IO;
1733 typedef struct context PERL_CONTEXT;
1734 typedef struct block BLOCK;
1735
1736 typedef struct magic MAGIC;
1737 typedef struct xrv XRV;
1738 typedef struct xpv XPV;
1739 typedef struct xpviv XPVIV;
1740 typedef struct xpvuv XPVUV;
1741 typedef struct xpvnv XPVNV;
1742 typedef struct xpvmg XPVMG;
1743 typedef struct xpvlv XPVLV;
1744 typedef struct xpvav XPVAV;
1745 typedef struct xpvhv XPVHV;
1746 typedef struct xpvgv XPVGV;
1747 typedef struct xpvcv XPVCV;
1748 typedef struct xpvbm XPVBM;
1749 typedef struct xpvfm XPVFM;
1750 typedef struct xpvio XPVIO;
1751 typedef struct mgvtbl MGVTBL;
1752 typedef union any ANY;
1753 typedef struct ptr_tbl_ent PTR_TBL_ENT_t;
1754 typedef struct ptr_tbl PTR_TBL_t;
1755
1756 #include "handy.h"
1757
1758 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
1759 #   if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO)
1760 #       define USE_64_BIT_RAWIO /* implicit */
1761 #   endif
1762 #endif
1763
1764 /* Notice the use of HAS_FSEEKO: now we are obligated to always use
1765  * fseeko/ftello if possible.  Don't go #defining ftell to ftello yourself,
1766  * however, because operating systems like to do that themself. */
1767 #ifndef FSEEKSIZE
1768 #   ifdef HAS_FSEEKO
1769 #       define FSEEKSIZE LSEEKSIZE
1770 #   else
1771 #       define FSEEKSIZE LONGSIZE
1772 #   endif
1773 #endif
1774
1775 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO)
1776 #   if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO)
1777 #       define USE_64_BIT_STDIO /* implicit */
1778 #   endif
1779 #endif
1780
1781 #ifdef USE_64_BIT_RAWIO
1782 #   ifdef HAS_OFF64_T
1783 #       undef Off_t
1784 #       define Off_t off64_t
1785 #       undef LSEEKSIZE
1786 #       define LSEEKSIZE 8
1787 #   endif
1788 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that
1789  * will trigger defines like the ones below.  Some 64-bit environments,
1790  * however, do not.  Therefore we have to explicitly mix and match. */
1791 #   if defined(USE_OPEN64)
1792 #       define open open64
1793 #   endif
1794 #   if defined(USE_LSEEK64)
1795 #       define lseek lseek64
1796 #   else
1797 #       if defined(USE_LLSEEK)
1798 #           define lseek llseek
1799 #       endif
1800 #   endif
1801 #   if defined(USE_STAT64)
1802 #       define stat stat64
1803 #   endif
1804 #   if defined(USE_FSTAT64)
1805 #       define fstat fstat64
1806 #   endif
1807 #   if defined(USE_LSTAT64)
1808 #       define lstat lstat64
1809 #   endif
1810 #   if defined(USE_FLOCK64)
1811 #       define flock flock64
1812 #   endif
1813 #   if defined(USE_LOCKF64)
1814 #       define lockf lockf64
1815 #   endif
1816 #   if defined(USE_FCNTL64)
1817 #       define fcntl fcntl64
1818 #   endif
1819 #   if defined(USE_TRUNCATE64)
1820 #       define truncate truncate64
1821 #   endif
1822 #   if defined(USE_FTRUNCATE64)
1823 #       define ftruncate ftruncate64
1824 #   endif
1825 #endif
1826
1827 #ifdef USE_64_BIT_STDIO
1828 #   ifdef HAS_FPOS64_T
1829 #       undef Fpos_t
1830 #       define Fpos_t fpos64_t
1831 #   endif
1832 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that
1833  * will trigger defines like the ones below.  Some 64-bit environments,
1834  * however, do not. */
1835 #   if defined(USE_FOPEN64)
1836 #       define fopen fopen64
1837 #   endif
1838 #   if defined(USE_FSEEK64)
1839 #       define fseek fseek64 /* don't do fseeko here, see perlio.c */
1840 #   endif
1841 #   if defined(USE_FTELL64)
1842 #       define ftell ftell64 /* don't do ftello here, see perlio.c */
1843 #   endif
1844 #   if defined(USE_FSETPOS64)
1845 #       define fsetpos fsetpos64
1846 #   endif
1847 #   if defined(USE_FGETPOS64)
1848 #       define fgetpos fgetpos64
1849 #   endif
1850 #   if defined(USE_TMPFILE64)
1851 #       define tmpfile tmpfile64
1852 #   endif
1853 #   if defined(USE_FREOPEN64)
1854 #       define freopen freopen64
1855 #   endif
1856 #endif
1857
1858 #if defined(OS2)
1859 #  include "iperlsys.h"
1860 #endif
1861
1862 #if defined(__OPEN_VM)
1863 # include "vmesa/vmesaish.h"
1864 #endif
1865
1866 #ifdef DOSISH
1867 # if defined(OS2)
1868 #   include "os2ish.h"
1869 # else
1870 #   include "dosish.h"
1871 # endif
1872 #else
1873 # if defined(VMS)
1874 #   include "vmsish.h"
1875 # else
1876 #   if defined(PLAN9)
1877 #     include "./plan9/plan9ish.h"
1878 #   else
1879 #     if defined(MPE)
1880 #       include "mpeix/mpeixish.h"
1881 #     else
1882 #       if defined(__VOS__)
1883 #         include "vosish.h"
1884 #       else
1885 #         if defined(EPOC)
1886 #           include "epocish.h"
1887 #         else
1888 #           if defined(MACOS_TRADITIONAL)
1889 #             include "macos/macish.h"
1890 #             ifndef NO_ENVIRON_ARRAY
1891 #               define NO_ENVIRON_ARRAY
1892 #             endif
1893 #           else
1894 #             include "unixish.h"
1895 #           endif
1896 #         endif
1897 #       endif
1898 #     endif
1899 #   endif
1900 # endif
1901 #endif
1902
1903 #ifndef NO_ENVIRON_ARRAY
1904 #  define USE_ENVIRON_ARRAY
1905 #endif
1906
1907 #ifdef JPL
1908     /* E.g. JPL needs to operate on a copy of the real environment.
1909      * JDK 1.2 and 1.3 seem to get upset if the original environment
1910      * is diddled with. */
1911 #   define NEED_ENVIRON_DUP_FOR_MODIFY
1912 #endif
1913
1914 /*
1915  * initialise to avoid floating-point exceptions from overflow, etc
1916  */
1917 #ifndef PERL_FPU_INIT
1918 #  ifdef HAS_FPSETMASK
1919 #    if HAS_FLOATINGPOINT_H
1920 #      include <floatingpoint.h>
1921 #    endif
1922 #    define PERL_FPU_INIT fpsetmask(0);
1923 #  else
1924 #    if defined(SIGFPE) && defined(SIG_IGN)
1925 #      define PERL_FPU_INIT signal(SIGFPE, SIG_IGN);
1926 #    else
1927 #      define PERL_FPU_INIT
1928 #    endif
1929 #  endif
1930 #endif
1931
1932 #ifndef PERL_SYS_INIT3
1933 #  define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
1934 #endif
1935
1936 #ifndef MAXPATHLEN
1937 #  ifdef PATH_MAX
1938 #    ifdef _POSIX_PATH_MAX
1939 #       if PATH_MAX > _POSIX_PATH_MAX
1940 /* MAXPATHLEN is supposed to include the final null character,
1941  * as opposed to PATH_MAX and _POSIX_PATH_MAX. */
1942 #         define MAXPATHLEN (PATH_MAX+1)
1943 #       else
1944 #         define MAXPATHLEN (_POSIX_PATH_MAX+1)
1945 #       endif
1946 #    else
1947 #      define MAXPATHLEN (PATH_MAX+1)
1948 #    endif
1949 #  else
1950 #    ifdef _POSIX_PATH_MAX
1951 #       define MAXPATHLEN (_POSIX_PATH_MAX+1)
1952 #    else
1953 #       define MAXPATHLEN 1024  /* Err on the large side. */
1954 #    endif
1955 #  endif
1956 #endif
1957
1958 /*
1959  * USE_5005THREADS needs to be after unixish.h as <pthread.h> includes
1960  * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
1961  * this results in many functions being undeclared which bothers C++
1962  * May make sense to have threads after "*ish.h" anyway
1963  */
1964
1965 #if defined(USE_5005THREADS) || defined(USE_ITHREADS)
1966 #  if defined(USE_5005THREADS)
1967    /* pending resolution of licensing issues, we avoid the erstwhile
1968     * atomic.h everywhere */
1969 #  define EMULATE_ATOMIC_REFCOUNTS
1970 #  endif
1971 #  ifdef NETWARE
1972 #   include <nw5thread.h>
1973 #  else
1974 #  ifdef FAKE_THREADS
1975 #    include "fakethr.h"
1976 #  else
1977 #    ifdef WIN32
1978 #      include <win32thread.h>
1979 #    else
1980 #      ifdef OS2
1981 #        include "os2thread.h"
1982 #      else
1983 #        ifdef I_MACH_CTHREADS
1984 #          include <mach/cthreads.h>
1985 #          if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC)
1986 #            define MUTEX_INIT_CALLS_MALLOC
1987 #          endif
1988 typedef cthread_t       perl_os_thread;
1989 typedef mutex_t         perl_mutex;
1990 typedef condition_t     perl_cond;
1991 typedef void *          perl_key;
1992 #        else /* Posix threads */
1993 #          ifdef I_PTHREAD
1994 #            include <pthread.h>
1995 #          endif
1996 typedef pthread_t       perl_os_thread;
1997 typedef pthread_mutex_t perl_mutex;
1998 typedef pthread_cond_t  perl_cond;
1999 typedef pthread_key_t   perl_key;
2000 #        endif /* I_MACH_CTHREADS */
2001 #      endif /* OS2 */
2002 #    endif /* WIN32 */
2003 #  endif /* FAKE_THREADS */
2004 #endif  /* NETWARE */
2005 #endif /* USE_5005THREADS || USE_ITHREADS */
2006
2007 #ifdef WIN32
2008 #  include "win32.h"
2009 #endif
2010
2011 #ifdef NETWARE
2012 #  include "netware.h"
2013 #endif
2014
2015 #ifdef VMS
2016 #   define STATUS_NATIVE        PL_statusvalue_vms
2017 #   define STATUS_NATIVE_EXPORT \
2018         (((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) | (VMSISH_HUSHED ? 0x10000000 : 0))
2019 #   define STATUS_NATIVE_SET(n)                                         \
2020         STMT_START {                                                    \
2021             PL_statusvalue_vms = (n);                                   \
2022             if ((I32)PL_statusvalue_vms == -1)                          \
2023                 PL_statusvalue = -1;                                    \
2024             else if (PL_statusvalue_vms & STS$M_SUCCESS)                \
2025                 PL_statusvalue = 0;                                     \
2026             else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0)        \
2027                 PL_statusvalue = 1 << 8;                                \
2028             else                                                        \
2029                 PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8;    \
2030         } STMT_END
2031 #   define STATUS_POSIX PL_statusvalue
2032 #   ifdef VMSISH_STATUS
2033 #       define STATUS_CURRENT   (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX)
2034 #   else
2035 #       define STATUS_CURRENT   STATUS_POSIX
2036 #   endif
2037 #   define STATUS_POSIX_SET(n)                          \
2038         STMT_START {                                    \
2039             PL_statusvalue = (n);                               \
2040             if (PL_statusvalue != -1) {                 \
2041                 PL_statusvalue &= 0xFFFF;                       \
2042                 PL_statusvalue_vms = PL_statusvalue ? 44 : 1;   \
2043             }                                           \
2044             else PL_statusvalue_vms = -1;                       \
2045         } STMT_END
2046 #   define STATUS_ALL_SUCCESS   (PL_statusvalue = 0, PL_statusvalue_vms = 1)
2047 #   define STATUS_ALL_FAILURE   (PL_statusvalue = 1, PL_statusvalue_vms = 44)
2048 #else
2049 #   define STATUS_NATIVE        STATUS_POSIX
2050 #   define STATUS_NATIVE_EXPORT STATUS_POSIX
2051 #   define STATUS_NATIVE_SET    STATUS_POSIX_SET
2052 #   define STATUS_POSIX         PL_statusvalue
2053 #   define STATUS_POSIX_SET(n)          \
2054         STMT_START {                    \
2055             PL_statusvalue = (n);               \
2056             if (PL_statusvalue != -1)   \
2057                 PL_statusvalue &= 0xFFFF;       \
2058         } STMT_END
2059 #   define STATUS_CURRENT STATUS_POSIX
2060 #   define STATUS_ALL_SUCCESS   (PL_statusvalue = 0)
2061 #   define STATUS_ALL_FAILURE   (PL_statusvalue = 1)
2062 #endif
2063
2064 /* flags in PL_exit_flags for nature of exit() */
2065 #define PERL_EXIT_EXPECTED      0x01
2066 #define PERL_EXIT_DESTRUCT_END  0x02  /* Run END in perl_destruct */
2067
2068 #ifndef MEMBER_TO_FPTR
2069 #  define MEMBER_TO_FPTR(name)          name
2070 #endif
2071
2072 /* format to use for version numbers in file/directory names */
2073 /* XXX move to Configure? */
2074 #ifndef PERL_FS_VER_FMT
2075 #  define PERL_FS_VER_FMT       "%d.%d.%d"
2076 #endif
2077
2078 /* This defines a way to flush all output buffers.  This may be a
2079  * performance issue, so we allow people to disable it.  Also, if
2080  * we are using stdio, there are broken implementations of fflush(NULL)
2081  * out there, Solaris being the most prominent.
2082  */
2083 #ifndef PERL_FLUSHALL_FOR_CHILD
2084 # if defined(USE_PERLIO) || defined(FFLUSH_NULL) || defined(USE_SFIO)
2085 #  define PERL_FLUSHALL_FOR_CHILD       PerlIO_flush((PerlIO*)NULL)
2086 # else
2087 #  ifdef FFLUSH_ALL
2088 #   define PERL_FLUSHALL_FOR_CHILD      my_fflush_all()
2089 #  else
2090 #   define PERL_FLUSHALL_FOR_CHILD      NOOP
2091 #  endif
2092 # endif
2093 #endif
2094
2095 #ifndef PERL_WAIT_FOR_CHILDREN
2096 #  define PERL_WAIT_FOR_CHILDREN        NOOP
2097 #endif
2098
2099 /* the traditional thread-unsafe notion of "current interpreter". */
2100 #ifndef PERL_SET_INTERP
2101 #  define PERL_SET_INTERP(i)            (PL_curinterp = (PerlInterpreter*)(i))
2102 #endif
2103
2104 #ifndef PERL_GET_INTERP
2105 #  define PERL_GET_INTERP               (PL_curinterp)
2106 #endif
2107
2108 #if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
2109 #  ifdef USE_5005THREADS
2110 #    define PERL_GET_THX                ((struct perl_thread *)PERL_GET_CONTEXT)
2111 #  else
2112 #  ifdef MULTIPLICITY
2113 #    define PERL_GET_THX                ((PerlInterpreter *)PERL_GET_CONTEXT)
2114 #  else
2115 #  ifdef PERL_OBJECT
2116 #    define PERL_GET_THX                ((CPerlObj *)PERL_GET_CONTEXT)
2117 #  endif
2118 #  endif
2119 #  endif
2120 #  define PERL_SET_THX(t)               PERL_SET_CONTEXT(t)
2121 #endif
2122
2123 #ifndef SVf
2124 #  ifdef CHECK_FORMAT
2125 #    define SVf "p"
2126 #  else
2127 #    define SVf "_"
2128 #  endif
2129 #endif
2130
2131 #ifndef UVf
2132 #  ifdef CHECK_FORMAT
2133 #    define UVf UVuf
2134 #  else
2135 #    define UVf "Vu"
2136 #  endif
2137 #endif
2138
2139 #ifndef VDf
2140 #  ifdef CHECK_FORMAT
2141 #    define VDf "p"
2142 #  else
2143 #    define VDf "vd"
2144 #  endif
2145 #endif
2146
2147 /* Some unistd.h's give a prototype for pause() even though
2148    HAS_PAUSE ends up undefined.  This causes the #define
2149    below to be rejected by the compiler.  Sigh.
2150 */
2151 #ifdef HAS_PAUSE
2152 #define Pause   pause
2153 #else
2154 #define Pause() sleep((32767<<16)+32767)
2155 #endif
2156
2157 #ifndef IOCPARM_LEN
2158 #   ifdef IOCPARM_MASK
2159         /* on BSDish systes we're safe */
2160 #       define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
2161 #   else
2162         /* otherwise guess at what's safe */
2163 #       define IOCPARM_LEN(x)   256
2164 #   endif
2165 #endif
2166
2167 #if defined(__CYGWIN__)
2168 /* USEMYBINMODE
2169  *   This symbol, if defined, indicates that the program should
2170  *   use the routine my_binmode(FILE *fp, char iotype, int mode) to insure
2171  *   that a file is in "binary" mode -- that is, that no translation
2172  *   of bytes occurs on read or write operations.
2173  */
2174 #  define USEMYBINMODE / **/
2175 #  define my_binmode(fp, iotype, mode) \
2176             (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1 ? TRUE : FALSE)
2177 #endif
2178
2179 #ifdef UNION_ANY_DEFINITION
2180 UNION_ANY_DEFINITION;
2181 #else
2182 union any {
2183     void*       any_ptr;
2184     I32         any_i32;
2185     IV          any_iv;
2186     long        any_long;
2187     void        (*any_dptr) (void*);
2188     void        (*any_dxptr) (pTHXo_ void*);
2189 };
2190 #endif
2191
2192 #ifdef USE_5005THREADS
2193 #define ARGSproto struct perl_thread *thr
2194 #else
2195 #define ARGSproto
2196 #endif /* USE_5005THREADS */
2197
2198 typedef I32 (*filter_t) (pTHXo_ int, SV *, int);
2199
2200 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
2201 #define FILTER_DATA(idx)           (AvARRAY(PL_rsfp_filters)[idx])
2202 #define FILTER_ISREADER(idx)       (idx >= AvFILLp(PL_rsfp_filters))
2203
2204 #if !defined(OS2)
2205 #  include "iperlsys.h"
2206 #endif
2207 #include "regexp.h"
2208 #include "sv.h"
2209 #include "util.h"
2210 #include "form.h"
2211 #include "gv.h"
2212 #include "cv.h"
2213 #include "opnames.h"
2214 #include "op.h"
2215 #include "cop.h"
2216 #include "av.h"
2217 #include "hv.h"
2218 #include "mg.h"
2219 #include "scope.h"
2220 #include "warnings.h"
2221 #include "utf8.h"
2222 #include "sharedsv.h"
2223
2224 /* Current curly descriptor */
2225 typedef struct curcur CURCUR;
2226 struct curcur {
2227     int         parenfloor;     /* how far back to strip paren data */
2228     int         cur;            /* how many instances of scan we've matched */
2229     int         min;            /* the minimal number of scans to match */
2230     int         max;            /* the maximal number of scans to match */
2231     int         minmod;         /* whether to work our way up or down */
2232     regnode *   scan;           /* the thing to match */
2233     regnode *   next;           /* what has to match after it */
2234     char *      lastloc;        /* where we started matching this scan */
2235     CURCUR *    oldcc;          /* current curly before we started this one */
2236 };
2237
2238 typedef struct _sublex_info SUBLEXINFO;
2239 struct _sublex_info {
2240     I32 super_state;    /* lexer state to save */
2241     I32 sub_inwhat;     /* "lex_inwhat" to use */
2242     OP *sub_op;         /* "lex_op" to use */
2243     char *super_bufptr; /* PL_bufptr that was */
2244     char *super_bufend; /* PL_bufend that was */
2245 };
2246
2247 typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
2248
2249 struct scan_data_t;             /* Used in S_* functions in regcomp.c */
2250 struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */
2251
2252 typedef I32 CHECKPOINT;
2253
2254 struct ptr_tbl_ent {
2255     struct ptr_tbl_ent*         next;
2256     void*                       oldval;
2257     void*                       newval;
2258 };
2259
2260 struct ptr_tbl {
2261     struct ptr_tbl_ent**        tbl_ary;
2262     UV                          tbl_max;
2263     UV                          tbl_items;
2264 };
2265
2266 #if defined(iAPX286) || defined(M_I286) || defined(I80286)
2267 #   define I286
2268 #endif
2269
2270 #if defined(htonl) && !defined(HAS_HTONL)
2271 #define HAS_HTONL
2272 #endif
2273 #if defined(htons) && !defined(HAS_HTONS)
2274 #define HAS_HTONS
2275 #endif
2276 #if defined(ntohl) && !defined(HAS_NTOHL)
2277 #define HAS_NTOHL
2278 #endif
2279 #if defined(ntohs) && !defined(HAS_NTOHS)
2280 #define HAS_NTOHS
2281 #endif
2282 #ifndef HAS_HTONL
2283 #if (BYTEORDER & 0xffff) != 0x4321
2284 #define HAS_HTONS
2285 #define HAS_HTONL
2286 #define HAS_NTOHS
2287 #define HAS_NTOHL
2288 #define MYSWAP
2289 #define htons my_swap
2290 #define htonl my_htonl
2291 #define ntohs my_swap
2292 #define ntohl my_ntohl
2293 #endif
2294 #else
2295 #if (BYTEORDER & 0xffff) == 0x4321
2296 #undef HAS_HTONS
2297 #undef HAS_HTONL
2298 #undef HAS_NTOHS
2299 #undef HAS_NTOHL
2300 #endif
2301 #endif
2302
2303 /*
2304  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
2305  * -DWS
2306  */
2307 #if BYTEORDER != 0x1234
2308 # define HAS_VTOHL
2309 # define HAS_VTOHS
2310 # define HAS_HTOVL
2311 # define HAS_HTOVS
2312 # if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
2313 #  define vtohl(x)      ((((x)&0xFF)<<24)       \
2314                         +(((x)>>24)&0xFF)       \
2315                         +(((x)&0x0000FF00)<<8)  \
2316                         +(((x)&0x00FF0000)>>8)  )
2317 #  define vtohs(x)      ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
2318 #  define htovl(x)      vtohl(x)
2319 #  define htovs(x)      vtohs(x)
2320 # endif
2321         /* otherwise default to functions in util.c */
2322 #endif
2323
2324 /* *MAX Plus 1. A floating point value.
2325    Hopefully expressed in a way that dodgy floating point can't mess up.
2326    >> 2 rather than 1, so that value is safely less than I32_MAX after 1
2327    is added to it
2328    May find that some broken compiler will want the value cast to I32.
2329    [after the shift, as signed >> may not be as secure as unsigned >>]
2330 */
2331 #define I32_MAX_P1 (2.0 * (1 + (((U32)I32_MAX) >> 1)))
2332 #define U32_MAX_P1 (4.0 * (1 + ((U32_MAX) >> 2)))
2333 /* For compilers that can't correctly cast NVs over 0x7FFFFFFF (or
2334    0x7FFFFFFFFFFFFFFF) to an unsigned integer. In the future, sizeof(UV)
2335    may be greater than sizeof(IV), so don't assume that half max UV is max IV.
2336 */
2337 #define U32_MAX_P1_HALF (2.0 * (1 + ((U32_MAX) >> 2)))
2338
2339 #define UV_MAX_P1 (4.0 * (1 + ((UV_MAX) >> 2)))
2340 #define IV_MAX_P1 (2.0 * (1 + (((UV)IV_MAX) >> 1)))
2341 #define UV_MAX_P1_HALF (2.0 * (1 + ((UV_MAX) >> 2)))
2342
2343 /* This may look like unnecessary jumping through hoops, but converting
2344    out of range floating point values to integers *is* undefined behaviour,
2345    and it is starting to bite.
2346 */
2347 #ifndef CAST_INLINE
2348 #define I_32(what) (cast_i32((NV)(what)))
2349 #define U_32(what) (cast_ulong((NV)(what)))
2350 #define I_V(what) (cast_iv((NV)(what)))
2351 #define U_V(what) (cast_uv((NV)(what)))
2352 #else
2353 #define I_32(n) ((n) < I32_MAX_P1 ? ((n) < I32_MIN ? I32_MIN : (I32) (n)) \
2354                   : ((n) < U32_MAX_P1 ? (I32)(U32) (n) \
2355                      : ((n) > 0 ? (I32) U32_MAX : 0 /* NaN */)))
2356 #define U_32(n) ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \
2357                   : ((n) < U32_MAX_P1 ? (U32) (n) \
2358                      : ((n) > 0 ? U32_MAX : 0 /* NaN */)))
2359 #define I_V(n) ((n) < IV_MAX_P1 ? ((n) < IV_MIN ? IV_MIN : (IV) (n)) \
2360                   : ((n) < UV_MAX_P1 ? (IV)(UV) (n) \
2361                      : ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */)))
2362 #define U_V(n) ((n) < 0.0 ? ((n) < IV_MIN ? (UV) IV_MIN : (UV)(IV) (n)) \
2363                   : ((n) < UV_MAX_P1 ? (UV) (n) \
2364                      : ((n) > 0 ? UV_MAX : 0 /* NaN */)))
2365 #endif
2366
2367 #define U_S(what) ((U16)U_32(what))
2368 #define U_I(what) ((unsigned int)U_32(what))
2369 #define U_L(what) U_32(what)
2370
2371 /* These do not care about the fractional part, only about the range. */
2372 #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX)
2373 #define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX)
2374
2375 /* Used with UV/IV arguments: */
2376                                         /* XXXX: need to speed it up */
2377 #define CLUMP_2UV(iv)   ((iv) < 0 ? 0 : (UV)(iv))
2378 #define CLUMP_2IV(uv)   ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv))
2379
2380 #ifndef MAXSYSFD
2381 #   define MAXSYSFD 2
2382 #endif
2383
2384 #ifndef __cplusplus
2385 #ifndef UNDER_CE
2386 Uid_t getuid (void);
2387 Uid_t geteuid (void);
2388 Gid_t getgid (void);
2389 Gid_t getegid (void);
2390 #endif
2391 #endif
2392
2393 #ifndef Perl_debug_log
2394 #  define Perl_debug_log        PerlIO_stderr()
2395 #endif
2396
2397 #ifndef Perl_error_log
2398 #  define Perl_error_log        (PL_stderrgv                    \
2399                                  && GvIOp(PL_stderrgv)          \
2400                                  && IoOFP(GvIOp(PL_stderrgv))   \
2401                                  ? IoOFP(GvIOp(PL_stderrgv))    \
2402                                  : PerlIO_stderr())
2403 #endif
2404
2405
2406 #define DEBUG_p_FLAG            0x00000001 /*      1 */
2407 #define DEBUG_s_FLAG            0x00000002 /*      2 */
2408 #define DEBUG_l_FLAG            0x00000004 /*      4 */
2409 #define DEBUG_t_FLAG            0x00000008 /*      8 */
2410 #define DEBUG_o_FLAG            0x00000010 /*     16 */
2411 #define DEBUG_c_FLAG            0x00000020 /*     32 */
2412 #define DEBUG_P_FLAG            0x00000040 /*     64 */
2413 #define DEBUG_m_FLAG            0x00000080 /*    128 */
2414 #define DEBUG_f_FLAG            0x00000100 /*    256 */
2415 #define DEBUG_r_FLAG            0x00000200 /*    512 */
2416 #define DEBUG_x_FLAG            0x00000400 /*   1024 */
2417 #define DEBUG_u_FLAG            0x00000800 /*   2048 */
2418 #define DEBUG_L_FLAG            0x00001000 /*   4096 */
2419 #define DEBUG_H_FLAG            0x00002000 /*   8192 */
2420 #define DEBUG_X_FLAG            0x00004000 /*  16384 */
2421 #define DEBUG_D_FLAG            0x00008000 /*  32768 */
2422 #define DEBUG_S_FLAG            0x00010000 /*  65536 */
2423 #define DEBUG_T_FLAG            0x00020000 /* 131072 */
2424 #define DEBUG_R_FLAG            0x00040000 /* 262144 */
2425 #define DEBUG_MASK              0x0007FFFF /* mask of all the standard flags */
2426
2427 #define DEBUG_DB_RECURSE_FLAG   0x40000000
2428 #define DEBUG_TOP_FLAG          0x80000000 /* XXX what's this for ??? */
2429
2430
2431 #ifdef DEBUGGING
2432
2433 #  undef  YYDEBUG
2434 #  define YYDEBUG 1
2435
2436 #  define DEBUG_p_TEST (PL_debug & DEBUG_p_FLAG)
2437 #  define DEBUG_s_TEST (PL_debug & DEBUG_s_FLAG)
2438 #  define DEBUG_l_TEST (PL_debug & DEBUG_l_FLAG)
2439 #  define DEBUG_t_TEST (PL_debug & DEBUG_t_FLAG)
2440 #  define DEBUG_o_TEST (PL_debug & DEBUG_o_FLAG)
2441 #  define DEBUG_c_TEST (PL_debug & DEBUG_c_FLAG)
2442 #  define DEBUG_P_TEST (PL_debug & DEBUG_P_FLAG)
2443 #  define DEBUG_m_TEST (PL_debug & DEBUG_m_FLAG)
2444 #  define DEBUG_f_TEST (PL_debug & DEBUG_f_FLAG)
2445 #  define DEBUG_r_TEST (PL_debug & DEBUG_r_FLAG)
2446 #  define DEBUG_x_TEST (PL_debug & DEBUG_x_FLAG)
2447 #  define DEBUG_u_TEST (PL_debug & DEBUG_u_FLAG)
2448 #  define DEBUG_L_TEST (PL_debug & DEBUG_L_FLAG)
2449 #  define DEBUG_H_TEST (PL_debug & DEBUG_H_FLAG)
2450 #  define DEBUG_X_TEST (PL_debug & DEBUG_X_FLAG)
2451 #  define DEBUG_D_TEST (PL_debug & DEBUG_D_FLAG)
2452 #  define DEBUG_S_TEST (PL_debug & DEBUG_S_FLAG)
2453 #  define DEBUG_T_TEST (PL_debug & DEBUG_T_FLAG)
2454 #  define DEBUG_R_TEST (PL_debug & DEBUG_R_FLAG)
2455
2456 #  define DEB(a)     a
2457 #  define DEBUG(a)   if (PL_debug)   a
2458 #  define DEBUG_p(a) if (DEBUG_p_TEST) a
2459 #  define DEBUG_s(a) if (DEBUG_s_TEST) a
2460 #  define DEBUG_l(a) if (DEBUG_l_TEST) a
2461 #  define DEBUG_t(a) if (DEBUG_t_TEST) a
2462 #  define DEBUG_o(a) if (DEBUG_o_TEST) a
2463 #  define DEBUG_c(a) if (DEBUG_c_TEST) a
2464 #  define DEBUG_P(a) if (DEBUG_P_TEST) a
2465
2466 #  if defined(PERL_OBJECT)
2467 #    define DEBUG_m(a) if (DEBUG_m_TEST) a
2468 #  else
2469      /* Temporarily turn off memory debugging in case the a
2470       * does memory allocation, either directly or indirectly. */
2471 #    define DEBUG_m(a)  \
2472     STMT_START {                                                        \
2473         if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \
2474     } STMT_END
2475 #  endif
2476
2477 #  define DEBUG__(t, a) \
2478         STMT_START { \
2479                 if (t) STMT_START {a;} STMT_END; \
2480         } STMT_END
2481
2482 #  define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
2483 #  define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
2484 #  define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
2485 #  define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
2486 #  define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a)
2487 #  define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
2488 #  define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a)
2489 #  define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a)
2490
2491 #  ifdef USE_5005THREADS
2492 #    define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a)
2493 #  else
2494 #    define DEBUG_S(a)
2495 #  endif
2496
2497 #  define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a)
2498 #  define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
2499
2500 #else /* DEBUGGING */
2501
2502 #  define DEBUG_p_TEST (0)
2503 #  define DEBUG_s_TEST (0)
2504 #  define DEBUG_l_TEST (0)
2505 #  define DEBUG_t_TEST (0)
2506 #  define DEBUG_o_TEST (0)
2507 #  define DEBUG_c_TEST (0)
2508 #  define DEBUG_P_TEST (0)
2509 #  define DEBUG_m_TEST (0)
2510 #  define DEBUG_f_TEST (0)
2511 #  define DEBUG_r_TEST (0)
2512 #  define DEBUG_x_TEST (0)
2513 #  define DEBUG_u_TEST (0)
2514 #  define DEBUG_L_TEST (0)
2515 #  define DEBUG_H_TEST (0)
2516 #  define DEBUG_X_TEST (0)
2517 #  define DEBUG_D_TEST (0)
2518 #  define DEBUG_S_TEST (0)
2519 #  define DEBUG_T_TEST (0)
2520 #  define DEBUG_R_TEST (0)
2521
2522 #  define DEB(a)
2523 #  define DEBUG(a)
2524 #  define DEBUG_p(a)
2525 #  define DEBUG_s(a)
2526 #  define DEBUG_l(a)
2527 #  define DEBUG_t(a)
2528 #  define DEBUG_o(a)
2529 #  define DEBUG_c(a)
2530 #  define DEBUG_P(a)
2531 #  define DEBUG_m(a)
2532 #  define DEBUG_f(a)
2533 #  define DEBUG_r(a)
2534 #  define DEBUG_x(a)
2535 #  define DEBUG_u(a)
2536 #  define DEBUG_L(a)
2537 #  define DEBUG_H(a)
2538 #  define DEBUG_X(a)
2539 #  define DEBUG_D(a)
2540 #  define DEBUG_S(a)
2541 #  define DEBUG_T(a)
2542 #  define DEBUG_R(a)
2543 #endif /* DEBUGGING */
2544
2545
2546 /* These constants should be used in preference to to raw characters
2547  * when using magic. Note that some perl guts still assume
2548  * certain character properties of these constants, namely that
2549  * isUPPER() and toLOWER() may do useful mappings.
2550  *
2551  * Update the magic_names table in dump.c when adding/amending these
2552  */
2553
2554 #define PERL_MAGIC_sv             '\0' /* Special scalar variable */
2555 #define PERL_MAGIC_overload       'A' /* %OVERLOAD hash */
2556 #define PERL_MAGIC_overload_elem  'a' /* %OVERLOAD hash element */
2557 #define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */
2558 #define PERL_MAGIC_bm             'B' /* Boyer-Moore (fast string search) */
2559 #define PERL_MAGIC_regdata        'D' /* Regex match position data
2560                                         (@+ and @- vars) */
2561 #define PERL_MAGIC_regdatum       'd' /* Regex match position data element */
2562 #define PERL_MAGIC_env            'E' /* %ENV hash */
2563 #define PERL_MAGIC_envelem        'e' /* %ENV hash element */
2564 #define PERL_MAGIC_fm             'f' /* Formline ('compiled' format) */
2565 #define PERL_MAGIC_regex_global   'g' /* m//g target / study()ed string */
2566 #define PERL_MAGIC_isa            'I' /* @ISA array */
2567 #define PERL_MAGIC_isaelem        'i' /* @ISA array element */
2568 #define PERL_MAGIC_nkeys          'k' /* scalar(keys()) lvalue */
2569 #define PERL_MAGIC_dbfile         'L' /* Debugger %_<filename */
2570 #define PERL_MAGIC_dbline         'l' /* Debugger %_<filename element */
2571 #define PERL_MAGIC_mutex          'm' /* ??? */
2572 #define PERL_MAGIC_collxfrm       'o' /* Locale transformation */
2573 #define PERL_MAGIC_tied           'P' /* Tied array or hash */
2574 #define PERL_MAGIC_tiedelem       'p' /* Tied array or hash element */
2575 #define PERL_MAGIC_tiedscalar     'q' /* Tied scalar or handle */
2576 #define PERL_MAGIC_qr             'r' /* precompiled qr// regex */
2577 #define PERL_MAGIC_sig            'S' /* %SIG hash */
2578 #define PERL_MAGIC_sigelem        's' /* %SIG hash element */
2579 #define PERL_MAGIC_taint          't' /* Taintedness */
2580 #define PERL_MAGIC_uvar           'U' /* Available for use by extensions */
2581 #define PERL_MAGIC_vec            'v' /* vec() lvalue */
2582 #define PERL_MAGIC_substr         'x' /* substr() lvalue */
2583 #define PERL_MAGIC_defelem        'y' /* Shadow "foreach" iterator variable /
2584                                         smart parameter vivification */
2585 #define PERL_MAGIC_glob           '*' /* GV (typeglob) */
2586 #define PERL_MAGIC_arylen         '#' /* Array length ($#ary) */
2587 #define PERL_MAGIC_pos            '.' /* pos() lvalue */
2588 #define PERL_MAGIC_backref        '<' /* ??? */
2589 #define PERL_MAGIC_ext            '~' /* Available for use by extensions */
2590
2591
2592 #define YYMAXDEPTH 300
2593
2594 #ifndef assert  /* <assert.h> might have been included somehow */
2595 #define assert(what)    DEB( {                                          \
2596         if (!(what)) {                                                  \
2597             Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d",  \
2598                 __FILE__, __LINE__);                                    \
2599             PerlProc_exit(1);                                           \
2600         }})
2601 #endif
2602
2603 struct ufuncs {
2604     I32 (*uf_val)(pTHX_ IV, SV*);
2605     I32 (*uf_set)(pTHX_ IV, SV*);
2606     IV uf_index;
2607 };
2608
2609 /* In pre-5.7-Perls the PERL_MAGIC_uvar magic didn't get the thread context.
2610  * XS code wanting to be backward compatible can do something
2611  * like the following:
2612
2613 #ifndef PERL_MG_UFUNC
2614 #define PERL_MG_UFUNC(name,ix,sv) I32 name(IV ix, SV *sv)
2615 #endif
2616
2617 static PERL_MG_UFUNC(foo_get, index, val)
2618 {
2619     sv_setsv(val, ...);
2620     return TRUE;
2621 }
2622
2623 -- Doug MacEachern
2624
2625 */
2626
2627 #ifndef PERL_MG_UFUNC
2628 #define PERL_MG_UFUNC(name,ix,sv) I32 name(pTHX_ IV ix, SV *sv)
2629 #endif
2630
2631 /* Fix these up for __STDC__ */
2632 #ifndef DONT_DECLARE_STD
2633 char *mktemp (char*);
2634 #ifndef atof
2635 double atof (const char*);
2636 #endif
2637 #endif
2638
2639 #ifndef STANDARD_C
2640 /* All of these are in stdlib.h or time.h for ANSI C */
2641 Time_t time();
2642 struct tm *gmtime(), *localtime();
2643 #if defined(OEMVS) || defined(__OPEN_VM)
2644 char *(strchr)(), *(strrchr)();
2645 char *(strcpy)(), *(strcat)();
2646 #else
2647 char *strchr(), *strrchr();
2648 char *strcpy(), *strcat();
2649 #endif
2650 #endif /* ! STANDARD_C */
2651
2652
2653 #ifdef I_MATH
2654 #    include <math.h>
2655 #else
2656 START_EXTERN_C
2657             double exp (double);
2658             double log (double);
2659             double log10 (double);
2660             double sqrt (double);
2661             double frexp (double,int*);
2662             double ldexp (double,int);
2663             double modf (double,double*);
2664             double sin (double);
2665             double cos (double);
2666             double atan2 (double,double);
2667             double pow (double,double);
2668 END_EXTERN_C
2669 #endif
2670
2671 #if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(LDBL_INFINITY)
2672 #  define NV_INF LDBL_INFINITY
2673 #endif
2674 #if !defined(NV_INF) && defined(DBL_INFINITY)
2675 #  define NV_INF (NV)DBL_INFINITY
2676 #endif
2677 #if !defined(NV_INF) && defined(INFINITY)
2678 #  define NV_INF (NV)INFINITY
2679 #endif
2680 #if !defined(NV_INF) && defined(INF)
2681 #  define NV_INF (NV)INF
2682 #endif
2683 #if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
2684 #  define NV_INF (NV)HUGE_VALL
2685 #endif
2686 #if !defined(NV_INF) && defined(HUGE_VAL)
2687 #  define NV_INF (NV)HUGE_VAL
2688 #endif
2689
2690 #if !defined(NV_NAN) && defined(USE_LONG_DOUBLE)
2691 #   if !defined(NV_NAN) && defined(LDBL_NAN)
2692 #       define NV_NAN LDBL_NAN
2693 #   endif
2694 #   if !defined(NV_NAN) && defined(LDBL_QNAN)
2695 #       define NV_NAN LDBL_QNAN
2696 #   endif
2697 #   if !defined(NV_NAN) && defined(LDBL_SNAN)
2698 #       define NV_NAN LDBL_SNAN
2699 #   endif
2700 #endif
2701 #if !defined(NV_NAN) && defined(DBL_NAN)
2702 #  define NV_NAN (NV)DBL_NAN
2703 #endif
2704 #if !defined(NV_NAN) && defined(DBL_QNAN)
2705 #  define NV_NAN (NV)DBL_QNAN
2706 #endif
2707 #if !defined(NV_NAN) && defined(DBL_SNAN)
2708 #  define NV_NAN (NV)DBL_SNAN
2709 #endif
2710 #if !defined(NV_NAN) && defined(QNAN)
2711 #  define NV_NAN (NV)QNAN
2712 #endif
2713 #if !defined(NV_NAN) && defined(SNAN)
2714 #  define NV_NAN (NV)SNAN
2715 #endif
2716 #if !defined(NV_NAN) && defined(NAN)
2717 #  define NV_NAN (NV)NAN
2718 #endif
2719
2720 #ifndef __cplusplus
2721 #  if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */
2722 char *crypt ();       /* Maybe more hosts will need the unprototyped version */
2723 #  else
2724 #    if !defined(WIN32) && !defined(VMS)
2725 char *crypt (const char*, const char*);
2726 #    endif /* !WIN32 */
2727 #  endif /* !NeXT && !__NeXT__ */
2728 #  ifndef DONT_DECLARE_STD
2729 #    ifndef getenv
2730 char *getenv (const char*);
2731 #    endif /* !getenv */
2732 #    if !defined(HAS_LSEEK_PROTO) && !defined(EPOC) && !defined(__hpux)
2733 #      ifdef _FILE_OFFSET_BITS
2734 #        if _FILE_OFFSET_BITS == 64
2735 Off_t lseek (int,Off_t,int);
2736 #        endif
2737 #      endif
2738 #    endif
2739 #  endif /* !DONT_DECLARE_STD */
2740 char *getlogin (void);
2741 #endif /* !__cplusplus */
2742
2743 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
2744 #define UNLINK unlnk
2745 I32 unlnk (char*);
2746 #else
2747 #define UNLINK PerlLIO_unlink
2748 #endif
2749
2750 /* some versions of glibc are missing the setresuid() proto */
2751 #if defined(HAS_SETRESUID) && !defined(HAS_SETRESUID_PROTO)
2752 int setresuid(uid_t ruid, uid_t euid, uid_t suid);
2753 #endif
2754 /* some versions of glibc are missing the setresgid() proto */
2755 #if defined(HAS_SETRESGID) && !defined(HAS_SETRESGID_PROTO)
2756 int setresgid(gid_t rgid, gid_t egid, gid_t sgid);
2757 #endif
2758
2759 #ifndef HAS_SETREUID
2760 #  ifdef HAS_SETRESUID
2761 #    define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
2762 #    define HAS_SETREUID
2763 #  endif
2764 #endif
2765 #ifndef HAS_SETREGID
2766 #  ifdef HAS_SETRESGID
2767 #    define setregid(r,e) setresgid(r,e,(Gid_t)-1)
2768 #    define HAS_SETREGID
2769 #  endif
2770 #endif
2771
2772 /* Sighandler_t defined in iperlsys.h */
2773
2774 #ifdef HAS_SIGACTION
2775 typedef struct sigaction Sigsave_t;
2776 #else
2777 typedef Sighandler_t Sigsave_t;
2778 #endif
2779
2780 #define SCAN_DEF 0
2781 #define SCAN_TR 1
2782 #define SCAN_REPL 2
2783
2784 #ifdef DEBUGGING
2785 # ifndef register
2786 #  define register
2787 # endif
2788 # define PAD_SV(po) pad_sv(po)
2789 # define RUNOPS_DEFAULT Perl_runops_debug
2790 #else
2791 # define PAD_SV(po) PL_curpad[po]
2792 # define RUNOPS_DEFAULT Perl_runops_standard
2793 #endif
2794
2795 #ifdef MYMALLOC
2796 #  ifdef MUTEX_INIT_CALLS_MALLOC
2797 #    define MALLOC_INIT                                 \
2798         STMT_START {                                    \
2799                 PL_malloc_mutex = NULL;                 \
2800                 MUTEX_INIT(&PL_malloc_mutex);           \
2801         } STMT_END
2802 #    define MALLOC_TERM                                 \
2803         STMT_START {                                    \
2804                 perl_mutex tmp = PL_malloc_mutex;       \
2805                 PL_malloc_mutex = NULL;                 \
2806                 MUTEX_DESTROY(&tmp);                    \
2807         } STMT_END
2808 #  else
2809 #    define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
2810 #    define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
2811 #  endif
2812 #else
2813 #  define MALLOC_INIT
2814 #  define MALLOC_TERM
2815 #endif
2816
2817
2818 typedef int (CPERLscope(*runops_proc_t)) (pTHX);
2819 typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
2820
2821 /* _ (for $_) must be first in the following list (DEFSV requires it) */
2822 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
2823
2824 /* NeXT has problems with crt0.o globals */
2825 #if defined(__DYNAMIC__) && \
2826     (defined(NeXT) || defined(__NeXT__) || defined(__APPLE__))
2827 #  if defined(NeXT) || defined(__NeXT)
2828 #    include <mach-o/dyld.h>
2829 #    define environ (*environ_pointer)
2830 EXT char *** environ_pointer;
2831 #  else
2832 #    if defined(__APPLE__) && defined(PERL_CORE)
2833 #      include <crt_externs.h>  /* for the env array */
2834 #      define environ (*_NSGetEnviron())
2835 #    endif
2836 #  endif
2837 #else
2838    /* VMS and some other platforms don't use the environ array */
2839 #  ifdef USE_ENVIRON_ARRAY
2840 #    if !defined(DONT_DECLARE_STD) || \
2841         (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
2842         defined(__sgi) || \
2843         defined(__DGUX)
2844 extern char **  environ;        /* environment variables supplied via exec */
2845 #    endif
2846 #  endif
2847 #endif
2848
2849 START_EXTERN_C
2850
2851 /* handy constants */
2852 EXTCONST char PL_warn_uninit[]
2853   INIT("Use of uninitialized value%s%s");
2854 EXTCONST char PL_warn_nosemi[]
2855   INIT("Semicolon seems to be missing");
2856 EXTCONST char PL_warn_reserved[]
2857   INIT("Unquoted string \"%s\" may clash with future reserved word");
2858 EXTCONST char PL_warn_nl[]
2859   INIT("Unsuccessful %s on filename containing newline");
2860 EXTCONST char PL_no_wrongref[]
2861   INIT("Can't use %s ref as %s ref");
2862 EXTCONST char PL_no_symref[]
2863   INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
2864 EXTCONST char PL_no_usym[]
2865   INIT("Can't use an undefined value as %s reference");
2866 EXTCONST char PL_no_aelem[]
2867   INIT("Modification of non-creatable array value attempted, subscript %d");
2868 EXTCONST char PL_no_helem[]
2869   INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
2870 EXTCONST char PL_no_modify[]
2871   INIT("Modification of a read-only value attempted");
2872 EXTCONST char PL_no_mem[]
2873   INIT("Out of memory!\n");
2874 EXTCONST char PL_no_security[]
2875   INIT("Insecure dependency in %s%s");
2876 EXTCONST char PL_no_sock_func[]
2877   INIT("Unsupported socket function \"%s\" called");
2878 EXTCONST char PL_no_dir_func[]
2879   INIT("Unsupported directory function \"%s\" called");
2880 EXTCONST char PL_no_func[]
2881   INIT("The %s function is unimplemented");
2882 EXTCONST char PL_no_myglob[]
2883   INIT("\"my\" variable %s can't be in a package");
2884
2885 EXTCONST char PL_uuemap[65]
2886   INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
2887
2888
2889 #ifdef DOINIT
2890 EXT char *PL_sig_name[] = { SIG_NAME };
2891 EXT int   PL_sig_num[]  = { SIG_NUM };
2892 #else
2893 EXT char *PL_sig_name[];
2894 EXT int   PL_sig_num[];
2895 #endif
2896
2897 /* fast conversion and case folding tables */
2898
2899 #ifdef DOINIT
2900 #ifdef EBCDIC
2901 EXT unsigned char PL_fold[] = { /* fast EBCDIC case folding table */
2902     0,      1,      2,      3,      4,      5,      6,      7,
2903     8,      9,      10,     11,     12,     13,     14,     15,
2904     16,     17,     18,     19,     20,     21,     22,     23,
2905     24,     25,     26,     27,     28,     29,     30,     31,
2906     32,     33,     34,     35,     36,     37,     38,     39,
2907     40,     41,     42,     43,     44,     45,     46,     47,
2908     48,     49,     50,     51,     52,     53,     54,     55,
2909     56,     57,     58,     59,     60,     61,     62,     63,
2910     64,     65,     66,     67,     68,     69,     70,     71,
2911     72,     73,     74,     75,     76,     77,     78,     79,
2912     80,     81,     82,     83,     84,     85,     86,     87,
2913     88,     89,     90,     91,     92,     93,     94,     95,
2914     96,     97,     98,     99,     100,    101,    102,    103,
2915     104,    105,    106,    107,    108,    109,    110,    111,
2916     112,    113,    114,    115,    116,    117,    118,    119,
2917     120,    121,    122,    123,    124,    125,    126,    127,
2918     128,    'A',    'B',    'C',    'D',    'E',    'F',    'G',
2919     'H',    'I',    138,    139,    140,    141,    142,    143,
2920     144,    'J',    'K',    'L',    'M',    'N',    'O',    'P',
2921     'Q',    'R',    154,    155,    156,    157,    158,    159,
2922     160,    161,    'S',    'T',    'U',    'V',    'W',    'X',
2923     'Y',    'Z',    170,    171,    172,    173,    174,    175,
2924     176,    177,    178,    179,    180,    181,    182,    183,
2925     184,    185,    186,    187,    188,    189,    190,    191,
2926     192,    'a',    'b',    'c',    'd',    'e',    'f',    'g',
2927     'h',    'i',    202,    203,    204,    205,    206,    207,
2928     208,    'j',    'k',    'l',    'm',    'n',    'o',    'p',
2929     'q',    'r',    218,    219,    220,    221,    222,    223,
2930     224,    225,    's',    't',    'u',    'v',    'w',    'x',
2931     'y',    'z',    234,    235,    236,    237,    238,    239,
2932     240,    241,    242,    243,    244,    245,    246,    247,
2933     248,    249,    250,    251,    252,    253,    254,    255
2934 };
2935 #else   /* ascii rather than ebcdic */
2936 EXTCONST  unsigned char PL_fold[] = {
2937         0,      1,      2,      3,      4,      5,      6,      7,
2938         8,      9,      10,     11,     12,     13,     14,     15,
2939         16,     17,     18,     19,     20,     21,     22,     23,
2940         24,     25,     26,     27,     28,     29,     30,     31,
2941         32,     33,     34,     35,     36,     37,     38,     39,
2942         40,     41,     42,     43,     44,     45,     46,     47,
2943         48,     49,     50,     51,     52,     53,     54,     55,
2944         56,     57,     58,     59,     60,     61,     62,     63,
2945         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
2946         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
2947         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
2948         'x',    'y',    'z',    91,     92,     93,     94,     95,
2949         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
2950         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
2951         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
2952         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
2953         128,    129,    130,    131,    132,    133,    134,    135,
2954         136,    137,    138,    139,    140,    141,    142,    143,
2955         144,    145,    146,    147,    148,    149,    150,    151,
2956         152,    153,    154,    155,    156,    157,    158,    159,
2957         160,    161,    162,    163,    164,    165,    166,    167,
2958         168,    169,    170,    171,    172,    173,    174,    175,
2959         176,    177,    178,    179,    180,    181,    182,    183,
2960         184,    185,    186,    187,    188,    189,    190,    191,
2961         192,    193,    194,    195,    196,    197,    198,    199,
2962         200,    201,    202,    203,    204,    205,    206,    207,
2963         208,    209,    210,    211,    212,    213,    214,    215,
2964         216,    217,    218,    219,    220,    221,    222,    223,
2965         224,    225,    226,    227,    228,    229,    230,    231,
2966         232,    233,    234,    235,    236,    237,    238,    239,
2967         240,    241,    242,    243,    244,    245,    246,    247,
2968         248,    249,    250,    251,    252,    253,    254,    255
2969 };
2970 #endif  /* !EBCDIC */
2971 #else
2972 EXTCONST unsigned char PL_fold[];
2973 #endif
2974
2975 #ifdef DOINIT
2976 EXT unsigned char PL_fold_locale[] = {
2977         0,      1,      2,      3,      4,      5,      6,      7,
2978         8,      9,      10,     11,     12,     13,     14,     15,
2979         16,     17,     18,     19,     20,     21,     22,     23,
2980         24,     25,     26,     27,     28,     29,     30,     31,
2981         32,     33,     34,     35,     36,     37,     38,     39,
2982         40,     41,     42,     43,     44,     45,     46,     47,
2983         48,     49,     50,     51,     52,     53,     54,     55,
2984         56,     57,     58,     59,     60,     61,     62,     63,
2985         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
2986         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
2987         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
2988         'x',    'y',    'z',    91,     92,     93,     94,     95,
2989         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
2990         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
2991         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
2992         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
2993         128,    129,    130,    131,    132,    133,    134,    135,
2994         136,    137,    138,    139,    140,    141,    142,    143,
2995         144,    145,    146,    147,    148,    149,    150,    151,
2996         152,    153,    154,    155,    156,    157,    158,    159,
2997         160,    161,    162,    163,    164,    165,    166,    167,
2998         168,    169,    170,    171,    172,    173,    174,    175,
2999         176,    177,    178,    179,    180,    181,    182,    183,
3000         184,    185,    186,    187,    188,    189,    190,    191,
3001         192,    193,    194,    195,    196,    197,    198,    199,
3002         200,    201,    202,    203,    204,    205,    206,    207,
3003         208,    209,    210,    211,    212,    213,    214,    215,
3004         216,    217,    218,    219,    220,    221,    222,    223,
3005         224,    225,    226,    227,    228,    229,    230,    231,
3006         232,    233,    234,    235,    236,    237,    238,    239,
3007         240,    241,    242,    243,    244,    245,    246,    247,
3008         248,    249,    250,    251,    252,    253,    254,    255
3009 };
3010 #else
3011 EXT unsigned char PL_fold_locale[];
3012 #endif
3013
3014 #ifdef DOINIT
3015 #ifdef EBCDIC
3016 EXT unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */
3017     1,      2,      84,     151,    154,    155,    156,    157,
3018     165,    246,    250,    3,      158,    7,      18,     29,
3019     40,     51,     62,     73,     85,     96,     107,    118,
3020     129,    140,    147,    148,    149,    150,    152,    153,
3021     255,      6,      8,      9,     10,     11,     12,     13,
3022      14,     15,     24,     25,     26,     27,     28,    226,
3023      29,     30,     31,     32,     33,     43,     44,     45,
3024      46,     47,     48,     49,     50,     76,     77,     78,
3025      79,     80,     81,     82,     83,     84,     85,     86,
3026      87,     94,     95,    234,    181,    233,    187,    190,
3027     180,     96,     97,     98,     99,    100,    101,    102,
3028     104,    112,    182,    174,    236,    232,    229,    103,
3029     228,    226,    114,    115,    116,    117,    118,    119,
3030     120,    121,    122,    235,    176,    230,    194,    162,
3031     130,    131,    132,    133,    134,    135,    136,    137,
3032     138,    139,    201,    205,    163,    217,    220,    224,
3033     5,      248,    227,    244,    242,    255,    241,    231,
3034     240,    253,    16,     197,    19,     20,     21,     187,
3035     23,     169,    210,    245,    237,    249,    247,    239,
3036     168,    252,    34,     196,    36,     37,     38,     39,
3037     41,     42,     251,    254,    238,    223,    221,    213,
3038     225,    177,    52,     53,     54,     55,     56,     57,
3039     58,     59,     60,     61,     63,     64,     65,     66,
3040     67,     68,     69,     70,     71,     72,     74,     75,
3041     205,    208,    186,    202,    200,    218,    198,    179,
3042     178,    214,    88,     89,     90,     91,     92,     93,
3043     217,    166,    170,    207,    199,    209,    206,    204,
3044     160,    212,    105,    106,    108,    109,    110,    111,
3045     203,    113,    216,    215,    192,    175,    193,    243,
3046     172,    161,    123,    124,    125,    126,    127,    128,
3047     222,    219,    211,    195,    188,    193,    185,    184,
3048     191,    183,    141,    142,    143,    144,    145,    146
3049 };
3050 #else  /* ascii rather than ebcdic */
3051 EXTCONST unsigned char PL_freq[] = {    /* letter frequencies for mixed English/C */
3052         1,      2,      84,     151,    154,    155,    156,    157,
3053         165,    246,    250,    3,      158,    7,      18,     29,
3054         40,     51,     62,     73,     85,     96,     107,    118,
3055         129,    140,    147,    148,    149,    150,    152,    153,
3056         255,    182,    224,    205,    174,    176,    180,    217,
3057         233,    232,    236,    187,    235,    228,    234,    226,
3058         222,    219,    211,    195,    188,    193,    185,    184,
3059         191,    183,    201,    229,    181,    220,    194,    162,
3060         163,    208,    186,    202,    200,    218,    198,    179,
3061         178,    214,    166,    170,    207,    199,    209,    206,
3062         204,    160,    212,    216,    215,    192,    175,    173,
3063         243,    172,    161,    190,    203,    189,    164,    230,
3064         167,    248,    227,    244,    242,    255,    241,    231,
3065         240,    253,    169,    210,    245,    237,    249,    247,
3066         239,    168,    252,    251,    254,    238,    223,    221,
3067         213,    225,    177,    197,    171,    196,    159,    4,
3068         5,      6,      8,      9,      10,     11,     12,     13,
3069         14,     15,     16,     17,     19,     20,     21,     22,
3070         23,     24,     25,     26,     27,     28,     30,     31,
3071         32,     33,     34,     35,     36,     37,     38,     39,
3072         41,     42,     43,     44,     45,     46,     47,     48,
3073         49,     50,     52,     53,     54,     55,     56,     57,
3074         58,     59,     60,     61,     63,     64,     65,     66,
3075         67,     68,     69,     70,     71,     72,     74,     75,
3076         76,     77,     78,     79,     80,     81,     82,     83,
3077         86,     87,     88,     89,     90,     91,     92,     93,
3078         94,     95,     97,     98,     99,     100,    101,    102,
3079         103,    104,    105,    106,    108,    109,    110,    111,
3080         112,    113,    114,    115,    116,    117,    119,    120,
3081         121,    122,    123,    124,    125,    126,    127,    128,
3082         130,    131,    132,    133,    134,    135,    136,    137,
3083         138,    139,    141,    142,    143,    144,    145,    146
3084 };
3085 #endif
3086 #else
3087 EXTCONST unsigned char PL_freq[];
3088 #endif
3089
3090 #ifdef DEBUGGING
3091 #ifdef DOINIT
3092 EXTCONST char* PL_block_type[] = {
3093         "NULL",
3094         "SUB",
3095         "EVAL",
3096         "LOOP",
3097         "SUBST",
3098         "BLOCK",
3099 };
3100 #else
3101 EXTCONST char* PL_block_type[];
3102 #endif
3103 #endif
3104
3105 END_EXTERN_C
3106
3107 /*****************************************************************************/
3108 /* This lexer/parser stuff is currently global since yacc is hard to reenter */
3109 /*****************************************************************************/
3110 /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
3111
3112 #include "perly.h"
3113
3114 #define LEX_NOTPARSING          11      /* borrowed from toke.c */
3115
3116 typedef enum {
3117     XOPERATOR,
3118     XTERM,
3119     XREF,
3120     XSTATE,
3121     XBLOCK,
3122     XATTRBLOCK,
3123     XATTRTERM,
3124     XTERMBLOCK
3125 } expectation;
3126
3127 enum {          /* pass one of these to get_vtbl */
3128     want_vtbl_sv,
3129     want_vtbl_env,
3130     want_vtbl_envelem,
3131     want_vtbl_sig,
3132     want_vtbl_sigelem,
3133     want_vtbl_pack,
3134     want_vtbl_packelem,
3135     want_vtbl_dbline,
3136     want_vtbl_isa,
3137     want_vtbl_isaelem,
3138     want_vtbl_arylen,
3139     want_vtbl_glob,
3140     want_vtbl_mglob,
3141     want_vtbl_nkeys,
3142     want_vtbl_taint,
3143     want_vtbl_substr,
3144     want_vtbl_vec,
3145     want_vtbl_pos,
3146     want_vtbl_bm,
3147     want_vtbl_fm,
3148     want_vtbl_uvar,
3149     want_vtbl_defelem,
3150     want_vtbl_regexp,
3151     want_vtbl_collxfrm,
3152     want_vtbl_amagic,
3153     want_vtbl_amagicelem,
3154 #ifdef USE_5005THREADS
3155     want_vtbl_mutex,
3156 #endif
3157     want_vtbl_regdata,
3158     want_vtbl_regdatum,
3159     want_vtbl_backref
3160 };
3161
3162                                 /* Note: the lowest 8 bits are reserved for
3163                                    stuffing into op->op_private */
3164 #define HINT_PRIVATE_MASK       0x000000ff
3165 #define HINT_INTEGER            0x00000001
3166 #define HINT_STRICT_REFS        0x00000002
3167 #define HINT_LOCALE             0x00000004
3168 #define HINT_BYTES              0x00000008
3169 #define HINT_BYTES              0x00000008
3170 /* #define HINT_notused10       0x00000010 */
3171                                 /* Note: 20,40,80 used for NATIVE_HINTS */
3172
3173 #define HINT_BLOCK_SCOPE        0x00000100
3174 #define HINT_STRICT_SUBS        0x00000200
3175 #define HINT_STRICT_VARS        0x00000400
3176
3177 #define HINT_NEW_INTEGER        0x00001000
3178 #define HINT_NEW_FLOAT          0x00002000
3179 #define HINT_NEW_BINARY         0x00004000
3180 #define HINT_NEW_STRING         0x00008000
3181 #define HINT_NEW_RE             0x00010000
3182 #define HINT_LOCALIZE_HH        0x00020000 /* %^H needs to be copied */
3183
3184 #define HINT_RE_TAINT           0x00100000
3185 #define HINT_RE_EVAL            0x00200000
3186
3187 #define HINT_FILETEST_ACCESS    0x00400000
3188 #define HINT_UTF8               0x00800000
3189
3190 /* Various states of an input record separator SV (rs, nrs) */
3191 #define RsSNARF(sv)   (! SvOK(sv))
3192 #define RsSIMPLE(sv)  (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))
3193 #define RsPARA(sv)    (SvPOK(sv) && ! SvCUR(sv))
3194 #define RsRECORD(sv)  (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
3195
3196 /* Enable variables which are pointers to functions */
3197 typedef void (CPERLscope(*peep_t))(pTHX_ OP* o);
3198 typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm);
3199 typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg,
3200                                       char* strend, char* strbeg, I32 minend,
3201                                       SV* screamer, void* data, U32 flags);
3202 typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv,
3203                                                 char *strpos, char *strend,
3204                                                 U32 flags,
3205                                                 struct re_scream_pos_data_s *d);
3206 typedef SV*     (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog);
3207 typedef void    (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r);
3208
3209 typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*);
3210 typedef void (*DESTRUCTORFUNC_t) (pTHXo_ void*);
3211 typedef void (*SVFUNC_t) (pTHXo_ SV*);
3212 typedef I32  (*SVCOMPARE_t) (pTHXo_ SV*, SV*);
3213 typedef void (*XSINIT_t) (pTHXo);
3214 typedef void (*ATEXIT_t) (pTHXo_ void*);
3215 typedef void (*XSUBADDR_t) (pTHXo_ CV *);
3216
3217 /* Set up PERLVAR macros for populating structs */
3218 #define PERLVAR(var,type) type var;
3219 #define PERLVARA(var,n,type) type var[n];
3220 #define PERLVARI(var,type,init) type var;
3221 #define PERLVARIC(var,type,init) type var;
3222
3223 /* Interpreter exitlist entry */
3224 typedef struct exitlistentry {
3225     void (*fn) (pTHXo_ void*);
3226     void *ptr;
3227 } PerlExitListEntry;
3228
3229 #ifdef PERL_GLOBAL_STRUCT
3230 struct perl_vars {
3231 #  include "perlvars.h"
3232 };
3233
3234 #  ifdef PERL_CORE
3235 EXT struct perl_vars PL_Vars;
3236 EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
3237 #  else /* PERL_CORE */
3238 #    if !defined(__GNUC__) || !defined(WIN32)
3239 EXT
3240 #    endif /* WIN32 */
3241 struct perl_vars *PL_VarsPtr;
3242 #    define PL_Vars (*((PL_VarsPtr) \
3243                        ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX))))
3244 #  endif /* PERL_CORE */
3245 #endif /* PERL_GLOBAL_STRUCT */
3246
3247 #if defined(MULTIPLICITY) || defined(PERL_OBJECT)
3248 /* If we have multiple interpreters define a struct
3249    holding variables which must be per-interpreter
3250    If we don't have threads anything that would have
3251    be per-thread is per-interpreter.
3252 */
3253
3254 struct interpreter {
3255 #  ifndef USE_5005THREADS
3256 #    include "thrdvar.h"
3257 #  endif
3258 #  include "intrpvar.h"
3259 /*
3260  * The following is a buffer where new variables must
3261  * be defined to maintain binary compatibility with PERL_OBJECT
3262  */
3263 PERLVARA(object_compatibility,30,       char)
3264 };
3265
3266 #else
3267 struct interpreter {
3268     char broiled;
3269 };
3270 #endif /* MULTIPLICITY || PERL_OBJECT */
3271
3272 #ifdef USE_5005THREADS
3273 /* If we have threads define a struct with all the variables
3274  * that have to be per-thread
3275  */
3276
3277
3278 struct perl_thread {
3279 #include "thrdvar.h"
3280 };
3281
3282 typedef struct perl_thread *Thread;
3283
3284 #else
3285 typedef void *Thread;
3286 #endif
3287
3288 /* Done with PERLVAR macros for now ... */
3289 #undef PERLVAR
3290 #undef PERLVARA
3291 #undef PERLVARI
3292 #undef PERLVARIC
3293
3294 #include "thread.h"
3295 #include "pp.h"
3296
3297 #ifndef PERL_CALLCONV
3298 #  define PERL_CALLCONV
3299 #endif
3300
3301 #ifndef NEXT30_NO_ATTRIBUTE
3302 #  ifndef HASATTRIBUTE       /* disable GNU-cc attribute checking? */
3303 #    ifdef  __attribute__      /* Avoid possible redefinition errors */
3304 #      undef  __attribute__
3305 #    endif
3306 #    define __attribute__(attr)
3307 #  endif
3308 #endif
3309
3310 #ifdef PERL_OBJECT
3311 #  define PERL_DECL_PROT
3312 #endif
3313
3314 #undef PERL_CKDEF
3315 #undef PERL_PPDEF
3316 #define PERL_CKDEF(s)   OP *s (pTHX_ OP *o);
3317 #define PERL_PPDEF(s)   OP *s (pTHX);
3318
3319 #include "proto.h"
3320
3321 #ifdef PERL_OBJECT
3322 #  undef PERL_DECL_PROT
3323 #endif
3324
3325 #ifndef PERL_OBJECT
3326 /* this has structure inits, so it cannot be included before here */
3327 #  include "opcode.h"
3328 #endif
3329
3330 /* The following must follow proto.h as #defines mess up syntax */
3331
3332 #if !defined(PERL_FOR_X2P)
3333 #  include "embedvar.h"
3334 #endif
3335
3336 /* Now include all the 'global' variables
3337  * If we don't have threads or multiple interpreters
3338  * these include variables that would have been their struct-s
3339  */
3340
3341 #define PERLVAR(var,type) EXT type PL_##var;
3342 #define PERLVARA(var,n,type) EXT type PL_##var[n];
3343 #define PERLVARI(var,type,init) EXT type  PL_##var INIT(init);
3344 #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
3345
3346 #if !defined(MULTIPLICITY) && !defined(PERL_OBJECT)
3347 START_EXTERN_C
3348 #  include "intrpvar.h"
3349 #  ifndef USE_5005THREADS
3350 #    include "thrdvar.h"
3351 #  endif
3352 END_EXTERN_C
3353 #endif
3354
3355 #ifdef PERL_OBJECT
3356 #  include "embed.h"
3357
3358 #  ifdef DOINIT
3359 #    include "INTERN.h"
3360 #  else
3361 #    include "EXTERN.h"
3362 #  endif
3363
3364 /* this has structure inits, so it cannot be included before here */
3365 #  include "opcode.h"
3366
3367 #else
3368 #  if defined(WIN32)
3369 #    include "embed.h"
3370 #  endif
3371 #endif  /* PERL_OBJECT */
3372
3373 #ifndef PERL_GLOBAL_STRUCT
3374 START_EXTERN_C
3375
3376 #  include "perlvars.h"
3377
3378 END_EXTERN_C
3379 #endif
3380
3381 #undef PERLVAR
3382 #undef PERLVARA
3383 #undef PERLVARI
3384 #undef PERLVARIC
3385
3386 START_EXTERN_C
3387
3388 #ifdef DOINIT
3389
3390 EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get),
3391                                 MEMBER_TO_FPTR(Perl_magic_set),
3392                                         MEMBER_TO_FPTR(Perl_magic_len),
3393                                                 0,      0};
3394 EXT MGVTBL PL_vtbl_env =        {0,     MEMBER_TO_FPTR(Perl_magic_set_all_env),
3395                                 0,      MEMBER_TO_FPTR(Perl_magic_clear_all_env),
3396                                                         0};
3397 EXT MGVTBL PL_vtbl_envelem =    {0,     MEMBER_TO_FPTR(Perl_magic_setenv),
3398                                         0,      MEMBER_TO_FPTR(Perl_magic_clearenv),
3399                                                         0};
3400 EXT MGVTBL PL_vtbl_sig =        {0,     0,               0, 0, 0};
3401 #ifdef PERL_MICRO
3402 EXT MGVTBL PL_vtbl_sigelem =    {0,     0,               0, 0, 0};
3403 #else
3404 EXT MGVTBL PL_vtbl_sigelem =    {MEMBER_TO_FPTR(Perl_magic_getsig),
3405                                         MEMBER_TO_FPTR(Perl_magic_setsig),
3406                                         0,      MEMBER_TO_FPTR(Perl_magic_clearsig),
3407                                                         0};
3408 #endif
3409 EXT MGVTBL PL_vtbl_pack =       {0,     0,      MEMBER_TO_FPTR(Perl_magic_sizepack),    MEMBER_TO_FPTR(Perl_magic_wipepack),
3410                                                         0};
3411 EXT MGVTBL PL_vtbl_packelem =   {MEMBER_TO_FPTR(Perl_magic_getpack),
3412                                 MEMBER_TO_FPTR(Perl_magic_setpack),
3413                                         0,      MEMBER_TO_FPTR(Perl_magic_clearpack),
3414                                                         0};
3415 EXT MGVTBL PL_vtbl_dbline =     {0,     MEMBER_TO_FPTR(Perl_magic_setdbline),
3416                                         0,      0,      0};
3417 EXT MGVTBL PL_vtbl_isa =        {0,     MEMBER_TO_FPTR(Perl_magic_setisa),
3418                                         0,      MEMBER_TO_FPTR(Perl_magic_setisa),
3419                                                         0};
3420 EXT MGVTBL PL_vtbl_isaelem =    {0,     MEMBER_TO_FPTR(Perl_magic_setisa),
3421                                         0,      0,      0};
3422 EXT MGVTBL PL_vtbl_arylen =     {MEMBER_TO_FPTR(Perl_magic_getarylen),
3423                                 MEMBER_TO_FPTR(Perl_magic_setarylen),
3424                                         0,      0,      0};
3425 EXT MGVTBL PL_vtbl_glob =       {MEMBER_TO_FPTR(Perl_magic_getglob),
3426                                 MEMBER_TO_FPTR(Perl_magic_setglob),
3427                                         0,      0,      0};
3428 EXT MGVTBL PL_vtbl_mglob =      {0,     MEMBER_TO_FPTR(Perl_magic_setmglob),
3429                                         0,      0,      0};
3430 EXT MGVTBL PL_vtbl_nkeys =      {MEMBER_TO_FPTR(Perl_magic_getnkeys),
3431                                 MEMBER_TO_FPTR(Perl_magic_setnkeys),
3432                                         0,      0,      0};
3433 EXT MGVTBL PL_vtbl_taint =      {MEMBER_TO_FPTR(Perl_magic_gettaint),MEMBER_TO_FPTR(Perl_magic_settaint),
3434                                         0,      0,      0};
3435 EXT MGVTBL PL_vtbl_substr =     {MEMBER_TO_FPTR(Perl_magic_getsubstr), MEMBER_TO_FPTR(Perl_magic_setsubstr),
3436                                         0,      0,      0};
3437 EXT MGVTBL PL_vtbl_vec =        {MEMBER_TO_FPTR(Perl_magic_getvec),
3438                                 MEMBER_TO_FPTR(Perl_magic_setvec),
3439                                         0,      0,      0};
3440 EXT MGVTBL PL_vtbl_pos =        {MEMBER_TO_FPTR(Perl_magic_getpos),
3441                                 MEMBER_TO_FPTR(Perl_magic_setpos),
3442                                         0,      0,      0};
3443 EXT MGVTBL PL_vtbl_bm = {0,     MEMBER_TO_FPTR(Perl_magic_setbm),
3444                                         0,      0,      0};
3445 EXT MGVTBL PL_vtbl_fm = {0,     MEMBER_TO_FPTR(Perl_magic_setfm),
3446                                         0,      0,      0};
3447 EXT MGVTBL PL_vtbl_uvar =       {MEMBER_TO_FPTR(Perl_magic_getuvar),
3448                                 MEMBER_TO_FPTR(Perl_magic_setuvar),
3449                                         0,      0,      0};
3450 #ifdef USE_5005THREADS
3451 EXT MGVTBL PL_vtbl_mutex =      {0,     0,      0,      0,      MEMBER_TO_FPTR(Perl_magic_mutexfree)};
3452 #endif /* USE_5005THREADS */
3453 EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),MEMBER_TO_FPTR(Perl_magic_setdefelem),
3454                                         0,      0,      0};
3455
3456 EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
3457 EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0};
3458 EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get),
3459                                MEMBER_TO_FPTR(Perl_magic_regdatum_set), 0, 0, 0};
3460
3461 #ifdef USE_LOCALE_COLLATE
3462 EXT MGVTBL PL_vtbl_collxfrm = {0,
3463                                 MEMBER_TO_FPTR(Perl_magic_setcollxfrm),
3464                                         0,      0,      0};
3465 #endif
3466
3467 EXT MGVTBL PL_vtbl_amagic =       {0,     MEMBER_TO_FPTR(Perl_magic_setamagic),
3468                                         0,      0,      MEMBER_TO_FPTR(Perl_magic_setamagic)};
3469 EXT MGVTBL PL_vtbl_amagicelem =   {0,     MEMBER_TO_FPTR(Perl_magic_setamagic),
3470                                         0,      0,      MEMBER_TO_FPTR(Perl_magic_setamagic)};
3471
3472 EXT MGVTBL PL_vtbl_backref =      {0,   0,
3473                                         0,      0,      MEMBER_TO_FPTR(Perl_magic_killbackrefs)};
3474
3475 EXT MGVTBL PL_vtbl_ovrld   =      {0,   0,
3476                                         0,      0,      MEMBER_TO_FPTR(Perl_magic_freeovrld)};
3477
3478 #else /* !DOINIT */
3479
3480 EXT MGVTBL PL_vtbl_sv;
3481 EXT MGVTBL PL_vtbl_env;
3482 EXT MGVTBL PL_vtbl_envelem;
3483 EXT MGVTBL PL_vtbl_sig;
3484 EXT MGVTBL PL_vtbl_sigelem;
3485 EXT MGVTBL PL_vtbl_pack;
3486 EXT MGVTBL PL_vtbl_packelem;
3487 EXT MGVTBL PL_vtbl_dbline;
3488 EXT MGVTBL PL_vtbl_isa;
3489 EXT MGVTBL PL_vtbl_isaelem;
3490 EXT MGVTBL PL_vtbl_arylen;
3491 EXT MGVTBL PL_vtbl_glob;
3492 EXT MGVTBL PL_vtbl_mglob;
3493 EXT MGVTBL PL_vtbl_nkeys;
3494 EXT MGVTBL PL_vtbl_taint;
3495 EXT MGVTBL PL_vtbl_substr;
3496 EXT MGVTBL PL_vtbl_vec;
3497 EXT MGVTBL PL_vtbl_pos;
3498 EXT MGVTBL PL_vtbl_bm;
3499 EXT MGVTBL PL_vtbl_fm;
3500 EXT MGVTBL PL_vtbl_uvar;
3501 EXT MGVTBL PL_vtbl_ovrld;
3502
3503 #ifdef USE_5005THREADS
3504 EXT MGVTBL PL_vtbl_mutex;
3505 #endif /* USE_5005THREADS */
3506
3507 EXT MGVTBL PL_vtbl_defelem;
3508 EXT MGVTBL PL_vtbl_regexp;
3509 EXT MGVTBL PL_vtbl_regdata;
3510 EXT MGVTBL PL_vtbl_regdatum;
3511
3512 #ifdef USE_LOCALE_COLLATE
3513 EXT MGVTBL PL_vtbl_collxfrm;
3514 #endif
3515
3516 EXT MGVTBL PL_vtbl_amagic;
3517 EXT MGVTBL PL_vtbl_amagicelem;
3518
3519 EXT MGVTBL PL_vtbl_backref;
3520
3521 #endif /* !DOINIT */
3522
3523 enum {
3524   fallback_amg,        abs_amg,
3525   bool__amg,   nomethod_amg,
3526   string_amg,  numer_amg,
3527   add_amg,     add_ass_amg,
3528   subtr_amg,   subtr_ass_amg,
3529   mult_amg,    mult_ass_amg,
3530   div_amg,     div_ass_amg,
3531   modulo_amg,  modulo_ass_amg,
3532   pow_amg,     pow_ass_amg,
3533   lshift_amg,  lshift_ass_amg,
3534   rshift_amg,  rshift_ass_amg,
3535   band_amg,    band_ass_amg,
3536   bor_amg,     bor_ass_amg,
3537   bxor_amg,    bxor_ass_amg,
3538   lt_amg,      le_amg,
3539   gt_amg,      ge_amg,
3540   eq_amg,      ne_amg,
3541   ncmp_amg,    scmp_amg,
3542   slt_amg,     sle_amg,
3543   sgt_amg,     sge_amg,
3544   seq_amg,     sne_amg,
3545   not_amg,     compl_amg,
3546   inc_amg,     dec_amg,
3547   atan2_amg,   cos_amg,
3548   sin_amg,     exp_amg,
3549   log_amg,     sqrt_amg,
3550   repeat_amg,   repeat_ass_amg,
3551   concat_amg,  concat_ass_amg,
3552   copy_amg,    neg_amg,
3553   to_sv_amg,   to_av_amg,
3554   to_hv_amg,   to_gv_amg,
3555   to_cv_amg,   iter_amg,
3556   int_amg,      DESTROY_amg,
3557   max_amg_code
3558   /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
3559 };
3560
3561 #define NofAMmeth max_amg_code
3562 #define AMG_id2name(id) ((char*)PL_AMG_names[id]+1)
3563
3564 #ifdef DOINIT
3565 EXTCONST char * PL_AMG_names[NofAMmeth] = {
3566   /* Names kept in the symbol table.  fallback => "()", the rest has
3567      "(" prepended.  The only other place in perl which knows about
3568      this convention is AMG_id2name (used for debugging output and
3569      'nomethod' only), the only other place which has it hardwired is
3570      overload.pm.  */
3571   "()",         "(abs",                 /* "fallback" should be the first. */
3572   "(bool",      "(nomethod",
3573   "(\"\"",      "(0+",
3574   "(+",         "(+=",
3575   "(-",         "(-=",
3576   "(*",         "(*=",
3577   "(/",         "(/=",
3578   "(%",         "(%=",
3579   "(**",        "(**=",
3580   "(<<",        "(<<=",
3581   "(>>",        "(>>=",
3582   "(&",         "(&=",
3583   "(|",         "(|=",
3584   "(^",         "(^=",
3585   "(<",         "(<=",
3586   "(>",         "(>=",
3587   "(==",        "(!=",
3588   "(<=>",       "(cmp",
3589   "(lt",        "(le",
3590   "(gt",        "(ge",
3591   "(eq",        "(ne",
3592   "(!",         "(~",
3593   "(++",        "(--",
3594   "(atan2",     "(cos",
3595   "(sin",       "(exp",
3596   "(log",       "(sqrt",
3597   "(x",         "(x=",
3598   "(.",         "(.=",
3599   "(=",         "(neg",
3600   "(${}",       "(@{}",
3601   "(%{}",       "(*{}",
3602   "(&{}",       "(<>",
3603   "(int",       "DESTROY",
3604 };
3605 #else
3606 EXTCONST char * PL_AMG_names[NofAMmeth];
3607 #endif /* def INITAMAGIC */
3608
3609 END_EXTERN_C
3610
3611 struct am_table {
3612   long was_ok_sub;
3613   long was_ok_am;
3614   U32 flags;
3615   CV* table[NofAMmeth];
3616   long fallback;
3617 };
3618 struct am_table_short {
3619   long was_ok_sub;
3620   long was_ok_am;
3621   U32 flags;
3622 };
3623 typedef struct am_table AMT;
3624 typedef struct am_table_short AMTS;
3625
3626 #define AMGfallNEVER    1
3627 #define AMGfallNO       2
3628 #define AMGfallYES      3
3629
3630 #define AMTf_AMAGIC             1
3631 #define AMTf_OVERLOADED         2
3632 #define AMT_AMAGIC(amt)         ((amt)->flags & AMTf_AMAGIC)
3633 #define AMT_AMAGIC_on(amt)      ((amt)->flags |= AMTf_AMAGIC)
3634 #define AMT_AMAGIC_off(amt)     ((amt)->flags &= ~AMTf_AMAGIC)
3635 #define AMT_OVERLOADED(amt)     ((amt)->flags & AMTf_OVERLOADED)
3636 #define AMT_OVERLOADED_on(amt)  ((amt)->flags |= AMTf_OVERLOADED)
3637 #define AMT_OVERLOADED_off(amt) ((amt)->flags &= ~AMTf_OVERLOADED)
3638
3639 #define StashHANDLER(stash,meth)        gv_handler((stash),CAT2(meth,_amg))
3640
3641 /*
3642  * some compilers like to redefine cos et alia as faster
3643  * (and less accurate?) versions called F_cos et cetera (Quidquid
3644  * latine dictum sit, altum viditur.)  This trick collides with
3645  * the Perl overloading (amg).  The following #defines fool both.
3646  */
3647
3648 #ifdef _FASTMATH
3649 #   ifdef atan2
3650 #       define F_atan2_amg  atan2_amg
3651 #   endif
3652 #   ifdef cos
3653 #       define F_cos_amg    cos_amg
3654 #   endif
3655 #   ifdef exp
3656 #       define F_exp_amg    exp_amg
3657 #   endif
3658 #   ifdef log
3659 #       define F_log_amg    log_amg
3660 #   endif
3661 #   ifdef pow
3662 #       define F_pow_amg    pow_amg
3663 #   endif
3664 #   ifdef sin
3665 #       define F_sin_amg    sin_amg
3666 #   endif
3667 #   ifdef sqrt
3668 #       define F_sqrt_amg   sqrt_amg
3669 #   endif
3670 #endif /* _FASTMATH */
3671
3672 #define PERLDB_ALL              (PERLDBf_SUB    | PERLDBf_LINE  |       \
3673                                  PERLDBf_NOOPT  | PERLDBf_INTER |       \
3674                                  PERLDBf_SUBLINE| PERLDBf_SINGLE|       \
3675                                  PERLDBf_NAMEEVAL| PERLDBf_NAMEANON)
3676                                         /* No _NONAME, _GOTO */
3677 #define PERLDBf_SUB             0x01    /* Debug sub enter/exit */
3678 #define PERLDBf_LINE            0x02    /* Keep line # */
3679 #define PERLDBf_NOOPT           0x04    /* Switch off optimizations */
3680 #define PERLDBf_INTER           0x08    /* Preserve more data for
3681                                            later inspections  */
3682 #define PERLDBf_SUBLINE         0x10    /* Keep subr source lines */
3683 #define PERLDBf_SINGLE          0x20    /* Start with single-step on */
3684 #define PERLDBf_NONAME          0x40    /* For _SUB: no name of the subr */
3685 #define PERLDBf_GOTO            0x80    /* Report goto: call DB::goto */
3686 #define PERLDBf_NAMEEVAL        0x100   /* Informative names for evals */
3687 #define PERLDBf_NAMEANON        0x200   /* Informative names for anon subs */
3688
3689 #define PERLDB_SUB      (PL_perldb && (PL_perldb & PERLDBf_SUB))
3690 #define PERLDB_LINE     (PL_perldb && (PL_perldb & PERLDBf_LINE))
3691 #define PERLDB_NOOPT    (PL_perldb && (PL_perldb & PERLDBf_NOOPT))
3692 #define PERLDB_INTER    (PL_perldb && (PL_perldb & PERLDBf_INTER))
3693 #define PERLDB_SUBLINE  (PL_perldb && (PL_perldb & PERLDBf_SUBLINE))
3694 #define PERLDB_SINGLE   (PL_perldb && (PL_perldb & PERLDBf_SINGLE))
3695 #define PERLDB_SUB_NN   (PL_perldb && (PL_perldb & (PERLDBf_NONAME)))
3696 #define PERLDB_GOTO     (PL_perldb && (PL_perldb & PERLDBf_GOTO))
3697 #define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL))
3698 #define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
3699
3700
3701 #ifdef USE_LOCALE_NUMERIC
3702
3703 #define SET_NUMERIC_STANDARD() \
3704         set_numeric_standard();
3705
3706 #define SET_NUMERIC_LOCAL() \
3707         set_numeric_local();
3708
3709 #define IN_LOCALE_RUNTIME       (PL_curcop->op_private & HINT_LOCALE)
3710 #define IN_LOCALE_COMPILETIME   (PL_hints & HINT_LOCALE)
3711
3712 #define IN_LOCALE \
3713         (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
3714
3715 #define STORE_NUMERIC_LOCAL_SET_STANDARD() \
3716         bool was_local = PL_numeric_local && IN_LOCALE; \
3717         if (was_local) SET_NUMERIC_STANDARD();
3718
3719 #define STORE_NUMERIC_STANDARD_SET_LOCAL() \
3720         bool was_standard = PL_numeric_standard && IN_LOCALE; \
3721         if (was_standard) SET_NUMERIC_LOCAL();
3722
3723 #define RESTORE_NUMERIC_LOCAL() \
3724         if (was_local) SET_NUMERIC_LOCAL();
3725
3726 #define RESTORE_NUMERIC_STANDARD() \
3727         if (was_standard) SET_NUMERIC_STANDARD();
3728
3729 #define Atof                            my_atof
3730
3731 #else /* !USE_LOCALE_NUMERIC */
3732
3733 #define SET_NUMERIC_STANDARD()          /**/
3734 #define SET_NUMERIC_LOCAL()             /**/
3735 #define IS_NUMERIC_RADIX(a, b)          (0)
3736 #define STORE_NUMERIC_LOCAL_SET_STANDARD()      /**/
3737 #define STORE_NUMERIC_STANDARD_SET_LOCAL()      /**/
3738 #define RESTORE_NUMERIC_LOCAL()         /**/
3739 #define RESTORE_NUMERIC_STANDARD()      /**/
3740 #define Atof                            Perl_atof
3741 #define IN_LOCALE_RUNTIME               0
3742
3743 #endif /* !USE_LOCALE_NUMERIC */
3744
3745 #if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG
3746 #    ifdef __hpux
3747 #        define strtoll __strtoll       /* secret handshake */
3748 #    endif
3749 #   if !defined(Strtol) && defined(HAS_STRTOLL)
3750 #       define Strtol   strtoll
3751 #   endif
3752 #    if !defined(Strtol) && defined(HAS_STRTOQ)
3753 #       define Strtol   strtoq
3754 #    endif
3755 /* is there atoq() anywhere? */
3756 #endif
3757 #if !defined(Strtol) && defined(HAS_STRTOL)
3758 #   define Strtol       strtol
3759 #endif
3760 #ifndef Atol
3761 /* It would be more fashionable to use Strtol() to define atol()
3762  * (as is done for Atoul(), see below) but for backward compatibility
3763  * we just assume atol(). */
3764 #   if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_ATOLL)
3765 #       define Atol     atoll
3766 #   else
3767 #       define Atol     atol
3768 #   endif
3769 #endif
3770
3771 #if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG
3772 #    ifdef __hpux
3773 #        define strtoull __strtoull     /* secret handshake */
3774 #    endif
3775 #    if !defined(Strtoul) && defined(HAS_STRTOULL)
3776 #       define Strtoul  strtoull
3777 #    endif
3778 #    if !defined(Strtoul) && defined(HAS_STRTOUQ)
3779 #       define Strtoul  strtouq
3780 #    endif
3781 /* is there atouq() anywhere? */
3782 #endif
3783 #if !defined(Strtoul) && defined(HAS_STRTOUL)
3784 #   define Strtoul      strtoul
3785 #endif
3786 #ifndef Atoul
3787 #   define Atoul(s)     Strtoul(s, (char **)NULL, 10)
3788 #endif
3789
3790 #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
3791 /*
3792  * Now we have __attribute__ out of the way
3793  * Remap printf
3794  */
3795 #undef printf
3796 #ifdef __GNUC__
3797 #define printf(fmt,args...) PerlIO_stdoutf(fmt,##args)
3798 #else
3799 #define printf PerlIO_stdoutf
3800 #endif
3801 #endif
3802
3803 /* if these never got defined, they need defaults */
3804 #ifndef PERL_SET_CONTEXT
3805 #  define PERL_SET_CONTEXT(i)           PERL_SET_INTERP(i)
3806 #endif
3807
3808 #ifndef PERL_GET_CONTEXT
3809 #  define PERL_GET_CONTEXT              PERL_GET_INTERP
3810 #endif
3811
3812 #ifndef PERL_GET_THX
3813 #  define PERL_GET_THX                  ((void*)NULL)
3814 #endif
3815
3816 #ifndef PERL_SET_THX
3817 #  define PERL_SET_THX(t)               NOOP
3818 #endif
3819
3820 #ifndef PERL_SCRIPT_MODE
3821 #define PERL_SCRIPT_MODE "r"
3822 #endif
3823
3824 /*
3825  * Some operating systems are stingy with stack allocation,
3826  * so perl may have to guard against stack overflow.
3827  */
3828 #ifndef PERL_STACK_OVERFLOW_CHECK
3829 #define PERL_STACK_OVERFLOW_CHECK()  NOOP
3830 #endif
3831
3832 /*
3833  * Some nonpreemptive operating systems find it convenient to
3834  * check for asynchronous conditions after each op execution.
3835  * Keep this check simple, or it may slow down execution
3836  * massively.
3837  */
3838
3839 #ifndef PERL_MICRO
3840 #   ifndef PERL_OLD_SIGNALS
3841 #               ifndef PERL_ASYNC_CHECK
3842 #                       define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals()
3843 #               endif
3844 #   endif
3845 #endif
3846
3847 #ifndef PERL_ASYNC_CHECK
3848 #   define PERL_ASYNC_CHECK()  NOOP
3849 #endif
3850
3851 /*
3852  * On some operating systems, a memory allocation may succeed,
3853  * but put the process too close to the system's comfort limit.
3854  * In this case, PERL_ALLOC_CHECK frees the pointer and sets
3855  * it to NULL.
3856  */
3857 #ifndef PERL_ALLOC_CHECK
3858 #define PERL_ALLOC_CHECK(p)  NOOP
3859 #endif
3860
3861 /*
3862  * nice_chunk and nice_chunk size need to be set
3863  * and queried under the protection of sv_mutex
3864  */
3865 #define offer_nice_chunk(chunk, chunk_size) STMT_START {  \
3866        void *new_chunk;                                   \
3867        U32 new_chunk_size;                                \
3868        LOCK_SV_MUTEX;                                     \
3869        new_chunk = (void *)(chunk);                       \
3870        new_chunk_size = (chunk_size);                     \
3871        if (new_chunk_size > PL_nice_chunk_size) {         \
3872            if (PL_nice_chunk) Safefree(PL_nice_chunk);    \
3873            PL_nice_chunk = new_chunk;                     \
3874            PL_nice_chunk_size = new_chunk_size;           \
3875        } else {                                           \
3876            Safefree(chunk);                               \
3877        }                                                  \
3878        UNLOCK_SV_MUTEX;                                   \
3879    } STMT_END
3880
3881 #ifdef HAS_SEM
3882 #   include <sys/ipc.h>
3883 #   include <sys/sem.h>
3884 #   ifndef HAS_UNION_SEMUN      /* Provide the union semun. */
3885     union semun {
3886         int             val;
3887         struct semid_ds *buf;
3888         unsigned short  *array;
3889     };
3890 #   endif
3891 #   ifdef USE_SEMCTL_SEMUN
3892 #       ifdef IRIX32_SEMUN_BROKEN_BY_GCC
3893             union gccbug_semun {
3894                 int             val;
3895                 struct semid_ds *buf;
3896                 unsigned short  *array;
3897                 char            __dummy[5];
3898             };
3899 #           define semun gccbug_semun
3900 #       endif
3901 #       define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
3902 #   else
3903 #       ifdef USE_SEMCTL_SEMID_DS
3904 #           ifdef EXTRA_F_IN_SEMUN_BUF
3905 #               define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buff)
3906 #           else
3907 #               define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
3908 #           endif
3909 #       endif
3910 #   endif
3911 #endif
3912
3913 #ifdef I_FCNTL
3914 #  include <fcntl.h>
3915 #endif
3916
3917 #ifdef I_SYS_FILE
3918 #  include <sys/file.h>
3919 #endif
3920
3921 #if defined(HAS_FLOCK) && !defined(HAS_FLOCK_PROTO)
3922 int flock(int fd, int op);
3923 #endif
3924
3925 #ifndef O_RDONLY
3926 /* Assume UNIX defaults */
3927 #    define O_RDONLY    0000
3928 #    define O_WRONLY    0001
3929 #    define O_RDWR      0002
3930 #    define O_CREAT     0100
3931 #endif
3932
3933 #ifndef O_BINARY
3934 #  define O_BINARY 0
3935 #endif
3936
3937 #ifndef O_TEXT
3938 #  define O_TEXT 0
3939 #endif
3940
3941 #ifdef IAMSUID
3942
3943 #ifdef I_SYS_STATVFS
3944 #   if defined(PERL_SCO) && !defined(_SVID3)
3945 #       define _SVID3
3946 #   endif
3947 #   include <sys/statvfs.h>     /* for f?statvfs() */
3948 #endif
3949 #ifdef I_SYS_MOUNT
3950 #   include <sys/mount.h>       /* for *BSD f?statfs() */
3951 #endif
3952 #ifdef I_MNTENT
3953 #   include <mntent.h>          /* for getmntent() */
3954 #endif
3955 #ifdef I_SYS_STATFS
3956 #   include <sys/statfs.h>      /* for some statfs() */
3957 #endif
3958 #ifdef I_SYS_VFS
3959 #  ifdef __sgi
3960 #    define sv IRIX_sv          /* kludge: IRIX has an sv of its own */
3961 #  endif
3962 #    include <sys/vfs.h>        /* for some statfs() */
3963 #  ifdef __sgi
3964 #    undef IRIX_sv
3965 #  endif
3966 #endif
3967 #ifdef I_USTAT
3968 #   include <ustat.h>           /* for ustat() */
3969 #endif
3970
3971 #if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID)
3972 #    define PERL_MOUNT_NOSUID MOUNT_NOSUID
3973 #endif
3974 #if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
3975 #    define PERL_MOUNT_NOSUID MNT_NOSUID
3976 #endif
3977 #if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
3978 #   define PERL_MOUNT_NOSUID MS_NOSUID
3979 #endif
3980 #if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
3981 #   define PERL_MOUNT_NOSUID M_NOSUID
3982 #endif
3983
3984 #endif /* IAMSUID */
3985
3986 #ifdef I_LIBUTIL
3987 #   include <libutil.h>         /* setproctitle() in some FreeBSDs */
3988 #endif
3989
3990 #ifndef EXEC_ARGV_CAST
3991 #define EXEC_ARGV_CAST(x) x
3992 #endif
3993
3994 #define IS_NUMBER_IN_UV               0x01 /* number within UV range (maybe not
3995                                               int).  value returned in pointed-
3996                                               to UV */
3997 #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */
3998 #define IS_NUMBER_NOT_INT             0x04 /* saw . or E notation */
3999 #define IS_NUMBER_NEG                 0x08 /* leading minus sign */
4000 #define IS_NUMBER_INFINITY            0x10 /* this is big */
4001 #define IS_NUMBER_NAN                 0x20 /* this is not */
4002
4003 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
4004
4005 /* to let user control profiling */
4006 #ifdef PERL_GPROF_CONTROL
4007 extern void moncontrol(int);
4008 #define PERL_GPROF_MONCONTROL(x) moncontrol(x)
4009 #else
4010 #define PERL_GPROF_MONCONTROL(x)
4011 #endif
4012
4013 /* and finally... */
4014 #define PERL_PATCHLEVEL_H_IMPLICIT
4015 #include "patchlevel.h"
4016 #undef PERL_PATCHLEVEL_H_IMPLICIT
4017
4018 /* Mention
4019
4020    NV_PRESERVES_UV
4021
4022    HAS_ICONV
4023    I_ICONV
4024
4025    HAS_MKSTEMP
4026    HAS_MKSTEMPS
4027    HAS_MKDTEMP
4028
4029    HAS_GETCWD
4030
4031    HAS_MMAP
4032    HAS_MPROTECT
4033    HAS_MSYNC
4034    HAS_MADVISE
4035    HAS_MUNMAP
4036    I_SYSMMAN
4037    Mmap_t
4038
4039    NVef
4040    NVff
4041    NVgf
4042
4043    HAS_USLEEP
4044    HAS_UALARM
4045
4046    HAS_SETITIMER
4047    HAS_GETITIMER
4048
4049    HAS_SENDMSG
4050    HAS_RECVMSG
4051    HAS_READV
4052    HAS_WRITEV
4053    I_SYSUIO
4054    HAS_STRUCT_MSGHDR
4055    HAS_STRUCT_CMSGHDR
4056
4057    HAS_NL_LANGINFO
4058
4059    so that Configure picks them up. */
4060
4061 #ifdef UNDER_CE
4062 #include "wince.h"
4063 #endif
4064
4065 #endif /* Include guard */