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