1 /* perl.h 2 * 3 * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 4 * 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others 5 * 6 * You may distribute under the terms of either the GNU General Public 7 * License or the Artistic License, as specified in the README file. 8 * 9 */ 10 11 #ifndef H_PERL 12 #define H_PERL 1 13 14 #ifdef PERL_FOR_X2P 15 /* 16 * This file is being used for x2p stuff. 17 * Above symbol is defined via -D in 'x2p/Makefile.SH' 18 * Decouple x2p stuff from some of perls more extreme eccentricities. 19 */ 20 #undef MULTIPLICITY 21 #undef USE_STDIO 22 #define USE_STDIO 23 #endif /* PERL_FOR_X2P */ 24 25 #if defined(DGUX) 26 #include <sys/fcntl.h> 27 #endif 28 29 #ifdef VOIDUSED 30 # undef VOIDUSED 31 #endif 32 #define VOIDUSED 1 33 34 #ifdef PERL_MICRO 35 # include "uconfig.h" 36 #else 37 # include "config.h" 38 #endif 39 40 #if defined(USE_ITHREADS) && defined(USE_5005THREADS) 41 # include "error: USE_ITHREADS and USE_5005THREADS are incompatible" 42 #endif 43 44 /* See L<perlguts/"The Perl API"> for detailed notes on 45 * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */ 46 47 /* Note that from here --> to <-- the same logic is 48 * repeated in makedef.pl, so be certain to update 49 * both places when editing. */ 50 51 #ifdef PERL_IMPLICIT_SYS 52 /* PERL_IMPLICIT_SYS implies PerlMemShared != PerlMem 53 so use slab allocator to avoid lots of MUTEX overhead 54 */ 55 # ifndef PL_OP_SLAB_ALLOC 56 # define PL_OP_SLAB_ALLOC 57 # endif 58 #endif 59 60 #ifdef USE_ITHREADS 61 # if !defined(MULTIPLICITY) 62 # define MULTIPLICITY 63 # endif 64 #endif 65 66 #ifdef USE_5005THREADS 67 # ifndef PERL_IMPLICIT_CONTEXT 68 # define PERL_IMPLICIT_CONTEXT 69 # endif 70 #endif 71 72 #if defined(MULTIPLICITY) 73 # ifndef PERL_IMPLICIT_CONTEXT 74 # define PERL_IMPLICIT_CONTEXT 75 # endif 76 #endif 77 78 /* undef WIN32 when building on Cygwin (for libwin32) - gph */ 79 #ifdef __CYGWIN__ 80 # undef WIN32 81 # undef _WIN32 82 #endif 83 84 /* Use the reentrant APIs like localtime_r and getpwent_r */ 85 /* Win32 has naturally threadsafe libraries, no need to use any _r variants. */ 86 #if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN) 87 # define USE_REENTRANT_API 88 #endif 89 90 /* <--- here ends the logic shared by perl.h and makedef.pl */ 91 92 /* 93 * PERL_DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned) 94 * (The -DPERL_DARWIN comes from the hints/darwin.sh.) 95 * __bsdi__ for BSD/OS 96 */ 97 #if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(PERL_DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44) 98 # ifndef BSDish 99 # define BSDish 100 # endif 101 #endif 102 103 #ifdef PERL_IMPLICIT_CONTEXT 104 # ifdef USE_5005THREADS 105 struct perl_thread; 106 # define pTHX register struct perl_thread *thr PERL_UNUSED_DECL 107 # define aTHX thr 108 # define dTHR dNOOP /* only backward compatibility */ 109 # define dTHXa(a) pTHX = (struct perl_thread*)a 110 # else 111 # ifndef MULTIPLICITY 112 # define MULTIPLICITY 113 # endif 114 # define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL 115 # define aTHX my_perl 116 # define dTHXa(a) pTHX = (PerlInterpreter*)a 117 # endif 118 # define dTHX pTHX = PERL_GET_THX 119 # define pTHX_ pTHX, 120 # define aTHX_ aTHX, 121 # define pTHX_1 2 122 # define pTHX_2 3 123 # define pTHX_3 4 124 # define pTHX_4 5 125 # define pTHX_5 6 126 # define pTHX_6 7 127 # define pTHX_7 8 128 # define pTHX_8 9 129 # define pTHX_9 10 130 #endif 131 132 #define STATIC static 133 #define CPERLscope(x) x 134 #define CPERLarg void 135 #define CPERLarg_ 136 #define _CPERLarg 137 #define PERL_OBJECT_THIS 138 #define _PERL_OBJECT_THIS 139 #define PERL_OBJECT_THIS_ 140 #define CALL_FPTR(fptr) (*fptr) 141 142 #define CALLRUNOPS CALL_FPTR(PL_runops) 143 #define CALLREGCOMP CALL_FPTR(PL_regcompp) 144 #define CALLREGEXEC CALL_FPTR(PL_regexecp) 145 #define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start) 146 #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string) 147 #define CALLREGFREE CALL_FPTR(PL_regfree) 148 149 #ifdef PERL_FLEXIBLE_EXCEPTIONS 150 # define CALLPROTECT CALL_FPTR(PL_protect) 151 #endif 152 153 #if defined(SYMBIAN) && defined(__GNUC__) 154 # ifdef __cplusplus 155 # define PERL_UNUSED_DECL 156 # else 157 # define PERL_UNUSED_DECL __attribute__((unused)) 158 # endif 159 #endif 160 161 #ifndef PERL_UNUSED_DECL 162 # if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus) 163 # define PERL_UNUSED_DECL __attribute__unused__ 164 # else 165 # define PERL_UNUSED_DECL 166 # endif 167 #endif 168 169 /* gcc -Wall: 170 * for silencing unused variables that are actually used most of the time, 171 * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs 172 */ 173 #ifndef PERL_UNUSED_ARG 174 # ifdef lint 175 # include <note.h> 176 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) 177 # else 178 # define PERL_UNUSED_ARG(x) ((void)x) 179 # endif 180 #endif 181 #ifndef PERL_UNUSED_VAR 182 # define PERL_UNUSED_VAR(x) ((void)x) 183 #endif 184 185 #ifdef USE_ITHREADS 186 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) 187 #else 188 # define PERL_UNUSED_CONTEXT 189 #endif 190 191 #define NOOP /*EMPTY*/(void)0 192 #if !defined(HASATTRIBUTE_UNUSED) && defined(__cplusplus) 193 #define dNOOP /*EMPTY*/(void)0 /* Older g++ has no __attribute((unused))__ */ 194 #else 195 #define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL 196 #endif 197 198 #ifndef pTHX 199 /* Don't bother defining tTHX and sTHX; using them outside 200 * code guarded by PERL_IMPLICIT_CONTEXT is an error. 201 */ 202 # define pTHX void 203 # define pTHX_ 204 # define aTHX 205 # define aTHX_ 206 # define dTHXa(a) dNOOP 207 # define dTHX dNOOP 208 # define pTHX_1 1 209 # define pTHX_2 2 210 # define pTHX_3 3 211 # define pTHX_4 4 212 # define pTHX_5 5 213 # define pTHX_6 6 214 # define pTHX_7 7 215 # define pTHX_8 8 216 # define pTHX_9 9 217 #endif 218 219 /* these are only defined for compatibility; should not be used internally */ 220 #if !defined(pTHXo) && !defined(PERL_CORE) 221 # define pTHXo pTHX 222 # define pTHXo_ pTHX_ 223 # define aTHXo aTHX 224 # define aTHXo_ aTHX_ 225 # define dTHXo dTHX 226 # define dTHXoa(x) dTHXa(x) 227 #endif 228 229 #ifndef pTHXx 230 # define pTHXx register PerlInterpreter *my_perl 231 # define pTHXx_ pTHXx, 232 # define aTHXx my_perl 233 # define aTHXx_ aTHXx, 234 # define dTHXx dTHX 235 #endif 236 237 /* Under PERL_IMPLICIT_SYS (used in Windows for fork emulation) 238 * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...). 239 * dTHXs is therefore needed for all functions using PerlIO_foo(). */ 240 #ifdef PERL_IMPLICIT_SYS 241 # define dTHXs dTHX 242 #else 243 # define dTHXs dNOOP 244 #endif 245 246 #undef START_EXTERN_C 247 #undef END_EXTERN_C 248 #undef EXTERN_C 249 #ifdef __cplusplus 250 # define START_EXTERN_C extern "C" { 251 # define END_EXTERN_C } 252 # define EXTERN_C extern "C" 253 #else 254 # define START_EXTERN_C 255 # define END_EXTERN_C 256 # define EXTERN_C extern 257 #endif 258 259 /* Some platforms require marking function declarations 260 * for them to be exportable. Used in perlio.h, proto.h 261 * is handled either by the makedef.pl or by defining the 262 * PERL_CALLCONV to be something special. See also the 263 * definition of XS() in XSUB.h. */ 264 #ifndef PERL_EXPORT_C 265 # define PERL_EXPORT_C extern 266 #endif 267 #ifndef PERL_XS_EXPORT_C 268 # define PERL_XS_EXPORT_C 269 #endif 270 271 #ifdef OP_IN_REGISTER 272 # ifdef __GNUC__ 273 # define stringify_immed(s) #s 274 # define stringify(s) stringify_immed(s) 275 register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); 276 # endif 277 #endif 278 279 #if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC) 280 # if !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) 281 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN 282 # endif 283 #endif 284 285 /* 286 * STMT_START { statements; } STMT_END; 287 * can be used as a single statement, as in 288 * if (x) STMT_START { ... } STMT_END; else ... 289 * 290 * Trying to select a version that gives no warnings... 291 */ 292 #if !(defined(STMT_START) && defined(STMT_END)) 293 # if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) 294 # define STMT_START (void)( /* gcc supports "({ STATEMENTS; })" */ 295 # define STMT_END ) 296 # else 297 /* Now which other defined()s do we need here ??? */ 298 # if (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) 299 # define STMT_START if (1) 300 # define STMT_END else (void)0 301 # else 302 # define STMT_START do 303 # define STMT_END while (0) 304 # endif 305 # endif 306 #endif 307 308 #define WITH_THX(s) STMT_START { dTHX; s; } STMT_END 309 #define WITH_THR(s) WITH_THX(s) 310 311 /* 312 * SOFT_CAST can be used for args to prototyped functions to retain some 313 * type checking; it only casts if the compiler does not know prototypes. 314 */ 315 #if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE) 316 #define SOFT_CAST(type) 317 #else 318 #define SOFT_CAST(type) (type) 319 #endif 320 321 #ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */ 322 # define BYTEORDER 0x1234 323 #endif 324 325 /* Overall memory policy? */ 326 #ifndef CONSERVATIVE 327 # define LIBERAL 1 328 #endif 329 330 #if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90 331 #define ASCIIish 332 #else 333 #undef ASCIIish 334 #endif 335 336 /* 337 * The following contortions are brought to you on behalf of all the 338 * standards, semi-standards, de facto standards, not-so-de-facto standards 339 * of the world, as well as all the other botches anyone ever thought of. 340 * The basic theory is that if we work hard enough here, the rest of the 341 * code can be a lot prettier. Well, so much for theory. Sorry, Henry... 342 */ 343 344 /* define this once if either system, instead of cluttering up the src */ 345 #if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(NETWARE) 346 #define DOSISH 1 347 #endif 348 349 #if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE) 350 # define STANDARD_C 1 351 #endif 352 353 #if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE) || defined(PERL_MICRO) 354 # define DONT_DECLARE_STD 1 355 #endif 356 357 #if defined(HASVOLATILE) || defined(STANDARD_C) 358 # ifdef __cplusplus 359 # define VOL /* to temporarily suppress warnings */ 360 # else 361 # define VOL volatile 362 # endif 363 #else 364 # define VOL 365 #endif 366 367 #define TAINT (PL_tainted = TRUE) 368 #define TAINT_NOT (PL_tainted = FALSE) 369 #define TAINT_IF(c) if (c) { PL_tainted = TRUE; } 370 #define TAINT_ENV() if (PL_tainting) { taint_env(); } 371 #define TAINT_PROPER(s) if (PL_tainting) { taint_proper(Nullch, s); } 372 373 /* XXX All process group stuff is handled in pp_sys.c. Should these 374 defines move there? If so, I could simplify this a lot. --AD 9/96. 375 */ 376 /* Process group stuff changed from traditional BSD to POSIX. 377 perlfunc.pod documents the traditional BSD-style syntax, so we'll 378 try to preserve that, if possible. 379 */ 380 #ifdef HAS_SETPGID 381 # define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp)) 382 #else 383 # if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP) 384 # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) 385 # else 386 # ifdef HAS_SETPGRP2 /* DG/UX */ 387 # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) 388 # endif 389 # endif 390 #endif 391 #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP) 392 # define HAS_SETPGRP /* Well, effectively it does . . . */ 393 #endif 394 395 /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes 396 our life easier :-) so we'll try it. 397 */ 398 #ifdef HAS_GETPGID 399 # define BSD_GETPGRP(pid) getpgid((pid)) 400 #else 401 # if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP) 402 # define BSD_GETPGRP(pid) getpgrp((pid)) 403 # else 404 # ifdef HAS_GETPGRP2 /* DG/UX */ 405 # define BSD_GETPGRP(pid) getpgrp2((pid)) 406 # endif 407 # endif 408 #endif 409 #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP) 410 # define HAS_GETPGRP /* Well, effectively it does . . . */ 411 #endif 412 413 /* These are not exact synonyms, since setpgrp() and getpgrp() may 414 have different behaviors, but perl.h used to define USE_BSDPGRP 415 (prior to 5.003_05) so some extension might depend on it. 416 */ 417 #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP) 418 # ifndef USE_BSDPGRP 419 # define USE_BSDPGRP 420 # endif 421 #endif 422 423 /* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that 424 pthread.h must be included before all other header files. 425 */ 426 #if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) \ 427 && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) 428 # include <pthread.h> 429 #endif 430 431 #ifndef _TYPES_ /* If types.h defines this it's easy. */ 432 # ifndef major /* Does everyone's types.h define this? */ 433 # include <sys/types.h> 434 # endif 435 #endif 436 437 #ifdef __cplusplus 438 # ifndef I_STDARG 439 # define I_STDARG 1 440 # endif 441 #endif 442 443 #ifdef I_STDARG 444 # include <stdarg.h> 445 #else 446 # ifdef I_VARARGS 447 # include <varargs.h> 448 # endif 449 #endif 450 451 #ifdef USE_NEXT_CTYPE 452 453 #if NX_CURRENT_COMPILER_RELEASE >= 500 454 # include <bsd/ctypes.h> 455 #else 456 # if NX_CURRENT_COMPILER_RELEASE >= 400 457 # include <objc/NXCType.h> 458 # else /* NX_CURRENT_COMPILER_RELEASE < 400 */ 459 # include <appkit/NXCType.h> 460 # endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */ 461 #endif /* NX_CURRENT_COMPILER_RELEASE >= 500 */ 462 463 #else /* !USE_NEXT_CTYPE */ 464 #include <ctype.h> 465 #endif /* USE_NEXT_CTYPE */ 466 467 #ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ 468 #undef METHOD 469 #endif 470 471 #ifdef PERL_MICRO 472 # define NO_LOCALE 473 #endif 474 475 #ifdef I_LOCALE 476 # include <locale.h> 477 #endif 478 479 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE) 480 # define USE_LOCALE 481 # if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \ 482 && defined(HAS_STRXFRM) 483 # define USE_LOCALE_COLLATE 484 # endif 485 # if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE) 486 # define USE_LOCALE_CTYPE 487 # endif 488 # if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC) 489 # define USE_LOCALE_NUMERIC 490 # endif 491 #endif /* !NO_LOCALE && HAS_SETLOCALE */ 492 493 #include <setjmp.h> 494 495 #ifdef I_SYS_PARAM 496 # ifdef PARAM_NEEDS_TYPES 497 # include <sys/types.h> 498 # endif 499 # include <sys/param.h> 500 #endif 501 502 /* Use all the "standard" definitions? */ 503 #if defined(STANDARD_C) && defined(I_STDLIB) 504 # include <stdlib.h> 505 #endif 506 507 /* If this causes problems, set i_unistd=undef in the hint file. */ 508 #ifdef I_UNISTD 509 # include <unistd.h> 510 #endif 511 512 #if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO) 513 int syscall(int, ...); 514 #endif 515 516 #if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO) && !defined(PERL_MICRO) 517 int usleep(unsigned int); 518 #endif 519 520 #ifdef PERL_MICRO /* Last chance to export Perl_my_swap */ 521 # define MYSWAP 522 #endif 523 524 #ifdef PERL_CORE 525 526 /* macros for correct constant construction */ 527 # if INTSIZE >= 2 528 # define U16_CONST(x) ((U16)x##U) 529 # else 530 # define U16_CONST(x) ((U16)x##UL) 531 # endif 532 533 # if INTSIZE >= 4 534 # define U32_CONST(x) ((U32)x##U) 535 # else 536 # define U32_CONST(x) ((U32)x##UL) 537 # endif 538 539 # ifdef HAS_QUAD 540 # if INTSIZE >= 8 541 # define U64_CONST(x) ((U64)x##U) 542 # elif LONGSIZE >= 8 543 # define U64_CONST(x) ((U64)x##UL) 544 # elif QUADKIND == QUAD_IS_LONG_LONG 545 # define U64_CONST(x) ((U64)x##ULL) 546 # else /* best guess we can make */ 547 # define U64_CONST(x) ((U64)x##UL) 548 # endif 549 # endif 550 551 /* byte-swapping functions for big-/little-endian conversion */ 552 # define _swab_16_(x) ((U16)( \ 553 (((U16)(x) & U16_CONST(0x00ff)) << 8) | \ 554 (((U16)(x) & U16_CONST(0xff00)) >> 8) )) 555 556 # define _swab_32_(x) ((U32)( \ 557 (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \ 558 (((U32)(x) & U32_CONST(0x0000ff00)) << 8) | \ 559 (((U32)(x) & U32_CONST(0x00ff0000)) >> 8) | \ 560 (((U32)(x) & U32_CONST(0xff000000)) >> 24) )) 561 562 # ifdef HAS_QUAD 563 # define _swab_64_(x) ((U64)( \ 564 (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \ 565 (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \ 566 (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \ 567 (((U64)(x) & U64_CONST(0x00000000ff000000)) << 8) | \ 568 (((U64)(x) & U64_CONST(0x000000ff00000000)) >> 8) | \ 569 (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \ 570 (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \ 571 (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) )) 572 # endif 573 574 /*----------------------------------------------------------------------------*/ 575 # if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 /* little-endian */ 576 /*----------------------------------------------------------------------------*/ 577 # define my_htole16(x) (x) 578 # define my_letoh16(x) (x) 579 # define my_htole32(x) (x) 580 # define my_letoh32(x) (x) 581 # define my_htobe16(x) _swab_16_(x) 582 # define my_betoh16(x) _swab_16_(x) 583 # define my_htobe32(x) _swab_32_(x) 584 # define my_betoh32(x) _swab_32_(x) 585 # ifdef HAS_QUAD 586 # define my_htole64(x) (x) 587 # define my_letoh64(x) (x) 588 # define my_htobe64(x) _swab_64_(x) 589 # define my_betoh64(x) _swab_64_(x) 590 # endif 591 # define my_htoles(x) (x) 592 # define my_letohs(x) (x) 593 # define my_htolei(x) (x) 594 # define my_letohi(x) (x) 595 # define my_htolel(x) (x) 596 # define my_letohl(x) (x) 597 # if SHORTSIZE == 1 598 # define my_htobes(x) (x) 599 # define my_betohs(x) (x) 600 # elif SHORTSIZE == 2 601 # define my_htobes(x) _swab_16_(x) 602 # define my_betohs(x) _swab_16_(x) 603 # elif SHORTSIZE == 4 604 # define my_htobes(x) _swab_32_(x) 605 # define my_betohs(x) _swab_32_(x) 606 # elif SHORTSIZE == 8 607 # define my_htobes(x) _swab_64_(x) 608 # define my_betohs(x) _swab_64_(x) 609 # else 610 # define PERL_NEED_MY_HTOBES 611 # define PERL_NEED_MY_BETOHS 612 # endif 613 # if INTSIZE == 1 614 # define my_htobei(x) (x) 615 # define my_betohi(x) (x) 616 # elif INTSIZE == 2 617 # define my_htobei(x) _swab_16_(x) 618 # define my_betohi(x) _swab_16_(x) 619 # elif INTSIZE == 4 620 # define my_htobei(x) _swab_32_(x) 621 # define my_betohi(x) _swab_32_(x) 622 # elif INTSIZE == 8 623 # define my_htobei(x) _swab_64_(x) 624 # define my_betohi(x) _swab_64_(x) 625 # else 626 # define PERL_NEED_MY_HTOBEI 627 # define PERL_NEED_MY_BETOHI 628 # endif 629 # if LONGSIZE == 1 630 # define my_htobel(x) (x) 631 # define my_betohl(x) (x) 632 # elif LONGSIZE == 2 633 # define my_htobel(x) _swab_16_(x) 634 # define my_betohl(x) _swab_16_(x) 635 # elif LONGSIZE == 4 636 # define my_htobel(x) _swab_32_(x) 637 # define my_betohl(x) _swab_32_(x) 638 # elif LONGSIZE == 8 639 # define my_htobel(x) _swab_64_(x) 640 # define my_betohl(x) _swab_64_(x) 641 # else 642 # define PERL_NEED_MY_HTOBEL 643 # define PERL_NEED_MY_BETOHL 644 # endif 645 # define my_htolen(p,n) NOOP 646 # define my_letohn(p,n) NOOP 647 # define my_htoben(p,n) my_swabn(p,n) 648 # define my_betohn(p,n) my_swabn(p,n) 649 /*----------------------------------------------------------------------------*/ 650 # elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 /* big-endian */ 651 /*----------------------------------------------------------------------------*/ 652 # define my_htobe16(x) (x) 653 # define my_betoh16(x) (x) 654 # define my_htobe32(x) (x) 655 # define my_betoh32(x) (x) 656 # define my_htole16(x) _swab_16_(x) 657 # define my_letoh16(x) _swab_16_(x) 658 # define my_htole32(x) _swab_32_(x) 659 # define my_letoh32(x) _swab_32_(x) 660 # ifdef HAS_QUAD 661 # define my_htobe64(x) (x) 662 # define my_betoh64(x) (x) 663 # define my_htole64(x) _swab_64_(x) 664 # define my_letoh64(x) _swab_64_(x) 665 # endif 666 # define my_htobes(x) (x) 667 # define my_betohs(x) (x) 668 # define my_htobei(x) (x) 669 # define my_betohi(x) (x) 670 # define my_htobel(x) (x) 671 # define my_betohl(x) (x) 672 # if SHORTSIZE == 1 673 # define my_htoles(x) (x) 674 # define my_letohs(x) (x) 675 # elif SHORTSIZE == 2 676 # define my_htoles(x) _swab_16_(x) 677 # define my_letohs(x) _swab_16_(x) 678 # elif SHORTSIZE == 4 679 # define my_htoles(x) _swab_32_(x) 680 # define my_letohs(x) _swab_32_(x) 681 # elif SHORTSIZE == 8 682 # define my_htoles(x) _swab_64_(x) 683 # define my_letohs(x) _swab_64_(x) 684 # else 685 # define PERL_NEED_MY_HTOLES 686 # define PERL_NEED_MY_LETOHS 687 # endif 688 # if INTSIZE == 1 689 # define my_htolei(x) (x) 690 # define my_letohi(x) (x) 691 # elif INTSIZE == 2 692 # define my_htolei(x) _swab_16_(x) 693 # define my_letohi(x) _swab_16_(x) 694 # elif INTSIZE == 4 695 # define my_htolei(x) _swab_32_(x) 696 # define my_letohi(x) _swab_32_(x) 697 # elif INTSIZE == 8 698 # define my_htolei(x) _swab_64_(x) 699 # define my_letohi(x) _swab_64_(x) 700 # else 701 # define PERL_NEED_MY_HTOLEI 702 # define PERL_NEED_MY_LETOHI 703 # endif 704 # if LONGSIZE == 1 705 # define my_htolel(x) (x) 706 # define my_letohl(x) (x) 707 # elif LONGSIZE == 2 708 # define my_htolel(x) _swab_16_(x) 709 # define my_letohl(x) _swab_16_(x) 710 # elif LONGSIZE == 4 711 # define my_htolel(x) _swab_32_(x) 712 # define my_letohl(x) _swab_32_(x) 713 # elif LONGSIZE == 8 714 # define my_htolel(x) _swab_64_(x) 715 # define my_letohl(x) _swab_64_(x) 716 # else 717 # define PERL_NEED_MY_HTOLEL 718 # define PERL_NEED_MY_LETOHL 719 # endif 720 # define my_htolen(p,n) my_swabn(p,n) 721 # define my_letohn(p,n) my_swabn(p,n) 722 # define my_htoben(p,n) NOOP 723 # define my_betohn(p,n) NOOP 724 /*----------------------------------------------------------------------------*/ 725 # else /* all other byte-orders */ 726 /*----------------------------------------------------------------------------*/ 727 # define PERL_NEED_MY_HTOLE16 728 # define PERL_NEED_MY_LETOH16 729 # define PERL_NEED_MY_HTOBE16 730 # define PERL_NEED_MY_BETOH16 731 # define PERL_NEED_MY_HTOLE32 732 # define PERL_NEED_MY_LETOH32 733 # define PERL_NEED_MY_HTOBE32 734 # define PERL_NEED_MY_BETOH32 735 # ifdef HAS_QUAD 736 # define PERL_NEED_MY_HTOLE64 737 # define PERL_NEED_MY_LETOH64 738 # define PERL_NEED_MY_HTOBE64 739 # define PERL_NEED_MY_BETOH64 740 # endif 741 # define PERL_NEED_MY_HTOLES 742 # define PERL_NEED_MY_LETOHS 743 # define PERL_NEED_MY_HTOBES 744 # define PERL_NEED_MY_BETOHS 745 # define PERL_NEED_MY_HTOLEI 746 # define PERL_NEED_MY_LETOHI 747 # define PERL_NEED_MY_HTOBEI 748 # define PERL_NEED_MY_BETOHI 749 # define PERL_NEED_MY_HTOLEL 750 # define PERL_NEED_MY_LETOHL 751 # define PERL_NEED_MY_HTOBEL 752 # define PERL_NEED_MY_BETOHL 753 /*----------------------------------------------------------------------------*/ 754 # endif /* end of byte-order macros */ 755 /*----------------------------------------------------------------------------*/ 756 757 /* The old value was hard coded at 1008. (4096-16) seems to be a bit faster, 758 at least on FreeBSD. YMMV, so experiment. */ 759 #ifndef PERL_ARENA_SIZE 760 #define PERL_ARENA_SIZE 4080 761 #endif 762 763 #endif /* PERL_CORE */ 764 765 /* Cannot include embed.h here on Win32 as win32.h has not 766 yet been included and defines some config variables e.g. HAVE_INTERP_INTERN 767 */ 768 #if !defined(PERL_FOR_X2P) && !(defined(WIN32)||defined(VMS)) 769 # include "embed.h" 770 #endif 771 772 #define MEM_SIZE Size_t 773 774 /* Round all values passed to malloc up, by default to a multiple of 775 sizeof(size_t) 776 */ 777 #ifndef PERL_STRLEN_ROUNDUP_QUANTUM 778 #define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size 779 #endif 780 781 #if defined(STANDARD_C) && defined(I_STDDEF) 782 # include <stddef.h> 783 # define STRUCT_OFFSET(s,m) offsetof(s,m) 784 #else 785 # define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) 786 #endif 787 788 #if defined(I_STRING) || defined(__cplusplus) 789 # include <string.h> 790 #else 791 # include <strings.h> 792 #endif 793 794 /* This comes after <stdlib.h> so we don't try to change the standard 795 * library prototypes; we'll use our own in proto.h instead. */ 796 797 #ifdef MYMALLOC 798 # ifdef PERL_POLLUTE_MALLOC 799 # ifndef PERL_EXTMALLOC_DEF 800 # define Perl_malloc malloc 801 # define Perl_calloc calloc 802 # define Perl_realloc realloc 803 # define Perl_mfree free 804 # endif 805 # else 806 # define EMBEDMYMALLOC /* for compatibility */ 807 # endif 808 809 # define safemalloc Perl_malloc 810 # define safecalloc Perl_calloc 811 # define saferealloc Perl_realloc 812 # define safefree Perl_mfree 813 # define CHECK_MALLOC_TOO_LATE_FOR_(code) STMT_START { \ 814 if (!PL_tainting && MallocCfg_ptr[MallocCfg_cfg_env_read]) \ 815 code; \ 816 } STMT_END 817 # define CHECK_MALLOC_TOO_LATE_FOR(ch) \ 818 CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch)) 819 # define panic_write2(s) write(2, s, strlen(s)) 820 # define CHECK_MALLOC_TAINT(newval) \ 821 CHECK_MALLOC_TOO_LATE_FOR_( \ 822 if (newval) { \ 823 panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\ 824 exit(1); }) 825 # define MALLOC_CHECK_TAINT(argc,argv,env) STMT_START { \ 826 if (doing_taint(argc,argv,env)) { \ 827 MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1; \ 828 }} STMT_END; 829 #else /* MYMALLOC */ 830 # define safemalloc safesysmalloc 831 # define safecalloc safesyscalloc 832 # define saferealloc safesysrealloc 833 # define safefree safesysfree 834 # define CHECK_MALLOC_TOO_LATE_FOR(ch) ((void)0) 835 # define CHECK_MALLOC_TAINT(newval) ((void)0) 836 # define MALLOC_CHECK_TAINT(argc,argv,env) 837 #endif /* MYMALLOC */ 838 839 #define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what) 840 #define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "") 841 #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") 842 #define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL) 843 844 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr) 845 #define strchr index 846 #define strrchr rindex 847 #endif 848 849 #ifdef I_MEMORY 850 # include <memory.h> 851 #endif 852 853 #ifdef HAS_MEMCPY 854 # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) 855 # ifndef memcpy 856 extern char * memcpy (char*, char*, int); 857 # endif 858 # endif 859 #else 860 # ifndef memcpy 861 # ifdef HAS_BCOPY 862 # define memcpy(d,s,l) bcopy(s,d,l) 863 # else 864 # define memcpy(d,s,l) my_bcopy(s,d,l) 865 # endif 866 # endif 867 #endif /* HAS_MEMCPY */ 868 869 #ifdef HAS_MEMSET 870 # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) 871 # ifndef memset 872 extern char *memset (char*, int, int); 873 # endif 874 # endif 875 #else 876 # undef memset 877 # define memset(d,c,l) my_memset(d,c,l) 878 #endif /* HAS_MEMSET */ 879 880 #if !defined(HAS_MEMMOVE) && !defined(memmove) 881 # if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY) 882 # define memmove(d,s,l) bcopy(s,d,l) 883 # else 884 # if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY) 885 # define memmove(d,s,l) memcpy(d,s,l) 886 # else 887 # define memmove(d,s,l) my_bcopy(s,d,l) 888 # endif 889 # endif 890 #endif 891 892 #if defined(mips) && defined(ultrix) && !defined(__STDC__) 893 # undef HAS_MEMCMP 894 #endif 895 896 #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP) 897 # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) 898 # ifndef memcmp 899 extern int memcmp (char*, char*, int); 900 # endif 901 # endif 902 # ifdef BUGGY_MSC 903 # pragma function(memcmp) 904 # endif 905 #else 906 # ifndef memcmp 907 # define memcmp my_memcmp 908 # endif 909 #endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */ 910 911 #ifndef memzero 912 # ifdef HAS_MEMSET 913 # define memzero(d,l) memset(d,0,l) 914 # else 915 # ifdef HAS_BZERO 916 # define memzero(d,l) bzero(d,l) 917 # else 918 # define memzero(d,l) my_bzero(d,l) 919 # endif 920 # endif 921 #endif 922 923 #ifndef PERL_MICRO 924 #ifndef memchr 925 # ifndef HAS_MEMCHR 926 # define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1) 927 # endif 928 #endif 929 #endif 930 931 #ifndef HAS_BCMP 932 # ifndef bcmp 933 # define bcmp(s1,s2,l) memcmp(s1,s2,l) 934 # endif 935 #endif /* !HAS_BCMP */ 936 937 #ifdef I_NETINET_IN 938 # include <netinet/in.h> 939 #endif 940 941 #ifdef I_ARPA_INET 942 # include <arpa/inet.h> 943 #endif 944 945 #if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO) 946 /* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND 947 * (the neo-BSD seem to do this). */ 948 # undef SF_APPEND 949 #endif 950 951 #ifdef I_SYS_STAT 952 # include <sys/stat.h> 953 #endif 954 955 /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives 956 like UTekV) are broken, sometimes giving false positives. Undefine 957 them here and let the code below set them to proper values. 958 959 The ghs macro stands for GreenHills Software C-1.8.5 which 960 is the C compiler for sysV88 and the various derivatives. 961 This header file bug is corrected in gcc-2.5.8 and later versions. 962 --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94. */ 963 964 #if defined(uts) || (defined(m88k) && defined(ghs)) 965 # undef S_ISDIR 966 # undef S_ISCHR 967 # undef S_ISBLK 968 # undef S_ISREG 969 # undef S_ISFIFO 970 # undef S_ISLNK 971 #endif 972 973 #ifdef I_TIME 974 # include <time.h> 975 #endif 976 977 #ifdef I_SYS_TIME 978 # ifdef I_SYS_TIME_KERNEL 979 # define KERNEL 980 # endif 981 # include <sys/time.h> 982 # ifdef I_SYS_TIME_KERNEL 983 # undef KERNEL 984 # endif 985 #endif 986 987 #if defined(HAS_TIMES) && defined(I_SYS_TIMES) 988 # include <sys/times.h> 989 #endif 990 991 #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR)) 992 # undef HAS_STRERROR 993 #endif 994 995 #include <errno.h> 996 997 #if defined(WIN32) && defined(PERL_IMPLICIT_SYS) 998 # define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */ 999 #endif 1000 1001 /* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one. 1002 * This is important for using IPv6. 1003 * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be 1004 * a bad idea since it breaks send() and recv(). */ 1005 #if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X) 1006 # define _SOCKADDR_LEN 1007 #endif 1008 1009 #if defined(HAS_SOCKET) && !defined(VMS) && !defined(WIN32) /* VMS/WIN32 handle sockets via vmsish.h/win32.h */ 1010 # include <sys/socket.h> 1011 # if defined(USE_SOCKS) && defined(I_SOCKS) 1012 # if !defined(INCLUDE_PROTOTYPES) 1013 # define INCLUDE_PROTOTYPES /* for <socks.h> */ 1014 # define PERL_SOCKS_NEED_PROTOTYPES 1015 # endif 1016 # ifdef USE_5005THREADS 1017 # define PERL_USE_THREADS /* store our value */ 1018 # undef USE_5005THREADS 1019 # endif 1020 # include <socks.h> 1021 # ifdef USE_5005THREADS 1022 # undef USE_5005THREADS /* socks.h does this on its own */ 1023 # endif 1024 # ifdef PERL_USE_THREADS 1025 # define USE_5005THREADS /* restore our value */ 1026 # undef PERL_USE_THREADS 1027 # endif 1028 # ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */ 1029 # undef INCLUDE_PROTOTYPES 1030 # undef PERL_SOCKS_NEED_PROTOTYPES 1031 # endif 1032 # endif 1033 # ifdef I_NETDB 1034 # ifdef NETWARE 1035 # include<stdio.h> 1036 # endif 1037 # include <netdb.h> 1038 # endif 1039 # ifndef ENOTSOCK 1040 # ifdef I_NET_ERRNO 1041 # include <net/errno.h> 1042 # endif 1043 # endif 1044 #endif 1045 1046 /* sockatmark() is so new (2001) that many places might have it hidden 1047 * behind some -D_BLAH_BLAH_SOURCE guard. The __THROW magic is required 1048 * e.g. in Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */ 1049 #if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO) 1050 # if defined(__THROW) && defined(__GLIBC__) 1051 int sockatmark(int) __THROW; 1052 # else 1053 int sockatmark(int); 1054 # endif 1055 #endif 1056 1057 #ifdef SETERRNO 1058 # undef SETERRNO /* SOCKS might have defined this */ 1059 #endif 1060 1061 #ifdef VMS 1062 # define SETERRNO(errcode,vmserrcode) \ 1063 STMT_START { \ 1064 set_errno(errcode); \ 1065 set_vaxc_errno(vmserrcode); \ 1066 } STMT_END 1067 # define LIB_INVARG LIB$_INVARG 1068 # define RMS_DIR RMS$_DIR 1069 # define RMS_FAC RMS$_FAC 1070 # define RMS_FEX RMS$_FEX 1071 # define RMS_FNF RMS$_FNF 1072 # define RMS_IFI RMS$_IFI 1073 # define RMS_ISI RMS$_ISI 1074 # define RMS_PRV RMS$_PRV 1075 # define SS_ACCVIO SS$_ACCVIO 1076 # define SS_DEVOFFLINE SS$_DEVOFFLINE 1077 # define SS_IVCHAN SS$_IVCHAN 1078 # define SS_NORMAL SS$_NORMAL 1079 #else 1080 # define SETERRNO(errcode,vmserrcode) (errno = (errcode)) 1081 # define LIB_INVARG 0 1082 # define RMS_DIR 0 1083 # define RMS_FAC 0 1084 # define RMS_FEX 0 1085 # define RMS_FNF 0 1086 # define RMS_IFI 0 1087 # define RMS_ISI 0 1088 # define RMS_PRV 0 1089 # define SS_ACCVIO 0 1090 # define SS_DEVOFFLINE 0 1091 # define SS_IVCHAN 0 1092 # define SS_NORMAL 0 1093 #endif 1094 1095 #ifdef USE_5005THREADS 1096 # define ERRSV (thr->errsv) 1097 # define DEFSV THREADSV(0) 1098 # define SAVE_DEFSV save_threadsv(0) 1099 #else 1100 /* FIXME? Change the assignments to PL_defgv to instantiate GvSV? */ 1101 # define ERRSV GvSV(PL_errgv) 1102 # define DEFSV GvSVn(PL_defgv) 1103 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 1104 #endif /* USE_5005THREADS */ 1105 1106 #define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */ 1107 1108 #ifndef errno 1109 extern int errno; /* ANSI allows errno to be an lvalue expr. 1110 * For example in multithreaded environments 1111 * something like this might happen: 1112 * extern int *_errno(void); 1113 * #define errno (*_errno()) */ 1114 #endif 1115 1116 #ifdef HAS_STRERROR 1117 # ifdef VMS 1118 char *strerror (int,...); 1119 # else 1120 #ifndef DONT_DECLARE_STD 1121 char *strerror (int); 1122 #endif 1123 # endif 1124 # ifndef Strerror 1125 # define Strerror strerror 1126 # endif 1127 #else 1128 # ifdef HAS_SYS_ERRLIST 1129 extern int sys_nerr; 1130 extern char *sys_errlist[]; 1131 # ifndef Strerror 1132 # define Strerror(e) \ 1133 ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e]) 1134 # endif 1135 # endif 1136 #endif 1137 1138 #ifdef I_SYS_IOCTL 1139 # ifndef _IOCTL_ 1140 # include <sys/ioctl.h> 1141 # endif 1142 #endif 1143 1144 #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000) 1145 # ifdef HAS_SOCKETPAIR 1146 # undef HAS_SOCKETPAIR 1147 # endif 1148 # ifdef I_NDBM 1149 # undef I_NDBM 1150 # endif 1151 #endif 1152 1153 #ifndef HAS_SOCKETPAIR 1154 # ifdef HAS_SOCKET 1155 # define socketpair Perl_my_socketpair 1156 # endif 1157 #endif 1158 1159 #if INTSIZE == 2 1160 # define htoni htons 1161 # define ntohi ntohs 1162 #else 1163 # define htoni htonl 1164 # define ntohi ntohl 1165 #endif 1166 1167 /* Configure already sets Direntry_t */ 1168 #if defined(I_DIRENT) 1169 # include <dirent.h> 1170 /* NeXT needs dirent + sys/dir.h */ 1171 # if defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__)) 1172 # include <sys/dir.h> 1173 # endif 1174 #else 1175 # ifdef I_SYS_NDIR 1176 # include <sys/ndir.h> 1177 # else 1178 # ifdef I_SYS_DIR 1179 # ifdef hp9000s500 1180 # include <ndir.h> /* may be wrong in the future */ 1181 # else 1182 # include <sys/dir.h> 1183 # endif 1184 # endif 1185 # endif 1186 #endif 1187 1188 #ifdef PERL_MICRO 1189 # ifndef DIR 1190 # define DIR void 1191 # endif 1192 #endif 1193 1194 #ifdef FPUTS_BOTCH 1195 /* work around botch in SunOS 4.0.1 and 4.0.2 */ 1196 # ifndef fputs 1197 # define fputs(sv,fp) fprintf(fp,"%s",sv) 1198 # endif 1199 #endif 1200 1201 /* 1202 * The following gobbledygook brought to you on behalf of __STDC__. 1203 * (I could just use #ifndef __STDC__, but this is more bulletproof 1204 * in the face of half-implementations.) 1205 */ 1206 1207 #if defined(I_SYSMODE) && !defined(PERL_MICRO) 1208 #include <sys/mode.h> 1209 #endif 1210 1211 #ifndef S_IFMT 1212 # ifdef _S_IFMT 1213 # define S_IFMT _S_IFMT 1214 # else 1215 # define S_IFMT 0170000 1216 # endif 1217 #endif 1218 1219 #ifndef S_ISDIR 1220 # define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR) 1221 #endif 1222 1223 #ifndef S_ISCHR 1224 # define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR) 1225 #endif 1226 1227 #ifndef S_ISBLK 1228 # ifdef S_IFBLK 1229 # define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK) 1230 # else 1231 # define S_ISBLK(m) (0) 1232 # endif 1233 #endif 1234 1235 #ifndef S_ISREG 1236 # define S_ISREG(m) ((m & S_IFMT) == S_IFREG) 1237 #endif 1238 1239 #ifndef S_ISFIFO 1240 # ifdef S_IFIFO 1241 # define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO) 1242 # else 1243 # define S_ISFIFO(m) (0) 1244 # endif 1245 #endif 1246 1247 #ifndef S_ISLNK 1248 # ifdef _S_ISLNK 1249 # define S_ISLNK(m) _S_ISLNK(m) 1250 # else 1251 # ifdef _S_IFLNK 1252 # define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK) 1253 # else 1254 # ifdef S_IFLNK 1255 # define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK) 1256 # else 1257 # define S_ISLNK(m) (0) 1258 # endif 1259 # endif 1260 # endif 1261 #endif 1262 1263 #ifndef S_ISSOCK 1264 # ifdef _S_ISSOCK 1265 # define S_ISSOCK(m) _S_ISSOCK(m) 1266 # else 1267 # ifdef _S_IFSOCK 1268 # define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK) 1269 # else 1270 # ifdef S_IFSOCK 1271 # define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK) 1272 # else 1273 # define S_ISSOCK(m) (0) 1274 # endif 1275 # endif 1276 # endif 1277 #endif 1278 1279 #ifndef S_IRUSR 1280 # ifdef S_IREAD 1281 # define S_IRUSR S_IREAD 1282 # define S_IWUSR S_IWRITE 1283 # define S_IXUSR S_IEXEC 1284 # else 1285 # define S_IRUSR 0400 1286 # define S_IWUSR 0200 1287 # define S_IXUSR 0100 1288 # endif 1289 #endif 1290 1291 #ifndef S_IRGRP 1292 # ifdef S_IRUSR 1293 # define S_IRGRP (S_IRUSR>>3) 1294 # define S_IWGRP (S_IWUSR>>3) 1295 # define S_IXGRP (S_IXUSR>>3) 1296 # else 1297 # define S_IRGRP 0040 1298 # define S_IWGRP 0020 1299 # define S_IXGRP 0010 1300 # endif 1301 #endif 1302 1303 #ifndef S_IROTH 1304 # ifdef S_IRUSR 1305 # define S_IROTH (S_IRUSR>>6) 1306 # define S_IWOTH (S_IWUSR>>6) 1307 # define S_IXOTH (S_IXUSR>>6) 1308 # else 1309 # define S_IROTH 0040 1310 # define S_IWOTH 0020 1311 # define S_IXOTH 0010 1312 # endif 1313 #endif 1314 1315 #ifndef S_ISUID 1316 # define S_ISUID 04000 1317 #endif 1318 1319 #ifndef S_ISGID 1320 # define S_ISGID 02000 1321 #endif 1322 1323 #ifndef S_IRWXU 1324 # define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) 1325 #endif 1326 1327 #ifndef S_IRWXG 1328 # define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) 1329 #endif 1330 1331 #ifndef S_IRWXO 1332 # define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) 1333 #endif 1334 1335 /* BeOS 5.0 seems to define S_IREAD and S_IWRITE in <posix/fcntl.h> 1336 * which would get included through <sys/file.h >, but that is 3000 1337 * lines in the future. --jhi */ 1338 1339 #if !defined(S_IREAD) && !defined(__BEOS__) 1340 # define S_IREAD S_IRUSR 1341 #endif 1342 1343 #if !defined(S_IWRITE) && !defined(__BEOS__) 1344 # define S_IWRITE S_IWUSR 1345 #endif 1346 1347 #ifndef S_IEXEC 1348 # define S_IEXEC S_IXUSR 1349 #endif 1350 1351 #ifdef ff_next 1352 # undef ff_next 1353 #endif 1354 1355 #if defined(cray) || defined(gould) || defined(i860) || defined(pyr) 1356 # define SLOPPYDIVIDE 1357 #endif 1358 1359 #ifdef UV 1360 #undef UV 1361 #endif 1362 1363 #ifdef SPRINTF_E_BUG 1364 # define sprintf UTS_sprintf_wrap 1365 #endif 1366 1367 /* Configure gets this right but the UTS compiler gets it wrong. 1368 -- Hal Morris <hom00@utsglobal.com> */ 1369 #ifdef UTS 1370 # undef UVTYPE 1371 # define UVTYPE unsigned 1372 #endif 1373 1374 /* 1375 The IV type is supposed to be long enough to hold any integral 1376 value or a pointer. 1377 --Andy Dougherty August 1996 1378 */ 1379 1380 typedef IVTYPE IV; 1381 typedef UVTYPE UV; 1382 1383 #if defined(USE_64_BIT_INT) && defined(HAS_QUAD) 1384 # if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX) 1385 # define IV_MAX INT64_MAX 1386 # define IV_MIN INT64_MIN 1387 # define UV_MAX UINT64_MAX 1388 # ifndef UINT64_MIN 1389 # define UINT64_MIN 0 1390 # endif 1391 # define UV_MIN UINT64_MIN 1392 # else 1393 # define IV_MAX PERL_QUAD_MAX 1394 # define IV_MIN PERL_QUAD_MIN 1395 # define UV_MAX PERL_UQUAD_MAX 1396 # define UV_MIN PERL_UQUAD_MIN 1397 # endif 1398 # define IV_IS_QUAD 1399 # define UV_IS_QUAD 1400 #else 1401 # if defined(INT32_MAX) && IVSIZE == 4 1402 # define IV_MAX INT32_MAX 1403 # define IV_MIN INT32_MIN 1404 # ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ 1405 # define UV_MAX UINT32_MAX 1406 # else 1407 # define UV_MAX 4294967295U 1408 # endif 1409 # ifndef UINT32_MIN 1410 # define UINT32_MIN 0 1411 # endif 1412 # define UV_MIN UINT32_MIN 1413 # else 1414 # define IV_MAX PERL_LONG_MAX 1415 # define IV_MIN PERL_LONG_MIN 1416 # define UV_MAX PERL_ULONG_MAX 1417 # define UV_MIN PERL_ULONG_MIN 1418 # endif 1419 # if IVSIZE == 8 1420 # define IV_IS_QUAD 1421 # define UV_IS_QUAD 1422 # ifndef HAS_QUAD 1423 # define HAS_QUAD 1424 # endif 1425 # else 1426 # undef IV_IS_QUAD 1427 # undef UV_IS_QUAD 1428 # undef HAS_QUAD 1429 # endif 1430 #endif 1431 1432 #ifndef HAS_QUAD 1433 # undef PERL_NEED_MY_HTOLE64 1434 # undef PERL_NEED_MY_LETOH64 1435 # undef PERL_NEED_MY_HTOBE64 1436 # undef PERL_NEED_MY_BETOH64 1437 #endif 1438 1439 #if defined(uts) || defined(UTS) 1440 # undef UV_MAX 1441 # define UV_MAX (4294967295u) 1442 #endif 1443 1444 #define IV_DIG (BIT_DIGITS(IVSIZE * 8)) 1445 #define UV_DIG (BIT_DIGITS(UVSIZE * 8)) 1446 1447 #ifndef NO_PERL_PRESERVE_IVUV 1448 #define PERL_PRESERVE_IVUV /* We like our integers to stay integers. */ 1449 #endif 1450 1451 /* 1452 * The macros INT2PTR and NUM2PTR are (despite their names) 1453 * bi-directional: they will convert int/float to or from pointers. 1454 * However the conversion to int/float are named explicitly: 1455 * PTR2IV, PTR2UV, PTR2NV. 1456 * 1457 * For int conversions we do not need two casts if pointers are 1458 * the same size as IV and UV. Otherwise we need an explicit 1459 * cast (PTRV) to avoid compiler warnings. 1460 */ 1461 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) 1462 # define PTRV UV 1463 # define INT2PTR(any,d) (any)(d) 1464 #else 1465 # if PTRSIZE == LONGSIZE 1466 # define PTRV unsigned long 1467 # define PTR2ul(p) (unsigned long)(p) 1468 # else 1469 # define PTRV unsigned 1470 # endif 1471 #endif 1472 1473 #ifndef INT2PTR 1474 # define INT2PTR(any,d) (any)(PTRV)(d) 1475 #endif 1476 1477 #ifndef PTR2ul 1478 # define PTR2ul(p) INT2PTR(unsigned long,p) 1479 #endif 1480 1481 #define NUM2PTR(any,d) (any)(PTRV)(d) 1482 #define PTR2IV(p) INT2PTR(IV,p) 1483 #define PTR2UV(p) INT2PTR(UV,p) 1484 #define PTR2NV(p) NUM2PTR(NV,p) 1485 #define PTR2nat(p) (PTRV)(p) /* pointer to integer of PTRSIZE */ 1486 1487 /* According to strict ANSI C89 one cannot freely cast between 1488 * data pointers and function (code) pointers. There are at least 1489 * two ways around this. One (used below) is to do two casts, 1490 * first the other pointer to an (unsigned) integer, and then 1491 * the integer to the other pointer. The other way would be 1492 * to use unions to "overlay" the pointers. For an example of 1493 * the latter technique, see union dirpu in struct xpvio in sv.h. 1494 * The only feasible use is probably temporarily storing 1495 * function pointers in a data pointer (such as a void pointer). */ 1496 1497 #define DPTR2FPTR(t,p) ((t)PTR2nat(p)) /* data pointer to function pointer */ 1498 #define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */ 1499 1500 #ifdef USE_LONG_DOUBLE 1501 # if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE 1502 # define LONG_DOUBLE_EQUALS_DOUBLE 1503 # endif 1504 # if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)) 1505 # undef USE_LONG_DOUBLE /* Ouch! */ 1506 # endif 1507 #endif 1508 1509 #ifdef OVR_DBL_DIG 1510 /* Use an overridden DBL_DIG */ 1511 # ifdef DBL_DIG 1512 # undef DBL_DIG 1513 # endif 1514 # define DBL_DIG OVR_DBL_DIG 1515 #else 1516 /* The following is all to get DBL_DIG, in order to pick a nice 1517 default value for printing floating point numbers in Gconvert 1518 (see config.h). (It also has other uses, such as figuring out if 1519 a given precision of printing can be done with a double instead of 1520 a long double - Allen). 1521 */ 1522 #ifdef I_LIMITS 1523 #include <limits.h> 1524 #endif 1525 #ifdef I_FLOAT 1526 #include <float.h> 1527 #endif 1528 #ifndef HAS_DBL_DIG 1529 #define DBL_DIG 15 /* A guess that works lots of places */ 1530 #endif 1531 #endif 1532 #ifdef I_FLOAT 1533 #include <float.h> 1534 #endif 1535 #ifndef HAS_DBL_DIG 1536 #define DBL_DIG 15 /* A guess that works lots of places */ 1537 #endif 1538 1539 #ifdef OVR_LDBL_DIG 1540 /* Use an overridden LDBL_DIG */ 1541 # ifdef LDBL_DIG 1542 # undef LDBL_DIG 1543 # endif 1544 # define LDBL_DIG OVR_LDBL_DIG 1545 #else 1546 /* The following is all to get LDBL_DIG, in order to pick a nice 1547 default value for printing floating point numbers in Gconvert. 1548 (see config.h) 1549 */ 1550 # ifdef I_LIMITS 1551 # include <limits.h> 1552 # endif 1553 # ifdef I_FLOAT 1554 # include <float.h> 1555 # endif 1556 # ifndef HAS_LDBL_DIG 1557 # if LONG_DOUBLESIZE == 10 1558 # define LDBL_DIG 18 /* assume IEEE */ 1559 # else 1560 # if LONG_DOUBLESIZE == 12 1561 # define LDBL_DIG 18 /* gcc? */ 1562 # else 1563 # if LONG_DOUBLESIZE == 16 1564 # define LDBL_DIG 33 /* assume IEEE */ 1565 # else 1566 # if LONG_DOUBLESIZE == DOUBLESIZE 1567 # define LDBL_DIG DBL_DIG /* bummer */ 1568 # endif 1569 # endif 1570 # endif 1571 # endif 1572 # endif 1573 #endif 1574 1575 /* 1576 * This is for making sure we have a good DBL_MAX value, if possible, 1577 * either for usage as NV_MAX or for usage in figuring out if we can 1578 * fit a given long double into a double, if bug-fixing makes it 1579 * necessary to do so. - Allen <allens@cpan.org> 1580 */ 1581 1582 #ifdef I_LIMITS 1583 # include <limits.h> 1584 #endif 1585 1586 #ifdef I_VALUES 1587 # if !(defined(DBL_MIN) && defined(DBL_MAX) && defined(I_LIMITS)) 1588 # include <values.h> 1589 # if defined(MAXDOUBLE) && !defined(DBL_MAX) 1590 # define DBL_MAX MAXDOUBLE 1591 # endif 1592 # if defined(MINDOUBLE) && !defined(DBL_MIN) 1593 # define DBL_MIN MINDOUBLE 1594 # endif 1595 # endif 1596 #endif /* defined(I_VALUES) */ 1597 1598 typedef NVTYPE NV; 1599 1600 #ifdef I_IEEEFP 1601 # include <ieeefp.h> 1602 #endif 1603 1604 #ifdef USE_LONG_DOUBLE 1605 # ifdef I_SUNMATH 1606 # include <sunmath.h> 1607 # endif 1608 # define NV_DIG LDBL_DIG 1609 # ifdef LDBL_MANT_DIG 1610 # define NV_MANT_DIG LDBL_MANT_DIG 1611 # endif 1612 # ifdef LDBL_MIN 1613 # define NV_MIN LDBL_MIN 1614 # endif 1615 # ifdef LDBL_MAX 1616 # define NV_MAX LDBL_MAX 1617 # endif 1618 # ifdef LDBL_MIN_10_EXP 1619 # define NV_MIN_10_EXP LDBL_MIN_10_EXP 1620 # endif 1621 # ifdef LDBL_MAX_10_EXP 1622 # define NV_MAX_10_EXP LDBL_MAX_10_EXP 1623 # endif 1624 # ifdef LDBL_EPSILON 1625 # define NV_EPSILON LDBL_EPSILON 1626 # endif 1627 # ifdef LDBL_MAX 1628 # define NV_MAX LDBL_MAX 1629 /* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */ 1630 # else 1631 # ifdef HUGE_VALL 1632 # define NV_MAX HUGE_VALL 1633 # else 1634 # ifdef HUGE_VAL 1635 # define NV_MAX ((NV)HUGE_VAL) 1636 # endif 1637 # endif 1638 # endif 1639 # ifdef HAS_SQRTL 1640 # define Perl_cos cosl 1641 # define Perl_sin sinl 1642 # define Perl_sqrt sqrtl 1643 # define Perl_exp expl 1644 # define Perl_log logl 1645 # define Perl_atan2 atan2l 1646 # define Perl_pow powl 1647 # define Perl_floor floorl 1648 # define Perl_ceil ceill 1649 # define Perl_fmod fmodl 1650 # endif 1651 /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */ 1652 # ifdef HAS_MODFL 1653 # define Perl_modf(x,y) modfl(x,y) 1654 /* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no 1655 prototype in <math.h> */ 1656 # ifndef HAS_MODFL_PROTO 1657 EXTERN_C long double modfl(long double, long double *); 1658 # endif 1659 # else 1660 # if defined(HAS_AINTL) && defined(HAS_COPYSIGNL) 1661 extern long double Perl_my_modfl(long double x, long double *ip); 1662 # define Perl_modf(x,y) Perl_my_modfl(x,y) 1663 # endif 1664 # endif 1665 # ifdef HAS_FREXPL 1666 # define Perl_frexp(x,y) frexpl(x,y) 1667 # else 1668 # if defined(HAS_ILOGBL) && defined(HAS_SCALBNL) 1669 extern long double Perl_my_frexpl(long double x, int *e); 1670 # define Perl_frexp(x,y) Perl_my_frexpl(x,y) 1671 # endif 1672 # endif 1673 # ifndef Perl_isnan 1674 # ifdef HAS_ISNANL 1675 # define Perl_isnan(x) isnanl(x) 1676 # endif 1677 # endif 1678 # ifndef Perl_isinf 1679 # ifdef HAS_FINITEL 1680 # define Perl_isinf(x) !(finitel(x)||Perl_isnan(x)) 1681 # endif 1682 # endif 1683 #else 1684 # define NV_DIG DBL_DIG 1685 # ifdef DBL_MANT_DIG 1686 # define NV_MANT_DIG DBL_MANT_DIG 1687 # endif 1688 # ifdef DBL_MIN 1689 # define NV_MIN DBL_MIN 1690 # endif 1691 # ifdef DBL_MAX 1692 # define NV_MAX DBL_MAX 1693 # endif 1694 # ifdef DBL_MIN_10_EXP 1695 # define NV_MIN_10_EXP DBL_MIN_10_EXP 1696 # endif 1697 # ifdef DBL_MAX_10_EXP 1698 # define NV_MAX_10_EXP DBL_MAX_10_EXP 1699 # endif 1700 # ifdef DBL_EPSILON 1701 # define NV_EPSILON DBL_EPSILON 1702 # endif 1703 # ifdef DBL_MAX /* XXX Does DBL_MAX imply having DBL_MIN? */ 1704 # define NV_MAX DBL_MAX 1705 # define NV_MIN DBL_MIN 1706 # else 1707 # ifdef HUGE_VAL 1708 # define NV_MAX HUGE_VAL 1709 # endif 1710 # endif 1711 # define Perl_cos cos 1712 # define Perl_sin sin 1713 # define Perl_sqrt sqrt 1714 # define Perl_exp exp 1715 # define Perl_log log 1716 # define Perl_atan2 atan2 1717 # define Perl_pow pow 1718 # define Perl_floor floor 1719 # define Perl_ceil ceil 1720 # define Perl_fmod fmod 1721 # define Perl_modf(x,y) modf(x,y) 1722 # define Perl_frexp(x,y) frexp(x,y) 1723 #endif 1724 1725 /* rumor has it that Win32 has _fpclass() */ 1726 1727 /* SGI has fpclassl... but not with the same result values, 1728 * and it's via a typedef (not via #define), so will need to redo Configure 1729 * to use. Not worth the trouble, IMO, at least until the below is used 1730 * more places. Also has fp_class_l, BTW, via fp_class.h. Feel free to check 1731 * with me for the SGI manpages, SGI testing, etcetera, if you want to 1732 * try getting this to work with IRIX. - Allen <allens@cpan.org> */ 1733 1734 #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL)) 1735 # ifdef I_IEEFP 1736 # include <ieeefp.h> 1737 # endif 1738 # ifdef I_FP 1739 # include <fp.h> 1740 # endif 1741 # if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL) 1742 # define Perl_fp_class() fpclassl(x) 1743 # else 1744 # define Perl_fp_class() fpclass(x) 1745 # endif 1746 # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_CLASS_SNAN) 1747 # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_CLASS_QNAN) 1748 # define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_CLASS_SNAN||Perl_fp_class(x)==FP_CLASS_QNAN) 1749 # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF) 1750 # define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_CLASS_PINF) 1751 # define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_CLASS_NINF||Perl_fp_class(x)==FP_CLASS_PINF) 1752 # define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_CLASS_NNORM) 1753 # define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_CLASS_PNORM) 1754 # define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_CLASS_NNORM||Perl_fp_class(x)==FP_CLASS_PNORM) 1755 # define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM) 1756 # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_CLASS_PDENORM) 1757 # define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM||Perl_fp_class(x)==FP_CLASS_PDENORM) 1758 # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_CLASS_NZERO) 1759 # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_CLASS_PZERO) 1760 # define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_CLASS_NZERO||Perl_fp_class(x)==FP_CLASS_PZERO) 1761 #endif 1762 1763 #if !defined(Perl_fp_class) && defined(HAS_FP_CLASS) && !defined(PERL_MICRO) 1764 # include <math.h> 1765 # if !defined(FP_SNAN) && defined(I_FP_CLASS) 1766 # include <fp_class.h> 1767 # endif 1768 # define Perl_fp_class(x) fp_class(x) 1769 # define Perl_fp_class_snan(x) (fp_class(x)==FP_SNAN) 1770 # define Perl_fp_class_qnan(x) (fp_class(x)==FP_QNAN) 1771 # define Perl_fp_class_nan(x) (fp_class(x)==FP_SNAN||fp_class(x)==FP_QNAN) 1772 # define Perl_fp_class_ninf(x) (fp_class(x)==FP_NEG_INF) 1773 # define Perl_fp_class_pinf(x) (fp_class(x)==FP_POS_INF) 1774 # define Perl_fp_class_inf(x) (fp_class(x)==FP_NEG_INF||fp_class(x)==FP_POS_INF) 1775 # define Perl_fp_class_nnorm(x) (fp_class(x)==FP_NEG_NORM) 1776 # define Perl_fp_class_pnorm(x) (fp_class(x)==FP_POS_NORM) 1777 # define Perl_fp_class_norm(x) (fp_class(x)==FP_NEG_NORM||fp_class(x)==FP_POS_NORM) 1778 # define Perl_fp_class_ndenorm(x) (fp_class(x)==FP_NEG_DENORM) 1779 # define Perl_fp_class_pdenorm(x) (fp_class(x)==FP_POS_DENORM) 1780 # define Perl_fp_class_denorm(x) (fp_class(x)==FP_NEG_DENORM||fp_class(x)==FP_POS_DENORM) 1781 # define Perl_fp_class_nzero(x) (fp_class(x)==FP_NEG_ZERO) 1782 # define Perl_fp_class_pzero(x) (fp_class(x)==FP_POS_ZERO) 1783 # define Perl_fp_class_zero(x) (fp_class(x)==FP_NEG_ZERO||fp_class(x)==FP_POS_ZERO) 1784 #endif 1785 1786 #if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY) 1787 # include <math.h> 1788 # define Perl_fp_class(x) fpclassify(x) 1789 # define Perl_fp_class_nan(x) (fp_classify(x)==FP_SNAN||fp_classify(x)==FP_QNAN) 1790 # define Perl_fp_class_inf(x) (fp_classify(x)==FP_INFINITE) 1791 # define Perl_fp_class_norm(x) (fp_classify(x)==FP_NORMAL) 1792 # define Perl_fp_class_denorm(x) (fp_classify(x)==FP_SUBNORMAL) 1793 # define Perl_fp_class_zero(x) (fp_classify(x)==FP_ZERO) 1794 #endif 1795 1796 #if !defined(Perl_fp_class) && defined(HAS_CLASS) 1797 # include <math.h> 1798 # ifndef _cplusplus 1799 # define Perl_fp_class(x) class(x) 1800 # else 1801 # define Perl_fp_class(x) _class(x) 1802 # endif 1803 # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS) 1804 # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ) 1805 # define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_SNAN||Perl_fp_class(x)==FP_QNAN) 1806 # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) 1807 # define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) 1808 # define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_MINUS_INF||Perl_fp_class(x)==FP_PLUS_INF) 1809 # define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) 1810 # define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) 1811 # define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_MINUS_NORM||Perl_fp_class(x)==FP_PLUS_NORM) 1812 # define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) 1813 # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) 1814 # define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM||Perl_fp_class(x)==FP_PLUS_DENORM) 1815 # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) 1816 # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) 1817 # define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_MINUS_ZERO||Perl_fp_class(x)==FP_PLUS_ZERO) 1818 #endif 1819 1820 /* rumor has it that Win32 has _isnan() */ 1821 1822 #ifndef Perl_isnan 1823 # ifdef HAS_ISNAN 1824 # define Perl_isnan(x) isnan((NV)x) 1825 # else 1826 # ifdef Perl_fp_class_nan 1827 # define Perl_isnan(x) Perl_fp_class_nan(x) 1828 # else 1829 # ifdef HAS_UNORDERED 1830 # define Perl_isnan(x) unordered((x), 0.0) 1831 # else 1832 # define Perl_isnan(x) ((x)!=(x)) 1833 # endif 1834 # endif 1835 # endif 1836 #endif 1837 1838 #ifdef UNDER_CE 1839 int isnan(double d); 1840 #endif 1841 1842 #ifndef Perl_isinf 1843 # ifdef HAS_ISINF 1844 # define Perl_isinf(x) isinf((NV)x) 1845 # else 1846 # ifdef Perl_fp_class_inf 1847 # define Perl_isinf(x) Perl_fp_class_inf(x) 1848 # else 1849 # define Perl_isinf(x) ((x)==NV_INF) 1850 # endif 1851 # endif 1852 #endif 1853 1854 #ifndef Perl_isfinite 1855 # ifdef HAS_FINITE 1856 # define Perl_isfinite(x) finite((NV)x) 1857 # else 1858 # ifdef HAS_ISFINITE 1859 # define Perl_isfinite(x) isfinite(x) 1860 # else 1861 # ifdef Perl_fp_class_finite 1862 # define Perl_isfinite(x) Perl_fp_class_finite(x) 1863 # else 1864 # define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x)) 1865 # endif 1866 # endif 1867 # endif 1868 #endif 1869 1870 /* The default is to use Perl's own atof() implementation (in numeric.c). 1871 * Usually that is the one to use but for some platforms (e.g. UNICOS) 1872 * it is however best to use the native implementation of atof. 1873 * You can experiment with using your native one by -DUSE_PERL_ATOF=0. 1874 * Some good tests to try out with either setting are t/base/num.t, 1875 * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles 1876 * you may need to be using a different function than atof! */ 1877 1878 #ifndef USE_PERL_ATOF 1879 # ifndef _UNICOS 1880 # define USE_PERL_ATOF 1881 # endif 1882 #else 1883 # if USE_PERL_ATOF == 0 1884 # undef USE_PERL_ATOF 1885 # endif 1886 #endif 1887 1888 #ifdef USE_PERL_ATOF 1889 # define Perl_atof(s) Perl_my_atof(s) 1890 # define Perl_atof2(s, n) Perl_my_atof2(aTHX_ (s), &(n)) 1891 #else 1892 # define Perl_atof(s) (NV)atof(s) 1893 # define Perl_atof2(s, n) ((n) = atof(s)) 1894 #endif 1895 1896 /* Previously these definitions used hardcoded figures. 1897 * It is hoped these formula are more portable, although 1898 * no data one way or another is presently known to me. 1899 * The "PERL_" names are used because these calculated constants 1900 * do not meet the ANSI requirements for LONG_MAX, etc., which 1901 * need to be constants acceptable to #if - kja 1902 * define PERL_LONG_MAX 2147483647L 1903 * define PERL_LONG_MIN (-LONG_MAX - 1) 1904 * define PERL ULONG_MAX 4294967295L 1905 */ 1906 1907 #ifdef I_LIMITS /* Needed for cast_xxx() functions below. */ 1908 # include <limits.h> 1909 #endif 1910 /* Included values.h above if necessary; still including limits.h down here, 1911 * despite doing above, because math.h might have overriden... XXX - Allen */ 1912 1913 /* 1914 * Try to figure out max and min values for the integral types. THE CORRECT 1915 * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE. The 1916 * following hacks are used if neither limits.h or values.h provide them: 1917 * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0 1918 * for types < int: (unsigned TYPE)~(unsigned)0 1919 * The argument to ~ must be unsigned so that later signed->unsigned 1920 * conversion can't modify the value's bit pattern (e.g. -0 -> +0), 1921 * and it must not be smaller than int because ~ does integral promotion. 1922 * <type>_MAX: (<type>) (U<type>_MAX >> 1) 1923 * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>. 1924 * The latter is a hack which happens to work on some machines but 1925 * does *not* catch any random system, or things like integer types 1926 * with NaN if that is possible. 1927 * 1928 * All of the types are explicitly cast to prevent accidental loss of 1929 * numeric range, and in the hope that they will be less likely to confuse 1930 * over-eager optimizers. 1931 * 1932 */ 1933 1934 #define PERL_UCHAR_MIN ((unsigned char)0) 1935 1936 #ifdef UCHAR_MAX 1937 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) 1938 #else 1939 # ifdef MAXUCHAR 1940 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) 1941 # else 1942 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) 1943 # endif 1944 #endif 1945 1946 /* 1947 * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be 1948 * ambiguous. It may be equivalent to (signed char) or (unsigned char) 1949 * depending on local options. Until Configure detects this (or at least 1950 * detects whether the "signed" keyword is available) the CHAR ranges 1951 * will not be included. UCHAR functions normally. 1952 * - kja 1953 */ 1954 1955 #define PERL_USHORT_MIN ((unsigned short)0) 1956 1957 #ifdef USHORT_MAX 1958 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) 1959 #else 1960 # ifdef MAXUSHORT 1961 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) 1962 # else 1963 # ifdef USHRT_MAX 1964 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) 1965 # else 1966 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) 1967 # endif 1968 # endif 1969 #endif 1970 1971 #ifdef SHORT_MAX 1972 # define PERL_SHORT_MAX ((short)SHORT_MAX) 1973 #else 1974 # ifdef MAXSHORT /* Often used in <values.h> */ 1975 # define PERL_SHORT_MAX ((short)MAXSHORT) 1976 # else 1977 # ifdef SHRT_MAX 1978 # define PERL_SHORT_MAX ((short)SHRT_MAX) 1979 # else 1980 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) 1981 # endif 1982 # endif 1983 #endif 1984 1985 #ifdef SHORT_MIN 1986 # define PERL_SHORT_MIN ((short)SHORT_MIN) 1987 #else 1988 # ifdef MINSHORT 1989 # define PERL_SHORT_MIN ((short)MINSHORT) 1990 # else 1991 # ifdef SHRT_MIN 1992 # define PERL_SHORT_MIN ((short)SHRT_MIN) 1993 # else 1994 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) 1995 # endif 1996 # endif 1997 #endif 1998 1999 #ifdef UINT_MAX 2000 # define PERL_UINT_MAX ((unsigned int)UINT_MAX) 2001 #else 2002 # ifdef MAXUINT 2003 # define PERL_UINT_MAX ((unsigned int)MAXUINT) 2004 # else 2005 # define PERL_UINT_MAX (~(unsigned int)0) 2006 # endif 2007 #endif 2008 2009 #define PERL_UINT_MIN ((unsigned int)0) 2010 2011 #ifdef INT_MAX 2012 # define PERL_INT_MAX ((int)INT_MAX) 2013 #else 2014 # ifdef MAXINT /* Often used in <values.h> */ 2015 # define PERL_INT_MAX ((int)MAXINT) 2016 # else 2017 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) 2018 # endif 2019 #endif 2020 2021 #ifdef INT_MIN 2022 # define PERL_INT_MIN ((int)INT_MIN) 2023 #else 2024 # ifdef MININT 2025 # define PERL_INT_MIN ((int)MININT) 2026 # else 2027 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) 2028 # endif 2029 #endif 2030 2031 #ifdef ULONG_MAX 2032 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) 2033 #else 2034 # ifdef MAXULONG 2035 # define PERL_ULONG_MAX ((unsigned long)MAXULONG) 2036 # else 2037 # define PERL_ULONG_MAX (~(unsigned long)0) 2038 # endif 2039 #endif 2040 2041 #define PERL_ULONG_MIN ((unsigned long)0L) 2042 2043 #ifdef LONG_MAX 2044 # define PERL_LONG_MAX ((long)LONG_MAX) 2045 #else 2046 # ifdef MAXLONG /* Often used in <values.h> */ 2047 # define PERL_LONG_MAX ((long)MAXLONG) 2048 # else 2049 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) 2050 # endif 2051 #endif 2052 2053 #ifdef LONG_MIN 2054 # define PERL_LONG_MIN ((long)LONG_MIN) 2055 #else 2056 # ifdef MINLONG 2057 # define PERL_LONG_MIN ((long)MINLONG) 2058 # else 2059 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) 2060 # endif 2061 #endif 2062 2063 #ifdef UV_IS_QUAD 2064 2065 # define PERL_UQUAD_MAX (~(UV)0) 2066 # define PERL_UQUAD_MIN ((UV)0) 2067 # define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1)) 2068 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) 2069 2070 #endif 2071 2072 #ifdef MYMALLOC 2073 # include "malloc_ctl.h" 2074 #endif 2075 2076 struct RExC_state_t; 2077 2078 typedef MEM_SIZE STRLEN; 2079 2080 typedef struct op OP; 2081 typedef struct cop COP; 2082 typedef struct unop UNOP; 2083 typedef struct binop BINOP; 2084 typedef struct listop LISTOP; 2085 typedef struct logop LOGOP; 2086 typedef struct pmop PMOP; 2087 typedef struct svop SVOP; 2088 typedef struct padop PADOP; 2089 typedef struct pvop PVOP; 2090 typedef struct loop LOOP; 2091 2092 typedef struct interpreter PerlInterpreter; 2093 2094 /* Amdahl's <ksync.h> has struct sv */ 2095 /* SGI's <sys/sema.h> has struct sv */ 2096 #if defined(UTS) || defined(__sgi) 2097 # define STRUCT_SV perl_sv 2098 #else 2099 # define STRUCT_SV sv 2100 #endif 2101 typedef struct STRUCT_SV SV; 2102 typedef struct av AV; 2103 typedef struct hv HV; 2104 typedef struct cv CV; 2105 typedef struct regexp REGEXP; 2106 typedef struct gp GP; 2107 typedef struct gv GV; 2108 typedef struct io IO; 2109 typedef struct context PERL_CONTEXT; 2110 typedef struct block BLOCK; 2111 2112 typedef struct magic MAGIC; 2113 typedef struct xrv XRV; 2114 typedef struct xpv XPV; 2115 typedef struct xpviv XPVIV; 2116 typedef struct xpvuv XPVUV; 2117 typedef struct xpvnv XPVNV; 2118 typedef struct xpvmg XPVMG; 2119 typedef struct xpvlv XPVLV; 2120 typedef struct xpvav XPVAV; 2121 typedef struct xpvhv XPVHV; 2122 typedef struct xpvgv XPVGV; 2123 typedef struct xpvcv XPVCV; 2124 typedef struct xpvbm XPVBM; 2125 typedef struct xpvfm XPVFM; 2126 typedef struct xpvio XPVIO; 2127 typedef struct mgvtbl MGVTBL; 2128 typedef union any ANY; 2129 typedef struct ptr_tbl_ent PTR_TBL_ENT_t; 2130 typedef struct ptr_tbl PTR_TBL_t; 2131 typedef struct clone_params CLONE_PARAMS; 2132 2133 #include "handy.h" 2134 2135 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) 2136 # if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO) 2137 # define USE_64_BIT_RAWIO /* implicit */ 2138 # endif 2139 #endif 2140 2141 /* Notice the use of HAS_FSEEKO: now we are obligated to always use 2142 * fseeko/ftello if possible. Don't go #defining ftell to ftello yourself, 2143 * however, because operating systems like to do that themself. */ 2144 #ifndef FSEEKSIZE 2145 # ifdef HAS_FSEEKO 2146 # define FSEEKSIZE LSEEKSIZE 2147 # else 2148 # define FSEEKSIZE LONGSIZE 2149 # endif 2150 #endif 2151 2152 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO) 2153 # if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO) 2154 # define USE_64_BIT_STDIO /* implicit */ 2155 # endif 2156 #endif 2157 2158 #ifdef USE_64_BIT_RAWIO 2159 # ifdef HAS_OFF64_T 2160 # undef Off_t 2161 # define Off_t off64_t 2162 # undef LSEEKSIZE 2163 # define LSEEKSIZE 8 2164 # endif 2165 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that 2166 * will trigger defines like the ones below. Some 64-bit environments, 2167 * however, do not. Therefore we have to explicitly mix and match. */ 2168 # if defined(USE_OPEN64) 2169 # define open open64 2170 # endif 2171 # if defined(USE_LSEEK64) 2172 # define lseek lseek64 2173 # else 2174 # if defined(USE_LLSEEK) 2175 # define lseek llseek 2176 # endif 2177 # endif 2178 # if defined(USE_STAT64) 2179 # define stat stat64 2180 # endif 2181 # if defined(USE_FSTAT64) 2182 # define fstat fstat64 2183 # endif 2184 # if defined(USE_LSTAT64) 2185 # define lstat lstat64 2186 # endif 2187 # if defined(USE_FLOCK64) 2188 # define flock flock64 2189 # endif 2190 # if defined(USE_LOCKF64) 2191 # define lockf lockf64 2192 # endif 2193 # if defined(USE_FCNTL64) 2194 # define fcntl fcntl64 2195 # endif 2196 # if defined(USE_TRUNCATE64) 2197 # define truncate truncate64 2198 # endif 2199 # if defined(USE_FTRUNCATE64) 2200 # define ftruncate ftruncate64 2201 # endif 2202 #endif 2203 2204 #ifdef USE_64_BIT_STDIO 2205 # ifdef HAS_FPOS64_T 2206 # undef Fpos_t 2207 # define Fpos_t fpos64_t 2208 # endif 2209 /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that 2210 * will trigger defines like the ones below. Some 64-bit environments, 2211 * however, do not. */ 2212 # if defined(USE_FOPEN64) 2213 # define fopen fopen64 2214 # endif 2215 # if defined(USE_FSEEK64) 2216 # define fseek fseek64 /* don't do fseeko here, see perlio.c */ 2217 # endif 2218 # if defined(USE_FTELL64) 2219 # define ftell ftell64 /* don't do ftello here, see perlio.c */ 2220 # endif 2221 # if defined(USE_FSETPOS64) 2222 # define fsetpos fsetpos64 2223 # endif 2224 # if defined(USE_FGETPOS64) 2225 # define fgetpos fgetpos64 2226 # endif 2227 # if defined(USE_TMPFILE64) 2228 # define tmpfile tmpfile64 2229 # endif 2230 # if defined(USE_FREOPEN64) 2231 # define freopen freopen64 2232 # endif 2233 #endif 2234 2235 #if defined(OS2) || defined(MACOS_TRADITIONAL) 2236 # include "iperlsys.h" 2237 #endif 2238 2239 #if defined(__OPEN_VM) 2240 # include "vmesa/vmesaish.h" 2241 # define ISHISH "vmesa" 2242 #endif 2243 2244 #ifdef DOSISH 2245 # if defined(OS2) 2246 # include "os2ish.h" 2247 # else 2248 # include "dosish.h" 2249 # endif 2250 # define ISHISH "dos" 2251 #endif 2252 2253 #if defined(VMS) 2254 # include "vmsish.h" 2255 # include "embed.h" 2256 # define ISHISH "vms" 2257 #endif 2258 2259 #if defined(PLAN9) 2260 # include "./plan9/plan9ish.h" 2261 # define ISHISH "plan9" 2262 #endif 2263 2264 #if defined(MPE) 2265 # include "mpeix/mpeixish.h" 2266 # define ISHISH "mpeix" 2267 #endif 2268 2269 #if defined(__VOS__) 2270 # ifdef __GNUC__ 2271 # include "./vos/vosish.h" 2272 # else 2273 # include "vos/vosish.h" 2274 # endif 2275 # define ISHISH "vos" 2276 #endif 2277 2278 #if defined(EPOC) 2279 # include "epocish.h" 2280 # define ISHISH "epoc" 2281 #endif 2282 2283 #if defined(MACOS_TRADITIONAL) 2284 # include "macos/macish.h" 2285 # ifndef NO_ENVIRON_ARRAY 2286 # define NO_ENVIRON_ARRAY 2287 # endif 2288 # define ISHISH "macos classic" 2289 #endif 2290 2291 #if defined(__BEOS__) 2292 # include "beos/beosish.h" 2293 # define ISHISH "beos" 2294 #endif 2295 2296 #ifndef ISHISH 2297 # include "unixish.h" 2298 # define ISHISH "unix" 2299 #endif 2300 2301 #ifndef NO_ENVIRON_ARRAY 2302 # define USE_ENVIRON_ARRAY 2303 #endif 2304 2305 /* 2306 * initialise to avoid floating-point exceptions from overflow, etc 2307 */ 2308 #ifndef PERL_FPU_INIT 2309 # ifdef HAS_FPSETMASK 2310 # if HAS_FLOATINGPOINT_H 2311 # include <floatingpoint.h> 2312 # endif 2313 # define PERL_FPU_INIT fpsetmask(0); 2314 # else 2315 # if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO) 2316 # define PERL_FPU_INIT PL_sigfpe_saved = signal(SIGFPE, SIG_IGN); 2317 # define PERL_FPU_PRE_EXEC { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe); 2318 # define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); } 2319 # else 2320 # define PERL_FPU_INIT 2321 2322 # endif 2323 # endif 2324 #endif 2325 #ifndef PERL_FPU_PRE_EXEC 2326 # define PERL_FPU_PRE_EXEC { 2327 # define PERL_FPU_POST_EXEC } 2328 #endif 2329 2330 #ifndef PERL_SYS_INIT3 2331 # define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp) 2332 #endif 2333 2334 #ifndef PERL_WRITE_MSG_TO_CONSOLE 2335 # define PERL_WRITE_MSG_TO_CONSOLE(io, msg, len) PerlIO_write(io, msg, len) 2336 #endif 2337 2338 #ifndef MAXPATHLEN 2339 # ifdef PATH_MAX 2340 # ifdef _POSIX_PATH_MAX 2341 # if PATH_MAX > _POSIX_PATH_MAX 2342 /* POSIX 1990 (and pre) was ambiguous about whether PATH_MAX 2343 * included the null byte or not. Later amendments of POSIX, 2344 * XPG4, the Austin Group, and the Single UNIX Specification 2345 * all explicitly include the null byte in the PATH_MAX. 2346 * Ditto for _POSIX_PATH_MAX. */ 2347 # define MAXPATHLEN PATH_MAX 2348 # else 2349 # define MAXPATHLEN _POSIX_PATH_MAX 2350 # endif 2351 # else 2352 # define MAXPATHLEN (PATH_MAX+1) 2353 # endif 2354 # else 2355 # ifdef _POSIX_PATH_MAX 2356 # define MAXPATHLEN _POSIX_PATH_MAX 2357 # else 2358 # define MAXPATHLEN 1024 /* Err on the large side. */ 2359 # endif 2360 # endif 2361 #endif 2362 2363 /* In case Configure was not used (we are using a "canned config" 2364 * such as Win32, or a cross-compilation setup, for example) try going 2365 * by the gcc major and minor versions. One useful URL is 2366 * http://www.ohse.de/uwe/articles/gcc-attributes.html, 2367 * but contrary to this information warn_unused_result seems 2368 * not to be in gcc 3.3.5, at least. --jhi 2369 * Also, when building extensions with an installed perl, this allows 2370 * the user to upgrade gcc and get the right attributes, rather than 2371 * relying on the list generated at Configure time. --AD 2372 * Set these up now otherwise we get confused when some of the <*thread.h> 2373 * includes below indirectly pull in <perlio.h> (which needs to know if we 2374 * have HASATTRIBUTE_FORMAT). 2375 */ 2376 2377 #if defined __GNUC__ && !defined(__INTEL_COMPILER) 2378 # if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */ 2379 # define HASATTRIBUTE_FORMAT 2380 # if defined __MINGW32__ 2381 # define PRINTF_FORMAT_NULL_OK 2382 # endif 2383 # endif 2384 # if __GNUC__ >= 3 /* 3.0 -> */ 2385 # define HASATTRIBUTE_MALLOC 2386 # endif 2387 # if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */ 2388 # define HASATTRIBUTE_NONNULL 2389 # endif 2390 # if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */ 2391 # define HASATTRIBUTE_NORETURN 2392 # endif 2393 # if __GNUC__ >= 3 /* gcc 3.0 -> */ 2394 # define HASATTRIBUTE_PURE 2395 # endif 2396 # if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ 2397 # define HASATTRIBUTE_UNUSED 2398 # endif 2399 # if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus) 2400 # define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */ 2401 # endif 2402 # if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ 2403 # define HASATTRIBUTE_WARN_UNUSED_RESULT 2404 # endif 2405 #endif 2406 2407 /* USE_5005THREADS needs to be after unixish.h as <pthread.h> includes 2408 * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h> 2409 * this results in many functions being undeclared which bothers C++ 2410 * May make sense to have threads after "*ish.h" anyway 2411 */ 2412 2413 #if defined(USE_ITHREADS) 2414 # ifdef NETWARE 2415 # include <nw5thread.h> 2416 # else 2417 # ifdef FAKE_THREADS 2418 # include "fakethr.h" 2419 # else 2420 # ifdef WIN32 2421 # include <win32thread.h> 2422 # else 2423 # ifdef OS2 2424 # include "os2thread.h" 2425 # else 2426 # ifdef I_MACH_CTHREADS 2427 # include <mach/cthreads.h> 2428 # if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC) 2429 # define MUTEX_INIT_CALLS_MALLOC 2430 # endif 2431 typedef cthread_t perl_os_thread; 2432 typedef mutex_t perl_mutex; 2433 typedef condition_t perl_cond; 2434 typedef void * perl_key; 2435 # else /* Posix threads */ 2436 # ifdef I_PTHREAD 2437 # include <pthread.h> 2438 # endif 2439 typedef pthread_t perl_os_thread; 2440 typedef pthread_mutex_t perl_mutex; 2441 typedef pthread_cond_t perl_cond; 2442 typedef pthread_key_t perl_key; 2443 # endif /* I_MACH_CTHREADS */ 2444 # endif /* OS2 */ 2445 # endif /* WIN32 */ 2446 # endif /* FAKE_THREADS */ 2447 #endif /* NETWARE */ 2448 #endif /* USE_5005THREADS || USE_ITHREADS */ 2449 2450 #if defined(WIN32) 2451 # include "win32.h" 2452 #endif 2453 2454 #ifdef NETWARE 2455 # include "netware.h" 2456 #endif 2457 2458 #ifdef VMS 2459 # define STATUS_NATIVE PL_statusvalue_vms 2460 # define STATUS_NATIVE_EXPORT \ 2461 (((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) | (VMSISH_HUSHED ? 0x10000000 : 0)) 2462 # define STATUS_NATIVE_SET(n) \ 2463 STMT_START { \ 2464 PL_statusvalue_vms = (n); \ 2465 if ((I32)PL_statusvalue_vms == -1) \ 2466 PL_statusvalue = -1; \ 2467 else if (PL_statusvalue_vms & STS$M_SUCCESS) \ 2468 PL_statusvalue = 0; \ 2469 else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0) \ 2470 PL_statusvalue = 1 << 8; \ 2471 else \ 2472 PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \ 2473 } STMT_END 2474 # define STATUS_POSIX PL_statusvalue 2475 # ifdef VMSISH_STATUS 2476 # define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX) 2477 # else 2478 # define STATUS_CURRENT STATUS_POSIX 2479 # endif 2480 # define STATUS_POSIX_SET(n) \ 2481 STMT_START { \ 2482 PL_statusvalue = (n); \ 2483 if (PL_statusvalue != -1) { \ 2484 PL_statusvalue &= 0xFFFF; \ 2485 PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \ 2486 } \ 2487 else PL_statusvalue_vms = -1; \ 2488 } STMT_END 2489 # define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1) 2490 # define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44) 2491 #else 2492 # define STATUS_NATIVE STATUS_POSIX 2493 # define STATUS_NATIVE_EXPORT STATUS_POSIX 2494 # define STATUS_NATIVE_SET STATUS_POSIX_SET 2495 # define STATUS_POSIX PL_statusvalue 2496 # define STATUS_POSIX_SET(n) \ 2497 STMT_START { \ 2498 PL_statusvalue = (n); \ 2499 if (PL_statusvalue != -1) \ 2500 PL_statusvalue &= 0xFFFF; \ 2501 } STMT_END 2502 # define STATUS_CURRENT STATUS_POSIX 2503 # define STATUS_ALL_SUCCESS (PL_statusvalue = 0) 2504 # define STATUS_ALL_FAILURE (PL_statusvalue = 1) 2505 #endif 2506 2507 /* flags in PL_exit_flags for nature of exit() */ 2508 #define PERL_EXIT_EXPECTED 0x01 2509 #define PERL_EXIT_DESTRUCT_END 0x02 /* Run END in perl_destruct */ 2510 2511 #ifndef MEMBER_TO_FPTR 2512 # define MEMBER_TO_FPTR(name) name 2513 #endif 2514 2515 /* format to use for version numbers in file/directory names */ 2516 /* XXX move to Configure? */ 2517 #ifndef PERL_FS_VER_FMT 2518 # define PERL_FS_VER_FMT "%d.%d.%d" 2519 #endif 2520 2521 /* This defines a way to flush all output buffers. This may be a 2522 * performance issue, so we allow people to disable it. Also, if 2523 * we are using stdio, there are broken implementations of fflush(NULL) 2524 * out there, Solaris being the most prominent. 2525 */ 2526 #ifndef PERL_FLUSHALL_FOR_CHILD 2527 # if defined(USE_PERLIO) || defined(FFLUSH_NULL) || defined(USE_SFIO) 2528 # define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL) 2529 # else 2530 # ifdef FFLUSH_ALL 2531 # define PERL_FLUSHALL_FOR_CHILD my_fflush_all() 2532 # else 2533 # define PERL_FLUSHALL_FOR_CHILD NOOP 2534 # endif 2535 # endif 2536 #endif 2537 2538 #ifndef PERL_WAIT_FOR_CHILDREN 2539 # define PERL_WAIT_FOR_CHILDREN NOOP 2540 #endif 2541 2542 /* the traditional thread-unsafe notion of "current interpreter". */ 2543 #ifndef PERL_SET_INTERP 2544 # define PERL_SET_INTERP(i) (PL_curinterp = (PerlInterpreter*)(i)) 2545 #endif 2546 2547 #ifndef PERL_GET_INTERP 2548 # define PERL_GET_INTERP (PL_curinterp) 2549 #endif 2550 2551 #if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX) 2552 # ifdef USE_5005THREADS 2553 # define PERL_GET_THX ((struct perl_thread *)PERL_GET_CONTEXT) 2554 # else 2555 # ifdef MULTIPLICITY 2556 # define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT) 2557 # endif 2558 # endif 2559 # define PERL_SET_THX(t) PERL_SET_CONTEXT(t) 2560 #endif 2561 2562 #ifndef SVf 2563 # ifdef CHECK_FORMAT 2564 # define SVf "-p" 2565 # else 2566 # define SVf "_" 2567 # endif 2568 #endif 2569 2570 #ifndef SVf_precision 2571 # ifdef CHECK_FORMAT 2572 # define SVf_precision(n) "-" n "p" 2573 # else 2574 # define SVf_precision(n) "." n "_" 2575 # endif 2576 #endif 2577 2578 #ifndef VDf 2579 # ifdef CHECK_FORMAT 2580 # define VDf "-1p" 2581 # else 2582 # define VDf "vd" 2583 # endif 2584 #endif 2585 2586 #ifndef SVf32 2587 # define SVf32 SVf_precision("32") 2588 #endif 2589 2590 #ifndef SVf256 2591 # define SVf256 SVf_precision("256") 2592 #endif 2593 2594 #ifndef UVf 2595 # define UVf UVuf 2596 #endif 2597 2598 #ifndef PERL_CORE 2599 # ifndef DieNull 2600 # define DieNull Perl_vdie(aTHX_ Nullch, Null(va_list *)) 2601 # endif 2602 #endif 2603 2604 /* Because 5.8.x has to keep using %_ for SVf, which will make the format 2605 * checking code (quite correctly) bleat a lot. */ 2606 #ifndef CHECK_FORMAT 2607 # undef HASATTRIBUTE_FORMAT 2608 #endif 2609 2610 #ifdef HASATTRIBUTE_FORMAT 2611 # define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) 2612 #endif 2613 #ifdef HASATTRIBUTE_MALLOC 2614 # define __attribute__malloc__ __attribute__((__malloc__)) 2615 #endif 2616 #ifdef HASATTRIBUTE_NONNULL 2617 # define __attribute__nonnull__(a) __attribute__((nonnull(a))) 2618 #endif 2619 #ifdef HASATTRIBUTE_NORETURN 2620 # define __attribute__noreturn__ __attribute__((noreturn)) 2621 #endif 2622 #ifdef HASATTRIBUTE_PURE 2623 # define __attribute__pure__ __attribute__((pure)) 2624 #endif 2625 #ifdef HASATTRIBUTE_UNUSED 2626 # define __attribute__unused__ __attribute__((unused)) 2627 #endif 2628 #ifdef HASATTRIBUTE_WARN_UNUSED_RESULT 2629 # define __attribute__warn_unused_result__ __attribute__((warn_unused_result)) 2630 #endif 2631 2632 /* If we haven't defined the attributes yet, define them to blank. */ 2633 #ifndef __attribute__format__ 2634 # define __attribute__format__(x,y,z) 2635 #endif 2636 #ifndef __attribute__malloc__ 2637 # define __attribute__malloc__ 2638 #endif 2639 #ifndef __attribute__nonnull__ 2640 # define __attribute__nonnull__(a) 2641 #endif 2642 #ifndef __attribute__noreturn__ 2643 # define __attribute__noreturn__ 2644 #endif 2645 #ifndef __attribute__pure__ 2646 # define __attribute__pure__ 2647 #endif 2648 #ifndef __attribute__unused__ 2649 # define __attribute__unused__ 2650 #endif 2651 #ifndef __attribute__warn_unused_result__ 2652 # define __attribute__warn_unused_result__ 2653 #endif 2654 2655 /* For functions that are marked as __attribute__noreturn__, it's not 2656 appropriate to call return. In either case, include the lint directive. 2657 */ 2658 #ifdef HASATTRIBUTE_NORETURN 2659 # define NORETURN_FUNCTION_END /* NOT REACHED */ 2660 #else 2661 # define NORETURN_FUNCTION_END /* NOT REACHED */ return 0 2662 #endif 2663 2664 /* Some unistd.h's give a prototype for pause() even though 2665 HAS_PAUSE ends up undefined. This causes the #define 2666 below to be rejected by the compiler. Sigh. 2667 */ 2668 #ifdef HAS_PAUSE 2669 #define Pause pause 2670 #else 2671 #define Pause() sleep((32767<<16)+32767) 2672 #endif 2673 2674 #ifndef IOCPARM_LEN 2675 # ifdef IOCPARM_MASK 2676 /* on BSDish systems we're safe */ 2677 # define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) 2678 # else 2679 # if defined(_IOC_SIZE) && defined(__GLIBC__) 2680 /* on Linux systems we're safe; except when we're not [perl #38223] */ 2681 # define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x)) 2682 # else 2683 /* otherwise guess at what's safe */ 2684 # define IOCPARM_LEN(x) 256 2685 # endif 2686 # endif 2687 #endif 2688 2689 #if defined(__CYGWIN__) 2690 /* USEMYBINMODE 2691 * This symbol, if defined, indicates that the program should 2692 * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure 2693 * that a file is in "binary" mode -- that is, that no translation 2694 * of bytes occurs on read or write operations. 2695 */ 2696 # define USEMYBINMODE /**/ 2697 # include <io.h> /* for setmode() prototype */ 2698 # define my_binmode(fp, iotype, mode) \ 2699 (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE) 2700 #endif 2701 2702 #ifdef __CYGWIN__ 2703 void init_os_extras(void); 2704 #endif 2705 2706 #ifdef UNION_ANY_DEFINITION 2707 UNION_ANY_DEFINITION; 2708 #else 2709 union any { 2710 void* any_ptr; 2711 I32 any_i32; 2712 IV any_iv; 2713 long any_long; 2714 bool any_bool; 2715 void (*any_dptr) (void*); 2716 void (*any_dxptr) (pTHX_ void*); 2717 }; 2718 #endif 2719 2720 #ifdef USE_5005THREADS 2721 #define ARGSproto struct perl_thread *thr 2722 #else 2723 #define ARGSproto 2724 #endif /* USE_5005THREADS */ 2725 2726 typedef I32 (*filter_t) (pTHX_ int, SV *, int); 2727 2728 #define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) 2729 #define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx]) 2730 #define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters)) 2731 2732 #if defined(_AIX) && !defined(_AIX43) 2733 #if defined(USE_REENTRANT) || defined(_REENTRANT) || defined(_THREAD_SAFE) 2734 /* We cannot include <crypt.h> to get the struct crypt_data 2735 * because of setkey prototype problems when threading */ 2736 typedef struct crypt_data { /* straight from /usr/include/crypt.h */ 2737 /* From OSF, Not needed in AIX 2738 char C[28], D[28]; 2739 */ 2740 char E[48]; 2741 char KS[16][48]; 2742 char block[66]; 2743 char iobuf[16]; 2744 } CRYPTD; 2745 #endif /* threading */ 2746 #endif /* AIX */ 2747 2748 #if !defined(OS2) && !defined(MACOS_TRADITIONAL) 2749 # include "iperlsys.h" 2750 #endif 2751 2752 /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0. 2753 * Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT* 2754 * defined by Configure, despite their names being similar to the 2755 * other defines like USE_ITHREADS. Configure in fact knows nothing 2756 * about the randomised hashes. Therefore to enable/disable the hash 2757 * randomisation defines use the Configure -Accflags=... instead. */ 2758 #if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT) 2759 # define USE_HASH_SEED 2760 #endif 2761 2762 #include "regexp.h" 2763 #include "sv.h" 2764 #include "util.h" 2765 #include "form.h" 2766 #include "gv.h" 2767 #include "pad.h" 2768 #include "cv.h" 2769 #include "opnames.h" 2770 #include "op.h" 2771 #include "cop.h" 2772 #include "av.h" 2773 #include "hv.h" 2774 #include "mg.h" 2775 #include "scope.h" 2776 #include "warnings.h" 2777 #include "utf8.h" 2778 2779 /* Current curly descriptor */ 2780 typedef struct curcur CURCUR; 2781 struct curcur { 2782 int parenfloor; /* how far back to strip paren data */ 2783 int cur; /* how many instances of scan we've matched */ 2784 int min; /* the minimal number of scans to match */ 2785 int max; /* the maximal number of scans to match */ 2786 int minmod; /* whether to work our way up or down */ 2787 regnode * scan; /* the thing to match */ 2788 regnode * next; /* what has to match after it */ 2789 char * lastloc; /* where we started matching this scan */ 2790 CURCUR * oldcc; /* current curly before we started this one */ 2791 }; 2792 2793 typedef struct _sublex_info SUBLEXINFO; 2794 struct _sublex_info { 2795 I32 super_state; /* lexer state to save */ 2796 I32 sub_inwhat; /* "lex_inwhat" to use */ 2797 OP *sub_op; /* "lex_op" to use */ 2798 char *super_bufptr; /* PL_bufptr that was */ 2799 char *super_bufend; /* PL_bufend that was */ 2800 }; 2801 2802 typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ 2803 2804 struct scan_data_t; /* Used in S_* functions in regcomp.c */ 2805 struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */ 2806 2807 typedef I32 CHECKPOINT; 2808 2809 struct ptr_tbl_ent { 2810 struct ptr_tbl_ent* next; 2811 const void* oldval; 2812 void* newval; 2813 }; 2814 2815 struct ptr_tbl { 2816 struct ptr_tbl_ent** tbl_ary; 2817 UV tbl_max; 2818 UV tbl_items; 2819 }; 2820 2821 #if defined(iAPX286) || defined(M_I286) || defined(I80286) 2822 # define I286 2823 #endif 2824 2825 #if defined(htonl) && !defined(HAS_HTONL) 2826 #define HAS_HTONL 2827 #endif 2828 #if defined(htons) && !defined(HAS_HTONS) 2829 #define HAS_HTONS 2830 #endif 2831 #if defined(ntohl) && !defined(HAS_NTOHL) 2832 #define HAS_NTOHL 2833 #endif 2834 #if defined(ntohs) && !defined(HAS_NTOHS) 2835 #define HAS_NTOHS 2836 #endif 2837 #ifndef HAS_HTONL 2838 #if (BYTEORDER & 0xffff) != 0x4321 2839 #define HAS_HTONS 2840 #define HAS_HTONL 2841 #define HAS_NTOHS 2842 #define HAS_NTOHL 2843 #define MYSWAP 2844 #define htons my_swap 2845 #define htonl my_htonl 2846 #define ntohs my_swap 2847 #define ntohl my_ntohl 2848 #endif 2849 #else 2850 #if (BYTEORDER & 0xffff) == 0x4321 2851 #undef HAS_HTONS 2852 #undef HAS_HTONL 2853 #undef HAS_NTOHS 2854 #undef HAS_NTOHL 2855 #endif 2856 #endif 2857 2858 /* 2859 * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'. 2860 * -DWS 2861 */ 2862 #if BYTEORDER != 0x1234 2863 # define HAS_VTOHL 2864 # define HAS_VTOHS 2865 # define HAS_HTOVL 2866 # define HAS_HTOVS 2867 # if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 2868 # define vtohl(x) ((((x)&0xFF)<<24) \ 2869 +(((x)>>24)&0xFF) \ 2870 +(((x)&0x0000FF00)<<8) \ 2871 +(((x)&0x00FF0000)>>8) ) 2872 # define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF)) 2873 # define htovl(x) vtohl(x) 2874 # define htovs(x) vtohs(x) 2875 # endif 2876 /* otherwise default to functions in util.c */ 2877 #ifndef htovs 2878 short htovs(short n); 2879 short vtohs(short n); 2880 long htovl(long n); 2881 long vtohl(long n); 2882 #endif 2883 #endif 2884 2885 /* *MAX Plus 1. A floating point value. 2886 Hopefully expressed in a way that dodgy floating point can't mess up. 2887 >> 2 rather than 1, so that value is safely less than I32_MAX after 1 2888 is added to it 2889 May find that some broken compiler will want the value cast to I32. 2890 [after the shift, as signed >> may not be as secure as unsigned >>] 2891 */ 2892 #define I32_MAX_P1 (2.0 * (1 + (((U32)I32_MAX) >> 1))) 2893 #define U32_MAX_P1 (4.0 * (1 + ((U32_MAX) >> 2))) 2894 /* For compilers that can't correctly cast NVs over 0x7FFFFFFF (or 2895 0x7FFFFFFFFFFFFFFF) to an unsigned integer. In the future, sizeof(UV) 2896 may be greater than sizeof(IV), so don't assume that half max UV is max IV. 2897 */ 2898 #define U32_MAX_P1_HALF (2.0 * (1 + ((U32_MAX) >> 2))) 2899 2900 #define UV_MAX_P1 (4.0 * (1 + ((UV_MAX) >> 2))) 2901 #define IV_MAX_P1 (2.0 * (1 + (((UV)IV_MAX) >> 1))) 2902 #define UV_MAX_P1_HALF (2.0 * (1 + ((UV_MAX) >> 2))) 2903 2904 /* This may look like unnecessary jumping through hoops, but converting 2905 out of range floating point values to integers *is* undefined behaviour, 2906 and it is starting to bite. 2907 */ 2908 #ifndef CAST_INLINE 2909 #define I_32(what) (cast_i32((NV)(what))) 2910 #define U_32(what) (cast_ulong((NV)(what))) 2911 #define I_V(what) (cast_iv((NV)(what))) 2912 #define U_V(what) (cast_uv((NV)(what))) 2913 #else 2914 #define I_32(n) ((n) < I32_MAX_P1 ? ((n) < I32_MIN ? I32_MIN : (I32) (n)) \ 2915 : ((n) < U32_MAX_P1 ? (I32)(U32) (n) \ 2916 : ((n) > 0 ? (I32) U32_MAX : 0 /* NaN */))) 2917 #define U_32(n) ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \ 2918 : ((n) < U32_MAX_P1 ? (U32) (n) \ 2919 : ((n) > 0 ? U32_MAX : 0 /* NaN */))) 2920 #define I_V(n) ((n) < IV_MAX_P1 ? ((n) < IV_MIN ? IV_MIN : (IV) (n)) \ 2921 : ((n) < UV_MAX_P1 ? (IV)(UV) (n) \ 2922 : ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */))) 2923 #define U_V(n) ((n) < 0.0 ? ((n) < IV_MIN ? (UV) IV_MIN : (UV)(IV) (n)) \ 2924 : ((n) < UV_MAX_P1 ? (UV) (n) \ 2925 : ((n) > 0 ? UV_MAX : 0 /* NaN */))) 2926 #endif 2927 2928 #define U_S(what) ((U16)U_32(what)) 2929 #define U_I(what) ((unsigned int)U_32(what)) 2930 #define U_L(what) U_32(what) 2931 2932 /* These do not care about the fractional part, only about the range. */ 2933 #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX) 2934 #define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX) 2935 2936 /* Used with UV/IV arguments: */ 2937 /* XXXX: need to speed it up */ 2938 #define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv)) 2939 #define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv)) 2940 2941 #ifndef MAXSYSFD 2942 # define MAXSYSFD 2 2943 #endif 2944 2945 #ifndef __cplusplus 2946 #ifndef UNDER_CE 2947 Uid_t getuid (void); 2948 Uid_t geteuid (void); 2949 Gid_t getgid (void); 2950 Gid_t getegid (void); 2951 #endif 2952 #endif 2953 2954 #ifndef Perl_debug_log 2955 # define Perl_debug_log PerlIO_stderr() 2956 #endif 2957 2958 #ifndef Perl_error_log 2959 # define Perl_error_log (PL_stderrgv \ 2960 && isGV(PL_stderrgv) \ 2961 && GvIOp(PL_stderrgv) \ 2962 && IoOFP(GvIOp(PL_stderrgv)) \ 2963 ? IoOFP(GvIOp(PL_stderrgv)) \ 2964 : PerlIO_stderr()) 2965 #endif 2966 2967 2968 #define DEBUG_p_FLAG 0x00000001 /* 1 */ 2969 #define DEBUG_s_FLAG 0x00000002 /* 2 */ 2970 #define DEBUG_l_FLAG 0x00000004 /* 4 */ 2971 #define DEBUG_t_FLAG 0x00000008 /* 8 */ 2972 #define DEBUG_o_FLAG 0x00000010 /* 16 */ 2973 #define DEBUG_c_FLAG 0x00000020 /* 32 */ 2974 #define DEBUG_P_FLAG 0x00000040 /* 64 */ 2975 #define DEBUG_m_FLAG 0x00000080 /* 128 */ 2976 #define DEBUG_f_FLAG 0x00000100 /* 256 */ 2977 #define DEBUG_r_FLAG 0x00000200 /* 512 */ 2978 #define DEBUG_x_FLAG 0x00000400 /* 1024 */ 2979 #define DEBUG_u_FLAG 0x00000800 /* 2048 */ 2980 #define DEBUG_H_FLAG 0x00002000 /* 8192 */ 2981 #define DEBUG_X_FLAG 0x00004000 /* 16384 */ 2982 #define DEBUG_D_FLAG 0x00008000 /* 32768 */ 2983 #define DEBUG_S_FLAG 0x00010000 /* 65536 */ 2984 #define DEBUG_T_FLAG 0x00020000 /* 131072 */ 2985 #define DEBUG_R_FLAG 0x00040000 /* 262144 */ 2986 #define DEBUG_J_FLAG 0x00080000 /* 524288 */ 2987 #define DEBUG_v_FLAG 0x00100000 /*1048576 */ 2988 #define DEBUG_MASK 0x001FEFFF /* mask of all the standard flags */ 2989 2990 #define DEBUG_DB_RECURSE_FLAG 0x40000000 2991 #define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal 2992 that something was done? */ 2993 2994 # define DEBUG_p_TEST_ (PL_debug & DEBUG_p_FLAG) 2995 # define DEBUG_s_TEST_ (PL_debug & DEBUG_s_FLAG) 2996 # define DEBUG_l_TEST_ (PL_debug & DEBUG_l_FLAG) 2997 # define DEBUG_t_TEST_ (PL_debug & DEBUG_t_FLAG) 2998 # define DEBUG_o_TEST_ (PL_debug & DEBUG_o_FLAG) 2999 # define DEBUG_c_TEST_ (PL_debug & DEBUG_c_FLAG) 3000 # define DEBUG_P_TEST_ (PL_debug & DEBUG_P_FLAG) 3001 # define DEBUG_m_TEST_ (PL_debug & DEBUG_m_FLAG) 3002 # define DEBUG_f_TEST_ (PL_debug & DEBUG_f_FLAG) 3003 # define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG) 3004 # define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG) 3005 # define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG) 3006 # define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG) 3007 # define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG) 3008 # define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG) 3009 # define DEBUG_S_TEST_ (PL_debug & DEBUG_S_FLAG) 3010 # define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG) 3011 # define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG) 3012 # define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG) 3013 # define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG) 3014 # define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_) 3015 3016 3017 #ifdef DEBUGGING 3018 3019 # undef YYDEBUG 3020 # define YYDEBUG 1 3021 3022 # define DEBUG_p_TEST DEBUG_p_TEST_ 3023 # define DEBUG_s_TEST DEBUG_s_TEST_ 3024 # define DEBUG_l_TEST DEBUG_l_TEST_ 3025 # define DEBUG_t_TEST DEBUG_t_TEST_ 3026 # define DEBUG_o_TEST DEBUG_o_TEST_ 3027 # define DEBUG_c_TEST DEBUG_c_TEST_ 3028 # define DEBUG_P_TEST DEBUG_P_TEST_ 3029 # define DEBUG_m_TEST DEBUG_m_TEST_ 3030 # define DEBUG_f_TEST DEBUG_f_TEST_ 3031 # define DEBUG_r_TEST DEBUG_r_TEST_ 3032 # define DEBUG_x_TEST DEBUG_x_TEST_ 3033 # define DEBUG_u_TEST DEBUG_u_TEST_ 3034 # define DEBUG_H_TEST DEBUG_H_TEST_ 3035 # define DEBUG_X_TEST DEBUG_X_TEST_ 3036 # define DEBUG_Xv_TEST DEBUG_Xv_TEST_ 3037 # define DEBUG_D_TEST DEBUG_D_TEST_ 3038 # define DEBUG_S_TEST DEBUG_S_TEST_ 3039 # define DEBUG_T_TEST DEBUG_T_TEST_ 3040 # define DEBUG_R_TEST DEBUG_R_TEST_ 3041 # define DEBUG_J_TEST DEBUG_J_TEST_ 3042 # define DEBUG_v_TEST DEBUG_v_TEST_ 3043 3044 # define PERL_DEB(a) a 3045 # define PERL_DEBUG(a) if (PL_debug) a 3046 # define DEBUG_p(a) if (DEBUG_p_TEST) a 3047 # define DEBUG_s(a) if (DEBUG_s_TEST) a 3048 # define DEBUG_l(a) if (DEBUG_l_TEST) a 3049 # define DEBUG_t(a) if (DEBUG_t_TEST) a 3050 # define DEBUG_o(a) if (DEBUG_o_TEST) a 3051 # define DEBUG_c(a) if (DEBUG_c_TEST) a 3052 # define DEBUG_P(a) if (DEBUG_P_TEST) a 3053 3054 /* Temporarily turn off memory debugging in case the a 3055 * does memory allocation, either directly or indirectly. */ 3056 # define DEBUG_m(a) \ 3057 STMT_START { \ 3058 if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) {PL_debug&=~DEBUG_m_FLAG; a; PL_debug|=DEBUG_m_FLAG;} } \ 3059 } STMT_END 3060 3061 # define DEBUG__(t, a) \ 3062 STMT_START { \ 3063 if (t) STMT_START {a;} STMT_END; \ 3064 } STMT_END 3065 3066 # define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a) 3067 # define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a) 3068 # define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a) 3069 # define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a) 3070 # define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a) 3071 # define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a) 3072 # define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a) 3073 # define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a) 3074 3075 # ifdef USE_5005THREADS 3076 # define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a) 3077 # else 3078 # define DEBUG_S(a) 3079 # endif 3080 3081 # define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a) 3082 # define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a) 3083 # define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a) 3084 3085 #else /* DEBUGGING */ 3086 3087 # define DEBUG_p_TEST (0) 3088 # define DEBUG_s_TEST (0) 3089 # define DEBUG_l_TEST (0) 3090 # define DEBUG_t_TEST (0) 3091 # define DEBUG_o_TEST (0) 3092 # define DEBUG_c_TEST (0) 3093 # define DEBUG_P_TEST (0) 3094 # define DEBUG_m_TEST (0) 3095 # define DEBUG_f_TEST (0) 3096 # define DEBUG_r_TEST (0) 3097 # define DEBUG_x_TEST (0) 3098 # define DEBUG_u_TEST (0) 3099 # define DEBUG_H_TEST (0) 3100 # define DEBUG_X_TEST (0) 3101 # define DEBUG_Xv_TEST (0) 3102 # define DEBUG_D_TEST (0) 3103 # define DEBUG_S_TEST (0) 3104 # define DEBUG_T_TEST (0) 3105 # define DEBUG_R_TEST (0) 3106 # define DEBUG_J_TEST (0) 3107 # define DEBUG_v_TEST (0) 3108 3109 # define PERL_DEB(a) 3110 # define PERL_DEBUG(a) 3111 # define DEBUG_p(a) 3112 # define DEBUG_s(a) 3113 # define DEBUG_l(a) 3114 # define DEBUG_t(a) 3115 # define DEBUG_o(a) 3116 # define DEBUG_c(a) 3117 # define DEBUG_P(a) 3118 # define DEBUG_m(a) 3119 # define DEBUG_f(a) 3120 # define DEBUG_r(a) 3121 # define DEBUG_x(a) 3122 # define DEBUG_u(a) 3123 # define DEBUG_H(a) 3124 # define DEBUG_X(a) 3125 # define DEBUG_Xv(a) 3126 # define DEBUG_D(a) 3127 # define DEBUG_S(a) 3128 # define DEBUG_T(a) 3129 # define DEBUG_R(a) 3130 # define DEBUG_v(a) 3131 #endif /* DEBUGGING */ 3132 3133 3134 #define DEBUG_SCOPE(where) \ 3135 DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n", \ 3136 where, (long)PL_scopestack_ix, __FILE__, __LINE__))); 3137 3138 3139 3140 3141 /* These constants should be used in preference to raw characters 3142 * when using magic. Note that some perl guts still assume 3143 * certain character properties of these constants, namely that 3144 * isUPPER() and toLOWER() may do useful mappings. 3145 * 3146 * Update the magic_names table in dump.c when adding/amending these 3147 */ 3148 3149 #define PERL_MAGIC_sv '\0' /* Special scalar variable */ 3150 #define PERL_MAGIC_overload 'A' /* %OVERLOAD hash */ 3151 #define PERL_MAGIC_overload_elem 'a' /* %OVERLOAD hash element */ 3152 #define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */ 3153 #define PERL_MAGIC_bm 'B' /* Boyer-Moore (fast string search) */ 3154 #define PERL_MAGIC_regdata 'D' /* Regex match position data 3155 (@+ and @- vars) */ 3156 #define PERL_MAGIC_regdatum 'd' /* Regex match position data element */ 3157 #define PERL_MAGIC_env 'E' /* %ENV hash */ 3158 #define PERL_MAGIC_envelem 'e' /* %ENV hash element */ 3159 #define PERL_MAGIC_fm 'f' /* Formline ('compiled' format) */ 3160 #define PERL_MAGIC_regex_global 'g' /* m//g target / study()ed string */ 3161 #define PERL_MAGIC_isa 'I' /* @ISA array */ 3162 #define PERL_MAGIC_isaelem 'i' /* @ISA array element */ 3163 #define PERL_MAGIC_nkeys 'k' /* scalar(keys()) lvalue */ 3164 #define PERL_MAGIC_dbfile 'L' /* Debugger %_<filename */ 3165 #define PERL_MAGIC_dbline 'l' /* Debugger %_<filename element */ 3166 #define PERL_MAGIC_mutex 'm' /* for lock op */ 3167 #define PERL_MAGIC_shared 'N' /* Shared between threads */ 3168 #define PERL_MAGIC_shared_scalar 'n' /* Shared between threads */ 3169 #define PERL_MAGIC_collxfrm 'o' /* Locale transformation */ 3170 #define PERL_MAGIC_tied 'P' /* Tied array or hash */ 3171 #define PERL_MAGIC_tiedelem 'p' /* Tied array or hash element */ 3172 #define PERL_MAGIC_tiedscalar 'q' /* Tied scalar or handle */ 3173 #define PERL_MAGIC_qr 'r' /* precompiled qr// regex */ 3174 #define PERL_MAGIC_sig 'S' /* %SIG hash */ 3175 #define PERL_MAGIC_sigelem 's' /* %SIG hash element */ 3176 #define PERL_MAGIC_taint 't' /* Taintedness */ 3177 #define PERL_MAGIC_uvar 'U' /* Available for use by extensions */ 3178 #define PERL_MAGIC_uvar_elem 'u' /* Reserved for use by extensions */ 3179 #define PERL_MAGIC_vstring 'V' /* SV was vstring literal */ 3180 #define PERL_MAGIC_vec 'v' /* vec() lvalue */ 3181 #define PERL_MAGIC_utf8 'w' /* Cached UTF-8 information */ 3182 #define PERL_MAGIC_substr 'x' /* substr() lvalue */ 3183 #define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable / 3184 smart parameter vivification */ 3185 #define PERL_MAGIC_glob '*' /* GV (typeglob) */ 3186 #define PERL_MAGIC_arylen '#' /* Array length ($#ary) */ 3187 #define PERL_MAGIC_pos '.' /* pos() lvalue */ 3188 #define PERL_MAGIC_backref '<' /* for weak ref data */ 3189 #define PERL_MAGIC_ext '~' /* Available for use by extensions */ 3190 3191 3192 #define YYMAXDEPTH 300 3193 3194 #ifndef assert /* <assert.h> might have been included somehow */ 3195 #define assert(what) PERL_DEB( \ 3196 ((what) ? ((void) 0) : \ 3197 (Perl_croak(aTHX_ "Assertion %s failed: file \"" __FILE__ \ 3198 "\", line %d", STRINGIFY(what), __LINE__), \ 3199 PerlProc_exit(1), \ 3200 (void) 0))) 3201 #endif 3202 3203 struct ufuncs { 3204 I32 (*uf_val)(pTHX_ IV, SV*); 3205 I32 (*uf_set)(pTHX_ IV, SV*); 3206 IV uf_index; 3207 }; 3208 3209 /* In pre-5.7-Perls the PERL_MAGIC_uvar magic didn't get the thread context. 3210 * XS code wanting to be backward compatible can do something 3211 * like the following: 3212 3213 #ifndef PERL_MG_UFUNC 3214 #define PERL_MG_UFUNC(name,ix,sv) I32 name(IV ix, SV *sv) 3215 #endif 3216 3217 static PERL_MG_UFUNC(foo_get, index, val) 3218 { 3219 sv_setsv(val, ...); 3220 return TRUE; 3221 } 3222 3223 -- Doug MacEachern 3224 3225 */ 3226 3227 #ifndef PERL_MG_UFUNC 3228 #define PERL_MG_UFUNC(name,ix,sv) I32 name(pTHX_ IV ix, SV *sv) 3229 #endif 3230 3231 /* Fix these up for __STDC__ */ 3232 #ifndef DONT_DECLARE_STD 3233 char *mktemp (char*); 3234 #ifndef atof 3235 double atof (const char*); 3236 #endif 3237 #endif 3238 3239 #ifndef STANDARD_C 3240 /* All of these are in stdlib.h or time.h for ANSI C */ 3241 Time_t time(); 3242 struct tm *gmtime(), *localtime(); 3243 #if defined(OEMVS) || defined(__OPEN_VM) 3244 char *(strchr)(), *(strrchr)(); 3245 char *(strcpy)(), *(strcat)(); 3246 #else 3247 char *strchr(), *strrchr(); 3248 char *strcpy(), *strcat(); 3249 #endif 3250 #endif /* ! STANDARD_C */ 3251 3252 3253 #ifdef I_MATH 3254 # include <math.h> 3255 #else 3256 START_EXTERN_C 3257 double exp (double); 3258 double log (double); 3259 double log10 (double); 3260 double sqrt (double); 3261 double frexp (double,int*); 3262 double ldexp (double,int); 3263 double modf (double,double*); 3264 double sin (double); 3265 double cos (double); 3266 double atan2 (double,double); 3267 double pow (double,double); 3268 END_EXTERN_C 3269 #endif 3270 3271 #if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(LDBL_INFINITY) 3272 # define NV_INF LDBL_INFINITY 3273 #endif 3274 #if !defined(NV_INF) && defined(DBL_INFINITY) 3275 # define NV_INF (NV)DBL_INFINITY 3276 #endif 3277 #if !defined(NV_INF) && defined(INFINITY) 3278 # define NV_INF (NV)INFINITY 3279 #endif 3280 #if !defined(NV_INF) && defined(INF) 3281 # define NV_INF (NV)INF 3282 #endif 3283 #if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(HUGE_VALL) 3284 # define NV_INF (NV)HUGE_VALL 3285 #endif 3286 #if !defined(NV_INF) && defined(HUGE_VAL) 3287 # define NV_INF (NV)HUGE_VAL 3288 #endif 3289 3290 #if !defined(NV_NAN) && defined(USE_LONG_DOUBLE) 3291 # if !defined(NV_NAN) && defined(LDBL_NAN) 3292 # define NV_NAN LDBL_NAN 3293 # endif 3294 # if !defined(NV_NAN) && defined(LDBL_QNAN) 3295 # define NV_NAN LDBL_QNAN 3296 # endif 3297 # if !defined(NV_NAN) && defined(LDBL_SNAN) 3298 # define NV_NAN LDBL_SNAN 3299 # endif 3300 #endif 3301 #if !defined(NV_NAN) && defined(DBL_NAN) 3302 # define NV_NAN (NV)DBL_NAN 3303 #endif 3304 #if !defined(NV_NAN) && defined(DBL_QNAN) 3305 # define NV_NAN (NV)DBL_QNAN 3306 #endif 3307 #if !defined(NV_NAN) && defined(DBL_SNAN) 3308 # define NV_NAN (NV)DBL_SNAN 3309 #endif 3310 #if !defined(NV_NAN) && defined(QNAN) 3311 # define NV_NAN (NV)QNAN 3312 #endif 3313 #if !defined(NV_NAN) && defined(SNAN) 3314 # define NV_NAN (NV)SNAN 3315 #endif 3316 #if !defined(NV_NAN) && defined(NAN) 3317 # define NV_NAN (NV)NAN 3318 #endif 3319 3320 #ifndef __cplusplus 3321 # if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */ 3322 char *crypt (); /* Maybe more hosts will need the unprototyped version */ 3323 # else 3324 # if !defined(WIN32) && !defined(VMS) 3325 #ifndef crypt 3326 char *crypt (const char*, const char*); 3327 #endif 3328 # endif /* !WIN32 */ 3329 # endif /* !NeXT && !__NeXT__ */ 3330 # ifndef DONT_DECLARE_STD 3331 # ifndef getenv 3332 char *getenv (const char*); 3333 # endif /* !getenv */ 3334 # if !defined(HAS_LSEEK_PROTO) && !defined(EPOC) && !defined(__hpux) 3335 # ifdef _FILE_OFFSET_BITS 3336 # if _FILE_OFFSET_BITS == 64 3337 Off_t lseek (int,Off_t,int); 3338 # endif 3339 # endif 3340 # endif 3341 # endif /* !DONT_DECLARE_STD */ 3342 #ifndef getlogin 3343 char *getlogin (void); 3344 #endif 3345 #endif /* !__cplusplus */ 3346 3347 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ 3348 #define UNLINK unlnk 3349 I32 unlnk (char*); 3350 #else 3351 #define UNLINK PerlLIO_unlink 3352 #endif 3353 3354 /* some versions of glibc are missing the setresuid() proto */ 3355 #if defined(HAS_SETRESUID) && !defined(HAS_SETRESUID_PROTO) 3356 int setresuid(uid_t ruid, uid_t euid, uid_t suid); 3357 #endif 3358 /* some versions of glibc are missing the setresgid() proto */ 3359 #if defined(HAS_SETRESGID) && !defined(HAS_SETRESGID_PROTO) 3360 int setresgid(gid_t rgid, gid_t egid, gid_t sgid); 3361 #endif 3362 3363 #ifndef HAS_SETREUID 3364 # ifdef HAS_SETRESUID 3365 # define setreuid(r,e) setresuid(r,e,(Uid_t)-1) 3366 # define HAS_SETREUID 3367 # endif 3368 #endif 3369 #ifndef HAS_SETREGID 3370 # ifdef HAS_SETRESGID 3371 # define setregid(r,e) setresgid(r,e,(Gid_t)-1) 3372 # define HAS_SETREGID 3373 # endif 3374 #endif 3375 3376 /* Sighandler_t defined in iperlsys.h */ 3377 3378 #ifdef HAS_SIGACTION 3379 typedef struct sigaction Sigsave_t; 3380 #else 3381 typedef Sighandler_t Sigsave_t; 3382 #endif 3383 3384 #define SCAN_DEF 0 3385 #define SCAN_TR 1 3386 #define SCAN_REPL 2 3387 3388 #ifdef DEBUGGING 3389 # ifndef register 3390 # define register 3391 # endif 3392 # define RUNOPS_DEFAULT Perl_runops_debug 3393 #else 3394 # define RUNOPS_DEFAULT Perl_runops_standard 3395 #endif 3396 3397 #ifdef MYMALLOC 3398 # ifdef MUTEX_INIT_CALLS_MALLOC 3399 # define MALLOC_INIT \ 3400 STMT_START { \ 3401 PL_malloc_mutex = NULL; \ 3402 MUTEX_INIT(&PL_malloc_mutex); \ 3403 } STMT_END 3404 # define MALLOC_TERM \ 3405 STMT_START { \ 3406 perl_mutex tmp = PL_malloc_mutex; \ 3407 PL_malloc_mutex = NULL; \ 3408 MUTEX_DESTROY(&tmp); \ 3409 } STMT_END 3410 # else 3411 # define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex) 3412 # define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex) 3413 # endif 3414 #else 3415 # define MALLOC_INIT 3416 # define MALLOC_TERM 3417 #endif 3418 3419 3420 typedef int (CPERLscope(*runops_proc_t)) (pTHX); 3421 typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv); 3422 typedef int (CPERLscope(*thrhook_proc_t)) (pTHX); 3423 typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX); 3424 3425 /* _ (for $_) must be first in the following list (DEFSV requires it) */ 3426 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" 3427 3428 /* NeXT has problems with crt0.o globals */ 3429 #if defined(__DYNAMIC__) && \ 3430 (defined(NeXT) || defined(__NeXT__) || defined(PERL_DARWIN)) 3431 # if defined(NeXT) || defined(__NeXT) 3432 # include <mach-o/dyld.h> 3433 # define environ (*environ_pointer) 3434 EXT char *** environ_pointer; 3435 # else 3436 # if defined(PERL_DARWIN) && defined(PERL_CORE) 3437 # include <crt_externs.h> /* for the env array */ 3438 # define environ (*_NSGetEnviron()) 3439 # endif 3440 # endif 3441 #else 3442 /* VMS and some other platforms don't use the environ array */ 3443 # ifdef USE_ENVIRON_ARRAY 3444 # if !defined(DONT_DECLARE_STD) || \ 3445 (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \ 3446 defined(__sgi) || \ 3447 defined(__DGUX) 3448 extern char ** environ; /* environment variables supplied via exec */ 3449 # endif 3450 # endif 3451 #endif 3452 3453 START_EXTERN_C 3454 3455 /* handy constants */ 3456 EXTCONST char PL_warn_uninit[] 3457 INIT("Use of uninitialized value%s%s"); 3458 EXTCONST char PL_warn_nosemi[] 3459 INIT("Semicolon seems to be missing"); 3460 EXTCONST char PL_warn_reserved[] 3461 INIT("Unquoted string \"%s\" may clash with future reserved word"); 3462 EXTCONST char PL_warn_nl[] 3463 INIT("Unsuccessful %s on filename containing newline"); 3464 EXTCONST char PL_no_wrongref[] 3465 INIT("Can't use %s ref as %s ref"); 3466 EXTCONST char PL_no_symref[] 3467 INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); 3468 EXTCONST char PL_no_usym[] 3469 INIT("Can't use an undefined value as %s reference"); 3470 EXTCONST char PL_no_aelem[] 3471 INIT("Modification of non-creatable array value attempted, subscript %d"); 3472 EXTCONST char PL_no_helem[] 3473 INIT("Modification of non-creatable hash value attempted, subscript \"%s\""); 3474 EXTCONST char PL_no_helem_sv[] 3475 INIT("Modification of non-creatable hash value attempted, subscript \""SVf"\""); 3476 EXTCONST char PL_no_modify[] 3477 INIT("Modification of a read-only value attempted"); 3478 EXTCONST char PL_no_mem[] 3479 INIT("Out of memory!\n"); 3480 EXTCONST char PL_no_security[] 3481 INIT("Insecure dependency in %s%s"); 3482 EXTCONST char PL_no_sock_func[] 3483 INIT("Unsupported socket function \"%s\" called"); 3484 EXTCONST char PL_no_dir_func[] 3485 INIT("Unsupported directory function \"%s\" called"); 3486 EXTCONST char PL_no_func[] 3487 INIT("The %s function is unimplemented"); 3488 EXTCONST char PL_no_myglob[] 3489 INIT("\"my\" variable %s can't be in a package"); 3490 EXTCONST char PL_no_localize_ref[] 3491 INIT("Can't localize through a reference"); 3492 EXTCONST char PL_memory_wrap[] 3493 INIT("panic: memory wrap"); 3494 3495 EXTCONST char PL_uuemap[65] 3496 INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); 3497 3498 3499 #ifdef DOINIT 3500 EXT const char *PL_sig_name[] = { SIG_NAME }; 3501 EXT int PL_sig_num[] = { SIG_NUM }; 3502 #else 3503 EXT const char *PL_sig_name[]; 3504 EXT int PL_sig_num[]; 3505 #endif 3506 3507 /* fast conversion and case folding tables */ 3508 3509 #ifdef DOINIT 3510 #ifdef EBCDIC 3511 EXT unsigned char PL_fold[] = { /* fast EBCDIC case folding table */ 3512 0, 1, 2, 3, 4, 5, 6, 7, 3513 8, 9, 10, 11, 12, 13, 14, 15, 3514 16, 17, 18, 19, 20, 21, 22, 23, 3515 24, 25, 26, 27, 28, 29, 30, 31, 3516 32, 33, 34, 35, 36, 37, 38, 39, 3517 40, 41, 42, 43, 44, 45, 46, 47, 3518 48, 49, 50, 51, 52, 53, 54, 55, 3519 56, 57, 58, 59, 60, 61, 62, 63, 3520 64, 65, 66, 67, 68, 69, 70, 71, 3521 72, 73, 74, 75, 76, 77, 78, 79, 3522 80, 81, 82, 83, 84, 85, 86, 87, 3523 88, 89, 90, 91, 92, 93, 94, 95, 3524 96, 97, 98, 99, 100, 101, 102, 103, 3525 104, 105, 106, 107, 108, 109, 110, 111, 3526 112, 113, 114, 115, 116, 117, 118, 119, 3527 120, 121, 122, 123, 124, 125, 126, 127, 3528 128, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 3529 'H', 'I', 138, 139, 140, 141, 142, 143, 3530 144, 'J', 'K', 'L', 'M', 'N', 'O', 'P', 3531 'Q', 'R', 154, 155, 156, 157, 158, 159, 3532 160, 161, 'S', 'T', 'U', 'V', 'W', 'X', 3533 'Y', 'Z', 170, 171, 172, 173, 174, 175, 3534 176, 177, 178, 179, 180, 181, 182, 183, 3535 184, 185, 186, 187, 188, 189, 190, 191, 3536 192, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 3537 'h', 'i', 202, 203, 204, 205, 206, 207, 3538 208, 'j', 'k', 'l', 'm', 'n', 'o', 'p', 3539 'q', 'r', 218, 219, 220, 221, 222, 223, 3540 224, 225, 's', 't', 'u', 'v', 'w', 'x', 3541 'y', 'z', 234, 235, 236, 237, 238, 239, 3542 240, 241, 242, 243, 244, 245, 246, 247, 3543 248, 249, 250, 251, 252, 253, 254, 255 3544 }; 3545 #else /* ascii rather than ebcdic */ 3546 EXTCONST unsigned char PL_fold[] = { 3547 0, 1, 2, 3, 4, 5, 6, 7, 3548 8, 9, 10, 11, 12, 13, 14, 15, 3549 16, 17, 18, 19, 20, 21, 22, 23, 3550 24, 25, 26, 27, 28, 29, 30, 31, 3551 32, 33, 34, 35, 36, 37, 38, 39, 3552 40, 41, 42, 43, 44, 45, 46, 47, 3553 48, 49, 50, 51, 52, 53, 54, 55, 3554 56, 57, 58, 59, 60, 61, 62, 63, 3555 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 3556 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 3557 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 3558 'x', 'y', 'z', 91, 92, 93, 94, 95, 3559 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 3560 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 3561 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 3562 'X', 'Y', 'Z', 123, 124, 125, 126, 127, 3563 128, 129, 130, 131, 132, 133, 134, 135, 3564 136, 137, 138, 139, 140, 141, 142, 143, 3565 144, 145, 146, 147, 148, 149, 150, 151, 3566 152, 153, 154, 155, 156, 157, 158, 159, 3567 160, 161, 162, 163, 164, 165, 166, 167, 3568 168, 169, 170, 171, 172, 173, 174, 175, 3569 176, 177, 178, 179, 180, 181, 182, 183, 3570 184, 185, 186, 187, 188, 189, 190, 191, 3571 192, 193, 194, 195, 196, 197, 198, 199, 3572 200, 201, 202, 203, 204, 205, 206, 207, 3573 208, 209, 210, 211, 212, 213, 214, 215, 3574 216, 217, 218, 219, 220, 221, 222, 223, 3575 224, 225, 226, 227, 228, 229, 230, 231, 3576 232, 233, 234, 235, 236, 237, 238, 239, 3577 240, 241, 242, 243, 244, 245, 246, 247, 3578 248, 249, 250, 251, 252, 253, 254, 255 3579 }; 3580 #endif /* !EBCDIC */ 3581 #else 3582 EXTCONST unsigned char PL_fold[]; 3583 #endif 3584 3585 #ifdef DOINIT 3586 EXT unsigned char PL_fold_locale[] = { 3587 0, 1, 2, 3, 4, 5, 6, 7, 3588 8, 9, 10, 11, 12, 13, 14, 15, 3589 16, 17, 18, 19, 20, 21, 22, 23, 3590 24, 25, 26, 27, 28, 29, 30, 31, 3591 32, 33, 34, 35, 36, 37, 38, 39, 3592 40, 41, 42, 43, 44, 45, 46, 47, 3593 48, 49, 50, 51, 52, 53, 54, 55, 3594 56, 57, 58, 59, 60, 61, 62, 63, 3595 64, 'a', 'b', 'c', 'd', 'e', 'f', 'g', 3596 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 3597 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 3598 'x', 'y', 'z', 91, 92, 93, 94, 95, 3599 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G', 3600 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 3601 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 3602 'X', 'Y', 'Z', 123, 124, 125, 126, 127, 3603 128, 129, 130, 131, 132, 133, 134, 135, 3604 136, 137, 138, 139, 140, 141, 142, 143, 3605 144, 145, 146, 147, 148, 149, 150, 151, 3606 152, 153, 154, 155, 156, 157, 158, 159, 3607 160, 161, 162, 163, 164, 165, 166, 167, 3608 168, 169, 170, 171, 172, 173, 174, 175, 3609 176, 177, 178, 179, 180, 181, 182, 183, 3610 184, 185, 186, 187, 188, 189, 190, 191, 3611 192, 193, 194, 195, 196, 197, 198, 199, 3612 200, 201, 202, 203, 204, 205, 206, 207, 3613 208, 209, 210, 211, 212, 213, 214, 215, 3614 216, 217, 218, 219, 220, 221, 222, 223, 3615 224, 225, 226, 227, 228, 229, 230, 231, 3616 232, 233, 234, 235, 236, 237, 238, 239, 3617 240, 241, 242, 243, 244, 245, 246, 247, 3618 248, 249, 250, 251, 252, 253, 254, 255 3619 }; 3620 #else 3621 EXT unsigned char PL_fold_locale[]; 3622 #endif 3623 3624 #ifdef DOINIT 3625 #ifdef EBCDIC 3626 EXT unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */ 3627 1, 2, 84, 151, 154, 155, 156, 157, 3628 165, 246, 250, 3, 158, 7, 18, 29, 3629 40, 51, 62, 73, 85, 96, 107, 118, 3630 129, 140, 147, 148, 149, 150, 152, 153, 3631 255, 6, 8, 9, 10, 11, 12, 13, 3632 14, 15, 24, 25, 26, 27, 28, 226, 3633 29, 30, 31, 32, 33, 43, 44, 45, 3634 46, 47, 48, 49, 50, 76, 77, 78, 3635 79, 80, 81, 82, 83, 84, 85, 86, 3636 87, 94, 95, 234, 181, 233, 187, 190, 3637 180, 96, 97, 98, 99, 100, 101, 102, 3638 104, 112, 182, 174, 236, 232, 229, 103, 3639 228, 226, 114, 115, 116, 117, 118, 119, 3640 120, 121, 122, 235, 176, 230, 194, 162, 3641 130, 131, 132, 133, 134, 135, 136, 137, 3642 138, 139, 201, 205, 163, 217, 220, 224, 3643 5, 248, 227, 244, 242, 255, 241, 231, 3644 240, 253, 16, 197, 19, 20, 21, 187, 3645 23, 169, 210, 245, 237, 249, 247, 239, 3646 168, 252, 34, 196, 36, 37, 38, 39, 3647 41, 42, 251, 254, 238, 223, 221, 213, 3648 225, 177, 52, 53, 54, 55, 56, 57, 3649 58, 59, 60, 61, 63, 64, 65, 66, 3650 67, 68, 69, 70, 71, 72, 74, 75, 3651 205, 208, 186, 202, 200, 218, 198, 179, 3652 178, 214, 88, 89, 90, 91, 92, 93, 3653 217, 166, 170, 207, 199, 209, 206, 204, 3654 160, 212, 105, 106, 108, 109, 110, 111, 3655 203, 113, 216, 215, 192, 175, 193, 243, 3656 172, 161, 123, 124, 125, 126, 127, 128, 3657 222, 219, 211, 195, 188, 193, 185, 184, 3658 191, 183, 141, 142, 143, 144, 145, 146 3659 }; 3660 #else /* ascii rather than ebcdic */ 3661 EXTCONST unsigned char PL_freq[] = { /* letter frequencies for mixed English/C */ 3662 1, 2, 84, 151, 154, 155, 156, 157, 3663 165, 246, 250, 3, 158, 7, 18, 29, 3664 40, 51, 62, 73, 85, 96, 107, 118, 3665 129, 140, 147, 148, 149, 150, 152, 153, 3666 255, 182, 224, 205, 174, 176, 180, 217, 3667 233, 232, 236, 187, 235, 228, 234, 226, 3668 222, 219, 211, 195, 188, 193, 185, 184, 3669 191, 183, 201, 229, 181, 220, 194, 162, 3670 163, 208, 186, 202, 200, 218, 198, 179, 3671 178, 214, 166, 170, 207, 199, 209, 206, 3672 204, 160, 212, 216, 215, 192, 175, 173, 3673 243, 172, 161, 190, 203, 189, 164, 230, 3674 167, 248, 227, 244, 242, 255, 241, 231, 3675 240, 253, 169, 210, 245, 237, 249, 247, 3676 239, 168, 252, 251, 254, 238, 223, 221, 3677 213, 225, 177, 197, 171, 196, 159, 4, 3678 5, 6, 8, 9, 10, 11, 12, 13, 3679 14, 15, 16, 17, 19, 20, 21, 22, 3680 23, 24, 25, 26, 27, 28, 30, 31, 3681 32, 33, 34, 35, 36, 37, 38, 39, 3682 41, 42, 43, 44, 45, 46, 47, 48, 3683 49, 50, 52, 53, 54, 55, 56, 57, 3684 58, 59, 60, 61, 63, 64, 65, 66, 3685 67, 68, 69, 70, 71, 72, 74, 75, 3686 76, 77, 78, 79, 80, 81, 82, 83, 3687 86, 87, 88, 89, 90, 91, 92, 93, 3688 94, 95, 97, 98, 99, 100, 101, 102, 3689 103, 104, 105, 106, 108, 109, 110, 111, 3690 112, 113, 114, 115, 116, 117, 119, 120, 3691 121, 122, 123, 124, 125, 126, 127, 128, 3692 130, 131, 132, 133, 134, 135, 136, 137, 3693 138, 139, 141, 142, 143, 144, 145, 146 3694 }; 3695 #endif 3696 #else 3697 EXTCONST unsigned char PL_freq[]; 3698 #endif 3699 3700 #ifdef DEBUGGING 3701 #ifdef DOINIT 3702 EXTCONST char* PL_block_type[] = { 3703 "NULL", 3704 "SUB", 3705 "EVAL", 3706 "LOOP", 3707 "SUBST", 3708 "BLOCK", 3709 }; 3710 #else 3711 EXTCONST char* PL_block_type[]; 3712 #endif 3713 #endif 3714 3715 END_EXTERN_C 3716 3717 /*****************************************************************************/ 3718 /* This lexer/parser stuff is currently global since yacc is hard to reenter */ 3719 /*****************************************************************************/ 3720 /* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */ 3721 3722 #ifdef __Lynx__ 3723 /* LynxOS defines these in scsi.h which is included via ioctl.h */ 3724 #ifdef FORMAT 3725 #undef FORMAT 3726 #endif 3727 #ifdef SPACE 3728 #undef SPACE 3729 #endif 3730 #endif 3731 3732 #include "perly.h" 3733 3734 #define LEX_NOTPARSING 11 /* borrowed from toke.c */ 3735 3736 typedef enum { 3737 XOPERATOR, 3738 XTERM, 3739 XREF, 3740 XSTATE, 3741 XBLOCK, 3742 XATTRBLOCK, 3743 XATTRTERM, 3744 XTERMBLOCK 3745 } expectation; 3746 3747 enum { /* pass one of these to get_vtbl */ 3748 want_vtbl_sv, 3749 want_vtbl_env, 3750 want_vtbl_envelem, 3751 want_vtbl_sig, 3752 want_vtbl_sigelem, 3753 want_vtbl_pack, 3754 want_vtbl_packelem, 3755 want_vtbl_dbline, 3756 want_vtbl_isa, 3757 want_vtbl_isaelem, 3758 want_vtbl_arylen, 3759 want_vtbl_glob, 3760 want_vtbl_mglob, 3761 want_vtbl_nkeys, 3762 want_vtbl_taint, 3763 want_vtbl_substr, 3764 want_vtbl_vec, 3765 want_vtbl_pos, 3766 want_vtbl_bm, 3767 want_vtbl_fm, 3768 want_vtbl_uvar, 3769 want_vtbl_defelem, 3770 want_vtbl_regexp, 3771 want_vtbl_collxfrm, 3772 want_vtbl_amagic, 3773 want_vtbl_amagicelem, 3774 #ifdef USE_5005THREADS 3775 want_vtbl_mutex, 3776 #endif 3777 want_vtbl_regdata, 3778 want_vtbl_regdatum, 3779 want_vtbl_backref, 3780 want_vtbl_utf8 3781 }; 3782 3783 /* Note: the lowest 8 bits are reserved for 3784 stuffing into op->op_private */ 3785 #define HINT_PRIVATE_MASK 0x000000ff 3786 #define HINT_INTEGER 0x00000001 /* integer pragma */ 3787 #define HINT_STRICT_REFS 0x00000002 /* strict pragma */ 3788 #define HINT_LOCALE 0x00000004 /* locale pragma */ 3789 #define HINT_BYTES 0x00000008 /* bytes pragma */ 3790 /* #define HINT_notused10 0x00000010 */ 3791 /* Note: 20,40,80 used for NATIVE_HINTS */ 3792 /* currently defined by vms/vmsish.h */ 3793 3794 #define HINT_BLOCK_SCOPE 0x00000100 3795 #define HINT_STRICT_SUBS 0x00000200 /* strict pragma */ 3796 #define HINT_STRICT_VARS 0x00000400 /* strict pragma */ 3797 3798 /* The HINT_NEW_* constants are used by the overload pragma */ 3799 #define HINT_NEW_INTEGER 0x00001000 3800 #define HINT_NEW_FLOAT 0x00002000 3801 #define HINT_NEW_BINARY 0x00004000 3802 #define HINT_NEW_STRING 0x00008000 3803 #define HINT_NEW_RE 0x00010000 3804 #define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */ 3805 3806 #define HINT_RE_TAINT 0x00100000 /* re pragma */ 3807 #define HINT_RE_EVAL 0x00200000 /* re pragma */ 3808 3809 #define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */ 3810 #define HINT_UTF8 0x00800000 /* utf8 pragma */ 3811 3812 /* The following are stored in $sort::hints, not in PL_hints */ 3813 #define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */ 3814 #define HINT_SORT_QUICKSORT 0x00000001 3815 #define HINT_SORT_MERGESORT 0x00000002 3816 #define HINT_SORT_STABLE 0x00000100 /* sort styles (currently one) */ 3817 3818 /* Various states of the input record separator SV (rs) */ 3819 #define RsSNARF(sv) (! SvOK(sv)) 3820 #define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv))) 3821 #define RsPARA(sv) (SvPOK(sv) && ! SvCUR(sv)) 3822 #define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0)) 3823 3824 /* A struct for keeping various DEBUGGING related stuff, 3825 * neatly packed. Currently only scratch variables for 3826 * constructing debug output are included. Needed always, 3827 * not just when DEBUGGING, though, because of the re extension. c*/ 3828 struct perl_debug_pad { 3829 SV pad[3]; 3830 }; 3831 3832 #define PERL_DEBUG_PAD(i) &(PL_debug_pad.pad[i]) 3833 #define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, \ 3834 (((XPV*) SvANY(PERL_DEBUG_PAD(i)))->xpv_cur = 0), \ 3835 PERL_DEBUG_PAD(i)) 3836 3837 /* Enable variables which are pointers to functions */ 3838 typedef void (CPERLscope(*peep_t))(pTHX_ OP* o); 3839 typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm); 3840 typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg, 3841 char* strend, char* strbeg, I32 minend, 3842 SV* screamer, void* data, U32 flags); 3843 typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv, 3844 char *strpos, char *strend, 3845 U32 flags, 3846 struct re_scream_pos_data_s *d); 3847 typedef SV* (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog); 3848 typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r); 3849 3850 typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*); 3851 typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*); 3852 typedef void (*SVFUNC_t) (pTHX_ SV*); 3853 typedef I32 (*SVCOMPARE_t) (pTHX_ SV*, SV*); 3854 typedef void (*XSINIT_t) (pTHX); 3855 typedef void (*ATEXIT_t) (pTHX_ void*); 3856 typedef void (*XSUBADDR_t) (pTHX_ CV *); 3857 3858 /* Set up PERLVAR macros for populating structs */ 3859 #define PERLVAR(var,type) type var; 3860 #define PERLVARA(var,n,type) type var[n]; 3861 #define PERLVARI(var,type,init) type var; 3862 #define PERLVARIC(var,type,init) type var; 3863 3864 /* Interpreter exitlist entry */ 3865 typedef struct exitlistentry { 3866 void (*fn) (pTHX_ void*); 3867 void *ptr; 3868 } PerlExitListEntry; 3869 3870 #ifdef PERL_GLOBAL_STRUCT 3871 struct perl_vars { 3872 # include "perlvars.h" 3873 }; 3874 3875 # ifdef PERL_CORE 3876 EXT struct perl_vars PL_Vars; 3877 EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); 3878 # else /* PERL_CORE */ 3879 # if !defined(__GNUC__) || !defined(WIN32) 3880 EXT 3881 # endif /* WIN32 */ 3882 struct perl_vars *PL_VarsPtr; 3883 # define PL_Vars (*((PL_VarsPtr) \ 3884 ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX)))) 3885 # endif /* PERL_CORE */ 3886 #endif /* PERL_GLOBAL_STRUCT */ 3887 3888 #if defined(MULTIPLICITY) 3889 /* If we have multiple interpreters define a struct 3890 holding variables which must be per-interpreter 3891 If we don't have threads anything that would have 3892 be per-thread is per-interpreter. 3893 */ 3894 3895 struct interpreter { 3896 # ifndef USE_5005THREADS 3897 # include "thrdvar.h" 3898 # endif 3899 # include "intrpvar.h" 3900 /* 3901 * The following is a buffer where new variables must 3902 * be defined to maintain binary compatibility with previous versions 3903 */ 3904 PERLVARA(object_compatibility,30, char) 3905 }; 3906 3907 #else 3908 struct interpreter { 3909 char broiled; 3910 }; 3911 #endif /* MULTIPLICITY */ 3912 3913 #ifdef USE_5005THREADS 3914 /* If we have threads define a struct with all the variables 3915 * that have to be per-thread 3916 */ 3917 3918 3919 struct perl_thread { 3920 #include "thrdvar.h" 3921 }; 3922 3923 typedef struct perl_thread *Thread; 3924 3925 #else 3926 typedef void *Thread; 3927 #endif 3928 3929 /* Done with PERLVAR macros for now ... */ 3930 #undef PERLVAR 3931 #undef PERLVARA 3932 #undef PERLVARI 3933 #undef PERLVARIC 3934 3935 /* Types used by pack/unpack */ 3936 typedef enum { 3937 e_no_len, /* no length */ 3938 e_number, /* number, [] */ 3939 e_star /* asterisk */ 3940 } howlen_t; 3941 3942 typedef struct { 3943 char* patptr; /* current template char */ 3944 char* patend; /* one after last char */ 3945 char* grpbeg; /* 1st char of ()-group */ 3946 char* grpend; /* end of ()-group */ 3947 I32 code; /* template code (!<>) */ 3948 I32 length; /* length/repeat count */ 3949 howlen_t howlen; /* how length is given */ 3950 int level; /* () nesting level */ 3951 U32 flags; /* /=4, comma=2, pack=1 */ 3952 /* and group modifiers */ 3953 } tempsym_t; 3954 3955 #include "thread.h" 3956 #include "pp.h" 3957 3958 #ifndef PERL_CALLCONV 3959 # define PERL_CALLCONV 3960 #endif 3961 #undef PERL_CKDEF 3962 #undef PERL_PPDEF 3963 #define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o); 3964 #define PERL_PPDEF(s) PERL_CALLCONV OP *s (pTHX); 3965 3966 #include "proto.h" 3967 3968 /* this has structure inits, so it cannot be included before here */ 3969 #include "opcode.h" 3970 3971 /* The following must follow proto.h as #defines mess up syntax */ 3972 3973 #if !defined(PERL_FOR_X2P) 3974 # include "embedvar.h" 3975 #endif 3976 3977 /* Now include all the 'global' variables 3978 * If we don't have threads or multiple interpreters 3979 * these include variables that would have been their struct-s 3980 */ 3981 3982 #define PERLVAR(var,type) EXT type PL_##var; 3983 #define PERLVARA(var,n,type) EXT type PL_##var[n]; 3984 #define PERLVARI(var,type,init) EXT type PL_##var INIT(init); 3985 #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init); 3986 3987 #if !defined(MULTIPLICITY) 3988 START_EXTERN_C 3989 # include "intrpvar.h" 3990 # ifndef USE_5005THREADS 3991 # include "thrdvar.h" 3992 # endif 3993 END_EXTERN_C 3994 #endif 3995 3996 #if defined(WIN32) 3997 /* Now all the config stuff is setup we can include embed.h */ 3998 # include "embed.h" 3999 #endif 4000 4001 #ifndef PERL_GLOBAL_STRUCT 4002 START_EXTERN_C 4003 4004 # include "perlvars.h" 4005 4006 END_EXTERN_C 4007 #endif 4008 4009 #include "reentr.inc" 4010 4011 #undef PERLVAR 4012 #undef PERLVARA 4013 #undef PERLVARI 4014 #undef PERLVARIC 4015 4016 START_EXTERN_C 4017 4018 #ifdef DOINIT 4019 4020 EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get), 4021 MEMBER_TO_FPTR(Perl_magic_set), 4022 MEMBER_TO_FPTR(Perl_magic_len), 4023 0, 0}; 4024 EXT MGVTBL PL_vtbl_env = {0, MEMBER_TO_FPTR(Perl_magic_set_all_env), 4025 0, MEMBER_TO_FPTR(Perl_magic_clear_all_env), 4026 0}; 4027 EXT MGVTBL PL_vtbl_envelem = {0, MEMBER_TO_FPTR(Perl_magic_setenv), 4028 0, MEMBER_TO_FPTR(Perl_magic_clearenv), 4029 0}; 4030 EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0}; 4031 #ifdef PERL_MICRO 4032 EXT MGVTBL PL_vtbl_sigelem = {0, 0, 0, 0, 0}; 4033 #else 4034 EXT MGVTBL PL_vtbl_sigelem = {MEMBER_TO_FPTR(Perl_magic_getsig), 4035 MEMBER_TO_FPTR(Perl_magic_setsig), 4036 0, MEMBER_TO_FPTR(Perl_magic_clearsig), 4037 0}; 4038 #endif 4039 EXT MGVTBL PL_vtbl_pack = {0, 0, 4040 MEMBER_TO_FPTR(Perl_magic_sizepack), 4041 MEMBER_TO_FPTR(Perl_magic_wipepack), 4042 0}; 4043 EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack), 4044 MEMBER_TO_FPTR(Perl_magic_setpack), 4045 0, MEMBER_TO_FPTR(Perl_magic_clearpack), 4046 0}; 4047 EXT MGVTBL PL_vtbl_dbline = {0, MEMBER_TO_FPTR(Perl_magic_setdbline), 4048 0, 0, 0}; 4049 EXT MGVTBL PL_vtbl_isa = {0, MEMBER_TO_FPTR(Perl_magic_setisa), 4050 0, MEMBER_TO_FPTR(Perl_magic_setisa), 4051 0}; 4052 EXT MGVTBL PL_vtbl_isaelem = {0, MEMBER_TO_FPTR(Perl_magic_setisa), 4053 0, 0, 0}; 4054 EXT MGVTBL PL_vtbl_arylen = {MEMBER_TO_FPTR(Perl_magic_getarylen), 4055 MEMBER_TO_FPTR(Perl_magic_setarylen), 4056 0, 0, 0}; 4057 EXT MGVTBL PL_vtbl_glob = {MEMBER_TO_FPTR(Perl_magic_getglob), 4058 MEMBER_TO_FPTR(Perl_magic_setglob), 4059 0, 0, 0}; 4060 EXT MGVTBL PL_vtbl_mglob = {0, MEMBER_TO_FPTR(Perl_magic_setmglob), 4061 0, 0, 0}; 4062 EXT MGVTBL PL_vtbl_nkeys = {MEMBER_TO_FPTR(Perl_magic_getnkeys), 4063 MEMBER_TO_FPTR(Perl_magic_setnkeys), 4064 0, 0, 0}; 4065 EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint), 4066 MEMBER_TO_FPTR(Perl_magic_settaint), 4067 0, 0, 0}; 4068 EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr), 4069 MEMBER_TO_FPTR(Perl_magic_setsubstr), 4070 0, 0, 0}; 4071 EXT MGVTBL PL_vtbl_vec = {MEMBER_TO_FPTR(Perl_magic_getvec), 4072 MEMBER_TO_FPTR(Perl_magic_setvec), 4073 0, 0, 0}; 4074 EXT MGVTBL PL_vtbl_pos = {MEMBER_TO_FPTR(Perl_magic_getpos), 4075 MEMBER_TO_FPTR(Perl_magic_setpos), 4076 0, 0, 0}; 4077 EXT MGVTBL PL_vtbl_bm = {0, MEMBER_TO_FPTR(Perl_magic_setbm), 4078 0, 0, 0}; 4079 EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm), 4080 0, 0, 0}; 4081 EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar), 4082 MEMBER_TO_FPTR(Perl_magic_setuvar), 4083 0, 0, 0}; 4084 #ifdef USE_5005THREADS 4085 EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, 4086 MEMBER_TO_FPTR(Perl_magic_mutexfree)}; 4087 #endif /* USE_5005THREADS */ 4088 EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem), 4089 MEMBER_TO_FPTR(Perl_magic_setdefelem), 4090 0, 0, 0}; 4091 4092 EXT MGVTBL PL_vtbl_regexp = {0, MEMBER_TO_FPTR(Perl_magic_setregexp),0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)}; 4093 EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0}; 4094 EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get), 4095 MEMBER_TO_FPTR(Perl_magic_regdatum_set), 0, 0, 0}; 4096 4097 #ifdef USE_LOCALE_COLLATE 4098 EXT MGVTBL PL_vtbl_collxfrm = {0, 4099 MEMBER_TO_FPTR(Perl_magic_setcollxfrm), 4100 0, 0, 0}; 4101 #endif 4102 4103 EXT MGVTBL PL_vtbl_amagic = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), 4104 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; 4105 EXT MGVTBL PL_vtbl_amagicelem = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), 4106 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; 4107 4108 EXT MGVTBL PL_vtbl_backref = {0, 0, 4109 0, 0, MEMBER_TO_FPTR(Perl_magic_killbackrefs)}; 4110 4111 EXT MGVTBL PL_vtbl_ovrld = {0, 0, 4112 0, 0, MEMBER_TO_FPTR(Perl_magic_freeovrld)}; 4113 4114 EXT MGVTBL PL_vtbl_utf8 = {0, 4115 MEMBER_TO_FPTR(Perl_magic_setutf8), 4116 0, 0, 0}; 4117 4118 #else /* !DOINIT */ 4119 4120 EXT MGVTBL PL_vtbl_sv; 4121 EXT MGVTBL PL_vtbl_env; 4122 EXT MGVTBL PL_vtbl_envelem; 4123 EXT MGVTBL PL_vtbl_sig; 4124 EXT MGVTBL PL_vtbl_sigelem; 4125 EXT MGVTBL PL_vtbl_pack; 4126 EXT MGVTBL PL_vtbl_packelem; 4127 EXT MGVTBL PL_vtbl_dbline; 4128 EXT MGVTBL PL_vtbl_isa; 4129 EXT MGVTBL PL_vtbl_isaelem; 4130 EXT MGVTBL PL_vtbl_arylen; 4131 EXT MGVTBL PL_vtbl_glob; 4132 EXT MGVTBL PL_vtbl_mglob; 4133 EXT MGVTBL PL_vtbl_nkeys; 4134 EXT MGVTBL PL_vtbl_taint; 4135 EXT MGVTBL PL_vtbl_substr; 4136 EXT MGVTBL PL_vtbl_vec; 4137 EXT MGVTBL PL_vtbl_pos; 4138 EXT MGVTBL PL_vtbl_bm; 4139 EXT MGVTBL PL_vtbl_fm; 4140 EXT MGVTBL PL_vtbl_uvar; 4141 EXT MGVTBL PL_vtbl_ovrld; 4142 4143 #ifdef USE_5005THREADS 4144 EXT MGVTBL PL_vtbl_mutex; 4145 #endif /* USE_5005THREADS */ 4146 4147 EXT MGVTBL PL_vtbl_defelem; 4148 EXT MGVTBL PL_vtbl_regexp; 4149 EXT MGVTBL PL_vtbl_regdata; 4150 EXT MGVTBL PL_vtbl_regdatum; 4151 4152 #ifdef USE_LOCALE_COLLATE 4153 EXT MGVTBL PL_vtbl_collxfrm; 4154 #endif 4155 4156 EXT MGVTBL PL_vtbl_amagic; 4157 EXT MGVTBL PL_vtbl_amagicelem; 4158 4159 EXT MGVTBL PL_vtbl_backref; 4160 EXT MGVTBL PL_vtbl_utf8; 4161 4162 #endif /* !DOINIT */ 4163 4164 enum { 4165 fallback_amg, abs_amg, 4166 bool__amg, nomethod_amg, 4167 string_amg, numer_amg, 4168 add_amg, add_ass_amg, 4169 subtr_amg, subtr_ass_amg, 4170 mult_amg, mult_ass_amg, 4171 div_amg, div_ass_amg, 4172 modulo_amg, modulo_ass_amg, 4173 pow_amg, pow_ass_amg, 4174 lshift_amg, lshift_ass_amg, 4175 rshift_amg, rshift_ass_amg, 4176 band_amg, band_ass_amg, 4177 bor_amg, bor_ass_amg, 4178 bxor_amg, bxor_ass_amg, 4179 lt_amg, le_amg, 4180 gt_amg, ge_amg, 4181 eq_amg, ne_amg, 4182 ncmp_amg, scmp_amg, 4183 slt_amg, sle_amg, 4184 sgt_amg, sge_amg, 4185 seq_amg, sne_amg, 4186 not_amg, compl_amg, 4187 inc_amg, dec_amg, 4188 atan2_amg, cos_amg, 4189 sin_amg, exp_amg, 4190 log_amg, sqrt_amg, 4191 repeat_amg, repeat_ass_amg, 4192 concat_amg, concat_ass_amg, 4193 copy_amg, neg_amg, 4194 to_sv_amg, to_av_amg, 4195 to_hv_amg, to_gv_amg, 4196 to_cv_amg, iter_amg, 4197 int_amg, DESTROY_amg, 4198 max_amg_code 4199 /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */ 4200 }; 4201 4202 #define NofAMmeth max_amg_code 4203 #define AMG_id2name(id) (PL_AMG_names[id]+1) 4204 4205 #ifdef DOINIT 4206 EXTCONST char * PL_AMG_names[NofAMmeth] = { 4207 /* Names kept in the symbol table. fallback => "()", the rest has 4208 "(" prepended. The only other place in perl which knows about 4209 this convention is AMG_id2name (used for debugging output and 4210 'nomethod' only), the only other place which has it hardwired is 4211 overload.pm. */ 4212 "()", "(abs", /* "fallback" should be the first. */ 4213 "(bool", "(nomethod", 4214 "(\"\"", "(0+", 4215 "(+", "(+=", 4216 "(-", "(-=", 4217 "(*", "(*=", 4218 "(/", "(/=", 4219 "(%", "(%=", 4220 "(**", "(**=", 4221 "(<<", "(<<=", 4222 "(>>", "(>>=", 4223 "(&", "(&=", 4224 "(|", "(|=", 4225 "(^", "(^=", 4226 "(<", "(<=", 4227 "(>", "(>=", 4228 "(==", "(!=", 4229 "(<=>", "(cmp", 4230 "(lt", "(le", 4231 "(gt", "(ge", 4232 "(eq", "(ne", 4233 "(!", "(~", 4234 "(++", "(--", 4235 "(atan2", "(cos", 4236 "(sin", "(exp", 4237 "(log", "(sqrt", 4238 "(x", "(x=", 4239 "(.", "(.=", 4240 "(=", "(neg", 4241 "(${}", "(@{}", 4242 "(%{}", "(*{}", 4243 "(&{}", "(<>", 4244 "(int", "DESTROY", 4245 }; 4246 #else 4247 EXTCONST char * PL_AMG_names[NofAMmeth]; 4248 #endif /* def INITAMAGIC */ 4249 4250 END_EXTERN_C 4251 4252 struct am_table { 4253 U32 was_ok_sub; 4254 long was_ok_am; 4255 U32 flags; 4256 CV* table[NofAMmeth]; 4257 long fallback; 4258 }; 4259 struct am_table_short { 4260 U32 was_ok_sub; 4261 long was_ok_am; 4262 U32 flags; 4263 }; 4264 typedef struct am_table AMT; 4265 typedef struct am_table_short AMTS; 4266 4267 #define AMGfallNEVER 1 4268 #define AMGfallNO 2 4269 #define AMGfallYES 3 4270 4271 #define AMTf_AMAGIC 1 4272 #define AMTf_OVERLOADED 2 4273 #define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC) 4274 #define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC) 4275 #define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC) 4276 #define AMT_OVERLOADED(amt) ((amt)->flags & AMTf_OVERLOADED) 4277 #define AMT_OVERLOADED_on(amt) ((amt)->flags |= AMTf_OVERLOADED) 4278 #define AMT_OVERLOADED_off(amt) ((amt)->flags &= ~AMTf_OVERLOADED) 4279 4280 #define StashHANDLER(stash,meth) gv_handler((stash),CAT2(meth,_amg)) 4281 4282 /* 4283 * some compilers like to redefine cos et alia as faster 4284 * (and less accurate?) versions called F_cos et cetera (Quidquid 4285 * latine dictum sit, altum viditur.) This trick collides with 4286 * the Perl overloading (amg). The following #defines fool both. 4287 */ 4288 4289 #ifdef _FASTMATH 4290 # ifdef atan2 4291 # define F_atan2_amg atan2_amg 4292 # endif 4293 # ifdef cos 4294 # define F_cos_amg cos_amg 4295 # endif 4296 # ifdef exp 4297 # define F_exp_amg exp_amg 4298 # endif 4299 # ifdef log 4300 # define F_log_amg log_amg 4301 # endif 4302 # ifdef pow 4303 # define F_pow_amg pow_amg 4304 # endif 4305 # ifdef sin 4306 # define F_sin_amg sin_amg 4307 # endif 4308 # ifdef sqrt 4309 # define F_sqrt_amg sqrt_amg 4310 # endif 4311 #endif /* _FASTMATH */ 4312 4313 #define PERLDB_ALL (PERLDBf_SUB | PERLDBf_LINE | \ 4314 PERLDBf_NOOPT | PERLDBf_INTER | \ 4315 PERLDBf_SUBLINE| PERLDBf_SINGLE| \ 4316 PERLDBf_NAMEEVAL| PERLDBf_NAMEANON) 4317 /* No _NONAME, _GOTO */ 4318 #define PERLDBf_SUB 0x01 /* Debug sub enter/exit */ 4319 #define PERLDBf_LINE 0x02 /* Keep line # */ 4320 #define PERLDBf_NOOPT 0x04 /* Switch off optimizations */ 4321 #define PERLDBf_INTER 0x08 /* Preserve more data for 4322 later inspections */ 4323 #define PERLDBf_SUBLINE 0x10 /* Keep subr source lines */ 4324 #define PERLDBf_SINGLE 0x20 /* Start with single-step on */ 4325 #define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr */ 4326 #define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto */ 4327 #define PERLDBf_NAMEEVAL 0x100 /* Informative names for evals */ 4328 #define PERLDBf_NAMEANON 0x200 /* Informative names for anon subs */ 4329 4330 #define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB)) 4331 #define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE)) 4332 #define PERLDB_NOOPT (PL_perldb && (PL_perldb & PERLDBf_NOOPT)) 4333 #define PERLDB_INTER (PL_perldb && (PL_perldb & PERLDBf_INTER)) 4334 #define PERLDB_SUBLINE (PL_perldb && (PL_perldb & PERLDBf_SUBLINE)) 4335 #define PERLDB_SINGLE (PL_perldb && (PL_perldb & PERLDBf_SINGLE)) 4336 #define PERLDB_SUB_NN (PL_perldb && (PL_perldb & (PERLDBf_NONAME))) 4337 #define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO)) 4338 #define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL)) 4339 #define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON)) 4340 4341 4342 #ifdef USE_LOCALE_NUMERIC 4343 4344 #define SET_NUMERIC_STANDARD() \ 4345 set_numeric_standard(); 4346 4347 #define SET_NUMERIC_LOCAL() \ 4348 set_numeric_local(); 4349 4350 #define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) 4351 #define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) 4352 4353 #define IN_LOCALE \ 4354 (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) 4355 4356 #define STORE_NUMERIC_LOCAL_SET_STANDARD() \ 4357 bool was_local = PL_numeric_local && IN_LOCALE; \ 4358 if (was_local) SET_NUMERIC_STANDARD(); 4359 4360 #define STORE_NUMERIC_STANDARD_SET_LOCAL() \ 4361 bool was_standard = PL_numeric_standard && IN_LOCALE; \ 4362 if (was_standard) SET_NUMERIC_LOCAL(); 4363 4364 #define RESTORE_NUMERIC_LOCAL() \ 4365 if (was_local) SET_NUMERIC_LOCAL(); 4366 4367 #define RESTORE_NUMERIC_STANDARD() \ 4368 if (was_standard) SET_NUMERIC_STANDARD(); 4369 4370 #define Atof my_atof 4371 4372 #else /* !USE_LOCALE_NUMERIC */ 4373 4374 #define SET_NUMERIC_STANDARD() /**/ 4375 #define SET_NUMERIC_LOCAL() /**/ 4376 #define IS_NUMERIC_RADIX(a, b) (0) 4377 #define STORE_NUMERIC_LOCAL_SET_STANDARD() /**/ 4378 #define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/ 4379 #define RESTORE_NUMERIC_LOCAL() /**/ 4380 #define RESTORE_NUMERIC_STANDARD() /**/ 4381 #define Atof my_atof 4382 #define IN_LOCALE_RUNTIME 0 4383 4384 #endif /* !USE_LOCALE_NUMERIC */ 4385 4386 #if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG 4387 # ifdef __hpux 4388 # define strtoll __strtoll /* secret handshake */ 4389 # endif 4390 # ifdef WIN64 4391 # define strtoll _strtoi64 /* secret handshake */ 4392 # endif 4393 # if !defined(Strtol) && defined(HAS_STRTOLL) 4394 # define Strtol strtoll 4395 # endif 4396 # if !defined(Strtol) && defined(HAS_STRTOQ) 4397 # define Strtol strtoq 4398 # endif 4399 /* is there atoq() anywhere? */ 4400 #endif 4401 #if !defined(Strtol) && defined(HAS_STRTOL) 4402 # define Strtol strtol 4403 #endif 4404 #ifndef Atol 4405 /* It would be more fashionable to use Strtol() to define atol() 4406 * (as is done for Atoul(), see below) but for backward compatibility 4407 * we just assume atol(). */ 4408 # if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_ATOLL) 4409 # ifdef WIN64 4410 # define atoll _atoi64 /* secret handshake */ 4411 # endif 4412 # define Atol atoll 4413 # else 4414 # define Atol atol 4415 # endif 4416 #endif 4417 4418 #if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG 4419 # ifdef __hpux 4420 # define strtoull __strtoull /* secret handshake */ 4421 # endif 4422 # ifdef WIN64 4423 # define strtoull _strtoui64 /* secret handshake */ 4424 # endif 4425 # if !defined(Strtoul) && defined(HAS_STRTOULL) 4426 # define Strtoul strtoull 4427 # endif 4428 # if !defined(Strtoul) && defined(HAS_STRTOUQ) 4429 # define Strtoul strtouq 4430 # endif 4431 /* is there atouq() anywhere? */ 4432 #endif 4433 #if !defined(Strtoul) && defined(HAS_STRTOUL) 4434 # define Strtoul strtoul 4435 #endif 4436 #if !defined(Strtoul) && defined(HAS_STRTOL) /* Last resort. */ 4437 # define Strtoul(s, e, b) strchr((s), '-') ? ULONG_MAX : (unsigned long)strtol((s), (e), (b)) 4438 #endif 4439 #ifndef Atoul 4440 # define Atoul(s) Strtoul(s, (char **)NULL, 10) 4441 #endif 4442 4443 4444 /* if these never got defined, they need defaults */ 4445 #ifndef PERL_SET_CONTEXT 4446 # define PERL_SET_CONTEXT(i) PERL_SET_INTERP(i) 4447 #endif 4448 4449 #ifndef PERL_GET_CONTEXT 4450 # define PERL_GET_CONTEXT PERL_GET_INTERP 4451 #endif 4452 4453 #ifndef PERL_GET_THX 4454 # define PERL_GET_THX ((void*)NULL) 4455 #endif 4456 4457 #ifndef PERL_SET_THX 4458 # define PERL_SET_THX(t) NOOP 4459 #endif 4460 4461 #ifndef PERL_SCRIPT_MODE 4462 #define PERL_SCRIPT_MODE "r" 4463 #endif 4464 4465 /* 4466 * Some operating systems are stingy with stack allocation, 4467 * so perl may have to guard against stack overflow. 4468 */ 4469 #ifndef PERL_STACK_OVERFLOW_CHECK 4470 #define PERL_STACK_OVERFLOW_CHECK() NOOP 4471 #endif 4472 4473 /* 4474 * Some nonpreemptive operating systems find it convenient to 4475 * check for asynchronous conditions after each op execution. 4476 * Keep this check simple, or it may slow down execution 4477 * massively. 4478 */ 4479 4480 #ifndef PERL_MICRO 4481 # ifndef PERL_ASYNC_CHECK 4482 # define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals() 4483 # endif 4484 #endif 4485 4486 #ifndef PERL_ASYNC_CHECK 4487 # define PERL_ASYNC_CHECK() NOOP 4488 #endif 4489 4490 /* 4491 * On some operating systems, a memory allocation may succeed, 4492 * but put the process too close to the system's comfort limit. 4493 * In this case, PERL_ALLOC_CHECK frees the pointer and sets 4494 * it to NULL. 4495 */ 4496 #ifndef PERL_ALLOC_CHECK 4497 #define PERL_ALLOC_CHECK(p) NOOP 4498 #endif 4499 4500 #ifdef HAS_SEM 4501 # include <sys/ipc.h> 4502 # include <sys/sem.h> 4503 # ifndef HAS_UNION_SEMUN /* Provide the union semun. */ 4504 union semun { 4505 int val; 4506 struct semid_ds *buf; 4507 unsigned short *array; 4508 }; 4509 # endif 4510 # ifdef USE_SEMCTL_SEMUN 4511 # ifdef IRIX32_SEMUN_BROKEN_BY_GCC 4512 union gccbug_semun { 4513 int val; 4514 struct semid_ds *buf; 4515 unsigned short *array; 4516 char __dummy[5]; 4517 }; 4518 # define semun gccbug_semun 4519 # endif 4520 # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) 4521 # else 4522 # ifdef USE_SEMCTL_SEMID_DS 4523 # ifdef EXTRA_F_IN_SEMUN_BUF 4524 # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buff) 4525 # else 4526 # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf) 4527 # endif 4528 # endif 4529 # endif 4530 #endif 4531 4532 /* 4533 * Boilerplate macros for initializing and accessing interpreter-local 4534 * data from C. All statics in extensions should be reworked to use 4535 * this, if you want to make the extension thread-safe. See ext/re/re.xs 4536 * for an example of the use of these macros, and perlxs.pod for more. 4537 * 4538 * Code that uses these macros is responsible for the following: 4539 * 1. #define MY_CXT_KEY to a unique string, e.g. 4540 * "DynaLoader::_guts" XS_VERSION 4541 * 2. Declare a typedef named my_cxt_t that is a structure that contains 4542 * all the data that needs to be interpreter-local. 4543 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. 4544 * 4. Use the MY_CXT_INIT macro such that it is called exactly once 4545 * (typically put in the BOOT: section). 4546 * 5. Use the members of the my_cxt_t structure everywhere as 4547 * MY_CXT.member. 4548 * 6. Use the dMY_CXT macro (a declaration) in all the functions that 4549 * access MY_CXT. 4550 */ 4551 4552 #if defined(PERL_IMPLICIT_CONTEXT) 4553 4554 /* This must appear in all extensions that define a my_cxt_t structure, 4555 * right after the definition (i.e. at file scope). The non-threads 4556 * case below uses it to declare the data as static. */ 4557 #define START_MY_CXT 4558 4559 /* Fetches the SV that keeps the per-interpreter data. */ 4560 #define dMY_CXT_SV \ 4561 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ 4562 sizeof(MY_CXT_KEY)-1, TRUE) 4563 4564 /* This declaration should be used within all functions that use the 4565 * interpreter-local data. */ 4566 #define dMY_CXT \ 4567 dMY_CXT_SV; \ 4568 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)) 4569 4570 /* Creates and zeroes the per-interpreter data. 4571 * (We allocate my_cxtp in a Perl SV so that it will be released when 4572 * the interpreter goes away.) */ 4573 #define MY_CXT_INIT \ 4574 dMY_CXT_SV; \ 4575 /* newSV() allocates one more than needed */ \ 4576 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 4577 Zero(my_cxtp, 1, my_cxt_t); \ 4578 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 4579 4580 /* Clones the per-interpreter data. */ 4581 #define MY_CXT_CLONE \ 4582 dMY_CXT_SV; \ 4583 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 4584 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ 4585 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 4586 4587 /* This macro must be used to access members of the my_cxt_t structure. 4588 * e.g. MYCXT.some_data */ 4589 #define MY_CXT (*my_cxtp) 4590 4591 /* Judicious use of these macros can reduce the number of times dMY_CXT 4592 * is used. Use is similar to pTHX, aTHX etc. */ 4593 #define pMY_CXT my_cxt_t *my_cxtp 4594 #define pMY_CXT_ pMY_CXT, 4595 #define _pMY_CXT ,pMY_CXT 4596 #define aMY_CXT my_cxtp 4597 #define aMY_CXT_ aMY_CXT, 4598 #define _aMY_CXT ,aMY_CXT 4599 4600 #else /* USE_ITHREADS */ 4601 4602 #define START_MY_CXT static my_cxt_t my_cxt; 4603 #define dMY_CXT_SV dNOOP 4604 #define dMY_CXT dNOOP 4605 #define MY_CXT_INIT NOOP 4606 #define MY_CXT_CLONE NOOP 4607 #define MY_CXT my_cxt 4608 4609 #define pMY_CXT void 4610 #define pMY_CXT_ 4611 #define _pMY_CXT 4612 #define aMY_CXT 4613 #define aMY_CXT_ 4614 #define _aMY_CXT 4615 4616 #endif /* !defined(USE_ITHREADS) */ 4617 4618 #ifdef I_FCNTL 4619 # include <fcntl.h> 4620 #endif 4621 4622 #ifdef __Lynx__ 4623 # include <fcntl.h> 4624 #endif 4625 4626 #ifdef I_SYS_FILE 4627 # include <sys/file.h> 4628 #endif 4629 4630 #if defined(HAS_FLOCK) && !defined(HAS_FLOCK_PROTO) 4631 int flock(int fd, int op); 4632 #endif 4633 4634 #ifndef O_RDONLY 4635 /* Assume UNIX defaults */ 4636 # define O_RDONLY 0000 4637 # define O_WRONLY 0001 4638 # define O_RDWR 0002 4639 # define O_CREAT 0100 4640 #endif 4641 4642 #ifndef O_BINARY 4643 # define O_BINARY 0 4644 #endif 4645 4646 #ifndef O_TEXT 4647 # define O_TEXT 0 4648 #endif 4649 4650 #if O_TEXT != O_BINARY 4651 /* If you have different O_TEXT and O_BINARY and you are a CLRF shop, 4652 * that is, you are somehow DOSish. */ 4653 # if defined(__BEOS__) || defined(__VOS__) || defined(__CYGWIN__) 4654 /* BeOS has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect; 4655 * BeOS is always UNIXoid (LF), not DOSish (CRLF). */ 4656 /* VOS has O_TEXT != O_BINARY, and they have effect, 4657 * but VOS always uses LF, never CRLF. */ 4658 /* If you have O_TEXT different from your O_BINARY but you still are 4659 * not a CRLF shop. */ 4660 # undef PERLIO_USING_CRLF 4661 # else 4662 /* If you really are DOSish. */ 4663 # define PERLIO_USING_CRLF 1 4664 # endif 4665 #endif 4666 4667 #ifdef IAMSUID 4668 4669 #ifdef I_SYS_STATVFS 4670 # if defined(PERL_SCO) && !defined(_SVID3) 4671 # define _SVID3 4672 # endif 4673 # include <sys/statvfs.h> /* for f?statvfs() */ 4674 #endif 4675 #ifdef I_SYS_MOUNT 4676 # include <sys/mount.h> /* for *BSD f?statfs() */ 4677 #endif 4678 #ifdef I_MNTENT 4679 # include <mntent.h> /* for getmntent() */ 4680 #endif 4681 #ifdef I_SYS_STATFS 4682 # include <sys/statfs.h> /* for some statfs() */ 4683 #endif 4684 #ifdef I_SYS_VFS 4685 # ifdef __sgi 4686 # define sv IRIX_sv /* kludge: IRIX has an sv of its own */ 4687 # endif 4688 # include <sys/vfs.h> /* for some statfs() */ 4689 # ifdef __sgi 4690 # undef IRIX_sv 4691 # endif 4692 #endif 4693 #ifdef I_USTAT 4694 # include <ustat.h> /* for ustat() */ 4695 #endif 4696 4697 #if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID) 4698 # define PERL_MOUNT_NOSUID MOUNT_NOSUID 4699 #endif 4700 #if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID) 4701 # define PERL_MOUNT_NOSUID MNT_NOSUID 4702 #endif 4703 #if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID) 4704 # define PERL_MOUNT_NOSUID MS_NOSUID 4705 #endif 4706 #if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID) 4707 # define PERL_MOUNT_NOSUID M_NOSUID 4708 #endif 4709 4710 #if !defined(PERL_MOUNT_NOEXEC) && defined(MOUNT_NOEXEC) 4711 # define PERL_MOUNT_NOEXEC MOUNT_NOEXEC 4712 #endif 4713 #if !defined(PERL_MOUNT_NOEXEC) && defined(MNT_NOEXEC) 4714 # define PERL_MOUNT_NOEXEC MNT_NOEXEC 4715 #endif 4716 #if !defined(PERL_MOUNT_NOEXEC) && defined(MS_NOEXEC) 4717 # define PERL_MOUNT_NOEXEC MS_NOEXEC 4718 #endif 4719 #if !defined(PERL_MOUNT_NOEXEC) && defined(M_NOEXEC) 4720 # define PERL_MOUNT_NOEXEC M_NOEXEC 4721 #endif 4722 4723 #endif /* IAMSUID */ 4724 4725 #ifdef I_LIBUTIL 4726 # include <libutil.h> /* setproctitle() in some FreeBSDs */ 4727 #endif 4728 4729 #ifndef EXEC_ARGV_CAST 4730 #define EXEC_ARGV_CAST(x) x 4731 #endif 4732 4733 #define IS_NUMBER_IN_UV 0x01 /* number within UV range (maybe not 4734 int). value returned in pointed- 4735 to UV */ 4736 #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */ 4737 #define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation */ 4738 #define IS_NUMBER_NEG 0x08 /* leading minus sign */ 4739 #define IS_NUMBER_INFINITY 0x10 /* this is big */ 4740 #define IS_NUMBER_NAN 0x20 /* this is not */ 4741 4742 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) 4743 4744 /* Input flags: */ 4745 #define PERL_SCAN_ALLOW_UNDERSCORES 0x01 /* grok_??? accept _ in numbers */ 4746 #define PERL_SCAN_DISALLOW_PREFIX 0x02 /* grok_??? reject 0x in hex etc */ 4747 #define PERL_SCAN_SILENT_ILLDIGIT 0x04 /* grok_??? not warn about illegal digits */ 4748 /* Output flags: */ 4749 #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */ 4750 4751 /* to let user control profiling */ 4752 #ifdef PERL_GPROF_CONTROL 4753 extern void moncontrol(int); 4754 #define PERL_GPROF_MONCONTROL(x) moncontrol(x) 4755 #else 4756 #define PERL_GPROF_MONCONTROL(x) 4757 #endif 4758 4759 #ifdef UNDER_CE 4760 #include "wince.h" 4761 #endif 4762 4763 /* ISO 6429 NEL - C1 control NExt Line */ 4764 /* See http://www.unicode.org/unicode/reports/tr13/ */ 4765 #ifdef EBCDIC /* In EBCDIC NEL is just an alias for LF */ 4766 # if '^' == 95 /* CP 1047: MVS OpenEdition - OS/390 - z/OS */ 4767 # define NEXT_LINE_CHAR 0x15 4768 # else /* CDRA */ 4769 # define NEXT_LINE_CHAR 0x25 4770 # endif 4771 #else 4772 # define NEXT_LINE_CHAR 0x85 4773 #endif 4774 4775 /* The UTF-8 bytes of the Unicode LS and PS, U+2028 and U+2029 */ 4776 #define UNICODE_LINE_SEPA_0 0xE2 4777 #define UNICODE_LINE_SEPA_1 0x80 4778 #define UNICODE_LINE_SEPA_2 0xA8 4779 #define UNICODE_PARA_SEPA_0 0xE2 4780 #define UNICODE_PARA_SEPA_1 0x80 4781 #define UNICODE_PARA_SEPA_2 0xA9 4782 4783 #ifndef PIPESOCK_MODE 4784 # define PIPESOCK_MODE 4785 #endif 4786 4787 #ifndef SOCKET_OPEN_MODE 4788 # define SOCKET_OPEN_MODE PIPESOCK_MODE 4789 #endif 4790 4791 #ifndef PIPE_OPEN_MODE 4792 # define PIPE_OPEN_MODE PIPESOCK_MODE 4793 #endif 4794 4795 #define PERL_MAGIC_UTF8_CACHESIZE 2 4796 4797 #define PERL_UNICODE_STDIN_FLAG 0x0001 4798 #define PERL_UNICODE_STDOUT_FLAG 0x0002 4799 #define PERL_UNICODE_STDERR_FLAG 0x0004 4800 #define PERL_UNICODE_IN_FLAG 0x0008 4801 #define PERL_UNICODE_OUT_FLAG 0x0010 4802 #define PERL_UNICODE_ARGV_FLAG 0x0020 4803 #define PERL_UNICODE_LOCALE_FLAG 0x0040 4804 #define PERL_UNICODE_WIDESYSCALLS_FLAG 0x0080 /* for Sarathy */ 4805 4806 #define PERL_UNICODE_STD_FLAG \ 4807 (PERL_UNICODE_STDIN_FLAG | \ 4808 PERL_UNICODE_STDOUT_FLAG | \ 4809 PERL_UNICODE_STDERR_FLAG) 4810 4811 #define PERL_UNICODE_INOUT_FLAG \ 4812 (PERL_UNICODE_IN_FLAG | \ 4813 PERL_UNICODE_OUT_FLAG) 4814 4815 #define PERL_UNICODE_DEFAULT_FLAGS \ 4816 (PERL_UNICODE_STD_FLAG | \ 4817 PERL_UNICODE_INOUT_FLAG | \ 4818 PERL_UNICODE_LOCALE_FLAG) 4819 4820 #define PERL_UNICODE_ALL_FLAGS 0x00ff 4821 4822 #define PERL_UNICODE_STDIN 'I' 4823 #define PERL_UNICODE_STDOUT 'O' 4824 #define PERL_UNICODE_STDERR 'E' 4825 #define PERL_UNICODE_STD 'S' 4826 #define PERL_UNICODE_IN 'i' 4827 #define PERL_UNICODE_OUT 'o' 4828 #define PERL_UNICODE_INOUT 'D' 4829 #define PERL_UNICODE_ARGV 'A' 4830 #define PERL_UNICODE_LOCALE 'L' 4831 #define PERL_UNICODE_WIDESYSCALLS 'W' 4832 4833 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001 4834 4835 /* From sigaction(2) (FreeBSD man page): 4836 * | Signal routines normally execute with the signal that 4837 * | caused their invocation blocked, but other signals may 4838 * | yet occur. 4839 * Emulation of this behavior (from within Perl) is enabled 4840 * by defining PERL_BLOCK_SIGNALS. 4841 */ 4842 #define PERL_BLOCK_SIGNALS 4843 4844 #if defined(HAS_SIGPROCMASK) && defined(PERL_BLOCK_SIGNALS) 4845 # define PERL_BLOCKSIG_ADD(set,sig) \ 4846 sigset_t set; sigemptyset(&(set)); sigaddset(&(set), sig) 4847 # define PERL_BLOCKSIG_BLOCK(set) \ 4848 sigprocmask(SIG_BLOCK, &(set), NULL) 4849 # define PERL_BLOCKSIG_UNBLOCK(set) \ 4850 sigprocmask(SIG_UNBLOCK, &(set), NULL) 4851 #endif /* HAS_SIGPROCMASK && PERL_BLOCK_SIGNALS */ 4852 4853 /* How about the old style of sigblock()? */ 4854 4855 #ifndef PERL_BLOCKSIG_ADD 4856 # define PERL_BLOCKSIG_ADD(set, sig) NOOP 4857 #endif 4858 #ifndef PERL_BLOCKSIG_BLOCK 4859 # define PERL_BLOCKSIG_BLOCK(set) NOOP 4860 #endif 4861 #ifndef PERL_BLOCKSIG_UNBLOCK 4862 # define PERL_BLOCKSIG_UNBLOCK(set) NOOP 4863 #endif 4864 4865 /* Use instead of abs() since abs() forces its argument to be an int, 4866 * but also beware since this evaluates its argument twice, so no x++. */ 4867 #define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) 4868 4869 #if defined(__DECC) && defined(__osf__) 4870 #pragma message disable (mainparm) /* Perl uses the envp in main(). */ 4871 #endif 4872 4873 /* and finally... */ 4874 #define PERL_PATCHLEVEL_H_IMPLICIT 4875 #include "patchlevel.h" 4876 #undef PERL_PATCHLEVEL_H_IMPLICIT 4877 4878 /* Mention 4879 4880 NV_PRESERVES_UV 4881 4882 HAS_MKSTEMP 4883 HAS_MKSTEMPS 4884 HAS_MKDTEMP 4885 4886 HAS_GETCWD 4887 4888 HAS_MMAP 4889 HAS_MPROTECT 4890 HAS_MSYNC 4891 HAS_MADVISE 4892 HAS_MUNMAP 4893 I_SYSMMAN 4894 Mmap_t 4895 4896 NVef 4897 NVff 4898 NVgf 4899 4900 HAS_UALARM 4901 HAS_USLEEP 4902 4903 HAS_SETITIMER 4904 HAS_GETITIMER 4905 4906 HAS_SENDMSG 4907 HAS_RECVMSG 4908 HAS_READV 4909 HAS_WRITEV 4910 I_SYSUIO 4911 HAS_STRUCT_MSGHDR 4912 HAS_STRUCT_CMSGHDR 4913 4914 HAS_NL_LANGINFO 4915 4916 HAS_DIRFD 4917 4918 so that Configure picks them up. */ 4919 4920 /* Source code compatibility cruft: 4921 PERL_XS_APIVERSION is not used, and has been superseded by inc_version_list 4922 It and PERL_PM_APIVERSION are retained for source compatibility in the 4923 5.8.x maintenance branch. 4924 */ 4925 4926 #define PERL_XS_APIVERSION "5.8.3" 4927 #define PERL_PM_APIVERSION "5.005" 4928 4929 #endif /* Include guard */ 4930 4931