perl.h

   1 /*    perl.h
   2  *
   3  *    Copyright (c) 1987-1994, 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 #define OVERLOAD
  12
  13 #ifdef PERL_FOR_X2P
  14 /*
  15  * This file is being used for x2p stuff.
  16  * Above symbol is defined via -D in 'x2p/Makefile.SH'
  17  * Decouple x2p stuff from some of perls more extreme eccentricities.
  18  */
  19 #undef EMBED
  20 #undef NO_EMBED
  21 #define NO_EMBED
  22 #undef MULTIPLICITY
  23 #undef HIDEMYMALLOC
  24 #undef EMBEDMYMALLOC
  25 #undef USE_STDIO
  26 #define USE_STDIO
  27 #endif /* PERL_FOR_X2P */
  28
  29 /*
  30  * STMT_START { statements; } STMT_END;
  31  * can be used as a single statement, as in
  32  * if (x) STMT_START { ... } STMT_END; else ...
  33  *
  34  * Trying to select a version that gives no warnings...
  35  */
  36 #if !(defined(STMT_START) && defined(STMT_END))
  37 # if defined(__GNUC__) && !defined(__STRICT_ANSI__)
  38 #   define STMT_START   (void)( /* gcc supports ``({ STATEMENTS; })'' */
  39 #   define STMT_END     )
  40 # else
  41    /* Now which other defined()s do we need here ??? */
  42 #  if (VOIDFLAGS) && (defined(sun) || defined(__sun__))
  43 #   define STMT_START   if (1)
  44 #   define STMT_END     else (void)0
  45 #  else
  46 #   define STMT_START   do
  47 #   define STMT_END     while (0)
  48 #  endif
  49 # endif
  50 #endif
  51
  52 #include "embed.h"
  53
  54 #define VOIDUSED 1
  55 #include "config.h"
  56
  57 /*
  58  * SOFT_CAST can be used for args to prototyped functions to retain some
  59  * type checking; it only casts if the compiler does not know prototypes.
  60  */
  61 #if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE)
  62 #define SOFT_CAST(type)
  63 #else
  64 #define SOFT_CAST(type) (type)
  65 #endif
  66
  67 #ifndef BYTEORDER
  68 #   define BYTEORDER 0x1234
  69 #endif
  70
  71 /* Overall memory policy? */
  72 #ifndef CONSERVATIVE
  73 #   define LIBERAL 1
  74 #endif
  75
  76 /*
  77  * The following contortions are brought to you on behalf of all the
  78  * standards, semi-standards, de facto standards, not-so-de-facto standards
  79  * of the world, as well as all the other botches anyone ever thought of.
  80  * The basic theory is that if we work hard enough here, the rest of the
  81  * code can be a lot prettier.  Well, so much for theory.  Sorry, Henry...
  82  */
  83
  84 /* define this once if either system, instead of cluttering up the src */
  85 #if defined(MSDOS) || defined(atarist)
  86 #define DOSISH 1
  87 #endif
  88
  89 #if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
  90 # define STANDARD_C 1
  91 #endif
  92
  93 #if defined(HASVOLATILE) || defined(STANDARD_C)
  94 #   ifdef __cplusplus
  95 #       define VOL              // to temporarily suppress warnings
  96 #   else
  97 #       define VOL volatile
  98 #   endif
  99 #else
 100 #   define VOL
 101 #endif
 102
 103 #define TAINT           (tainted = TRUE)
 104 #define TAINT_NOT       (tainted = FALSE)
 105 #define TAINT_IF(c)     if (c) { tainted = TRUE; }
 106 #define TAINT_ENV()     if (tainting) { taint_env(); }
 107 #define TAINT_PROPER(s) if (tainting) { taint_proper(no_security, s); }
 108
 109 /* XXX All process group stuff is handled in pp_sys.c.  Should these
 110    defines move there?  If so, I could simplify this a lot. --AD  9/96.
 111 */
 112 /* Process group stuff changed from traditional BSD to POSIX.
 113    perlfunc.pod documents the traditional BSD-style syntax, so we'll
 114    try to preserve that, if possible.
 115 */
 116 #ifdef HAS_SETPGID
 117 #  define BSD_SETPGRP(pid, pgrp)        setpgid((pid), (pgrp))
 118 #else
 119 #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
 120 #    define BSD_SETPGRP(pid, pgrp)      setpgrp((pid), (pgrp))
 121 #  else
 122 #    ifdef HAS_SETPGRP2  /* DG/UX */
 123 #      define BSD_SETPGRP(pid, pgrp)    setpgrp2((pid), (pgrp))
 124 #    endif
 125 #  endif
 126 #endif
 127 #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
 128 #  define HAS_SETPGRP  /* Well, effectively it does . . . */
 129 #endif
 130
 131 /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
 132     our life easier :-) so we'll try it.
 133 */
 134 #ifdef HAS_GETPGID
 135 #  define BSD_GETPGRP(pid)              getpgid((pid))
 136 #else
 137 #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
 138 #    define BSD_GETPGRP(pid)            getpgrp((pid))
 139 #  else
 140 #    ifdef HAS_GETPGRP2  /* DG/UX */
 141 #      define BSD_GETPGRP(pid)          getpgrp2((pid))
 142 #    endif
 143 #  endif
 144 #endif
 145 #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
 146 #  define HAS_GETPGRP  /* Well, effectively it does . . . */
 147 #endif
 148
 149 /* These are not exact synonyms, since setpgrp() and getpgrp() may
 150    have different behaviors, but perl.h used to define USE_BSDPGRP
 151    (prior to 5.003_05) so some extension might depend on it.
 152 */
 153 #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
 154 #  ifndef USE_BSDPGRP
 155 #    define USE_BSDPGRP
 156 #  endif
 157 #endif
 158
 159 #ifndef _TYPES_         /* If types.h defines this it's easy. */
 160 #   ifndef major                /* Does everyone's types.h define this? */
 161 #       include <sys/types.h>
 162 #   endif
 163 #endif
 164
 165 #ifdef __cplusplus
 166 #  ifndef I_STDARG
 167 #    define I_STDARG 1
 168 #  endif
 169 #endif
 170
 171 #ifdef I_STDARG
 172 #  include <stdarg.h>
 173 #else
 174 #  ifdef I_VARARGS
 175 #    include <varargs.h>
 176 #  endif
 177 #endif
 178
 179 #include "perlio.h"
 180
 181 #ifdef USE_NEXT_CTYPE
 182
 183 #if NX_CURRENT_COMPILER_RELEASE >= 400
 184 #include <objc/NXCType.h>
 185 #else /*  NX_CURRENT_COMPILER_RELEASE < 400 */
 186 #include <appkit/NXCType.h>
 187 #endif /*  NX_CURRENT_COMPILER_RELEASE >= 400 */
 188
 189 #else /* !USE_NEXT_CTYPE */
 190 #include <ctype.h>
 191 #endif /* USE_NEXT_CTYPE */
 192
 193 #ifdef I_LOCALE
 194 #include <locale.h>
 195 #endif
 196
 197 #ifdef METHOD   /* Defined by OSF/1 v3.0 by ctype.h */
 198 #undef METHOD
 199 #endif
 200
 201 #include <setjmp.h>
 202
 203 #ifdef I_SYS_PARAM
 204 #   ifdef PARAM_NEEDS_TYPES
 205 #       include <sys/types.h>
 206 #   endif
 207 #   include <sys/param.h>
 208 #endif
 209
 210
 211 /* Use all the "standard" definitions? */
 212 #if defined(STANDARD_C) && defined(I_STDLIB)
 213 #   include <stdlib.h>
 214 #endif /* STANDARD_C */
 215
 216 /* This comes after <stdlib.h> so we don't try to change the standard
 217  * library prototypes; we'll use our own in proto.h instead. */
 218
 219 #ifdef MYMALLOC
 220
 221 #   ifdef HIDEMYMALLOC
 222 #       define malloc  Mymalloc
 223 #       define calloc  Mycalloc
 224 #       define realloc Myremalloc
 225 #       define free    Myfree
 226 #   endif
 227 #   ifdef EMBEDMYMALLOC
 228 #       define malloc  Perl_malloc
 229 #       define calloc  Perl_calloc
 230 #       define realloc Perl_realloc
 231 #       define free    Perl_free
 232 #   endif
 233
 234 #   undef safemalloc
 235 #   undef safecalloc
 236 #   undef saferealloc
 237 #   undef safefree
 238 #   define safemalloc  malloc
 239 #   define safecalloc  calloc
 240 #   define saferealloc realloc
 241 #   define safefree    free
 242
 243 #endif /* MYMALLOC */
 244
 245 #define MEM_SIZE Size_t
 246
 247 #if defined(I_STRING) || defined(__cplusplus)
 248 #   include <string.h>
 249 #else
 250 #   include <strings.h>
 251 #endif
 252
 253 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
 254 #define strchr index
 255 #define strrchr rindex
 256 #endif
 257
 258 #if defined(mips) && defined(ultrix) && !defined(__STDC__)
 259 #   undef HAS_MEMCMP
 260 #endif
 261
 262 #ifdef I_MEMORY
 263 #  include <memory.h>
 264 #endif
 265
 266 #ifdef HAS_MEMCPY
 267 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 268 #    ifndef memcpy
 269         extern char * memcpy _((char*, char*, int));
 270 #    endif
 271 #  endif
 272 #else
 273 #   ifndef memcpy
 274 #       ifdef HAS_BCOPY
 275 #           define memcpy(d,s,l) bcopy(s,d,l)
 276 #       else
 277 #           define memcpy(d,s,l) my_bcopy(s,d,l)
 278 #       endif
 279 #   endif
 280 #endif /* HAS_MEMCPY */
 281
 282 #ifdef HAS_MEMSET
 283 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 284 #    ifndef memset
 285         extern char *memset _((char*, int, int));
 286 #    endif
 287 #  endif
 288 #  define memzero(d,l) memset(d,0,l)
 289 #else
 290 #   ifndef memzero
 291 #       ifdef HAS_BZERO
 292 #           define memzero(d,l) bzero(d,l)
 293 #       else
 294 #           define memzero(d,l) my_bzero(d,l)
 295 #       endif
 296 #   endif
 297 #endif /* HAS_MEMSET */
 298
 299 #ifdef HAS_MEMCMP
 300 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 301 #    ifndef memcmp
 302         extern int memcmp _((char*, char*, int));
 303 #    endif
 304 #  endif
 305 #else
 306 #   ifndef memcmp
 307 #       define memcmp   my_memcmp
 308 #   endif
 309 #endif /* HAS_MEMCMP */
 310
 311 #if !defined(HAS_MEMMOVE) && !defined(memmove)
 312 #   if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
 313 #       define memmove(d,s,l) bcopy(s,d,l)
 314 #   else
 315 #       if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
 316 #           define memmove(d,s,l) memcpy(d,s,l)
 317 #       else
 318 #           define memmove(d,s,l) my_bcopy(s,d,l)
 319 #       endif
 320 #   endif
 321 #endif
 322
 323 #ifdef I_NETINET_IN
 324 #   include <netinet/in.h>
 325 #endif
 326
 327 #ifdef I_SYS_STAT
 328 #include <sys/stat.h>
 329 #endif
 330
 331 /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
 332    like UTekV) are broken, sometimes giving false positives.  Undefine
 333    them here and let the code below set them to proper values.
 334
 335    The ghs macro stands for GreenHills Software C-1.8.5 which
 336    is the C compiler for sysV88 and the various derivatives.
 337    This header file bug is corrected in gcc-2.5.8 and later versions.
 338    --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94.  */
 339
 340 #if defined(uts) || (defined(m88k) && defined(ghs))
 341 #   undef S_ISDIR
 342 #   undef S_ISCHR
 343 #   undef S_ISBLK
 344 #   undef S_ISREG
 345 #   undef S_ISFIFO
 346 #   undef S_ISLNK
 347 #endif
 348
 349 #ifdef I_TIME
 350 #   include <time.h>
 351 #endif
 352
 353 #ifdef I_SYS_TIME
 354 #   ifdef I_SYS_TIME_KERNEL
 355 #       define KERNEL
 356 #   endif
 357 #   include <sys/time.h>
 358 #   ifdef I_SYS_TIME_KERNEL
 359 #       undef KERNEL
 360 #   endif
 361 #endif
 362
 363 #if defined(HAS_TIMES) && defined(I_SYS_TIMES)
 364 #    include <sys/times.h>
 365 #endif
 366
 367 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
 368 #   undef HAS_STRERROR
 369 #endif
 370
 371 #ifndef HAS_MKFIFO
 372 #  ifndef mkfifo
 373 #    define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
 374 #  endif
 375 #endif /* !HAS_MKFIFO */
 376
 377 #include <errno.h>
 378 #ifdef HAS_SOCKET
 379 #   ifdef I_NET_ERRNO
 380 #     include <net/errno.h>
 381 #   endif
 382 #endif
 383 #ifndef VMS
 384 #   define FIXSTATUS(sts)  (U_L((sts) & 0xffff))
 385 #   define SHIFTSTATUS(sts) ((sts) >> 8)
 386 #   define SETERRNO(errcode,vmserrcode) errno = (errcode)
 387 #else
 388 #   define FIXSTATUS(sts)  (U_L(sts))
 389 #   define SHIFTSTATUS(sts) (sts)
 390 #   define SETERRNO(errcode,vmserrcode) STMT_START {set_errno(errcode); set_vaxc_errno(vmserrcode);} STMT_END
 391 #endif
 392
 393 #ifndef errno
 394         extern int errno;     /* ANSI allows errno to be an lvalue expr */
 395 #endif
 396
 397 #ifdef HAS_STRERROR
 398 #       ifdef VMS
 399         char *strerror _((int,...));
 400 #       else
 401         char *strerror _((int));
 402 #       endif
 403 #       ifndef Strerror
 404 #           define Strerror strerror
 405 #       endif
 406 #else
 407 #    ifdef HAS_SYS_ERRLIST
 408         extern int sys_nerr;
 409         extern char *sys_errlist[];
 410 #       ifndef Strerror
 411 #           define Strerror(e) \
 412                 ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
 413 #       endif
 414 #   endif
 415 #endif
 416
 417 #ifdef I_SYS_IOCTL
 418 #   ifndef _IOCTL_
 419 #       include <sys/ioctl.h>
 420 #   endif
 421 #endif
 422
 423 #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
 424 #   ifdef HAS_SOCKETPAIR
 425 #       undef HAS_SOCKETPAIR
 426 #   endif
 427 #   ifdef I_NDBM
 428 #       undef I_NDBM
 429 #   endif
 430 #endif
 431
 432 #if INTSIZE == 2
 433 #   define htoni htons
 434 #   define ntohi ntohs
 435 #else
 436 #   define htoni htonl
 437 #   define ntohi ntohl
 438 #endif
 439
 440 /* Configure already sets Direntry_t */
 441 #if defined(I_DIRENT)
 442 #   include <dirent.h>
 443 #   if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
 444 #       include <sys/dir.h>
 445 #   endif
 446 #else
 447 #   ifdef I_SYS_NDIR
 448 #       include <sys/ndir.h>
 449 #   else
 450 #       ifdef I_SYS_DIR
 451 #           ifdef hp9000s500
 452 #               include <ndir.h>        /* may be wrong in the future */
 453 #           else
 454 #               include <sys/dir.h>
 455 #           endif
 456 #       endif
 457 #   endif
 458 #endif
 459
 460 #ifdef FPUTS_BOTCH
 461 /* work around botch in SunOS 4.0.1 and 4.0.2 */
 462 #   ifndef fputs
 463 #       define fputs(sv,fp) fprintf(fp,"%s",sv)
 464 #   endif
 465 #endif
 466
 467 /*
 468  * The following gobbledygook brought to you on behalf of __STDC__.
 469  * (I could just use #ifndef __STDC__, but this is more bulletproof
 470  * in the face of half-implementations.)
 471  */
 472
 473 #ifndef S_IFMT
 474 #   ifdef _S_IFMT
 475 #       define S_IFMT _S_IFMT
 476 #   else
 477 #       define S_IFMT 0170000
 478 #   endif
 479 #endif
 480
 481 #ifndef S_ISDIR
 482 #   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
 483 #endif
 484
 485 #ifndef S_ISCHR
 486 #   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
 487 #endif
 488
 489 #ifndef S_ISBLK
 490 #   ifdef S_IFBLK
 491 #       define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
 492 #   else
 493 #       define S_ISBLK(m) (0)
 494 #   endif
 495 #endif
 496
 497 #ifndef S_ISREG
 498 #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
 499 #endif
 500
 501 #ifndef S_ISFIFO
 502 #   ifdef S_IFIFO
 503 #       define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
 504 #   else
 505 #       define S_ISFIFO(m) (0)
 506 #   endif
 507 #endif
 508
 509 #ifndef S_ISLNK
 510 #   ifdef _S_ISLNK
 511 #       define S_ISLNK(m) _S_ISLNK(m)
 512 #   else
 513 #       ifdef _S_IFLNK
 514 #           define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
 515 #       else
 516 #           ifdef S_IFLNK
 517 #               define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
 518 #           else
 519 #               define S_ISLNK(m) (0)
 520 #           endif
 521 #       endif
 522 #   endif
 523 #endif
 524
 525 #ifndef S_ISSOCK
 526 #   ifdef _S_ISSOCK
 527 #       define S_ISSOCK(m) _S_ISSOCK(m)
 528 #   else
 529 #       ifdef _S_IFSOCK
 530 #           define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
 531 #       else
 532 #           ifdef S_IFSOCK
 533 #               define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
 534 #           else
 535 #               define S_ISSOCK(m) (0)
 536 #           endif
 537 #       endif
 538 #   endif
 539 #endif
 540
 541 #ifndef S_IRUSR
 542 #   ifdef S_IREAD
 543 #       define S_IRUSR S_IREAD
 544 #       define S_IWUSR S_IWRITE
 545 #       define S_IXUSR S_IEXEC
 546 #   else
 547 #       define S_IRUSR 0400
 548 #       define S_IWUSR 0200
 549 #       define S_IXUSR 0100
 550 #   endif
 551 #   define S_IRGRP (S_IRUSR>>3)
 552 #   define S_IWGRP (S_IWUSR>>3)
 553 #   define S_IXGRP (S_IXUSR>>3)
 554 #   define S_IROTH (S_IRUSR>>6)
 555 #   define S_IWOTH (S_IWUSR>>6)
 556 #   define S_IXOTH (S_IXUSR>>6)
 557 #endif
 558
 559 #ifndef S_ISUID
 560 #   define S_ISUID 04000
 561 #endif
 562
 563 #ifndef S_ISGID
 564 #   define S_ISGID 02000
 565 #endif
 566
 567 #ifdef ff_next
 568 #   undef ff_next
 569 #endif
 570
 571 #if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
 572 #   define SLOPPYDIVIDE
 573 #endif
 574
 575 #if defined(cray) || defined(convex) || BYTEORDER > 0xffff
 576 #   define HAS_QUAD
 577 #endif
 578
 579 #ifdef UV
 580 #undef UV
 581 #endif
 582
 583 /*  XXX QUAD stuff is not currently supported on most systems.
 584     Specifically, perl internals don't support long long.  Among
 585     the many problems is that some compilers support long long,
 586     but the underlying library functions (such as sprintf) don't.
 587     Some things do work (such as quad pack/unpack on convex);
 588     also some systems use long long for the fpos_t typedef.  That
 589     seems to work too.
 590
 591     The IV type is supposed to be long enough to hold any integral
 592     value or a pointer.
 593     --Andy Dougherty    August 1996
 594 */
 595
 596 #ifdef HAS_QUAD
 597 #   ifdef cray
 598 #       define Quad_t int
 599 #   else
 600 #       if defined(convex)
 601 #           define Quad_t long long
 602 #       else
 603 #           define Quad_t long
 604 #       endif
 605 #   endif
 606     typedef Quad_t IV;
 607     typedef unsigned Quad_t UV;
 608 #   define IV_MAX PERL_QUAD_MAX
 609 #   define IV_MIN PERL_QUAD_MIN
 610 #   define UV_MAX PERL_UQUAD_MAX
 611 #   define UV_MIN PERL_UQUAD_MIN
 612 #else
 613     typedef long IV;
 614     typedef unsigned long UV;
 615 #   define IV_MAX PERL_LONG_MAX
 616 #   define IV_MIN PERL_LONG_MIN
 617 #   define UV_MAX PERL_ULONG_MAX
 618 #   define UV_MIN PERL_ULONG_MIN
 619 #endif
 620
 621 /* Previously these definitions used hardcoded figures.
 622  * It is hoped these formula are more portable, although
 623  * no data one way or another is presently known to me.
 624  * The "PERL_" names are used because these calculated constants
 625  * do not meet the ANSI requirements for LONG_MAX, etc., which
 626  * need to be constants acceptable to #if - kja
 627  *    define PERL_LONG_MAX        2147483647L
 628  *    define PERL_LONG_MIN        (-LONG_MAX - 1)
 629  *    define PERL ULONG_MAX       4294967295L
 630  */
 631
 632 #ifdef I_LIMITS  /* Needed for cast_xxx() functions below. */
 633 #  include <limits.h>
 634 #else
 635 #ifdef I_VALUES
 636 #  include <values.h>
 637 #endif
 638 #endif
 639
 640 /*
 641  * Try to figure out max and min values for the integral types.  THE CORRECT
 642  * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE.  The
 643  * following hacks are used if neither limits.h or values.h provide them:
 644  * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0
 645  *              for types <  int:  (unsigned TYPE)~(unsigned)0
 646  *      The argument to ~ must be unsigned so that later signed->unsigned
 647  *      conversion can't modify the value's bit pattern (e.g. -0 -> +0),
 648  *      and it must not be smaller than int because ~ does integral promotion.
 649  * <type>_MAX: (<type>) (U<type>_MAX >> 1)
 650  * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>.
 651  *      The latter is a hack which happens to work on some machines but
 652  *      does *not* catch any random system, or things like integer types
 653  *      with NaN if that is possible.
 654  *
 655  * All of the types are explicitly cast to prevent accidental loss of
 656  * numeric range, and in the hope that they will be less likely to confuse
 657  * over-eager optimizers.
 658  *
 659  */
 660
 661 #define PERL_UCHAR_MIN ((unsigned char)0)
 662
 663 #ifdef UCHAR_MAX
 664 #  define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
 665 #else
 666 #  ifdef MAXUCHAR
 667 #    define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
 668 #  else
 669 #    define PERL_UCHAR_MAX       ((unsigned char)~(unsigned)0)
 670 #  endif
 671 #endif
 672
 673 /*
 674  * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be
 675  * ambiguous. It may be equivalent to (signed char) or (unsigned char)
 676  * depending on local options. Until Configure detects this (or at least
 677  * detects whether the "signed" keyword is available) the CHAR ranges
 678  * will not be included. UCHAR functions normally.
 679  *                                                           - kja
 680  */
 681
 682 #define PERL_USHORT_MIN ((unsigned short)0)
 683
 684 #ifdef USHORT_MAX
 685 #  define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
 686 #else
 687 #  ifdef MAXUSHORT
 688 #    define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
 689 #  else
 690 #    define PERL_USHORT_MAX       ((unsigned short)~(unsigned)0)
 691 #  endif
 692 #endif
 693
 694 #ifdef SHORT_MAX
 695 #  define PERL_SHORT_MAX ((short)SHORT_MAX)
 696 #else
 697 #  ifdef MAXSHORT    /* Often used in <values.h> */
 698 #    define PERL_SHORT_MAX ((short)MAXSHORT)
 699 #  else
 700 #    define PERL_SHORT_MAX      ((short) (PERL_USHORT_MAX >> 1))
 701 #  endif
 702 #endif
 703
 704 #ifdef SHORT_MIN
 705 #  define PERL_SHORT_MIN ((short)SHORT_MIN)
 706 #else
 707 #  ifdef MINSHORT
 708 #    define PERL_SHORT_MIN ((short)MINSHORT)
 709 #  else
 710 #    define PERL_SHORT_MIN        (-PERL_SHORT_MAX - ((3 & -1) == 3))
 711 #  endif
 712 #endif
 713
 714 #ifdef UINT_MAX
 715 #  define PERL_UINT_MAX ((unsigned int)UINT_MAX)
 716 #else
 717 #  ifdef MAXUINT
 718 #    define PERL_UINT_MAX ((unsigned int)MAXUINT)
 719 #  else
 720 #    define PERL_UINT_MAX       (~(unsigned int)0)
 721 #  endif
 722 #endif
 723
 724 #define PERL_UINT_MIN ((unsigned int)0)
 725
 726 #ifdef INT_MAX
 727 #  define PERL_INT_MAX ((int)INT_MAX)
 728 #else
 729 #  ifdef MAXINT    /* Often used in <values.h> */
 730 #    define PERL_INT_MAX ((int)MAXINT)
 731 #  else
 732 #    define PERL_INT_MAX        ((int)(PERL_UINT_MAX >> 1))
 733 #  endif
 734 #endif
 735
 736 #ifdef INT_MIN
 737 #  define PERL_INT_MIN ((int)INT_MIN)
 738 #else
 739 #  ifdef MININT
 740 #    define PERL_INT_MIN ((int)MININT)
 741 #  else
 742 #    define PERL_INT_MIN        (-PERL_INT_MAX - ((3 & -1) == 3))
 743 #  endif
 744 #endif
 745
 746 #ifdef ULONG_MAX
 747 #  define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
 748 #else
 749 #  ifdef MAXULONG
 750 #    define PERL_ULONG_MAX ((unsigned long)MAXULONG)
 751 #  else
 752 #    define PERL_ULONG_MAX       (~(unsigned long)0)
 753 #  endif
 754 #endif
 755
 756 #define PERL_ULONG_MIN ((unsigned long)0L)
 757
 758 #ifdef LONG_MAX
 759 #  define PERL_LONG_MAX ((long)LONG_MAX)
 760 #else
 761 #  ifdef MAXLONG    /* Often used in <values.h> */
 762 #    define PERL_LONG_MAX ((long)MAXLONG)
 763 #  else
 764 #    define PERL_LONG_MAX        ((long) (PERL_ULONG_MAX >> 1))
 765 #  endif
 766 #endif
 767
 768 #ifdef LONG_MIN
 769 #  define PERL_LONG_MIN ((long)LONG_MIN)
 770 #else
 771 #  ifdef MINLONG
 772 #    define PERL_LONG_MIN ((long)MINLONG)
 773 #  else
 774 #    define PERL_LONG_MIN        (-PERL_LONG_MAX - ((3 & -1) == 3))
 775 #  endif
 776 #endif
 777
 778 #ifdef HAS_QUAD
 779
 780 #  ifdef UQUAD_MAX
 781 #    define PERL_UQUAD_MAX ((UV)UQUAD_MAX)
 782 #  else
 783 #    define PERL_UQUAD_MAX      (~(UV)0)
 784 #  endif
 785
 786 #  define PERL_UQUAD_MIN ((UV)0)
 787
 788 #  ifdef QUAD_MAX
 789 #    define PERL_QUAD_MAX ((IV)QUAD_MAX)
 790 #  else
 791 #    define PERL_QUAD_MAX       ((IV) (PERL_UQUAD_MAX >> 1))
 792 #  endif
 793
 794 #  ifdef QUAD_MIN
 795 #    define PERL_QUAD_MIN ((IV)QUAD_MIN)
 796 #  else
 797 #    define PERL_QUAD_MIN       (-PERL_QUAD_MAX - ((3 & -1) == 3))
 798 #  endif
 799
 800 #endif
 801
 802 typedef MEM_SIZE STRLEN;
 803
 804 typedef struct op OP;
 805 typedef struct cop COP;
 806 typedef struct unop UNOP;
 807 typedef struct binop BINOP;
 808 typedef struct listop LISTOP;
 809 typedef struct logop LOGOP;
 810 typedef struct condop CONDOP;
 811 typedef struct pmop PMOP;
 812 typedef struct svop SVOP;
 813 typedef struct gvop GVOP;
 814 typedef struct pvop PVOP;
 815 typedef struct loop LOOP;
 816
 817 typedef struct Outrec Outrec;
 818 typedef struct interpreter PerlInterpreter;
 819 typedef struct ff FF;
 820 typedef struct sv SV;
 821 typedef struct av AV;
 822 typedef struct hv HV;
 823 typedef struct cv CV;
 824 typedef struct regexp REGEXP;
 825 typedef struct gp GP;
 826 typedef struct gv GV;
 827 typedef struct io IO;
 828 typedef struct context CONTEXT;
 829 typedef struct block BLOCK;
 830
 831 typedef struct magic MAGIC;
 832 typedef struct xrv XRV;
 833 typedef struct xpv XPV;
 834 typedef struct xpviv XPVIV;
 835 typedef struct xpvnv XPVNV;
 836 typedef struct xpvmg XPVMG;
 837 typedef struct xpvlv XPVLV;
 838 typedef struct xpvav XPVAV;
 839 typedef struct xpvhv XPVHV;
 840 typedef struct xpvgv XPVGV;
 841 typedef struct xpvcv XPVCV;
 842 typedef struct xpvbm XPVBM;
 843 typedef struct xpvfm XPVFM;
 844 typedef struct xpvio XPVIO;
 845 typedef struct mgvtbl MGVTBL;
 846 typedef union any ANY;
 847
 848 #include "handy.h"
 849
 850 typedef I32 (*filter_t) _((int, SV *, int));
 851 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
 852 #define FILTER_DATA(idx)           (AvARRAY(rsfp_filters)[idx])
 853 #define FILTER_ISREADER(idx)       (idx >= AvFILL(rsfp_filters))
 854
 855 #ifdef DOSISH
 856 # if defined(OS2)
 857 #   include "os2ish.h"
 858 # else
 859 #   include "dosish.h"
 860 # endif
 861 #else
 862 # if defined(VMS)
 863 #   include "vmsish.h"
 864 # else
 865 #   if defined(PLAN9)
 866 #     include "./plan9/plan9ish.h"
 867 #   else
 868 #     include "unixish.h"
 869 #   endif
 870 # endif
 871 #endif
 872
 873 /* Some unistd.h's give a prototype for pause() even though
 874    HAS_PAUSE ends up undefined.  This causes the #define
 875    below to be rejected by the compmiler.  Sigh.
 876 */
 877 #ifdef HAS_PAUSE
 878 #define Pause   pause
 879 #else
 880 #define Pause() sleep((32767<<16)+32767)
 881 #endif
 882
 883 #ifndef IOCPARM_LEN
 884 #   ifdef IOCPARM_MASK
 885         /* on BSDish systes we're safe */
 886 #       define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
 887 #   else
 888         /* otherwise guess at what's safe */
 889 #       define IOCPARM_LEN(x)   256
 890 #   endif
 891 #endif
 892
 893 union any {
 894     void*       any_ptr;
 895     I32         any_i32;
 896     IV          any_iv;
 897     long        any_long;
 898     void        (*any_dptr) _((void*));
 899 };
 900
 901 #include "regexp.h"
 902 #include "sv.h"
 903 #include "util.h"
 904 #include "form.h"
 905 #include "gv.h"
 906 #include "cv.h"
 907 #include "opcode.h"
 908 #include "op.h"
 909 #include "cop.h"
 910 #include "av.h"
 911 #include "hv.h"
 912 #include "mg.h"
 913 #include "scope.h"
 914
 915 /* work around some libPW problems */
 916 #ifdef DOINIT
 917 EXT char Error[1];
 918 #endif
 919
 920 #if defined(iAPX286) || defined(M_I286) || defined(I80286)
 921 #   define I286
 922 #endif
 923
 924 #if defined(htonl) && !defined(HAS_HTONL)
 925 #define HAS_HTONL
 926 #endif
 927 #if defined(htons) && !defined(HAS_HTONS)
 928 #define HAS_HTONS
 929 #endif
 930 #if defined(ntohl) && !defined(HAS_NTOHL)
 931 #define HAS_NTOHL
 932 #endif
 933 #if defined(ntohs) && !defined(HAS_NTOHS)
 934 #define HAS_NTOHS
 935 #endif
 936 #ifndef HAS_HTONL
 937 #if (BYTEORDER & 0xffff) != 0x4321
 938 #define HAS_HTONS
 939 #define HAS_HTONL
 940 #define HAS_NTOHS
 941 #define HAS_NTOHL
 942 #define MYSWAP
 943 #define htons my_swap
 944 #define htonl my_htonl
 945 #define ntohs my_swap
 946 #define ntohl my_ntohl
 947 #endif
 948 #else
 949 #if (BYTEORDER & 0xffff) == 0x4321
 950 #undef HAS_HTONS
 951 #undef HAS_HTONL
 952 #undef HAS_NTOHS
 953 #undef HAS_NTOHL
 954 #endif
 955 #endif
 956
 957 /*
 958  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
 959  * -DWS
 960  */
 961 #if BYTEORDER != 0x1234
 962 # define HAS_VTOHL
 963 # define HAS_VTOHS
 964 # define HAS_HTOVL
 965 # define HAS_HTOVS
 966 # if BYTEORDER == 0x4321
 967 #  define vtohl(x)      ((((x)&0xFF)<<24)       \
 968                         +(((x)>>24)&0xFF)       \
 969                         +(((x)&0x0000FF00)<<8)  \
 970                         +(((x)&0x00FF0000)>>8)  )
 971 #  define vtohs(x)      ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
 972 #  define htovl(x)      vtohl(x)
 973 #  define htovs(x)      vtohs(x)
 974 # endif
 975         /* otherwise default to functions in util.c */
 976 #endif
 977
 978 #ifdef CASTNEGFLOAT
 979 #define U_S(what) ((U16)(what))
 980 #define U_I(what) ((unsigned int)(what))
 981 #define U_L(what) ((U32)(what))
 982 #else
 983 #  ifdef __cplusplus
 984     extern "C" {
 985 #  endif
 986 U32 cast_ulong _((double));
 987 #  ifdef __cplusplus
 988     }
 989 #  endif
 990 #define U_S(what) ((U16)cast_ulong((double)(what)))
 991 #define U_I(what) ((unsigned int)cast_ulong((double)(what)))
 992 #define U_L(what) (cast_ulong((double)(what)))
 993 #endif
 994
 995 #ifdef CASTI32
 996 #define I_32(what) ((I32)(what))
 997 #define I_V(what) ((IV)(what))
 998 #define U_V(what) ((UV)(what))
 999 #else
1000 #  ifdef __cplusplus
1001     extern "C" {
1002 #  endif
1003 I32 cast_i32 _((double));
1004 IV cast_iv _((double));
1005 UV cast_uv _((double));
1006 #  ifdef __cplusplus
1007     }
1008 #  endif
1009 #define I_32(what) (cast_i32((double)(what)))
1010 #define I_V(what) (cast_iv((double)(what)))
1011 #define U_V(what) (cast_uv((double)(what)))
1012 #endif
1013
1014 struct Outrec {
1015     I32         o_lines;
1016     char        *o_str;
1017     U32         o_len;
1018 };
1019
1020 #ifndef MAXSYSFD
1021 #   define MAXSYSFD 2
1022 #endif
1023
1024 #ifndef TMPPATH
1025 #  define TMPPATH "/tmp/perl-eXXXXXX"
1026 #endif
1027
1028 #ifndef __cplusplus
1029 Uid_t getuid _((void));
1030 Uid_t geteuid _((void));
1031 Gid_t getgid _((void));
1032 Gid_t getegid _((void));
1033 #endif
1034
1035 #ifdef DEBUGGING
1036 #ifndef Perl_debug_log
1037 #define Perl_debug_log  PerlIO_stderr()
1038 #endif
1039 #define YYDEBUG 1
1040 #define DEB(a)                          a
1041 #define DEBUG(a)   if (debug)           a
1042 #define DEBUG_p(a) if (debug & 1)       a
1043 #define DEBUG_s(a) if (debug & 2)       a
1044 #define DEBUG_l(a) if (debug & 4)       a
1045 #define DEBUG_t(a) if (debug & 8)       a
1046 #define DEBUG_o(a) if (debug & 16)      a
1047 #define DEBUG_c(a) if (debug & 32)      a
1048 #define DEBUG_P(a) if (debug & 64)      a
1049 #define DEBUG_m(a) if (curinterp && debug & 128)        a
1050 #define DEBUG_f(a) if (debug & 256)     a
1051 #define DEBUG_r(a) if (debug & 512)     a
1052 #define DEBUG_x(a) if (debug & 1024)    a
1053 #define DEBUG_u(a) if (debug & 2048)    a
1054 #define DEBUG_L(a) if (debug & 4096)    a
1055 #define DEBUG_H(a) if (debug & 8192)    a
1056 #define DEBUG_X(a) if (debug & 16384)   a
1057 #define DEBUG_D(a) if (debug & 32768)   a
1058 #else
1059 #define DEB(a)
1060 #define DEBUG(a)
1061 #define DEBUG_p(a)
1062 #define DEBUG_s(a)
1063 #define DEBUG_l(a)
1064 #define DEBUG_t(a)
1065 #define DEBUG_o(a)
1066 #define DEBUG_c(a)
1067 #define DEBUG_P(a)
1068 #define DEBUG_m(a)
1069 #define DEBUG_f(a)
1070 #define DEBUG_r(a)
1071 #define DEBUG_x(a)
1072 #define DEBUG_u(a)
1073 #define DEBUG_L(a)
1074 #define DEBUG_H(a)
1075 #define DEBUG_X(a)
1076 #define DEBUG_D(a)
1077 #endif
1078 #define YYMAXDEPTH 300
1079
1080 #ifndef assert  /* <assert.h> might have been included somehow */
1081 #define assert(what)    DEB( {                                          \
1082         if (!(what)) {                                                  \
1083             croak("Assertion failed: file \"%s\", line %d",             \
1084                 __FILE__, __LINE__);                                    \
1085             exit(1);                                                    \
1086         }})
1087 #endif
1088
1089 struct ufuncs {
1090     I32 (*uf_val)_((IV, SV*));
1091     I32 (*uf_set)_((IV, SV*));
1092     IV uf_index;
1093 };
1094
1095 /* Fix these up for __STDC__ */
1096 #ifndef __cplusplus
1097 char *mktemp _((char*));
1098 double atof _((const char*));
1099 #endif
1100
1101 #ifndef STANDARD_C
1102 /* All of these are in stdlib.h or time.h for ANSI C */
1103 Time_t time();
1104 struct tm *gmtime(), *localtime();
1105 char *strchr(), *strrchr();
1106 char *strcpy(), *strcat();
1107 #endif /* ! STANDARD_C */
1108
1109
1110 #ifdef I_MATH
1111 #    include <math.h>
1112 #else
1113 #   ifdef __cplusplus
1114         extern "C" {
1115 #   endif
1116             double exp _((double));
1117             double log _((double));
1118             double sqrt _((double));
1119             double modf _((double,double*));
1120             double sin _((double));
1121             double cos _((double));
1122             double atan2 _((double,double));
1123             double pow _((double,double));
1124 #   ifdef __cplusplus
1125         };
1126 #   endif
1127 #endif
1128
1129 #ifndef __cplusplus
1130 #ifdef __NeXT__ /* or whatever catches all NeXTs */
1131 char *crypt ();       /* Maybe more hosts will need the unprototyped version */
1132 #else
1133 char *crypt _((const char*, const char*));
1134 #endif
1135 char *getenv _((const char*));
1136 Off_t lseek _((int,Off_t,int));
1137 char *getlogin _((void));
1138 #endif
1139
1140 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
1141 #define UNLINK unlnk
1142 I32 unlnk _((char*));
1143 #else
1144 #define UNLINK unlink
1145 #endif
1146
1147 #ifndef HAS_SETREUID
1148 #  ifdef HAS_SETRESUID
1149 #    define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
1150 #    define HAS_SETREUID
1151 #  endif
1152 #endif
1153 #ifndef HAS_SETREGID
1154 #  ifdef HAS_SETRESGID
1155 #    define setregid(r,e) setresgid(r,e,(Gid_t)-1)
1156 #    define HAS_SETREGID
1157 #  endif
1158 #endif
1159
1160 #define SCAN_DEF 0
1161 #define SCAN_TR 1
1162 #define SCAN_REPL 2
1163
1164 #ifdef DEBUGGING
1165 # ifndef register
1166 #  define register
1167 # endif
1168 # ifdef MYMALLOC
1169 #  ifndef DEBUGGING_MSTATS
1170 #   define DEBUGGING_MSTATS
1171 #  endif
1172 # endif
1173 # define PAD_SV(po) pad_sv(po)
1174 #else
1175 # define PAD_SV(po) curpad[po]
1176 #endif
1177
1178 /****************/
1179 /* Truly global */
1180 /****************/
1181
1182 /* global state */
1183 EXT PerlInterpreter *   curinterp;      /* currently running interpreter */
1184 /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
1185 #if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
1186 extern char **  environ;        /* environment variables supplied via exec */
1187 #else
1188 #  if defined(NeXT) && defined(__DYNAMIC__)
1189
1190 #  include <mach-o/dyld.h>
1191 EXT char *** environ_pointer;
1192 #  define environ (*environ_pointer)
1193 #  endif
1194 #endif /* environ processing */
1195
1196 EXT int         uid;            /* current real user id */
1197 EXT int         euid;           /* current effective user id */
1198 EXT int         gid;            /* current real group id */
1199 EXT int         egid;           /* current effective group id */
1200 EXT bool        nomemok;        /* let malloc context handle nomem */
1201 EXT U32         an;             /* malloc sequence number */
1202 EXT U32         cop_seqmax;     /* statement sequence number */
1203 EXT U16         op_seqmax;      /* op sequence number */
1204 EXT U32         evalseq;        /* eval sequence number */
1205 EXT U32         sub_generation; /* inc to force methods to be looked up again */
1206 EXT char **     origenviron;
1207 EXT U32         origalen;
1208 EXT U32 *       profiledata;
1209 EXT int         maxo INIT(MAXO);/* Number of ops */
1210 EXT char *      osname;         /* operating system */
1211
1212 EXT XPV*        xiv_arenaroot;  /* list of allocated xiv areas */
1213 EXT IV **       xiv_root;       /* free xiv list--shared by interpreters */
1214 EXT double *    xnv_root;       /* free xnv list--shared by interpreters */
1215 EXT XRV *       xrv_root;       /* free xrv list--shared by interpreters */
1216 EXT XPV *       xpv_root;       /* free xpv list--shared by interpreters */
1217 EXT HE *        he_root;        /* free he list--shared by interpreters */
1218 EXT char *      nice_chunk;     /* a nice chunk of memory to reuse */
1219 EXT U32         nice_chunk_size;/* how nice the chunk of memory is */
1220
1221 /* Stack for currently executing thread--context switch must handle this.     */
1222 EXT SV **       stack_base;     /* stack->array_ary */
1223 EXT SV **       stack_sp;       /* stack pointer now */
1224 EXT SV **       stack_max;      /* stack->array_ary + stack->array_max */
1225
1226 /* likewise for these */
1227
1228 EXT OP *        op;             /* current op--oughta be in a global register */
1229
1230 EXT I32 *       scopestack;     /* blocks we've entered */
1231 EXT I32         scopestack_ix;
1232 EXT I32         scopestack_max;
1233
1234 EXT ANY*        savestack;      /* to save non-local values on */
1235 EXT I32         savestack_ix;
1236 EXT I32         savestack_max;
1237
1238 EXT OP **       retstack;       /* returns we've pushed */
1239 EXT I32         retstack_ix;
1240 EXT I32         retstack_max;
1241
1242 EXT I32 *       markstack;      /* stackmarks we're remembering */
1243 EXT I32 *       markstack_ptr;  /* stackmarks we're remembering */
1244 EXT I32 *       markstack_max;  /* stackmarks we're remembering */
1245
1246 EXT SV **       curpad;
1247
1248 /* temp space */
1249 EXT SV *        Sv;
1250 EXT HE          He;
1251 EXT XPV *       Xpv;
1252 EXT char        buf[2048];      /* should be longer than PATH_MAX */
1253 EXT char        tokenbuf[256];
1254 EXT struct stat statbuf;
1255 #ifdef HAS_TIMES
1256 EXT struct tms  timesbuf;
1257 #endif
1258 EXT STRLEN na;          /* for use in SvPV when length is Not Applicable */
1259
1260 /* for tmp use in stupid debuggers */
1261 EXT int *       di;
1262 EXT short *     ds;
1263 EXT char *      dc;
1264
1265 /* handy constants */
1266 EXT char *      Yes INIT("1");
1267 EXT char *      No INIT("");
1268 EXT char *      hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
1269 EXT char *      patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}");
1270 EXT char *      vert INIT("|");
1271
1272 EXT char        warn_uninit[]
1273   INIT("Use of uninitialized value");
1274 EXT char        warn_nosemi[]
1275   INIT("Semicolon seems to be missing");
1276 EXT char        warn_reserved[]
1277   INIT("Unquoted string \"%s\" may clash with future reserved word");
1278 EXT char        warn_nl[]
1279   INIT("Unsuccessful %s on filename containing newline");
1280 EXT char        no_wrongref[]
1281   INIT("Can't use %s ref as %s ref");
1282 EXT char        no_symref[]
1283   INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
1284 EXT char        no_usym[]
1285   INIT("Can't use an undefined value as %s reference");
1286 EXT char        no_aelem[]
1287   INIT("Modification of non-creatable array value attempted, subscript %d");
1288 EXT char        no_helem[]
1289   INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
1290 EXT char        no_modify[]
1291   INIT("Modification of a read-only value attempted");
1292 EXT char        no_mem[]
1293   INIT("Out of memory!\n");
1294 EXT char        no_security[]
1295   INIT("Insecure dependency in %s%s");
1296 EXT char        no_sock_func[]
1297   INIT("Unsupported socket function \"%s\" called");
1298 EXT char        no_dir_func[]
1299   INIT("Unsupported directory function \"%s\" called");
1300 EXT char        no_func[]
1301   INIT("The %s function is unimplemented");
1302 EXT char        no_myglob[]
1303   INIT("\"my\" variable %s can't be in a package");
1304
1305 EXT SV          sv_undef;
1306 EXT SV          sv_no;
1307 EXT SV          sv_yes;
1308 #ifdef CSH
1309     EXT char *  cshname INIT(CSH);
1310     EXT I32     cshlen;
1311 #endif
1312
1313 #ifdef DOINIT
1314 EXT char *sig_name[] = { SIG_NAME };
1315 EXT int   sig_num[]  = { SIG_NUM };
1316 EXT SV  * psig_ptr[sizeof(sig_num)/sizeof(*sig_num)];
1317 EXT SV  * psig_name[sizeof(sig_num)/sizeof(*sig_num)];
1318 #else
1319 EXT char *sig_name[];
1320 EXT int   sig_num[];
1321 EXT SV  * psig_ptr[];
1322 EXT SV  * psig_name[];
1323 #endif
1324
1325 /* fast case folding tables */
1326
1327 #ifdef DOINIT
1328 EXT const unsigned char fold[] = {
1329         0,      1,      2,      3,      4,      5,      6,      7,
1330         8,      9,      10,     11,     12,     13,     14,     15,
1331         16,     17,     18,     19,     20,     21,     22,     23,
1332         24,     25,     26,     27,     28,     29,     30,     31,
1333         32,     33,     34,     35,     36,     37,     38,     39,
1334         40,     41,     42,     43,     44,     45,     46,     47,
1335         48,     49,     50,     51,     52,     53,     54,     55,
1336         56,     57,     58,     59,     60,     61,     62,     63,
1337         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
1338         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
1339         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
1340         'x',    'y',    'z',    91,     92,     93,     94,     95,
1341         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
1342         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
1343         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
1344         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
1345         128,    129,    130,    131,    132,    133,    134,    135,
1346         136,    137,    138,    139,    140,    141,    142,    143,
1347         144,    145,    146,    147,    148,    149,    150,    151,
1348         152,    153,    154,    155,    156,    157,    158,    159,
1349         160,    161,    162,    163,    164,    165,    166,    167,
1350         168,    169,    170,    171,    172,    173,    174,    175,
1351         176,    177,    178,    179,    180,    181,    182,    183,
1352         184,    185,    186,    187,    188,    189,    190,    191,
1353         192,    193,    194,    195,    196,    197,    198,    199,
1354         200,    201,    202,    203,    204,    205,    206,    207,
1355         208,    209,    210,    211,    212,    213,    214,    215,
1356         216,    217,    218,    219,    220,    221,    222,    223,
1357         224,    225,    226,    227,    228,    229,    230,    231,
1358         232,    233,    234,    235,    236,    237,    238,    239,
1359         240,    241,    242,    243,    244,    245,    246,    247,
1360         248,    249,    250,    251,    252,    253,    254,    255
1361 };
1362 #else
1363 EXT unsigned char fold[];
1364 #endif
1365
1366 #ifdef DOINIT
1367 EXT unsigned char fold_locale[] = {
1368         0,      1,      2,      3,      4,      5,      6,      7,
1369         8,      9,      10,     11,     12,     13,     14,     15,
1370         16,     17,     18,     19,     20,     21,     22,     23,
1371         24,     25,     26,     27,     28,     29,     30,     31,
1372         32,     33,     34,     35,     36,     37,     38,     39,
1373         40,     41,     42,     43,     44,     45,     46,     47,
1374         48,     49,     50,     51,     52,     53,     54,     55,
1375         56,     57,     58,     59,     60,     61,     62,     63,
1376         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
1377         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
1378         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
1379         'x',    'y',    'z',    91,     92,     93,     94,     95,
1380         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
1381         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
1382         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
1383         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
1384         128,    129,    130,    131,    132,    133,    134,    135,
1385         136,    137,    138,    139,    140,    141,    142,    143,
1386         144,    145,    146,    147,    148,    149,    150,    151,
1387         152,    153,    154,    155,    156,    157,    158,    159,
1388         160,    161,    162,    163,    164,    165,    166,    167,
1389         168,    169,    170,    171,    172,    173,    174,    175,
1390         176,    177,    178,    179,    180,    181,    182,    183,
1391         184,    185,    186,    187,    188,    189,    190,    191,
1392         192,    193,    194,    195,    196,    197,    198,    199,
1393         200,    201,    202,    203,    204,    205,    206,    207,
1394         208,    209,    210,    211,    212,    213,    214,    215,
1395         216,    217,    218,    219,    220,    221,    222,    223,
1396         224,    225,    226,    227,    228,    229,    230,    231,
1397         232,    233,    234,    235,    236,    237,    238,    239,
1398         240,    241,    242,    243,    244,    245,    246,    247,
1399         248,    249,    250,    251,    252,    253,    254,    255
1400 };
1401 #else
1402 EXT unsigned char fold_locale[];
1403 #endif
1404
1405 #ifdef DOINIT
1406 EXT unsigned char freq[] = {    /* letter frequencies for mixed English/C */
1407         1,      2,      84,     151,    154,    155,    156,    157,
1408         165,    246,    250,    3,      158,    7,      18,     29,
1409         40,     51,     62,     73,     85,     96,     107,    118,
1410         129,    140,    147,    148,    149,    150,    152,    153,
1411         255,    182,    224,    205,    174,    176,    180,    217,
1412         233,    232,    236,    187,    235,    228,    234,    226,
1413         222,    219,    211,    195,    188,    193,    185,    184,
1414         191,    183,    201,    229,    181,    220,    194,    162,
1415         163,    208,    186,    202,    200,    218,    198,    179,
1416         178,    214,    166,    170,    207,    199,    209,    206,
1417         204,    160,    212,    216,    215,    192,    175,    173,
1418         243,    172,    161,    190,    203,    189,    164,    230,
1419         167,    248,    227,    244,    242,    255,    241,    231,
1420         240,    253,    169,    210,    245,    237,    249,    247,
1421         239,    168,    252,    251,    254,    238,    223,    221,
1422         213,    225,    177,    197,    171,    196,    159,    4,
1423         5,      6,      8,      9,      10,     11,     12,     13,
1424         14,     15,     16,     17,     19,     20,     21,     22,
1425         23,     24,     25,     26,     27,     28,     30,     31,
1426         32,     33,     34,     35,     36,     37,     38,     39,
1427         41,     42,     43,     44,     45,     46,     47,     48,
1428         49,     50,     52,     53,     54,     55,     56,     57,
1429         58,     59,     60,     61,     63,     64,     65,     66,
1430         67,     68,     69,     70,     71,     72,     74,     75,
1431         76,     77,     78,     79,     80,     81,     82,     83,
1432         86,     87,     88,     89,     90,     91,     92,     93,
1433         94,     95,     97,     98,     99,     100,    101,    102,
1434         103,    104,    105,    106,    108,    109,    110,    111,
1435         112,    113,    114,    115,    116,    117,    119,    120,
1436         121,    122,    123,    124,    125,    126,    127,    128,
1437         130,    131,    132,    133,    134,    135,    136,    137,
1438         138,    139,    141,    142,    143,    144,    145,    146
1439 };
1440 #else
1441 EXT unsigned char freq[];
1442 #endif
1443
1444 #ifdef DEBUGGING
1445 #ifdef DOINIT
1446 EXT char* block_type[] = {
1447         "NULL",
1448         "SUB",
1449         "EVAL",
1450         "LOOP",
1451         "SUBST",
1452         "BLOCK",
1453 };
1454 #else
1455 EXT char* block_type[];
1456 #endif
1457 #endif
1458
1459 /*****************************************************************************/
1460 /* This lexer/parser stuff is currently global since yacc is hard to reenter */
1461 /*****************************************************************************/
1462 /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
1463
1464 #include "perly.h"
1465
1466 typedef enum {
1467     XOPERATOR,
1468     XTERM,
1469     XREF,
1470     XSTATE,
1471     XBLOCK,
1472     XTERMBLOCK
1473 } expectation;
1474
1475 EXT U32         lex_state;      /* next token is determined */
1476 EXT U32         lex_defer;      /* state after determined token */
1477 EXT expectation lex_expect;     /* expect after determined token */
1478 EXT I32         lex_brackets;   /* bracket count */
1479 EXT I32         lex_formbrack;  /* bracket count at outer format level */
1480 EXT I32         lex_fakebrack;  /* outer bracket is mere delimiter */
1481 EXT I32         lex_casemods;   /* casemod count */
1482 EXT I32         lex_dojoin;     /* doing an array interpolation */
1483 EXT I32         lex_endscope;   /* maybe end of scope; defer lexical vars */
1484 EXT I32         lex_starts;     /* how many interps done on level */
1485 EXT SV *        lex_stuff;      /* runtime pattern from m// or s/// */
1486 EXT SV *        lex_repl;       /* runtime replacement from s/// */
1487 EXT OP *        lex_op;         /* extra info to pass back on op */
1488 EXT OP *        lex_inpat;      /* in pattern $) and $| are special */
1489 EXT I32         lex_inwhat;     /* what kind of quoting are we in */
1490 EXT char *      lex_brackstack; /* what kind of brackets to pop */
1491 EXT char *      lex_casestack;  /* what kind of case mods in effect */
1492
1493 /* What we know when we're in LEX_KNOWNEXT state. */
1494 EXT YYSTYPE     nextval[5];     /* value of next token, if any */
1495 EXT I32         nexttype[5];    /* type of next token */
1496 EXT I32         nexttoke;
1497
1498 EXT PerlIO * VOL        rsfp INIT(Nullfp);
1499 EXT SV *        linestr;
1500 EXT char *      bufptr;
1501 EXT char *      oldbufptr;
1502 EXT char *      oldoldbufptr;
1503 EXT char *      bufend;
1504 EXT expectation expect INIT(XSTATE);    /* how to interpret ambiguous tokens */
1505 EXT AV *        rsfp_filters;
1506
1507 EXT I32         multi_start;    /* 1st line of multi-line string */
1508 EXT I32         multi_end;      /* last line of multi-line string */
1509 EXT I32         multi_open;     /* delimiter of said string */
1510 EXT I32         multi_close;    /* delimiter of said string */
1511
1512 EXT GV *        scrgv;
1513 EXT I32         error_count;    /* how many errors so far, max 10 */
1514 EXT I32         subline;        /* line this subroutine began on */
1515 EXT SV *        subname;        /* name of current subroutine */
1516
1517 EXT CV *        compcv;         /* currently compiling subroutine */
1518 EXT AV *        comppad;        /* storage for lexically scoped temporaries */
1519 EXT AV *        comppad_name;   /* variable names for "my" variables */
1520 EXT I32         comppad_name_fill;/* last "introduced" variable offset */
1521 EXT I32         comppad_name_floor;/* start of vars in innermost block */
1522 EXT I32         min_intro_pending;/* start of vars to introduce */
1523 EXT I32         max_intro_pending;/* end of vars to introduce */
1524 EXT I32         padix;          /* max used index in current "register" pad */
1525 EXT I32         padix_floor;    /* how low may inner block reset padix */
1526 EXT I32         pad_reset_pending; /* reset pad on next attempted alloc */
1527 EXT COP         compiling;
1528
1529 EXT I32         thisexpr;       /* name id for nothing_in_common() */
1530 EXT char *      last_uni;       /* position of last named-unary operator */
1531 EXT char *      last_lop;       /* position of last list operator */
1532 EXT OPCODE      last_lop_op;    /* last list operator */
1533 EXT bool        in_my;          /* we're compiling a "my" declaration */
1534 #ifdef FCRYPT
1535 EXT I32         cryptseen;      /* has fast crypt() been initialized? */
1536 #endif
1537
1538 EXT U32         hints;          /* various compilation flags */
1539
1540                                 /* Note: the lowest 8 bits are reserved for
1541                                    stuffing into op->op_private */
1542 #define HINT_INTEGER            0x00000001
1543 #define HINT_STRICT_REFS        0x00000002
1544
1545 #define HINT_BLOCK_SCOPE        0x00000100
1546 #define HINT_STRICT_SUBS        0x00000200
1547 #define HINT_STRICT_VARS        0x00000400
1548 #define HINT_LOCALE             0x00000800
1549
1550 /**************************************************************************/
1551 /* This regexp stuff is global since it always happens within 1 expr eval */
1552 /**************************************************************************/
1553
1554 EXT char *      regprecomp;     /* uncompiled string. */
1555 EXT char *      regparse;       /* Input-scan pointer. */
1556 EXT char *      regxend;        /* End of input for compile */
1557 EXT I32         regnpar;        /* () count. */
1558 EXT char *      regcode;        /* Code-emit pointer; &regdummy = don't. */
1559 EXT I32         regsize;        /* Code size. */
1560 EXT I32         regnaughty;     /* How bad is this pattern? */
1561 EXT I32         regsawback;     /* Did we see \1, ...? */
1562
1563 EXT char *      reginput;       /* String-input pointer. */
1564 EXT char *      regbol;         /* Beginning of input, for ^ check. */
1565 EXT char *      regeol;         /* End of input, for $ check. */
1566 EXT char **     regstartp;      /* Pointer to startp array. */
1567 EXT char **     regendp;        /* Ditto for endp. */
1568 EXT U32 *       reglastparen;   /* Similarly for lastparen. */
1569 EXT char *      regtill;        /* How far we are required to go. */
1570 EXT U16         regflags;       /* are we folding, multilining? */
1571 EXT char        regprev;        /* char before regbol, \n if none */
1572
1573 EXT bool        do_undump;      /* -u or dump seen? */
1574 EXT VOL U32     debug;
1575
1576 /***********************************************/
1577 /* Global only to current interpreter instance */
1578 /***********************************************/
1579
1580 #ifdef MULTIPLICITY
1581 #define IEXT
1582 #define IINIT(x)
1583 struct interpreter {
1584 #else
1585 #define IEXT EXT
1586 #define IINIT(x) INIT(x)
1587 #endif
1588
1589 /* pseudo environmental stuff */
1590 IEXT int        Iorigargc;
1591 IEXT char **    Iorigargv;
1592 IEXT GV *       Ienvgv;
1593 IEXT GV *       Isiggv;
1594 IEXT GV *       Iincgv;
1595 IEXT char *     Iorigfilename;
1596 IEXT SV *       Idiehook;
1597 IEXT SV *       Iwarnhook;
1598 IEXT SV *       Iparsehook;
1599
1600 /* Various states of an input record separator SV (rs, nrs) */
1601 #define RsSNARF(sv)   (! SvOK(sv))
1602 #define RsSIMPLE(sv)  (SvOK(sv) && SvCUR(sv))
1603 #define RsPARA(sv)    (SvOK(sv) && ! SvCUR(sv))
1604
1605 /* switches */
1606 IEXT char *     Icddir;
1607 IEXT bool       Iminus_c;
1608 IEXT char       Ipatchlevel[10];
1609 IEXT char **    Ilocalpatches;
1610 IEXT SV *       Inrs;
1611 IEXT char *     Isplitstr IINIT(" ");
1612 IEXT bool       Ipreprocess;
1613 IEXT bool       Iminus_n;
1614 IEXT bool       Iminus_p;
1615 IEXT bool       Iminus_l;
1616 IEXT bool       Iminus_a;
1617 IEXT bool       Iminus_F;
1618 IEXT bool       Idoswitches;
1619 IEXT bool       Idowarn;
1620 IEXT bool       Idoextract;
1621 IEXT bool       Isawampersand;  /* must save all match strings */
1622 IEXT bool       Isawstudy;      /* do fbm_instr on all strings */
1623 IEXT bool       Isawvec;
1624 IEXT bool       Iunsafe;
1625 IEXT char *     Iinplace;
1626 IEXT char *     Ie_tmpname;
1627 IEXT PerlIO *   Ie_fp;
1628 IEXT U32        Iperldb;
1629         /* This value may be raised by extensions for testing purposes */
1630 IEXT int        Iperl_destruct_level;   /* 0=none, 1=full, 2=full with checks */
1631
1632 /* magical thingies */
1633 IEXT Time_t     Ibasetime;              /* $^T */
1634 IEXT SV *       Iformfeed;              /* $^L */
1635 IEXT char *     Ichopset IINIT(" \n-"); /* $: */
1636 IEXT SV *       Irs;                    /* $/ */
1637 IEXT char *     Iofs;                   /* $, */
1638 IEXT STRLEN     Iofslen;
1639 IEXT char *     Iors;                   /* $\ */
1640 IEXT STRLEN     Iorslen;
1641 IEXT char *     Iofmt;                  /* $# */
1642 IEXT I32        Imaxsysfd IINIT(MAXSYSFD); /* top fd to pass to subprocesses */
1643 IEXT int        Imultiline;       /* $*--do strings hold >1 line? */
1644 IEXT U32        Istatusvalue;   /* $? */
1645
1646 IEXT struct stat Istatcache;            /* _ */
1647 IEXT GV *       Istatgv;
1648 IEXT SV *       Istatname IINIT(Nullsv);
1649
1650 /* shortcuts to various I/O objects */
1651 IEXT GV *       Istdingv;
1652 IEXT GV *       Ilast_in_gv;
1653 IEXT GV *       Idefgv;
1654 IEXT GV *       Iargvgv;
1655 IEXT GV *       Idefoutgv;
1656 IEXT GV *       Iargvoutgv;
1657
1658 /* shortcuts to regexp stuff */
1659 IEXT GV *       Ileftgv;
1660 IEXT GV *       Iampergv;
1661 IEXT GV *       Irightgv;
1662 IEXT PMOP *     Icurpm;         /* what to do \ interps from */
1663 IEXT I32 *      Iscreamfirst;
1664 IEXT I32 *      Iscreamnext;
1665 IEXT I32        Imaxscream IINIT(-1);
1666 IEXT SV *       Ilastscream;
1667
1668 /* shortcuts to misc objects */
1669 IEXT GV *       Ierrgv;
1670
1671 /* shortcuts to debugging objects */
1672 IEXT GV *       IDBgv;
1673 IEXT GV *       IDBline;
1674 IEXT GV *       IDBsub;
1675 IEXT SV *       IDBsingle;
1676 IEXT SV *       IDBtrace;
1677 IEXT SV *       IDBsignal;
1678 IEXT AV *       Ilineary;       /* lines of script for debugger */
1679 IEXT AV *       Idbargs;        /* args to call listed by caller function */
1680
1681 /* symbol tables */
1682 IEXT HV *       Idefstash;      /* main symbol table */
1683 IEXT HV *       Icurstash;      /* symbol table for current package */
1684 IEXT HV *       Idebstash;      /* symbol table for perldb package */
1685 IEXT SV *       Icurstname;     /* name of current package */
1686 IEXT AV *       Ibeginav;       /* names of BEGIN subroutines */
1687 IEXT AV *       Iendav;         /* names of END subroutines */
1688 IEXT HV *       Istrtab;        /* shared string table */
1689
1690 /* memory management */
1691 IEXT SV **      Itmps_stack;
1692 IEXT I32        Itmps_ix IINIT(-1);
1693 IEXT I32        Itmps_floor IINIT(-1);
1694 IEXT I32        Itmps_max;
1695 IEXT I32        Isv_count;      /* how many SV* are currently allocated */
1696 IEXT I32        Isv_objcount;   /* how many objects are currently allocated */
1697 IEXT SV*        Isv_root;       /* storage for SVs belonging to interp */
1698 IEXT SV*        Isv_arenaroot;  /* list of areas for garbage collection */
1699
1700 /* funky return mechanisms */
1701 IEXT I32        Ilastspbase;
1702 IEXT I32        Ilastsize;
1703 IEXT int        Iforkprocess;   /* so do_open |- can return proc# */
1704
1705 /* subprocess state */
1706 IEXT AV *       Ifdpid;         /* keep fd-to-pid mappings for my_popen */
1707 IEXT HV *       Ipidstatus;     /* keep pid-to-status mappings for waitpid */
1708
1709 /* internal state */
1710 IEXT VOL int    Iin_eval;       /* trap "fatal" errors? */
1711 IEXT OP *       Irestartop;     /* Are we propagating an error from croak? */
1712 IEXT int        Idelaymagic;    /* ($<,$>) = ... */
1713 IEXT bool       Idirty;         /* In the middle of tearing things down? */
1714 IEXT U8         Ilocalizing;    /* are we processing a local() list? */
1715 IEXT bool       Itainted;       /* using variables controlled by $< */
1716 IEXT bool       Itainting;      /* doing taint checks */
1717 IEXT char *     Iop_mask IINIT(NULL);   /* masked operations for safe evals */
1718
1719 /* trace state */
1720 IEXT I32        Idlevel;
1721 IEXT I32        Idlmax IINIT(128);
1722 IEXT char *     Idebname;
1723 IEXT char *     Idebdelim;
1724
1725 /* current interpreter roots */
1726 IEXT CV *       Imain_cv;
1727 IEXT OP *       Imain_root;
1728 IEXT OP *       Imain_start;
1729 IEXT OP *       Ieval_root;
1730 IEXT OP *       Ieval_start;
1731
1732 /* runtime control stuff */
1733 IEXT COP * VOL  Icurcop IINIT(&compiling);
1734 IEXT COP *      Icurcopdb IINIT(NULL);
1735 IEXT line_t     Icopline IINIT(NOLINE);
1736 IEXT CONTEXT *  Icxstack;
1737 IEXT I32        Icxstack_ix IINIT(-1);
1738 IEXT I32        Icxstack_max IINIT(128);
1739 IEXT Sigjmp_buf Itop_env;
1740 IEXT I32        Irunlevel;
1741
1742 /* stack stuff */
1743 IEXT AV *       Icurstack;              /* THE STACK */
1744 IEXT AV *       Imainstack;     /* the stack when nothing funny is happening */
1745 IEXT SV **      Imystack_base;  /* stack->array_ary */
1746 IEXT SV **      Imystack_sp;    /* stack pointer now */
1747 IEXT SV **      Imystack_max;   /* stack->array_ary + stack->array_max */
1748
1749 /* format accumulators */
1750 IEXT SV *       Iformtarget;
1751 IEXT SV *       Ibodytarget;
1752 IEXT SV *       Itoptarget;
1753
1754 /* statics moved here for shared library purposes */
1755 IEXT SV         Istrchop;       /* return value from chop */
1756 IEXT int        Ifilemode;      /* so nextargv() can preserve mode */
1757 IEXT int        Ilastfd;        /* what to preserve mode on */
1758 IEXT char *     Ioldname;       /* what to preserve mode on */
1759 IEXT char **    IArgv;          /* stuff to free from do_aexec, vfork safe */
1760 IEXT char *     ICmd;           /* stuff to free from do_aexec, vfork safe */
1761 IEXT OP *       Isortcop;       /* user defined sort routine */
1762 IEXT HV *       Isortstash;     /* which is in some package or other */
1763 IEXT GV *       Ifirstgv;       /* $a */
1764 IEXT GV *       Isecondgv;      /* $b */
1765 IEXT AV *       Isortstack;     /* temp stack during pp_sort() */
1766 IEXT AV *       Isignalstack;   /* temp stack during sighandler() */
1767 IEXT SV *       Imystrk;        /* temp key string for do_each() */
1768 IEXT I32        Idumplvl;       /* indentation level on syntax tree dump */
1769 IEXT PMOP *     Ioldlastpm;     /* for saving regexp context during debugger */
1770 IEXT I32        Igensym;        /* next symbol for getsym() to define */
1771 IEXT bool       Ipreambled;
1772 IEXT AV *       Ipreambleav;
1773 IEXT int        Ilaststatval IINIT(-1);
1774 IEXT I32        Ilaststype IINIT(OP_STAT);
1775
1776 #undef IEXT
1777 #undef IINIT
1778
1779 #ifdef MULTIPLICITY
1780 };
1781 #else
1782 struct interpreter {
1783     char broiled;
1784 };
1785 #endif
1786
1787 #include "pp.h"
1788
1789 #ifdef __cplusplus
1790 extern "C" {
1791 #endif
1792
1793 #include "proto.h"
1794
1795 #ifdef EMBED
1796 #define Perl_sv_setptrobj(rv,ptr,name) Perl_sv_setref_iv(rv,name,(IV)ptr)
1797 #define Perl_sv_setptrref(rv,ptr) Perl_sv_setref_iv(rv,Nullch,(IV)ptr)
1798 #else
1799 #define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
1800 #define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
1801 #endif
1802
1803 #ifdef __cplusplus
1804 };
1805 #endif
1806
1807 /* The following must follow proto.h */
1808
1809 #ifdef DOINIT
1810
1811 EXT MGVTBL vtbl_sv =    {magic_get,
1812                                 magic_set,
1813                                         magic_len,
1814                                                 0,      0};
1815 EXT MGVTBL vtbl_env =   {0,     0,      0,      0,      0};
1816 EXT MGVTBL vtbl_envelem =       {0,     magic_setenv,
1817                                         0,      magic_clearenv,
1818                                                         0};
1819 EXT MGVTBL vtbl_sig =   {0,     0,               0, 0, 0};
1820 EXT MGVTBL vtbl_sigelem =       {magic_getsig,
1821                                         magic_setsig,
1822                                         0,      magic_clearsig,
1823                                                         0};
1824 EXT MGVTBL vtbl_pack =  {0,     0,      0,      magic_wipepack,
1825                                                         0};
1826 EXT MGVTBL vtbl_packelem =      {magic_getpack,
1827                                 magic_setpack,
1828                                         0,      magic_clearpack,
1829                                                         0};
1830 EXT MGVTBL vtbl_dbline =        {0,     magic_setdbline,
1831                                         0,      0,      0};
1832 EXT MGVTBL vtbl_isa =   {0,     magic_setisa,
1833                                         0,      0,      0};
1834 EXT MGVTBL vtbl_isaelem =       {0,     magic_setisa,
1835                                         0,      0,      0};
1836 EXT MGVTBL vtbl_arylen =        {magic_getarylen,
1837                                 magic_setarylen,
1838                                         0,      0,      0};
1839 EXT MGVTBL vtbl_glob =  {magic_getglob,
1840                                 magic_setglob,
1841                                         0,      0,      0};
1842 EXT MGVTBL vtbl_mglob = {0,     magic_setmglob,
1843                                         0,      0,      0};
1844 EXT MGVTBL vtbl_nkeys = {0,     magic_setnkeys,
1845                                         0,      0,      0};
1846 EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint,
1847                                         0,      0,      0};
1848 EXT MGVTBL vtbl_substr =        {0,     magic_setsubstr,
1849                                         0,      0,      0};
1850 EXT MGVTBL vtbl_vec =   {0,     magic_setvec,
1851                                         0,      0,      0};
1852 EXT MGVTBL vtbl_pos =   {magic_getpos,
1853                                 magic_setpos,
1854                                         0,      0,      0};
1855 EXT MGVTBL vtbl_bm =    {0,     magic_setbm,
1856                                         0,      0,      0};
1857 EXT MGVTBL vtbl_fm =    {0,     magic_setfm,
1858                                         0,      0,      0};
1859 EXT MGVTBL vtbl_uvar =  {magic_getuvar,
1860                                 magic_setuvar,
1861                                         0,      0,      0};
1862
1863 #ifdef LC_COLLATE
1864 EXT MGVTBL vtbl_collxfrm = {0,
1865                                 magic_setcollxfrm,
1866                                         0,      0,      0};
1867 #endif
1868
1869 #ifdef OVERLOAD
1870 EXT MGVTBL vtbl_amagic =       {0,     magic_setamagic,
1871                                         0,      0,      magic_setamagic};
1872 EXT MGVTBL vtbl_amagicelem =   {0,     magic_setamagic,
1873                                         0,      0,      magic_setamagic};
1874 #endif /* OVERLOAD */
1875
1876 #else /* !DOINIT */
1877
1878 EXT MGVTBL vtbl_sv;
1879 EXT MGVTBL vtbl_env;
1880 EXT MGVTBL vtbl_envelem;
1881 EXT MGVTBL vtbl_sig;
1882 EXT MGVTBL vtbl_sigelem;
1883 EXT MGVTBL vtbl_pack;
1884 EXT MGVTBL vtbl_packelem;
1885 EXT MGVTBL vtbl_dbline;
1886 EXT MGVTBL vtbl_isa;
1887 EXT MGVTBL vtbl_isaelem;
1888 EXT MGVTBL vtbl_arylen;
1889 EXT MGVTBL vtbl_glob;
1890 EXT MGVTBL vtbl_mglob;
1891 EXT MGVTBL vtbl_nkeys;
1892 EXT MGVTBL vtbl_taint;
1893 EXT MGVTBL vtbl_substr;
1894 EXT MGVTBL vtbl_vec;
1895 EXT MGVTBL vtbl_pos;
1896 EXT MGVTBL vtbl_bm;
1897 EXT MGVTBL vtbl_fm;
1898 EXT MGVTBL vtbl_uvar;
1899
1900 #ifdef HAS_STRXFRM
1901 EXT MGVTBL vtbl_collxfrm;
1902 #endif
1903
1904 #ifdef OVERLOAD
1905 EXT MGVTBL vtbl_amagic;
1906 EXT MGVTBL vtbl_amagicelem;
1907 #endif /* OVERLOAD */
1908
1909 #endif /* !DOINIT */
1910
1911 #ifdef OVERLOAD
1912 EXT long amagic_generation;
1913
1914 #define NofAMmeth 29
1915 #ifdef DOINIT
1916 EXT char * AMG_names[NofAMmeth][2] = {
1917   {"fallback","abs"},
1918   {"bool", "nomethod"},
1919   {"\"\"", "0+"},
1920   {"+","+="},
1921   {"-","-="},
1922   {"*", "*="},
1923   {"/", "/="},
1924   {"%", "%="},
1925   {"**", "**="},
1926   {"<<", "<<="},
1927   {">>", ">>="},
1928   {"&", "&="},
1929   {"|", "|="},
1930   {"^", "^="},
1931   {"<", "<="},
1932   {">", ">="},
1933   {"==", "!="},
1934   {"<=>", "cmp"},
1935   {"lt", "le"},
1936   {"gt", "ge"},
1937   {"eq", "ne"},
1938   {"!", "~"},
1939   {"++", "--"},
1940   {"atan2", "cos"},
1941   {"sin", "exp"},
1942   {"log", "sqrt"},
1943   {"x","x="},
1944   {".",".="},
1945   {"=","neg"}
1946 };
1947 #else
1948 EXT char * AMG_names[NofAMmeth][2];
1949 #endif /* def INITAMAGIC */
1950
1951 struct  am_table        {
1952   long was_ok_sub;
1953   long was_ok_am;
1954   CV* table[NofAMmeth*2];
1955   long fallback;
1956 };
1957 typedef struct am_table AMT;
1958
1959 #define AMGfallNEVER    1
1960 #define AMGfallNO       2
1961 #define AMGfallYES      3
1962
1963 enum {
1964   fallback_amg, abs_amg,
1965   bool__amg,    nomethod_amg,
1966   string_amg,   numer_amg,
1967   add_amg,      add_ass_amg,
1968   subtr_amg,    subtr_ass_amg,
1969   mult_amg,     mult_ass_amg,
1970   div_amg,      div_ass_amg,
1971   mod_amg,      mod_ass_amg,
1972   pow_amg,      pow_ass_amg,
1973   lshift_amg,   lshift_ass_amg,
1974   rshift_amg,   rshift_ass_amg,
1975   band_amg,     band_ass_amg,
1976   bor_amg,      bor_ass_amg,
1977   bxor_amg,     bxor_ass_amg,
1978   lt_amg,       le_amg,
1979   gt_amg,       ge_amg,
1980   eq_amg,       ne_amg,
1981   ncmp_amg,     scmp_amg,
1982   slt_amg,      sle_amg,
1983   sgt_amg,      sge_amg,
1984   seq_amg,      sne_amg,
1985   not_amg,      compl_amg,
1986   inc_amg,      dec_amg,
1987   atan2_amg,    cos_amg,
1988   sin_amg,      exp_amg,
1989   log_amg,      sqrt_amg,
1990   repeat_amg,   repeat_ass_amg,
1991   concat_amg,   concat_ass_amg,
1992   copy_amg,     neg_amg
1993 };
1994 #endif /* OVERLOAD */
1995
1996 #ifdef LC_COLLATE
1997 EXT U32         collation_ix;           /* Collation generation index */
1998 EXT char *      collation_name;         /* Name of current collation */
1999 EXT bool        collation_standard INIT(TRUE); /* Assume simple collation */
2000 EXT Size_t      collxfrm_base;          /* Basic overhead in *xfrm() */
2001 EXT Size_t      collxfrm_mult INIT(2);  /* Expansion factor in *xfrm() */
2002 #endif /* LC_COLLATE */
2003
2004 #ifdef LC_NUMERIC
2005
2006 EXT char *      numeric_name;           /* Name of current numeric locale */
2007 EXT bool        numeric_standard INIT(TRUE); /* Assume simple numerics */
2008 EXT bool        numeric_local INIT(TRUE);    /* Assume local numerics */
2009
2010 #define NUMERIC_STANDARD() \
2011     STMT_START { if (! numeric_standard) perl_numeric_standard(); } STMT_END
2012 #define NUMERIC_LOCAL() \
2013     STMT_START { if (! numeric_local) perl_numeric_local(); } STMT_END
2014
2015 #else /* !LC_NUMERIC */
2016
2017 #define NUMERIC_STANDARD()  /**/
2018 #define NUMERIC_LOCAL()     /**/
2019
2020 #endif /* !LC_NUMERIC */
2021
2022 #if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE)
2023 /*
2024  * Now we have __attribute__ out of the way
2025  * Remap printf
2026  */
2027 #define printf PerlIO_stdoutf
2028 #endif
2029
2030 #endif /* Include guard */
2031