perl.h

   1 /*    perl.h
   2  *
   3  *    Copyright (c) 1987-1997, 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 USE_STDIO
  24 #define USE_STDIO
  25 #endif /* PERL_FOR_X2P */
  26
  27 #define VOIDUSED 1
  28 #include "config.h"
  29
  30 #include "embed.h"
  31
  32 #undef START_EXTERN_C
  33 #undef END_EXTERN_C
  34 #undef EXTERN_C
  35 #ifdef __cplusplus
  36 #  define START_EXTERN_C extern "C" {
  37 #  define END_EXTERN_C }
  38 #  define EXTERN_C extern "C"
  39 #else
  40 #  define START_EXTERN_C
  41 #  define END_EXTERN_C
  42 #  define EXTERN_C
  43 #endif
  44
  45 #ifdef OP_IN_REGISTER
  46 #  ifdef __GNUC__
  47 #    define stringify_immed(s) #s
  48 #    define stringify(s) stringify_immed(s)
  49 register struct op *op asm(stringify(OP_IN_REGISTER));
  50 #  endif
  51 #endif
  52
  53 /*
  54  * STMT_START { statements; } STMT_END;
  55  * can be used as a single statement, as in
  56  * if (x) STMT_START { ... } STMT_END; else ...
  57  *
  58  * Trying to select a version that gives no warnings...
  59  */
  60 #if !(defined(STMT_START) && defined(STMT_END))
  61 # if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(__cplusplus)
  62 #   define STMT_START   (void)( /* gcc supports ``({ STATEMENTS; })'' */
  63 #   define STMT_END     )
  64 # else
  65    /* Now which other defined()s do we need here ??? */
  66 #  if (VOIDFLAGS) && (defined(sun) || defined(__sun__))
  67 #   define STMT_START   if (1)
  68 #   define STMT_END     else (void)0
  69 #  else
  70 #   define STMT_START   do
  71 #   define STMT_END     while (0)
  72 #  endif
  73 # endif
  74 #endif
  75
  76 #define NOOP (void)0
  77
  78 #define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
  79
  80 /*
  81  * SOFT_CAST can be used for args to prototyped functions to retain some
  82  * type checking; it only casts if the compiler does not know prototypes.
  83  */
  84 #if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE)
  85 #define SOFT_CAST(type)
  86 #else
  87 #define SOFT_CAST(type) (type)
  88 #endif
  89
  90 #ifndef BYTEORDER
  91 #   define BYTEORDER 0x1234
  92 #endif
  93
  94 /* Overall memory policy? */
  95 #ifndef CONSERVATIVE
  96 #   define LIBERAL 1
  97 #endif
  98
  99 /*
 100  * The following contortions are brought to you on behalf of all the
 101  * standards, semi-standards, de facto standards, not-so-de-facto standards
 102  * of the world, as well as all the other botches anyone ever thought of.
 103  * The basic theory is that if we work hard enough here, the rest of the
 104  * code can be a lot prettier.  Well, so much for theory.  Sorry, Henry...
 105  */
 106
 107 /* define this once if either system, instead of cluttering up the src */
 108 #if defined(MSDOS) || defined(atarist) || defined(WIN32)
 109 #define DOSISH 1
 110 #endif
 111
 112 #if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
 113 # define STANDARD_C 1
 114 #endif
 115
 116 #if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) \
 117         || defined(__DGUX)
 118 # define DONT_DECLARE_STD 1
 119 #endif
 120
 121 #if defined(NeXT) && !defined(_POSIX_SOURCE)
 122 #   define MISSING_PID_T
 123 #endif
 124
 125 #if defined(HASVOLATILE) || defined(STANDARD_C)
 126 #   ifdef __cplusplus
 127 #       define VOL              // to temporarily suppress warnings
 128 #   else
 129 #       define VOL volatile
 130 #   endif
 131 #else
 132 #   define VOL
 133 #endif
 134
 135 #define TAINT           (tainted = TRUE)
 136 #define TAINT_NOT       (tainted = FALSE)
 137 #define TAINT_IF(c)     if (c) { tainted = TRUE; }
 138 #define TAINT_ENV()     if (tainting) { taint_env(); }
 139 #define TAINT_PROPER(s) if (tainting) { taint_proper(no_security, s); }
 140
 141 #ifdef MISSING_PID_T
 142 typedef int pid_t;
 143 #endif
 144
 145 /* XXX All process group stuff is handled in pp_sys.c.  Should these
 146    defines move there?  If so, I could simplify this a lot. --AD  9/96.
 147 */
 148 /* Process group stuff changed from traditional BSD to POSIX.
 149    perlfunc.pod documents the traditional BSD-style syntax, so we'll
 150    try to preserve that, if possible.
 151 */
 152 #ifdef HAS_SETPGID
 153 #  define BSD_SETPGRP(pid, pgrp)        setpgid((pid), (pgrp))
 154 #else
 155 #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
 156 #    define BSD_SETPGRP(pid, pgrp)      setpgrp((pid), (pgrp))
 157 #  else
 158 #    ifdef HAS_SETPGRP2  /* DG/UX */
 159 #      define BSD_SETPGRP(pid, pgrp)    setpgrp2((pid), (pgrp))
 160 #    endif
 161 #  endif
 162 #endif
 163 #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
 164 #  define HAS_SETPGRP  /* Well, effectively it does . . . */
 165 #endif
 166
 167 /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
 168     our life easier :-) so we'll try it.
 169 */
 170 #ifdef HAS_GETPGID
 171 #  define BSD_GETPGRP(pid)              getpgid((pid))
 172 #else
 173 #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
 174 #    define BSD_GETPGRP(pid)            getpgrp((pid))
 175 #  else
 176 #    ifdef HAS_GETPGRP2  /* DG/UX */
 177 #      define BSD_GETPGRP(pid)          getpgrp2((pid))
 178 #    endif
 179 #  endif
 180 #endif
 181 #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
 182 #  define HAS_GETPGRP  /* Well, effectively it does . . . */
 183 #endif
 184
 185 /* These are not exact synonyms, since setpgrp() and getpgrp() may
 186    have different behaviors, but perl.h used to define USE_BSDPGRP
 187    (prior to 5.003_05) so some extension might depend on it.
 188 */
 189 #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
 190 #  ifndef USE_BSDPGRP
 191 #    define USE_BSDPGRP
 192 #  endif
 193 #endif
 194
 195 #ifndef _TYPES_         /* If types.h defines this it's easy. */
 196 #   ifndef major                /* Does everyone's types.h define this? */
 197 #       include <sys/types.h>
 198 #   endif
 199 #endif
 200
 201 #ifdef __cplusplus
 202 #  ifndef I_STDARG
 203 #    define I_STDARG 1
 204 #  endif
 205 #endif
 206
 207 #ifdef I_STDARG
 208 #  include <stdarg.h>
 209 #else
 210 #  ifdef I_VARARGS
 211 #    include <varargs.h>
 212 #  endif
 213 #endif
 214
 215 #include "perlio.h"
 216 #include "perllio.h"
 217 #include "perlsock.h"
 218 #include "perlproc.h"
 219 #include "perlenv.h"
 220 #include "perldir.h"
 221
 222 #ifdef USE_NEXT_CTYPE
 223
 224 #if NX_CURRENT_COMPILER_RELEASE >= 400
 225 #include <objc/NXCType.h>
 226 #else /*  NX_CURRENT_COMPILER_RELEASE < 400 */
 227 #include <appkit/NXCType.h>
 228 #endif /*  NX_CURRENT_COMPILER_RELEASE >= 400 */
 229
 230 #else /* !USE_NEXT_CTYPE */
 231 #include <ctype.h>
 232 #endif /* USE_NEXT_CTYPE */
 233
 234 #ifdef METHOD   /* Defined by OSF/1 v3.0 by ctype.h */
 235 #undef METHOD
 236 #endif
 237
 238 #ifdef I_LOCALE
 239 #   include <locale.h>
 240 #endif
 241
 242 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
 243 #   define USE_LOCALE
 244 #   if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
 245        && defined(HAS_STRXFRM)
 246 #       define USE_LOCALE_COLLATE
 247 #   endif
 248 #   if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE)
 249 #       define USE_LOCALE_CTYPE
 250 #   endif
 251 #   if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC)
 252 #       define USE_LOCALE_NUMERIC
 253 #   endif
 254 #endif /* !NO_LOCALE && HAS_SETLOCALE */
 255
 256 #include <setjmp.h>
 257
 258 #ifdef I_SYS_PARAM
 259 #   ifdef PARAM_NEEDS_TYPES
 260 #       include <sys/types.h>
 261 #   endif
 262 #   include <sys/param.h>
 263 #endif
 264
 265
 266 /* Use all the "standard" definitions? */
 267 #if defined(STANDARD_C) && defined(I_STDLIB)
 268 #   include <stdlib.h>
 269 #endif
 270
 271 #define MEM_SIZE Size_t
 272
 273 /* This comes after <stdlib.h> so we don't try to change the standard
 274  * library prototypes; we'll use our own in proto.h instead. */
 275
 276 #ifdef MYMALLOC
 277
 278 #   ifdef HIDEMYMALLOC
 279 #       define malloc  Mymalloc
 280 #       define calloc  Mycalloc
 281 #       define realloc Myremalloc
 282 #       define free    Myfree
 283 Malloc_t Mymalloc _((MEM_SIZE nbytes));
 284 Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size));
 285 Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes));
 286 Free_t   Myfree _((Malloc_t where));
 287 #   endif
 288 #   ifdef EMBEDMYMALLOC
 289 #       define malloc  Perl_malloc
 290 #       define calloc  Perl_calloc
 291 #       define realloc Perl_realloc
 292 #       define free    Perl_free
 293 Malloc_t Perl_malloc _((MEM_SIZE nbytes));
 294 Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size));
 295 Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes));
 296 Free_t   Perl_free _((Malloc_t where));
 297 #   endif
 298
 299 #   undef safemalloc
 300 #   undef safecalloc
 301 #   undef saferealloc
 302 #   undef safefree
 303 #   define safemalloc  malloc
 304 #   define safecalloc  calloc
 305 #   define saferealloc realloc
 306 #   define safefree    free
 307
 308 #endif /* MYMALLOC */
 309
 310 #if defined(STANDARD_C) && defined(I_STDDEF)
 311 #   include <stddef.h>
 312 #   define STRUCT_OFFSET(s,m)  offsetof(s,m)
 313 #else
 314 #   define STRUCT_OFFSET(s,m)  (Size_t)(&(((s *)0)->m))
 315 #endif
 316
 317 #if defined(I_STRING) || defined(__cplusplus)
 318 #   include <string.h>
 319 #else
 320 #   include <strings.h>
 321 #endif
 322
 323 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
 324 #define strchr index
 325 #define strrchr rindex
 326 #endif
 327
 328 #ifdef I_MEMORY
 329 #  include <memory.h>
 330 #endif
 331
 332 #ifdef HAS_MEMCPY
 333 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 334 #    ifndef memcpy
 335         extern char * memcpy _((char*, char*, int));
 336 #    endif
 337 #  endif
 338 #else
 339 #   ifndef memcpy
 340 #       ifdef HAS_BCOPY
 341 #           define memcpy(d,s,l) bcopy(s,d,l)
 342 #       else
 343 #           define memcpy(d,s,l) my_bcopy(s,d,l)
 344 #       endif
 345 #   endif
 346 #endif /* HAS_MEMCPY */
 347
 348 #ifdef HAS_MEMSET
 349 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 350 #    ifndef memset
 351         extern char *memset _((char*, int, int));
 352 #    endif
 353 #  endif
 354 #else
 355 #  define memset(d,c,l) my_memset(d,c,l)
 356 #endif /* HAS_MEMSET */
 357
 358 #if !defined(HAS_MEMMOVE) && !defined(memmove)
 359 #   if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
 360 #       define memmove(d,s,l) bcopy(s,d,l)
 361 #   else
 362 #       if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
 363 #           define memmove(d,s,l) memcpy(d,s,l)
 364 #       else
 365 #           define memmove(d,s,l) my_bcopy(s,d,l)
 366 #       endif
 367 #   endif
 368 #endif
 369
 370 #if defined(mips) && defined(ultrix) && !defined(__STDC__)
 371 #   undef HAS_MEMCMP
 372 #endif
 373
 374 #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
 375 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 376 #    ifndef memcmp
 377         extern int memcmp _((char*, char*, int));
 378 #    endif
 379 #  endif
 380 #  ifdef BUGGY_MSC
 381   #  pragma function(memcmp)
 382 #  endif
 383 #else
 384 #   ifndef memcmp
 385 #       define memcmp   my_memcmp
 386 #   endif
 387 #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
 388
 389 #ifndef memzero
 390 #   ifdef HAS_MEMSET
 391 #       define memzero(d,l) memset(d,0,l)
 392 #   else
 393 #       ifdef HAS_BZERO
 394 #           define memzero(d,l) bzero(d,l)
 395 #       else
 396 #           define memzero(d,l) my_bzero(d,l)
 397 #       endif
 398 #   endif
 399 #endif
 400
 401 #ifndef HAS_BCMP
 402 #   ifndef bcmp
 403 #       define bcmp(s1,s2,l) memcmp(s1,s2,l)
 404 #   endif
 405 #endif /* !HAS_BCMP */
 406
 407 #ifdef I_NETINET_IN
 408 #   include <netinet/in.h>
 409 #endif
 410
 411 #if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
 412 /* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
 413  * (the neo-BSD seem to do this).  */
 414 #   undef SF_APPEND
 415 #endif
 416
 417 #ifdef I_SYS_STAT
 418 #   include <sys/stat.h>
 419 #endif
 420
 421 /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
 422    like UTekV) are broken, sometimes giving false positives.  Undefine
 423    them here and let the code below set them to proper values.
 424
 425    The ghs macro stands for GreenHills Software C-1.8.5 which
 426    is the C compiler for sysV88 and the various derivatives.
 427    This header file bug is corrected in gcc-2.5.8 and later versions.
 428    --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94.  */
 429
 430 #if defined(uts) || (defined(m88k) && defined(ghs))
 431 #   undef S_ISDIR
 432 #   undef S_ISCHR
 433 #   undef S_ISBLK
 434 #   undef S_ISREG
 435 #   undef S_ISFIFO
 436 #   undef S_ISLNK
 437 #endif
 438
 439 #ifdef I_TIME
 440 #   include <time.h>
 441 #endif
 442
 443 #ifdef I_SYS_TIME
 444 #   ifdef I_SYS_TIME_KERNEL
 445 #       define KERNEL
 446 #   endif
 447 #   include <sys/time.h>
 448 #   ifdef I_SYS_TIME_KERNEL
 449 #       undef KERNEL
 450 #   endif
 451 #endif
 452
 453 #if defined(HAS_TIMES) && defined(I_SYS_TIMES)
 454 #    include <sys/times.h>
 455 #endif
 456
 457 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
 458 #   undef HAS_STRERROR
 459 #endif
 460
 461 #ifndef HAS_MKFIFO
 462 #  ifndef mkfifo
 463 #    define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
 464 #  endif
 465 #endif /* !HAS_MKFIFO */
 466
 467 #include <errno.h>
 468 #ifdef HAS_SOCKET
 469 #   ifdef I_NET_ERRNO
 470 #     include <net/errno.h>
 471 #   endif
 472 #endif
 473
 474 #ifdef VMS
 475 #   define SETERRNO(errcode,vmserrcode) \
 476         STMT_START {                    \
 477             set_errno(errcode);         \
 478             set_vaxc_errno(vmserrcode); \
 479         } STMT_END
 480 #else
 481 #   define SETERRNO(errcode,vmserrcode) errno = (errcode)
 482 #endif
 483
 484 #ifdef USE_THREADS
 485 #  define ERRSV (thr->errsv)
 486 #  define ERRHV (thr->errhv)
 487 #  define DEFSV THREADSV(0)
 488 #  define SAVE_DEFSV save_threadsv(0)
 489 #else
 490 #  define ERRSV GvSV(errgv)
 491 #  define ERRHV GvHV(errgv)
 492 #  define DEFSV GvSV(defgv)
 493 #  define SAVE_DEFSV SAVESPTR(GvSV(defgv))
 494 #endif /* USE_THREADS */
 495
 496 #ifndef errno
 497         extern int errno;     /* ANSI allows errno to be an lvalue expr */
 498 #endif
 499
 500 #ifdef HAS_STRERROR
 501 #       ifdef VMS
 502         char *strerror _((int,...));
 503 #       else
 504 #ifndef DONT_DECLARE_STD
 505         char *strerror _((int));
 506 #endif
 507 #       endif
 508 #       ifndef Strerror
 509 #           define Strerror strerror
 510 #       endif
 511 #else
 512 #    ifdef HAS_SYS_ERRLIST
 513         extern int sys_nerr;
 514         extern char *sys_errlist[];
 515 #       ifndef Strerror
 516 #           define Strerror(e) \
 517                 ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
 518 #       endif
 519 #   endif
 520 #endif
 521
 522 #ifdef I_SYS_IOCTL
 523 #   ifndef _IOCTL_
 524 #       include <sys/ioctl.h>
 525 #   endif
 526 #endif
 527
 528 #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
 529 #   ifdef HAS_SOCKETPAIR
 530 #       undef HAS_SOCKETPAIR
 531 #   endif
 532 #   ifdef I_NDBM
 533 #       undef I_NDBM
 534 #   endif
 535 #endif
 536
 537 #if INTSIZE == 2
 538 #   define htoni htons
 539 #   define ntohi ntohs
 540 #else
 541 #   define htoni htonl
 542 #   define ntohi ntohl
 543 #endif
 544
 545 /* Configure already sets Direntry_t */
 546 #if defined(I_DIRENT)
 547 #   include <dirent.h>
 548 #   if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
 549 #       include <sys/dir.h>
 550 #   endif
 551 #else
 552 #   ifdef I_SYS_NDIR
 553 #       include <sys/ndir.h>
 554 #   else
 555 #       ifdef I_SYS_DIR
 556 #           ifdef hp9000s500
 557 #               include <ndir.h>        /* may be wrong in the future */
 558 #           else
 559 #               include <sys/dir.h>
 560 #           endif
 561 #       endif
 562 #   endif
 563 #endif
 564
 565 #ifdef FPUTS_BOTCH
 566 /* work around botch in SunOS 4.0.1 and 4.0.2 */
 567 #   ifndef fputs
 568 #       define fputs(sv,fp) fprintf(fp,"%s",sv)
 569 #   endif
 570 #endif
 571
 572 /*
 573  * The following gobbledygook brought to you on behalf of __STDC__.
 574  * (I could just use #ifndef __STDC__, but this is more bulletproof
 575  * in the face of half-implementations.)
 576  */
 577
 578 #ifndef S_IFMT
 579 #   ifdef _S_IFMT
 580 #       define S_IFMT _S_IFMT
 581 #   else
 582 #       define S_IFMT 0170000
 583 #   endif
 584 #endif
 585
 586 #ifndef S_ISDIR
 587 #   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
 588 #endif
 589
 590 #ifndef S_ISCHR
 591 #   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
 592 #endif
 593
 594 #ifndef S_ISBLK
 595 #   ifdef S_IFBLK
 596 #       define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
 597 #   else
 598 #       define S_ISBLK(m) (0)
 599 #   endif
 600 #endif
 601
 602 #ifndef S_ISREG
 603 #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
 604 #endif
 605
 606 #ifndef S_ISFIFO
 607 #   ifdef S_IFIFO
 608 #       define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
 609 #   else
 610 #       define S_ISFIFO(m) (0)
 611 #   endif
 612 #endif
 613
 614 #ifndef S_ISLNK
 615 #   ifdef _S_ISLNK
 616 #       define S_ISLNK(m) _S_ISLNK(m)
 617 #   else
 618 #       ifdef _S_IFLNK
 619 #           define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
 620 #       else
 621 #           ifdef S_IFLNK
 622 #               define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
 623 #           else
 624 #               define S_ISLNK(m) (0)
 625 #           endif
 626 #       endif
 627 #   endif
 628 #endif
 629
 630 #ifndef S_ISSOCK
 631 #   ifdef _S_ISSOCK
 632 #       define S_ISSOCK(m) _S_ISSOCK(m)
 633 #   else
 634 #       ifdef _S_IFSOCK
 635 #           define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
 636 #       else
 637 #           ifdef S_IFSOCK
 638 #               define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
 639 #           else
 640 #               define S_ISSOCK(m) (0)
 641 #           endif
 642 #       endif
 643 #   endif
 644 #endif
 645
 646 #ifndef S_IRUSR
 647 #   ifdef S_IREAD
 648 #       define S_IRUSR S_IREAD
 649 #       define S_IWUSR S_IWRITE
 650 #       define S_IXUSR S_IEXEC
 651 #   else
 652 #       define S_IRUSR 0400
 653 #       define S_IWUSR 0200
 654 #       define S_IXUSR 0100
 655 #   endif
 656 #   define S_IRGRP (S_IRUSR>>3)
 657 #   define S_IWGRP (S_IWUSR>>3)
 658 #   define S_IXGRP (S_IXUSR>>3)
 659 #   define S_IROTH (S_IRUSR>>6)
 660 #   define S_IWOTH (S_IWUSR>>6)
 661 #   define S_IXOTH (S_IXUSR>>6)
 662 #endif
 663
 664 #ifndef S_ISUID
 665 #   define S_ISUID 04000
 666 #endif
 667
 668 #ifndef S_ISGID
 669 #   define S_ISGID 02000
 670 #endif
 671
 672 #ifdef ff_next
 673 #   undef ff_next
 674 #endif
 675
 676 #if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
 677 #   define SLOPPYDIVIDE
 678 #endif
 679
 680 #ifdef UV
 681 #undef UV
 682 #endif
 683
 684 /*  XXX QUAD stuff is not currently supported on most systems.
 685     Specifically, perl internals don't support long long.  Among
 686     the many problems is that some compilers support long long,
 687     but the underlying library functions (such as sprintf) don't.
 688     Some things do work (such as quad pack/unpack on convex);
 689     also some systems use long long for the fpos_t typedef.  That
 690     seems to work too.
 691
 692     The IV type is supposed to be long enough to hold any integral
 693     value or a pointer.
 694     --Andy Dougherty    August 1996
 695 */
 696
 697 #ifdef cray
 698 #   define Quad_t int
 699 #else
 700 #   ifdef convex
 701 #       define Quad_t long long
 702 #   else
 703 #       if BYTEORDER > 0xFFFF
 704 #           define Quad_t long
 705 #       endif
 706 #   endif
 707 #endif
 708
 709 #ifdef Quad_t
 710 #   define HAS_QUAD
 711     typedef Quad_t IV;
 712     typedef unsigned Quad_t UV;
 713 #   define IV_MAX PERL_QUAD_MAX
 714 #   define IV_MIN PERL_QUAD_MIN
 715 #   define UV_MAX PERL_UQUAD_MAX
 716 #   define UV_MIN PERL_UQUAD_MIN
 717 #else
 718     typedef long IV;
 719     typedef unsigned long UV;
 720 #   define IV_MAX PERL_LONG_MAX
 721 #   define IV_MIN PERL_LONG_MIN
 722 #   define UV_MAX PERL_ULONG_MAX
 723 #   define UV_MIN PERL_ULONG_MIN
 724 #endif
 725
 726 /* Previously these definitions used hardcoded figures.
 727  * It is hoped these formula are more portable, although
 728  * no data one way or another is presently known to me.
 729  * The "PERL_" names are used because these calculated constants
 730  * do not meet the ANSI requirements for LONG_MAX, etc., which
 731  * need to be constants acceptable to #if - kja
 732  *    define PERL_LONG_MAX        2147483647L
 733  *    define PERL_LONG_MIN        (-LONG_MAX - 1)
 734  *    define PERL ULONG_MAX       4294967295L
 735  */
 736
 737 #ifdef I_LIMITS  /* Needed for cast_xxx() functions below. */
 738 #  include <limits.h>
 739 #else
 740 #ifdef I_VALUES
 741 #  include <values.h>
 742 #endif
 743 #endif
 744
 745 /*
 746  * Try to figure out max and min values for the integral types.  THE CORRECT
 747  * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE.  The
 748  * following hacks are used if neither limits.h or values.h provide them:
 749  * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0
 750  *              for types <  int:  (unsigned TYPE)~(unsigned)0
 751  *      The argument to ~ must be unsigned so that later signed->unsigned
 752  *      conversion can't modify the value's bit pattern (e.g. -0 -> +0),
 753  *      and it must not be smaller than int because ~ does integral promotion.
 754  * <type>_MAX: (<type>) (U<type>_MAX >> 1)
 755  * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>.
 756  *      The latter is a hack which happens to work on some machines but
 757  *      does *not* catch any random system, or things like integer types
 758  *      with NaN if that is possible.
 759  *
 760  * All of the types are explicitly cast to prevent accidental loss of
 761  * numeric range, and in the hope that they will be less likely to confuse
 762  * over-eager optimizers.
 763  *
 764  */
 765
 766 #define PERL_UCHAR_MIN ((unsigned char)0)
 767
 768 #ifdef UCHAR_MAX
 769 #  define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
 770 #else
 771 #  ifdef MAXUCHAR
 772 #    define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
 773 #  else
 774 #    define PERL_UCHAR_MAX       ((unsigned char)~(unsigned)0)
 775 #  endif
 776 #endif
 777
 778 /*
 779  * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be
 780  * ambiguous. It may be equivalent to (signed char) or (unsigned char)
 781  * depending on local options. Until Configure detects this (or at least
 782  * detects whether the "signed" keyword is available) the CHAR ranges
 783  * will not be included. UCHAR functions normally.
 784  *                                                           - kja
 785  */
 786
 787 #define PERL_USHORT_MIN ((unsigned short)0)
 788
 789 #ifdef USHORT_MAX
 790 #  define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
 791 #else
 792 #  ifdef MAXUSHORT
 793 #    define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
 794 #  else
 795 #    define PERL_USHORT_MAX       ((unsigned short)~(unsigned)0)
 796 #  endif
 797 #endif
 798
 799 #ifdef SHORT_MAX
 800 #  define PERL_SHORT_MAX ((short)SHORT_MAX)
 801 #else
 802 #  ifdef MAXSHORT    /* Often used in <values.h> */
 803 #    define PERL_SHORT_MAX ((short)MAXSHORT)
 804 #  else
 805 #    define PERL_SHORT_MAX      ((short) (PERL_USHORT_MAX >> 1))
 806 #  endif
 807 #endif
 808
 809 #ifdef SHORT_MIN
 810 #  define PERL_SHORT_MIN ((short)SHORT_MIN)
 811 #else
 812 #  ifdef MINSHORT
 813 #    define PERL_SHORT_MIN ((short)MINSHORT)
 814 #  else
 815 #    define PERL_SHORT_MIN        (-PERL_SHORT_MAX - ((3 & -1) == 3))
 816 #  endif
 817 #endif
 818
 819 #ifdef UINT_MAX
 820 #  define PERL_UINT_MAX ((unsigned int)UINT_MAX)
 821 #else
 822 #  ifdef MAXUINT
 823 #    define PERL_UINT_MAX ((unsigned int)MAXUINT)
 824 #  else
 825 #    define PERL_UINT_MAX       (~(unsigned int)0)
 826 #  endif
 827 #endif
 828
 829 #define PERL_UINT_MIN ((unsigned int)0)
 830
 831 #ifdef INT_MAX
 832 #  define PERL_INT_MAX ((int)INT_MAX)
 833 #else
 834 #  ifdef MAXINT    /* Often used in <values.h> */
 835 #    define PERL_INT_MAX ((int)MAXINT)
 836 #  else
 837 #    define PERL_INT_MAX        ((int)(PERL_UINT_MAX >> 1))
 838 #  endif
 839 #endif
 840
 841 #ifdef INT_MIN
 842 #  define PERL_INT_MIN ((int)INT_MIN)
 843 #else
 844 #  ifdef MININT
 845 #    define PERL_INT_MIN ((int)MININT)
 846 #  else
 847 #    define PERL_INT_MIN        (-PERL_INT_MAX - ((3 & -1) == 3))
 848 #  endif
 849 #endif
 850
 851 #ifdef ULONG_MAX
 852 #  define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
 853 #else
 854 #  ifdef MAXULONG
 855 #    define PERL_ULONG_MAX ((unsigned long)MAXULONG)
 856 #  else
 857 #    define PERL_ULONG_MAX       (~(unsigned long)0)
 858 #  endif
 859 #endif
 860
 861 #define PERL_ULONG_MIN ((unsigned long)0L)
 862
 863 #ifdef LONG_MAX
 864 #  define PERL_LONG_MAX ((long)LONG_MAX)
 865 #else
 866 #  ifdef MAXLONG    /* Often used in <values.h> */
 867 #    define PERL_LONG_MAX ((long)MAXLONG)
 868 #  else
 869 #    define PERL_LONG_MAX        ((long) (PERL_ULONG_MAX >> 1))
 870 #  endif
 871 #endif
 872
 873 #ifdef LONG_MIN
 874 #  define PERL_LONG_MIN ((long)LONG_MIN)
 875 #else
 876 #  ifdef MINLONG
 877 #    define PERL_LONG_MIN ((long)MINLONG)
 878 #  else
 879 #    define PERL_LONG_MIN        (-PERL_LONG_MAX - ((3 & -1) == 3))
 880 #  endif
 881 #endif
 882
 883 #ifdef HAS_QUAD
 884
 885 #  ifdef UQUAD_MAX
 886 #    define PERL_UQUAD_MAX ((UV)UQUAD_MAX)
 887 #  else
 888 #    define PERL_UQUAD_MAX      (~(UV)0)
 889 #  endif
 890
 891 #  define PERL_UQUAD_MIN ((UV)0)
 892
 893 #  ifdef QUAD_MAX
 894 #    define PERL_QUAD_MAX ((IV)QUAD_MAX)
 895 #  else
 896 #    define PERL_QUAD_MAX       ((IV) (PERL_UQUAD_MAX >> 1))
 897 #  endif
 898
 899 #  ifdef QUAD_MIN
 900 #    define PERL_QUAD_MIN ((IV)QUAD_MIN)
 901 #  else
 902 #    define PERL_QUAD_MIN       (-PERL_QUAD_MAX - ((3 & -1) == 3))
 903 #  endif
 904
 905 #endif
 906
 907 typedef MEM_SIZE STRLEN;
 908
 909 typedef struct op OP;
 910 typedef struct cop COP;
 911 typedef struct unop UNOP;
 912 typedef struct binop BINOP;
 913 typedef struct listop LISTOP;
 914 typedef struct logop LOGOP;
 915 typedef struct condop CONDOP;
 916 typedef struct pmop PMOP;
 917 typedef struct svop SVOP;
 918 typedef struct gvop GVOP;
 919 typedef struct pvop PVOP;
 920 typedef struct loop LOOP;
 921
 922 typedef struct Outrec Outrec;
 923 typedef struct interpreter PerlInterpreter;
 924 #ifndef __BORLANDC__
 925 typedef struct ff FF;           /* XXX not defined anywhere, should go? */
 926 #endif
 927 typedef struct sv SV;
 928 typedef struct av AV;
 929 typedef struct hv HV;
 930 typedef struct cv CV;
 931 typedef struct regexp REGEXP;
 932 typedef struct gp GP;
 933 typedef struct gv GV;
 934 typedef struct io IO;
 935 typedef struct context PERL_CONTEXT;
 936 typedef struct block BLOCK;
 937
 938 typedef struct magic MAGIC;
 939 typedef struct xrv XRV;
 940 typedef struct xpv XPV;
 941 typedef struct xpviv XPVIV;
 942 typedef struct xpvuv XPVUV;
 943 typedef struct xpvnv XPVNV;
 944 typedef struct xpvmg XPVMG;
 945 typedef struct xpvlv XPVLV;
 946 typedef struct xpvav XPVAV;
 947 typedef struct xpvhv XPVHV;
 948 typedef struct xpvgv XPVGV;
 949 typedef struct xpvcv XPVCV;
 950 typedef struct xpvbm XPVBM;
 951 typedef struct xpvfm XPVFM;
 952 typedef struct xpvio XPVIO;
 953 typedef struct mgvtbl MGVTBL;
 954 typedef union any ANY;
 955
 956 #include "handy.h"
 957
 958 typedef I32 (*filter_t) _((int, SV *, int));
 959 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
 960 #define FILTER_DATA(idx)           (AvARRAY(rsfp_filters)[idx])
 961 #define FILTER_ISREADER(idx)       (idx >= AvFILLp(rsfp_filters))
 962
 963 #ifdef DOSISH
 964 # if defined(OS2)
 965 #   include "os2ish.h"
 966 # else
 967 #   include "dosish.h"
 968 # endif
 969 #else
 970 # if defined(VMS)
 971 #   include "vmsish.h"
 972 # else
 973 #   if defined(PLAN9)
 974 #     include "./plan9/plan9ish.h"
 975 #   else
 976 #     include "unixish.h"
 977 #   endif
 978 # endif
 979 #endif
 980
 981 /*
 982  * USE_THREADS needs to be after unixish.h as <pthread.h> includes
 983  * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
 984  * this results in many functions being undeclared which bothers C++
 985  * May make sense to have threads after "*ish.h" anyway
 986  */
 987
 988 #ifdef USE_THREADS
 989 #  ifdef FAKE_THREADS
 990 #    include "fakethr.h"
 991 #  else
 992 #    ifdef WIN32
 993 #      include <win32thread.h>
 994 #    else
 995 #      ifdef OS2
 996 #        include "os2thread.h"
 997 #      else
 998 #        include <pthread.h>
 999 typedef pthread_t perl_os_thread;
1000 typedef pthread_mutex_t perl_mutex;
1001 typedef pthread_cond_t perl_cond;
1002 typedef pthread_key_t perl_key;
1003 #      endif /* OS2 */
1004 #    endif /* WIN32 */
1005 #  endif /* FAKE_THREADS */
1006 #endif /* USE_THREADS */
1007
1008
1009
1010 #ifdef VMS
1011 #   define STATUS_NATIVE        statusvalue_vms
1012 #   define STATUS_NATIVE_EXPORT \
1013         ((I32)statusvalue_vms == -1 ? 44 : statusvalue_vms)
1014 #   define STATUS_NATIVE_SET(n)                                         \
1015         STMT_START {                                                    \
1016             statusvalue_vms = (n);                                      \
1017             if ((I32)statusvalue_vms == -1)                             \
1018                 statusvalue = -1;                                       \
1019             else if (statusvalue_vms & STS$M_SUCCESS)                   \
1020                 statusvalue = 0;                                        \
1021             else if ((statusvalue_vms & STS$M_SEVERITY) == 0)           \
1022                 statusvalue = 1 << 8;                                   \
1023             else                                                        \
1024                 statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8;  \
1025         } STMT_END
1026 #   define STATUS_POSIX statusvalue
1027 #   ifdef VMSISH_STATUS
1028 #       define STATUS_CURRENT   (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX)
1029 #   else
1030 #       define STATUS_CURRENT   STATUS_POSIX
1031 #   endif
1032 #   define STATUS_POSIX_SET(n)                          \
1033         STMT_START {                                    \
1034             statusvalue = (n);                          \
1035             if (statusvalue != -1) {                    \
1036                 statusvalue &= 0xFFFF;                  \
1037                 statusvalue_vms = statusvalue ? 44 : 1; \
1038             }                                           \
1039             else statusvalue_vms = -1;                  \
1040         } STMT_END
1041 #   define STATUS_ALL_SUCCESS   (statusvalue = 0, statusvalue_vms = 1)
1042 #   define STATUS_ALL_FAILURE   (statusvalue = 1, statusvalue_vms = 44)
1043 #else
1044 #   define STATUS_NATIVE        STATUS_POSIX
1045 #   define STATUS_NATIVE_EXPORT STATUS_POSIX
1046 #   define STATUS_NATIVE_SET    STATUS_POSIX_SET
1047 #   define STATUS_POSIX         statusvalue
1048 #   define STATUS_POSIX_SET(n)          \
1049         STMT_START {                    \
1050             statusvalue = (n);          \
1051             if (statusvalue != -1)      \
1052                 statusvalue &= 0xFFFF;  \
1053         } STMT_END
1054 #   define STATUS_CURRENT STATUS_POSIX
1055 #   define STATUS_ALL_SUCCESS   (statusvalue = 0)
1056 #   define STATUS_ALL_FAILURE   (statusvalue = 1)
1057 #endif
1058
1059 /* Some unistd.h's give a prototype for pause() even though
1060    HAS_PAUSE ends up undefined.  This causes the #define
1061    below to be rejected by the compmiler.  Sigh.
1062 */
1063 #ifdef HAS_PAUSE
1064 #define Pause   pause
1065 #else
1066 #define Pause() sleep((32767<<16)+32767)
1067 #endif
1068
1069 #ifndef IOCPARM_LEN
1070 #   ifdef IOCPARM_MASK
1071         /* on BSDish systes we're safe */
1072 #       define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
1073 #   else
1074         /* otherwise guess at what's safe */
1075 #       define IOCPARM_LEN(x)   256
1076 #   endif
1077 #endif
1078
1079 union any {
1080     void*       any_ptr;
1081     I32         any_i32;
1082     IV          any_iv;
1083     long        any_long;
1084     void        (*any_dptr) _((void*));
1085 };
1086
1087 #ifdef USE_THREADS
1088 #define ARGSproto struct perl_thread *thr
1089 #else
1090 #define ARGSproto void
1091 #endif /* USE_THREADS */
1092
1093 /* Work around some cygwin32 problems with importing global symbols */
1094 #if defined(CYGWIN32) && defined(DLLIMPORT)
1095 #   include "cw32imp.h"
1096 #endif
1097
1098 #include "regexp.h"
1099 #include "sv.h"
1100 #include "util.h"
1101 #include "form.h"
1102 #include "gv.h"
1103 #include "cv.h"
1104 #include "opcode.h"
1105 #include "op.h"
1106 #include "cop.h"
1107 #include "av.h"
1108 #include "hv.h"
1109 #include "mg.h"
1110 #include "scope.h"
1111
1112 /* work around some libPW problems */
1113 #ifdef DOINIT
1114 EXT char Error[1];
1115 #endif
1116
1117 #if defined(iAPX286) || defined(M_I286) || defined(I80286)
1118 #   define I286
1119 #endif
1120
1121 #if defined(htonl) && !defined(HAS_HTONL)
1122 #define HAS_HTONL
1123 #endif
1124 #if defined(htons) && !defined(HAS_HTONS)
1125 #define HAS_HTONS
1126 #endif
1127 #if defined(ntohl) && !defined(HAS_NTOHL)
1128 #define HAS_NTOHL
1129 #endif
1130 #if defined(ntohs) && !defined(HAS_NTOHS)
1131 #define HAS_NTOHS
1132 #endif
1133 #ifndef HAS_HTONL
1134 #if (BYTEORDER & 0xffff) != 0x4321
1135 #define HAS_HTONS
1136 #define HAS_HTONL
1137 #define HAS_NTOHS
1138 #define HAS_NTOHL
1139 #define MYSWAP
1140 #define htons my_swap
1141 #define htonl my_htonl
1142 #define ntohs my_swap
1143 #define ntohl my_ntohl
1144 #endif
1145 #else
1146 #if (BYTEORDER & 0xffff) == 0x4321
1147 #undef HAS_HTONS
1148 #undef HAS_HTONL
1149 #undef HAS_NTOHS
1150 #undef HAS_NTOHL
1151 #endif
1152 #endif
1153
1154 /*
1155  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
1156  * -DWS
1157  */
1158 #if BYTEORDER != 0x1234
1159 # define HAS_VTOHL
1160 # define HAS_VTOHS
1161 # define HAS_HTOVL
1162 # define HAS_HTOVS
1163 # if BYTEORDER == 0x4321
1164 #  define vtohl(x)      ((((x)&0xFF)<<24)       \
1165                         +(((x)>>24)&0xFF)       \
1166                         +(((x)&0x0000FF00)<<8)  \
1167                         +(((x)&0x00FF0000)>>8)  )
1168 #  define vtohs(x)      ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
1169 #  define htovl(x)      vtohl(x)
1170 #  define htovs(x)      vtohs(x)
1171 # endif
1172         /* otherwise default to functions in util.c */
1173 #endif
1174
1175 #ifdef CASTNEGFLOAT
1176 #define U_S(what) ((U16)(what))
1177 #define U_I(what) ((unsigned int)(what))
1178 #define U_L(what) ((U32)(what))
1179 #else
1180 EXTERN_C U32 cast_ulong _((double));
1181 #define U_S(what) ((U16)cast_ulong((double)(what)))
1182 #define U_I(what) ((unsigned int)cast_ulong((double)(what)))
1183 #define U_L(what) (cast_ulong((double)(what)))
1184 #endif
1185
1186 #ifdef CASTI32
1187 #define I_32(what) ((I32)(what))
1188 #define I_V(what) ((IV)(what))
1189 #define U_V(what) ((UV)(what))
1190 #else
1191 START_EXTERN_C
1192 I32 cast_i32 _((double));
1193 IV cast_iv _((double));
1194 UV cast_uv _((double));
1195 END_EXTERN_C
1196 #define I_32(what) (cast_i32((double)(what)))
1197 #define I_V(what) (cast_iv((double)(what)))
1198 #define U_V(what) (cast_uv((double)(what)))
1199 #endif
1200
1201 struct Outrec {
1202     I32         o_lines;
1203     char        *o_str;
1204     U32         o_len;
1205 };
1206
1207 #ifndef MAXSYSFD
1208 #   define MAXSYSFD 2
1209 #endif
1210
1211 #ifndef TMPPATH
1212 #  define TMPPATH "/tmp/perl-eXXXXXX"
1213 #endif
1214
1215 #ifndef __cplusplus
1216 Uid_t getuid _((void));
1217 Uid_t geteuid _((void));
1218 Gid_t getgid _((void));
1219 Gid_t getegid _((void));
1220 #endif
1221
1222 #ifdef DEBUGGING
1223 #ifndef Perl_debug_log
1224 #define Perl_debug_log  PerlIO_stderr()
1225 #endif
1226 #define YYDEBUG 1
1227 #define DEB(a)                          a
1228 #define DEBUG(a)   if (debug)           a
1229 #define DEBUG_p(a) if (debug & 1)       a
1230 #define DEBUG_s(a) if (debug & 2)       a
1231 #define DEBUG_l(a) if (debug & 4)       a
1232 #define DEBUG_t(a) if (debug & 8)       a
1233 #define DEBUG_o(a) if (debug & 16)      a
1234 #define DEBUG_c(a) if (debug & 32)      a
1235 #define DEBUG_P(a) if (debug & 64)      a
1236 #define DEBUG_m(a) if (curinterp && debug & 128)        a
1237 #define DEBUG_f(a) if (debug & 256)     a
1238 #define DEBUG_r(a) if (debug & 512)     a
1239 #define DEBUG_x(a) if (debug & 1024)    a
1240 #define DEBUG_u(a) if (debug & 2048)    a
1241 #define DEBUG_L(a) if (debug & 4096)    a
1242 #define DEBUG_H(a) if (debug & 8192)    a
1243 #define DEBUG_X(a) if (debug & 16384)   a
1244 #define DEBUG_D(a) if (debug & 32768)   a
1245 #else
1246 #define DEB(a)
1247 #define DEBUG(a)
1248 #define DEBUG_p(a)
1249 #define DEBUG_s(a)
1250 #define DEBUG_l(a)
1251 #define DEBUG_t(a)
1252 #define DEBUG_o(a)
1253 #define DEBUG_c(a)
1254 #define DEBUG_P(a)
1255 #define DEBUG_m(a)
1256 #define DEBUG_f(a)
1257 #define DEBUG_r(a)
1258 #define DEBUG_x(a)
1259 #define DEBUG_u(a)
1260 #define DEBUG_L(a)
1261 #define DEBUG_H(a)
1262 #define DEBUG_X(a)
1263 #define DEBUG_D(a)
1264 #endif
1265 #define YYMAXDEPTH 300
1266
1267 #ifndef assert  /* <assert.h> might have been included somehow */
1268 #define assert(what)    DEB( {                                          \
1269         if (!(what)) {                                                  \
1270             croak("Assertion failed: file \"%s\", line %d",             \
1271                 __FILE__, __LINE__);                                    \
1272             PerlProc_exit(1);                                                   \
1273         }})
1274 #endif
1275
1276 struct ufuncs {
1277     I32 (*uf_val)_((IV, SV*));
1278     I32 (*uf_set)_((IV, SV*));
1279     IV uf_index;
1280 };
1281
1282 /* Fix these up for __STDC__ */
1283 #ifndef DONT_DECLARE_STD
1284 char *mktemp _((char*));
1285 double atof _((const char*));
1286 #endif
1287
1288 #ifndef STANDARD_C
1289 /* All of these are in stdlib.h or time.h for ANSI C */
1290 Time_t time();
1291 struct tm *gmtime(), *localtime();
1292 char *strchr(), *strrchr();
1293 char *strcpy(), *strcat();
1294 #endif /* ! STANDARD_C */
1295
1296
1297 #ifdef I_MATH
1298 #    include <math.h>
1299 #else
1300 START_EXTERN_C
1301             double exp _((double));
1302             double log _((double));
1303             double log10 _((double));
1304             double sqrt _((double));
1305             double frexp _((double,int*));
1306             double ldexp _((double,int));
1307             double modf _((double,double*));
1308             double sin _((double));
1309             double cos _((double));
1310             double atan2 _((double,double));
1311             double pow _((double,double));
1312 END_EXTERN_C
1313 #endif
1314
1315 #ifndef __cplusplus
1316 #  ifdef __NeXT__ /* or whatever catches all NeXTs */
1317 char *crypt ();       /* Maybe more hosts will need the unprototyped version */
1318 #  else
1319 #    if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
1320 char *crypt _((const char*, const char*));
1321 #    endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
1322 #  endif /* !__NeXT__ */
1323 #  ifndef DONT_DECLARE_STD
1324 #    ifndef getenv
1325 char *getenv _((const char*));
1326 #    endif /* !getenv */
1327 Off_t lseek _((int,Off_t,int));
1328 #  endif /* !DONT_DECLARE_STD */
1329 char *getlogin _((void));
1330 #endif /* !__cplusplus */
1331
1332 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
1333 #define UNLINK unlnk
1334 I32 unlnk _((char*));
1335 #else
1336 #define UNLINK unlink
1337 #endif
1338
1339 #ifndef HAS_SETREUID
1340 #  ifdef HAS_SETRESUID
1341 #    define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
1342 #    define HAS_SETREUID
1343 #  endif
1344 #endif
1345 #ifndef HAS_SETREGID
1346 #  ifdef HAS_SETRESGID
1347 #    define setregid(r,e) setresgid(r,e,(Gid_t)-1)
1348 #    define HAS_SETREGID
1349 #  endif
1350 #endif
1351
1352 typedef Signal_t (*Sighandler_t) _((int));
1353
1354 #ifdef HAS_SIGACTION
1355 typedef struct sigaction Sigsave_t;
1356 #else
1357 typedef Sighandler_t Sigsave_t;
1358 #endif
1359
1360 #define SCAN_DEF 0
1361 #define SCAN_TR 1
1362 #define SCAN_REPL 2
1363
1364 #ifdef DEBUGGING
1365 # ifndef register
1366 #  define register
1367 # endif
1368 # define PAD_SV(po) pad_sv(po)
1369 # define RUNOPS_DEFAULT runops_debug
1370 #else
1371 # define PAD_SV(po) curpad[po]
1372 # define RUNOPS_DEFAULT runops_standard
1373 #endif
1374
1375 #ifdef MYMALLOC
1376 #  define MALLOC_INIT MUTEX_INIT(&malloc_mutex)
1377 #  define MALLOC_TERM MUTEX_DESTROY(&malloc_mutex)
1378 #else
1379 #  define MALLOC_INIT
1380 #  define MALLOC_TERM
1381 #endif
1382
1383
1384 /*
1385  * These need prototyping here because <proto.h> isn't
1386  * included until after runops is initialised.
1387  */
1388
1389 typedef int runops_proc_t _((void));
1390 int runops_standard _((void));
1391 #ifdef DEBUGGING
1392 int runops_debug _((void));
1393 #endif
1394
1395 /* _ (for $_) must be first in the following list (DEFSV requires it) */
1396 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
1397
1398 /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
1399 #if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
1400 #if !defined(DONT_DECLARE_STD) \
1401         || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) \
1402         || defined(__sgi) || defined(__DGUX)
1403 extern char **  environ;        /* environment variables supplied via exec */
1404 #endif
1405 #else
1406 #  if defined(NeXT) && defined(__DYNAMIC__)
1407
1408 #  include <mach-o/dyld.h>
1409 EXT char *** environ_pointer;
1410 #  define environ (*environ_pointer)
1411 #  endif
1412 #endif /* environ processing */
1413
1414
1415 /* for tmp use in stupid debuggers */
1416 EXT int *       di;
1417 EXT short *     ds;
1418 EXT char *      dc;
1419
1420 /* handy constants */
1421 EXTCONST char warn_uninit[]
1422   INIT("Use of uninitialized value");
1423 EXTCONST char warn_nosemi[]
1424   INIT("Semicolon seems to be missing");
1425 EXTCONST char warn_reserved[]
1426   INIT("Unquoted string \"%s\" may clash with future reserved word");
1427 EXTCONST char warn_nl[]
1428   INIT("Unsuccessful %s on filename containing newline");
1429 EXTCONST char no_wrongref[]
1430   INIT("Can't use %s ref as %s ref");
1431 EXTCONST char no_symref[]
1432   INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
1433 EXTCONST char no_usym[]
1434   INIT("Can't use an undefined value as %s reference");
1435 EXTCONST char no_aelem[]
1436   INIT("Modification of non-creatable array value attempted, subscript %d");
1437 EXTCONST char no_helem[]
1438   INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
1439 EXTCONST char no_modify[]
1440   INIT("Modification of a read-only value attempted");
1441 EXTCONST char no_mem[]
1442   INIT("Out of memory!\n");
1443 EXTCONST char no_security[]
1444   INIT("Insecure dependency in %s%s");
1445 EXTCONST char no_sock_func[]
1446   INIT("Unsupported socket function \"%s\" called");
1447 EXTCONST char no_dir_func[]
1448   INIT("Unsupported directory function \"%s\" called");
1449 EXTCONST char no_func[]
1450   INIT("The %s function is unimplemented");
1451 EXTCONST char no_myglob[]
1452   INIT("\"my\" variable %s can't be in a package");
1453
1454 #ifdef DOINIT
1455 EXT char *sig_name[] = { SIG_NAME };
1456 EXT int   sig_num[]  = { SIG_NUM };
1457 EXT SV  * psig_ptr[sizeof(sig_num)/sizeof(*sig_num)];
1458 EXT SV  * psig_name[sizeof(sig_num)/sizeof(*sig_num)];
1459 #else
1460 EXT char *sig_name[];
1461 EXT int   sig_num[];
1462 EXT SV  * psig_ptr[];
1463 EXT SV  * psig_name[];
1464 #endif
1465
1466 /* fast case folding tables */
1467
1468 #ifdef DOINIT
1469 EXTCONST  unsigned char fold[] = {
1470         0,      1,      2,      3,      4,      5,      6,      7,
1471         8,      9,      10,     11,     12,     13,     14,     15,
1472         16,     17,     18,     19,     20,     21,     22,     23,
1473         24,     25,     26,     27,     28,     29,     30,     31,
1474         32,     33,     34,     35,     36,     37,     38,     39,
1475         40,     41,     42,     43,     44,     45,     46,     47,
1476         48,     49,     50,     51,     52,     53,     54,     55,
1477         56,     57,     58,     59,     60,     61,     62,     63,
1478         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
1479         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
1480         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
1481         'x',    'y',    'z',    91,     92,     93,     94,     95,
1482         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
1483         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
1484         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
1485         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
1486         128,    129,    130,    131,    132,    133,    134,    135,
1487         136,    137,    138,    139,    140,    141,    142,    143,
1488         144,    145,    146,    147,    148,    149,    150,    151,
1489         152,    153,    154,    155,    156,    157,    158,    159,
1490         160,    161,    162,    163,    164,    165,    166,    167,
1491         168,    169,    170,    171,    172,    173,    174,    175,
1492         176,    177,    178,    179,    180,    181,    182,    183,
1493         184,    185,    186,    187,    188,    189,    190,    191,
1494         192,    193,    194,    195,    196,    197,    198,    199,
1495         200,    201,    202,    203,    204,    205,    206,    207,
1496         208,    209,    210,    211,    212,    213,    214,    215,
1497         216,    217,    218,    219,    220,    221,    222,    223,
1498         224,    225,    226,    227,    228,    229,    230,    231,
1499         232,    233,    234,    235,    236,    237,    238,    239,
1500         240,    241,    242,    243,    244,    245,    246,    247,
1501         248,    249,    250,    251,    252,    253,    254,    255
1502 };
1503 #else
1504 EXTCONST unsigned char fold[];
1505 #endif
1506
1507 #ifdef DOINIT
1508 EXT unsigned char fold_locale[] = {
1509         0,      1,      2,      3,      4,      5,      6,      7,
1510         8,      9,      10,     11,     12,     13,     14,     15,
1511         16,     17,     18,     19,     20,     21,     22,     23,
1512         24,     25,     26,     27,     28,     29,     30,     31,
1513         32,     33,     34,     35,     36,     37,     38,     39,
1514         40,     41,     42,     43,     44,     45,     46,     47,
1515         48,     49,     50,     51,     52,     53,     54,     55,
1516         56,     57,     58,     59,     60,     61,     62,     63,
1517         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
1518         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
1519         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
1520         'x',    'y',    'z',    91,     92,     93,     94,     95,
1521         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
1522         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
1523         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
1524         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
1525         128,    129,    130,    131,    132,    133,    134,    135,
1526         136,    137,    138,    139,    140,    141,    142,    143,
1527         144,    145,    146,    147,    148,    149,    150,    151,
1528         152,    153,    154,    155,    156,    157,    158,    159,
1529         160,    161,    162,    163,    164,    165,    166,    167,
1530         168,    169,    170,    171,    172,    173,    174,    175,
1531         176,    177,    178,    179,    180,    181,    182,    183,
1532         184,    185,    186,    187,    188,    189,    190,    191,
1533         192,    193,    194,    195,    196,    197,    198,    199,
1534         200,    201,    202,    203,    204,    205,    206,    207,
1535         208,    209,    210,    211,    212,    213,    214,    215,
1536         216,    217,    218,    219,    220,    221,    222,    223,
1537         224,    225,    226,    227,    228,    229,    230,    231,
1538         232,    233,    234,    235,    236,    237,    238,    239,
1539         240,    241,    242,    243,    244,    245,    246,    247,
1540         248,    249,    250,    251,    252,    253,    254,    255
1541 };
1542 #else
1543 EXT unsigned char fold_locale[];
1544 #endif
1545
1546 #ifdef DOINIT
1547 EXTCONST unsigned char freq[] = {       /* letter frequencies for mixed English/C */
1548         1,      2,      84,     151,    154,    155,    156,    157,
1549         165,    246,    250,    3,      158,    7,      18,     29,
1550         40,     51,     62,     73,     85,     96,     107,    118,
1551         129,    140,    147,    148,    149,    150,    152,    153,
1552         255,    182,    224,    205,    174,    176,    180,    217,
1553         233,    232,    236,    187,    235,    228,    234,    226,
1554         222,    219,    211,    195,    188,    193,    185,    184,
1555         191,    183,    201,    229,    181,    220,    194,    162,
1556         163,    208,    186,    202,    200,    218,    198,    179,
1557         178,    214,    166,    170,    207,    199,    209,    206,
1558         204,    160,    212,    216,    215,    192,    175,    173,
1559         243,    172,    161,    190,    203,    189,    164,    230,
1560         167,    248,    227,    244,    242,    255,    241,    231,
1561         240,    253,    169,    210,    245,    237,    249,    247,
1562         239,    168,    252,    251,    254,    238,    223,    221,
1563         213,    225,    177,    197,    171,    196,    159,    4,
1564         5,      6,      8,      9,      10,     11,     12,     13,
1565         14,     15,     16,     17,     19,     20,     21,     22,
1566         23,     24,     25,     26,     27,     28,     30,     31,
1567         32,     33,     34,     35,     36,     37,     38,     39,
1568         41,     42,     43,     44,     45,     46,     47,     48,
1569         49,     50,     52,     53,     54,     55,     56,     57,
1570         58,     59,     60,     61,     63,     64,     65,     66,
1571         67,     68,     69,     70,     71,     72,     74,     75,
1572         76,     77,     78,     79,     80,     81,     82,     83,
1573         86,     87,     88,     89,     90,     91,     92,     93,
1574         94,     95,     97,     98,     99,     100,    101,    102,
1575         103,    104,    105,    106,    108,    109,    110,    111,
1576         112,    113,    114,    115,    116,    117,    119,    120,
1577         121,    122,    123,    124,    125,    126,    127,    128,
1578         130,    131,    132,    133,    134,    135,    136,    137,
1579         138,    139,    141,    142,    143,    144,    145,    146
1580 };
1581 #else
1582 EXTCONST unsigned char freq[];
1583 #endif
1584
1585 #ifdef DEBUGGING
1586 #ifdef DOINIT
1587 EXTCONST char* block_type[] = {
1588         "NULL",
1589         "SUB",
1590         "EVAL",
1591         "LOOP",
1592         "SUBST",
1593         "BLOCK",
1594 };
1595 #else
1596 EXTCONST char* block_type[];
1597 #endif
1598 #endif
1599
1600 /*****************************************************************************/
1601 /* This lexer/parser stuff is currently global since yacc is hard to reenter */
1602 /*****************************************************************************/
1603 /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
1604
1605 #include "perly.h"
1606
1607 #define LEX_NOTPARSING          11      /* borrowed from toke.c */
1608
1609 typedef enum {
1610     XOPERATOR,
1611     XTERM,
1612     XREF,
1613     XSTATE,
1614     XBLOCK,
1615     XTERMBLOCK
1616 } expectation;
1617
1618
1619                                 /* Note: the lowest 8 bits are reserved for
1620                                    stuffing into op->op_private */
1621 #define HINT_INTEGER            0x00000001
1622 #define HINT_STRICT_REFS        0x00000002
1623
1624 #define HINT_BLOCK_SCOPE        0x00000100
1625 #define HINT_STRICT_SUBS        0x00000200
1626 #define HINT_STRICT_VARS        0x00000400
1627 #define HINT_LOCALE             0x00000800
1628
1629 /* Various states of an input record separator SV (rs, nrs) */
1630 #define RsSNARF(sv)   (! SvOK(sv))
1631 #define RsSIMPLE(sv)  (SvOK(sv) && SvCUR(sv))
1632 #define RsPARA(sv)    (SvOK(sv) && ! SvCUR(sv))
1633
1634 /* Set up PERLVAR macros for populating structs */
1635 #define PERLVAR(var,type) type var;
1636 #define PERLVARI(var,type,init) type var;
1637 #define PERLVARIC(var,type,init) type var;
1638
1639 #ifdef PERL_GLOBAL_STRUCT
1640 struct perl_vars {
1641 #include "perlvars.h"
1642 };
1643
1644 #ifdef PERL_CORE
1645 EXT struct perl_vars Perl_Vars;
1646 EXT struct perl_vars *Perl_VarsPtr INIT(&Perl_Vars);
1647 #else
1648 #if !defined(__GNUC__) || !defined(WIN32)
1649 EXT
1650 #endif
1651 struct perl_vars *Perl_VarsPtr;
1652 #define Perl_Vars (*((Perl_VarsPtr) ? Perl_VarsPtr : (Perl_VarsPtr =  Perl_GetVars())))
1653 #endif
1654 #endif /* PERL_GLOBAL_STRUCT */
1655
1656 #ifdef MULTIPLICITY
1657 /* If we have multiple interpreters define a struct
1658    holding variables which must be per-interpreter
1659    If we don't have threads anything that would have
1660    be per-thread is per-interpreter.
1661 */
1662
1663 struct interpreter {
1664 #ifndef USE_THREADS
1665 #include "thrdvar.h"
1666 #endif
1667 #include "intrpvar.h"
1668 };
1669
1670 #else
1671 struct interpreter {
1672     char broiled;
1673 };
1674 #endif
1675
1676 #ifdef USE_THREADS
1677 /* If we have threads define a struct with all the variables
1678  * that have to be per-thread
1679  */
1680
1681
1682 struct perl_thread {
1683 #include "thrdvar.h"
1684 };
1685
1686 typedef struct perl_thread *Thread;
1687
1688 #else
1689 typedef void *Thread;
1690 #endif
1691
1692 /* Done with PERLVAR macros for now ... */
1693 #undef PERLVAR
1694 #undef PERLVARI
1695 #undef PERLVARIC
1696
1697 #include "thread.h"
1698 #include "pp.h"
1699 #include "proto.h"
1700
1701 #ifdef EMBED
1702 #define Perl_sv_setptrobj(rv,ptr,name) Perl_sv_setref_iv(rv,name,(IV)ptr)
1703 #define Perl_sv_setptrref(rv,ptr) Perl_sv_setref_iv(rv,Nullch,(IV)ptr)
1704 #else
1705 #define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
1706 #define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
1707 #endif
1708
1709 /* The following must follow proto.h as #defines mess up syntax */
1710
1711 #include "embedvar.h"
1712
1713 /* Now include all the 'global' variables
1714  * If we don't have threads or multiple interpreters
1715  * these include variables that would have been their struct-s
1716  */
1717
1718 #define PERLVAR(var,type) EXT type var;
1719 #define PERLVARI(var,type,init) EXT type var INIT(init);
1720 #define PERLVARIC(var,type,init) EXTCONST type var INIT(init);
1721
1722 #ifndef PERL_GLOBAL_STRUCT
1723 #include "perlvars.h"
1724 #endif
1725
1726 #ifndef MULTIPLICITY
1727
1728 #ifndef USE_THREADS
1729 #include "thrdvar.h"
1730 #endif
1731
1732 #include "intrpvar.h"
1733 #endif
1734
1735
1736 #undef PERLVAR
1737 #undef PERLVARI
1738 #undef PERLVARIC
1739
1740 #if defined(HASATTRIBUTE) && defined(WIN32)
1741 /*
1742  * This provides a layer of functions and macros to ensure extensions will
1743  * get to use the same RTL functions as the core.
1744  * It has to go here or #define of printf messes up __attribute__
1745  * stuff in proto.h
1746  */
1747 #  include <win32iop.h>
1748 #endif  /* WIN32 */
1749
1750 #ifdef DOINIT
1751
1752 EXT MGVTBL vtbl_sv =    {magic_get,
1753                                 magic_set,
1754                                         magic_len,
1755                                                 0,      0};
1756 EXT MGVTBL vtbl_env =   {0,     magic_set_all_env,
1757                                 0,      magic_clear_all_env,
1758                                                         0};
1759 EXT MGVTBL vtbl_envelem =       {0,     magic_setenv,
1760                                         0,      magic_clearenv,
1761                                                         0};
1762 EXT MGVTBL vtbl_sig =   {0,     0,               0, 0, 0};
1763 EXT MGVTBL vtbl_sigelem =       {magic_getsig,
1764                                         magic_setsig,
1765                                         0,      magic_clearsig,
1766                                                         0};
1767 EXT MGVTBL vtbl_pack =  {0,     0,      magic_sizepack, magic_wipepack,
1768                                                         0};
1769 EXT MGVTBL vtbl_packelem =      {magic_getpack,
1770                                 magic_setpack,
1771                                         0,      magic_clearpack,
1772                                                         0};
1773 EXT MGVTBL vtbl_dbline =        {0,     magic_setdbline,
1774                                         0,      0,      0};
1775 EXT MGVTBL vtbl_isa =   {0,     magic_setisa,
1776                                         0,      magic_setisa,
1777                                                         0};
1778 EXT MGVTBL vtbl_isaelem =       {0,     magic_setisa,
1779                                         0,      0,      0};
1780 EXT MGVTBL vtbl_arylen =        {magic_getarylen,
1781                                 magic_setarylen,
1782                                         0,      0,      0};
1783 EXT MGVTBL vtbl_glob =  {magic_getglob,
1784                                 magic_setglob,
1785                                         0,      0,      0};
1786 EXT MGVTBL vtbl_mglob = {0,     magic_setmglob,
1787                                         0,      0,      0};
1788 EXT MGVTBL vtbl_nkeys = {0,     magic_setnkeys,
1789                                         0,      0,      0};
1790 EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint,
1791                                         0,      0,      0};
1792 EXT MGVTBL vtbl_substr =        {0,     magic_setsubstr,
1793                                         0,      0,      0};
1794 EXT MGVTBL vtbl_vec =   {0,     magic_setvec,
1795                                         0,      0,      0};
1796 EXT MGVTBL vtbl_pos =   {magic_getpos,
1797                                 magic_setpos,
1798                                         0,      0,      0};
1799 EXT MGVTBL vtbl_bm =    {0,     magic_setbm,
1800                                         0,      0,      0};
1801 EXT MGVTBL vtbl_fm =    {0,     magic_setfm,
1802                                         0,      0,      0};
1803 EXT MGVTBL vtbl_uvar =  {magic_getuvar,
1804                                 magic_setuvar,
1805                                         0,      0,      0};
1806 #ifdef USE_THREADS
1807 EXT MGVTBL vtbl_mutex = {0,     0,      0,      0,      magic_mutexfree};
1808 #endif /* USE_THREADS */
1809 EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
1810                                         0,      0,      magic_freedefelem};
1811
1812 EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp};
1813
1814 #ifdef USE_LOCALE_COLLATE
1815 EXT MGVTBL vtbl_collxfrm = {0,
1816                                 magic_setcollxfrm,
1817                                         0,      0,      0};
1818 #endif
1819
1820 #ifdef OVERLOAD
1821 EXT MGVTBL vtbl_amagic =       {0,     magic_setamagic,
1822                                         0,      0,      magic_setamagic};
1823 EXT MGVTBL vtbl_amagicelem =   {0,     magic_setamagic,
1824                                         0,      0,      magic_setamagic};
1825 #endif /* OVERLOAD */
1826
1827 #else /* !DOINIT */
1828
1829 EXT MGVTBL vtbl_sv;
1830 EXT MGVTBL vtbl_env;
1831 EXT MGVTBL vtbl_envelem;
1832 EXT MGVTBL vtbl_sig;
1833 EXT MGVTBL vtbl_sigelem;
1834 EXT MGVTBL vtbl_pack;
1835 EXT MGVTBL vtbl_packelem;
1836 EXT MGVTBL vtbl_dbline;
1837 EXT MGVTBL vtbl_isa;
1838 EXT MGVTBL vtbl_isaelem;
1839 EXT MGVTBL vtbl_arylen;
1840 EXT MGVTBL vtbl_glob;
1841 EXT MGVTBL vtbl_mglob;
1842 EXT MGVTBL vtbl_nkeys;
1843 EXT MGVTBL vtbl_taint;
1844 EXT MGVTBL vtbl_substr;
1845 EXT MGVTBL vtbl_vec;
1846 EXT MGVTBL vtbl_pos;
1847 EXT MGVTBL vtbl_bm;
1848 EXT MGVTBL vtbl_fm;
1849 EXT MGVTBL vtbl_uvar;
1850
1851 #ifdef USE_THREADS
1852 EXT MGVTBL vtbl_mutex;
1853 #endif /* USE_THREADS */
1854
1855 EXT MGVTBL vtbl_defelem;
1856 EXT MGVTBL vtbl_regexp;
1857
1858 #ifdef USE_LOCALE_COLLATE
1859 EXT MGVTBL vtbl_collxfrm;
1860 #endif
1861
1862 #ifdef OVERLOAD
1863 EXT MGVTBL vtbl_amagic;
1864 EXT MGVTBL vtbl_amagicelem;
1865 #endif /* OVERLOAD */
1866
1867 #endif /* !DOINIT */
1868
1869 #ifdef OVERLOAD
1870
1871 #define NofAMmeth 58
1872 #ifdef DOINIT
1873 EXTCONST char * AMG_names[NofAMmeth] = {
1874   "fallback",   "abs",                  /* "fallback" should be the first. */
1875   "bool",       "nomethod",
1876   "\"\"",       "0+",
1877   "+",          "+=",
1878   "-",          "-=",
1879   "*",          "*=",
1880   "/",          "/=",
1881   "%",          "%=",
1882   "**",         "**=",
1883   "<<",         "<<=",
1884   ">>",         ">>=",
1885   "&",          "&=",
1886   "|",          "|=",
1887   "^",          "^=",
1888   "<",          "<=",
1889   ">",          ">=",
1890   "==",         "!=",
1891   "<=>",        "cmp",
1892   "lt",         "le",
1893   "gt",         "ge",
1894   "eq",         "ne",
1895   "!",          "~",
1896   "++",         "--",
1897   "atan2",      "cos",
1898   "sin",        "exp",
1899   "log",        "sqrt",
1900   "x",          "x=",
1901   ".",          ".=",
1902   "=",          "neg"
1903 };
1904 #else
1905 EXTCONST char * AMG_names[NofAMmeth];
1906 #endif /* def INITAMAGIC */
1907
1908 struct am_table {
1909   long was_ok_sub;
1910   long was_ok_am;
1911   U32 flags;
1912   CV* table[NofAMmeth];
1913   long fallback;
1914 };
1915 struct am_table_short {
1916   long was_ok_sub;
1917   long was_ok_am;
1918   U32 flags;
1919 };
1920 typedef struct am_table AMT;
1921 typedef struct am_table_short AMTS;
1922
1923 #define AMGfallNEVER    1
1924 #define AMGfallNO       2
1925 #define AMGfallYES      3
1926
1927 #define AMTf_AMAGIC             1
1928 #define AMT_AMAGIC(amt)         ((amt)->flags & AMTf_AMAGIC)
1929 #define AMT_AMAGIC_on(amt)      ((amt)->flags |= AMTf_AMAGIC)
1930 #define AMT_AMAGIC_off(amt)     ((amt)->flags &= ~AMTf_AMAGIC)
1931
1932 enum {
1933   fallback_amg, abs_amg,
1934   bool__amg,    nomethod_amg,
1935   string_amg,   numer_amg,
1936   add_amg,      add_ass_amg,
1937   subtr_amg,    subtr_ass_amg,
1938   mult_amg,     mult_ass_amg,
1939   div_amg,      div_ass_amg,
1940   mod_amg,      mod_ass_amg,
1941   pow_amg,      pow_ass_amg,
1942   lshift_amg,   lshift_ass_amg,
1943   rshift_amg,   rshift_ass_amg,
1944   band_amg,     band_ass_amg,
1945   bor_amg,      bor_ass_amg,
1946   bxor_amg,     bxor_ass_amg,
1947   lt_amg,       le_amg,
1948   gt_amg,       ge_amg,
1949   eq_amg,       ne_amg,
1950   ncmp_amg,     scmp_amg,
1951   slt_amg,      sle_amg,
1952   sgt_amg,      sge_amg,
1953   seq_amg,      sne_amg,
1954   not_amg,      compl_amg,
1955   inc_amg,      dec_amg,
1956   atan2_amg,    cos_amg,
1957   sin_amg,      exp_amg,
1958   log_amg,      sqrt_amg,
1959   repeat_amg,   repeat_ass_amg,
1960   concat_amg,   concat_ass_amg,
1961   copy_amg,     neg_amg
1962 };
1963
1964 /*
1965  * some compilers like to redefine cos et alia as faster
1966  * (and less accurate?) versions called F_cos et cetera (Quidquid
1967  * latine dictum sit, altum viditur.)  This trick collides with
1968  * the Perl overloading (amg).  The following #defines fool both.
1969  */
1970
1971 #ifdef _FASTMATH
1972 #   ifdef atan2
1973 #       define F_atan2_amg  atan2_amg
1974 #   endif
1975 #   ifdef cos
1976 #       define F_cos_amg    cos_amg
1977 #   endif
1978 #   ifdef exp
1979 #       define F_exp_amg    exp_amg
1980 #   endif
1981 #   ifdef log
1982 #       define F_log_amg    log_amg
1983 #   endif
1984 #   ifdef pow
1985 #       define F_pow_amg    pow_amg
1986 #   endif
1987 #   ifdef sin
1988 #       define F_sin_amg    sin_amg
1989 #   endif
1990 #   ifdef sqrt
1991 #       define F_sqrt_amg   sqrt_amg
1992 #   endif
1993 #endif /* _FASTMATH */
1994
1995 #endif /* OVERLOAD */
1996
1997 #define PERLDB_ALL      0xff
1998 #define PERLDBf_SUB     0x01            /* Debug sub enter/exit. */
1999 #define PERLDBf_LINE    0x02            /* Keep line #. */
2000 #define PERLDBf_NOOPT   0x04            /* Switch off optimizations. */
2001 #define PERLDBf_INTER   0x08            /* Preserve more data for
2002                                            later inspections.  */
2003 #define PERLDBf_SUBLINE 0x10            /* Keep subr source lines. */
2004 #define PERLDBf_SINGLE  0x20            /* Start with single-step on. */
2005
2006 #define PERLDB_SUB      (perldb && (perldb & PERLDBf_SUB))
2007 #define PERLDB_LINE     (perldb && (perldb & PERLDBf_LINE))
2008 #define PERLDB_NOOPT    (perldb && (perldb & PERLDBf_NOOPT))
2009 #define PERLDB_INTER    (perldb && (perldb & PERLDBf_INTER))
2010 #define PERLDB_SUBLINE  (perldb && (perldb & PERLDBf_SUBLINE))
2011 #define PERLDB_SINGLE   (perldb && (perldb & PERLDBf_SINGLE))
2012
2013
2014 #ifdef USE_LOCALE_NUMERIC
2015
2016 #define SET_NUMERIC_STANDARD() \
2017     STMT_START {                                \
2018         if (! numeric_standard)                 \
2019             perl_set_numeric_standard();        \
2020     } STMT_END
2021
2022 #define SET_NUMERIC_LOCAL() \
2023     STMT_START {                                \
2024         if (! numeric_local)                    \
2025             perl_set_numeric_local();           \
2026     } STMT_END
2027
2028 #else /* !USE_LOCALE_NUMERIC */
2029
2030 #define SET_NUMERIC_STANDARD()  /**/
2031 #define SET_NUMERIC_LOCAL()     /**/
2032
2033 #endif /* !USE_LOCALE_NUMERIC */
2034
2035 #if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE)
2036 /*
2037  * Now we have __attribute__ out of the way
2038  * Remap printf
2039  */
2040 #define printf PerlIO_stdoutf
2041 #endif
2042
2043 #ifndef PERL_SCRIPT_MODE
2044 #define PERL_SCRIPT_MODE "r"
2045 #endif
2046
2047 /*
2048  * nice_chunk and nice_chunk size need to be set
2049  * and queried under the protection of sv_mutex
2050  */
2051 #define offer_nice_chunk(chunk, chunk_size) do {        \
2052         LOCK_SV_MUTEX;                                  \
2053         if (!nice_chunk) {                              \
2054             nice_chunk = (char*)(chunk);                \
2055             nice_chunk_size = (chunk_size);             \
2056         }                                               \
2057         UNLOCK_SV_MUTEX;                                \
2058     } while (0)
2059
2060
2061 #endif /* Include guard */
2062